# HG changeset patch # User wenzelm # Date 1484665312 -3600 # Node ID 2bb0152d82cfb828970847ce7460201507adf41e # Parent 51f015bd4565c47f6453c46ab168ce62a255df1f misc tuning and modernization; diff -r 51f015bd4565 -r 2bb0152d82cf src/HOL/ex/Tarski.thy --- a/src/HOL/ex/Tarski.thy Tue Jan 17 15:40:33 2017 +0100 +++ b/src/HOL/ex/Tarski.thy Tue Jan 17 16:01:52 2017 +0100 @@ -19,245 +19,208 @@ record 'a potype = pset :: "'a set" - order :: "('a * 'a) set" + order :: "('a \ 'a) set" -definition - monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool" where - "monotone f A r = (\x\A. \y\A. (x, y): r --> ((f x), (f y)) : r)" +definition monotone :: "['a \ 'a, 'a set, ('a \ 'a) set] \ bool" + where "monotone f A r \ (\x\A. \y\A. (x, y) \ r \ (f x, f y) \ r)" -definition - least :: "['a => bool, 'a potype] => 'a" where - "least P po = (SOME x. x: pset po & P x & - (\y \ pset po. P y --> (x,y): order po))" +definition least :: "['a \ bool, 'a potype] \ 'a" + where "least P po = (SOME x. x \ pset po \ P x \ (\y \ pset po. P y \ (x, y) \ order po))" -definition - greatest :: "['a => bool, 'a potype] => 'a" where - "greatest P po = (SOME x. x: pset po & P x & - (\y \ pset po. P y --> (y,x): order po))" +definition greatest :: "['a \ bool, 'a potype] \ 'a" + where "greatest P po = (SOME x. x \ pset po \ P x \ (\y \ pset po. P y \ (y, x) \ order po))" -definition - lub :: "['a set, 'a potype] => 'a" where - "lub S po = least (%x. \y\S. (y,x): order po) po" +definition lub :: "['a set, 'a potype] \ 'a" + where "lub S po = least (\x. \y\S. (y, x) \ order po) po" -definition - glb :: "['a set, 'a potype] => 'a" where - "glb S po = greatest (%x. \y\S. (x,y): order po) po" +definition glb :: "['a set, 'a potype] \ 'a" + where "glb S po = greatest (\x. \y\S. (x, y) \ order po) po" -definition - isLub :: "['a set, 'a potype, 'a] => bool" where - "isLub S po = (%L. (L: pset po & (\y\S. (y,L): order po) & - (\z\pset po. (\y\S. (y,z): order po) --> (L,z): order po)))" +definition isLub :: "['a set, 'a potype, 'a] \ bool" + where "isLub S po = + (\L. L \ pset po \ (\y\S. (y, L) \ order po) \ + (\z\pset po. (\y\S. (y, z) \ order po) \ (L, z) \ order po))" -definition - isGlb :: "['a set, 'a potype, 'a] => bool" where - "isGlb S po = (%G. (G: pset po & (\y\S. (G,y): order po) & - (\z \ pset po. (\y\S. (z,y): order po) --> (z,G): order po)))" +definition isGlb :: "['a set, 'a potype, 'a] \ bool" + where "isGlb S po = + (\G. (G \ pset po \ (\y\S. (G, y) \ order po) \ + (\z \ pset po. (\y\S. (z, y) \ order po) \ (z, G) \ order po)))" -definition - "fix" :: "[('a => 'a), 'a set] => 'a set" where - "fix f A = {x. x: A & f x = x}" +definition "fix" :: "['a \ 'a, 'a set] \ 'a set" + where "fix f A = {x. x \ A \ f x = x}" -definition - interval :: "[('a*'a) set,'a, 'a ] => 'a set" where - "interval r a b = {x. (a,x): r & (x,b): r}" - +definition interval :: "[('a \ 'a) set, 'a, 'a] \ 'a set" + where "interval r a b = {x. (a, x) \ r \ (x, b) \ r}" -definition - Bot :: "'a potype => 'a" where - "Bot po = least (%x. True) po" +definition Bot :: "'a potype \ 'a" + where "Bot po = least (\x. True) po" -definition - Top :: "'a potype => 'a" where - "Top po = greatest (%x. True) po" +definition Top :: "'a potype \ 'a" + where "Top po = greatest (\x. True) po" -definition - PartialOrder :: "('a potype) set" where - "PartialOrder = {P. refl_on (pset P) (order P) & antisym (order P) & - trans (order P)}" +definition PartialOrder :: "'a potype set" + where "PartialOrder = {P. refl_on (pset P) (order P) \ antisym (order P) \ trans (order P)}" -definition - CompleteLattice :: "('a potype) set" where - "CompleteLattice = {cl. cl: PartialOrder & - (\S. S \ pset cl --> (\L. isLub S cl L)) & - (\S. S \ pset cl --> (\G. isGlb S cl G))}" +definition CompleteLattice :: "'a potype set" + where "CompleteLattice = + {cl. cl \ PartialOrder \ + (\S. S \ pset cl \ (\L. isLub S cl L)) \ + (\S. S \ pset cl \ (\G. isGlb S cl G))}" -definition - CLF_set :: "('a potype * ('a => 'a)) set" where - "CLF_set = (SIGMA cl: CompleteLattice. - {f. f: pset cl \ pset cl & monotone f (pset cl) (order cl)})" +definition CLF_set :: "('a potype \ ('a \ 'a)) set" + where "CLF_set = + (SIGMA cl : CompleteLattice. + {f. f \ pset cl \ pset cl \ monotone f (pset cl) (order cl)})" -definition - induced :: "['a set, ('a * 'a) set] => ('a *'a)set" where - "induced A r = {(a,b). a : A & b: A & (a,b): r}" - +definition induced :: "['a set, ('a \ 'a) set] \ ('a \ 'a) set" + where "induced A r = {(a, b). a \ A \ b \ A \ (a, b) \ r}" -definition - sublattice :: "('a potype * 'a set)set" where - "sublattice = - (SIGMA cl: CompleteLattice. - {S. S \ pset cl & - (| pset = S, order = induced S (order cl) |): CompleteLattice})" +definition sublattice :: "('a potype \ 'a set) set" + where "sublattice = + (SIGMA cl : CompleteLattice. + {S. S \ pset cl \ \pset = S, order = induced S (order cl)\ \ CompleteLattice})" -abbreviation - sublat :: "['a set, 'a potype] => bool" ("_ <<= _" [51,50]50) where - "S <<= cl == S : sublattice `` {cl}" +abbreviation sublat :: "['a set, 'a potype] \ bool" ("_ <<= _" [51, 50] 50) + where "S <<= cl \ S \ sublattice `` {cl}" -definition - dual :: "'a potype => 'a potype" where - "dual po = (| pset = pset po, order = converse (order po) |)" +definition dual :: "'a potype \ 'a potype" + where "dual po = \pset = pset po, order = converse (order po)\" locale S = fixes cl :: "'a potype" - and A :: "'a set" - and r :: "('a * 'a) set" - defines A_def: "A == pset cl" - and r_def: "r == order cl" + and A :: "'a set" + and r :: "('a \ 'a) set" + defines A_def: "A \ pset cl" + and r_def: "r \ order cl" locale PO = S + - assumes cl_po: "cl : PartialOrder" + assumes cl_po: "cl \ PartialOrder" locale CL = S + - assumes cl_co: "cl : CompleteLattice" + assumes cl_co: "cl \ CompleteLattice" sublocale CL < po?: PO -apply (simp_all add: A_def r_def) -apply unfold_locales -using cl_co unfolding CompleteLattice_def by auto + apply (simp_all add: A_def r_def) + apply unfold_locales + using cl_co unfolding CompleteLattice_def + apply auto + done locale CLF = S + - fixes f :: "'a => 'a" + fixes f :: "'a \ 'a" and P :: "'a set" - assumes f_cl: "(cl,f) : CLF_set" (*was the equivalent "f : CLF_set``{cl}"*) - defines P_def: "P == fix f A" + assumes f_cl: "(cl, f) \ CLF_set" (*was the equivalent "f \ CLF_set``{cl}"*) + defines P_def: "P \ fix f A" sublocale CLF < cl?: CL -apply (simp_all add: A_def r_def) -apply unfold_locales -using f_cl unfolding CLF_set_def by auto + apply (simp_all add: A_def r_def) + apply unfold_locales + using f_cl unfolding CLF_set_def + apply auto + done locale Tarski = CLF + - fixes Y :: "'a set" + fixes Y :: "'a set" and intY1 :: "'a set" - and v :: "'a" - assumes - 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 & - x: intY1} - (| pset=intY1, order=induced intY1 r|)" + and v :: "'a" + assumes 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 \ x \ intY1} + \pset = intY1, order = induced intY1 r\" subsection \Partial Order\ -lemma (in PO) dual: - "PO (dual cl)" -apply unfold_locales -using cl_po -unfolding PartialOrder_def dual_def -by auto +lemma (in PO) dual: "PO (dual cl)" + apply unfold_locales + using cl_po + unfolding PartialOrder_def dual_def + apply auto + done lemma (in PO) PO_imp_refl_on [simp]: "refl_on A r" -apply (insert cl_po) -apply (simp add: PartialOrder_def A_def r_def) -done + using cl_po by (simp add: PartialOrder_def A_def r_def) lemma (in PO) PO_imp_sym [simp]: "antisym r" -apply (insert cl_po) -apply (simp add: PartialOrder_def r_def) -done + using cl_po by (simp add: PartialOrder_def r_def) lemma (in PO) PO_imp_trans [simp]: "trans r" -apply (insert cl_po) -apply (simp add: PartialOrder_def r_def) -done + using cl_po by (simp add: PartialOrder_def r_def) -lemma (in PO) reflE: "x \ A ==> (x, x) \ r" -apply (insert cl_po) -apply (simp add: PartialOrder_def refl_on_def A_def r_def) -done +lemma (in PO) reflE: "x \ A \ (x, x) \ r" + using cl_po by (simp add: PartialOrder_def refl_on_def A_def r_def) -lemma (in PO) antisymE: "[| (a, b) \ r; (b, a) \ r |] ==> a = b" -apply (insert cl_po) -apply (simp add: PartialOrder_def antisym_def r_def) -done +lemma (in PO) antisymE: "\(a, b) \ r; (b, a) \ r\ \ a = b" + using cl_po by (simp add: PartialOrder_def antisym_def r_def) -lemma (in PO) transE: "[| (a, b) \ r; (b, c) \ r|] ==> (a,c) \ r" -apply (insert cl_po) -apply (simp add: PartialOrder_def r_def) -apply (unfold trans_def, fast) -done +lemma (in PO) transE: "\(a, b) \ r; (b, c) \ r\ \ (a, c) \ r" + using cl_po by (simp add: PartialOrder_def r_def) (unfold trans_def, fast) -lemma (in PO) monotoneE: - "[| monotone f A r; x \ A; y \ A; (x, y) \ r |] ==> (f x, f y) \ r" -by (simp add: monotone_def) +lemma (in PO) monotoneE: "\monotone f A r; x \ A; y \ A; (x, y) \ r\ \ (f x, f y) \ r" + by (simp add: monotone_def) -lemma (in PO) po_subset_po: - "S \ A ==> (| pset = S, order = induced S r |) \ PartialOrder" -apply (simp (no_asm) add: PartialOrder_def) -apply auto -\ \refl\ -apply (simp add: refl_on_def induced_def) -apply (blast intro: reflE) -\ \antisym\ -apply (simp add: antisym_def induced_def) -apply (blast intro: antisymE) -\ \trans\ -apply (simp add: trans_def induced_def) -apply (blast intro: transE) -done +lemma (in PO) po_subset_po: "S \ A \ \pset = S, order = induced S r\ \ PartialOrder" + apply (simp add: PartialOrder_def) + apply auto + \ \refl\ + apply (simp add: refl_on_def induced_def) + apply (blast intro: reflE) + \ \antisym\ + apply (simp add: antisym_def induced_def) + apply (blast intro: antisymE) + \ \trans\ + apply (simp add: trans_def induced_def) + apply (blast intro: transE) + done -lemma (in PO) indE: "[| (x, y) \ induced S r; S \ A |] ==> (x, y) \ r" -by (simp add: add: induced_def) +lemma (in PO) indE: "\(x, y) \ induced S r; S \ A\ \ (x, y) \ r" + by (simp add: induced_def) -lemma (in PO) indI: "[| (x, y) \ r; x \ S; y \ S |] ==> (x, y) \ induced S r" -by (simp add: add: induced_def) +lemma (in PO) indI: "\(x, y) \ r; x \ S; y \ S\ \ (x, y) \ induced S r" + by (simp add: induced_def) -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 +lemma (in CL) CL_imp_ex_isLub: "S \ A \ \L. isLub S cl L" + using cl_co by (simp add: CompleteLattice_def A_def) declare (in CL) cl_co [simp] -lemma isLub_lub: "(\L. isLub S cl L) = isLub S cl (lub S cl)" -by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric]) +lemma isLub_lub: "(\L. isLub S cl L) \ isLub S cl (lub S cl)" + by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric]) -lemma isGlb_glb: "(\G. isGlb S cl G) = isGlb S cl (glb S cl)" -by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric]) +lemma isGlb_glb: "(\G. isGlb S cl G) \ isGlb S cl (glb S cl)" + by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric]) lemma isGlb_dual_isLub: "isGlb S cl = isLub S (dual cl)" -by (simp add: isLub_def isGlb_def dual_def converse_unfold) + by (simp add: isLub_def isGlb_def dual_def converse_unfold) lemma isLub_dual_isGlb: "isLub S cl = isGlb S (dual cl)" -by (simp add: isLub_def isGlb_def dual_def converse_unfold) + by (simp add: isLub_def isGlb_def dual_def converse_unfold) lemma (in PO) dualPO: "dual cl \ PartialOrder" -apply (insert cl_po) -apply (simp add: PartialOrder_def dual_def refl_on_converse - trans_converse antisym_converse) -done + using cl_po by (simp add: PartialOrder_def dual_def) lemma Rdual: - "\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)} - (|pset = A, order = r|) " in exI) -apply (drule_tac x = "{y. y \ A & (\k \ S. (y,k) \ r) }" in spec) -apply (drule mp, fast) -apply (simp add: isLub_lub isGlb_def) -apply (simp add: isLub_def, blast) -done + "\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)} \pset = A, order = r\" in exI) + apply (drule_tac x = "{y. y \ A \ (\k \ S. (y, k) \ r)}" in spec) + apply (drule mp) + apply fast + apply (simp add: isLub_lub isGlb_def) + apply (simp add: isLub_def) + apply blast + done lemma lub_dual_glb: "lub S cl = glb S (dual cl)" -by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold) + by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold) lemma glb_dual_lub: "glb S cl = lub S (dual cl)" -by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold) + by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold) lemma CL_subset_PO: "CompleteLattice \ PartialOrder" -by (simp add: PartialOrder_def CompleteLattice_def, fast) + by (auto simp: PartialOrder_def CompleteLattice_def) lemmas CL_imp_PO = CL_subset_PO [THEN subsetD] @@ -266,657 +229,610 @@ declare CL_imp_PO [THEN PO.PO_imp_trans, simp]*) lemma (in CL) CO_refl_on: "refl_on A r" -by (rule PO_imp_refl_on) + by (rule PO_imp_refl_on) lemma (in CL) CO_antisym: "antisym r" -by (rule PO_imp_sym) + by (rule PO_imp_sym) lemma (in CL) CO_trans: "trans r" -by (rule PO_imp_trans) + by (rule PO_imp_trans) lemma CompleteLatticeI: - "[| po \ PartialOrder; (\S. S \ pset po --> (\L. isLub S po L)); - (\S. S \ pset po --> (\G. isGlb S po G))|] - ==> po \ CompleteLattice" -apply (unfold CompleteLattice_def, blast) -done + "\po \ PartialOrder; \S. S \ pset po \ (\L. isLub S po L); + \S. S \ pset po --> (\G. isGlb S po G)\ + \ po \ CompleteLattice" + unfolding CompleteLattice_def by blast lemma (in CL) CL_dualCL: "dual cl \ CompleteLattice" -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] - dualPO) -done + using cl_co + apply (simp add: CompleteLattice_def dual_def) + apply (fold dual_def) + apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric] dualPO) + done lemma (in PO) dualA_iff: "pset (dual cl) = pset cl" -by (simp add: dual_def) + by (simp add: dual_def) -lemma (in PO) dualr_iff: "((x, y) \ (order(dual cl))) = ((y, x) \ order cl)" -by (simp add: dual_def) +lemma (in PO) dualr_iff: "(x, y) \ (order (dual cl)) \ (y, x) \ order cl" + by (simp add: dual_def) lemma (in PO) monotone_dual: - "monotone f (pset cl) (order cl) - ==> monotone f (pset (dual cl)) (order(dual cl))" -by (simp add: monotone_def dualA_iff dualr_iff) + "monotone f (pset cl) (order cl) \ monotone f (pset (dual cl)) (order(dual cl))" + by (simp add: monotone_def dualA_iff dualr_iff) lemma (in PO) interval_dual: - "[| x \ A; y \ A|] ==> interval r x y = interval (order(dual cl)) y x" -apply (simp add: interval_def dualr_iff) -apply (fold r_def, fast) -done + "\x \ A; y \ A\ \ interval r x y = interval (order(dual cl)) y x" + apply (simp add: interval_def dualr_iff) + apply (fold r_def) + apply fast + done -lemma (in PO) trans: - "(x, y) \ r \ (y, z) \ r \ (x, z) \ r" -using cl_po apply (auto simp add: PartialOrder_def r_def) -unfolding trans_def by blast - -lemma (in PO) interval_not_empty: - "interval r a b \ {} ==> (a, b) \ r" -apply (simp add: interval_def) -using trans by blast +lemma (in PO) trans: "(x, y) \ r \ (y, z) \ r \ (x, z) \ r" + using cl_po + apply (auto simp add: PartialOrder_def r_def) + unfolding trans_def + apply blast + done -lemma (in PO) interval_imp_mem: "x \ interval r a b ==> (a, x) \ r" -by (simp add: interval_def) +lemma (in PO) interval_not_empty: "interval r a b \ {} \ (a, b) \ r" + by (simp add: interval_def) (use trans in blast) + +lemma (in PO) interval_imp_mem: "x \ interval r a b \ (a, x) \ r" + by (simp add: interval_def) -lemma (in PO) left_in_interval: - "[| a \ A; b \ A; interval r a b \ {} |] ==> a \ interval r a b" -apply (simp (no_asm_simp) add: interval_def) -apply (simp add: PO_imp_trans interval_not_empty) -apply (simp add: reflE) -done +lemma (in PO) left_in_interval: "\a \ A; b \ A; interval r a b \ {}\ \ a \ interval r a b" + apply (simp (no_asm_simp) add: interval_def) + apply (simp add: interval_not_empty) + apply (simp add: reflE) + done -lemma (in PO) right_in_interval: - "[| a \ A; b \ A; interval r a b \ {} |] ==> b \ interval r a b" -apply (simp (no_asm_simp) add: interval_def) -apply (simp add: PO_imp_trans interval_not_empty) -apply (simp add: reflE) -done +lemma (in PO) right_in_interval: "\a \ A; b \ A; interval r a b \ {}\ \ b \ interval r a b" + apply (simp (no_asm_simp) add: interval_def) + apply (simp add: interval_not_empty) + apply (simp add: reflE) + done subsection \sublattice\ lemma (in PO) sublattice_imp_CL: - "S <<= cl ==> (| pset = S, order = induced S r |) \ CompleteLattice" -by (simp add: sublattice_def CompleteLattice_def r_def) + "S <<= cl \ \pset = S, order = induced S r\ \ CompleteLattice" + by (simp add: sublattice_def CompleteLattice_def r_def) lemma (in CL) sublatticeI: - "[| S \ A; (| pset = S, order = induced S r |) \ CompleteLattice |] - ==> S <<= cl" -by (simp add: sublattice_def A_def r_def) + "\S \ A; \pset = S, order = induced S r\ \ CompleteLattice\ \ S <<= cl" + by (simp add: sublattice_def A_def r_def) -lemma (in CL) dual: - "CL (dual cl)" -apply unfold_locales -using cl_co unfolding CompleteLattice_def -apply (simp add: dualPO isGlb_dual_isLub [symmetric] isLub_dual_isGlb [symmetric] dualA_iff) -done +lemma (in CL) dual: "CL (dual cl)" + apply unfold_locales + using cl_co + unfolding CompleteLattice_def + apply (simp add: dualPO isGlb_dual_isLub [symmetric] isLub_dual_isGlb [symmetric] dualA_iff) + done subsection \lub\ -lemma (in CL) lub_unique: "[| S \ A; isLub S cl x; isLub S cl L|] ==> x = L" -apply (rule antisymE) -apply (auto simp add: isLub_def r_def) -done +lemma (in CL) lub_unique: "\S \ A; isLub S cl x; isLub S cl L\ \ x = L" + by (rule antisymE) (auto simp add: isLub_def r_def) -lemma (in CL) lub_upper: "[|S \ A; x \ S|] ==> (x, lub S cl) \ r" -apply (rule CL_imp_ex_isLub [THEN exE], assumption) -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: isLub_def r_def) -done +lemma (in CL) lub_upper: "\S \ A; x \ S\ \ (x, lub S cl) \ r" + apply (rule CL_imp_ex_isLub [THEN exE], assumption) + 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: isLub_def r_def) + done -lemma (in CL) lub_least: - "[| S \ A; L \ A; \x \ S. (x,L) \ r |] ==> (lub S cl, L) \ r" -apply (rule CL_imp_ex_isLub [THEN exE], assumption) -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: isLub_def r_def A_def) -done +lemma (in CL) lub_least: "\S \ A; L \ A; \x \ S. (x, L) \ r\ \ (lub S cl, L) \ r" + apply (rule CL_imp_ex_isLub [THEN exE], assumption) + 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: isLub_def r_def A_def) + done -lemma (in CL) lub_in_lattice: "S \ A ==> lub S cl \ A" -apply (rule CL_imp_ex_isLub [THEN exE], assumption) -apply (unfold lub_def least_def) -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) -done +lemma (in CL) lub_in_lattice: "S \ A \ lub S cl \ A" + apply (rule CL_imp_ex_isLub [THEN exE], assumption) + apply (unfold lub_def least_def) + 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) + done lemma (in CL) lubI: - "[| 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) -apply (unfold isLub_def) -apply (rule conjI) -apply (fold A_def r_def) -apply (rule lub_in_lattice, assumption) -apply (simp add: lub_upper lub_least) -done + "\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) + apply (unfold isLub_def) + apply (rule conjI) + apply (fold A_def r_def) + apply (rule lub_in_lattice, assumption) + apply (simp add: lub_upper lub_least) + done -lemma (in CL) lubIa: "[| S \ A; isLub S cl L |] ==> L = lub S cl" -by (simp add: lubI isLub_def A_def r_def) +lemma (in CL) lubIa: "\S \ A; isLub S cl L\ \ L = lub S cl" + by (simp add: lubI isLub_def A_def r_def) -lemma (in CL) isLub_in_lattice: "isLub S cl L ==> L \ A" -by (simp add: isLub_def A_def) +lemma (in CL) isLub_in_lattice: "isLub S cl L \ L \ A" + by (simp add: isLub_def A_def) -lemma (in CL) isLub_upper: "[|isLub S cl L; y \ S|] ==> (y, L) \ r" -by (simp add: isLub_def r_def) +lemma (in CL) isLub_upper: "\isLub S cl L; y \ S\ \ (y, L) \ r" + by (simp add: isLub_def r_def) -lemma (in CL) isLub_least: - "[| isLub S cl L; z \ A; \y \ S. (y, z) \ r|] ==> (L, z) \ r" -by (simp add: isLub_def A_def r_def) +lemma (in CL) isLub_least: "\isLub S cl L; z \ A; \y \ S. (y, z) \ r\ \ (L, z) \ r" + by (simp add: isLub_def A_def r_def) lemma (in CL) isLubI: - "[| 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) + "\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) subsection \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 CL.lub_in_lattice) -apply (rule dual) -apply (simp add: dualA_iff) -done +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 CL.lub_in_lattice) + apply (rule dual) + apply (simp add: dualA_iff) + done -lemma (in CL) glb_lower: "[|S \ A; x \ S|] ==> (glb S cl, x) \ r" -apply (subst glb_dual_lub) -apply (simp add: r_def) -apply (rule dualr_iff [THEN subst]) -apply (rule CL.lub_upper) -apply (rule dual) -apply (simp add: dualA_iff A_def, assumption) -done +lemma (in CL) glb_lower: "\S \ A; x \ S\ \ (glb S cl, x) \ r" + apply (subst glb_dual_lub) + apply (simp add: r_def) + apply (rule dualr_iff [THEN subst]) + apply (rule CL.lub_upper) + apply (rule dual) + apply (simp add: dualA_iff A_def, assumption) + done text \ Reduce the sublattice property by using substructural properties; abandoned see \Tarski_4.ML\. \ -lemma (in CLF) [simp]: - "f: pset cl \ pset cl & monotone f (pset cl) (order cl)" -apply (insert f_cl) -apply (simp add: CLF_set_def) -done +lemma (in CLF) [simp]: "f \ pset cl \ pset cl \ monotone f (pset cl) (order cl)" + using f_cl by (simp add: CLF_set_def) declare (in CLF) f_cl [simp] lemma (in CLF) f_in_funcset: "f \ A \ A" -by (simp add: A_def) + by (simp add: A_def) lemma (in CLF) monotone_f: "monotone f A r" -by (simp add: A_def r_def) + by (simp add: A_def r_def) lemma (in CLF) CLF_dual: "(dual cl, f) \ CLF_set" -apply (simp add: CLF_set_def CL_dualCL monotone_dual) -apply (simp add: dualA_iff) -done + by (simp add: CLF_set_def CL_dualCL monotone_dual) (simp add: dualA_iff) -lemma (in CLF) dual: - "CLF (dual cl) f" -apply (rule CLF.intro) -apply (rule CLF_dual) -done +lemma (in CLF) dual: "CLF (dual cl) f" + by (rule CLF.intro) (rule CLF_dual) subsection \fixed points\ lemma fix_subset: "fix f A \ A" -by (simp add: fix_def, fast) + by (auto simp: fix_def) -lemma fix_imp_eq: "x \ fix f A ==> f x = x" -by (simp add: fix_def) +lemma fix_imp_eq: "x \ fix f A \ f x = x" + by (simp add: fix_def) -lemma fixf_subset: - "[| A \ B; x \ fix (%y: A. f y) A |] ==> x \ fix f B" -by (simp add: fix_def, auto) +lemma fixf_subset: "\A \ B; x \ fix (\y \ A. f y) A\ \ x \ fix f B" + by (auto simp: fix_def) subsection \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\\ -apply (rule ballI) -apply (rule transE) -\ \instantiates \(x, ???z) \ order cl to (x, f x)\,\ -\ \because of the def of \H\\ -apply fast -\ \so it remains to show \(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) -apply (rule lub_upper, fast) -apply assumption -done + +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\\ + apply (rule ballI) + apply (rule transE) + \ \instantiates \(x, ???z) \ order cl to (x, f x)\,\ + \ \because of the def of \H\\ + apply fast + \ \so it remains to show \(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) + apply (rule lub_upper, fast) + apply assumption + done -lemma (in CLF) flubH_le_lubH: - "[| H = {x. (x, f x) \ r & x \ A} |] ==> (f (lub H cl), lub H cl) \ r" -apply (rule lub_upper, fast) -apply (rule_tac t = "H" in ssubst, assumption) -apply (rule CollectI) -apply (rule conjI) -apply (rule_tac [2] f_in_funcset [THEN funcset_mem]) -apply (rule_tac [2] lub_in_lattice) -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 (simp add: lubH_le_flubH) -done +lemma (in CLF) flubH_le_lubH: "\H = {x. (x, f x) \ r \ x \ A}\ \ (f (lub H cl), lub H cl) \ r" + apply (rule lub_upper, fast) + apply (rule_tac t = "H" in ssubst, assumption) + apply (rule CollectI) + apply (rule conjI) + apply (rule_tac [2] f_in_funcset [THEN funcset_mem]) + apply (rule_tac [2] lub_in_lattice) + 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 (simp add: lubH_le_flubH) + done -lemma (in CLF) lubH_is_fixp: - "H = {x. (x, f x) \ r & x \ A} ==> lub H cl \ fix f A" -apply (simp add: fix_def) -apply (rule conjI) -apply (rule lub_in_lattice, fast) -apply (rule antisymE) -apply (simp add: flubH_le_lubH) -apply (simp add: lubH_le_flubH) -done +lemma (in CLF) lubH_is_fixp: "H = {x. (x, f x) \ r \ x \ A} \ lub H cl \ fix f A" + apply (simp add: fix_def) + apply (rule conjI) + apply (rule lub_in_lattice, fast) + apply (rule antisymE) + apply (simp add: flubH_le_lubH) + apply (simp add: lubH_le_flubH) + done -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_on - fix_subset [of f A, THEN subsetD]) +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 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) -done +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) + apply fast + apply (rule fix_in_H) + apply (simp_all add: P_def) + done lemma (in CLF) lubH_least_fixf: - "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) -apply (erule bspec) -apply (rule lubH_is_fixp, assumption) -done + "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) + apply (erule bspec) + apply (rule lubH_is_fixp, assumption) + done subsection \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 (rule lubI) -apply (rule fix_subset) -apply (rule lub_in_lattice, fast) -apply (simp add: fixf_le_lubH) -apply (simp add: lubH_least_fixf) -done +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 (rule lubI) + apply (rule fix_subset) + apply (rule lub_in_lattice, fast) + apply (simp add: fixf_le_lubH) + apply (simp add: lubH_least_fixf) + done -lemma (in CLF) glbH_is_fixp: "H = {x. (f x, x) \ r & x \ A} ==> glb H cl \ P" +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 CLF.lubH_is_fixp) -apply (rule dual) -apply (simp add: dualr_iff dualA_iff) -done + apply (simp add: glb_dual_lub P_def A_def r_def) + apply (rule dualA_iff [THEN subst]) + apply (rule CLF.lubH_is_fixp) + apply (rule dual) + apply (simp add: dualr_iff dualA_iff) + done -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: CLF.T_thm_1_lub [of _ f, OF dual] - dualPO CL_dualCL CLF_dual dualr_iff) -done +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: CLF.T_thm_1_lub [of _ f, OF dual] dualPO CL_dualCL CLF_dual dualr_iff) + done + subsection \interval\ -lemma (in CLF) rel_imp_elem: "(x, y) \ r ==> x \ A" -apply (insert CO_refl_on) -apply (simp add: refl_on_def, blast) -done +lemma (in CLF) rel_imp_elem: "(x, y) \ r \ x \ A" + using CO_refl_on by (auto simp: refl_on_def) + +lemma (in CLF) interval_subset: "\a \ A; b \ A\ \ interval r a b \ A" + by (simp add: interval_def) (blast intro: rel_imp_elem) -lemma (in CLF) interval_subset: "[| a \ A; b \ A |] ==> interval r a b \ A" -apply (simp add: interval_def) -apply (blast intro: rel_imp_elem) -done +lemma (in CLF) intervalI: "\(a, x) \ r; (x, b) \ r\ \ x \ interval r a b" + by (simp add: interval_def) -lemma (in CLF) intervalI: - "[| (a, x) \ r; (x, b) \ r |] ==> x \ interval r a b" -by (simp add: interval_def) - -lemma (in CLF) interval_lemma1: - "[| S \ interval r a b; x \ S |] ==> (a, x) \ r" -by (unfold interval_def, fast) +lemma (in CLF) interval_lemma1: "\S \ interval r a b; x \ S\ \ (a, x) \ r" + unfolding interval_def by fast -lemma (in CLF) interval_lemma2: - "[| S \ interval r a b; x \ S |] ==> (x, b) \ r" -by (unfold interval_def, fast) +lemma (in CLF) interval_lemma2: "\S \ interval r a b; x \ S\ \ (x, b) \ r" + unfolding interval_def by fast -lemma (in CLF) a_less_lub: - "[| S \ A; S \ {}; - \x \ S. (a,x) \ r; \y \ S. (y, L) \ r |] ==> (a,L) \ r" -by (blast intro: transE) +lemma (in CLF) a_less_lub: "\S \ A; S \ {}; \x \ S. (a,x) \ r; \y \ S. (y, L) \ r\ \ (a, L) \ r" + by (blast intro: transE) -lemma (in CLF) glb_less_b: - "[| S \ A; S \ {}; - \x \ S. (x,b) \ r; \y \ S. (G, y) \ r |] ==> (G,b) \ r" -by (blast intro: transE) +lemma (in CLF) glb_less_b: "\S \ A; S \ {}; \x \ S. (x,b) \ r; \y \ S. (G, y) \ r\ \ (G, b) \ r" + by (blast intro: transE) -lemma (in CLF) S_intv_cl: - "[| a \ A; b \ A; S \ interval r a b |]==> S \ A" -by (simp add: subset_trans [OF _ interval_subset]) +lemma (in CLF) S_intv_cl: "\a \ A; b \ A; S \ interval r a b\ \ S \ A" + by (simp add: subset_trans [OF _ interval_subset]) lemma (in CLF) L_in_interval: - "[| 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) -prefer 2 apply assumption -apply (simp add: S_intv_cl) -apply (rule ballI) -apply (simp add: interval_lemma1) -apply (simp add: isLub_upper) -\ \\(L, b) \ r\\ -apply (simp add: isLub_least interval_lemma2) -done + "\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) + prefer 2 apply assumption + apply (simp add: S_intv_cl) + apply (rule ballI) + apply (simp add: interval_lemma1) + apply (simp add: isLub_upper) + \ \\(L, b) \ r\\ + apply (simp add: isLub_least interval_lemma2) + done lemma (in CLF) G_in_interval: - "[| 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: CLF.L_in_interval [of _ f, OF dual] - dualA_iff A_def isGlb_dual_isLub) -done + "\a \ A; b \ A; interval r a b \ {}; S \ interval r a b; isGlb S cl G; S \ {}\ + \ G \ interval r a b" + by (simp add: interval_dual) + (simp add: CLF.L_in_interval [of _ f, OF dual] dualA_iff A_def isGlb_dual_isLub) lemma (in CLF) intervalPO: - "[| 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) -apply (simp add: interval_subset) -done + "\a \ A; b \ A; interval r a b \ {}\ + \ \pset = interval r a b, order = induced (interval r a b) r\ \ PartialOrder" + by (rule po_subset_po) (simp add: interval_subset) 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, - 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\ -apply (rule_tac x = "if S = {} then a else L" in exI) -apply (simp (no_asm_simp) add: isLub_def split del: if_split) -apply (intro impI conjI) -\ \\(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\ -apply (case_tac "S = {}") -\ \\S = {}, y \ S = False => everything\\ -apply fast -\ \\S \ {}\\ -apply simp -\ \\\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\\ -apply (rule ballI) -apply (rule impI) -apply (case_tac "S = {}") -\ \\S = {}\\ -apply simp -apply (simp add: induced_def interval_def) -apply (rule conjI) -apply (rule reflE, assumption) -apply (rule interval_not_empty) -apply (simp add: interval_def) -\ \\S \ {}\\ -apply simp -apply (simp add: induced_def L_in_interval) -apply (rule isLub_least, assumption) -apply (rule subsetD) -prefer 2 apply assumption -apply (simp add: S_intv_cl, fast) -done + "\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\ + apply (rule_tac x = "if S = {} then a else L" in exI) + apply (simp (no_asm_simp) add: isLub_def split del: if_split) + apply (intro impI conjI) + \ \\(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\ + apply (case_tac "S = {}") + \ \\S = {}, y \ S = False \ everything\\ + apply fast + \ \\S \ {}\\ + apply simp + \ \\\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\\ + apply (rule ballI) + apply (rule impI) + apply (case_tac "S = {}") + \ \\S = {}\\ + apply simp + apply (simp add: induced_def interval_def) + apply (rule conjI) + apply (rule reflE, assumption) + apply (rule interval_not_empty) + apply (simp add: interval_def) + \ \\S \ {}\\ + apply simp + apply (simp add: induced_def L_in_interval) + apply (rule isLub_least, assumption) + apply (rule subsetD) + prefer 2 apply assumption + apply (simp add: S_intv_cl, fast) + done 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 \ {} |] - ==> interval r a b <<= cl" -apply (rule sublatticeI) -apply (simp add: interval_subset) -apply (rule CompleteLatticeI) -apply (simp add: intervalPO) - apply (simp add: intv_CL_lub) -apply (simp add: intv_CL_glb) -done + "\a \ A; b \ A; interval r a b \ {}\ \ interval r a b <<= cl" + apply (rule sublatticeI) + apply (simp add: interval_subset) + apply (rule CompleteLatticeI) + apply (simp add: intervalPO) + apply (simp add: intv_CL_lub) + apply (simp add: intv_CL_glb) + done -lemmas (in CLF) interv_is_compl_latt = - interval_is_sublattice [THEN sublattice_imp_CL] +lemmas (in CLF) interv_is_compl_latt = interval_is_sublattice [THEN sublattice_imp_CL] subsection \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) + by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff) lemma (in CLF) Bot_dual_Top: "Bot cl = Top (dual cl)" -by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff) + by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff) lemma (in CLF) Bot_in_lattice: "Bot cl \ A" -apply (simp add: Bot_def least_def) -apply (rule_tac a="glb A cl" in someI2) -apply (simp_all add: glb_in_lattice glb_lower - r_def [symmetric] A_def [symmetric]) -done + apply (simp add: Bot_def least_def) + apply (rule_tac a = "glb A cl" in someI2) + apply (simp_all add: glb_in_lattice glb_lower r_def [symmetric] A_def [symmetric]) + done lemma (in CLF) Top_in_lattice: "Top cl \ A" -apply (simp add: Top_dual_Bot A_def) -apply (rule dualA_iff [THEN subst]) -apply (rule CLF.Bot_in_lattice [OF dual]) -done + apply (simp add: Top_dual_Bot A_def) + apply (rule dualA_iff [THEN subst]) + apply (rule CLF.Bot_in_lattice [OF dual]) + done -lemma (in CLF) Top_prop: "x \ A ==> (x, Top cl) \ r" -apply (simp add: Top_def greatest_def) -apply (rule_tac a="lub A cl" in someI2) -apply (rule someI2) -apply (simp_all add: lub_in_lattice lub_upper - r_def [symmetric] A_def [symmetric]) -done +lemma (in CLF) Top_prop: "x \ A \ (x, Top cl) \ r" + apply (simp add: Top_def greatest_def) + apply (rule_tac a = "lub A cl" in someI2) + apply (rule someI2) + apply (simp_all add: lub_in_lattice lub_upper + r_def [symmetric] A_def [symmetric]) + done -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 (rule CLF.Top_prop [OF dual]) -apply (simp add: dualA_iff A_def) -done +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 (rule CLF.Top_prop [OF dual]) + apply (simp add: dualA_iff A_def) + done -lemma (in CLF) Top_intv_not_empty: "x \ A ==> interval r x (Top cl) \ {}" -apply (rule notI) -apply (drule_tac a = "Top cl" in equals0D) -apply (simp add: interval_def) -apply (simp add: refl_on_def Top_in_lattice Top_prop) -done +lemma (in CLF) Top_intv_not_empty: "x \ A \ interval r x (Top cl) \ {}" + apply (rule notI) + apply (drule_tac a = "Top cl" in equals0D) + apply (simp add: interval_def) + apply (simp add: refl_on_def Top_in_lattice Top_prop) + done -lemma (in CLF) Bot_intv_not_empty: "x \ A ==> interval r (Bot cl) x \ {}" -apply (simp add: Bot_dual_Top) -apply (subst interval_dual) -prefer 2 apply assumption -apply (simp add: A_def) -apply (rule dualA_iff [THEN subst]) -apply (rule CLF.Top_in_lattice [OF dual]) -apply (rule CLF.Top_intv_not_empty [OF dual]) -apply (simp add: dualA_iff A_def) -done +lemma (in CLF) Bot_intv_not_empty: "x \ A \ interval r (Bot cl) x \ {}" + apply (simp add: Bot_dual_Top) + apply (subst interval_dual) + prefer 2 apply assumption + apply (simp add: A_def) + apply (rule dualA_iff [THEN subst]) + apply (rule CLF.Top_in_lattice [OF dual]) + apply (rule CLF.Top_intv_not_empty [OF dual]) + apply (simp add: dualA_iff A_def) + done + subsection \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) +lemma (in CLF) fixf_po: "\pset = P, order = induced P r\ \ PartialOrder" + by (simp add: P_def fix_subset po_subset_po) lemma (in Tarski) Y_subset_A: "Y \ A" -apply (rule subset_trans [OF _ fix_subset]) -apply (rule Y_ss [simplified P_def]) -done + by (rule subset_trans [OF _ fix_subset]) (rule Y_ss [simplified P_def]) lemma (in Tarski) lubY_in_A: "lub Y cl \ A" by (rule Y_subset_A [THEN lub_in_lattice]) lemma (in Tarski) lubY_le_flubY: "(lub Y cl, f (lub Y cl)) \ r" -apply (rule lub_least) -apply (rule Y_subset_A) -apply (rule f_in_funcset [THEN funcset_mem]) -apply (rule lubY_in_A) -\ \\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\ -apply (rule_tac f = "f" in monotoneE) -apply (rule monotone_f) -apply (simp add: Y_subset_A [THEN subsetD]) -apply (rule lubY_in_A) -apply (simp add: lub_upper Y_subset_A) -done + apply (rule lub_least) + apply (rule Y_subset_A) + apply (rule f_in_funcset [THEN funcset_mem]) + apply (rule lubY_in_A) + \ \\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\ + apply (rule_tac f = "f" in monotoneE) + apply (rule monotone_f) + apply (simp add: Y_subset_A [THEN subsetD]) + apply (rule lubY_in_A) + apply (simp add: lub_upper Y_subset_A) + done lemma (in Tarski) intY1_subset: "intY1 \ A" -apply (unfold intY1_def) -apply (rule interval_subset) -apply (rule lubY_in_A) -apply (rule Top_in_lattice) -done + apply (unfold intY1_def) + apply (rule interval_subset) + apply (rule lubY_in_A) + apply (rule Top_in_lattice) + done lemmas (in Tarski) intY1_elem = intY1_subset [THEN subsetD] lemma (in Tarski) intY1_f_closed: "x \ intY1 \ f x \ intY1" -apply (simp add: intY1_def interval_def) -apply (rule conjI) -apply (rule transE) -apply (rule lubY_le_flubY) -\ \\(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\\ -apply (rule Top_prop) -apply (rule f_in_funcset [THEN funcset_mem]) -apply (simp add: intY1_def interval_def intY1_elem) -done + apply (simp add: intY1_def interval_def) + apply (rule conjI) + apply (rule transE) + apply (rule lubY_le_flubY) + \ \\(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\\ + apply (rule Top_prop) + apply (rule f_in_funcset [THEN funcset_mem]) + apply (simp add: intY1_def interval_def intY1_elem) + done -lemma (in Tarski) intY1_mono: - "monotone (%x: intY1. f x) intY1 (induced intY1 r)" -apply (auto simp add: monotone_def induced_def intY1_f_closed) -apply (blast intro: intY1_elem monotone_f [THEN monotoneE]) -done +lemma (in Tarski) intY1_mono: "monotone (\ x \ intY1. f x) intY1 (induced intY1 r)" + apply (auto simp add: monotone_def induced_def intY1_f_closed) + apply (blast intro: intY1_elem monotone_f [THEN monotoneE]) + done -lemma (in Tarski) intY1_is_cl: - "(| pset = intY1, order = induced intY1 r |) \ CompleteLattice" -apply (unfold intY1_def) -apply (rule interv_is_compl_latt) -apply (rule lubY_in_A) -apply (rule Top_in_lattice) -apply (rule Top_intv_not_empty) -apply (rule lubY_in_A) -done +lemma (in Tarski) intY1_is_cl: "\pset = intY1, order = induced intY1 r\ \ CompleteLattice" + apply (unfold intY1_def) + apply (rule interv_is_compl_latt) + apply (rule lubY_in_A) + apply (rule Top_in_lattice) + apply (rule Top_intv_not_empty) + apply (rule lubY_in_A) + done lemma (in Tarski) v_in_P: "v \ P" -apply (unfold P_def) -apply (rule_tac A = "intY1" in fixf_subset) -apply (rule intY1_subset) -unfolding v_def -apply (rule CLF.glbH_is_fixp [OF CLF.intro, unfolded CLF_set_def, of "\pset = intY1, order = induced intY1 r\", simplified]) -apply auto -apply (rule intY1_is_cl) -apply (erule intY1_f_closed) -apply (rule intY1_mono) -done + apply (unfold P_def) + apply (rule_tac A = intY1 in fixf_subset) + apply (rule intY1_subset) + unfolding v_def + apply (rule CLF.glbH_is_fixp + [OF CLF.intro, unfolded CLF_set_def, of "\pset = intY1, order = induced intY1 r\", simplified]) + apply auto + apply (rule intY1_is_cl) + apply (erule intY1_f_closed) + apply (rule intY1_mono) + done -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 - apply (erule fix_subset [THEN subsetD, THEN Top_prop]) -apply (rule lub_least) -apply (rule Y_subset_A) -apply (fast elim!: fix_subset [THEN subsetD]) -apply (simp add: induced_def) -done +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 + apply (erule fix_subset [THEN subsetD, THEN Top_prop]) + apply (rule lub_least) + apply (rule Y_subset_A) + apply (fast elim!: fix_subset [THEN subsetD]) + apply (simp add: induced_def) + done -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] - reflE) -done +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" + by (simp add: induced_def intY1_f_closed z_in_interval P_def) + (simp add: fix_imp_eq [of _ f A] fix_subset [of f A, THEN subsetD] reflE) -lemma (in Tarski) tarski_full_lemma: - "\L. isLub Y (| pset = P, order = induced P r |) L" -apply (rule_tac x = "v" in exI) -apply (simp add: isLub_def) -\ \\v \ P\\ -apply (simp add: v_in_P) -apply (rule conjI) -\ \\v\ is lub\ -\ \\1. \y:Y. (y, v) \ induced P r\\ -apply (rule ballI) -apply (simp add: induced_def subsetD v_in_P) -apply (rule conjI) -apply (erule Y_ss [THEN subsetD]) -apply (rule_tac b = "lub Y cl" in transE) -apply (rule lub_upper) -apply (rule Y_subset_A, assumption) -apply (rule_tac b = "Top cl" in interval_imp_mem) -apply (simp add: v_def) -apply (fold intY1_def) -apply (rule CL.glb_in_lattice [OF CL.intro [OF intY1_is_cl], simplified]) -apply auto -apply (rule indI) - prefer 3 apply assumption - prefer 2 apply (simp add: v_in_P) -apply (unfold v_def) -apply (rule indE) -apply (rule_tac [2] intY1_subset) -apply (rule CL.glb_lower [OF CL.intro [OF intY1_is_cl], simplified]) - 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] reflE - fix_subset [of f A, THEN subsetD]) -done +lemma (in Tarski) tarski_full_lemma: "\L. isLub Y \pset = P, order = induced P r\ L" + apply (rule_tac x = "v" in exI) + apply (simp add: isLub_def) + \ \\v \ P\\ + apply (simp add: v_in_P) + apply (rule conjI) + \ \\v\ is lub\ + \ \\1. \y:Y. (y, v) \ induced P r\\ + apply (rule ballI) + apply (simp add: induced_def subsetD v_in_P) + apply (rule conjI) + apply (erule Y_ss [THEN subsetD]) + apply (rule_tac b = "lub Y cl" in transE) + apply (rule lub_upper) + apply (rule Y_subset_A, assumption) + apply (rule_tac b = "Top cl" in interval_imp_mem) + apply (simp add: v_def) + apply (fold intY1_def) + apply (rule CL.glb_in_lattice [OF CL.intro [OF intY1_is_cl], simplified]) + apply auto + apply (rule indI) + prefer 3 apply assumption + prefer 2 apply (simp add: v_in_P) + apply (unfold v_def) + apply (rule indE) + apply (rule_tac [2] intY1_subset) + apply (rule CL.glb_lower [OF CL.intro [OF intY1_is_cl], simplified]) + 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] reflE fix_subset [of f A, THEN subsetD]) + done lemma CompleteLatticeI_simp: - "[| (| 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) + "\\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) -theorem (in CLF) Tarski_full: - "(| 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 (rule Tarski.tarski_full_lemma [OF Tarski.intro [OF _ Tarski_axioms.intro]]) -proof - show "CLF cl f" .. qed +theorem (in CLF) Tarski_full: "\pset = P, order = induced P r\ \ CompleteLattice" + apply (rule CompleteLatticeI_simp) + apply (rule fixf_po) + apply clarify + apply (simp add: P_def A_def r_def) + apply (rule Tarski.tarski_full_lemma [OF Tarski.intro [OF _ Tarski_axioms.intro]]) +proof - + show "CLF cl f" .. +qed end