Theory Porder

Up to index of Isabelle/HOLCF

theory Porder
imports Datatype
begin

(*  Title:      HOLCF/Porder.thy
    ID:         $Id: Porder.thy,v 1.38 2007/10/21 12:21:49 wenzelm Exp $
    Author:     Franz Regensburger
*)

header {* Partial orders *}

theory Porder
imports Datatype Finite_Set
begin

subsection {* Type class for partial orders *}

class sq_ord = type +
  fixes sq_le :: "'a => 'a => bool"

notation
  sq_le (infixl "<<" 55)

notation (xsymbols)
  sq_le (infixl "\<sqsubseteq>" 55)

axclass po < sq_ord
  refl_less [iff]: "x \<sqsubseteq> x"
  antisym_less:    "[|x \<sqsubseteq> y; y \<sqsubseteq> x|] ==> x = y"
  trans_less:      "[|x \<sqsubseteq> y; y \<sqsubseteq> z|] ==> x \<sqsubseteq> z"

text {* minimal fixes least element *}

lemma minimal2UU[OF allI] : "∀x::'a::po. uu \<sqsubseteq> x ==> uu = (THE u. ∀y. u \<sqsubseteq> y)"
by (blast intro: theI2 antisym_less)

text {* the reverse law of anti-symmetry of @{term "op <<"} *}

lemma antisym_less_inverse: "(x::'a::po) = y ==> x \<sqsubseteq> y ∧ y \<sqsubseteq> x"
by simp

lemma box_less: "[|(a::'a::po) \<sqsubseteq> b; c \<sqsubseteq> a; b \<sqsubseteq> d|] ==> c \<sqsubseteq> d"
by (rule trans_less [OF trans_less])

lemma po_eq_conv: "((x::'a::po) = y) = (x \<sqsubseteq> y ∧ y \<sqsubseteq> x)"
by (fast elim!: antisym_less_inverse intro!: antisym_less)

lemma rev_trans_less: "[|(y::'a::po) \<sqsubseteq> z; x \<sqsubseteq> y|] ==> x \<sqsubseteq> z"
by (rule trans_less)

lemma sq_ord_less_eq_trans: "[|a \<sqsubseteq> b; b = c|] ==> a \<sqsubseteq> c"
by (rule subst)

lemma sq_ord_eq_less_trans: "[|a = b; b \<sqsubseteq> c|] ==> a \<sqsubseteq> c"
by (rule ssubst)

lemmas HOLCF_trans_rules [trans] =
  trans_less
  antisym_less
  sq_ord_less_eq_trans
  sq_ord_eq_less_trans

subsection {* Chains and least upper bounds *}

text {* class definitions *}

definition
  is_ub :: "['a set, 'a::po] => bool"  (infixl "<|" 55)  where
  "(S <| x) = (∀y. y ∈ S --> y \<sqsubseteq> x)"

definition
  is_lub :: "['a set, 'a::po] => bool"  (infixl "<<|" 55)  where
  "(S <<| x) = (S <| x ∧ (∀u. S <| u --> x \<sqsubseteq> u))"

definition
  -- {* Arbitrary chains are total orders *}
  tord :: "'a::po set => bool" where
  "tord S = (∀x y. x ∈ S ∧ y ∈ S --> (x \<sqsubseteq> y ∨ y \<sqsubseteq> x))"

definition
  -- {* Here we use countable chains and I prefer to code them as functions! *}
  chain :: "(nat => 'a::po) => bool" where
  "chain F = (∀i. F i \<sqsubseteq> F (Suc i))"

definition
  -- {* finite chains, needed for monotony of continuous functions *}
  max_in_chain :: "[nat, nat => 'a::po] => bool" where
  "max_in_chain i C = (∀j. i ≤ j --> C i = C j)"

definition
  finite_chain :: "(nat => 'a::po) => bool" where
  "finite_chain C = (chain C ∧ (∃i. max_in_chain i C))"

definition
  lub :: "'a set => 'a::po" where
  "lub S = (THE x. S <<| x)"

abbreviation
  Lub  (binder "LUB " 10) where
  "LUB n. t n == lub (range t)"

notation (xsymbols)
  Lub  (binder "\<Squnion> " 10)


text {* lubs are unique *}

lemma unique_lub: "[|S <<| x; S <<| y|] ==> x = y"
apply (unfold is_lub_def is_ub_def)
apply (blast intro: antisym_less)
done

text {* chains are monotone functions *}

lemma chain_mono [rule_format]: "chain F ==> x < y --> F x \<sqsubseteq> F y"
apply (unfold chain_def)
apply (induct_tac y)
apply simp
apply (blast elim: less_SucE intro: trans_less)
done

lemma chain_mono3: "[|chain F; x ≤ y|] ==> F x \<sqsubseteq> F y"
apply (drule le_imp_less_or_eq)
apply (blast intro: chain_mono)
done

