Theorem Inductive.lfp_ordinal_induct generalized to complete lattices
authorhaftmann
Wed Jan 30 10:57:44 2008 +0100 (2008-01-30)
changeset 260138764a1f1253b
parent 26012 f6917792f8a4
child 26014 00c2c3525bef
Theorem Inductive.lfp_ordinal_induct generalized to complete lattices
NEWS
src/HOL/Inductive.thy
     1.1 --- a/NEWS	Tue Jan 29 18:00:12 2008 +0100
     1.2 +++ b/NEWS	Wed Jan 30 10:57:44 2008 +0100
     1.3 @@ -35,6 +35,9 @@
     1.4  
     1.5  *** HOL ***
     1.6  
     1.7 +* Theorem Inductive.lfp_ordinal_induct generalized to complete lattices.  The
     1.8 +form set-specific version is available as Inductive.lfp_ordinal_induct_set.
     1.9 +
    1.10  * Theorems "power.simps" renamed to "power_int.simps".
    1.11  
    1.12  * New class semiring_div provides basic abstract properties of semirings
     2.1 --- a/src/HOL/Inductive.thy	Tue Jan 29 18:00:12 2008 +0100
     2.2 +++ b/src/HOL/Inductive.thy	Wed Jan 30 10:57:44 2008 +0100
     2.3 @@ -24,12 +24,15 @@
     2.4  
     2.5  subsection {* Least and greatest fixed points *}
     2.6  
     2.7 +context complete_lattice
     2.8 +begin
     2.9 +
    2.10  definition
    2.11 -  lfp :: "('a\<Colon>complete_lattice \<Rightarrow> 'a) \<Rightarrow> 'a" where
    2.12 +  lfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a" where
    2.13    "lfp f = Inf {u. f u \<le> u}"    --{*least fixed point*}
    2.14  
    2.15  definition
    2.16 -  gfp :: "('a\<Colon>complete_lattice \<Rightarrow> 'a) \<Rightarrow> 'a" where
    2.17 +  gfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a" where
    2.18    "gfp f = Sup {u. u \<le> f u}"    --{*greatest fixed point*}
    2.19  
    2.20  
    2.21 @@ -44,6 +47,8 @@
    2.22  lemma lfp_greatest: "(!!u. f u \<le> u ==> A \<le> u) ==> A \<le> lfp f"
    2.23    by (auto simp add: lfp_def intro: Inf_greatest)
    2.24  
    2.25 +end
    2.26 +
    2.27  lemma lfp_lemma2: "mono f ==> f (lfp f) \<le> lfp f"
    2.28    by (iprover intro: lfp_greatest order_trans monoD lfp_lowerbound)
    2.29  
    2.30 @@ -81,25 +86,34 @@
    2.31    by (rule lfp_induct [THEN subsetD, THEN CollectD, OF mono _ lfp])
    2.32      (auto simp: inf_set_eq intro: indhyp)
    2.33  
    2.34 -lemma lfp_ordinal_induct: 
    2.35 +lemma lfp_ordinal_induct:
    2.36 +  fixes f :: "'a\<Colon>complete_lattice \<Rightarrow> 'a"
    2.37 +  assumes mono: "mono f"
    2.38 +  and P_f: "\<And>S. P S \<Longrightarrow> P (f S)"
    2.39 +  and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Sup M)"
    2.40 +  shows "P (lfp f)"
    2.41 +proof -
    2.42 +  let ?M = "{S. S \<le> lfp f \<and> P S}"
    2.43 +  have "P (Sup ?M)" using P_Union by simp
    2.44 +  also have "Sup ?M = lfp f"
    2.45 +  proof (rule antisym)
    2.46 +    show "Sup ?M \<le> lfp f" by (blast intro: Sup_least)
    2.47 +    hence "f (Sup ?M) \<le> f (lfp f)" by (rule mono [THEN monoD])
    2.48 +    hence "f (Sup ?M) \<le> lfp f" using mono [THEN lfp_unfold] by simp
    2.49 +    hence "f (Sup ?M) \<in> ?M" using P_f P_Union by simp
    2.50 +    hence "f (Sup ?M) \<le> Sup ?M" by (rule Sup_upper)
    2.51 +    thus "lfp f \<le> Sup ?M" by (rule lfp_lowerbound)
    2.52 +  qed
    2.53 +  finally show ?thesis .
    2.54 +qed 
    2.55 +
    2.56 +lemma lfp_ordinal_induct_set: 
    2.57    assumes mono: "mono f"
    2.58    and P_f: "!!S. P S ==> P(f S)"
    2.59    and P_Union: "!!M. !S:M. P S ==> P(Union M)"
    2.60    shows "P(lfp f)"
    2.61 -proof -
    2.62 -  let ?M = "{S. S \<subseteq> lfp f & P S}"
    2.63 -  have "P (Union ?M)" using P_Union by simp
    2.64 -  also have "Union ?M = lfp f"
    2.65 -  proof
    2.66 -    show "Union ?M \<subseteq> lfp f" by blast
    2.67 -    hence "f (Union ?M) \<subseteq> f (lfp f)" by (rule mono [THEN monoD])
    2.68 -    hence "f (Union ?M) \<subseteq> lfp f" using mono [THEN lfp_unfold] by simp
    2.69 -    hence "f (Union ?M) \<in> ?M" using P_f P_Union by simp
    2.70 -    hence "f (Union ?M) \<subseteq> Union ?M" by (rule Union_upper)
    2.71 -    thus "lfp f \<subseteq> Union ?M" by (rule lfp_lowerbound)
    2.72 -  qed
    2.73 -  finally show ?thesis .
    2.74 -qed
    2.75 +  using assms unfolding Sup_set_def [symmetric]
    2.76 +  by (rule lfp_ordinal_induct) 
    2.77  
    2.78  
    2.79  text{*Definition forms of @{text lfp_unfold} and @{text lfp_induct},