src/HOL/Wfrec.thy
author wenzelm
Sat Jul 18 22:58:50 2015 +0200 (2015-07-18)
changeset 60758 d8d85a8172b5
parent 58889 5b7a9633cfa8
child 61799 4cf66f21b764
permissions -rw-r--r--
isabelle update_cartouches;
wenzelm@55210
     1
(*  Title:      HOL/Wfrec.thy
krauss@44014
     2
    Author:     Tobias Nipkow
krauss@44014
     3
    Author:     Lawrence C Paulson
krauss@44014
     4
    Author:     Konrad Slind
krauss@44014
     5
*)
krauss@44014
     6
wenzelm@60758
     7
section \<open>Well-Founded Recursion Combinator\<close>
krauss@44014
     8
krauss@44014
     9
theory Wfrec
blanchet@55017
    10
imports Wellfounded
krauss@44014
    11
begin
krauss@44014
    12
hoelzl@58184
    13
inductive wfrec_rel :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool" for R F where
hoelzl@58184
    14
  wfrecI: "(\<And>z. (z, x) \<in> R \<Longrightarrow> wfrec_rel R F z (g z)) \<Longrightarrow> wfrec_rel R F x (F g x)"
krauss@44014
    15
hoelzl@58184
    16
definition cut :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b" where
hoelzl@58184
    17
  "cut f R x = (\<lambda>y. if (y, x) \<in> R then f y else undefined)"
hoelzl@58184
    18
hoelzl@58184
    19
definition adm_wf :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)) \<Rightarrow> bool" where
hoelzl@58184
    20
  "adm_wf R F \<longleftrightarrow> (\<forall>f g x. (\<forall>z. (z, x) \<in> R \<longrightarrow> f z = g z) \<longrightarrow> F f x = F g x)"
krauss@44014
    21
hoelzl@58184
    22
definition wfrec :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)) \<Rightarrow> ('a \<Rightarrow> 'b)" where
hoelzl@58184
    23
  "wfrec R F = (\<lambda>x. THE y. wfrec_rel R (\<lambda>f x. F (cut f R x) x) x y)"
krauss@44014
    24
hoelzl@58184
    25
lemma cuts_eq: "(cut f R x = cut g R x) \<longleftrightarrow> (\<forall>y. (y, x) \<in> R \<longrightarrow> f y = g y)"
hoelzl@58184
    26
  by (simp add: fun_eq_iff cut_def)
krauss@44014
    27
hoelzl@58184
    28
lemma cut_apply: "(x, a) \<in> R \<Longrightarrow> cut f R a x = f x"
hoelzl@58184
    29
  by (simp add: cut_def)
krauss@44014
    30
wenzelm@60758
    31
text\<open>Inductive characterization of wfrec combinator; for details see:
wenzelm@60758
    32
John Harrison, "Inductive definitions: automation and application"\<close>
krauss@44014
    33
hoelzl@58184
    34
lemma theI_unique: "\<exists>!x. P x \<Longrightarrow> P x \<longleftrightarrow> x = The P"
hoelzl@58184
    35
  by (auto intro: the_equality[symmetric] theI)
krauss@44014
    36
hoelzl@58184
    37
lemma wfrec_unique: assumes "adm_wf R F" "wf R" shows "\<exists>!y. wfrec_rel R F x y"
wenzelm@60758
    38
  using \<open>wf R\<close>
hoelzl@58184
    39
proof induct
hoelzl@58184
    40
  def f \<equiv> "\<lambda>y. THE z. wfrec_rel R F y z"
hoelzl@58184
    41
  case (less x)
hoelzl@58184
    42
  then have "\<And>y z. (y, x) \<in> R \<Longrightarrow> wfrec_rel R F y z \<longleftrightarrow> z = f y"
hoelzl@58184
    43
    unfolding f_def by (rule theI_unique)
wenzelm@60758
    44
  with \<open>adm_wf R F\<close> show ?case
hoelzl@58184
    45
    by (subst wfrec_rel.simps) (auto simp: adm_wf_def)
hoelzl@58184
    46
qed
krauss@44014
    47
hoelzl@58184
    48
