src/HOL/ex/Abstract_NAT.thy
changeset 21368 bffb2240d03f
parent 20713 823967ef47f1
child 21392 e571e84cbe89
equal deleted inserted replaced
21367:7a0cc1bb4dcc 21368:bffb2240d03f
    16     and succ :: "'n \<Rightarrow> 'n"
    16     and succ :: "'n \<Rightarrow> 'n"
    17   assumes succ_inject [simp]: "(succ m = succ n) = (m = n)"
    17   assumes succ_inject [simp]: "(succ m = succ n) = (m = n)"
    18     and succ_neq_zero [simp]: "succ m \<noteq> zero"
    18     and succ_neq_zero [simp]: "succ m \<noteq> zero"
    19     and induct [case_names zero succ, induct type: 'n]:
    19     and induct [case_names zero succ, induct type: 'n]:
    20       "P zero \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (succ n)) \<Longrightarrow> P n"
    20       "P zero \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (succ n)) \<Longrightarrow> P n"
       
    21 begin
    21 
    22 
    22 lemma (in NAT) zero_neq_succ [simp]: "zero \<noteq> succ m"
    23 lemma zero_neq_succ [simp]: "zero \<noteq> succ m"
    23   by (rule succ_neq_zero [symmetric])
    24   by (rule succ_neq_zero [symmetric])
    24 
    25 
    25 
    26 
    26 text {*
    27 text {* \medskip Primitive recursion as a (functional) relation -- polymorphic! *}
    27   Primitive recursion as a (functional) relation -- polymorphic!
       
    28 
    28 
    29   (We simulate a localized version of the inductive packages using
    29 inductive2
    30   explicit premises + parameters, and an abbreviation.) *}
    30   Rec :: "'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> 'a \<Rightarrow> bool"
       
    31   for e :: 'a and r :: "'n \<Rightarrow> 'a \<Rightarrow> 'a"
       
    32 where
       
    33     Rec_zero: "Rec e r zero e"
       
    34   | Rec_succ: "Rec e r m n \<Longrightarrow> Rec e r (succ m) (r m n)"
    31 
    35 
    32 consts
    36 lemma Rec_functional:
    33   REC :: "'n \<Rightarrow> ('n \<Rightarrow> 'n) \<Rightarrow> 'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('n * 'a) set"
       
    34 inductive "REC zer succ e r"
       
    35   intros
       
    36     Rec_zero: "NAT zer succ \<Longrightarrow> (zer, e) \<in> REC zer succ e r"
       
    37     Rec_succ: "NAT zer succ \<Longrightarrow> (m, n) \<in> REC zer succ e r \<Longrightarrow>
       
    38       (succ m, r m n) \<in> REC zer succ e r"
       
    39 
       
    40 abbreviation (in NAT)
       
    41   "Rec == REC zero succ"
       
    42 
       
    43 lemma (in NAT) Rec_functional:
       
    44   fixes x :: 'n
    37   fixes x :: 'n
    45   shows "\<exists>!y::'a. (x, y) \<in> Rec e r"  (is "\<exists>!y::'a. _ \<in> ?Rec")
    38   shows "\<exists>!y::'a. Rec e r x y"
    46 proof (induct x)
    39 proof -
    47   case zero
    40   let ?R = "Rec e r"
    48   show "\<exists>!y. (zero, y) \<in> ?Rec"
    41   show ?thesis
    49   proof
    42   proof (induct x)
    50     show "(zero, e) \<in> ?Rec" by (rule Rec_zero)
    43     case zero
    51     fix y assume "(zero, y) \<in> ?Rec"
    44     show "\<exists>!y. ?R zero y"
    52     then show "y = e" by cases simp_all
    45     proof
    53   qed
    46       show "?R zero e" by (rule Rec_zero)
    54 next
    47       fix y assume "?R zero y"
    55   case (succ m)
    48       then show "y = e" by cases simp_all
    56   from `\<exists>!y. (m, y) \<in> ?Rec`
    49     qed
    57   obtain y where y: "(m, y) \<in> ?Rec"
    50   next
    58     and yy': "\<And>y'. (m, y') \<in> ?Rec \<Longrightarrow> y = y'" by blast
    51     case (succ m)
    59   show "\<exists>!z. (succ m, z) \<in> ?Rec"
    52     from `\<exists>!y. ?R m y`
    60   proof
    53     obtain y where y: "?R m y"
    61     from _ y show "(succ m, r m y) \<in> ?Rec" by (rule Rec_succ)
    54       and yy': "\<And>y'. ?R m y' \<Longrightarrow> y = y'" by blast
    62     fix z assume "(succ m, z) \<in> ?Rec"
    55     show "\<exists>!z. ?R (succ m) z"
    63     then obtain u where "z = r m u" and "(m, u) \<in> ?Rec" by cases simp_all
    56     proof
    64     with yy' show "z = r m y" by (simp only:)
    57       from y show "?R (succ m) (r m y)" by (rule Rec_succ)
       
    58       fix z assume "?R (succ m) z"
       
    59       then obtain u where "z = r m u" and "?R m u" by cases simp_all
       
    60       with yy' show "z = r m y" by (simp only:)
       
    61     qed
    65   qed
    62   qed
    66 qed
    63 qed
    67 
    64 
    68 
    65 
    69 text {* The recursion operator -- polymorphic! *}
    66 text {* \medskip The recursion operator -- polymorphic! *}
    70 
    67 
    71 definition (in NAT)
    68 definition
    72   "rec e r x = (THE y. (x, y) \<in> Rec e r)"
    69   rec :: "'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> 'a"
       
    70   "rec e r x = (THE y. Rec e r x y)"
    73 
    71 
    74 lemma (in NAT) rec_eval:
    72 lemma rec_eval:
    75   assumes Rec: "(x, y) \<in> Rec e r"
    73   assumes Rec: "Rec e r x y"
    76   shows "rec e r x = y"
    74   shows "rec e r x = y"
    77   unfolding rec_def
    75   unfolding rec_def
    78   using Rec_functional and Rec by (rule the1_equality)
    76   using Rec_functional and Rec by (rule the1_equality)
    79 
    77 
    80 lemma (in NAT) rec_zero: "rec e r zero = e"
    78 lemma rec_zero [simp]: "rec e r zero = e"
    81 proof (rule rec_eval)
    79 proof (rule rec_eval)
    82   show "(zero, e) \<in> Rec e r" by (rule Rec_zero)
    80   show "Rec e r zero e" by (rule Rec_zero)
    83 qed
    81 qed
    84 
    82 
    85 lemma (in NAT) rec_succ: "rec e r (succ m) = r m (rec e r m)"
    83 lemma rec_succ [simp]: "rec e r (succ m) = r m (rec e r m)"
    86 proof (rule rec_eval)
    84 proof (rule rec_eval)
    87   let ?Rec = "Rec e r"
    85   let ?R = "Rec e r"
    88   have "(m, rec e r m) \<in> ?Rec"
    86   have "?R m (rec e r m)"
    89     unfolding rec_def
    87     unfolding rec_def using Rec_functional by (rule theI')
    90     using Rec_functional by (rule theI')
    88   then show "?R (succ m) (r m (rec e r m))" by (rule Rec_succ)
    91   with _ show "(succ m, r m (rec e r m)) \<in> ?Rec" by (rule Rec_succ)
       
    92 qed
    89 qed
    93 
    90 
    94 
    91 
    95 text {* Just see that our abstract specification makes sense \dots *}
    92 text {* \medskip Example: addition (monomorphic) *}
       
    93 
       
    94 definition
       
    95   add :: "'n \<Rightarrow> 'n \<Rightarrow> 'n"
       
    96   "add m n = rec n (\<lambda>_ k. succ k) m"
       
    97 
       
    98 lemma add_zero [simp]: "add zero n = n"
       
    99   and add_succ [simp]: "add (succ m) n = succ (add m n)"
       
   100   unfolding add_def by simp_all
       
   101 
       
   102 lemma add_assoc: "add (add k m) n = add k (add m n)"
       
   103   by (induct k) simp_all
       
   104 
       
   105 lemma add_zero_right: "add m zero = m"
       
   106   by (induct m) simp_all
       
   107 
       
   108 lemma add_succ_right: "add m (succ n) = succ (add m n)"
       
   109   by (induct m) simp_all
       
   110 
       
   111 
       
   112 text {* \medskip Example: replication (polymorphic) *}
       
   113 
       
   114 definition
       
   115   repl :: "'n \<Rightarrow> 'a \<Rightarrow> 'a list"
       
   116   "repl n x = rec [] (\<lambda>_ xs. x # xs) n"
       
   117 
       
   118 lemma repl_zero [simp]: "repl zero x = []"
       
   119   and repl_succ [simp]: "repl (succ n) x = x # repl n x"
       
   120   unfolding repl_def by simp_all
       
   121 
       
   122 lemma "repl (succ (succ (succ zero))) True = [True, True, True]"
       
   123   by simp
       
   124 
       
   125 end
       
   126 
       
   127 
       
   128 text {* \medskip Just see that our abstract specification makes sense \dots *}
    96 
   129 
    97 interpretation NAT [0 Suc]
   130 interpretation NAT [0 Suc]
    98 proof (rule NAT.intro)
   131 proof (rule NAT.intro)
    99   fix m n
   132   fix m n
   100   show "(Suc m = Suc n) = (m = n)" by simp
   133   show "(Suc m = Suc n) = (m = n)" by simp