src/HOLCF/Porder.thy
 author huffman Mon May 11 08:28:09 2009 -0700 (2009-05-11) changeset 31095 b79d140f6d0b parent 31076 99fe356cbbc2 child 39968 d841744718fe permissions -rw-r--r--
simplify fixrec proofs for mutually-recursive definitions; generate better fixpoint induction rules
```     1 (*  Title:      HOLCF/Porder.thy
```
```     2     Author:     Franz Regensburger and Brian Huffman
```
```     3 *)
```
```     4
```
```     5 header {* Partial orders *}
```
```     6
```
```     7 theory Porder
```
```     8 imports Main
```
```     9 begin
```
```    10
```
```    11 subsection {* Type class for partial orders *}
```
```    12
```
```    13 class below =
```
```    14   fixes below :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
```
```    15 begin
```
```    16
```
```    17 notation
```
```    18   below (infixl "<<" 55)
```
```    19
```
```    20 notation (xsymbols)
```
```    21   below (infixl "\<sqsubseteq>" 55)
```
```    22
```
```    23 lemma below_eq_trans: "\<lbrakk>a \<sqsubseteq> b; b = c\<rbrakk> \<Longrightarrow> a \<sqsubseteq> c"
```
```    24   by (rule subst)
```
```    25
```
```    26 lemma eq_below_trans: "\<lbrakk>a = b; b \<sqsubseteq> c\<rbrakk> \<Longrightarrow> a \<sqsubseteq> c"
```
```    27   by (rule ssubst)
```
```    28
```
```    29 end
```
```    30
```
```    31 class po = below +
```
```    32   assumes below_refl [iff]: "x \<sqsubseteq> x"
```
```    33   assumes below_trans: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"
```
```    34   assumes below_antisym: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x = y"
```
```    35 begin
```
```    36
```
```    37 text {* minimal fixes least element *}
```
```    38
```
```    39 lemma minimal2UU[OF allI] : "\<forall>x. uu \<sqsubseteq> x \<Longrightarrow> uu = (THE u. \<forall>y. u \<sqsubseteq> y)"
```
```    40   by (blast intro: theI2 below_antisym)
```
```    41
```
```    42 text {* the reverse law of anti-symmetry of @{term "op <<"} *}
```
```    43 (* Is this rule ever useful? *)
```
```    44 lemma below_antisym_inverse: "x = y \<Longrightarrow> x \<sqsubseteq> y \<and> y \<sqsubseteq> x"
```
```    45   by simp
```
```    46
```
```    47 lemma box_below: "a \<sqsubseteq> b \<Longrightarrow> c \<sqsubseteq> a \<Longrightarrow> b \<sqsubseteq> d \<Longrightarrow> c \<sqsubseteq> d"
```
```    48   by (rule below_trans [OF below_trans])
```
```    49
```
```    50 lemma po_eq_conv: "x = y \<longleftrightarrow> x \<sqsubseteq> y \<and> y \<sqsubseteq> x"
```
```    51   by (fast intro!: below_antisym)
```
```    52
```
```    53 lemma rev_below_trans: "y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> x \<sqsubseteq> z"
```
```    54   by (rule below_trans)
```
```    55
```
```    56 lemma not_below2not_eq: "\<not> x \<sqsubseteq> y \<Longrightarrow> x \<noteq> y"
```
```    57   by auto
```
```    58
```
```    59 end
```
```    60
```
```    61 lemmas HOLCF_trans_rules [trans] =
```
```    62   below_trans
```
```    63   below_antisym
```
```    64   below_eq_trans
```
```    65   eq_below_trans
```
```    66
```
```    67 context po
```
```    68 begin
```
```    69
```
```    70 subsection {* Upper bounds *}
```
```    71
```
```    72 definition is_ub :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" (infixl "<|" 55) where
```
```    73   "S <| x \<longleftrightarrow> (\<forall>y. y \<in> S \<longrightarrow> y \<sqsubseteq> x)"
```
```    74
```
```    75 lemma is_ubI: "(\<And>x. x \<in> S \<Longrightarrow> x \<sqsubseteq> u) \<Longrightarrow> S <| u"
```
```    76   by (simp add: is_ub_def)
```
```    77
```
```    78 lemma is_ubD: "\<lbrakk>S <| u; x \<in> S\<rbrakk> \<Longrightarrow> x \<sqsubseteq> u"
```
```    79   by (simp add: is_ub_def)
```
```    80
```
```    81 lemma ub_imageI: "(\<And>x. x \<in> S \<Longrightarrow> f x \<sqsubseteq> u) \<Longrightarrow> (\<lambda>x. f x) ` S <| u"
```
```    82   unfolding is_ub_def by fast
```
```    83
```
```    84 lemma ub_imageD: "\<lbrakk>f ` S <| u; x \<in> S\<rbrakk> \<Longrightarrow> f x \<sqsubseteq> u"
```
```    85   unfolding is_ub_def by fast
```
```    86
```
```    87 lemma ub_rangeI: "(\<And>i. S i \<sqsubseteq> x) \<Longrightarrow> range S <| x"
```
```    88   unfolding is_ub_def by fast
```
```    89
```
```    90 lemma ub_rangeD: "range S <| x \<Longrightarrow> S i \<sqsubseteq> x"
```
```    91   unfolding is_ub_def by fast
```
```    92
```
```    93 lemma is_ub_empty [simp]: "{} <| u"
```
```    94   unfolding is_ub_def by fast
```
```    95
```
```    96 lemma is_ub_insert [simp]: "(insert x A) <| y = (x \<sqsubseteq> y \<and> A <| y)"
```
```    97   unfolding is_ub_def by fast
```
```    98
```
```    99 lemma is_ub_upward: "\<lbrakk>S <| x; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> S <| y"
```
```   100   unfolding is_ub_def by (fast intro: below_trans)
```
```   101
```
```   102 subsection {* Least upper bounds *}
```
```   103
```
```   104 definition is_lub :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" (infixl "<<|" 55) where
```
```   105   "S <<| x \<longleftrightarrow> S <| x \<and> (\<forall>u. S <| u \<longrightarrow> x \<sqsubseteq> u)"
```
```   106
```
```   107 definition lub :: "'a set \<Rightarrow> 'a" where
```
```   108   "lub S = (THE x. S <<| x)"
```
```   109
```
```   110 end
```
```   111
```
```   112 syntax
```
```   113   "_BLub" :: "[pttrn, 'a set, 'b] \<Rightarrow> 'b" ("(3LUB _:_./ _)" [0,0, 10] 10)
```
```   114
```
```   115 syntax (xsymbols)
```
```   116   "_BLub" :: "[pttrn, 'a set, 'b] \<Rightarrow> 'b" ("(3\<Squnion>_\<in>_./ _)" [0,0, 10] 10)
```
```   117
```
```   118 translations
```
```   119   "LUB x:A. t" == "CONST lub ((%x. t) ` A)"
```
```   120
```
```   121 context po
```
```   122 begin
```
```   123
```
```   124 abbreviation
```
```   125   Lub  (binder "LUB " 10) where
```
```   126   "LUB n. t n == lub (range t)"
```
```   127
```
```   128 notation (xsymbols)
```
```   129   Lub  (binder "\<Squnion> " 10)
```
```   130
```
```   131 text {* access to some definition as inference rule *}
```
```   132
```
```   133 lemma is_lubD1: "S <<| x \<Longrightarrow> S <| x"
```
```   134   unfolding is_lub_def by fast
```
```   135
```
```   136 lemma is_lub_lub: "\<lbrakk>S <<| x; S <| u\<rbrakk> \<Longrightarrow> x \<sqsubseteq> u"
```
```   137   unfolding is_lub_def by fast
```
```   138
```
```   139 lemma is_lubI: "\<lbrakk>S <| x; \<And>u. S <| u \<Longrightarrow> x \<sqsubseteq> u\<rbrakk> \<Longrightarrow> S <<| x"
```
```   140   unfolding is_lub_def by fast
```
```   141
```
```   142 text {* lubs are unique *}
```
```   143
```
```   144 lemma unique_lub: "\<lbrakk>S <<| x; S <<| y\<rbrakk> \<Longrightarrow> x = y"
```
```   145 apply (unfold is_lub_def is_ub_def)
```
```   146 apply (blast intro: below_antisym)
```
```   147 done
```
```   148
```
```   149 text {* technical lemmas about @{term lub} and @{term is_lub} *}
```
```   150
```
```   151 lemma lubI: "M <<| x \<Longrightarrow> M <<| lub M"
```
```   152 apply (unfold lub_def)
```
```   153 apply (rule theI)
```
```   154 apply assumption
```
```   155 apply (erule (1) unique_lub)
```
```   156 done
```
```   157
```
```   158 lemma thelubI: "M <<| l \<Longrightarrow> lub M = l"
```
```   159   by (rule unique_lub [OF lubI])
```
```   160
```
```   161 lemma is_lub_singleton: "{x} <<| x"
```
```   162   by (simp add: is_lub_def)
```
```   163
```
```   164 lemma lub_singleton [simp]: "lub {x} = x"
```
```   165   by (rule thelubI [OF is_lub_singleton])
```
```   166
```
```   167 lemma is_lub_bin: "x \<sqsubseteq> y \<Longrightarrow> {x, y} <<| y"
```
```   168   by (simp add: is_lub_def)
```
```   169
```
```   170 lemma lub_bin: "x \<sqsubseteq> y \<Longrightarrow> lub {x, y} = y"
```
```   171   by (rule is_lub_bin [THEN thelubI])
```
```   172
```
```   173 lemma is_lub_maximal: "\<lbrakk>S <| x; x \<in> S\<rbrakk> \<Longrightarrow> S <<| x"
```
```   174   by (erule is_lubI, erule (1) is_ubD)
```
```   175
```
```   176 lemma lub_maximal: "\<lbrakk>S <| x; x \<in> S\<rbrakk> \<Longrightarrow> lub S = x"
```
```   177   by (rule is_lub_maximal [THEN thelubI])
```
```   178
```
```   179 subsection {* Countable chains *}
```
```   180
```
```   181 definition chain :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool" where
```
```   182   -- {* Here we use countable chains and I prefer to code them as functions! *}
```
```   183   "chain Y = (\<forall>i. Y i \<sqsubseteq> Y (Suc i))"
```
```   184
```
```   185 lemma chainI: "(\<And>i. Y i \<sqsubseteq> Y (Suc i)) \<Longrightarrow> chain Y"
```
```   186   unfolding chain_def by fast
```
```   187
```
```   188 lemma chainE: "chain Y \<Longrightarrow> Y i \<sqsubseteq> Y (Suc i)"
```
```   189   unfolding chain_def by fast
```
```   190
```
```   191 text {* chains are monotone functions *}
```
```   192
```
```   193 lemma chain_mono_less: "\<lbrakk>chain Y; i < j\<rbrakk> \<Longrightarrow> Y i \<sqsubseteq> Y j"
```
```   194   by (erule less_Suc_induct, erule chainE, erule below_trans)
```
```   195
```
```   196 lemma chain_mono: "\<lbrakk>chain Y; i \<le> j\<rbrakk> \<Longrightarrow> Y i \<sqsubseteq> Y j"
```
```   197   by (cases "i = j", simp, simp add: chain_mono_less)
```
```   198
```
```   199 lemma chain_shift: "chain Y \<Longrightarrow> chain (\<lambda>i. Y (i + j))"
```
```   200   by (rule chainI, simp, erule chainE)
```
```   201
```
```   202 text {* technical lemmas about (least) upper bounds of chains *}
```
```   203
```
```   204 lemma is_ub_lub: "range S <<| x \<Longrightarrow> S i \<sqsubseteq> x"
```
```   205   by (rule is_lubD1 [THEN ub_rangeD])
```
```   206
```
```   207 lemma is_ub_range_shift:
```
```   208   "chain S \<Longrightarrow> range (\<lambda>i. S (i + j)) <| x = range S <| x"
```
```   209 apply (rule iffI)
```
```   210 apply (rule ub_rangeI)
```
```   211 apply (rule_tac y="S (i + j)" in below_trans)
```
```   212 apply (erule chain_mono)
```
```   213 apply (rule le_add1)
```
```   214 apply (erule ub_rangeD)
```
```   215 apply (rule ub_rangeI)
```
```   216 apply (erule ub_rangeD)
```
```   217 done
```
```   218
```
```   219 lemma is_lub_range_shift:
```
```   220   "chain S \<Longrightarrow> range (\<lambda>i. S (i + j)) <<| x = range S <<| x"
```
```   221   by (simp add: is_lub_def is_ub_range_shift)
```
```   222
```
```   223 text {* the lub of a constant chain is the constant *}
```
```   224
```
```   225 lemma chain_const [simp]: "chain (\<lambda>i. c)"
```
```   226   by (simp add: chainI)
```
```   227
```
```   228 lemma lub_const: "range (\<lambda>x. c) <<| c"
```
```   229 by (blast dest: ub_rangeD intro: is_lubI ub_rangeI)
```
```   230
```
```   231 lemma thelub_const [simp]: "(\<Squnion>i. c) = c"
```
```   232   by (rule lub_const [THEN thelubI])
```
```   233
```
```   234 subsection {* Finite chains *}
```
```   235
```
```   236 definition max_in_chain :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> bool" where
```
```   237   -- {* finite chains, needed for monotony of continuous functions *}
```
```   238   "max_in_chain i C \<longleftrightarrow> (\<forall>j. i \<le> j \<longrightarrow> C i = C j)"
```
```   239
```
```   240 definition finite_chain :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool" where
```
```   241   "finite_chain C = (chain C \<and> (\<exists>i. max_in_chain i C))"
```
```   242
```
```   243 text {* results about finite chains *}
```
```   244
```
```   245 lemma max_in_chainI: "(\<And>j. i \<le> j \<Longrightarrow> Y i = Y j) \<Longrightarrow> max_in_chain i Y"
```
```   246   unfolding max_in_chain_def by fast
```
```   247
```
```   248 lemma max_in_chainD: "\<lbrakk>max_in_chain i Y; i \<le> j\<rbrakk> \<Longrightarrow> Y i = Y j"
```
```   249   unfolding max_in_chain_def by fast
```
```   250
```
```   251 lemma finite_chainI:
```
```   252   "\<lbrakk>chain C; max_in_chain i C\<rbrakk> \<Longrightarrow> finite_chain C"
```
```   253   unfolding finite_chain_def by fast
```
```   254
```
```   255 lemma finite_chainE:
```
```   256   "\<lbrakk>finite_chain C; \<And>i. \<lbrakk>chain C; max_in_chain i C\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
```
```   257   unfolding finite_chain_def by fast
```
```   258
```
```   259 lemma lub_finch1: "\<lbrakk>chain C; max_in_chain i C\<rbrakk> \<Longrightarrow> range C <<| C i"
```
```   260 apply (rule is_lubI)
```
```   261 apply (rule ub_rangeI, rename_tac j)
```
```   262 apply (rule_tac x=i and y=j in linorder_le_cases)
```
```   263 apply (drule (1) max_in_chainD, simp)
```
```   264 apply (erule (1) chain_mono)
```
```   265 apply (erule ub_rangeD)
```
```   266 done
```
```   267
```
```   268 lemma lub_finch2:
```
```   269   "finite_chain C \<Longrightarrow> range C <<| C (LEAST i. max_in_chain i C)"
```
```   270 apply (erule finite_chainE)
```
```   271 apply (erule LeastI2 [where Q="\<lambda>i. range C <<| C i"])
```
```   272 apply (erule (1) lub_finch1)
```
```   273 done
```
```   274
```
```   275 lemma finch_imp_finite_range: "finite_chain Y \<Longrightarrow> finite (range Y)"
```
```   276  apply (erule finite_chainE)
```
```   277  apply (rule_tac B="Y ` {..i}" in finite_subset)
```
```   278   apply (rule subsetI)
```
```   279   apply (erule rangeE, rename_tac j)
```
```   280   apply (rule_tac x=i and y=j in linorder_le_cases)
```
```   281    apply (subgoal_tac "Y j = Y i", simp)
```
```   282    apply (simp add: max_in_chain_def)
```
```   283   apply simp
```
```   284  apply simp
```
```   285 done
```
```   286
```
```   287 lemma finite_range_has_max:
```
```   288   fixes f :: "nat \<Rightarrow> 'a" and r :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
```
```   289   assumes mono: "\<And>i j. i \<le> j \<Longrightarrow> r (f i) (f j)"
```
```   290   assumes finite_range: "finite (range f)"
```
```   291   shows "\<exists>k. \<forall>i. r (f i) (f k)"
```
```   292 proof (intro exI allI)
```
```   293   fix i :: nat
```
```   294   let ?j = "LEAST k. f k = f i"
```
```   295   let ?k = "Max ((\<lambda>x. LEAST k. f k = x) ` range f)"
```
```   296   have "?j \<le> ?k"
```
```   297   proof (rule Max_ge)
```
```   298     show "finite ((\<lambda>x. LEAST k. f k = x) ` range f)"
```
```   299       using finite_range by (rule finite_imageI)
```
```   300     show "?j \<in> (\<lambda>x. LEAST k. f k = x) ` range f"
```
```   301       by (intro imageI rangeI)
```
```   302   qed
```
```   303   hence "r (f ?j) (f ?k)"
```
```   304     by (rule mono)
```
```   305   also have "f ?j = f i"
```
```   306     by (rule LeastI, rule refl)
```
```   307   finally show "r (f i) (f ?k)" .
```
```   308 qed
```
```   309
```
```   310 lemma finite_range_imp_finch:
```
```   311   "\<lbrakk>chain Y; finite (range Y)\<rbrakk> \<Longrightarrow> finite_chain Y"
```
```   312  apply (subgoal_tac "\<exists>k. \<forall>i. Y i \<sqsubseteq> Y k")
```
```   313   apply (erule exE)
```
```   314   apply (rule finite_chainI, assumption)
```
```   315   apply (rule max_in_chainI)
```
```   316   apply (rule below_antisym)
```
```   317    apply (erule (1) chain_mono)
```
```   318   apply (erule spec)
```
```   319  apply (rule finite_range_has_max)
```
```   320   apply (erule (1) chain_mono)
```
```   321  apply assumption
```
```   322 done
```
```   323
```
```   324 lemma bin_chain: "x \<sqsubseteq> y \<Longrightarrow> chain (\<lambda>i. if i=0 then x else y)"
```
```   325   by (rule chainI, simp)
```
```   326
```
```   327 lemma bin_chainmax:
```
```   328   "x \<sqsubseteq> y \<Longrightarrow> max_in_chain (Suc 0) (\<lambda>i. if i=0 then x else y)"
```
```   329   unfolding max_in_chain_def by simp
```
```   330
```
```   331 lemma lub_bin_chain:
```
```   332   "x \<sqsubseteq> y \<Longrightarrow> range (\<lambda>i::nat. if i=0 then x else y) <<| y"
```
```   333 apply (frule bin_chain)
```
```   334 apply (drule bin_chainmax)
```
```   335 apply (drule (1) lub_finch1)
```
```   336 apply simp
```
```   337 done
```
```   338
```
```   339 text {* the maximal element in a chain is its lub *}
```
```   340
```
```   341 lemma lub_chain_maxelem: "\<lbrakk>Y i = c; \<forall>i. Y i \<sqsubseteq> c\<rbrakk> \<Longrightarrow> lub (range Y) = c"
```
```   342   by (blast dest: ub_rangeD intro: thelubI is_lubI ub_rangeI)
```
```   343
```
```   344 subsection {* Directed sets *}
```
```   345
```
```   346 definition directed :: "'a set \<Rightarrow> bool" where
```
```   347   "directed S \<longleftrightarrow> (\<exists>x. x \<in> S) \<and> (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>z\<in>S. x \<sqsubseteq> z \<and> y \<sqsubseteq> z)"
```
```   348
```
```   349 lemma directedI:
```
```   350   assumes 1: "\<exists>z. z \<in> S"
```
```   351   assumes 2: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> \<exists>z\<in>S. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
```
```   352   shows "directed S"
```
```   353   unfolding directed_def using prems by fast
```
```   354
```
```   355 lemma directedD1: "directed S \<Longrightarrow> \<exists>z. z \<in> S"
```
```   356   unfolding directed_def by fast
```
```   357
```
```   358 lemma directedD2: "\<lbrakk>directed S; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> \<exists>z\<in>S. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
```
```   359   unfolding directed_def by fast
```
```   360
```
```   361 lemma directedE1:
```
```   362   assumes S: "directed S"
```
```   363   obtains z where "z \<in> S"
```
```   364   by (insert directedD1 [OF S], fast)
```
```   365
```
```   366 lemma directedE2:
```
```   367   assumes S: "directed S"
```
```   368   assumes x: "x \<in> S" and y: "y \<in> S"
```
```   369   obtains z where "z \<in> S" "x \<sqsubseteq> z" "y \<sqsubseteq> z"
```
```   370   by (insert directedD2 [OF S x y], fast)
```
```   371
```
```   372 lemma directed_finiteI:
```
```   373   assumes U: "\<And>U. \<lbrakk>finite U; U \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>z\<in>S. U <| z"
```
```   374   shows "directed S"
```
```   375 proof (rule directedI)
```
```   376   have "finite {}" and "{} \<subseteq> S" by simp_all
```
```   377   hence "\<exists>z\<in>S. {} <| z" by (rule U)
```
```   378   thus "\<exists>z. z \<in> S" by simp
```
```   379 next
```
```   380   fix x y
```
```   381   assume "x \<in> S" and "y \<in> S"
```
```   382   hence "finite {x, y}" and "{x, y} \<subseteq> S" by simp_all
```
```   383   hence "\<exists>z\<in>S. {x, y} <| z" by (rule U)
```
```   384   thus "\<exists>z\<in>S. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by simp
```
```   385 qed
```
```   386
```
```   387 lemma directed_finiteD:
```
```   388   assumes S: "directed S"
```
```   389   shows "\<lbrakk>finite U; U \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>z\<in>S. U <| z"
```
```   390 proof (induct U set: finite)
```
```   391   case empty
```
```   392   from S have "\<exists>z. z \<in> S" by (rule directedD1)
```
```   393   thus "\<exists>z\<in>S. {} <| z" by simp
```
```   394 next
```
```   395   case (insert x F)
```
```   396   from `insert x F \<subseteq> S`
```
```   397   have xS: "x \<in> S" and FS: "F \<subseteq> S" by simp_all
```
```   398   from FS have "\<exists>y\<in>S. F <| y" by fact
```
```   399   then obtain y where yS: "y \<in> S" and Fy: "F <| y" ..
```
```   400   obtain z where zS: "z \<in> S" and xz: "x \<sqsubseteq> z" and yz: "y \<sqsubseteq> z"
```
```   401     using S xS yS by (rule directedE2)
```
```   402   from Fy yz have "F <| z" by (rule is_ub_upward)
```
```   403   with xz have "insert x F <| z" by simp
```
```   404   with zS show "\<exists>z\<in>S. insert x F <| z" ..
```
```   405 qed
```
```   406
```
```   407 lemma not_directed_empty [simp]: "\<not> directed {}"
```
```   408   by (rule notI, drule directedD1, simp)
```
```   409
```
```   410 lemma directed_singleton: "directed {x}"
```
```   411   by (rule directedI, auto)
```
```   412
```
```   413 lemma directed_bin: "x \<sqsubseteq> y \<Longrightarrow> directed {x, y}"
```
```   414   by (rule directedI, auto)
```
```   415
```
```   416 lemma directed_chain: "chain S \<Longrightarrow> directed (range S)"
```
```   417 apply (rule directedI)
```
```   418 apply (rule_tac x="S 0" in exI, simp)
```
```   419 apply (clarify, rename_tac m n)
```
```   420 apply (rule_tac x="S (max m n)" in bexI)
```
```   421 apply (simp add: chain_mono)
```
```   422 apply simp
```
```   423 done
```
```   424
```
```   425 text {* lemmata for improved admissibility introdution rule *}
```
```   426
```
```   427 lemma infinite_chain_adm_lemma:
```
```   428   "\<lbrakk>chain Y; \<forall>i. P (Y i);
```
```   429     \<And>Y. \<lbrakk>chain Y; \<forall>i. P (Y i); \<not> finite_chain Y\<rbrakk> \<Longrightarrow> P (\<Squnion>i. Y i)\<rbrakk>
```
```   430       \<Longrightarrow> P (\<Squnion>i. Y i)"
```
```   431 apply (case_tac "finite_chain Y")
```
```   432 prefer 2 apply fast
```
```   433 apply (unfold finite_chain_def)
```
```   434 apply safe
```
```   435 apply (erule lub_finch1 [THEN thelubI, THEN ssubst])
```
```   436 apply assumption
```
```   437 apply (erule spec)
```
```   438 done
```
```   439
```
```   440 lemma increasing_chain_adm_lemma:
```
```   441   "\<lbrakk>chain Y;  \<forall>i. P (Y i); \<And>Y. \<lbrakk>chain Y; \<forall>i. P (Y i);
```
```   442     \<forall>i. \<exists>j>i. Y i \<noteq> Y j \<and> Y i \<sqsubseteq> Y j\<rbrakk> \<Longrightarrow> P (\<Squnion>i. Y i)\<rbrakk>
```
```   443       \<Longrightarrow> P (\<Squnion>i. Y i)"
```
```   444 apply (erule infinite_chain_adm_lemma)
```
```   445 apply assumption
```
```   446 apply (erule thin_rl)
```
```   447 apply (unfold finite_chain_def)
```
```   448 apply (unfold max_in_chain_def)
```
```   449 apply (fast dest: le_imp_less_or_eq elim: chain_mono_less)
```
```   450 done
```
```   451
```
```   452 end
```
```   453
```
```   454 end
```