lemma adm_lemma: "adm_wf R (\<lambda>f x. F (cut f R x) x)"
hoelzl@58184
    49
  by (auto simp add: adm_wf_def
hoelzl@58184
    50
           intro!: arg_cong[where f="\<lambda>x. F x y" for y] cuts_eq[THEN iffD2])
hoelzl@58184
    51
hoelzl@58184
    52
lemma wfrec: "wf R \<Longrightarrow> wfrec R F a = F (cut (wfrec R F) R a) a"
krauss@44014
    53
apply (simp add: wfrec_def)
krauss@44014
    54
apply (rule adm_lemma [THEN wfrec_unique, THEN the1_equality], assumption)
krauss@44014
    55
apply (rule wfrec_rel.wfrecI)
krauss@44014
    56
apply (erule adm_lemma [THEN wfrec_unique, THEN theI'])
krauss@44014
    57
done
krauss@44014
    58
krauss@44014
    59
wenzelm@60758
    60
text\<open>* This form avoids giant explosions in proofs.  NOTE USE OF ==\<close>
hoelzl@58184
    61
lemma def_wfrec: "f \<equiv> wfrec R F \<Longrightarrow> wf R \<Longrightarrow> f a = F (cut f R a) a"
hoelzl@58184
    62
 by (auto intro: wfrec)
hoelzl@58184
    63
hoelzl@58184
    64
wenzelm@60758
    65
subsubsection \<open>Well-founded recursion via genuine fixpoints\<close>
krauss@44014
    66
hoelzl@58184
    67
lemma wfrec_fixpoint:
hoelzl@58184
    68
  assumes WF: "wf R" and ADM: "adm_wf R F"
hoelzl@58184
    69
  shows "wfrec R F = F (wfrec R F)"
hoelzl@58184
    70
proof (rule ext)
hoelzl@58184
    71
  fix x
hoelzl@58184
    72
  have "wfrec R F x = F (cut (wfrec R F) R x) x"
hoelzl@58184
    73
    using wfrec[of R F] WF by simp
hoelzl@58184
    74
  also
hoelzl@58184
    75
  { have "\<And> y. (y,x) \<in> R \<Longrightarrow> (cut (wfrec R F) R x) y = (wfrec R F) y"
hoelzl@58184
    76
      by (auto simp add: cut_apply)
hoelzl@58184
    77
    hence "F (cut (wfrec R F) R x) x = F (wfrec R F) x"
hoelzl@58184
    78
      using ADM adm_wf_def[of R F] by auto }
hoelzl@58184
    79
  finally show "wfrec R F x = F (wfrec R F) x" .
hoelzl@58184
    80
qed
krauss@44014
    81
wenzelm@60758
    82
subsection \<open>Wellfoundedness of @{text same_fst}\<close>
krauss@44014
    83
hoelzl@58184
    84
definition same_fst :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> ('b \<times> 'b) set) \<Rightarrow> (('a \<times> 'b) \<times> ('a \<times> 'b)) set" where
hoelzl@58184
    85
  "same_fst P R = {((x', y'), (x, y)) . x' = x \<and> P x \<and> (y',y) \<in> R x}"
wenzelm@60758
    86
   --\<open>For @{const wfrec} declarations where the first n parameters
wenzelm@60758
    87
       stay unchanged in the recursive call.\<close>
krauss@44014
    88
hoelzl@58184
    89
lemma same_fstI [intro!]: "P x \<Longrightarrow> (y', y) \<in> R x \<Longrightarrow> ((x, y'), (x, y)) \<in> same_fst P R"
hoelzl@58184
    90
  by (simp add: same_fst_def)
krauss@44014
    91
krauss@44014
    92
lemma wf_same_fst:
hoelzl@58184
    93
  assumes prem: "\<And>x. P x \<Longrightarrow> wf (R x)"
hoelzl@58184
    94
  shows "wf (same_fst P R)"
krauss@44014
    95
apply (simp cong del: imp_cong add: wf_def same_fst_def)
krauss@44014
    96
apply (intro strip)
krauss@44014
    97
apply (rename_tac a b)
krauss@44014
    98
apply (case_tac "wf (R a)")
krauss@44014
    99
 apply (erule_tac a = b in wf_induct, blast)
krauss@44014
   100
apply (blast intro: prem)
krauss@44014
   101
done
krauss@44014
   102
krauss@44014
   103
end