# HG changeset patch # User popescua # Date 1369753009 -7200 # Node ID 055c392e79cf830ea50548a9c553a42c321d2b79 # Parent 6324f30e23b6bf69d2fb00748941535124fa241a fixed broken Cardinals and BNF due to Order_Union diff -r 6324f30e23b6 -r 055c392e79cf src/HOL/Cardinals/Constructions_on_Wellorders.thy --- a/src/HOL/Cardinals/Constructions_on_Wellorders.thy Tue May 28 13:22:06 2013 +0200 +++ b/src/HOL/Cardinals/Constructions_on_Wellorders.thy Tue May 28 16:56:49 2013 +0200 @@ -188,376 +188,7 @@ qed qed - -subsection {* Ordinal-like sum of two (disjoint) well-orders *} - -text{* This is roughly obtained by ``concatenating" the two well-orders -- thus, all elements -of the first will be smaller than all elements of the second. This construction -only makes sense if the fields of the two well-order relations are disjoint. *} - -definition Osum :: "'a rel \ 'a rel \ 'a rel" (infix "Osum" 60) -where -"r Osum r' = r \ r' \ {(a,a'). a \ Field r \ a' \ Field r'}" - -abbreviation Osum2 :: "'a rel \ 'a rel \ 'a rel" (infix "\o" 60) -where "r \o r' \ r Osum r'" - -lemma Field_Osum: "Field(r Osum r') = Field r \ Field r'" -unfolding Osum_def Field_def by blast - -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 (* Need first unfold Field_Osum, only then Osum_def *) -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) \ r \o r'" and **: "(y, z) \ r \o r'" - show "(x, z) \ r \o r'" - proof- - {assume Case1: "(x,y) \ r" - hence 1: "x \ Field r \ y \ Field r" unfolding Field_def by auto - have ?thesis - proof- - {assume Case11: "(y,z) \ r" - hence "(x,z) \ r" using Case1 TRANS trans_def[of r] by blast - hence ?thesis unfolding Osum_def by auto - } - moreover - {assume Case12: "(y,z) \ r'" - hence "y \ Field r'" unfolding Field_def by auto - hence False using FLD 1 by auto - } - moreover - {assume Case13: "z \ 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) \ r'" - hence 2: "x \ Field r' \ y \ Field r'" unfolding Field_def by auto - have ?thesis - proof- - {assume Case21: "(y,z) \ r" - hence "y \ Field r" unfolding Field_def by auto - hence False using FLD 2 by auto - } - moreover - {assume Case22: "(y,z) \ r'" - hence "(x,z) \ r'" using Case2 TRANS' trans_def[of r'] by blast - hence ?thesis unfolding Osum_def by auto - } - moreover - {assume Case23: "y \ Field r" - hence False using FLD 2 by auto - } - ultimately show ?thesis using ** unfolding Osum_def by blast - qed - } - moreover - {assume Case3: "x \ Field r \ y \ Field r'" - have ?thesis - proof- - {assume Case31: "(y,z) \ r" - hence "y \ Field r" unfolding Field_def by auto - hence False using FLD Case3 by auto - } - moreover - {assume Case32: "(y,z) \ r'" - hence "z \ Field r'" unfolding Field_def by blast - hence ?thesis unfolding Osum_def using Case3 by auto - } - moreover - {assume Case33: "y \ 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 - -lemma Osum_Preorder: -"\Field r Int Field r' = {}; Preorder r; Preorder r'\ \ 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) \ r \o r'" and **: "(y, x) \ r \o r'" - show "x = y" - proof- - {assume Case1: "(x,y) \ r" - hence 1: "x \ Field r \ y \ Field r" unfolding Field_def by auto - have ?thesis - proof- - have "(y,x) \ r \ ?thesis" - using Case1 AN antisym_def[of r] by blast - moreover - {assume "(y,x) \ r'" - hence "y \ Field r'" unfolding Field_def by auto - hence False using FLD 1 by auto - } - moreover - have "x \ Field r' \ False" using FLD 1 by auto - ultimately show ?thesis using ** unfolding Osum_def by blast - qed - } - moreover - {assume Case2: "(x,y) \ r'" - hence 2: "x \ Field r' \ y \ Field r'" unfolding Field_def by auto - have ?thesis - proof- - {assume "(y,x) \ r" - hence "y \ Field r" unfolding Field_def by auto - hence False using FLD 2 by auto - } - moreover - have "(y,x) \ r' \ ?thesis" - using Case2 AN' antisym_def[of r'] by blast - moreover - {assume "y \ Field r" - hence False using FLD 2 by auto - } - ultimately show ?thesis using ** unfolding Osum_def by blast - qed - } - moreover - {assume Case3: "x \ Field r \ y \ Field r'" - have ?thesis - proof- - {assume "(y,x) \ r" - hence "y \ Field r" unfolding Field_def by auto - hence False using FLD Case3 by auto - } - moreover - {assume Case32: "(y,x) \ r'" - hence "x \ Field r'" unfolding Field_def by blast - hence False using FLD Case3 by auto - } - moreover - have "\ y \ 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 - -lemma Osum_Partial_order: -"\Field r Int Field r' = {}; Partial_order r; Partial_order r'\ \ - Partial_order (r Osum r')" -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 - -lemma Osum_Linear_order: -"\Field r Int Field r' = {}; Linear_order r; Linear_order r'\ \ - Linear_order (r Osum r')" -unfolding linear_order_on_def using Osum_Partial_order Osum_Total 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 -proof(intro allI impI, elim conjE) - fix A assume *: "A \ Field r \ Field r'" and **: "A \ {}" - obtain B where B_def: "B = A Int Field r" by blast - show "\a\A. \a'\A. (a', a) \ r \o r'" - proof(cases "B = {}") - assume Case1: "B \ {}" - hence "B \ {} \ B \ Field r" using B_def by auto - then obtain a where 1: "a \ B" and 2: "\a1 \ B. (a1,a) \ r" - using WF unfolding wf_eq_minimal2 by metis - hence 3: "a \ Field r \ a \ Field r'" using B_def FLD by auto - (* *) - have "\a1 \ A. (a1,a) \ r Osum r'" - proof(intro ballI) - fix a1 assume **: "a1 \ A" - {assume Case11: "a1 \ Field r" - hence "(a1,a) \ r" using B_def ** 2 by auto - moreover - have "(a1,a) \ r'" using 3 by (auto simp add: Field_def) - ultimately have "(a1,a) \ r Osum r'" - using 3 unfolding Osum_def by auto - } - moreover - {assume Case12: "a1 \ Field r" - hence "(a1,a) \ r" unfolding Field_def by auto - moreover - have "(a1,a) \ r'" using 3 unfolding Field_def by auto - ultimately have "(a1,a) \ r Osum r'" - using 3 unfolding Osum_def by auto - } - ultimately show "(a1,a) \ r Osum r'" by blast - qed - thus ?thesis using 1 B_def by auto - next - assume Case2: "B = {}" - hence 1: "A \ {} \ A \ Field r'" using * ** B_def by auto - then obtain a' where 2: "a' \ A" and 3: "\a1' \ A. (a1',a') \ r'" - using WF' unfolding wf_eq_minimal2 by metis - hence 4: "a' \ Field r' \ a' \ Field r" using 1 FLD by blast - (* *) - have "\a1' \ A. (a1',a') \ r Osum r'" - proof(unfold Osum_def, auto simp add: 3) - fix a1' assume "(a1', a') \ r" - thus False using 4 unfolding Field_def by blast - next - fix a1' assume "a1' \ A" and "a1' \ Field r" - thus False using Case2 B_def by auto - qed - thus ?thesis using 2 by blast - qed -qed - -lemma Osum_minus_Id: -assumes TOT: "Total r" and TOT': "Total r'" and - NID: "\ (r \ Id)" and NID': "\ (r' \ Id)" -shows "(r Osum r') - Id \ (r - Id) Osum (r' - Id)" -proof- - {fix a a' assume *: "(a,a') \ (r Osum r')" and **: "a \ a'" - have "(a,a') \ (r - Id) Osum (r' - Id)" - proof- - {assume "(a,a') \ r \ (a,a') \ r'" - with ** have ?thesis unfolding Osum_def by auto - } - moreover - {assume "a \ Field r \ a' \ Field r'" - hence "a \ Field(r - Id) \ a' \ 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 blast - qed - } - thus ?thesis by(auto simp add: Osum_def) -qed - -lemma wf_Int_Times: -assumes "A Int B = {}" -shows "wf(A \ B)" -proof(unfold wf_def mem_Sigma_iff, intro impI allI) - fix P x - assume *: "\x. (\y. y \ A \ x \ B \ P y) \ P x" - moreover have "\y \ A. P y" using assms * by blast - ultimately show "P x" using * by (case_tac "x \ B") blast+ -qed - -lemma Osum_minus_Id1: -assumes "r \ Id" -shows "(r Osum r') - Id \ (r' - Id) \ (Field r \ Field r')" -proof- - let ?Left = "(r Osum r') - Id" - let ?Right = "(r' - Id) \ (Field r \ Field r')" - {fix a::'a and b assume *: "(a,b) \ Id" - {assume "(a,b) \ r" - with * have False using assms by auto - } - moreover - {assume "(a,b) \ r'" - with * have "(a,b) \ r' - Id" by auto - } - ultimately - have "(a,b) \ ?Left \ (a,b) \ ?Right" - unfolding Osum_def by auto - } - thus ?thesis by auto -qed - -lemma Osum_minus_Id2: -assumes "r' \ Id" -shows "(r Osum r') - Id \ (r - Id) \ (Field r \ Field r')" -proof- - let ?Left = "(r Osum r') - Id" - let ?Right = "(r - Id) \ (Field r \ Field r')" - {fix a::'a and b assume *: "(a,b) \ Id" - {assume "(a,b) \ r'" - with * have False using assms by auto - } - moreover - {assume "(a,b) \ r" - with * have "(a,b) \ r - Id" by auto - } - ultimately - have "(a,b) \ ?Left \ (a,b) \ ?Right" - unfolding Osum_def by auto - } - thus ?thesis by auto -qed - -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)" -proof(cases "r \ Id \ r' \ Id") - assume Case1: "\(r \ Id \ r' \ 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 - thus ?thesis - using Case1 Osum_minus_Id[of r r'] assms Osum_wf[of "r - Id" "r' - Id"] - wf_subset[of "(r - Id) \o (r' - Id)" "(r Osum r') - Id"] by auto -next - have 1: "wf(Field r \ Field r')" - using FLD by (auto simp add: wf_Int_Times) - assume Case2: "r \ Id \ r' \ Id" - moreover - {assume Case21: "r \ Id" - hence "(r Osum r') - Id \ (r' - Id) \ (Field r \ Field r')" - using Osum_minus_Id1[of r r'] by simp - moreover - {have "Domain(Field r \ Field r') Int Range(r' - Id) = {}" - using FLD unfolding Field_def by blast - hence "wf((r' - Id) \ (Field r \ Field r'))" - using 1 WF' wf_Un[of "Field r \ Field r'" "r' - Id"] - by (auto simp add: Un_commute) - } - ultimately have ?thesis by (auto simp add: wf_subset) - } - moreover - {assume Case22: "r' \ Id" - hence "(r Osum r') - Id \ (r - Id) \ (Field r \ Field r')" - using Osum_minus_Id2[of r' r] by simp - moreover - {have "Range(Field r \ Field r') Int Domain(r - Id) = {}" - using FLD unfolding Field_def by blast - hence "wf((r - Id) \ (Field r \ Field r'))" - using 1 WF wf_Un[of "r - Id" "Field r \ Field r'"] - by (auto simp add: Un_commute) - } - ultimately have ?thesis by (auto simp add: wf_subset) - } - 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')" -proof- - have "Total r \ 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 +(* More facts on ordinal sum: *) lemma Osum_embed: assumes FLD: "Field r Int Field r' = {}" and