text {* The range of a chain is a totally ordered *}

lemma chain_tord: "chain F ==> tord (range F)"
apply (unfold tord_def, clarify)
apply (rule nat_less_cases)
apply (fast intro: chain_mono)+
done

text {* technical lemmas about @{term lub} and @{term is_lub} *}

lemma lubI: "M <<| x ==> M <<| lub M"
apply (unfold lub_def)
apply (rule theI)
apply assumption
apply (erule (1) unique_lub)
done

lemma thelubI: "M <<| l ==> lub M = l"
by (rule unique_lub [OF lubI])

lemma lub_singleton [simp]: "lub {x} = x"
by (simp add: thelubI is_lub_def is_ub_def)

text {* access to some definition as inference rule *}

lemma is_lubD1: "S <<| x ==> S <| x"
by (unfold is_lub_def, simp)

lemma is_lub_lub: "[|S <<| x; S <| u|] ==> x \<sqsubseteq> u"
by (unfold is_lub_def, simp)

lemma is_lubI: "[|S <| x; !!u. S <| u ==> x \<sqsubseteq> u|] ==> S <<| x"
by (unfold is_lub_def, fast)

lemma chainE: "chain F ==> F i \<sqsubseteq> F (Suc i)"
by (unfold chain_def, simp)

lemma chainI: "(!!i. F i \<sqsubseteq> F (Suc i)) ==> chain F"
by (unfold chain_def, simp)

lemma chain_shift: "chain Y ==> chain (λi. Y (i + j))"
apply (rule chainI)
apply simp
apply (erule chainE)
done

text {* technical lemmas about (least) upper bounds of chains *}

lemma ub_rangeD: "range S <| x ==> S i \<sqsubseteq> x"
by (unfold is_ub_def, simp)

lemma ub_rangeI: "(!!i. S i \<sqsubseteq> x) ==> range S <| x"
by (unfold is_ub_def, fast)

lemma is_ub_lub: "range S <<| x ==> S i \<sqsubseteq> x"
by (rule is_lubD1 [THEN ub_rangeD])

lemma is_ub_range_shift:
  "chain S ==> range (λi. S (i + j)) <| x = range S <| x"
apply (rule iffI)
apply (rule ub_rangeI)
apply (rule_tac y="S (i + j)" in trans_less)
apply (erule chain_mono3)
apply (rule le_add1)
apply (erule ub_rangeD)
apply (rule ub_rangeI)
apply (erule ub_rangeD)
done

lemma is_lub_range_shift:
  "chain S ==> range (λi. S (i + j)) <<| x = range S <<| x"
by (simp add: is_lub_def is_ub_range_shift)

text {* results about finite chains *}

lemma lub_finch1: "[|chain C; max_in_chain i C|] ==> range C <<| C i"
apply (unfold max_in_chain_def)
apply (rule is_lubI)
apply (rule ub_rangeI, rename_tac j)
apply (rule_tac x=i and y=j in linorder_le_cases)
apply simp
apply (erule (1) chain_mono3)
apply (erule ub_rangeD)
done

lemma lub_finch2:
        "finite_chain C ==> range C <<| C (LEAST i. max_in_chain i C)"
apply (unfold finite_chain_def)
apply (erule conjE)
apply (erule LeastI2_ex)
apply (erule (1) lub_finch1)
done

lemma finch_imp_finite_range: "finite_chain Y ==> finite (range Y)"
 apply (unfold finite_chain_def, clarify)
 apply (rule_tac f="Y" and n="Suc i" in nat_seg_image_imp_finite)
 apply (rule equalityI)
  apply (rule subsetI)
  apply (erule rangeE, rename_tac j)
  apply (rule_tac x=i and y=j in linorder_le_cases)
   apply (subgoal_tac "Y j = Y i", simp)
   apply (simp add: max_in_chain_def)
  apply simp
 apply fast
done

lemma finite_tord_has_max [rule_format]:
  "finite S ==> S ≠ {} --> tord S --> (∃y∈S. ∀x∈S. x \<sqsubseteq> y)"
 apply (erule finite_induct, simp)
 apply (rename_tac a S, clarify)
 apply (case_tac "S = {}", simp)
 apply (drule (1) mp)
 apply (drule mp, simp add: tord_def)
 apply (erule bexE, rename_tac z)
 apply (subgoal_tac "a \<sqsubseteq> z ∨ z \<sqsubseteq> a")
  apply (erule disjE)
   apply (rule_tac x="z" in bexI, simp, simp)
  apply (rule_tac x="a" in bexI)
   apply (clarsimp elim!: rev_trans_less)
  apply simp
 apply (simp add: tord_def)
done

