(* Title: HOL/HOLCF/Porder.thy
Author: Franz Regensburger and Brian Huffman
*)
section \<open>Partial orders\<close>
theory Porder
imports Main
begin
declare [[typedef_overloaded]]
subsection \<open>Type class for partial orders\<close>
class below =
fixes below :: "'a \ 'a \ bool"
begin
notation (ASCII)
below (infix "<<" 50)
notation
below (infix "\" 50)
abbreviation not_below :: "'a \ 'a \ bool" (infix "\" 50)
where "not_below x y \ \ below x y"
notation (ASCII)
not_below (infix "~<<" 50)
lemma below_eq_trans: "a \ b \ b = c \ a \ c"
by (rule subst)
lemma eq_below_trans: "a = b \ b \ c \ a \ c"
by (rule ssubst)
end
class po = below +
assumes below_refl [iff]: "x \ x"
assumes below_trans: "x \ y \ y \ z \ x \ z"
assumes below_antisym: "x \ y \ y \ x \ x = y"
begin
lemma eq_imp_below: "x = y \ x \ y"
by simp
lemma box_below: "a \ b \ c \ a \ b \ d \ c \ d"
by (rule below_trans [OF below_trans])
lemma po_eq_conv: "x = y \ x \ y \ y \ x"
by (fast intro!: below_antisym)
lemma rev_below_trans: "y \ z \ x \ y \ x \ z"
by (rule below_trans)
lemma not_below2not_eq: "x \ y \ x \ y"
by auto
end
lemmas HOLCF_trans_rules [trans] =
below_trans
below_antisym
below_eq_trans
eq_below_trans
context po
begin
subsection \<open>Upper bounds\<close>
definition is_ub :: "'a set \ 'a \ bool" (infix "<|" 55)
where "S <| x \ (\y\S. y \ x)"
lemma is_ubI: "(\x. x \ S \ x \ u) \ S <| u"
by (simp add: is_ub_def)
lemma is_ubD: "\S <| u; x \ S\ \ x \ u"
by (simp add: is_ub_def)
lemma ub_imageI: "(\x. x \ S \ f x \ u) \ (\x. f x) ` S <| u"
unfolding is_ub_def by fast
lemma ub_imageD: "\f ` S <| u; x \ S\ \ f x \ u"
unfolding is_ub_def by fast
lemma ub_rangeI: "(\i. S i \ x) \ range S <| x"
unfolding is_ub_def by fast
lemma ub_rangeD: "range S <| x \ S i \ x"
unfolding is_ub_def by fast
lemma is_ub_empty [simp]: "{} <| u"
unfolding is_ub_def by fast
lemma is_ub_insert [simp]: "(insert x A) <| y = (x \ y \ A <| y)"
unfolding is_ub_def by fast
lemma is_ub_upward: "\S <| x; x \ y\ \ S <| y"
unfolding is_ub_def by (fast intro: below_trans)
subsection \<open>Least upper bounds\<close>
definition is_lub :: "'a set \ 'a \ bool" (infix "<<|" 55)
where "S <<| x \ S <| x \ (\u. S <| u \ x \ u)"
definition lub :: "'a set \ 'a"
where "lub S = (THE x. S <<| x)"
end
syntax (ASCII)
"_BLub" :: "[pttrn, 'a set, 'b] \ 'b" ("(3LUB _:_./ _)" [0,0, 10] 10)
syntax
"_BLub" :: "[pttrn, 'a set, 'b] \ 'b" ("(3\_\_./ _)" [0,0, 10] 10)
translations
"LUB x:A. t" \<rightleftharpoons> "CONST lub ((\<lambda>x. t) ` A)"
context po
begin
abbreviation Lub (binder "\" 10)
where "\n. t n \ lub (range t)"
notation (ASCII)
Lub (binder "LUB " 10)
text \<open>access to some definition as inference rule\<close>
lemma is_lubD1: "S <<| x \ S <| x"
unfolding is_lub_def by fast
lemma is_lubD2: "\S <<| x; S <| u\ \ x \ u"
unfolding is_lub_def by fast
lemma is_lubI: "\S <| x; \u. S <| u \ x \ u\ \ S <<| x"
unfolding is_lub_def by fast
lemma is_lub_below_iff: "S <<| x \ x \ u \ S <| u"
unfolding is_lub_def is_ub_def by (metis below_trans)
text \<open>lubs are unique\<close>
lemma is_lub_unique: "S <<| x \ S <<| y \ x = y"
unfolding is_lub_def is_ub_def by (blast intro: below_antisym)
text \<open>technical lemmas about \<^term>\<open>lub\<close> and \<^term>\<open>is_lub\<close>\<close>
lemma is_lub_lub: "M <<| x \ M <<| lub M"
unfolding lub_def by (rule theI [OF _ is_lub_unique])
lemma lub_eqI: "M <<| l \ lub M = l"
by (rule is_lub_unique [OF is_lub_lub])
lemma is_lub_singleton [simp]: "{x} <<| x"
by (simp add: is_lub_def)
lemma lub_singleton [simp]: "lub {x} = x"
by (rule is_lub_singleton [THEN lub_eqI])
lemma is_lub_bin: "x \ y \ {x, y} <<| y"
by (simp add: is_lub_def)
lemma lub_bin: "x \ y \ lub {x, y} = y"
by (rule is_lub_bin [THEN lub_eqI])
lemma is_lub_maximal: "S <| x \ x \ S \ S <<| x"
by (erule is_lubI, erule (1) is_ubD)
lemma lub_maximal: "S <| x \ x \ S \ lub S = x"
by (rule is_lub_maximal [THEN lub_eqI])
subsection \<open>Countable chains\<close>
definition chain :: "(nat \ 'a) \ bool"
where \<comment> \<open>Here we use countable chains and I prefer to code them as functions!\<close>
"chain Y = (\i. Y i \ Y (Suc i))"
lemma chainI: "(\i. Y i \ Y (Suc i)) \ chain Y"
unfolding chain_def by fast
lemma chainE: "chain Y \ Y i \ Y (Suc i)"
unfolding chain_def by fast
text \<open>chains are monotone functions\<close>
lemma chain_mono_less: "chain Y \ i < j \ Y i \ Y j"
by (erule less_Suc_induct, erule chainE, erule below_trans)
lemma chain_mono: "chain Y \ i \ j \ Y i \ Y j"
by (cases "i = j") (simp_all add: chain_mono_less)
lemma chain_shift: "chain Y \ chain (\i. Y (i + j))"
by (rule chainI, simp, erule chainE)
text \<open>technical lemmas about (least) upper bounds of chains\<close>
lemma is_lub_rangeD1: "range S <<| x \ S i \ 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 below_trans)
apply (erule chain_mono)
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 \<open>the lub of a constant chain is the constant\<close>
lemma chain_const [simp]: "chain (\i. c)"
by (simp add: chainI)
lemma is_lub_const: "range (\x. c) <<| c"
by (blast dest: ub_rangeD intro: is_lubI ub_rangeI)
lemma lub_const [simp]: "(\i. c) = c"
by (rule is_lub_const [THEN lub_eqI])
subsection \<open>Finite chains\<close>
definition max_in_chain :: "nat \ (nat \ 'a) \ bool"
where \<comment> \<open>finite chains, needed for monotony of continuous functions\<close>
"max_in_chain i C \ (\j. i \ j \ C i = C j)"
definition finite_chain :: "(nat \ 'a) \ bool"
where "finite_chain C = (chain C \ (\i. max_in_chain i C))"
text \<open>results about finite chains\<close>
lemma max_in_chainI: "(\j. i \ j \ Y i = Y j) \ max_in_chain i Y"
unfolding max_in_chain_def by fast
lemma max_in_chainD: "max_in_chain i Y \ i \ j \ Y i = Y j"
unfolding max_in_chain_def by fast
lemma finite_chainI: "chain C \ max_in_chain i C \ finite_chain C"
unfolding finite_chain_def by fast
lemma finite_chainE: "\finite_chain C; \i. \chain C; max_in_chain i C\ \ R\ \ R"
unfolding finite_chain_def by fast
lemma lub_finch1: "chain C \ max_in_chain i C \ range C <<| C i"
apply (rule is_lubI)
apply (rule ub_rangeI, rename_tac j)
apply (rule_tac x=i and y=j in linorder_le_cases)
apply (drule (1) max_in_chainD, simp)
apply (erule (1) chain_mono)
apply (erule ub_rangeD)
done
lemma lub_finch2: "finite_chain C \ range C <<| C (LEAST i. max_in_chain i C)"
apply (erule finite_chainE)
apply (erule LeastI2 [where Q="\i. range C <<| C i"])
apply (erule (1) lub_finch1)
done
lemma finch_imp_finite_range: "finite_chain Y \ finite (range Y)"
apply (erule finite_chainE)
apply (rule_tac B="Y ` {..i}" in finite_subset)
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 simp
done
lemma finite_range_has_max:
fixes f :: "nat \ 'a"
and r :: "'a \ 'a \ bool"
assumes mono: "\i j. i \ j \ r (f i) (f j)"
assumes finite_range: "finite (range f)"
shows "\k. \i. r (f i) (f k)"
proof (intro exI allI)
fix i :: nat
let ?j = "LEAST k. f k = f i"
let ?k = "Max ((\x. LEAST k. f k = x) ` range f)"
have "?j \ ?k"
proof (rule Max_ge)
show "finite ((\x. LEAST k. f k = x) ` range f)"
using finite_range by (rule finite_imageI)
show "?j \ (\x. LEAST k. f k = x) ` range f"
by (intro imageI rangeI)
qed
hence "r (f ?j) (f ?k)"
by (rule mono)
also have "f ?j = f i"
by (rule LeastI, rule refl)
finally show "r (f i) (f ?k)" .
qed
lemma finite_range_imp_finch: "chain Y \ finite (range Y) \ finite_chain Y"
apply (subgoal_tac "\k. \i. Y i \ Y k")
apply (erule exE)
apply (rule finite_chainI, assumption)
apply (rule max_in_chainI)
apply (rule below_antisym)
apply (erule (1) chain_mono)
apply (erule spec)
apply (rule finite_range_has_max)
apply (erule (1) chain_mono)
apply assumption
done
lemma bin_chain: "x \ y \ chain (\i. if i=0 then x else y)"
by (rule chainI) simp
lemma bin_chainmax: "x \ y \ max_in_chain (Suc 0) (\i. if i=0 then x else y)"
by (simp add: max_in_chain_def)
lemma is_lub_bin_chain: "x \ 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 \<open>the maximal element in a chain is its lub\<close>
lemma lub_chain_maxelem: "Y i = c \ \i. Y i \ c \ lub (range Y) = c"
by (blast dest: ub_rangeD intro: lub_eqI is_lubI ub_rangeI)
end
end
¤ Dauer der Verarbeitung: 0.22 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
