# HG changeset patch # User wenzelm # Date 1026838346 -7200 # Node ID 041d78bf9403715015acc245960a450621bbe5da # Parent b37764a46b16990ad77cd79d7182071adfea3e13 adapted locales; diff -r b37764a46b16 -r 041d78bf9403 src/HOL/ex/Locales.thy --- a/src/HOL/ex/Locales.thy Tue Jul 16 18:46:59 2002 +0200 +++ b/src/HOL/ex/Locales.thy Tue Jul 16 18:52:26 2002 +0200 @@ -231,11 +231,14 @@ contexts is rather light-weight and convenient to use for abstract reasoning. Here the ``components'' (the group operations) have been exhibited directly as context parameters; logically this corresponds - to a curried predicate definition. Occasionally, this - ``externalized'' version of the informal idea of classes of tuple - structures may cause some inconveniences, especially in - meta-theoretical studies (involving functors from groups to groups, - for example). + to a curried predicate definition: + + @{thm [display] group_context_axioms_def [no_vars]} + + Occasionally, this ``externalized'' version of the informal idea of + classes of tuple structures may cause some inconveniences, + especially in meta-theoretical studies (involving functors from + groups to groups, for example). Another minor drawback of the naive approach above is that concrete syntax will get lost on any kind of operation on the locale itself diff -r b37764a46b16 -r 041d78bf9403 src/HOL/ex/Tarski.thy --- a/src/HOL/ex/Tarski.thy Tue Jul 16 18:46:59 2002 +0200 +++ b/src/HOL/ex/Tarski.thy Tue Jul 16 18:52:26 2002 +0200 @@ -1,25 +1,29 @@ -(* Title: HOL/ex/Tarski +(* Title: HOL/ex/Tarski.thy ID: $Id$ - Author: Florian Kammueller, Cambridge University Computer Laboratory + Author: Florian Kammüller, Cambridge University Computer Laboratory Copyright 1999 University of Cambridge +*) -Minimal version of lattice theory plus the full theorem of Tarski: - The fixedpoints of a complete lattice themselves form a complete lattice. - -Illustrates first-class theories, using the Sigma representation of structures - -Tidied and converted to Isar by lcp -*) +header {* The full theorem of Tarski *} theory Tarski = Main: -record 'a potype = +text {* + Minimal version of lattice theory plus the full theorem of Tarski: + The fixedpoints of a complete lattice themselves form a complete + lattice. + + Illustrates first-class theories, using the Sigma representation of + structures. Tidied and converted to Isar by lcp. +*} + +record 'a potype = pset :: "'a set" order :: "('a * 'a) set" syntax "@pset" :: "'a potype => 'a set" ("_ ." [90] 90) - "@order" :: "'a potype => ('a *'a)set" ("_ ." [90] 90) + "@order" :: "'a potype => ('a *'a)set" ("_ ." [90] 90) translations "po." == "pset po" @@ -27,69 +31,67 @@ constdefs monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool" - "monotone f A r == \x\A. \y\A. (x, y): r --> ((f x), (f y)) : r" + "monotone f A r == \x\A. \y\A. (x, y): r --> ((f x), (f y)) : r" least :: "['a => bool, 'a potype] => 'a" - "least P po == @ x. x: po. & P x & + "least P po == @ x. x: po. & P x & (\y \ po.. P y --> (x,y): po.)" greatest :: "['a => bool, 'a potype] => 'a" - "greatest P po == @ x. x: po. & P x & + "greatest P po == @ x. x: po. & P x & (\y \ po.. P y --> (y,x): po.)" lub :: "['a set, 'a potype] => 'a" - "lub S po == least (%x. \y\S. (y,x): po.) po" + "lub S po == least (%x. \y\S. (y,x): po.) po" glb :: "['a set, 'a potype] => 'a" - "glb S po == greatest (%x. \y\S. (x,y): po.) po" + "glb S po == greatest (%x. \y\S. (x,y): po.) po" isLub :: "['a set, 'a potype, 'a] => bool" - "isLub S po == %L. (L: po. & (\y\S. (y,L): po.) & - (\z\po.. (\y\S. (y,z): po.) --> (L,z): po.))" + "isLub S po == %L. (L: po. & (\y\S. (y,L): po.) & + (\z\po.. (\y\S. (y,z): po.) --> (L,z): po.))" isGlb :: "['a set, 'a potype, 'a] => bool" - "isGlb S po == %G. (G: po. & (\y\S. (G,y): po.) & + "isGlb S po == %G. (G: po. & (\y\S. (G,y): po.) & (\z \ po.. (\y\S. (z,y): po.) --> (z,G): po.))" "fix" :: "[('a => 'a), 'a set] => 'a set" - "fix f A == {x. x: A & f x = x}" + "fix f A == {x. x: A & f x = x}" interval :: "[('a*'a) set,'a, 'a ] => 'a set" - "interval r a b == {x. (a,x): r & (x,b): r}" + "interval r a b == {x. (a,x): r & (x,b): r}" constdefs Bot :: "'a potype => 'a" - "Bot po == least (%x. True) po" + "Bot po == least (%x. True) po" Top :: "'a potype => 'a" - "Top po == greatest (%x. True) po" + "Top po == greatest (%x. True) po" PartialOrder :: "('a potype) set" - "PartialOrder == {P. refl (P.) (P.) & antisym (P.) & - trans (P.)}" + "PartialOrder == {P. refl (P.) (P.) & antisym (P.) & + trans (P.)}" CompleteLattice :: "('a potype) set" - "CompleteLattice == {cl. cl: PartialOrder & - (\S. S <= cl. --> (\L. isLub S cl L)) & - (\S. S <= cl. --> (\G. isGlb S cl G))}" + "CompleteLattice == {cl. cl: PartialOrder & + (\S. S <= cl. --> (\L. isLub S cl L)) & + (\S. S <= cl. --> (\G. isGlb S cl G))}" CLF :: "('a potype * ('a => 'a)) set" - "CLF == SIGMA cl: CompleteLattice. - {f. f: cl. funcset cl. & monotone f (cl.) (cl.)}" - + "CLF == SIGMA cl: CompleteLattice. + {f. f: cl. funcset cl. & monotone f (cl.) (cl.)}" + induced :: "['a set, ('a * 'a) set] => ('a *'a)set" - "induced A r == {(a,b). a : A & b: A & (a,b): r}" - - + "induced A r == {(a,b). a : A & b: A & (a,b): r}" constdefs sublattice :: "('a potype * 'a set)set" - "sublattice == + "sublattice == SIGMA cl: CompleteLattice. {S. S <= cl. & - (| pset = S, order = induced S (cl.) |): CompleteLattice }" + (| pset = S, order = induced S (cl.) |): CompleteLattice }" syntax "@SL" :: "['a set, 'a potype] => bool" ("_ <<= _" [51,50]50) @@ -99,9 +101,9 @@ constdefs dual :: "'a potype => 'a potype" - "dual po == (| pset = po., order = converse (po.) |)" + "dual po == (| pset = po., order = converse (po.) |)" -locale PO = +locale (open) PO = fixes cl :: "'a potype" and A :: "'a set" and r :: "('a * 'a) set" @@ -109,17 +111,17 @@ defines A_def: "A == cl." and r_def: "r == cl." -locale CL = PO + +locale (open) CL = PO + assumes cl_co: "cl : CompleteLattice" -locale CLF = CL + +locale (open) CLF = CL + fixes f :: "'a => 'a" and P :: "'a set" assumes f_cl: "(cl,f) : CLF" (*was the equivalent "f : CLF``{cl}"*) defines P_def: "P == fix f A" -locale Tarski = CLF + +locale (open) Tarski = CLF + fixes Y :: "'a set" and intY1 :: "'a set" and v :: "'a" @@ -127,41 +129,40 @@ Y_ss: "Y <= P" defines intY1_def: "intY1 == interval r (lub Y cl) (Top cl)" - and v_def: "v == glb {x. ((%x: intY1. f x) x, x): induced intY1 r & + and v_def: "v == glb {x. ((%x: intY1. f x) x, x): induced intY1 r & x: intY1} - (| pset=intY1, order=induced intY1 r|)" + (| pset=intY1, order=induced intY1 r|)" - -(* Partial Order *) +subsubsection {* Partial Order *} lemma (in PO) PO_imp_refl: "refl A r" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def A_def r_def) done lemma (in PO) PO_imp_sym: "antisym r" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def A_def r_def) done lemma (in PO) PO_imp_trans: "trans r" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def A_def r_def) done lemma (in PO) reflE: "[| refl A r; x \ A|] ==> (x, x) \ r" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def refl_def) done lemma (in PO) antisymE: "[| antisym r; (a, b) \ r; (b, a) \ r |] ==> a = b" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def antisym_def) done lemma (in PO) transE: "[| trans r; (a, b) \ r; (b, c) \ r|] ==> (a,c) \ r" -apply (insert cl_po) +apply (insert cl_po) apply (simp add: PartialOrder_def) apply (unfold trans_def, fast) done @@ -174,13 +175,13 @@ "S <= A ==> (| pset = S, order = induced S r |) \ PartialOrder" apply (simp (no_asm) add: PartialOrder_def) apply auto -(* refl *) +-- {* refl *} apply (simp add: refl_def induced_def) apply (blast intro: PO_imp_refl [THEN reflE]) -(* antisym *) +-- {* antisym *} apply (simp add: antisym_def induced_def) apply (blast intro: PO_imp_sym [THEN antisymE]) -(* trans *) +-- {* trans *} apply (simp add: trans_def induced_def) apply (blast intro: PO_imp_trans [THEN transE]) done @@ -191,8 +192,8 @@ lemma (in PO) indI: "[| (x, y) \ r; x \ S; y \ S |] ==> (x, y) \ induced S r" by (simp add: add: induced_def) -lemma (in CL) CL_imp_ex_isLub: "S <= A ==> \L. isLub S cl L" -apply (insert cl_co) +lemma (in CL) CL_imp_ex_isLub: "S <= A ==> \L. isLub S cl L" +apply (insert cl_co) apply (simp add: CompleteLattice_def A_def) done @@ -211,13 +212,13 @@ by (simp add: isLub_def isGlb_def dual_def converse_def) lemma (in PO) dualPO: "dual cl \ PartialOrder" -apply (insert cl_po) -apply (simp add: PartialOrder_def dual_def refl_converse +apply (insert cl_po) +apply (simp add: PartialOrder_def dual_def refl_converse trans_converse antisym_converse) done lemma Rdual: - "\S. (S <= A -->( \L. isLub S (| pset = A, order = r|) L)) + "\S. (S <= A -->( \L. isLub S (| pset = A, order = r|) L)) ==> \S. (S <= A --> (\G. isGlb S (| pset = A, order = r|) G))" apply safe apply (rule_tac x = "lub {y. y \ A & (\k \ S. (y, k) \ r)} @@ -253,17 +254,17 @@ by (rule PO_imp_trans) lemma CompleteLatticeI: - "[| po \ PartialOrder; (\S. S <= po. --> (\L. isLub S po L)); - (\S. S <= po. --> (\G. isGlb S po G))|] + "[| po \ PartialOrder; (\S. S <= po. --> (\L. isLub S po L)); + (\S. S <= po. --> (\G. isGlb S po G))|] ==> po \ CompleteLattice" -apply (unfold CompleteLattice_def, blast) +apply (unfold CompleteLattice_def, blast) done lemma (in CL) CL_dualCL: "dual cl \ CompleteLattice" -apply (insert cl_co) +apply (insert cl_co) apply (simp add: CompleteLattice_def dual_def) -apply (fold dual_def) -apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric] +apply (fold dual_def) +apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric] dualPO) done @@ -307,17 +308,21 @@ apply (simp add: PO_imp_refl [THEN reflE]) done -(* sublattice *) + +subsubsection {* sublattice *} + lemma (in PO) sublattice_imp_CL: "S <<= cl ==> (| pset = S, order = induced S r |) \ CompleteLattice" by (simp add: sublattice_def CompleteLattice_def A_def r_def) lemma (in CL) sublatticeI: - "[| S <= A; (| pset = S, order = induced S r |) \ CompleteLattice |] + "[| S <= A; (| pset = S, order = induced S r |) \ CompleteLattice |] ==> S <<= cl" by (simp add: sublattice_def A_def r_def) -(* lub *) + +subsubsection {* lub *} + lemma (in CL) lub_unique: "[| S <= A; isLub S cl x; isLub S cl L|] ==> x = L" apply (rule antisymE) apply (rule CO_antisym) @@ -329,7 +334,7 @@ apply (unfold lub_def least_def) apply (rule some_equality [THEN ssubst]) apply (simp add: isLub_def) - apply (simp add: lub_unique A_def isLub_def) + apply (simp add: lub_unique A_def isLub_def) apply (simp add: isLub_def r_def) done @@ -339,7 +344,7 @@ apply (unfold lub_def least_def) apply (rule_tac s=x in some_equality [THEN ssubst]) apply (simp add: isLub_def) - apply (simp add: lub_unique A_def isLub_def) + apply (simp add: lub_unique A_def isLub_def) apply (simp add: isLub_def r_def A_def) done @@ -349,11 +354,11 @@ apply (subst some_equality) apply (simp add: isLub_def) prefer 2 apply (simp add: isLub_def A_def) -apply (simp add: lub_unique A_def isLub_def) +apply (simp add: lub_unique A_def isLub_def) done lemma (in CL) lubI: - "[| S <= A; L \ A; \x \ S. (x,L) \ r; + "[| S <= A; L \ A; \x \ S. (x,L) \ r; \z \ A. (\y \ S. (y,z) \ r) --> (L,z) \ r |] ==> L = lub S cl" apply (rule lub_unique, assumption) apply (simp add: isLub_def A_def r_def) @@ -378,17 +383,19 @@ by (simp add: isLub_def A_def r_def) lemma (in CL) isLubI: - "[| L \ A; \y \ S. (y, L) \ r; + "[| L \ A; \y \ S. (y, L) \ r; (\z \ A. (\y \ S. (y, z):r) --> (L, z) \ r)|] ==> isLub S cl L" by (simp add: isLub_def A_def r_def) -(* glb *) + +subsubsection {* glb *} + lemma (in CL) glb_in_lattice: "S <= A ==> glb S cl \ A" apply (subst glb_dual_lub) apply (simp add: A_def) apply (rule dualA_iff [THEN subst]) apply (rule Tarski.lub_in_lattice) -apply (rule dualPO) +apply (rule dualPO) apply (rule CL_dualCL) apply (simp add: dualA_iff) done @@ -398,18 +405,20 @@ apply (simp add: r_def) apply (rule dualr_iff [THEN subst]) apply (rule Tarski.lub_upper [rule_format]) -apply (rule dualPO) +apply (rule dualPO) apply (rule CL_dualCL) apply (simp add: dualA_iff A_def, assumption) done -(* Reduce the sublattice property by using substructural properties*) -(* abandoned see Tarski_4.ML *) +text {* + Reduce the sublattice property by using substructural properties; + abandoned see @{text "Tarski_4.ML"}. +*} lemma (in CLF) [simp]: "f: cl. funcset cl. & monotone f (cl.) (cl.)" -apply (insert f_cl) -apply (simp add: CLF_def) +apply (insert f_cl) +apply (simp add: CLF_def) done declare (in CLF) f_cl [simp] @@ -426,7 +435,9 @@ apply (simp add: dualA_iff) done -(* fixed points *) + +subsubsection {* fixed points *} + lemma fix_subset: "fix f A <= A" by (simp add: fix_def, fast) @@ -435,22 +446,24 @@ lemma fixf_subset: "[| A <= B; x \ fix (%y: A. f y) A |] ==> x \ fix f B" -apply (simp add: fix_def, auto) +apply (simp add: fix_def, auto) done -(* lemmas for Tarski, lub *) + +subsubsection {* lemmas for Tarski, lub *} lemma (in CLF) lubH_le_flubH: "H = {x. (x, f x) \ r & x \ A} ==> (lub H cl, f (lub H cl)) \ r" apply (rule lub_least, fast) apply (rule f_in_funcset [THEN funcset_mem]) apply (rule lub_in_lattice, fast) -(* \x:H. (x, f (lub H r)) \ r *) +-- {* @{text "\x:H. (x, f (lub H r)) \ r"} *} apply (rule ballI) apply (rule transE) apply (rule CO_trans) -(* instantiates (x, ???z) \ cl. to (x, f x), because of the def of H *) +-- {* instantiates @{text "(x, ???z) \ cl. to (x, f x)"}, *} +-- {* because of the def of @{text H} *} apply fast -(* so it remains to show (f x, f (lub H cl)) \ r *) +-- {* so it remains to show @{text "(f x, f (lub H cl)) \ r"} *} apply (rule_tac f = "f" in monotoneE) apply (rule monotone_f, fast) apply (rule lub_in_lattice, fast) @@ -469,8 +482,8 @@ prefer 2 apply fast apply (rule_tac f = "f" in monotoneE) apply (rule monotone_f) - apply (blast intro: lub_in_lattice) - apply (blast intro: lub_in_lattice f_in_funcset [THEN funcset_mem]) + apply (blast intro: lub_in_lattice) + apply (blast intro: lub_in_lattice f_in_funcset [THEN funcset_mem]) apply (simp add: lubH_le_flubH) done @@ -487,19 +500,19 @@ lemma (in CLF) fix_in_H: "[| H = {x. (x, f x) \ r & x \ A}; x \ P |] ==> x \ H" -by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl - fix_subset [of f A, THEN subsetD]) +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl + fix_subset [of f A, THEN subsetD]) lemma (in CLF) fixf_le_lubH: "H = {x. (x, f x) \ r & x \ A} ==> \x \ fix f A. (x, lub H cl) \ r" apply (rule ballI) apply (rule lub_upper, fast) apply (rule fix_in_H) -apply (simp_all add: P_def) +apply (simp_all add: P_def) done lemma (in CLF) lubH_least_fixf: - "H = {x. (x, f x) \ r & x \ A} + "H = {x. (x, f x) \ r & x \ A} ==> \L. (\y \ fix f A. (y,L) \ r) --> (lub H cl, L) \ r" apply (rule allI) apply (rule impI) @@ -507,10 +520,10 @@ apply (rule lubH_is_fixp, assumption) done -(* Tarski fixpoint theorem 1, first part *) +subsubsection {* Tarski fixpoint theorem 1, first part *} lemma (in CLF) T_thm_1_lub: "lub P cl = lub {x. (x, f x) \ r & x \ A} cl" apply (rule sym) -apply (simp add: P_def) +apply (simp add: P_def) apply (rule lubI) apply (rule fix_subset) apply (rule lub_in_lattice, fast) @@ -518,12 +531,12 @@ apply (simp add: lubH_least_fixf) done -(* Tarski for glb *) lemma (in CLF) glbH_is_fixp: "H = {x. (f x, x) \ r & x \ A} ==> glb H cl \ P" + -- {* Tarski for glb *} apply (simp add: glb_dual_lub P_def A_def r_def) apply (rule dualA_iff [THEN subst]) apply (rule Tarski.lubH_is_fixp) -apply (rule dualPO) +apply (rule dualPO) apply (rule CL_dualCL) apply (rule f_cl [THEN CLF_dual]) apply (simp add: dualr_iff dualA_iff) @@ -532,14 +545,15 @@ lemma (in CLF) T_thm_1_glb: "glb P cl = glb {x. (f x, x) \ r & x \ A} cl" apply (simp add: glb_dual_lub P_def A_def r_def) apply (rule dualA_iff [THEN subst]) -apply (simp add: Tarski.T_thm_1_lub [of _ f, OF dualPO CL_dualCL] +apply (simp add: Tarski.T_thm_1_lub [of _ f, OF dualPO CL_dualCL] dualPO CL_dualCL CLF_dual dualr_iff) done -(* interval *) +subsubsection {* interval *} + lemma (in CLF) rel_imp_elem: "(x, y) \ r ==> x \ A" -apply (insert CO_refl) -apply (simp add: refl_def, blast) +apply (insert CO_refl) +apply (simp add: refl_def, blast) done lemma (in CLF) interval_subset: "[| a \ A; b \ A |] ==> interval r a b <= A" @@ -563,12 +577,12 @@ done lemma (in CLF) a_less_lub: - "[| S <= A; S \ {}; + "[| S <= A; S \ {}; \x \ S. (a,x) \ r; \y \ S. (y, L) \ r |] ==> (a,L) \ r" by (blast intro: transE PO_imp_trans) lemma (in CLF) glb_less_b: - "[| S <= A; S \ {}; + "[| S <= A; S \ {}; \x \ S. (x,b) \ r; \y \ S. (G, y) \ r |] ==> (G,b) \ r" by (blast intro: transE PO_imp_trans) @@ -577,7 +591,7 @@ by (simp add: subset_trans [OF _ interval_subset]) lemma (in CLF) L_in_interval: - "[| a \ A; b \ A; S <= interval r a b; + "[| a \ A; b \ A; S <= interval r a b; S \ {}; isLub S cl L; interval r a b \ {} |] ==> L \ interval r a b" apply (rule intervalI) apply (rule a_less_lub) @@ -586,7 +600,7 @@ apply (rule ballI) apply (simp add: interval_lemma1) apply (simp add: isLub_upper) -(* (L, b) \ r *) +-- {* @{text "(L, b) \ r"} *} apply (simp add: isLub_least interval_lemma2) done @@ -594,12 +608,12 @@ "[| a \ A; b \ A; interval r a b \ {}; S <= interval r a b; isGlb S cl G; S \ {} |] ==> G \ interval r a b" apply (simp add: interval_dual) -apply (simp add: Tarski.L_in_interval [of _ f] +apply (simp add: Tarski.L_in_interval [of _ f] dualA_iff A_def dualPO CL_dualCL CLF_dual isGlb_dual_isLub) done lemma (in CLF) intervalPO: - "[| a \ A; b \ A; interval r a b \ {} |] + "[| a \ A; b \ A; interval r a b \ {} |] ==> (| pset = interval r a b, order = induced (interval r a b) r |) \ PartialOrder" apply (rule po_subset_po) @@ -607,41 +621,40 @@ done lemma (in CLF) intv_CL_lub: - "[| a \ A; b \ A; interval r a b \ {} |] - ==> \S. S <= interval r a b --> - (\L. isLub S (| pset = interval r a b, + "[| a \ A; b \ A; interval r a b \ {} |] + ==> \S. S <= interval r a b --> + (\L. isLub S (| pset = interval r a b, order = induced (interval r a b) r |) L)" apply (intro strip) apply (frule S_intv_cl [THEN CL_imp_ex_isLub]) prefer 2 apply assumption apply assumption apply (erule exE) -(* define the lub for the interval as *) +-- {* define the lub for the interval as *} apply (rule_tac x = "if S = {} then a else L" in exI) apply (simp (no_asm_simp) add: isLub_def split del: split_if) -apply (intro impI conjI) -(* (if S = {} then a else L) \ interval r a b *) +apply (intro impI conjI) +-- {* @{text "(if S = {} then a else L) \ interval r a b"} *} apply (simp add: CL_imp_PO L_in_interval) apply (simp add: left_in_interval) -(* lub prop 1 *) +-- {* lub prop 1 *} apply (case_tac "S = {}") -(* S = {}, y \ S = False => everything *) +-- {* @{text "S = {}, y \ S = False => everything"} *} apply fast -(* S \ {} *) +-- {* @{text "S \ {}"} *} apply simp -(* \y:S. (y, L) \ induced (interval r a b) r *) +-- {* @{text "\y:S. (y, L) \ induced (interval r a b) r"} *} apply (rule ballI) apply (simp add: induced_def L_in_interval) apply (rule conjI) apply (rule subsetD) apply (simp add: S_intv_cl, assumption) apply (simp add: isLub_upper) -(* \z:interval r a b. (\y:S. (y, z) \ induced (interval r a b) r --> - (if S = {} then a else L, z) \ induced (interval r a b) r *) +-- {* @{text "\z:interval r a b. (\y:S. (y, z) \ induced (interval r a b) r \ (if S = {} then a else L, z) \ induced (interval r a b) r"} *} apply (rule ballI) apply (rule impI) apply (case_tac "S = {}") -(* S = {} *) +-- {* @{text "S = {}"} *} apply simp apply (simp add: induced_def interval_def) apply (rule conjI) @@ -650,7 +663,7 @@ apply (rule interval_not_empty) apply (rule CO_trans) apply (simp add: interval_def) -(* S \ {} *) +-- {* @{text "S \ {}"} *} apply simp apply (simp add: induced_def L_in_interval) apply (rule isLub_least, assumption) @@ -662,7 +675,7 @@ lemmas (in CLF) intv_CL_glb = intv_CL_lub [THEN Rdual] lemma (in CLF) interval_is_sublattice: - "[| a \ A; b \ A; interval r a b \ {} |] + "[| a \ A; b \ A; interval r a b \ {} |] ==> interval r a b <<= cl" apply (rule sublatticeI) apply (simp add: interval_subset) @@ -672,10 +685,11 @@ apply (simp add: intv_CL_glb) done -lemmas (in CLF) interv_is_compl_latt = +lemmas (in CLF) interv_is_compl_latt = interval_is_sublattice [THEN sublattice_imp_CL] -(* Top and Bottom *) + +subsubsection {* Top and Bottom *} lemma (in CLF) Top_dual_Bot: "Top cl = Bot (dual cl)" by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff) @@ -696,8 +710,8 @@ lemma (in CLF) Top_in_lattice: "Top cl \ A" apply (simp add: Top_dual_Bot A_def) -apply (rule dualA_iff [THEN subst]) -apply (blast intro!: Tarski.Bot_in_lattice dualPO CL_dualCL CLF_dual f_cl) +apply (rule dualA_iff [THEN subst]) +apply (blast intro!: Tarski.Bot_in_lattice dualPO CL_dualCL CLF_dual f_cl) done lemma (in CLF) Top_prop: "x \ A ==> (x, Top cl) \ r" @@ -713,7 +727,7 @@ lemma (in CLF) Bot_prop: "x \ A ==> (Bot cl, x) \ r" apply (simp add: Bot_dual_Top r_def) apply (rule dualr_iff [THEN subst]) -apply (simp add: Tarski.Top_prop [of _ f] +apply (simp add: Tarski.Top_prop [of _ f] dualA_iff A_def dualPO CL_dualCL CLF_dual) done @@ -732,11 +746,12 @@ apply (rule dualA_iff [THEN subst]) apply (blast intro!: Tarski.Top_in_lattice f_cl dualPO CL_dualCL CLF_dual) -apply (simp add: Tarski.Top_intv_not_empty [of _ f] +apply (simp add: Tarski.Top_intv_not_empty [of _ f] dualA_iff A_def dualPO CL_dualCL CLF_dual) done -(* fixed points form a partial order *) +subsubsection {* fixed points form a partial order *} + lemma (in CLF) fixf_po: "(| pset = P, order = induced P r|) \ PartialOrder" by (simp add: P_def fix_subset po_subset_po) @@ -753,11 +768,11 @@ apply (rule Y_subset_A) apply (rule f_in_funcset [THEN funcset_mem]) apply (rule lubY_in_A) -(* Y <= P ==> f x = x *) +-- {* @{text "Y <= P ==> f x = x"} *} apply (rule ballI) apply (rule_tac t = "x" in fix_imp_eq [THEN subst]) apply (erule Y_ss [simplified P_def, THEN subsetD]) -(* reduce (f x, f (lub Y cl)) \ r to (x, lub Y cl) \ r by monotonicity *) +-- {* @{text "reduce (f x, f (lub Y cl)) \ r to (x, lub Y cl) \ r"} by monotonicity *} apply (rule_tac f = "f" in monotoneE) apply (rule monotone_f) apply (simp add: Y_subset_A [THEN subsetD]) @@ -780,13 +795,13 @@ apply (rule transE) apply (rule CO_trans) apply (rule lubY_le_flubY) -(* (f (lub Y cl), f x) \ r *) +-- {* @{text "(f (lub Y cl), f x) \ r"} *} apply (rule_tac f=f in monotoneE) apply (rule monotone_f) apply (rule lubY_in_A) apply (simp add: intY1_def interval_def intY1_elem) apply (simp add: intY1_def interval_def) -(* (f x, Top cl) \ r *) +-- {* @{text "(f x, Top cl) \ r"} *} apply (rule Top_prop) apply (rule f_in_funcset [THEN funcset_mem]) apply (simp add: intY1_def interval_def intY1_elem) @@ -803,7 +818,7 @@ apply (blast intro: intY1_elem monotone_f [THEN monotoneE]) done -lemma (in Tarski) intY1_is_cl: +lemma (in Tarski) intY1_is_cl: "(| pset = intY1, order = induced intY1 r |) \ CompleteLattice" apply (unfold intY1_def) apply (rule interv_is_compl_latt) @@ -821,11 +836,11 @@ v_def CL_imp_PO intY1_is_cl CLF_def intY1_func intY1_mono) done -lemma (in Tarski) z_in_interval: +lemma (in Tarski) z_in_interval: "[| z \ P; \y\Y. (y, z) \ induced P r |] ==> z \ intY1" apply (unfold intY1_def P_def) apply (rule intervalI) -prefer 2 +prefer 2 apply (erule fix_subset [THEN subsetD, THEN Top_prop]) apply (rule lub_least) apply (rule Y_subset_A) @@ -833,10 +848,10 @@ apply (simp add: induced_def) done -lemma (in Tarski) f'z_in_int_rel: "[| z \ P; \y\Y. (y, z) \ induced P r |] +lemma (in Tarski) f'z_in_int_rel: "[| z \ P; \y\Y. (y, z) \ induced P r |] ==> ((%x: intY1. f x) z, z) \ induced intY1 r" apply (simp add: induced_def intY1_f_closed z_in_interval P_def) -apply (simp add: fix_imp_eq [of _ f A] fix_subset [of f A, THEN subsetD] +apply (simp add: fix_imp_eq [of _ f A] fix_subset [of f A, THEN subsetD] CO_refl [THEN reflE]) done @@ -844,11 +859,11 @@ "\L. isLub Y (| pset = P, order = induced P r |) L" apply (rule_tac x = "v" in exI) apply (simp add: isLub_def) -(* v \ P *) +-- {* @{text "v \ P"} *} apply (simp add: v_in_P) apply (rule conjI) -(* v is lub *) -(* 1. \y:Y. (y, v) \ induced P r *) +-- {* @{text v} is lub *} +-- {* @{text "1. \y:Y. (y, v) \ induced P r"} *} apply (rule ballI) apply (simp add: induced_def subsetD v_in_P) apply (rule conjI) @@ -862,7 +877,7 @@ apply (fold intY1_def) apply (rule Tarski.glb_in_lattice [OF _ intY1_is_cl, simplified]) apply (simp add: CL_imp_PO intY1_is_cl, force) -(* v is LEAST ub *) +-- {* @{text v} is LEAST ub *} apply clarify apply (rule indI) prefer 3 apply assumption @@ -871,18 +886,17 @@ apply (rule indE) apply (rule_tac [2] intY1_subset) apply (rule Tarski.glb_lower [OF _ intY1_is_cl, simplified]) - apply (simp add: CL_imp_PO intY1_is_cl) + apply (simp add: CL_imp_PO intY1_is_cl) apply force apply (simp add: induced_def intY1_f_closed z_in_interval) -apply (simp add: P_def fix_imp_eq [of _ f A] - fix_subset [of f A, THEN subsetD] +apply (simp add: P_def fix_imp_eq [of _ f A] + fix_subset [of f A, THEN subsetD] CO_refl [THEN reflE]) done - lemma CompleteLatticeI_simp: - "[| (| pset = A, order = r |) \ PartialOrder; - \S. S <= A --> (\L. isLub S (| pset = A, order = r |) L) |] + "[| (| pset = A, order = r |) \ PartialOrder; + \S. S <= A --> (\L. isLub S (| pset = A, order = r |) L) |] ==> (| pset = A, order = r |) \ CompleteLattice" by (simp add: CompleteLatticeI Rdual) @@ -890,8 +904,8 @@ "(| pset = P, order = induced P r|) \ CompleteLattice" apply (rule CompleteLatticeI_simp) apply (rule fixf_po, clarify) -apply (simp add: P_def A_def r_def) -apply (blast intro!: Tarski.tarski_full_lemma cl_po cl_co f_cl) +apply (simp add: P_def A_def r_def) +apply (blast intro!: Tarski.tarski_full_lemma cl_po cl_co f_cl) done end