Theory Adm

Up to index of Isabelle/HOLCF

theory Adm
imports Cont
begin

(*  Title:      HOLCF/Adm.thy
    ID:         $Id: Adm.thy,v 1.12 2007/10/21 12:21:48 wenzelm Exp $
    Author:     Franz Regensburger
*)

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))"

definition
  compact :: "'a::cpo => bool" where
  "compact k = adm (λx. ¬ k \<sqsubseteq> x)"

lemma admI:
   "(!!Y. [|chain Y; ∀i. P (Y i)|] ==> P (\<Squnion>i. Y i)) ==> adm P"
by (unfold adm_def, fast)

lemma triv_admI: "∀x. P x ==> adm P"
by (rule admI, erule spec)

lemma admD: "[|adm P; chain Y; ∀i. P (Y i)|] ==> P (\<Squnion>i. Y i)"
by (unfold adm_def, fast)

lemma compactI: "adm (λx. ¬ k \<sqsubseteq> x) ==> compact k"
by (unfold compact_def)

lemma compactD: "compact k ==> adm (λx. ¬ k \<sqsubseteq> x)"
by (unfold compact_def)

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_max_in_chain: 
  "∀Y. chain (Y::nat => 'a) --> (∃n. max_in_chain n Y)
    ==> adm (P::'a => bool)"
by (auto simp add: adm_def maxinch_is_thelub)

lemmas adm_chfin = chfin [THEN adm_max_in_chain, standard]

lemma compact_chfin: "compact (x::'a::chfin)"
by (rule compactI, rule adm_chfin)

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 elim: admD intro: admI)

lemma adm_all: "∀y. adm (P y) ==> adm (λx. ∀y. P y x)"
by (fast intro: admI elim: admD)

lemma adm_ball: "∀y∈A. adm (P y) ==> adm (λx. ∀y∈A. P y x)"
by (fast intro: admI elim: admD)

lemmas adm_all2 = adm_all [rule_format]
lemmas adm_ball2 = adm_ball [rule_format]

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_mono3)
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 [rule_format], assumption+)
  apply (erule chain_mono3)
  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 add: le_maxI1 le_maxI2)
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 assumption
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 assumption
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 monofun_fun_arg])
apply (erule is_ub_thelub)
done

text {* admissibility and compactness *}

lemma adm_compact_not_less: "[|compact k; cont t|] ==> adm (λx. ¬ k \<sqsubseteq> t x)"
by (unfold compact_def, erule 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)

lemmas adm_lemmas [simp] =
  adm_not_free adm_conj adm_all2 adm_ball2 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

(* legacy ML bindings *)
ML
{*
val adm_def = thm "adm_def";
val admI = thm "admI";
val triv_admI = thm "triv_admI";
val admD = thm "admD";
val adm_max_in_chain = thm "adm_max_in_chain";
val adm_chfin = thm "adm_chfin";
val admI2 = thm "admI2";
val adm_less = thm "adm_less";
val adm_conj = thm "adm_conj";
val adm_not_free = thm "adm_not_free";
val adm_not_less = thm "adm_not_less";
val adm_all = thm "adm_all";
val adm_all2 = thm "adm_all2";
val adm_ball = thm "adm_ball";
val adm_ball2 = thm "adm_ball2";
val adm_subst = thm "adm_subst";
val adm_not_UU = thm "adm_not_UU";
val adm_eq = thm "adm_eq";
val adm_disj_lemma1 = thm "adm_disj_lemma1";
val adm_disj_lemma2 = thm "adm_disj_lemma2";
val adm_disj_lemma3 = thm "adm_disj_lemma3";
val adm_disj_lemma4 = thm "adm_disj_lemma4";
val adm_disj_lemma5 = thm "adm_disj_lemma5";
val adm_disj = thm "adm_disj";
val adm_imp = thm "adm_imp";
val adm_iff = thm "adm_iff";
val adm_not_conj = thm "adm_not_conj";
val adm_lemmas = thms "adm_lemmas";
*}

end

Definitions

lemma admI:

  (!!Y. [| chain Y; ∀i. P (Y i) |] ==> P (LUB i. Y i)) ==> adm P

lemma triv_admI:

  x. P x ==> adm P

