src/ZF/AC/Cardinal_aux.thy
changeset 46822 95f1e700b712
parent 36319 8feb2c4bef1a
child 47101 ded5cc757bc9
equal deleted inserted replaced
46821:ff6b0c1087f2 46822:95f1e700b712
    18 (* ********************************************************************** *)
    18 (* ********************************************************************** *)
    19 
    19 
    20 
    20 
    21 (* j=|A| *)
    21 (* j=|A| *)
    22 lemma lepoll_imp_ex_le_eqpoll:
    22 lemma lepoll_imp_ex_le_eqpoll:
    23      "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j le i & A \<approx> j"
    23      "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j \<le> i & A \<approx> j"
    24 by (blast intro!: lepoll_cardinal_le well_ord_Memrel 
    24 by (blast intro!: lepoll_cardinal_le well_ord_Memrel
    25                   well_ord_cardinal_eqpoll [THEN eqpoll_sym]
    25                   well_ord_cardinal_eqpoll [THEN eqpoll_sym]
    26           dest: lepoll_well_ord)
    26           dest: lepoll_well_ord)
    27 
    27 
    28 (* j=|A| *)
    28 (* j=|A| *)
    29 lemma lesspoll_imp_ex_lt_eqpoll: 
    29 lemma lesspoll_imp_ex_lt_eqpoll:
    30      "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j"
    30      "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j"
    31 by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE)
    31 by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE)
    32 
    32 
    33 lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)"
    33 lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)"
    34 apply (unfold InfCard_def)
    34 apply (unfold InfCard_def)
    35 apply (rule conjI)
    35 apply (rule conjI)
    36 apply (rule Card_cardinal)
    36 apply (rule Card_cardinal)
    37 apply (rule Card_nat 
    37 apply (rule Card_nat
    38             [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]])
    38             [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]])
    39   -- "rewriting would loop!"
    39   -- "rewriting would loop!"
    40 apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption) 
    40 apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption)
    41 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
    41 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
    42 done
    42 done
    43 
    43 
    44 text{*An alternative and more general proof goes like this: A and B are both
    44 text{*An alternative and more general proof goes like this: A and B are both
    45 well-ordered (because they are injected into an ordinal), either A lepoll B
    45 well-ordered (because they are injected into an ordinal), either @{term"A \<lesssim> B"}
    46 or B lepoll A.  Also both are equipollent to their cardinalities, so
    46 or @{term"B \<lesssim> A"}.  Also both are equipollent to their cardinalities, so
    47 (if A and B are infinite) then A Un B lepoll |A|+|B| = max(|A|,|B|) lepoll i.
    47 (if A and B are infinite) then @{term"A \<union> B \<lesssim> |A\<oplus>B| \<longleftrightarrow> max(|A|,|B|) \<lesssim> i"}.
    48 In fact, the correctly strengthened version of this theorem appears below.*}
    48 In fact, the correctly strengthened version of this theorem appears below.*}
    49 lemma Un_lepoll_Inf_Ord_weak:
    49 lemma Un_lepoll_Inf_Ord_weak:
    50      "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i"
    50      "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i"
    51 apply (rule Un_lepoll_sum [THEN lepoll_trans])
    51 apply (rule Un_lepoll_sum [THEN lepoll_trans])
    52 apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans])
    52 apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans])
    53 apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll]) 
    53 apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll])
    54 apply (erule eqpoll_sym) 
    54 apply (erule eqpoll_sym)
    55 apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans]) 
    55 apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans])
    56 apply (rule nat_2I [THEN OrdmemD], rule Ord_nat) 
    56 apply (rule nat_2I [THEN OrdmemD], rule Ord_nat)
    57 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) 
    57 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
    58 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) 
    58 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
    59 apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans],
    59 apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans],
    60        assumption)
    60        assumption)
    61 apply (rule eqpoll_imp_lepoll) 
    61 apply (rule eqpoll_imp_lepoll)
    62 apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption) 
    62 apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption)
    63 apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+) 
    63 apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+)
    64 done
    64 done
    65 
    65 
    66 lemma Un_eqpoll_Inf_Ord:
    66 lemma Un_eqpoll_Inf_Ord:
    67      "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A Un B \<approx> i"
    67      "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A \<union> B \<approx> i"
    68 apply (rule eqpollI)
    68 apply (rule eqpollI)
    69 apply (blast intro: Un_lepoll_Inf_Ord_weak) 
    69 apply (blast intro: Un_lepoll_Inf_Ord_weak)
    70 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]) 
    70 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans])
    71 apply (rule Un_upper1 [THEN subset_imp_lepoll]) 
    71 apply (rule Un_upper1 [THEN subset_imp_lepoll])
    72 done
    72 done
    73 
    73 
    74 schematic_lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)"
    74 schematic_lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)"
    75 apply (rule RepFun_bijective)
    75 apply (rule RepFun_bijective)
    76 apply (simp add: doubleton_eq_iff, blast)
    76 apply (simp add: doubleton_eq_iff, blast)
    77 done
    77 done
    78 
    78 
    79 lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x"
    79 lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x"
    80 by (unfold eqpoll_def, fast intro!: paired_bij)
    80 by (unfold eqpoll_def, fast intro!: paired_bij)
    81 
    81 
    82 lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B Int C = 0"
    82 lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B \<inter> C = 0"
    83 by (fast intro!: paired_eqpoll equals0I elim: mem_asym)
    83 by (fast intro!: paired_eqpoll equals0I elim: mem_asym)
    84 
    84 
    85 (*Finally we reach this result.  Surely there's a simpler proof, as sketched
    85 (*Finally we reach this result.  Surely there's a simpler proof, as sketched
    86   above?*)
    86   above?*)
    87 lemma Un_lepoll_Inf_Ord:
    87 lemma Un_lepoll_Inf_Ord:
    88      "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A Un B \<lesssim> i"
    88      "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A \<union> B \<lesssim> i"
    89 apply (rule_tac A1 = i and C1 = i in ex_eqpoll_disjoint [THEN exE])
    89 apply (rule_tac A1 = i and C1 = i in ex_eqpoll_disjoint [THEN exE])
    90 apply (erule conjE)
    90 apply (erule conjE)
    91 apply (drule lepoll_trans) 
    91 apply (drule lepoll_trans)
    92 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
    92 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
    93 apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+))
    93 apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+))
    94 apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll) 
    94 apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll)
    95 done
    95 done
    96 
    96 
    97 lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j"
    97 lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j"
    98 apply (erule Least_le [THEN leE])
    98 apply (erule Least_le [THEN leE])
    99 apply (erule Ord_in_Ord, assumption)
    99 apply (erule Ord_in_Ord, assumption)
   101 apply (fast dest: OrdmemD)
   101 apply (fast dest: OrdmemD)
   102 apply (erule subst_elem, assumption)
   102 apply (erule subst_elem, assumption)
   103 done
   103 done
   104 
   104 
   105 lemma Diff_first_lepoll:
   105 lemma Diff_first_lepoll:
   106      "[| well_ord(x,r); y \<subseteq> x; y \<lesssim> succ(n); n \<in> nat |] 
   106      "[| well_ord(x,r); y \<subseteq> x; y \<lesssim> succ(n); n \<in> nat |]
   107       ==> y - {THE b. first(b,y,r)} \<lesssim> n"
   107       ==> y - {THE b. first(b,y,r)} \<lesssim> n"
   108 apply (case_tac "y=0", simp add: empty_lepollI) 
   108 apply (case_tac "y=0", simp add: empty_lepollI)
   109 apply (fast intro!: Diff_sing_lepoll the_first_in)
   109 apply (fast intro!: Diff_sing_lepoll the_first_in)
   110 done
   110 done
   111 
   111 
   112 lemma UN_subset_split:
   112 lemma UN_subset_split:
   113      "(\<Union>x \<in> X. P(x)) \<subseteq> (\<Union>x \<in> X. P(x)-Q(x)) Un (\<Union>x \<in> X. Q(x))"
   113      "(\<Union>x \<in> X. P(x)) \<subseteq> (\<Union>x \<in> X. P(x)-Q(x)) \<union> (\<Union>x \<in> X. Q(x))"
   114 by blast
   114 by blast
   115 
   115 
   116 lemma UN_sing_lepoll: "Ord(a) ==> (\<Union>x \<in> a. {P(x)}) \<lesssim> a"
   116 lemma UN_sing_lepoll: "Ord(a) ==> (\<Union>x \<in> a. {P(x)}) \<lesssim> a"
   117 apply (unfold lepoll_def)
   117 apply (unfold lepoll_def)
   118 apply (rule_tac x = "\<lambda>z \<in> (\<Union>x \<in> a. {P (x) }) . (LEAST i. P (i) =z) " in exI)
   118 apply (rule_tac x = "\<lambda>z \<in> (\<Union>x \<in> a. {P (x) }) . (LEAST i. P (i) =z) " in exI)
   120 apply (fast intro!: Least_in_Ord)
   120 apply (fast intro!: Least_in_Ord)
   121 apply (fast intro: LeastI elim!: Ord_in_Ord)
   121 apply (fast intro: LeastI elim!: Ord_in_Ord)
   122 done
   122 done
   123 
   123 
   124 lemma UN_fun_lepoll_lemma [rule_format]:
   124 lemma UN_fun_lepoll_lemma [rule_format]:
   125      "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |] 
   125      "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |]
   126       ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) --> (\<Union>b \<in> a. f`b) \<lesssim> a"
   126       ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) \<longrightarrow> (\<Union>b \<in> a. f`b) \<lesssim> a"
   127 apply (induct_tac "n")
   127 apply (induct_tac "n")
   128 apply (rule allI)
   128 apply (rule allI)
   129 apply (rule impI)
   129 apply (rule impI)
   130 apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst)
   130 apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst)
   131 apply (rule_tac [2] empty_lepollI)
   131 apply (rule_tac [2] empty_lepollI)
   132 apply (rule equals0I [symmetric], clarify) 
   132 apply (rule equals0I [symmetric], clarify)
   133 apply (fast dest: lepoll_0_is_0 [THEN subst])
   133 apply (fast dest: lepoll_0_is_0 [THEN subst])
   134 apply (rule allI)
   134 apply (rule allI)
   135 apply (rule impI)
   135 apply (rule impI)
   136 apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE)
   136 apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE)
   137 apply (erule impE, simp)
   137 apply (erule impE, simp)
   138 apply (fast intro!: Diff_first_lepoll, simp)
   138 apply (fast intro!: Diff_first_lepoll, simp)
   139 apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans])
   139 apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans])
   140 apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll) 
   140 apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll)
   141 done
   141 done
   142 
   142 
   143 lemma UN_fun_lepoll:
   143 lemma UN_fun_lepoll:
   144      "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R);   
   144      "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R);
   145          ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a"
   145          ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a"
   146 by (blast intro: UN_fun_lepoll_lemma) 
   146 by (blast intro: UN_fun_lepoll_lemma)
   147 
   147 
   148 lemma UN_lepoll:
   148 lemma UN_lepoll:
   149      "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R);   
   149      "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R);
   150          ~Finite(a); Ord(a); n \<in> nat |] 
   150          ~Finite(a); Ord(a); n \<in> nat |]
   151       ==> (\<Union>b \<in> a. F(b)) \<lesssim> a"
   151       ==> (\<Union>b \<in> a. F(b)) \<lesssim> a"
   152 apply (rule rev_mp) 
   152 apply (rule rev_mp)
   153 apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll)
   153 apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll)
   154 apply auto
   154 apply auto
   155 done
   155 done
   156 
   156 
   157 lemma UN_eq_UN_Diffs:
   157 lemma UN_eq_UN_Diffs:
   165 apply (rule DiffI, best intro: Ord_in_Ord LeastI, clarify)
   165 apply (rule DiffI, best intro: Ord_in_Ord LeastI, clarify)
   166 apply (erule_tac P = "%z. x \<in> F (z) " and i = c in less_LeastE)
   166 apply (erule_tac P = "%z. x \<in> F (z) " and i = c in less_LeastE)
   167 apply (blast intro: Ord_Least ltI)
   167 apply (blast intro: Ord_Least ltI)
   168 done
   168 done
   169 
   169 
   170 lemma lepoll_imp_eqpoll_subset: 
   170 lemma lepoll_imp_eqpoll_subset:
   171      "a \<lesssim> X ==> \<exists>Y. Y \<subseteq> X & a \<approx> Y"
   171      "a \<lesssim> X ==> \<exists>Y. Y \<subseteq> X & a \<approx> Y"
   172 apply (unfold lepoll_def eqpoll_def, clarify) 
   172 apply (unfold lepoll_def eqpoll_def, clarify)
   173 apply (blast intro: restrict_bij
   173 apply (blast intro: restrict_bij
   174              dest: inj_is_fun [THEN fun_is_rel, THEN image_subset]) 
   174              dest: inj_is_fun [THEN fun_is_rel, THEN image_subset])
   175 done
   175 done
   176 
   176 
   177 (* ********************************************************************** *)
   177 (* ********************************************************************** *)
   178 (* Diff_lesspoll_eqpoll_Card                                              *)
   178 (* Diff_lesspoll_eqpoll_Card                                              *)
   179 (* ********************************************************************** *)
   179 (* ********************************************************************** *)
   182      "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P"
   182      "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P"
   183 apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE)
   183 apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE)
   184 apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption)
   184 apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption)
   185 apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption)
   185 apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption)
   186 apply (drule Un_least_lt, assumption)
   186 apply (drule Un_least_lt, assumption)
   187 apply (drule eqpoll_imp_lepoll [THEN lepoll_trans], 
   187 apply (drule eqpoll_imp_lepoll [THEN lepoll_trans],
   188        rule le_imp_lepoll, assumption)+
   188        rule le_imp_lepoll, assumption)+
   189 apply (case_tac "Finite(x Un xa)")
   189 apply (case_tac "Finite(x \<union> xa)")
   190 txt{*finite case*}
   190 txt{*finite case*}
   191  apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+) 
   191  apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+)
   192  apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite])
   192  apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite])
   193  apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite])
   193  apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite])
   194 txt{*infinite case*}
   194 txt{*infinite case*}
   195 apply (drule Un_lepoll_Inf_Ord, (assumption+))
   195 apply (drule Un_lepoll_Inf_Ord, (assumption+))
   196 apply (blast intro: le_Ord2) 
   196 apply (blast intro: le_Ord2)
   197 apply (drule lesspoll_trans1 
   197 apply (drule lesspoll_trans1
   198              [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans] 
   198              [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans]
   199                  lt_Card_imp_lesspoll], assumption+)
   199                  lt_Card_imp_lesspoll], assumption+)
   200 apply (simp add: lesspoll_def) 
   200 apply (simp add: lesspoll_def)
   201 done
   201 done
   202 
   202 
   203 lemma Diff_lesspoll_eqpoll_Card:
   203 lemma Diff_lesspoll_eqpoll_Card:
   204      "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a"
   204      "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a"
   205 apply (rule ccontr)
   205 apply (rule ccontr)
   206 apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+))
   206 apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+))
   207 apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2] 
   207 apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2]
   208                     subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
   208                     subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
   209 done
   209 done
   210 
   210 
   211 end
   211 end