diff -r 9b38f8527510 -r c656222c4dc1 src/ZF/OrderArith.thy --- a/src/ZF/OrderArith.thy Sun Mar 04 23:20:43 2012 +0100 +++ b/src/ZF/OrderArith.thy Tue Mar 06 15:15:49 2012 +0000 @@ -12,22 +12,22 @@ radd :: "[i,i,i,i]=>i" where "radd(A,r,B,s) == {z: (A+B) * (A+B). - (EX x y. z = ) | - (EX x' x. z = & :r) | - (EX y' y. z = & :s)}" + (\x y. z = ) | + (\x' x. z = & :r) | + (\y' y. z = & :s)}" definition (*lexicographic product of two relations; underlies ordinal multiplication*) rmult :: "[i,i,i,i]=>i" where "rmult(A,r,B,s) == {z: (A*B) * (A*B). - EX x' y' x y. z = <, > & + \x' y' x y. z = <, > & (: r | (x'=x & : s))}" definition (*inverse image of a relation*) rvimage :: "[i,i,i]=>i" where - "rvimage(A,f,r) == {z: A*A. EX x y. z = & : r}" + "rvimage(A,f,r) == {z: A*A. \x y. z = & : r}" definition measure :: "[i, i\i] \ i" where @@ -39,19 +39,19 @@ subsubsection{*Rewrite rules. Can be used to obtain introduction rules*} lemma radd_Inl_Inr_iff [iff]: - " : radd(A,r,B,s) <-> a:A & b:B" + " \ radd(A,r,B,s) <-> a:A & b:B" by (unfold radd_def, blast) lemma radd_Inl_iff [iff]: - " : radd(A,r,B,s) <-> a':A & a:A & :r" + " \ radd(A,r,B,s) <-> a':A & a:A & :r" by (unfold radd_def, blast) lemma radd_Inr_iff [iff]: - " : radd(A,r,B,s) <-> b':B & b:B & :s" + " \ radd(A,r,B,s) <-> b':B & b:B & :s" by (unfold radd_def, blast) lemma radd_Inr_Inl_iff [simp]: - " : radd(A,r,B,s) <-> False" + " \ radd(A,r,B,s) <-> False" by (unfold radd_def, blast) declare radd_Inr_Inl_iff [THEN iffD1, dest!] @@ -59,7 +59,7 @@ subsubsection{*Elimination Rule*} lemma raddE: - "[| : radd(A,r,B,s); + "[| \ radd(A,r,B,s); !!x y. [| p'=Inl(x); x:A; p=Inr(y); y:B |] ==> Q; !!x' x. [| p'=Inl(x'); p=Inl(x); : r; x':A; x:A |] ==> Q; !!y' y. [| p'=Inr(y'); p=Inr(y); : s; y':B; y:B |] ==> Q @@ -68,7 +68,7 @@ subsubsection{*Type checking*} -lemma radd_type: "radd(A,r,B,s) <= (A+B) * (A+B)" +lemma radd_type: "radd(A,r,B,s) \ (A+B) * (A+B)" apply (unfold radd_def) apply (rule Collect_subset) done @@ -86,10 +86,10 @@ lemma wf_on_radd: "[| wf[A](r); wf[B](s) |] ==> wf[A+B](radd(A,r,B,s))" apply (rule wf_onI2) -apply (subgoal_tac "ALL x:A. Inl (x) : Ba") +apply (subgoal_tac "\x\A. Inl (x) \ Ba") --{*Proving the lemma, which is needed twice!*} prefer 2 - apply (erule_tac V = "y : A + B" in thin_rl) + apply (erule_tac V = "y \ A + B" in thin_rl) apply (rule_tac ballI) apply (erule_tac r = r and a = x in wf_on_induct, assumption) apply blast @@ -116,7 +116,7 @@ lemma sum_bij: "[| f: bij(A,C); g: bij(B,D) |] - ==> (lam z:A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) : bij(A+B, C+D)" + ==> (\z\A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) \ bij(A+B, C+D)" apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))" in lam_bijective) apply (typecheck add: bij_is_inj inj_is_fun) @@ -125,8 +125,8 @@ lemma sum_ord_iso_cong: "[| f: ord_iso(A,r,A',r'); g: ord_iso(B,s,B',s') |] ==> - (lam z:A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) - : ord_iso(A+B, radd(A,r,B,s), A'+B', radd(A',r',B',s'))" + (\z\A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) + \ ord_iso(A+B, radd(A,r,B,s), A'+B', radd(A',r',B',s'))" apply (unfold ord_iso_def) apply (safe intro!: sum_bij) (*Do the beta-reductions now*) @@ -134,9 +134,9 @@ done (*Could we prove an ord_iso result? Perhaps - ord_iso(A+B, radd(A,r,B,s), A Un B, r Un s) *) -lemma sum_disjoint_bij: "A Int B = 0 ==> - (lam z:A+B. case(%x. x, %y. y, z)) : bij(A+B, A Un B)" + ord_iso(A+B, radd(A,r,B,s), A \ B, r \ s) *) +lemma sum_disjoint_bij: "A \ B = 0 ==> + (\z\A+B. case(%x. x, %y. y, z)) \ bij(A+B, A \ B)" apply (rule_tac d = "%z. if z:A then Inl (z) else Inr (z) " in lam_bijective) apply auto done @@ -144,16 +144,16 @@ subsubsection{*Associativity*} lemma sum_assoc_bij: - "(lam z:(A+B)+C. case(case(Inl, %y. Inr(Inl(y))), %y. Inr(Inr(y)), z)) - : bij((A+B)+C, A+(B+C))" + "(\z\(A+B)+C. case(case(Inl, %y. Inr(Inl(y))), %y. Inr(Inr(y)), z)) + \ bij((A+B)+C, A+(B+C))" apply (rule_tac d = "case (%x. Inl (Inl (x)), case (%x. Inl (Inr (x)), Inr))" in lam_bijective) apply auto done lemma sum_assoc_ord_iso: - "(lam z:(A+B)+C. case(case(Inl, %y. Inr(Inl(y))), %y. Inr(Inr(y)), z)) - : ord_iso((A+B)+C, radd(A+B, radd(A,r,B,s), C, t), + "(\z\(A+B)+C. case(case(Inl, %y. Inr(Inl(y))), %y. Inr(Inr(y)), z)) + \ ord_iso((A+B)+C, radd(A+B, radd(A,r,B,s), C, t), A+(B+C), radd(A, r, B+C, radd(B,s,C,t)))" by (rule sum_assoc_bij [THEN ord_isoI], auto) @@ -163,14 +163,14 @@ subsubsection{*Rewrite rule. Can be used to obtain introduction rules*} lemma rmult_iff [iff]: - "<, > : rmult(A,r,B,s) <-> + "<, > \ rmult(A,r,B,s) <-> (: r & a':A & a:A & b': B & b: B) | (: s & a'=a & a:A & b': B & b: B)" by (unfold rmult_def, blast) lemma rmultE: - "[| <, > : rmult(A,r,B,s); + "[| <, > \ rmult(A,r,B,s); [| : r; a':A; a:A; b':B; b:B |] ==> Q; [| : s; a:A; a'=a; b':B; b:B |] ==> Q |] ==> Q" @@ -178,7 +178,7 @@ subsubsection{*Type checking*} -lemma rmult_type: "rmult(A,r,B,s) <= (A*B) * (A*B)" +lemma rmult_type: "rmult(A,r,B,s) \ (A*B) * (A*B)" by (unfold rmult_def, rule Collect_subset) lemmas field_rmult = rmult_type [THEN field_rel_subset] @@ -195,7 +195,7 @@ apply (rule wf_onI2) apply (erule SigmaE) apply (erule ssubst) -apply (subgoal_tac "ALL b:B. : Ba", blast) +apply (subgoal_tac "\b\B. : Ba", blast) apply (erule_tac a = x in wf_on_induct, assumption) apply (rule ballI) apply (erule_tac a = b in wf_on_induct, assumption) @@ -221,7 +221,7 @@ lemma prod_bij: "[| f: bij(A,C); g: bij(B,D) |] - ==> (lam :A*B. ) : bij(A*B, C*D)" + ==> (lam :A*B. ) \ bij(A*B, C*D)" apply (rule_tac d = "%. " in lam_bijective) apply (typecheck add: bij_is_inj inj_is_fun) @@ -231,20 +231,20 @@ lemma prod_ord_iso_cong: "[| f: ord_iso(A,r,A',r'); g: ord_iso(B,s,B',s') |] ==> (lam :A*B. ) - : ord_iso(A*B, rmult(A,r,B,s), A'*B', rmult(A',r',B',s'))" + \ ord_iso(A*B, rmult(A,r,B,s), A'*B', rmult(A',r',B',s'))" apply (unfold ord_iso_def) apply (safe intro!: prod_bij) apply (simp_all add: bij_is_fun [THEN apply_type]) apply (blast intro: bij_is_inj [THEN inj_apply_equality]) done -lemma singleton_prod_bij: "(lam z:A. ) : bij(A, {x}*A)" +lemma singleton_prod_bij: "(\z\A. ) \ bij(A, {x}*A)" by (rule_tac d = snd in lam_bijective, auto) (*Used??*) lemma singleton_prod_ord_iso: "well_ord({x},xr) ==> - (lam z:A. ) : ord_iso(A, r, {x}*A, rmult({x}, xr, A, r))" + (\z\A. ) \ ord_iso(A, r, {x}*A, rmult({x}, xr, A, r))" apply (rule singleton_prod_bij [THEN ord_isoI]) apply (simp (no_asm_simp)) apply (blast dest: well_ord_is_wf [THEN wf_on_not_refl]) @@ -253,9 +253,9 @@ (*Here we build a complicated function term, then simplify it using case_cong, id_conv, comp_lam, case_case.*) lemma prod_sum_singleton_bij: - "a~:C ==> - (lam x:C*B + D. case(%x. x, %y., x)) - : bij(C*B + D, C*B Un {a}*D)" + "a\C ==> + (\x\C*B + D. case(%x. x, %y., x)) + \ bij(C*B + D, C*B \ {a}*D)" apply (rule subst_elem) apply (rule id_bij [THEN sum_bij, THEN comp_bij]) apply (rule singleton_prod_bij) @@ -268,10 +268,10 @@ lemma prod_sum_singleton_ord_iso: "[| a:A; well_ord(A,r) |] ==> - (lam x:pred(A,a,r)*B + pred(B,b,s). case(%x. x, %y., x)) - : ord_iso(pred(A,a,r)*B + pred(B,b,s), + (\x\pred(A,a,r)*B + pred(B,b,s). case(%x. x, %y., x)) + \ ord_iso(pred(A,a,r)*B + pred(B,b,s), radd(A*B, rmult(A,r,B,s), B, s), - pred(A,a,r)*B Un {a}*pred(B,b,s), rmult(A,r,B,s))" + pred(A,a,r)*B \ {a}*pred(B,b,s), rmult(A,r,B,s))" apply (rule prod_sum_singleton_bij [THEN ord_isoI]) apply (simp (no_asm_simp) add: pred_iff well_ord_is_wf [THEN wf_on_not_refl]) apply (auto elim!: well_ord_is_wf [THEN wf_on_asym] predE) @@ -281,25 +281,25 @@ lemma sum_prod_distrib_bij: "(lam :(A+B)*C. case(%y. Inl(), %y. Inr(), x)) - : bij((A+B)*C, (A*C)+(B*C))" + \ bij((A+B)*C, (A*C)+(B*C))" by (rule_tac d = "case (%., %.) " in lam_bijective, auto) lemma sum_prod_distrib_ord_iso: "(lam :(A+B)*C. case(%y. Inl(), %y. Inr(), x)) - : ord_iso((A+B)*C, rmult(A+B, radd(A,r,B,s), C, t), + \ ord_iso((A+B)*C, rmult(A+B, radd(A,r,B,s), C, t), (A*C)+(B*C), radd(A*C, rmult(A,r,C,t), B*C, rmult(B,s,C,t)))" by (rule sum_prod_distrib_bij [THEN ord_isoI], auto) subsubsection{*Associativity*} lemma prod_assoc_bij: - "(lam <, z>:(A*B)*C. >) : bij((A*B)*C, A*(B*C))" + "(lam <, z>:(A*B)*C. >) \ bij((A*B)*C, A*(B*C))" by (rule_tac d = "%>. <, z>" in lam_bijective, auto) lemma prod_assoc_ord_iso: "(lam <, z>:(A*B)*C. >) - : ord_iso((A*B)*C, rmult(A*B, rmult(A,r,B,s), C, t), + \ ord_iso((A*B)*C, rmult(A*B, rmult(A,r,B,s), C, t), A*(B*C), rmult(A, r, B*C, rmult(B,s,C,t)))" by (rule prod_assoc_bij [THEN ord_isoI], auto) @@ -307,12 +307,12 @@ subsubsection{*Rewrite rule*} -lemma rvimage_iff: " : rvimage(A,f,r) <-> : r & a:A & b:A" +lemma rvimage_iff: " \ rvimage(A,f,r) <-> : r & a:A & b:A" by (unfold rvimage_def, blast) subsubsection{*Type checking*} -lemma rvimage_type: "rvimage(A,f,r) <= A*A" +lemma rvimage_type: "rvimage(A,f,r) \ A*A" by (unfold rvimage_def, rule Collect_subset) lemmas field_rvimage = rvimage_type [THEN field_rel_subset] @@ -361,7 +361,7 @@ lemma wf_rvimage [intro!]: "wf(r) ==> wf(rvimage(A,f,r))" apply (simp (no_asm_use) add: rvimage_def wf_eq_minimal) apply clarify -apply (subgoal_tac "EX w. w : {w: {f`x. x:Q}. EX x. x: Q & (f`x = w) }") +apply (subgoal_tac "\w. w \ {w: {f`x. x:Q}. \x. x: Q & (f`x = w) }") apply (erule allE) apply (erule impE) apply assumption @@ -373,7 +373,7 @@ @{text wf_rvimage} gives @{prop "wf(r) ==> wf[C](rvimage(A,f,r))"}*} lemma wf_on_rvimage: "[| f: A->B; wf[B](r) |] ==> wf[A](rvimage(A,f,r))" apply (rule wf_onI2) -apply (subgoal_tac "ALL z:A. f`z=f`y --> z: Ba") +apply (subgoal_tac "\z\A. f`z=f`y \ z: Ba") apply blast apply (erule_tac a = "f`y" in wf_on_induct) apply (blast intro!: apply_funtype) @@ -396,7 +396,7 @@ done lemma ord_iso_rvimage_eq: - "f: ord_iso(A,r, B,s) ==> rvimage(A,f,s) = r Int A*A" + "f: ord_iso(A,r, B,s) ==> rvimage(A,f,s) = r \ A*A" by (unfold ord_iso_def rvimage_def, blast) @@ -440,7 +440,7 @@ lemma wf_imp_subset_rvimage: - "[|wf(r); r \ A*A|] ==> \i f. Ord(i) & r <= rvimage(A, f, Memrel(i))" + "[|wf(r); r \ A*A|] ==> \i f. Ord(i) & r \ rvimage(A, f, Memrel(i))" apply (rule_tac x="wftype(r)" in exI) apply (rule_tac x="\x\A. wfrank(r,x)" in exI) apply (simp add: Ord_wftype, clarify) @@ -450,25 +450,25 @@ done theorem wf_iff_subset_rvimage: - "relation(r) ==> wf(r) <-> (\i f A. Ord(i) & r <= rvimage(A, f, Memrel(i)))" + "relation(r) ==> wf(r) <-> (\i f A. Ord(i) & r \ rvimage(A, f, Memrel(i)))" by (blast dest!: relation_field_times_field wf_imp_subset_rvimage intro: wf_rvimage_Ord [THEN wf_subset]) subsection{*Other Results*} -lemma wf_times: "A Int B = 0 ==> wf(A*B)" +lemma wf_times: "A \ B = 0 ==> wf(A*B)" by (simp add: wf_def, blast) text{*Could also be used to prove @{text wf_radd}*} lemma wf_Un: - "[| range(r) Int domain(s) = 0; wf(r); wf(s) |] ==> wf(r Un s)" + "[| range(r) \ domain(s) = 0; wf(r); wf(s) |] ==> wf(r \ s)" apply (simp add: wf_def, clarify) apply (rule equalityI) prefer 2 apply blast apply clarify apply (drule_tac x=Z in spec) -apply (drule_tac x="Z Int domain(s)" in spec) +apply (drule_tac x="Z \ domain(s)" in spec) apply simp apply (blast intro: elim: equalityE) done @@ -496,7 +496,7 @@ lemma wf_measure [iff]: "wf(measure(A,f))" by (simp (no_asm) add: measure_eq_rvimage_Memrel wf_Memrel wf_rvimage) -lemma measure_iff [iff]: " : measure(A,f) <-> x:A & y:A & f(x) \ measure(A,f) <-> x:A & y:A & f(x) A*A" by (auto simp add: measure_def) subsubsection{*Well-foundedness of Unions*} @@ -549,7 +549,7 @@ lemma Pow_sum_bij: "(\Z \ Pow(A+B). <{x \ A. Inl(x) \ Z}, {y \ B. Inr(y) \ Z}>) \ bij(Pow(A+B), Pow(A)*Pow(B))" -apply (rule_tac d = "%. {Inl (x). x \ X} Un {Inr (y). y \ Y}" +apply (rule_tac d = "%. {Inl (x). x \ X} \ {Inr (y). y \ Y}" in lam_bijective) apply force+ done