lemma admD:

  [| adm P; chain Y; ∀i. P (Y i) |] ==> P (LUB i. Y i)

lemma compactI:

  admx. ¬ k << x) ==> compact k

lemma compactD:

  compact k ==> admx. ¬ k << x)

lemma admI2:

  (!!Y. [| chain Y; ∀i. P (Y i); ∀i. ∃j>i. Y i  Y jY i << Y j |]
        ==> P (LUB i. Y i))
  ==> adm P

Admissibility on chain-finite types

lemma adm_max_in_chain:

  Y. chain Y --> (∃n. max_in_chain n Y) ==> adm P

lemma adm_chfin:

  adm P

lemma compact_chfin:

  compact x

Admissibility of special formulae and propagation

lemma adm_not_free:

  admx. t)

lemma adm_conj:

  [| adm P; adm Q |] ==> admx. P xQ x)

lemma adm_all:

  y. adm (P y) ==> admx. ∀y. P y x)

lemma adm_ball:

  yA. adm (P y) ==> admx. ∀yA. P y x)

lemma adm_all2:

  (!!y. adm (P y)) ==> admx. ∀y. P y x)

lemma adm_ball2:

  (!!y. yA ==> adm (P y)) ==> admx. ∀yA. P y x)

lemma adm_disj_lemma1:

  [| chain Y; ∀i. ∃ji. P (Y j) |] ==> chaini. Y (LEAST j. i  jP (Y j)))

lemma adm_disj_lemma2:

  xi. P (Y x)
  ==> i  (LEAST j. i  jP (Y j)) ∧ P (Y (LEAST j. i  jP (Y j)))

lemma adm_disj_lemma3:

  [| chain Y; ∀i. ∃ji. P (Y j) |]
  ==> (LUB i. Y i) = (LUB i. Y (LEAST j. i  jP (Y j)))

lemma adm_disj_lemma4:

  [| adm P; chain Y; ∀i. ∃ji. P (Y j) |] ==> P (LUB i. Y i)

lemma adm_disj_lemma5:

  n. P nQ n ==> (∀i. ∃ji. P j) ∨ (∀i. ∃ji. Q j)

lemma adm_disj:

  [| adm P; adm Q |] ==> admx. P xQ x)

lemma adm_imp:

  [| admx. ¬ P x); adm Q |] ==> admx. P x --> Q x)

lemma adm_iff:

  [| admx. P x --> Q x); admx. Q x --> P x) |] ==> admx. P x = Q x)

lemma adm_not_conj:

  [| admx. ¬ P x); admx. ¬ Q x) |] ==> admx. ¬ (P xQ x))

lemma adm_less:

  [| cont u; cont v |] ==> admx. u x << v x)

lemma adm_eq:

  [| cont u; cont v |] ==> admx. u x = v x)

lemma adm_subst:

  [| cont t; adm P |] ==> admx. P (t x))

lemma adm_not_less:

  cont t ==> admx. ¬ t x << u)

lemma adm_compact_not_less:

  [| compact k; cont t |] ==> admx. ¬ k << t x)

lemma adm_neq_compact:

  [| compact k; cont t |] ==> admx. t x  k)

lemma adm_compact_neq:

  [| compact k; cont t |] ==> admx. k  t x)

lemma compact_UU:

  compact UU

lemma adm_not_UU:

  cont t ==> admx. t x  UU)

lemma adm_lemmas:

  admx. t)
  [| adm P; adm Q |] ==> admx. P xQ x)
  (!!y. adm (P y)) ==> admx. ∀y. P y x)
  (!!y. yA ==> adm (P y)) ==> admx. ∀yA. P y x)
  [| adm P; adm Q |] ==> admx. P xQ x)
  [| admx. ¬ P x); adm Q |] ==> admx. P x --> Q x)
  [| admx. P x --> Q x); admx. Q x --> P x) |] ==> admx. P x = Q x)
  [| cont u; cont v |] ==> admx. u x << v x)
  [| cont u; cont v |] ==> admx. u x = v x)
  cont t ==> admx. ¬ t x << u)
  [| compact k; cont t |] ==> admx. ¬ k << t x)
  [| compact k; cont t |] ==> admx. k  t x)
  [| compact k; cont t |] ==> admx. t x  k)
  cont t ==> admx. t x  UU)