lemma finite_range_imp_finch:
  "[|chain Y; finite (range Y)|] ==> finite_chain Y"
 apply (subgoal_tac "∃y∈range Y. ∀x∈range Y. x \<sqsubseteq> y")
  apply (clarsimp, rename_tac i)
  apply (subgoal_tac "max_in_chain i Y")
   apply (simp add: finite_chain_def exI)
  apply (simp add: max_in_chain_def po_eq_conv chain_mono3)
 apply (erule finite_tord_has_max, simp)
 apply (erule chain_tord)
done

lemma bin_chain: "x \<sqsubseteq> y ==> chain (λi. if i=0 then x else y)"
by (rule chainI, simp)

lemma bin_chainmax:
  "x \<sqsubseteq> y ==> max_in_chain (Suc 0) (λi. if i=0 then x else y)"
by (unfold max_in_chain_def, simp)

lemma lub_bin_chain:
  "x \<sqsubseteq> y ==> range (λi::nat. if i=0 then x else y) <<| y"
apply (frule bin_chain)
apply (drule bin_chainmax)
apply (drule (1) lub_finch1)
apply simp
done

text {* the maximal element in a chain is its lub *}

lemma lub_chain_maxelem: "[|Y i = c; ∀i. Y i \<sqsubseteq> c|] ==> lub (range Y) = c"
by (blast dest: ub_rangeD intro: thelubI is_lubI ub_rangeI)

text {* the lub of a constant chain is the constant *}

lemma chain_const [simp]: "chain (λi. c)"
by (simp add: chainI)

lemma lub_const: "range (λx. c) <<| c"
by (blast dest: ub_rangeD intro: is_lubI ub_rangeI)

lemma thelub_const [simp]: "(\<Squnion>i. c) = c"
by (rule lub_const [THEN thelubI])

end

Type class for partial orders

lemma minimal2UU:

  (!!x. uu << x) ==> uu = (THE u. ∀y. u << y)

lemma antisym_less_inverse:

  x = y ==> x << yy << x

lemma box_less:

  [| a << b; c << a; b << d |] ==> c << d

lemma po_eq_conv:

  (x = y) = (x << yy << x)

lemma rev_trans_less:

  [| y << z; x << y |] ==> x << z

lemma sq_ord_less_eq_trans:

  [| a << b; b = c |] ==> a << c

lemma sq_ord_eq_less_trans:

  [| a = b; b << c |] ==> a << c

lemma HOLCF_trans_rules:

  [| x << y; y << z |] ==> x << z
  [| x << y; y << x |] ==> x = y
  [| a << b; b = c |] ==> a << c
  [| a = b; b << c |] ==> a << c

Chains and least upper bounds

lemma unique_lub:

  [| S <<| x; S <<| y |] ==> x = y

lemma chain_mono:

  [| chain F; x < y |] ==> F x << F y

lemma chain_mono3:

  [| chain F; x  y |] ==> F x << F y

lemma chain_tord:

  chain F ==> tord (range F)

lemma lubI:

  M <<| x ==> M <<| lub M

lemma thelubI:

  M <<| l ==> lub M = l

lemma lub_singleton:

  lub {x} = x

lemma is_lubD1:

  S <<| x ==> S <| x

lemma is_lub_lub:

  [| S <<| x; S <| u |] ==> x << u

lemma is_lubI:

  [| S <| x; !!u. S <| u ==> x << u |] ==> S <<| x

lemma chainE:

  chain F ==> F i << F (Suc i)

lemma chainI:

  (!!i. F i << F (Suc i)) ==> chain F

lemma chain_shift:

  chain Y ==> chaini. Y (i + j))

lemma ub_rangeD:

  range S <| x ==> S i << x

lemma ub_rangeI:

  (!!i. S i << x) ==> range S <| x

lemma is_ub_lub:

  range S <<| x ==> S i << x

lemma is_ub_range_shift:

  chain S ==> rangei. S (i + j)) <| x = range S <| x

lemma is_lub_range_shift:

  chain S ==> rangei. S (i + j)) <<| x = range S <<| x

lemma lub_finch1:

  [| chain C; max_in_chain i C |] ==> range C <<| C i

lemma lub_finch2:

  finite_chain C ==> range C <<| C (LEAST i. max_in_chain i C)

lemma finch_imp_finite_range:

  finite_chain Y ==> finite (range Y)

lemma finite_tord_has_max:

  [| finite S; S  {}; tord S |] ==> ∃yS. ∀xS. x << y

lemma finite_range_imp_finch:

  [| chain Y; finite (range Y) |] ==> finite_chain Y

lemma bin_chain:

  x << y ==> chaini. if i = 0 then x else y)

lemma bin_chainmax:

  x << y ==> max_in_chain (Suc 0) (λi. if i = 0 then x else y)

lemma lub_bin_chain:

  x << y ==> rangei. if i = 0 then x else y) <<| y

lemma lub_chain_maxelem:

  [| Y i = c; ∀i. Y i << c |] ==> Lub Y = c

lemma chain_const:

  chaini. c)

lemma lub_const:

  rangex. c) <<| c

lemma thelub_const:

  (LUB i. c) = c