--- a/NEWS Sun Jan 15 20:00:37 2023 +0100
+++ b/NEWS Sun Jan 15 20:00:44 2023 +0100
@@ -199,6 +199,9 @@
multp_mono_strong
wfP_subset_mset[simp]
+* Mirabelle:
+ - Added session to output directory structure. Minor INCOMPATIBILITY.
+
*** ML ***
--- a/src/HOL/Analysis/Further_Topology.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Analysis/Further_Topology.thy Sun Jan 15 20:00:44 2023 +0100
@@ -168,8 +168,7 @@
by (simp add: \<open>subspace S\<close> closed_subspace compact_Int_closed)
then obtain g where pfg: "polynomial_function g" and gim: "g ` (sphere 0 1 \<inter> S) \<subseteq> T"
and g12: "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> norm(f x - g x) < 1/2"
- apply (rule Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"])
- using fim by auto
+ using Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"] fim by auto
have gnz: "g x \<noteq> 0" if "x \<in> sphere 0 1 \<inter> S" for x
proof -
have "norm (f x) = 1"
@@ -326,8 +325,8 @@
obtain T':: "'a set"
where "subspace T'" and affT': "aff_dim T' = aff_dim T"
and homT: "rel_frontier T homeomorphic sphere 0 1 \<inter> T'"
- apply (rule spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a])
- using \<open>T \<noteq> {}\<close> by (auto simp add: aff_dim_le_DIM)
+ using \<open>T \<noteq> {}\<close> spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a]
+ by (force simp add: aff_dim_le_DIM)
with homeomorphic_imp_homotopy_eqv
have relT: "sphere 0 1 \<inter> T' homotopy_eqv rel_frontier T"
using homotopy_equivalent_space_sym by blast
@@ -344,10 +343,9 @@
have dimST': "dim S' < dim T'"
by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> affS' affST affT' less_irrefl not_le subspace_dim_equal)
have "\<exists>c. homotopic_with_canon (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
- apply (rule homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim])
- apply (rule homotopy_eqv_cohomotopic_triviality_null[OF relS, THEN iffD1, rule_format])
- apply (metis dimST' \<open>subspace S'\<close> \<open>subspace T'\<close> \<open>S' \<subseteq> T'\<close> spheremap_lemma2, blast)
- done
+ using spheremap_lemma2 homotopy_eqv_cohomotopic_triviality_null[OF relS]
+ using homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim]
+ by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> dimST')
with that show ?thesis by blast
qed
qed
@@ -370,8 +368,8 @@
case False
with \<open>\<not> s \<le> 0\<close> have "r > 0" "s > 0" by auto
show thesis
- apply (rule inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
- using \<open>0 < r\<close> \<open>0 < s\<close> assms(1) that by (simp_all add: f aff_dim_cball)
+ using inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f]
+ using \<open>0 < r\<close> \<open>0 < s\<close> assms(1) that by (auto simp add: f aff_dim_cball)
qed
qed
@@ -401,12 +399,10 @@
then show ?thesis
using UnionI feq geq \<open>S \<notin> \<F>\<close> subsetD that by fastforce
qed
- show ?case
- apply (rule_tac x="\<lambda>x. if x \<in> S then f x else g x" in exI, simp)
- apply (intro conjI continuous_on_cases)
- using fim gim feq geq
- apply (force simp: insert closed_Union contf contg inf_commute intro: fg)+
- done
+ moreover have "continuous_on (S \<union> \<Union> \<F>) (\<lambda>x. if x \<in> S then f x else g x)"
+ by (auto simp: insert closed_Union contf contg intro: fg continuous_on_cases)
+ ultimately show ?case
+ by (smt (verit, del_insts) Int_iff UnE complete_lattice_class.Sup_insert feq fim geq gim image_subset_iff)
qed
lemma extending_maps_Union:
@@ -573,13 +569,10 @@
have ff: "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
if XY: "X face_of D" "Y face_of E" and DE: "D \<in> \<F>" "E \<in> \<F>" for D E
by (rule face_of_Int_subface [OF _ _ XY]) (auto simp: face' DE)
- show ?thesis
- using that
- apply auto
- apply (drule_tac x="X \<inter> Y" in spec, safe)
- using ff face_of_imp_convex [of X] face_of_imp_convex [of Y]
- apply (fastforce dest: face_of_aff_dim_lt)
- by (meson face_of_trans ff)
+ show ?thesis
+ using that
+ apply clarsimp
+ by (smt (verit, ccfv_SIG) IntI face_of_aff_dim_lt face_of_imp_convex [of X] face_of_imp_convex [of Y] face_of_trans ff)
qed
obtain g where "continuous_on (\<Union>(\<G> \<union> ?Faces)) g"
"g ` \<Union>(\<G> \<union> ?Faces) \<subseteq> rel_frontier T"
@@ -711,10 +704,7 @@
have face': "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
by (metis face inf_commute)
have *: "\<And>X Y. \<lbrakk>X \<in> \<H>; Y \<in> \<H>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
- unfolding \<H>_def
- using subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] apply (auto simp add: face)
- apply (meson face' face_of_Int_subface face_of_refl_eq poly polytope_imp_convex)+
- done
+ by (simp add: \<H>_def) (smt (verit) \<open>\<G> \<subseteq> \<F>\<close> DiffE face' face_of_Int_subface in_mono inf.idem)
obtain h where conth: "continuous_on (\<Union>\<H>) h" and him: "h ` (\<Union>\<H>) \<subseteq> rel_frontier T"
and hf: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x"
proof (rule extend_map_lemma [OF \<open>finite \<H>\<close> [unfolded \<H>_def] Un_upper1 T])
@@ -1143,7 +1133,7 @@
proof (cases "K = {}")
case True
then show ?thesis
- by (metis Diff_empty Diff_subset contf fim continuous_on_subset image_subsetI rev_image_eqI subset_iff that)
+ by (metis Diff_empty Diff_subset contf fim continuous_on_subset image_subsetI image_eqI subset_iff that)
next
case False
have "S \<subseteq> U"
@@ -1166,12 +1156,7 @@
by (simp_all add: in_components_subset comps that)
then obtain a where a: "a \<in> C" "a \<in> L" by auto
have opeUC: "openin (top_of_set U) C"
- proof (rule openin_trans)
- show "openin (top_of_set (U-S)) C"
- by (simp add: \<open>locally connected U\<close> clo locally_diff_closed openin_components_locally_connected [OF _ C])
- show "openin (top_of_set U) (U - S)"
- by (simp add: clo openin_diff)
- qed
+ by (metis C \<open>locally connected U\<close> clo closedin_def locally_connected_open_component topspace_euclidean_subtopology)
then obtain d where "C \<subseteq> U" "0 < d" and d: "cball a d \<inter> U \<subseteq> C"
using openin_contains_cball by (metis \<open>a \<in> C\<close>)
then have "ball a d \<inter> U \<subseteq> C"
@@ -1190,7 +1175,7 @@
show "finite (C \<inter> K)"
by (simp add: \<open>finite K\<close>)
show "S \<union> C \<subseteq> affine hull C"
- by (metis \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> opeUC affine_hull_eq affine_hull_openin all_not_in_conv assms(2) sup.bounded_iff)
+ by (metis \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> affine_hull_eq affine_hull_openin assms(2) empty_iff hull_subset le_sup_iff opeUC)
show "connected C"
by (metis C in_components_connected)
qed auto
@@ -1360,15 +1345,15 @@
proof (rule closedin_closed_subset [OF _ SU'])
have *: "\<And>C. C \<in> F \<Longrightarrow> openin (top_of_set U) C"
unfolding F_def
- by clarify (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_diff_closed openin_components_locally_connected openin_trans topspace_euclidean_subtopology)
+ by (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_connected_open_component mem_Collect_eq topspace_euclidean_subtopology)
show "closedin (top_of_set U) (U - UF)"
- unfolding UF_def
- by (force intro: openin_delete *)
- show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
- using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
- apply (metis Diff_iff UnionI Union_components)
- apply (metis DiffD1 UnionI Union_components)
- by (metis (no_types, lifting) IntI components_nonoverlap empty_iff)
+ unfolding UF_def by (force intro: openin_delete *)
+ have "(\<Union>x\<in>F. x - {a x}) \<inter> S = {}" "\<Union> G \<subseteq> U"
+ using in_components_subset by (auto simp: F_def G_def)
+ moreover have "\<Union> G \<inter> UF = {}"
+ using components_nonoverlap by (fastforce simp: F_def G_def UF_def)
+ ultimately show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
+ using UF_def \<open>S \<subseteq> U\<close> by auto
qed
have clo2: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> UF)"
proof (rule closedin_closed_subset [OF _ SU'])
@@ -1378,13 +1363,14 @@
using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
qed (simp add: \<open>finite F\<close>)
show "S \<union> UF = (\<Union>C\<in>F. S \<union> C) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
- using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
- using C0 apply blast
- by (metis components_nonoverlap disjoint_iff)
+ proof
+ show "\<Union> ((\<union>) S ` F) \<inter> (S \<union> \<Union> G \<union> (S \<union> UF)) \<subseteq> S \<union> UF"
+ using components_eq [of _ "U-S"]
+ by (auto simp add: F_def G_def UF_def disjoint_iff_not_equal)
+ qed (use UF_def \<open>C0 \<in> F\<close> in blast)
qed
have SUG: "S \<union> \<Union>G \<subseteq> U - K"
- using \<open>S \<subseteq> U\<close> K apply (auto simp: G_def disjnt_iff)
- by (meson Diff_iff subsetD in_components_subset)
+ using \<open>S \<subseteq> U\<close> K in_components_subset[of _ "U-S"] by (force simp: G_def disjnt_iff)
then have contf': "continuous_on (S \<union> \<Union>G) f"
by (rule continuous_on_subset [OF contf])
have contg': "continuous_on (S \<union> UF) g"
@@ -1392,8 +1378,7 @@
have "\<And>x. \<lbrakk>S \<subseteq> U; x \<in> S\<rbrakk> \<Longrightarrow> f x = g x"
by (subst gh) (auto simp: ah C0 intro: \<open>C0 \<in> F\<close>)
then have f_eq_g: "\<And>x. x \<in> S \<union> UF \<and> x \<in> S \<union> \<Union>G \<Longrightarrow> f x = g x"
- using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def dest: in_components_subset)
- using components_eq by blast
+ using \<open>S \<subseteq> U\<close> components_eq [of _ "U-S"] by (fastforce simp add: F_def G_def UF_def)
have cont: "continuous_on (S \<union> \<Union>G \<union> (S \<union> UF)) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
by (blast intro: continuous_on_cases_local [OF clo1 clo2 contf' contg' f_eq_g, of "\<lambda>x. x \<in> S \<union> \<Union>G"])
show ?thesis
@@ -1553,8 +1538,7 @@
then have "\<not> bounded (\<Union>{C \<in> components (T - S). \<not> bounded C})"
by (metis (no_types, lifting) Sup_upper bounded_subset mem_Collect_eq that)
then show ?thesis
- apply (clarsimp simp: LU_def Int_Un_distrib Diff_Int_distrib Int_UN_distrib)
- by (metis (no_types, lifting) False Sup_upper bounded_cbox bounded_subset inf.orderE mem_Collect_eq that)
+ by (simp add: LU_def disjoint_iff) (meson False bounded_cbox bounded_subset subset_iff that)
qed
qed blast
have *: False if "x \<in> cbox (- b - m *\<^sub>R One) (b + m *\<^sub>R One)"
@@ -1626,10 +1610,11 @@
then show ?thesis
using cT_ne clo_cT closest_point_in_set by blast
qed
- show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
- using cloTK
- apply (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg])
- by (auto simp add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
+ have "convex (cbox (- c) c \<inter> T)"
+ by (simp add: affine_imp_convex assms(4) convex_Int)
+ then show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
+ using cloTK clo_cT cT_ne
+ by (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg]; force)
have "g (closest_point (cbox (- c) c \<inter> T) x) \<in> rel_frontier U"
if "x \<in> T" "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
using gim [THEN subsetD] that cloTK by blast
@@ -1661,10 +1646,9 @@
then have "aff_dim T \<le> aff_dim (cball a r)"
by (simp add: aff aff_dim_cball)
then show ?thesis
- apply (rule extend_map_affine_to_sphere_cofinite_gen
- [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf])
- using fim apply (auto simp: assms False that dest: dis)
- done
+ using extend_map_affine_to_sphere_cofinite_gen
+ [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf]
+ using fim by (fastforce simp: assms False that dest: dis)
qed
corollary extend_map_UNIV_to_sphere_cofinite:
@@ -1688,9 +1672,9 @@
and fim: "f ` S \<subseteq> sphere a r"
and dis: "\<And>C. C \<in> components(- S) \<Longrightarrow> \<not> bounded C"
obtains g where "continuous_on UNIV g" "g ` UNIV \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
- apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
- apply (auto dest: dis)
-done
+ using extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"]
+ by (metis Compl_empty_eq dis subset_empty)
+
theorem Borsuk_separation_theorem_gen:
fixes S :: "'a::euclidean_space set"
@@ -1754,11 +1738,10 @@
qed
next
assume R: ?rhs
- then show ?lhs
- apply (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>, symmetric])
- apply (auto simp: components_def connected_iff_eq_connected_component_set)
- using connected_component_in apply fastforce
- using cobounded_unique_unbounded_component [OF _ 2, of "-S"] \<open>compact S\<close> compact_eq_bounded_closed by fastforce
+ then have "\<forall>c\<in>components (- S). \<not> bounded c \<Longrightarrow> connected (- S)"
+ by (metis "2" assms(1) cobounded_has_bounded_component compact_imp_bounded double_complement)
+ with R show ?lhs
+ by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
qed
@@ -2032,8 +2015,7 @@
show "open (k ` U)"
by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope])
show "inj_on (k \<circ> f \<circ> h) (k ` U)"
- apply (clarsimp simp: inj_on_def)
- by (metis \<open>U \<subseteq> S\<close> fim homeomorphism_apply2 homhk image_subset_iff inj_onD injf subsetD)
+ by (smt (verit) comp_apply inj_on_def \<open>U \<subseteq> S\<close> fim homeomorphism_apply2 homhk image_iff injf subsetD)
qed
moreover
have eq: "f ` U = h ` (k \<circ> f \<circ> h \<circ> k) ` U"
@@ -2117,8 +2099,7 @@
show "continuous_on S (h \<circ> f)"
by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
show "inj_on (h \<circ> f) S"
- apply (clarsimp simp: inj_on_def)
- by (metis fim homeomorphism_apply2 [OF homkh] image_subset_iff inj_onD injf)
+ by (smt (verit, ccfv_SIG) comp_apply fim inj_on_def homeomorphism_apply2 [OF homkh] image_subset_iff injf)
show "(h \<circ> f) ` S \<subseteq> U"
using \<open>V' \<subseteq> U\<close> hfV' by auto
qed (auto simp: assms)
@@ -2149,8 +2130,7 @@
moreover have "(h \<circ> f) ` S \<subseteq> U"
using \<open>T \<subseteq> U\<close> fim homeomorphism_image1 homhk by fastforce
moreover have "inj_on (h \<circ> f) S"
- apply (clarsimp simp: inj_on_def)
- by (metis fim homeomorphism_apply1 homhk image_subset_iff inj_onD injf)
+ by (smt (verit, best) comp_apply inj_on_def fim homeomorphism_apply1 homhk image_subset_iff injf)
ultimately have ope_hf: "openin (top_of_set U) ((h \<circ> f) ` S)"
using invariance_of_domain_subspaces [OF ope \<open>subspace U\<close> \<open>subspace U\<close>] by blast
have "(h \<circ> f) ` S \<subseteq> T"
@@ -2313,9 +2293,13 @@
lemma injective_into_1d_imp_open_map_UNIV:
fixes f :: "'a::euclidean_space \<Rightarrow> real"
assumes "open T" "continuous_on S f" "inj_on f S" "T \<subseteq> S"
- shows "open (f ` T)"
- apply (rule invariance_of_domain_gen [OF \<open>open T\<close>])
- using assms by (auto simp: elim: continuous_on_subset subset_inj_on)
+ shows "open (f ` T)"
+proof -
+ have "DIM(real) \<le> DIM('a)"
+ by simp
+ then show ?thesis
+ using invariance_of_domain_gen assms continuous_on_subset subset_inj_on by metis
+qed
lemma continuous_on_inverse_open:
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
@@ -2417,7 +2401,7 @@
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
assumes "S homeomorphic T" "open S" "S \<noteq> {}" "open T" "T \<noteq> {}"
shows "DIM('a) = DIM('b)"
- using assms
+ using assms
apply (simp add: homeomorphic_minimal)
apply (rule order_antisym; metis inj_onI invariance_of_dimension)
done
@@ -2427,9 +2411,6 @@
assumes "S homeomorphic T" "interior S = {} \<longleftrightarrow> interior T = {}"
shows "(interior S) homeomorphic (interior T)"
proof (cases "interior T = {}")
- case True
- with assms show ?thesis by auto
-next
case False
then have "DIM('a) = DIM('b)"
using assms
@@ -2438,7 +2419,7 @@
done
then show ?thesis
by (rule homeomorphic_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
-qed
+qed (use assms in auto)
lemma homeomorphic_frontiers_same_dimension:
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
@@ -2674,7 +2655,7 @@
obtain f g
where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
and contf: "continuous_on S f" and contg: "continuous_on T g"
- using assms [unfolded homeomorphic_minimal] by auto
+ using assms by (auto simp: homeomorphic_minimal)
have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
using False assms homeomorphic_aff_dim_le by blast
moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
@@ -2777,16 +2758,14 @@
using Arg2pi_eq that h01 by (force simp: j_def)
have eq: "S = S \<inter> (UNIV \<times> {z. 0 \<le> Im z}) \<union> S \<inter> (UNIV \<times> {z. Im z \<le> 0})" for S :: "(real*complex)set"
by auto
+ have \<section>: "Arg2pi z \<le> 2 * pi" for z
+ by (simp add: Arg2pi order_le_less)
have c1: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. 0 \<le> Im z}) (\<lambda>x. h (fst x, Arg2pi (snd x) / (2 * pi)))"
apply (intro continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
- apply (auto simp: Arg2pi)
- apply (meson Arg2pi_lt_2pi linear not_le)
- done
+ by (auto simp: Arg2pi \<section>)
have c2: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. Im z \<le> 0}) (\<lambda>x. h (fst x, 1 - Arg2pi (cnj (snd x)) / (2 * pi)))"
apply (intro continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
- apply (auto simp: Arg2pi)
- apply (meson Arg2pi_lt_2pi linear not_le)
- done
+ by (auto simp: Arg2pi \<section>)
show "continuous_on ({0..1} \<times> sphere 0 1) j"
apply (simp add: j_def)
apply (subst eq)
@@ -2815,10 +2794,11 @@
and contg: "continuous_on (sphere 0 1) g" and gim: "g ` (sphere 0 1) \<subseteq> S"
shows "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
proof -
- have "homotopic_loops S (f \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi * t) * \<i>)) (g \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi * t) * \<i>))"
- apply (rule S [unfolded simply_connected_homotopic_loops, rule_format])
- apply (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim)
- done
+ let ?h = "(\<lambda>t. complex_of_real (2 * pi * t) * \<i>)"
+ have "homotopic_loops S (f \<circ> exp \<circ> ?h) (f \<circ> exp \<circ> ?h) \<and> homotopic_loops S (g \<circ> exp \<circ> ?h) (g \<circ> exp \<circ> ?h)"
+ by (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim)
+ then have "homotopic_loops S (f \<circ> exp \<circ> ?h) (g \<circ> exp \<circ> ?h)"
+ using S simply_connected_homotopic_loops by blast
then show ?thesis
apply (rule homotopic_with_eq [OF homotopic_loops_imp_homotopic_circlemaps])
apply (auto simp: o_def complex_norm_eq_1_exp mult.commute)
@@ -2833,9 +2813,7 @@
continuous_on (sphere 0 1) g; g ` (sphere 0 1) \<subseteq> S\<rbrakk>
\<Longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
shows "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S h (\<lambda>x. a)"
- apply (rule_tac x="h 1" in exI)
- apply (rule hom)
- using assms by (auto)
+ by (metis conth continuous_on_const him hom image_subset_iff)
lemma simply_connected_eq_homotopic_circlemaps2b:
fixes S :: "'a::real_normed_vector set"
@@ -2889,9 +2867,8 @@
continuous_on (sphere 0 1) f \<and> f ` (sphere 0 1) \<subseteq> S \<and>
continuous_on (sphere 0 1) g \<and> g ` (sphere 0 1) \<subseteq> S
\<longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g)"
- apply (rule iffI)
- apply (blast dest: simply_connected_eq_homotopic_circlemaps1)
- by (simp add: simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b simply_connected_eq_homotopic_circlemaps3)
+ by (metis simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a
+ simply_connected_eq_homotopic_circlemaps2b simply_connected_eq_homotopic_circlemaps3)
proposition simply_connected_eq_contractible_circlemap:
fixes S :: "'a::real_normed_vector set"
@@ -2900,9 +2877,8 @@
(\<forall>f::complex \<Rightarrow> 'a.
continuous_on (sphere 0 1) f \<and> f `(sphere 0 1) \<subseteq> S
\<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f (\<lambda>x. a)))"
- apply (rule iffI)
- apply (simp add: simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b)
- using simply_connected_eq_homotopic_circlemaps3 by blast
+ by (metis simply_connected_eq_homotopic_circlemaps simply_connected_eq_homotopic_circlemaps2a
+ simply_connected_eq_homotopic_circlemaps3 simply_connected_imp_path_connected)
corollary homotopy_eqv_simple_connectedness:
fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
@@ -3019,8 +2995,12 @@
fixes a :: "'a::euclidean_space" and c :: "'b::euclidean_space"
assumes "a \<noteq> 0" "c \<noteq> 0"
shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('a) = DIM('b))"
- apply (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
- by (metis DIM_positive Suc_pred)
+proof -
+ have "DIM('a) - Suc 0 = DIM('b) - Suc 0 \<Longrightarrow> DIM('a) = DIM('b)"
+ by (metis DIM_positive Suc_pred)
+ then show ?thesis
+ by (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
+qed
lemma homeomorphic_UNIV_UNIV:
shows "(UNIV::'a set) homeomorphic (UNIV::'b set) \<longleftrightarrow>
@@ -3043,9 +3023,7 @@
by (rule convex_cball)
then obtain c where "homotopic_with_canon (\<lambda>z. True) (sphere (0::complex) 1) (rel_frontier S) f (\<lambda>x. c)"
apply (rule inessential_spheremap_lowdim_gen [OF _ bounded_cball \<open>convex S\<close> \<open>bounded S\<close>, where f=f])
- using f 3
- apply (auto simp: aff_dim_cball)
- done
+ using f 3 by (auto simp: aff_dim_cball)
then show "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (rel_frontier S) f (\<lambda>x. a)"
by blast
qed
@@ -3101,9 +3079,7 @@
by (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
qed (use contf continuous_on_subset hgsub in blast)
show "inj_on (f \<circ> h) (g ` (S - {b}))"
- using kjsub
- apply (clarsimp simp add: inj_on_def)
- by (metis SU b homeomorphism_def inj_onD injf insert_Diff insert_iff gh rev_subsetD)
+ by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf gh Diff_iff comp_apply imageE subset_iff)
show "(f \<circ> h) ` g ` (S - {b}) \<subseteq> T"
by (metis fim image_comp image_mono hgsub subset_trans)
qed (auto simp: assms)
@@ -3118,9 +3094,7 @@
by (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
qed (use contf continuous_on_subset kjsub in blast)
show "inj_on (f \<circ> k) (j ` (S - {c}))"
- using kjsub
- apply (clarsimp simp add: inj_on_def)
- by (metis SU c homeomorphism_def inj_onD injf insert_Diff insert_iff jk rev_subsetD)
+ by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf jk Diff_iff comp_apply imageE subset_iff)
show "(f \<circ> k) ` j ` (S - {c}) \<subseteq> T"
by (metis fim image_comp image_mono kjsub subset_trans)
qed (auto simp: assms)
@@ -3131,11 +3105,9 @@
have "h ` g ` (S - {b}) = (S - {b})"
proof
show "h ` g ` (S - {b}) \<subseteq> S - {b}"
- using homeomorphism_apply1 [OF gh] SU
- by (fastforce simp add: image_iff image_subset_iff)
+ using homeomorphism_apply1 [OF gh] SU by (fastforce simp add: image_iff image_subset_iff)
show "S - {b} \<subseteq> h ` g ` (S - {b})"
- apply clarify
- by (metis SU subsetD homeomorphism_apply1 [OF gh] image_iff member_remove remove_def)
+ by (metis Diff_mono SU gh homeomorphism_image2 homeomorphism_of_subsets set_eq_subset)
qed
then show ?thesis
by (metis image_comp)
@@ -3143,14 +3115,8 @@
moreover have "(f \<circ> k) ` j ` (S - {c}) = f ` (S - {c})"
proof -
have "k ` j ` (S - {c}) = (S - {c})"
- proof
- show "k ` j ` (S - {c}) \<subseteq> S - {c}"
- using homeomorphism_apply1 [OF jk] SU
- by (fastforce simp add: image_iff image_subset_iff)
- show "S - {c} \<subseteq> k ` j ` (S - {c})"
- apply clarify
- by (metis SU subsetD homeomorphism_apply1 [OF jk] image_iff member_remove remove_def)
- qed
+ using homeomorphism_apply1 [OF jk] SU
+ by (meson Diff_mono homeomorphism_def homeomorphism_of_subsets jk subset_refl)
then show ?thesis
by (metis image_comp)
qed
@@ -3252,8 +3218,7 @@
using contractible_sphere contractible_def not_one_le_zero by blast
qed
with False show ?rhs
- apply simp
- by (metis DIM_ge_Suc0 le_antisym not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
+ by (metis DIM_ge_Suc0 One_nat_def Suc_1 not_less_eq_eq numeral_3_eq_3 order_antisym_conv)
next
assume ?rhs
with False show ?lhs by (simp add: simply_connected_sphere)
@@ -3610,7 +3575,10 @@
using pi_ge_two by (simp add: ball_subset_ball_iff)
then have inj_exp: "inj_on exp (ball (Ln z) 1)"
using inj_on_exp_pi inj_on_subset by blast
- define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1))"
+ define twopi where "twopi \<equiv> \<lambda>n. of_real (2 * of_int n * pi) * \<i>"
+ define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + twopi n) ` (ball(Ln z) 1))"
+ have exp_eq': "exp w = exp z \<longleftrightarrow> (\<exists>n::int. w = z + twopi n)" for z w
+ by (simp add: exp_eq twopi_def)
show ?thesis
proof (intro exI conjI)
show "z \<in> exp ` (ball(Ln z) 1)"
@@ -3619,80 +3587,73 @@
by blast
with inj_exp show "openin (top_of_set (- {0})) (exp ` ball (Ln z) 1)"
by (auto simp: openin_open_eq invariance_of_domain continuous_on_exp [OF continuous_on_id])
- show "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
- by (force simp: \<V>_def Complex_Transcendental.exp_eq image_iff)
+ show UV: "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
+ by (force simp: \<V>_def twopi_def Complex_Transcendental.exp_eq image_iff)
show "\<forall>V\<in>\<V>. open V"
by (auto simp: \<V>_def inj_on_def continuous_intros invariance_of_domain)
- have xy: "2 \<le> cmod (2 * of_int x * of_real pi * \<i> - 2 * of_int y * of_real pi * \<i>)"
- if "x < y" for x y
+ have "2 \<le> cmod (twopi m -twopi n)" if "m \<noteq> n" for m n
proof -
- have "1 \<le> abs (x - y)"
+ have "1 \<le> abs (m - n)"
using that by linarith
- then have "1 \<le> cmod (of_int x - of_int y) * 1"
+ then have "1 \<le> cmod (of_int m - of_int n) * 1"
by (metis mult.right_neutral norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
- also have "... \<le> cmod (of_int x - of_int y) * of_real pi"
+ also have "... \<le> cmod (of_int m - of_int n) * of_real pi"
using pi_ge_two
by (intro mult_left_mono) auto
- also have "... \<le> cmod ((of_int x - of_int y) * of_real pi * \<i>)"
+ also have "... \<le> cmod ((of_int m - of_int n) * of_real pi * \<i>)"
by (simp add: norm_mult)
- also have "... \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)"
+ also have "... \<le> cmod (of_int m * of_real pi * \<i> - of_int n * of_real pi * \<i>)"
by (simp add: algebra_simps)
- finally have "1 \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)" .
- then have "2 * 1 \<le> cmod (2 * (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>))"
+ finally have "1 \<le> cmod (of_int m * of_real pi * \<i> - of_int n * of_real pi * \<i>)" .
+ then have "2 * 1 \<le> cmod (2 * (of_int m * of_real pi * \<i> - of_int n * of_real pi * \<i>))"
by (metis mult_le_cancel_left_pos norm_mult_numeral1 zero_less_numeral)
then show ?thesis
- by (simp add: algebra_simps)
+ by (simp add: algebra_simps twopi_def)
qed
- show "disjoint \<V>"
- apply (clarsimp simp add: \<V>_def pairwise_def disjnt_def add.commute [of _ "x*y" for x y]
- ball_eq_ball_iff intro!: disjoint_ballI)
- apply (auto simp: dist_norm neq_iff)
- by (metis norm_minus_commute xy)+
+ then show "disjoint \<V>"
+ unfolding \<V>_def pairwise_def disjnt_iff
+ by (smt (verit, best) add.commute add_diff_cancel_left' add_diff_eq dist_commute dist_complex_def dist_triangle imageE mem_ball)
show "\<forall>u\<in>\<V>. \<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
proof
fix u
assume "u \<in> \<V>"
- then obtain n where n: "u = (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1)"
+ then obtain n where n: "u = (\<lambda>x. x + twopi n) ` (ball(Ln z) 1)"
by (auto simp: \<V>_def)
have "compact (cball (Ln z) 1)"
by simp
moreover have "continuous_on (cball (Ln z) 1) exp"
by (rule continuous_on_exp [OF continuous_on_id])
moreover have "inj_on exp (cball (Ln z) 1)"
- apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
- using pi_ge_two by (simp add: cball_subset_ball_iff)
+ using pi_ge_two inj_on_subset [OF inj_on_exp_pi [of "Ln z"]]
+ by (simp add: subset_iff)
ultimately obtain \<gamma> where hom: "homeomorphism (cball (Ln z) 1) (exp ` cball (Ln z) 1) exp \<gamma>"
using homeomorphism_compact by blast
have eq1: "exp ` u = exp ` ball (Ln z) 1"
- apply (auto simp: algebra_simps n)
- apply (rule_tac x = "_ + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
- apply (auto simp: image_iff)
- done
- have \<gamma>exp: "\<gamma> (exp x) + 2 * of_int n * of_real pi * \<i> = x" if "x \<in> u" for x
+ by (smt (verit) n exp_eq' image_cong image_image)
+ have \<gamma>exp: "\<gamma> (exp x) + twopi n = x" if "x \<in> u" for x
proof -
- have "exp x = exp (x - 2 * of_int n * of_real pi * \<i>)"
- by (simp add: exp_eq)
- then have "\<gamma> (exp x) = \<gamma> (exp (x - 2 * of_int n * of_real pi * \<i>))"
+ have "exp x = exp (x - twopi n)"
+ using exp_eq' by auto
+ then have "\<gamma> (exp x) = \<gamma> (exp (x - twopi n))"
by simp
- also have "... = x - 2 * of_int n * of_real pi * \<i>"
+ also have "... = x - twopi n"
using \<open>x \<in> u\<close> by (auto simp: n intro: homeomorphism_apply1 [OF hom])
finally show ?thesis
by simp
qed
- have exp2n: "exp (\<gamma> (exp x) + 2 * of_int n * complex_of_real pi * \<i>) = exp x"
- if "dist (Ln z) x < 1" for x
- using that by (auto simp: exp_eq homeomorphism_apply1 [OF hom])
+ have exp2n: "exp (\<gamma> (exp x) + twopi n) = exp x" if "dist (Ln z) x < 1" for x
+ by (metis \<gamma>exp exp_eq' imageI mem_ball n that)
have "continuous_on (exp ` ball (Ln z) 1) \<gamma>"
by (meson ball_subset_cball continuous_on_subset hom homeomorphism_cont2 image_mono)
- then have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
+ then have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + twopi n)"
by (intro continuous_intros)
- show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
- apply (rule_tac x="(\<lambda>x. x + of_real(2 * n * pi) * \<i>) \<circ> \<gamma>" in exI)
+ have "homeomorphism u (exp ` ball (Ln z) 1) exp ((\<lambda>x. x + twopi n) \<circ> \<gamma>)"
unfolding homeomorphism_def
apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
apply (auto simp: \<gamma>exp exp2n cont n)
apply (force simp: image_iff homeomorphism_apply1 [OF hom])+
done
+ then show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q" by metis
qed
qed
qed
@@ -3787,7 +3748,7 @@
using hom by (auto simp: homotopic_with_def)
show ?thesis
apply (simp add: homotopic_with)
- apply (rule_tac x="\<lambda>z. k z*(h \<circ> snd)z" in exI)
+ apply (rule_tac x="\<lambda>z. k z * (h \<circ> snd)z" in exI)
using kim hin by (fastforce simp: conth norm_mult k0 k1 intro!: contk continuous_intros)+
qed
@@ -3832,10 +3793,10 @@
have [simp]: "\<And>x. x \<in> S \<Longrightarrow> g x \<noteq> 0"
using geq1 by fastforce
have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
- apply (rule homotopic_with_eq [OF homotopic_with_sphere_times [OF L cont]])
+ using homotopic_with_eq [OF homotopic_with_sphere_times [OF L cont]]
by (auto simp: divide_inverse norm_inverse)
with L show ?rhs
- by (auto simp: homotopic_with_imp_continuous dest: homotopic_with_imp_subset1 homotopic_with_imp_subset2)
+ by (simp add: homotopic_with_imp_continuous homotopic_with_imp_subset1 homotopic_with_imp_subset2)
next
assume ?rhs then show ?lhs
by (elim conjE homotopic_with_eq [OF homotopic_with_sphere_times]; force)
@@ -3998,15 +3959,13 @@
by (force simp: openin_euclidean_subtopology_iff dest: fST)
have oo: "\<And>U. openin (top_of_set T) U \<Longrightarrow>
openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
- apply (rule lower_hemicontinuous [THEN iffD1, rule_format])
- using fST clo by auto
+ using lower_hemicontinuous fST clo by blast
have "compact (closure(f x))"
by (simp add: bofx)
moreover have "closure(f x) \<subseteq> (\<Union>a \<in> f x. ball a (e/2))"
using \<open>0 < e\<close> by (force simp: closure_approachable simp del: divide_const_simps)
ultimately obtain C where "C \<subseteq> f x" "finite C" "closure(f x) \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
- apply (rule compactE, force)
- by (metis finite_subset_image)
+ by (meson compactE finite_subset_image Elementary_Metric_Spaces.open_ball compactE_image)
then have fx_cover: "f x \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
by (meson closure_subset order_trans)
with fx_ne have "C \<noteq> {}"
@@ -4173,9 +4132,10 @@
qed auto
then have "homotopic_with_canon (\<lambda>f. True) (sphere a r) (sphere b s) (k \<circ> (h \<circ> f)) (k \<circ> (\<lambda>x. c))"
by (rule homotopic_with_compose_continuous_left [OF _ contk kim])
- then have "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
- apply (rule homotopic_with_eq, auto)
+ moreover have "\<And>x. r = dist a x \<Longrightarrow> f x = k (h (f x))"
by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
+ ultimately have "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
+ by (auto intro: homotopic_with_eq)
then show ?thesis
by (metis that)
qed
@@ -4318,9 +4278,8 @@
by (simp add: exp_minus fgeq that)
finally have "f z = exp (- h z) + \<i>*g z"
by (simp add: diff_eq_eq)
- then show ?thesis
- apply (simp add: cos_exp_eq)
- by (metis fgeq add.assoc mult_2_right that)
+ with that show ?thesis
+ by (simp add: cos_exp_eq flip: fgeq)
qed
qed
qed
@@ -4391,11 +4350,7 @@
qed
lemma retract_of_Borsukian: "\<lbrakk>Borsukian T; S retract_of T\<rbrakk> \<Longrightarrow> Borsukian S"
- apply (auto simp: retract_of_def retraction_def)
- apply (erule (1) Borsukian_retraction_gen)
- apply (meson retraction retraction_def)
- apply (auto)
- done
+ by (smt (verit) Borsukian_retraction_gen retract_of_def retraction retraction_def retraction_subset)
lemma homeomorphic_Borsukian: "\<lbrakk>Borsukian S; S homeomorphic T\<rbrakk> \<Longrightarrow> Borsukian T"
using Borsukian_retraction_gen order_refl
@@ -4580,12 +4535,7 @@
have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
proof (rule continuous_discrete_range_constant [OF ST])
show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
- proof (intro continuous_intros)
- show "continuous_on (S \<inter> T) g"
- by (meson contg continuous_on_subset inf_le1)
- show "continuous_on (S \<inter> T) h"
- by (meson conth continuous_on_subset inf_sup_ord(2))
- qed
+ by (metis contg conth continuous_on_diff continuous_on_subset inf_le1 inf_le2)
show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
if "x \<in> S \<inter> T" for x
proof -
@@ -4763,7 +4713,7 @@
by (simp add: Abstract_Topology_2.continuous_imp_closed_map \<open>compact S\<close> contf fim)
show "\<And>U. closedin (top_of_set S) U \<Longrightarrow>
closedin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
- using ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
+ using ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
by meson
show "bounded {z \<in> S. f z = y}"
by (metis (no_types, lifting) compact_imp_bounded [OF \<open>compact S\<close>] bounded_subset mem_Collect_eq subsetI)
@@ -4783,7 +4733,7 @@
by (fastforce simp: dist_norm abs_diff_less_iff algebra_simps)
qed
then show "\<exists>d>0. \<forall>x'\<in>T. dist x' y < d \<longrightarrow> dist (h (k x')) (h (k y)) < e"
- using \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
+ using \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
qed
then show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (\<i> * complex_of_real (h x)))"
using fk gfh kTS by force
@@ -5537,10 +5487,6 @@
by (simp_all add: assms)
show "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. a)" if "S \<in> \<F>" for S
proof (cases "S = {}")
- case True
- then show ?thesis
- by auto
- next
case False
then obtain b where "b \<in> S"
by blast
@@ -5549,11 +5495,10 @@
then have "c \<in> T"
using \<open>b \<in> S\<close> homotopic_with_imp_subset2 by blast
then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. c)"
- using T \<open>a \<in> T\<close> homotopic_constant_maps path_connected_component
- by (simp add: homotopic_constant_maps path_connected_component)
+ using T \<open>a \<in> T\<close> by (simp add: homotopic_constant_maps path_connected_component)
then show ?thesis
using c homotopic_with_symD homotopic_with_trans by blast
- qed
+ qed auto
qed
then show ?thesis ..
qed
@@ -5568,7 +5513,7 @@
by (simp add: assms compact_Un)
with Borsukian_imp_unicoherent [of "S \<union> T"] ST assms
show ?thesis
- by (auto simp: closed_subset compact_imp_closed Borsukian_separation_compact unicoherent_def)
+ by (simp add: Borsukian_separation_compact closed_subset compact_imp_closed unicoherentD)
qed
end
--- a/src/HOL/BNF_Cardinal_Arithmetic.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/BNF_Cardinal_Arithmetic.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,35 +8,37 @@
section \<open>Cardinal Arithmetic as Needed by Bounded Natural Functors\<close>
theory BNF_Cardinal_Arithmetic
-imports BNF_Cardinal_Order_Relation
+ imports BNF_Cardinal_Order_Relation
begin
lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
-by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
+ by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
lemma card_order_dir_image:
assumes bij: "bij f" and co: "card_order r"
shows "card_order (dir_image r f)"
proof -
- from assms have "Field (dir_image r f) = UNIV"
- using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
- moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
+ have "Field (dir_image r f) = UNIV"
+ using assms card_order_on_Card_order[of UNIV r]
+ unfolding bij_def dir_image_Field by auto
+ moreover from bij have "\<And>x y. (f x = f y) = (x = y)"
+ unfolding bij_def inj_on_def by auto
with co have "Card_order (dir_image r f)"
- using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
+ using card_order_on_Card_order Card_order_ordIso2[OF _ dir_image] by blast
ultimately show ?thesis by auto
qed
lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
-by (rule card_order_on_ordIso)
+ by (rule card_order_on_ordIso)
lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
-by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
+ by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
-by (simp only: ordIso_refl card_of_Card_order)
+ by (simp only: ordIso_refl card_of_Card_order)
lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
-using card_order_on_Card_order[of UNIV r] by simp
+ using card_order_on_Card_order[of UNIV r] by simp
subsection \<open>Zero\<close>
@@ -44,13 +46,12 @@
definition czero where
"czero = card_of {}"
-lemma czero_ordIso:
- "czero =o czero"
-using card_of_empty_ordIso by (simp add: czero_def)
+lemma czero_ordIso: "czero =o czero"
+ using card_of_empty_ordIso by (simp add: czero_def)
lemma card_of_ordIso_czero_iff_empty:
"|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
-unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
+ unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
(* A "not czero" Cardinal predicate *)
abbreviation Cnotzero where
@@ -62,28 +63,21 @@
lemma czeroI:
"\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
-using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
+ using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
lemma czeroE:
"r =o czero \<Longrightarrow> Field r = {}"
-unfolding czero_def
-by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
+ unfolding czero_def
+ by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
lemma Cnotzero_mono:
"\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
-apply (rule ccontr)
-apply auto
-apply (drule czeroE)
-apply (erule notE)
-apply (erule czeroI)
-apply (drule card_of_mono2)
-apply (simp only: card_of_empty3)
-done
+ by (force intro: czeroI dest: card_of_mono2 card_of_empty3 czeroE)
subsection \<open>(In)finite cardinals\<close>
definition cinfinite where
- "cinfinite r = (\<not> finite (Field r))"
+ "cinfinite r \<equiv> (\<not> finite (Field r))"
abbreviation Cinfinite where
"Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
@@ -101,7 +95,7 @@
lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]
lemma natLeq_cinfinite: "cinfinite natLeq"
-unfolding cinfinite_def Field_natLeq by (rule infinite_UNIV_nat)
+ unfolding cinfinite_def Field_natLeq by (rule infinite_UNIV_nat)
lemma natLeq_Cinfinite: "Cinfinite natLeq"
using natLeq_cinfinite natLeq_Card_order by simp
@@ -117,50 +111,46 @@
qed
lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
-unfolding cinfinite_def by (cases "Field r = {}") (auto dest: czeroE)
+ unfolding cinfinite_def by (cases "Field r = {}") (auto dest: czeroE)
lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
-by (rule conjI[OF cinfinite_not_czero]) simp_all
+ using cinfinite_not_czero by auto
lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
-using Card_order_ordIso2[of r1 r2] unfolding cinfinite_def ordIso_iff_ordLeq
-by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])
+ using Card_order_ordIso2[of r1 r2] unfolding cinfinite_def ordIso_iff_ordLeq
+ by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])
lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
-unfolding cinfinite_def by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])
+ unfolding cinfinite_def by (auto dest: card_of_ordLeq_infinite[OF card_of_mono2])
lemma regularCard_ordIso:
-assumes "k =o k'" and "Cinfinite k" and "regularCard k"
-shows "regularCard k'"
+ assumes "k =o k'" and "Cinfinite k" and "regularCard k"
+ shows "regularCard k'"
proof-
have "stable k" using assms cinfinite_def regularCard_stable by blast
hence "stable k'" using assms stable_ordIso1 ordIso_symmetric by blast
- thus ?thesis using assms cinfinite_def stable_regularCard
- using Cinfinite_cong by blast
+ thus ?thesis using assms cinfinite_def stable_regularCard Cinfinite_cong by blast
qed
corollary card_of_UNION_ordLess_infinite_Field_regularCard:
-assumes ST: "regularCard r" and INF: "Cinfinite r" and
- LEQ_I: "|I| <o r" and LEQ: "\<forall>i \<in> I. |A i| <o r"
- shows "|\<Union>i \<in> I. A i| <o r"
+ assumes "regularCard r" and "Cinfinite r" and "|I| <o r" and "\<forall>i \<in> I. |A i| <o r"
+ shows "|\<Union>i \<in> I. A i| <o r"
using card_of_UNION_ordLess_infinite_Field regularCard_stable assms cinfinite_def by blast
subsection \<open>Binary sum\<close>
-definition csum (infixr "+c" 65) where
- "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
+definition csum (infixr "+c" 65)
+ where "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
unfolding csum_def Field_card_of by auto
-lemma Card_order_csum:
- "Card_order (r1 +c r2)"
-unfolding csum_def by (simp add: card_of_Card_order)
+lemma Card_order_csum: "Card_order (r1 +c r2)"
+ unfolding csum_def by (simp add: card_of_Card_order)
-lemma csum_Cnotzero1:
- "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
-unfolding csum_def using Cnotzero_imp_not_empty[of r1] Plus_eq_empty_conv[of "Field r1" "Field r2"]
- card_of_ordIso_czero_iff_empty[of "Field r1 <+> Field r2"] by (auto intro: card_of_Card_order)
+lemma csum_Cnotzero1: "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
+ using Cnotzero_imp_not_empty
+ by (auto intro: card_of_Card_order simp: csum_def card_of_ordIso_czero_iff_empty)
lemma card_order_csum:
assumes "card_order r1" "card_order r2"
@@ -172,49 +162,49 @@
lemma cinfinite_csum:
"cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
-unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
-
-lemma Cinfinite_csum1:
- "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
-unfolding cinfinite_def csum_def by (rule conjI[OF _ card_of_Card_order]) (auto simp: Field_card_of)
+ unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
lemma Cinfinite_csum:
"Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
-unfolding cinfinite_def csum_def by (rule conjI[OF _ card_of_Card_order]) (auto simp: Field_card_of)
+ using card_of_Card_order
+ by (auto simp: cinfinite_def csum_def Field_card_of)
+
+lemma Cinfinite_csum1: "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
+ by (blast intro!: Cinfinite_csum elim: )
lemma Cinfinite_csum_weak:
"\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
by (erule Cinfinite_csum1)
lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
-by (simp only: csum_def ordIso_Plus_cong)
+ by (simp only: csum_def ordIso_Plus_cong)
lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
-by (simp only: csum_def ordIso_Plus_cong1)
+ by (simp only: csum_def ordIso_Plus_cong1)
lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
-by (simp only: csum_def ordIso_Plus_cong2)
+ by (simp only: csum_def ordIso_Plus_cong2)
lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
-by (simp only: csum_def ordLeq_Plus_mono)
+ by (simp only: csum_def ordLeq_Plus_mono)
lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
-by (simp only: csum_def ordLeq_Plus_mono1)
+ by (simp only: csum_def ordLeq_Plus_mono1)
lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
-by (simp only: csum_def ordLeq_Plus_mono2)
+ by (simp only: csum_def ordLeq_Plus_mono2)
lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
-by (simp only: csum_def Card_order_Plus1)
+ by (simp only: csum_def Card_order_Plus1)
lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
-by (simp only: csum_def Card_order_Plus2)
+ by (simp only: csum_def Card_order_Plus2)
lemma csum_com: "p1 +c p2 =o p2 +c p1"
-by (simp only: csum_def card_of_Plus_commute)
+ by (simp only: csum_def card_of_Plus_commute)
lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
-by (simp only: csum_def Field_card_of card_of_Plus_assoc)
+ by (simp only: csum_def Field_card_of card_of_Plus_assoc)
lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
@@ -235,10 +225,10 @@
qed
lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
-by (simp only: csum_def Field_card_of card_of_refl)
+ by (simp only: csum_def Field_card_of card_of_refl)
lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
-using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
+ using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
subsection \<open>One\<close>
@@ -246,16 +236,17 @@
"cone = card_of {()}"
lemma Card_order_cone: "Card_order cone"
-unfolding cone_def by (rule card_of_Card_order)
+ unfolding cone_def by (rule card_of_Card_order)
lemma Cfinite_cone: "Cfinite cone"
unfolding cfinite_def by (simp add: Card_order_cone)
lemma cone_not_czero: "\<not> (cone =o czero)"
-unfolding czero_def cone_def ordIso_iff_ordLeq using card_of_empty3 empty_not_insert by blast
+ unfolding czero_def cone_def ordIso_iff_ordLeq
+ using card_of_empty3 empty_not_insert by blast
lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
-unfolding cone_def by (rule Card_order_singl_ordLeq) (auto intro: czeroI)
+ unfolding cone_def by (rule Card_order_singl_ordLeq) (auto intro: czeroI)
subsection \<open>Two\<close>
@@ -264,14 +255,14 @@
"ctwo = |UNIV :: bool set|"
lemma Card_order_ctwo: "Card_order ctwo"
-unfolding ctwo_def by (rule card_of_Card_order)
+ unfolding ctwo_def by (rule card_of_Card_order)
lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
-using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
-unfolding czero_def ctwo_def using UNIV_not_empty by auto
+ using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
+ unfolding czero_def ctwo_def using UNIV_not_empty by auto
lemma ctwo_Cnotzero: "Cnotzero ctwo"
-by (simp add: ctwo_not_czero Card_order_ctwo)
+ by (simp add: ctwo_not_czero Card_order_ctwo)
subsection \<open>Family sum\<close>
@@ -288,7 +279,7 @@
"CSUM i:r. rs" == "CONST Csum r (%i. rs)"
lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
-by (auto simp: Csum_def Field_card_of)
+ by (auto simp: Csum_def Field_card_of)
(* NB: Always, under the cardinal operator,
operations on sets are reduced automatically to operations on cardinals.
@@ -304,49 +295,50 @@
assumes "card_order r1" "card_order r2"
shows "card_order (r1 *c r2)"
proof -
- have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
+ have "Field r1 = UNIV" "Field r2 = UNIV"
+ using assms card_order_on_Card_order by auto
thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
qed
lemma Card_order_cprod: "Card_order (r1 *c r2)"
-by (simp only: cprod_def Field_card_of card_of_card_order_on)
+ by (simp only: cprod_def Field_card_of card_of_card_order_on)
lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
-by (simp only: cprod_def ordLeq_Times_mono1)
+ by (simp only: cprod_def ordLeq_Times_mono1)
lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
-by (simp only: cprod_def ordLeq_Times_mono2)
+ by (simp only: cprod_def ordLeq_Times_mono2)
lemma cprod_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 *c p2 \<le>o r1 *c r2"
-by (rule ordLeq_transitive[OF cprod_mono1 cprod_mono2])
+ by (rule ordLeq_transitive[OF cprod_mono1 cprod_mono2])
lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
-unfolding cprod_def by (rule Card_order_Times2) (auto intro: czeroI)
+ unfolding cprod_def by (rule Card_order_Times2) (auto intro: czeroI)
lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
-by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
+ by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
-by (rule cinfinite_mono) (auto intro: ordLeq_cprod2)
+ by (rule cinfinite_mono) (auto intro: ordLeq_cprod2)
lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
-by (blast intro: cinfinite_cprod2 Card_order_cprod)
+ by (blast intro: cinfinite_cprod2 Card_order_cprod)
lemma cprod_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 *c p2 =o r1 *c r2"
-unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono)
+ unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono)
lemma cprod_cong1: "\<lbrakk>p1 =o r1\<rbrakk> \<Longrightarrow> p1 *c p2 =o r1 *c p2"
-unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono1)
+ unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono1)
lemma cprod_cong2: "p2 =o r2 \<Longrightarrow> q *c p2 =o q *c r2"
-unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono2)
+ unfolding ordIso_iff_ordLeq by (blast intro: cprod_mono2)
lemma cprod_com: "p1 *c p2 =o p2 *c p1"
-by (simp only: cprod_def card_of_Times_commute)
+ by (simp only: cprod_def card_of_Times_commute)
lemma card_of_Csum_Times:
"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
-by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_mono1)
+ by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_mono1)
lemma card_of_Csum_Times':
assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
@@ -361,27 +353,33 @@
qed
lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
-unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
+ unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
-unfolding csum_def by (rule conjunct2[OF Card_order_Plus_infinite])
- (auto simp: cinfinite_def dest: cinfinite_mono)
+ unfolding csum_def
+ using Card_order_Plus_infinite
+ by (fastforce simp: cinfinite_def dest: cinfinite_mono)
lemma csum_absorb1':
assumes card: "Card_order r2"
- and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
+ and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
shows "r2 +c r1 =o r2"
-by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
+proof -
+ have "r1 +c r2 =o r2"
+ by (simp add: csum_absorb2' assms)
+ then show ?thesis
+ by (blast intro: ordIso_transitive csum_com)
+qed
lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
-by (rule csum_absorb1') auto
+ by (rule csum_absorb1') auto
lemma csum_absorb2: "\<lbrakk>Cinfinite r2 ; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
using ordIso_transitive csum_com csum_absorb1 by blast
lemma regularCard_csum:
assumes "Cinfinite r" "Cinfinite s" "regularCard r" "regularCard s"
- shows "regularCard (r +c s)"
+ shows "regularCard (r +c s)"
proof (cases "r \<le>o s")
case True
then show ?thesis using regularCard_ordIso[of s] csum_absorb2'[THEN ordIso_symmetric] assms by auto
@@ -394,9 +392,9 @@
lemma csum_mono_strict:
assumes Card_order: "Card_order r" "Card_order q"
- and Cinfinite: "Cinfinite r'" "Cinfinite q'"
- and less: "r <o r'" "q <o q'"
-shows "r +c q <o r' +c q'"
+ and Cinfinite: "Cinfinite r'" "Cinfinite q'"
+ and less: "r <o r'" "q <o q'"
+ shows "r +c q <o r' +c q'"
proof -
have Well_order: "Well_order r" "Well_order q" "Well_order r'" "Well_order q'"
using card_order_on_well_order_on Card_order Cinfinite by auto
@@ -434,7 +432,7 @@
proof (cases "Cinfinite q")
case True
then have "r \<le>o q" using finite_ordLess_infinite cinfinite_def cfinite_def outer Well_order
- ordLess_imp_ordLeq by blast
+ ordLess_imp_ordLeq by blast
then have "r +c q =o q" by (rule csum_absorb2[OF True])
then show ?thesis using ordIso_ordLess_trans ordLess_ordLeq_trans less ordLeq_csum2 Cinfinite by blast
next
@@ -453,11 +451,11 @@
"r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
lemma Card_order_cexp: "Card_order (r1 ^c r2)"
-unfolding cexp_def by (rule card_of_Card_order)
+ unfolding cexp_def by (rule card_of_Card_order)
lemma cexp_mono':
assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
- and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
+ and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
shows "p1 ^c p2 \<le>o r1 ^c r2"
proof(cases "Field p1 = {}")
case True
@@ -498,36 +496,36 @@
lemma cexp_mono:
assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
- and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
+ and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
shows "p1 ^c p2 \<le>o r1 ^c r2"
by (rule cexp_mono'[OF 1 2 czeroE[OF n[OF czeroI[OF card]]]])
lemma cexp_mono1:
assumes 1: "p1 \<le>o r1" and q: "Card_order q"
shows "p1 ^c q \<le>o r1 ^c q"
-using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
+ using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
lemma cexp_mono2':
assumes 2: "p2 \<le>o r2" and q: "Card_order q"
- and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
+ and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
shows "q ^c p2 \<le>o q ^c r2"
-using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
+ using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
lemma cexp_mono2:
assumes 2: "p2 \<le>o r2" and q: "Card_order q"
- and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
+ and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
shows "q ^c p2 \<le>o q ^c r2"
-using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
+ using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
lemma cexp_mono2_Cnotzero:
assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
shows "q ^c p2 \<le>o q ^c r2"
-using assms(3) czeroI by (blast intro: cexp_mono2'[OF assms(1,2)])
+ using assms(3) czeroI by (blast intro: cexp_mono2'[OF assms(1,2)])
lemma cexp_cong:
assumes 1: "p1 =o r1" and 2: "p2 =o r2"
- and Cr: "Card_order r2"
- and Cp: "Card_order p2"
+ and Cr: "Card_order r2"
+ and Cp: "Card_order p2"
shows "p1 ^c p2 =o r1 ^c r2"
proof -
obtain f where "bij_betw f (Field p2) (Field r2)"
@@ -535,7 +533,7 @@
hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
- using 0 Cr Cp czeroE czeroI by auto
+ using 0 Cr Cp czeroE czeroI by auto
show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by blast
qed
@@ -543,12 +541,12 @@
lemma cexp_cong1:
assumes 1: "p1 =o r1" and q: "Card_order q"
shows "p1 ^c q =o r1 ^c q"
-by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
+ by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
lemma cexp_cong2:
assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
shows "q ^c p2 =o q ^c r2"
-by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
+ by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
lemma cexp_cone:
assumes "Card_order r"
@@ -570,31 +568,30 @@
unfolding cprod_def cexp_def Field_card_of
using card_of_Func_Times by(rule ordIso_symmetric)
also have "r1 ^c (r3 *c r2) =o ?R"
- apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
+ using cprod_com r1 by (intro cexp_cong2, auto simp: Card_order_cprod)
finally show ?thesis .
qed
lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
-unfolding cinfinite_def cprod_def
-by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
+ unfolding cinfinite_def cprod_def
+ by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
lemma cprod_infinite: "Cinfinite r \<Longrightarrow> r *c r =o r"
-using cprod_infinite1' Cinfinite_Cnotzero ordLeq_refl by blast
+ using cprod_infinite1' Cinfinite_Cnotzero ordLeq_refl by blast
lemma cexp_cprod_ordLeq:
assumes r1: "Card_order r1" and r2: "Cinfinite r2"
- and r3: "Cnotzero r3" "r3 \<le>o r2"
+ and r3: "Cnotzero r3" "r3 \<le>o r2"
shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
proof-
have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
also have "r1 ^c (r2 *c r3) =o ?R"
- apply(rule cexp_cong2)
- apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
+ using assms by (fastforce simp: Card_order_cprod intro: cprod_infinite1' cexp_cong2)
finally show ?thesis .
qed
lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
-by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
+ by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
lemma ordLess_ctwo_cexp:
assumes "Card_order r"
@@ -613,21 +610,12 @@
case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
next
case False
- thus ?thesis
- apply -
- apply (rule ordIso_ordLeq_trans)
- apply (rule ordIso_symmetric)
- apply (rule cexp_cone)
- apply (rule assms(2))
- apply (rule cexp_mono2)
- apply (rule cone_ordLeq_Cnotzero)
- apply (rule assms(1))
- apply (rule assms(2))
- apply (rule notE)
- apply (rule cone_not_czero)
- apply assumption
- apply (rule Card_order_cone)
- done
+ have "q =o q ^c cone"
+ by (blast intro: assms ordIso_symmetric cexp_cone)
+ also have "q ^c cone \<le>o q ^c r"
+ using assms
+ by (intro cexp_mono2) (simp_all add: cone_ordLeq_Cnotzero cone_not_czero Card_order_cone)
+ finally show ?thesis .
qed
lemma ordLeq_cexp2:
@@ -636,24 +624,20 @@
proof (cases "r =o (czero :: 'a rel)")
case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
next
- case False thus ?thesis
- apply -
- apply (rule ordLess_imp_ordLeq)
- apply (rule ordLess_ordLeq_trans)
- apply (rule ordLess_ctwo_cexp)
- apply (rule assms(2))
- apply (rule cexp_mono1)
- apply (rule assms(1))
- apply (rule assms(2))
- done
+ case False
+ have "r <o ctwo ^c r"
+ by (blast intro: assms ordLess_ctwo_cexp)
+ also have "ctwo ^c r \<le>o q ^c r"
+ by (blast intro: assms cexp_mono1)
+ finally show ?thesis by (rule ordLess_imp_ordLeq)
qed
lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
-by (rule cinfinite_mono[OF ordLeq_cexp2]) simp_all
+ by (rule cinfinite_mono[OF ordLeq_cexp2]) simp_all
lemma Cinfinite_cexp:
"\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
-by (simp add: cinfinite_cexp Card_order_cexp)
+ by (simp add: cinfinite_cexp Card_order_cexp)
lemma card_order_cexp:
assumes "card_order r1" "card_order r2"
@@ -664,32 +648,32 @@
qed
lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
-unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
-by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
+ unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
+ by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
-by (rule ordLess_ordLeq_trans[OF ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite])
+ by (rule ordLess_ordLeq_trans[OF ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite])
lemma ctwo_ordLeq_Cinfinite:
assumes "Cinfinite r"
shows "ctwo \<le>o r"
-by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
+ by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
-by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
+ by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
lemma Un_Cinfinite_bound_strict: "\<lbrakk>|A| <o r; |B| <o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| <o r"
-by (auto simp add: cinfinite_def card_of_Un_ordLess_infinite_Field)
+ by (auto simp add: cinfinite_def card_of_Un_ordLess_infinite_Field)
lemma UNION_Cinfinite_bound: "\<lbrakk>|I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |\<Union>i \<in> I. A i| \<le>o r"
-by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
+ by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
lemma csum_cinfinite_bound:
assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
shows "p +c q \<le>o r"
proof -
- from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
- unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
+ have "|Field p| \<le>o r" "|Field q| \<le>o r"
+ using assms card_of_least ordLeq_transitive unfolding card_order_on_def by blast+
with assms show ?thesis unfolding cinfinite_def csum_def
by (blast intro: card_of_Plus_ordLeq_infinite_Field)
qed
@@ -711,26 +695,22 @@
lemma regularCard_cprod:
assumes "Cinfinite r" "Cinfinite s" "regularCard r" "regularCard s"
- shows "regularCard (r *c s)"
+ shows "regularCard (r *c s)"
proof (cases "r \<le>o s")
case True
- show ?thesis
- apply (rule regularCard_ordIso[of s])
- apply (rule ordIso_symmetric[OF cprod_infinite2'])
- using assms True Cinfinite_Cnotzero by auto
+ with assms Cinfinite_Cnotzero show ?thesis
+ by (force intro: regularCard_ordIso ordIso_symmetric[OF cprod_infinite2'])
next
case False
have "Well_order r" "Well_order s" using assms card_order_on_well_order_on by auto
- then have 1: "s \<le>o r" using not_ordLeq_iff_ordLess ordLess_imp_ordLeq False by blast
- show ?thesis
- apply (rule regularCard_ordIso[of r])
- apply (rule ordIso_symmetric[OF cprod_infinite1'])
- using assms 1 Cinfinite_Cnotzero by auto
+ then have "s \<le>o r" using not_ordLeq_iff_ordLess ordLess_imp_ordLeq False by blast
+ with assms Cinfinite_Cnotzero show ?thesis
+ by (force intro: regularCard_ordIso ordIso_symmetric[OF cprod_infinite1'])
qed
lemma cprod_csum_cexp:
"r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
-unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
+ unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
proof -
let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
@@ -742,8 +722,8 @@
qed
lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
-by (intro cprod_cinfinite_bound)
- (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
+ by (intro cprod_cinfinite_bound)
+ (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
@@ -807,12 +787,12 @@
(* cardSuc *)
lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
-by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
+ by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
lemma cardSuc_UNION_Cinfinite:
assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (\<Union>i \<in> Field (cardSuc r). As i)" "|B| <=o r"
shows "\<exists>i \<in> Field (cardSuc r). B \<le> As i"
-using cardSuc_UNION assms unfolding cinfinite_def by blast
+ using cardSuc_UNION assms unfolding cinfinite_def by blast
lemma Cinfinite_card_suc: "\<lbrakk> Cinfinite r ; card_order r \<rbrakk> \<Longrightarrow> Cinfinite (card_suc r)"
using Cinfinite_cong[OF cardSuc_ordIso_card_suc Cinfinite_cardSuc] .
--- a/src/HOL/BNF_Cardinal_Order_Relation.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/BNF_Cardinal_Order_Relation.thy Sun Jan 15 20:00:44 2023 +0100
@@ -9,7 +9,7 @@
section \<open>Cardinal-Order Relations as Needed by Bounded Natural Functors\<close>
theory BNF_Cardinal_Order_Relation
-imports Zorn BNF_Wellorder_Constructions
+ imports Zorn BNF_Wellorder_Constructions
begin
text\<open>In this section, we define cardinal-order relations to be minim well-orders
@@ -42,20 +42,20 @@
strict order-embedding relation, \<open><o\<close>), among all the well-orders on its field.\<close>
definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
-where
-"card_order_on A r \<equiv> well_order_on A r \<and> (\<forall>r'. well_order_on A r' \<longrightarrow> r \<le>o r')"
+ where
+ "card_order_on A r \<equiv> well_order_on A r \<and> (\<forall>r'. well_order_on A r' \<longrightarrow> r \<le>o r')"
abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
abbreviation "card_order r \<equiv> card_order_on UNIV r"
lemma card_order_on_well_order_on:
-assumes "card_order_on A r"
-shows "well_order_on A r"
-using assms unfolding card_order_on_def by simp
+ assumes "card_order_on A r"
+ shows "well_order_on A r"
+ using assms unfolding card_order_on_def by simp
lemma card_order_on_Card_order:
-"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
-unfolding card_order_on_def using well_order_on_Field by blast
+ "card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
+ unfolding card_order_on_def using well_order_on_Field by blast
text\<open>The existence of a cardinal relation on any given set (which will mean
that any set has a cardinal) follows from two facts:
@@ -68,48 +68,47 @@
\<close>
theorem card_order_on: "\<exists>r. card_order_on A r"
-proof-
- obtain R where R_def: "R = {r. well_order_on A r}" by blast
- have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
- using well_order_on[of A] R_def well_order_on_Well_order by blast
- hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
- using exists_minim_Well_order[of R] by auto
- thus ?thesis using R_def unfolding card_order_on_def by auto
+proof -
+ define R where "R \<equiv> {r. well_order_on A r}"
+ have "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
+ using well_order_on[of A] R_def well_order_on_Well_order by blast
+ with exists_minim_Well_order[of R] show ?thesis
+ by (auto simp: R_def card_order_on_def)
qed
lemma card_order_on_ordIso:
-assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
-shows "r =o r'"
-using assms unfolding card_order_on_def
-using ordIso_iff_ordLeq by blast
+ assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
+ shows "r =o r'"
+ using assms unfolding card_order_on_def
+ using ordIso_iff_ordLeq by blast
lemma Card_order_ordIso:
-assumes CO: "Card_order r" and ISO: "r' =o r"
-shows "Card_order r'"
-using ISO unfolding ordIso_def
+ assumes CO: "Card_order r" and ISO: "r' =o r"
+ shows "Card_order r'"
+ using ISO unfolding ordIso_def
proof(unfold card_order_on_def, auto)
fix p' assume "well_order_on (Field r') p'"
hence 0: "Well_order p' \<and> Field p' = Field r'"
- using well_order_on_Well_order by blast
+ using well_order_on_Well_order by blast
obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
- using ISO unfolding ordIso_def by auto
+ using ISO unfolding ordIso_def by auto
hence 3: "inj_on f (Field r') \<and> f ` (Field r') = Field r"
- by (auto simp add: iso_iff embed_inj_on)
+ by (auto simp add: iso_iff embed_inj_on)
let ?p = "dir_image p' f"
have 4: "p' =o ?p \<and> Well_order ?p"
- using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
- moreover have "Field ?p = Field r"
- using 0 3 by (auto simp add: dir_image_Field)
+ using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
+ moreover have "Field ?p = Field r"
+ using 0 3 by (auto simp add: dir_image_Field)
ultimately have "well_order_on (Field r) ?p" by auto
hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
thus "r' \<le>o p'"
- using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
+ using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
qed
lemma Card_order_ordIso2:
-assumes CO: "Card_order r" and ISO: "r =o r'"
-shows "Card_order r'"
-using assms Card_order_ordIso ordIso_symmetric by blast
+ assumes CO: "Card_order r" and ISO: "r =o r'"
+ shows "Card_order r'"
+ using assms Card_order_ordIso ordIso_symmetric by blast
subsection \<open>Cardinal of a set\<close>
@@ -119,220 +118,213 @@
that order isomorphism shall be the true identity of cardinals.\<close>
definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
-where "card_of A = (SOME r. card_order_on A r)"
+ where "card_of A = (SOME r. card_order_on A r)"
lemma card_of_card_order_on: "card_order_on A |A|"
-unfolding card_of_def by (auto simp add: card_order_on someI_ex)
+ unfolding card_of_def by (auto simp add: card_order_on someI_ex)
lemma card_of_well_order_on: "well_order_on A |A|"
-using card_of_card_order_on card_order_on_def by blast
+ using card_of_card_order_on card_order_on_def by blast
lemma Field_card_of: "Field |A| = A"
-using card_of_card_order_on[of A] unfolding card_order_on_def
-using well_order_on_Field by blast
+ using card_of_card_order_on[of A] unfolding card_order_on_def
+ using well_order_on_Field by blast
lemma card_of_Card_order: "Card_order |A|"
-by (simp only: card_of_card_order_on Field_card_of)
+ by (simp only: card_of_card_order_on Field_card_of)
corollary ordIso_card_of_imp_Card_order:
-"r =o |A| \<Longrightarrow> Card_order r"
-using card_of_Card_order Card_order_ordIso by blast
+ "r =o |A| \<Longrightarrow> Card_order r"
+ using card_of_Card_order Card_order_ordIso by blast
lemma card_of_Well_order: "Well_order |A|"
-using card_of_Card_order unfolding card_order_on_def by auto
+ using card_of_Card_order unfolding card_order_on_def by auto
lemma card_of_refl: "|A| =o |A|"
-using card_of_Well_order ordIso_reflexive by blast
+ using card_of_Well_order ordIso_reflexive by blast
lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
-using card_of_card_order_on unfolding card_order_on_def by blast
+ using card_of_card_order_on unfolding card_order_on_def by blast
lemma card_of_ordIso:
-"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
+ "(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
proof(auto)
fix f assume *: "bij_betw f A B"
then obtain r where "well_order_on B r \<and> |A| =o r"
- using Well_order_iso_copy card_of_well_order_on by blast
+ using Well_order_iso_copy card_of_well_order_on by blast
hence "|B| \<le>o |A|" using card_of_least
- ordLeq_ordIso_trans ordIso_symmetric by blast
+ ordLeq_ordIso_trans ordIso_symmetric by blast
moreover
{let ?g = "inv_into A f"
- have "bij_betw ?g B A" using * bij_betw_inv_into by blast
- then obtain r where "well_order_on A r \<and> |B| =o r"
- using Well_order_iso_copy card_of_well_order_on by blast
- hence "|A| \<le>o |B|" using card_of_least
- ordLeq_ordIso_trans ordIso_symmetric by blast
+ have "bij_betw ?g B A" using * bij_betw_inv_into by blast
+ then obtain r where "well_order_on A r \<and> |B| =o r"
+ using Well_order_iso_copy card_of_well_order_on by blast
+ hence "|A| \<le>o |B|"
+ using card_of_least ordLeq_ordIso_trans ordIso_symmetric by blast
}
ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
next
assume "|A| =o |B|"
then obtain f where "iso ( |A| ) ( |B| ) f"
- unfolding ordIso_def by auto
+ unfolding ordIso_def by auto
hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
thus "\<exists>f. bij_betw f A B" by auto
qed
lemma card_of_ordLeq:
-"(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
+ "(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
proof(auto)
fix f assume *: "inj_on f A" and **: "f ` A \<le> B"
{assume "|B| <o |A|"
- hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
- then obtain g where "embed ( |B| ) ( |A| ) g"
- unfolding ordLeq_def by auto
- hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
- card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
- embed_Field[of "|B|" "|A|" g] by auto
- obtain h where "bij_betw h A B"
- using * ** 1 Schroeder_Bernstein[of f] by fastforce
- hence "|A| =o |B|" using card_of_ordIso by blast
- hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
+ hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
+ then obtain g where "embed ( |B| ) ( |A| ) g"
+ unfolding ordLeq_def by auto
+ hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
+ card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
+ embed_Field[of "|B|" "|A|" g] by auto
+ obtain h where "bij_betw h A B"
+ using * ** 1 Schroeder_Bernstein[of f] by fastforce
+ hence "|A| \<le>o |B|" using card_of_ordIso ordIso_iff_ordLeq by auto
}
thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
- by (auto simp: card_of_Well_order)
+ by (auto simp: card_of_Well_order)
next
assume *: "|A| \<le>o |B|"
- obtain f where "embed ( |A| ) ( |B| ) f"
- using * unfolding ordLeq_def by auto
- hence "inj_on f A \<and> f ` A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
- card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
- embed_Field[of "|A|" "|B|" f] by auto
+ obtain f where "embed |A| |B| f"
+ using * unfolding ordLeq_def by auto
+ hence "inj_on f A \<and> f ` A \<le> B"
+ using embed_inj_on[of "|A|" "|B|"] card_of_Well_order embed_Field[of "|A|" "|B|"]
+ by (auto simp: Field_card_of)
thus "\<exists>f. inj_on f A \<and> f ` A \<le> B" by auto
qed
lemma card_of_ordLeq2:
-"A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
-using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
+ "A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
+ using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
lemma card_of_ordLess:
-"(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
-proof-
+ "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
+proof -
have "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = (\<not> |A| \<le>o |B| )"
- using card_of_ordLeq by blast
+ using card_of_ordLeq by blast
also have "\<dots> = ( |B| <o |A| )"
- using card_of_Well_order[of A] card_of_Well_order[of B]
- not_ordLeq_iff_ordLess by blast
+ using not_ordLeq_iff_ordLess by (auto intro: card_of_Well_order)
finally show ?thesis .
qed
lemma card_of_ordLess2:
-"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
-using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
+ "B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
+ using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
lemma card_of_ordIsoI:
-assumes "bij_betw f A B"
-shows "|A| =o |B|"
-using assms unfolding card_of_ordIso[symmetric] by auto
+ assumes "bij_betw f A B"
+ shows "|A| =o |B|"
+ using assms unfolding card_of_ordIso[symmetric] by auto
lemma card_of_ordLeqI:
-assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
-shows "|A| \<le>o |B|"
-using assms unfolding card_of_ordLeq[symmetric] by auto
+ assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
+ shows "|A| \<le>o |B|"
+ using assms unfolding card_of_ordLeq[symmetric] by auto
lemma card_of_unique:
-"card_order_on A r \<Longrightarrow> r =o |A|"
-by (simp only: card_order_on_ordIso card_of_card_order_on)
+ "card_order_on A r \<Longrightarrow> r =o |A|"
+ by (simp only: card_order_on_ordIso card_of_card_order_on)
lemma card_of_mono1:
-"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
-using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
+ "A \<le> B \<Longrightarrow> |A| \<le>o |B|"
+ using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
lemma card_of_mono2:
-assumes "r \<le>o r'"
-shows "|Field r| \<le>o |Field r'|"
-proof-
+ assumes "r \<le>o r'"
+ shows "|Field r| \<le>o |Field r'|"
+proof -
obtain f where
- 1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
- using assms unfolding ordLeq_def
- by (auto simp add: well_order_on_Well_order)
+ 1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
+ using assms unfolding ordLeq_def
+ by (auto simp add: well_order_on_Well_order)
hence "inj_on f (Field r) \<and> f ` (Field r) \<le> Field r'"
- by (auto simp add: embed_inj_on embed_Field)
+ by (auto simp add: embed_inj_on embed_Field)
thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
qed
lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
-by (simp add: ordIso_iff_ordLeq card_of_mono2)
-
-lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
-using card_of_least card_of_well_order_on well_order_on_Well_order by blast
+ by (simp add: ordIso_iff_ordLeq card_of_mono2)
lemma card_of_Field_ordIso:
-assumes "Card_order r"
-shows "|Field r| =o r"
-proof-
+ assumes "Card_order r"
+ shows "|Field r| =o r"
+proof -
have "card_order_on (Field r) r"
- using assms card_order_on_Card_order by blast
+ using assms card_order_on_Card_order by blast
moreover have "card_order_on (Field r) |Field r|"
- using card_of_card_order_on by blast
+ using card_of_card_order_on by blast
ultimately show ?thesis using card_order_on_ordIso by blast
qed
lemma Card_order_iff_ordIso_card_of:
-"Card_order r = (r =o |Field r| )"
-using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
+ "Card_order r = (r =o |Field r| )"
+ using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
lemma Card_order_iff_ordLeq_card_of:
-"Card_order r = (r \<le>o |Field r| )"
-proof-
+ "Card_order r = (r \<le>o |Field r| )"
+proof -
have "Card_order r = (r =o |Field r| )"
- unfolding Card_order_iff_ordIso_card_of by simp
- also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
- unfolding ordIso_iff_ordLeq by simp
- also have "... = (r \<le>o |Field r| )"
- using card_of_Field_ordLess
- by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
+ unfolding Card_order_iff_ordIso_card_of by simp
+ also have "\<dots> = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
+ unfolding ordIso_iff_ordLeq by simp
+ also have "\<dots> = (r \<le>o |Field r| )"
+ using card_of_least
+ by (auto simp: card_of_least ordLeq_Well_order_simp)
finally show ?thesis .
qed
lemma Card_order_iff_Restr_underS:
-assumes "Well_order r"
-shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
-using assms unfolding Card_order_iff_ordLeq_card_of
-using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
+ assumes "Well_order r"
+ shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
+ using assms ordLeq_iff_ordLess_Restr card_of_Well_order
+ unfolding Card_order_iff_ordLeq_card_of by blast
lemma card_of_underS:
-assumes r: "Card_order r" and a: "a \<in> Field r"
-shows "|underS r a| <o r"
-proof-
+ assumes r: "Card_order r" and a: "a \<in> Field r"
+ shows "|underS r a| <o r"
+proof -
let ?A = "underS r a" let ?r' = "Restr r ?A"
have 1: "Well_order r"
- using r unfolding card_order_on_def by simp
+ using r unfolding card_order_on_def by simp
have "Well_order ?r'" using 1 Well_order_Restr by auto
- moreover have "card_order_on (Field ?r') |Field ?r'|"
- using card_of_card_order_on .
- ultimately have "|Field ?r'| \<le>o ?r'"
- unfolding card_order_on_def by simp
+ with card_of_card_order_on have "|Field ?r'| \<le>o ?r'"
+ unfolding card_order_on_def by auto
moreover have "Field ?r' = ?A"
- using 1 wo_rel.underS_ofilter Field_Restr_ofilter
- unfolding wo_rel_def by fastforce
+ using 1 wo_rel.underS_ofilter Field_Restr_ofilter
+ unfolding wo_rel_def by fastforce
ultimately have "|?A| \<le>o ?r'" by simp
also have "?r' <o |Field r|"
- using 1 a r Card_order_iff_Restr_underS by blast
+ using 1 a r Card_order_iff_Restr_underS by blast
also have "|Field r| =o r"
- using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
+ using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
finally show ?thesis .
qed
lemma ordLess_Field:
-assumes "r <o r'"
-shows "|Field r| <o r'"
-proof-
+ assumes "r <o r'"
+ shows "|Field r| <o r'"
+proof -
have "well_order_on (Field r) r" using assms unfolding ordLess_def
- by (auto simp add: well_order_on_Well_order)
+ by (auto simp add: well_order_on_Well_order)
hence "|Field r| \<le>o r" using card_of_least by blast
thus ?thesis using assms ordLeq_ordLess_trans by blast
qed
lemma internalize_card_of_ordLeq:
-"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
+ "( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
proof
assume "|A| \<le>o r"
then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
- using internalize_ordLeq[of "|A|" r] by blast
+ using internalize_ordLeq[of "|A|" r] by blast
hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
hence "|Field p| =o p" using card_of_Field_ordIso by blast
hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
- using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
+ using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
next
assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
@@ -340,8 +332,8 @@
qed
lemma internalize_card_of_ordLeq2:
-"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
-using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
+ "( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
+ using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
subsection \<open>Cardinals versus set operations on arbitrary sets\<close>
@@ -353,123 +345,113 @@
\<close>
lemma card_of_empty: "|{}| \<le>o |A|"
-using card_of_ordLeq inj_on_id by blast
+ using card_of_ordLeq inj_on_id by blast
lemma card_of_empty1:
-assumes "Well_order r \<or> Card_order r"
-shows "|{}| \<le>o r"
-proof-
+ assumes "Well_order r \<or> Card_order r"
+ shows "|{}| \<le>o r"
+proof -
have "Well_order r" using assms unfolding card_order_on_def by auto
- hence "|Field r| <=o r"
- using assms card_of_Field_ordLess by blast
+ hence "|Field r| \<le>o r"
+ using assms card_of_least by blast
moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
ultimately show ?thesis using ordLeq_transitive by blast
qed
corollary Card_order_empty:
-"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
+ "Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
lemma card_of_empty2:
-assumes LEQ: "|A| =o |{}|"
-shows "A = {}"
-using assms card_of_ordIso[of A] bij_betw_empty2 by blast
+ assumes "|A| =o |{}|"
+ shows "A = {}"
+ using assms card_of_ordIso[of A] bij_betw_empty2 by blast
lemma card_of_empty3:
-assumes LEQ: "|A| \<le>o |{}|"
-shows "A = {}"
-using assms
-by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
- ordLeq_Well_order_simp)
+ assumes "|A| \<le>o |{}|"
+ shows "A = {}"
+ using assms
+ by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
+ ordLeq_Well_order_simp)
lemma card_of_empty_ordIso:
-"|{}::'a set| =o |{}::'b set|"
-using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
+ "|{}::'a set| =o |{}::'b set|"
+ using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
lemma card_of_image:
-"|f ` A| <=o |A|"
-proof(cases "A = {}", simp add: card_of_empty)
- assume "A \<noteq> {}"
+ "|f ` A| \<le>o |A|"
+proof(cases "A = {}")
+ case False
hence "f ` A \<noteq> {}" by auto
- thus "|f ` A| \<le>o |A|"
- using card_of_ordLeq2[of "f ` A" A] by auto
-qed
+ thus ?thesis
+ using card_of_ordLeq2[of "f ` A" A] by auto
+qed (simp add: card_of_empty)
lemma surj_imp_ordLeq:
-assumes "B \<subseteq> f ` A"
-shows "|B| \<le>o |A|"
-proof-
- have "|B| <=o |f ` A|" using assms card_of_mono1 by auto
+ assumes "B \<subseteq> f ` A"
+ shows "|B| \<le>o |A|"
+proof -
+ have "|B| \<le>o |f ` A|" using assms card_of_mono1 by auto
thus ?thesis using card_of_image ordLeq_transitive by blast
qed
lemma card_of_singl_ordLeq:
-assumes "A \<noteq> {}"
-shows "|{b}| \<le>o |A|"
-proof-
+ assumes "A \<noteq> {}"
+ shows "|{b}| \<le>o |A|"
+proof -
obtain a where *: "a \<in> A" using assms by auto
let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
have "inj_on ?h {b} \<and> ?h ` {b} \<le> A"
- using * unfolding inj_on_def by auto
+ using * unfolding inj_on_def by auto
thus ?thesis unfolding card_of_ordLeq[symmetric] by (intro exI)
qed
corollary Card_order_singl_ordLeq:
-"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
-using card_of_singl_ordLeq[of "Field r" b]
- card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
+ "\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
+ using card_of_singl_ordLeq[of "Field r" b]
+ card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
lemma card_of_Pow: "|A| <o |Pow A|"
-using card_of_ordLess2[of "Pow A" A] Cantors_paradox[of A]
- Pow_not_empty[of A] by auto
+ using card_of_ordLess2[of "Pow A" A] Cantors_paradox[of A]
+ Pow_not_empty[of A] by auto
corollary Card_order_Pow:
-"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
-using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
+ "Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
+ using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
-lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
-proof-
- have "Inl ` A \<le> A <+> B" by auto
- thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
-qed
+lemma card_of_Plus1: "|A| \<le>o |A <+> B|" and card_of_Plus2: "|B| \<le>o |A <+> B|"
+ using card_of_ordLeq by force+
corollary Card_order_Plus1:
-"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
-using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
-
-lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
-proof-
- have "Inr ` B \<le> A <+> B" by auto
- thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
-qed
+ "Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
+ using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
corollary Card_order_Plus2:
-"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
-using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
+ "Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
+ using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
-proof-
+proof -
have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
thus ?thesis using card_of_ordIso by auto
qed
lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
-proof-
+proof -
have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
thus ?thesis using card_of_ordIso by auto
qed
lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
-proof-
- let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
- | Inr b \<Rightarrow> Inl b"
+proof -
+ let ?f = "\<lambda>c. case c of Inl a \<Rightarrow> Inr a | Inr b \<Rightarrow> Inl b"
have "bij_betw ?f (A <+> B) (B <+> A)"
- unfolding bij_betw_def inj_on_def by force
+ unfolding bij_betw_def inj_on_def by force
thus ?thesis using card_of_ordIso by blast
qed
lemma card_of_Plus_assoc:
-fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
-shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
+ fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
+ shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
proof -
define f :: "('a + 'b) + 'c \<Rightarrow> 'a + 'b + 'c"
where [abs_def]: "f k =
@@ -487,21 +469,11 @@
proof(cases x)
case (Inl a)
hence "a \<in> A" "x = f (Inl (Inl a))"
- using x unfolding f_def by auto
+ using x unfolding f_def by auto
thus ?thesis by auto
next
- case (Inr bc) note 1 = Inr show ?thesis
- proof(cases bc)
- case (Inl b)
- hence "b \<in> B" "x = f (Inl (Inr b))"
- using x 1 unfolding f_def by auto
- thus ?thesis by auto
- next
- case (Inr c)
- hence "c \<in> C" "x = f (Inr c)"
- using x 1 unfolding f_def by auto
- thus ?thesis by auto
- qed
+ case (Inr bc) with x show ?thesis
+ by (cases bc) (force simp: f_def)+
qed
qed
hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
@@ -510,159 +482,134 @@
qed
lemma card_of_Plus_mono1:
-assumes "|A| \<le>o |B|"
-shows "|A <+> C| \<le>o |B <+> C|"
-proof-
- obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
- using assms card_of_ordLeq[of A] by fastforce
- obtain g where g_def:
- "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
+ assumes "|A| \<le>o |B|"
+ shows "|A <+> C| \<le>o |B <+> C|"
+proof -
+ obtain f where f: "inj_on f A \<and> f ` A \<le> B"
+ using assms card_of_ordLeq[of A] by fastforce
+ define g where "g \<equiv> \<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c"
have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
- proof-
- {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
- "g d1 = g d2"
- hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
- }
- moreover
- {fix d assume "d \<in> A <+> C"
- hence "g d \<in> B <+> C" using 1
- by(cases d) (auto simp add: g_def)
- }
- ultimately show ?thesis unfolding inj_on_def by auto
- qed
+ using f unfolding inj_on_def g_def by force
thus ?thesis using card_of_ordLeq by blast
qed
corollary ordLeq_Plus_mono1:
-assumes "r \<le>o r'"
-shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
-using assms card_of_mono2 card_of_Plus_mono1 by blast
+ assumes "r \<le>o r'"
+ shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
+ using assms card_of_mono2 card_of_Plus_mono1 by blast
lemma card_of_Plus_mono2:
-assumes "|A| \<le>o |B|"
-shows "|C <+> A| \<le>o |C <+> B|"
-using assms card_of_Plus_mono1[of A B C]
- card_of_Plus_commute[of C A] card_of_Plus_commute[of B C]
- ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
-by blast
+ assumes "|A| \<le>o |B|"
+ shows "|C <+> A| \<le>o |C <+> B|"
+ using card_of_Plus_mono1[OF assms]
+ by (blast intro: card_of_Plus_commute ordIso_ordLeq_trans ordLeq_ordIso_trans)
corollary ordLeq_Plus_mono2:
-assumes "r \<le>o r'"
-shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
-using assms card_of_mono2 card_of_Plus_mono2 by blast
+ assumes "r \<le>o r'"
+ shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
+ using assms card_of_mono2 card_of_Plus_mono2 by blast
lemma card_of_Plus_mono:
-assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
-shows "|A <+> C| \<le>o |B <+> D|"
-using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
- ordLeq_transitive[of "|A <+> C|"] by blast
+ assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
+ shows "|A <+> C| \<le>o |B <+> D|"
+ using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
+ ordLeq_transitive by blast
corollary ordLeq_Plus_mono:
-assumes "r \<le>o r'" and "p \<le>o p'"
-shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
-using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
+ assumes "r \<le>o r'" and "p \<le>o p'"
+ shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
+ using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
lemma card_of_Plus_cong1:
-assumes "|A| =o |B|"
-shows "|A <+> C| =o |B <+> C|"
-using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
+ assumes "|A| =o |B|"
+ shows "|A <+> C| =o |B <+> C|"
+ using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
corollary ordIso_Plus_cong1:
-assumes "r =o r'"
-shows "|(Field r) <+> C| =o |(Field r') <+> C|"
-using assms card_of_cong card_of_Plus_cong1 by blast
+ assumes "r =o r'"
+ shows "|(Field r) <+> C| =o |(Field r') <+> C|"
+ using assms card_of_cong card_of_Plus_cong1 by blast
lemma card_of_Plus_cong2:
-assumes "|A| =o |B|"
-shows "|C <+> A| =o |C <+> B|"
-using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
+ assumes "|A| =o |B|"
+ shows "|C <+> A| =o |C <+> B|"
+ using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
corollary ordIso_Plus_cong2:
-assumes "r =o r'"
-shows "|A <+> (Field r)| =o |A <+> (Field r')|"
-using assms card_of_cong card_of_Plus_cong2 by blast
+ assumes "r =o r'"
+ shows "|A <+> (Field r)| =o |A <+> (Field r')|"
+ using assms card_of_cong card_of_Plus_cong2 by blast
lemma card_of_Plus_cong:
-assumes "|A| =o |B|" and "|C| =o |D|"
-shows "|A <+> C| =o |B <+> D|"
-using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
+ assumes "|A| =o |B|" and "|C| =o |D|"
+ shows "|A <+> C| =o |B <+> D|"
+ using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
corollary ordIso_Plus_cong:
-assumes "r =o r'" and "p =o p'"
-shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
-using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
+ assumes "r =o r'" and "p =o p'"
+ shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
+ using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
lemma card_of_Un_Plus_ordLeq:
-"|A \<union> B| \<le>o |A <+> B|"
-proof-
- let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
- have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
- unfolding inj_on_def by auto
- thus ?thesis using card_of_ordLeq by blast
+ "|A \<union> B| \<le>o |A <+> B|"
+proof -
+ let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
+ have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
+ unfolding inj_on_def by auto
+ thus ?thesis using card_of_ordLeq by blast
qed
lemma card_of_Times1:
-assumes "A \<noteq> {}"
-shows "|B| \<le>o |B \<times> A|"
-proof(cases "B = {}", simp add: card_of_empty)
- assume *: "B \<noteq> {}"
+ assumes "A \<noteq> {}"
+ shows "|B| \<le>o |B \<times> A|"
+proof(cases "B = {}")
+ case False
have "fst `(B \<times> A) = B" using assms by auto
thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
- card_of_ordLeq[of B "B \<times> A"] * by blast
-qed
+ card_of_ordLeq False by blast
+qed (simp add: card_of_empty)
lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
-proof-
- let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
- have "bij_betw ?f (A \<times> B) (B \<times> A)"
- unfolding bij_betw_def inj_on_def by auto
+proof -
+ have "bij_betw (\<lambda>(a,b). (b,a)) (A \<times> B) (B \<times> A)"
+ unfolding bij_betw_def inj_on_def by auto
thus ?thesis using card_of_ordIso by blast
qed
lemma card_of_Times2:
-assumes "A \<noteq> {}" shows "|B| \<le>o |A \<times> B|"
-using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
- ordLeq_ordIso_trans by blast
+ assumes "A \<noteq> {}" shows "|B| \<le>o |A \<times> B|"
+ using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
+ ordLeq_ordIso_trans by blast
corollary Card_order_Times1:
-"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
-using card_of_Times1[of B] card_of_Field_ordIso
- ordIso_ordLeq_trans ordIso_symmetric by blast
+ "\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
+ using card_of_Times1[of B] card_of_Field_ordIso
+ ordIso_ordLeq_trans ordIso_symmetric by blast
corollary Card_order_Times2:
-"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
-using card_of_Times2[of A] card_of_Field_ordIso
- ordIso_ordLeq_trans ordIso_symmetric by blast
+ "\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
+ using card_of_Times2[of A] card_of_Field_ordIso
+ ordIso_ordLeq_trans ordIso_symmetric by blast
lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
-using card_of_Times1[of A]
-by(cases "A = {}", simp add: card_of_empty, blast)
+ using card_of_Times1[of A]
+ by(cases "A = {}", simp add: card_of_empty)
lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
-proof-
+proof -
let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
|Inr a \<Rightarrow> (a,False)"
have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
- proof-
- {fix c1 and c2 assume "?f c1 = ?f c2"
- hence "c1 = c2"
- by(cases c1; cases c2) auto
- }
+ proof -
+ have "\<And>c1 c2. ?f c1 = ?f c2 \<Longrightarrow> c1 = c2"
+ by (force split: sum.split_asm)
moreover
- {fix c assume "c \<in> A <+> A"
- hence "?f c \<in> A \<times> (UNIV::bool set)"
- by(cases c) auto
- }
+ have "\<And>c. c \<in> A <+> A \<Longrightarrow> ?f c \<in> A \<times> (UNIV::bool set)"
+ by (force split: sum.split_asm)
moreover
- {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
- have "(a,bl) \<in> ?f ` ( A <+> A)"
- proof(cases bl)
- assume bl hence "?f(Inl a) = (a,bl)" by auto
- thus ?thesis using * by force
- next
- assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
- thus ?thesis using * by force
- qed
+ {fix a bl assume "(a,bl) \<in> A \<times> (UNIV::bool set)"
+ hence "(a,bl) \<in> ?f ` ( A <+> A)"
+ by (cases bl) (force split: sum.split_asm)+
}
ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
qed
@@ -670,127 +617,107 @@
qed
lemma card_of_Times_mono1:
-assumes "|A| \<le>o |B|"
-shows "|A \<times> C| \<le>o |B \<times> C|"
-proof-
- obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
- using assms card_of_ordLeq[of A] by fastforce
- obtain g where g_def:
- "g = (\<lambda>(a,c::'c). (f a,c))" by blast
+ assumes "|A| \<le>o |B|"
+ shows "|A \<times> C| \<le>o |B \<times> C|"
+proof -
+ obtain f where f: "inj_on f A \<and> f ` A \<le> B"
+ using assms card_of_ordLeq[of A] by fastforce
+ define g where "g \<equiv> (\<lambda>(a,c::'c). (f a,c))"
have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
- using 1 unfolding inj_on_def using g_def by auto
+ using f unfolding inj_on_def using g_def by auto
thus ?thesis using card_of_ordLeq by blast
qed
corollary ordLeq_Times_mono1:
-assumes "r \<le>o r'"
-shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
-using assms card_of_mono2 card_of_Times_mono1 by blast
+ assumes "r \<le>o r'"
+ shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
+ using assms card_of_mono2 card_of_Times_mono1 by blast
lemma card_of_Times_mono2:
-assumes "|A| \<le>o |B|"
-shows "|C \<times> A| \<le>o |C \<times> B|"
-using assms card_of_Times_mono1[of A B C]
- card_of_Times_commute[of C A] card_of_Times_commute[of B C]
- ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
-by blast
+ assumes "|A| \<le>o |B|"
+ shows "|C \<times> A| \<le>o |C \<times> B|"
+ using assms card_of_Times_mono1[of A B C]
+ by (blast intro: card_of_Times_commute ordIso_ordLeq_trans ordLeq_ordIso_trans)
corollary ordLeq_Times_mono2:
-assumes "r \<le>o r'"
-shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
-using assms card_of_mono2 card_of_Times_mono2 by blast
+ assumes "r \<le>o r'"
+ shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
+ using assms card_of_mono2 card_of_Times_mono2 by blast
lemma card_of_Sigma_mono1:
-assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
-shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
-proof-
+ assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
+ shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
+proof -
have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
- using assms by (auto simp add: card_of_ordLeq)
+ using assms by (auto simp add: card_of_ordLeq)
with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
- obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i"
+ obtain F where F: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i"
by atomize_elim (auto intro: bchoice)
- obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
+ define g where "g \<equiv> (\<lambda>(i,a::'b). (i,F i a))"
have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
- using 1 unfolding inj_on_def using g_def by force
+ using F unfolding inj_on_def using g_def by force
thus ?thesis using card_of_ordLeq by blast
qed
lemma card_of_UNION_Sigma:
-"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
-using Ex_inj_on_UNION_Sigma [of A I] card_of_ordLeq by blast
+ "|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
+ using Ex_inj_on_UNION_Sigma [of A I] card_of_ordLeq by blast
lemma card_of_bool:
-assumes "a1 \<noteq> a2"
-shows "|UNIV::bool set| =o |{a1,a2}|"
-proof-
- let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
+ assumes "a1 \<noteq> a2"
+ shows "|UNIV::bool set| =o |{a1,a2}|"
+proof -
+ let ?f = "\<lambda> bl. if bl then a1 else a2"
have "bij_betw ?f UNIV {a1,a2}"
- proof-
- {fix bl1 and bl2 assume "?f bl1 = ?f bl2"
- hence "bl1 = bl2" using assms by (cases bl1, cases bl2) auto
- }
+ proof -
+ have "\<And>bl1 bl2. ?f bl1 = ?f bl2 \<Longrightarrow> bl1 = bl2"
+ using assms by (force split: if_split_asm)
moreover
- {fix bl have "?f bl \<in> {a1,a2}" by (cases bl) auto
- }
- moreover
- {fix a assume *: "a \<in> {a1,a2}"
- have "a \<in> ?f ` UNIV"
- proof(cases "a = a1")
- assume "a = a1"
- hence "?f True = a" by auto thus ?thesis by blast
- next
- assume "a \<noteq> a1" hence "a = a2" using * by auto
- hence "?f False = a" by auto thus ?thesis by blast
- qed
- }
- ultimately show ?thesis unfolding bij_betw_def inj_on_def by blast
+ have "\<And>bl. ?f bl \<in> {a1,a2}"
+ using assms by (force split: if_split_asm)
+ ultimately show ?thesis unfolding bij_betw_def inj_on_def by force
qed
thus ?thesis using card_of_ordIso by blast
qed
lemma card_of_Plus_Times_aux:
-assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
- LEQ: "|A| \<le>o |B|"
-shows "|A <+> B| \<le>o |A \<times> B|"
-proof-
+ assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
+ LEQ: "|A| \<le>o |B|"
+ shows "|A <+> B| \<le>o |A \<times> B|"
+proof -
have 1: "|UNIV::bool set| \<le>o |A|"
- using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
- ordIso_ordLeq_trans[of "|UNIV::bool set|"] by blast
- (* *)
+ using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
+ by (blast intro: ordIso_ordLeq_trans)
have "|A <+> B| \<le>o |B <+> B|"
- using LEQ card_of_Plus_mono1 by blast
+ using LEQ card_of_Plus_mono1 by blast
moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
- using card_of_Plus_Times_bool by blast
+ using card_of_Plus_Times_bool by blast
moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
- using 1 by (simp add: card_of_Times_mono2)
+ using 1 by (simp add: card_of_Times_mono2)
moreover have " |B \<times> A| =o |A \<times> B|"
- using card_of_Times_commute by blast
+ using card_of_Times_commute by blast
ultimately show "|A <+> B| \<le>o |A \<times> B|"
- using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
- ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
- ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
- by blast
+ by (blast intro: ordLeq_transitive dest: ordLeq_ordIso_trans)
qed
lemma card_of_Plus_Times:
-assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
- B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
-shows "|A <+> B| \<le>o |A \<times> B|"
-proof-
+ assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
+ shows "|A <+> B| \<le>o |A \<times> B|"
+proof -
{assume "|A| \<le>o |B|"
- hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
+ hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
}
moreover
{assume "|B| \<le>o |A|"
- hence "|B <+> A| \<le>o |B \<times> A|"
- using assms by (auto simp add: card_of_Plus_Times_aux)
- hence ?thesis
- using card_of_Plus_commute card_of_Times_commute
- ordIso_ordLeq_trans ordLeq_ordIso_trans by blast
+ hence "|B <+> A| \<le>o |B \<times> A|"
+ using assms by (auto simp add: card_of_Plus_Times_aux)
+ hence ?thesis
+ using card_of_Plus_commute card_of_Times_commute
+ ordIso_ordLeq_trans ordLeq_ordIso_trans by blast
}
ultimately show ?thesis
- using card_of_Well_order[of A] card_of_Well_order[of B]
- ordLeq_total[of "|A|"] by blast
+ using card_of_Well_order[of A] card_of_Well_order[of B]
+ ordLeq_total[of "|A|"] by blast
qed
lemma card_of_Times_Plus_distrib:
@@ -802,27 +729,27 @@
qed
lemma card_of_ordLeq_finite:
-assumes "|A| \<le>o |B|" and "finite B"
-shows "finite A"
-using assms unfolding ordLeq_def
-using embed_inj_on[of "|A|" "|B|"] embed_Field[of "|A|" "|B|"]
- Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
+ assumes "|A| \<le>o |B|" and "finite B"
+ shows "finite A"
+ using assms unfolding ordLeq_def
+ using embed_inj_on[of "|A|" "|B|"] embed_Field[of "|A|" "|B|"]
+ Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
lemma card_of_ordLeq_infinite:
-assumes "|A| \<le>o |B|" and "\<not> finite A"
-shows "\<not> finite B"
-using assms card_of_ordLeq_finite by auto
+ assumes "|A| \<le>o |B|" and "\<not> finite A"
+ shows "\<not> finite B"
+ using assms card_of_ordLeq_finite by auto
lemma card_of_ordIso_finite:
-assumes "|A| =o |B|"
-shows "finite A = finite B"
-using assms unfolding ordIso_def iso_def[abs_def]
-by (auto simp: bij_betw_finite Field_card_of)
+ assumes "|A| =o |B|"
+ shows "finite A = finite B"
+ using assms unfolding ordIso_def iso_def[abs_def]
+ by (auto simp: bij_betw_finite Field_card_of)
lemma card_of_ordIso_finite_Field:
-assumes "Card_order r" and "r =o |A|"
-shows "finite(Field r) = finite A"
-using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
+ assumes "Card_order r" and "r =o |A|"
+ shows "finite(Field r) = finite A"
+ using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
subsection \<open>Cardinals versus set operations involving infinite sets\<close>
@@ -835,18 +762,18 @@
at page 47 in @{cite "card-book"}. Then everything else follows fairly easily.\<close>
lemma infinite_iff_card_of_nat:
-"\<not> finite A \<longleftrightarrow> ( |UNIV::nat set| \<le>o |A| )"
-unfolding infinite_iff_countable_subset card_of_ordLeq ..
+ "\<not> finite A \<longleftrightarrow> ( |UNIV::nat set| \<le>o |A| )"
+ unfolding infinite_iff_countable_subset card_of_ordLeq ..
text\<open>The next two results correspond to the ZF fact that all infinite cardinals are
limit ordinals:\<close>
lemma Card_order_infinite_not_under:
-assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
-shows "\<not> (\<exists>a. Field r = under r a)"
+ assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
+ shows "\<not> (\<exists>a. Field r = under r a)"
proof(auto)
have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
- using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
+ using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
fix a assume *: "Field r = under r a"
show False
proof(cases "a \<in> Field r")
@@ -857,115 +784,113 @@
let ?r' = "Restr r (underS r a)"
assume Case2: "a \<in> Field r"
hence 1: "under r a = underS r a \<union> {a} \<and> a \<notin> underS r a"
- using 0 Refl_under_underS[of r a] underS_notIn[of a r] by blast
+ using 0 Refl_under_underS[of r a] underS_notIn[of a r] by blast
have 2: "wo_rel.ofilter r (underS r a) \<and> underS r a < Field r"
- using 0 wo_rel.underS_ofilter * 1 Case2 by fast
+ using 0 wo_rel.underS_ofilter * 1 Case2 by fast
hence "?r' <o r" using 0 using ofilter_ordLess by blast
moreover
have "Field ?r' = underS r a \<and> Well_order ?r'"
- using 2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
+ using 2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
ultimately have "|underS r a| <o r" using ordLess_Field[of ?r'] by auto
moreover have "|under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
ultimately have "|underS r a| <o |under r a|"
- using ordIso_symmetric ordLess_ordIso_trans by blast
+ using ordIso_symmetric ordLess_ordIso_trans by blast
moreover
{have "\<exists>f. bij_betw f (under r a) (underS r a)"
- using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
- hence "|under r a| =o |underS r a|" using card_of_ordIso by blast
+ using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
+ hence "|under r a| =o |underS r a|" using card_of_ordIso by blast
}
ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
qed
qed
lemma infinite_Card_order_limit:
-assumes r: "Card_order r" and "\<not>finite (Field r)"
-and a: "a \<in> Field r"
-shows "\<exists>b \<in> Field r. a \<noteq> b \<and> (a,b) \<in> r"
-proof-
+ assumes r: "Card_order r" and "\<not>finite (Field r)"
+ and a: "a \<in> Field r"
+ shows "\<exists>b \<in> Field r. a \<noteq> b \<and> (a,b) \<in> r"
+proof -
have "Field r \<noteq> under r a"
- using assms Card_order_infinite_not_under by blast
+ using assms Card_order_infinite_not_under by blast
moreover have "under r a \<le> Field r"
- using under_Field .
- ultimately have "under r a < Field r" by blast
- then obtain b where 1: "b \<in> Field r \<and> \<not> (b,a) \<in> r"
- unfolding under_def by blast
+ using under_Field .
+ ultimately obtain b where b: "b \<in> Field r \<and> \<not> (b,a) \<in> r"
+ unfolding under_def by blast
moreover have ba: "b \<noteq> a"
- using 1 r unfolding card_order_on_def well_order_on_def
- linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
+ using b r unfolding card_order_on_def well_order_on_def
+ linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
ultimately have "(a,b) \<in> r"
- using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
- total_on_def by blast
- thus ?thesis using 1 ba by auto
+ using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
+ total_on_def by blast
+ thus ?thesis using b ba by auto
qed
theorem Card_order_Times_same_infinite:
-assumes CO: "Card_order r" and INF: "\<not>finite(Field r)"
-shows "|Field r \<times> Field r| \<le>o r"
-proof-
- obtain phi where phi_def:
- "phi = (\<lambda>r::'a rel. Card_order r \<and> \<not>finite(Field r) \<and>
- \<not> |Field r \<times> Field r| \<le>o r )" by blast
+ assumes CO: "Card_order r" and INF: "\<not>finite(Field r)"
+ shows "|Field r \<times> Field r| \<le>o r"
+proof -
+ define phi where
+ "phi \<equiv> \<lambda>r::'a rel. Card_order r \<and> \<not>finite(Field r) \<and> \<not> |Field r \<times> Field r| \<le>o r"
have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
- unfolding phi_def card_order_on_def by auto
+ unfolding phi_def card_order_on_def by auto
have Ft: "\<not>(\<exists>r. phi r)"
proof
assume "\<exists>r. phi r"
hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
- using temp1 by auto
+ using temp1 by auto
then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
- 3: "Card_order r \<and> Well_order r"
- using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
+ 3: "Card_order r \<and> Well_order r"
+ using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
let ?A = "Field r" let ?r' = "bsqr r"
have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
- using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
+ using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
- using card_of_Card_order card_of_Well_order by blast
- (* *)
+ using card_of_Card_order card_of_Well_order by blast
+ (* *)
have "r <o |?A \<times> ?A|"
- using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
+ using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
moreover have "|?A \<times> ?A| \<le>o ?r'"
- using card_of_least[of "?A \<times> ?A"] 4 by auto
+ using card_of_least[of "?A \<times> ?A"] 4 by auto
ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
- unfolding ordLess_def embedS_def[abs_def]
- by (auto simp add: Field_bsqr)
+ unfolding ordLess_def embedS_def[abs_def]
+ by (auto simp add: Field_bsqr)
let ?B = "f ` ?A"
have "|?A| =o |?B|"
- using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
+ using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
- (* *)
+ (* *)
have "wo_rel.ofilter ?r' ?B"
- using 6 embed_Field_ofilter 3 4 by blast
+ using 6 embed_Field_ofilter 3 4 by blast
hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
- using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
+ using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
- using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
+ using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
have "\<not> (\<exists>a. Field r = under r a)"
- using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
+ using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
- using temp2 3 bsqr_ofilter[of r ?B] by blast
+ using temp2 3 bsqr_ofilter[of r ?B] by blast
hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
let ?r1 = "Restr r A1"
have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
moreover
{have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
- hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
+ hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
}
ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
- (* *)
+ (* *)
have "\<not> finite (Field r)" using 1 unfolding phi_def by simp
hence "\<not> finite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
hence "\<not> finite A1" using 9 finite_cartesian_product finite_subset by blast
moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
- using card_of_Card_order[of A1] card_of_Well_order[of A1]
- by (simp add: Field_card_of)
+ using card_of_Card_order[of A1] card_of_Well_order[of A1]
+ by (simp add: Field_card_of)
moreover have "\<not> r \<le>o | A1 |"
- using temp4 11 3 using not_ordLeq_iff_ordLess by blast
+ using temp4 11 3 using not_ordLeq_iff_ordLess by blast
ultimately have "\<not> finite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
- by (simp add: card_of_card_order_on)
+ by (simp add: card_of_card_order_on)
hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
- using 2 unfolding phi_def by blast
+ using 2 unfolding phi_def by blast
hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
thus False using 11 not_ordLess_ordLeq by auto
@@ -974,175 +899,175 @@
qed
corollary card_of_Times_same_infinite:
-assumes "\<not>finite A"
-shows "|A \<times> A| =o |A|"
-proof-
+ assumes "\<not>finite A"
+ shows "|A \<times> A| =o |A|"
+proof -
let ?r = "|A|"
have "Field ?r = A \<and> Card_order ?r"
- using Field_card_of card_of_Card_order[of A] by fastforce
+ using Field_card_of card_of_Card_order[of A] by fastforce
hence "|A \<times> A| \<le>o |A|"
- using Card_order_Times_same_infinite[of ?r] assms by auto
+ using Card_order_Times_same_infinite[of ?r] assms by auto
thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
qed
lemma card_of_Times_infinite:
-assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
-shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
-proof-
+ assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
+ shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
+proof -
have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
- using assms by (simp add: card_of_Times1 card_of_Times2)
+ using assms by (simp add: card_of_Times1 card_of_Times2)
moreover
{have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
- using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
- moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
- ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
- using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
+ using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
+ moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
+ ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
+ using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
}
ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
qed
corollary Card_order_Times_infinite:
-assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
- NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
-shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
-proof-
+ assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
+ NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
+ shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
+proof -
have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
- using assms by (simp add: card_of_Times_infinite card_of_mono2)
+ using assms by (simp add: card_of_Times_infinite card_of_mono2)
thus ?thesis
- using assms card_of_Field_ordIso[of r]
- ordIso_transitive[of "|Field r \<times> Field p|"]
- ordIso_transitive[of _ "|Field r|"] by blast
+ using assms card_of_Field_ordIso by (blast intro: ordIso_transitive)
qed
lemma card_of_Sigma_ordLeq_infinite:
-assumes INF: "\<not>finite B" and
- LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
-shows "|SIGMA i : I. A i| \<le>o |B|"
-proof(cases "I = {}", simp add: card_of_empty)
- assume *: "I \<noteq> {}"
+ assumes INF: "\<not>finite B" and
+ LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
+ shows "|SIGMA i : I. A i| \<le>o |B|"
+proof(cases "I = {}")
+ case False
have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
- using card_of_Sigma_mono1[OF LEQ] by blast
+ using card_of_Sigma_mono1[OF LEQ] by blast
moreover have "|I \<times> B| =o |B|"
- using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
+ using INF False LEQ_I by (auto simp add: card_of_Times_infinite)
ultimately show ?thesis using ordLeq_ordIso_trans by blast
-qed
+qed (simp add: card_of_empty)
lemma card_of_Sigma_ordLeq_infinite_Field:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
-shows "|SIGMA i : I. A i| \<le>o r"
-proof-
+ assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
+ LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
+ shows "|SIGMA i : I. A i| \<le>o r"
+proof -
let ?B = "Field r"
- have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ have 1: "r =o |?B| \<and> |?B| =o r"
+ using r card_of_Field_ordIso ordIso_symmetric by blast
hence "|I| \<le>o |?B|" "\<forall>i \<in> I. |A i| \<le>o |?B|"
- using LEQ_I LEQ ordLeq_ordIso_trans by blast+
+ using LEQ_I LEQ ordLeq_ordIso_trans by blast+
hence "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
- card_of_Sigma_ordLeq_infinite by blast
+ card_of_Sigma_ordLeq_infinite by blast
thus ?thesis using 1 ordLeq_ordIso_trans by blast
qed
lemma card_of_Times_ordLeq_infinite_Field:
-"\<lbrakk>\<not>finite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
- \<Longrightarrow> |A \<times> B| \<le>o r"
-by(simp add: card_of_Sigma_ordLeq_infinite_Field)
+ "\<lbrakk>\<not>finite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk> \<Longrightarrow> |A \<times> B| \<le>o r"
+ by(simp add: card_of_Sigma_ordLeq_infinite_Field)
lemma card_of_Times_infinite_simps:
-"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
-"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
-"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
-"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
-by (auto simp add: card_of_Times_infinite ordIso_symmetric)
+ "\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
+ "\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
+ "\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
+ "\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
+ by (auto simp add: card_of_Times_infinite ordIso_symmetric)
lemma card_of_UNION_ordLeq_infinite:
-assumes INF: "\<not>finite B" and
- LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
-shows "|\<Union>i \<in> I. A i| \<le>o |B|"
-proof(cases "I = {}", simp add: card_of_empty)
- assume *: "I \<noteq> {}"
+ assumes INF: "\<not>finite B" and LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
+ shows "|\<Union>i \<in> I. A i| \<le>o |B|"
+proof(cases "I = {}")
+ case False
have "|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
- using card_of_UNION_Sigma by blast
+ using card_of_UNION_Sigma by blast
moreover have "|SIGMA i : I. A i| \<le>o |B|"
- using assms card_of_Sigma_ordLeq_infinite by blast
+ using assms card_of_Sigma_ordLeq_infinite by blast
ultimately show ?thesis using ordLeq_transitive by blast
-qed
+qed (simp add: card_of_empty)
corollary card_of_UNION_ordLeq_infinite_Field:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
-shows "|\<Union>i \<in> I. A i| \<le>o r"
-proof-
+ assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
+ LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
+ shows "|\<Union>i \<in> I. A i| \<le>o r"
+proof -
let ?B = "Field r"
- have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ have 1: "r =o |?B| \<and> |?B| =o r"
+ using r card_of_Field_ordIso ordIso_symmetric by blast
hence "|I| \<le>o |?B|" "\<forall>i \<in> I. |A i| \<le>o |?B|"
- using LEQ_I LEQ ordLeq_ordIso_trans by blast+
+ using LEQ_I LEQ ordLeq_ordIso_trans by blast+
hence "|\<Union>i \<in> I. A i| \<le>o |?B|" using INF LEQ
- card_of_UNION_ordLeq_infinite by blast
+ card_of_UNION_ordLeq_infinite by blast
thus ?thesis using 1 ordLeq_ordIso_trans by blast
qed
lemma card_of_Plus_infinite1:
-assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
-shows "|A <+> B| =o |A|"
-proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
+ assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
+ shows "|A <+> B| =o |A|"
+proof(cases "B = {}")
+ case True
+ then show ?thesis
+ by (simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
+next
+ case False
let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b" let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
assume *: "B \<noteq> {}"
then obtain b1 where 1: "b1 \<in> B" by blast
show ?thesis
proof(cases "B = {b1}")
- assume Case1: "B = {b1}"
+ case True
have 2: "bij_betw ?Inl A ((?Inl ` A))"
- unfolding bij_betw_def inj_on_def by auto
+ unfolding bij_betw_def inj_on_def by auto
hence 3: "\<not>finite (?Inl ` A)"
- using INF bij_betw_finite[of ?Inl A] by blast
+ using INF bij_betw_finite[of ?Inl A] by blast
let ?A' = "?Inl ` A \<union> {?Inr b1}"
obtain g where "bij_betw g (?Inl ` A) ?A'"
- using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
- moreover have "?A' = A <+> B" using Case1 by blast
+ using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
+ moreover have "?A' = A <+> B" using True by blast
ultimately have "bij_betw g (?Inl ` A) (A <+> B)" by simp
hence "bij_betw (g \<circ> ?Inl) A (A <+> B)"
- using 2 by (auto simp add: bij_betw_trans)
+ using 2 by (auto simp add: bij_betw_trans)
thus ?thesis using card_of_ordIso ordIso_symmetric by blast
next
- assume Case2: "B \<noteq> {b1}"
+ case False
with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
obtain f where "inj_on f B \<and> f ` B \<le> A"
- using LEQ card_of_ordLeq[of B] by fastforce
+ using LEQ card_of_ordLeq[of B] by fastforce
with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
- unfolding inj_on_def by auto
+ unfolding inj_on_def by auto
with 3 have "|A <+> B| \<le>o |A \<times> B|"
- by (auto simp add: card_of_Plus_Times)
+ by (auto simp add: card_of_Plus_Times)
moreover have "|A \<times> B| =o |A|"
- using assms * by (simp add: card_of_Times_infinite_simps)
+ using assms * by (simp add: card_of_Times_infinite_simps)
ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by blast
thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
qed
qed
lemma card_of_Plus_infinite2:
-assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
-shows "|B <+> A| =o |A|"
-using assms card_of_Plus_commute card_of_Plus_infinite1
-ordIso_equivalence by blast
+ assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
+ shows "|B <+> A| =o |A|"
+ using assms card_of_Plus_commute card_of_Plus_infinite1
+ ordIso_equivalence by blast
lemma card_of_Plus_infinite:
-assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
-shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
-using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
+ assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
+ shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
+ using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
corollary Card_order_Plus_infinite:
-assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
- LEQ: "p \<le>o r"
-shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
-proof-
+ assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
+ LEQ: "p \<le>o r"
+ shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
+proof -
have "| Field r <+> Field p | =o | Field r | \<and>
| Field p <+> Field r | =o | Field r |"
- using assms by (simp add: card_of_Plus_infinite card_of_mono2)
+ using assms by (simp add: card_of_Plus_infinite card_of_mono2)
thus ?thesis
- using assms card_of_Field_ordIso[of r]
- ordIso_transitive[of "|Field r <+> Field p|"]
- ordIso_transitive[of _ "|Field r|"] by blast
+ using assms card_of_Field_ordIso by (blast intro: ordIso_transitive)
+
qed
@@ -1158,110 +1083,111 @@
definition "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
-where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
+ where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
lemma infinite_cartesian_product:
-assumes "\<not>finite A" "\<not>finite B"
-shows "\<not>finite (A \<times> B)"
-proof
- assume "finite (A \<times> B)"
- from assms(1) have "A \<noteq> {}" by auto
- with \<open>finite (A \<times> B)\<close> have "finite B" using finite_cartesian_productD2 by auto
- with assms(2) show False by simp
-qed
+ assumes "\<not>finite A" "\<not>finite B"
+ shows "\<not>finite (A \<times> B)"
+using assms finite_cartesian_productD2 by auto
subsubsection \<open>First as well-orders\<close>
lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
-by(unfold Field_def natLeq_def, auto)
+ by(unfold Field_def natLeq_def, auto)
lemma natLeq_Refl: "Refl natLeq"
-unfolding refl_on_def Field_def natLeq_def by auto
+ unfolding refl_on_def Field_def natLeq_def by auto
lemma natLeq_trans: "trans natLeq"
-unfolding trans_def natLeq_def by auto
+ unfolding trans_def natLeq_def by auto
lemma natLeq_Preorder: "Preorder natLeq"
-unfolding preorder_on_def
-by (auto simp add: natLeq_Refl natLeq_trans)
+ unfolding preorder_on_def
+ by (auto simp add: natLeq_Refl natLeq_trans)
lemma natLeq_antisym: "antisym natLeq"
-unfolding antisym_def natLeq_def by auto
+ unfolding antisym_def natLeq_def by auto
lemma natLeq_Partial_order: "Partial_order natLeq"
-unfolding partial_order_on_def
-by (auto simp add: natLeq_Preorder natLeq_antisym)
+ unfolding partial_order_on_def
+ by (auto simp add: natLeq_Preorder natLeq_antisym)
lemma natLeq_Total: "Total natLeq"
-unfolding total_on_def natLeq_def by auto
+ unfolding total_on_def natLeq_def by auto
lemma natLeq_Linear_order: "Linear_order natLeq"
-unfolding linear_order_on_def
-by (auto simp add: natLeq_Partial_order natLeq_Total)
+ unfolding linear_order_on_def
+ by (auto simp add: natLeq_Partial_order natLeq_Total)
lemma natLeq_natLess_Id: "natLess = natLeq - Id"
-unfolding natLeq_def natLess_def by auto
+ unfolding natLeq_def natLess_def by auto
lemma natLeq_Well_order: "Well_order natLeq"
-unfolding well_order_on_def
-using natLeq_Linear_order wf_less natLeq_natLess_Id natLeq_def natLess_def by auto
+ unfolding well_order_on_def
+ using natLeq_Linear_order wf_less natLeq_natLess_Id natLeq_def natLess_def by auto
lemma Field_natLeq_on: "Field (natLeq_on n) = {x. x < n}"
-unfolding Field_def by auto
+ unfolding Field_def by auto
lemma natLeq_underS_less: "underS natLeq n = {x. x < n}"
-unfolding underS_def natLeq_def by auto
+ unfolding underS_def natLeq_def by auto
lemma Restr_natLeq: "Restr natLeq {x. x < n} = natLeq_on n"
-unfolding natLeq_def by force
+ unfolding natLeq_def by force
lemma Restr_natLeq2:
-"Restr natLeq (underS natLeq n) = natLeq_on n"
-by (auto simp add: Restr_natLeq natLeq_underS_less)
+ "Restr natLeq (underS natLeq n) = natLeq_on n"
+ by (auto simp add: Restr_natLeq natLeq_underS_less)
lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
-using Restr_natLeq[of n] natLeq_Well_order
- Well_order_Restr[of natLeq "{x. x < n}"] by auto
+ using Restr_natLeq[of n] natLeq_Well_order
+ Well_order_Restr[of natLeq "{x. x < n}"] by auto
corollary natLeq_on_well_order_on: "well_order_on {x. x < n} (natLeq_on n)"
-using natLeq_on_Well_order Field_natLeq_on by auto
+ using natLeq_on_Well_order Field_natLeq_on by auto
lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
-unfolding wo_rel_def using natLeq_on_Well_order .
+ unfolding wo_rel_def using natLeq_on_Well_order .
subsubsection \<open>Then as cardinals\<close>
lemma natLeq_Card_order: "Card_order natLeq"
-proof(auto simp add: natLeq_Well_order
- Card_order_iff_Restr_underS Restr_natLeq2, simp add: Field_natLeq)
- fix n have "finite(Field (natLeq_on n))" by (auto simp: Field_def)
- moreover have "\<not>finite(UNIV::nat set)" by auto
- ultimately show "natLeq_on n <o |UNIV::nat set|"
- using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
- Field_card_of[of "UNIV::nat set"]
- card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
+proof -
+ have "natLeq_on n <o |UNIV::nat set|" for n
+ proof -
+ have "finite(Field (natLeq_on n))" by (auto simp: Field_def)
+ moreover have "\<not>finite(UNIV::nat set)" by auto
+ ultimately show ?thesis
+ using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
+ card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order
+ by (force simp add: Field_card_of)
+ qed
+ then show ?thesis
+ apply (simp add: natLeq_Well_order Card_order_iff_Restr_underS Restr_natLeq2)
+ apply (force simp add: Field_natLeq)
+ done
qed
corollary card_of_Field_natLeq:
-"|Field natLeq| =o natLeq"
-using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
- ordIso_symmetric[of natLeq] by blast
+ "|Field natLeq| =o natLeq"
+ using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
+ ordIso_symmetric[of natLeq] by blast
corollary card_of_nat:
-"|UNIV::nat set| =o natLeq"
-using Field_natLeq card_of_Field_natLeq by auto
+ "|UNIV::nat set| =o natLeq"
+ using Field_natLeq card_of_Field_natLeq by auto
corollary infinite_iff_natLeq_ordLeq:
-"\<not>finite A = ( natLeq \<le>o |A| )"
-using infinite_iff_card_of_nat[of A] card_of_nat
- ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
+ "\<not>finite A = ( natLeq \<le>o |A| )"
+ using infinite_iff_card_of_nat[of A] card_of_nat
+ ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
corollary finite_iff_ordLess_natLeq:
-"finite A = ( |A| <o natLeq)"
-using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
- card_of_Well_order natLeq_Well_order by blast
+ "finite A = ( |A| <o natLeq)"
+ using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
+ card_of_Well_order natLeq_Well_order by blast
subsection \<open>The successor of a cardinal\<close>
@@ -1271,169 +1197,167 @@
not require \<open>r\<close> to be a cardinal, only this case will be meaningful.\<close>
definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
-where
-"isCardSuc r r' \<equiv>
- Card_order r' \<and> r <o r' \<and>
- (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
+ where
+ "isCardSuc r r' \<equiv>
+ Card_order r' \<and> r <o r' \<and>
+ (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
text\<open>Now we introduce the cardinal-successor operator \<open>cardSuc\<close>,
by picking {\em some} cardinal-order relation fulfilling \<open>isCardSuc\<close>.
Again, the picked item shall be proved unique up to order-isomorphism.\<close>
definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
-where
-"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
+ where "cardSuc r \<equiv> SOME r'. isCardSuc r r'"
lemma exists_minim_Card_order:
-"\<lbrakk>R \<noteq> {}; \<forall>r \<in> R. Card_order r\<rbrakk> \<Longrightarrow> \<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
-unfolding card_order_on_def using exists_minim_Well_order by blast
+ "\<lbrakk>R \<noteq> {}; \<forall>r \<in> R. Card_order r\<rbrakk> \<Longrightarrow> \<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
+ unfolding card_order_on_def using exists_minim_Well_order by blast
lemma exists_isCardSuc:
-assumes "Card_order r"
-shows "\<exists>r'. isCardSuc r r'"
-proof-
+ assumes "Card_order r"
+ shows "\<exists>r'. isCardSuc r r'"
+proof -
let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
- by (simp add: card_of_Card_order Card_order_Pow)
+ by (simp add: card_of_Card_order Card_order_Pow)
then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
- using exists_minim_Card_order[of ?R] by blast
+ using exists_minim_Card_order[of ?R] by blast
thus ?thesis unfolding isCardSuc_def by auto
qed
lemma cardSuc_isCardSuc:
-assumes "Card_order r"
-shows "isCardSuc r (cardSuc r)"
-unfolding cardSuc_def using assms
-by (simp add: exists_isCardSuc someI_ex)
+ assumes "Card_order r"
+ shows "isCardSuc r (cardSuc r)"
+ unfolding cardSuc_def using assms
+ by (simp add: exists_isCardSuc someI_ex)
lemma cardSuc_Card_order:
-"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
-using cardSuc_isCardSuc unfolding isCardSuc_def by blast
+ "Card_order r \<Longrightarrow> Card_order(cardSuc r)"
+ using cardSuc_isCardSuc unfolding isCardSuc_def by blast
lemma cardSuc_greater:
-"Card_order r \<Longrightarrow> r <o cardSuc r"
-using cardSuc_isCardSuc unfolding isCardSuc_def by blast
+ "Card_order r \<Longrightarrow> r <o cardSuc r"
+ using cardSuc_isCardSuc unfolding isCardSuc_def by blast
lemma cardSuc_ordLeq:
-"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
-using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
+ "Card_order r \<Longrightarrow> r \<le>o cardSuc r"
+ using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
text\<open>The minimality property of \<open>cardSuc\<close> originally present in its definition
is local to the type \<open>'a set rel\<close>, i.e., that of \<open>cardSuc r\<close>:\<close>
lemma cardSuc_least_aux:
-"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
-using cardSuc_isCardSuc unfolding isCardSuc_def by blast
+ "\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
+ using cardSuc_isCardSuc unfolding isCardSuc_def by blast
text\<open>But from this we can infer general minimality:\<close>
lemma cardSuc_least:
-assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
-shows "cardSuc r \<le>o r'"
-proof-
+ assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
+ shows "cardSuc r \<le>o r'"
+proof -
let ?p = "cardSuc r"
have 0: "Well_order ?p \<and> Well_order r'"
- using assms cardSuc_Card_order unfolding card_order_on_def by blast
- {assume "r' <o ?p"
- then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
- using internalize_ordLess[of r' ?p] by blast
- (* *)
- have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
- moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
- ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
- hence False using 2 not_ordLess_ordLeq by blast
+ using assms cardSuc_Card_order unfolding card_order_on_def by blast
+ { assume "r' <o ?p"
+ then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
+ using internalize_ordLess[of r' ?p] by blast
+ (* *)
+ have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
+ moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
+ ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
+ hence False using 2 not_ordLess_ordLeq by blast
}
thus ?thesis using 0 ordLess_or_ordLeq by blast
qed
lemma cardSuc_ordLess_ordLeq:
-assumes CARD: "Card_order r" and CARD': "Card_order r'"
-shows "(r <o r') = (cardSuc r \<le>o r')"
-proof(auto simp add: assms cardSuc_least)
- assume "cardSuc r \<le>o r'"
- thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
-qed
+ assumes CARD: "Card_order r" and CARD': "Card_order r'"
+ shows "(r <o r') = (cardSuc r \<le>o r')"
+proof
+ show "cardSuc r \<le>o r' \<Longrightarrow> r <o r'"
+ using assms cardSuc_greater ordLess_ordLeq_trans by blast
+qed (auto simp add: assms cardSuc_least)
lemma cardSuc_ordLeq_ordLess:
-assumes CARD: "Card_order r" and CARD': "Card_order r'"
-shows "(r' <o cardSuc r) = (r' \<le>o r)"
-proof-
+ assumes CARD: "Card_order r" and CARD': "Card_order r'"
+ shows "(r' <o cardSuc r) = (r' \<le>o r)"
+proof -
have "Well_order r \<and> Well_order r'"
- using assms unfolding card_order_on_def by auto
+ using assms unfolding card_order_on_def by auto
moreover have "Well_order(cardSuc r)"
- using assms cardSuc_Card_order card_order_on_def by blast
+ using assms cardSuc_Card_order card_order_on_def by blast
ultimately show ?thesis
- using assms cardSuc_ordLess_ordLeq[of r r']
- not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
+ using assms cardSuc_ordLess_ordLeq by (blast dest: not_ordLeq_iff_ordLess)
qed
lemma cardSuc_mono_ordLeq:
-assumes CARD: "Card_order r" and CARD': "Card_order r'"
-shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
-using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
+ assumes CARD: "Card_order r" and CARD': "Card_order r'"
+ shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
+ using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
lemma cardSuc_invar_ordIso:
-assumes CARD: "Card_order r" and CARD': "Card_order r'"
-shows "(cardSuc r =o cardSuc r') = (r =o r')"
-proof-
+ assumes CARD: "Card_order r" and CARD': "Card_order r'"
+ shows "(cardSuc r =o cardSuc r') = (r =o r')"
+proof -
have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
- using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
+ using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
thus ?thesis
- using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
- using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
+ using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
+ using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
qed
lemma card_of_cardSuc_finite:
-"finite(Field(cardSuc |A| )) = finite A"
+ "finite(Field(cardSuc |A| )) = finite A"
proof
assume *: "finite (Field (cardSuc |A| ))"
have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
- using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
+ using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
hence "|A| \<le>o |Field(cardSuc |A| )|"
- using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
- ordLeq_ordIso_trans by blast
+ using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
+ ordLeq_ordIso_trans by blast
thus "finite A" using * card_of_ordLeq_finite by blast
next
assume "finite A"
then have "finite ( Field |Pow A| )" unfolding Field_card_of by simp
- then show "finite (Field (cardSuc |A| ))"
- proof (rule card_of_ordLeq_finite[OF card_of_mono2, rotated])
- show "cardSuc |A| \<le>o |Pow A|"
- by (rule iffD1[OF cardSuc_ordLess_ordLeq card_of_Pow]) (simp_all add: card_of_Card_order)
- qed
+ moreover
+ have "cardSuc |A| \<le>o |Pow A|"
+ by (rule iffD1[OF cardSuc_ordLess_ordLeq card_of_Pow]) (simp_all add: card_of_Card_order)
+ ultimately show "finite (Field (cardSuc |A| ))"
+ by (blast intro: card_of_ordLeq_finite card_of_mono2)
qed
lemma cardSuc_finite:
-assumes "Card_order r"
-shows "finite (Field (cardSuc r)) = finite (Field r)"
-proof-
+ assumes "Card_order r"
+ shows "finite (Field (cardSuc r)) = finite (Field r)"
+proof -
let ?A = "Field r"
have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
hence "cardSuc |?A| =o cardSuc r" using assms
- by (simp add: card_of_Card_order cardSuc_invar_ordIso)
+ by (simp add: card_of_Card_order cardSuc_invar_ordIso)
moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
- by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
+ by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
moreover
- {have "|Field (cardSuc r) | =o cardSuc r"
- using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
- hence "cardSuc r =o |Field (cardSuc r) |"
- using ordIso_symmetric by blast
+ { have "|Field (cardSuc r) | =o cardSuc r"
+ using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
+ hence "cardSuc r =o |Field (cardSuc r) |"
+ using ordIso_symmetric by blast
}
ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
- using ordIso_transitive by blast
+ using ordIso_transitive by blast
hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
- using card_of_ordIso_finite by blast
+ using card_of_ordIso_finite by blast
thus ?thesis by (simp only: card_of_cardSuc_finite)
qed
lemma Field_cardSuc_not_empty:
-assumes "Card_order r"
-shows "Field (cardSuc r) \<noteq> {}"
+ assumes "Card_order r"
+ shows "Field (cardSuc r) \<noteq> {}"
proof
assume "Field(cardSuc r) = {}"
then have "|Field(cardSuc r)| \<le>o r" using assms Card_order_empty[of r] by auto
then have "cardSuc r \<le>o r" using assms card_of_Field_ordIso
- cardSuc_Card_order ordIso_symmetric ordIso_ordLeq_trans by blast
+ cardSuc_Card_order ordIso_symmetric ordIso_ordLeq_trans by blast
then show False using cardSuc_greater not_ordLess_ordLeq assms by blast
qed
@@ -1487,265 +1411,263 @@
using ordLess_ordIso_trans[OF cardSuc_greater cardSuc_ordIso_card_suc] card_order_on_Card_order by blast
lemma card_of_Plus_ordLess_infinite:
-assumes INF: "\<not>finite C" and
- LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
-shows "|A <+> B| <o |C|"
+ assumes INF: "\<not>finite C" and LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
+ shows "|A <+> B| <o |C|"
proof(cases "A = {} \<or> B = {}")
- assume Case1: "A = {} \<or> B = {}"
+ case True
hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
- using card_of_Plus_empty1 card_of_Plus_empty2 by blast
+ using card_of_Plus_empty1 card_of_Plus_empty2 by blast
hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
- using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
+ using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
thus ?thesis using LESS1 LESS2
- ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
- ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
+ ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
+ ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
next
- assume Case2: "\<not>(A = {} \<or> B = {})"
- {assume *: "|C| \<le>o |A <+> B|"
- hence "\<not>finite (A <+> B)" using INF card_of_ordLeq_finite by blast
- hence 1: "\<not>finite A \<or> \<not>finite B" using finite_Plus by blast
- {assume Case21: "|A| \<le>o |B|"
- hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
- hence "|A <+> B| =o |B|" using Case2 Case21
- by (auto simp add: card_of_Plus_infinite)
- hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
- }
- moreover
- {assume Case22: "|B| \<le>o |A|"
- hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
- hence "|A <+> B| =o |A|" using Case2 Case22
- by (auto simp add: card_of_Plus_infinite)
- hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
- }
- ultimately have False using ordLeq_total card_of_Well_order[of A]
- card_of_Well_order[of B] by blast
- }
- thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
- card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
+ case False
+ have False if "|C| \<le>o |A <+> B|"
+ proof -
+ have \<section>: "\<not>finite A \<or> \<not>finite B"
+ using that INF card_of_ordLeq_finite finite_Plus by blast
+ consider "|A| \<le>o |B|" | "|B| \<le>o |A|"
+ using ordLeq_total [OF card_of_Well_order card_of_Well_order] by blast
+ then show False
+ proof cases
+ case 1
+ hence "\<not>finite B" using \<section> card_of_ordLeq_finite by blast
+ hence "|A <+> B| =o |B|" using False 1
+ by (auto simp add: card_of_Plus_infinite)
+ thus False using LESS2 not_ordLess_ordLeq that ordLeq_ordIso_trans by blast
+ next
+ case 2
+ hence "\<not>finite A" using \<section> card_of_ordLeq_finite by blast
+ hence "|A <+> B| =o |A|" using False 2
+ by (auto simp add: card_of_Plus_infinite)
+ thus False using LESS1 not_ordLess_ordLeq that ordLeq_ordIso_trans by blast
+ qed
+ qed
+ thus ?thesis
+ using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
+ card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
qed
lemma card_of_Plus_ordLess_infinite_Field:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LESS1: "|A| <o r" and LESS2: "|B| <o r"
-shows "|A <+> B| <o r"
-proof-
+ assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
+ LESS1: "|A| <o r" and LESS2: "|B| <o r"
+ shows "|A <+> B| <o r"
+proof -
let ?C = "Field r"
- have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ have 1: "r =o |?C| \<and> |?C| =o r"
+ using r card_of_Field_ordIso ordIso_symmetric by blast
hence "|A| <o |?C|" "|B| <o |?C|"
- using LESS1 LESS2 ordLess_ordIso_trans by blast+
+ using LESS1 LESS2 ordLess_ordIso_trans by blast+
hence "|A <+> B| <o |?C|" using INF
- card_of_Plus_ordLess_infinite by blast
+ card_of_Plus_ordLess_infinite by blast
thus ?thesis using 1 ordLess_ordIso_trans by blast
qed
lemma card_of_Plus_ordLeq_infinite_Field:
-assumes r: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
-and c: "Card_order r"
-shows "|A <+> B| \<le>o r"
-proof-
+ assumes r: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
+ and c: "Card_order r"
+ shows "|A <+> B| \<le>o r"
+proof -
let ?r' = "cardSuc r"
have "Card_order ?r' \<and> \<not>finite (Field ?r')" using assms
- by (simp add: cardSuc_Card_order cardSuc_finite)
+ by (simp add: cardSuc_Card_order cardSuc_finite)
moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
- by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
+ by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
ultimately have "|A <+> B| <o ?r'"
- using card_of_Plus_ordLess_infinite_Field by blast
+ using card_of_Plus_ordLess_infinite_Field by blast
thus ?thesis using c r
- by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
+ by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
qed
lemma card_of_Un_ordLeq_infinite_Field:
-assumes C: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
-and "Card_order r"
-shows "|A Un B| \<le>o r"
-using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
-ordLeq_transitive by fast
+ assumes C: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
+ and "Card_order r"
+ shows "|A Un B| \<le>o r"
+ using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
+ ordLeq_transitive by fast
lemma card_of_Un_ordLess_infinite:
-assumes INF: "\<not>finite C" and
- LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
-shows "|A \<union> B| <o |C|"
-using assms card_of_Plus_ordLess_infinite card_of_Un_Plus_ordLeq
- ordLeq_ordLess_trans by blast
+ assumes INF: "\<not>finite C" and
+ LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
+ shows "|A \<union> B| <o |C|"
+ using assms card_of_Plus_ordLess_infinite card_of_Un_Plus_ordLeq
+ ordLeq_ordLess_trans by blast
lemma card_of_Un_ordLess_infinite_Field:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LESS1: "|A| <o r" and LESS2: "|B| <o r"
-shows "|A Un B| <o r"
-proof-
+ assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
+ LESS1: "|A| <o r" and LESS2: "|B| <o r"
+ shows "|A Un B| <o r"
+proof -
let ?C = "Field r"
have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ ordIso_symmetric by blast
hence "|A| <o |?C|" "|B| <o |?C|"
- using LESS1 LESS2 ordLess_ordIso_trans by blast+
+ using LESS1 LESS2 ordLess_ordIso_trans by blast+
hence "|A Un B| <o |?C|" using INF
- card_of_Un_ordLess_infinite by blast
+ card_of_Un_ordLess_infinite by blast
thus ?thesis using 1 ordLess_ordIso_trans by blast
qed
subsection \<open>Regular cardinals\<close>
definition cofinal where
-"cofinal A r \<equiv>
- \<forall>a \<in> Field r. \<exists>b \<in> A. a \<noteq> b \<and> (a,b) \<in> r"
+ "cofinal A r \<equiv> \<forall>a \<in> Field r. \<exists>b \<in> A. a \<noteq> b \<and> (a,b) \<in> r"
definition regularCard where
-"regularCard r \<equiv>
- \<forall>K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
+ "regularCard r \<equiv> \<forall>K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
definition relChain where
-"relChain r As \<equiv>
- \<forall>i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
+ "relChain r As \<equiv> \<forall>i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
lemma regularCard_UNION:
-assumes r: "Card_order r" "regularCard r"
-and As: "relChain r As"
-and Bsub: "B \<le> (\<Union>i \<in> Field r. As i)"
-and cardB: "|B| <o r"
-shows "\<exists>i \<in> Field r. B \<le> As i"
-proof-
+ assumes r: "Card_order r" "regularCard r"
+ and As: "relChain r As"
+ and Bsub: "B \<le> (\<Union>i \<in> Field r. As i)"
+ and cardB: "|B| <o r"
+ shows "\<exists>i \<in> Field r. B \<le> As i"
+proof -
let ?phi = "\<lambda>b j. j \<in> Field r \<and> b \<in> As j"
have "\<forall>b\<in>B. \<exists>j. ?phi b j" using Bsub by blast
then obtain f where f: "\<And>b. b \<in> B \<Longrightarrow> ?phi b (f b)"
- using bchoice[of B ?phi] by blast
+ using bchoice[of B ?phi] by blast
let ?K = "f ` B"
{assume 1: "\<And>i. i \<in> Field r \<Longrightarrow> \<not> B \<le> As i"
- have 2: "cofinal ?K r"
- unfolding cofinal_def proof auto
- fix i assume i: "i \<in> Field r"
- with 1 obtain b where b: "b \<in> B \<and> b \<notin> As i" by blast
- hence "i \<noteq> f b \<and> \<not> (f b,i) \<in> r"
- using As f unfolding relChain_def by auto
- hence "i \<noteq> f b \<and> (i, f b) \<in> r" using r
- unfolding card_order_on_def well_order_on_def linear_order_on_def
- total_on_def using i f b by auto
- with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
- qed
- moreover have "?K \<le> Field r" using f by blast
- ultimately have "|?K| =o r" using 2 r unfolding regularCard_def by blast
- moreover
- {
- have "|?K| <=o |B|" using card_of_image .
- hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
- }
- ultimately have False using not_ordLess_ordIso by blast
+ have 2: "cofinal ?K r"
+ unfolding cofinal_def
+ proof (intro strip)
+ fix i assume i: "i \<in> Field r"
+ with 1 obtain b where b: "b \<in> B \<and> b \<notin> As i" by blast
+ hence "i \<noteq> f b \<and> \<not> (f b,i) \<in> r"
+ using As f unfolding relChain_def by auto
+ hence "i \<noteq> f b \<and> (i, f b) \<in> r" using r
+ unfolding card_order_on_def well_order_on_def linear_order_on_def
+ total_on_def using i f b by auto
+ with b show "\<exists>b \<in> f`B. i \<noteq> b \<and> (i,b) \<in> r" by blast
+ qed
+ moreover have "?K \<le> Field r" using f by blast
+ ultimately have "|?K| =o r" using 2 r unfolding regularCard_def by blast
+ moreover
+ have "|?K| <o r" using cardB ordLeq_ordLess_trans card_of_image by blast
+ ultimately have False using not_ordLess_ordIso by blast
}
thus ?thesis by blast
qed
lemma infinite_cardSuc_regularCard:
-assumes r_inf: "\<not>finite (Field r)" and r_card: "Card_order r"
-shows "regularCard (cardSuc r)"
-proof-
+ assumes r_inf: "\<not>finite (Field r)" and r_card: "Card_order r"
+ shows "regularCard (cardSuc r)"
+proof -
let ?r' = "cardSuc r"
- have r': "Card_order ?r'"
- "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
- using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
+ have r': "Card_order ?r'" "\<And>p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
+ using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
show ?thesis
- unfolding regularCard_def proof auto
+ unfolding regularCard_def proof auto
fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
also have 22: "|Field ?r'| =o ?r'"
- using r' by (simp add: card_of_Field_ordIso[of ?r'])
+ using r' by (simp add: card_of_Field_ordIso[of ?r'])
finally have "|K| \<le>o ?r'" .
moreover
- {let ?L = "\<Union> j \<in> K. underS ?r' j"
- let ?J = "Field r"
- have rJ: "r =o |?J|"
- using r_card card_of_Field_ordIso ordIso_symmetric by blast
- assume "|K| <o ?r'"
- hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
- hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
- moreover
- {have "\<forall>j\<in>K. |underS ?r' j| <o ?r'"
- using r' 1 by (auto simp: card_of_underS)
- hence "\<forall>j\<in>K. |underS ?r' j| \<le>o r"
- using r' card_of_Card_order by blast
- hence "\<forall>j\<in>K. |underS ?r' j| \<le>o |?J|"
- using rJ ordLeq_ordIso_trans by blast
- }
- ultimately have "|?L| \<le>o |?J|"
- using r_inf card_of_UNION_ordLeq_infinite by blast
- hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
- hence "|?L| <o ?r'" using r' card_of_Card_order by blast
- moreover
- {
- have "Field ?r' \<le> ?L"
- using 2 unfolding underS_def cofinal_def by auto
- hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
- hence "?r' \<le>o |?L|"
- using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
- }
- ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
- hence False using ordLess_irreflexive by blast
+ { let ?L = "\<Union> j \<in> K. underS ?r' j"
+ let ?J = "Field r"
+ have rJ: "r =o |?J|"
+ using r_card card_of_Field_ordIso ordIso_symmetric by blast
+ assume "|K| <o ?r'"
+ hence "|K| \<le>o r" using r' card_of_Card_order[of K] by blast
+ hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
+ moreover
+ {have "\<forall>j\<in>K. |underS ?r' j| <o ?r'"
+ using r' 1 by (auto simp: card_of_underS)
+ hence "\<forall>j\<in>K. |underS ?r' j| \<le>o r"
+ using r' card_of_Card_order by blast
+ hence "\<forall>j\<in>K. |underS ?r' j| \<le>o |?J|"
+ using rJ ordLeq_ordIso_trans by blast
+ }
+ ultimately have "|?L| \<le>o |?J|"
+ using r_inf card_of_UNION_ordLeq_infinite by blast
+ hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
+ hence "|?L| <o ?r'" using r' card_of_Card_order by blast
+ moreover
+ {
+ have "Field ?r' \<le> ?L"
+ using 2 unfolding underS_def cofinal_def by auto
+ hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
+ hence "?r' \<le>o |?L|"
+ using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
+ }
+ ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
+ hence False using ordLess_irreflexive by blast
}
ultimately show "|K| =o ?r'"
- unfolding ordLeq_iff_ordLess_or_ordIso by blast
+ unfolding ordLeq_iff_ordLess_or_ordIso by blast
qed
qed
lemma cardSuc_UNION:
-assumes r: "Card_order r" and "\<not>finite (Field r)"
-and As: "relChain (cardSuc r) As"
-and Bsub: "B \<le> (\<Union> i \<in> Field (cardSuc r). As i)"
-and cardB: "|B| <=o r"
-shows "\<exists>i \<in> Field (cardSuc r). B \<le> As i"
-proof-
+ assumes r: "Card_order r" and "\<not>finite (Field r)"
+ and As: "relChain (cardSuc r) As"
+ and Bsub: "B \<le> (\<Union> i \<in> Field (cardSuc r). As i)"
+ and cardB: "|B| \<le>o r"
+ shows "\<exists>i \<in> Field (cardSuc r). B \<le> As i"
+proof -
let ?r' = "cardSuc r"
have "Card_order ?r' \<and> |B| <o ?r'"
- using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
- card_of_Card_order by blast
+ using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
+ card_of_Card_order by blast
moreover have "regularCard ?r'"
- using assms by(simp add: infinite_cardSuc_regularCard)
+ using assms by(simp add: infinite_cardSuc_regularCard)
ultimately show ?thesis
- using As Bsub cardB regularCard_UNION by blast
+ using As Bsub cardB regularCard_UNION by blast
qed
subsection \<open>Others\<close>
lemma card_of_Func_Times:
-"|Func (A \<times> B) C| =o |Func A (Func B C)|"
-unfolding card_of_ordIso[symmetric]
-using bij_betw_curr by blast
+ "|Func (A \<times> B) C| =o |Func A (Func B C)|"
+ unfolding card_of_ordIso[symmetric]
+ using bij_betw_curr by blast
lemma card_of_Pow_Func:
-"|Pow A| =o |Func A (UNIV::bool set)|"
-proof-
- define F where [abs_def]: "F A' a =
+ "|Pow A| =o |Func A (UNIV::bool set)|"
+proof -
+ define F where [abs_def]: "F A' a \<equiv>
(if a \<in> A then (if a \<in> A' then True else False) else undefined)" for A' a
have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
- unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
+ unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: if_split_asm)
next
show "F ` Pow A = Func A UNIV"
proof safe
fix f assume f: "f \<in> Func A (UNIV::bool set)"
- show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
- let ?A1 = "{a \<in> A. f a = True}"
- show "f = F ?A1"
- unfolding F_def apply(rule ext)
- using f unfolding Func_def mem_Collect_eq by auto
+ show "f \<in> F ` Pow A"
+ unfolding image_iff
+ proof
+ show "f = F {a \<in> A. f a = True}"
+ using f unfolding Func_def F_def by force
qed auto
- qed(unfold Func_def mem_Collect_eq F_def, auto)
+ qed(unfold Func_def F_def, auto)
qed
thus ?thesis unfolding card_of_ordIso[symmetric] by blast
qed
lemma card_of_Func_UNIV:
-"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
-apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
+ "|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
+proof -
let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
- show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
- unfolding bij_betw_def inj_on_def proof safe
+ have "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
+ unfolding bij_betw_def inj_on_def
+ proof safe
fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
- hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
then obtain f where f: "\<forall> a. h a = f a" by blast
hence "range f \<subseteq> B" using h unfolding Func_def by auto
thus "h \<in> (\<lambda>f a. f a) ` {f. range f \<subseteq> B}" using f by auto
qed(unfold Func_def fun_eq_iff, auto)
+ then show ?thesis
+ by (blast intro: ordIso_symmetric card_of_ordIsoI)
qed
lemma Func_Times_Range:
@@ -1774,8 +1696,8 @@
subsection \<open>Regular vs. stable cardinals\<close>
definition stable :: "'a rel \<Rightarrow> bool"
-where
-"stable r \<equiv> \<forall>(A::'a set) (F :: 'a \<Rightarrow> 'a set).
+ where
+ "stable r \<equiv> \<forall>(A::'a set) (F :: 'a \<Rightarrow> 'a set).
|A| <o r \<and> (\<forall>a \<in> A. |F a| <o r)
\<longrightarrow> |SIGMA a : A. F a| <o r"
@@ -1793,14 +1715,13 @@
{fix a assume a: "a \<in> A"
define L where "L = {(a,u) | u. u \<in> F a}"
have fL: "f ` L \<subseteq> Field r" using f a unfolding L_def by auto
- have "|L| =o |F a|" unfolding L_def card_of_ordIso[symmetric]
- apply(rule exI[of _ snd]) unfolding bij_betw_def inj_on_def by (auto simp: image_def)
+ have "bij_betw snd {(a, u) |u. u \<in> F a} (F a)"
+ unfolding bij_betw_def inj_on_def by (auto simp: image_def)
+ then have "|L| =o |F a|" unfolding L_def card_of_ordIso[symmetric] by blast
hence "|L| <o r" using F a ordIso_ordLess_trans[of "|L|" "|F a|"] unfolding L_def by auto
hence "|f ` L| <o r" using ordLeq_ordLess_trans[OF card_of_image, of "L"] unfolding L_def by auto
hence "\<not> cofinal (f ` L) r" using reg fL unfolding regularCard_def
- apply simp
- apply (drule not_ordLess_ordIso)
- by auto
+ by (force simp add: dest: not_ordLess_ordIso)
then obtain k where k: "k \<in> Field r" and "\<forall> l \<in> L. \<not> (f l \<noteq> k \<and> (k, f l) \<in> r)"
unfolding cofinal_def image_def by auto
hence "\<exists> k \<in> Field r. \<forall> l \<in> L. (f l, k) \<in> r"
@@ -1816,11 +1737,13 @@
hence 1: "Field r \<subseteq> (\<Union>a \<in> A. under r (g a))"
using f[symmetric] unfolding under_def image_def by auto
have gA: "g ` A \<subseteq> Field r" using gg j0 unfolding Field_def g_def by auto
- moreover have "cofinal (g ` A) r" unfolding cofinal_def proof safe
+ moreover have "cofinal (g ` A) r" unfolding cofinal_def
+ proof safe
fix i assume "i \<in> Field r"
then obtain j where ij: "(i,j) \<in> r" "i \<noteq> j" using cr ir infinite_Card_order_limit by fast
hence "j \<in> Field r" using card_order_on_def cr well_order_on_domain by fast
- then obtain a where a: "a \<in> A" and j: "(j, g a) \<in> r" using 1 unfolding under_def by auto
+ then obtain a where a: "a \<in> A" and j: "(j, g a) \<in> r"
+ using 1 unfolding under_def by auto
hence "(i, g a) \<in> r" using ij wo_rel.TRANS[OF r] unfolding trans_def by blast
moreover have "i \<noteq> g a"
using ij j r unfolding wo_rel_def unfolding well_order_on_def linear_order_on_def
@@ -1836,40 +1759,40 @@
qed
lemma stable_regularCard:
-assumes cr: "Card_order r" and ir: "\<not>finite (Field r)" and st: "stable r"
-shows "regularCard r"
-unfolding regularCard_def proof safe
+ assumes cr: "Card_order r" and ir: "\<not>finite (Field r)" and st: "stable r"
+ shows "regularCard r"
+ unfolding regularCard_def proof safe
fix K assume K: "K \<subseteq> Field r" and cof: "cofinal K r"
have "|K| \<le>o r" using K card_of_Field_ordIso card_of_mono1 cr ordLeq_ordIso_trans by blast
moreover
{assume Kr: "|K| <o r"
- have x: "\<And>a. a \<in> Field r \<Longrightarrow> \<exists>b. b \<in> K \<and> a \<noteq> b \<and> (a, b) \<in> r" using cof unfolding cofinal_def by blast
- then obtain f where "\<And>a. a \<in> Field r \<Longrightarrow> f a = (SOME b. b \<in> K \<and> a \<noteq> b \<and> (a, b) \<in> r)" by simp
- then have "\<forall>a\<in>Field r. f a \<in> K \<and> a \<noteq> f a \<and> (a, f a) \<in> r" using someI_ex[OF x] by simp
- hence "Field r \<subseteq> (\<Union>a \<in> K. underS r a)" unfolding underS_def by auto
- hence "r \<le>o |\<Union>a \<in> K. underS r a|"
- using cr Card_order_iff_ordLeq_card_of card_of_mono1 ordLeq_transitive by blast
- also have "|\<Union>a \<in> K. underS r a| \<le>o |SIGMA a: K. underS r a|" by (rule card_of_UNION_Sigma)
- also
- {have "\<forall> a \<in> K. |underS r a| <o r" using K card_of_underS[OF cr] subsetD by auto
- hence "|SIGMA a: K. underS r a| <o r" using st Kr unfolding stable_def by auto
- }
- finally have "r <o r" .
- hence False using ordLess_irreflexive by blast
+ have x: "\<And>a. a \<in> Field r \<Longrightarrow> \<exists>b. b \<in> K \<and> a \<noteq> b \<and> (a, b) \<in> r" using cof unfolding cofinal_def by blast
+ then obtain f where "\<And>a. a \<in> Field r \<Longrightarrow> f a = (SOME b. b \<in> K \<and> a \<noteq> b \<and> (a, b) \<in> r)" by simp
+ then have "\<forall>a\<in>Field r. f a \<in> K \<and> a \<noteq> f a \<and> (a, f a) \<in> r" using someI_ex[OF x] by simp
+ hence "Field r \<subseteq> (\<Union>a \<in> K. underS r a)" unfolding underS_def by auto
+ hence "r \<le>o |\<Union>a \<in> K. underS r a|"
+ using cr Card_order_iff_ordLeq_card_of card_of_mono1 ordLeq_transitive by blast
+ also have "|\<Union>a \<in> K. underS r a| \<le>o |SIGMA a: K. underS r a|" by (rule card_of_UNION_Sigma)
+ also
+ {have "\<forall> a \<in> K. |underS r a| <o r" using K card_of_underS[OF cr] subsetD by auto
+ hence "|SIGMA a: K. underS r a| <o r" using st Kr unfolding stable_def by auto
+ }
+ finally have "r <o r" .
+ hence False using ordLess_irreflexive by blast
}
ultimately show "|K| =o r" using ordLeq_iff_ordLess_or_ordIso by blast
qed
lemma internalize_card_of_ordLess:
-"( |A| <o r) = (\<exists>B < Field r. |A| =o |B| \<and> |B| <o r)"
+ "( |A| <o r) = (\<exists>B < Field r. |A| =o |B| \<and> |B| <o r)"
proof
assume "|A| <o r"
then obtain p where 1: "Field p < Field r \<and> |A| =o p \<and> p <o r"
- using internalize_ordLess[of "|A|" r] by blast
+ using internalize_ordLess[of "|A|" r] by blast
hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
hence "|Field p| =o p" using card_of_Field_ordIso by blast
hence "|A| =o |Field p| \<and> |Field p| <o r"
- using 1 ordIso_equivalence ordIso_ordLess_trans by blast
+ using 1 ordIso_equivalence ordIso_ordLess_trans by blast
thus "\<exists>B < Field r. |A| =o |B| \<and> |B| <o r" using 1 by blast
next
assume "\<exists>B < Field r. |A| =o |B| \<and> |B| <o r"
@@ -1877,62 +1800,61 @@
qed
lemma card_of_Sigma_cong1:
-assumes "\<forall>i \<in> I. |A i| =o |B i|"
-shows "|SIGMA i : I. A i| =o |SIGMA i : I. B i|"
-using assms by (auto simp add: card_of_Sigma_mono1 ordIso_iff_ordLeq)
+ assumes "\<forall>i \<in> I. |A i| =o |B i|"
+ shows "|SIGMA i : I. A i| =o |SIGMA i : I. B i|"
+ using assms by (auto simp add: card_of_Sigma_mono1 ordIso_iff_ordLeq)
lemma card_of_Sigma_cong2:
-assumes "bij_betw f (I::'i set) (J::'j set)"
-shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| =o |SIGMA j : J. A j|"
-proof-
+ assumes "bij_betw f (I::'i set) (J::'j set)"
+ shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| =o |SIGMA j : J. A j|"
+proof -
let ?LEFT = "SIGMA i : I. A (f i)"
let ?RIGHT = "SIGMA j : J. A j"
- obtain u where u_def: "u = (\<lambda>(i::'i,a::'a). (f i,a))" by blast
+ define u where "u \<equiv> \<lambda>(i::'i,a::'a). (f i,a)"
have "bij_betw u ?LEFT ?RIGHT"
- using assms unfolding u_def bij_betw_def inj_on_def by auto
+ using assms unfolding u_def bij_betw_def inj_on_def by auto
thus ?thesis using card_of_ordIso by blast
qed
lemma card_of_Sigma_cong:
-assumes BIJ: "bij_betw f I J" and
- ISO: "\<forall>j \<in> J. |A j| =o |B j|"
-shows "|SIGMA i : I. A (f i)| =o |SIGMA j : J. B j|"
-proof-
+ assumes BIJ: "bij_betw f I J" and ISO: "\<forall>j \<in> J. |A j| =o |B j|"
+ shows "|SIGMA i : I. A (f i)| =o |SIGMA j : J. B j|"
+proof -
have "\<forall>i \<in> I. |A(f i)| =o |B(f i)|"
- using ISO BIJ unfolding bij_betw_def by blast
+ using ISO BIJ unfolding bij_betw_def by blast
hence "|SIGMA i : I. A (f i)| =o |SIGMA i : I. B (f i)|" by (rule card_of_Sigma_cong1)
moreover have "|SIGMA i : I. B (f i)| =o |SIGMA j : J. B j|"
- using BIJ card_of_Sigma_cong2 by blast
+ using BIJ card_of_Sigma_cong2 by blast
ultimately show ?thesis using ordIso_transitive by blast
qed
(* Note that below the types of A and F are now unconstrained: *)
lemma stable_elim:
-assumes ST: "stable r" and A_LESS: "|A| <o r" and
- F_LESS: "\<And> a. a \<in> A \<Longrightarrow> |F a| <o r"
-shows "|SIGMA a : A. F a| <o r"
-proof-
+ assumes ST: "stable r" and A_LESS: "|A| <o r" and
+ F_LESS: "\<And> a. a \<in> A \<Longrightarrow> |F a| <o r"
+ shows "|SIGMA a : A. F a| <o r"
+proof -
obtain A' where 1: "A' < Field r \<and> |A'| <o r" and 2: " |A| =o |A'|"
- using internalize_card_of_ordLess[of A r] A_LESS by blast
+ using internalize_card_of_ordLess[of A r] A_LESS by blast
then obtain G where 3: "bij_betw G A' A"
- using card_of_ordIso ordIso_symmetric by blast
- (* *)
+ using card_of_ordIso ordIso_symmetric by blast
+ (* *)
{fix a assume "a \<in> A"
- hence "\<exists>B'. B' \<le> Field r \<and> |F a| =o |B'| \<and> |B'| <o r"
- using internalize_card_of_ordLess[of "F a" r] F_LESS by blast
+ hence "\<exists>B'. B' \<le> Field r \<and> |F a| =o |B'| \<and> |B'| <o r"
+ using internalize_card_of_ordLess[of "F a" r] F_LESS by blast
}
then obtain F' where
- temp: "\<forall>a \<in> A. F' a \<le> Field r \<and> |F a| =o |F' a| \<and> |F' a| <o r"
- using bchoice[of A "\<lambda> a B'. B' \<le> Field r \<and> |F a| =o |B'| \<and> |B'| <o r"] by blast
+ temp: "\<forall>a \<in> A. F' a \<le> Field r \<and> |F a| =o |F' a| \<and> |F' a| <o r"
+ using bchoice[of A "\<lambda> a B'. B' \<le> Field r \<and> |F a| =o |B'| \<and> |B'| <o r"] by blast
hence 4: "\<forall>a \<in> A. F' a \<le> Field r \<and> |F' a| <o r" by auto
have 5: "\<forall>a \<in> A. |F' a| =o |F a|" using temp ordIso_symmetric by auto
- (* *)
+ (* *)
have "\<forall>a' \<in> A'. F'(G a') \<le> Field r \<and> |F'(G a')| <o r"
- using 3 4 bij_betw_ball[of G A' A] by auto
+ using 3 4 bij_betw_ball[of G A' A] by auto
hence "|SIGMA a' : A'. F'(G a')| <o r"
- using ST 1 unfolding stable_def by auto
+ using ST 1 unfolding stable_def by auto
moreover have "|SIGMA a' : A'. F'(G a')| =o |SIGMA a : A. F a|"
- using card_of_Sigma_cong[of G A' A F' F] 5 3 by blast
+ using card_of_Sigma_cong[of G A' A F' F] 5 3 by blast
ultimately show ?thesis using ordIso_symmetric ordIso_ordLess_trans by blast
qed
@@ -1941,57 +1863,51 @@
fix A :: "'a set" and F :: "'a \<Rightarrow> 'a set"
assume "|A| <o natLeq" and "\<forall>a\<in>A. |F a| <o natLeq"
hence "finite A \<and> (\<forall>a \<in> A. finite(F a))"
- by (auto simp add: finite_iff_ordLess_natLeq)
+ by (auto simp add: finite_iff_ordLess_natLeq)
hence "finite(Sigma A F)" by (simp only: finite_SigmaI[of A F])
thus "|Sigma A F | <o natLeq"
- by (auto simp add: finite_iff_ordLess_natLeq)
+ by (auto simp add: finite_iff_ordLess_natLeq)
qed
corollary regularCard_natLeq: "regularCard natLeq"
-using stable_regularCard[OF natLeq_Card_order _ stable_natLeq] Field_natLeq by simp
+ using stable_regularCard[OF natLeq_Card_order _ stable_natLeq] Field_natLeq by simp
lemma stable_ordIso1:
-assumes ST: "stable r" and ISO: "r' =o r"
-shows "stable r'"
+ assumes ST: "stable r" and ISO: "r' =o r"
+ shows "stable r'"
proof(unfold stable_def, auto)
fix A::"'b set" and F::"'b \<Rightarrow> 'b set"
assume "|A| <o r'" and "\<forall>a \<in> A. |F a| <o r'"
hence "( |A| <o r) \<and> (\<forall>a \<in> A. |F a| <o r)"
- using ISO ordLess_ordIso_trans by blast
+ using ISO ordLess_ordIso_trans by blast
hence "|SIGMA a : A. F a| <o r" using assms stable_elim by blast
thus "|SIGMA a : A. F a| <o r'"
- using ISO ordIso_symmetric ordLess_ordIso_trans by blast
+ using ISO ordIso_symmetric ordLess_ordIso_trans by blast
qed
lemma stable_UNION:
-assumes ST: "stable r" and A_LESS: "|A| <o r" and
- F_LESS: "\<And> a. a \<in> A \<Longrightarrow> |F a| <o r"
-shows "|\<Union>a \<in> A. F a| <o r"
-proof-
- have "|\<Union>a \<in> A. F a| \<le>o |SIGMA a : A. F a|"
- using card_of_UNION_Sigma by blast
- thus ?thesis using assms stable_elim ordLeq_ordLess_trans by blast
-qed
+ assumes "stable r" and "|A| <o r" and "\<And> a. a \<in> A \<Longrightarrow> |F a| <o r"
+ shows "|\<Union>a \<in> A. F a| <o r"
+ using assms card_of_UNION_Sigma stable_elim ordLeq_ordLess_trans by blast
corollary card_of_UNION_ordLess_infinite:
-assumes INF: "stable |B|" and
- LEQ_I: "|I| <o |B|" and LEQ: "\<forall>i \<in> I. |A i| <o |B|"
-shows "|\<Union>i \<in> I. A i| <o |B|"
+ assumes "stable |B|" and "|I| <o |B|" and "\<forall>i \<in> I. |A i| <o |B|"
+ shows "|\<Union>i \<in> I. A i| <o |B|"
using assms stable_UNION by blast
corollary card_of_UNION_ordLess_infinite_Field:
-assumes ST: "stable r" and r: "Card_order r" and
- LEQ_I: "|I| <o r" and LEQ: "\<forall>i \<in> I. |A i| <o r"
-shows "|\<Union>i \<in> I. A i| <o r"
-proof-
+ assumes ST: "stable r" and r: "Card_order r" and
+ LEQ_I: "|I| <o r" and LEQ: "\<forall>i \<in> I. |A i| <o r"
+ shows "|\<Union>i \<in> I. A i| <o r"
+proof -
let ?B = "Field r"
have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ ordIso_symmetric by blast
hence "|I| <o |?B|" "\<forall>i \<in> I. |A i| <o |?B|"
using LEQ_I LEQ ordLess_ordIso_trans by blast+
moreover have "stable |?B|" using stable_ordIso1 ST 1 by blast
ultimately have "|\<Union>i \<in> I. A i| <o |?B|" using LEQ
- card_of_UNION_ordLess_infinite by blast
+ card_of_UNION_ordLess_infinite by blast
thus ?thesis using 1 ordLess_ordIso_trans by blast
qed
--- a/src/HOL/BNF_Wellorder_Constructions.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/BNF_Wellorder_Constructions.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,7 +8,7 @@
section \<open>Constructions on Wellorders as Needed by Bounded Natural Functors\<close>
theory BNF_Wellorder_Constructions
-imports BNF_Wellorder_Embedding
+ imports BNF_Wellorder_Embedding
begin
text \<open>In this section, we study basic constructions on well-orders, such as restriction to
@@ -70,13 +70,8 @@
lemma Well_order_Restr:
assumes "Well_order r"
shows "Well_order(Restr r A)"
-proof-
- have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
- hence "wf(Restr r A - Id)" using assms
- using well_order_on_def wf_subset by blast
- thus ?thesis using assms unfolding well_order_on_def
- by (simp add: Linear_order_Restr)
-qed
+ using assms
+ by (auto simp: well_order_on_def Linear_order_Restr elim: wf_subset)
lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
by (auto simp add: Field_def)
@@ -92,7 +87,7 @@
lemma well_order_on_Restr:
assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
shows "well_order_on A (Restr r A)"
- using assms
+ using assms
using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
order_on_defs[of "Field r" r] by auto
@@ -100,12 +95,12 @@
subsection \<open>Order filters versus restrictions and embeddings\<close>
lemma Field_Restr_ofilter:
-"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
-by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
+ "\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
+ by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
lemma ofilter_Restr_under:
-assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
-shows "under (Restr r A) a = under r a"
+ assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
+ shows "under (Restr r A) a = under r a"
unfolding wo_rel.ofilter_def under_def
proof
show "{b. (b, a) \<in> Restr r A} \<subseteq> {b. (b, a) \<in> r}"
@@ -125,51 +120,51 @@
qed
lemma ofilter_embed:
-assumes "Well_order r"
-shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
+ assumes "Well_order r"
+ shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
proof
assume *: "wo_rel.ofilter r A"
show "A \<le> Field r \<and> embed (Restr r A) r id"
- unfolding embed_def
+ unfolding embed_def
proof safe
fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
- by (auto simp add: wo_rel_def wo_rel.ofilter_def)
+ by (auto simp add: wo_rel_def wo_rel.ofilter_def)
next
fix a assume "a \<in> Field (Restr r A)"
thus "bij_betw id (under (Restr r A) a) (under r (id a))" using assms *
- by (simp add: ofilter_Restr_under Field_Restr_ofilter)
+ by (simp add: ofilter_Restr_under Field_Restr_ofilter)
qed
next
assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
hence "Field(Restr r A) \<le> Field r"
- using assms embed_Field[of "Restr r A" r id] id_def
- Well_order_Restr[of r] by auto
+ using assms embed_Field[of "Restr r A" r id] id_def
+ Well_order_Restr[of r] by auto
{fix a assume "a \<in> A"
- hence "a \<in> Field(Restr r A)" using * assms
- by (simp add: order_on_defs Refl_Field_Restr2)
- hence "bij_betw id (under (Restr r A) a) (under r a)"
- using * unfolding embed_def by auto
- hence "under r a \<le> under (Restr r A) a"
- unfolding bij_betw_def by auto
- also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
- also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
- finally have "under r a \<le> A" .
+ hence "a \<in> Field(Restr r A)" using * assms
+ by (simp add: order_on_defs Refl_Field_Restr2)
+ hence "bij_betw id (under (Restr r A) a) (under r a)"
+ using * unfolding embed_def by auto
+ hence "under r a \<le> under (Restr r A) a"
+ unfolding bij_betw_def by auto
+ also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
+ also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
+ finally have "under r a \<le> A" .
}
thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
qed
lemma ofilter_Restr_Int:
-assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
-shows "wo_rel.ofilter (Restr r B) (A Int B)"
+ assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
+ shows "wo_rel.ofilter (Restr r B) (A Int B)"
proof-
let ?rB = "Restr r B"
have Well: "wo_rel r" unfolding wo_rel_def using WELL .
hence Refl: "Refl r" by (simp add: wo_rel.REFL)
hence Field: "Field ?rB = Field r Int B"
- using Refl_Field_Restr by blast
+ using Refl_Field_Restr by blast
have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
- by (simp add: Well_order_Restr wo_rel_def)
- (* Main proof *)
+ by (simp add: Well_order_Restr wo_rel_def)
+ (* Main proof *)
show ?thesis using WellB assms
unfolding wo_rel.ofilter_def under_def ofilter_def
proof safe
@@ -183,84 +178,84 @@
qed
lemma ofilter_Restr_subset:
-assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
-shows "wo_rel.ofilter (Restr r B) A"
+ assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
+ shows "wo_rel.ofilter (Restr r B) A"
proof-
have "A Int B = A" using SUB by blast
thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
qed
lemma ofilter_subset_embed:
-assumes WELL: "Well_order r" and
- OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
-shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
+ assumes WELL: "Well_order r" and
+ OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
+ shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
proof-
let ?rA = "Restr r A" let ?rB = "Restr r B"
have Well: "wo_rel r" unfolding wo_rel_def using WELL .
hence Refl: "Refl r" by (simp add: wo_rel.REFL)
hence FieldA: "Field ?rA = Field r Int A"
- using Refl_Field_Restr by blast
+ using Refl_Field_Restr by blast
have FieldB: "Field ?rB = Field r Int B"
- using Refl Refl_Field_Restr by blast
+ using Refl Refl_Field_Restr by blast
have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
- by (simp add: Well_order_Restr wo_rel_def)
+ by (simp add: Well_order_Restr wo_rel_def)
have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
- by (simp add: Well_order_Restr wo_rel_def)
- (* Main proof *)
+ by (simp add: Well_order_Restr wo_rel_def)
+ (* Main proof *)
show ?thesis
proof
assume *: "A \<le> B"
hence "wo_rel.ofilter (Restr r B) A" using assms
- by (simp add: ofilter_Restr_subset)
+ by (simp add: ofilter_Restr_subset)
hence "embed (Restr ?rB A) (Restr r B) id"
- using WellB ofilter_embed[of "?rB" A] by auto
+ using WellB ofilter_embed[of "?rB" A] by auto
thus "embed (Restr r A) (Restr r B) id"
- using * by (simp add: Restr_subset)
+ using * by (simp add: Restr_subset)
next
assume *: "embed (Restr r A) (Restr r B) id"
{fix a assume **: "a \<in> A"
- hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
- with ** FieldA have "a \<in> Field ?rA" by auto
- hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
- hence "a \<in> B" using FieldB by auto
+ hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
+ with ** FieldA have "a \<in> Field ?rA" by auto
+ hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
+ hence "a \<in> B" using FieldB by auto
}
thus "A \<le> B" by blast
qed
qed
lemma ofilter_subset_embedS_iso:
-assumes WELL: "Well_order r" and
- OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
-shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
+ assumes WELL: "Well_order r" and
+ OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
+ shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
((A = B) = (iso (Restr r A) (Restr r B) id))"
proof-
let ?rA = "Restr r A" let ?rB = "Restr r B"
have Well: "wo_rel r" unfolding wo_rel_def using WELL .
hence Refl: "Refl r" by (simp add: wo_rel.REFL)
hence "Field ?rA = Field r Int A"
- using Refl_Field_Restr by blast
+ using Refl_Field_Restr by blast
hence FieldA: "Field ?rA = A" using OFA Well
- by (auto simp add: wo_rel.ofilter_def)
+ by (auto simp add: wo_rel.ofilter_def)
have "Field ?rB = Field r Int B"
- using Refl Refl_Field_Restr by blast
+ using Refl Refl_Field_Restr by blast
hence FieldB: "Field ?rB = B" using OFB Well
- by (auto simp add: wo_rel.ofilter_def)
- (* Main proof *)
+ by (auto simp add: wo_rel.ofilter_def)
+ (* Main proof *)
show ?thesis unfolding embedS_def iso_def
- using assms ofilter_subset_embed[of r A B]
- FieldA FieldB bij_betw_id_iff[of A B] by auto
+ using assms ofilter_subset_embed[of r A B]
+ FieldA FieldB bij_betw_id_iff[of A B] by auto
qed
lemma ofilter_subset_embedS:
-assumes WELL: "Well_order r" and
- OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
-shows "(A < B) = embedS (Restr r A) (Restr r B) id"
-using assms by (simp add: ofilter_subset_embedS_iso)
+ assumes WELL: "Well_order r" and
+ OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
+ shows "(A < B) = embedS (Restr r A) (Restr r B) id"
+ using assms by (simp add: ofilter_subset_embedS_iso)
lemma embed_implies_iso_Restr:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r' r f"
-shows "iso r' (Restr r (f ` (Field r'))) f"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r' r f"
+ shows "iso r' (Restr r (f ` (Field r'))) f"
proof-
let ?A' = "Field r'"
let ?r'' = "Restr r (f ` ?A')"
@@ -268,13 +263,13 @@
have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter by blast
hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
hence "bij_betw f ?A' (Field ?r'')"
- using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
+ using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
moreover
{have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
- unfolding Field_def by auto
- hence "compat r' ?r'' f"
- using assms embed_iff_compat_inj_on_ofilter
- unfolding compat_def by blast
+ unfolding Field_def by auto
+ hence "compat r' ?r'' f"
+ using assms embed_iff_compat_inj_on_ofilter
+ unfolding compat_def by blast
}
ultimately show ?thesis using WELL' 0 iso_iff3 by blast
qed
@@ -283,13 +278,13 @@
subsection \<open>The strict inclusion on proper ofilters is well-founded\<close>
definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
-where
-"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
+ where
+ "ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
lemma wf_ofilterIncl:
-assumes WELL: "Well_order r"
-shows "wf(ofilterIncl r)"
+ assumes WELL: "Well_order r"
+ shows "wf(ofilterIncl r)"
proof-
have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
@@ -299,23 +294,23 @@
moreover
have "compat (ofilterIncl r) ?rS ?h"
proof(unfold compat_def ofilterIncl_def,
- intro allI impI, simp, elim conjE)
+ intro allI impI, simp, elim conjE)
fix A B
assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
- **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
+ **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
- 1: "A = underS r a \<and> B = underS r b"
- using Well by (auto simp add: wo_rel.ofilter_underS_Field)
+ 1: "A = underS r a \<and> B = underS r b"
+ using Well by (auto simp add: wo_rel.ofilter_underS_Field)
hence "a \<noteq> b" using *** by auto
moreover
have "(a,b) \<in> r" using 0 1 Lo ***
- by (auto simp add: underS_incl_iff)
+ by (auto simp add: underS_incl_iff)
moreover
have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
- using Well 0 1 by (simp add: wo_rel.suc_underS)
+ using Well 0 1 by (simp add: wo_rel.suc_underS)
ultimately
show "(wo_rel.suc r A, wo_rel.suc r B) \<in> r \<and> wo_rel.suc r A \<noteq> wo_rel.suc r B"
- by simp
+ by simp
qed
ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
qed
@@ -336,35 +331,35 @@
\<close>
definition ordLeq :: "('a rel * 'a' rel) set"
-where
-"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
+ where
+ "ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
-where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
+ where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
-where "r \<le>o r' \<equiv> r <=o r'"
+ where "r \<le>o r' \<equiv> r <=o r'"
definition ordLess :: "('a rel * 'a' rel) set"
-where
-"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
+ where
+ "ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
-where "r <o r' \<equiv> (r,r') \<in> ordLess"
+ where "r <o r' \<equiv> (r,r') \<in> ordLess"
definition ordIso :: "('a rel * 'a' rel) set"
-where
-"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
+ where
+ "ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
-where "r =o r' \<equiv> (r,r') \<in> ordIso"
+ where "r =o r' \<equiv> (r,r') \<in> ordIso"
lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
lemma ordLeq_Well_order_simp:
-assumes "r \<le>o r'"
-shows "Well_order r \<and> Well_order r'"
-using assms unfolding ordLeq_def by simp
+ assumes "r \<le>o r'"
+ shows "Well_order r \<and> Well_order r'"
+ using assms unfolding ordLeq_def by simp
text\<open>Notice that the relations \<open>\<le>o\<close>, \<open><o\<close>, \<open>=o\<close> connect well-orders
on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
@@ -372,360 +367,313 @@
to \<open>'a rel rel\<close>.\<close>
lemma ordLeq_reflexive:
-"Well_order r \<Longrightarrow> r \<le>o r"
-unfolding ordLeq_def using id_embed[of r] by blast
+ "Well_order r \<Longrightarrow> r \<le>o r"
+ unfolding ordLeq_def using id_embed[of r] by blast
lemma ordLeq_transitive[trans]:
-assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
-shows "r \<le>o r''"
-proof-
- obtain f and f'
- where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
- "embed r r' f" and "embed r' r'' f'"
- using * ** unfolding ordLeq_def by blast
- hence "embed r r'' (f' \<circ> f)"
- using comp_embed[of r r' f r'' f'] by auto
- thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
-qed
+ assumes "r \<le>o r'" and "r' \<le>o r''"
+ shows "r \<le>o r''"
+ using assms by (auto simp: ordLeq_def intro: comp_embed)
lemma ordLeq_total:
-"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
-unfolding ordLeq_def using wellorders_totally_ordered by blast
+ "\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
+ unfolding ordLeq_def using wellorders_totally_ordered by blast
lemma ordIso_reflexive:
-"Well_order r \<Longrightarrow> r =o r"
-unfolding ordIso_def using id_iso[of r] by blast
+ "Well_order r \<Longrightarrow> r =o r"
+ unfolding ordIso_def using id_iso[of r] by blast
lemma ordIso_transitive[trans]:
-assumes *: "r =o r'" and **: "r' =o r''"
-shows "r =o r''"
-proof-
- obtain f and f'
- where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
- "iso r r' f" and 3: "iso r' r'' f'"
- using * ** unfolding ordIso_def by auto
- hence "iso r r'' (f' \<circ> f)"
- using comp_iso[of r r' f r'' f'] by auto
- thus "r =o r''" unfolding ordIso_def using 1 by auto
-qed
+ assumes *: "r =o r'" and **: "r' =o r''"
+ shows "r =o r''"
+ using assms by (auto simp: ordIso_def intro: comp_iso)
lemma ordIso_symmetric:
-assumes *: "r =o r'"
-shows "r' =o r"
+ assumes *: "r =o r'"
+ shows "r' =o r"
proof-
obtain f where 1: "Well_order r \<and> Well_order r'" and
- 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
- using * by (auto simp add: ordIso_def iso_def)
+ 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
+ using * by (auto simp add: ordIso_def iso_def)
let ?f' = "inv_into (Field r) f"
have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
- using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
+ using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
qed
lemma ordLeq_ordLess_trans[trans]:
-assumes "r \<le>o r'" and " r' <o r''"
-shows "r <o r''"
+ assumes "r \<le>o r'" and " r' <o r''"
+ shows "r <o r''"
proof-
have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLeq_def ordLess_def by auto
+ using assms unfolding ordLeq_def ordLess_def by auto
thus ?thesis using assms unfolding ordLeq_def ordLess_def
- using embed_comp_embedS by blast
+ using embed_comp_embedS by blast
qed
lemma ordLess_ordLeq_trans[trans]:
-assumes "r <o r'" and " r' \<le>o r''"
-shows "r <o r''"
-proof-
- have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLeq_def ordLess_def by auto
- thus ?thesis using assms unfolding ordLeq_def ordLess_def
- using embedS_comp_embed by blast
-qed
+ assumes "r <o r'" and " r' \<le>o r''"
+ shows "r <o r''"
+ using embedS_comp_embed assms by (force simp: ordLeq_def ordLess_def)
lemma ordLeq_ordIso_trans[trans]:
-assumes "r \<le>o r'" and " r' =o r''"
-shows "r \<le>o r''"
-proof-
- have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLeq_def ordIso_def by auto
- thus ?thesis using assms unfolding ordLeq_def ordIso_def
- using embed_comp_iso by blast
-qed
+ assumes "r \<le>o r'" and " r' =o r''"
+ shows "r \<le>o r''"
+ using embed_comp_iso assms by (force simp: ordLeq_def ordIso_def)
lemma ordIso_ordLeq_trans[trans]:
-assumes "r =o r'" and " r' \<le>o r''"
-shows "r \<le>o r''"
-proof-
- have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLeq_def ordIso_def by auto
- thus ?thesis using assms unfolding ordLeq_def ordIso_def
- using iso_comp_embed by blast
-qed
+ assumes "r =o r'" and " r' \<le>o r''"
+ shows "r \<le>o r''"
+ using iso_comp_embed assms by (force simp: ordLeq_def ordIso_def)
lemma ordLess_ordIso_trans[trans]:
-assumes "r <o r'" and " r' =o r''"
-shows "r <o r''"
-proof-
- have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLess_def ordIso_def by auto
- thus ?thesis using assms unfolding ordLess_def ordIso_def
- using embedS_comp_iso by blast
-qed
+ assumes "r <o r'" and " r' =o r''"
+ shows "r <o r''"
+ using embedS_comp_iso assms by (force simp: ordLess_def ordIso_def)
lemma ordIso_ordLess_trans[trans]:
-assumes "r =o r'" and " r' <o r''"
-shows "r <o r''"
-proof-
- have "Well_order r \<and> Well_order r''"
- using assms unfolding ordLess_def ordIso_def by auto
- thus ?thesis using assms unfolding ordLess_def ordIso_def
- using iso_comp_embedS by blast
-qed
+ assumes "r =o r'" and " r' <o r''"
+ shows "r <o r''"
+ using iso_comp_embedS assms by (force simp: ordLess_def ordIso_def)
lemma ordLess_not_embed:
-assumes "r <o r'"
-shows "\<not>(\<exists>f'. embed r' r f')"
+ assumes "r <o r'"
+ shows "\<not>(\<exists>f'. embed r' r f')"
proof-
obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
- 3: " \<not> bij_betw f (Field r) (Field r')"
- using assms unfolding ordLess_def by (auto simp add: embedS_def)
+ 3: " \<not> bij_betw f (Field r) (Field r')"
+ using assms unfolding ordLess_def by (auto simp add: embedS_def)
{fix f' assume *: "embed r' r f'"
- hence "bij_betw f (Field r) (Field r')" using 1 2
- by (simp add: embed_bothWays_Field_bij_betw)
- with 3 have False by contradiction
+ hence "bij_betw f (Field r) (Field r')" using 1 2
+ by (simp add: embed_bothWays_Field_bij_betw)
+ with 3 have False by contradiction
}
thus ?thesis by blast
qed
lemma ordLess_Field:
-assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
-shows "\<not> (f`(Field r1) = Field r2)"
+ assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
+ shows "\<not> (f`(Field r1) = Field r2)"
proof-
let ?A1 = "Field r1" let ?A2 = "Field r2"
obtain g where
- 0: "Well_order r1 \<and> Well_order r2" and
- 1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
- using OL unfolding ordLess_def by (auto simp add: embedS_def)
+ 0: "Well_order r1 \<and> Well_order r2" and
+ 1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
+ using OL unfolding ordLess_def by (auto simp add: embedS_def)
hence "\<forall>a \<in> ?A1. f a = g a"
- using 0 EMB embed_unique[of r1] by auto
+ using 0 EMB embed_unique[of r1] by auto
hence "\<not>(bij_betw f ?A1 ?A2)"
- using 1 bij_betw_cong[of ?A1] by blast
+ using 1 bij_betw_cong[of ?A1] by blast
moreover
have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
ultimately show ?thesis by (simp add: bij_betw_def)
qed
lemma ordLess_iff:
-"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
+ "r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
proof
assume *: "r <o r'"
hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
- unfolding ordLess_def by auto
+ unfolding ordLess_def by auto
next
assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
then obtain f where 1: "embed r r' f"
- using wellorders_totally_ordered[of r r'] by blast
+ using wellorders_totally_ordered[of r r'] by blast
moreover
{assume "bij_betw f (Field r) (Field r')"
- with * 1 have "embed r' r (inv_into (Field r) f) "
- using inv_into_Field_embed_bij_betw[of r r' f] by auto
- with * have False by blast
+ with * 1 have "embed r' r (inv_into (Field r) f) "
+ using inv_into_Field_embed_bij_betw[of r r' f] by auto
+ with * have False by blast
}
ultimately show "(r,r') \<in> ordLess"
- unfolding ordLess_def using * by (fastforce simp add: embedS_def)
+ unfolding ordLess_def using * by (fastforce simp add: embedS_def)
qed
lemma ordLess_irreflexive: "\<not> r <o r"
-proof
- assume "r <o r"
- hence "Well_order r \<and> \<not>(\<exists>f. embed r r f)"
- unfolding ordLess_iff ..
- moreover have "embed r r id" using id_embed[of r] .
- ultimately show False by blast
-qed
+ using id_embed[of r] by (auto simp: ordLess_iff)
lemma ordLeq_iff_ordLess_or_ordIso:
-"r \<le>o r' = (r <o r' \<or> r =o r')"
-unfolding ordRels_def embedS_defs iso_defs by blast
+ "r \<le>o r' = (r <o r' \<or> r =o r')"
+ unfolding ordRels_def embedS_defs iso_defs by blast
lemma ordIso_iff_ordLeq:
-"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
+ "(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
proof
assume "r =o r'"
then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
embed r r' f \<and> bij_betw f (Field r) (Field r')"
- unfolding ordIso_def iso_defs by auto
+ unfolding ordIso_def iso_defs by auto
hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
- by (simp add: inv_into_Field_embed_bij_betw)
+ by (simp add: inv_into_Field_embed_bij_betw)
thus "r \<le>o r' \<and> r' \<le>o r"
- unfolding ordLeq_def using 1 by auto
+ unfolding ordLeq_def using 1 by auto
next
assume "r \<le>o r' \<and> r' \<le>o r"
then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
embed r r' f \<and> embed r' r g"
- unfolding ordLeq_def by auto
+ unfolding ordLeq_def by auto
hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
thus "r =o r'" unfolding ordIso_def using 1 by auto
qed
lemma not_ordLess_ordLeq:
-"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
-using ordLess_ordLeq_trans ordLess_irreflexive by blast
+ "r <o r' \<Longrightarrow> \<not> r' \<le>o r"
+ using ordLess_ordLeq_trans ordLess_irreflexive by blast
lemma not_ordLeq_ordLess:
-"r \<le>o r' \<Longrightarrow> \<not> r' <o r"
-using not_ordLess_ordLeq by blast
+ "r \<le>o r' \<Longrightarrow> \<not> r' <o r"
+ using not_ordLess_ordLeq by blast
lemma ordLess_or_ordLeq:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "r <o r' \<or> r' \<le>o r"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "r <o r' \<or> r' \<le>o r"
proof-
have "r \<le>o r' \<or> r' \<le>o r"
- using assms by (simp add: ordLeq_total)
+ using assms by (simp add: ordLeq_total)
moreover
{assume "\<not> r <o r' \<and> r \<le>o r'"
- hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
- hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
+ hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
+ hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
}
ultimately show ?thesis by blast
qed
lemma not_ordLess_ordIso:
-"r <o r' \<Longrightarrow> \<not> r =o r'"
-using ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
+ "r <o r' \<Longrightarrow> \<not> r =o r'"
+ using ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
lemma not_ordLeq_iff_ordLess:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(\<not> r' \<le>o r) = (r <o r')"
-using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(\<not> r' \<le>o r) = (r <o r')"
+ using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
lemma not_ordLess_iff_ordLeq:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(\<not> r' <o r) = (r \<le>o r')"
-using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(\<not> r' <o r) = (r \<le>o r')"
+ using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
lemma ordLess_transitive[trans]:
-"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
-using ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
+ "\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
+ using ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
corollary ordLess_trans: "trans ordLess"
-unfolding trans_def using ordLess_transitive by blast
+ unfolding trans_def using ordLess_transitive by blast
lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
lemma ordIso_imp_ordLeq:
-"r =o r' \<Longrightarrow> r \<le>o r'"
-using ordIso_iff_ordLeq by blast
+ "r =o r' \<Longrightarrow> r \<le>o r'"
+ using ordIso_iff_ordLeq by blast
lemma ordLess_imp_ordLeq:
-"r <o r' \<Longrightarrow> r \<le>o r'"
-using ordLeq_iff_ordLess_or_ordIso by blast
+ "r <o r' \<Longrightarrow> r \<le>o r'"
+ using ordLeq_iff_ordLess_or_ordIso by blast
lemma ofilter_subset_ordLeq:
-assumes WELL: "Well_order r" and
- OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
-shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
+ assumes WELL: "Well_order r" and
+ OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
+ shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
proof
assume "A \<le> B"
thus "Restr r A \<le>o Restr r B"
- unfolding ordLeq_def using assms
- Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
+ unfolding ordLeq_def using assms
+ Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
next
assume *: "Restr r A \<le>o Restr r B"
then obtain f where "embed (Restr r A) (Restr r B) f"
- unfolding ordLeq_def by blast
+ unfolding ordLeq_def by blast
{assume "B < A"
- hence "Restr r B <o Restr r A"
- unfolding ordLess_def using assms
- Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
- hence False using * not_ordLess_ordLeq by blast
+ hence "Restr r B <o Restr r A"
+ unfolding ordLess_def using assms
+ Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
+ hence False using * not_ordLess_ordLeq by blast
}
thus "A \<le> B" using OFA OFB WELL
- wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
+ wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
qed
lemma ofilter_subset_ordLess:
-assumes WELL: "Well_order r" and
- OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
-shows "(A < B) = (Restr r A <o Restr r B)"
+ assumes WELL: "Well_order r" and
+ OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
+ shows "(A < B) = (Restr r A <o Restr r B)"
proof-
let ?rA = "Restr r A" let ?rB = "Restr r B"
have 1: "Well_order ?rA \<and> Well_order ?rB"
- using WELL Well_order_Restr by blast
+ using WELL Well_order_Restr by blast
have "(A < B) = (\<not> B \<le> A)" using assms
- wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
+ wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
- using assms ofilter_subset_ordLeq by blast
+ using assms ofilter_subset_ordLeq by blast
also have "\<dots> = (Restr r A <o Restr r B)"
- using 1 not_ordLeq_iff_ordLess by blast
+ using 1 not_ordLeq_iff_ordLess by blast
finally show ?thesis .
qed
lemma ofilter_ordLess:
-"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
-by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
- wo_rel_def Restr_Field)
+ "\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
+ by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
+ wo_rel_def Restr_Field)
corollary underS_Restr_ordLess:
-assumes "Well_order r" and "Field r \<noteq> {}"
-shows "Restr r (underS r a) <o r"
+ assumes "Well_order r" and "Field r \<noteq> {}"
+ shows "Restr r (underS r a) <o r"
proof-
have "underS r a < Field r" using assms
- by (simp add: underS_Field3)
+ by (simp add: underS_Field3)
thus ?thesis using assms
- by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
+ by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
qed
lemma embed_ordLess_ofilterIncl:
-assumes
- OL12: "r1 <o r2" and OL23: "r2 <o r3" and
- EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
-shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
+ assumes
+ OL12: "r1 <o r2" and OL23: "r2 <o r3" and
+ EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
+ shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
proof-
have OL13: "r1 <o r3"
- using OL12 OL23 using ordLess_transitive by auto
+ using OL12 OL23 using ordLess_transitive by auto
let ?A1 = "Field r1" let ?A2 ="Field r2" let ?A3 ="Field r3"
obtain f12 g23 where
- 0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
- 1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
- 2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
- using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
+ 0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
+ 1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
+ 2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
+ using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
hence "\<forall>a \<in> ?A2. f23 a = g23 a"
- using EMB23 embed_unique[of r2 r3] by blast
+ using EMB23 embed_unique[of r2 r3] by blast
hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
- using 2 bij_betw_cong[of ?A2 f23 g23] by blast
- (* *)
+ using 2 bij_betw_cong[of ?A2 f23 g23] by blast
+ (* *)
have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
- using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
+ using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
- using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
+ using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
have 6: "wo_rel.ofilter r3 (f13 ` ?A1) \<and> f13 ` ?A1 \<noteq> ?A3"
- using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
- (* *)
+ using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
+ (* *)
have "f12 ` ?A1 < ?A2"
- using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
+ using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
moreover have "inj_on f23 ?A2"
- using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
+ using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
ultimately
have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: image_strict_mono)
moreover
{have "embed r1 r3 (f23 \<circ> f12)"
- using 1 EMB23 0 by (auto simp add: comp_embed)
- hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
- using EMB13 0 embed_unique[of r1 r3 "f23 \<circ> f12" f13] by auto
- hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
+ using 1 EMB23 0 by (auto simp add: comp_embed)
+ hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
+ using EMB13 0 embed_unique[of r1 r3 "f23 \<circ> f12" f13] by auto
+ hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
}
ultimately
have "f13 ` ?A1 < f23 ` ?A2" by simp
- (* *)
+ (* *)
with 5 6 show ?thesis
- unfolding ofilterIncl_def by auto
+ unfolding ofilterIncl_def by auto
qed
lemma ordLess_iff_ordIso_Restr:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
proof safe
fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (underS r a)"
hence "Restr r (underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
@@ -733,112 +681,107 @@
next
assume "r' <o r"
then obtain f where 1: "Well_order r \<and> Well_order r'" and
- 2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
- unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
+ 2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
+ unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
then obtain a where 3: "a \<in> Field r" and 4: "underS r a = f ` (Field r')"
- using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
+ using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
have "iso r' (Restr r (f ` (Field r'))) f"
- using embed_implies_iso_Restr 2 assms by blast
+ using embed_implies_iso_Restr 2 assms by blast
moreover have "Well_order (Restr r (f ` (Field r')))"
- using WELL Well_order_Restr by blast
+ using WELL Well_order_Restr by blast
ultimately have "r' =o Restr r (f ` (Field r'))"
- using WELL' unfolding ordIso_def by auto
+ using WELL' unfolding ordIso_def by auto
hence "r' =o Restr r (underS r a)" using 4 by auto
thus "\<exists>a \<in> Field r. r' =o Restr r (underS r a)" using 3 by auto
qed
lemma internalize_ordLess:
-"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
+ "(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
proof
assume *: "r' <o r"
hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (underS r a)"
- using ordLess_iff_ordIso_Restr by blast
+ using ordLess_iff_ordIso_Restr by blast
let ?p = "Restr r (underS r a)"
have "wo_rel.ofilter r (underS r a)" using 0
- by (simp add: wo_rel_def wo_rel.underS_ofilter)
+ by (simp add: wo_rel_def wo_rel.underS_ofilter)
hence "Field ?p = underS r a" using 0 Field_Restr_ofilter by blast
hence "Field ?p < Field r" using underS_Field2 1 by fast
moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
- ultimately
- show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
+ ultimately show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
next
assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
thus "r' <o r" using ordIso_ordLess_trans by blast
qed
lemma internalize_ordLeq:
-"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
+ "(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
proof
assume *: "r' \<le>o r"
moreover
- {assume "r' <o r"
- then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
- using internalize_ordLess[of r' r] by blast
- hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
- using ordLeq_iff_ordLess_or_ordIso by blast
- }
+ have "r' <o r \<Longrightarrow> \<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
+ using ordLeq_iff_ordLess_or_ordIso internalize_ordLess[of r' r] by blast
moreover
have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
- using ordLeq_iff_ordLess_or_ordIso by blast
+ using ordLeq_iff_ordLess_or_ordIso by blast
next
assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
qed
lemma ordLeq_iff_ordLess_Restr:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
proof safe
assume *: "r \<le>o r'"
fix a assume "a \<in> Field r"
hence "Restr r (underS r a) <o r"
- using WELL underS_Restr_ordLess[of r] by blast
+ using WELL underS_Restr_ordLess[of r] by blast
thus "Restr r (underS r a) <o r'"
- using * ordLess_ordLeq_trans by blast
+ using * ordLess_ordLeq_trans by blast
next
assume *: "\<forall>a \<in> Field r. Restr r (underS r a) <o r'"
{assume "r' <o r"
- then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
- using assms ordLess_iff_ordIso_Restr by blast
- hence False using * not_ordLess_ordIso ordIso_symmetric by blast
+ then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
+ using assms ordLess_iff_ordIso_Restr by blast
+ hence False using * not_ordLess_ordIso ordIso_symmetric by blast
}
thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
qed
lemma finite_ordLess_infinite:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
-shows "r <o r'"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
+ shows "r <o r'"
proof-
{assume "r' \<le>o r"
- then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
- unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
- hence False using finite_imageD finite_subset FIN INF by blast
+ then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
+ unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
+ hence False using finite_imageD finite_subset FIN INF by blast
}
thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
qed
lemma finite_well_order_on_ordIso:
-assumes FIN: "finite A" and
- WELL: "well_order_on A r" and WELL': "well_order_on A r'"
-shows "r =o r'"
+ assumes FIN: "finite A" and
+ WELL: "well_order_on A r" and WELL': "well_order_on A r'"
+ shows "r =o r'"
proof-
have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
- using assms well_order_on_Well_order by blast
+ using assms well_order_on_Well_order by blast
moreover
have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
\<longrightarrow> r =o r'"
proof(clarify)
fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
- using * ** well_order_on_Well_order by blast
+ using * ** well_order_on_Well_order by blast
assume "r \<le>o r'"
then obtain f where 1: "embed r r' f" and
- "inj_on f A \<and> f ` A \<le> A"
- unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
+ "inj_on f A \<and> f ` A \<le> A"
+ unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
qed
@@ -854,10 +797,10 @@
{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded.\<close>
definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
-where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
+ where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
lemma ord_to_filter_compat:
-"compat (ordLess Int (ordLess\<inverse>``{r0} \<times> ordLess\<inverse>``{r0}))
+ "compat (ordLess Int (ordLess\<inverse>``{r0} \<times> ordLess\<inverse>``{r0}))
(ofilterIncl r0)
(ord_to_filter r0)"
proof(unfold compat_def ord_to_filter_def, clarify)
@@ -867,41 +810,41 @@
let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
- by (auto simp add: ordLess_def embedS_def)
+ by (auto simp add: ordLess_def embedS_def)
hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
- using * ** by (simp add: embed_ordLess_ofilterIncl)
+ using * ** by (simp add: embed_ordLess_ofilterIncl)
qed
theorem wf_ordLess: "wf ordLess"
proof-
{fix r0 :: "('a \<times> 'a) set"
- (* need to annotate here!*)
- let ?ordLess = "ordLess::('d rel * 'd rel) set"
- let ?R = "?ordLess Int (?ordLess\<inverse>``{r0} \<times> ?ordLess\<inverse>``{r0})"
- {assume Case1: "Well_order r0"
- hence "wf ?R"
- using wf_ofilterIncl[of r0]
+ (* need to annotate here!*)
+ let ?ordLess = "ordLess::('d rel * 'd rel) set"
+ let ?R = "?ordLess Int (?ordLess\<inverse>``{r0} \<times> ?ordLess\<inverse>``{r0})"
+ {assume Case1: "Well_order r0"
+ hence "wf ?R"
+ using wf_ofilterIncl[of r0]
compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
ord_to_filter_compat[of r0] by auto
- }
- moreover
- {assume Case2: "\<not> Well_order r0"
- hence "?R = {}" unfolding ordLess_def by auto
- hence "wf ?R" using wf_empty by simp
- }
- ultimately have "wf ?R" by blast
+ }
+ moreover
+ {assume Case2: "\<not> Well_order r0"
+ hence "?R = {}" unfolding ordLess_def by auto
+ hence "wf ?R" using wf_empty by simp
+ }
+ ultimately have "wf ?R" by blast
}
thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
qed
corollary exists_minim_Well_order:
-assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
-shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
+ assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
+ shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
proof-
obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
- using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
- equals0I[of R] by blast
+ using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
+ equals0I[of R] by blast
with not_ordLeq_iff_ordLess WELL show ?thesis by blast
qed
@@ -913,79 +856,79 @@
different types.\<close>
definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
-where
-"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
+ where
+ "dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
lemma dir_image_Field:
-"Field(dir_image r f) = f ` (Field r)"
-unfolding dir_image_def Field_def Range_def Domain_def by fast
+ "Field(dir_image r f) = f ` (Field r)"
+ unfolding dir_image_def Field_def Range_def Domain_def by fast
lemma dir_image_minus_Id:
-"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
-unfolding inj_on_def Field_def dir_image_def by auto
+ "inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
+ unfolding inj_on_def Field_def dir_image_def by auto
lemma Refl_dir_image:
-assumes "Refl r"
-shows "Refl(dir_image r f)"
+ assumes "Refl r"
+ shows "Refl(dir_image r f)"
proof-
{fix a' b'
- assume "(a',b') \<in> dir_image r f"
- then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
- unfolding dir_image_def by blast
- hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
- hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
- with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
- unfolding dir_image_def by auto
+ assume "(a',b') \<in> dir_image r f"
+ then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
+ unfolding dir_image_def by blast
+ hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
+ hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
+ with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
+ unfolding dir_image_def by auto
}
thus ?thesis
- by(unfold refl_on_def Field_def Domain_def Range_def, auto)
+ by(unfold refl_on_def Field_def Domain_def Range_def, auto)
qed
lemma trans_dir_image:
-assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
-shows "trans(dir_image r f)"
-unfolding trans_def
+ assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
+ shows "trans(dir_image r f)"
+ unfolding trans_def
proof safe
fix a' b' c'
assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
- 2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
- unfolding dir_image_def by blast
+ 2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
+ unfolding dir_image_def by blast
hence "b1 \<in> Field r \<and> b2 \<in> Field r"
- unfolding Field_def by auto
+ unfolding Field_def by auto
hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
hence "(a,c) \<in> r" using 2 TRANS unfolding trans_def by blast
thus "(a',c') \<in> dir_image r f"
- unfolding dir_image_def using 1 by auto
+ unfolding dir_image_def using 1 by auto
qed
lemma Preorder_dir_image:
-"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
-by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
+ "\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
+ by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
lemma antisym_dir_image:
-assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
-shows "antisym(dir_image r f)"
-unfolding antisym_def
+ assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
+ shows "antisym(dir_image r f)"
+ unfolding antisym_def
proof safe
fix a' b'
assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
- 2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
- 3: "{a1,a2,b1,b2} \<le> Field r"
- unfolding dir_image_def Field_def by blast
+ 2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
+ 3: "{a1,a2,b1,b2} \<le> Field r"
+ unfolding dir_image_def Field_def by blast
hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
hence "a1 = b2" using 2 AN unfolding antisym_def by auto
thus "a' = b'" using 1 by auto
qed
lemma Partial_order_dir_image:
-"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
-by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
+ "\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
+ by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
lemma Total_dir_image:
-assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
-shows "Total(dir_image r f)"
+ assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
+ shows "Total(dir_image r f)"
proof(unfold total_on_def, intro ballI impI)
fix a' b'
assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
@@ -995,76 +938,76 @@
ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
- using 1 unfolding dir_image_def by auto
+ using 1 unfolding dir_image_def by auto
qed
lemma Linear_order_dir_image:
-"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
-by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
+ "\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
+ by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
lemma wf_dir_image:
-assumes WF: "wf r" and INJ: "inj_on f (Field r)"
-shows "wf(dir_image r f)"
+ assumes WF: "wf r" and INJ: "inj_on f (Field r)"
+ shows "wf(dir_image r f)"
proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
fix A'::"'b set"
assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
have "A \<noteq> {} \<and> A \<le> Field r" using A_def SUB NE by (auto simp: dir_image_Field)
then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
- using spec[OF WF[unfolded wf_eq_minimal2], of A] by blast
+ using spec[OF WF[unfolded wf_eq_minimal2], of A] by blast
have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
proof(clarify)
fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
- 3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
- using ** unfolding dir_image_def Field_def by blast
+ 3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
+ using ** unfolding dir_image_def Field_def by blast
hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
with 1 show False by auto
qed
thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
- using A_def 1 by blast
+ using A_def 1 by blast
qed
lemma Well_order_dir_image:
-"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
-unfolding well_order_on_def
-using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
- dir_image_minus_Id[of f r]
- subset_inj_on[of f "Field r" "Field(r - Id)"]
- mono_Field[of "r - Id" r] by auto
+ "\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
+ unfolding well_order_on_def
+ using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
+ dir_image_minus_Id[of f r]
+ subset_inj_on[of f "Field r" "Field(r - Id)"]
+ mono_Field[of "r - Id" r] by auto
lemma dir_image_bij_betw:
-"\<lbrakk>inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
-unfolding bij_betw_def by (simp add: dir_image_Field order_on_defs)
+ "\<lbrakk>inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
+ unfolding bij_betw_def by (simp add: dir_image_Field order_on_defs)
lemma dir_image_compat:
-"compat r (dir_image r f) f"
-unfolding compat_def dir_image_def by auto
+ "compat r (dir_image r f) f"
+ unfolding compat_def dir_image_def by auto
lemma dir_image_iso:
-"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> iso r (dir_image r f) f"
-using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
+ "\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> iso r (dir_image r f) f"
+ using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
lemma dir_image_ordIso:
-"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> r =o dir_image r f"
-unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
+ "\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> r =o dir_image r f"
+ unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
lemma Well_order_iso_copy:
-assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
-shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
+ assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
+ shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
proof-
- let ?r' = "dir_image r f"
- have 1: "A = Field r \<and> Well_order r"
- using WELL well_order_on_Well_order by blast
- hence 2: "iso r ?r' f"
- using dir_image_iso using BIJ unfolding bij_betw_def by auto
- hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
- hence "Field ?r' = A'"
- using 1 BIJ unfolding bij_betw_def by auto
- moreover have "Well_order ?r'"
- using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
- ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
+ let ?r' = "dir_image r f"
+ have 1: "A = Field r \<and> Well_order r"
+ using WELL well_order_on_Well_order by blast
+ hence 2: "iso r ?r' f"
+ using dir_image_iso using BIJ unfolding bij_betw_def by auto
+ hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
+ hence "Field ?r' = A'"
+ using 1 BIJ unfolding bij_betw_def by auto
+ moreover have "Well_order ?r'"
+ using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
+ ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
qed
@@ -1086,8 +1029,8 @@
in a product of proper filters on the original relation (assumed to be a well-order).\<close>
definition bsqr :: "'a rel => ('a * 'a)rel"
-where
-"bsqr r = {((a1,a2),(b1,b2)).
+ where
+ "bsqr r = {((a1,a2),(b1,b2)).
{a1,a2,b1,b2} \<le> Field r \<and>
(a1 = b1 \<and> a2 = b2 \<or>
(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
@@ -1096,15 +1039,15 @@
)}"
lemma Field_bsqr:
-"Field (bsqr r) = Field r \<times> Field r"
+ "Field (bsqr r) = Field r \<times> Field r"
proof
show "Field (bsqr r) \<le> Field r \<times> Field r"
proof-
{fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
- moreover
- have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
+ moreover
+ have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
- ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
+ ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
}
thus ?thesis unfolding Field_def by force
qed
@@ -1118,101 +1061,101 @@
qed
lemma bsqr_Refl: "Refl(bsqr r)"
-by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
+ by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
lemma bsqr_Trans:
-assumes "Well_order r"
-shows "trans (bsqr r)"
-unfolding trans_def
+ assumes "Well_order r"
+ shows "trans (bsqr r)"
+ unfolding trans_def
proof safe
(* Preliminary facts *)
have Well: "wo_rel r" using assms wo_rel_def by auto
hence Trans: "trans r" using wo_rel.TRANS by auto
have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
- (* Main proof *)
+ (* Main proof *)
fix a1 a2 b1 b2 c1 c2
assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
- using * unfolding bsqr_def by auto
+ using * unfolding bsqr_def by auto
have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
- using ** unfolding bsqr_def by auto
+ using ** unfolding bsqr_def by auto
show "((a1,a2),(c1,c2)) \<in> bsqr r"
proof-
{assume Case1: "a1 = b1 \<and> a2 = b2"
- hence ?thesis using ** by simp
+ hence ?thesis using ** by simp
}
moreover
{assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
- {assume Case21: "b1 = c1 \<and> b2 = c2"
- hence ?thesis using * by simp
- }
- moreover
- {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
- hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
- using Case2 TransS trans_def[of "r - Id"] by blast
- hence ?thesis using 0 unfolding bsqr_def by auto
- }
- moreover
- {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
- hence ?thesis using Case2 0 unfolding bsqr_def by auto
- }
- ultimately have ?thesis using 0 2 by auto
+ {assume Case21: "b1 = c1 \<and> b2 = c2"
+ hence ?thesis using * by simp
+ }
+ moreover
+ {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
+ hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
+ using Case2 TransS trans_def[of "r - Id"] by blast
+ hence ?thesis using 0 unfolding bsqr_def by auto
+ }
+ moreover
+ {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
+ hence ?thesis using Case2 0 unfolding bsqr_def by auto
+ }
+ ultimately have ?thesis using 0 2 by auto
}
moreover
{assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
- {assume Case31: "b1 = c1 \<and> b2 = c2"
- hence ?thesis using * by simp
- }
- moreover
- {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
- hence ?thesis using Case3 0 unfolding bsqr_def by auto
- }
- moreover
- {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
- hence "(a1,c1) \<in> r - Id"
- using Case3 TransS trans_def[of "r - Id"] by blast
- hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
- }
- moreover
- {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
- hence ?thesis using Case3 0 unfolding bsqr_def by auto
- }
- ultimately have ?thesis using 0 2 by auto
+ {assume Case31: "b1 = c1 \<and> b2 = c2"
+ hence ?thesis using * by simp
+ }
+ moreover
+ {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
+ hence ?thesis using Case3 0 unfolding bsqr_def by auto
+ }
+ moreover
+ {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
+ hence "(a1,c1) \<in> r - Id"
+ using Case3 TransS trans_def[of "r - Id"] by blast
+ hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
+ }
+ moreover
+ {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
+ hence ?thesis using Case3 0 unfolding bsqr_def by auto
+ }
+ ultimately have ?thesis using 0 2 by auto
}
moreover
{assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
- {assume Case41: "b1 = c1 \<and> b2 = c2"
- hence ?thesis using * by simp
- }
- moreover
- {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
- hence ?thesis using Case4 0 unfolding bsqr_def by force
- }
- moreover
- {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
- hence ?thesis using Case4 0 unfolding bsqr_def by auto
- }
- moreover
- {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
- hence "(a2,c2) \<in> r - Id"
- using Case4 TransS trans_def[of "r - Id"] by blast
- hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
- }
- ultimately have ?thesis using 0 2 by auto
+ {assume Case41: "b1 = c1 \<and> b2 = c2"
+ hence ?thesis using * by simp
+ }
+ moreover
+ {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
+ hence ?thesis using Case4 0 unfolding bsqr_def by force
+ }
+ moreover
+ {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
+ hence ?thesis using Case4 0 unfolding bsqr_def by auto
+ }
+ moreover
+ {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
+ hence "(a2,c2) \<in> r - Id"
+ using Case4 TransS trans_def[of "r - Id"] by blast
+ hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
+ }
+ ultimately have ?thesis using 0 2 by auto
}
ultimately show ?thesis using 0 1 by auto
qed
qed
lemma bsqr_antisym:
-assumes "Well_order r"
-shows "antisym (bsqr r)"
+ assumes "Well_order r"
+ shows "antisym (bsqr r)"
proof(unfold antisym_def, clarify)
(* Preliminary facts *)
have Well: "wo_rel r" using assms wo_rel_def by auto
@@ -1220,334 +1163,293 @@
have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
- using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
- (* Main proof *)
+ using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
+ (* Main proof *)
fix a1 a2 b1 b2
assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
- hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
- have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
+ hence "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
+ moreover
+ have "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
- using * unfolding bsqr_def by auto
- have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
+ using * unfolding bsqr_def by auto
+ moreover
+ have "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
- using ** unfolding bsqr_def by auto
- show "a1 = b1 \<and> a2 = b2"
- proof-
- {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
- {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
- hence False using Case1 IrrS by blast
- }
- moreover
- {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
- hence False using Case1 by auto
- }
- ultimately have ?thesis using 0 2 by auto
- }
- moreover
- {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
- {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
- hence False using Case2 by auto
- }
- moreover
- {assume Case22: "(b1,a1) \<in> r - Id"
- hence False using Case2 IrrS by blast
- }
- moreover
- {assume Case23: "b1 = a1"
- hence False using Case2 by auto
- }
- ultimately have ?thesis using 0 2 by auto
- }
- moreover
- {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
- moreover
- {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
- hence False using Case3 by auto
- }
- moreover
- {assume Case32: "(b1,a1) \<in> r - Id"
- hence False using Case3 by auto
- }
- moreover
- {assume Case33: "(b2,a2) \<in> r - Id"
- hence False using Case3 IrrS by blast
- }
- ultimately have ?thesis using 0 2 by auto
- }
- ultimately show ?thesis using 0 1 by blast
- qed
+ using ** unfolding bsqr_def by auto
+ ultimately show "a1 = b1 \<and> a2 = b2"
+ using IrrS by auto
qed
lemma bsqr_Total:
-assumes "Well_order r"
-shows "Total(bsqr r)"
+ assumes "Well_order r"
+ shows "Total(bsqr r)"
proof-
(* Preliminary facts *)
have Well: "wo_rel r" using assms wo_rel_def by auto
hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
- using wo_rel.TOTALS by auto
- (* Main proof *)
+ using wo_rel.TOTALS by auto
+ (* Main proof *)
{fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
- hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
- using Field_bsqr by blast
- have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
- proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
- (* Why didn't clarsimp simp add: Well 0 do the same job? *)
- assume Case1: "(a1,a2) \<in> r"
- hence 1: "wo_rel.max2 r a1 a2 = a2"
- using Well 0 by (simp add: wo_rel.max2_equals2)
- show ?thesis
- proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
- assume Case11: "(b1,b2) \<in> r"
- hence 2: "wo_rel.max2 r b1 b2 = b2"
- using Well 0 by (simp add: wo_rel.max2_equals2)
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
- assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
- thus ?thesis using 0 1 2 unfolding bsqr_def by auto
- next
- assume Case112: "a2 = b2"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
- assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
- thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
- next
- assume Case1122: "a1 = b1"
- thus ?thesis using Case112 by auto
- qed
- qed
- next
- assume Case12: "(b2,b1) \<in> r"
- hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
- assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
- thus ?thesis using 0 1 3 unfolding bsqr_def by auto
- next
- assume Case122: "a2 = b1"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
- assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
- thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
- next
- assume Case1222: "a1 = b1"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
- assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
- thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
- next
- assume Case12222: "a2 = b2"
- thus ?thesis using Case122 Case1222 by auto
- qed
- qed
- qed
- qed
- next
- assume Case2: "(a2,a1) \<in> r"
- hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
- show ?thesis
- proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
- assume Case21: "(b1,b2) \<in> r"
- hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
- assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
- thus ?thesis using 0 1 2 unfolding bsqr_def by auto
- next
- assume Case212: "a1 = b2"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
- assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
- thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
- next
- assume Case2122: "a1 = b1"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
- assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
- thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
- next
- assume Case21222: "a2 = b2"
- thus ?thesis using Case2122 Case212 by auto
- qed
- qed
- qed
- next
- assume Case22: "(b2,b1) \<in> r"
- hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
- assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
- thus ?thesis using 0 1 3 unfolding bsqr_def by auto
- next
- assume Case222: "a1 = b1"
- show ?thesis
- proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
- assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
- thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
- next
- assume Case2222: "a2 = b2"
- thus ?thesis using Case222 by auto
- qed
- qed
- qed
- qed
+ hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
+ using Field_bsqr by blast
+ have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
+ proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
+ (* Why didn't clarsimp simp add: Well 0 do the same job? *)
+ assume Case1: "(a1,a2) \<in> r"
+ hence 1: "wo_rel.max2 r a1 a2 = a2"
+ using Well 0 by (simp add: wo_rel.max2_equals2)
+ show ?thesis
+ proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case11: "(b1,b2) \<in> r"
+ hence 2: "wo_rel.max2 r b1 b2 = b2"
+ using Well 0 by (simp add: wo_rel.max2_equals2)
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
+ thus ?thesis using 0 1 2 unfolding bsqr_def by auto
+ next
+ assume Case112: "a2 = b2"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
+ assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
+ thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
+ next
+ assume Case1122: "a1 = b1"
+ thus ?thesis using Case112 by auto
+ qed
+ qed
+ next
+ assume Case12: "(b2,b1) \<in> r"
+ hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
+ assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
+ thus ?thesis using 0 1 3 unfolding bsqr_def by auto
+ next
+ assume Case122: "a2 = b1"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
+ assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
+ thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
+ next
+ assume Case1222: "a1 = b1"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
+ thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
+ next
+ assume Case12222: "a2 = b2"
+ thus ?thesis using Case122 Case1222 by auto
+ qed
+ qed
+ qed
+ qed
+ next
+ assume Case2: "(a2,a1) \<in> r"
+ hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
+ show ?thesis
+ proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case21: "(b1,b2) \<in> r"
+ hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
+ thus ?thesis using 0 1 2 unfolding bsqr_def by auto
+ next
+ assume Case212: "a1 = b2"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
+ assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
+ thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
+ next
+ assume Case2122: "a1 = b1"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
+ thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
+ next
+ assume Case21222: "a2 = b2"
+ thus ?thesis using Case2122 Case212 by auto
+ qed
+ qed
+ qed
+ next
+ assume Case22: "(b2,b1) \<in> r"
+ hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
+ assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
+ thus ?thesis using 0 1 3 unfolding bsqr_def by auto
+ next
+ assume Case222: "a1 = b1"
+ show ?thesis
+ proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
+ assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
+ thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
+ next
+ assume Case2222: "a2 = b2"
+ thus ?thesis using Case222 by auto
+ qed
+ qed
+ qed
+ qed
}
thus ?thesis unfolding total_on_def by fast
qed
lemma bsqr_Linear_order:
-assumes "Well_order r"
-shows "Linear_order(bsqr r)"
-unfolding order_on_defs
-using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
+ assumes "Well_order r"
+ shows "Linear_order(bsqr r)"
+ unfolding order_on_defs
+ using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
lemma bsqr_Well_order:
-assumes "Well_order r"
-shows "Well_order(bsqr r)"
-using assms
+ assumes "Well_order r"
+ shows "Well_order(bsqr r)"
+ using assms
proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
- using assms well_order_on_def Linear_order_Well_order_iff by blast
+ using assms well_order_on_def Linear_order_Well_order_iff by blast
fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
- (* *)
+ (* *)
obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
have "M \<noteq> {}" using 1 M_def ** by auto
moreover
have "M \<le> Field r" unfolding M_def
- using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
+ using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
- using 0 by blast
- (* *)
+ using 0 by blast
+ (* *)
obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
have "A1 \<le> Field r" unfolding A1_def using 1 by auto
moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
- using 0 by blast
- (* *)
+ using 0 by blast
+ (* *)
obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
have "A2 \<le> Field r" unfolding A2_def using 1 by auto
moreover have "A2 \<noteq> {}" unfolding A2_def
- using m_min a1_min unfolding A1_def M_def by blast
+ using m_min a1_min unfolding A1_def M_def by blast
ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
- using 0 by blast
- (* *)
+ using 0 by blast
+ (* *)
have 2: "wo_rel.max2 r a1 a2 = m"
- using a1_min a2_min unfolding A1_def A2_def by auto
+ using a1_min a2_min unfolding A1_def A2_def by auto
have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
- (* *)
+ (* *)
moreover
{fix b1 b2 assume ***: "(b1,b2) \<in> D"
- hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
- have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
- using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
- have "((a1,a2),(b1,b2)) \<in> bsqr r"
- proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
- assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
- thus ?thesis unfolding bsqr_def using 4 5 by auto
- next
- assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
- hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
- hence 6: "(a1,b1) \<in> r" using a1_min by auto
- show ?thesis
- proof(cases "a1 = b1")
- assume Case21: "a1 \<noteq> b1"
- thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
- next
- assume Case22: "a1 = b1"
- hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
- hence 7: "(a2,b2) \<in> r" using a2_min by auto
- thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
- qed
- qed
+ hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
+ have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
+ using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
+ have "((a1,a2),(b1,b2)) \<in> bsqr r"
+ proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
+ assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
+ thus ?thesis unfolding bsqr_def using 4 5 by auto
+ next
+ assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
+ hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
+ hence 6: "(a1,b1) \<in> r" using a1_min by auto
+ show ?thesis
+ proof(cases "a1 = b1")
+ assume Case21: "a1 \<noteq> b1"
+ thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
+ next
+ assume Case22: "a1 = b1"
+ hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
+ hence 7: "(a2,b2) \<in> r" using a2_min by auto
+ thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
+ qed
+ qed
}
- (* *)
+ (* *)
ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
qed
lemma bsqr_max2:
-assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
-shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
+ assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
+ shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
proof-
have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
- using LEQ unfolding Field_def by auto
+ using LEQ unfolding Field_def by auto
hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
- using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
+ using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
moreover have "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r \<or> wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
- using LEQ unfolding bsqr_def by auto
+ using LEQ unfolding bsqr_def by auto
ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
qed
lemma bsqr_ofilter:
-assumes WELL: "Well_order r" and
- OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
- NE: "\<not> (\<exists>a. Field r = under r a)"
-shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
+ assumes WELL: "Well_order r" and
+ OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
+ NE: "\<not> (\<exists>a. Field r = under r a)"
+ shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
proof-
let ?r' = "bsqr r"
have Well: "wo_rel r" using WELL wo_rel_def by blast
hence Trans: "trans r" using wo_rel.TRANS by blast
have Well': "Well_order ?r' \<and> wo_rel ?r'"
- using WELL bsqr_Well_order wo_rel_def by blast
- (* *)
+ using WELL bsqr_Well_order wo_rel_def by blast
+ (* *)
have "D < Field ?r'" unfolding Field_bsqr using SUB .
with OF obtain a1 and a2 where
- "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
- using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
+ "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
+ using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
let ?m = "wo_rel.max2 r a1 a2"
have "D \<le> (under r ?m) \<times> (under r ?m)"
proof(unfold 1)
{fix b1 b2
- let ?n = "wo_rel.max2 r b1 b2"
- assume "(b1,b2) \<in> underS ?r' (a1,a2)"
- hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
- unfolding underS_def by blast
- hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
- moreover
- {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
- hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
- hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
- using Well by (simp add: wo_rel.max2_greater)
- }
- ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
- using Trans trans_def[of r] by blast
- hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
- thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
+ let ?n = "wo_rel.max2 r b1 b2"
+ assume "(b1,b2) \<in> underS ?r' (a1,a2)"
+ hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
+ unfolding underS_def by blast
+ hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
+ moreover
+ {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
+ hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
+ hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
+ using Well by (simp add: wo_rel.max2_greater)
+ }
+ ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
+ using Trans trans_def[of r] by blast
+ hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
+ thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
qed
moreover have "wo_rel.ofilter r (under r ?m)"
- using Well by (simp add: wo_rel.under_ofilter)
+ using Well by (simp add: wo_rel.under_ofilter)
moreover have "under r ?m < Field r"
- using NE under_Field[of r ?m] by blast
+ using NE under_Field[of r ?m] by blast
ultimately show ?thesis by blast
qed
definition Func where
-"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
+ "Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
lemma Func_empty:
-"Func {} B = {\<lambda>x. undefined}"
-unfolding Func_def by auto
+ "Func {} B = {\<lambda>x. undefined}"
+ unfolding Func_def by auto
lemma Func_elim:
-assumes "g \<in> Func A B" and "a \<in> A"
-shows "\<exists> b. b \<in> B \<and> g a = b"
-using assms unfolding Func_def by (cases "g a = undefined") auto
+ assumes "g \<in> Func A B" and "a \<in> A"
+ shows "\<exists> b. b \<in> B \<and> g a = b"
+ using assms unfolding Func_def by (cases "g a = undefined") auto
definition curr where
-"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
+ "curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
lemma curr_in:
-assumes f: "f \<in> Func (A \<times> B) C"
-shows "curr A f \<in> Func A (Func B C)"
-using assms unfolding curr_def Func_def by auto
+ assumes f: "f \<in> Func (A \<times> B) C"
+ shows "curr A f \<in> Func A (Func B C)"
+ using assms unfolding curr_def Func_def by auto
lemma curr_inj:
-assumes "f1 \<in> Func (A \<times> B) C" and "f2 \<in> Func (A \<times> B) C"
-shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
+ assumes "f1 \<in> Func (A \<times> B) C" and "f2 \<in> Func (A \<times> B) C"
+ shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
proof safe
assume c: "curr A f1 = curr A f2"
show "f1 = f2"
@@ -1559,14 +1461,14 @@
next
case True hence a: "a \<in> A" and b: "b \<in> B" by auto
thus ?thesis
- using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
+ using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
qed
qed
qed
lemma curr_surj:
-assumes "g \<in> Func A (Func B C)"
-shows "\<exists> f \<in> Func (A \<times> B) C. curr A f = g"
+ assumes "g \<in> Func A (Func B C)"
+ shows "\<exists> f \<in> Func (A \<times> B) C. curr A f = g"
proof
let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
show "curr A ?f = g"
@@ -1579,7 +1481,7 @@
next
case True
obtain g1 where "g1 \<in> Func B C" and "g a = g1"
- using assms using Func_elim[OF assms True] by blast
+ using assms using Func_elim[OF assms True] by blast
thus ?thesis using True unfolding Func_def curr_def by auto
qed
qed
@@ -1587,24 +1489,21 @@
qed
lemma bij_betw_curr:
-"bij_betw (curr A) (Func (A \<times> B) C) (Func A (Func B C))"
- unfolding bij_betw_def inj_on_def image_def
- apply (intro impI conjI ballI)
- apply (erule curr_inj[THEN iffD1], assumption+, safe)
- using curr_surj curr_in apply blast+
- done
+ "bij_betw (curr A) (Func (A \<times> B) C) (Func A (Func B C))"
+ unfolding bij_betw_def inj_on_def
+ using curr_surj curr_in curr_inj by blast
definition Func_map where
-"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
+ "Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
lemma Func_map:
-assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
-shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
-using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
+ assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
+ shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
+ using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
lemma Func_non_emp:
-assumes "B \<noteq> {}"
-shows "Func A B \<noteq> {}"
+ assumes "B \<noteq> {}"
+ shows "Func A B \<noteq> {}"
proof-
obtain b where b: "b \<in> B" using assms by auto
hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
@@ -1612,27 +1511,21 @@
qed
lemma Func_is_emp:
-"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
+ "Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
proof
- assume L: ?L
- moreover {assume "A = {}" hence False using L Func_empty by auto}
- moreover {assume "B \<noteq> {}" hence False using L Func_non_emp[of B A] by simp }
- ultimately show ?R by blast
+ assume ?L
+ then show ?R
+ using Func_empty Func_non_emp[of B A] by blast
next
- assume R: ?R
- moreover
- {fix f assume "f \<in> Func A B"
- moreover obtain a where "a \<in> A" using R by blast
- ultimately obtain b where "b \<in> B" unfolding Func_def by blast
- with R have False by blast
- }
- thus ?L by blast
+ assume ?R
+ then show ?L
+ using Func_empty Func_non_emp[of B A] by (auto simp: Func_def)
qed
lemma Func_map_surj:
-assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
-and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
-shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
+ assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
+ and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
+ shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
proof(cases "B2 = {}")
case True
thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
@@ -1646,15 +1539,15 @@
then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2"
by atomize_elim (rule bchoice)
{fix b2 assume b2: "b2 \<in> B2"
- hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
- moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
- ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
+ hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
+ moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
+ ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
} note kk = this
obtain b22 where b22: "b22 \<in> B2" using B2 by auto
define j2 where [abs_def]: "j2 a2 = (if a2 \<in> f2 ` B2 then k a2 else b22)" for a2
have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
- using kk unfolding j2_def by auto
+ using kk unfolding j2_def by auto
define g where "g = Func_map A2 j1 j2 h"
have "Func_map B2 f1 f2 g = h"
proof (rule ext)
@@ -1668,13 +1561,13 @@
show ?thesis using A2 f_inv_into_f[OF b1]
unfolding True g_def Func_map_def j1_def j2[OF \<open>b2 \<in> B2\<close>] by auto
qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
- auto intro: f_inv_into_f)
+ auto intro: f_inv_into_f)
qed(insert h, unfold Func_def Func_map_def, auto)
qed
moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
- using j2A2 B1 A2 unfolding j1_def by (fast intro: inv_into_into)+
+ using j2A2 B1 A2 unfolding j1_def by (fast intro: inv_into_into)+
ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
- unfolding Func_map_def[abs_def] by auto
+ unfolding Func_map_def[abs_def] by auto
qed(use B1 Func_map[OF _ _ A2(2)] in auto)
qed
--- a/src/HOL/BNF_Wellorder_Embedding.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/BNF_Wellorder_Embedding.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,7 +8,7 @@
section \<open>Well-Order Embeddings as Needed by Bounded Natural Functors\<close>
theory BNF_Wellorder_Embedding
-imports Hilbert_Choice BNF_Wellorder_Relation
+ imports Hilbert_Choice BNF_Wellorder_Relation
begin
text\<open>In this section, we introduce well-order {\em embeddings} and {\em isomorphisms} and
@@ -23,35 +23,35 @@
subsection \<open>Auxiliaries\<close>
lemma UNION_inj_on_ofilter:
-assumes WELL: "Well_order r" and
- OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
- INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
-shows "inj_on f (\<Union>i \<in> I. A i)"
+ assumes WELL: "Well_order r" and
+ OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
+ INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
+ shows "inj_on f (\<Union>i \<in> I. A i)"
proof-
have "wo_rel r" using WELL by (simp add: wo_rel_def)
hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i <= A j \<or> A j <= A i"
- using wo_rel.ofilter_linord[of r] OF by blast
+ using wo_rel.ofilter_linord[of r] OF by blast
with WELL INJ show ?thesis
- by (auto simp add: inj_on_UNION_chain)
+ by (auto simp add: inj_on_UNION_chain)
qed
lemma under_underS_bij_betw:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
- BIJ: "bij_betw f (underS r a) (underS r' (f a))"
-shows "bij_betw f (under r a) (under r' (f a))"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
+ BIJ: "bij_betw f (underS r a) (underS r' (f a))"
+ shows "bij_betw f (under r a) (under r' (f a))"
proof-
have "a \<notin> underS r a \<and> f a \<notin> underS r' (f a)"
- unfolding underS_def by auto
+ unfolding underS_def by auto
moreover
{have "Refl r \<and> Refl r'" using WELL WELL'
- by (auto simp add: order_on_defs)
- hence "under r a = underS r a \<union> {a} \<and>
+ by (auto simp add: order_on_defs)
+ hence "under r a = underS r a \<union> {a} \<and>
under r' (f a) = underS r' (f a) \<union> {f a}"
- using IN IN' by(auto simp add: Refl_under_underS)
+ using IN IN' by(auto simp add: Refl_under_underS)
}
ultimately show ?thesis
- using BIJ notIn_Un_bij_betw[of a "underS r a" f "underS r' (f a)"] by auto
+ using BIJ notIn_Un_bij_betw[of a "underS r a" f "underS r' (f a)"] by auto
qed
@@ -69,28 +69,28 @@
and an isomorphism (operator \<open>iso\<close>) is a bijective embedding.\<close>
definition embed :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
-where
-"embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (under r a) (under r' (f a))"
+ where
+ "embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (under r a) (under r' (f a))"
lemmas embed_defs = embed_def embed_def[abs_def]
text \<open>Strict embeddings:\<close>
definition embedS :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
-where
-"embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
+ where
+ "embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
lemmas embedS_defs = embedS_def embedS_def[abs_def]
definition iso :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
-where
-"iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
+ where
+ "iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
lemmas iso_defs = iso_def iso_def[abs_def]
definition compat :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
-where
-"compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
+ where
+ "compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
lemma compat_wf:
assumes CMP: "compat r r' f" and WF: "wf r'"
@@ -168,46 +168,46 @@
by (auto simp add: embed_in_Field)
lemma embed_preserves_ofilter:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
-shows "wo_rel.ofilter r' (f`A)"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
+ shows "wo_rel.ofilter r' (f`A)"
proof-
(* Preliminary facts *)
from WELL have Well: "wo_rel r" unfolding wo_rel_def .
from WELL' have Well': "wo_rel r'" unfolding wo_rel_def .
from OF have 0: "A \<le> Field r" by(auto simp add: Well wo_rel.ofilter_def)
- (* Main proof *)
+ (* Main proof *)
show ?thesis using Well' WELL EMB 0 embed_Field[of r r' f]
proof(unfold wo_rel.ofilter_def, auto simp add: image_def)
fix a b'
assume *: "a \<in> A" and **: "b' \<in> under r' (f a)"
hence "a \<in> Field r" using 0 by auto
hence "bij_betw f (under r a) (under r' (f a))"
- using * EMB by (auto simp add: embed_def)
+ using * EMB by (auto simp add: embed_def)
hence "f`(under r a) = under r' (f a)"
- by (simp add: bij_betw_def)
+ by (simp add: bij_betw_def)
with ** image_def[of f "under r a"] obtain b where
- 1: "b \<in> under r a \<and> b' = f b" by blast
+ 1: "b \<in> under r a \<and> b' = f b" by blast
hence "b \<in> A" using Well * OF
- by (auto simp add: wo_rel.ofilter_def)
+ by (auto simp add: wo_rel.ofilter_def)
with 1 show "\<exists>b \<in> A. b' = f b" by blast
qed
qed
lemma embed_Field_ofilter:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f"
-shows "wo_rel.ofilter r' (f`(Field r))"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f"
+ shows "wo_rel.ofilter r' (f`(Field r))"
proof-
have "wo_rel.ofilter r (Field r)"
- using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
+ using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
with WELL WELL' EMB
show ?thesis by (auto simp add: embed_preserves_ofilter)
qed
lemma embed_inj_on:
-assumes WELL: "Well_order r" and EMB: "embed r r' f"
-shows "inj_on f (Field r)"
+ assumes WELL: "Well_order r" and EMB: "embed r r' f"
+ shows "inj_on f (Field r)"
proof(unfold inj_on_def, clarify)
(* Preliminary facts *)
from WELL have Well: "wo_rel r" unfolding wo_rel_def .
@@ -215,30 +215,30 @@
have Total: "Total r" by simp
from Well wo_rel.REFL[of r]
have Refl: "Refl r" by simp
- (* Main proof *)
+ (* Main proof *)
fix a b
assume *: "a \<in> Field r" and **: "b \<in> Field r" and
- ***: "f a = f b"
+ ***: "f a = f b"
hence 1: "a \<in> Field r \<and> b \<in> Field r"
- unfolding Field_def by auto
+ unfolding Field_def by auto
{assume "(a,b) \<in> r"
- hence "a \<in> under r b \<and> b \<in> under r b"
- using Refl by(auto simp add: under_def refl_on_def)
- hence "a = b"
- using EMB 1 ***
- by (auto simp add: embed_def bij_betw_def inj_on_def)
+ hence "a \<in> under r b \<and> b \<in> under r b"
+ using Refl by(auto simp add: under_def refl_on_def)
+ hence "a = b"
+ using EMB 1 ***
+ by (auto simp add: embed_def bij_betw_def inj_on_def)
}
moreover
{assume "(b,a) \<in> r"
- hence "a \<in> under r a \<and> b \<in> under r a"
- using Refl by(auto simp add: under_def refl_on_def)
- hence "a = b"
- using EMB 1 ***
- by (auto simp add: embed_def bij_betw_def inj_on_def)
+ hence "a \<in> under r a \<and> b \<in> under r a"
+ using Refl by(auto simp add: under_def refl_on_def)
+ hence "a = b"
+ using EMB 1 ***
+ by (auto simp add: embed_def bij_betw_def inj_on_def)
}
ultimately
show "a = b" using Total 1
- by (auto simp add: total_on_def)
+ by (auto simp add: total_on_def)
qed
lemma embed_underS:
@@ -265,173 +265,173 @@
qed
lemma embed_iff_compat_inj_on_ofilter:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
-using assms
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
+ using assms
proof(auto simp add: embed_compat embed_inj_on embed_Field_ofilter,
- unfold embed_def, auto) (* get rid of one implication *)
+ unfold embed_def, auto) (* get rid of one implication *)
fix a
assume *: "inj_on f (Field r)" and
- **: "compat r r' f" and
- ***: "wo_rel.ofilter r' (f`(Field r))" and
- ****: "a \<in> Field r"
- (* Preliminary facts *)
+ **: "compat r r' f" and
+ ***: "wo_rel.ofilter r' (f`(Field r))" and
+ ****: "a \<in> Field r"
+ (* Preliminary facts *)
have Well: "wo_rel r"
- using WELL wo_rel_def[of r] by simp
+ using WELL wo_rel_def[of r] by simp
hence Refl: "Refl r"
- using wo_rel.REFL[of r] by simp
+ using wo_rel.REFL[of r] by simp
have Total: "Total r"
- using Well wo_rel.TOTAL[of r] by simp
+ using Well wo_rel.TOTAL[of r] by simp
have Well': "wo_rel r'"
- using WELL' wo_rel_def[of r'] by simp
+ using WELL' wo_rel_def[of r'] by simp
hence Antisym': "antisym r'"
- using wo_rel.ANTISYM[of r'] by simp
+ using wo_rel.ANTISYM[of r'] by simp
have "(a,a) \<in> r"
- using **** Well wo_rel.REFL[of r]
- refl_on_def[of _ r] by auto
+ using **** Well wo_rel.REFL[of r]
+ refl_on_def[of _ r] by auto
hence "(f a, f a) \<in> r'"
- using ** by(auto simp add: compat_def)
+ using ** by(auto simp add: compat_def)
hence 0: "f a \<in> Field r'"
- unfolding Field_def by auto
+ unfolding Field_def by auto
have "f a \<in> f`(Field r)"
- using **** by auto
+ using **** by auto
hence 2: "under r' (f a) \<le> f`(Field r)"
- using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
- (* Main proof *)
+ using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
+ (* Main proof *)
show "bij_betw f (under r a) (under r' (f a))"
proof(unfold bij_betw_def, auto)
show "inj_on f (under r a)" by (rule subset_inj_on[OF * under_Field])
next
fix b assume "b \<in> under r a"
thus "f b \<in> under r' (f a)"
- unfolding under_def using **
- by (auto simp add: compat_def)
+ unfolding under_def using **
+ by (auto simp add: compat_def)
next
fix b' assume *****: "b' \<in> under r' (f a)"
hence "b' \<in> f`(Field r)"
- using 2 by auto
+ using 2 by auto
with Field_def[of r] obtain b where
- 3: "b \<in> Field r" and 4: "b' = f b" by auto
+ 3: "b \<in> Field r" and 4: "b' = f b" by auto
have "(b,a) \<in> r"
proof-
{assume "(a,b) \<in> r"
- with ** 4 have "(f a, b') \<in> r'"
- by (auto simp add: compat_def)
- with ***** Antisym' have "f a = b'"
- by(auto simp add: under_def antisym_def)
- with 3 **** 4 * have "a = b"
- by(auto simp add: inj_on_def)
+ with ** 4 have "(f a, b') \<in> r'"
+ by (auto simp add: compat_def)
+ with ***** Antisym' have "f a = b'"
+ by(auto simp add: under_def antisym_def)
+ with 3 **** 4 * have "a = b"
+ by(auto simp add: inj_on_def)
}
moreover
{assume "a = b"
- hence "(b,a) \<in> r" using Refl **** 3
- by (auto simp add: refl_on_def)
+ hence "(b,a) \<in> r" using Refl **** 3
+ by (auto simp add: refl_on_def)
}
ultimately
show ?thesis using Total **** 3 by (fastforce simp add: total_on_def)
qed
with 4 show "b' \<in> f`(under r a)"
- unfolding under_def by auto
+ unfolding under_def by auto
qed
qed
lemma inv_into_ofilter_embed:
-assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
- BIJ: "\<forall>b \<in> A. bij_betw f (under r b) (under r' (f b))" and
- IMAGE: "f ` A = Field r'"
-shows "embed r' r (inv_into A f)"
+ assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
+ BIJ: "\<forall>b \<in> A. bij_betw f (under r b) (under r' (f b))" and
+ IMAGE: "f ` A = Field r'"
+ shows "embed r' r (inv_into A f)"
proof-
(* Preliminary facts *)
have Well: "wo_rel r"
- using WELL wo_rel_def[of r] by simp
+ using WELL wo_rel_def[of r] by simp
have Refl: "Refl r"
- using Well wo_rel.REFL[of r] by simp
+ using Well wo_rel.REFL[of r] by simp
have Total: "Total r"
- using Well wo_rel.TOTAL[of r] by simp
- (* Main proof *)
+ using Well wo_rel.TOTAL[of r] by simp
+ (* Main proof *)
have 1: "bij_betw f A (Field r')"
proof(unfold bij_betw_def inj_on_def, auto simp add: IMAGE)
fix b1 b2
assume *: "b1 \<in> A" and **: "b2 \<in> A" and
- ***: "f b1 = f b2"
+ ***: "f b1 = f b2"
have 11: "b1 \<in> Field r \<and> b2 \<in> Field r"
- using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
+ using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
moreover
{assume "(b1,b2) \<in> r"
- hence "b1 \<in> under r b2 \<and> b2 \<in> under r b2"
- unfolding under_def using 11 Refl
- by (auto simp add: refl_on_def)
- hence "b1 = b2" using BIJ * ** ***
- by (simp add: bij_betw_def inj_on_def)
+ hence "b1 \<in> under r b2 \<and> b2 \<in> under r b2"
+ unfolding under_def using 11 Refl
+ by (auto simp add: refl_on_def)
+ hence "b1 = b2" using BIJ * ** ***
+ by (simp add: bij_betw_def inj_on_def)
}
moreover
- {assume "(b2,b1) \<in> r"
- hence "b1 \<in> under r b1 \<and> b2 \<in> under r b1"
- unfolding under_def using 11 Refl
- by (auto simp add: refl_on_def)
- hence "b1 = b2" using BIJ * ** ***
- by (simp add: bij_betw_def inj_on_def)
+ {assume "(b2,b1) \<in> r"
+ hence "b1 \<in> under r b1 \<and> b2 \<in> under r b1"
+ unfolding under_def using 11 Refl
+ by (auto simp add: refl_on_def)
+ hence "b1 = b2" using BIJ * ** ***
+ by (simp add: bij_betw_def inj_on_def)
}
ultimately
show "b1 = b2"
- using Total by (auto simp add: total_on_def)
+ using Total by (auto simp add: total_on_def)
qed
- (* *)
+ (* *)
let ?f' = "(inv_into A f)"
- (* *)
+ (* *)
have 2: "\<forall>b \<in> A. bij_betw ?f' (under r' (f b)) (under r b)"
proof(clarify)
fix b assume *: "b \<in> A"
hence "under r b \<le> A"
- using Well OF by(auto simp add: wo_rel.ofilter_def)
+ using Well OF by(auto simp add: wo_rel.ofilter_def)
moreover
have "f ` (under r b) = under r' (f b)"
- using * BIJ by (auto simp add: bij_betw_def)
+ using * BIJ by (auto simp add: bij_betw_def)
ultimately
show "bij_betw ?f' (under r' (f b)) (under r b)"
- using 1 by (auto simp add: bij_betw_inv_into_subset)
+ using 1 by (auto simp add: bij_betw_inv_into_subset)
qed
- (* *)
+ (* *)
have 3: "\<forall>b' \<in> Field r'. bij_betw ?f' (under r' b') (under r (?f' b'))"
proof(clarify)
fix b' assume *: "b' \<in> Field r'"
have "b' = f (?f' b')" using * 1
- by (auto simp add: bij_betw_inv_into_right)
+ by (auto simp add: bij_betw_inv_into_right)
moreover
{obtain b where 31: "b \<in> A" and "f b = b'" using IMAGE * by force
- hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
- with 31 have "?f' b' \<in> A" by auto
+ hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
+ with 31 have "?f' b' \<in> A" by auto
}
ultimately
show "bij_betw ?f' (under r' b') (under r (?f' b'))"
- using 2 by auto
+ using 2 by auto
qed
- (* *)
+ (* *)
thus ?thesis unfolding embed_def .
qed
lemma inv_into_underS_embed:
-assumes WELL: "Well_order r" and
- BIJ: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
- IN: "a \<in> Field r" and
- IMAGE: "f ` (underS r a) = Field r'"
-shows "embed r' r (inv_into (underS r a) f)"
-using assms
-by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
+ assumes WELL: "Well_order r" and
+ BIJ: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
+ IN: "a \<in> Field r" and
+ IMAGE: "f ` (underS r a) = Field r'"
+ shows "embed r' r (inv_into (underS r a) f)"
+ using assms
+ by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
lemma inv_into_Field_embed:
-assumes WELL: "Well_order r" and EMB: "embed r r' f" and
- IMAGE: "Field r' \<le> f ` (Field r)"
-shows "embed r' r (inv_into (Field r) f)"
+ assumes WELL: "Well_order r" and EMB: "embed r r' f" and
+ IMAGE: "Field r' \<le> f ` (Field r)"
+ shows "embed r' r (inv_into (Field r) f)"
proof-
have "(\<forall>b \<in> Field r. bij_betw f (under r b) (under r' (f b)))"
- using EMB by (auto simp add: embed_def)
+ using EMB by (auto simp add: embed_def)
moreover
have "f ` (Field r) \<le> Field r'"
- using EMB WELL by (auto simp add: embed_Field)
+ using EMB WELL by (auto simp add: embed_Field)
ultimately
show ?thesis using assms
- by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
+ by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
qed
lemma inv_into_Field_embed_bij_betw:
@@ -487,12 +487,12 @@
\<close>
lemma wellorders_totally_ordered_aux:
-fixes r ::"'a rel" and r'::"'a' rel" and
- f :: "'a \<Rightarrow> 'a'" and a::'a
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
- IH: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
- NOT: "f ` (underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(underS r a))"
-shows "bij_betw f (under r a) (under r' (f a))"
+ fixes r ::"'a rel" and r'::"'a' rel" and
+ f :: "'a \<Rightarrow> 'a'" and a::'a
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
+ IH: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
+ NOT: "f ` (underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(underS r a))"
+ shows "bij_betw f (under r a) (under r' (f a))"
proof-
(* Preliminary facts *)
have Well: "wo_rel r" using WELL unfolding wo_rel_def .
@@ -500,197 +500,197 @@
have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
have OF: "wo_rel.ofilter r (underS r a)"
- by (auto simp add: Well wo_rel.underS_ofilter)
+ by (auto simp add: Well wo_rel.underS_ofilter)
hence UN: "underS r a = (\<Union>b \<in> underS r a. under r b)"
- using Well wo_rel.ofilter_under_UNION[of r "underS r a"] by blast
- (* Gather facts about elements of underS r a *)
+ using Well wo_rel.ofilter_under_UNION[of r "underS r a"] by blast
+ (* Gather facts about elements of underS r a *)
{fix b assume *: "b \<in> underS r a"
- hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
- have t1: "b \<in> Field r"
- using * underS_Field[of r a] by auto
- have t2: "f`(under r b) = under r' (f b)"
- using IH * by (auto simp add: bij_betw_def)
- hence t3: "wo_rel.ofilter r' (f`(under r b))"
- using Well' by (auto simp add: wo_rel.under_ofilter)
- have "f`(under r b) \<le> Field r'"
- using t2 by (auto simp add: under_Field)
- moreover
- have "b \<in> under r b"
- using t1 by(auto simp add: Refl Refl_under_in)
- ultimately
- have t4: "f b \<in> Field r'" by auto
- have "f`(under r b) = under r' (f b) \<and>
+ hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
+ have t1: "b \<in> Field r"
+ using * underS_Field[of r a] by auto
+ have t2: "f`(under r b) = under r' (f b)"
+ using IH * by (auto simp add: bij_betw_def)
+ hence t3: "wo_rel.ofilter r' (f`(under r b))"
+ using Well' by (auto simp add: wo_rel.under_ofilter)
+ have "f`(under r b) \<le> Field r'"
+ using t2 by (auto simp add: under_Field)
+ moreover
+ have "b \<in> under r b"
+ using t1 by(auto simp add: Refl Refl_under_in)
+ ultimately
+ have t4: "f b \<in> Field r'" by auto
+ have "f`(under r b) = under r' (f b) \<and>
wo_rel.ofilter r' (f`(under r b)) \<and>
f b \<in> Field r'"
- using t2 t3 t4 by auto
+ using t2 t3 t4 by auto
}
hence bFact:
- "\<forall>b \<in> underS r a. f`(under r b) = under r' (f b) \<and>
+ "\<forall>b \<in> underS r a. f`(under r b) = under r' (f b) \<and>
wo_rel.ofilter r' (f`(under r b)) \<and>
f b \<in> Field r'" by blast
- (* *)
+ (* *)
have subField: "f`(underS r a) \<le> Field r'"
- using bFact by blast
- (* *)
+ using bFact by blast
+ (* *)
have OF': "wo_rel.ofilter r' (f`(underS r a))"
proof-
have "f`(underS r a) = f`(\<Union>b \<in> underS r a. under r b)"
- using UN by auto
+ using UN by auto
also have "\<dots> = (\<Union>b \<in> underS r a. f`(under r b))" by blast
also have "\<dots> = (\<Union>b \<in> underS r a. (under r' (f b)))"
- using bFact by auto
+ using bFact by auto
finally
have "f`(underS r a) = (\<Union>b \<in> underS r a. (under r' (f b)))" .
thus ?thesis
- using Well' bFact
- wo_rel.ofilter_UNION[of r' "underS r a" "\<lambda> b. under r' (f b)"] by fastforce
+ using Well' bFact
+ wo_rel.ofilter_UNION[of r' "underS r a" "\<lambda> b. under r' (f b)"] by fastforce
qed
- (* *)
+ (* *)
have "f`(underS r a) \<union> AboveS r' (f`(underS r a)) = Field r'"
- using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
+ using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
hence NE: "AboveS r' (f`(underS r a)) \<noteq> {}"
- using subField NOT by blast
- (* Main proof *)
+ using subField NOT by blast
+ (* Main proof *)
have INCL1: "f`(underS r a) \<le> underS r' (f a) "
proof(auto)
fix b assume *: "b \<in> underS r a"
have "f b \<noteq> f a \<and> (f b, f a) \<in> r'"
- using subField Well' SUC NE *
- wo_rel.suc_greater[of r' "f`(underS r a)" "f b"] by force
+ using subField Well' SUC NE *
+ wo_rel.suc_greater[of r' "f`(underS r a)" "f b"] by force
thus "f b \<in> underS r' (f a)"
- unfolding underS_def by simp
+ unfolding underS_def by simp
qed
- (* *)
+ (* *)
have INCL2: "underS r' (f a) \<le> f`(underS r a)"
proof
fix b' assume "b' \<in> underS r' (f a)"
hence "b' \<noteq> f a \<and> (b', f a) \<in> r'"
- unfolding underS_def by simp
+ unfolding underS_def by simp
thus "b' \<in> f`(underS r a)"
- using Well' SUC NE OF'
- wo_rel.suc_ofilter_in[of r' "f ` underS r a" b'] by auto
+ using Well' SUC NE OF'
+ wo_rel.suc_ofilter_in[of r' "f ` underS r a" b'] by auto
qed
- (* *)
+ (* *)
have INJ: "inj_on f (underS r a)"
proof-
have "\<forall>b \<in> underS r a. inj_on f (under r b)"
- using IH by (auto simp add: bij_betw_def)
+ using IH by (auto simp add: bij_betw_def)
moreover
have "\<forall>b. wo_rel.ofilter r (under r b)"
- using Well by (auto simp add: wo_rel.under_ofilter)
+ using Well by (auto simp add: wo_rel.under_ofilter)
ultimately show ?thesis
- using WELL bFact UN
- UNION_inj_on_ofilter[of r "underS r a" "\<lambda>b. under r b" f]
- by auto
+ using WELL bFact UN
+ UNION_inj_on_ofilter[of r "underS r a" "\<lambda>b. under r b" f]
+ by auto
qed
- (* *)
+ (* *)
have BIJ: "bij_betw f (underS r a) (underS r' (f a))"
- unfolding bij_betw_def
- using INJ INCL1 INCL2 by auto
- (* *)
+ unfolding bij_betw_def
+ using INJ INCL1 INCL2 by auto
+ (* *)
have "f a \<in> Field r'"
- using Well' subField NE SUC
- by (auto simp add: wo_rel.suc_inField)
+ using Well' subField NE SUC
+ by (auto simp add: wo_rel.suc_inField)
thus ?thesis
- using WELL WELL' IN BIJ under_underS_bij_betw[of r r' a f] by auto
+ using WELL WELL' IN BIJ under_underS_bij_betw[of r r' a f] by auto
qed
lemma wellorders_totally_ordered_aux2:
-fixes r ::"'a rel" and r'::"'a' rel" and
- f :: "'a \<Rightarrow> 'a'" and g :: "'a \<Rightarrow> bool" and a::'a
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
-MAIN1:
- "\<And> a. (False \<notin> g`(underS r a) \<and> f`(underS r a) \<noteq> Field r'
+ fixes r ::"'a rel" and r'::"'a' rel" and
+ f :: "'a \<Rightarrow> 'a'" and g :: "'a \<Rightarrow> bool" and a::'a
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ MAIN1:
+ "\<And> a. (False \<notin> g`(underS r a) \<and> f`(underS r a) \<noteq> Field r'
\<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True)
\<and>
(\<not>(False \<notin> (g`(underS r a)) \<and> f`(underS r a) \<noteq> Field r')
\<longrightarrow> g a = False)" and
-MAIN2: "\<And> a. a \<in> Field r \<and> False \<notin> g`(under r a) \<longrightarrow>
+ MAIN2: "\<And> a. a \<in> Field r \<and> False \<notin> g`(under r a) \<longrightarrow>
bij_betw f (under r a) (under r' (f a))" and
-Case: "a \<in> Field r \<and> False \<in> g`(under r a)"
-shows "\<exists>f'. embed r' r f'"
+ Case: "a \<in> Field r \<and> False \<in> g`(under r a)"
+ shows "\<exists>f'. embed r' r f'"
proof-
have Well: "wo_rel r" using WELL unfolding wo_rel_def .
hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
have Antisym: "antisym r" using Well wo_rel.ANTISYM[of r] by auto
have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
- (* *)
+ (* *)
have 0: "under r a = underS r a \<union> {a}"
- using Refl Case by(auto simp add: Refl_under_underS)
- (* *)
+ using Refl Case by(auto simp add: Refl_under_underS)
+ (* *)
have 1: "g a = False"
proof-
{assume "g a \<noteq> False"
- with 0 Case have "False \<in> g`(underS r a)" by blast
- with MAIN1 have "g a = False" by blast}
+ with 0 Case have "False \<in> g`(underS r a)" by blast
+ with MAIN1 have "g a = False" by blast}
thus ?thesis by blast
qed
let ?A = "{a \<in> Field r. g a = False}"
let ?a = "(wo_rel.minim r ?A)"
- (* *)
+ (* *)
have 2: "?A \<noteq> {} \<and> ?A \<le> Field r" using Case 1 by blast
- (* *)
+ (* *)
have 3: "False \<notin> g`(underS r ?a)"
proof
assume "False \<in> g`(underS r ?a)"
then obtain b where "b \<in> underS r ?a" and 31: "g b = False" by auto
hence 32: "(b,?a) \<in> r \<and> b \<noteq> ?a"
- by (auto simp add: underS_def)
+ by (auto simp add: underS_def)
hence "b \<in> Field r" unfolding Field_def by auto
with 31 have "b \<in> ?A" by auto
hence "(?a,b) \<in> r" using wo_rel.minim_least 2 Well by fastforce
- (* again: why worked without type annotations? *)
+ (* again: why worked without type annotations? *)
with 32 Antisym show False
- by (auto simp add: antisym_def)
+ by (auto simp add: antisym_def)
qed
have temp: "?a \<in> ?A"
- using Well 2 wo_rel.minim_in[of r ?A] by auto
+ using Well 2 wo_rel.minim_in[of r ?A] by auto
hence 4: "?a \<in> Field r" by auto
- (* *)
+ (* *)
have 5: "g ?a = False" using temp by blast
- (* *)
+ (* *)
have 6: "f`(underS r ?a) = Field r'"
- using MAIN1[of ?a] 3 5 by blast
- (* *)
+ using MAIN1[of ?a] 3 5 by blast
+ (* *)
have 7: "\<forall>b \<in> underS r ?a. bij_betw f (under r b) (under r' (f b))"
proof
fix b assume as: "b \<in> underS r ?a"
moreover
have "wo_rel.ofilter r (underS r ?a)"
- using Well by (auto simp add: wo_rel.underS_ofilter)
+ using Well by (auto simp add: wo_rel.underS_ofilter)
ultimately
have "False \<notin> g`(under r b)" using 3 Well by (subst (asm) wo_rel.ofilter_def) fast+
moreover have "b \<in> Field r"
- unfolding Field_def using as by (auto simp add: underS_def)
+ unfolding Field_def using as by (auto simp add: underS_def)
ultimately
show "bij_betw f (under r b) (under r' (f b))"
- using MAIN2 by auto
+ using MAIN2 by auto
qed
- (* *)
+ (* *)
have "embed r' r (inv_into (underS r ?a) f)"
- using WELL WELL' 7 4 6 inv_into_underS_embed[of r ?a f r'] by auto
+ using WELL WELL' 7 4 6 inv_into_underS_embed[of r ?a f r'] by auto
thus ?thesis
- unfolding embed_def by blast
+ unfolding embed_def by blast
qed
theorem wellorders_totally_ordered:
-fixes r ::"'a rel" and r'::"'a' rel"
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(\<exists>f. embed r r' f) \<or> (\<exists>f'. embed r' r f')"
+ fixes r ::"'a rel" and r'::"'a' rel"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(\<exists>f. embed r r' f) \<or> (\<exists>f'. embed r' r f')"
proof-
(* Preliminary facts *)
have Well: "wo_rel r" using WELL unfolding wo_rel_def .
hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
- (* Main proof *)
+ (* Main proof *)
obtain H where H_def: "H =
(\<lambda>h a. if False \<notin> (snd \<circ> h)`(underS r a) \<and> (fst \<circ> h)`(underS r a) \<noteq> Field r'
then (wo_rel.suc r' ((fst \<circ> h)`(underS r a)), True)
else (undefined, False))" by blast
have Adm: "wo_rel.adm_wo r H"
- using Well
+ using Well
proof(unfold wo_rel.adm_wo_def, clarify)
fix h1::"'a \<Rightarrow> 'a' * bool" and h2::"'a \<Rightarrow> 'a' * bool" and x
assume "\<forall>y\<in>underS r x. h1 y = h2 y"
@@ -701,52 +701,52 @@
by (auto simp add: image_def)
thus "H h1 x = H h2 x" by (simp add: H_def del: not_False_in_image_Ball)
qed
- (* More constant definitions: *)
+ (* More constant definitions: *)
obtain h::"'a \<Rightarrow> 'a' * bool" and f::"'a \<Rightarrow> 'a'" and g::"'a \<Rightarrow> bool"
- where h_def: "h = wo_rel.worec r H" and
- f_def: "f = fst \<circ> h" and g_def: "g = snd \<circ> h" by blast
+ where h_def: "h = wo_rel.worec r H" and
+ f_def: "f = fst \<circ> h" and g_def: "g = snd \<circ> h" by blast
obtain test where test_def:
- "test = (\<lambda> a. False \<notin> (g`(underS r a)) \<and> f`(underS r a) \<noteq> Field r')" by blast
- (* *)
+ "test = (\<lambda> a. False \<notin> (g`(underS r a)) \<and> f`(underS r a) \<noteq> Field r')" by blast
+ (* *)
have *: "\<And> a. h a = H h a"
- using Adm Well wo_rel.worec_fixpoint[of r H] by (simp add: h_def)
+ using Adm Well wo_rel.worec_fixpoint[of r H] by (simp add: h_def)
have Main1:
- "\<And> a. (test a \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True) \<and>
+ "\<And> a. (test a \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True) \<and>
(\<not>(test a) \<longrightarrow> g a = False)"
proof- (* How can I prove this withou fixing a? *)
fix a show "(test a \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True) \<and>
(\<not>(test a) \<longrightarrow> g a = False)"
- using *[of a] test_def f_def g_def H_def by auto
+ using *[of a] test_def f_def g_def H_def by auto
qed
- (* *)
+ (* *)
let ?phi = "\<lambda> a. a \<in> Field r \<and> False \<notin> g`(under r a) \<longrightarrow>
bij_betw f (under r a) (under r' (f a))"
have Main2: "\<And> a. ?phi a"
proof-
fix a show "?phi a"
proof(rule wo_rel.well_order_induct[of r ?phi],
- simp only: Well, clarify)
+ simp only: Well, clarify)
fix a
assume IH: "\<forall>b. b \<noteq> a \<and> (b,a) \<in> r \<longrightarrow> ?phi b" and
- *: "a \<in> Field r" and
- **: "False \<notin> g`(under r a)"
+ *: "a \<in> Field r" and
+ **: "False \<notin> g`(under r a)"
have 1: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))"
proof(clarify)
fix b assume ***: "b \<in> underS r a"
hence 0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
moreover have "b \<in> Field r"
- using *** underS_Field[of r a] by auto
+ using *** underS_Field[of r a] by auto
moreover have "False \<notin> g`(under r b)"
- using 0 ** Trans under_incr[of r b a] by auto
+ using 0 ** Trans under_incr[of r b a] by auto
ultimately show "bij_betw f (under r b) (under r' (f b))"
- using IH by auto
+ using IH by auto
qed
- (* *)
+ (* *)
have 21: "False \<notin> g`(underS r a)"
- using ** underS_subset_under[of r a] by auto
+ using ** underS_subset_under[of r a] by auto
have 22: "g`(under r a) \<le> {True}" using ** by auto
moreover have 23: "a \<in> under r a"
- using Refl * by (auto simp add: Refl_under_in)
+ using Refl * by (auto simp add: Refl_under_in)
ultimately have 24: "g a = True" by blast
have 2: "f`(underS r a) \<noteq> Field r'"
proof
@@ -754,29 +754,29 @@
hence "g a = False" using Main1 test_def by blast
with 24 show False using ** by blast
qed
- (* *)
+ (* *)
have 3: "f a = wo_rel.suc r' (f`(underS r a))"
- using 21 2 Main1 test_def by blast
- (* *)
+ using 21 2 Main1 test_def by blast
+ (* *)
show "bij_betw f (under r a) (under r' (f a))"
- using WELL WELL' 1 2 3 *
- wellorders_totally_ordered_aux[of r r' a f] by auto
+ using WELL WELL' 1 2 3 *
+ wellorders_totally_ordered_aux[of r r' a f] by auto
qed
qed
- (* *)
+ (* *)
let ?chi = "(\<lambda> a. a \<in> Field r \<and> False \<in> g`(under r a))"
show ?thesis
proof(cases "\<exists>a. ?chi a")
assume "\<not> (\<exists>a. ?chi a)"
hence "\<forall>a \<in> Field r. bij_betw f (under r a) (under r' (f a))"
- using Main2 by blast
+ using Main2 by blast
thus ?thesis unfolding embed_def by blast
next
assume "\<exists>a. ?chi a"
then obtain a where "?chi a" by blast
hence "\<exists>f'. embed r' r f'"
- using wellorders_totally_ordered_aux2[of r r' g f a]
- WELL WELL' Main1 Main2 test_def by fast
+ using wellorders_totally_ordered_aux2[of r r' g f a]
+ WELL WELL' Main1 Main2 test_def by fast
thus ?thesis by blast
qed
qed
@@ -790,75 +790,75 @@
embeddings of opposite directions are mutually inverse.\<close>
lemma embed_determined:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and IN: "a \<in> Field r"
-shows "f a = wo_rel.suc r' (f`(underS r a))"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and IN: "a \<in> Field r"
+ shows "f a = wo_rel.suc r' (f`(underS r a))"
proof-
have "bij_betw f (underS r a) (underS r' (f a))"
- using assms by (auto simp add: embed_underS)
+ using assms by (auto simp add: embed_underS)
hence "f`(underS r a) = underS r' (f a)"
- by (auto simp add: bij_betw_def)
+ by (auto simp add: bij_betw_def)
moreover
{have "f a \<in> Field r'" using IN
- using EMB WELL embed_Field[of r r' f] by auto
- hence "f a = wo_rel.suc r' (underS r' (f a))"
- using WELL' by (auto simp add: wo_rel_def wo_rel.suc_underS)
+ using EMB WELL embed_Field[of r r' f] by auto
+ hence "f a = wo_rel.suc r' (underS r' (f a))"
+ using WELL' by (auto simp add: wo_rel_def wo_rel.suc_underS)
}
ultimately show ?thesis by simp
qed
lemma embed_unique:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMBf: "embed r r' f" and EMBg: "embed r r' g"
-shows "a \<in> Field r \<longrightarrow> f a = g a"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMBf: "embed r r' f" and EMBg: "embed r r' g"
+ shows "a \<in> Field r \<longrightarrow> f a = g a"
proof(rule wo_rel.well_order_induct[of r], auto simp add: WELL wo_rel_def)
fix a
assume IH: "\<forall>b. b \<noteq> a \<and> (b,a) \<in> r \<longrightarrow> b \<in> Field r \<longrightarrow> f b = g b" and
- *: "a \<in> Field r"
+ *: "a \<in> Field r"
hence "\<forall>b \<in> underS r a. f b = g b"
- unfolding underS_def by (auto simp add: Field_def)
+ unfolding underS_def by (auto simp add: Field_def)
hence "f`(underS r a) = g`(underS r a)" by force
thus "f a = g a"
- using assms * embed_determined[of r r' f a] embed_determined[of r r' g a] by auto
+ using assms * embed_determined[of r r' f a] embed_determined[of r r' g a] by auto
qed
lemma embed_bothWays_inverse:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and EMB': "embed r' r f'"
-shows "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and EMB': "embed r' r f'"
+ shows "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
proof-
have "embed r r (f' \<circ> f)" using assms
- by(auto simp add: comp_embed)
+ by(auto simp add: comp_embed)
moreover have "embed r r id" using assms
- by (auto simp add: id_embed)
+ by (auto simp add: id_embed)
ultimately have "\<forall>a \<in> Field r. f'(f a) = a"
- using assms embed_unique[of r r "f' \<circ> f" id] id_def by auto
+ using assms embed_unique[of r r "f' \<circ> f" id] id_def by auto
moreover
{have "embed r' r' (f \<circ> f')" using assms
- by(auto simp add: comp_embed)
- moreover have "embed r' r' id" using assms
- by (auto simp add: id_embed)
- ultimately have "\<forall>a' \<in> Field r'. f(f' a') = a'"
- using assms embed_unique[of r' r' "f \<circ> f'" id] id_def by auto
+ by(auto simp add: comp_embed)
+ moreover have "embed r' r' id" using assms
+ by (auto simp add: id_embed)
+ ultimately have "\<forall>a' \<in> Field r'. f(f' a') = a'"
+ using assms embed_unique[of r' r' "f \<circ> f'" id] id_def by auto
}
ultimately show ?thesis by blast
qed
lemma embed_bothWays_bij_betw:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and EMB': "embed r' r g"
-shows "bij_betw f (Field r) (Field r')"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and EMB': "embed r' r g"
+ shows "bij_betw f (Field r) (Field r')"
proof-
let ?A = "Field r" let ?A' = "Field r'"
have "embed r r (g \<circ> f) \<and> embed r' r' (f \<circ> g)"
- using assms by (auto simp add: comp_embed)
+ using assms by (auto simp add: comp_embed)
hence 1: "(\<forall>a \<in> ?A. g(f a) = a) \<and> (\<forall>a' \<in> ?A'. f(g a') = a')"
- using WELL id_embed[of r] embed_unique[of r r "g \<circ> f" id]
- WELL' id_embed[of r'] embed_unique[of r' r' "f \<circ> g" id]
- id_def by auto
+ using WELL id_embed[of r] embed_unique[of r r "g \<circ> f" id]
+ WELL' id_embed[of r'] embed_unique[of r' r' "f \<circ> g" id]
+ id_def by auto
have 2: "(\<forall>a \<in> ?A. f a \<in> ?A') \<and> (\<forall>a' \<in> ?A'. g a' \<in> ?A)"
- using assms embed_Field[of r r' f] embed_Field[of r' r g] by blast
- (* *)
+ using assms embed_Field[of r r' f] embed_Field[of r' r g] by blast
+ (* *)
show ?thesis
proof(unfold bij_betw_def inj_on_def, auto simp add: 2)
fix a b assume *: "a \<in> ?A" "b \<in> ?A" and **: "f a = f b"
@@ -872,24 +872,24 @@
qed
lemma embed_bothWays_iso:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and EMB': "embed r' r g"
-shows "iso r r' f"
-unfolding iso_def using assms by (auto simp add: embed_bothWays_bij_betw)
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and EMB': "embed r' r g"
+ shows "iso r r' f"
+ unfolding iso_def using assms by (auto simp add: embed_bothWays_bij_betw)
subsection \<open>More properties of embeddings, strict embeddings and isomorphisms\<close>
lemma embed_bothWays_Field_bij_betw:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and
- EMB: "embed r r' f" and EMB': "embed r' r f'"
-shows "bij_betw f (Field r) (Field r')"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and
+ EMB: "embed r r' f" and EMB': "embed r' r f'"
+ shows "bij_betw f (Field r) (Field r')"
proof-
have "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
- using assms by (auto simp add: embed_bothWays_inverse)
+ using assms by (auto simp add: embed_bothWays_inverse)
moreover
have "f`(Field r) \<le> Field r' \<and> f' ` (Field r') \<le> Field r"
- using assms by (auto simp add: embed_Field)
+ using assms by (auto simp add: embed_Field)
ultimately
show ?thesis using bij_betw_byWitness[of "Field r" f' f "Field r'"] by auto
qed
@@ -928,7 +928,7 @@
hence 2: "embed r r'' ?g"
using WELL EMB comp_embed[of r r' f r'' f'] by auto
moreover have \<section>: "f' ` Field r' \<subseteq> Field r''"
- by (simp add: "1" embed_Field)
+ by (simp add: "1" embed_Field)
{assume \<section>: "bij_betw ?g (Field r) (Field r'')"
hence "embed r'' r ?h" using 2 WELL
by (auto simp add: inv_into_Field_embed_bij_betw)
@@ -974,57 +974,57 @@
using assms unfolding iso_def by (auto simp add: embed_comp_embedS)
lemma embedS_Field:
-assumes WELL: "Well_order r" and EMB: "embedS r r' f"
-shows "f ` (Field r) < Field r'"
+ assumes WELL: "Well_order r" and EMB: "embedS r r' f"
+ shows "f ` (Field r) < Field r'"
proof-
have "f`(Field r) \<le> Field r'" using assms
- by (auto simp add: embed_Field embedS_def)
+ by (auto simp add: embed_Field embedS_def)
moreover
{have "inj_on f (Field r)" using assms
- by (auto simp add: embedS_def embed_inj_on)
- hence "f`(Field r) \<noteq> Field r'" using EMB
- by (auto simp add: embedS_def bij_betw_def)
+ by (auto simp add: embedS_def embed_inj_on)
+ hence "f`(Field r) \<noteq> Field r'" using EMB
+ by (auto simp add: embedS_def bij_betw_def)
}
ultimately show ?thesis by blast
qed
lemma embedS_iff:
-assumes WELL: "Well_order r" and ISO: "embed r r' f"
-shows "embedS r r' f = (f ` (Field r) < Field r')"
+ assumes WELL: "Well_order r" and ISO: "embed r r' f"
+ shows "embedS r r' f = (f ` (Field r) < Field r')"
proof
assume "embedS r r' f"
thus "f ` Field r \<subset> Field r'"
- using WELL by (auto simp add: embedS_Field)
+ using WELL by (auto simp add: embedS_Field)
next
assume "f ` Field r \<subset> Field r'"
hence "\<not> bij_betw f (Field r) (Field r')"
- unfolding bij_betw_def by blast
+ unfolding bij_betw_def by blast
thus "embedS r r' f" unfolding embedS_def
- using ISO by auto
+ using ISO by auto
qed
lemma iso_Field: "iso r r' f \<Longrightarrow> f ` (Field r) = Field r'"
by (auto simp add: iso_def bij_betw_def)
lemma iso_iff:
-assumes "Well_order r"
-shows "iso r r' f = (embed r r' f \<and> f ` (Field r) = Field r')"
+ assumes "Well_order r"
+ shows "iso r r' f = (embed r r' f \<and> f ` (Field r) = Field r')"
proof
assume "iso r r' f"
thus "embed r r' f \<and> f ` (Field r) = Field r'"
- by (auto simp add: iso_Field iso_def)
+ by (auto simp add: iso_Field iso_def)
next
assume *: "embed r r' f \<and> f ` Field r = Field r'"
hence "inj_on f (Field r)" using assms by (auto simp add: embed_inj_on)
with * have "bij_betw f (Field r) (Field r')"
- unfolding bij_betw_def by simp
+ unfolding bij_betw_def by simp
with * show "iso r r' f" unfolding iso_def by auto
qed
lemma iso_iff2: "iso r r' f \<longleftrightarrow>
bij_betw f (Field r) (Field r') \<and>
(\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a, b) \<in> r \<longleftrightarrow> (f a, f b) \<in> r')"
- (is "?lhs = ?rhs")
+ (is "?lhs = ?rhs")
proof
assume L: ?lhs
then have "bij_betw f (Field r) (Field r')" and emb: "embed r r' f"
@@ -1047,31 +1047,31 @@
qed
lemma iso_iff3:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and> compat r r' f)"
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and> compat r r' f)"
proof
assume "iso r r' f"
thus "bij_betw f (Field r) (Field r') \<and> compat r r' f"
- unfolding compat_def using WELL by (auto simp add: iso_iff2 Field_def)
+ unfolding compat_def using WELL by (auto simp add: iso_iff2 Field_def)
next
have Well: "wo_rel r \<and> wo_rel r'" using WELL WELL'
- by (auto simp add: wo_rel_def)
+ by (auto simp add: wo_rel_def)
assume *: "bij_betw f (Field r) (Field r') \<and> compat r r' f"
thus "iso r r' f"
- unfolding "compat_def" using assms
+ unfolding "compat_def" using assms
proof(auto simp add: iso_iff2)
fix a b assume **: "a \<in> Field r" "b \<in> Field r" and
- ***: "(f a, f b) \<in> r'"
+ ***: "(f a, f b) \<in> r'"
{assume "(b,a) \<in> r \<or> b = a"
- hence "(b,a) \<in> r"using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
- hence "(f b, f a) \<in> r'" using * unfolding compat_def by auto
- hence "f a = f b"
- using Well *** wo_rel.ANTISYM[of r'] antisym_def[of r'] by blast
- hence "a = b" using * ** unfolding bij_betw_def inj_on_def by auto
- hence "(a,b) \<in> r" using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
+ hence "(b,a) \<in> r"using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
+ hence "(f b, f a) \<in> r'" using * unfolding compat_def by auto
+ hence "f a = f b"
+ using Well *** wo_rel.ANTISYM[of r'] antisym_def[of r'] by blast
+ hence "a = b" using * ** unfolding bij_betw_def inj_on_def by auto
+ hence "(a,b) \<in> r" using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
}
thus "(a,b) \<in> r"
- using Well ** wo_rel.TOTAL[of r] total_on_def[of _ r] by blast
+ using Well ** wo_rel.TOTAL[of r] total_on_def[of _ r] by blast
qed
qed
@@ -1098,12 +1098,7 @@
lemma iso_forward:
assumes "(x,y) \<in> r" "iso r r' f" shows "(f x,f y) \<in> r'"
-proof -
- have "x \<in> Field r" "y \<in> Field r"
- using assms by (auto simp: Field_def)
- with assms show ?thesis unfolding iso_iff2 by blast
-qed
-
+ using assms by (auto simp: Field_def iso_iff2)
lemma iso_trans:
assumes "trans r" and iso: "iso r r' f" shows "trans r'"
@@ -1112,7 +1107,7 @@
fix x y z
assume xyz: "(x, y) \<in> r'" "(y, z) \<in> r'"
then have *: "(inv_into (Field r) f x, inv_into (Field r) f y) \<in> r"
- "(inv_into (Field r) f y, inv_into (Field r) f z) \<in> r"
+ "(inv_into (Field r) f y, inv_into (Field r) f z) \<in> r"
using iso_backward [OF _ iso] by blast+
then have "inv_into (Field r) f x \<in> Field r" "inv_into (Field r) f y \<in> Field r"
by (auto simp: Field_def)
--- a/src/HOL/BNF_Wellorder_Relation.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/BNF_Wellorder_Relation.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,7 +8,7 @@
section \<open>Well-Order Relations as Needed by Bounded Natural Functors\<close>
theory BNF_Wellorder_Relation
-imports Order_Relation
+ imports Order_Relation
begin
text\<open>In this section, we develop basic concepts and results pertaining
@@ -41,35 +41,35 @@
subsection \<open>Auxiliaries\<close>
lemma REFL: "Refl r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma TRANS: "trans r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma ANTISYM: "antisym r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma TOTAL: "Total r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma TOTALS: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
-using REFL TOTAL refl_on_def[of _ r] total_on_def[of _ r] by force
+ using REFL TOTAL refl_on_def[of _ r] total_on_def[of _ r] by force
lemma LIN: "Linear_order r"
-using WELL well_order_on_def[of _ r] by auto
+ using WELL well_order_on_def[of _ r] by auto
lemma WF: "wf (r - Id)"
-using WELL well_order_on_def[of _ r] by auto
+ using WELL well_order_on_def[of _ r] by auto
lemma cases_Total:
-"\<And> phi a b. \<lbrakk>{a,b} <= Field r; ((a,b) \<in> r \<Longrightarrow> phi a b); ((b,a) \<in> r \<Longrightarrow> phi a b)\<rbrakk>
+ "\<And> phi a b. \<lbrakk>{a,b} <= Field r; ((a,b) \<in> r \<Longrightarrow> phi a b); ((b,a) \<in> r \<Longrightarrow> phi a b)\<rbrakk>
\<Longrightarrow> phi a b"
-using TOTALS by auto
+ using TOTALS by auto
lemma cases_Total3:
-"\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<or> (b,a) \<in> r - Id \<Longrightarrow> phi a b);
+ "\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<or> (b,a) \<in> r - Id \<Longrightarrow> phi a b);
(a = b \<Longrightarrow> phi a b)\<rbrakk> \<Longrightarrow> phi a b"
-using TOTALS by auto
+ using TOTALS by auto
subsection \<open>Well-founded induction and recursion adapted to non-strict well-order relations\<close>
@@ -81,34 +81,34 @@
having to take out the diagonal each time in order to switch to a well-founded relation.\<close>
lemma well_order_induct:
-assumes IND: "\<And>x. \<forall>y. y \<noteq> x \<and> (y, x) \<in> r \<longrightarrow> P y \<Longrightarrow> P x"
-shows "P a"
+ assumes IND: "\<And>x. \<forall>y. y \<noteq> x \<and> (y, x) \<in> r \<longrightarrow> P y \<Longrightarrow> P x"
+ shows "P a"
proof-
have "\<And>x. \<forall>y. (y, x) \<in> r - Id \<longrightarrow> P y \<Longrightarrow> P x"
- using IND by blast
+ using IND by blast
thus "P a" using WF wf_induct[of "r - Id" P a] by blast
qed
definition
-worec :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
-where
-"worec F \<equiv> wfrec (r - Id) F"
+ worec :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
+ where
+ "worec F \<equiv> wfrec (r - Id) F"
definition
-adm_wo :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> bool"
-where
-"adm_wo H \<equiv> \<forall>f g x. (\<forall>y \<in> underS x. f y = g y) \<longrightarrow> H f x = H g x"
+ adm_wo :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> bool"
+ where
+ "adm_wo H \<equiv> \<forall>f g x. (\<forall>y \<in> underS x. f y = g y) \<longrightarrow> H f x = H g x"
lemma worec_fixpoint:
-assumes ADM: "adm_wo H"
-shows "worec H = H (worec H)"
+ assumes ADM: "adm_wo H"
+ shows "worec H = H (worec H)"
proof-
let ?rS = "r - Id"
have "adm_wf (r - Id) H"
- unfolding adm_wf_def
- using ADM adm_wo_def[of H] underS_def[of r] by auto
+ unfolding adm_wf_def
+ using ADM adm_wo_def[of H] underS_def[of r] by auto
hence "wfrec ?rS H = H (wfrec ?rS H)"
- using WF wfrec_fixpoint[of ?rS H] by simp
+ using WF wfrec_fixpoint[of ?rS H] by simp
thus ?thesis unfolding worec_def .
qed
@@ -127,97 +127,83 @@
Order filters for well-orders are also known as ``initial segments".\<close>
definition max2 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
-where "max2 a b \<equiv> if (a,b) \<in> r then b else a"
+ where "max2 a b \<equiv> if (a,b) \<in> r then b else a"
definition isMinim :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
-where "isMinim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (b,a) \<in> r)"
+ where "isMinim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (b,a) \<in> r)"
definition minim :: "'a set \<Rightarrow> 'a"
-where "minim A \<equiv> THE b. isMinim A b"
+ where "minim A \<equiv> THE b. isMinim A b"
definition supr :: "'a set \<Rightarrow> 'a"
-where "supr A \<equiv> minim (Above A)"
+ where "supr A \<equiv> minim (Above A)"
definition suc :: "'a set \<Rightarrow> 'a"
-where "suc A \<equiv> minim (AboveS A)"
+ where "suc A \<equiv> minim (AboveS A)"
subsubsection \<open>Properties of max2\<close>
lemma max2_greater_among:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r \<and> max2 a b \<in> {a,b}"
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r \<and> max2 a b \<in> {a,b}"
proof-
{assume "(a,b) \<in> r"
- hence ?thesis using max2_def assms REFL refl_on_def
- by (auto simp add: refl_on_def)
+ hence ?thesis using max2_def assms REFL refl_on_def
+ by (auto simp add: refl_on_def)
}
moreover
{assume "a = b"
- hence "(a,b) \<in> r" using REFL assms
- by (auto simp add: refl_on_def)
+ hence "(a,b) \<in> r" using REFL assms
+ by (auto simp add: refl_on_def)
}
moreover
{assume *: "a \<noteq> b \<and> (b,a) \<in> r"
- hence "(a,b) \<notin> r" using ANTISYM
- by (auto simp add: antisym_def)
- hence ?thesis using * max2_def assms REFL refl_on_def
- by (auto simp add: refl_on_def)
+ hence "(a,b) \<notin> r" using ANTISYM
+ by (auto simp add: antisym_def)
+ hence ?thesis using * max2_def assms REFL refl_on_def
+ by (auto simp add: refl_on_def)
}
ultimately show ?thesis using assms TOTAL
- total_on_def[of "Field r" r] by blast
+ total_on_def[of "Field r" r] by blast
qed
lemma max2_greater:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r"
-using assms by (auto simp add: max2_greater_among)
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r"
+ using assms by (auto simp add: max2_greater_among)
lemma max2_among:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "max2 a b \<in> {a, b}"
-using assms max2_greater_among[of a b] by simp
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "max2 a b \<in> {a, b}"
+ using assms max2_greater_among[of a b] by simp
lemma max2_equals1:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "(max2 a b = a) = ((b,a) \<in> r)"
-using assms ANTISYM unfolding antisym_def using TOTALS
-by(auto simp add: max2_def max2_among)
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "(max2 a b = a) = ((b,a) \<in> r)"
+ using assms ANTISYM unfolding antisym_def using TOTALS
+ by(auto simp add: max2_def max2_among)
lemma max2_equals2:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "(max2 a b = b) = ((a,b) \<in> r)"
-using assms ANTISYM unfolding antisym_def using TOTALS
-unfolding max2_def by auto
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "(max2 a b = b) = ((a,b) \<in> r)"
+ using assms ANTISYM unfolding antisym_def using TOTALS
+ unfolding max2_def by auto
lemma in_notinI:
-assumes "(j,i) \<notin> r \<or> j = i" and "i \<in> Field r" and "j \<in> Field r"
-shows "(i,j) \<in> r" using assms max2_def max2_greater_among by fastforce
+ assumes "(j,i) \<notin> r \<or> j = i" and "i \<in> Field r" and "j \<in> Field r"
+ shows "(i,j) \<in> r" using assms max2_def max2_greater_among by fastforce
subsubsection \<open>Existence and uniqueness for isMinim and well-definedness of minim\<close>
lemma isMinim_unique:
-assumes MINIM: "isMinim B a" and MINIM': "isMinim B a'"
-shows "a = a'"
-proof-
- {have "a \<in> B"
- using MINIM isMinim_def by simp
- hence "(a',a) \<in> r"
- using MINIM' isMinim_def by simp
- }
- moreover
- {have "a' \<in> B"
- using MINIM' isMinim_def by simp
- hence "(a,a') \<in> r"
- using MINIM isMinim_def by simp
- }
- ultimately
- show ?thesis using ANTISYM antisym_def[of r] by blast
-qed
+ assumes "isMinim B a" "isMinim B a'"
+ shows "a = a'"
+ using assms ANTISYM antisym_def[of r] by (auto simp: isMinim_def)
lemma Well_order_isMinim_exists:
-assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
-shows "\<exists>b. isMinim B b"
+ assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
+ shows "\<exists>b. isMinim B b"
proof-
from spec[OF WF[unfolded wf_eq_minimal[of "r - Id"]], of B] NE obtain b where
*: "b \<in> B \<and> (\<forall>b'. b' \<noteq> b \<and> (b',b) \<in> r \<longrightarrow> b' \<notin> B)" by auto
@@ -232,52 +218,46 @@
moreover have "b' = b \<Longrightarrow> (b, b') \<in> r"
using ** REFL by (auto simp add: refl_on_def)
moreover have "b' \<noteq> b \<and> (b',b) \<notin> r \<Longrightarrow> (b,b') \<in> r"
- using ** TOTAL by (auto simp add: total_on_def)
+ using ** TOTAL by (auto simp add: total_on_def)
ultimately show "(b,b') \<in> r" by blast
qed
qed
- then have "isMinim B b"
+ then show ?thesis
unfolding isMinim_def using * by auto
- then show ?thesis
- by auto
qed
lemma minim_isMinim:
-assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
-shows "isMinim B (minim B)"
+ assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
+ shows "isMinim B (minim B)"
proof-
let ?phi = "(\<lambda> b. isMinim B b)"
from assms Well_order_isMinim_exists
obtain b where *: "?phi b" by blast
moreover
have "\<And> b'. ?phi b' \<Longrightarrow> b' = b"
- using isMinim_unique * by auto
+ using isMinim_unique * by auto
ultimately show ?thesis
- unfolding minim_def using theI[of ?phi b] by blast
+ unfolding minim_def using theI[of ?phi b] by blast
qed
subsubsection\<open>Properties of minim\<close>
lemma minim_in:
-assumes "B \<le> Field r" and "B \<noteq> {}"
-shows "minim B \<in> B"
-proof-
- from minim_isMinim[of B] assms
- have "isMinim B (minim B)" by simp
- thus ?thesis by (simp add: isMinim_def)
-qed
+ assumes "B \<le> Field r" and "B \<noteq> {}"
+ shows "minim B \<in> B"
+ using assms minim_isMinim[of B] by (auto simp: isMinim_def)
lemma minim_inField:
-assumes "B \<le> Field r" and "B \<noteq> {}"
-shows "minim B \<in> Field r"
+ assumes "B \<le> Field r" and "B \<noteq> {}"
+ shows "minim B \<in> Field r"
proof-
have "minim B \<in> B" using assms by (simp add: minim_in)
thus ?thesis using assms by blast
qed
lemma minim_least:
-assumes SUB: "B \<le> Field r" and IN: "b \<in> B"
-shows "(minim B, b) \<in> r"
+ assumes SUB: "B \<le> Field r" and IN: "b \<in> B"
+ shows "(minim B, b) \<in> r"
proof-
from minim_isMinim[of B] assms
have "isMinim B (minim B)" by auto
@@ -285,137 +265,104 @@
qed
lemma equals_minim:
-assumes SUB: "B \<le> Field r" and IN: "a \<in> B" and
- LEAST: "\<And> b. b \<in> B \<Longrightarrow> (a,b) \<in> r"
-shows "a = minim B"
+ assumes SUB: "B \<le> Field r" and IN: "a \<in> B" and
+ LEAST: "\<And> b. b \<in> B \<Longrightarrow> (a,b) \<in> r"
+ shows "a = minim B"
proof-
from minim_isMinim[of B] assms
have "isMinim B (minim B)" by auto
moreover have "isMinim B a" using IN LEAST isMinim_def by auto
ultimately show ?thesis
- using isMinim_unique by auto
+ using isMinim_unique by auto
qed
subsubsection\<open>Properties of successor\<close>
lemma suc_AboveS:
-assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}"
-shows "suc B \<in> AboveS B"
+ assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}"
+ shows "suc B \<in> AboveS B"
proof(unfold suc_def)
have "AboveS B \<le> Field r"
- using AboveS_Field[of r] by auto
+ using AboveS_Field[of r] by auto
thus "minim (AboveS B) \<in> AboveS B"
- using assms by (simp add: minim_in)
+ using assms by (simp add: minim_in)
qed
lemma suc_greater:
-assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}" and
- IN: "b \<in> B"
-shows "suc B \<noteq> b \<and> (b,suc B) \<in> r"
-proof-
- from assms suc_AboveS
- have "suc B \<in> AboveS B" by simp
- with IN AboveS_def[of r] show ?thesis by simp
-qed
+ assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}" and IN: "b \<in> B"
+ shows "suc B \<noteq> b \<and> (b,suc B) \<in> r"
+ using IN AboveS_def[of r] assms suc_AboveS by auto
lemma suc_least_AboveS:
-assumes ABOVES: "a \<in> AboveS B"
-shows "(suc B,a) \<in> r"
-proof(unfold suc_def)
- have "AboveS B \<le> Field r"
- using AboveS_Field[of r] by auto
- thus "(minim (AboveS B),a) \<in> r"
- using assms minim_least by simp
-qed
+ assumes ABOVES: "a \<in> AboveS B"
+ shows "(suc B,a) \<in> r"
+ using assms minim_least AboveS_Field[of r] by (auto simp: suc_def)
lemma suc_inField:
-assumes "B \<le> Field r" and "AboveS B \<noteq> {}"
-shows "suc B \<in> Field r"
-proof-
- have "suc B \<in> AboveS B" using suc_AboveS assms by simp
- thus ?thesis
- using assms AboveS_Field[of r] by auto
-qed
+ assumes "B \<le> Field r" and "AboveS B \<noteq> {}"
+ shows "suc B \<in> Field r"
+ using suc_AboveS assms AboveS_Field[of r] by auto
lemma equals_suc_AboveS:
-assumes SUB: "B \<le> Field r" and ABV: "a \<in> AboveS B" and
- MINIM: "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
-shows "a = suc B"
-proof(unfold suc_def)
- have "AboveS B \<le> Field r"
- using AboveS_Field[of r B] by auto
- thus "a = minim (AboveS B)"
- using assms equals_minim
- by simp
-qed
+ assumes "B \<le> Field r" and "a \<in> AboveS B" and "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
+ shows "a = suc B"
+ using assms equals_minim AboveS_Field[of r B] by (auto simp: suc_def)
lemma suc_underS:
-assumes IN: "a \<in> Field r"
-shows "a = suc (underS a)"
+ assumes IN: "a \<in> Field r"
+ shows "a = suc (underS a)"
proof-
have "underS a \<le> Field r"
- using underS_Field[of r] by auto
+ using underS_Field[of r] by auto
moreover
have "a \<in> AboveS (underS a)"
- using in_AboveS_underS IN by fast
+ using in_AboveS_underS IN by fast
moreover
have "\<forall>a' \<in> AboveS (underS a). (a,a') \<in> r"
proof(clarify)
fix a'
assume *: "a' \<in> AboveS (underS a)"
hence **: "a' \<in> Field r"
- using AboveS_Field by fast
+ using AboveS_Field by fast
{assume "(a,a') \<notin> r"
- hence "a' = a \<or> (a',a) \<in> r"
- using TOTAL IN ** by (auto simp add: total_on_def)
- moreover
- {assume "a' = a"
- hence "(a,a') \<in> r"
- using REFL IN ** by (auto simp add: refl_on_def)
- }
- moreover
- {assume "a' \<noteq> a \<and> (a',a) \<in> r"
- hence "a' \<in> underS a"
- unfolding underS_def by simp
- hence "a' \<notin> AboveS (underS a)"
- using AboveS_disjoint by fast
- with * have False by simp
- }
- ultimately have "(a,a') \<in> r" by blast
+ hence "a' = a \<or> (a',a) \<in> r"
+ using TOTAL IN ** by (auto simp add: total_on_def)
+ moreover
+ {assume "a' = a"
+ hence "(a,a') \<in> r"
+ using REFL IN ** by (auto simp add: refl_on_def)
+ }
+ moreover
+ {assume "a' \<noteq> a \<and> (a',a) \<in> r"
+ hence "a' \<in> underS a"
+ unfolding underS_def by simp
+ hence "a' \<notin> AboveS (underS a)"
+ using AboveS_disjoint by fast
+ with * have False by simp
+ }
+ ultimately have "(a,a') \<in> r" by blast
}
thus "(a, a') \<in> r" by blast
qed
ultimately show ?thesis
- using equals_suc_AboveS by auto
+ using equals_suc_AboveS by auto
qed
subsubsection \<open>Properties of order filters\<close>
-lemma under_ofilter:
-"ofilter (under a)"
-proof -
- have "\<And>aa x. (aa, a) \<in> r \<Longrightarrow> (x, aa) \<in> r \<Longrightarrow> (x, a) \<in> r"
- proof -
- fix aa x
- assume "(aa,a) \<in> r" "(x,aa) \<in> r"
- then show "(x,a) \<in> r"
- using TRANS trans_def[of r] by blast
- qed
- then show ?thesis unfolding ofilter_def under_def
- by (auto simp add: Field_def)
-qed
+lemma under_ofilter: "ofilter (under a)"
+ using TRANS by (auto simp: ofilter_def under_def Field_iff trans_def)
-lemma underS_ofilter:
-"ofilter (underS a)"
+lemma underS_ofilter: "ofilter (underS a)"
unfolding ofilter_def underS_def under_def
proof safe
- fix aa assume "(a, aa) \<in> r" "(aa, a) \<in> r" and DIFF: "aa \<noteq> a"
+ fix b assume "(a, b) \<in> r" "(b, a) \<in> r" and DIFF: "b \<noteq> a"
thus False
- using ANTISYM antisym_def[of r] by blast
+ using ANTISYM antisym_def[of r] by blast
next
- fix aa x
- assume "(aa,a) \<in> r" "aa \<noteq> a" "(x,aa) \<in> r"
+ fix b x
+ assume "(b,a) \<in> r" "b \<noteq> a" "(x,b) \<in> r"
thus "(x,a) \<in> r"
using TRANS trans_def[of r] by blast
next
@@ -427,15 +374,15 @@
qed
lemma Field_ofilter:
-"ofilter (Field r)"
-by(unfold ofilter_def under_def, auto simp add: Field_def)
+ "ofilter (Field r)"
+ by(unfold ofilter_def under_def, auto simp add: Field_def)
lemma ofilter_underS_Field:
-"ofilter A = ((\<exists>a \<in> Field r. A = underS a) \<or> (A = Field r))"
+ "ofilter A = ((\<exists>a \<in> Field r. A = underS a) \<or> (A = Field r))"
proof
assume "(\<exists>a\<in>Field r. A = underS a) \<or> A = Field r"
thus "ofilter A"
- by (auto simp: underS_ofilter Field_ofilter)
+ by (auto simp: underS_ofilter Field_ofilter)
next
assume *: "ofilter A"
let ?One = "(\<exists>a\<in>Field r. A = underS a)"
@@ -451,7 +398,7 @@
have 3: "?a \<in> ?B" using minim_in[of ?B] 1 by blast
hence 4: "?a \<notin> A" by blast
have 5: "A \<le> Field r" using * ofilter_def by auto
- (* *)
+ (* *)
moreover
have "A = underS ?a"
proof
@@ -462,12 +409,12 @@
have 12: "x \<noteq> ?a" using 4 ** by auto
have 13: "under x \<le> A" using * ofilter_def ** by auto
{assume "(x,?a) \<notin> r"
- hence "(?a,x) \<in> r"
- using TOTAL total_on_def[of "Field r" r]
- 2 4 11 12 by auto
- hence "?a \<in> under x" using under_def[of r] by auto
- hence "?a \<in> A" using ** 13 by blast
- with 4 have False by simp
+ hence "(?a,x) \<in> r"
+ using TOTAL total_on_def[of "Field r" r]
+ 2 4 11 12 by auto
+ hence "?a \<in> under x" using under_def[of r] by auto
+ hence "?a \<in> A" using ** 13 by blast
+ with 4 have False by simp
}
then have "(x,?a) \<in> r" by blast
thus "x \<in> underS ?a"
@@ -479,13 +426,13 @@
fix x
assume **: "x \<in> underS ?a"
hence 11: "x \<in> Field r"
- using Field_def unfolding underS_def by fastforce
- {assume "x \<notin> A"
+ using Field_def unfolding underS_def by fastforce
+ {assume "x \<notin> A"
hence "x \<in> ?B" using 11 by auto
hence "(?a,x) \<in> r" using 3 minim_least[of ?B x] by blast
hence False
- using ANTISYM antisym_def[of r] ** unfolding underS_def by auto
- }
+ using ANTISYM antisym_def[of r] ** unfolding underS_def by auto
+ }
thus "x \<in> A" by blast
qed
qed
@@ -499,27 +446,27 @@
qed
lemma ofilter_UNION:
-"(\<And> i. i \<in> I \<Longrightarrow> ofilter(A i)) \<Longrightarrow> ofilter (\<Union>i \<in> I. A i)"
-unfolding ofilter_def by blast
+ "(\<And> i. i \<in> I \<Longrightarrow> ofilter(A i)) \<Longrightarrow> ofilter (\<Union>i \<in> I. A i)"
+ unfolding ofilter_def by blast
lemma ofilter_under_UNION:
-assumes "ofilter A"
-shows "A = (\<Union>a \<in> A. under a)"
+ assumes "ofilter A"
+ shows "A = (\<Union>a \<in> A. under a)"
proof
have "\<forall>a \<in> A. under a \<le> A"
- using assms ofilter_def by auto
+ using assms ofilter_def by auto
thus "(\<Union>a \<in> A. under a) \<le> A" by blast
next
have "\<forall>a \<in> A. a \<in> under a"
- using REFL Refl_under_in[of r] assms ofilter_def[of A] by blast
+ using REFL Refl_under_in[of r] assms ofilter_def[of A] by blast
thus "A \<le> (\<Union>a \<in> A. under a)" by blast
qed
subsubsection\<open>Other properties\<close>
lemma ofilter_linord:
-assumes OF1: "ofilter A" and OF2: "ofilter B"
-shows "A \<le> B \<or> B \<le> A"
+ assumes OF1: "ofilter A" and OF2: "ofilter B"
+ shows "A \<le> B \<or> B \<le> A"
proof(cases "A = Field r")
assume Case1: "A = Field r"
hence "B \<le> A" using OF2 ofilter_def by auto
@@ -527,7 +474,7 @@
next
assume Case2: "A \<noteq> Field r"
with ofilter_underS_Field OF1 obtain a where
- 1: "a \<in> Field r \<and> A = underS a" by auto
+ 1: "a \<in> Field r \<and> A = underS a" by auto
show ?thesis
proof(cases "B = Field r")
assume Case21: "B = Field r"
@@ -536,68 +483,68 @@
next
assume Case22: "B \<noteq> Field r"
with ofilter_underS_Field OF2 obtain b where
- 2: "b \<in> Field r \<and> B = underS b" by auto
+ 2: "b \<in> Field r \<and> B = underS b" by auto
have "a = b \<or> (a,b) \<in> r \<or> (b,a) \<in> r"
- using 1 2 TOTAL total_on_def[of _ r] by auto
+ using 1 2 TOTAL total_on_def[of _ r] by auto
moreover
{assume "a = b" with 1 2 have ?thesis by auto
}
moreover
{assume "(a,b) \<in> r"
- with underS_incr[of r] TRANS ANTISYM 1 2
- have "A \<le> B" by auto
- hence ?thesis by auto
+ with underS_incr[of r] TRANS ANTISYM 1 2
+ have "A \<le> B" by auto
+ hence ?thesis by auto
}
moreover
- {assume "(b,a) \<in> r"
- with underS_incr[of r] TRANS ANTISYM 1 2
- have "B \<le> A" by auto
- hence ?thesis by auto
+ {assume "(b,a) \<in> r"
+ with underS_incr[of r] TRANS ANTISYM 1 2
+ have "B \<le> A" by auto
+ hence ?thesis by auto
}
ultimately show ?thesis by blast
qed
qed
lemma ofilter_AboveS_Field:
-assumes "ofilter A"
-shows "A \<union> (AboveS A) = Field r"
+ assumes "ofilter A"
+ shows "A \<union> (AboveS A) = Field r"
proof
show "A \<union> (AboveS A) \<le> Field r"
- using assms ofilter_def AboveS_Field[of r] by auto
+ using assms ofilter_def AboveS_Field[of r] by auto
next
{fix x assume *: "x \<in> Field r" and **: "x \<notin> A"
- {fix y assume ***: "y \<in> A"
- with ** have 1: "y \<noteq> x" by auto
- {assume "(y,x) \<notin> r"
- moreover
- have "y \<in> Field r" using assms ofilter_def *** by auto
- ultimately have "(x,y) \<in> r"
- using 1 * TOTAL total_on_def[of _ r] by auto
- with *** assms ofilter_def under_def[of r] have "x \<in> A" by auto
- with ** have False by contradiction
+ {fix y assume ***: "y \<in> A"
+ with ** have 1: "y \<noteq> x" by auto
+ {assume "(y,x) \<notin> r"
+ moreover
+ have "y \<in> Field r" using assms ofilter_def *** by auto
+ ultimately have "(x,y) \<in> r"
+ using 1 * TOTAL total_on_def[of _ r] by auto
+ with *** assms ofilter_def under_def[of r] have "x \<in> A" by auto
+ with ** have False by contradiction
+ }
+ hence "(y,x) \<in> r" by blast
+ with 1 have "y \<noteq> x \<and> (y,x) \<in> r" by auto
}
- hence "(y,x) \<in> r" by blast
- with 1 have "y \<noteq> x \<and> (y,x) \<in> r" by auto
- }
- with * have "x \<in> AboveS A" unfolding AboveS_def by auto
+ with * have "x \<in> AboveS A" unfolding AboveS_def by auto
}
thus "Field r \<le> A \<union> (AboveS A)" by blast
qed
lemma suc_ofilter_in:
-assumes OF: "ofilter A" and ABOVE_NE: "AboveS A \<noteq> {}" and
- REL: "(b,suc A) \<in> r" and DIFF: "b \<noteq> suc A"
-shows "b \<in> A"
+ assumes OF: "ofilter A" and ABOVE_NE: "AboveS A \<noteq> {}" and
+ REL: "(b,suc A) \<in> r" and DIFF: "b \<noteq> suc A"
+ shows "b \<in> A"
proof-
have *: "suc A \<in> Field r \<and> b \<in> Field r"
- using WELL REL well_order_on_domain[of "Field r"] by auto
+ using WELL REL well_order_on_domain[of "Field r"] by auto
{assume **: "b \<notin> A"
- hence "b \<in> AboveS A"
- using OF * ofilter_AboveS_Field by auto
- hence "(suc A, b) \<in> r"
- using suc_least_AboveS by auto
- hence False using REL DIFF ANTISYM *
- by (auto simp add: antisym_def)
+ hence "b \<in> AboveS A"
+ using OF * ofilter_AboveS_Field by auto
+ hence "(suc A, b) \<in> r"
+ using suc_least_AboveS by auto
+ hence False using REL DIFF ANTISYM *
+ by (auto simp add: antisym_def)
}
thus ?thesis by blast
qed
--- a/src/HOL/Basic_BNFs.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Basic_BNFs.thy Sun Jan 15 20:00:44 2023 +0100
@@ -130,7 +130,7 @@
lemma rel_prod_conv:
"rel_prod R1 R2 = (\<lambda>(a, b) (c, d). R1 a c \<and> R2 b d)"
- by (rule ext, rule ext) auto
+ by force
definition
pred_fun :: "('a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
@@ -198,27 +198,22 @@
lemma regularCard_bd_fun: "regularCard (natLeq +c card_suc ( |UNIV| ))"
(is "regularCard (_ +c card_suc ?U)")
- apply (cases "Cinfinite ?U")
- apply (rule regularCard_csum)
- apply (rule natLeq_Cinfinite)
- apply (rule Cinfinite_card_suc)
- apply assumption
- apply (rule card_of_card_order_on)
- apply (rule regularCard_natLeq)
- apply (rule regularCard_card_suc)
- apply (rule card_of_card_order_on)
- apply assumption
- apply (rule regularCard_ordIso[of natLeq])
- apply (rule csum_absorb1[THEN ordIso_symmetric])
- apply (rule natLeq_Cinfinite)
- apply (rule card_suc_least)
- apply (rule card_of_card_order_on)
- apply (rule natLeq_Card_order)
- apply (subst finite_iff_ordLess_natLeq[symmetric])
- apply (simp add: cinfinite_def Field_card_of card_of_card_order_on)
- apply (rule natLeq_Cinfinite)
- apply (rule regularCard_natLeq)
- done
+proof (cases "Cinfinite ?U")
+ case True
+ then show ?thesis
+ by (intro regularCard_csum natLeq_Cinfinite Cinfinite_card_suc
+ card_of_card_order_on regularCard_natLeq regularCard_card_suc)
+next
+ case False
+ then have "card_suc ?U \<le>o natLeq"
+ unfolding cinfinite_def Field_card_of
+ by (intro card_suc_least;
+ simp add: natLeq_Card_order card_of_card_order_on flip: finite_iff_ordLess_natLeq)
+ then have "natLeq =o natLeq +c card_suc ?U"
+ using natLeq_Cinfinite csum_absorb1 ordIso_symmetric by blast
+ then show ?thesis
+ by (intro regularCard_ordIso[OF _ natLeq_Cinfinite regularCard_natLeq])
+qed
lemma ordLess_bd_fun: "|UNIV::'a set| <o natLeq +c card_suc ( |UNIV::'a set| )"
(is "_ <o (_ +c card_suc (?U :: 'a rel))")
--- a/src/HOL/Cardinals/Cardinal_Arithmetic.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Cardinal_Arithmetic.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,15 +8,15 @@
section \<open>Cardinal Arithmetic\<close>
theory Cardinal_Arithmetic
-imports Cardinal_Order_Relation
+ imports Cardinal_Order_Relation
begin
subsection \<open>Binary sum\<close>
lemma csum_Cnotzero2:
"Cnotzero r2 \<Longrightarrow> Cnotzero (r1 +c r2)"
-unfolding csum_def
-by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
+ unfolding csum_def
+ by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
lemma single_cone:
"|{x}| =o cone"
@@ -27,10 +27,10 @@
qed
lemma cone_Cnotzero: "Cnotzero cone"
-by (simp add: cone_not_czero Card_order_cone)
+ by (simp add: cone_not_czero Card_order_cone)
lemma cone_ordLeq_ctwo: "cone \<le>o ctwo"
-unfolding cone_def ctwo_def card_of_ordLeq[symmetric] by auto
+ unfolding cone_def ctwo_def card_of_ordLeq[symmetric] by auto
lemma csum_czero1: "Card_order r \<Longrightarrow> r +c czero =o r"
unfolding czero_def csum_def Field_card_of
@@ -44,7 +44,7 @@
subsection \<open>Product\<close>
lemma Times_cprod: "|A \<times> B| =o |A| *c |B|"
-by (simp only: cprod_def Field_card_of card_of_refl)
+ by (simp only: cprod_def Field_card_of card_of_refl)
lemma card_of_Times_singleton:
fixes A :: "'a set"
@@ -64,21 +64,20 @@
lemma cprod_cone: "Card_order r \<Longrightarrow> r *c cone =o r"
unfolding cprod_def cone_def Field_card_of
- by (drule card_of_Field_ordIso) (erule ordIso_transitive[OF card_of_Times_singleton])
-
+ by (metis (no_types) card_of_Field_ordIso card_of_Times_singleton ordIso_transitive)
lemma ordLeq_cprod1: "\<lbrakk>Card_order p1; Cnotzero p2\<rbrakk> \<Longrightarrow> p1 \<le>o p1 *c p2"
-unfolding cprod_def by (metis Card_order_Times1 czeroI)
+ unfolding cprod_def by (metis Card_order_Times1 czeroI)
subsection \<open>Exponentiation\<close>
lemma cexp_czero: "r ^c czero =o cone"
-unfolding cexp_def czero_def Field_card_of Func_empty by (rule single_cone)
+ unfolding cexp_def czero_def Field_card_of Func_empty by (rule single_cone)
lemma Pow_cexp_ctwo:
"|Pow A| =o ctwo ^c |A|"
-unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
+ by (simp add: card_of_Pow_Func cexp_def ctwo_def)
lemma Cnotzero_cexp:
assumes "Cnotzero q"
@@ -92,29 +91,24 @@
lemma Cinfinite_ctwo_cexp:
"Cinfinite r \<Longrightarrow> Cinfinite (ctwo ^c r)"
-unfolding ctwo_def cexp_def cinfinite_def Field_card_of
-by (rule conjI, rule infinite_Func, auto)
+ unfolding ctwo_def cexp_def cinfinite_def Field_card_of
+ by (rule conjI, rule infinite_Func, auto)
lemma cone_ordLeq_iff_Field:
assumes "cone \<le>o r"
shows "Field r \<noteq> {}"
-proof (rule ccontr)
- assume "\<not> Field r \<noteq> {}"
- hence "Field r = {}" by simp
- thus False using card_of_empty3
- card_of_mono2[OF assms] Cnotzero_imp_not_empty[OF cone_Cnotzero] by auto
-qed
+ by (metis assms card_of_empty3 card_of_mono2 cone_Cnotzero czeroI)
lemma cone_ordLeq_cexp: "cone \<le>o r1 \<Longrightarrow> cone \<le>o r1 ^c r2"
-by (simp add: cexp_def cone_def Func_non_emp cone_ordLeq_iff_Field)
+ by (simp add: cexp_def cone_def Func_non_emp cone_ordLeq_iff_Field)
lemma Card_order_czero: "Card_order czero"
-by (simp only: card_of_Card_order czero_def)
+ by (simp only: card_of_Card_order czero_def)
lemma cexp_mono2'':
assumes 2: "p2 \<le>o r2"
- and n1: "Cnotzero q"
- and n2: "Card_order p2"
+ and n1: "Cnotzero q"
+ and n2: "Card_order p2"
shows "q ^c p2 \<le>o q ^c r2"
proof (cases "p2 =o (czero :: 'a rel)")
case True
@@ -129,28 +123,20 @@
lemma csum_cexp: "\<lbrakk>Cinfinite r1; Cinfinite r2; Card_order q; ctwo \<le>o q\<rbrakk> \<Longrightarrow>
q ^c r1 +c q ^c r2 \<le>o q ^c (r1 +c r2)"
apply (rule csum_cinfinite_bound)
- apply (metis cexp_mono2' cinfinite_def finite.emptyI ordLeq_csum1)
- apply (metis cexp_mono2' cinfinite_def finite.emptyI ordLeq_csum2)
+ apply (metis cexp_mono2' cinfinite_def finite.emptyI ordLeq_csum1)
+ apply (metis cexp_mono2' cinfinite_def finite.emptyI ordLeq_csum2)
by (simp_all add: Card_order_cexp Cinfinite_csum1 Cinfinite_cexp cinfinite_cexp)
lemma csum_cexp': "\<lbrakk>Cinfinite r; Card_order q; ctwo \<le>o q\<rbrakk> \<Longrightarrow> q +c r \<le>o q ^c r"
-apply (rule csum_cinfinite_bound)
- apply (metis Cinfinite_Cnotzero ordLeq_cexp1)
- apply (metis ordLeq_cexp2)
- apply blast+
-by (metis Cinfinite_cexp)
+ apply (rule csum_cinfinite_bound)
+ apply (metis Cinfinite_Cnotzero ordLeq_cexp1)
+ apply (metis ordLeq_cexp2)
+ apply blast+
+ by (metis Cinfinite_cexp)
lemma card_of_Sigma_ordLeq_Cinfinite:
"\<lbrakk>Cinfinite r; |I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r\<rbrakk> \<Longrightarrow> |SIGMA i : I. A i| \<le>o r"
-unfolding cinfinite_def by (blast intro: card_of_Sigma_ordLeq_infinite_Field)
-
-lemma card_order_cexp:
- assumes "card_order r1" "card_order r2"
- shows "card_order (r1 ^c r2)"
-proof -
- have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
- thus ?thesis unfolding cexp_def Func_def by simp
-qed
+ unfolding cinfinite_def by (blast intro: card_of_Sigma_ordLeq_infinite_Field)
lemma Cinfinite_ordLess_cexp:
assumes r: "Cinfinite r"
@@ -165,19 +151,19 @@
lemma infinite_ordLeq_cexp:
assumes "Cinfinite r"
shows "r \<le>o r ^c r"
-by (rule ordLess_imp_ordLeq[OF Cinfinite_ordLess_cexp[OF assms]])
+ by (rule ordLess_imp_ordLeq[OF Cinfinite_ordLess_cexp[OF assms]])
lemma czero_cexp: "Cnotzero r \<Longrightarrow> czero ^c r =o czero"
- by (drule Cnotzero_imp_not_empty) (simp add: cexp_def czero_def card_of_empty_ordIso)
+ by (metis Cnotzero_imp_not_empty cexp_def czero_def card_of_empty_ordIso Field_card_of Func_is_emp)
lemma Func_singleton:
-fixes x :: 'b and A :: "'a set"
-shows "|Func A {x}| =o |{x}|"
+ fixes x :: 'b and A :: "'a set"
+ shows "|Func A {x}| =o |{x}|"
proof (rule ordIso_symmetric)
define f where [abs_def]: "f y a = (if y = x \<and> a \<in> A then x else undefined)" for y a
have "Func A {x} \<subseteq> f ` {x}" unfolding f_def Func_def by (force simp: fun_eq_iff)
- hence "bij_betw f {x} (Func A {x})" unfolding bij_betw_def inj_on_def f_def Func_def
- by (auto split: if_split_asm)
+ hence "bij_betw f {x} (Func A {x})"
+ unfolding bij_betw_def inj_on_def f_def Func_def by (auto split: if_split_asm)
thus "|{x}| =o |Func A {x}|" using card_of_ordIso by blast
qed
@@ -225,32 +211,32 @@
definition cpow where "cpow r = |Pow (Field r)|"
lemma card_order_cpow: "card_order r \<Longrightarrow> card_order (cpow r)"
-by (simp only: cpow_def Field_card_order Pow_UNIV card_of_card_order_on)
+ by (simp only: cpow_def Field_card_order Pow_UNIV card_of_card_order_on)
lemma cpow_greater_eq: "Card_order r \<Longrightarrow> r \<le>o cpow r"
-by (rule ordLess_imp_ordLeq) (simp only: cpow_def Card_order_Pow)
+ by (rule ordLess_imp_ordLeq) (simp only: cpow_def Card_order_Pow)
lemma Cinfinite_cpow: "Cinfinite r \<Longrightarrow> Cinfinite (cpow r)"
-unfolding cpow_def cinfinite_def by (metis Field_card_of card_of_Card_order infinite_Pow)
+ unfolding cpow_def cinfinite_def by simp
lemma Card_order_cpow: "Card_order (cpow r)"
-unfolding cpow_def by (rule card_of_Card_order)
+ unfolding cpow_def by (rule card_of_Card_order)
lemma cardSuc_ordLeq_cpow: "Card_order r \<Longrightarrow> cardSuc r \<le>o cpow r"
-unfolding cpow_def by (metis Card_order_Pow cardSuc_ordLess_ordLeq card_of_Card_order)
+ unfolding cpow_def by (metis Card_order_Pow cardSuc_ordLess_ordLeq card_of_Card_order)
lemma cpow_cexp_ctwo: "cpow r =o ctwo ^c r"
-unfolding cpow_def ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
+ unfolding cpow_def ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
subsection \<open>Inverse image\<close>
lemma vimage_ordLeq:
-assumes "|A| \<le>o k" and "\<forall> a \<in> A. |vimage f {a}| \<le>o k" and "Cinfinite k"
-shows "|vimage f A| \<le>o k"
+ assumes "|A| \<le>o k" and "\<forall> a \<in> A. |vimage f {a}| \<le>o k" and "Cinfinite k"
+ shows "|vimage f A| \<le>o k"
proof-
have "vimage f A = (\<Union>a \<in> A. vimage f {a})" by auto
also have "|\<Union>a \<in> A. vimage f {a}| \<le>o k"
- using UNION_Cinfinite_bound[OF assms] .
+ using UNION_Cinfinite_bound[OF assms] .
finally show ?thesis .
qed
@@ -268,7 +254,8 @@
lemma cmax1:
assumes "Card_order r" "Card_order s" "s \<le>o r"
shows "cmax r s =o r"
-unfolding cmax_def proof (split if_splits, intro conjI impI)
+ unfolding cmax_def
+proof (split if_splits, intro conjI impI)
assume "cinfinite r \<or> cinfinite s"
hence Cinf: "Cinfinite r" using assms(1,3) by (metis cinfinite_mono)
have "czero +c r +c s =o r +c s" by (rule csum_czero2[OF Card_order_csum])
@@ -299,33 +286,14 @@
shows "cmax r s =o s"
by (metis assms cmax1 cmax_com ordIso_transitive)
-lemma csum_absorb2: "Cinfinite r2 \<Longrightarrow> r1 \<le>o r2 \<Longrightarrow> r1 +c r2 =o r2"
- by (metis csum_absorb2')
-
-lemma cprod_infinite2': "\<lbrakk>Cnotzero r1; Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r1 *c r2 =o r2"
- unfolding ordIso_iff_ordLeq
- by (intro conjI cprod_cinfinite_bound ordLeq_cprod2 ordLeq_refl)
- (auto dest!: ordIso_imp_ordLeq not_ordLeq_ordLess simp: czero_def Card_order_empty)
-
context
fixes r s
assumes r: "Cinfinite r"
- and s: "Cinfinite s"
+ and s: "Cinfinite s"
begin
lemma cmax_csum: "cmax r s =o r +c s"
-proof (cases "r \<le>o s")
- case True
- hence "cmax r s =o s" by (metis cmax2 r s)
- also have "s =o r +c s" by (metis True csum_absorb2 ordIso_symmetric s)
- finally show ?thesis .
-next
- case False
- hence "s \<le>o r" by (metis ordLeq_total r s card_order_on_def)
- hence "cmax r s =o r" by (metis cmax1 r s)
- also have "r =o r +c s" by (metis \<open>s \<le>o r\<close> csum_absorb1 ordIso_symmetric r)
- finally show ?thesis .
-qed
+ by (simp add: Card_order_csum cmax_def csum_czero2 r)
lemma cmax_cprod: "cmax r s =o r *c s"
proof (cases "r \<le>o s")
@@ -344,39 +312,21 @@
end
lemma Card_order_cmax:
-assumes r: "Card_order r" and s: "Card_order s"
-shows "Card_order (cmax r s)"
-unfolding cmax_def by (auto simp: Card_order_csum)
+ assumes r: "Card_order r" and s: "Card_order s"
+ shows "Card_order (cmax r s)"
+ unfolding cmax_def by (auto simp: Card_order_csum)
lemma ordLeq_cmax:
-assumes r: "Card_order r" and s: "Card_order s"
-shows "r \<le>o cmax r s \<and> s \<le>o cmax r s"
-proof-
- {assume "r \<le>o s"
- hence ?thesis by (metis cmax2 ordIso_iff_ordLeq ordLeq_transitive r s)
- }
- moreover
- {assume "s \<le>o r"
- hence ?thesis using cmax_com by (metis cmax2 ordIso_iff_ordLeq ordLeq_transitive r s)
- }
- ultimately show ?thesis using r s ordLeq_total unfolding card_order_on_def by auto
-qed
+ assumes r: "Card_order r" and s: "Card_order s"
+ shows "r \<le>o cmax r s \<and> s \<le>o cmax r s"
+ by (meson card_order_on_def cmax1 cmax2 ordIso_iff_ordLeq ordLeq_total ordLeq_transitive r s)
lemmas ordLeq_cmax1 = ordLeq_cmax[THEN conjunct1] and
- ordLeq_cmax2 = ordLeq_cmax[THEN conjunct2]
+ ordLeq_cmax2 = ordLeq_cmax[THEN conjunct2]
lemma finite_cmax:
-assumes r: "Card_order r" and s: "Card_order s"
-shows "finite (Field (cmax r s)) \<longleftrightarrow> finite (Field r) \<and> finite (Field s)"
-proof-
- {assume "r \<le>o s"
- hence ?thesis by (metis cmax2 ordIso_finite_Field ordLeq_finite_Field r s)
- }
- moreover
- {assume "s \<le>o r"
- hence ?thesis by (metis cmax1 ordIso_finite_Field ordLeq_finite_Field r s)
- }
- ultimately show ?thesis using r s ordLeq_total unfolding card_order_on_def by auto
-qed
+ assumes r: "Card_order r" and s: "Card_order s"
+ shows "finite (Field (cmax r s)) \<longleftrightarrow> finite (Field r) \<and> finite (Field s)"
+ by (meson card_order_on_def cmax1 cmax2 ordIso_finite_Field ordLeq_finite_Field ordLeq_total r s)
end
--- a/src/HOL/Cardinals/Cardinal_Order_Relation.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Cardinal_Order_Relation.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,7 +8,7 @@
section \<open>Cardinal-Order Relations\<close>
theory Cardinal_Order_Relation
-imports Wellorder_Constructions
+ imports Wellorder_Constructions
begin
declare
@@ -23,7 +23,6 @@
card_of_mono1[simp]
card_of_mono2[simp]
card_of_cong[simp]
- card_of_Field_ordLess[simp]
card_of_Field_ordIso[simp]
card_of_underS[simp]
ordLess_Field[simp]
@@ -72,46 +71,36 @@
subsection \<open>Cardinal of a set\<close>
lemma card_of_inj_rel: assumes INJ: "\<And>x y y'. \<lbrakk>(x,y) \<in> R; (x,y') \<in> R\<rbrakk> \<Longrightarrow> y = y'"
-shows "|{y. \<exists>x. (x,y) \<in> R}| <=o |{x. \<exists>y. (x,y) \<in> R}|"
+ shows "|{y. \<exists>x. (x,y) \<in> R}| <=o |{x. \<exists>y. (x,y) \<in> R}|"
proof-
let ?Y = "{y. \<exists>x. (x,y) \<in> R}" let ?X = "{x. \<exists>y. (x,y) \<in> R}"
let ?f = "\<lambda>y. SOME x. (x,y) \<in> R"
have "?f ` ?Y <= ?X" by (auto dest: someI)
moreover have "inj_on ?f ?Y"
- unfolding inj_on_def proof(auto)
- fix y1 x1 y2 x2
- assume *: "(x1, y1) \<in> R" "(x2, y2) \<in> R" and **: "?f y1 = ?f y2"
- hence "(?f y1,y1) \<in> R" using someI[of "\<lambda>x. (x,y1) \<in> R"] by auto
- moreover have "(?f y2,y2) \<in> R" using * someI[of "\<lambda>x. (x,y2) \<in> R"] by auto
- ultimately show "y1 = y2" using ** INJ by auto
- qed
+ by (metis (mono_tags, lifting) assms inj_onI mem_Collect_eq)
ultimately show "|?Y| <=o |?X|" using card_of_ordLeq by blast
qed
lemma card_of_unique2: "\<lbrakk>card_order_on B r; bij_betw f A B\<rbrakk> \<Longrightarrow> r =o |A|"
-using card_of_ordIso card_of_unique ordIso_equivalence by blast
+ using card_of_ordIso card_of_unique ordIso_equivalence by blast
lemma internalize_card_of_ordLess2:
-"( |A| <o |C| ) = (\<exists>B < C. |A| =o |B| \<and> |B| <o |C| )"
-using internalize_card_of_ordLess[of "A" "|C|"] Field_card_of[of C] by auto
+ "( |A| <o |C| ) = (\<exists>B < C. |A| =o |B| \<and> |B| <o |C| )"
+ using internalize_card_of_ordLess[of "A" "|C|"] Field_card_of[of C] by auto
lemma Card_order_omax:
-assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Card_order r"
-shows "Card_order (omax R)"
-proof-
- have "\<forall>r\<in>R. Well_order r"
- using assms unfolding card_order_on_def by simp
- thus ?thesis using assms apply - apply(drule omax_in) by auto
-qed
+ assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Card_order r"
+ shows "Card_order (omax R)"
+ by (simp add: assms omax_in)
lemma Card_order_omax2:
-assumes "finite I" and "I \<noteq> {}"
-shows "Card_order (omax {|A i| | i. i \<in> I})"
+ assumes "finite I" and "I \<noteq> {}"
+ shows "Card_order (omax {|A i| | i. i \<in> I})"
proof-
let ?R = "{|A i| | i. i \<in> I}"
have "finite ?R" and "?R \<noteq> {}" using assms by auto
moreover have "\<forall>r\<in>?R. Card_order r"
- using card_of_Card_order by auto
+ using card_of_Card_order by auto
ultimately show ?thesis by(rule Card_order_omax)
qed
@@ -119,138 +108,104 @@
subsection \<open>Cardinals versus set operations on arbitrary sets\<close>
lemma card_of_set_type[simp]: "|UNIV::'a set| <o |UNIV::'a set set|"
-using card_of_Pow[of "UNIV::'a set"] by simp
+ using card_of_Pow[of "UNIV::'a set"] by simp
-lemma card_of_Un1[simp]:
-shows "|A| \<le>o |A \<union> B| "
-using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
+lemma card_of_Un1[simp]: "|A| \<le>o |A \<union> B| "
+ by fastforce
-lemma card_of_diff[simp]:
-shows "|A - B| \<le>o |A|"
-using inj_on_id[of "A - B"] card_of_ordLeq[of "A - B" _] by fastforce
+lemma card_of_diff[simp]: "|A - B| \<le>o |A|"
+ by fastforce
lemma subset_ordLeq_strict:
-assumes "A \<le> B" and "|A| <o |B|"
-shows "A < B"
-proof-
- {assume "\<not>(A < B)"
- hence "A = B" using assms(1) by blast
- hence False using assms(2) not_ordLess_ordIso card_of_refl by blast
- }
- thus ?thesis by blast
-qed
+ assumes "A \<le> B" and "|A| <o |B|"
+ shows "A < B"
+ using assms ordLess_irreflexive by blast
corollary subset_ordLeq_diff:
-assumes "A \<le> B" and "|A| <o |B|"
-shows "B - A \<noteq> {}"
-using assms subset_ordLeq_strict by blast
+ assumes "A \<le> B" and "|A| <o |B|"
+ shows "B - A \<noteq> {}"
+ using assms subset_ordLeq_strict by blast
lemma card_of_empty4:
-"|{}::'b set| <o |A::'a set| = (A \<noteq> {})"
-proof(intro iffI notI)
- assume *: "|{}::'b set| <o |A|" and "A = {}"
- hence "|A| =o |{}::'b set|"
- using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
- hence "|{}::'b set| =o |A|" using ordIso_symmetric by blast
- with * show False using not_ordLess_ordIso[of "|{}::'b set|" "|A|"] by blast
-next
- assume "A \<noteq> {}"
- hence "(\<not> (\<exists>f. inj_on f A \<and> f ` A \<subseteq> {}))"
- unfolding inj_on_def by blast
- thus "| {} | <o | A |"
- using card_of_ordLess by blast
-qed
+ "|{}::'b set| <o |A::'a set| = (A \<noteq> {})"
+ by (metis card_of_empty card_of_ordLess2 image_is_empty not_ordLess_ordLeq)
lemma card_of_empty5:
-"|A| <o |B| \<Longrightarrow> B \<noteq> {}"
-using card_of_empty not_ordLess_ordLeq by blast
+ "|A| <o |B| \<Longrightarrow> B \<noteq> {}"
+ using card_of_empty not_ordLess_ordLeq by blast
lemma Well_order_card_of_empty:
-"Well_order r \<Longrightarrow> |{}| \<le>o r" by simp
+ "Well_order r \<Longrightarrow> |{}| \<le>o r"
+ by simp
lemma card_of_UNIV[simp]:
-"|A :: 'a set| \<le>o |UNIV :: 'a set|"
-using card_of_mono1[of A] by simp
+ "|A :: 'a set| \<le>o |UNIV :: 'a set|"
+ by simp
lemma card_of_UNIV2[simp]:
-"Card_order r \<Longrightarrow> (r :: 'a rel) \<le>o |UNIV :: 'a set|"
-using card_of_UNIV[of "Field r"] card_of_Field_ordIso
- ordIso_symmetric ordIso_ordLeq_trans by blast
+ "Card_order r \<Longrightarrow> (r :: 'a rel) \<le>o |UNIV :: 'a set|"
+ using card_of_UNIV[of "Field r"] card_of_Field_ordIso
+ ordIso_symmetric ordIso_ordLeq_trans by blast
lemma card_of_Pow_mono[simp]:
-assumes "|A| \<le>o |B|"
-shows "|Pow A| \<le>o |Pow B|"
+ assumes "|A| \<le>o |B|"
+ shows "|Pow A| \<le>o |Pow B|"
proof-
obtain f where "inj_on f A \<and> f ` A \<le> B"
- using assms card_of_ordLeq[of A B] by auto
+ using assms card_of_ordLeq[of A B] by auto
hence "inj_on (image f) (Pow A) \<and> (image f) ` (Pow A) \<le> (Pow B)"
- by (auto simp add: inj_on_image_Pow image_Pow_mono)
+ by (auto simp: inj_on_image_Pow image_Pow_mono)
thus ?thesis using card_of_ordLeq[of "Pow A"] by metis
qed
lemma ordIso_Pow_mono[simp]:
-assumes "r \<le>o r'"
-shows "|Pow(Field r)| \<le>o |Pow(Field r')|"
-using assms card_of_mono2 card_of_Pow_mono by blast
+ assumes "r \<le>o r'"
+ shows "|Pow(Field r)| \<le>o |Pow(Field r')|"
+ using assms card_of_mono2 card_of_Pow_mono by blast
lemma card_of_Pow_cong[simp]:
-assumes "|A| =o |B|"
-shows "|Pow A| =o |Pow B|"
-proof-
- obtain f where "bij_betw f A B"
- using assms card_of_ordIso[of A B] by auto
- hence "bij_betw (image f) (Pow A) (Pow B)"
- by (auto simp add: bij_betw_image_Pow)
- thus ?thesis using card_of_ordIso[of "Pow A"] by auto
-qed
+ assumes "|A| =o |B|"
+ shows "|Pow A| =o |Pow B|"
+ by (meson assms card_of_Pow_mono ordIso_iff_ordLeq)
lemma ordIso_Pow_cong[simp]:
-assumes "r =o r'"
-shows "|Pow(Field r)| =o |Pow(Field r')|"
-using assms card_of_cong card_of_Pow_cong by blast
+ assumes "r =o r'"
+ shows "|Pow(Field r)| =o |Pow(Field r')|"
+ using assms card_of_cong card_of_Pow_cong by blast
corollary Card_order_Plus_empty1:
-"Card_order r \<Longrightarrow> r =o |(Field r) <+> {}|"
-using card_of_Plus_empty1 card_of_Field_ordIso ordIso_equivalence by blast
+ "Card_order r \<Longrightarrow> r =o |(Field r) <+> {}|"
+ using card_of_Plus_empty1 card_of_Field_ordIso ordIso_equivalence by blast
corollary Card_order_Plus_empty2:
-"Card_order r \<Longrightarrow> r =o |{} <+> (Field r)|"
-using card_of_Plus_empty2 card_of_Field_ordIso ordIso_equivalence by blast
-
-lemma Card_order_Un1:
-shows "Card_order r \<Longrightarrow> |Field r| \<le>o |(Field r) \<union> B| "
-using card_of_Un1 card_of_Field_ordIso ordIso_symmetric ordIso_ordLeq_trans by auto
+ "Card_order r \<Longrightarrow> r =o |{} <+> (Field r)|"
+ using card_of_Plus_empty2 card_of_Field_ordIso ordIso_equivalence by blast
lemma card_of_Un2[simp]:
-shows "|A| \<le>o |B \<union> A|"
-using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
-
-lemma Card_order_Un2:
-shows "Card_order r \<Longrightarrow> |Field r| \<le>o |A \<union> (Field r)| "
-using card_of_Un2 card_of_Field_ordIso ordIso_symmetric ordIso_ordLeq_trans by auto
+ shows "|A| \<le>o |B \<union> A|"
+ by fastforce
lemma Un_Plus_bij_betw:
-assumes "A Int B = {}"
-shows "\<exists>f. bij_betw f (A \<union> B) (A <+> B)"
+ assumes "A Int B = {}"
+ shows "\<exists>f. bij_betw f (A \<union> B) (A <+> B)"
proof-
- let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
- have "bij_betw ?f (A \<union> B) (A <+> B)"
- using assms by(unfold bij_betw_def inj_on_def, auto)
+ have "bij_betw (\<lambda> c. if c \<in> A then Inl c else Inr c) (A \<union> B) (A <+> B)"
+ using assms unfolding bij_betw_def inj_on_def by auto
thus ?thesis by blast
qed
lemma card_of_Un_Plus_ordIso:
-assumes "A Int B = {}"
-shows "|A \<union> B| =o |A <+> B|"
-using assms card_of_ordIso[of "A \<union> B"] Un_Plus_bij_betw[of A B] by auto
+ assumes "A Int B = {}"
+ shows "|A \<union> B| =o |A <+> B|"
+ by (meson Un_Plus_bij_betw assms card_of_ordIso)
lemma card_of_Un_Plus_ordIso1:
-"|A \<union> B| =o |A <+> (B - A)|"
-using card_of_Un_Plus_ordIso[of A "B - A"] by auto
+ "|A \<union> B| =o |A <+> (B - A)|"
+ using card_of_Un_Plus_ordIso[of A "B - A"] by auto
lemma card_of_Un_Plus_ordIso2:
-"|A \<union> B| =o |(A - B) <+> B|"
-using card_of_Un_Plus_ordIso[of "A - B" B] by auto
+ "|A \<union> B| =o |(A - B) <+> B|"
+ using card_of_Un_Plus_ordIso[of "A - B" B] by auto
lemma card_of_Times_singl1: "|A| =o |A \<times> {b}|"
proof-
@@ -259,18 +214,19 @@
qed
corollary Card_order_Times_singl1:
-"Card_order r \<Longrightarrow> r =o |(Field r) \<times> {b}|"
-using card_of_Times_singl1[of _ b] card_of_Field_ordIso ordIso_equivalence by blast
+ "Card_order r \<Longrightarrow> r =o |(Field r) \<times> {b}|"
+ using card_of_Times_singl1[of _ b] card_of_Field_ordIso ordIso_equivalence by blast
lemma card_of_Times_singl2: "|A| =o |{b} \<times> A|"
proof-
- have "bij_betw snd ({b} \<times> A) A" unfolding bij_betw_def inj_on_def by force
+ have "bij_betw snd ({b} \<times> A) A"
+ unfolding bij_betw_def inj_on_def by force
thus ?thesis using card_of_ordIso ordIso_symmetric by blast
qed
corollary Card_order_Times_singl2:
-"Card_order r \<Longrightarrow> r =o |{a} \<times> (Field r)|"
-using card_of_Times_singl2[of _ a] card_of_Field_ordIso ordIso_equivalence by blast
+ "Card_order r \<Longrightarrow> r =o |{a} \<times> (Field r)|"
+ using card_of_Times_singl2[of _ a] card_of_Field_ordIso ordIso_equivalence by blast
lemma card_of_Times_assoc: "|(A \<times> B) \<times> C| =o |A \<times> B \<times> C|"
proof -
@@ -284,118 +240,111 @@
thus "x \<in> ?f ` ((A \<times> B) \<times> C)" by blast
qed
hence "bij_betw ?f ((A \<times> B) \<times> C) (A \<times> B \<times> C)"
- unfolding bij_betw_def inj_on_def by auto
+ unfolding bij_betw_def inj_on_def by auto
thus ?thesis using card_of_ordIso by blast
qed
-corollary Card_order_Times3:
-"Card_order r \<Longrightarrow> |Field r| \<le>o |(Field r) \<times> (Field r)|"
- by (rule card_of_Times3)
-
lemma card_of_Times_cong1[simp]:
-assumes "|A| =o |B|"
-shows "|A \<times> C| =o |B \<times> C|"
-using assms by (simp add: ordIso_iff_ordLeq)
+ assumes "|A| =o |B|"
+ shows "|A \<times> C| =o |B \<times> C|"
+ using assms by (simp add: ordIso_iff_ordLeq)
lemma card_of_Times_cong2[simp]:
-assumes "|A| =o |B|"
-shows "|C \<times> A| =o |C \<times> B|"
-using assms by (simp add: ordIso_iff_ordLeq)
+ assumes "|A| =o |B|"
+ shows "|C \<times> A| =o |C \<times> B|"
+ using assms by (simp add: ordIso_iff_ordLeq)
lemma card_of_Times_mono[simp]:
-assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
-shows "|A \<times> C| \<le>o |B \<times> D|"
-using assms card_of_Times_mono1[of A B C] card_of_Times_mono2[of C D B]
- ordLeq_transitive[of "|A \<times> C|"] by blast
+ assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
+ shows "|A \<times> C| \<le>o |B \<times> D|"
+ using assms card_of_Times_mono1[of A B C] card_of_Times_mono2[of C D B]
+ ordLeq_transitive[of "|A \<times> C|"] by blast
corollary ordLeq_Times_mono:
-assumes "r \<le>o r'" and "p \<le>o p'"
-shows "|(Field r) \<times> (Field p)| \<le>o |(Field r') \<times> (Field p')|"
-using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Times_mono by blast
+ assumes "r \<le>o r'" and "p \<le>o p'"
+ shows "|(Field r) \<times> (Field p)| \<le>o |(Field r') \<times> (Field p')|"
+ using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Times_mono by blast
corollary ordIso_Times_cong1[simp]:
-assumes "r =o r'"
-shows "|(Field r) \<times> C| =o |(Field r') \<times> C|"
-using assms card_of_cong card_of_Times_cong1 by blast
+ assumes "r =o r'"
+ shows "|(Field r) \<times> C| =o |(Field r') \<times> C|"
+ using assms card_of_cong card_of_Times_cong1 by blast
corollary ordIso_Times_cong2:
-assumes "r =o r'"
-shows "|A \<times> (Field r)| =o |A \<times> (Field r')|"
-using assms card_of_cong card_of_Times_cong2 by blast
+ assumes "r =o r'"
+ shows "|A \<times> (Field r)| =o |A \<times> (Field r')|"
+ using assms card_of_cong card_of_Times_cong2 by blast
lemma card_of_Times_cong[simp]:
-assumes "|A| =o |B|" and "|C| =o |D|"
-shows "|A \<times> C| =o |B \<times> D|"
-using assms
-by (auto simp add: ordIso_iff_ordLeq)
+ assumes "|A| =o |B|" and "|C| =o |D|"
+ shows "|A \<times> C| =o |B \<times> D|"
+ using assms
+ by (auto simp: ordIso_iff_ordLeq)
corollary ordIso_Times_cong:
-assumes "r =o r'" and "p =o p'"
-shows "|(Field r) \<times> (Field p)| =o |(Field r') \<times> (Field p')|"
-using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Times_cong by blast
+ assumes "r =o r'" and "p =o p'"
+ shows "|(Field r) \<times> (Field p)| =o |(Field r') \<times> (Field p')|"
+ using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Times_cong by blast
lemma card_of_Sigma_mono2:
-assumes "inj_on f (I::'i set)" and "f ` I \<le> (J::'j set)"
-shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| \<le>o |SIGMA j : J. A j|"
+ assumes "inj_on f (I::'i set)" and "f ` I \<le> (J::'j set)"
+ shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| \<le>o |SIGMA j : J. A j|"
proof-
let ?LEFT = "SIGMA i : I. A (f i)"
let ?RIGHT = "SIGMA j : J. A j"
obtain u where u_def: "u = (\<lambda>(i::'i,a::'a). (f i,a))" by blast
have "inj_on u ?LEFT \<and> u `?LEFT \<le> ?RIGHT"
- using assms unfolding u_def inj_on_def by auto
+ using assms unfolding u_def inj_on_def by auto
thus ?thesis using card_of_ordLeq by blast
qed
lemma card_of_Sigma_mono:
-assumes INJ: "inj_on f I" and IM: "f ` I \<le> J" and
- LEQ: "\<forall>j \<in> J. |A j| \<le>o |B j|"
-shows "|SIGMA i : I. A (f i)| \<le>o |SIGMA j : J. B j|"
+ assumes INJ: "inj_on f I" and IM: "f ` I \<le> J" and
+ LEQ: "\<forall>j \<in> J. |A j| \<le>o |B j|"
+ shows "|SIGMA i : I. A (f i)| \<le>o |SIGMA j : J. B j|"
proof-
have "\<forall>i \<in> I. |A(f i)| \<le>o |B(f i)|"
- using IM LEQ by blast
+ using IM LEQ by blast
hence "|SIGMA i : I. A (f i)| \<le>o |SIGMA i : I. B (f i)|"
- using card_of_Sigma_mono1[of I] by metis
+ using card_of_Sigma_mono1[of I] by metis
moreover have "|SIGMA i : I. B (f i)| \<le>o |SIGMA j : J. B j|"
- using INJ IM card_of_Sigma_mono2 by blast
+ using INJ IM card_of_Sigma_mono2 by blast
ultimately show ?thesis using ordLeq_transitive by blast
qed
lemma ordLeq_Sigma_mono1:
-assumes "\<forall>i \<in> I. p i \<le>o r i"
-shows "|SIGMA i : I. Field(p i)| \<le>o |SIGMA i : I. Field(r i)|"
-using assms by (auto simp add: card_of_Sigma_mono1)
+ assumes "\<forall>i \<in> I. p i \<le>o r i"
+ shows "|SIGMA i : I. Field(p i)| \<le>o |SIGMA i : I. Field(r i)|"
+ using assms by (auto simp: card_of_Sigma_mono1)
lemma ordLeq_Sigma_mono:
-assumes "inj_on f I" and "f ` I \<le> J" and
- "\<forall>j \<in> J. p j \<le>o r j"
-shows "|SIGMA i : I. Field(p(f i))| \<le>o |SIGMA j : J. Field(r j)|"
-using assms card_of_mono2 card_of_Sigma_mono
- [of f I J "\<lambda> i. Field(p i)" "\<lambda> j. Field(r j)"] by metis
+ assumes "inj_on f I" and "f ` I \<le> J" and
+ "\<forall>j \<in> J. p j \<le>o r j"
+ shows "|SIGMA i : I. Field(p(f i))| \<le>o |SIGMA j : J. Field(r j)|"
+ using assms card_of_mono2 card_of_Sigma_mono [of f I J "\<lambda> i. Field(p i)"] by metis
lemma ordIso_Sigma_cong1:
-assumes "\<forall>i \<in> I. p i =o r i"
-shows "|SIGMA i : I. Field(p i)| =o |SIGMA i : I. Field(r i)|"
-using assms by (auto simp add: card_of_Sigma_cong1)
+ assumes "\<forall>i \<in> I. p i =o r i"
+ shows "|SIGMA i : I. Field(p i)| =o |SIGMA i : I. Field(r i)|"
+ using assms by (auto simp: card_of_Sigma_cong1)
lemma ordLeq_Sigma_cong:
-assumes "bij_betw f I J" and
- "\<forall>j \<in> J. p j =o r j"
-shows "|SIGMA i : I. Field(p(f i))| =o |SIGMA j : J. Field(r j)|"
-using assms card_of_cong card_of_Sigma_cong
- [of f I J "\<lambda> j. Field(p j)" "\<lambda> j. Field(r j)"] by blast
+ assumes "bij_betw f I J" and
+ "\<forall>j \<in> J. p j =o r j"
+ shows "|SIGMA i : I. Field(p(f i))| =o |SIGMA j : J. Field(r j)|"
+ using assms card_of_cong card_of_Sigma_cong
+ [of f I J "\<lambda> j. Field(p j)" "\<lambda> j. Field(r j)"] by blast
lemma card_of_UNION_Sigma2:
-assumes
-"!! i j. \<lbrakk>{i,j} <= I; i ~= j\<rbrakk> \<Longrightarrow> A i Int A j = {}"
-shows
-"|\<Union>i\<in>I. A i| =o |Sigma I A|"
+ assumes "\<And>i j. \<lbrakk>{i,j} <= I; i \<noteq> j\<rbrakk> \<Longrightarrow> A i Int A j = {}"
+ shows "|\<Union>i\<in>I. A i| =o |Sigma I A|"
proof-
let ?L = "\<Union>i\<in>I. A i" let ?R = "Sigma I A"
have "|?L| <=o |?R|" using card_of_UNION_Sigma .
moreover have "|?R| <=o |?L|"
proof-
have "inj_on snd ?R"
- unfolding inj_on_def using assms by auto
+ unfolding inj_on_def using assms by auto
moreover have "snd ` ?R <= ?L" by auto
ultimately show ?thesis using card_of_ordLeq by blast
qed
@@ -403,102 +352,91 @@
qed
corollary Plus_into_Times:
-assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
- B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
-shows "\<exists>f. inj_on f (A <+> B) \<and> f ` (A <+> B) \<le> A \<times> B"
-using assms by (auto simp add: card_of_Plus_Times card_of_ordLeq)
+ assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
+ shows "\<exists>f. inj_on f (A <+> B) \<and> f ` (A <+> B) \<le> A \<times> B"
+ using assms by (auto simp: card_of_Plus_Times card_of_ordLeq)
corollary Plus_into_Times_types:
-assumes A2: "(a1::'a) \<noteq> a2" and B2: "(b1::'b) \<noteq> b2"
-shows "\<exists>(f::'a + 'b \<Rightarrow> 'a * 'b). inj f"
-using assms Plus_into_Times[of a1 a2 UNIV b1 b2 UNIV]
-by auto
+ assumes A2: "(a1::'a) \<noteq> a2" and B2: "(b1::'b) \<noteq> b2"
+ shows "\<exists>(f::'a + 'b \<Rightarrow> 'a * 'b). inj f"
+ using assms Plus_into_Times[of a1 a2 UNIV b1 b2 UNIV]
+ by auto
corollary Times_same_infinite_bij_betw:
-assumes "\<not>finite A"
-shows "\<exists>f. bij_betw f (A \<times> A) A"
-using assms by (auto simp add: card_of_ordIso)
+ assumes "\<not>finite A"
+ shows "\<exists>f. bij_betw f (A \<times> A) A"
+ using assms by (auto simp: card_of_ordIso)
corollary Times_same_infinite_bij_betw_types:
-assumes INF: "\<not>finite(UNIV::'a set)"
-shows "\<exists>(f::('a * 'a) => 'a). bij f"
-using assms Times_same_infinite_bij_betw[of "UNIV::'a set"]
-by auto
+ assumes INF: "\<not>finite(UNIV::'a set)"
+ shows "\<exists>(f::('a * 'a) => 'a). bij f"
+ using assms Times_same_infinite_bij_betw[of "UNIV::'a set"]
+ by auto
corollary Times_infinite_bij_betw:
-assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and INJ: "inj_on g B \<and> g ` B \<le> A"
-shows "(\<exists>f. bij_betw f (A \<times> B) A) \<and> (\<exists>h. bij_betw h (B \<times> A) A)"
+ assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and INJ: "inj_on g B \<and> g ` B \<le> A"
+ shows "(\<exists>f. bij_betw f (A \<times> B) A) \<and> (\<exists>h. bij_betw h (B \<times> A) A)"
proof-
have "|B| \<le>o |A|" using INJ card_of_ordLeq by blast
thus ?thesis using INF NE
- by (auto simp add: card_of_ordIso card_of_Times_infinite)
+ by (auto simp: card_of_ordIso card_of_Times_infinite)
qed
corollary Times_infinite_bij_betw_types:
-assumes INF: "\<not>finite(UNIV::'a set)" and
- BIJ: "inj(g::'b \<Rightarrow> 'a)"
-shows "(\<exists>(f::('b * 'a) => 'a). bij f) \<and> (\<exists>(h::('a * 'b) => 'a). bij h)"
-using assms Times_infinite_bij_betw[of "UNIV::'a set" "UNIV::'b set" g]
-by auto
+ assumes "\<not>finite(UNIV::'a set)" and "inj(g::'b \<Rightarrow> 'a)"
+ shows "(\<exists>(f::('b * 'a) => 'a). bij f) \<and> (\<exists>(h::('a * 'b) => 'a). bij h)"
+ using assms Times_infinite_bij_betw[of "UNIV::'a set" "UNIV::'b set" g]
+ by auto
lemma card_of_Times_ordLeq_infinite:
-"\<lbrakk>\<not>finite C; |A| \<le>o |C|; |B| \<le>o |C|\<rbrakk>
- \<Longrightarrow> |A \<times> B| \<le>o |C|"
-by(simp add: card_of_Sigma_ordLeq_infinite)
+ "\<lbrakk>\<not>finite C; |A| \<le>o |C|; |B| \<le>o |C|\<rbrakk> \<Longrightarrow> |A \<times> B| \<le>o |C|"
+ by(simp add: card_of_Sigma_ordLeq_infinite)
corollary Plus_infinite_bij_betw:
-assumes INF: "\<not>finite A" and INJ: "inj_on g B \<and> g ` B \<le> A"
-shows "(\<exists>f. bij_betw f (A <+> B) A) \<and> (\<exists>h. bij_betw h (B <+> A) A)"
+ assumes INF: "\<not>finite A" and INJ: "inj_on g B \<and> g ` B \<le> A"
+ shows "(\<exists>f. bij_betw f (A <+> B) A) \<and> (\<exists>h. bij_betw h (B <+> A) A)"
proof-
have "|B| \<le>o |A|" using INJ card_of_ordLeq by blast
thus ?thesis using INF
- by (auto simp add: card_of_ordIso)
+ by (auto simp: card_of_ordIso)
qed
corollary Plus_infinite_bij_betw_types:
-assumes INF: "\<not>finite(UNIV::'a set)" and
- BIJ: "inj(g::'b \<Rightarrow> 'a)"
-shows "(\<exists>(f::('b + 'a) => 'a). bij f) \<and> (\<exists>(h::('a + 'b) => 'a). bij h)"
-using assms Plus_infinite_bij_betw[of "UNIV::'a set" g "UNIV::'b set"]
-by auto
+ assumes "\<not>finite(UNIV::'a set)" and "inj(g::'b \<Rightarrow> 'a)"
+ shows "(\<exists>(f::('b + 'a) => 'a). bij f) \<and> (\<exists>(h::('a + 'b) => 'a). bij h)"
+ using assms Plus_infinite_bij_betw[of "UNIV::'a set" g "UNIV::'b set"]
+ by auto
lemma card_of_Un_infinite:
-assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
-shows "|A \<union> B| =o |A| \<and> |B \<union> A| =o |A|"
-proof-
- have "|A \<union> B| \<le>o |A <+> B|" by (rule card_of_Un_Plus_ordLeq)
- moreover have "|A <+> B| =o |A|"
- using assms by (metis card_of_Plus_infinite)
- ultimately have "|A \<union> B| \<le>o |A|" using ordLeq_ordIso_trans by blast
- hence "|A \<union> B| =o |A|" using card_of_Un1 ordIso_iff_ordLeq by blast
- thus ?thesis using Un_commute[of B A] by auto
-qed
+ assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
+ shows "|A \<union> B| =o |A| \<and> |B \<union> A| =o |A|"
+ by (simp add: INF LEQ card_of_Un_ordLeq_infinite_Field ordIso_iff_ordLeq)
lemma card_of_Un_infinite_simps[simp]:
-"\<lbrakk>\<not>finite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |A \<union> B| =o |A|"
-"\<lbrakk>\<not>finite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |B \<union> A| =o |A|"
-using card_of_Un_infinite by auto
+ "\<lbrakk>\<not>finite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |A \<union> B| =o |A|"
+ "\<lbrakk>\<not>finite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |B \<union> A| =o |A|"
+ using card_of_Un_infinite by auto
lemma card_of_Un_diff_infinite:
-assumes INF: "\<not>finite A" and LESS: "|B| <o |A|"
-shows "|A - B| =o |A|"
+ assumes INF: "\<not>finite A" and LESS: "|B| <o |A|"
+ shows "|A - B| =o |A|"
proof-
obtain C where C_def: "C = A - B" by blast
have "|A \<union> B| =o |A|"
- using assms ordLeq_iff_ordLess_or_ordIso card_of_Un_infinite by blast
+ using assms ordLeq_iff_ordLess_or_ordIso card_of_Un_infinite by blast
moreover have "C \<union> B = A \<union> B" unfolding C_def by auto
ultimately have 1: "|C \<union> B| =o |A|" by auto
- (* *)
+ (* *)
{assume *: "|C| \<le>o |B|"
- moreover
- {assume **: "finite B"
- hence "finite C"
- using card_of_ordLeq_finite * by blast
- hence False using ** INF card_of_ordIso_finite 1 by blast
- }
- hence "\<not>finite B" by auto
- ultimately have False
- using card_of_Un_infinite 1 ordIso_equivalence(1,3) LESS not_ordLess_ordIso by metis
+ moreover
+ {assume **: "finite B"
+ hence "finite C"
+ using card_of_ordLeq_finite * by blast
+ hence False using ** INF card_of_ordIso_finite 1 by blast
+ }
+ hence "\<not>finite B" by auto
+ ultimately have False
+ using card_of_Un_infinite 1 ordIso_equivalence(1,3) LESS not_ordLess_ordIso by metis
}
hence 2: "|B| \<le>o |C|" using card_of_Well_order ordLeq_total by blast
{assume *: "finite C"
@@ -507,155 +445,121 @@
}
hence "\<not>finite C" by auto
hence "|C| =o |A|"
- using card_of_Un_infinite 1 2 ordIso_equivalence(1,3) by metis
+ using card_of_Un_infinite 1 2 ordIso_equivalence(1,3) by metis
thus ?thesis unfolding C_def .
qed
corollary Card_order_Un_infinite:
-assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
- LEQ: "p \<le>o r"
-shows "| (Field r) \<union> (Field p) | =o r \<and> | (Field p) \<union> (Field r) | =o r"
+ assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
+ LEQ: "p \<le>o r"
+ shows "| (Field r) \<union> (Field p) | =o r \<and> | (Field p) \<union> (Field r) | =o r"
proof-
have "| Field r \<union> Field p | =o | Field r | \<and>
| Field p \<union> Field r | =o | Field r |"
- using assms by (auto simp add: card_of_Un_infinite)
+ using assms by (auto simp: card_of_Un_infinite)
thus ?thesis
- using assms card_of_Field_ordIso[of r]
- ordIso_transitive[of "|Field r \<union> Field p|"]
- ordIso_transitive[of _ "|Field r|"] by blast
+ using assms card_of_Field_ordIso[of r]
+ ordIso_transitive[of "|Field r \<union> Field p|"]
+ ordIso_transitive[of _ "|Field r|"] by blast
qed
corollary subset_ordLeq_diff_infinite:
-assumes INF: "\<not>finite B" and SUB: "A \<le> B" and LESS: "|A| <o |B|"
-shows "\<not>finite (B - A)"
-using assms card_of_Un_diff_infinite card_of_ordIso_finite by blast
+ assumes INF: "\<not>finite B" and SUB: "A \<le> B" and LESS: "|A| <o |B|"
+ shows "\<not>finite (B - A)"
+ using assms card_of_Un_diff_infinite card_of_ordIso_finite by blast
lemma card_of_Times_ordLess_infinite[simp]:
-assumes INF: "\<not>finite C" and
- LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
-shows "|A \<times> B| <o |C|"
+ assumes INF: "\<not>finite C" and
+ LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
+ shows "|A \<times> B| <o |C|"
proof(cases "A = {} \<or> B = {}")
assume Case1: "A = {} \<or> B = {}"
hence "A \<times> B = {}" by blast
moreover have "C \<noteq> {}" using
- LESS1 card_of_empty5 by blast
- ultimately show ?thesis by(auto simp add: card_of_empty4)
+ LESS1 card_of_empty5 by blast
+ ultimately show ?thesis by(auto simp: card_of_empty4)
next
assume Case2: "\<not>(A = {} \<or> B = {})"
{assume *: "|C| \<le>o |A \<times> B|"
- hence "\<not>finite (A \<times> B)" using INF card_of_ordLeq_finite by blast
- hence 1: "\<not>finite A \<or> \<not>finite B" using finite_cartesian_product by blast
- {assume Case21: "|A| \<le>o |B|"
- hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
- hence "|A \<times> B| =o |B|" using Case2 Case21
- by (auto simp add: card_of_Times_infinite)
- hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
- }
- moreover
- {assume Case22: "|B| \<le>o |A|"
- hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
- hence "|A \<times> B| =o |A|" using Case2 Case22
- by (auto simp add: card_of_Times_infinite)
- hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
- }
- ultimately have False using ordLeq_total card_of_Well_order[of A]
- card_of_Well_order[of B] by blast
+ hence "\<not>finite (A \<times> B)" using INF card_of_ordLeq_finite by blast
+ hence 1: "\<not>finite A \<or> \<not>finite B" using finite_cartesian_product by blast
+ {assume Case21: "|A| \<le>o |B|"
+ hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
+ hence "|A \<times> B| =o |B|" using Case2 Case21
+ by (auto simp: card_of_Times_infinite)
+ hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
+ }
+ moreover
+ {assume Case22: "|B| \<le>o |A|"
+ hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
+ hence "|A \<times> B| =o |A|" using Case2 Case22
+ by (auto simp: card_of_Times_infinite)
+ hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
+ }
+ ultimately have False using ordLeq_total card_of_Well_order[of A]
+ card_of_Well_order[of B] by blast
}
thus ?thesis using ordLess_or_ordLeq[of "|A \<times> B|" "|C|"]
- card_of_Well_order[of "A \<times> B"] card_of_Well_order[of "C"] by auto
+ card_of_Well_order[of "A \<times> B"] card_of_Well_order[of "C"] by auto
qed
lemma card_of_Times_ordLess_infinite_Field[simp]:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LESS1: "|A| <o r" and LESS2: "|B| <o r"
-shows "|A \<times> B| <o r"
+ assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
+ LESS1: "|A| <o r" and LESS2: "|B| <o r"
+ shows "|A \<times> B| <o r"
proof-
let ?C = "Field r"
have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
+ ordIso_symmetric by blast
hence "|A| <o |?C|" "|B| <o |?C|"
- using LESS1 LESS2 ordLess_ordIso_trans by blast+
+ using LESS1 LESS2 ordLess_ordIso_trans by blast+
hence "|A \<times> B| <o |?C|" using INF
- card_of_Times_ordLess_infinite by blast
- thus ?thesis using 1 ordLess_ordIso_trans by blast
-qed
-
-lemma card_of_Un_ordLess_infinite[simp]:
-assumes INF: "\<not>finite C" and
- LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
-shows "|A \<union> B| <o |C|"
-using assms card_of_Plus_ordLess_infinite card_of_Un_Plus_ordLeq
- ordLeq_ordLess_trans by blast
-
-lemma card_of_Un_ordLess_infinite_Field[simp]:
-assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
- LESS1: "|A| <o r" and LESS2: "|B| <o r"
-shows "|A Un B| <o r"
-proof-
- let ?C = "Field r"
- have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
- ordIso_symmetric by blast
- hence "|A| <o |?C|" "|B| <o |?C|"
- using LESS1 LESS2 ordLess_ordIso_trans by blast+
- hence "|A Un B| <o |?C|" using INF
- card_of_Un_ordLess_infinite by blast
+ card_of_Times_ordLess_infinite by blast
thus ?thesis using 1 ordLess_ordIso_trans by blast
qed
lemma ordLeq_finite_Field:
-assumes "r \<le>o s" and "finite (Field s)"
-shows "finite (Field r)"
-by (metis assms card_of_mono2 card_of_ordLeq_infinite)
+ assumes "r \<le>o s" and "finite (Field s)"
+ shows "finite (Field r)"
+ by (metis assms card_of_mono2 card_of_ordLeq_infinite)
lemma ordIso_finite_Field:
-assumes "r =o s"
-shows "finite (Field r) \<longleftrightarrow> finite (Field s)"
-by (metis assms ordIso_iff_ordLeq ordLeq_finite_Field)
+ assumes "r =o s"
+ shows "finite (Field r) \<longleftrightarrow> finite (Field s)"
+ by (metis assms ordIso_iff_ordLeq ordLeq_finite_Field)
subsection \<open>Cardinals versus set operations involving infinite sets\<close>
lemma finite_iff_cardOf_nat:
-"finite A = ( |A| <o |UNIV :: nat set| )"
-using infinite_iff_card_of_nat[of A]
-not_ordLeq_iff_ordLess[of "|A|" "|UNIV :: nat set|"]
-by fastforce
+ "finite A = ( |A| <o |UNIV :: nat set| )"
+ by (meson card_of_Well_order infinite_iff_card_of_nat not_ordLeq_iff_ordLess)
lemma finite_ordLess_infinite2[simp]:
-assumes "finite A" and "\<not>finite B"
-shows "|A| <o |B|"
-using assms
-finite_ordLess_infinite[of "|A|" "|B|"]
-card_of_Well_order[of A] card_of_Well_order[of B]
-Field_card_of[of A] Field_card_of[of B] by auto
+ assumes "finite A" and "\<not>finite B"
+ shows "|A| <o |B|"
+ by (meson assms card_of_Well_order card_of_ordLeq_finite not_ordLeq_iff_ordLess)
lemma infinite_card_of_insert:
-assumes "\<not>finite A"
-shows "|insert a A| =o |A|"
+ assumes "\<not>finite A"
+ shows "|insert a A| =o |A|"
proof-
have iA: "insert a A = A \<union> {a}" by simp
show ?thesis
- using infinite_imp_bij_betw2[OF assms] unfolding iA
- by (metis bij_betw_inv card_of_ordIso)
+ using infinite_imp_bij_betw2[OF assms] unfolding iA
+ by (metis bij_betw_inv card_of_ordIso)
qed
lemma card_of_Un_singl_ordLess_infinite1:
-assumes "\<not>finite B" and "|A| <o |B|"
-shows "|{a} Un A| <o |B|"
-proof-
- have "|{a}| <o |B|" using assms by auto
- thus ?thesis using assms card_of_Un_ordLess_infinite[of B] by blast
-qed
+ assumes "\<not>finite B" and "|A| <o |B|"
+ shows "|{a} Un A| <o |B|"
+ by (metis assms card_of_Un_ordLess_infinite finite.emptyI finite_insert finite_ordLess_infinite2)
lemma card_of_Un_singl_ordLess_infinite:
-assumes "\<not>finite B"
-shows "( |A| <o |B| ) = ( |{a} Un A| <o |B| )"
-using assms card_of_Un_singl_ordLess_infinite1[of B A]
-proof(auto)
- assume "|insert a A| <o |B|"
- moreover have "|A| <=o |insert a A|" using card_of_mono1[of A "insert a A"] by blast
- ultimately show "|A| <o |B|" using ordLeq_ordLess_trans by blast
-qed
+ assumes "\<not>finite B"
+ shows "|A| <o |B| \<longleftrightarrow> |{a} Un A| <o |B|"
+ using assms card_of_Un_singl_ordLess_infinite1[of B A]
+ using card_of_Un2 ordLeq_ordLess_trans by blast
subsection \<open>Cardinals versus lists\<close>
@@ -664,48 +568,39 @@
proofs of facts concerning the cardinality of \<open>List\<close> :\<close>
definition nlists :: "'a set \<Rightarrow> nat \<Rightarrow> 'a list set"
-where "nlists A n \<equiv> {l. set l \<le> A \<and> length l = n}"
-
-lemma lists_def2: "lists A = {l. set l \<le> A}"
-using in_listsI by blast
+ where "nlists A n \<equiv> {l. set l \<le> A \<and> length l = n}"
lemma lists_UNION_nlists: "lists A = (\<Union>n. nlists A n)"
-unfolding lists_def2 nlists_def by blast
+ unfolding lists_eq_set nlists_def by blast
lemma card_of_lists: "|A| \<le>o |lists A|"
proof-
let ?h = "\<lambda> a. [a]"
have "inj_on ?h A \<and> ?h ` A \<le> lists A"
- unfolding inj_on_def lists_def2 by auto
+ unfolding inj_on_def lists_eq_set by auto
thus ?thesis by (metis card_of_ordLeq)
qed
lemma nlists_0: "nlists A 0 = {[]}"
-unfolding nlists_def by auto
+ unfolding nlists_def by auto
lemma nlists_not_empty:
-assumes "A \<noteq> {}"
-shows "nlists A n \<noteq> {}"
-proof(induct n, simp add: nlists_0)
- fix n assume "nlists A n \<noteq> {}"
+ assumes "A \<noteq> {}"
+ shows "nlists A n \<noteq> {}"
+proof (induction n)
+ case (Suc n)
then obtain a and l where "a \<in> A \<and> l \<in> nlists A n" using assms by auto
hence "a # l \<in> nlists A (Suc n)" unfolding nlists_def by auto
- thus "nlists A (Suc n) \<noteq> {}" by auto
-qed
-
-lemma Nil_in_lists: "[] \<in> lists A"
-unfolding lists_def2 by auto
-
-lemma lists_not_empty: "lists A \<noteq> {}"
-using Nil_in_lists by blast
+ then show ?case by auto
+qed (simp add: nlists_0)
lemma card_of_nlists_Succ: "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
proof-
let ?B = "A \<times> (nlists A n)" let ?h = "\<lambda>(a,l). a # l"
have "inj_on ?h ?B \<and> ?h ` ?B \<le> nlists A (Suc n)"
- unfolding inj_on_def nlists_def by auto
+ unfolding inj_on_def nlists_def by auto
moreover have "nlists A (Suc n) \<le> ?h ` ?B"
- proof(auto)
+ proof clarify
fix l assume "l \<in> nlists A (Suc n)"
hence 1: "length l = Suc n \<and> set l \<le> A" unfolding nlists_def by auto
then obtain a and l' where 2: "l = a # l'" by (auto simp: length_Suc_conv)
@@ -713,131 +608,113 @@
thus "l \<in> ?h ` ?B" using 2 unfolding nlists_def by auto
qed
ultimately have "bij_betw ?h ?B (nlists A (Suc n))"
- unfolding bij_betw_def by auto
+ unfolding bij_betw_def by auto
thus ?thesis using card_of_ordIso ordIso_symmetric by blast
qed
lemma card_of_nlists_infinite:
-assumes "\<not>finite A"
-shows "|nlists A n| \<le>o |A|"
-proof(induct n)
+ assumes "\<not>finite A"
+ shows "|nlists A n| \<le>o |A|"
+proof(induction n)
+ case 0
have "A \<noteq> {}" using assms by auto
- thus "|nlists A 0| \<le>o |A|" by (simp add: nlists_0)
+ then show ?case
+ by (simp add: nlists_0)
next
- fix n assume IH: "|nlists A n| \<le>o |A|"
+ case (Suc n)
have "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
- using card_of_nlists_Succ by blast
+ using card_of_nlists_Succ by blast
moreover
- {have "nlists A n \<noteq> {}" using assms nlists_not_empty[of A] by blast
- hence "|A \<times> (nlists A n)| =o |A|"
- using assms IH by (auto simp add: card_of_Times_infinite)
- }
- ultimately show "|nlists A (Suc n)| \<le>o |A|"
- using ordIso_transitive ordIso_iff_ordLeq by blast
+ have "nlists A n \<noteq> {}" using assms nlists_not_empty[of A] by blast
+ hence "|A \<times> (nlists A n)| =o |A|"
+ using Suc assms by auto
+ ultimately show ?case
+ using ordIso_transitive ordIso_iff_ordLeq by blast
qed
+
lemma Card_order_lists: "Card_order r \<Longrightarrow> r \<le>o |lists(Field r) |"
-using card_of_lists card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
+ using card_of_lists card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
lemma Union_set_lists: "\<Union>(set ` (lists A)) = A"
- unfolding lists_def2
-proof(auto)
- fix a assume "a \<in> A"
+proof -
+ { fix a assume "a \<in> A"
hence "set [a] \<le> A \<and> a \<in> set [a]" by auto
- thus "\<exists>l. set l \<le> A \<and> a \<in> set l" by blast
+ hence "\<exists>l. set l \<le> A \<and> a \<in> set l" by blast }
+ then show ?thesis by force
qed
lemma inj_on_map_lists:
-assumes "inj_on f A"
-shows "inj_on (map f) (lists A)"
-using assms Union_set_lists[of A] inj_on_mapI[of f "lists A"] by auto
+ assumes "inj_on f A"
+ shows "inj_on (map f) (lists A)"
+ using assms Union_set_lists[of A] inj_on_mapI[of f "lists A"] by auto
lemma map_lists_mono:
-assumes "f ` A \<le> B"
-shows "(map f) ` (lists A) \<le> lists B"
-using assms unfolding lists_def2 by (auto, blast) (* lethal combination of methods :) *)
+ assumes "f ` A \<le> B"
+ shows "(map f) ` (lists A) \<le> lists B"
+ using assms by force
lemma map_lists_surjective:
-assumes "f ` A = B"
-shows "(map f) ` (lists A) = lists B"
-using assms unfolding lists_def2
-proof (auto, blast)
- fix l' assume *: "set l' \<le> f ` A"
- have "set l' \<le> f ` A \<longrightarrow> l' \<in> map f ` {l. set l \<le> A}"
- proof(induct l', auto)
- fix l a
- assume "a \<in> A" and "set l \<le> A" and
- IH: "f ` (set l) \<le> f ` A"
- hence "set (a # l) \<le> A" by auto
- hence "map f (a # l) \<in> map f ` {l. set l \<le> A}" by blast
- thus "f a # map f l \<in> map f ` {l. set l \<le> A}" by auto
- qed
- thus "l' \<in> map f ` {l. set l \<le> A}" using * by auto
-qed
+ assumes "f ` A = B"
+ shows "(map f) ` (lists A) = lists B"
+ by (metis assms lists_image)
lemma bij_betw_map_lists:
-assumes "bij_betw f A B"
-shows "bij_betw (map f) (lists A) (lists B)"
-using assms unfolding bij_betw_def
-by(auto simp add: inj_on_map_lists map_lists_surjective)
+ assumes "bij_betw f A B"
+ shows "bij_betw (map f) (lists A) (lists B)"
+ using assms unfolding bij_betw_def
+ by(auto simp: inj_on_map_lists map_lists_surjective)
lemma card_of_lists_mono[simp]:
-assumes "|A| \<le>o |B|"
-shows "|lists A| \<le>o |lists B|"
+ assumes "|A| \<le>o |B|"
+ shows "|lists A| \<le>o |lists B|"
proof-
obtain f where "inj_on f A \<and> f ` A \<le> B"
- using assms card_of_ordLeq[of A B] by auto
+ using assms card_of_ordLeq[of A B] by auto
hence "inj_on (map f) (lists A) \<and> (map f) ` (lists A) \<le> (lists B)"
- by (auto simp add: inj_on_map_lists map_lists_mono)
+ by (auto simp: inj_on_map_lists map_lists_mono)
thus ?thesis using card_of_ordLeq[of "lists A"] by metis
qed
lemma ordIso_lists_mono:
-assumes "r \<le>o r'"
-shows "|lists(Field r)| \<le>o |lists(Field r')|"
-using assms card_of_mono2 card_of_lists_mono by blast
+ assumes "r \<le>o r'"
+ shows "|lists(Field r)| \<le>o |lists(Field r')|"
+ using assms card_of_mono2 card_of_lists_mono by blast
lemma card_of_lists_cong[simp]:
-assumes "|A| =o |B|"
-shows "|lists A| =o |lists B|"
-proof-
- obtain f where "bij_betw f A B"
- using assms card_of_ordIso[of A B] by auto
- hence "bij_betw (map f) (lists A) (lists B)"
- by (auto simp add: bij_betw_map_lists)
- thus ?thesis using card_of_ordIso[of "lists A"] by auto
-qed
+ assumes "|A| =o |B|"
+ shows "|lists A| =o |lists B|"
+ by (meson assms card_of_lists_mono ordIso_iff_ordLeq)
lemma card_of_lists_infinite[simp]:
-assumes "\<not>finite A"
-shows "|lists A| =o |A|"
+ assumes "\<not>finite A"
+ shows "|lists A| =o |A|"
proof-
have "|lists A| \<le>o |A|" unfolding lists_UNION_nlists
- by (rule card_of_UNION_ordLeq_infinite[OF assms _ ballI[OF card_of_nlists_infinite[OF assms]]])
- (metis infinite_iff_card_of_nat assms)
+ by (rule card_of_UNION_ordLeq_infinite[OF assms _ ballI[OF card_of_nlists_infinite[OF assms]]])
+ (metis infinite_iff_card_of_nat assms)
thus ?thesis using card_of_lists ordIso_iff_ordLeq by blast
qed
lemma Card_order_lists_infinite:
-assumes "Card_order r" and "\<not>finite(Field r)"
-shows "|lists(Field r)| =o r"
-using assms card_of_lists_infinite card_of_Field_ordIso ordIso_transitive by blast
+ assumes "Card_order r" and "\<not>finite(Field r)"
+ shows "|lists(Field r)| =o r"
+ using assms card_of_lists_infinite card_of_Field_ordIso ordIso_transitive by blast
lemma ordIso_lists_cong:
-assumes "r =o r'"
-shows "|lists(Field r)| =o |lists(Field r')|"
-using assms card_of_cong card_of_lists_cong by blast
+ assumes "r =o r'"
+ shows "|lists(Field r)| =o |lists(Field r')|"
+ using assms card_of_cong card_of_lists_cong by blast
corollary lists_infinite_bij_betw:
-assumes "\<not>finite A"
-shows "\<exists>f. bij_betw f (lists A) A"
-using assms card_of_lists_infinite card_of_ordIso by blast
+ assumes "\<not>finite A"
+ shows "\<exists>f. bij_betw f (lists A) A"
+ using assms card_of_lists_infinite card_of_ordIso by blast
corollary lists_infinite_bij_betw_types:
-assumes "\<not>finite(UNIV :: 'a set)"
-shows "\<exists>(f::'a list \<Rightarrow> 'a). bij f"
-using assms assms lists_infinite_bij_betw[of "UNIV::'a set"]
-using lists_UNIV by auto
+ assumes "\<not>finite(UNIV :: 'a set)"
+ shows "\<exists>(f::'a list \<Rightarrow> 'a). bij f"
+ using assms lists_infinite_bij_betw by fastforce
subsection \<open>Cardinals versus the finite powerset operator\<close>
@@ -846,82 +723,72 @@
proof-
let ?h = "\<lambda> a. {a}"
have "inj_on ?h A \<and> ?h ` A \<le> Fpow A"
- unfolding inj_on_def Fpow_def by auto
+ unfolding inj_on_def Fpow_def by auto
thus ?thesis using card_of_ordLeq by metis
qed
lemma Card_order_Fpow: "Card_order r \<Longrightarrow> r \<le>o |Fpow(Field r) |"
-using card_of_Fpow card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
+ using card_of_Fpow card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
lemma image_Fpow_surjective:
-assumes "f ` A = B"
-shows "(image f) ` (Fpow A) = Fpow B"
-using assms proof(unfold Fpow_def, auto)
- fix Y assume *: "Y \<le> f ` A" and **: "finite Y"
- hence "\<forall>b \<in> Y. \<exists>a. a \<in> A \<and> f a = b" by auto
- with bchoice[of Y "\<lambda>b a. a \<in> A \<and> f a = b"]
- obtain g where 1: "\<forall>b \<in> Y. g b \<in> A \<and> f(g b) = b" by blast
- obtain X where X_def: "X = g ` Y" by blast
- have "f ` X = Y \<and> X \<le> A \<and> finite X"
- by(unfold X_def, force simp add: ** 1)
- thus "Y \<in> (image f) ` {X. X \<le> A \<and> finite X}" by auto
+ assumes "f ` A = B"
+ shows "(image f) ` (Fpow A) = Fpow B"
+proof -
+ have "\<And>C. \<lbrakk>C \<subseteq> f ` A; finite C\<rbrakk> \<Longrightarrow> C \<in> (`) f ` {X. X \<subseteq> A \<and> finite X}"
+ by (simp add: finite_subset_image image_iff)
+ then show ?thesis
+ using assms by (force simp add: Fpow_def)
qed
lemma bij_betw_image_Fpow:
-assumes "bij_betw f A B"
-shows "bij_betw (image f) (Fpow A) (Fpow B)"
-using assms unfolding bij_betw_def
-by (auto simp add: inj_on_image_Fpow image_Fpow_surjective)
+ assumes "bij_betw f A B"
+ shows "bij_betw (image f) (Fpow A) (Fpow B)"
+ using assms unfolding bij_betw_def
+ by (auto simp: inj_on_image_Fpow image_Fpow_surjective)
lemma card_of_Fpow_mono[simp]:
-assumes "|A| \<le>o |B|"
-shows "|Fpow A| \<le>o |Fpow B|"
+ assumes "|A| \<le>o |B|"
+ shows "|Fpow A| \<le>o |Fpow B|"
proof-
obtain f where "inj_on f A \<and> f ` A \<le> B"
- using assms card_of_ordLeq[of A B] by auto
+ using assms card_of_ordLeq[of A B] by auto
hence "inj_on (image f) (Fpow A) \<and> (image f) ` (Fpow A) \<le> (Fpow B)"
- by (auto simp add: inj_on_image_Fpow image_Fpow_mono)
+ by (auto simp: inj_on_image_Fpow image_Fpow_mono)
thus ?thesis using card_of_ordLeq[of "Fpow A"] by auto
qed
lemma ordIso_Fpow_mono:
-assumes "r \<le>o r'"
-shows "|Fpow(Field r)| \<le>o |Fpow(Field r')|"
-using assms card_of_mono2 card_of_Fpow_mono by blast
+ assumes "r \<le>o r'"
+ shows "|Fpow(Field r)| \<le>o |Fpow(Field r')|"
+ using assms card_of_mono2 card_of_Fpow_mono by blast
lemma card_of_Fpow_cong[simp]:
-assumes "|A| =o |B|"
-shows "|Fpow A| =o |Fpow B|"
-proof-
- obtain f where "bij_betw f A B"
- using assms card_of_ordIso[of A B] by auto
- hence "bij_betw (image f) (Fpow A) (Fpow B)"
- by (auto simp add: bij_betw_image_Fpow)
- thus ?thesis using card_of_ordIso[of "Fpow A"] by auto
-qed
+ assumes "|A| =o |B|"
+ shows "|Fpow A| =o |Fpow B|"
+ by (meson assms card_of_Fpow_mono ordIso_iff_ordLeq)
lemma ordIso_Fpow_cong:
-assumes "r =o r'"
-shows "|Fpow(Field r)| =o |Fpow(Field r')|"
-using assms card_of_cong card_of_Fpow_cong by blast
+ assumes "r =o r'"
+ shows "|Fpow(Field r)| =o |Fpow(Field r')|"
+ using assms card_of_cong card_of_Fpow_cong by blast
lemma card_of_Fpow_lists: "|Fpow A| \<le>o |lists A|"
proof-
have "set ` (lists A) = Fpow A"
- unfolding lists_def2 Fpow_def using finite_list finite_set by blast
+ unfolding lists_eq_set Fpow_def using finite_list finite_set by blast
thus ?thesis using card_of_ordLeq2[of "Fpow A"] Fpow_not_empty[of A] by blast
qed
lemma card_of_Fpow_infinite[simp]:
-assumes "\<not>finite A"
-shows "|Fpow A| =o |A|"
-using assms card_of_Fpow_lists card_of_lists_infinite card_of_Fpow
- ordLeq_ordIso_trans ordIso_iff_ordLeq by blast
+ assumes "\<not>finite A"
+ shows "|Fpow A| =o |A|"
+ using assms card_of_Fpow_lists card_of_lists_infinite card_of_Fpow
+ ordLeq_ordIso_trans ordIso_iff_ordLeq by blast
corollary Fpow_infinite_bij_betw:
-assumes "\<not>finite A"
-shows "\<exists>f. bij_betw f (Fpow A) A"
-using assms card_of_Fpow_infinite card_of_ordIso by blast
+ assumes "\<not>finite A"
+ shows "\<exists>f. bij_betw f (Fpow A) A"
+ using assms card_of_Fpow_infinite card_of_ordIso by blast
subsection \<open>The cardinal $\omega$ and the finite cardinals\<close>
@@ -929,108 +796,120 @@
subsubsection \<open>First as well-orders\<close>
lemma Field_natLess: "Field natLess = (UNIV::nat set)"
-by(unfold Field_def natLess_def, auto)
+ by (auto simp: Field_def natLess_def)
lemma natLeq_well_order_on: "well_order_on UNIV natLeq"
-using natLeq_Well_order Field_natLeq by auto
+ using natLeq_Well_order Field_natLeq by auto
lemma natLeq_wo_rel: "wo_rel natLeq"
-unfolding wo_rel_def using natLeq_Well_order .
+ unfolding wo_rel_def using natLeq_Well_order .
lemma natLeq_ofilter_less: "ofilter natLeq {0 ..< n}"
-by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
- simp add: Field_natLeq, unfold under_def natLeq_def, auto)
+proof -
+ have "\<forall>t<n. t \<in> Field natLeq"
+ by (simp add: Field_natLeq)
+ moreover have "\<forall>x<n. \<forall>t. (t, x) \<in> natLeq \<longrightarrow> t < n"
+ by (simp add: natLeq_def)
+ ultimately show ?thesis
+ by (auto simp: natLeq_wo_rel wo_rel.ofilter_def under_def)
+qed
lemma natLeq_ofilter_leq: "ofilter natLeq {0 .. n}"
-by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
- simp add: Field_natLeq, unfold under_def natLeq_def, auto)
+ by (metis (no_types) atLeastLessThanSuc_atLeastAtMost natLeq_ofilter_less)
lemma natLeq_UNIV_ofilter: "wo_rel.ofilter natLeq UNIV"
-using natLeq_wo_rel Field_natLeq wo_rel.Field_ofilter[of natLeq] by auto
+ using natLeq_wo_rel Field_natLeq wo_rel.Field_ofilter[of natLeq] by auto
lemma closed_nat_set_iff:
-assumes "\<forall>(m::nat) n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
-shows "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
+ assumes "\<forall>(m::nat) n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
+ shows "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
proof-
{assume "A \<noteq> UNIV" hence "\<exists>n. n \<notin> A" by blast
- moreover obtain n where n_def: "n = (LEAST n. n \<notin> A)" by blast
- ultimately have 1: "n \<notin> A \<and> (\<forall>m. m < n \<longrightarrow> m \<in> A)"
- using LeastI_ex[of "\<lambda> n. n \<notin> A"] n_def Least_le[of "\<lambda> n. n \<notin> A"] by fastforce
- have "A = {0 ..< n}"
- proof(auto simp add: 1)
- fix m assume *: "m \<in> A"
- {assume "n \<le> m" with assms * have "n \<in> A" by blast
- hence False using 1 by auto
- }
- thus "m < n" by fastforce
- qed
- hence "\<exists>n. A = {0 ..< n}" by blast
+ moreover obtain n where n_def: "n = (LEAST n. n \<notin> A)" by blast
+ ultimately have 1: "n \<notin> A \<and> (\<forall>m. m < n \<longrightarrow> m \<in> A)"
+ using LeastI_ex[of "\<lambda> n. n \<notin> A"] n_def Least_le[of "\<lambda> n. n \<notin> A"] by fastforce
+ then have "A = {0 ..< n}"
+ proof(auto simp: 1)
+ fix m assume *: "m \<in> A"
+ {assume "n \<le> m" with assms * have "n \<in> A" by blast
+ hence False using 1 by auto
+ }
+ thus "m < n" by fastforce
+ qed
+ hence "\<exists>n. A = {0 ..< n}" by blast
}
thus ?thesis by blast
qed
lemma natLeq_ofilter_iff:
-"ofilter natLeq A = (A = UNIV \<or> (\<exists>n. A = {0 ..< n}))"
+ "ofilter natLeq A = (A = UNIV \<or> (\<exists>n. A = {0 ..< n}))"
proof(rule iffI)
assume "ofilter natLeq A"
hence "\<forall>m n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A" using natLeq_wo_rel
- by(auto simp add: natLeq_def wo_rel.ofilter_def under_def)
+ by(auto simp: natLeq_def wo_rel.ofilter_def under_def)
thus "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
next
assume "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
thus "ofilter natLeq A"
- by(auto simp add: natLeq_ofilter_less natLeq_UNIV_ofilter)
+ by(auto simp: natLeq_ofilter_less natLeq_UNIV_ofilter)
qed
lemma natLeq_under_leq: "under natLeq n = {0 .. n}"
-unfolding under_def natLeq_def by auto
+ unfolding under_def natLeq_def by auto
lemma natLeq_on_ofilter_less_eq:
-"n \<le> m \<Longrightarrow> wo_rel.ofilter (natLeq_on m) {0 ..< n}"
-apply (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def)
-apply (simp add: Field_natLeq_on)
-by (auto simp add: under_def)
+ "n \<le> m \<Longrightarrow> wo_rel.ofilter (natLeq_on m) {0 ..< n}"
+ by (auto simp: natLeq_on_wo_rel wo_rel.ofilter_def Field_natLeq_on under_def)
lemma natLeq_on_ofilter_iff:
-"wo_rel.ofilter (natLeq_on m) A = (\<exists>n \<le> m. A = {0 ..< n})"
+ "wo_rel.ofilter (natLeq_on m) A = (\<exists>n \<le> m. A = {0 ..< n})"
proof(rule iffI)
assume *: "wo_rel.ofilter (natLeq_on m) A"
hence 1: "A \<le> {0..<m}"
- by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def under_def Field_natLeq_on)
+ by (auto simp: natLeq_on_wo_rel wo_rel.ofilter_def under_def Field_natLeq_on)
hence "\<forall>n1 n2. n2 \<in> A \<and> n1 \<le> n2 \<longrightarrow> n1 \<in> A"
- using * by(fastforce simp add: natLeq_on_wo_rel wo_rel.ofilter_def under_def)
+ using * by(fastforce simp add: natLeq_on_wo_rel wo_rel.ofilter_def under_def)
hence "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
thus "\<exists>n \<le> m. A = {0 ..< n}" using 1 atLeastLessThan_less_eq by blast
next
assume "(\<exists>n\<le>m. A = {0 ..< n})"
- thus "wo_rel.ofilter (natLeq_on m) A" by (auto simp add: natLeq_on_ofilter_less_eq)
+ thus "wo_rel.ofilter (natLeq_on m) A" by (auto simp: natLeq_on_ofilter_less_eq)
qed
corollary natLeq_on_ofilter:
-"ofilter(natLeq_on n) {0 ..< n}"
-by (auto simp add: natLeq_on_ofilter_less_eq)
+ "ofilter(natLeq_on n) {0 ..< n}"
+ by (auto simp: natLeq_on_ofilter_less_eq)
lemma natLeq_on_ofilter_less:
-"n < m \<Longrightarrow> ofilter (natLeq_on m) {0 .. n}"
-by(auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def,
- simp add: Field_natLeq_on, unfold under_def, auto)
+ assumes "n < m" shows "ofilter (natLeq_on m) {0 .. n}"
+proof -
+ have "Suc n \<le> m"
+ using assms by simp
+ then show ?thesis
+ using natLeq_on_ofilter_iff by auto
+qed
lemma natLeq_on_ordLess_natLeq: "natLeq_on n <o natLeq"
-using Field_natLeq Field_natLeq_on[of n]
- finite_ordLess_infinite[of "natLeq_on n" natLeq]
- natLeq_Well_order natLeq_on_Well_order[of n] by auto
+proof -
+ have "well_order natLeq"
+ using Field_natLeq natLeq_Well_order by auto
+ moreover have "\<And>n. well_order_on {na. na < n} (natLeq_on n)"
+ using Field_natLeq_on natLeq_on_Well_order by presburger
+ ultimately show ?thesis
+ by (simp add: Field_natLeq Field_natLeq_on finite_ordLess_infinite)
+qed
lemma natLeq_on_injective:
-"natLeq_on m = natLeq_on n \<Longrightarrow> m = n"
-using Field_natLeq_on[of m] Field_natLeq_on[of n]
- atLeastLessThan_injective[of m n, unfolded atLeastLessThan_def] by blast
+ "natLeq_on m = natLeq_on n \<Longrightarrow> m = n"
+ using Field_natLeq_on[of m] Field_natLeq_on[of n]
+ atLeastLessThan_injective[of m n, unfolded atLeastLessThan_def] by blast
lemma natLeq_on_injective_ordIso:
-"(natLeq_on m =o natLeq_on n) = (m = n)"
-proof(auto simp add: natLeq_on_Well_order ordIso_reflexive)
+ "(natLeq_on m =o natLeq_on n) = (m = n)"
+proof(auto simp: natLeq_on_Well_order ordIso_reflexive)
assume "natLeq_on m =o natLeq_on n"
then obtain f where "bij_betw f {x. x<m} {x. x<n}"
- using Field_natLeq_on unfolding ordIso_def iso_def[abs_def] by auto
+ using Field_natLeq_on unfolding ordIso_def iso_def[abs_def] by auto
thus "m = n" using atLeastLessThan_injective2[of f m n]
unfolding atLeast_0 atLeastLessThan_def lessThan_def Int_UNIV_left by blast
qed
@@ -1039,46 +918,48 @@
subsubsection \<open>Then as cardinals\<close>
lemma ordIso_natLeq_infinite1:
-"|A| =o natLeq \<Longrightarrow> \<not>finite A"
-using ordIso_symmetric ordIso_imp_ordLeq infinite_iff_natLeq_ordLeq by blast
+ "|A| =o natLeq \<Longrightarrow> \<not>finite A"
+ by (meson finite_iff_ordLess_natLeq not_ordLess_ordIso)
lemma ordIso_natLeq_infinite2:
-"natLeq =o |A| \<Longrightarrow> \<not>finite A"
-using ordIso_imp_ordLeq infinite_iff_natLeq_ordLeq by blast
+ "natLeq =o |A| \<Longrightarrow> \<not>finite A"
+ using ordIso_imp_ordLeq infinite_iff_natLeq_ordLeq by blast
lemma ordIso_natLeq_on_imp_finite:
-"|A| =o natLeq_on n \<Longrightarrow> finite A"
-unfolding ordIso_def iso_def[abs_def]
-by (auto simp: Field_natLeq_on bij_betw_finite)
+ "|A| =o natLeq_on n \<Longrightarrow> finite A"
+ unfolding ordIso_def iso_def[abs_def]
+ by (auto simp: Field_natLeq_on bij_betw_finite)
lemma natLeq_on_Card_order: "Card_order (natLeq_on n)"
-proof(unfold card_order_on_def,
- auto simp add: natLeq_on_Well_order, simp add: Field_natLeq_on)
- fix r assume "well_order_on {x. x < n} r"
- thus "natLeq_on n \<le>o r"
- using finite_atLeastLessThan natLeq_on_well_order_on
+proof -
+ { fix r assume "well_order_on {x. x < n} r"
+ hence "natLeq_on n \<le>o r"
+ using finite_atLeastLessThan natLeq_on_well_order_on
finite_well_order_on_ordIso ordIso_iff_ordLeq by blast
+ }
+ then show ?thesis
+ unfolding card_order_on_def using Field_natLeq_on natLeq_on_Well_order by presburger
qed
corollary card_of_Field_natLeq_on:
-"|Field (natLeq_on n)| =o natLeq_on n"
-using Field_natLeq_on natLeq_on_Card_order
- Card_order_iff_ordIso_card_of[of "natLeq_on n"]
- ordIso_symmetric[of "natLeq_on n"] by blast
+ "|Field (natLeq_on n)| =o natLeq_on n"
+ using Field_natLeq_on natLeq_on_Card_order
+ Card_order_iff_ordIso_card_of[of "natLeq_on n"]
+ ordIso_symmetric[of "natLeq_on n"] by blast
corollary card_of_less:
-"|{0 ..< n}| =o natLeq_on n"
-using Field_natLeq_on card_of_Field_natLeq_on
-unfolding atLeast_0 atLeastLessThan_def lessThan_def Int_UNIV_left by auto
+ "|{0 ..< n}| =o natLeq_on n"
+ using Field_natLeq_on card_of_Field_natLeq_on
+ unfolding atLeast_0 atLeastLessThan_def lessThan_def Int_UNIV_left by auto
lemma natLeq_on_ordLeq_less_eq:
-"((natLeq_on m) \<le>o (natLeq_on n)) = (m \<le> n)"
+ "((natLeq_on m) \<le>o (natLeq_on n)) = (m \<le> n)"
proof
assume "natLeq_on m \<le>o natLeq_on n"
then obtain f where "inj_on f {x. x < m} \<and> f ` {x. x < m} \<le> {x. x < n}"
- unfolding ordLeq_def using
- embed_inj_on[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on]
- embed_Field Field_natLeq_on by blast
+ unfolding ordLeq_def using
+ embed_inj_on[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on]
+ embed_Field Field_natLeq_on by blast
thus "m \<le> n" using atLeastLessThan_less_eq2
unfolding atLeast_0 atLeastLessThan_def lessThan_def Int_UNIV_left by blast
next
@@ -1086,141 +967,126 @@
hence "inj_on id {0..<m} \<and> id ` {0..<m} \<le> {0..<n}" unfolding inj_on_def by auto
hence "|{0..<m}| \<le>o |{0..<n}|" using card_of_ordLeq by blast
thus "natLeq_on m \<le>o natLeq_on n"
- using card_of_less ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
+ using card_of_less ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
qed
lemma natLeq_on_ordLeq_less:
-"((natLeq_on m) <o (natLeq_on n)) = (m < n)"
-using not_ordLeq_iff_ordLess[OF natLeq_on_Well_order natLeq_on_Well_order, of n m]
- natLeq_on_ordLeq_less_eq[of n m] by linarith
+ "((natLeq_on m) <o (natLeq_on n)) = (m < n)"
+ using not_ordLeq_iff_ordLess[OF natLeq_on_Well_order natLeq_on_Well_order, of n m]
+ natLeq_on_ordLeq_less_eq[of n m] by linarith
lemma ordLeq_natLeq_on_imp_finite:
-assumes "|A| \<le>o natLeq_on n"
-shows "finite A"
+ assumes "|A| \<le>o natLeq_on n"
+ shows "finite A"
proof-
have "|A| \<le>o |{0 ..< n}|"
- using assms card_of_less ordIso_symmetric ordLeq_ordIso_trans by blast
- thus ?thesis by (auto simp add: card_of_ordLeq_finite)
+ using assms card_of_less ordIso_symmetric ordLeq_ordIso_trans by blast
+ thus ?thesis by (auto simp: card_of_ordLeq_finite)
qed
subsubsection \<open>"Backward compatibility" with the numeric cardinal operator for finite sets\<close>
lemma finite_card_of_iff_card2:
-assumes FIN: "finite A" and FIN': "finite B"
-shows "( |A| \<le>o |B| ) = (card A \<le> card B)"
-using assms card_of_ordLeq[of A B] inj_on_iff_card_le[of A B] by blast
+ assumes FIN: "finite A" and FIN': "finite B"
+ shows "( |A| \<le>o |B| ) = (card A \<le> card B)"
+ using assms card_of_ordLeq[of A B] inj_on_iff_card_le[of A B] by blast
lemma finite_imp_card_of_natLeq_on:
-assumes "finite A"
-shows "|A| =o natLeq_on (card A)"
+ assumes "finite A"
+ shows "|A| =o natLeq_on (card A)"
proof-
obtain h where "bij_betw h A {0 ..< card A}"
- using assms ex_bij_betw_finite_nat by blast
+ using assms ex_bij_betw_finite_nat by blast
thus ?thesis using card_of_ordIso card_of_less ordIso_equivalence by blast
qed
lemma finite_iff_card_of_natLeq_on:
-"finite A = (\<exists>n. |A| =o natLeq_on n)"
-using finite_imp_card_of_natLeq_on[of A]
-by(auto simp add: ordIso_natLeq_on_imp_finite)
+ "finite A = (\<exists>n. |A| =o natLeq_on n)"
+ using finite_imp_card_of_natLeq_on[of A]
+ by(auto simp: ordIso_natLeq_on_imp_finite)
lemma finite_card_of_iff_card:
-assumes FIN: "finite A" and FIN': "finite B"
-shows "( |A| =o |B| ) = (card A = card B)"
-using assms card_of_ordIso[of A B] bij_betw_iff_card[of A B] by blast
+ assumes FIN: "finite A" and FIN': "finite B"
+ shows "( |A| =o |B| ) = (card A = card B)"
+ using assms card_of_ordIso[of A B] bij_betw_iff_card[of A B] by blast
lemma finite_card_of_iff_card3:
-assumes FIN: "finite A" and FIN': "finite B"
-shows "( |A| <o |B| ) = (card A < card B)"
+ assumes FIN: "finite A" and FIN': "finite B"
+ shows "( |A| <o |B| ) = (card A < card B)"
proof-
have "( |A| <o |B| ) = (~ ( |B| \<le>o |A| ))" by simp
- also have "... = (~ (card B \<le> card A))"
- using assms by(simp add: finite_card_of_iff_card2)
- also have "... = (card A < card B)" by auto
+ also have "\<dots> = (~ (card B \<le> card A))"
+ using assms by(simp add: finite_card_of_iff_card2)
+ also have "\<dots> = (card A < card B)" by auto
finally show ?thesis .
qed
lemma card_Field_natLeq_on:
-"card(Field(natLeq_on n)) = n"
-using Field_natLeq_on card_atLeastLessThan by auto
+ "card(Field(natLeq_on n)) = n"
+ using Field_natLeq_on card_atLeastLessThan by auto
subsection \<open>The successor of a cardinal\<close>
lemma embed_implies_ordIso_Restr:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and EMB: "embed r' r f"
-shows "r' =o Restr r (f ` (Field r'))"
-using assms embed_implies_iso_Restr Well_order_Restr unfolding ordIso_def by blast
-
-lemma cardSuc_Well_order[simp]:
-"Card_order r \<Longrightarrow> Well_order(cardSuc r)"
-using cardSuc_Card_order unfolding card_order_on_def by blast
-
-lemma Field_cardSuc_not_empty:
-assumes "Card_order r"
-shows "Field (cardSuc r) \<noteq> {}"
-proof
- assume "Field(cardSuc r) = {}"
- hence "|Field(cardSuc r)| \<le>o r" using assms Card_order_empty[of r] by auto
- hence "cardSuc r \<le>o r" using assms card_of_Field_ordIso
- cardSuc_Card_order ordIso_symmetric ordIso_ordLeq_trans by blast
- thus False using cardSuc_greater not_ordLess_ordLeq assms by blast
-qed
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and EMB: "embed r' r f"
+ shows "r' =o Restr r (f ` (Field r'))"
+ using assms embed_implies_iso_Restr Well_order_Restr unfolding ordIso_def by blast
lemma cardSuc_mono_ordLess[simp]:
-assumes CARD: "Card_order r" and CARD': "Card_order r'"
-shows "(cardSuc r <o cardSuc r') = (r <o r')"
+ assumes CARD: "Card_order r" and CARD': "Card_order r'"
+ shows "(cardSuc r <o cardSuc r') = (r <o r')"
proof-
have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
- using assms by auto
+ using assms by auto
thus ?thesis
- using not_ordLeq_iff_ordLess not_ordLeq_iff_ordLess[of r r']
- using cardSuc_mono_ordLeq[of r' r] assms by blast
+ using not_ordLeq_iff_ordLess not_ordLeq_iff_ordLess[of r r']
+ using cardSuc_mono_ordLeq[of r' r] assms by blast
qed
lemma cardSuc_natLeq_on_Suc:
-"cardSuc(natLeq_on n) =o natLeq_on(Suc n)"
+ "cardSuc(natLeq_on n) =o natLeq_on(Suc n)"
proof-
obtain r r' p where r_def: "r = natLeq_on n" and
- r'_def: "r' = cardSuc(natLeq_on n)" and
- p_def: "p = natLeq_on(Suc n)" by blast
- (* Preliminary facts: *)
+ r'_def: "r' = cardSuc(natLeq_on n)" and
+ p_def: "p = natLeq_on(Suc n)" by blast
+ (* Preliminary facts: *)
have CARD: "Card_order r \<and> Card_order r' \<and> Card_order p" unfolding r_def r'_def p_def
- using cardSuc_ordLess_ordLeq natLeq_on_Card_order cardSuc_Card_order by blast
+ using cardSuc_ordLess_ordLeq natLeq_on_Card_order cardSuc_Card_order by blast
hence WELL: "Well_order r \<and> Well_order r' \<and> Well_order p"
- unfolding card_order_on_def by force
+ unfolding card_order_on_def by force
have FIELD: "Field r = {0..<n} \<and> Field p = {0..<(Suc n)}"
- unfolding r_def p_def Field_natLeq_on atLeast_0 atLeastLessThan_def lessThan_def by simp
+ unfolding r_def p_def Field_natLeq_on atLeast_0 atLeastLessThan_def lessThan_def by simp
hence FIN: "finite (Field r)" by force
have "r <o r'" using CARD unfolding r_def r'_def using cardSuc_greater by blast
hence "|Field r| <o r'" using CARD card_of_Field_ordIso ordIso_ordLess_trans by blast
hence LESS: "|Field r| <o |Field r'|"
- using CARD card_of_Field_ordIso ordLess_ordIso_trans ordIso_symmetric by blast
- (* Main proof: *)
+ using CARD card_of_Field_ordIso ordLess_ordIso_trans ordIso_symmetric by blast
+ (* Main proof: *)
have "r' \<le>o p" using CARD unfolding r_def r'_def p_def
- using natLeq_on_ordLeq_less cardSuc_ordLess_ordLeq by blast
+ using natLeq_on_ordLeq_less cardSuc_ordLess_ordLeq by blast
moreover have "p \<le>o r'"
proof-
{assume "r' <o p"
- then obtain f where 0: "embedS r' p f" unfolding ordLess_def by force
- let ?q = "Restr p (f ` Field r')"
- have 1: "embed r' p f" using 0 unfolding embedS_def by force
- hence 2: "f ` Field r' < {0..<(Suc n)}"
- using WELL FIELD 0 by (auto simp add: embedS_iff)
- have "wo_rel.ofilter p (f ` Field r')" using embed_Field_ofilter 1 WELL by blast
- then obtain m where "m \<le> Suc n" and 3: "f ` (Field r') = {0..<m}"
- unfolding p_def by (auto simp add: natLeq_on_ofilter_iff)
- hence 4: "m \<le> n" using 2 by force
- (* *)
- have "bij_betw f (Field r') (f ` (Field r'))"
- using WELL embed_inj_on[OF _ 1] unfolding bij_betw_def by blast
- moreover have "finite(f ` (Field r'))" using 3 finite_atLeastLessThan[of 0 m] by force
- ultimately have 5: "finite (Field r') \<and> card(Field r') = card (f ` (Field r'))"
- using bij_betw_same_card bij_betw_finite by metis
- hence "card(Field r') \<le> card(Field r)" using 3 4 FIELD by force
- hence "|Field r'| \<le>o |Field r|" using FIN 5 finite_card_of_iff_card2 by blast
- hence False using LESS not_ordLess_ordLeq by auto
+ then obtain f where 0: "embedS r' p f" unfolding ordLess_def by force
+ let ?q = "Restr p (f ` Field r')"
+ have 1: "embed r' p f" using 0 unfolding embedS_def by force
+ hence 2: "f ` Field r' < {0..<(Suc n)}"
+ using WELL FIELD 0 by (auto simp: embedS_iff)
+ have "wo_rel.ofilter p (f ` Field r')" using embed_Field_ofilter 1 WELL by blast
+ then obtain m where "m \<le> Suc n" and 3: "f ` (Field r') = {0..<m}"
+ unfolding p_def by (auto simp: natLeq_on_ofilter_iff)
+ hence 4: "m \<le> n" using 2 by force
+ (* *)
+ have "bij_betw f (Field r') (f ` (Field r'))"
+ using WELL embed_inj_on[OF _ 1] unfolding bij_betw_def by blast
+ moreover have "finite(f ` (Field r'))" using 3 finite_atLeastLessThan[of 0 m] by force
+ ultimately have 5: "finite (Field r') \<and> card(Field r') = card (f ` (Field r'))"
+ using bij_betw_same_card bij_betw_finite by metis
+ hence "card(Field r') \<le> card(Field r)" using 3 4 FIELD by force
+ hence "|Field r'| \<le>o |Field r|" using FIN 5 finite_card_of_iff_card2 by blast
+ hence False using LESS not_ordLess_ordLeq by auto
}
thus ?thesis using WELL CARD by fastforce
qed
@@ -1228,129 +1094,104 @@
qed
lemma card_of_Plus_ordLeq_infinite[simp]:
-assumes C: "\<not>finite C" and A: "|A| \<le>o |C|" and B: "|B| \<le>o |C|"
-shows "|A <+> B| \<le>o |C|"
-proof-
- let ?r = "cardSuc |C|"
- have "Card_order ?r \<and> \<not>finite (Field ?r)" using assms by simp
- moreover have "|A| <o ?r" and "|B| <o ?r" using A B by auto
- ultimately have "|A <+> B| <o ?r"
- using card_of_Plus_ordLess_infinite_Field by blast
- thus ?thesis using C by simp
-qed
+ assumes "\<not>finite C" and "|A| \<le>o |C|" and "|B| \<le>o |C|"
+ shows "|A <+> B| \<le>o |C|"
+ by (simp add: assms)
lemma card_of_Un_ordLeq_infinite[simp]:
-assumes C: "\<not>finite C" and A: "|A| \<le>o |C|" and B: "|B| \<le>o |C|"
-shows "|A Un B| \<le>o |C|"
-using assms card_of_Plus_ordLeq_infinite card_of_Un_Plus_ordLeq
-ordLeq_transitive by metis
+ assumes "\<not>finite C" and "|A| \<le>o |C|" and "|B| \<le>o |C|"
+ shows "|A Un B| \<le>o |C|"
+ using assms card_of_Plus_ordLeq_infinite card_of_Un_Plus_ordLeq ordLeq_transitive by metis
subsection \<open>Others\<close>
lemma under_mono[simp]:
-assumes "Well_order r" and "(i,j) \<in> r"
-shows "under r i \<subseteq> under r j"
-using assms unfolding under_def order_on_defs
-trans_def by blast
+ assumes "Well_order r" and "(i,j) \<in> r"
+ shows "under r i \<subseteq> under r j"
+ using assms unfolding under_def order_on_defs trans_def by blast
lemma underS_under:
-assumes "i \<in> Field r"
-shows "underS r i = under r i - {i}"
-using assms unfolding underS_def under_def by auto
+ assumes "i \<in> Field r"
+ shows "underS r i = under r i - {i}"
+ using assms unfolding underS_def under_def by auto
lemma relChain_under:
-assumes "Well_order r"
-shows "relChain r (\<lambda> i. under r i)"
-using assms unfolding relChain_def by auto
+ assumes "Well_order r"
+ shows "relChain r (\<lambda> i. under r i)"
+ using assms unfolding relChain_def by auto
lemma card_of_infinite_diff_finite:
-assumes "\<not>finite A" and "finite B"
-shows "|A - B| =o |A|"
-by (metis assms card_of_Un_diff_infinite finite_ordLess_infinite2)
+ assumes "\<not>finite A" and "finite B"
+ shows "|A - B| =o |A|"
+ by (metis assms card_of_Un_diff_infinite finite_ordLess_infinite2)
lemma infinite_card_of_diff_singl:
-assumes "\<not>finite A"
-shows "|A - {a}| =o |A|"
-by (metis assms card_of_infinite_diff_finite finite.emptyI finite_insert)
+ assumes "\<not>finite A"
+ shows "|A - {a}| =o |A|"
+ by (metis assms card_of_infinite_diff_finite finite.emptyI finite_insert)
lemma card_of_vimage:
-assumes "B \<subseteq> range f"
-shows "|B| \<le>o |f -` B|"
-apply(rule surj_imp_ordLeq[of _ f])
-using assms by (metis Int_absorb2 image_vimage_eq order_refl)
+ assumes "B \<subseteq> range f"
+ shows "|B| \<le>o |f -` B|"
+ by (metis Int_absorb2 assms image_vimage_eq order_refl surj_imp_ordLeq)
lemma surj_card_of_vimage:
-assumes "surj f"
-shows "|B| \<le>o |f -` B|"
-by (metis assms card_of_vimage subset_UNIV)
-
-lemma infinite_Pow:
-assumes "\<not> finite A"
-shows "\<not> finite (Pow A)"
-proof-
- have "|A| \<le>o |Pow A|" by (metis card_of_Pow ordLess_imp_ordLeq)
- thus ?thesis by (metis assms finite_Pow_iff)
-qed
+ assumes "surj f"
+ shows "|B| \<le>o |f -` B|"
+ by (metis assms card_of_vimage subset_UNIV)
(* bounded powerset *)
definition Bpow where
-"Bpow r A \<equiv> {X . X \<subseteq> A \<and> |X| \<le>o r}"
+ "Bpow r A \<equiv> {X . X \<subseteq> A \<and> |X| \<le>o r}"
lemma Bpow_empty[simp]:
-assumes "Card_order r"
-shows "Bpow r {} = {{}}"
-using assms unfolding Bpow_def by auto
+ assumes "Card_order r"
+ shows "Bpow r {} = {{}}"
+ using assms unfolding Bpow_def by auto
lemma singl_in_Bpow:
-assumes rc: "Card_order r"
-and r: "Field r \<noteq> {}" and a: "a \<in> A"
-shows "{a} \<in> Bpow r A"
+ assumes rc: "Card_order r"
+ and r: "Field r \<noteq> {}" and a: "a \<in> A"
+ shows "{a} \<in> Bpow r A"
proof-
have "|{a}| \<le>o r" using r rc by auto
thus ?thesis unfolding Bpow_def using a by auto
qed
lemma ordLeq_card_Bpow:
-assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
-shows "|A| \<le>o |Bpow r A|"
+ assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
+ shows "|A| \<le>o |Bpow r A|"
proof-
have "inj_on (\<lambda> a. {a}) A" unfolding inj_on_def by auto
moreover have "(\<lambda> a. {a}) ` A \<subseteq> Bpow r A"
- using singl_in_Bpow[OF assms] by auto
+ using singl_in_Bpow[OF assms] by auto
ultimately show ?thesis unfolding card_of_ordLeq[symmetric] by blast
qed
lemma infinite_Bpow:
-assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
-and A: "\<not>finite A"
-shows "\<not>finite (Bpow r A)"
-using ordLeq_card_Bpow[OF rc r]
-by (metis A card_of_ordLeq_infinite)
+ assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
+ and A: "\<not>finite A"
+ shows "\<not>finite (Bpow r A)"
+ using ordLeq_card_Bpow[OF rc r]
+ by (metis A card_of_ordLeq_infinite)
definition Func_option where
- "Func_option A B \<equiv>
+ "Func_option A B \<equiv>
{f. (\<forall> a. f a \<noteq> None \<longleftrightarrow> a \<in> A) \<and> (\<forall> a \<in> A. case f a of Some b \<Rightarrow> b \<in> B |None \<Rightarrow> True)}"
lemma card_of_Func_option_Func:
-"|Func_option A B| =o |Func A B|"
+ "|Func_option A B| =o |Func A B|"
proof (rule ordIso_symmetric, unfold card_of_ordIso[symmetric], intro exI)
let ?F = "\<lambda> f a. if a \<in> A then Some (f a) else None"
show "bij_betw ?F (Func A B) (Func_option A B)"
- unfolding bij_betw_def unfolding inj_on_def proof(intro conjI ballI impI)
+ unfolding bij_betw_def unfolding inj_on_def proof(intro conjI ballI impI)
fix f g assume f: "f \<in> Func A B" and g: "g \<in> Func A B" and eq: "?F f = ?F g"
show "f = g"
proof(rule ext)
fix a
show "f a = g a"
- proof(cases "a \<in> A")
- case True
- have "Some (f a) = ?F f a" using True by auto
- also have "... = ?F g a" using eq unfolding fun_eq_iff by(rule allE)
- also have "... = Some (g a)" using True by auto
- finally have "Some (f a) = Some (g a)" .
- thus ?thesis by simp
- qed(insert f g, unfold Func_def, auto)
+ by (smt (verit) Func_def eq f g mem_Collect_eq option.inject)
qed
next
show "?F ` Func A B = Func_option A B"
@@ -1358,11 +1199,11 @@
fix f assume f: "f \<in> Func_option A B"
define g where [abs_def]: "g a = (case f a of Some b \<Rightarrow> b | None \<Rightarrow> undefined)" for a
have "g \<in> Func A B"
- using f unfolding g_def Func_def Func_option_def by force+
+ using f unfolding g_def Func_def Func_option_def by force+
moreover have "f = ?F g"
proof(rule ext)
fix a show "f a = ?F g a"
- using f unfolding Func_option_def g_def by (cases "a \<in> A") force+
+ using f unfolding Func_option_def g_def by (cases "a \<in> A") force+
qed
ultimately show "f \<in> ?F ` (Func A B)" by blast
qed(unfold Func_def Func_option_def, auto)
@@ -1371,16 +1212,16 @@
(* partial-function space: *)
definition Pfunc where
-"Pfunc A B \<equiv>
+ "Pfunc A B \<equiv>
{f. (\<forall>a. f a \<noteq> None \<longrightarrow> a \<in> A) \<and>
(\<forall>a. case f a of None \<Rightarrow> True | Some b \<Rightarrow> b \<in> B)}"
lemma Func_Pfunc:
-"Func_option A B \<subseteq> Pfunc A B"
-unfolding Func_option_def Pfunc_def by auto
+ "Func_option A B \<subseteq> Pfunc A B"
+ unfolding Func_option_def Pfunc_def by auto
lemma Pfunc_Func_option:
-"Pfunc A B = (\<Union>A' \<in> Pow A. Func_option A' B)"
+ "Pfunc A B = (\<Union>A' \<in> Pow A. Func_option A' B)"
proof safe
fix f assume f: "f \<in> Pfunc A B"
show "f \<in> (\<Union>A'\<in>Pow A. Func_option A' B)"
@@ -1395,180 +1236,161 @@
qed
lemma card_of_Func_mono:
-fixes A1 A2 :: "'a set" and B :: "'b set"
-assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
-shows "|Func A1 B| \<le>o |Func A2 B|"
+ fixes A1 A2 :: "'a set" and B :: "'b set"
+ assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
+ shows "|Func A1 B| \<le>o |Func A2 B|"
proof-
obtain bb where bb: "bb \<in> B" using B by auto
define F where [abs_def]: "F f1 a =
(if a \<in> A2 then (if a \<in> A1 then f1 a else bb) else undefined)" for f1 :: "'a \<Rightarrow> 'b" and a
- show ?thesis unfolding card_of_ordLeq[symmetric] proof(intro exI[of _ F] conjI)
- show "inj_on F (Func A1 B)" unfolding inj_on_def proof safe
+ show ?thesis unfolding card_of_ordLeq[symmetric]
+ proof(intro exI[of _ F] conjI)
+ show "inj_on F (Func A1 B)" unfolding inj_on_def
+ proof safe
fix f g assume f: "f \<in> Func A1 B" and g: "g \<in> Func A1 B" and eq: "F f = F g"
show "f = g"
proof(rule ext)
fix a show "f a = g a"
- proof(cases "a \<in> A1")
- case True
- thus ?thesis using eq A12 unfolding F_def fun_eq_iff
- by (elim allE[of _ a]) auto
- qed(insert f g, unfold Func_def, fastforce)
+ by (smt (verit) A12 F_def Func_def eq f g mem_Collect_eq subsetD)
qed
qed
qed(insert bb, unfold Func_def F_def, force)
qed
lemma card_of_Func_option_mono:
-fixes A1 A2 :: "'a set" and B :: "'b set"
-assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
-shows "|Func_option A1 B| \<le>o |Func_option A2 B|"
-by (metis card_of_Func_mono[OF A12 B] card_of_Func_option_Func
- ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric)
+ fixes A1 A2 :: "'a set" and B :: "'b set"
+ assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
+ shows "|Func_option A1 B| \<le>o |Func_option A2 B|"
+ by (metis card_of_Func_mono[OF A12 B] card_of_Func_option_Func
+ ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric)
lemma card_of_Pfunc_Pow_Func_option:
-assumes "B \<noteq> {}"
-shows "|Pfunc A B| \<le>o |Pow A \<times> Func_option A B|"
+ assumes "B \<noteq> {}"
+ shows "|Pfunc A B| \<le>o |Pow A \<times> Func_option A B|"
proof-
have "|Pfunc A B| =o |\<Union>A' \<in> Pow A. Func_option A' B|" (is "_ =o ?K")
unfolding Pfunc_Func_option by(rule card_of_refl)
also have "?K \<le>o |Sigma (Pow A) (\<lambda> A'. Func_option A' B)|" using card_of_UNION_Sigma .
also have "|Sigma (Pow A) (\<lambda> A'. Func_option A' B)| \<le>o |Pow A \<times> Func_option A B|"
- apply(rule card_of_Sigma_mono1) using card_of_Func_option_mono[OF _ assms] by auto
+ by (simp add: assms card_of_Func_option_mono card_of_Sigma_mono1)
finally show ?thesis .
qed
lemma Bpow_ordLeq_Func_Field:
-assumes rc: "Card_order r" and r: "Field r \<noteq> {}" and A: "\<not>finite A"
-shows "|Bpow r A| \<le>o |Func (Field r) A|"
+ assumes rc: "Card_order r" and r: "Field r \<noteq> {}" and A: "\<not>finite A"
+ shows "|Bpow r A| \<le>o |Func (Field r) A|"
proof-
let ?F = "\<lambda> f. {x | x a. f a = x \<and> a \<in> Field r}"
{fix X assume "X \<in> Bpow r A - {{}}"
- hence XA: "X \<subseteq> A" and "|X| \<le>o r"
- and X: "X \<noteq> {}" unfolding Bpow_def by auto
- hence "|X| \<le>o |Field r|" by (metis Field_card_of card_of_mono2)
- then obtain F where 1: "X = F ` (Field r)"
- using card_of_ordLeq2[OF X] by metis
- define f where [abs_def]: "f i = (if i \<in> Field r then F i else undefined)" for i
- have "\<exists> f \<in> Func (Field r) A. X = ?F f"
- apply (intro bexI[of _ f]) using 1 XA unfolding Func_def f_def by auto
+ hence XA: "X \<subseteq> A" and "|X| \<le>o r"
+ and X: "X \<noteq> {}" unfolding Bpow_def by auto
+ hence "|X| \<le>o |Field r|" by (metis Field_card_of card_of_mono2)
+ then obtain F where 1: "X = F ` (Field r)"
+ using card_of_ordLeq2[OF X] by metis
+ define f where [abs_def]: "f i = (if i \<in> Field r then F i else undefined)" for i
+ have "\<exists> f \<in> Func (Field r) A. X = ?F f"
+ apply (intro bexI[of _ f]) using 1 XA unfolding Func_def f_def by auto
}
hence "Bpow r A - {{}} \<subseteq> ?F ` (Func (Field r) A)" by auto
hence "|Bpow r A - {{}}| \<le>o |Func (Field r) A|"
- by (rule surj_imp_ordLeq)
+ by (rule surj_imp_ordLeq)
moreover
{have 2: "\<not>finite (Bpow r A)" using infinite_Bpow[OF rc r A] .
- have "|Bpow r A| =o |Bpow r A - {{}}|"
- by (metis 2 infinite_card_of_diff_singl ordIso_symmetric)
+ have "|Bpow r A| =o |Bpow r A - {{}}|"
+ by (metis 2 infinite_card_of_diff_singl ordIso_symmetric)
}
ultimately show ?thesis by (metis ordIso_ordLeq_trans)
qed
lemma empty_in_Func[simp]:
-"B \<noteq> {} \<Longrightarrow> (\<lambda>x. undefined) \<in> Func {} B"
-unfolding Func_def by auto
+ "B \<noteq> {} \<Longrightarrow> (\<lambda>x. undefined) \<in> Func {} B"
+ by simp
lemma Func_mono[simp]:
-assumes "B1 \<subseteq> B2"
-shows "Func A B1 \<subseteq> Func A B2"
-using assms unfolding Func_def by force
+ assumes "B1 \<subseteq> B2"
+ shows "Func A B1 \<subseteq> Func A B2"
+ using assms unfolding Func_def by force
lemma Pfunc_mono[simp]:
-assumes "A1 \<subseteq> A2" and "B1 \<subseteq> B2"
-shows "Pfunc A B1 \<subseteq> Pfunc A B2"
-using assms unfolding Pfunc_def
-apply safe
-apply (case_tac "x a", auto)
-apply (metis in_mono option.simps(5))
-done
+ assumes "A1 \<subseteq> A2" and "B1 \<subseteq> B2"
+ shows "Pfunc A B1 \<subseteq> Pfunc A B2"
+ using assms unfolding Pfunc_def
+ by (force split: option.split_asm option.split)
lemma card_of_Func_UNIV_UNIV:
-"|Func (UNIV::'a set) (UNIV::'b set)| =o |UNIV::('a \<Rightarrow> 'b) set|"
-using card_of_Func_UNIV[of "UNIV::'b set"] by auto
+ "|Func (UNIV::'a set) (UNIV::'b set)| =o |UNIV::('a \<Rightarrow> 'b) set|"
+ using card_of_Func_UNIV[of "UNIV::'b set"] by auto
lemma ordLeq_Func:
-assumes "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
-shows "|A| \<le>o |Func A B|"
-unfolding card_of_ordLeq[symmetric] proof(intro exI conjI)
- let ?F = "\<lambda> aa a. if a \<in> A then (if a = aa then b1 else b2) else undefined"
+ assumes "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
+ shows "|A| \<le>o |Func A B|"
+ unfolding card_of_ordLeq[symmetric] proof(intro exI conjI)
+ let ?F = "\<lambda>x a. if a \<in> A then (if a = x then b1 else b2) else undefined"
show "inj_on ?F A" using assms unfolding inj_on_def fun_eq_iff by auto
show "?F ` A \<subseteq> Func A B" using assms unfolding Func_def by auto
qed
lemma infinite_Func:
-assumes A: "\<not>finite A" and B: "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
-shows "\<not>finite (Func A B)"
-using ordLeq_Func[OF B] by (metis A card_of_ordLeq_finite)
+ assumes A: "\<not>finite A" and B: "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
+ shows "\<not>finite (Func A B)"
+ using ordLeq_Func[OF B] by (metis A card_of_ordLeq_finite)
subsection \<open>Infinite cardinals are limit ordinals\<close>
lemma card_order_infinite_isLimOrd:
-assumes c: "Card_order r" and i: "\<not>finite (Field r)"
-shows "isLimOrd r"
+ assumes c: "Card_order r" and i: "\<not>finite (Field r)"
+ shows "isLimOrd r"
proof-
have 0: "wo_rel r" and 00: "Well_order r"
- using c unfolding card_order_on_def wo_rel_def by auto
+ using c unfolding card_order_on_def wo_rel_def by auto
hence rr: "Refl r" by (metis wo_rel.REFL)
- show ?thesis unfolding wo_rel.isLimOrd_def[OF 0] wo_rel.isSuccOrd_def[OF 0] proof safe
- fix j assume j: "j \<in> Field r" and jm: "\<forall>i\<in>Field r. (i, j) \<in> r"
- define p where "p = Restr r (Field r - {j})"
- have fp: "Field p = Field r - {j}"
- unfolding p_def apply(rule Refl_Field_Restr2[OF rr]) by auto
- have of: "ofilter r (Field p)" unfolding wo_rel.ofilter_def[OF 0] proof safe
- fix a x assume a: "a \<in> Field p" and "x \<in> under r a"
- hence x: "(x,a) \<in> r" "x \<in> Field r" unfolding under_def Field_def by auto
- moreover have a: "a \<noteq> j" "a \<in> Field r" "(a,j) \<in> r" using a jm unfolding fp by auto
- ultimately have "x \<noteq> j" using j jm by (metis 0 wo_rel.max2_def wo_rel.max2_equals1)
- thus "x \<in> Field p" using x unfolding fp by auto
- qed(unfold p_def Field_def, auto)
- have "p <o r" using j ofilter_ordLess[OF 00 of] unfolding fp p_def[symmetric] by auto
- hence 2: "|Field p| <o r" using c by (metis BNF_Cardinal_Order_Relation.ordLess_Field)
- have "|Field p| =o |Field r|" unfolding fp using i by (metis infinite_card_of_diff_singl)
- also have "|Field r| =o r"
- using c by (metis card_of_unique ordIso_symmetric)
- finally have "|Field p| =o r" .
- with 2 show False by (metis not_ordLess_ordIso)
+ show ?thesis unfolding wo_rel.isLimOrd_def[OF 0] wo_rel.isSuccOrd_def[OF 0]
+ proof safe
+ fix j assume "j \<in> Field r" and "\<forall>i\<in>Field r. (i, j) \<in> r"
+ then show False
+ by (metis Card_order_trans c i infinite_Card_order_limit)
qed
qed
lemma insert_Chain:
-assumes "Refl r" "C \<in> Chains r" and "i \<in> Field r" and "\<And>j. j \<in> C \<Longrightarrow> (j,i) \<in> r \<or> (i,j) \<in> r"
-shows "insert i C \<in> Chains r"
-using assms unfolding Chains_def by (auto dest: refl_onD)
+ assumes "Refl r" "C \<in> Chains r" and "i \<in> Field r" and "\<And>j. j \<in> C \<Longrightarrow> (j,i) \<in> r \<or> (i,j) \<in> r"
+ shows "insert i C \<in> Chains r"
+ using assms unfolding Chains_def by (auto dest: refl_onD)
lemma Collect_insert: "{R j |j. j \<in> insert j1 J} = insert (R j1) {R j |j. j \<in> J}"
-by auto
+ by auto
lemma Field_init_seg_of[simp]:
-"Field init_seg_of = UNIV"
-unfolding Field_def init_seg_of_def by auto
+ "Field init_seg_of = UNIV"
+ unfolding Field_def init_seg_of_def by auto
lemma refl_init_seg_of[intro, simp]: "refl init_seg_of"
-unfolding refl_on_def Field_def by auto
+ unfolding refl_on_def Field_def by auto
lemma regularCard_all_ex:
-assumes r: "Card_order r" "regularCard r"
-and As: "\<And> i j b. b \<in> B \<Longrightarrow> (i,j) \<in> r \<Longrightarrow> P i b \<Longrightarrow> P j b"
-and Bsub: "\<forall> b \<in> B. \<exists> i \<in> Field r. P i b"
-and cardB: "|B| <o r"
-shows "\<exists> i \<in> Field r. \<forall> b \<in> B. P i b"
+ assumes r: "Card_order r" "regularCard r"
+ and As: "\<And> i j b. b \<in> B \<Longrightarrow> (i,j) \<in> r \<Longrightarrow> P i b \<Longrightarrow> P j b"
+ and Bsub: "\<forall> b \<in> B. \<exists> i \<in> Field r. P i b"
+ and cardB: "|B| <o r"
+ shows "\<exists> i \<in> Field r. \<forall> b \<in> B. P i b"
proof-
let ?As = "\<lambda>i. {b \<in> B. P i b}"
have "\<exists>i \<in> Field r. B \<le> ?As i"
- apply(rule regularCard_UNION) using assms unfolding relChain_def by auto
+ apply(rule regularCard_UNION) using assms unfolding relChain_def by auto
thus ?thesis by auto
qed
lemma relChain_stabilize:
-assumes rc: "relChain r As" and AsB: "(\<Union>i \<in> Field r. As i) \<subseteq> B" and Br: "|B| <o r"
-and ir: "\<not>finite (Field r)" and cr: "Card_order r"
-shows "\<exists> i \<in> Field r. As (succ r i) = As i"
+ assumes rc: "relChain r As" and AsB: "(\<Union>i \<in> Field r. As i) \<subseteq> B" and Br: "|B| <o r"
+ and ir: "\<not>finite (Field r)" and cr: "Card_order r"
+ shows "\<exists> i \<in> Field r. As (succ r i) = As i"
proof(rule ccontr, auto)
have 0: "wo_rel r" and 00: "Well_order r"
- unfolding wo_rel_def by (metis card_order_on_well_order_on cr)+
+ unfolding wo_rel_def by (metis card_order_on_well_order_on cr)+
have L: "isLimOrd r" using ir cr by (metis card_order_infinite_isLimOrd)
have AsBs: "(\<Union>i \<in> Field r. As (succ r i)) \<subseteq> B"
- using AsB L apply safe by (metis "0" UN_I subsetD wo_rel.isLimOrd_succ)
+ using AsB L by (simp add: "0" Sup_le_iff wo_rel.isLimOrd_succ)
assume As_s: "\<forall>i\<in>Field r. As (succ r i) \<noteq> As i"
have 1: "\<forall>i j. (i,j) \<in> r \<and> i \<noteq> j \<longrightarrow> As i \<subset> As j"
proof safe
@@ -1576,18 +1398,19 @@
hence rij: "(succ r i, j) \<in> r" by (metis "0" wo_rel.succ_smallest)
hence "As (succ r i) \<subseteq> As j" using rc unfolding relChain_def by auto
moreover
- {have "(i,succ r i) \<in> r" apply(rule wo_rel.succ_in[OF 0])
- using 1 unfolding aboveS_def by auto
- hence "As i \<subset> As (succ r i)" using As_s rc rij unfolding relChain_def Field_def by auto
+ { have "(i,succ r i) \<in> r"
+ by (meson "0" "1"(1) FieldI1 L wo_rel.isLimOrd_aboveS wo_rel.succ_in)
+ hence "As i \<subset> As (succ r i)" using As_s rc rij unfolding relChain_def Field_def by auto
}
ultimately show False unfolding Asij by auto
qed (insert rc, unfold relChain_def, auto)
hence "\<forall> i \<in> Field r. \<exists> a. a \<in> As (succ r i) - As i"
- using wo_rel.succ_in[OF 0] AsB
- by(metis 0 card_order_infinite_isLimOrd cr ir psubset_imp_ex_mem
- wo_rel.isLimOrd_aboveS wo_rel.succ_diff)
+ using wo_rel.succ_in[OF 0] AsB
+ by(metis 0 card_order_infinite_isLimOrd cr ir psubset_imp_ex_mem
+ wo_rel.isLimOrd_aboveS wo_rel.succ_diff)
then obtain f where f: "\<forall> i \<in> Field r. f i \<in> As (succ r i) - As i" by metis
- have "inj_on f (Field r)" unfolding inj_on_def proof safe
+ have "inj_on f (Field r)" unfolding inj_on_def
+ proof safe
fix i j assume ij: "i \<in> Field r" "j \<in> Field r" and fij: "f i = f j"
show "i = j"
proof(cases rule: wo_rel.cases_Total3[OF 0], safe)
@@ -1610,118 +1433,62 @@
subsection \<open>Regular vs. stable cardinals\<close>
-lemma stable_regularCard:
-assumes cr: "Card_order r" and ir: "\<not>finite (Field r)" and st: "stable r"
-shows "regularCard r"
-unfolding regularCard_def proof safe
- fix K assume K: "K \<subseteq> Field r" and cof: "cofinal K r"
- have "|K| \<le>o r" using K by (metis card_of_Field_ordIso card_of_mono1 cr ordLeq_ordIso_trans)
- moreover
- {assume Kr: "|K| <o r"
- then obtain f where "\<forall> a \<in> Field r. f a \<in> K \<and> a \<noteq> f a \<and> (a, f a) \<in> r"
- using cof unfolding cofinal_def by metis
- hence "Field r \<subseteq> (\<Union>a \<in> K. underS r a)" unfolding underS_def by auto
- hence "r \<le>o |\<Union>a \<in> K. underS r a|" using cr
- by (metis Card_order_iff_ordLeq_card_of card_of_mono1 ordLeq_transitive)
- also have "|\<Union>a \<in> K. underS r a| \<le>o |SIGMA a: K. underS r a|" by (rule card_of_UNION_Sigma)
- also
- {have "\<forall> a \<in> K. |underS r a| <o r" using K by (metis card_of_underS cr subsetD)
- hence "|SIGMA a: K. underS r a| <o r" using st Kr unfolding stable_def by auto
- }
- finally have "r <o r" .
- hence False by (metis ordLess_irreflexive)
- }
- ultimately show "|K| =o r" by (metis ordLeq_iff_ordLess_or_ordIso)
-qed
-
-lemma stable_natLeq: "stable natLeq"
-proof(unfold stable_def, safe)
- fix A :: "'a set" and F :: "'a \<Rightarrow> 'a set"
- assume "|A| <o natLeq" and "\<forall>a\<in>A. |F a| <o natLeq"
- hence "finite A \<and> (\<forall>a \<in> A. finite(F a))"
- by (auto simp add: finite_iff_ordLess_natLeq)
- hence "finite(Sigma A F)" by (simp only: finite_SigmaI[of A F])
- thus "|Sigma A F | <o natLeq"
- by (auto simp add: finite_iff_ordLess_natLeq)
-qed
-
-corollary regularCard_natLeq: "regularCard natLeq"
-using stable_regularCard[OF natLeq_Card_order _ stable_natLeq] Field_natLeq by simp
-
lemma stable_cardSuc:
-assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
-shows "stable(cardSuc r)"
-using infinite_cardSuc_regularCard regularCard_stable
-by (metis CARD INF cardSuc_Card_order cardSuc_finite)
-
-lemma stable_ordIso1:
-assumes ST: "stable r" and ISO: "r' =o r"
-shows "stable r'"
-proof(unfold stable_def, auto)
- fix A::"'b set" and F::"'b \<Rightarrow> 'b set"
- assume "|A| <o r'" and "\<forall>a \<in> A. |F a| <o r'"
- hence "( |A| <o r) \<and> (\<forall>a \<in> A. |F a| <o r)"
- using ISO ordLess_ordIso_trans by blast
- hence "|SIGMA a : A. F a| <o r" using assms stable_elim by blast
- thus "|SIGMA a : A. F a| <o r'"
- using ISO ordIso_symmetric ordLess_ordIso_trans by blast
-qed
-
-lemma stable_ordIso2:
-assumes ST: "stable r" and ISO: "r =o r'"
-shows "stable r'"
-using assms stable_ordIso1 ordIso_symmetric by blast
+ assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
+ shows "stable(cardSuc r)"
+ using infinite_cardSuc_regularCard regularCard_stable
+ by (metis CARD INF cardSuc_Card_order cardSuc_finite)
lemma stable_ordIso:
-assumes "r =o r'"
-shows "stable r = stable r'"
-using assms stable_ordIso1 stable_ordIso2 by blast
+ assumes "r =o r'"
+ shows "stable r = stable r'"
+ by (metis assms ordIso_symmetric stable_ordIso1)
lemma stable_nat: "stable |UNIV::nat set|"
-using stable_natLeq card_of_nat stable_ordIso by auto
+ using stable_natLeq card_of_nat stable_ordIso by auto
text\<open>Below, the type of "A" is not important -- we just had to choose an appropriate
type to make "A" possible. What is important is that arbitrarily large
infinite sets of stable cardinality exist.\<close>
lemma infinite_stable_exists:
-assumes CARD: "\<forall>r \<in> R. Card_order (r::'a rel)"
-shows "\<exists>(A :: (nat + 'a set)set).
+ assumes CARD: "\<forall>r \<in> R. Card_order (r::'a rel)"
+ shows "\<exists>(A :: (nat + 'a set)set).
\<not>finite A \<and> stable |A| \<and> (\<forall>r \<in> R. r <o |A| )"
proof-
have "\<exists>(A :: (nat + 'a set)set).
\<not>finite A \<and> stable |A| \<and> |UNIV::'a set| <o |A|"
proof(cases "finite (UNIV::'a set)")
- assume Case1: "finite (UNIV::'a set)"
+ case True
let ?B = "UNIV::nat set"
have "\<not>finite(?B <+> {})" using finite_Plus_iff by blast
moreover
have "stable |?B|" using stable_natLeq card_of_nat stable_ordIso1 by blast
hence "stable |?B <+> {}|" using stable_ordIso card_of_Plus_empty1 by blast
moreover
- have "\<not>finite(Field |?B| ) \<and> finite(Field |UNIV::'a set| )" using Case1 by simp
+ have "\<not>finite(Field |?B| ) \<and> finite(Field |UNIV::'a set| )" using True by simp
hence "|UNIV::'a set| <o |?B|" by (simp add: finite_ordLess_infinite)
hence "|UNIV::'a set| <o |?B <+> {}|" using card_of_Plus_empty1 ordLess_ordIso_trans by blast
ultimately show ?thesis by blast
next
- assume Case1: "\<not>finite (UNIV::'a set)"
+ case False
hence *: "\<not>finite(Field |UNIV::'a set| )" by simp
let ?B = "Field(cardSuc |UNIV::'a set| )"
have 0: "|?B| =o |{} <+> ?B|" using card_of_Plus_empty2 by blast
- have 1: "\<not>finite ?B" using Case1 card_of_cardSuc_finite by blast
+ have 1: "\<not>finite ?B" using False card_of_cardSuc_finite by blast
hence 2: "\<not>finite({} <+> ?B)" using 0 card_of_ordIso_finite by blast
have "|?B| =o cardSuc |UNIV::'a set|"
- using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
+ using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
moreover have "stable(cardSuc |UNIV::'a set| )"
- using stable_cardSuc * card_of_Card_order by blast
+ using stable_cardSuc * card_of_Card_order by blast
ultimately have "stable |?B|" using stable_ordIso by blast
hence 3: "stable |{} <+> ?B|" using stable_ordIso 0 by blast
have "|UNIV::'a set| <o cardSuc |UNIV::'a set|"
- using card_of_Card_order cardSuc_greater by blast
+ using card_of_Card_order cardSuc_greater by blast
moreover have "|?B| =o cardSuc |UNIV::'a set|"
- using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
+ using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
ultimately have "|UNIV::'a set| <o |?B|"
- using ordIso_symmetric ordLess_ordIso_trans by blast
+ using ordIso_symmetric ordLess_ordIso_trans by blast
hence "|UNIV::'a set| <o |{} <+> ?B|" using 0 ordLess_ordIso_trans by blast
thus ?thesis using 2 3 by blast
qed
@@ -1729,9 +1496,9 @@
qed
corollary infinite_regularCard_exists:
-assumes CARD: "\<forall>r \<in> R. Card_order (r::'a rel)"
-shows "\<exists>(A :: (nat + 'a set)set).
+ assumes CARD: "\<forall>r \<in> R. Card_order (r::'a rel)"
+ shows "\<exists>(A :: (nat + 'a set)set).
\<not>finite A \<and> regularCard |A| \<and> (\<forall>r \<in> R. r <o |A| )"
-using infinite_stable_exists[OF CARD] stable_regularCard by (metis Field_card_of card_of_card_order_on)
+ using infinite_stable_exists[OF CARD] stable_regularCard by (metis Field_card_of card_of_card_order_on)
end
--- a/src/HOL/Cardinals/Fun_More.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Fun_More.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,44 +8,20 @@
section \<open>More on Injections, Bijections and Inverses\<close>
theory Fun_More
-imports Main
+ imports Main
begin
subsection \<open>Purely functional properties\<close>
(* unused *)
-(*1*)lemma notIn_Un_bij_betw2:
-assumes NIN: "b \<notin> A" and NIN': "b' \<notin> A'" and
- BIJ: "bij_betw f A A'"
-shows "bij_betw f (A \<union> {b}) (A' \<union> {b'}) = (f b = b')"
-proof
- assume "f b = b'"
- thus "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
- using assms notIn_Un_bij_betw[of b A f A'] by auto
-next
- assume *: "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
- hence "f b \<in> A' \<union> {b'}"
- unfolding bij_betw_def by auto
- moreover
- {assume "f b \<in> A'"
- then obtain b1 where 1: "b1 \<in> A" and 2: "f b1 = f b" using BIJ
- by (auto simp add: bij_betw_def)
- hence "b = b1" using *
- by (auto simp add: bij_betw_def inj_on_def)
- with 1 NIN have False by auto
- }
- ultimately show "f b = b'" by blast
-qed
-
-(* unused *)
(*1*)lemma bij_betw_diff_singl:
-assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
-shows "bij_betw f (A - {a}) (A' - {f a})"
+ assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
+ shows "bij_betw f (A - {a}) (A' - {f a})"
proof-
let ?B = "A - {a}" let ?B' = "A' - {f a}"
have "f a \<in> A'" using IN BIJ unfolding bij_betw_def by blast
hence "a \<notin> ?B \<and> f a \<notin> ?B' \<and> A = ?B \<union> {a} \<and> A' = ?B' \<union> {f a}"
- using IN by blast
+ using IN by blast
thus ?thesis using notIn_Un_bij_betw3[of a ?B f ?B'] BIJ by simp
qed
@@ -54,120 +30,62 @@
(* unused *)
(*1*)lemma bij_betw_inv_into_RIGHT:
-assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'"
-shows "f `((inv_into A f)`B') = B'"
-using assms
-proof(auto simp add: bij_betw_inv_into_right)
- let ?f' = "(inv_into A f)"
- fix a' assume *: "a' \<in> B'"
- hence "a' \<in> A'" using SUB by auto
- hence "a' = f (?f' a')"
- using BIJ by (auto simp add: bij_betw_inv_into_right)
- thus "a' \<in> f ` (?f' ` B')" using * by blast
-qed
+ assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'"
+ shows "f `((inv_into A f)`B') = B'"
+ by (metis BIJ SUB bij_betw_imp_surj_on image_inv_into_cancel)
+
(* unused *)
(*1*)lemma bij_betw_inv_into_RIGHT_LEFT:
-assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'" and
- IM: "(inv_into A f) ` B' = B"
-shows "f ` B = B'"
-proof-
- have "f`((inv_into A f)` B') = B'"
- using assms bij_betw_inv_into_RIGHT[of f A A' B'] by auto
- thus ?thesis using IM by auto
-qed
+ assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'" and
+ IM: "(inv_into A f) ` B' = B"
+ shows "f ` B = B'"
+ by (metis BIJ IM SUB bij_betw_inv_into_RIGHT)
(* unused *)
(*2*)lemma bij_betw_inv_into_twice:
-assumes "bij_betw f A A'"
-shows "\<forall>a \<in> A. inv_into A' (inv_into A f) a = f a"
-proof
- let ?f' = "inv_into A f" let ?f'' = "inv_into A' ?f'"
- have 1: "bij_betw ?f' A' A" using assms
- by (auto simp add: bij_betw_inv_into)
- fix a assume *: "a \<in> A"
- then obtain a' where 2: "a' \<in> A'" and 3: "?f' a' = a"
- using 1 unfolding bij_betw_def by force
- hence "?f'' a = a'"
- using * 1 3 by (auto simp add: bij_betw_inv_into_left)
- moreover have "f a = a'" using assms 2 3
- by (auto simp add: bij_betw_inv_into_right)
- ultimately show "?f'' a = f a" by simp
-qed
+ assumes "bij_betw f A A'"
+ shows "\<forall>a \<in> A. inv_into A' (inv_into A f) a = f a"
+ by (simp add: assms inv_into_inv_into_eq)
subsection \<open>Properties involving Hilbert choice\<close>
(*1*)lemma bij_betw_inv_into_LEFT:
-assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A"
-shows "(inv_into A f)`(f ` B) = B"
-using assms unfolding bij_betw_def using inv_into_image_cancel by force
+ assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A"
+ shows "(inv_into A f)`(f ` B) = B"
+ using assms unfolding bij_betw_def using inv_into_image_cancel by force
(*1*)lemma bij_betw_inv_into_LEFT_RIGHT:
-assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A" and
- IM: "f ` B = B'"
-shows "(inv_into A f) ` B' = B"
-using assms bij_betw_inv_into_LEFT[of f A A' B] by fast
+ assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A" and
+ IM: "f ` B = B'"
+ shows "(inv_into A f) ` B' = B"
+ using assms bij_betw_inv_into_LEFT[of f A A' B] by fast
subsection \<open>Other facts\<close>
(*3*)lemma atLeastLessThan_injective:
-assumes "{0 ..< m::nat} = {0 ..< n}"
-shows "m = n"
-proof-
- {assume "m < n"
- hence "m \<in> {0 ..< n}" by auto
- hence "{0 ..< m} < {0 ..< n}" by auto
- hence False using assms by blast
- }
- moreover
- {assume "n < m"
- hence "n \<in> {0 ..< m}" by auto
- hence "{0 ..< n} < {0 ..< m}" by auto
- hence False using assms by blast
- }
- ultimately show ?thesis by force
-qed
+ assumes "{0 ..< m::nat} = {0 ..< n}"
+ shows "m = n"
+ using assms atLeast0LessThan by force
(*2*)lemma atLeastLessThan_injective2:
-"bij_betw f {0 ..< m::nat} {0 ..< n} \<Longrightarrow> m = n"
-using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
- card_atLeastLessThan[of m] card_atLeastLessThan[of n]
- bij_betw_iff_card[of "{0 ..< m}" "{0 ..< n}"] by auto
+ "bij_betw f {0 ..< m::nat} {0 ..< n} \<Longrightarrow> m = n"
+ using bij_betw_same_card by fastforce
(*2*)lemma atLeastLessThan_less_eq:
-"({0..<m} \<le> {0..<n}) = ((m::nat) \<le> n)"
-unfolding ivl_subset by arith
+ "({0..<m} \<le> {0..<n}) = ((m::nat) \<le> n)"
+ by auto
(*2*)lemma atLeastLessThan_less_eq2:
-assumes "inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}"
-shows "m \<le> n"
-using assms
-using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
- card_atLeastLessThan[of m] card_atLeastLessThan[of n]
- card_inj_on_le[of f "{0 ..< m}" "{0 ..< n}"] by fastforce
-
-(* unused *)
-(*2*)lemma atLeastLessThan_less_eq3:
-"(\<exists>f. inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}) = (m \<le> n)"
-using atLeastLessThan_less_eq2
-proof(auto)
- assume "m \<le> n"
- hence "inj_on id {0..<m} \<and> id ` {0..<m} \<subseteq> {0..<n}" unfolding inj_on_def by force
- thus "\<exists>f. inj_on f {0..<m} \<and> f ` {0..<m} \<subseteq> {0..<n}" by blast
-qed
+ assumes "inj_on f {0..<(m::nat)}" "f ` {0..<m} \<le> {0..<n}"
+ shows "m \<le> n"
+ by (metis assms card_inj_on_le card_lessThan finite_lessThan lessThan_atLeast0)
(* unused *)
(*3*)lemma atLeastLessThan_less:
-"({0..<m} < {0..<n}) = ((m::nat) < n)"
-proof-
- have "({0..<m} < {0..<n}) = ({0..<m} \<le> {0..<n} \<and> {0..<m} ~= {0..<n})"
- using subset_iff_psubset_eq by blast
- also have "\<dots> = (m \<le> n \<and> m ~= n)"
- using atLeastLessThan_less_eq atLeastLessThan_injective by blast
- also have "\<dots> = (m < n)" by auto
- finally show ?thesis .
-qed
+ "({0..<m} < {0..<n}) = ((m::nat) < n)"
+ by auto
end
--- a/src/HOL/Cardinals/Order_Relation_More.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Order_Relation_More.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,57 +8,57 @@
section \<open>Basics on Order-Like Relations\<close>
theory Order_Relation_More
-imports Main
+ imports Main
begin
subsection \<open>The upper and lower bounds operators\<close>
lemma aboveS_subset_above: "aboveS r a \<le> above r a"
-by(auto simp add: aboveS_def above_def)
+ by(auto simp add: aboveS_def above_def)
lemma AboveS_subset_Above: "AboveS r A \<le> Above r A"
-by(auto simp add: AboveS_def Above_def)
+ by(auto simp add: AboveS_def Above_def)
lemma UnderS_disjoint: "A Int (UnderS r A) = {}"
-by(auto simp add: UnderS_def)
+ by(auto simp add: UnderS_def)
lemma aboveS_notIn: "a \<notin> aboveS r a"
-by(auto simp add: aboveS_def)
+ by(auto simp add: aboveS_def)
lemma Refl_above_in: "\<lbrakk>Refl r; a \<in> Field r\<rbrakk> \<Longrightarrow> a \<in> above r a"
-by(auto simp add: refl_on_def above_def)
+ by(auto simp add: refl_on_def above_def)
lemma in_Above_under: "a \<in> Field r \<Longrightarrow> a \<in> Above r (under r a)"
-by(auto simp add: Above_def under_def)
+ by(auto simp add: Above_def under_def)
lemma in_Under_above: "a \<in> Field r \<Longrightarrow> a \<in> Under r (above r a)"
-by(auto simp add: Under_def above_def)
+ by(auto simp add: Under_def above_def)
lemma in_UnderS_aboveS: "a \<in> Field r \<Longrightarrow> a \<in> UnderS r (aboveS r a)"
-by(auto simp add: UnderS_def aboveS_def)
+ by(auto simp add: UnderS_def aboveS_def)
lemma UnderS_subset_Under: "UnderS r A \<le> Under r A"
-by(auto simp add: UnderS_def Under_def)
+ by(auto simp add: UnderS_def Under_def)
lemma subset_Above_Under: "B \<le> Field r \<Longrightarrow> B \<le> Above r (Under r B)"
-by(auto simp add: Above_def Under_def)
+ by(auto simp add: Above_def Under_def)
lemma subset_Under_Above: "B \<le> Field r \<Longrightarrow> B \<le> Under r (Above r B)"
-by(auto simp add: Under_def Above_def)
+ by(auto simp add: Under_def Above_def)
lemma subset_AboveS_UnderS: "B \<le> Field r \<Longrightarrow> B \<le> AboveS r (UnderS r B)"
-by(auto simp add: AboveS_def UnderS_def)
+ by(auto simp add: AboveS_def UnderS_def)
lemma subset_UnderS_AboveS: "B \<le> Field r \<Longrightarrow> B \<le> UnderS r (AboveS r B)"
-by(auto simp add: UnderS_def AboveS_def)
+ by(auto simp add: UnderS_def AboveS_def)
lemma Under_Above_Galois:
-"\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> Above r C) = (C \<le> Under r B)"
-by(unfold Above_def Under_def, blast)
+ "\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> Above r C) = (C \<le> Under r B)"
+ by(unfold Above_def Under_def, blast)
lemma UnderS_AboveS_Galois:
-"\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> AboveS r C) = (C \<le> UnderS r B)"
-by(unfold AboveS_def UnderS_def, blast)
+ "\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> AboveS r C) = (C \<le> UnderS r B)"
+ by(unfold AboveS_def UnderS_def, blast)
lemma Refl_above_aboveS:
assumes REFL: "Refl r" and IN: "a \<in> Field r"
@@ -79,20 +79,20 @@
with LIN IN order_on_defs[of "Field r" r] total_on_def[of "Field r" r]
have "(a,b) \<in> r \<or> a = b" by blast
thus "(a,b) \<in> r"
- using LIN IN order_on_defs[of _ r] refl_on_def[of _ r] by auto
+ using LIN IN order_on_defs[of _ r] refl_on_def[of _ r] by auto
next
fix b assume "(b, a) \<in> r"
thus "b \<in> Field r"
- using LIN order_on_defs[of _ r] refl_on_def[of _ r] by blast
+ using LIN order_on_defs[of _ r] refl_on_def[of _ r] by blast
next
fix b assume "b \<noteq> a" "(a, b) \<in> r"
thus "b \<in> Field r"
- using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
+ using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
qed
lemma Linear_order_underS_above_Field:
-assumes LIN: "Linear_order r" and IN: "a \<in> Field r"
-shows "Field r = underS r a \<union> above r a"
+ assumes LIN: "Linear_order r" and IN: "a \<in> Field r"
+ shows "Field r = underS r a \<union> above r a"
proof(unfold underS_def above_def, auto)
assume "a \<in> Field r" "(a, a) \<notin> r"
with LIN IN order_on_defs[of _ r] refl_on_def[of _ r]
@@ -102,174 +102,174 @@
with LIN IN order_on_defs[of "Field r" r] total_on_def[of "Field r" r]
have "(b,a) \<in> r \<or> b = a" by blast
thus "(b,a) \<in> r"
- using LIN IN order_on_defs[of _ r] refl_on_def[of _ r] by auto
+ using LIN IN order_on_defs[of _ r] refl_on_def[of _ r] by auto
next
fix b assume "b \<noteq> a" "(b, a) \<in> r"
thus "b \<in> Field r"
- using LIN order_on_defs[of _ r] refl_on_def[of _ r] by blast
+ using LIN order_on_defs[of _ r] refl_on_def[of _ r] by blast
next
fix b assume "(a, b) \<in> r"
thus "b \<in> Field r"
- using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
+ using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
qed
lemma under_empty: "a \<notin> Field r \<Longrightarrow> under r a = {}"
-unfolding Field_def under_def by auto
+ unfolding Field_def under_def by auto
lemma Under_Field: "Under r A \<le> Field r"
-by(unfold Under_def Field_def, auto)
+ by(unfold Under_def Field_def, auto)
lemma UnderS_Field: "UnderS r A \<le> Field r"
-by(unfold UnderS_def Field_def, auto)
+ by(unfold UnderS_def Field_def, auto)
lemma above_Field: "above r a \<le> Field r"
-by(unfold above_def Field_def, auto)
+ by(unfold above_def Field_def, auto)
lemma aboveS_Field: "aboveS r a \<le> Field r"
-by(unfold aboveS_def Field_def, auto)
+ by(unfold aboveS_def Field_def, auto)
lemma Above_Field: "Above r A \<le> Field r"
-by(unfold Above_def Field_def, auto)
+ by(unfold Above_def Field_def, auto)
lemma Refl_under_Under:
-assumes REFL: "Refl r" and NE: "A \<noteq> {}"
-shows "Under r A = (\<Inter>a \<in> A. under r a)"
+ assumes REFL: "Refl r" and NE: "A \<noteq> {}"
+ shows "Under r A = (\<Inter>a \<in> A. under r a)"
proof
show "Under r A \<subseteq> (\<Inter>a \<in> A. under r a)"
- by(unfold Under_def under_def, auto)
+ by(unfold Under_def under_def, auto)
next
show "(\<Inter>a \<in> A. under r a) \<subseteq> Under r A"
proof(auto)
fix x
assume *: "\<forall>xa \<in> A. x \<in> under r xa"
hence "\<forall>xa \<in> A. (x,xa) \<in> r"
- by (simp add: under_def)
+ by (simp add: under_def)
moreover
{from NE obtain a where "a \<in> A" by blast
- with * have "x \<in> under r a" by simp
- hence "x \<in> Field r"
- using under_Field[of r a] by auto
+ with * have "x \<in> under r a" by simp
+ hence "x \<in> Field r"
+ using under_Field[of r a] by auto
}
ultimately show "x \<in> Under r A"
- unfolding Under_def by auto
+ unfolding Under_def by auto
qed
qed
lemma Refl_underS_UnderS:
-assumes REFL: "Refl r" and NE: "A \<noteq> {}"
-shows "UnderS r A = (\<Inter>a \<in> A. underS r a)"
+ assumes REFL: "Refl r" and NE: "A \<noteq> {}"
+ shows "UnderS r A = (\<Inter>a \<in> A. underS r a)"
proof
show "UnderS r A \<subseteq> (\<Inter>a \<in> A. underS r a)"
- by(unfold UnderS_def underS_def, auto)
+ by(unfold UnderS_def underS_def, auto)
next
show "(\<Inter>a \<in> A. underS r a) \<subseteq> UnderS r A"
proof(auto)
fix x
assume *: "\<forall>xa \<in> A. x \<in> underS r xa"
hence "\<forall>xa \<in> A. x \<noteq> xa \<and> (x,xa) \<in> r"
- by (auto simp add: underS_def)
+ by (auto simp add: underS_def)
moreover
{from NE obtain a where "a \<in> A" by blast
- with * have "x \<in> underS r a" by simp
- hence "x \<in> Field r"
- using underS_Field[of _ r a] by auto
+ with * have "x \<in> underS r a" by simp
+ hence "x \<in> Field r"
+ using underS_Field[of _ r a] by auto
}
ultimately show "x \<in> UnderS r A"
- unfolding UnderS_def by auto
+ unfolding UnderS_def by auto
qed
qed
lemma Refl_above_Above:
-assumes REFL: "Refl r" and NE: "A \<noteq> {}"
-shows "Above r A = (\<Inter>a \<in> A. above r a)"
+ assumes REFL: "Refl r" and NE: "A \<noteq> {}"
+ shows "Above r A = (\<Inter>a \<in> A. above r a)"
proof
show "Above r A \<subseteq> (\<Inter>a \<in> A. above r a)"
- by(unfold Above_def above_def, auto)
+ by(unfold Above_def above_def, auto)
next
show "(\<Inter>a \<in> A. above r a) \<subseteq> Above r A"
proof(auto)
fix x
assume *: "\<forall>xa \<in> A. x \<in> above r xa"
hence "\<forall>xa \<in> A. (xa,x) \<in> r"
- by (simp add: above_def)
+ by (simp add: above_def)
moreover
{from NE obtain a where "a \<in> A" by blast
- with * have "x \<in> above r a" by simp
- hence "x \<in> Field r"
- using above_Field[of r a] by auto
+ with * have "x \<in> above r a" by simp
+ hence "x \<in> Field r"
+ using above_Field[of r a] by auto
}
ultimately show "x \<in> Above r A"
- unfolding Above_def by auto
+ unfolding Above_def by auto
qed
qed
lemma Refl_aboveS_AboveS:
-assumes REFL: "Refl r" and NE: "A \<noteq> {}"
-shows "AboveS r A = (\<Inter>a \<in> A. aboveS r a)"
+ assumes REFL: "Refl r" and NE: "A \<noteq> {}"
+ shows "AboveS r A = (\<Inter>a \<in> A. aboveS r a)"
proof
show "AboveS r A \<subseteq> (\<Inter>a \<in> A. aboveS r a)"
- by(unfold AboveS_def aboveS_def, auto)
+ by(unfold AboveS_def aboveS_def, auto)
next
show "(\<Inter>a \<in> A. aboveS r a) \<subseteq> AboveS r A"
proof(auto)
fix x
assume *: "\<forall>xa \<in> A. x \<in> aboveS r xa"
hence "\<forall>xa \<in> A. xa \<noteq> x \<and> (xa,x) \<in> r"
- by (auto simp add: aboveS_def)
+ by (auto simp add: aboveS_def)
moreover
{from NE obtain a where "a \<in> A" by blast
- with * have "x \<in> aboveS r a" by simp
- hence "x \<in> Field r"
- using aboveS_Field[of r a] by auto
+ with * have "x \<in> aboveS r a" by simp
+ hence "x \<in> Field r"
+ using aboveS_Field[of r a] by auto
}
ultimately show "x \<in> AboveS r A"
- unfolding AboveS_def by auto
+ unfolding AboveS_def by auto
qed
qed
lemma under_Under_singl: "under r a = Under r {a}"
-by(unfold Under_def under_def, auto simp add: Field_def)
+ by(unfold Under_def under_def, auto simp add: Field_def)
lemma underS_UnderS_singl: "underS r a = UnderS r {a}"
-by(unfold UnderS_def underS_def, auto simp add: Field_def)
+ by(unfold UnderS_def underS_def, auto simp add: Field_def)
lemma above_Above_singl: "above r a = Above r {a}"
-by(unfold Above_def above_def, auto simp add: Field_def)
+ by(unfold Above_def above_def, auto simp add: Field_def)
lemma aboveS_AboveS_singl: "aboveS r a = AboveS r {a}"
-by(unfold AboveS_def aboveS_def, auto simp add: Field_def)
+ by(unfold AboveS_def aboveS_def, auto simp add: Field_def)
lemma Under_decr: "A \<le> B \<Longrightarrow> Under r B \<le> Under r A"
-by(unfold Under_def, auto)
+ by(unfold Under_def, auto)
lemma UnderS_decr: "A \<le> B \<Longrightarrow> UnderS r B \<le> UnderS r A"
-by(unfold UnderS_def, auto)
+ by(unfold UnderS_def, auto)
lemma Above_decr: "A \<le> B \<Longrightarrow> Above r B \<le> Above r A"
-by(unfold Above_def, auto)
+ by(unfold Above_def, auto)
lemma AboveS_decr: "A \<le> B \<Longrightarrow> AboveS r B \<le> AboveS r A"
-by(unfold AboveS_def, auto)
+ by(unfold AboveS_def, auto)
lemma under_incl_iff:
-assumes TRANS: "trans r" and REFL: "Refl r" and IN: "a \<in> Field r"
-shows "(under r a \<le> under r b) = ((a,b) \<in> r)"
+ assumes TRANS: "trans r" and REFL: "Refl r" and IN: "a \<in> Field r"
+ shows "(under r a \<le> under r b) = ((a,b) \<in> r)"
proof
assume "(a,b) \<in> r"
thus "under r a \<le> under r b" using TRANS
- by (auto simp add: under_incr)
+ by (auto simp add: under_incr)
next
assume "under r a \<le> under r b"
moreover
have "a \<in> under r a" using REFL IN
- by (auto simp add: Refl_under_in)
+ by (auto simp add: Refl_under_in)
ultimately show "(a,b) \<in> r"
- by (auto simp add: under_def)
+ by (auto simp add: under_def)
qed
lemma above_decr:
-assumes TRANS: "trans r" and REL: "(a,b) \<in> r"
-shows "above r b \<le> above r a"
+ assumes TRANS: "trans r" and REL: "(a,b) \<in> r"
+ shows "above r b \<le> above r a"
proof(unfold above_def, auto)
fix x assume "(b,x) \<in> r"
with REL TRANS trans_def[of r]
@@ -277,9 +277,9 @@
qed
lemma aboveS_decr:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- REL: "(a,b) \<in> r"
-shows "aboveS r b \<le> aboveS r a"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ REL: "(a,b) \<in> r"
+ shows "aboveS r b \<le> aboveS r a"
proof(unfold aboveS_def, auto)
assume *: "a \<noteq> b" and **: "(b,a) \<in> r"
with ANTISYM antisym_def[of r] REL
@@ -291,26 +291,26 @@
qed
lemma under_trans:
-assumes TRANS: "trans r" and
- IN1: "a \<in> under r b" and IN2: "b \<in> under r c"
-shows "a \<in> under r c"
+ assumes TRANS: "trans r" and
+ IN1: "a \<in> under r b" and IN2: "b \<in> under r c"
+ shows "a \<in> under r c"
proof-
have "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 under_def by fastforce
+ using IN1 IN2 under_def by fastforce
hence "(a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
thus ?thesis unfolding under_def by simp
qed
lemma under_underS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> under r b" and IN2: "b \<in> underS r c"
-shows "a \<in> underS r c"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> under r b" and IN2: "b \<in> underS r c"
+ shows "a \<in> underS r c"
proof-
have 0: "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 under_def underS_def by fastforce
+ using IN1 IN2 under_def underS_def by fastforce
hence 1: "(a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
have 2: "b \<noteq> c" using IN2 underS_def by force
have 3: "a \<noteq> c"
proof
@@ -321,14 +321,14 @@
qed
lemma underS_under_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> underS r b" and IN2: "b \<in> under r c"
-shows "a \<in> underS r c"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> underS r b" and IN2: "b \<in> under r c"
+ shows "a \<in> underS r c"
proof-
have 0: "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 under_def underS_def by fast
+ using IN1 IN2 under_def underS_def by fast
hence 1: "(a,c) \<in> r"
- using TRANS trans_def[of r] by fast
+ using TRANS trans_def[of r] by fast
have 2: "a \<noteq> b" using IN1 underS_def by force
have 3: "a \<noteq> c"
proof
@@ -339,36 +339,36 @@
qed
lemma underS_underS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> underS r b" and IN2: "b \<in> underS r c"
-shows "a \<in> underS r c"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> underS r b" and IN2: "b \<in> underS r c"
+ shows "a \<in> underS r c"
proof-
have "a \<in> under r b"
- using IN1 underS_subset_under by fast
+ using IN1 underS_subset_under by fast
with assms under_underS_trans show ?thesis by fast
qed
lemma above_trans:
-assumes TRANS: "trans r" and
- IN1: "b \<in> above r a" and IN2: "c \<in> above r b"
-shows "c \<in> above r a"
+ assumes TRANS: "trans r" and
+ IN1: "b \<in> above r a" and IN2: "c \<in> above r b"
+ shows "c \<in> above r a"
proof-
have "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 above_def by fast
+ using IN1 IN2 above_def by fast
hence "(a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
thus ?thesis unfolding above_def by simp
qed
lemma above_aboveS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "b \<in> above r a" and IN2: "c \<in> aboveS r b"
-shows "c \<in> aboveS r a"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "b \<in> above r a" and IN2: "c \<in> aboveS r b"
+ shows "c \<in> aboveS r a"
proof-
have 0: "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 above_def aboveS_def by fast
+ using IN1 IN2 above_def aboveS_def by fast
hence 1: "(a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
have 2: "b \<noteq> c" using IN2 aboveS_def by force
have 3: "a \<noteq> c"
proof
@@ -379,14 +379,14 @@
qed
lemma aboveS_above_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "b \<in> aboveS r a" and IN2: "c \<in> above r b"
-shows "c \<in> aboveS r a"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "b \<in> aboveS r a" and IN2: "c \<in> above r b"
+ shows "c \<in> aboveS r a"
proof-
have 0: "(a,b) \<in> r \<and> (b,c) \<in> r"
- using IN1 IN2 above_def aboveS_def by fast
+ using IN1 IN2 above_def aboveS_def by fast
hence 1: "(a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
have 2: "a \<noteq> b" using IN1 aboveS_def by force
have 3: "a \<noteq> c"
proof
@@ -397,26 +397,26 @@
qed
lemma aboveS_aboveS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "b \<in> aboveS r a" and IN2: "c \<in> aboveS r b"
-shows "c \<in> aboveS r a"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "b \<in> aboveS r a" and IN2: "c \<in> aboveS r b"
+ shows "c \<in> aboveS r a"
proof-
have "b \<in> above r a"
- using IN1 aboveS_subset_above by fast
+ using IN1 aboveS_subset_above by fast
with assms above_aboveS_trans show ?thesis by fast
qed
lemma under_Under_trans:
-assumes TRANS: "trans r" and
- IN1: "a \<in> under r b" and IN2: "b \<in> Under r C"
-shows "a \<in> Under r C"
+ assumes TRANS: "trans r" and
+ IN1: "a \<in> under r b" and IN2: "b \<in> Under r C"
+ shows "a \<in> Under r C"
proof-
have "b \<in> {u \<in> Field r. \<forall>x. x \<in> C \<longrightarrow> (u, x) \<in> r}"
using IN2 Under_def by force
hence "(a,b) \<in> r \<and> (\<forall>c \<in> C. (b,c) \<in> r)"
using IN1 under_def by fast
hence "\<forall>c \<in> C. (a,c) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
moreover
have "a \<in> Field r" using IN1 unfolding Field_def under_def by blast
ultimately
@@ -424,53 +424,53 @@
qed
lemma underS_Under_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> underS r b" and IN2: "b \<in> Under r C"
-shows "a \<in> UnderS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> underS r b" and IN2: "b \<in> Under r C"
+ shows "a \<in> UnderS r C"
proof-
from IN1 have "a \<in> under r b"
- using underS_subset_under[of r b] by fast
+ using underS_subset_under[of r b] by fast
with assms under_Under_trans
have "a \<in> Under r C" by fast
- (* *)
+ (* *)
moreover
have "a \<notin> C"
proof
assume *: "a \<in> C"
have 1: "b \<noteq> a \<and> (a,b) \<in> r"
- using IN1 underS_def[of r b] by auto
+ using IN1 underS_def[of r b] by auto
have "\<forall>c \<in> C. (b,c) \<in> r"
- using IN2 Under_def[of r C] by auto
+ using IN2 Under_def[of r C] by auto
with * have "(b,a) \<in> r" by simp
with 1 ANTISYM antisym_def[of r]
show False by blast
qed
- (* *)
+ (* *)
ultimately
show ?thesis unfolding UnderS_def
- using Under_def by force
+ using Under_def by force
qed
lemma underS_UnderS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> underS r b" and IN2: "b \<in> UnderS r C"
-shows "a \<in> UnderS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> underS r b" and IN2: "b \<in> UnderS r C"
+ shows "a \<in> UnderS r C"
proof-
from IN2 have "b \<in> Under r C"
- using UnderS_subset_Under[of r C] by blast
+ using UnderS_subset_Under[of r C] by blast
with underS_Under_trans assms
show ?thesis by force
qed
lemma above_Above_trans:
-assumes TRANS: "trans r" and
- IN1: "a \<in> above r b" and IN2: "b \<in> Above r C"
-shows "a \<in> Above r C"
+ assumes TRANS: "trans r" and
+ IN1: "a \<in> above r b" and IN2: "b \<in> Above r C"
+ shows "a \<in> Above r C"
proof-
have "(b,a) \<in> r \<and> (\<forall>c \<in> C. (c,b) \<in> r)"
using IN1[unfolded above_def] IN2[unfolded Above_def] by simp
hence "\<forall>c \<in> C. (c,a) \<in> r"
- using TRANS trans_def[of r] by blast
+ using TRANS trans_def[of r] by blast
moreover
have "a \<in> Field r" using IN1[unfolded above_def] Field_def by fast
ultimately
@@ -478,95 +478,95 @@
qed
lemma aboveS_Above_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> aboveS r b" and IN2: "b \<in> Above r C"
-shows "a \<in> AboveS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> aboveS r b" and IN2: "b \<in> Above r C"
+ shows "a \<in> AboveS r C"
proof-
from IN1 have "a \<in> above r b"
- using aboveS_subset_above[of r b] by blast
+ using aboveS_subset_above[of r b] by blast
with assms above_Above_trans
have "a \<in> Above r C" by fast
- (* *)
+ (* *)
moreover
have "a \<notin> C"
proof
assume *: "a \<in> C"
have 1: "b \<noteq> a \<and> (b,a) \<in> r"
- using IN1 aboveS_def[of r b] by auto
+ using IN1 aboveS_def[of r b] by auto
have "\<forall>c \<in> C. (c,b) \<in> r"
- using IN2 Above_def[of r C] by auto
+ using IN2 Above_def[of r C] by auto
with * have "(a,b) \<in> r" by simp
with 1 ANTISYM antisym_def[of r]
show False by blast
qed
- (* *)
+ (* *)
ultimately
show ?thesis unfolding AboveS_def
- using Above_def by force
+ using Above_def by force
qed
lemma above_AboveS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> above r b" and IN2: "b \<in> AboveS r C"
-shows "a \<in> AboveS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> above r b" and IN2: "b \<in> AboveS r C"
+ shows "a \<in> AboveS r C"
proof-
from IN2 have "b \<in> Above r C"
- using AboveS_subset_Above[of r C] by blast
+ using AboveS_subset_Above[of r C] by blast
with assms above_Above_trans
have "a \<in> Above r C" by force
- (* *)
+ (* *)
moreover
have "a \<notin> C"
proof
assume *: "a \<in> C"
have 1: "(b,a) \<in> r"
- using IN1 above_def[of r b] by auto
+ using IN1 above_def[of r b] by auto
have "\<forall>c \<in> C. b \<noteq> c \<and> (c,b) \<in> r"
- using IN2 AboveS_def[of r C] by auto
+ using IN2 AboveS_def[of r C] by auto
with * have "b \<noteq> a \<and> (a,b) \<in> r" by simp
with 1 ANTISYM antisym_def[of r]
show False by blast
qed
- (* *)
+ (* *)
ultimately
show ?thesis unfolding AboveS_def
- using Above_def by force
+ using Above_def by force
qed
lemma aboveS_AboveS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> aboveS r b" and IN2: "b \<in> AboveS r C"
-shows "a \<in> AboveS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> aboveS r b" and IN2: "b \<in> AboveS r C"
+ shows "a \<in> AboveS r C"
proof-
from IN2 have "b \<in> Above r C"
- using AboveS_subset_Above[of r C] by blast
+ using AboveS_subset_Above[of r C] by blast
with aboveS_Above_trans assms
show ?thesis by force
qed
lemma under_UnderS_trans:
-assumes TRANS: "trans r" and ANTISYM: "antisym r" and
- IN1: "a \<in> under r b" and IN2: "b \<in> UnderS r C"
-shows "a \<in> UnderS r C"
+ assumes TRANS: "trans r" and ANTISYM: "antisym r" and
+ IN1: "a \<in> under r b" and IN2: "b \<in> UnderS r C"
+ shows "a \<in> UnderS r C"
proof-
from IN2 have "b \<in> Under r C"
- using UnderS_subset_Under[of r C] by blast
+ using UnderS_subset_Under[of r C] by blast
with assms under_Under_trans
have "a \<in> Under r C" by force
- (* *)
+ (* *)
moreover
have "a \<notin> C"
proof
assume *: "a \<in> C"
have 1: "(a,b) \<in> r"
- using IN1 under_def[of r b] by auto
+ using IN1 under_def[of r b] by auto
have "\<forall>c \<in> C. b \<noteq> c \<and> (b,c) \<in> r"
- using IN2 UnderS_def[of r C] by blast
+ using IN2 UnderS_def[of r C] by blast
with * have "b \<noteq> a \<and> (b,a) \<in> r" by blast
with 1 ANTISYM antisym_def[of r]
show False by blast
qed
- (* *)
+ (* *)
ultimately
show ?thesis unfolding UnderS_def Under_def by fast
qed
@@ -575,12 +575,12 @@
subsection \<open>Properties depending on more than one relation\<close>
lemma under_incr2:
-"r \<le> r' \<Longrightarrow> under r a \<le> under r' a"
-unfolding under_def by blast
+ "r \<le> r' \<Longrightarrow> under r a \<le> under r' a"
+ unfolding under_def by blast
lemma underS_incr2:
-"r \<le> r' \<Longrightarrow> underS r a \<le> underS r' a"
-unfolding underS_def by blast
+ "r \<le> r' \<Longrightarrow> underS r a \<le> underS r' a"
+ unfolding underS_def by blast
(* FIXME: r \<leadsto> r'
lemma Under_incr:
@@ -601,12 +601,12 @@
*)
lemma above_incr2:
-"r \<le> r' \<Longrightarrow> above r a \<le> above r' a"
-unfolding above_def by blast
+ "r \<le> r' \<Longrightarrow> above r a \<le> above r' a"
+ unfolding above_def by blast
lemma aboveS_incr2:
-"r \<le> r' \<Longrightarrow> aboveS r a \<le> aboveS r' a"
-unfolding aboveS_def by blast
+ "r \<le> r' \<Longrightarrow> aboveS r a \<le> aboveS r' a"
+ unfolding aboveS_def by blast
(* FIXME
lemma Above_incr:
--- a/src/HOL/Cardinals/Order_Union.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Order_Union.thy Sun Jan 15 20:00:44 2023 +0100
@@ -7,7 +7,7 @@
section \<open>Order Union\<close>
theory Order_Union
-imports Main
+ imports Main
begin
definition Osum :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel" (infix "Osum" 60) where
@@ -19,10 +19,10 @@
unfolding Osum_def Field_def by blast
lemma Osum_wf:
-assumes FLD: "Field r Int Field r' = {}" and
- WF: "wf r" and WF': "wf r'"
-shows "wf (r Osum r')"
-unfolding wf_eq_minimal2 unfolding Field_Osum
+ assumes FLD: "Field r Int Field r' = {}" and
+ WF: "wf r" and WF': "wf r'"
+ shows "wf (r Osum r')"
+ unfolding wf_eq_minimal2 unfolding Field_Osum
proof(intro allI impI, elim conjE)
fix A assume *: "A \<subseteq> Field r \<union> Field r'" and **: "A \<noteq> {}"
obtain B where B_def: "B = A Int Field r" by blast
@@ -31,26 +31,26 @@
assume Case1: "B \<noteq> {}"
hence "B \<noteq> {} \<and> B \<le> Field r" using B_def by auto
then obtain a where 1: "a \<in> B" and 2: "\<forall>a1 \<in> B. (a1,a) \<notin> r"
- using WF unfolding wf_eq_minimal2 by blast
+ using WF unfolding wf_eq_minimal2 by blast
hence 3: "a \<in> Field r \<and> a \<notin> Field r'" using B_def FLD by auto
- (* *)
+ (* *)
have "\<forall>a1 \<in> A. (a1,a) \<notin> r Osum r'"
proof(intro ballI)
fix a1 assume **: "a1 \<in> A"
{assume Case11: "a1 \<in> Field r"
- hence "(a1,a) \<notin> r" using B_def ** 2 by auto
- moreover
- have "(a1,a) \<notin> r'" using 3 by (auto simp add: Field_def)
- ultimately have "(a1,a) \<notin> r Osum r'"
- using 3 unfolding Osum_def by auto
+ hence "(a1,a) \<notin> r" using B_def ** 2 by auto
+ moreover
+ have "(a1,a) \<notin> r'" using 3 by (auto simp add: Field_def)
+ ultimately have "(a1,a) \<notin> r Osum r'"
+ using 3 unfolding Osum_def by auto
}
moreover
{assume Case12: "a1 \<notin> Field r"
- hence "(a1,a) \<notin> r" unfolding Field_def by auto
- moreover
- have "(a1,a) \<notin> r'" using 3 unfolding Field_def by auto
- ultimately have "(a1,a) \<notin> r Osum r'"
- using 3 unfolding Osum_def by auto
+ hence "(a1,a) \<notin> r" unfolding Field_def by auto
+ moreover
+ have "(a1,a) \<notin> r'" using 3 unfolding Field_def by auto
+ ultimately have "(a1,a) \<notin> r Osum r'"
+ using 3 unfolding Osum_def by auto
}
ultimately show "(a1,a) \<notin> r Osum r'" by blast
qed
@@ -59,9 +59,9 @@
assume Case2: "B = {}"
hence 1: "A \<noteq> {} \<and> A \<le> Field r'" using * ** B_def by auto
then obtain a' where 2: "a' \<in> A" and 3: "\<forall>a1' \<in> A. (a1',a') \<notin> r'"
- using WF' unfolding wf_eq_minimal2 by blast
+ using WF' unfolding wf_eq_minimal2 by blast
hence 4: "a' \<in> Field r' \<and> a' \<notin> Field r" using 1 FLD by blast
- (* *)
+ (* *)
have "\<forall>a1' \<in> A. (a1',a') \<notin> r Osum r'"
proof(unfold Osum_def, auto simp add: 3)
fix a1' assume "(a1', a') \<in> r"
@@ -75,296 +75,118 @@
qed
lemma Osum_Refl:
-assumes FLD: "Field r Int Field r' = {}" and
- REFL: "Refl r" and REFL': "Refl r'"
-shows "Refl (r Osum r')"
-using assms
-unfolding refl_on_def Field_Osum unfolding Osum_def by blast
+ assumes FLD: "Field r Int Field r' = {}" and
+ REFL: "Refl r" and REFL': "Refl r'"
+ shows "Refl (r Osum r')"
+ using assms
+ unfolding refl_on_def Field_Osum unfolding Osum_def by blast
lemma Osum_trans:
-assumes FLD: "Field r Int Field r' = {}" and
- TRANS: "trans r" and TRANS': "trans r'"
-shows "trans (r Osum r')"
-proof(unfold trans_def, auto)
- fix x y z assume *: "(x, y) \<in> r \<union>o r'" and **: "(y, z) \<in> r \<union>o r'"
- show "(x, z) \<in> r \<union>o r'"
- proof-
- {assume Case1: "(x,y) \<in> r"
- hence 1: "x \<in> Field r \<and> y \<in> Field r" unfolding Field_def by auto
- have ?thesis
- proof-
- {assume Case11: "(y,z) \<in> r"
- hence "(x,z) \<in> r" using Case1 TRANS trans_def[of r] by blast
- hence ?thesis unfolding Osum_def by auto
- }
- moreover
- {assume Case12: "(y,z) \<in> r'"
- hence "y \<in> Field r'" unfolding Field_def by auto
- hence False using FLD 1 by auto
- }
- moreover
- {assume Case13: "z \<in> Field r'"
- hence ?thesis using 1 unfolding Osum_def by auto
- }
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- moreover
- {assume Case2: "(x,y) \<in> r'"
- hence 2: "x \<in> Field r' \<and> y \<in> Field r'" unfolding Field_def by auto
- have ?thesis
- proof-
- {assume Case21: "(y,z) \<in> r"
- hence "y \<in> Field r" unfolding Field_def by auto
- hence False using FLD 2 by auto
- }
- moreover
- {assume Case22: "(y,z) \<in> r'"
- hence "(x,z) \<in> r'" using Case2 TRANS' trans_def[of r'] by blast
- hence ?thesis unfolding Osum_def by auto
- }
- moreover
- {assume Case23: "y \<in> Field r"
- hence False using FLD 2 by auto
- }
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- moreover
- {assume Case3: "x \<in> Field r \<and> y \<in> Field r'"
- have ?thesis
- proof-
- {assume Case31: "(y,z) \<in> r"
- hence "y \<in> Field r" unfolding Field_def by auto
- hence False using FLD Case3 by auto
- }
- moreover
- {assume Case32: "(y,z) \<in> r'"
- hence "z \<in> Field r'" unfolding Field_def by blast
- hence ?thesis unfolding Osum_def using Case3 by auto
- }
- moreover
- {assume Case33: "y \<in> Field r"
- hence False using FLD Case3 by auto
- }
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- ultimately show ?thesis using * unfolding Osum_def by blast
- qed
-qed
+ assumes FLD: "Field r Int Field r' = {}" and
+ TRANS: "trans r" and TRANS': "trans r'"
+ shows "trans (r Osum r')"
+ using assms unfolding Osum_def trans_def disjoint_iff Field_iff by blast
lemma Osum_Preorder:
-"\<lbrakk>Field r Int Field r' = {}; Preorder r; Preorder r'\<rbrakk> \<Longrightarrow> Preorder (r Osum r')"
-unfolding preorder_on_def using Osum_Refl Osum_trans by blast
+ "\<lbrakk>Field r Int Field r' = {}; Preorder r; Preorder r'\<rbrakk> \<Longrightarrow> Preorder (r Osum r')"
+ unfolding preorder_on_def using Osum_Refl Osum_trans by blast
lemma Osum_antisym:
-assumes FLD: "Field r Int Field r' = {}" and
- AN: "antisym r" and AN': "antisym r'"
-shows "antisym (r Osum r')"
-proof(unfold antisym_def, auto)
- fix x y assume *: "(x, y) \<in> r \<union>o r'" and **: "(y, x) \<in> r \<union>o r'"
- show "x = y"
- proof-
- {assume Case1: "(x,y) \<in> r"
- hence 1: "x \<in> Field r \<and> y \<in> Field r" unfolding Field_def by auto
- have ?thesis
- proof-
- have "(y,x) \<in> r \<Longrightarrow> ?thesis"
- using Case1 AN antisym_def[of r] by blast
- moreover
- {assume "(y,x) \<in> r'"
- hence "y \<in> Field r'" unfolding Field_def by auto
- hence False using FLD 1 by auto
- }
- moreover
- have "x \<in> Field r' \<Longrightarrow> False" using FLD 1 by auto
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- moreover
- {assume Case2: "(x,y) \<in> r'"
- hence 2: "x \<in> Field r' \<and> y \<in> Field r'" unfolding Field_def by auto
- have ?thesis
- proof-
- {assume "(y,x) \<in> r"
- hence "y \<in> Field r" unfolding Field_def by auto
- hence False using FLD 2 by auto
- }
- moreover
- have "(y,x) \<in> r' \<Longrightarrow> ?thesis"
- using Case2 AN' antisym_def[of r'] by blast
- moreover
- {assume "y \<in> Field r"
- hence False using FLD 2 by auto
- }
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- moreover
- {assume Case3: "x \<in> Field r \<and> y \<in> Field r'"
- have ?thesis
- proof-
- {assume "(y,x) \<in> r"
- hence "y \<in> Field r" unfolding Field_def by auto
- hence False using FLD Case3 by auto
- }
- moreover
- {assume Case32: "(y,x) \<in> r'"
- hence "x \<in> Field r'" unfolding Field_def by blast
- hence False using FLD Case3 by auto
- }
- moreover
- have "\<not> y \<in> Field r" using FLD Case3 by auto
- ultimately show ?thesis using ** unfolding Osum_def by blast
- qed
- }
- ultimately show ?thesis using * unfolding Osum_def by blast
- qed
-qed
+ assumes FLD: "Field r Int Field r' = {}" and
+ AN: "antisym r" and AN': "antisym r'"
+ shows "antisym (r Osum r')"
+ using assms by (auto simp: disjoint_iff antisym_def Osum_def Field_def)
lemma Osum_Partial_order:
-"\<lbrakk>Field r Int Field r' = {}; Partial_order r; Partial_order r'\<rbrakk> \<Longrightarrow>
+ "\<lbrakk>Field r Int Field r' = {}; Partial_order r; Partial_order r'\<rbrakk> \<Longrightarrow>
Partial_order (r Osum r')"
-unfolding partial_order_on_def using Osum_Preorder Osum_antisym by blast
+ unfolding partial_order_on_def using Osum_Preorder Osum_antisym by blast
lemma Osum_Total:
-assumes FLD: "Field r Int Field r' = {}" and
- TOT: "Total r" and TOT': "Total r'"
-shows "Total (r Osum r')"
-using assms
-unfolding total_on_def Field_Osum unfolding Osum_def by blast
+ assumes FLD: "Field r Int Field r' = {}" and
+ TOT: "Total r" and TOT': "Total r'"
+ shows "Total (r Osum r')"
+ using assms
+ unfolding total_on_def Field_Osum unfolding Osum_def by blast
lemma Osum_Linear_order:
-"\<lbrakk>Field r Int Field r' = {}; Linear_order r; Linear_order r'\<rbrakk> \<Longrightarrow>
- Linear_order (r Osum r')"
-unfolding linear_order_on_def using Osum_Partial_order Osum_Total by blast
+ "\<lbrakk>Field r Int Field r' = {}; Linear_order r; Linear_order r'\<rbrakk> \<Longrightarrow> Linear_order (r Osum r')"
+ by (simp add: Osum_Partial_order Osum_Total linear_order_on_def)
lemma Osum_minus_Id1:
-assumes "r \<le> Id"
-shows "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
-proof-
- let ?Left = "(r Osum r') - Id"
- let ?Right = "(r' - Id) \<union> (Field r \<times> Field r')"
- {fix a::'a and b assume *: "(a,b) \<notin> Id"
- {assume "(a,b) \<in> r"
- with * have False using assms by auto
- }
- moreover
- {assume "(a,b) \<in> r'"
- with * have "(a,b) \<in> r' - Id" by auto
- }
- ultimately
- have "(a,b) \<in> ?Left \<Longrightarrow> (a,b) \<in> ?Right"
- unfolding Osum_def by auto
- }
- thus ?thesis by auto
-qed
+ assumes "r \<le> Id"
+ shows "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
+using assms by (force simp: Osum_def)
lemma Osum_minus_Id2:
-assumes "r' \<le> Id"
-shows "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
-proof-
- let ?Left = "(r Osum r') - Id"
- let ?Right = "(r - Id) \<union> (Field r \<times> Field r')"
- {fix a::'a and b assume *: "(a,b) \<notin> Id"
- {assume "(a,b) \<in> r'"
- with * have False using assms by auto
- }
- moreover
- {assume "(a,b) \<in> r"
- with * have "(a,b) \<in> r - Id" by auto
- }
- ultimately
- have "(a,b) \<in> ?Left \<Longrightarrow> (a,b) \<in> ?Right"
- unfolding Osum_def by auto
- }
- thus ?thesis by auto
-qed
+ assumes "r' \<le> Id"
+ shows "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
+using assms by (force simp: Osum_def)
lemma Osum_minus_Id:
-assumes TOT: "Total r" and TOT': "Total r'" and
- NID: "\<not> (r \<le> Id)" and NID': "\<not> (r' \<le> Id)"
-shows "(r Osum r') - Id \<le> (r - Id) Osum (r' - Id)"
-proof-
- {fix a a' assume *: "(a,a') \<in> (r Osum r')" and **: "a \<noteq> a'"
- have "(a,a') \<in> (r - Id) Osum (r' - Id)"
- proof-
- {assume "(a,a') \<in> r \<or> (a,a') \<in> r'"
- with ** have ?thesis unfolding Osum_def by auto
- }
- moreover
- {assume "a \<in> Field r \<and> a' \<in> Field r'"
- hence "a \<in> Field(r - Id) \<and> a' \<in> Field (r' - Id)"
- using assms Total_Id_Field by blast
- hence ?thesis unfolding Osum_def by auto
- }
- ultimately show ?thesis using * unfolding Osum_def by fast
- qed
- }
- thus ?thesis by(auto simp add: Osum_def)
-qed
+ assumes TOT: "Total r" and TOT': "Total r'" and
+ NID: "\<not> (r \<le> Id)" and NID': "\<not> (r' \<le> Id)"
+ shows "(r Osum r') - Id \<le> (r - Id) Osum (r' - Id)"
+ using assms Total_Id_Field by (force simp: Osum_def)
lemma wf_Int_Times:
-assumes "A Int B = {}"
-shows "wf(A \<times> B)"
-unfolding wf_def using assms by blast
+ assumes "A Int B = {}"
+ shows "wf(A \<times> B)"
+ unfolding wf_def using assms by blast
lemma Osum_wf_Id:
-assumes TOT: "Total r" and TOT': "Total r'" and
- FLD: "Field r Int Field r' = {}" and
- WF: "wf(r - Id)" and WF': "wf(r' - Id)"
-shows "wf ((r Osum r') - Id)"
+ assumes TOT: "Total r" and TOT': "Total r'" and
+ FLD: "Field r Int Field r' = {}" and
+ WF: "wf(r - Id)" and WF': "wf(r' - Id)"
+ shows "wf ((r Osum r') - Id)"
proof(cases "r \<le> Id \<or> r' \<le> Id")
assume Case1: "\<not>(r \<le> Id \<or> r' \<le> Id)"
have "Field(r - Id) Int Field(r' - Id) = {}"
- using FLD mono_Field[of "r - Id" r] mono_Field[of "r' - Id" r']
- Diff_subset[of r Id] Diff_subset[of r' Id] by blast
+ using Case1 FLD TOT TOT' Total_Id_Field by blast
thus ?thesis
- using Case1 Osum_minus_Id[of r r'] assms Osum_wf[of "r - Id" "r' - Id"]
- wf_subset[of "(r - Id) \<union>o (r' - Id)" "(r Osum r') - Id"] by auto
+ by (meson Case1 Osum_minus_Id Osum_wf TOT TOT' WF WF' wf_subset)
next
have 1: "wf(Field r \<times> Field r')"
- using FLD by (auto simp add: wf_Int_Times)
+ using FLD by (auto simp add: wf_Int_Times)
assume Case2: "r \<le> Id \<or> r' \<le> Id"
moreover
{assume Case21: "r \<le> Id"
- hence "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
- using Osum_minus_Id1[of r r'] by simp
- moreover
- {have "Domain(Field r \<times> Field r') Int Range(r' - Id) = {}"
- using FLD unfolding Field_def by blast
- hence "wf((r' - Id) \<union> (Field r \<times> Field r'))"
- using 1 WF' wf_Un[of "Field r \<times> Field r'" "r' - Id"]
- by (auto simp add: Un_commute)
- }
- ultimately have ?thesis using wf_subset by blast
+ hence "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
+ using Osum_minus_Id1[of r r'] by simp
+ moreover
+ {have "Domain(Field r \<times> Field r') Int Range(r' - Id) = {}"
+ using FLD unfolding Field_def by blast
+ hence "wf((r' - Id) \<union> (Field r \<times> Field r'))"
+ using 1 WF' wf_Un[of "Field r \<times> Field r'" "r' - Id"]
+ by (auto simp add: Un_commute)
+ }
+ ultimately have ?thesis using wf_subset by blast
}
moreover
{assume Case22: "r' \<le> Id"
- hence "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
- using Osum_minus_Id2[of r' r] by simp
- moreover
- {have "Range(Field r \<times> Field r') Int Domain(r - Id) = {}"
- using FLD unfolding Field_def by blast
- hence "wf((r - Id) \<union> (Field r \<times> Field r'))"
- using 1 WF wf_Un[of "r - Id" "Field r \<times> Field r'"]
- by (auto simp add: Un_commute)
- }
- ultimately have ?thesis using wf_subset by blast
+ hence "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
+ using Osum_minus_Id2[of r' r] by simp
+ moreover
+ {have "Range(Field r \<times> Field r') Int Domain(r - Id) = {}"
+ using FLD unfolding Field_def by blast
+ hence "wf((r - Id) \<union> (Field r \<times> Field r'))"
+ using 1 WF wf_Un[of "r - Id" "Field r \<times> Field r'"]
+ by (auto simp add: Un_commute)
+ }
+ ultimately have ?thesis using wf_subset by blast
}
ultimately show ?thesis by blast
qed
lemma Osum_Well_order:
-assumes FLD: "Field r Int Field r' = {}" and
- WELL: "Well_order r" and WELL': "Well_order r'"
-shows "Well_order (r Osum r')"
+ assumes FLD: "Field r Int Field r' = {}" and
+ WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "Well_order (r Osum r')"
proof-
have "Total r \<and> Total r'" using WELL WELL'
- by (auto simp add: order_on_defs)
+ by (auto simp add: order_on_defs)
thus ?thesis using assms unfolding well_order_on_def
- using Osum_Linear_order Osum_wf_Id by blast
+ using Osum_Linear_order Osum_wf_Id by blast
qed
end
--- a/src/HOL/Cardinals/Ordinal_Arithmetic.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Ordinal_Arithmetic.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,12 +8,12 @@
section \<open>Ordinal Arithmetic\<close>
theory Ordinal_Arithmetic
-imports Wellorder_Constructions
+ imports Wellorder_Constructions
begin
definition osum :: "'a rel \<Rightarrow> 'b rel \<Rightarrow> ('a + 'b) rel" (infixr "+o" 70)
-where
- "r +o r' = map_prod Inl Inl ` r \<union> map_prod Inr Inr ` r' \<union>
+ where
+ "r +o r' = map_prod Inl Inl ` r \<union> map_prod Inr Inr ` r' \<union>
{(Inl a, Inr a') | a a' . a \<in> Field r \<and> a' \<in> Field r'}"
lemma Field_osum: "Field(r +o r') = Inl ` Field r \<union> Inr ` Field r'"
@@ -24,9 +24,10 @@
unfolding refl_on_def Field_osum unfolding osum_def by blast
lemma osum_trans:
-assumes TRANS: "trans r" and TRANS': "trans r'"
-shows "trans (r +o r')"
-proof(unfold trans_def, safe)
+ assumes TRANS: "trans r" and TRANS': "trans r'"
+ shows "trans (r +o r')"
+ unfolding trans_def
+proof(safe)
fix x y z assume *: "(x, y) \<in> r +o r'" "(y, z) \<in> r +o r'"
thus "(x, z) \<in> r +o r'"
proof (cases x y z rule: sum.exhaust[case_product sum.exhaust sum.exhaust])
@@ -66,9 +67,9 @@
unfolding linear_order_on_def using osum_Partial_order osum_Total by blast
lemma osum_wf:
-assumes WF: "wf r" and WF': "wf r'"
-shows "wf (r +o r')"
-unfolding wf_eq_minimal2 unfolding Field_osum
+ assumes WF: "wf r" and WF': "wf r'"
+ shows "wf (r +o r')"
+ unfolding wf_eq_minimal2 unfolding Field_osum
proof(intro allI impI, elim conjE)
fix A assume *: "A \<subseteq> Inl ` Field r \<union> Inr ` Field r'" and **: "A \<noteq> {}"
obtain B where B_def: "B = A Int Inl ` Field r" by blast
@@ -113,8 +114,8 @@
proof(cases "r \<le> Id \<or> r' \<le> Id")
case False
thus ?thesis
- using osum_minus_Id[of r r'] assms osum_wf[of "r - Id" "r' - Id"]
- wf_subset[of "(r - Id) +o (r' - Id)" "(r +o r') - Id"] by auto
+ using osum_minus_Id[of r r'] assms osum_wf[of "r - Id" "r' - Id"]
+ wf_subset[of "(r - Id) +o (r' - Id)" "(r +o r') - Id"] by auto
next
have 1: "wf (Inl ` Field r \<times> Inr ` Field r')" by (rule wf_Int_Times) auto
case True
@@ -131,13 +132,9 @@
qed
lemma osum_Well_order:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "Well_order (r +o r')"
-proof-
- have "Total r \<and> Total r'" using WELL WELL' by (auto simp add: order_on_defs)
- thus ?thesis using assms unfolding well_order_on_def
- using osum_Linear_order osum_wf_Id by blast
-qed
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "Well_order (r +o r')"
+ by (meson WELL WELL' osum_Linear_order osum_wf_Id well_order_on_def wo_rel.TOTAL wo_rel.intro)
lemma osum_embedL:
assumes WELL: "Well_order r" and WELL': "Well_order r'"
@@ -162,10 +159,10 @@
unfolding dir_image_def map_prod_def by auto
lemma map_prod_ordIso: "\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> map_prod f f ` r =o r"
- unfolding dir_image_alt[symmetric] by (rule ordIso_symmetric[OF dir_image_ordIso])
+ by (metis dir_image_alt dir_image_ordIso ordIso_symmetric)
definition oprod :: "'a rel \<Rightarrow> 'b rel \<Rightarrow> ('a \<times> 'b) rel" (infixr "*o" 80)
-where "r *o r' = {((x1, y1), (x2, y2)).
+ where "r *o r' = {((x1, y1), (x2, y2)).
(((y1, y2) \<in> r' - Id \<and> x1 \<in> Field r \<and> x2 \<in> Field r) \<or>
((y1, y2) \<in> Restr Id (Field r') \<and> (x1, x2) \<in> r))}"
@@ -178,30 +175,7 @@
lemma oprod_trans:
assumes "trans r" "trans r'" "antisym r" "antisym r'"
shows "trans (r *o r')"
-proof(unfold trans_def, safe)
- fix x y z assume *: "(x, y) \<in> r *o r'" "(y, z) \<in> r *o r'"
- thus "(x, z) \<in> r *o r'"
- unfolding oprod_def
- apply safe
- apply (metis assms(2) transE)
- apply (metis assms(2) transE)
- apply (metis assms(2) transE)
- apply (metis assms(4) antisymD)
- apply (metis assms(4) antisymD)
- apply (metis assms(2) transE)
- apply (metis assms(4) antisymD)
- apply (metis Field_def Range_iff Un_iff)
- apply (metis Field_def Range_iff Un_iff)
- apply (metis Field_def Range_iff Un_iff)
- apply (metis Field_def Domain_iff Un_iff)
- apply (metis Field_def Domain_iff Un_iff)
- apply (metis Field_def Domain_iff Un_iff)
- apply (metis assms(1) transE)
- apply (metis assms(1) transE)
- apply (metis assms(1) transE)
- apply (metis assms(1) transE)
- done
-qed
+ using assms by (clarsimp simp: trans_def antisym_def oprod_def) (metis FieldI1 FieldI2)
lemma oprod_Preorder: "\<lbrakk>Preorder r; Preorder r'; antisym r; antisym r'\<rbrakk> \<Longrightarrow> Preorder (r *o r')"
unfolding preorder_on_def using oprod_Refl oprod_trans by blast
@@ -219,9 +193,9 @@
unfolding linear_order_on_def using oprod_Partial_order oprod_Total by blast
lemma oprod_wf:
-assumes WF: "wf r" and WF': "wf r'"
-shows "wf (r *o r')"
-unfolding wf_eq_minimal2 unfolding Field_oprod
+ assumes WF: "wf r" and WF': "wf r'"
+ shows "wf (r *o r')"
+ unfolding wf_eq_minimal2 unfolding Field_oprod
proof(intro allI impI, elim conjE)
fix A assume *: "A \<subseteq> Field r \<times> Field r'" and **: "A \<noteq> {}"
then obtain y where y: "y \<in> snd ` A" "\<forall>y'\<in>snd ` A. (y', y) \<notin> r'"
@@ -285,22 +259,17 @@
proof(cases "r \<le> Id \<or> r' \<le> Id")
case False
thus ?thesis
- using oprod_minus_Id[of r r'] assms oprod_wf[of "r - Id" "r' - Id"]
- wf_subset[of "(r - Id) *o (r' - Id)" "(r *o r') - Id"] by auto
+ by (meson TOT TOT' WF WF' oprod_minus_Id oprod_wf wf_subset)
next
case True
thus ?thesis using wf_subset[OF wf_extend_oprod1[OF WF'] oprod_minus_Id1]
- wf_subset[OF wf_extend_oprod2[OF WF] oprod_minus_Id2] by auto
+ wf_subset[OF wf_extend_oprod2[OF WF] oprod_minus_Id2] by auto
qed
lemma oprod_Well_order:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "Well_order (r *o r')"
-proof-
- have "Total r \<and> Total r'" using WELL WELL' by (auto simp add: order_on_defs)
- thus ?thesis using assms unfolding well_order_on_def
- using oprod_Linear_order oprod_wf_Id by blast
-qed
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "Well_order (r *o r')"
+ by (meson WELL WELL' linear_order_on_def oprod_Linear_order oprod_wf_Id well_order_on_def)
lemma oprod_embed:
assumes WELL: "Well_order r" and WELL': "Well_order r'" and "r' \<noteq> {}"
@@ -344,14 +313,8 @@
lemma fun_unequal_in_support:
assumes "f \<noteq> g" "f \<in> Func A B" "g \<in> Func A C"
- shows "(support z A f \<union> support z A g) \<inter> {a. f a \<noteq> g a} \<noteq> {}" (is "?L \<inter> ?R \<noteq> {}")
-proof -
- from assms(1) obtain x where x: "f x \<noteq> g x" by blast
- hence "x \<in> ?R" by simp
- moreover from assms(2-3) x have "x \<in> A" unfolding Func_def by fastforce
- with x have "x \<in> ?L" unfolding support_def by auto
- ultimately show ?thesis by auto
-qed
+ shows "(support z A f \<union> support z A g) \<inter> {a. f a \<noteq> g a} \<noteq> {}"
+ using assms by (simp add: Func_def support_def disjoint_iff fun_eq_iff) metis
definition fin_support where
"fin_support z A = {f. finite (support z A f)}"
@@ -381,18 +344,18 @@
begin
definition isMaxim :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
-where "isMaxim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (a,b) \<in> r)"
+ where "isMaxim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (a,b) \<in> r)"
definition maxim :: "'a set \<Rightarrow> 'a"
-where "maxim A \<equiv> THE b. isMaxim A b"
+ where "maxim A \<equiv> THE b. isMaxim A b"
lemma isMaxim_unique[intro]: "\<lbrakk>isMaxim A x; isMaxim A y\<rbrakk> \<Longrightarrow> x = y"
unfolding isMaxim_def using antisymD[OF ANTISYM, of x y] by auto
lemma maxim_isMaxim: "\<lbrakk>finite A; A \<noteq> {}; A \<subseteq> Field r\<rbrakk> \<Longrightarrow> isMaxim A (maxim A)"
-unfolding maxim_def
+ unfolding maxim_def
proof (rule theI', rule ex_ex1I[OF _ isMaxim_unique, rotated], assumption+,
- induct A rule: finite_induct)
+ induct A rule: finite_induct)
case (insert x A)
thus ?case
proof (cases "A = {}")
@@ -426,9 +389,10 @@
show ?thesis
proof (cases "(x, maxim A) \<in> r")
case True
- with *(2) have "isMaxim (insert x A) (maxim A)" unfolding isMaxim_def
- using transD[OF TRANS, of _ x "maxim A"] by blast
- with *(1) True show ?thesis unfolding max2_def by (metis isMaxim_unique)
+ with *(2) have "isMaxim (insert x A) (maxim A)"
+ by (simp add: isMaxim_def)
+ with *(1) True show ?thesis
+ unfolding max2_def by (metis isMaxim_unique)
next
case False
hence "(maxim A, x) \<in> r" by (metis *(2) assms(3,4) in_mono in_notinI isMaxim_def)
@@ -453,8 +417,8 @@
next
case False
hence "(maxim B, maxim A) \<in> r" by (metis *(2,3) assms(3,6) in_mono in_notinI isMaxim_def)
- with *(2,3) have "isMaxim (A \<union> B) (maxim A)" unfolding isMaxim_def
- using transD[OF TRANS, of _ "maxim B" "maxim A"] by blast
+ with *(2,3) have "isMaxim (A \<union> B) (maxim A)"
+ by (metis "*"(1) False Un_iff isMaxim_def isMaxim_unique)
with *(1) False show ?thesis unfolding max2_def by (metis isMaxim_unique)
qed
qed
@@ -462,7 +426,7 @@
lemma maxim_insert_zero:
assumes "finite A" "A \<noteq> {}" "A \<subseteq> Field r"
shows "maxim (insert zero A) = maxim A"
-using assms zero_in_Field maxim_in[OF assms] by (subst maxim_insert[unfolded max2_def]) auto
+ using assms finite.cases in_mono max2_def maxim_in maxim_insert subset_empty zero_in_Field zero_smallest by fastforce
lemma maxim_equality: "isMaxim A x \<Longrightarrow> maxim A = x"
unfolding maxim_def by (rule the_equality) auto
@@ -495,7 +459,7 @@
locale wo_rel2 =
fixes r s
assumes rWELL: "Well_order r"
- and sWELL: "Well_order s"
+ and sWELL: "Well_order s"
begin
interpretation r: wo_rel r by unfold_locales (rule rWELL)
@@ -510,7 +474,7 @@
lemma max_fun_diff_alt:
"s.max_fun_diff f g = s.maxim ((SUPP f \<union> SUPP g) \<inter> {a. f a \<noteq> g a})"
- unfolding s.max_fun_diff_def fun_diff_alt ..
+ unfolding s.max_fun_diff_def fun_diff_alt ..
lemma isMaxim_max_fun_diff: "\<lbrakk>f \<noteq> g; f \<in> FINFUNC; g \<in> FINFUNC\<rbrakk> \<Longrightarrow>
s.isMaxim {a \<in> Field s. f a \<noteq> g a} (s.max_fun_diff f g)"
@@ -552,13 +516,7 @@
hence "(x, ?fg) \<in> s"
proof (cases "x = ?fg")
case False show ?thesis
- proof (rule ccontr)
- assume "(x, ?fg) \<notin> s"
- with max_fun_diff_in[OF fg f g] x False have *: "(?fg, x) \<in> s" by (blast intro: s.in_notinI)
- hence "f x = g x" by (rule max_fun_diff_le_eq[OF _ fg f g False])
- moreover have "g x = h x" using max_fun_diff_le_eq[OF _ gh g h] False True * by simp
- ultimately show False using x by simp
- qed
+ by (metis (mono_tags, lifting) True assms(5-7) max_fun_diff_max mem_Collect_eq x)
qed (simp add: refl_onD[OF s.REFL])
}
ultimately have "s.isMaxim {a \<in> Field s. f a \<noteq> h a} ?fg"
@@ -572,7 +530,7 @@
case True
hence *: "f ?gh = g ?gh" by (rule max_fun_diff_le_eq[OF _ fg f g *[symmetric]])
hence "s.isMaxim {a \<in> Field s. f a \<noteq> h a} ?gh" using isMaxim_max_fun_diff[OF gh g h]
- isMaxim_max_fun_diff[OF fg f g] transD[OF s.TRANS _ True]
+ isMaxim_max_fun_diff[OF fg f g] transD[OF s.TRANS _ True]
unfolding s.isMaxim_def by auto
hence "?fh = ?gh" using isMaxim_max_fun_diff[OF fh f h] by blast
thus ?thesis using True unfolding s.max2_def by simp
@@ -582,7 +540,7 @@
by (blast intro: s.in_notinI)
hence *: "g ?fg = h ?fg" by (rule max_fun_diff_le_eq[OF _ gh g h *])
hence "s.isMaxim {a \<in> Field s. f a \<noteq> h a} ?fg" using isMaxim_max_fun_diff[OF gh g h]
- isMaxim_max_fun_diff[OF fg f g] True transD[OF s.TRANS, of _ _ ?fg]
+ isMaxim_max_fun_diff[OF fg f g] True transD[OF s.TRANS, of _ _ ?fg]
unfolding s.isMaxim_def by auto
hence "?fh = ?fg" using isMaxim_max_fun_diff[OF fh f h] by blast
thus ?thesis using False unfolding s.max2_def by simp
@@ -603,8 +561,8 @@
proof (unfold trans_def, safe)
fix f g h :: "'b \<Rightarrow> 'a"
let ?fg = "s.max_fun_diff f g"
- and ?gh = "s.max_fun_diff g h"
- and ?fh = "s.max_fun_diff f h"
+ and ?gh = "s.max_fun_diff g h"
+ and ?fh = "s.max_fun_diff f h"
assume oexp: "(f, g) \<in> oexp" "(g, h) \<in> oexp"
thus "(f, h) \<in> oexp"
proof (cases "f = g \<or> g = h")
@@ -619,8 +577,8 @@
proof (cases "?fg = ?gh \<longrightarrow> f ?fg \<noteq> h ?gh")
case True
show ?thesis using max_fun_diff_max2[of f g h, OF True] * \<open>f \<noteq> h\<close> max_fun_diff_in
- r.max2_iff[OF FINFUNCD FINFUNCD] r.max2_equals1[OF FINFUNCD FINFUNCD] max_fun_diff_le_eq
- s.in_notinI[OF disjI1] unfolding oexp_def Let_def s.max2_def mem_Collect_eq by safe metis
+ r.max2_iff[OF FINFUNCD FINFUNCD] r.max2_equals1[OF FINFUNCD FINFUNCD] max_fun_diff_le_eq
+ s.in_notinI[OF disjI1] unfolding oexp_def Let_def s.max2_def mem_Collect_eq by safe metis
next
case False with * show ?thesis unfolding oexp_def Let_def
using antisymD[OF r.ANTISYM, of "g ?gh" "h ?gh"] max_fun_diff_in[of g h] by auto
@@ -667,13 +625,7 @@
lemma const_least:
assumes "Field r \<noteq> {}" "f \<in> FINFUNC"
shows "(const, f) \<in> oexp"
-proof (cases "f = const")
- case True thus ?thesis using refl_onD[OF oexp_Refl] assms(2) unfolding Field_oexp by auto
-next
- case False
- with assms show ?thesis using max_fun_diff_in[of f const]
- unfolding oexp_def Let_def by (auto intro: r.zero_smallest FinFuncD simp: s.max_fun_diff_commute)
-qed
+ using assms const_FINFUNC max_fun_diff max_fun_diff_in oexp_def by fastforce
lemma support_not_const:
assumes "F \<subseteq> FINFUNC" and "const \<notin> F"
@@ -693,15 +645,15 @@
qed
lemma maxim_isMaxim_support:
- assumes f: "F \<subseteq> FINFUNC" and "const \<notin> F"
+ assumes "F \<subseteq> FINFUNC" and "const \<notin> F"
shows "\<forall>f \<in> F. s.isMaxim (SUPP f) (s.maxim (SUPP f))"
- using support_not_const[OF assms] by (auto intro!: s.maxim_isMaxim)
+ using assms s.maxim_isMaxim support_not_const by force
lemma oexp_empty2: "Field s = {} \<Longrightarrow> oexp = {(\<lambda>x. undefined, \<lambda>x. undefined)}"
unfolding oexp_def FinFunc_def fin_support_def support_def by auto
lemma oexp_empty: "\<lbrakk>Field r = {}; Field s \<noteq> {}\<rbrakk> \<Longrightarrow> oexp = {}"
- unfolding oexp_def FinFunc_def Let_def by auto
+ using FINFUNCD oexp_def by auto
lemma fun_upd_FINFUNC: "\<lbrakk>f \<in> FINFUNC; x \<in> Field s; y \<in> Field r\<rbrakk> \<Longrightarrow> f(x := y) \<in> FINFUNC"
unfolding FinFunc_def Func_def fin_support_def
@@ -734,7 +686,7 @@
have const[simp]: "\<And>F. \<lbrakk>const \<in> F; F \<subseteq> FINFUNC\<rbrakk> \<Longrightarrow> \<exists>f0\<in>F. \<forall>f\<in>F. (f0, f) \<in> oexp"
using const_least[OF Fields(2)] by auto
show ?thesis
- unfolding Linear_order_wf_diff_Id[OF oexp_Linear_order] Field_oexp
+ unfolding Linear_order_wf_diff_Id[OF oexp_Linear_order] Field_oexp
proof (intro allI impI)
fix A assume A: "A \<subseteq> FINFUNC" "A \<noteq> {}"
{ fix y F
@@ -758,7 +710,7 @@
hence zField: "z \<in> Field s" unfolding Field_def by auto
define x0 where "x0 = r.minim {f z | f. f \<in> F \<and> z = s.maxim (SUPP f)}"
from F(1,2) maxF(1) SUPPF zmin
- have x0min: "r.isMinim {f z | f. f \<in> F \<and> z = s.maxim (SUPP f)} x0"
+ have x0min: "r.isMinim {f z | f. f \<in> F \<and> z = s.maxim (SUPP f)} x0"
unfolding x0_def s.isMaxim_def s.isMinim_def
by (blast intro!: r.minim_isMinim FinFuncD[of _ r s])
with maxF(1) SUPPF F(1) have x0Field: "x0 \<in> Field r"
@@ -770,13 +722,8 @@
from zmin x0min have "G \<noteq> {}" unfolding G_def z_def s.isMinim_def r.isMinim_def by blast
have GF: "G \<subseteq> (\<lambda>f. f(z := r.zero)) ` F" unfolding G_def by auto
have "G \<subseteq> fin_support r.zero (Field s)"
- unfolding FinFunc_def fin_support_def proof safe
- fix g assume "g \<in> G"
- with GF obtain f where f: "f \<in> F" "g = f(z := r.zero)" by auto
- with SUPPF have "finite (SUPP f)" by blast
- with f show "finite (SUPP g)"
- by (elim finite_subset[rotated]) (auto simp: support_def)
- qed
+ unfolding FinFunc_def fin_support_def
+ using F(1) FinFunc_def G_def fin_support_def by fastforce
moreover from F GF zField have "G \<subseteq> Func (Field s) (Field r)"
using Func_upd[of _ "Field s" "Field r" z r.zero] unfolding FinFunc_def by auto
ultimately have G: "G \<subseteq> FINFUNC" unfolding FinFunc_def by blast
@@ -799,7 +746,7 @@
unfolding z by (intro s.maxim_mono) auto
}
moreover from y'min have "\<And>g. g \<in> G \<Longrightarrow> (y', s.maxim (SUPP g)) \<in> s"
- unfolding s.isMinim_def by auto
+ unfolding s.isMinim_def by auto
ultimately have "y' \<noteq> z" "(y', z) \<in> s" using maxG
unfolding s.isMinim_def s.isMaxim_def by auto
with zy have "y' \<noteq> y" "(y', y) \<in> s" using antisymD[OF s.ANTISYM] transD[OF s.TRANS]
@@ -814,7 +761,7 @@
with x0notzero zField have SUPP: "SUPP f0 = SUPP g0 \<union> {z}" unfolding support_def by auto
from g0z have f0z: "f0(z := r.zero) = g0" unfolding f0_def fun_upd_upd by auto
have f0: "f0 \<in> F" using x0min g0(1)
- Func_elim[OF subsetD[OF subset_trans[OF F(1)[unfolded FinFunc_def] Int_lower1]] zField]
+ Func_elim[OF subsetD[OF subset_trans[OF F(1)[unfolded FinFunc_def] Int_lower1]] zField]
unfolding f0_def r.isMinim_def G_def by (force simp: fun_upd_idem)
from g0(1) maxF(1) have maxf0: "s.maxim (SUPP f0) = z" unfolding SUPP G_def
by (intro s.maxim_equality) (auto simp: s.isMaxim_def)
@@ -834,7 +781,7 @@
hence oexp: "(f0(z := r.zero, z := x0), f(z := r.zero, z := x0)) \<in> oexp"
by (elim fun_upd_same_oexp[OF _ _ zField x0Field]) simp
with f F(1) x0min True
- have "(f(z := x0), f) \<in> oexp" unfolding G_def r.isMinim_def
+ have "(f(z := x0), f) \<in> oexp" unfolding G_def r.isMinim_def
by (intro fun_upd_smaller_oexp[OF _ zField x0Field]) auto
with oexp show ?thesis using transD[OF oexp_trans, of f0 "f(z := x0)" f]
unfolding f0_def by auto
@@ -868,12 +815,12 @@
have "f (s.maxim (SUPP f)) \<noteq> r.zero"
using bspec[OF maxF(1) f, unfolded s.isMaxim_def] by (auto simp: support_def)
with f0f * f f0 maxf0 SUPPF
- have "s.max_fun_diff f0 f = s.maxim (SUPP f0 \<union> SUPP f)"
+ have "s.max_fun_diff f0 f = s.maxim (SUPP f0 \<union> SUPP f)"
unfolding max_fun_diff_alt using s.maxim_Un[of "SUPP f0" "SUPP f"]
by (intro s.maxim_Int) (auto simp: s.max2_def)
moreover have "s.maxim (SUPP f0 \<union> SUPP f) = s.maxim (SUPP f)"
- using s.maxim_Un[of "SUPP f0" "SUPP f"] * maxf0 SUPPF f0 f
- by (auto simp: s.max2_def)
+ using s.maxim_Un[of "SUPP f0" "SUPP f"] * maxf0 SUPPF f0 f
+ by (auto simp: s.max2_def)
ultimately show ?thesis using f f0 F(1) maxF(1) SUPPF unfolding oexp_def Let_def
by (fastforce simp: s.isMaxim_def intro!: r.zero_smallest FINFUNCD)
qed
@@ -883,13 +830,9 @@
qed simp
qed
qed
- } note * = mp[OF this]
- from A(2) obtain f where f: "f \<in> A" by blast
- with A(1) show "\<exists>a\<in>A. \<forall>a'\<in>A. (a, a') \<in> oexp"
- proof (cases "f = const")
- case False with f A(1) show ?thesis using maxim_isMaxim_support[of "{f}"]
- by (intro *[of _ "s.maxim (SUPP f)"]) (auto simp: s.isMaxim_def support_def)
- qed simp
+ }
+ with A show "\<exists>a\<in>A. \<forall>a'\<in>A. (a, a') \<in> oexp"
+ by blast
qed
qed
@@ -899,8 +842,7 @@
interpretation o: wo_rel oexp by unfold_locales (rule oexp_Well_order)
lemma zero_oexp: "Field r \<noteq> {} \<Longrightarrow> o.zero = const"
- by (rule sym[OF o.leq_zero_imp[OF const_least]])
- (auto intro!: o.zero_in_Field[unfolded Field_oexp] dest!: const_FINFUNC)
+ by (metis Field_oexp const_FINFUNC const_least o.Field_ofilter o.equals_minim o.ofilter_def o.zero_def)
end
@@ -925,8 +867,8 @@
by (auto dest: well_order_on_domain)
lemma ozero_ordLeq:
-assumes "Well_order r" shows "ozero \<le>o r"
-using assms unfolding ozero_def ordLeq_def embed_def[abs_def] under_def by auto
+ assumes "Well_order r" shows "ozero \<le>o r"
+ using assms unfolding ozero_def ordLeq_def embed_def[abs_def] under_def by auto
definition "oone = {((),())}"
@@ -985,8 +927,8 @@
lemma osum_cong:
assumes "t =o u" and "r =o s"
shows "t +o r =o u +o s"
-using ordIso_transitive[OF osum_congL[OF assms(1)] osum_congR[OF assms(2)]]
- assms[unfolded ordIso_def] by auto
+ using ordIso_transitive[OF osum_congL[OF assms(1)] osum_congR[OF assms(2)]]
+ assms[unfolded ordIso_def] by auto
lemma Well_order_empty[simp]: "Well_order {}"
unfolding Field_empty by (rule well_order_on_empty)
@@ -1005,8 +947,8 @@
shows "{} ^o r = {}"
proof -
from assms(2) have "Field r \<noteq> {}" unfolding Field_def by auto
- thus ?thesis unfolding oexp_def[OF Well_order_empty assms(1)] FinFunc_def fin_support_def support_def
- by auto
+ thus ?thesis
+ by (simp add: assms(1) wo_rel2.intro wo_rel2.oexp_empty)
qed
lemma oprod_zero[simp]: "{} *o r = {}" "r *o {} = {}"
@@ -1051,8 +993,8 @@
lemma oprod_cong:
assumes "t =o u" and "r =o s"
shows "t *o r =o u *o s"
-using ordIso_transitive[OF oprod_congL[OF assms(1)] oprod_congR[OF assms(2)]]
- assms[unfolded ordIso_def] by auto
+ using ordIso_transitive[OF oprod_congL[OF assms(1)] oprod_congR[OF assms(2)]]
+ assms[unfolded ordIso_def] by auto
lemma Field_singleton[simp]: "Field {(z,z)} = {z}"
by (metis well_order_on_Field well_order_on_singleton)
@@ -1155,7 +1097,7 @@
let ?f = "map_sum f id"
from f have "\<forall>a\<in>Field (r +o t).
?f a \<in> Field (s +o t) \<and> ?f ` underS (r +o t) a \<subseteq> underS (s +o t) (?f a)"
- unfolding Field_osum underS_def by (fastforce simp: osum_def)
+ unfolding Field_osum underS_def by (fastforce simp: osum_def)
thus ?thesis unfolding ordLeq_def2 by (auto intro: osum_Well_order r s t)
qed
@@ -1224,7 +1166,7 @@
let ?f = "map_prod f id"
from f have "\<forall>a\<in>Field (r *o t).
?f a \<in> Field (s *o t) \<and> ?f ` underS (r *o t) a \<subseteq> underS (s *o t) (?f a)"
- unfolding Field_oprod underS_def unfolding map_prod_def oprod_def by auto
+ unfolding Field_oprod underS_def unfolding map_prod_def oprod_def by auto
thus ?thesis unfolding ordLeq_def2 by (auto intro: oprod_Well_order r s t)
qed
@@ -1266,8 +1208,7 @@
qed
lemma ozero_oexp: "\<not> (s =o ozero) \<Longrightarrow> ozero ^o s =o ozero"
- unfolding oexp_def[OF ozero_Well_order s] FinFunc_def
- by simp (metis Func_emp2 bot.extremum_uniqueI emptyE well_order_on_domain s subrelI)
+ by (fastforce simp add: oexp_def[OF ozero_Well_order s] FinFunc_def Func_def intro: FieldI1)
lemma oone_oexp: "oone ^o s =o oone" (is "?L =o ?R")
by (rule oone_ordIso_oexp[OF ordIso_reflexive[OF oone_Well_order] s])
@@ -1315,17 +1256,17 @@
"let m = s.max_fun_diff g h in (g m, h m) \<in> r"
hence "g \<noteq> h" by auto
note max_fun_diff_in = rs.max_fun_diff_in[OF \<open>g \<noteq> h\<close> gh(1,2)]
- and max_fun_diff_max = rs.max_fun_diff_max[OF \<open>g \<noteq> h\<close> gh(1,2)]
+ and max_fun_diff_max = rs.max_fun_diff_max[OF \<open>g \<noteq> h\<close> gh(1,2)]
with *(4) invff *(2) have "t.max_fun_diff (F g) (F h) = f (s.max_fun_diff g h)"
unfolding t.max_fun_diff_def compat_def
by (intro t.maxim_equality) (auto simp: t.isMaxim_def F_def dest: injfD)
with gh invff max_fun_diff_in
- show "let m = t.max_fun_diff (F g) (F h) in (F g m, F h m) \<in> r"
+ show "let m = t.max_fun_diff (F g) (F h) in (F g m, F h m) \<in> r"
unfolding F_def Let_def by (auto simp: dest: injfD)
qed
moreover
from FLR have "ofilter ?R (F ` Field ?L)"
- unfolding rexpt.ofilter_def under_def rs.Field_oexp rt.Field_oexp unfolding rt.oexp_def
+ unfolding rexpt.ofilter_def under_def rs.Field_oexp rt.Field_oexp unfolding rt.oexp_def
proof (safe elim!: imageI)
fix g h assume gh: "g \<in> FinFunc r s" "h \<in> FinFunc r t" "F g \<in> FinFunc r t"
"let m = t.max_fun_diff h (F g) in (h m, F g m) \<in> r"
@@ -1345,13 +1286,13 @@
proof (rule ccontr)
assume "(t.max_fun_diff h (F g), z) \<notin> t"
hence "(z, t.max_fun_diff h (F g)) \<in> t" using t.in_notinI[of "t.max_fun_diff h (F g)" z]
- z max_Field by auto
+ z max_Field by auto
hence "z \<in> f ` Field s" using *(3) max_f_Field unfolding t.ofilter_def under_def
by fastforce
with z show False by blast
qed
hence "h z = r.zero" using rt.max_fun_diff_le_eq[OF _ False gh(2,3), of z]
- z max_f_Field unfolding F_def by auto
+ z max_f_Field unfolding F_def by auto
} note ** = this
with *(3) gh(2) have "h = F (\<lambda>x. if x \<in> Field s then h (f x) else undefined)" using invff
unfolding F_def fun_eq_iff FinFunc_def Func_def Let_def t.ofilter_def under_def by auto
@@ -1437,8 +1378,8 @@
by (subst t.max_fun_diff_def, intro t.maxim_equality)
(auto simp: t.isMaxim_def intro: inj_onD[OF inj] intro!: rt.max_fun_diff_max)
with Field_fg Field_fh hg fz f_underS compat neq have "(?f h, ?f g) \<in> st.oexp"
- using rt.max_fun_diff[OF \<open>h \<noteq> g\<close>] rt.max_fun_diff_in[OF \<open>h \<noteq> g\<close>] unfolding st.Field_oexp
- unfolding rt.oexp_def st.oexp_def Let_def compat_def by auto
+ using rt.max_fun_diff[OF \<open>h \<noteq> g\<close>] rt.max_fun_diff_in[OF \<open>h \<noteq> g\<close>] unfolding st.Field_oexp
+ unfolding rt.oexp_def st.oexp_def Let_def compat_def by auto
with neq show "?f h \<in> underS (s ^o t) (?f g)" unfolding underS_def by auto
qed
ultimately have "?f g \<in> Field (s ^o t) \<and> ?f ` underS (r ^o t) g \<subseteq> underS (s ^o t) (?f g)"
@@ -1460,7 +1401,7 @@
x: "x \<in> Field r" "r.zero \<in> Field r" "x \<noteq> r.zero"
unfolding ordLess_def oone_def embedS_def[abs_def] bij_betw_def embed_def under_def
by (auto simp: image_def)
- (metis (lifting) equals0D mem_Collect_eq r.zero_in_Field singletonI)
+ (metis (lifting) equals0D mem_Collect_eq r.zero_in_Field singletonI)
let ?f = "\<lambda>a b. if b \<in> Field s then if b = a then x else r.zero else undefined"
from x(3) have SUPP: "\<And>y. y \<in> Field s \<Longrightarrow> rs.SUPP (?f y) = {y}" unfolding support_def by auto
{ fix y assume y: "y \<in> Field s"
@@ -1553,7 +1494,7 @@
interpret rt: wo_rel2 r t by unfold_locales (rule r, rule t)
let ?f = "\<lambda>(f, g). case_sum f g"
have "bij_betw ?f (Field ?L) (Field ?R)"
- unfolding bij_betw_def rst.Field_oexp rs.Field_oexp rt.Field_oexp Field_oprod proof (intro conjI)
+ unfolding bij_betw_def rst.Field_oexp rs.Field_oexp rt.Field_oexp Field_oprod proof (intro conjI)
show "inj_on ?f (FinFunc r s \<times> FinFunc r t)" unfolding inj_on_def
by (auto simp: fun_eq_iff split: sum.splits)
show "?f ` (FinFunc r s \<times> FinFunc r t) = FinFunc r (s +o t)"
@@ -1567,7 +1508,7 @@
moreover have "compat ?L ?R ?f"
unfolding compat_def rst.Field_oexp rs.Field_oexp rt.Field_oexp oprod_def
unfolding rst.oexp_def Let_def rs.oexp_def rt.oexp_def
- by (fastforce simp: Field_osum FinFunc_osum o_def split: sum.splits
+ by (fastforce simp: Field_osum FinFunc_osum o_def split: sum.splits
dest: max_fun_diff_eq_Inl max_fun_diff_eq_Inr)
ultimately have "iso ?L ?R ?f" using r s t
by (subst iso_iff3) (auto intro: oexp_Well_order oprod_Well_order osum_Well_order)
@@ -1638,8 +1579,8 @@
interpret rs: wo_rel2 r s by unfold_locales (rule r, rule s)
interpret rst: wo_rel2 "r ^o s" t by unfold_locales (rule oexp_Well_order[OF r s], rule t)
from fun_unequal_in_support[OF assms(2), of "Field (s *o t)" "Field r" "Field r"] assms(3,4)
- have diff1: "rev_curr f \<noteq> rev_curr g"
- "rev_curr f \<in> FinFunc (r ^o s) t" "rev_curr g \<in> FinFunc (r ^o s) t" using rev_curr_FinFunc[OF Field]
+ have diff1: "rev_curr f \<noteq> rev_curr g"
+ "rev_curr f \<in> FinFunc (r ^o s) t" "rev_curr g \<in> FinFunc (r ^o s) t" using rev_curr_FinFunc[OF Field]
unfolding fun_eq_iff rev_curr_def[abs_def] FinFunc_def support_def Field_oprod
by auto fast
hence diff2: "rev_curr f m \<noteq> rev_curr g m" "rev_curr f m \<in> FinFunc r s" "rev_curr g m \<in> FinFunc r s"
@@ -1653,7 +1594,7 @@
next
assume "f (s.max_fun_diff (rev_curr f m) (rev_curr g m), m) =
g (s.max_fun_diff (rev_curr f m) (rev_curr g m), m)"
- (is "f (?x, m) = g (?x, m)")
+ (is "f (?x, m) = g (?x, m)")
hence "rev_curr f m ?x = rev_curr g m ?x" unfolding rev_curr_def by auto
with rs.max_fun_diff[OF diff2] show False by auto
next
@@ -1674,14 +1615,14 @@
proof (cases "s = {} \<or> t = {}")
case True with \<open>r = {}\<close> show ?thesis
by (auto simp: oexp_empty[OF oexp_Well_order[OF Well_order_empty s]]
- intro!: ordIso_transitive[OF ordIso_symmetric[OF oone_ordIso] oone_ordIso]
+ intro!: ordIso_transitive[OF ordIso_symmetric[OF oone_ordIso] oone_ordIso]
ordIso_transitive[OF oone_ordIso_oexp[OF ordIso_symmetric[OF oone_ordIso] t] oone_ordIso])
next
- case False
- hence "s *o t \<noteq> {}" unfolding oprod_def Field_def by fastforce
- with False show ?thesis
- using \<open>r = {}\<close> ozero_ordIso
- by (auto simp add: s t oprod_Well_order ozero_def)
+ case False
+ hence "s *o t \<noteq> {}" unfolding oprod_def Field_def by fastforce
+ with False show ?thesis
+ using \<open>r = {}\<close> ozero_ordIso
+ by (auto simp add: s t oprod_Well_order ozero_def)
qed
next
case False
@@ -1692,7 +1633,7 @@
interpret rs: wo_rel2 r s by unfold_locales (rule r, rule s)
interpret rst: wo_rel2 "r ^o s" t by unfold_locales (rule oexp_Well_order[OF r s], rule t)
have bij: "bij_betw rev_curr (Field ?L) (Field ?R)"
- unfolding bij_betw_def r_st.Field_oexp rst.Field_oexp Field_oprod proof (intro conjI)
+ unfolding bij_betw_def r_st.Field_oexp rst.Field_oexp Field_oprod proof (intro conjI)
show "inj_on rev_curr (FinFunc r (s *o t))"
unfolding inj_on_def FinFunc_def Func_def Field_oprod rs.Field_oexp rev_curr_def[abs_def]
by (auto simp: fun_eq_iff) metis
@@ -1700,16 +1641,16 @@
qed
moreover
have "compat ?L ?R rev_curr"
- unfolding compat_def proof safe
+ unfolding compat_def proof safe
fix fg1 fg2 assume fg: "(fg1, fg2) \<in> r ^o (s *o t)"
show "(rev_curr fg1, rev_curr fg2) \<in> r ^o s ^o t"
proof (cases "fg1 = fg2")
assume "fg1 \<noteq> fg2"
with fg show ?thesis
- using rst.max_fun_diff_in[of "rev_curr fg1" "rev_curr fg2"]
- max_fun_diff_oprod[OF Field, of fg1 fg2] rev_curr_FinFunc[OF Field, symmetric]
- unfolding r_st.Field_oexp rs.Field_oexp rst.Field_oexp unfolding r_st.oexp_def rst.oexp_def
- by (auto simp: rs.oexp_def Let_def) (auto simp: rev_curr_def[abs_def])
+ using rst.max_fun_diff_in[of "rev_curr fg1" "rev_curr fg2"]
+ max_fun_diff_oprod[OF Field, of fg1 fg2] rev_curr_FinFunc[OF Field, symmetric]
+ unfolding r_st.Field_oexp rs.Field_oexp rst.Field_oexp unfolding r_st.oexp_def rst.oexp_def
+ by (auto simp: rs.oexp_def Let_def) (auto simp: rev_curr_def[abs_def])
next
assume "fg1 = fg2"
with fg bij show ?thesis unfolding r_st.Field_oexp rs.Field_oexp rst.Field_oexp bij_betw_def
--- a/src/HOL/Cardinals/Wellorder_Constructions.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Wellorder_Constructions.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,8 +8,8 @@
section \<open>Constructions on Wellorders\<close>
theory Wellorder_Constructions
-imports
- Wellorder_Embedding Order_Union
+ imports
+ Wellorder_Embedding Order_Union
begin
unbundle cardinal_syntax
@@ -21,254 +21,158 @@
Func_empty[simp]
Func_is_emp[simp]
-lemma Func_emp2[simp]: "A \<noteq> {} \<Longrightarrow> Func A {} = {}" by auto
-
-
-subsection \<open>Restriction to a set\<close>
-
-lemma Restr_incr2:
-"r <= r' \<Longrightarrow> Restr r A <= Restr r' A"
-by blast
-
-lemma Restr_incr:
-"\<lbrakk>r \<le> r'; A \<le> A'\<rbrakk> \<Longrightarrow> Restr r A \<le> Restr r' A'"
-by blast
-
-lemma Restr_Int:
-"Restr (Restr r A) B = Restr r (A Int B)"
-by blast
-
-lemma Restr_iff: "(a,b) \<in> Restr r A = (a \<in> A \<and> b \<in> A \<and> (a,b) \<in> r)"
-by (auto simp add: Field_def)
-
-lemma Restr_subset1: "Restr r A \<le> r"
-by auto
-
-lemma Restr_subset2: "Restr r A \<le> A \<times> A"
-by auto
-
-lemma wf_Restr:
-"wf r \<Longrightarrow> wf(Restr r A)"
-using Restr_subset by (elim wf_subset) simp
-
-lemma Restr_incr1:
-"A \<le> B \<Longrightarrow> Restr r A \<le> Restr r B"
-by blast
subsection \<open>Order filters versus restrictions and embeddings\<close>
-lemma ofilter_Restr:
-assumes WELL: "Well_order r" and
- OFA: "ofilter r A" and OFB: "ofilter r B" and SUB: "A \<le> B"
-shows "ofilter (Restr r B) A"
-proof-
- let ?rB = "Restr r B"
- have Well: "wo_rel r" unfolding wo_rel_def using WELL .
- hence Refl: "Refl r" by (auto simp add: wo_rel.REFL)
- hence Field: "Field ?rB = Field r Int B"
- using Refl_Field_Restr by blast
- have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
- by (auto simp add: Well_order_Restr wo_rel_def)
- (* Main proof *)
- show ?thesis
- proof(auto simp add: WellB wo_rel.ofilter_def)
- fix a assume "a \<in> A"
- hence "a \<in> Field r \<and> a \<in> B" using assms Well
- by (auto simp add: wo_rel.ofilter_def)
- with Field show "a \<in> Field(Restr r B)" by auto
- next
- fix a b assume *: "a \<in> A" and "b \<in> under (Restr r B) a"
- hence "b \<in> under r a"
- using WELL OFB SUB ofilter_Restr_under[of r B a] by auto
- thus "b \<in> A" using * Well OFA by(auto simp add: wo_rel.ofilter_def)
- qed
-qed
-
lemma ofilter_subset_iso:
-assumes WELL: "Well_order r" and
- OFA: "ofilter r A" and OFB: "ofilter r B"
-shows "(A = B) = iso (Restr r A) (Restr r B) id"
-using assms
-by (auto simp add: ofilter_subset_embedS_iso)
+ assumes WELL: "Well_order r" and
+ OFA: "ofilter r A" and OFB: "ofilter r B"
+ shows "(A = B) = iso (Restr r A) (Restr r B) id"
+ using assms by (auto simp add: ofilter_subset_embedS_iso)
subsection \<open>Ordering the well-orders by existence of embeddings\<close>
corollary ordLeq_refl_on: "refl_on {r. Well_order r} ordLeq"
-using ordLeq_reflexive unfolding ordLeq_def refl_on_def
-by blast
+ using ordLeq_reflexive unfolding ordLeq_def refl_on_def
+ by blast
corollary ordLeq_trans: "trans ordLeq"
-using trans_def[of ordLeq] ordLeq_transitive by blast
+ using trans_def[of ordLeq] ordLeq_transitive by blast
corollary ordLeq_preorder_on: "preorder_on {r. Well_order r} ordLeq"
-by(auto simp add: preorder_on_def ordLeq_refl_on ordLeq_trans)
+ by(auto simp add: preorder_on_def ordLeq_refl_on ordLeq_trans)
corollary ordIso_refl_on: "refl_on {r. Well_order r} ordIso"
-using ordIso_reflexive unfolding refl_on_def ordIso_def
-by blast
+ using ordIso_reflexive unfolding refl_on_def ordIso_def
+ by blast
corollary ordIso_trans: "trans ordIso"
-using trans_def[of ordIso] ordIso_transitive by blast
+ using trans_def[of ordIso] ordIso_transitive by blast
corollary ordIso_sym: "sym ordIso"
-by (auto simp add: sym_def ordIso_symmetric)
+ by (auto simp add: sym_def ordIso_symmetric)
corollary ordIso_equiv: "equiv {r. Well_order r} ordIso"
-by (auto simp add: equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
+ by (auto simp add: equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
lemma ordLess_Well_order_simp[simp]:
-assumes "r <o r'"
-shows "Well_order r \<and> Well_order r'"
-using assms unfolding ordLess_def by simp
+ assumes "r <o r'"
+ shows "Well_order r \<and> Well_order r'"
+ using assms unfolding ordLess_def by simp
lemma ordIso_Well_order_simp[simp]:
-assumes "r =o r'"
-shows "Well_order r \<and> Well_order r'"
-using assms unfolding ordIso_def by simp
+ assumes "r =o r'"
+ shows "Well_order r \<and> Well_order r'"
+ using assms unfolding ordIso_def by simp
lemma ordLess_irrefl: "irrefl ordLess"
-by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
+ by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
lemma ordLess_or_ordIso:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "r <o r' \<or> r' <o r \<or> r =o r'"
-unfolding ordLess_def ordIso_def
-using assms embedS_or_iso[of r r'] by auto
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "r <o r' \<or> r' <o r \<or> r =o r'"
+ unfolding ordLess_def ordIso_def
+ using assms embedS_or_iso[of r r'] by auto
corollary ordLeq_ordLess_Un_ordIso:
-"ordLeq = ordLess \<union> ordIso"
-by (auto simp add: ordLeq_iff_ordLess_or_ordIso)
-
-lemma not_ordLeq_ordLess:
-"r \<le>o r' \<Longrightarrow> \<not> r' <o r"
-using not_ordLess_ordLeq by blast
+ "ordLeq = ordLess \<union> ordIso"
+ by (auto simp add: ordLeq_iff_ordLess_or_ordIso)
lemma ordIso_or_ordLess:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "r =o r' \<or> r <o r' \<or> r' <o r"
-using assms ordLess_or_ordLeq ordLeq_iff_ordLess_or_ordIso by blast
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "r =o r' \<or> r <o r' \<or> r' <o r"
+ using assms ordLess_or_ordLeq ordLeq_iff_ordLess_or_ordIso by blast
lemmas ord_trans = ordIso_transitive ordLeq_transitive ordLess_transitive
- ordIso_ordLeq_trans ordLeq_ordIso_trans
- ordIso_ordLess_trans ordLess_ordIso_trans
- ordLess_ordLeq_trans ordLeq_ordLess_trans
+ ordIso_ordLeq_trans ordLeq_ordIso_trans
+ ordIso_ordLess_trans ordLess_ordIso_trans
+ ordLess_ordLeq_trans ordLeq_ordLess_trans
lemma ofilter_ordLeq:
-assumes "Well_order r" and "ofilter r A"
-shows "Restr r A \<le>o r"
-proof-
- have "A \<le> Field r" using assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
- thus ?thesis using assms
- by (simp add: ofilter_subset_ordLeq wo_rel.Field_ofilter
- wo_rel_def Restr_Field)
-qed
+ assumes "Well_order r" and "ofilter r A"
+ shows "Restr r A \<le>o r"
+by (metis assms inf.orderE ofilter_embed ofilter_subset_ordLeq refl_on_def wo_rel.Field_ofilter wo_rel.REFL wo_rel.intro)
corollary under_Restr_ordLeq:
-"Well_order r \<Longrightarrow> Restr r (under r a) \<le>o r"
-by (auto simp add: ofilter_ordLeq wo_rel.under_ofilter wo_rel_def)
+ "Well_order r \<Longrightarrow> Restr r (under r a) \<le>o r"
+ by (auto simp add: ofilter_ordLeq wo_rel.under_ofilter wo_rel_def)
subsection \<open>Copy via direct images\<close>
lemma Id_dir_image: "dir_image Id f \<le> Id"
-unfolding dir_image_def by auto
+ unfolding dir_image_def by auto
lemma Un_dir_image:
-"dir_image (r1 \<union> r2) f = (dir_image r1 f) \<union> (dir_image r2 f)"
-unfolding dir_image_def by auto
+ "dir_image (r1 \<union> r2) f = (dir_image r1 f) \<union> (dir_image r2 f)"
+ unfolding dir_image_def by auto
lemma Int_dir_image:
-assumes "inj_on f (Field r1 \<union> Field r2)"
-shows "dir_image (r1 Int r2) f = (dir_image r1 f) Int (dir_image r2 f)"
+ assumes "inj_on f (Field r1 \<union> Field r2)"
+ shows "dir_image (r1 Int r2) f = (dir_image r1 f) Int (dir_image r2 f)"
proof
show "dir_image (r1 Int r2) f \<le> (dir_image r1 f) Int (dir_image r2 f)"
- using assms unfolding dir_image_def inj_on_def by auto
+ using assms unfolding dir_image_def inj_on_def by auto
next
show "(dir_image r1 f) Int (dir_image r2 f) \<le> dir_image (r1 Int r2) f"
- proof(clarify)
- fix a' b'
- assume "(a',b') \<in> dir_image r1 f" "(a',b') \<in> dir_image r2 f"
- then obtain a1 b1 a2 b2
- where 1: "a' = f a1 \<and> b' = f b1 \<and> a' = f a2 \<and> b' = f b2" and
- 2: "(a1,b1) \<in> r1 \<and> (a2,b2) \<in> r2" and
- 3: "{a1,b1} \<le> Field r1 \<and> {a2,b2} \<le> Field r2"
- unfolding dir_image_def Field_def by blast
- hence "a1 = a2 \<and> b1 = b2" using assms unfolding inj_on_def by auto
- hence "a' = f a1 \<and> b' = f b1 \<and> (a1,b1) \<in> r1 Int r2 \<and> (a2,b2) \<in> r1 Int r2"
- using 1 2 by auto
- thus "(a',b') \<in> dir_image (r1 \<inter> r2) f"
- unfolding dir_image_def by blast
- qed
+ by (clarsimp simp: dir_image_def) (metis FieldI1 FieldI2 UnCI assms inj_on_def)
qed
(* More facts on ordinal sum: *)
lemma Osum_embed:
-assumes FLD: "Field r Int Field r' = {}" and
- WELL: "Well_order r" and WELL': "Well_order r'"
-shows "embed r (r Osum r') id"
+ assumes FLD: "Field r Int Field r' = {}" and
+ WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "embed r (r Osum r') id"
proof-
have 1: "Well_order (r Osum r')"
- using assms by (auto simp add: Osum_Well_order)
+ using assms by (auto simp add: Osum_Well_order)
moreover
have "compat r (r Osum r') id"
- unfolding compat_def Osum_def by auto
+ unfolding compat_def Osum_def by auto
moreover
have "inj_on id (Field r)" by simp
moreover
have "ofilter (r Osum r') (Field r)"
- using 1 proof(auto simp add: wo_rel_def wo_rel.ofilter_def
- Field_Osum under_def)
- fix a b assume 2: "a \<in> Field r" and 3: "(b,a) \<in> r Osum r'"
- moreover
- {assume "(b,a) \<in> r'"
- hence "a \<in> Field r'" using Field_def[of r'] by blast
- hence False using 2 FLD by blast
- }
- moreover
- {assume "a \<in> Field r'"
- hence False using 2 FLD by blast
- }
- ultimately
- show "b \<in> Field r" by (auto simp add: Osum_def Field_def)
- qed
+ using 1 FLD
+ by (auto simp add: wo_rel_def wo_rel.ofilter_def Osum_def under_def Field_iff disjoint_iff)
ultimately show ?thesis
- using assms by (auto simp add: embed_iff_compat_inj_on_ofilter)
+ using assms by (auto simp add: embed_iff_compat_inj_on_ofilter)
qed
corollary Osum_ordLeq:
-assumes FLD: "Field r Int Field r' = {}" and
- WELL: "Well_order r" and WELL': "Well_order r'"
-shows "r \<le>o r Osum r'"
-using assms Osum_embed Osum_Well_order
-unfolding ordLeq_def by blast
+ assumes FLD: "Field r Int Field r' = {}" and
+ WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "r \<le>o r Osum r'"
+ using assms Osum_embed Osum_Well_order
+ unfolding ordLeq_def by blast
lemma Well_order_embed_copy:
-assumes WELL: "well_order_on A r" and
- INJ: "inj_on f A" and SUB: "f ` A \<le> B"
-shows "\<exists>r'. well_order_on B r' \<and> r \<le>o r'"
+ assumes WELL: "well_order_on A r" and
+ INJ: "inj_on f A" and SUB: "f ` A \<le> B"
+ shows "\<exists>r'. well_order_on B r' \<and> r \<le>o r'"
proof-
have "bij_betw f A (f ` A)"
- using INJ inj_on_imp_bij_betw by blast
+ using INJ inj_on_imp_bij_betw by blast
then obtain r'' where "well_order_on (f ` A) r''" and 1: "r =o r''"
- using WELL Well_order_iso_copy by blast
+ using WELL Well_order_iso_copy by blast
hence 2: "Well_order r'' \<and> Field r'' = (f ` A)"
- using well_order_on_Well_order by blast
- (* *)
+ using well_order_on_Well_order by blast
+ (* *)
let ?C = "B - (f ` A)"
obtain r''' where "well_order_on ?C r'''"
- using well_order_on by blast
+ using well_order_on by blast
hence 3: "Well_order r''' \<and> Field r''' = ?C"
- using well_order_on_Well_order by blast
- (* *)
+ using well_order_on_Well_order by blast
+ (* *)
let ?r' = "r'' Osum r'''"
have "Field r'' Int Field r''' = {}"
- using 2 3 by auto
+ using 2 3 by auto
hence "r'' \<le>o ?r'" using Osum_ordLeq[of r'' r'''] 2 3 by blast
hence 4: "r \<le>o ?r'" using 1 ordIso_ordLeq_trans by blast
- (* *)
+ (* *)
hence "Well_order ?r'" unfolding ordLeq_def by auto
moreover
have "Field ?r' = B" using 2 3 SUB by (auto simp add: Field_Osum)
@@ -281,174 +185,131 @@
text \<open>The correct phrasing would be ``a maxim of ...", as \<open>\<le>o\<close> is only a preorder.\<close>
definition isOmax :: "'a rel set \<Rightarrow> 'a rel \<Rightarrow> bool"
-where
-"isOmax R r \<equiv> r \<in> R \<and> (\<forall>r' \<in> R. r' \<le>o r)"
+ where
+ "isOmax R r \<equiv> r \<in> R \<and> (\<forall>r' \<in> R. r' \<le>o r)"
definition omax :: "'a rel set \<Rightarrow> 'a rel"
-where
-"omax R == SOME r. isOmax R r"
+ where
+ "omax R == SOME r. isOmax R r"
lemma exists_isOmax:
-assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
-shows "\<exists> r. isOmax R r"
+ assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
+ shows "\<exists> r. isOmax R r"
proof-
have "finite R \<Longrightarrow> R \<noteq> {} \<longrightarrow> (\<forall> r \<in> R. Well_order r) \<longrightarrow> (\<exists> r. isOmax R r)"
- apply(erule finite_induct) apply(simp add: isOmax_def)
+ apply(erule finite_induct) apply(simp add: isOmax_def)
proof(clarsimp)
fix r :: "('a \<times> 'a) set" and R assume *: "finite R" and **: "r \<notin> R"
- and ***: "Well_order r" and ****: "\<forall>r\<in>R. Well_order r"
- and IH: "R \<noteq> {} \<longrightarrow> (\<exists>p. isOmax R p)"
+ and ***: "Well_order r" and ****: "\<forall>r\<in>R. Well_order r"
+ and IH: "R \<noteq> {} \<longrightarrow> (\<exists>p. isOmax R p)"
let ?R' = "insert r R"
show "\<exists>p'. (isOmax ?R' p')"
proof(cases "R = {}")
- assume Case1: "R = {}"
- thus ?thesis unfolding isOmax_def using ***
- by (simp add: ordLeq_reflexive)
+ case True
+ thus ?thesis
+ by (simp add: "***" isOmax_def ordLeq_reflexive)
next
- assume Case2: "R \<noteq> {}"
+ case False
then obtain p where p: "isOmax R p" using IH by auto
- hence 1: "Well_order p" using **** unfolding isOmax_def by simp
- {assume Case21: "r \<le>o p"
- hence "isOmax ?R' p" using p unfolding isOmax_def by simp
- hence ?thesis by auto
- }
- moreover
- {assume Case22: "p \<le>o r"
- {fix r' assume "r' \<in> ?R'"
- moreover
- {assume "r' \<in> R"
- hence "r' \<le>o p" using p unfolding isOmax_def by simp
- hence "r' \<le>o r" using Case22 by(rule ordLeq_transitive)
- }
- moreover have "r \<le>o r" using *** by(rule ordLeq_reflexive)
- ultimately have "r' \<le>o r" by auto
- }
- hence "isOmax ?R' r" unfolding isOmax_def by simp
- hence ?thesis by auto
- }
- moreover have "r \<le>o p \<or> p \<le>o r"
- using 1 *** ordLeq_total by auto
- ultimately show ?thesis by blast
+ hence "Well_order p" using **** unfolding isOmax_def by simp
+ then consider "r \<le>o p" | "p \<le>o r"
+ using *** ordLeq_total by auto
+ then show ?thesis
+ proof cases
+ case 1
+ then show ?thesis
+ using p unfolding isOmax_def by auto
+ next
+ case 2
+ then show ?thesis
+ by (metis "***" insert_iff isOmax_def ordLeq_reflexive ordLeq_transitive p)
+ qed
qed
qed
thus ?thesis using assms by auto
qed
lemma omax_isOmax:
-assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
-shows "isOmax R (omax R)"
-unfolding omax_def using assms
-by(simp add: exists_isOmax someI_ex)
+ assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
+ shows "isOmax R (omax R)"
+ unfolding omax_def using assms
+ by(simp add: exists_isOmax someI_ex)
lemma omax_in:
-assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
-shows "omax R \<in> R"
-using assms omax_isOmax unfolding isOmax_def by blast
+ assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
+ shows "omax R \<in> R"
+ using assms omax_isOmax unfolding isOmax_def by blast
lemma Well_order_omax:
-assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Well_order r"
-shows "Well_order (omax R)"
-using assms apply - apply(drule omax_in) by auto
+ assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Well_order r"
+ shows "Well_order (omax R)"
+ using assms omax_in by blast
lemma omax_maxim:
-assumes "finite R" and "\<forall> r \<in> R. Well_order r" and "r \<in> R"
-shows "r \<le>o omax R"
-using assms omax_isOmax unfolding isOmax_def by blast
+ assumes "finite R" and "\<forall> r \<in> R. Well_order r" and "r \<in> R"
+ shows "r \<le>o omax R"
+ using assms omax_isOmax unfolding isOmax_def by blast
lemma omax_ordLeq:
-assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r \<le>o p"
-shows "omax R \<le>o p"
-proof-
- have "\<forall> r \<in> R. Well_order r" using * unfolding ordLeq_def by simp
- thus ?thesis using assms omax_in by auto
-qed
+ assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. r \<le>o p"
+ shows "omax R \<le>o p"
+ by (meson assms omax_in ordLeq_Well_order_simp)
lemma omax_ordLess:
-assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r <o p"
-shows "omax R <o p"
-proof-
- have "\<forall> r \<in> R. Well_order r" using * unfolding ordLess_def by simp
- thus ?thesis using assms omax_in by auto
-qed
+ assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. r <o p"
+ shows "omax R <o p"
+ by (meson assms omax_in ordLess_Well_order_simp)
lemma omax_ordLeq_elim:
-assumes "finite R" and "\<forall> r \<in> R. Well_order r"
-and "omax R \<le>o p" and "r \<in> R"
-shows "r \<le>o p"
-using assms omax_maxim[of R r] apply simp
-using ordLeq_transitive by blast
+ assumes "finite R" and "\<forall> r \<in> R. Well_order r"
+ and "omax R \<le>o p" and "r \<in> R"
+ shows "r \<le>o p"
+ by (meson assms omax_maxim ordLeq_transitive)
lemma omax_ordLess_elim:
-assumes "finite R" and "\<forall> r \<in> R. Well_order r"
-and "omax R <o p" and "r \<in> R"
-shows "r <o p"
-using assms omax_maxim[of R r] apply simp
-using ordLeq_ordLess_trans by blast
+ assumes "finite R" and "\<forall> r \<in> R. Well_order r"
+ and "omax R <o p" and "r \<in> R"
+ shows "r <o p"
+ by (meson assms omax_maxim ordLeq_ordLess_trans)
lemma ordLeq_omax:
-assumes "finite R" and "\<forall> r \<in> R. Well_order r"
-and "r \<in> R" and "p \<le>o r"
-shows "p \<le>o omax R"
-using assms omax_maxim[of R r] apply simp
-using ordLeq_transitive by blast
+ assumes "finite R" and "\<forall> r \<in> R. Well_order r"
+ and "r \<in> R" and "p \<le>o r"
+ shows "p \<le>o omax R"
+ by (meson assms omax_maxim ordLeq_transitive)
lemma ordLess_omax:
-assumes "finite R" and "\<forall> r \<in> R. Well_order r"
-and "r \<in> R" and "p <o r"
-shows "p <o omax R"
-using assms omax_maxim[of R r] apply simp
-using ordLess_ordLeq_trans by blast
+ assumes "finite R" and "\<forall> r \<in> R. Well_order r"
+ and "r \<in> R" and "p <o r"
+ shows "p <o omax R"
+ by (meson assms omax_maxim ordLess_ordLeq_trans)
lemma omax_ordLeq_mono:
-assumes P: "finite P" and R: "finite R"
-and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
-and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p \<le>o r"
-shows "omax P \<le>o omax R"
-proof-
- let ?mp = "omax P" let ?mr = "omax R"
- {fix p assume "p \<in> P"
- then obtain r where r: "r \<in> R" and "p \<le>o r"
- using LEQ by blast
- moreover have "r <=o ?mr"
- using r R Well_R omax_maxim by blast
- ultimately have "p <=o ?mr"
- using ordLeq_transitive by blast
- }
- thus "?mp <=o ?mr"
- using NE_P P using omax_ordLeq by blast
-qed
+ assumes P: "finite P" and R: "finite R"
+ and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
+ and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p \<le>o r"
+ shows "omax P \<le>o omax R"
+ by (meson LEQ NE_P P R Well_R omax_ordLeq ordLeq_omax)
lemma omax_ordLess_mono:
-assumes P: "finite P" and R: "finite R"
-and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
-and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p <o r"
-shows "omax P <o omax R"
-proof-
- let ?mp = "omax P" let ?mr = "omax R"
- {fix p assume "p \<in> P"
- then obtain r where r: "r \<in> R" and "p <o r"
- using LEQ by blast
- moreover have "r <=o ?mr"
- using r R Well_R omax_maxim by blast
- ultimately have "p <o ?mr"
- using ordLess_ordLeq_trans by blast
- }
- thus "?mp <o ?mr"
- using NE_P P omax_ordLess by blast
-qed
+ assumes P: "finite P" and R: "finite R"
+ and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
+ and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p <o r"
+ shows "omax P <o omax R"
+ by (meson LEQ NE_P P R Well_R omax_ordLess ordLess_omax)
subsection \<open>Limit and succesor ordinals\<close>
lemma embed_underS2:
-assumes r: "Well_order r" and g: "embed r s g" and a: "a \<in> Field r"
-shows "g ` underS r a = underS s (g a)"
+ assumes r: "Well_order r" and g: "embed r s g" and a: "a \<in> Field r"
+ shows "g ` underS r a = underS s (g a)"
by (meson a bij_betw_def embed_underS g r)
lemma bij_betw_insert:
-assumes "b \<notin> A" and "f b \<notin> A'" and "bij_betw f A A'"
-shows "bij_betw f (insert b A) (insert (f b) A')"
-using notIn_Un_bij_betw[OF assms] by auto
+ assumes "b \<notin> A" and "f b \<notin> A'" and "bij_betw f A A'"
+ shows "bij_betw f (insert b A) (insert (f b) A')"
+ using notIn_Un_bij_betw[OF assms] by auto
context wo_rel
begin
@@ -459,91 +320,63 @@
by (induct rule: well_order_induct) (rule assms, simp add: underS_def)
lemma suc_underS:
-assumes B: "B \<subseteq> Field r" and A: "AboveS B \<noteq> {}" and b: "b \<in> B"
-shows "b \<in> underS (suc B)"
-using suc_AboveS[OF B A] b unfolding underS_def AboveS_def by auto
+ assumes B: "B \<subseteq> Field r" and A: "AboveS B \<noteq> {}" and b: "b \<in> B"
+ shows "b \<in> underS (suc B)"
+ using suc_AboveS[OF B A] b unfolding underS_def AboveS_def by auto
lemma underS_supr:
-assumes bA: "b \<in> underS (supr A)" and A: "A \<subseteq> Field r"
-shows "\<exists> a \<in> A. b \<in> underS a"
-proof(rule ccontr, auto)
+ assumes bA: "b \<in> underS (supr A)" and A: "A \<subseteq> Field r"
+ shows "\<exists> a \<in> A. b \<in> underS a"
+proof(rule ccontr, simp)
have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
assume "\<forall>a\<in>A. b \<notin> underS a"
hence 0: "\<forall>a \<in> A. (a,b) \<in> r" using A bA unfolding underS_def
- by simp (metis REFL in_mono max2_def max2_greater refl_on_domain)
- have "(supr A, b) \<in> r" apply(rule supr_least[OF A bb]) using 0 by auto
- thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
+ by simp (metis REFL in_mono max2_def max2_greater refl_on_domain)
+ have "(supr A, b) \<in> r"
+ by (simp add: "0" A bb supr_least)
+ thus False
+ by (metis antisymD bA underS_E wo_rel.ANTISYM wo_rel_axioms)
qed
lemma underS_suc:
-assumes bA: "b \<in> underS (suc A)" and A: "A \<subseteq> Field r"
-shows "\<exists> a \<in> A. b \<in> under a"
-proof(rule ccontr, auto)
+ assumes bA: "b \<in> underS (suc A)" and A: "A \<subseteq> Field r"
+ shows "\<exists> a \<in> A. b \<in> under a"
+proof(rule ccontr, simp)
have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
assume "\<forall>a\<in>A. b \<notin> under a"
- hence 0: "\<forall>a \<in> A. a \<in> underS b" using A bA unfolding underS_def
- by simp (metis (lifting) bb max2_def max2_greater mem_Collect_eq under_def rev_subsetD)
- have "(suc A, b) \<in> r" apply(rule suc_least[OF A bb]) using 0 unfolding underS_def by auto
- thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
+ hence 0: "\<forall>a \<in> A. a \<in> underS b" using A bA
+ by (metis bb in_mono max2_def max2_greater mem_Collect_eq underS_I under_def)
+ have "(suc A, b) \<in> r"
+ by (metis "0" A bb suc_least underS_E)
+ thus False
+ by (metis antisymD bA underS_E wo_rel.ANTISYM wo_rel_axioms)
qed
lemma (in wo_rel) in_underS_supr:
-assumes j: "j \<in> underS i" and i: "i \<in> A" and A: "A \<subseteq> Field r" and AA: "Above A \<noteq> {}"
-shows "j \<in> underS (supr A)"
-proof-
- have "(i,supr A) \<in> r" using supr_greater[OF A AA i] .
- thus ?thesis using j unfolding underS_def
- by simp (metis REFL TRANS max2_def max2_equals1 refl_on_domain transD)
-qed
+ assumes "j \<in> underS i" and "i \<in> A" and "A \<subseteq> Field r" and "Above A \<noteq> {}"
+ shows "j \<in> underS (supr A)"
+ by (meson assms LIN in_mono supr_greater supr_inField underS_incl_iff)
lemma inj_on_Field:
-assumes A: "A \<subseteq> Field r" and f: "\<And> a b. \<lbrakk>a \<in> A; b \<in> A; a \<in> underS b\<rbrakk> \<Longrightarrow> f a \<noteq> f b"
-shows "inj_on f A"
-unfolding inj_on_def proof safe
- fix a b assume a: "a \<in> A" and b: "b \<in> A" and fab: "f a = f b"
- {assume "a \<in> underS b"
- hence False using f[OF a b] fab by auto
- }
- moreover
- {assume "b \<in> underS a"
- hence False using f[OF b a] fab by auto
- }
- ultimately show "a = b" using TOTALS A a b unfolding underS_def by auto
-qed
+ assumes A: "A \<subseteq> Field r" and f: "\<And> a b. \<lbrakk>a \<in> A; b \<in> A; a \<in> underS b\<rbrakk> \<Longrightarrow> f a \<noteq> f b"
+ shows "inj_on f A"
+ by (smt (verit) A f in_notinI inj_on_def subsetD underS_I)
lemma ofilter_init_seg_of:
-assumes "ofilter F"
-shows "Restr r F initial_segment_of r"
-using assms unfolding ofilter_def init_seg_of_def under_def by auto
+ assumes "ofilter F"
+ shows "Restr r F initial_segment_of r"
+ using assms unfolding ofilter_def init_seg_of_def under_def by auto
lemma underS_init_seg_of_Collect:
-assumes "\<And>j1 j2. \<lbrakk>j2 \<in> underS i; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
-shows "{R j |j. j \<in> underS i} \<in> Chains init_seg_of"
-unfolding Chains_def proof safe
- fix j ja assume jS: "j \<in> underS i" and jaS: "ja \<in> underS i"
- and init: "(R ja, R j) \<notin> init_seg_of"
- hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
- and jjai: "(j,i) \<in> r" "(ja,i) \<in> r"
- and i: "i \<notin> {j,ja}" unfolding Field_def underS_def by auto
- have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
- show "R j initial_segment_of R ja"
- using jja init jjai i
- by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: underS_def)
-qed
+ assumes "\<And>j1 j2. \<lbrakk>j2 \<in> underS i; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
+ shows "{R j |j. j \<in> underS i} \<in> Chains init_seg_of"
+ using TOTALS assms
+ by (clarsimp simp: Chains_def) (meson BNF_Least_Fixpoint.underS_Field)
lemma (in wo_rel) Field_init_seg_of_Collect:
-assumes "\<And>j1 j2. \<lbrakk>j2 \<in> Field r; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
-shows "{R j |j. j \<in> Field r} \<in> Chains init_seg_of"
-unfolding Chains_def proof safe
- fix j ja assume jS: "j \<in> Field r" and jaS: "ja \<in> Field r"
- and init: "(R ja, R j) \<notin> init_seg_of"
- hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
- unfolding Field_def underS_def by auto
- have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
- show "R j initial_segment_of R ja"
- using jja init
- by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: Field_def)
-qed
+ assumes "\<And>j1 j2. \<lbrakk>j2 \<in> Field r; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
+ shows "{R j |j. j \<in> Field r} \<in> Chains init_seg_of"
+ using TOTALS assms by (auto simp: Chains_def)
subsubsection \<open>Successor and limit elements of an ordinal\<close>
@@ -556,77 +389,63 @@
definition "isLim i \<equiv> \<not> isSucc i"
lemma zero_smallest[simp]:
-assumes "j \<in> Field r" shows "(zero, j) \<in> r"
-unfolding zero_def
-by (metis AboveS_Field assms subset_AboveS_UnderS subset_antisym subset_refl suc_def suc_least_AboveS)
+ assumes "j \<in> Field r" shows "(zero, j) \<in> r"
+ by (simp add: assms wo_rel.ofilter_linord wo_rel_axioms zero_def)
lemma zero_in_Field: assumes "Field r \<noteq> {}" shows "zero \<in> Field r"
-using assms unfolding zero_def by (metis Field_ofilter minim_in ofilter_def)
+ using assms unfolding zero_def by (metis Field_ofilter minim_in ofilter_def)
lemma leq_zero_imp[simp]:
-"(x, zero) \<in> r \<Longrightarrow> x = zero"
-by (metis ANTISYM WELL antisymD well_order_on_domain zero_smallest)
+ "(x, zero) \<in> r \<Longrightarrow> x = zero"
+ by (metis ANTISYM WELL antisymD well_order_on_domain zero_smallest)
lemma leq_zero[simp]:
-assumes "Field r \<noteq> {}" shows "(x, zero) \<in> r \<longleftrightarrow> x = zero"
-using zero_in_Field[OF assms] in_notinI[of x zero] by auto
+ assumes "Field r \<noteq> {}" shows "(x, zero) \<in> r \<longleftrightarrow> x = zero"
+ using zero_in_Field[OF assms] in_notinI[of x zero] by auto
lemma under_zero[simp]:
-assumes "Field r \<noteq> {}" shows "under zero = {zero}"
-using assms unfolding under_def by auto
+ assumes "Field r \<noteq> {}" shows "under zero = {zero}"
+ using assms unfolding under_def by auto
lemma underS_zero[simp,intro]: "underS zero = {}"
-unfolding underS_def by auto
+ unfolding underS_def by auto
lemma isSucc_succ: "aboveS i \<noteq> {} \<Longrightarrow> isSucc (succ i)"
-unfolding isSucc_def succ_def by auto
+ unfolding isSucc_def succ_def by auto
lemma succ_in_diff:
-assumes "aboveS i \<noteq> {}" shows "(i,succ i) \<in> r \<and> succ i \<noteq> i"
-using assms suc_greater[of "{i}"] unfolding succ_def AboveS_def aboveS_def Field_def by auto
+ assumes "aboveS i \<noteq> {}" shows "(i,succ i) \<in> r \<and> succ i \<noteq> i"
+ using assms suc_greater[of "{i}"] unfolding succ_def AboveS_def aboveS_def Field_def by auto
lemmas succ_in[simp] = succ_in_diff[THEN conjunct1]
lemmas succ_diff[simp] = succ_in_diff[THEN conjunct2]
lemma succ_in_Field[simp]:
-assumes "aboveS i \<noteq> {}" shows "succ i \<in> Field r"
-using succ_in[OF assms] unfolding Field_def by auto
+ assumes "aboveS i \<noteq> {}" shows "succ i \<in> Field r"
+ using succ_in[OF assms] unfolding Field_def by auto
lemma succ_not_in:
-assumes "aboveS i \<noteq> {}" shows "(succ i, i) \<notin> r"
-proof
- assume 1: "(succ i, i) \<in> r"
- hence "succ i \<in> Field r \<and> i \<in> Field r" unfolding Field_def by auto
- hence "(i, succ i) \<in> r \<and> succ i \<noteq> i" using assms by auto
- thus False using 1 by (metis ANTISYM antisymD)
-qed
+ assumes "aboveS i \<noteq> {}" shows "(succ i, i) \<notin> r"
+ by (metis FieldI2 assms max2_equals1 max2_equals2 succ_diff succ_in)
lemma not_isSucc_zero: "\<not> isSucc zero"
-proof
- assume *: "isSucc zero"
- then obtain i where "aboveS i \<noteq> {}" and 1: "minim (Field r) = succ i"
- unfolding isSucc_def zero_def by auto
- hence "succ i \<in> Field r" by auto
- with * show False
- by (metis REFL isSucc_def minim_least refl_on_domain
- subset_refl succ_in succ_not_in zero_def)
-qed
+ by (metis isSucc_def leq_zero_imp succ_in_diff)
lemma isLim_zero[simp]: "isLim zero"
by (metis isLim_def not_isSucc_zero)
lemma succ_smallest:
-assumes "(i,j) \<in> r" and "i \<noteq> j"
-shows "(succ i, j) \<in> r"
-unfolding succ_def apply(rule suc_least)
-using assms unfolding Field_def by auto
+ assumes "(i,j) \<in> r" and "i \<noteq> j"
+ shows "(succ i, j) \<in> r"
+ by (metis Field_iff assms empty_subsetI insert_subset singletonD suc_least succ_def)
lemma isLim_supr:
-assumes f: "i \<in> Field r" and l: "isLim i"
-shows "i = supr (underS i)"
+ assumes f: "i \<in> Field r" and l: "isLim i"
+ shows "i = supr (underS i)"
proof(rule equals_supr)
fix j assume j: "j \<in> Field r" and 1: "\<And> j'. j' \<in> underS i \<Longrightarrow> (j',j) \<in> r"
- show "(i,j) \<in> r" proof(intro in_notinI[OF _ f j], safe)
+ show "(i,j) \<in> r"
+ proof(intro in_notinI[OF _ f j], safe)
assume ji: "(j,i) \<in> r" "j \<noteq> i"
hence a: "aboveS j \<noteq> {}" unfolding aboveS_def by auto
hence "i \<noteq> succ j" using l unfolding isLim_def isSucc_def by auto
@@ -635,17 +454,19 @@
hence "(succ j, j) \<in> r" using 1 by auto
thus False using succ_not_in[OF a] by simp
qed
-qed(insert f, unfold underS_def Field_def, auto)
+qed(use f underS_def Field_def in fastforce)+
definition "pred i \<equiv> SOME j. j \<in> Field r \<and> aboveS j \<noteq> {} \<and> succ j = i"
lemma pred_Field_succ:
-assumes "isSucc i" shows "pred i \<in> Field r \<and> aboveS (pred i) \<noteq> {} \<and> succ (pred i) = i"
+ assumes "isSucc i" shows "pred i \<in> Field r \<and> aboveS (pred i) \<noteq> {} \<and> succ (pred i) = i"
proof-
- obtain j where a: "aboveS j \<noteq> {}" and i: "i = succ j" using assms unfolding isSucc_def by auto
- have 1: "j \<in> Field r" "j \<noteq> i" unfolding Field_def i
- using succ_diff[OF a] a unfolding aboveS_def by auto
- show ?thesis unfolding pred_def apply(rule someI_ex) using 1 i a by auto
+ obtain j where j: "aboveS j \<noteq> {}" "i = succ j"
+ using assms unfolding isSucc_def by auto
+ then obtain "j \<in> Field r" "j \<noteq> i"
+ by (metis FieldI1 succ_diff succ_in)
+ then show ?thesis unfolding pred_def
+ by (metis (mono_tags, lifting) j someI_ex)
qed
lemmas pred_Field[simp] = pred_Field_succ[THEN conjunct1]
@@ -653,165 +474,100 @@
lemmas succ_pred[simp] = pred_Field_succ[THEN conjunct2, THEN conjunct2]
lemma isSucc_pred_in:
-assumes "isSucc i" shows "(pred i, i) \<in> r"
-proof-
- define j where "j = pred i"
- have i: "i = succ j" using assms unfolding j_def by simp
- have a: "aboveS j \<noteq> {}" unfolding j_def using assms by auto
- show ?thesis unfolding j_def[symmetric] unfolding i using succ_in[OF a] .
-qed
+ assumes "isSucc i" shows "(pred i, i) \<in> r"
+ by (metis assms pred_Field_succ succ_in)
lemma isSucc_pred_diff:
-assumes "isSucc i" shows "pred i \<noteq> i"
-by (metis aboveS_pred assms succ_diff succ_pred)
+ assumes "isSucc i" shows "pred i \<noteq> i"
+ by (metis aboveS_pred assms succ_diff succ_pred)
(* todo: pred maximal, pred injective? *)
lemma succ_inj[simp]:
-assumes "aboveS i \<noteq> {}" and "aboveS j \<noteq> {}"
-shows "succ i = succ j \<longleftrightarrow> i = j"
-proof safe
- assume s: "succ i = succ j"
- {assume "i \<noteq> j" and "(i,j) \<in> r"
- hence "(succ i, j) \<in> r" using assms by (metis succ_smallest)
- hence False using s assms by (metis succ_not_in)
- }
- moreover
- {assume "i \<noteq> j" and "(j,i) \<in> r"
- hence "(succ j, i) \<in> r" using assms by (metis succ_smallest)
- hence False using s assms by (metis succ_not_in)
- }
- ultimately show "i = j" by (metis TOTALS WELL assms(1) assms(2) succ_in_diff well_order_on_domain)
-qed
+ assumes "aboveS i \<noteq> {}" and "aboveS j \<noteq> {}"
+ shows "succ i = succ j \<longleftrightarrow> i = j"
+ by (metis FieldI1 assms succ_def succ_in supr_under under_underS_suc)
lemma pred_succ[simp]:
-assumes "aboveS j \<noteq> {}" shows "pred (succ j) = j"
-unfolding pred_def apply(rule some_equality)
-using assms apply(force simp: Field_def aboveS_def)
-by (metis assms succ_inj)
+ assumes "aboveS j \<noteq> {}" shows "pred (succ j) = j"
+ using assms isSucc_def pred_Field_succ succ_inj by blast
lemma less_succ[simp]:
-assumes "aboveS i \<noteq> {}"
-shows "(j, succ i) \<in> r \<longleftrightarrow> (j,i) \<in> r \<or> j = succ i"
-apply safe
- apply (metis WELL assms in_notinI well_order_on_domain suc_singl_pred succ_def succ_in_diff)
- apply (metis (opaque_lifting, full_types) REFL TRANS assms max2_def max2_equals1 refl_on_domain succ_in_Field succ_not_in transD)
- apply (metis assms in_notinI succ_in_Field)
-done
+ assumes "aboveS i \<noteq> {}"
+ shows "(j, succ i) \<in> r \<longleftrightarrow> (j,i) \<in> r \<or> j = succ i"
+ by (metis FieldI1 assms in_notinI max2_equals1 max2_equals2 max2_iff succ_in succ_smallest)
lemma underS_succ[simp]:
-assumes "aboveS i \<noteq> {}"
-shows "underS (succ i) = under i"
-unfolding underS_def under_def by (auto simp: assms succ_not_in)
+ assumes "aboveS i \<noteq> {}"
+ shows "underS (succ i) = under i"
+ unfolding underS_def under_def by (auto simp: assms succ_not_in)
lemma succ_mono:
-assumes "aboveS j \<noteq> {}" and "(i,j) \<in> r"
-shows "(succ i, succ j) \<in> r"
-by (metis (full_types) assms less_succ succ_smallest)
+ assumes "aboveS j \<noteq> {}" and "(i,j) \<in> r"
+ shows "(succ i, succ j) \<in> r"
+ by (metis (full_types) assms less_succ succ_smallest)
lemma under_succ[simp]:
-assumes "aboveS i \<noteq> {}"
-shows "under (succ i) = insert (succ i) (under i)"
-using less_succ[OF assms] unfolding under_def by auto
+ assumes "aboveS i \<noteq> {}"
+ shows "under (succ i) = insert (succ i) (under i)"
+ using less_succ[OF assms] unfolding under_def by auto
definition mergeSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
-where
-"mergeSL S L f i \<equiv>
- if isSucc i then S (pred i) (f (pred i))
- else L f i"
+ where
+ "mergeSL S L f i \<equiv> if isSucc i then S (pred i) (f (pred i)) else L f i"
subsubsection \<open>Well-order recursion with (zero), succesor, and limit\<close>
definition worecSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
-where "worecSL S L \<equiv> worec (mergeSL S L)"
+ where "worecSL S L \<equiv> worec (mergeSL S L)"
definition "adm_woL L \<equiv> \<forall>f g i. isLim i \<and> (\<forall>j\<in>underS i. f j = g j) \<longrightarrow> L f i = L g i"
-lemma mergeSL:
-assumes "adm_woL L" shows "adm_wo (mergeSL S L)"
-unfolding adm_wo_def proof safe
- fix f g :: "'a => 'b" and i :: 'a
- assume 1: "\<forall>j\<in>underS i. f j = g j"
- show "mergeSL S L f i = mergeSL S L g i"
- proof(cases "isSucc i")
- case True
- hence "pred i \<in> underS i" unfolding underS_def using isSucc_pred_in isSucc_pred_diff by auto
- thus ?thesis using True 1 unfolding mergeSL_def by auto
- next
- case False hence "isLim i" unfolding isLim_def by auto
- thus ?thesis using assms False 1 unfolding mergeSL_def adm_woL_def by auto
- qed
-qed
+lemma mergeSL: "adm_woL L \<Longrightarrow>adm_wo (mergeSL S L)"
+ unfolding adm_wo_def adm_woL_def isLim_def
+ by (smt (verit, ccfv_threshold) isSucc_pred_diff isSucc_pred_in mergeSL_def underS_I)
lemma worec_fixpoint1: "adm_wo H \<Longrightarrow> worec H i = H (worec H) i"
-by (metis worec_fixpoint)
+ by (metis worec_fixpoint)
lemma worecSL_isSucc:
-assumes a: "adm_woL L" and i: "isSucc i"
-shows "worecSL S L i = S (pred i) (worecSL S L (pred i))"
-proof-
- let ?H = "mergeSL S L"
- have "worecSL S L i = ?H (worec ?H) i"
- unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
- also have "... = S (pred i) (worecSL S L (pred i))"
- unfolding worecSL_def mergeSL_def using i by simp
- finally show ?thesis .
-qed
+ assumes a: "adm_woL L" and i: "isSucc i"
+ shows "worecSL S L i = S (pred i) (worecSL S L (pred i))"
+ by (metis a i mergeSL mergeSL_def worecSL_def worec_fixpoint)
lemma worecSL_succ:
-assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
-shows "worecSL S L (succ j) = S j (worecSL S L j)"
-proof-
- define i where "i = succ j"
- have i: "isSucc i" by (metis i i_def isSucc_succ)
- have ij: "j = pred i" unfolding i_def using assms by simp
- have 0: "succ (pred i) = i" using i by simp
- show ?thesis unfolding ij using worecSL_isSucc[OF a i] unfolding 0 .
-qed
+ assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
+ shows "worecSL S L (succ j) = S j (worecSL S L j)"
+ by (simp add: a i isSucc_succ worecSL_isSucc)
lemma worecSL_isLim:
-assumes a: "adm_woL L" and i: "isLim i"
-shows "worecSL S L i = L (worecSL S L) i"
-proof-
- let ?H = "mergeSL S L"
- have "worecSL S L i = ?H (worec ?H) i"
- unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
- also have "... = L (worecSL S L) i"
- using i unfolding worecSL_def mergeSL_def isLim_def by simp
- finally show ?thesis .
-qed
+ assumes a: "adm_woL L" and i: "isLim i"
+ shows "worecSL S L i = L (worecSL S L) i"
+ by (metis a i isLim_def mergeSL mergeSL_def worecSL_def worec_fixpoint)
definition worecZSL :: "'b \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
-where "worecZSL Z S L \<equiv> worecSL S (\<lambda> f a. if a = zero then Z else L f a)"
+ where "worecZSL Z S L \<equiv> worecSL S (\<lambda> f a. if a = zero then Z else L f a)"
lemma worecZSL_zero:
-assumes a: "adm_woL L"
-shows "worecZSL Z S L zero = Z"
-proof-
- let ?L = "\<lambda> f a. if a = zero then Z else L f a"
- have "worecZSL Z S L zero = ?L (worecZSL Z S L) zero"
- unfolding worecZSL_def apply(rule worecSL_isLim)
- using assms unfolding adm_woL_def by auto
- also have "... = Z" by simp
- finally show ?thesis .
-qed
+ assumes a: "adm_woL L"
+ shows "worecZSL Z S L zero = Z"
+ by (smt (verit, best) adm_woL_def assms isLim_zero worecSL_isLim worecZSL_def)
lemma worecZSL_succ:
-assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
-shows "worecZSL Z S L (succ j) = S j (worecZSL Z S L j)"
-unfolding worecZSL_def apply(rule worecSL_succ)
-using assms unfolding adm_woL_def by auto
+ assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
+ shows "worecZSL Z S L (succ j) = S j (worecZSL Z S L j)"
+ unfolding worecZSL_def
+ by (smt (verit, best) a adm_woL_def i worecSL_succ)
lemma worecZSL_isLim:
-assumes a: "adm_woL L" and "isLim i" and "i \<noteq> zero"
-shows "worecZSL Z S L i = L (worecZSL Z S L) i"
+ assumes a: "adm_woL L" and "isLim i" and "i \<noteq> zero"
+ shows "worecZSL Z S L i = L (worecZSL Z S L) i"
proof-
let ?L = "\<lambda> f a. if a = zero then Z else L f a"
have "worecZSL Z S L i = ?L (worecZSL Z S L) i"
- unfolding worecZSL_def apply(rule worecSL_isLim)
- using assms unfolding adm_woL_def by auto
- also have "... = L (worecZSL Z S L) i" using assms by simp
+ unfolding worecZSL_def by (smt (verit, best) adm_woL_def assms worecSL_isLim)
+ also have "\<dots> = L (worecZSL Z S L) i" using assms by simp
finally show ?thesis .
qed
@@ -819,70 +575,54 @@
subsubsection \<open>Well-order succ-lim induction\<close>
lemma ord_cases:
-obtains j where "i = succ j" and "aboveS j \<noteq> {}" | "isLim i"
-by (metis isLim_def isSucc_def)
+ obtains j where "i = succ j" and "aboveS j \<noteq> {}" | "isLim i"
+ by (metis isLim_def isSucc_def)
lemma well_order_inductSL[case_names Suc Lim]:
-assumes SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
-LIM: "\<And>i. \<lbrakk>isLim i; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
-shows "P i"
+ assumes "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" "\<And>i. \<lbrakk>isLim i; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
+ shows "P i"
proof(induction rule: well_order_induct)
- fix i assume 0: "\<forall>j. j \<noteq> i \<and> (j, i) \<in> r \<longrightarrow> P j"
- show "P i" proof(cases i rule: ord_cases)
- fix j assume i: "i = succ j" and j: "aboveS j \<noteq> {}"
- hence "j \<noteq> i \<and> (j, i) \<in> r" by (metis succ_diff succ_in)
- hence 1: "P j" using 0 by simp
- show "P i" unfolding i apply(rule SUCC) using 1 j by auto
- qed(insert 0 LIM, unfold underS_def, auto)
+ case (1 x)
+ then show ?case
+ by (metis assms ord_cases succ_diff succ_in underS_E)
qed
lemma well_order_inductZSL[case_names Zero Suc Lim]:
-assumes ZERO: "P zero"
-and SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
-LIM: "\<And>i. \<lbrakk>isLim i; i \<noteq> zero; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
-shows "P i"
-apply(induction rule: well_order_inductSL) using assms by auto
+ assumes "P zero"
+ and "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
+ "\<And>i. \<lbrakk>isLim i; i \<noteq> zero; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
+ shows "P i"
+ by (metis assms well_order_inductSL)
(* Succesor and limit ordinals *)
definition "isSuccOrd \<equiv> \<exists> j \<in> Field r. \<forall> i \<in> Field r. (i,j) \<in> r"
definition "isLimOrd \<equiv> \<not> isSuccOrd"
lemma isLimOrd_succ:
-assumes isLimOrd and "i \<in> Field r"
-shows "succ i \<in> Field r"
-using assms unfolding isLimOrd_def isSuccOrd_def
-by (metis REFL in_notinI refl_on_domain succ_smallest)
+ assumes isLimOrd and "i \<in> Field r"
+ shows "succ i \<in> Field r"
+ using assms unfolding isLimOrd_def isSuccOrd_def
+ by (metis REFL in_notinI refl_on_domain succ_smallest)
lemma isLimOrd_aboveS:
-assumes l: isLimOrd and i: "i \<in> Field r"
-shows "aboveS i \<noteq> {}"
+ assumes l: isLimOrd and i: "i \<in> Field r"
+ shows "aboveS i \<noteq> {}"
proof-
obtain j where "j \<in> Field r" and "(j,i) \<notin> r"
- using assms unfolding isLimOrd_def isSuccOrd_def by auto
+ using assms unfolding isLimOrd_def isSuccOrd_def by auto
hence "(i,j) \<in> r \<and> j \<noteq> i" by (metis i max2_def max2_greater)
thus ?thesis unfolding aboveS_def by auto
qed
lemma succ_aboveS_isLimOrd:
-assumes "\<forall> i \<in> Field r. aboveS i \<noteq> {} \<and> succ i \<in> Field r"
-shows isLimOrd
-unfolding isLimOrd_def isSuccOrd_def proof safe
- fix j assume j: "j \<in> Field r" "\<forall>i\<in>Field r. (i, j) \<in> r"
- hence "(succ j, j) \<in> r" using assms by auto
- moreover have "aboveS j \<noteq> {}" using assms j unfolding aboveS_def by auto
- ultimately show False by (metis succ_not_in)
-qed
+ assumes "\<forall> i \<in> Field r. aboveS i \<noteq> {} \<and> succ i \<in> Field r"
+ shows isLimOrd
+ using assms isLimOrd_def isSuccOrd_def succ_not_in by blast
lemma isLim_iff:
-assumes l: "isLim i" and j: "j \<in> underS i"
-shows "\<exists> k. k \<in> underS i \<and> j \<in> underS k"
-proof-
- have a: "aboveS j \<noteq> {}" using j unfolding underS_def aboveS_def by auto
- show ?thesis apply(rule exI[of _ "succ j"]) apply safe
- using assms a unfolding underS_def isLim_def
- apply (metis (lifting, full_types) isSucc_def mem_Collect_eq succ_smallest)
- by (metis (lifting, full_types) a mem_Collect_eq succ_diff succ_in)
-qed
+ assumes l: "isLim i" and j: "j \<in> underS i"
+ shows "\<exists> k. k \<in> underS i \<and> j \<in> underS k"
+ by (metis Order_Relation.underS_Field empty_iff isLim_supr j l underS_empty underS_supr)
end (* context wo_rel *)
@@ -903,124 +643,73 @@
definition "oproj r s f \<equiv> Field s \<subseteq> f ` (Field r) \<and> compat r s f"
lemma oproj_in:
-assumes "oproj r s f" and "(a,a') \<in> r"
-shows "(f a, f a') \<in> s"
-using assms unfolding oproj_def compat_def by auto
+ assumes "oproj r s f" and "(a,a') \<in> r"
+ shows "(f a, f a') \<in> s"
+ using assms unfolding oproj_def compat_def by auto
lemma oproj_Field:
-assumes f: "oproj r s f" and a: "a \<in> Field r"
-shows "f a \<in> Field s"
-using oproj_in[OF f] a unfolding Field_def by auto
+ assumes f: "oproj r s f" and a: "a \<in> Field r"
+ shows "f a \<in> Field s"
+ using oproj_in[OF f] a unfolding Field_def by auto
lemma oproj_Field2:
-assumes f: "oproj r s f" and a: "b \<in> Field s"
-shows "\<exists> a \<in> Field r. f a = b"
-using assms unfolding oproj_def by auto
+ assumes f: "oproj r s f" and a: "b \<in> Field s"
+ shows "\<exists> a \<in> Field r. f a = b"
+ using assms unfolding oproj_def by auto
lemma oproj_under:
-assumes f: "oproj r s f" and a: "a \<in> under r a'"
-shows "f a \<in> under s (f a')"
-using oproj_in[OF f] a unfolding under_def by auto
+ assumes f: "oproj r s f" and a: "a \<in> under r a'"
+ shows "f a \<in> under s (f a')"
+ using oproj_in[OF f] a unfolding under_def by auto
(* An ordinal is embedded in another whenever it is embedded as an order
(not necessarily as initial segment):*)
theorem embedI:
-assumes r: "Well_order r" and s: "Well_order s"
-and f: "\<And> a. a \<in> Field r \<Longrightarrow> f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a)"
-shows "\<exists> g. embed r s g"
+ assumes r: "Well_order r" and s: "Well_order s"
+ and f: "\<And> a. a \<in> Field r \<Longrightarrow> f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a)"
+ shows "\<exists> g. embed r s g"
proof-
interpret r: wo_rel r by unfold_locales (rule r)
interpret s: wo_rel s by unfold_locales (rule s)
let ?G = "\<lambda> g a. suc s (g ` underS r a)"
define g where "g = worec r ?G"
have adm: "adm_wo r ?G" unfolding r.adm_wo_def image_def by auto
- (* *)
+ (* *)
{fix a assume "a \<in> Field r"
- hence "bij_betw g (under r a) (under s (g a)) \<and>
+ hence "bij_betw g (under r a) (under s (g a)) \<and>
g a \<in> under s (f a)"
- proof(induction a rule: r.underS_induct)
- case (1 a)
- hence a: "a \<in> Field r"
- and IH1a: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> inj_on g (under r a1)"
- and IH1b: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g ` under r a1 = under s (g a1)"
- and IH2: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> under s (f a1)"
- unfolding underS_def Field_def bij_betw_def by auto
- have fa: "f a \<in> Field s" using f[OF a] by auto
- have g: "g a = suc s (g ` underS r a)"
- using r.worec_fixpoint[OF adm] unfolding g_def fun_eq_iff by blast
- have A0: "g ` underS r a \<subseteq> Field s"
- using IH1b by (metis IH2 image_subsetI in_mono under_Field)
- {fix a1 assume a1: "a1 \<in> underS r a"
- from IH2[OF this] have "g a1 \<in> under s (f a1)" .
- moreover have "f a1 \<in> underS s (f a)" using f[OF a] a1 by auto
- ultimately have "g a1 \<in> underS s (f a)" by (metis s.ANTISYM s.TRANS under_underS_trans)
- }
- hence "f a \<in> AboveS s (g ` underS r a)" unfolding AboveS_def
- using fa by simp (metis (lifting, full_types) mem_Collect_eq underS_def)
- hence A: "AboveS s (g ` underS r a) \<noteq> {}" by auto
- have B: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (g a)"
- unfolding g apply(rule s.suc_underS[OF A0 A]) by auto
- {fix a1 a2 assume a2: "a2 \<in> underS r a" and 1: "a1 \<in> underS r a2"
- hence a12: "{a1,a2} \<subseteq> under r a2" and "a1 \<noteq> a2" using r.REFL a
- unfolding underS_def under_def refl_on_def Field_def by auto
- hence "g a1 \<noteq> g a2" using IH1a[OF a2] unfolding inj_on_def by auto
- hence "g a1 \<in> underS s (g a2)" using IH1b[OF a2] a12
- unfolding underS_def under_def by auto
- } note C = this
- have ga: "g a \<in> Field s" unfolding g using s.suc_inField[OF A0 A] .
- have aa: "a \<in> under r a"
- using a r.REFL unfolding under_def underS_def refl_on_def by auto
- show ?case proof safe
- show "bij_betw g (under r a) (under s (g a))" unfolding bij_betw_def proof safe
- show "inj_on g (under r a)" proof(rule r.inj_on_Field)
- fix a1 a2 assume "a1 \<in> under r a" and a2: "a2 \<in> under r a" and a1: "a1 \<in> underS r a2"
- hence a22: "a2 \<in> under r a2" and a12: "a1 \<in> under r a2" "a1 \<noteq> a2"
- using a r.REFL unfolding under_def underS_def refl_on_def by auto
- show "g a1 \<noteq> g a2"
- proof(cases "a2 = a")
- case False hence "a2 \<in> underS r a"
- using a2 unfolding underS_def under_def by auto
- from IH1a[OF this] show ?thesis using a12 a22 unfolding inj_on_def by auto
- qed(insert B a1, unfold underS_def, auto)
- qed(unfold under_def Field_def, auto)
- next
- fix a1 assume a1: "a1 \<in> under r a"
- show "g a1 \<in> under s (g a)"
- proof(cases "a1 = a")
- case True thus ?thesis
- using ga s.REFL unfolding refl_on_def under_def by auto
- next
- case False
- hence a1: "a1 \<in> underS r a" using a1 unfolding underS_def under_def by auto
- thus ?thesis using B unfolding underS_def under_def by auto
- qed
- next
- fix b1 assume b1: "b1 \<in> under s (g a)"
- show "b1 \<in> g ` under r a"
- proof(cases "b1 = g a")
- case True thus ?thesis using aa by auto
- next
- case False
- hence "b1 \<in> underS s (g a)" using b1 unfolding underS_def under_def by auto
- from s.underS_suc[OF this[unfolded g] A0]
- obtain a1 where a1: "a1 \<in> underS r a" and b1: "b1 \<in> under s (g a1)" by auto
- obtain a2 where "a2 \<in> under r a1" and b1: "b1 = g a2" using IH1b[OF a1] b1 by auto
- hence "a2 \<in> under r a" using a1
- by (metis r.ANTISYM r.TRANS in_mono underS_subset_under under_underS_trans)
- thus ?thesis using b1 by auto
- qed
- qed
- next
- have "(g a, f a) \<in> s" unfolding g proof(rule s.suc_least[OF A0])
- fix b1 assume "b1 \<in> g ` underS r a"
- then obtain a1 where a1: "b1 = g a1" and a1: "a1 \<in> underS r a" by auto
- hence "b1 \<in> underS s (f a)"
- using a by (metis \<open>\<And>a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (f a)\<close>)
- thus "f a \<noteq> b1 \<and> (b1, f a) \<in> s" unfolding underS_def by auto
- qed(insert fa, auto)
- thus "g a \<in> under s (f a)" unfolding under_def by auto
- qed
- qed
+ proof(induction a rule: r.underS_induct)
+ case (1 a)
+ hence a: "a \<in> Field r"
+ and IH1a: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> inj_on g (under r a1)"
+ and IH1b: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g ` under r a1 = under s (g a1)"
+ and IH2: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> under s (f a1)"
+ unfolding underS_def Field_def bij_betw_def by auto
+ have fa: "f a \<in> Field s" using f[OF a] by auto
+ have g: "g a = suc s (g ` underS r a)"
+ using r.worec_fixpoint[OF adm] unfolding g_def fun_eq_iff by blast
+ have A0: "g ` underS r a \<subseteq> Field s"
+ using IH1b by (metis IH2 image_subsetI in_mono under_Field)
+ {fix a1 assume a1: "a1 \<in> underS r a"
+ from IH2[OF this] have "g a1 \<in> under s (f a1)" .
+ moreover have "f a1 \<in> underS s (f a)" using f[OF a] a1 by auto
+ ultimately have "g a1 \<in> underS s (f a)" by (metis s.ANTISYM s.TRANS under_underS_trans)
+ }
+ hence fa_in: "f a \<in> AboveS s (g ` underS r a)" unfolding AboveS_def
+ using fa by simp (metis (lifting, full_types) mem_Collect_eq underS_def)
+ hence A: "AboveS s (g ` underS r a) \<noteq> {}" by auto
+ have ga: "g a \<in> Field s" unfolding g using s.suc_inField[OF A0 A] .
+ show ?case
+ unfolding bij_betw_def
+ proof (intro conjI)
+ show "inj_on g (r.under a)"
+ by (metis A IH1a IH1b a bij_betw_def g ga r s s.suc_greater subsetI wellorders_totally_ordered_aux)
+ show "g ` r.under a = s.under (g a)"
+ by (metis A A0 IH1a IH1b a bij_betw_def g ga r s s.suc_greater wellorders_totally_ordered_aux)
+ show "g a \<in> s.under (f a)"
+ by (simp add: fa_in g s.suc_least_AboveS under_def)
+ qed
+ qed
}
thus ?thesis unfolding embed_def by auto
qed
@@ -1028,39 +717,38 @@
corollary ordLeq_def2:
"r \<le>o s \<longleftrightarrow> Well_order r \<and> Well_order s \<and>
(\<exists> f. \<forall> a \<in> Field r. f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a))"
-using embed_in_Field[of r s] embed_underS2[of r s] embedI[of r s]
-unfolding ordLeq_def by fast
+ using embed_in_Field[of r s] embed_underS2[of r s] embedI[of r s]
+ unfolding ordLeq_def by fast
lemma iso_oproj:
assumes r: "Well_order r" and s: "Well_order s" and f: "iso r s f"
shows "oproj r s f"
-using assms unfolding oproj_def
-by (subst (asm) iso_iff3) (auto simp: bij_betw_def)
+ by (metis embed_Field f iso_Field iso_iff iso_iff3 oproj_def r s)
theorem oproj_embed:
-assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
-shows "\<exists> g. embed s r g"
+ assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
+ shows "\<exists> g. embed s r g"
proof (rule embedI[OF s r, of "inv_into (Field r) f"], unfold underS_def, safe)
fix b assume "b \<in> Field s"
- thus "inv_into (Field r) f b \<in> Field r" using oproj_Field2[OF f] by (metis imageI inv_into_into)
+ thus "inv_into (Field r) f b \<in> Field r"
+ using oproj_Field2[OF f] by (metis imageI inv_into_into)
next
fix a b assume "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
"inv_into (Field r) f a = inv_into (Field r) f b"
- with f show False by (auto dest!: inv_into_injective simp: Field_def oproj_def)
+ with f show False
+ by (meson FieldI1 in_mono inv_into_injective oproj_def)
next
fix a b assume *: "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
- { assume "(inv_into (Field r) f a, inv_into (Field r) f b) \<notin> r"
+ { assume notin: "(inv_into (Field r) f a, inv_into (Field r) f b) \<notin> r"
moreover
from *(3) have "a \<in> Field s" unfolding Field_def by auto
- with *(1,2) have
- "inv_into (Field r) f a \<in> Field r" "inv_into (Field r) f b \<in> Field r"
- "inv_into (Field r) f a \<noteq> inv_into (Field r) f b"
- by (auto dest!: oproj_Field2[OF f] inv_into_injective intro!: inv_into_into)
+ then have "(inv_into (Field r) f b, inv_into (Field r) f a) \<in> r"
+ by (meson "*"(1) notin f in_mono inv_into_into oproj_def r wo_rel.in_notinI wo_rel.intro)
ultimately have "(inv_into (Field r) f b, inv_into (Field r) f a) \<in> r"
using r by (auto simp: well_order_on_def linear_order_on_def total_on_def)
with f[unfolded oproj_def compat_def] *(1) \<open>a \<in> Field s\<close>
f_inv_into_f[of b f "Field r"] f_inv_into_f[of a f "Field r"]
- have "(b, a) \<in> s" by (metis in_mono)
+ have "(b, a) \<in> s" by (metis in_mono)
with *(2,3) s have False
by (auto simp: well_order_on_def linear_order_on_def partial_order_on_def antisym_def)
} thus "(inv_into (Field r) f a, inv_into (Field r) f b) \<in> r" by blast
@@ -1069,6 +757,6 @@
corollary oproj_ordLeq:
assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
shows "s \<le>o r"
- using oproj_embed[OF assms] r s unfolding ordLeq_def by auto
+ using f oproj_embed ordLess_iff ordLess_or_ordLeq r s by blast
end
--- a/src/HOL/Cardinals/Wellorder_Embedding.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Wellorder_Embedding.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,22 +8,22 @@
section \<open>Well-Order Embeddings\<close>
theory Wellorder_Embedding
-imports Fun_More Wellorder_Relation
+ imports Fun_More Wellorder_Relation
begin
subsection \<open>Auxiliaries\<close>
lemma UNION_bij_betw_ofilter:
-assumes WELL: "Well_order r" and
- OF: "\<And> i. i \<in> I \<Longrightarrow> ofilter r (A i)" and
- BIJ: "\<And> i. i \<in> I \<Longrightarrow> bij_betw f (A i) (A' i)"
-shows "bij_betw f (\<Union>i \<in> I. A i) (\<Union>i \<in> I. A' i)"
+ assumes WELL: "Well_order r" and
+ OF: "\<And> i. i \<in> I \<Longrightarrow> ofilter r (A i)" and
+ BIJ: "\<And> i. i \<in> I \<Longrightarrow> bij_betw f (A i) (A' i)"
+ shows "bij_betw f (\<Union>i \<in> I. A i) (\<Union>i \<in> I. A' i)"
proof-
have "wo_rel r" using WELL by (simp add: wo_rel_def)
hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i \<le> A j \<or> A j \<le> A i"
- using wo_rel.ofilter_linord[of r] OF by blast
+ using wo_rel.ofilter_linord[of r] OF by blast
with WELL BIJ show ?thesis
- by (auto simp add: bij_betw_UNION_chain)
+ by (auto simp add: bij_betw_UNION_chain)
qed
@@ -31,144 +31,98 @@
functions\<close>
lemma embed_halfcong:
-assumes EQ: "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a" and
- EMB: "embed r r' f"
-shows "embed r r' g"
-proof(unfold embed_def, auto)
- fix a assume *: "a \<in> Field r"
- hence "bij_betw f (under r a) (under r' (f a))"
- using EMB unfolding embed_def by simp
- moreover
- {have "under r a \<le> Field r"
- by (auto simp add: under_Field)
- hence "\<And> b. b \<in> under r a \<Longrightarrow> f b = g b"
- using EQ by blast
- }
- moreover have "f a = g a" using * EQ by auto
- ultimately show "bij_betw g (under r a) (under r' (g a))"
- using bij_betw_cong[of "under r a" f g "under r' (f a)"] by auto
-qed
+ assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a" and "embed r r' f"
+ shows "embed r r' g"
+ by (smt (verit, del_insts) assms bij_betw_cong embed_def in_mono under_Field)
lemma embed_cong[fundef_cong]:
-assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
-shows "embed r r' f = embed r r' g"
-using assms embed_halfcong[of r f g r']
- embed_halfcong[of r g f r'] by auto
+ assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
+ shows "embed r r' f = embed r r' g"
+ by (metis assms embed_halfcong)
lemma embedS_cong[fundef_cong]:
-assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
-shows "embedS r r' f = embedS r r' g"
-unfolding embedS_def using assms
-embed_cong[of r f g r'] bij_betw_cong[of "Field r" f g "Field r'"] by blast
+ assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
+ shows "embedS r r' f = embedS r r' g"
+ unfolding embedS_def using assms
+ embed_cong[of r f g r'] bij_betw_cong[of "Field r" f g "Field r'"] by blast
lemma iso_cong[fundef_cong]:
-assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
-shows "iso r r' f = iso r r' g"
-unfolding iso_def using assms
-embed_cong[of r f g r'] bij_betw_cong[of "Field r" f g "Field r'"] by blast
+ assumes "\<And> a. a \<in> Field r \<Longrightarrow> f a = g a"
+ shows "iso r r' f = iso r r' g"
+ unfolding iso_def using assms
+ embed_cong[of r f g r'] bij_betw_cong[of "Field r" f g "Field r'"] by blast
lemma id_compat: "compat r r id"
-by(auto simp add: id_def compat_def)
+ by(auto simp add: id_def compat_def)
lemma comp_compat:
-"\<lbrakk>compat r r' f; compat r' r'' f'\<rbrakk> \<Longrightarrow> compat r r'' (f' o f)"
-by(auto simp add: comp_def compat_def)
+ "\<lbrakk>compat r r' f; compat r' r'' f'\<rbrakk> \<Longrightarrow> compat r r'' (f' o f)"
+ by(auto simp add: comp_def compat_def)
corollary one_set_greater:
-"(\<exists>f::'a \<Rightarrow> 'a'. f ` A \<le> A' \<and> inj_on f A) \<or> (\<exists>g::'a' \<Rightarrow> 'a. g ` A' \<le> A \<and> inj_on g A')"
+ "(\<exists>f::'a \<Rightarrow> 'a'. f ` A \<le> A' \<and> inj_on f A) \<or> (\<exists>g::'a' \<Rightarrow> 'a. g ` A' \<le> A \<and> inj_on g A')"
proof-
obtain r where "well_order_on A r" by (fastforce simp add: well_order_on)
hence 1: "A = Field r \<and> Well_order r"
- using well_order_on_Well_order by auto
+ using well_order_on_Well_order by auto
obtain r' where 2: "well_order_on A' r'" by (fastforce simp add: well_order_on)
hence 2: "A' = Field r' \<and> Well_order r'"
- using well_order_on_Well_order by auto
+ using well_order_on_Well_order by auto
hence "(\<exists>f. embed r r' f) \<or> (\<exists>g. embed r' r g)"
- using 1 2 by (auto simp add: wellorders_totally_ordered)
+ using 1 2 by (auto simp add: wellorders_totally_ordered)
moreover
{fix f assume "embed r r' f"
- hence "f`A \<le> A' \<and> inj_on f A"
- using 1 2 by (auto simp add: embed_Field embed_inj_on)
+ hence "f`A \<le> A' \<and> inj_on f A"
+ using 1 2 by (auto simp add: embed_Field embed_inj_on)
}
moreover
{fix g assume "embed r' r g"
- hence "g`A' \<le> A \<and> inj_on g A'"
- using 1 2 by (auto simp add: embed_Field embed_inj_on)
+ hence "g`A' \<le> A \<and> inj_on g A'"
+ using 1 2 by (auto simp add: embed_Field embed_inj_on)
}
ultimately show ?thesis by blast
qed
corollary one_type_greater:
-"(\<exists>f::'a \<Rightarrow> 'a'. inj f) \<or> (\<exists>g::'a' \<Rightarrow> 'a. inj g)"
-using one_set_greater[of UNIV UNIV] by auto
+ "(\<exists>f::'a \<Rightarrow> 'a'. inj f) \<or> (\<exists>g::'a' \<Rightarrow> 'a. inj g)"
+ using one_set_greater[of UNIV UNIV] by auto
subsection \<open>Uniqueness of embeddings\<close>
lemma comp_embedS:
-assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
- and EMB: "embedS r r' f" and EMB': "embedS r' r'' f'"
-shows "embedS r r'' (f' o f)"
-proof-
- have "embed r' r'' f'" using EMB' unfolding embedS_def by simp
- thus ?thesis using assms by (auto simp add: embedS_comp_embed)
-qed
+ assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
+ and EMB: "embedS r r' f" and EMB': "embedS r' r'' f'"
+ shows "embedS r r'' (f' o f)"
+ using EMB EMB' WELL WELL' embedS_comp_embed embedS_def by blast
lemma iso_iff4:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "iso r r' f = (embed r r' f \<and> embed r' r (inv_into (Field r) f))"
-using assms embed_bothWays_iso
-by(unfold iso_def, auto simp add: inv_into_Field_embed_bij_betw)
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "iso r r' f = (embed r r' f \<and> embed r' r (inv_into (Field r) f))"
+ using assms embed_bothWays_iso
+ by(unfold iso_def, auto simp add: inv_into_Field_embed_bij_betw)
lemma embed_embedS_iso:
-"embed r r' f = (embedS r r' f \<or> iso r r' f)"
-unfolding embedS_def iso_def by blast
+ "embed r r' f = (embedS r r' f \<or> iso r r' f)"
+ unfolding embedS_def iso_def by blast
lemma not_embedS_iso:
-"\<not> (embedS r r' f \<and> iso r r' f)"
-unfolding embedS_def iso_def by blast
+ "\<not> (embedS r r' f \<and> iso r r' f)"
+ unfolding embedS_def iso_def by blast
lemma embed_embedS_iff_not_iso:
-assumes "embed r r' f"
-shows "embedS r r' f = (\<not> iso r r' f)"
-using assms unfolding embedS_def iso_def by blast
+ assumes "embed r r' f"
+ shows "embedS r r' f = (\<not> iso r r' f)"
+ using assms unfolding embedS_def iso_def by blast
lemma iso_inv_into:
-assumes WELL: "Well_order r" and ISO: "iso r r' f"
-shows "iso r' r (inv_into (Field r) f)"
-using assms unfolding iso_def
-using bij_betw_inv_into inv_into_Field_embed_bij_betw by blast
+ assumes WELL: "Well_order r" and ISO: "iso r r' f"
+ shows "iso r' r (inv_into (Field r) f)"
+ by (meson ISO WELL bij_betw_inv_into inv_into_Field_embed_bij_betw iso_def iso_iff iso_iff2)
lemma embedS_or_iso:
-assumes WELL: "Well_order r" and WELL': "Well_order r'"
-shows "(\<exists>g. embedS r r' g) \<or> (\<exists>h. embedS r' r h) \<or> (\<exists>f. iso r r' f)"
-proof-
- {fix f assume *: "embed r r' f"
- {assume "bij_betw f (Field r) (Field r')"
- hence ?thesis using * by (auto simp add: iso_def)
- }
- moreover
- {assume "\<not> bij_betw f (Field r) (Field r')"
- hence ?thesis using * by (auto simp add: embedS_def)
- }
- ultimately have ?thesis by auto
- }
- moreover
- {fix f assume *: "embed r' r f"
- {assume "bij_betw f (Field r') (Field r)"
- hence "iso r' r f" using * by (auto simp add: iso_def)
- hence "iso r r' (inv_into (Field r') f)"
- using WELL' by (auto simp add: iso_inv_into)
- hence ?thesis by blast
- }
- moreover
- {assume "\<not> bij_betw f (Field r') (Field r)"
- hence ?thesis using * by (auto simp add: embedS_def)
- }
- ultimately have ?thesis by auto
- }
- ultimately show ?thesis using WELL WELL'
- wellorders_totally_ordered[of r r'] by blast
-qed
+ assumes WELL: "Well_order r" and WELL': "Well_order r'"
+ shows "(\<exists>g. embedS r r' g) \<or> (\<exists>h. embedS r' r h) \<or> (\<exists>f. iso r r' f)"
+ by (metis WELL WELL' embed_embedS_iso embed_embedS_iso iso_iff4 wellorders_totally_ordered)
end
--- a/src/HOL/Cardinals/Wellorder_Relation.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Cardinals/Wellorder_Relation.thy Sun Jan 15 20:00:44 2023 +0100
@@ -8,7 +8,7 @@
section \<open>Well-Order Relations\<close>
theory Wellorder_Relation
-imports Wellfounded_More
+ imports Wellfounded_More
begin
context wo_rel
@@ -17,29 +17,29 @@
subsection \<open>Auxiliaries\<close>
lemma PREORD: "Preorder r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma PARORD: "Partial_order r"
-using WELL order_on_defs[of _ r] by auto
+ using WELL order_on_defs[of _ r] by auto
lemma cases_Total2:
-"\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<Longrightarrow> phi a b);
+ "\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<Longrightarrow> phi a b);
((b,a) \<in> r - Id \<Longrightarrow> phi a b); (a = b \<Longrightarrow> phi a b)\<rbrakk>
\<Longrightarrow> phi a b"
-using TOTALS by auto
+ using TOTALS by auto
subsection \<open>Well-founded induction and recursion adapted to non-strict well-order relations\<close>
lemma worec_unique_fixpoint:
-assumes ADM: "adm_wo H" and fp: "f = H f"
-shows "f = worec H"
+ assumes ADM: "adm_wo H" and fp: "f = H f"
+ shows "f = worec H"
proof-
have "adm_wf (r - Id) H"
- unfolding adm_wf_def
- using ADM adm_wo_def[of H] underS_def[of r] by auto
+ unfolding adm_wf_def
+ using ADM adm_wo_def[of H] underS_def[of r] by auto
hence "f = wfrec (r - Id) H"
- using fp WF wfrec_unique_fixpoint[of "r - Id" H] by simp
+ using fp WF wfrec_unique_fixpoint[of "r - Id" H] by simp
thus ?thesis unfolding worec_def .
qed
@@ -47,121 +47,66 @@
subsubsection \<open>Properties of max2\<close>
lemma max2_iff:
-assumes "a \<in> Field r" and "b \<in> Field r"
-shows "((max2 a b, c) \<in> r) = ((a,c) \<in> r \<and> (b,c) \<in> r)"
+ assumes "a \<in> Field r" and "b \<in> Field r"
+ shows "((max2 a b, c) \<in> r) = ((a,c) \<in> r \<and> (b,c) \<in> r)"
proof
assume "(max2 a b, c) \<in> r"
thus "(a,c) \<in> r \<and> (b,c) \<in> r"
- using assms max2_greater[of a b] TRANS trans_def[of r] by blast
+ using assms max2_greater[of a b] TRANS trans_def[of r] by blast
next
assume "(a,c) \<in> r \<and> (b,c) \<in> r"
thus "(max2 a b, c) \<in> r"
- using assms max2_among[of a b] by auto
+ using assms max2_among[of a b] by auto
qed
subsubsection \<open>Properties of minim\<close>
lemma minim_Under:
-"\<lbrakk>B \<le> Field r; B \<noteq> {}\<rbrakk> \<Longrightarrow> minim B \<in> Under B"
-by(auto simp add: Under_def minim_inField minim_least)
+ "\<lbrakk>B \<le> Field r; B \<noteq> {}\<rbrakk> \<Longrightarrow> minim B \<in> Under B"
+ by(auto simp add: Under_def minim_inField minim_least)
lemma equals_minim_Under:
-"\<lbrakk>B \<le> Field r; a \<in> B; a \<in> Under B\<rbrakk>
+ "\<lbrakk>B \<le> Field r; a \<in> B; a \<in> Under B\<rbrakk>
\<Longrightarrow> a = minim B"
-by(auto simp add: Under_def equals_minim)
+ by(auto simp add: Under_def equals_minim)
lemma minim_iff_In_Under:
-assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
-shows "(a = minim B) = (a \<in> B \<and> a \<in> Under B)"
+ assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
+ shows "(a = minim B) = (a \<in> B \<and> a \<in> Under B)"
proof
assume "a = minim B"
thus "a \<in> B \<and> a \<in> Under B"
- using assms minim_in minim_Under by simp
+ using assms minim_in minim_Under by simp
next
assume "a \<in> B \<and> a \<in> Under B"
thus "a = minim B"
- using assms equals_minim_Under by simp
+ using assms equals_minim_Under by simp
qed
lemma minim_Under_under:
-assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
-shows "Under A = under (minim A)"
+ assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
+ shows "Under A = under (minim A)"
proof-
- (* Preliminary facts *)
- have 1: "minim A \<in> A"
- using assms minim_in by auto
- have 2: "\<forall>x \<in> A. (minim A, x) \<in> r"
- using assms minim_least by auto
- (* Main proof *)
- have "Under A \<le> under (minim A)"
- proof
- fix x assume "x \<in> Under A"
- with 1 Under_def[of r] have "(x,minim A) \<in> r" by auto
- thus "x \<in> under(minim A)" unfolding under_def by simp
- qed
- (* *)
- moreover
- (* *)
- have "under (minim A) \<le> Under A"
- proof
- fix x assume "x \<in> under(minim A)"
- hence 11: "(x,minim A) \<in> r" unfolding under_def by simp
- hence "x \<in> Field r" unfolding Field_def by auto
- moreover
- {fix a assume "a \<in> A"
- with 2 have "(minim A, a) \<in> r" by simp
- with 11 have "(x,a) \<in> r"
- using TRANS trans_def[of r] by blast
- }
- ultimately show "x \<in> Under A" by (unfold Under_def, auto)
- qed
- (* *)
+ have "minim A \<in> A"
+ using assms minim_in by auto
+ then have "Under A \<le> under (minim A)"
+ by (simp add: Under_decr under_Under_singl)
+ moreover have "under (minim A) \<le> Under A"
+ by (meson NE SUB TRANS minim_Under subset_eq under_Under_trans)
ultimately show ?thesis by blast
qed
lemma minim_UnderS_underS:
-assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
-shows "UnderS A = underS (minim A)"
+ assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
+ shows "UnderS A = underS (minim A)"
proof-
- (* Preliminary facts *)
- have 1: "minim A \<in> A"
- using assms minim_in by auto
- have 2: "\<forall>x \<in> A. (minim A, x) \<in> r"
- using assms minim_least by auto
- (* Main proof *)
- have "UnderS A \<le> underS (minim A)"
- proof
- fix x assume "x \<in> UnderS A"
- with 1 UnderS_def[of r] have "x \<noteq> minim A \<and> (x,minim A) \<in> r" by auto
- thus "x \<in> underS(minim A)" unfolding underS_def by simp
- qed
- (* *)
- moreover
- (* *)
- have "underS (minim A) \<le> UnderS A"
- proof
- fix x assume "x \<in> underS(minim A)"
- hence 11: "x \<noteq> minim A \<and> (x,minim A) \<in> r" unfolding underS_def by simp
- hence "x \<in> Field r" unfolding Field_def by auto
- moreover
- {fix a assume "a \<in> A"
- with 2 have 3: "(minim A, a) \<in> r" by simp
- with 11 have "(x,a) \<in> r"
- using TRANS trans_def[of r] by blast
- moreover
- have "x \<noteq> a"
- proof
- assume "x = a"
- with 11 3 ANTISYM antisym_def[of r]
- show False by auto
- qed
- ultimately
- have "x \<noteq> a \<and> (x,a) \<in> r" by simp
- }
- ultimately show "x \<in> UnderS A" by (unfold UnderS_def, auto)
- qed
- (* *)
+ have "minim A \<in> A"
+ using assms minim_in by auto
+ then have "UnderS A \<le> underS (minim A)"
+ by (simp add: UnderS_decr underS_UnderS_singl)
+ moreover have "underS (minim A) \<le> UnderS A"
+ by (meson ANTISYM NE SUB TRANS minim_Under subset_eq underS_Under_trans)
ultimately show ?thesis by blast
qed
@@ -169,150 +114,103 @@
subsubsection \<open>Properties of supr\<close>
lemma supr_Above:
-assumes SUB: "B \<le> Field r" and ABOVE: "Above B \<noteq> {}"
-shows "supr B \<in> Above B"
-proof(unfold supr_def)
- have "Above B \<le> Field r"
- using Above_Field[of r] by auto
- thus "minim (Above B) \<in> Above B"
- using assms by (simp add: minim_in)
-qed
+ assumes "Above B \<noteq> {}"
+ shows "supr B \<in> Above B"
+ by (simp add: assms Above_Field minim_in supr_def)
lemma supr_greater:
-assumes SUB: "B \<le> Field r" and ABOVE: "Above B \<noteq> {}" and
- IN: "b \<in> B"
-shows "(b, supr B) \<in> r"
-proof-
- from assms supr_Above
- have "supr B \<in> Above B" by simp
- with IN Above_def[of r] show ?thesis by simp
-qed
+ assumes "Above B \<noteq> {}" "b \<in> B"
+ shows "(b, supr B) \<in> r"
+ using assms Above_def supr_Above by fastforce
lemma supr_least_Above:
-assumes SUB: "B \<le> Field r" and
- ABOVE: "a \<in> Above B"
-shows "(supr B, a) \<in> r"
-proof(unfold supr_def)
- have "Above B \<le> Field r"
- using Above_Field[of r] by auto
- thus "(minim (Above B), a) \<in> r"
- using assms minim_least
- by simp
-qed
+ assumes "a \<in> Above B"
+ shows "(supr B, a) \<in> r"
+ by (simp add: assms Above_Field minim_least supr_def)
lemma supr_least:
-"\<lbrakk>B \<le> Field r; a \<in> Field r; (\<And> b. b \<in> B \<Longrightarrow> (b,a) \<in> r)\<rbrakk>
+ "\<lbrakk>B \<le> Field r; a \<in> Field r; (\<And> b. b \<in> B \<Longrightarrow> (b,a) \<in> r)\<rbrakk>
\<Longrightarrow> (supr B, a) \<in> r"
-by(auto simp add: supr_least_Above Above_def)
+ by(auto simp add: supr_least_Above Above_def)
lemma equals_supr_Above:
-assumes SUB: "B \<le> Field r" and ABV: "a \<in> Above B" and
- MINIM: "\<And> a'. a' \<in> Above B \<Longrightarrow> (a,a') \<in> r"
-shows "a = supr B"
-proof(unfold supr_def)
- have "Above B \<le> Field r"
- using Above_Field[of r] by auto
- thus "a = minim (Above B)"
- using assms equals_minim by simp
-qed
+ assumes "a \<in> Above B" "\<And> a'. a' \<in> Above B \<Longrightarrow> (a,a') \<in> r"
+ shows "a = supr B"
+ by (simp add: assms Above_Field equals_minim supr_def)
lemma equals_supr:
-assumes SUB: "B \<le> Field r" and IN: "a \<in> Field r" and
- ABV: "\<And> b. b \<in> B \<Longrightarrow> (b,a) \<in> r" and
- MINIM: "\<And> a'. \<lbrakk> a' \<in> Field r; \<And> b. b \<in> B \<Longrightarrow> (b,a') \<in> r\<rbrakk> \<Longrightarrow> (a,a') \<in> r"
-shows "a = supr B"
+ assumes SUB: "B \<le> Field r" and IN: "a \<in> Field r" and
+ ABV: "\<And> b. b \<in> B \<Longrightarrow> (b,a) \<in> r" and
+ MINIM: "\<And> a'. \<lbrakk> a' \<in> Field r; \<And> b. b \<in> B \<Longrightarrow> (b,a') \<in> r\<rbrakk> \<Longrightarrow> (a,a') \<in> r"
+ shows "a = supr B"
proof-
have "a \<in> Above B"
- unfolding Above_def using ABV IN by simp
+ unfolding Above_def using ABV IN by simp
moreover
have "\<And> a'. a' \<in> Above B \<Longrightarrow> (a,a') \<in> r"
- unfolding Above_def using MINIM by simp
+ unfolding Above_def using MINIM by simp
ultimately show ?thesis
- using equals_supr_Above SUB by auto
+ using equals_supr_Above SUB by auto
qed
lemma supr_inField:
-assumes "B \<le> Field r" and "Above B \<noteq> {}"
-shows "supr B \<in> Field r"
-proof-
- have "supr B \<in> Above B" using supr_Above assms by simp
- thus ?thesis using assms Above_Field[of r] by auto
-qed
+ assumes "Above B \<noteq> {}"
+ shows "supr B \<in> Field r"
+ by (simp add: Above_Field assms minim_inField supr_def)
lemma supr_above_Above:
-assumes SUB: "B \<le> Field r" and ABOVE: "Above B \<noteq> {}"
-shows "Above B = above (supr B)"
-proof(unfold Above_def above_def, auto)
- fix a assume "a \<in> Field r" "\<forall>b \<in> B. (b,a) \<in> r"
- with supr_least assms
- show "(supr B, a) \<in> r" by auto
-next
- fix b assume "(supr B, b) \<in> r"
- thus "b \<in> Field r"
- using REFL refl_on_def[of _ r] by auto
-next
- fix a b
- assume 1: "(supr B, b) \<in> r" and 2: "a \<in> B"
- with assms supr_greater
- have "(a,supr B) \<in> r" by auto
- thus "(a,b) \<in> r"
- using 1 TRANS trans_def[of r] by blast
-qed
+ assumes SUB: "B \<le> Field r" and ABOVE: "Above B \<noteq> {}"
+ shows "Above B = above (supr B)"
+ apply (clarsimp simp: Above_def above_def set_eq_iff)
+ by (meson ABOVE FieldI2 SUB TRANS supr_greater supr_least transD)
lemma supr_under:
-assumes IN: "a \<in> Field r"
-shows "a = supr (under a)"
+ assumes "a \<in> Field r"
+ shows "a = supr (under a)"
proof-
have "under a \<le> Field r"
- using under_Field[of r] by auto
+ using under_Field[of r] by auto
moreover
have "under a \<noteq> {}"
- using IN Refl_under_in[of r] REFL by auto
+ using assms Refl_under_in[of r] REFL by auto
moreover
have "a \<in> Above (under a)"
- using in_Above_under[of _ r] IN by auto
+ using in_Above_under[of _ r] assms by auto
moreover
have "\<forall>a' \<in> Above (under a). (a,a') \<in> r"
- proof(unfold Above_def under_def, auto)
- fix a'
- assume "\<forall>aa. (aa, a) \<in> r \<longrightarrow> (aa, a') \<in> r"
- hence "(a,a) \<in> r \<longrightarrow> (a,a') \<in> r" by blast
- moreover have "(a,a) \<in> r"
- using REFL IN by (auto simp add: refl_on_def)
- ultimately
- show "(a, a') \<in> r" by (rule mp)
- qed
+ by (auto simp: Above_def above_def REFL Refl_under_in assms)
ultimately show ?thesis
- using equals_supr_Above by auto
+ using equals_supr_Above by auto
qed
subsubsection \<open>Properties of successor\<close>
lemma suc_least:
-"\<lbrakk>B \<le> Field r; a \<in> Field r; (\<And> b. b \<in> B \<Longrightarrow> a \<noteq> b \<and> (b,a) \<in> r)\<rbrakk>
+ "\<lbrakk>B \<le> Field r; a \<in> Field r; (\<And> b. b \<in> B \<Longrightarrow> a \<noteq> b \<and> (b,a) \<in> r)\<rbrakk>
\<Longrightarrow> (suc B, a) \<in> r"
-by(auto simp add: suc_least_AboveS AboveS_def)
+ by(auto simp add: suc_least_AboveS AboveS_def)
lemma equals_suc:
-assumes SUB: "B \<le> Field r" and IN: "a \<in> Field r" and
- ABVS: "\<And> b. b \<in> B \<Longrightarrow> a \<noteq> b \<and> (b,a) \<in> r" and
- MINIM: "\<And> a'. \<lbrakk>a' \<in> Field r; \<And> b. b \<in> B \<Longrightarrow> a' \<noteq> b \<and> (b,a') \<in> r\<rbrakk> \<Longrightarrow> (a,a') \<in> r"
-shows "a = suc B"
+ assumes SUB: "B \<le> Field r" and IN: "a \<in> Field r" and
+ ABVS: "\<And> b. b \<in> B \<Longrightarrow> a \<noteq> b \<and> (b,a) \<in> r" and
+ MINIM: "\<And> a'. \<lbrakk>a' \<in> Field r; \<And> b. b \<in> B \<Longrightarrow> a' \<noteq> b \<and> (b,a') \<in> r\<rbrakk> \<Longrightarrow> (a,a') \<in> r"
+ shows "a = suc B"
proof-
have "a \<in> AboveS B"
- unfolding AboveS_def using ABVS IN by simp
+ unfolding AboveS_def using ABVS IN by simp
moreover
have "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
- unfolding AboveS_def using MINIM by simp
+ unfolding AboveS_def using MINIM by simp
ultimately show ?thesis
- using equals_suc_AboveS SUB by auto
+ using equals_suc_AboveS SUB by auto
qed
lemma suc_above_AboveS:
-assumes SUB: "B \<le> Field r" and
- ABOVE: "AboveS B \<noteq> {}"
-shows "AboveS B = above (suc B)"
+ assumes SUB: "B \<le> Field r" and
+ ABOVE: "AboveS B \<noteq> {}"
+ shows "AboveS B = above (suc B)"
+ using assms
proof(unfold AboveS_def above_def, auto)
fix a assume "a \<in> Field r" "\<forall>b \<in> B. a \<noteq> b \<and> (b,a) \<in> r"
with suc_least assms
@@ -320,82 +218,57 @@
next
fix b assume "(suc B, b) \<in> r"
thus "b \<in> Field r"
- using REFL refl_on_def[of _ r] by auto
+ using REFL refl_on_def[of _ r] by auto
next
fix a b
assume 1: "(suc B, b) \<in> r" and 2: "a \<in> B"
with assms suc_greater[of B a]
have "(a,suc B) \<in> r" by auto
thus "(a,b) \<in> r"
- using 1 TRANS trans_def[of r] by blast
+ using 1 TRANS trans_def[of r] by blast
next
fix a
- assume 1: "(suc B, a) \<in> r" and 2: "a \<in> B"
- with assms suc_greater[of B a]
- have "(a,suc B) \<in> r" by auto
- moreover have "suc B \<in> Field r"
- using assms suc_inField by simp
- ultimately have "a = suc B"
- using 1 2 SUB ANTISYM antisym_def[of r] by auto
+ assume "(suc B, a) \<in> r" and 2: "a \<in> B"
thus False
- using assms suc_greater[of B a] 2 by auto
+ by (metis ABOVE ANTISYM SUB antisymD suc_greater)
qed
lemma suc_singl_pred:
-assumes IN: "a \<in> Field r" and ABOVE_NE: "aboveS a \<noteq> {}" and
- REL: "(a',suc {a}) \<in> r" and DIFF: "a' \<noteq> suc {a}"
-shows "a' = a \<or> (a',a) \<in> r"
+ assumes IN: "a \<in> Field r" and ABOVE_NE: "aboveS a \<noteq> {}" and
+ REL: "(a',suc {a}) \<in> r" and DIFF: "a' \<noteq> suc {a}"
+ shows "a' = a \<or> (a',a) \<in> r"
proof-
have *: "suc {a} \<in> Field r \<and> a' \<in> Field r"
- using WELL REL well_order_on_domain by metis
+ using WELL REL well_order_on_domain by metis
{assume **: "a' \<noteq> a"
- hence "(a,a') \<in> r \<or> (a',a) \<in> r"
- using TOTAL IN * by (auto simp add: total_on_def)
- moreover
- {assume "(a,a') \<in> r"
- with ** * assms WELL suc_least[of "{a}" a']
- have "(suc {a},a') \<in> r" by auto
- with REL DIFF * ANTISYM antisym_def[of r]
- have False by simp
- }
- ultimately have "(a',a) \<in> r"
- by blast
+ hence "(a,a') \<in> r \<or> (a',a) \<in> r"
+ using TOTAL IN * by (auto simp add: total_on_def)
+ moreover
+ {assume "(a,a') \<in> r"
+ with ** * assms WELL suc_least[of "{a}" a']
+ have "(suc {a},a') \<in> r" by auto
+ with REL DIFF * ANTISYM antisym_def[of r]
+ have False by simp
+ }
+ ultimately have "(a',a) \<in> r"
+ by blast
}
thus ?thesis by blast
qed
lemma under_underS_suc:
-assumes IN: "a \<in> Field r" and ABV: "aboveS a \<noteq> {}"
-shows "underS (suc {a}) = under a"
-proof-
- have 1: "AboveS {a} \<noteq> {}"
- using ABV aboveS_AboveS_singl[of r] by auto
- have 2: "a \<noteq> suc {a} \<and> (a,suc {a}) \<in> r"
- using suc_greater[of "{a}" a] IN 1 by auto
- (* *)
+ assumes IN: "a \<in> Field r" and ABV: "aboveS a \<noteq> {}"
+ shows "underS (suc {a}) = under a"
+proof -
+ have "AboveS {a} \<noteq> {}"
+ using ABV aboveS_AboveS_singl[of r] by auto
+ then have 2: "a \<noteq> suc {a} \<and> (a,suc {a}) \<in> r"
+ using suc_greater[of "{a}" a] IN by auto
have "underS (suc {a}) \<le> under a"
- proof(unfold underS_def under_def, auto)
- fix x assume *: "x \<noteq> suc {a}" and **: "(x,suc {a}) \<in> r"
- with suc_singl_pred[of a x] IN ABV
- have "x = a \<or> (x,a) \<in> r" by auto
- with REFL refl_on_def[of _ r] IN
- show "(x,a) \<in> r" by auto
- qed
- (* *)
+ using ABV IN REFL Refl_under_in underS_E under_def wo_rel.suc_singl_pred wo_rel_axioms by fastforce
moreover
- (* *)
have "under a \<le> underS (suc {a})"
- proof(unfold underS_def under_def, auto)
- assume "(suc {a}, a) \<in> r"
- with 2 ANTISYM antisym_def[of r]
- show False by auto
- next
- fix x assume *: "(x,a) \<in> r"
- with 2 TRANS trans_def[of r]
- show "(x,suc {a}) \<in> r" by blast
- (* blast is often better than auto/auto for transitivity-like properties *)
- qed
- (* *)
+ by (simp add: "2" ANTISYM TRANS subsetI underS_I under_underS_trans)
ultimately show ?thesis by blast
qed
@@ -403,113 +276,49 @@
subsubsection \<open>Properties of order filters\<close>
lemma ofilter_Under[simp]:
-assumes "A \<le> Field r"
-shows "ofilter(Under A)"
-proof(unfold ofilter_def, auto)
- fix x assume "x \<in> Under A"
- thus "x \<in> Field r"
- using Under_Field[of r] assms by auto
-next
- fix a x
- assume "a \<in> Under A" and "x \<in> under a"
- thus "x \<in> Under A"
- using TRANS under_Under_trans[of r] by auto
-qed
+ assumes "A \<le> Field r"
+ shows "ofilter(Under A)"
+ by (clarsimp simp: ofilter_def) (meson TRANS Under_Field subset_eq under_Under_trans)
lemma ofilter_UnderS[simp]:
-assumes "A \<le> Field r"
-shows "ofilter(UnderS A)"
-proof(unfold ofilter_def, auto)
- fix x assume "x \<in> UnderS A"
- thus "x \<in> Field r"
- using UnderS_Field[of r] assms by auto
-next
- fix a x
- assume "a \<in> UnderS A" and "x \<in> under a"
- thus "x \<in> UnderS A"
- using TRANS ANTISYM under_UnderS_trans[of r] by auto
-qed
+ assumes "A \<le> Field r"
+ shows "ofilter(UnderS A)"
+ by (clarsimp simp: ofilter_def) (meson ANTISYM TRANS UnderS_Field subset_eq under_UnderS_trans)
lemma ofilter_Int[simp]: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A Int B)"
-unfolding ofilter_def by blast
+ unfolding ofilter_def by blast
lemma ofilter_Un[simp]: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A \<union> B)"
-unfolding ofilter_def by blast
+ unfolding ofilter_def by blast
lemma ofilter_INTER:
-"\<lbrakk>I \<noteq> {}; \<And> i. i \<in> I \<Longrightarrow> ofilter(A i)\<rbrakk> \<Longrightarrow> ofilter (\<Inter>i \<in> I. A i)"
-unfolding ofilter_def by blast
+ "\<lbrakk>I \<noteq> {}; \<And> i. i \<in> I \<Longrightarrow> ofilter(A i)\<rbrakk> \<Longrightarrow> ofilter (\<Inter>i \<in> I. A i)"
+ unfolding ofilter_def by blast
lemma ofilter_Inter:
-"\<lbrakk>S \<noteq> {}; \<And> A. A \<in> S \<Longrightarrow> ofilter A\<rbrakk> \<Longrightarrow> ofilter (\<Inter>S)"
-unfolding ofilter_def by blast
+ "\<lbrakk>S \<noteq> {}; \<And> A. A \<in> S \<Longrightarrow> ofilter A\<rbrakk> \<Longrightarrow> ofilter (\<Inter>S)"
+ unfolding ofilter_def by blast
lemma ofilter_Union:
-"(\<And> A. A \<in> S \<Longrightarrow> ofilter A) \<Longrightarrow> ofilter (\<Union>S)"
-unfolding ofilter_def by blast
+ "(\<And> A. A \<in> S \<Longrightarrow> ofilter A) \<Longrightarrow> ofilter (\<Union>S)"
+ unfolding ofilter_def by blast
lemma ofilter_under_Union:
-"ofilter A \<Longrightarrow> A = \<Union>{under a| a. a \<in> A}"
-using ofilter_under_UNION [of A] by auto
+ "ofilter A \<Longrightarrow> A = \<Union>{under a| a. a \<in> A}"
+ using ofilter_under_UNION [of A] by auto
subsubsection \<open>Other properties\<close>
lemma Trans_Under_regressive:
-assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
-shows "Under(Under A) \<le> Under A"
-proof
- let ?a = "minim A"
- (* Preliminary facts *)
- have 1: "minim A \<in> Under A"
- using assms minim_Under by auto
- have 2: "\<forall>y \<in> A. (minim A, y) \<in> r"
- using assms minim_least by auto
- (* Main proof *)
- fix x assume "x \<in> Under(Under A)"
- with 1 have 1: "(x,minim A) \<in> r"
- using Under_def[of r] by auto
- with Field_def have "x \<in> Field r" by fastforce
- moreover
- {fix y assume *: "y \<in> A"
- hence "(x,y) \<in> r"
- using 1 2 TRANS trans_def[of r] by blast
- with Field_def have "(x,y) \<in> r" by auto
- }
- ultimately
- show "x \<in> Under A" unfolding Under_def by auto
-qed
+ assumes NE: "A \<noteq> {}" and SUB: "A \<le> Field r"
+ shows "Under(Under A) \<le> Under A"
+ by (metis INT_E NE REFL Refl_under_Under SUB empty_iff minim_Under minim_Under_under subsetI)
lemma ofilter_suc_Field:
-assumes OF: "ofilter A" and NE: "A \<noteq> Field r"
-shows "ofilter (A \<union> {suc A})"
-proof-
- (* Preliminary facts *)
- have 1: "A \<le> Field r" using OF ofilter_def by auto
- hence 2: "AboveS A \<noteq> {}"
- using ofilter_AboveS_Field NE OF by blast
- from 1 2 suc_inField
- have 3: "suc A \<in> Field r" by auto
- (* Main proof *)
- show ?thesis
- proof(unfold ofilter_def, auto simp add: 1 3)
- fix a x
- assume "a \<in> A" "x \<in> under a" "x \<notin> A"
- with OF ofilter_def have False by auto
- thus "x = suc A" by simp
- next
- fix x assume *: "x \<in> under (suc A)" and **: "x \<notin> A"
- hence "x \<in> Field r" using under_def Field_def by fastforce
- with ** have "x \<in> AboveS A"
- using ofilter_AboveS_Field[of A] OF by auto
- hence "(suc A,x) \<in> r"
- using suc_least_AboveS by auto
- moreover
- have "(x,suc A) \<in> r" using * under_def[of r] by auto
- ultimately show "x = suc A"
- using ANTISYM antisym_def[of r] by auto
- qed
-qed
+ assumes OF: "ofilter A" and NE: "A \<noteq> Field r"
+ shows "ofilter (A \<union> {suc A})"
+ by (metis NE OF REFL Refl_under_underS ofilter_underS_Field suc_underS under_ofilter)
(* FIXME: needed? *)
declare
--- a/src/HOL/Relation.thy Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Relation.thy Sun Jan 15 20:00:44 2023 +0100
@@ -1247,6 +1247,9 @@
definition Field :: "'a rel \<Rightarrow> 'a set"
where "Field r = Domain r \<union> Range r"
+lemma Field_iff: "x \<in> Field r \<longleftrightarrow> (\<exists>y. (x,y) \<in> r \<or> (y,x) \<in> r)"
+ by (auto simp: Field_def)
+
lemma FieldI1: "(i, j) \<in> R \<Longrightarrow> i \<in> Field R"
unfolding Field_def by blast
--- a/src/HOL/Tools/Mirabelle/mirabelle_sledgehammer.ML Sun Jan 15 20:00:37 2023 +0100
+++ b/src/HOL/Tools/Mirabelle/mirabelle_sledgehammer.ML Sun Jan 15 20:00:44 2023 +0100
@@ -305,12 +305,14 @@
exhaustive_preplay proof_method_from_msg thy_index trivial pos st =
let
val thy = Proof.theory_of st
- val thy_name = Context.theory_name thy
+ val thy_long_name = Context.theory_long_name thy
+ val session_name = Long_Name.qualifier thy_long_name
+ val thy_name = Long_Name.base_name thy_long_name
val triv_str = if trivial then "[T] " else ""
val keep =
if keep_probs orelse keep_proofs then
let val subdir = StringCvt.padLeft #"0" 4 (string_of_int thy_index) ^ "_" ^ thy_name in
- Path.append output_dir (Path.basic subdir)
+ Path.append (Path.append output_dir (Path.basic session_name)) (Path.basic subdir)
|> Isabelle_System.make_directory
|> Path.implode
|> (fn dir => SOME (dir, keep_probs, keep_proofs))