diff --git a/thys/ZFC_in_HOL/Cantor_NF.thy b/thys/ZFC_in_HOL/Cantor_NF.thy new file mode 100644 --- /dev/null +++ b/thys/ZFC_in_HOL/Cantor_NF.thy @@ -0,0 +1,1423 @@ +section \Cantor Normal Form\ + +theory Cantor_NF + imports Ordinal_Exp +begin + +subsection \Cantor normal form\ + +text \Lemma 5.1\ +lemma cnf_1: + assumes \: "\ \ elts \" "Ord \" and "m > 0" + shows "\\\ * ord_of_nat n < \\\ * ord_of_nat m" +proof - + have \: "\\succ \ \ \\\" + using Ord_mem_iff_less_TC assms oexp_mono succ_le_TC_iff by auto + have "\\\ * ord_of_nat n < \\\ * \" + using Ord_in_Ord OrdmemD assms by auto + also have "\ = \\succ \" + using Ord_in_Ord \ by auto + also have "\ \ \\\" + using "\" by blast + also have "\ \ \\\ * ord_of_nat m" + using \m > 0\ le_mult by auto + finally show ?thesis . +qed + + +fun Cantor_sum where + Cantor_sum_Nil: "Cantor_sum [] ms = 0" +| Cantor_sum_Nil2: "Cantor_sum (\#\s) [] = 0" +| Cantor_sum_Cons: "Cantor_sum (\#\s) (m#ms) = (\\\) * ord_of_nat m + Cantor_sum \s ms" + + +abbreviation Cantor_dec :: "V list \ bool" where + "Cantor_dec \ sorted_wrt (>)" + +lemma Ord_Cantor_sum: + assumes "List.set \s \ ON" + shows "Ord (Cantor_sum \s ms)" + using assms +proof (induction \s arbitrary: ms) + case (Cons a \s ms) + then show ?case + by (cases ms) auto +qed auto + +lemma Cantor_dec_Cons_iff [simp]: "Cantor_dec (\#\#\s) \ \ < \ \ Cantor_dec (\#\s)" + by auto + + +text \Lemma 5.2. The second and third premises aren't really necessary, but their + removal requires quite a lot of work.\ +lemma cnf_2: + assumes "List.set (\#\s) \ ON" "list.set ms \ {0<..}" "length \s = length ms" + and "Cantor_dec (\#\s)" + shows "\\\ > Cantor_sum \s ms" + using assms +proof (induction ms arbitrary: \ \s) + case Nil + then obtain \0 where \0: "(\#\s) = [\0]" + by (metis length_0_conv) + then have "Ord \0" + using Nil.prems(1) by auto + then show ?case + using \0 zero_less_Limit by auto +next + case (Cons m1 ms) + then obtain \0 \1 \s' where \01: "(\#\s) = \0#\1#\s'" + by (metis (no_types, lifting) Cons.prems(3) Suc_length_conv) + then have "Ord \0" "Ord \1" + using Cons.prems(1) \01 by auto + have *: "\\\0 * ord_of_nat 1 > \\\1 * ord_of_nat m1" + proof (rule cnf_1) + show "\1 \ elts \0" + using Cons.prems \01 by (simp add: Ord_mem_iff_lt \Ord \0\ \Ord \1\) + qed (use \Ord \0\ in auto) + show ?case + proof (cases ms) + case Nil + then show ?thesis + using * one_V_def Cons.prems(3) \01 by auto + next + case (Cons m2 ms') + then obtain \2 \s'' where \02: "(\#\s) = \0#\1#\2#\s''" + by (metis Cons.prems(3) Suc_length_conv \01 length_tl list.sel(3)) + then have "Ord \2" + using Cons.prems(1) by auto + have "m1 > 0" "m2 > 0" + using Cons.prems Cons by auto + have "\\\1 * ord_of_nat m1 + \\\1 * ord_of_nat m1 = (\\\1 * ord_of_nat m1) * ord_of_nat 2" + by (simp add: mult_succ eval_nat_numeral) + also have "\ < \\\0" + using cnf_1 [of concl: "\1" "m1 * 2" "\0" 1] Cons.prems \01 one_V_def + by (simp add: mult.assoc ord_of_nat_mult Ord_mem_iff_lt) + finally have II: "\\\1 * ord_of_nat m1 + \\\1 * ord_of_nat m1 < \\\0" + by simp + have "Cantor_sum (tl \s) ms < \\hd \s" + proof (rule Cons.IH) + show "Cantor_dec (hd \s # tl \s)" + using \Cantor_dec (\#\s)\ \01 by auto + qed (use Cons.prems \01 in auto) + then have "Cantor_sum (\2 # \s'') ms < \\\1" + using \02 by auto + also have "\ \ \\\1 * ord_of_nat m1" + by (simp add: \0 < m1\ le_mult) + finally show ?thesis + using II \02 dual_order.strict_trans by fastforce + qed +qed + +proposition Cantor_nf_exists: + assumes "Ord \" + obtains \s ms where "List.set \s \ ON" "list.set ms \ {0<..}" "length \s = length ms" + and "Cantor_dec \s" + and "\ = Cantor_sum \s ms" + using assms +proof (induction \ arbitrary: thesis rule: Ord_induct) + case (step \) + show ?case + proof (cases "\ = 0") + case True + have "Cantor_sum [] [] = 0" + by simp + with True show ?thesis + using length_pos_if_in_set step.prems subset_eq + by (metis length_0_conv not_gr_zero sorted_wrt.simps(1)) + next + case False + define \hat where "\hat \ Sup {\ \ ON. \\\ \ \}" + then have "Ord \hat" + using Ord_Sup assms by fastforce + have "\\. \Ord \; \\\ \ \\ \ \ \ \\\" + by (metis Ord_\ OrdmemD le_oexp' order_trans step.hyps one_V_def succ_in_omega zero_in_omega) + then have "{\ \ ON. \\\ \ \} \ elts (succ (\\\))" + using Ord_mem_iff_lt step.hyps by force + then have sma: "small {\ \ ON. \\\ \ \}" + by (meson down) + have le: "\\\hat \ \" + proof (rule ccontr) + assume "\ \\\hat \ \" + then have \: "\ \ elts (\\\hat)" + by (meson Ord_\ Ord_linear2 Ord_mem_iff_lt Ord_oexp \Ord \hat\ step.hyps) + obtain \ where "Ord \" "\\\ \ \" "\ < \" + using \Ord \hat\ + proof (cases \hat rule: Ord_cases) + case 0 + with \ show thesis + by (auto simp: False) + next + case (succ \) + have "succ \ \ {\ \ ON. \\\ \ \}" + by (rule succ_in_Sup_Ord) (use succ \hat_def sma in auto) + then have "\\succ \ \ \" + by blast + with \ show thesis + using \\ \\\hat \ \\ succ by blast + next + case limit + with \ show thesis + apply (clarsimp simp: oexp_Limit \hat_def) + by (meson Ord_\ Ord_in_Ord Ord_linear_le mem_not_refl oexp_mono_le omega_nonzero vsubsetD) + qed + then show False + by (metis Ord_\ OrdmemD leD le_less_trans le_oexp' one_V_def succ_in_omega zero_in_omega) + qed + have False if "\M. \ < \\\hat * ord_of_nat M" + proof - + have \: "\\\hat * ord_of_nat M \ \" for M + by (meson that Ord_\ Ord_linear2 Ord_mult Ord_oexp Ord_ord_of_nat \Ord \hat\ step.hyps) + have "\ \\succ \hat \ \" + using Ord_mem_iff_lt \hat_def \Ord \hat\ sma elts_succ by blast + then have "\ < \\succ \hat" + by (meson Ord_\ Ord_linear2 Ord_oexp Ord_succ \Ord \hat\ step.hyps) + also have "\ = \\\hat * \" + using \Ord \hat\ oexp_succ by blast + also have "\ = Sup (range (\m. \\\hat * ord_of_nat m))" + by (simp add: mult_Limit) (auto simp: \_def image_image) + also have "\ \ \" + using \ by blast + finally show False + by simp + qed + then obtain M where M: "\\\hat * ord_of_nat M > \" + by blast + have bound: "i \ M" if "\\\hat * ord_of_nat i \ \" for i + proof - + have "\\\hat * ord_of_nat i < \\\hat * ord_of_nat M" + using M dual_order.strict_trans2 that by blast + then show ?thesis + using \Ord \hat\ less_V_def by auto + qed + define mhat where "mhat \ Greatest (\m. \\\hat * ord_of_nat m \ \)" + have mhat_ge: "m \ mhat" if "\\\hat * ord_of_nat m \ \" for m + unfolding mhat_def + by (metis (mono_tags, lifting) Greatest_le_nat bound that) + have mhat: "\\\hat * ord_of_nat mhat \ \" + unfolding mhat_def + by (rule GreatestI_nat [where k=0 and b=M]) (use bound in auto) + then obtain \ where "Ord \" "\ \ \" and \: "\ = \\\hat * ord_of_nat mhat + \" + by (metis Ord_\ Ord_mult Ord_oexp Ord_ord_of_nat \Ord \hat\ step.hyps le_Ord_diff) + have False if "\ = \" + proof - + have "\ \ \\\hat" + by (simp add: le that) + then obtain \ where "Ord \" "\ \ \" and \: "\ = \\\hat + \" + by (metis Ord_\ Ord_oexp \Ord \hat\ \Ord \\ le_Ord_diff) + then have "\ = \\\hat * ord_of_nat mhat + \\\hat + \" + by (simp add: \ add.assoc) + then have "\\\hat * ord_of_nat (Suc mhat) \ \" + by (metis add_le_cancel_left add.right_neutral le_0 mult_succ ord_of_nat.simps(2)) + then show False + using Suc_n_not_le_n mhat_ge by blast + qed + then have \in\: "\ \ elts \" + using Ord_mem_iff_lt \Ord \\ \\ \ \\ less_V_def step.hyps by auto + show thesis + proof (cases "\ = 0") + case True + show thesis + proof (rule step.prems) + show "\ = Cantor_sum [\hat] [mhat]" + by (simp add: True \) + qed (use \ True \\ \ 0\ \Ord \hat\ in auto) + next + case False + obtain \s ns where sub: "List.set \s \ ON" "list.set ns \ {0<..}" + and len_eq: "length \s = length ns" + and dec: "Cantor_dec \s" + and \eq: "\ = Cantor_sum \s ns" + using step.IH [OF \in\] by blast + then have "length \s > 0" "length ns > 0" + using False Cantor_sum.simps(1) \\ = Cantor_sum \s ns\ by auto + then obtain \0 n0 \s' ns' where \0: "\s = \0 # \s'" and "Ord \0" + and n0: "ns = n0 # ns'" and "n0 > 0" + using sub by (auto simp: neq_Nil_conv) + moreover have False if "\0 > \hat" + proof - + have "\\\0 \ \\\0 * ord_of_nat n0 + u" for u + using \n0 > 0\ + by (metis add_le_cancel_left Ord_ord_of_nat add.right_neutral dual_order.trans gr_implies_not_zero le_0 le_mult ord_of_eq_0_iff) + moreover have "\\\0 > \" + using that \Ord \0\ + by (metis (no_types, lifting) Ord_\ Ord_linear2 Ord_oexp Sup_upper \hat_def leD mem_Collect_eq sma step.hyps) + ultimately have "\ \ \\\0" + by (simp add: \eq \0 n0) + then show ?thesis + using \\ < \\\0\ \\ \ \\ by auto + qed + ultimately have "\0 \ \hat" + using Ord_linear2 \Ord \hat\ by auto + then consider "\0 < \hat" | "\0 = \hat" + using dual_order.order_iff_strict by auto + then show ?thesis + proof cases + case 1 + show ?thesis + proof (rule step.prems) + show "list.set (\hat#\s) \ ON" + using sub by (auto simp: \Ord \hat\) + show "list.set (mhat#ns) \ {0::nat<..}" + using sub using \\ = \ \ False\ \ by fastforce + show "Cantor_dec (\hat#\s)" + using that \\0 < \hat\ \Ord \hat\ \Ord \0\ Ord_mem_iff_lt \0 dec less_Suc_eq_0_disj + by (force simp: \0 n0) + show "length (\hat#\s) = length (mhat#ns)" + by (auto simp: len_eq) + show "\ = Cantor_sum (\hat#\s) (mhat#ns)" + by (simp add: \ \eq \0 n0) + qed + next + case 2 + show ?thesis + proof (rule step.prems) + show "list.set \s \ ON" + by (simp add: sub(1)) + show "list.set ((n0+mhat)#ns') \ {0::nat<..}" + using n0 sub(2) by auto + show "length (\s::V list) = length ((n0+mhat)#ns')" + by (simp add: len_eq n0) + show "Cantor_dec \s" + using that \0 dec by auto + show "\ = Cantor_sum \s ((n0+mhat)#ns')" + using 2 + by (simp add: add_mult_distrib \0 \ \eq add.assoc add.commute n0 ord_of_nat_add) + qed + qed + qed + qed +qed + +lemma Cantor_sum_0E: + assumes "Cantor_sum \s ms = 0" "List.set \s \ ON" "list.set ms \ {0<..}" "length \s = length ms" + shows "\s = []" + using assms +proof (induction \s arbitrary: ms) + case Nil + then show ?case + by auto +next + case (Cons a list) + then obtain m ms' where "ms = m#ms'" "m \ 0" "list.set ms' \ {0<..}" + by simp (metis Suc_length_conv greaterThan_iff insert_subset list.set(2)) + with Cons show ?case by auto +qed + + +lemma Cantor_nf_unique_aux: + assumes "Ord \" + and \sON: "List.set \s \ ON" + and \sON: "List.set \s \ ON" + and ms: "list.set ms \ {0<..}" + and ns: "list.set ns \ {0<..}" + and mseq: "length \s = length ms" + and nseq: "length \s = length ns" + and \sdec: "Cantor_dec \s" + and \sdec: "Cantor_dec \s" + and \seq: "\ = Cantor_sum \s ms" + and \seq: "\ = Cantor_sum \s ns" + shows "\s = \s \ ms = ns" + using assms +proof (induction \ arbitrary: \s ms \s ns rule: Ord_induct) + case (step \) + show ?case + proof (cases "\ = 0") + case True + then show ?thesis + using step.prems by (metis Cantor_sum_0E length_0_conv) + next + case False + then obtain \0 \s' \0 \s' where \s: "\s = \0 # \s'" and \s: "\s = \0 # \s'" + by (metis Cantor_sum.simps(1) min_list.cases step.prems(9,10)) + then have ON: "Ord \0" "list.set \s' \ ON" "Ord \0" "list.set \s' \ ON" + using \s \s step.prems(1,2) by auto + then obtain m0 ms' n0 ns' where ms: "ms = m0 # ms'" and ns: "ns = n0 # ns'" + by (metis \s \s length_0_conv list.distinct(1) list.exhaust step.prems(5,6)) + then have nz: "m0 \ 0" "list.set ms' \ {0<..}" "n0 \ 0" "list.set ns' \ {0<..}" + using ms ns step.prems(3,4) by auto + have False if "\0 < \0" + proof - + have Ordc: "Ord (Cantor_sum \s ns)" "Ord (\\\0)" + using Ord_oexp \Ord \0\ step.hyps step.prems(10) by blast+ + have *: "Cantor_sum \s ns < \\\0" + using step.prems(2-6) \Ord \0\ \Cantor_dec \s\ that \s cnf_2 + by (metis Cantor_dec_Cons_iff insert_subset list.set(2) mem_Collect_eq) + then show False + by (metis Cantor_sum_Cons Ord_mem_iff_lt Ord_ord_of_nat Ordc \s \m0 \ 0\ * le_mult ms not_add_mem_right ord_of_eq_0 step.prems(9,10) vsubsetD) + qed + moreover + have False if "\0 < \0" + proof - + have Ordc: "Ord (Cantor_sum \s ms)" "Ord (\\\0)" + using Ord_oexp \Ord \0\ step.hyps step.prems(9) by blast+ + have *: "Cantor_sum \s ms < \\\0" + using step.prems(1-5) \Ord \0\ \Cantor_dec \s\ that \s cnf_2 + by (metis Cantor_dec_Cons_iff \s insert_subset list.set(2)) + then show False + by (metis Cantor_sum_Cons Ord_mem_iff_lt Ord_ord_of_nat Ordc \s \n0 \ 0\ * le_mult not_add_mem_right ns ord_of_eq_0 step.prems(9,10) vsubsetD) + qed + ultimately have 1: "\0 = \0" + using Ord_linear_lt \Ord \0\ \Ord \0\ by blast + have False if "m0 < n0" + proof - + have "\\\0 > Cantor_sum \s' ms'" + using \s \list.set ms' \ {0<..}\ cnf_2 ms step.prems(1,5,7) by auto + then have "\ < \\\0 * ord_of_nat m0 + \\\0" + by (simp add: \s ms step.prems(9)) + also have "\ = \\\0 * ord_of_nat (Suc m0)" + by (simp add: mult_succ) + also have "\ \ \\\0 * ord_of_nat n0" + by (meson Ord_\ Ord_oexp Ord_ord_of_nat Suc_leI \Ord \0\ mult_cancel_le_iff ord_of_nat_mono_iff that) + also have "\ \ \" + by (metis Cantor_sum_Cons add_le_cancel_left \s \\0 = \0\ add.right_neutral le_0 ns step.prems(10)) + finally show False + by blast + qed + moreover have False if "n0 < m0" + proof - + have "\\\0 > Cantor_sum \s' ns'" + using \s \list.set ns' \ {0<..}\ cnf_2 ns step.prems(2,6,8) by auto + then have "\ < \\\0 * ord_of_nat n0 + \\\0" + by (simp add: \s ns step.prems(10)) + also have "\ = \\\0 * ord_of_nat (Suc n0)" + by (simp add: mult_succ) + also have "\ \ \\\0 * ord_of_nat m0" + by (meson Ord_\ Ord_oexp Ord_ord_of_nat Suc_leI \Ord \0\ mult_cancel_le_iff ord_of_nat_mono_iff that) + also have "\ \ \" + by (metis Cantor_sum_Cons add_le_cancel_left \s \\0 = \0\ add.right_neutral le_0 ms step.prems(9)) + finally show False + by blast + qed + ultimately have 2: "m0 = n0" + using nat_neq_iff by blast + have "\s' = \s' \ ms' = ns'" + proof (rule step.IH) + have "Cantor_sum \s' ms' < \\\0" + using \s cnf_2 ms nz(2) step.prems(1) step.prems(5) step.prems(7) by auto + also have "\ \ Cantor_sum \s ms" + apply (simp add: \s \s ms ns) + by (metis Cantor_sum_Cons add_less_cancel_left ON(1) Ord_\ Ord_linear2 Ord_oexp Ord_ord_of_nat \s add.right_neutral dual_order.strict_trans1 le_mult ms not_less_0 nz(1) ord_of_eq_0 step.hyps step.prems(9)) + finally show "Cantor_sum \s' ms' \ elts \" + using ON(2) Ord_Cantor_sum Ord_mem_iff_lt step.hyps step.prems(9) by blast + show "length \s' = length ms'" "length \s' = length ns'" + using \s ms \s ns step.prems by auto + show "Cantor_dec \s'" "Cantor_dec \s'" + using \s \s step.prems(7,8) by auto + have "Cantor_sum \s ms = Cantor_sum \s ns" + using step.prems(9,10) by auto + then show "Cantor_sum \s' ms' = Cantor_sum \s' ns'" + using 1 2 by (simp add: \s \s ms ns) + qed (use ON nz in auto) + then show ?thesis + using 1 2 by (simp add: \s \s ms ns) + qed +qed + + +proposition Cantor_nf_unique: + assumes "Cantor_sum \s ms = Cantor_sum \s ns" + and \sON: "List.set \s \ ON" + and \sON: "List.set \s \ ON" + and ms: "list.set ms \ {0<..}" + and ns: "list.set ns \ {0<..}" + and mseq: "length \s = length ms" + and nseq: "length \s = length ns" + and \sdec: "Cantor_dec \s" + and \sdec: "Cantor_dec \s" + shows "\s = \s \ ms = ns" + using Cantor_nf_unique_aux Ord_Cantor_sum assms by auto + + +lemma less_\_power: + assumes "Ord \1" "Ord \" + and \2: "\2 \ elts \1" and \: "\ < \\\2" + and "m1 > 0" "m2 > 0" + shows "\\\2 * ord_of_nat m2 + \ < \\\1 * ord_of_nat m1 + (\\\2 * ord_of_nat m2 + \)" + (is "?lhs < ?rhs") +proof - + obtain oo: "Ord (\\\1)" "Ord (\\\2)" + using Ord_in_Ord Ord_oexp assms by blast + moreover obtain "ord_of_nat m2 \ 0" + using assms ord_of_eq_0 by blast + ultimately have "\ < \\\2 * ord_of_nat m2" + by (meson Ord_ord_of_nat \ dual_order.strict_trans1 le_mult) + with oo assms have "?lhs \ ?rhs" + by (metis Ord_mult Ord_ord_of_nat add_strict_mono add.assoc cnf_1 not_add_less_right oo) + then show ?thesis + by (simp add: add_le_left \Ord \\ less_V_def oo) +qed + +lemma Cantor_sum_ge: + assumes "List.set (\#\s) \ ON" "list.set ms \ {0<..}" "length ms > 0" + shows "\ \ \ \ Cantor_sum (\#\s) ms" +proof - + obtain m ns where ms: "ms = Cons m ns" + using assms(3) strict_sorted.cases by auto + then have "\ \ \ \ \ \ \ * ord_of_nat m" + using assms(2) le_mult by auto + then show ?thesis + using dual_order.trans ms by auto +qed + +subsection \Simplified Cantor normal form\ + +text \No coefficients, and the exponents decreasing non-strictly\ + +fun \_sum where + \_sum_Nil: "\_sum [] = 0" +| \_sum_Cons: "\_sum (\#\s) = (\\\) + \_sum \s" + +abbreviation \_dec :: "V list \ bool" where + "\_dec \ sorted_wrt (\)" + +lemma Ord_\_sum [simp]: "List.set \s \ ON \ Ord (\_sum \s)" + by (induction \s) auto + +lemma \_dec_Cons_iff [simp]: "\_dec (\#\#\s) \ \ \ \ \ \_dec (\#\s)" + by auto + +lemma \_sum_0E: + assumes "\_sum \s = 0" "List.set \s \ ON" + shows "\s = []" + using assms +by (induction \s) auto + +fun \_of_Cantor where + \_of_Cantor_Nil: "\_of_Cantor [] ms = []" +| \_of_Cantor_Nil2: "\_of_Cantor (\#\s) [] = []" +| \_of_Cantor_Cons: "\_of_Cantor (\#\s) (m#ms) = replicate m \ @ \_of_Cantor \s ms" + + +lemma \_sum_append [simp]: "\_sum (xs @ ys) = \_sum xs + \_sum ys" + by (induction xs) (auto simp: add.assoc) + +lemma \_sum_replicate [simp]: "\_sum (replicate m a) = \ \ a * ord_of_nat m" + by (induction m) (auto simp: mult_succ simp flip: replicate_append_same) + +lemma \_sum_of_Cantor [simp]: "\_sum (\_of_Cantor \s ms) = Cantor_sum \s ms" +proof (induction \s arbitrary: ms) + case (Cons a \s ms) + then show ?case + by (cases ms) auto +qed auto + +lemma \_of_Cantor_subset: "List.set (\_of_Cantor \s ms) \ List.set \s" +proof (induction \s arbitrary: ms) + case (Cons a \s ms) + then show ?case + by (cases ms) auto +qed auto + + +lemma \_dec_replicate: "\_dec (replicate m \ @ \s) = (if m=0 then \_dec \s else \_dec (\#\s))" + by (induction m arbitrary: \s) (simp_all flip: replicate_append_same) + + +lemma \_dec_of_Cantor_aux: + assumes "Cantor_dec (\#\s)" "length \s = length ms" + shows "\_dec (\_of_Cantor (\#\s) (m#ms))" + using assms +proof (induction \s arbitrary: ms) + case Nil + then show ?case + using sorted_wrt_iff_nth_less by fastforce +next + case (Cons a \s ms) + then obtain n ns where ns: "ms = n#ns" + by (metis length_Suc_conv) + then have "a \ \" + using Cons.prems(1) order.strict_implies_order by auto + moreover have "\x\list.set (\_of_Cantor \s ns). x \ a" + using Cons ns \a \ \\ + apply (simp add: \_dec_replicate) + by (meson \_of_Cantor_subset order.strict_implies_order subsetD) + ultimately show ?case + using Cons ns by (force simp: \_dec_replicate) +qed + +lemma \_dec_of_Cantor: + assumes "Cantor_dec \s" "length \s = length ms" + shows "\_dec (\_of_Cantor \s ms)" +proof (cases \s) + case Nil + then have "ms = []" + using assms by auto + with Nil show ?thesis + by simp +next + case (Cons a list) + then show ?thesis + by (metis \_dec_of_Cantor_aux assms length_Suc_conv) +qed + +proposition \_nf_exists: + assumes "Ord \" + obtains \s where "List.set \s \ ON" and "\_dec \s" and "\ = \_sum \s" +proof - + obtain \s ms where "List.set \s \ ON" "list.set ms \ {0<..}" and length: "length \s = length ms" + and "Cantor_dec \s" + and \: "\ = Cantor_sum \s ms" + using Cantor_nf_exists assms by blast + then show thesis + by (metis \_dec_of_Cantor \_of_Cantor_subset \_sum_of_Cantor order_trans that) +qed + +lemma \_sum_take_drop: "\_sum \s = \_sum (take k \s) + \_sum (drop k \s)" +proof (induction k arbitrary: \s) + case 0 + then show ?case + by simp +next + case (Suc k) + then show ?case + proof (cases "\s") + case Nil + then show ?thesis + by simp + next + case (Cons a list) + with Suc.prems show ?thesis + by (simp add: add.assoc flip: Suc.IH) + qed +qed + +lemma in_elts_\_sum: + assumes "\ \ elts (\_sum \s)" + shows "\ks. \\\elts (\ \ (\s!k)). \ = \_sum (take k \s) + \" + using assms +proof (induction \s arbitrary: \) + case (Cons \ \s) + then have "\ \ elts (\ \ \ + \_sum \s)" + by simp + then show ?case + proof (rule mem_plus_V_E) + fix \ + assume \: "\ \ elts (\_sum \s)" and \: "\ = \ \ \ + \" + then obtain k \ where "ks" "\ \ elts (\ \ (\s!k))" "\ = \_sum (take k \s) + \" + using Cons.IH by blast + then show ?case + by (rule_tac x="Suc k" in exI) (simp add: \ add.assoc) + qed auto +qed auto + +lemma \_le_\_sum: "\k < length \s; List.set \s \ ON\ \ \ \ (\s!k) \ \_sum \s" +proof (induction \s arbitrary: k) + case (Cons a \s) + then obtain "Ord a" "list.set \s \ ON" + by simp + with Cons.IH have "\k x. k < length \s \ \ \ \s ! k \ \ \ a + \_sum \s" + by (meson Ord_\ Ord_\_sum Ord_oexp add_le_left order_trans) + then show ?case + using Cons by (simp add: nth_Cons split: nat.split) +qed auto + +lemma \_sum_less_self: + assumes "List.set (\#\s) \ ON" and "\_dec (\#\s)" + shows "\_sum \s < \\\ + \_sum \s" + using assms +proof (induction \s arbitrary: \) + case Nil + then show ?case + using ZFC_in_HOL.neq0_conv by fastforce +next + case (Cons \1 \s) + then show ?case + by (simp add: add_right_strict_mono oexp_mono_le) +qed + +text \Something like Lemma 5.2 for \_sum\ +lemma \_sum_less_\_power: + assumes "\_dec (\#\s)" "List.set (\#\s) \ ON" + shows "\_sum \s < \\\ * \" + using assms +proof (induction \s) + case Nil + then show ?case + by (simp add: \_gt0) +next + case (Cons \ \s) + then have "Ord \" + by auto + have "\_sum \s < \\\ * \" + using Cons by force + then have "\\\ + \_sum \s < \\\ + \\\ * \" + using Cons.prems add_right_strict_mono oexp_mono_le by auto + also have "\ = \\\ * \" + by (metis Kirby.add_mult_distrib mult.right_neutral one_plus_\_equals_\) + finally show ?case + by simp +qed + + +lemma \_sum_nf_unique_aux: + assumes "Ord \" + and \sON: "List.set \s \ ON" + and \sON: "List.set \s \ ON" + and \sdec: "\_dec \s" + and \sdec: "\_dec \s" + and \seq: "\ = \_sum \s" + and \seq: "\ = \_sum \s" + shows "\s = \s" + using assms +proof (induction \ arbitrary: \s \s rule: Ord_induct) + case (step \) + show ?case + proof (cases "\ = 0") + case True + then show ?thesis + using step.prems by (metis \_sum_0E) + next + case False + then obtain \0 \s' \0 \s' where \s: "\s = \0 # \s'" and \s: "\s = \0 # \s'" + by (metis \_sum.elims step.prems(5,6)) + then have ON: "Ord \0" "list.set \s' \ ON" "Ord \0" "list.set \s' \ ON" + using \s \s step.prems(1,2) by auto + have False if "\0 < \0" + proof - + have Ordc: "Ord (\_sum \s)" "Ord (\\\0)" + using Ord_oexp \Ord \0\ step.hyps step.prems(6) by blast+ + have "\_sum \s < \\\0 * \" + by (rule \_sum_less_\_power) (use \s step.prems ON in auto) + also have "\ \ \\\0" + using ON by (metis Ord_\ Ord_succ oexp_mono_le oexp_succ omega_nonzero succ_le_iff that) + finally show False + using \s leD step.prems(5,6) by auto + qed + moreover + have False if "\0 < \0" + proof - + have Ordc: "Ord (\_sum \s)" "Ord (\\\0)" + using Ord_oexp \Ord \0\ step.hyps step.prems(5) by blast+ + have "\_sum \s < \\\0 * \" + by (rule \_sum_less_\_power) (use \s step.prems ON in auto) + also have "\ \ \\\0" + using ON by (metis Ord_\ Ord_succ oexp_mono_le oexp_succ omega_nonzero succ_le_iff that) + finally show False + using \s leD step.prems(5,6) + by (simp add: \\ = \_sum \s\ leD) + qed + ultimately have \: "\0 = \0" + using Ord_linear_lt \Ord \0\ \Ord \0\ by blast + moreover have "\s' = \s'" + proof (rule step.IH) + show "\_sum \s' \ elts \" + using step.prems \s + by (simp add: Ord_mem_iff_lt \_sum_less_self) + show "\_dec \s'" "\_dec \s'" + using \s \s step.prems(3,4) by auto + have "\_sum \s = \_sum \s" + using step.prems(5,6) by auto + then show "\_sum \s' = \_sum \s'" + by (simp add: \ \s \s) + qed (use ON in auto) + ultimately show ?thesis + by (simp add: \s \s) + qed +qed + + +subsection \Indecomposable ordinals\ + +text \Cf exercise 5 on page 43 of Kunen\ + +definition indecomposable + where "indecomposable \ \ Ord \ \ (\\ \ elts \. \\ \ elts \. \+\ \ elts \)" + +lemma indecomposableD: + "\indecomposable \; \ < \; \ < \; Ord \; Ord \\ \ \+\ < \" + by (meson Ord_mem_iff_lt OrdmemD indecomposable_def) + +lemma indecomposable_imp_Ord: + "indecomposable \ \ Ord \" + using indecomposable_def by blast + +lemma indecomposable_1: "indecomposable 1" + by (auto simp: indecomposable_def) + +lemma indecomposable_0: "indecomposable 0" + by (auto simp: indecomposable_def) + +lemma indecomposable_succ [simp]: "indecomposable (succ \) \ \ = 0" + using not_add_mem_right + apply (auto simp: indecomposable_def) + apply (metis add_right_cancel add.right_neutral) + done + +lemma indecomposable_alt: + assumes ord: "Ord \" "Ord \" and \: "\ < \" and minor: "\\ \. \\ < \; \ < \; Ord \\ \ \+\ < \" + shows "\+\ = \" +proof - + have "\ \+\ < \" + by (simp add: add_le_left ord leD) + moreover have "\ \ < \+\" + by (metis assms le_Ord_diff less_V_def) + ultimately show ?thesis + by (simp add: add_le_left less_V_def ord) +qed + +lemma indecomposable_imp_eq: + assumes "indecomposable \" "Ord \" "\ < \" + shows "\+\ = \" + by (metis assms indecomposableD indecomposable_def le_Ord_diff less_V_def less_irrefl) + +lemma indecomposable2: + assumes y: "y < x" and z: "z < x" and minor: "\y::V. y < x \ y+x = x" + shows "y+z < x" + by (metis add_less_cancel_left y z minor) + +lemma indecomposable_imp_Limit: + assumes indec: "indecomposable \" and "\ > 1" + shows "Limit \" + using indecomposable_imp_Ord [OF indec] +proof (cases rule: Ord_cases) + case (succ \) + then show ?thesis + using assms one_V_def by auto +qed (use assms in auto) + +lemma eq_imp_indecomposable: + assumes "Ord \" "\\::V. \ \ elts \ \ \+\ = \" + shows "indecomposable \" + by (metis add_mem_right_cancel assms indecomposable_def) + +lemma indecomposable_\_power: + assumes "Ord \" + shows "indecomposable (\\\)" + unfolding indecomposable_def +proof (intro conjI ballI) + show "Ord (\\\)" + by (simp add: \Ord \\) +next + fix \ \ + assume asm: "\ \ elts (\\\)" "\ \ elts (\\\)" + then obtain ord: "Ord \" "Ord \" and \: "\ < \\\" and \: "\ < \\\" + by (meson Ord_\ Ord_in_Ord Ord_oexp OrdmemD \Ord \\) + show "\ + \ \ elts (\\\)" + using \Ord \\ + proof (cases \ rule: Ord_cases) + case 0 + then show ?thesis + using \Ord \\ asm by auto + next + case (succ l) + have "\x\elts \. \ + \ \ elts (\\l * x)" + if x: "x \ elts \" "\ \ elts (\\l * x)" and y: "y \ elts \" "\ \ elts (\\l * y)" + for x y + proof - + obtain "Ord x" "Ord y" "Ord (\\l * x)" "Ord (\\l * y)" + using Ord_\ Ord_mult Ord_oexp x y nat_into_Ord succ(1) by presburger + then have "\ + \ \ elts (\\l * (x+y))" + using add_mult_distrib Ord_add Ord_mem_iff_lt add_strict_mono ord x y by presburger + then show ?thesis + using x y by blast + qed + then show ?thesis + using \Ord \\ succ ord \ \ by (auto simp: mult_Limit simp flip: Ord_mem_iff_lt) + next + case limit + have "Ord (\\\)" + by (simp add: \Ord \\) + then obtain x y where x: "x \ elts \" "Ord x" "\ \ elts (\\x)" + and y: "y \ elts \" "Ord y" "\ \ elts (\\y)" + using \Ord \\ limit ord \ \ oexp_Limit + by (auto simp flip: Ord_mem_iff_lt intro: Ord_in_Ord) + then have "succ (x \ y) \ elts \" + by (metis Limit_def Ord_linear_le limit sup.absorb2 sup.orderE) + moreover have "\ + \ \ elts (\\succ (x \ y))" + proof - + have oxy: "Ord (x \ y)" + using Ord_sup x y by blast + then obtain "\\x \ \\(x \ y)" "\\y \ \\(x \ y)" + by (metis Ord_\ Ord_linear_le Ord_mem_iff_less_TC Ord_mem_iff_lt le_TC_def less_le_not_le oexp_mono omega_nonzero sup.absorb2 sup.orderE x(2) y(2)) + then have "\ \ elts (\\(x \ y))" "\ \ elts (\\(x \ y))" + using x y by blast+ + then have "\ + \ \ elts (\\(x \ y) * succ (succ 0))" + by (metis Ord_\ Ord_add Ord_mem_iff_lt Ord_oexp Ord_sup add_strict_mono mult.right_neutral mult_succ ord one_V_def x(2) y(2)) + then show ?thesis + apply (simp add: oxy) + using Ord_\ Ord_mult Ord_oexp Ord_trans mem_0_Ord mult_add_mem_0 oexp_eq_0_iff omega_nonzero oxy succ_in_omega by presburger + qed + ultimately show ?thesis + using ord \Ord (\\\)\ limit oexp_Limit by auto + qed +qed + +lemma \_power_imp_eq: + assumes "\ < \\\" "Ord \" "Ord \" "\ \ 0" + shows "\ + \\\ = \\\" + by (simp add: assms indecomposable_\_power indecomposable_imp_eq) + +lemma type_imp_indecomposable: + assumes \: "Ord \" + and minor: "\X. X \ elts \ \ ordertype X VWF = \ \ ordertype (elts \ - X) VWF = \" + shows "indecomposable \" + unfolding indecomposable_def +proof (intro conjI ballI) + fix \ \ + assume \: "\ \ elts \" and \: "\ \ elts \" + then obtain \\: "elts \ \ elts \" "elts \ \ elts \" "Ord \" "Ord \" + using \ Ord_in_Ord Ord_trans by blast + then have oeq: "ordertype (elts \) VWF = \" + by auto + show "\ + \ \ elts \" + proof (rule ccontr) + assume "\ + \ \ elts \" + then obtain \ where \: "Ord \" "\ + \ = \" + by (metis Ord_ordertype \\(1) le_Ord_diff less_eq_V_def minor oeq) + then have "\ \ elts \" + using Ord_linear \\ \ \\ + \ \ elts \\ by blast + then have "ordertype (elts \ - elts \) VWF = \" + using \ ordertype_diff Limit_def \ \Ord \\ by blast + then show False + by (metis \ \\ \ elts \\ \elts \ \ elts \\ oeq mem_not_refl minor) + qed +qed (use assms in auto) + + +text \This proof uses Cantor normal form_split, yet still is rather long\ +proposition indecomposable_is_\_power: + assumes inc: "indecomposable \" + obtains "\ = 0" | \ where "Ord \" "\ = \\\" +proof (cases "\ = 0") + case True + then show thesis + by (simp add: that) +next + case False + obtain "Ord \" + using Limit_def assms indecomposable_def by blast + then obtain \s ms where Cantor: "List.set \s \ ON" "list.set ms \ {0<..}" + "length \s = length ms" "Cantor_dec \s" + and \: "\ = Cantor_sum \s ms" + using Cantor_nf_exists by blast + consider (0) "length \s = 0" | (1) "length \s = 1" | (2) "length \s \ 2" + by linarith + then show thesis + proof cases + case 0 + then show ?thesis + using \ assms False indecomposable_def by auto + next + case 1 + then obtain \ m where \m: "\s = [\]" "ms = [m]" + by (metis One_nat_def \length \s = length ms\ length_0_conv length_Suc_conv) + then obtain "Ord \" "m \ 0" "Ord (\\\)" + using \list.set \s \ ON\ \list.set ms \ {0<..}\ by auto + have \: "\ = \\\ * ord_of_nat m" + using \m by (simp add: \) + moreover have "m = 1" + proof (rule ccontr) + assume "m \ 1" + then have 2: "m \ 2" + using \m \ 0\ by linarith + then have "m = Suc 0 + Suc 0 + (m-2)" + by simp + then have "ord_of_nat m = 1 + 1 + ord_of_nat (m-2)" + by (metis add.left_neutral mult.left_neutral mult_succ ord_of_nat.simps ord_of_nat_add) + then have \eq: "\ = \\\ + \\\ + \\\ * ord_of_nat (m-2)" + using \ by (simp add: add_mult_distrib) + moreover have less: "\\\ < \" + by (metis Ord_\ OrdmemD \eq \Ord \\ add_le_cancel_left0 add_less_cancel_left0 le_less_trans less_V_def oexp_gt_0_iff zero_in_omega) + moreover have "\\\ + \\\ * ord_of_nat (m-2) < \" + using "2" "\" \Ord \\ assms less indecomposableD less_V_def by auto + ultimately show False + using indecomposableD [OF inc, of "\\\" "\\\ + \\\ * ord_of_nat (m-2)"] + by (simp add: \Ord (\\\)\ add.assoc) + qed + moreover have "Ord \" + using \List.set \s \ ON\ by (simp add: \\s = [\]\) + ultimately show ?thesis + by (metis One_nat_def mult.right_neutral ord_of_nat.simps one_V_def that(2)) + next + case 2 + then obtain \1 \2 \s' m1 m2 ms' where \m: "\s = \1#\2#\s'" "ms = m1#m2#ms'" + by (metis Cantor(3) One_nat_def Suc_1 impossible_Cons length_Cons list.size(3) not_numeral_le_zero remdups_adj.cases) + then obtain "Ord \1" "Ord \2" "m1 \ 0" "m2 \ 0" "Ord (\\\1)" "Ord (\\\2)" + "list.set \s' \ ON" "list.set ms' \ {0<..}" + using \list.set \s \ ON\ \list.set ms \ {0<..}\ by auto + have oCs: "Ord (Cantor_sum \s' ms')" + by (simp add: Ord_Cantor_sum \list.set \s' \ ON\) + have \21: "\2 \ elts \1" + using Cantor_dec_Cons_iff \m(1) \Cantor_dec \s\ + by (simp add: Ord_mem_iff_lt \Ord \1\ \Ord \2\) + have "\\\2 \ 0" + by (simp add: \Ord \2\) + then have *: "(\\\2 * ord_of_nat m2 + Cantor_sum \s' ms') > 0" + by (simp add: OrdmemD \Ord (\\\2)\ \m2 \ 0\ mem_0_Ord oCs) + have \: "\ = \\\1 * ord_of_nat m1 + (\\\2 * ord_of_nat m2 + Cantor_sum \s' ms')" + (is "\ = ?\ + ?\") + using \m by (simp add: \) + moreover + have "\\\2 * ord_of_nat m2 + Cantor_sum \s' ms' < \\\1 * ord_of_nat m1 + (\\\2 * ord_of_nat m2 + Cantor_sum \s' ms')" + if "\2 \ elts \1" + proof (rule less_\_power) + show "Cantor_sum \s' ms' < \\\2" + using \m Cantor cnf_2 by auto + qed (use oCs \Ord \1\ \m1 \ 0\ \m2 \ 0\ that in auto) + then have "?\ < \" + using \21 by (simp add: \ \m) + moreover have less: "?\ < \" + using oCs by (metis \ "*" add_less_cancel_left add.right_neutral) + ultimately have False + using indecomposableD [OF inc, of "?\" "?\"] + by (simp add: \Ord (\\\1)\ \Ord (\\\2)\ oCs) + then show ?thesis .. + qed +qed + +corollary indecomposable_iff_\_power: + "indecomposable \ \ \ = 0 \ (\\. \ = \\\ \ Ord \)" + by (meson indecomposable_0 indecomposable_\_power indecomposable_is_\_power) + +theorem indecomposable_imp_type: + fixes X :: "bool \ V set" + assumes \: "indecomposable \" + and "\b. ordertype (X b) VWF \ \" "\b. small (X b)" "\b. X b \ ON" + and "elts \ \ (UN b. X b)" + shows "\b. ordertype (X b) VWF = \" + using \ [THEN indecomposable_imp_Ord] assms +proof (induction arbitrary: X) + case (succ \) + show ?case + proof (cases "\ = 0") + case True + then have "\b. 0 \ X b" + using succ.prems(5) by blast + then have "\b. ordertype (X b) VWF \ 0" + using succ.prems(3) by auto + then have "\b. ordertype (X b) VWF \ succ 0" + by (meson Ord_0 Ord_linear2 Ord_ordertype less_eq_V_0_iff succ_le_iff) + then show ?thesis + using True succ.prems(2) by blast + next + case False + then show ?thesis + using succ.prems by auto + qed +next + case (Limit \) + then obtain \ where \: "\ = \\\" and "\ \ 0" "Ord \" + by (metis Limit_eq_Sup_self image_ident indecomposable_is_\_power not_succ_Limit oexp_0_right one_V_def zero_not_Limit) + show ?case + proof (cases "Limit \") + case True + have ot: "\b. ordertype (X b \ elts (\\\)) VWF = \\\" + if "\ \ elts \" for \ + proof (rule Limit.IH) + have "Ord \" + using Ord_in_Ord \Ord \\ that by blast + then show "\\\ \ elts \" + by (simp add: Ord_mem_iff_lt \ \_gt1 \Ord \\ oexp_less that) + show "indecomposable (\\\)" + using \Ord \\ indecomposable_1 indecomposable_\_power by fastforce + show "small (X b \ elts (\\\))" for b + by (meson down inf_le2) + show "ordertype (X b \ elts (\ \ \)) VWF \ \ \ \" for b + by (simp add: \Ord \\ ordertype_le_Ord) + show "X b \ elts (\ \ \) \ ON" for b + by (simp add: Limit.prems inf.coboundedI1) + show "elts (\ \ \) \ (\b. X b \ elts (\ \ \))" + using Limit.prems Limit.hyps \\ \ \ \ elts \\ + by clarsimp (metis Ord_trans UN_E indecomposable_imp_Ord subset_eq) + qed + define A where "A \ \b. {\ \ elts \. ordertype (X b \ elts (\\\)) VWF \ \\\}" + have Asmall: "small (A b)" for b + by (simp add: A_def) + have AON: "A b \ ON" for b + using A_def \Ord \\ elts_subset_ON by blast + have eq: "elts \ = (\ b. A b)" + by (auto simp: A_def) (metis ot eq_refl) + then obtain b where b: "Sup (A b) = \" + using \Limit \\ + apply (auto simp: UN_bool_eq) + by (metis AON ON_imp_Ord Ord_Sup Ord_linear_le Limit_eq_Sup_self Sup_Un_distrib Asmall sup.absorb2 sup.orderE) + have "\\\ \ ordertype (X b) VWF" if "\ \ A b" for \ + proof - + have "(\\\) = ordertype ((X b) \ elts (\\\)) VWF" + using \Ord \\ that by (simp add: A_def Ord_in_Ord dual_order.antisym ordertype_le_Ord) + also have "\ \ ordertype (X b) VWF" + by (simp add: Limit.prems ordertype_VWF_mono) + finally show ?thesis . + qed + then have "ordertype (X b) VWF \ Sup ((\\. \\\) ` A b)" + by blast + moreover have "Sup ((\\. \\\) ` A b) = \ \ Sup (A b)" + by (metis b Ord_\ ZFC_in_HOL.Sup_empty AON \\ \ 0\ Asmall oexp_Sup omega_nonzero) + ultimately show ?thesis + using Limit.hyps Limit.prems \ b by auto + next + case False + then obtain \ where \: "\ = succ \" "Ord \" + using Ord_cases \\ \ 0\ \Ord \\ by auto + then have Ord\\: "Ord (\\\)" + using Ord_oexp by blast + have subX12: "elts (\\\ * \) \ (\b. X b)" + using Limit \ \ by auto + define E where "E \ \n. {\\\ * ord_of_nat n ..< \\\ * ord_of_nat (Suc n)} \ ON" + have EON: "E n \ ON" for n + using E_def by blast + have E_imp_less: "x < y" if "i < j" "x \ E i" "y \ E j" for x y i j + proof - + have "succ (i) \ ord_of_nat j" + using that(1) by force + then have "\ y \ x" + using that + apply (auto simp: E_def) + by (metis Ord\\ Ord_ord_of_nat leD mult_cancel_le_iff ord_of_nat.simps(2) order_trans) + with that show ?thesis + by (meson EON ON_imp_Ord Ord_linear2) + qed + then have djE: "disjnt (E i) (E j)" if "i \ j" for i j + using that nat_neq_iff unfolding disjnt_def by auto + have less_imp_E: "i \ j" if "x < y" "x \ E i" "y \ E j" for x y i j + using that E_imp_less [OF _ \y \ E j\ \x \ E i\] leI less_asym by blast + have inc: "indecomposable (\\\)" + using \ indecomposable_1 indecomposable_\_power by fastforce + have in_En: "\\\ * ord_of_nat n + x \ E n" if "x \ elts (\\\)" for x n + using that Ord\\ Ord_in_Ord [OF Ord\\] by (auto simp: E_def Ord\\ OrdmemD mult_succ) + have *: "elts \ = \(range E)" + proof + have "\m. \\\ * m \ x \ x < \\\ * succ (ord_of_nat m)" + if "x \ elts (\\\ * ord_of_nat n)" for x n + using that + apply (clarsimp simp add: mult [of _ "ord_of_nat n"] lift_def) + by (metis add_less_cancel_left OrdmemD inc indecomposable_imp_Ord mult_succ plus sup_ge1) + moreover have "Ord x" if "x \ elts (\\\ * ord_of_nat n)" for x n + by (meson Ord\\ Ord_in_Ord Ord_mult Ord_ord_of_nat that) + ultimately show "elts \ \ \(range E)" + by (auto simp: \ \ E_def mult_Limit elts_\) + have "x \ elts (\\\ * succ(ord_of_nat n))" + if "Ord x" "x < \\\ * succ (n)" for x n + by (metis that Ord_mem_iff_lt Ord_mult Ord_ord_of_nat inc indecomposable_imp_Ord ord_of_nat.simps(2)) + then show "\(range E) \ elts \" + by (force simp: \ \ E_def Limit.prems mult_Limit) + qed + have smE: "small (E n)" for n + by (metis "*" complete_lattice_class.Sup_upper down rangeI) + have otE: "ordertype (E n) VWF = \\\" for n + by (simp add: E_def inc indecomposable_imp_Ord mult_succ ordertype_interval_eq) + + define cut where "cut \ \n x. odiff x (\\\ * ord_of_nat n)" + have cutON: "cut n ` X \ ON" if "X \ ON" for n X + using that by (simp add: image_subset_iff cut_def ON_imp_Ord Ord\\ Ord_odiff) + have cut [simp]: "cut n (\ \ \ * ord_of_nat n + x) = x" for x n + by (auto simp: cut_def) + have cuteq: "x \ cut n ` (X \ E n) \ \\\ * ord_of_nat n + x \ X" + if x: "x \ elts (\\\)" for x X n + proof + show "\\\ * ord_of_nat n + x \ X" if "x \ cut n ` (X \ E n)" + using E_def Ord\\ Ord_odiff_eq image_iff local.cut_def that by auto + show "x \ cut n ` (X \ E n)" + if "\\\ * ord_of_nat n + x \ X" + by (metis (full_types) IntI cut image_iff in_En that x) + qed + have ot_cuteq: "ordertype (cut n ` (X \ E n)) VWF = ordertype (X \ E n) VWF" for n X + proof (rule ordertype_VWF_inc_eq) + show "X \ E n \ ON" + using E_def by blast + then show "cut n ` (X \ E n) \ ON" + by (simp add: cutON) + show "small (X \ E n)" + by (meson Int_lower2 smE smaller_than_small) + show "cut n x < cut n y" + if "x \ X \ E n" "y \ X \ E n" "x < y" for x y + using that \X \ E n \ ON\ by(simp add: E_def Ord\\ Ord_odiff_less_odiff local.cut_def) + qed + + define N where "N \ \b. {n. ordertype (X b \ E n) VWF = \\\}" + have "\b. infinite (N b)" + proof (rule ccontr) + assume "\b. infinite (N b)" + then obtain n where "\b. n \ N b" + apply (simp add: ex_bool_eq) + by (metis (full_types) finite_nat_set_iff_bounded not_less_iff_gr_or_eq) + moreover + have "\b. ordertype (cut n ` (X b \ E n)) VWF = \\\" + proof (rule Limit.IH) + show "\\\ \ elts \" + by (metis Limit.hyps Limit_def Limit_omega Ord_mem_iff_less_TC \ \ mult_le2 not_succ_Limit oexp_succ omega_nonzero one_V_def) + show "indecomposable (\\\)" + by (simp add: inc) + show "ordertype (cut n ` (X b \ E n)) VWF \ \\\" for b + by (metis "otE" inf_le2 ordertype_VWF_mono ot_cuteq smE) + show "small (cut n ` (X b \ E n))" for b + using smE subset_iff_less_eq_V + by (meson inf_le2 replacement) + show "cut n ` (X b \ E n) \ ON" for b + using E_def cutON by auto + have "elts (\\\ * succ n) \ \(range X)" + by (metis Ord\\ Ord_\ Ord_ord_of_nat less_eq_V_def mult_cancel_le_iff ord_of_nat.simps(2) ord_of_nat_le_omega order_trans subX12) + then show "elts (\\\) \ (\b. cut n ` (X b \ E n))" + by (auto simp: mult_succ mult_Limit UN_subset_iff cuteq UN_bool_eq) + qed + then have "\b. ordertype (X b \ E n) VWF = \\\" + by (simp add: ot_cuteq) + ultimately show False + by (simp add: N_def) + qed + then obtain b where b: "infinite (N b)" + by blast + then obtain \ :: "nat \ nat" where \: "bij_betw \ UNIV (N b)" and mono: "strict_mono \" + by (meson bij_enumerate enumerate_mono strict_mono_def) + then have "ordertype (X b \ E (\ n)) VWF = \\\" for n + using N_def bij_betw_imp_surj_on by blast + moreover have "small (X b \ E (\ n))" for n + by (meson inf_le2 smE subset_iff_less_eq_V) + ultimately have "\f. bij_betw f (X b \ E (\ n)) (elts (\\\)) \ (\x \ X b \ E (\ n). \y \ X b \ E (\ n). f x < f y \ (x,y) \ VWF)" + for n by (metis Ord_ordertype ordertype_VWF_eq_iff) + then obtain F where bijF: "\n. bij_betw (F n) (X b \ E (\ n)) (elts (\\\))" + and F: "\n. \x \ X b \ E (\ n). \y \ X b \ E (\ n). F n x < F n y \ (x,y) \ VWF" + by metis + then have F_bound: "\n. \x \ X b \ E (\ n). F n x < \\\" + by (metis Ord_\ Ord_oexp OrdmemD \(2) bij_betw_imp_surj_on image_eqI) + have F_Ord: "\n. \x \ X b \ E (\ n). Ord (F n x)" + by (metis otE ON_imp_Ord Ord_ordertype bijF bij_betw_def elts_subset_ON imageI) + + have inc: "\ n \ n" for n + by (simp add: mono strict_mono_imp_increasing) + + have dj\: "disjnt (E (\ i)) (E (\ j))" if "i \ j" for i j + by (rule djE) (use \ that in \auto simp: bij_betw_def inj_def\) + define Y where "Y \ (\n. E (\ n))" + have "\n. y \ E (\ n)" if "y \ Y" for y + using Y_def that by blast + then obtain \ where \: "\y. y \ Y \ y \ E (\ (\ y))" + by metis + have "Y \ ON" + by (auto simp: Y_def E_def) + have \le: "\ x \ \ y" if "x < y" "x \ Y" "y \ Y" for x y + using less_imp_E strict_mono_less_eq that \ [OF \x \ Y\] \ [OF \y \ Y\] mono + unfolding Y_def by blast + have eq\: "x \ E (\ k) \ \ x = k" for x k + using \ unfolding Y_def + by (meson UN_I disjnt_iff dj\ iso_tuple_UNIV_I) + + have upper: "\\\ * ord_of_nat (\ x) \ x" if "x \ Y" for x + using that + proof (clarsimp simp add: Y_def eq\) + fix u v + assume u: "u \ elts (\\\ * ord_of_nat v)" and v: "x \ E (\ v)" + then have "u < \\\ * ord_of_nat v" + by (simp add: OrdmemD \(2)) + also have "\ \ \\\ * ord_of_nat (\ v)" + by (simp add: \(2) inc) + also have "\ \ x" + using v by (simp add: E_def) + finally show "u \ elts x" + using \Y \ ON\ + by (meson ON_imp_Ord Ord_\ Ord_in_Ord Ord_mem_iff_lt Ord_mult Ord_oexp Ord_ord_of_nat \(2) that u) + qed + + define G where "G \ \x. \\\ * ord_of_nat (\ x) + F (\ x) x" + have G_strict_mono: "G x < G y" if "x < y" "x \ X b \ Y" "y \ X b \ Y" for x y + proof (cases "\ x = \ y") + case True + then show ?thesis + using that unfolding G_def + by (metis F Int_iff add_less_cancel_left Limit.prems(4) ON_imp_Ord VWF_iff_Ord_less \) + next + case False + then have "\ x < \ y" + by (meson IntE \le le_less that) + then show ?thesis + using that by (simp add: G_def F_Ord F_bound Ord\\ \ mult_nat_less_add_less) + qed + + have "ordertype (X b \ Y) VWF = (\\\) * \" + proof (rule ordertype_VWF_eq_iff [THEN iffD2]) + show "Ord (\\\ * \)" + by (simp add: \) + show "small (X b \ Y)" + by (meson Limit.prems(3) inf_le1 subset_iff_less_eq_V) + have "bij_betw G (X b \ Y) (elts (\\\ * \))" + proof (rule bij_betw_imageI) + show "inj_on G (X b \ Y)" + proof (rule linorder_inj_onI) + fix x y + assume xy: "x < y" "x \ (X b \ Y)" "y \ (X b \ Y)" + show "G x \ G y" + using G_strict_mono xy by force + next + show "x \ y \ y \ x" + if "x \ (X b \ Y)" "y \ (X b \ Y)" for x y + using that \X b \ ON\ by (clarsimp simp: Y_def) (metis ON_imp_Ord Ord_linear Ord_trans) + qed + show "G ` (X b \ Y) = elts (\\\ * \)" + proof + show "G ` (X b \ Y) \ elts (\\\ * \)" + using \X b \ ON\ + apply (clarsimp simp: G_def mult_Limit Y_def eq\) + by (metis IntI add_mem_right_cancel bijF bij_betw_imp_surj_on image_eqI mult_succ ord_of_nat_\ succ_in_omega) + show "elts (\\\ * \) \ G ` (X b \ Y)" + proof + fix x + assume x: "x \ elts (\\\ * \)" + then obtain k where n: "x \ elts (\\\ * ord_of_nat (Suc k))" + and minim: "\m. m < Suc k \ x \ elts (\\\ * ord_of_nat m)" + using elts_mult_\E + by (metis old.nat.exhaust) + then obtain y where y: "y \ elts (\\\)" and xeq: "x = \\\ * ord_of_nat k + y" + using x by (auto simp: mult_succ elim: mem_plus_V_E) + then have 1: "inv_into (X b \ E (\ k)) (F k) y \ (X b \ E (\ k))" + by (metis bijF bij_betw_def inv_into_into) + then have "(inv_into (X b \ E (\ k)) (F k) y) \ X b \ Y" + by (force simp: Y_def) + moreover have "G (inv_into (X b \ E (\ k)) (F k) y) = x" + by (metis "1" G_def Int_iff bijF bij_betw_inv_into_right eq\ xeq y) + ultimately show "x \ G ` (X b \ Y)" + by blast + qed + qed + qed + moreover have "(x,y) \ VWF" + if "x \ X b" "x \ Y" "y \ X b" "y \ Y" "G x < G y" for x y + proof - + have "x < y" + using that by (metis G_strict_mono Int_iff Limit.prems(4) ON_imp_Ord Ord_linear_lt less_asym) + then show ?thesis + using ON_imp_Ord \Y \ ON\ that by auto + qed + moreover have "G x < G y" + if "x \ X b" "x \ Y" "y \ X b" "y \ Y" "(x, y) \ VWF" for x y + proof - + have "x < y" + using that ON_imp_Ord \Y \ ON\ by auto + then show ?thesis + by (simp add: G_strict_mono that) + qed + ultimately show "\f. bij_betw f (X b \ Y) (elts (\\\ * \)) \ (\x\(X b \ Y). \y\(X b \ Y). f x < f y \ ((x, y) \ VWF))" + by blast + qed + moreover have "ordertype (\n. X b \ E (\ n)) VWF \ ordertype (X b) VWF" + using Limit.prems(3) ordertype_VWF_mono by auto + ultimately have "ordertype (X b) VWF = (\\\) * \" + using Limit.hyps Limit.prems(2) \ \ + using Y_def by auto + then show ?thesis + using Limit.hyps \ \ by auto + qed +qed auto + +corollary indecomposable_imp_type2: + assumes \: "indecomposable \" "X \ elts \" + shows "ordertype X VWF = \ \ ordertype (elts \ - X) VWF = \" +proof - + have "Ord \" + using assms indecomposable_imp_Ord by blast + have "\b. ordertype (if b then X else elts \ - X) VWF = \" + proof (rule indecomposable_imp_type) + show "ordertype (if b then X else elts \ - X) VWF \ \" for b + by (simp add: \Ord \\ assms ordertype_le_Ord) + show "(if b then X else elts \ - X) \ ON" for b + using \Ord \\ assms elts_subset_ON by auto + qed (use assms down in auto) + then show ?thesis + by (metis (full_types)) +qed + +subsection \From ordinals to order types\ + +lemma indecomposable_ordertype_eq: + assumes indec: "indecomposable \" and \: "ordertype A VWF = \" and A: "B \ A" "small A" + shows "ordertype B VWF = \ \ ordertype (A-B) VWF = \" +proof (rule ccontr) + assume "\ (ordertype B VWF = \ \ ordertype (A - B) VWF = \)" + moreover have "ordertype (ordermap A VWF ` B) VWF = ordertype B VWF" + using \B \ A\ by (auto intro: ordertype_image_ordermap [OF \small A\]) + moreover have "ordertype (elts \ - ordermap A VWF ` B) VWF = ordertype (A - B) VWF" + by (metis ordertype_map_image \ A elts_of_set ordertype_def replacement) + moreover have "ordermap A VWF ` B \ elts \" + using \ A by blast + ultimately show False + using indecomposable_imp_type2 [OF \indecomposable \\] \small A\ by metis +qed + +lemma indecomposable_ordertype_ge: + assumes indec: "indecomposable \" and \: "ordertype A VWF \ \" and small: "small A" "small B" + shows "ordertype B VWF \ \ \ ordertype (A-B) VWF \ \" +proof - + obtain A' where "A' \ A" "ordertype A' VWF = \" + by (meson \ \small A\ indec indecomposable_def le_ordertype_obtains_subset) + then have "ordertype (B \ A') VWF = \ \ ordertype (A'-B) VWF = \" + by (metis Diff_Diff_Int Diff_subset Int_commute \small A\ indecomposable_ordertype_eq indec smaller_than_small) + moreover have "ordertype (B \ A') VWF \ ordertype B VWF" + by (meson Int_lower1 small ordertype_VWF_mono smaller_than_small) + moreover have "ordertype (A'-B) VWF \ ordertype (A-B) VWF" + by (meson Diff_mono Diff_subset \A' \ A\ \small A\ order_refl ordertype_VWF_mono smaller_than_small) + ultimately show ?thesis + by blast +qed + +text \now for finite partitions\ +lemma indecomposable_ordertype_finite_eq: + assumes "indecomposable \" + and \: "finite \" "pairwise disjnt \" "\\ = A" "\ \ {}" "ordertype A VWF = \" "small A" + shows "\X \ \. ordertype X VWF = \" + using \ +proof (induction arbitrary: A) + case (insert X \) + show ?case + proof (cases "\ = {}") + case True + then show ?thesis + using insert.prems by blast + next + case False + have smA: "small (\\)" + using insert.prems by auto + show ?thesis + proof (cases "\X \ \. ordertype X VWF = \") + case True + then show ?thesis + using insert.prems by blast + next + case False + have "X = A - \\" + using insert.hyps insert.prems by (auto simp: pairwise_insert disjnt_iff) + then have "ordertype X VWF = \" + using indecomposable_ordertype_eq assms insert False + by (metis Union_mono cSup_singleton pairwise_insert smA subset_insertI) + then show ?thesis + using insert.prems by blast + qed + qed +qed auto + +lemma indecomposable_ordertype_finite_ge: + assumes indec: "indecomposable \" + and \: "finite \" "A \ \\" "\ \ {}" "ordertype A VWF \ \" "small (\\)" + shows "\X \ \. ordertype X VWF \ \" + using \ +proof (induction arbitrary: A) + case (insert X \) + show ?case + proof (cases "\ = {}") + case True + then have "\ \ ordertype X VWF" + using insert.prems + by (simp add: order.trans ordertype_VWF_mono) + then show ?thesis + using insert.prems by blast + next + case False + show ?thesis + proof (cases "\X \ \. ordertype X VWF \ \") + case True + then show ?thesis + using insert.prems by blast + next + case False + moreover have "small (X \ \\)" + using insert.prems by auto + moreover have "ordertype (\(insert X \)) VWF \ \" + using insert.prems ordertype_VWF_mono by blast + ultimately have "ordertype X VWF \ \" + using indecomposable_ordertype_ge [OF indec] + by (metis Diff_subset_conv Sup_insert cSup_singleton insert.IH small_sup_iff subset_refl) + then show ?thesis + using insert.prems by blast + qed + qed +qed auto + +end diff --git a/thys/ZFC_in_HOL/ROOT b/thys/ZFC_in_HOL/ROOT --- a/thys/ZFC_in_HOL/ROOT +++ b/thys/ZFC_in_HOL/ROOT @@ -1,13 +1,13 @@ chapter AFP session ZFC_in_HOL (AFP) = HOL + options [timeout = 600] sessions "HOL-Library" "HOL-Cardinals" theories - Ordinal_Exp + Cantor_NF ZFC_Typeclasses document_files "root.tex" "root.bib" diff --git a/thys/ZFC_in_HOL/document/root.tex b/thys/ZFC_in_HOL/document/root.tex --- a/thys/ZFC_in_HOL/document/root.tex +++ b/thys/ZFC_in_HOL/document/root.tex @@ -1,61 +1,61 @@ \documentclass[11pt,a4paper]{article} \usepackage{isabelle,isabellesym} \usepackage{amssymb} \usepackage{stmaryrd} % this should be the last package used \usepackage{pdfsetup} % urls in roman style, theory text in math-similar italics \urlstyle{rm} \isabellestyle{it} % for uniform font size %\renewcommand{\isastyle}{\isastyleminor} \begin{document} \title{Zermelo Fraenkel Set Theory in Higher-Order Logic} \author{Lawrence C. Paulson\\ Computer Laboratory\\ University of Cambridge} \maketitle \begin{abstract} This entry is a new formalisation of ZFC set theory in Isabelle/HOL\@. It is logically equivalent to Obua's HOLZF~\cite{obua-partizan-games}; the point is to have the closest possible integration with the rest of Isabelle/HOL, minimising the amount of new notations and exploiting type classes. There is a type \isa{V} of sets and a function \isa{elts :: V\ {\isasymRightarrow}\ V\ set} mapping a set to its elements. Classes simply have type \isa{V\ set}, and the predicate \isa{small} identifies those classes that correspond to actual sets. Type classes connected with orders and lattices are used to minimise the amount of new notation for concepts such as the subset relation, union and intersection. -Basic concepts --- Cartesian products, disjoint sums, natural numbers, functions, etc. --- are formalised. +Basic concepts are formalised: Cartesian products, disjoint sums, natural numbers, functions, etc. More advanced set-theoretic concepts, such as transfinite induction, ordinals, cardinals and the transitive closure of a set, are also provided. The definition of addition and multiplication for general sets (not just ordinals) follows Kirby \cite{kirby-addition}. -The development includes essential results about cardinal arithmetic. +The development includes essential results about cardinal arithmetic. It also develops ordinal exponentiation, Cantor normal form and the concept of indecomposable ordinals. There are numerous results about order types. The theory provides two type classes with the aim of facilitating developments that combine \isa{V} with other Isabelle/HOL types: \isa{embeddable}, the class of types that can be injected into~\isa{V} (including \isa{V} itself as well as \isa{V*V}, \isa{V\ list}, etc.), and \isa{small}, the class of types that correspond to some ZF set. \end{abstract} \newpage \tableofcontents % sane default for proof documents \parindent 0pt\parskip 0.5ex % generated text of all theories \newpage \input{session} \bibliographystyle{abbrv} \bibliography{root.bib} \end{document}