Up to index of Isabelle/HOLCF
theory CompactBasis(* Title: HOLCF/CompactBasis.thy ID: $Id: CompactBasis.thy,v 1.10 2008/05/16 21:25:37 huffman Exp $ Author: Brian Huffman *) header {* Compact bases of domains *} theory CompactBasis imports Bifinite SetPcpo begin subsection {* Ideals over a preorder *} context preorder begin definition ideal :: "'a set => bool" where "ideal A = ((∃x. x ∈ A) ∧ (∀x∈A. ∀y∈A. ∃z∈A. x \<sqsubseteq> z ∧ y \<sqsubseteq> z) ∧ (∀x y. x \<sqsubseteq> y --> y ∈ A --> x ∈ A))" lemma idealI: assumes "∃x. x ∈ A" assumes "!!x y. [|x ∈ A; y ∈ A|] ==> ∃z∈A. x \<sqsubseteq> z ∧ y \<sqsubseteq> z" assumes "!!x y. [|x \<sqsubseteq> y; y ∈ A|] ==> x ∈ A" shows "ideal A" unfolding ideal_def using prems by fast lemma idealD1: "ideal A ==> ∃x. x ∈ A" unfolding ideal_def by fast lemma idealD2: "[|ideal A; x ∈ A; y ∈ A|] ==> ∃z∈A. x \<sqsubseteq> z ∧ y \<sqsubseteq> z" unfolding ideal_def by fast lemma idealD3: "[|ideal A; x \<sqsubseteq> y; y ∈ A|] ==> x ∈ A" unfolding ideal_def by fast lemma ideal_directed_finite: assumes A: "ideal A" shows "[|finite U; U ⊆ A|] ==> ∃z∈A. ∀x∈U. x \<sqsubseteq> z" apply (induct U set: finite) apply (simp add: idealD1 [OF A]) apply (simp, clarify, rename_tac y) apply (drule (1) idealD2 [OF A]) apply (clarify, erule_tac x=z in rev_bexI) apply (fast intro: trans_less) done lemma ideal_principal: "ideal {x. x \<sqsubseteq> z}" apply (rule idealI) apply (rule_tac x=z in exI) apply fast apply (rule_tac x=z in bexI, fast) apply fast apply (fast intro: trans_less) done lemma directed_image_ideal: assumes A: "ideal A" assumes f: "!!x y. x \<sqsubseteq> y ==> f x \<sqsubseteq> f y" shows "directed (f ` A)" apply (rule directedI) apply (cut_tac idealD1 [OF A], fast) apply (clarify, rename_tac a b) apply (drule (1) idealD2 [OF A]) apply (clarify, rename_tac c) apply (rule_tac x="f c" in rev_bexI) apply (erule imageI) apply (simp add: f) done lemma adm_ideal: "adm (λA. ideal A)" unfolding ideal_def by (intro adm_lemmas adm_set_lemmas) lemma lub_image_principal: assumes f: "!!x y. x \<sqsubseteq> y ==> f x \<sqsubseteq> f y" shows "(\<Squnion>x∈{x. x \<sqsubseteq> y}. f x) = f y" apply (rule thelubI) apply (rule is_lub_maximal) apply (rule ub_imageI) apply (simp add: f) apply (rule imageI) apply simp done end subsection {* Defining functions in terms of basis elements *} lemma finite_directed_contains_lub: "[|finite S; directed S|] ==> ∃u∈S. S <<| u" apply (drule (1) directed_finiteD, rule subset_refl) apply (erule bexE) apply (rule rev_bexI, assumption) apply (erule (1) is_lub_maximal) done lemma lub_finite_directed_in_self: "[|finite S; directed S|] ==> lub S ∈ S" apply (drule (1) finite_directed_contains_lub, clarify) apply (drule thelubI, simp) done lemma finite_directed_has_lub: "[|finite S; directed S|] ==> ∃u. S <<| u" by (drule (1) finite_directed_contains_lub, fast) lemma is_ub_thelub0: "[|∃u. S <<| u; x ∈ S|] ==> x \<sqsubseteq> lub S" apply (erule exE, drule lubI) apply (drule is_lubD1) apply (erule (1) is_ubD) done lemma is_lub_thelub0: "[|∃u. S <<| u; S <| x|] ==> lub S \<sqsubseteq> x" by (erule exE, drule lubI, erule is_lub_lub) locale basis_take = preorder r + fixes take :: "nat => 'a::type => 'a" assumes take_less: "r (take n a) a" assumes take_take: "take n (take n a) = take n a" assumes take_mono: "r a b ==> r (take n a) (take n b)" assumes take_chain: "r (take n a) (take (Suc n) a)" assumes finite_range_take: "finite (range (take n))" assumes take_covers: "∃n. take n a = a" locale ideal_completion = basis_take r + fixes principal :: "'a::type => 'b::cpo" fixes rep :: "'b::cpo => 'a::type set" assumes ideal_rep: "!!x. preorder.ideal r (rep x)" assumes cont_rep: "cont rep" assumes rep_principal: "!!a. rep (principal a) = {b. r b a}" assumes subset_repD: "!!x y. rep x ⊆ rep y ==> x \<sqsubseteq> y" begin lemma finite_take_rep: "finite (take n ` rep x)" by (rule finite_subset [OF image_mono [OF subset_UNIV] finite_range_take]) lemma basis_fun_lemma0: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "∃u. f ` take i ` rep x <<| u" apply (rule finite_directed_has_lub) apply (rule finite_imageI) apply (rule finite_take_rep) apply (subst image_image) apply (rule directed_image_ideal) apply (rule ideal_rep) apply (rule f_mono) apply (erule take_mono) done lemma basis_fun_lemma1: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "chain (λi. lub (f ` take i ` rep x))" apply (rule chainI) apply (rule is_lub_thelub0) apply (rule basis_fun_lemma0, erule f_mono) apply (rule is_ubI, clarsimp, rename_tac a) apply (rule sq_le.trans_less [OF f_mono [OF take_chain]]) apply (rule is_ub_thelub0) apply (rule basis_fun_lemma0, erule f_mono) apply simp done lemma basis_fun_lemma2: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "f ` rep x <<| (\<Squnion>i. lub (f ` take i ` rep x))" apply (rule is_lubI) apply (rule ub_imageI, rename_tac a) apply (cut_tac a=a in take_covers, erule exE, rename_tac i) apply (erule subst) apply (rule rev_trans_less) apply (rule_tac x=i in is_ub_thelub) apply (rule basis_fun_lemma1, erule f_mono) apply (rule is_ub_thelub0) apply (rule basis_fun_lemma0, erule f_mono) apply simp apply (rule is_lub_thelub [OF _ ub_rangeI]) apply (rule basis_fun_lemma1, erule f_mono) apply (rule is_lub_thelub0) apply (rule basis_fun_lemma0, erule f_mono) apply (rule is_ubI, clarsimp, rename_tac a) apply (rule sq_le.trans_less [OF f_mono [OF take_less]]) apply (erule (1) ub_imageD) done lemma basis_fun_lemma: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "∃u. f ` rep x <<| u" by (rule exI, rule basis_fun_lemma2, erule f_mono) lemma rep_mono: "x \<sqsubseteq> y ==> rep x ⊆ rep y" apply (drule cont_rep [THEN cont2mono, THEN monofunE]) apply (simp add: set_cpo_simps) done lemma rep_contlub: "chain Y ==> rep (\<Squnion>i. Y i) = (\<Union>i. rep (Y i))" by (simp add: cont2contlubE [OF cont_rep] set_cpo_simps) lemma less_def: "x \<sqsubseteq> y <-> rep x ⊆ rep y" by (rule iffI [OF rep_mono subset_repD]) lemma rep_eq: "rep x = {a. principal a \<sqsubseteq> x}" unfolding less_def rep_principal apply safe apply (erule (1) idealD3 [OF ideal_rep]) apply (erule subsetD, simp add: refl) done lemma mem_rep_iff_principal_less: "a ∈ rep x <-> principal a \<sqsubseteq> x" by (simp add: rep_eq) lemma principal_less_iff_mem_rep: "principal a \<sqsubseteq> x <-> a ∈ rep x" by (simp add: rep_eq) lemma principal_less_iff: "principal a \<sqsubseteq> principal b <-> r a b" by (simp add: principal_less_iff_mem_rep rep_principal) lemma principal_eq_iff: "principal a = principal b <-> r a b ∧ r b a" unfolding po_eq_conv [where 'a='b] principal_less_iff .. lemma repD: "a ∈ rep x ==> principal a \<sqsubseteq> x" by (simp add: rep_eq) lemma principal_mono: "r a b ==> principal a \<sqsubseteq> principal b" by (simp add: principal_less_iff) lemma lessI: "(!!a. principal a \<sqsubseteq> x ==> principal a \<sqsubseteq> u) ==> x \<sqsubseteq> u" unfolding principal_less_iff_mem_rep by (simp add: less_def subset_eq) lemma lub_principal_rep: "principal ` rep x <<| x" apply (rule is_lubI) apply (rule ub_imageI) apply (erule repD) apply (subst less_def) apply (rule subsetI) apply (drule (1) ub_imageD) apply (simp add: rep_eq) done definition basis_fun :: "('a::type => 'c::cpo) => 'b -> 'c" where "basis_fun = (λf. (Λ x. lub (f ` rep x)))" lemma basis_fun_beta: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "basis_fun f·x = lub (f ` rep x)" unfolding basis_fun_def proof (rule beta_cfun) have lub: "!!x. ∃u. f ` rep x <<| u" using f_mono by (rule basis_fun_lemma) show cont: "cont (λx. lub (f ` rep x))" apply (rule contI2) apply (rule monofunI) apply (rule is_lub_thelub0 [OF lub ub_imageI]) apply (rule is_ub_thelub0 [OF lub imageI]) apply (erule (1) subsetD [OF rep_mono]) apply (rule is_lub_thelub0 [OF lub ub_imageI]) apply (simp add: rep_contlub, clarify) apply (erule rev_trans_less [OF is_ub_thelub]) apply (erule is_ub_thelub0 [OF lub imageI]) done qed lemma basis_fun_principal: fixes f :: "'a::type => 'c::cpo" assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" shows "basis_fun f·(principal a) = f a" apply (subst basis_fun_beta, erule f_mono) apply (subst rep_principal) apply (rule lub_image_principal, erule f_mono) done lemma basis_fun_mono: assumes f_mono: "!!a b. r a b ==> f a \<sqsubseteq> f b" assumes g_mono: "!!a b. r a b ==> g a \<sqsubseteq> g b" assumes less: "!!a. f a \<sqsubseteq> g a" shows "basis_fun f \<sqsubseteq> basis_fun g" apply (rule less_cfun_ext) apply (simp only: basis_fun_beta f_mono g_mono) apply (rule is_lub_thelub0) apply (rule basis_fun_lemma, erule f_mono) apply (rule ub_imageI, rename_tac a) apply (rule sq_le.trans_less [OF less]) apply (rule is_ub_thelub0) apply (rule basis_fun_lemma, erule g_mono) apply (erule imageI) done lemma compact_principal: "compact (principal a)" by (rule compactI2, simp add: principal_less_iff_mem_rep rep_contlub) definition completion_approx :: "nat => 'b -> 'b" where "completion_approx = (λi. basis_fun (λa. principal (take i a)))" lemma completion_approx_beta: "completion_approx i·x = (\<Squnion>a∈rep x. principal (take i a))" unfolding completion_approx_def by (simp add: basis_fun_beta principal_mono take_mono) lemma completion_approx_principal: "completion_approx i·(principal a) = principal (take i a)" unfolding completion_approx_def by (simp add: basis_fun_principal principal_mono take_mono) lemma chain_completion_approx: "chain completion_approx" unfolding completion_approx_def apply (rule chainI) apply (rule basis_fun_mono) apply (erule principal_mono [OF take_mono]) apply (erule principal_mono [OF take_mono]) apply (rule principal_mono [OF take_chain]) done lemma lub_completion_approx: "(\<Squnion>i. completion_approx i·x) = x" unfolding completion_approx_beta apply (subst image_image [where f=principal, symmetric]) apply (rule unique_lub [OF _ lub_principal_rep]) apply (rule basis_fun_lemma2, erule principal_mono) done lemma completion_approx_eq_principal: "∃a∈rep x. completion_approx i·x = principal (take i a)" unfolding completion_approx_beta apply (subst image_image [where f=principal, symmetric]) apply (subgoal_tac "finite (principal ` take i ` rep x)") apply (subgoal_tac "directed (principal ` take i ` rep x)") apply (drule (1) lub_finite_directed_in_self, fast) apply (subst image_image) apply (rule directed_image_ideal) apply (rule ideal_rep) apply (erule principal_mono [OF take_mono]) apply (rule finite_imageI) apply (rule finite_take_rep) done lemma completion_approx_idem: "completion_approx i·(completion_approx i·x) = completion_approx i·x" using completion_approx_eq_principal [where i=i and x=x] by (auto simp add: completion_approx_principal take_take) lemma finite_fixes_completion_approx: "finite {x. completion_approx i·x = x}" (is "finite ?S") apply (subgoal_tac "?S ⊆ principal ` range (take i)") apply (erule finite_subset) apply (rule finite_imageI) apply (rule finite_range_take) apply (clarify, erule subst) apply (cut_tac x=x and i=i in completion_approx_eq_principal) apply fast done lemma principal_induct: assumes adm: "adm P" assumes P: "!!a. P (principal a)" shows "P x" apply (subgoal_tac "P (\<Squnion>i. completion_approx i·x)") apply (simp add: lub_completion_approx) apply (rule admD [OF adm]) apply (simp add: chain_completion_approx) apply (cut_tac x=x and i=i in completion_approx_eq_principal) apply (clarify, simp add: P) done end subsection {* Compact bases of bifinite domains *} defaultsort profinite typedef (open) 'a compact_basis = "{x::'a::profinite. compact x}" by (fast intro: compact_approx) lemma compact_Rep_compact_basis [simp]: "compact (Rep_compact_basis a)" by (rule Rep_compact_basis [unfolded mem_Collect_eq]) lemma Rep_Abs_compact_basis_approx [simp]: "Rep_compact_basis (Abs_compact_basis (approx n·x)) = approx n·x" by (rule Abs_compact_basis_inverse, simp) lemma compact_imp_Rep_compact_basis: "compact x ==> ∃y. x = Rep_compact_basis y" by (rule exI, rule Abs_compact_basis_inverse [symmetric], simp) instantiation compact_basis :: (profinite) sq_ord begin definition compact_le_def: "(op \<sqsubseteq>) ≡ (λx y. Rep_compact_basis x \<sqsubseteq> Rep_compact_basis y)" instance .. end instance compact_basis :: (profinite) po by (rule typedef_po [OF type_definition_compact_basis compact_le_def]) text {* minimal compact element *} definition compact_bot :: "'a::bifinite compact_basis" where "compact_bot = Abs_compact_basis ⊥" lemma Rep_compact_bot: "Rep_compact_basis compact_bot = ⊥" unfolding compact_bot_def by (simp add: Abs_compact_basis_inverse) lemma compact_minimal [simp]: "compact_bot \<sqsubseteq> a" unfolding compact_le_def Rep_compact_bot by simp text {* compacts *} definition compacts :: "'a => 'a compact_basis set" where "compacts = (λx. {a. Rep_compact_basis a \<sqsubseteq> x})" lemma ideal_compacts: "preorder.ideal sq_le (compacts w)" unfolding compacts_def apply (rule preorder.idealI) apply (rule preorder_class.axioms) apply (rule_tac x="Abs_compact_basis (approx 0·w)" in exI) apply (simp add: approx_less) apply simp apply (cut_tac a=x in compact_Rep_compact_basis) apply (cut_tac a=y in compact_Rep_compact_basis) apply (drule bifinite_compact_eq_approx) apply (drule bifinite_compact_eq_approx) apply (clarify, rename_tac i j) apply (rule_tac x="Abs_compact_basis (approx (max i j)·w)" in exI) apply (simp add: approx_less compact_le_def) apply (erule subst, erule subst) apply (simp add: monofun_cfun chain_mono [OF chain_approx]) apply (simp add: compact_le_def) apply (erule (1) trans_less) done lemma compacts_Rep_compact_basis: "compacts (Rep_compact_basis b) = {a. a \<sqsubseteq> b}" unfolding compacts_def compact_le_def .. lemma cont_compacts: "cont compacts" unfolding compacts_def apply (rule contI2) apply (rule monofunI) apply (simp add: set_cpo_simps) apply (fast intro: trans_less) apply (simp add: set_cpo_simps) apply clarify apply simp apply (erule (1) compactD2 [OF compact_Rep_compact_basis]) done lemma compacts_lessD: "compacts x ⊆ compacts y ==> x \<sqsubseteq> y" apply (subgoal_tac "(\<Squnion>i. approx i·x) \<sqsubseteq> y", simp) apply (rule admD, simp, simp) apply (drule_tac c="Abs_compact_basis (approx i·x)" in subsetD) apply (simp add: compacts_def Abs_compact_basis_inverse approx_less) apply (simp add: compacts_def Abs_compact_basis_inverse) done lemma compacts_mono: "x \<sqsubseteq> y ==> compacts x ⊆ compacts y" unfolding compacts_def by (fast intro: trans_less) lemma less_compact_basis_iff: "(x \<sqsubseteq> y) = (compacts x ⊆ compacts y)" by (rule iffI [OF compacts_mono compacts_lessD]) lemma compact_basis_induct: "[|adm P; !!a. P (Rep_compact_basis a)|] ==> P x" apply (erule approx_induct) apply (drule_tac x="Abs_compact_basis (approx n·x)" in meta_spec) apply (simp add: Abs_compact_basis_inverse) done text {* approximation on compact bases *} definition compact_approx :: "nat => 'a compact_basis => 'a compact_basis" where "compact_approx = (λn a. Abs_compact_basis (approx n·(Rep_compact_basis a)))" lemma Rep_compact_approx: "Rep_compact_basis (compact_approx n a) = approx n·(Rep_compact_basis a)" unfolding compact_approx_def by (simp add: Abs_compact_basis_inverse) lemmas approx_Rep_compact_basis = Rep_compact_approx [symmetric] lemma compact_approx_le: "compact_approx n a \<sqsubseteq> a" unfolding compact_le_def by (simp add: Rep_compact_approx approx_less) lemma compact_approx_mono1: "i ≤ j ==> compact_approx i a \<sqsubseteq> compact_approx j a" unfolding compact_le_def apply (simp add: Rep_compact_approx) apply (rule chain_mono, simp, assumption) done lemma compact_approx_mono: "a \<sqsubseteq> b ==> compact_approx n a \<sqsubseteq> compact_approx n b" unfolding compact_le_def apply (simp add: Rep_compact_approx) apply (erule monofun_cfun_arg) done lemma ex_compact_approx_eq: "∃n. compact_approx n a = a" apply (simp add: Rep_compact_basis_inject [symmetric]) apply (simp add: Rep_compact_approx) apply (rule bifinite_compact_eq_approx) apply (rule compact_Rep_compact_basis) done lemma compact_approx_idem: "compact_approx n (compact_approx n a) = compact_approx n a" apply (rule Rep_compact_basis_inject [THEN iffD1]) apply (simp add: Rep_compact_approx) done lemma finite_fixes_compact_approx: "finite {a. compact_approx n a = a}" apply (subgoal_tac "finite (Rep_compact_basis ` {a. compact_approx n a = a})") apply (erule finite_imageD) apply (rule inj_onI, simp add: Rep_compact_basis_inject) apply (rule finite_subset [OF _ finite_fixes_approx [where i=n]]) apply (rule subsetI, clarify, rename_tac a) apply (simp add: Rep_compact_basis_inject [symmetric]) apply (simp add: Rep_compact_approx) done lemma finite_range_compact_approx: "finite (range (compact_approx n))" apply (cut_tac n=n in finite_fixes_compact_approx) apply (simp add: idem_fixes_eq_range compact_approx_idem) apply (simp add: image_def) done interpretation compact_basis: ideal_completion [sq_le compact_approx Rep_compact_basis compacts] proof (unfold_locales) fix n :: nat and a b :: "'a compact_basis" and x :: "'a" show "compact_approx n a \<sqsubseteq> a" by (rule compact_approx_le) show "compact_approx n (compact_approx n a) = compact_approx n a" by (rule compact_approx_idem) show "compact_approx n a \<sqsubseteq> compact_approx (Suc n) a" by (rule compact_approx_mono1, simp) show "finite (range (compact_approx n))" by (rule finite_range_compact_approx) show "∃n::nat. compact_approx n a = a" by (rule ex_compact_approx_eq) show "preorder.ideal sq_le (compacts x)" by (rule ideal_compacts) show "cont compacts" by (rule cont_compacts) show "compacts (Rep_compact_basis a) = {b. b \<sqsubseteq> a}" by (rule compacts_Rep_compact_basis) next fix n :: nat and a b :: "'a compact_basis" assume "a \<sqsubseteq> b" thus "compact_approx n a \<sqsubseteq> compact_approx n b" by (rule compact_approx_mono) next fix x y :: "'a" assume "compacts x ⊆ compacts y" thus "x \<sqsubseteq> y" by (rule compacts_lessD) qed subsection {* A compact basis for powerdomains *} typedef 'a pd_basis = "{S::'a::profinite compact_basis set. finite S ∧ S ≠ {}}" by (rule_tac x="{arbitrary}" in exI, simp) lemma finite_Rep_pd_basis [simp]: "finite (Rep_pd_basis u)" by (insert Rep_pd_basis [of u, unfolded pd_basis_def]) simp lemma Rep_pd_basis_nonempty [simp]: "Rep_pd_basis u ≠ {}" by (insert Rep_pd_basis [of u, unfolded pd_basis_def]) simp text {* unit and plus *} definition PDUnit :: "'a compact_basis => 'a pd_basis" where "PDUnit = (λx. Abs_pd_basis {x})" definition PDPlus :: "'a pd_basis => 'a pd_basis => 'a pd_basis" where "PDPlus t u = Abs_pd_basis (Rep_pd_basis t ∪ Rep_pd_basis u)" lemma Rep_PDUnit: "Rep_pd_basis (PDUnit x) = {x}" unfolding PDUnit_def by (rule Abs_pd_basis_inverse) (simp add: pd_basis_def) lemma Rep_PDPlus: "Rep_pd_basis (PDPlus u v) = Rep_pd_basis u ∪ Rep_pd_basis v" unfolding PDPlus_def by (rule Abs_pd_basis_inverse) (simp add: pd_basis_def) lemma PDUnit_inject [simp]: "(PDUnit a = PDUnit b) = (a = b)" unfolding Rep_pd_basis_inject [symmetric] Rep_PDUnit by simp lemma PDPlus_assoc: "PDPlus (PDPlus t u) v = PDPlus t (PDPlus u v)" unfolding Rep_pd_basis_inject [symmetric] Rep_PDPlus by (rule Un_assoc) lemma PDPlus_commute: "PDPlus t u = PDPlus u t" unfolding Rep_pd_basis_inject [symmetric] Rep_PDPlus by (rule Un_commute) lemma PDPlus_absorb: "PDPlus t t = t" unfolding Rep_pd_basis_inject [symmetric] Rep_PDPlus by (rule Un_absorb) lemma pd_basis_induct1: assumes PDUnit: "!!a. P (PDUnit a)" assumes PDPlus: "!!a t. P t ==> P (PDPlus (PDUnit a) t)" shows "P x" apply (induct x, unfold pd_basis_def, clarify) apply (erule (1) finite_ne_induct) apply (cut_tac a=x in PDUnit) apply (simp add: PDUnit_def) apply (drule_tac a=x in PDPlus) apply (simp add: PDUnit_def PDPlus_def Abs_pd_basis_inverse [unfolded pd_basis_def]) done lemma pd_basis_induct: assumes PDUnit: "!!a. P (PDUnit a)" assumes PDPlus: "!!t u. [|P t; P u|] ==> P (PDPlus t u)" shows "P x" apply (induct x rule: pd_basis_induct1) apply (rule PDUnit, erule PDPlus [OF PDUnit]) done text {* fold-pd *} definition fold_pd :: "('a compact_basis => 'b::type) => ('b => 'b => 'b) => 'a pd_basis => 'b" where "fold_pd g f t = fold1 f (g ` Rep_pd_basis t)" lemma fold_pd_PDUnit: includes ab_semigroup_idem_mult f shows "fold_pd g f (PDUnit x) = g x" unfolding fold_pd_def Rep_PDUnit by simp lemma fold_pd_PDPlus: includes ab_semigroup_idem_mult f shows "fold_pd g f (PDPlus t u) = f (fold_pd g f t) (fold_pd g f u)" unfolding fold_pd_def Rep_PDPlus by (simp add: image_Un fold1_Un2) text {* approx-pd *} definition approx_pd :: "nat => 'a pd_basis => 'a pd_basis" where "approx_pd n = (λt. Abs_pd_basis (compact_approx n ` Rep_pd_basis t))" lemma Rep_approx_pd: "Rep_pd_basis (approx_pd n t) = compact_approx n ` Rep_pd_basis t" unfolding approx_pd_def apply (rule Abs_pd_basis_inverse) apply (simp add: pd_basis_def) done lemma approx_pd_simps [simp]: "approx_pd n (PDUnit a) = PDUnit (compact_approx n a)" "approx_pd n (PDPlus t u) = PDPlus (approx_pd n t) (approx_pd n u)" apply (simp_all add: Rep_pd_basis_inject [symmetric]) apply (simp_all add: Rep_approx_pd Rep_PDUnit Rep_PDPlus image_Un) done lemma approx_pd_idem: "approx_pd n (approx_pd n t) = approx_pd n t" apply (induct t rule: pd_basis_induct) apply (simp add: compact_approx_idem) apply simp done lemma range_image_f: "range (image f) = Pow (range f)" apply (safe, fast) apply (rule_tac x="f -` x" in range_eqI) apply (simp, fast) done lemma finite_range_approx_pd: "finite (range (approx_pd n))" apply (subgoal_tac "finite (Rep_pd_basis ` range (approx_pd n))") apply (erule finite_imageD) apply (rule inj_onI, simp add: Rep_pd_basis_inject) apply (subst image_image) apply (subst Rep_approx_pd) apply (simp only: range_composition) apply (rule finite_subset [OF image_mono [OF subset_UNIV]]) apply (simp add: range_image_f) apply (rule finite_range_compact_approx) done lemma ex_approx_pd_eq: "∃n. approx_pd n t = t" apply (subgoal_tac "∃n. ∀m≥n. approx_pd m t = t", fast) apply (induct t rule: pd_basis_induct) apply (cut_tac a=a in ex_compact_approx_eq) apply (clarify, rule_tac x=n in exI) apply (clarify, simp) apply (rule antisym_less) apply (rule compact_approx_le) apply (drule_tac a=a in compact_approx_mono1) apply simp apply (clarify, rename_tac i j) apply (rule_tac x="max i j" in exI, simp) done end
lemma idealI:
[| ∃x. x ∈ A; !!x y. [| x ∈ A; y ∈ A |] ==> ∃z∈A. x << z ∧ y << z;
!!x y. [| x << y; y ∈ A |] ==> x ∈ A |]
==> ideal A
lemma idealD1:
ideal A ==> ∃x. x ∈ A
lemma idealD2:
[| ideal A; x ∈ A; y ∈ A |] ==> ∃z∈A. x << z ∧ y << z
lemma idealD3:
[| ideal A; x << y; y ∈ A |] ==> x ∈ A
lemma ideal_directed_finite:
[| ideal A; finite U; U ⊆ A |] ==> ∃z∈A. ∀x∈U. x << z
lemma ideal_principal:
ideal {x. x << z}
lemma directed_image_ideal:
[| ideal A; !!x y. x << y ==> f x << f y |] ==> directed (f ` A)
lemma adm_ideal:
adm ideal
lemma lub_image_principal:
(!!x y. x << y ==> f x << f y) ==> lub (f ` {x. x << y}) = f y
lemma finite_directed_contains_lub:
[| finite S; directed S |] ==> ∃u∈S. S <<| u
lemma lub_finite_directed_in_self:
[| finite S; directed S |] ==> lub S ∈ S
lemma finite_directed_has_lub:
[| finite S; directed S |] ==> ∃u. S <<| u
lemma is_ub_thelub0:
[| ∃u. S <<| u; x ∈ S |] ==> x << lub S
lemma is_lub_thelub0:
[| ∃u. S <<| u; S <| x |] ==> lub S << x
lemma finite_take_rep:
finite (take n ` rep x)
lemma basis_fun_lemma0:
(!!a b. r a b ==> f a << f b) ==> ∃u. f ` take i ` rep x <<| u
lemma basis_fun_lemma1:
(!!a b. r a b ==> f a << f b) ==> chain (λi. lub (f ` take i ` rep x))
lemma basis_fun_lemma2:
(!!a b. r a b ==> f a << f b)
==> f ` rep x <<| (LUB i. lub (f ` take i ` rep x))
lemma basis_fun_lemma:
(!!a b. r a b ==> f a << f b) ==> ∃u. f ` rep x <<| u
lemma rep_mono:
x << y ==> rep x ⊆ rep y
lemma rep_contlub:
chain Y ==> rep (LUB i. Y i) = (UN i. rep (Y i))
lemma less_def:
x << y = (rep x ⊆ rep y)
lemma rep_eq:
rep x = {a. principal a << x}
lemma mem_rep_iff_principal_less:
(a ∈ rep x) = principal a << x
lemma principal_less_iff_mem_rep:
principal a << x = (a ∈ rep x)
lemma principal_less_iff:
principal a << principal b = r a b
lemma principal_eq_iff:
(principal a = principal b) = (r a b ∧ r b a)
lemma repD:
a ∈ rep x ==> principal a << x
lemma principal_mono:
r a b ==> principal a << principal b
lemma lessI:
(!!a. principal a << x ==> principal a << u) ==> x << u
lemma lub_principal_rep:
principal ` rep x <<| x
lemma basis_fun_beta:
(!!a b. r a b ==> f a << f b) ==> basis_fun f·x = lub (f ` rep x)
lemma basis_fun_principal:
(!!a b. r a b ==> f a << f b) ==> basis_fun f·(principal a) = f a
lemma basis_fun_mono:
[| !!a b. r a b ==> f a << f b; !!a b. r a b ==> g a << g b; !!a. f a << g a |]
==> basis_fun f << basis_fun g
lemma compact_principal:
compact (principal a)
lemma completion_approx_beta:
completion_approx i·x = (LUB a:rep x. principal (take i a))
lemma completion_approx_principal:
completion_approx i·(principal a) = principal (take i a)
lemma chain_completion_approx:
chain completion_approx
lemma lub_completion_approx:
(LUB i. completion_approx i·x) = x
lemma completion_approx_eq_principal:
∃a∈rep x. completion_approx i·x = principal (take i a)
lemma completion_approx_idem:
completion_approx i·(completion_approx i·x) = completion_approx i·x
lemma finite_fixes_completion_approx:
finite {x. completion_approx i·x = x}
lemma principal_induct:
[| adm P; !!a. P (principal a) |] ==> P x
lemma compact_Rep_compact_basis:
compact (Rep_compact_basis a)
lemma Rep_Abs_compact_basis_approx:
Rep_compact_basis (Abs_compact_basis (approx n·x)) = approx n·x
lemma compact_imp_Rep_compact_basis:
compact x ==> ∃y. x = Rep_compact_basis y
lemma Rep_compact_bot:
Rep_compact_basis compact_bot = UU
lemma compact_minimal:
compact_bot << a
lemma ideal_compacts:
preorder.ideal op << (compacts w)
lemma compacts_Rep_compact_basis:
compacts (Rep_compact_basis b) = {a. a << b}
lemma cont_compacts:
cont compacts
lemma compacts_lessD:
compacts x ⊆ compacts y ==> x << y
lemma compacts_mono:
x << y ==> compacts x ⊆ compacts y
lemma less_compact_basis_iff:
x << y = (compacts x ⊆ compacts y)
lemma compact_basis_induct:
[| adm P; !!a. P (Rep_compact_basis a) |] ==> P x
lemma Rep_compact_approx:
Rep_compact_basis (compact_approx n a) = approx n·(Rep_compact_basis a)
lemma approx_Rep_compact_basis:
approx n·(Rep_compact_basis a) = Rep_compact_basis (compact_approx n a)
lemma compact_approx_le:
compact_approx n a << a
lemma compact_approx_mono1:
i ≤ j ==> compact_approx i a << compact_approx j a
lemma compact_approx_mono:
a << b ==> compact_approx n a << compact_approx n b
lemma ex_compact_approx_eq:
∃n. compact_approx n a = a
lemma compact_approx_idem:
compact_approx n (compact_approx n a) = compact_approx n a
lemma finite_fixes_compact_approx:
finite {a. compact_approx n a = a}
lemma finite_range_compact_approx:
finite (range (compact_approx n))
lemma finite_Rep_pd_basis:
finite (Rep_pd_basis u)
lemma Rep_pd_basis_nonempty:
Rep_pd_basis u ≠ {}
lemma Rep_PDUnit:
Rep_pd_basis (PDUnit x) = {x}
lemma Rep_PDPlus:
Rep_pd_basis (PDPlus u v) = Rep_pd_basis u ∪ Rep_pd_basis v
lemma PDUnit_inject:
(PDUnit a = PDUnit b) = (a = b)
lemma PDPlus_assoc:
PDPlus (PDPlus t u) v = PDPlus t (PDPlus u v)
lemma PDPlus_commute:
PDPlus t u = PDPlus u t
lemma PDPlus_absorb:
PDPlus t t = t
lemma pd_basis_induct1:
[| !!a. P (PDUnit a); !!a t. P t ==> P (PDPlus (PDUnit a) t) |] ==> P x
lemma pd_basis_induct:
[| !!a. P (PDUnit a); !!t u. [| P t; P u |] ==> P (PDPlus t u) |] ==> P x
lemma fold_pd_PDUnit:
ab_semigroup_idem_mult f ==> fold_pd g f (PDUnit x) = g x
lemma fold_pd_PDPlus:
ab_semigroup_idem_mult f
==> fold_pd g f (PDPlus t u) = f (fold_pd g f t) (fold_pd g f u)
lemma Rep_approx_pd:
Rep_pd_basis (approx_pd n t) = compact_approx n ` Rep_pd_basis t
lemma approx_pd_simps:
approx_pd n (PDUnit a) = PDUnit (compact_approx n a)
approx_pd n (PDPlus t u) = PDPlus (approx_pd n t) (approx_pd n u)
lemma approx_pd_idem:
approx_pd n (approx_pd n t) = approx_pd n t
lemma range_image_f:
range (op ` f) = Pow (range f)
lemma finite_range_approx_pd:
finite (range (approx_pd n))
lemma ex_approx_pd_eq:
∃n. approx_pd n t = t