header {* Admissibility and compactness *}
theory Adm
imports Cont
begin
defaultsort cpo
subsection {* Definitions *}
definition
adm :: "('a::cpo => bool) => bool" where
"adm P = (∀Y. chain Y --> (∀i. P (Y i)) --> P (\<Squnion>i. Y i))"
lemma admI:
"(!!Y. [|chain Y; ∀i. P (Y i)|] ==> P (\<Squnion>i. Y i)) ==> adm P"
unfolding adm_def by fast
lemma admD: "[|adm P; chain Y; !!i. P (Y i)|] ==> P (\<Squnion>i. Y i)"
unfolding adm_def by fast
lemma admD2: "[|adm (λx. ¬ P x); chain Y; P (\<Squnion>i. Y i)|] ==> ∃i. P (Y i)"
unfolding adm_def by fast
lemma triv_admI: "∀x. P x ==> adm P"
by (rule admI, erule spec)
text {* improved admissibility introduction *}
lemma admI2:
"(!!Y. [|chain Y; ∀i. P (Y i); ∀i. ∃j>i. Y i ≠ Y j ∧ Y i \<sqsubseteq> Y j|]
==> P (\<Squnion>i. Y i)) ==> adm P"
apply (rule admI)
apply (erule (1) increasing_chain_adm_lemma)
apply fast
done
subsection {* Admissibility on chain-finite types *}
text {* for chain-finite (easy) types every formula is admissible *}
lemma adm_chfin: "adm (P::'a::chfin => bool)"
by (rule admI, frule chfin, auto simp add: maxinch_is_thelub)
subsection {* Admissibility of special formulae and propagation *}
lemma adm_not_free: "adm (λx. t)"
by (rule admI, simp)
lemma adm_conj: "[|adm P; adm Q|] ==> adm (λx. P x ∧ Q x)"
by (fast intro: admI elim: admD)
lemma adm_all: "(!!y. adm (λx. P x y)) ==> adm (λx. ∀y. P x y)"
by (fast intro: admI elim: admD)
lemma adm_ball: "(!!y. y ∈ A ==> adm (λx. P x y)) ==> adm (λx. ∀y∈A. P x y)"
by (fast intro: admI elim: admD)
text {* Admissibility for disjunction is hard to prove. It takes 5 Lemmas *}
lemma adm_disj_lemma1:
"[|chain (Y::nat => 'a::cpo); ∀i. ∃j≥i. P (Y j)|]
==> chain (λi. Y (LEAST j. i ≤ j ∧ P (Y j)))"
apply (rule chainI)
apply (erule chain_mono)
apply (rule Least_le)
apply (rule LeastI2_ex)
apply simp_all
done
lemmas adm_disj_lemma2 = LeastI_ex [of "λj. i ≤ j ∧ P (Y j)", standard]
lemma adm_disj_lemma3:
"[|chain (Y::nat => 'a::cpo); ∀i. ∃j≥i. P (Y j)|] ==>
(\<Squnion>i. Y i) = (\<Squnion>i. Y (LEAST j. i ≤ j ∧ P (Y j)))"
apply (frule (1) adm_disj_lemma1)
apply (rule antisym_less)
apply (rule lub_mono, assumption+)
apply (erule chain_mono)
apply (simp add: adm_disj_lemma2)
apply (rule lub_range_mono, fast, assumption+)
done
lemma adm_disj_lemma4:
"[|adm P; chain Y; ∀i. ∃j≥i. P (Y j)|] ==> P (\<Squnion>i. Y i)"
apply (subst adm_disj_lemma3, assumption+)
apply (erule admD)
apply (simp add: adm_disj_lemma1)
apply (simp add: adm_disj_lemma2)
done
lemma adm_disj_lemma5:
"∀n::nat. P n ∨ Q n ==> (∀i. ∃j≥i. P j) ∨ (∀i. ∃j≥i. Q j)"
apply (erule contrapos_pp)
apply (clarsimp, rename_tac a b)
apply (rule_tac x="max a b" in exI)
apply simp
done
lemma adm_disj: "[|adm P; adm Q|] ==> adm (λx. P x ∨ Q x)"
apply (rule admI)
apply (erule adm_disj_lemma5 [THEN disjE])
apply (erule (2) adm_disj_lemma4 [THEN disjI1])
apply (erule (2) adm_disj_lemma4 [THEN disjI2])
done
lemma adm_imp: "[|adm (λx. ¬ P x); adm Q|] ==> adm (λx. P x --> Q x)"
by (subst imp_conv_disj, rule adm_disj)
lemma adm_iff:
"[|adm (λx. P x --> Q x); adm (λx. Q x --> P x)|]
==> adm (λx. P x = Q x)"
by (subst iff_conv_conj_imp, rule adm_conj)
lemma adm_not_conj:
"[|adm (λx. ¬ P x); adm (λx. ¬ Q x)|] ==> adm (λx. ¬ (P x ∧ Q x))"
by (simp add: adm_imp)
text {* admissibility and continuity *}
lemma adm_less: "[|cont u; cont v|] ==> adm (λx. u x \<sqsubseteq> v x)"
apply (rule admI)
apply (simp add: cont2contlubE)
apply (rule lub_mono)
apply (erule (1) ch2ch_cont)
apply (erule (1) ch2ch_cont)
apply (erule spec)
done
lemma adm_eq: "[|cont u; cont v|] ==> adm (λx. u x = v x)"
by (simp add: po_eq_conv adm_conj adm_less)
lemma adm_subst: "[|cont t; adm P|] ==> adm (λx. P (t x))"
apply (rule admI)
apply (simp add: cont2contlubE)
apply (erule admD)
apply (erule (1) ch2ch_cont)
apply (erule spec)
done
lemma adm_not_less: "cont t ==> adm (λx. ¬ t x \<sqsubseteq> u)"
apply (rule admI)
apply (drule_tac x=0 in spec)
apply (erule contrapos_nn)
apply (erule rev_trans_less)
apply (erule cont2mono [THEN monofunE])
apply (erule is_ub_thelub)
done
subsection {* Compactness *}
definition
compact :: "'a::cpo => bool" where
"compact k = adm (λx. ¬ k \<sqsubseteq> x)"
lemma compactI: "adm (λx. ¬ k \<sqsubseteq> x) ==> compact k"
unfolding compact_def .
lemma compactD: "compact k ==> adm (λx. ¬ k \<sqsubseteq> x)"
unfolding compact_def .
lemma compactI2:
"(!!Y. [|chain Y; x \<sqsubseteq> (\<Squnion>i. Y i)|] ==> ∃i. x \<sqsubseteq> Y i) ==> compact x"
unfolding compact_def adm_def by fast
lemma compactD2:
"[|compact x; chain Y; x \<sqsubseteq> (\<Squnion>i. Y i)|] ==> ∃i. x \<sqsubseteq> Y i"
unfolding compact_def adm_def by fast
lemma compact_chfin [simp]: "compact (x::'a::chfin)"
by (rule compactI [OF adm_chfin])
lemma compact_imp_max_in_chain:
"[|chain Y; compact (\<Squnion>i. Y i)|] ==> ∃i. max_in_chain i Y"
apply (drule (1) compactD2, simp)
apply (erule exE, rule_tac x=i in exI)
apply (rule max_in_chainI)
apply (rule antisym_less)
apply (erule (1) chain_mono)
apply (erule (1) trans_less [OF is_ub_thelub])
done
text {* admissibility and compactness *}
lemma adm_compact_not_less: "[|compact k; cont t|] ==> adm (λx. ¬ k \<sqsubseteq> t x)"
unfolding compact_def by (rule adm_subst)
lemma adm_neq_compact: "[|compact k; cont t|] ==> adm (λx. t x ≠ k)"
by (simp add: po_eq_conv adm_imp adm_not_less adm_compact_not_less)
lemma adm_compact_neq: "[|compact k; cont t|] ==> adm (λx. k ≠ t x)"
by (simp add: po_eq_conv adm_imp adm_not_less adm_compact_not_less)
lemma compact_UU [simp, intro]: "compact ⊥"
by (rule compactI, simp add: adm_not_free)
lemma adm_not_UU: "cont t ==> adm (λx. t x ≠ ⊥)"
by (simp add: adm_neq_compact)
text {* Any upward-closed predicate is admissible. *}
lemma adm_upward:
assumes P: "!!x y. [|P x; x \<sqsubseteq> y|] ==> P y"
shows "adm P"
by (rule admI, drule spec, erule P, erule is_ub_thelub)
lemmas adm_lemmas [simp] =
adm_not_free adm_conj adm_all adm_ball adm_disj adm_imp adm_iff
adm_less adm_eq adm_not_less
adm_compact_not_less adm_compact_neq adm_neq_compact adm_not_UU
end