thys/Rec_Def.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Tue, 26 Feb 2013 13:24:40 +0000
changeset 198 d93cc4295306
parent 169 6013ca0e6e22
child 229 d8e6f0798e23
permissions -rwxr-xr-x
tuned some files
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     1
(* Title: thys/Rec_Def.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     2
   Author: Jian Xu, Xingyuan Zhang, and Christian Urban
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     3
*)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     4
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     5
header {* Definition of Recursive Functions *}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     6
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     7
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
     8
theory Rec_Def
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
imports Main
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
begin
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    12
section {* Recursive functions *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
datatype recf = 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    15
  z | s | 
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    16
  -- {* The projection function, where @{text "id i j"} returns the @{text "j"}-th
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    17
  argment out of the @{text "i"} arguments. *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    18
  id nat nat | 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    19
  -- {* The compostion operator, where "@{text "Cn n f [g1; g2; \<dots> ;gm]"} 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
  computes @{text "f (g1(x1, x2, \<dots>, xn), g2(x1, x2, \<dots>, xn), \<dots> , 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    21
  gm(x1, x2, \<dots> , xn))"} for input argments @{text "x1, \<dots>, xn"}. *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
  Cn nat recf "recf list" | 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    23
  -- {* The primitive resursive operator, where @{text "Pr n f g"} computes:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    24
  @{text "Pr n f g (x1, x2, \<dots>, xn-1, 0) = f(x1, \<dots>, xn-1)"} 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
  and @{text "Pr n f g (x1, x2, \<dots>, xn-1, k') = g(x1, x2, \<dots>, xn-1, k, 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    26
                                            Pr n f g (x1, \<dots>, xn-1, k))"}.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    27
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
  Pr nat recf recf | 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    29
  -- {* The minimization operator, where @{text "Mn n f (x1, x2, \<dots> , xn)"} 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
  computes the first i such that @{text "f (x1, \<dots>, xn, i) = 0"} and for all
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    31
  @{text "j"}, @{text "f (x1, x2, \<dots>, xn, j) > 0"}. *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
  Mn nat recf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
198
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    34
(*
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    35
partial_function (tailrec) 
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    36
  rec_exec :: "recf \<Rightarrow> nat list \<Rightarrow> nat"
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    37
where
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    38
  "rec_exec f ns = (case (f, ns) of
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    39
      (z, xs) => 0
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    40
   |  (s, xs) => Suc (xs ! 0)
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    41
   |  (id m n, xs) => (xs ! n) 
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    42
   |  (Cn n f gs, xs) => 
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    43
             (let ys = (map (\<lambda> a. rec_exec a xs) gs) in 
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    44
                                  rec_exec f ys)
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    45
   |  (Pr n f g, xs) => 
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    46
         (if last xs = 0 then rec_exec f (butlast xs)
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    47
          else rec_exec g (butlast xs @ [last xs - 1] @
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    48
            [rec_exec (Pr n f g) (butlast xs @ [last xs - 1])]))
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    49
   |  (Mn n f, xs) => (LEAST x. rec_exec f (xs @ [x]) = 0))"
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    50
*)
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    51
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
text {* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
  The semantis of recursive operators is given by an inductively defined
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
  relation as follows, where  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
  @{text "rec_calc_rel R [x1, x2, \<dots>, xn] r"} means the computation of 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
  @{text "R"} over input arguments @{text "[x1, x2, \<dots>, xn"} terminates
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  and gives rise to a result @{text "r"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
inductive rec_calc_rel :: "recf \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    61
where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    62
  calc_z: "rec_calc_rel z [n] 0" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    63
  calc_s: "rec_calc_rel s [n] (Suc n)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    64
  calc_id: "\<lbrakk>length args = i; j < i; args!j = r\<rbrakk> \<Longrightarrow> rec_calc_rel (id i j) args r" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
  calc_cn: "\<lbrakk>length args = n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
             \<forall> k < length gs. rec_calc_rel (gs ! k) args (rs ! k);
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
             length rs = length gs; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
             rec_calc_rel f rs r\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
            \<Longrightarrow> rec_calc_rel (Cn n f gs) args r" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
  calc_pr_zero: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
           "\<lbrakk>length args = n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
             rec_calc_rel f args r0 \<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
            \<Longrightarrow> rec_calc_rel (Pr n f g) (args @ [0]) r0" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
  calc_pr_ind: "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
           \<lbrakk> length args = n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    76
             rec_calc_rel (Pr n f g) (args @ [k]) rk; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    77
             rec_calc_rel g (args @ [k] @ [rk]) rk'\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    78
            \<Longrightarrow> rec_calc_rel (Pr n f g) (args @ [Suc k]) rk'"  |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    79
  calc_mn: "\<lbrakk>length args = n; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    80
             rec_calc_rel f (args@[r]) 0; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    81
             \<forall> i < r. (\<exists> ri. rec_calc_rel f (args@[i]) ri \<and> ri \<noteq> 0)\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
            \<Longrightarrow> rec_calc_rel (Mn n f) args r" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    84
inductive_cases calc_pr_reverse: "rec_calc_rel (Pr n f g) (lm) rSucy"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    86
inductive_cases calc_z_reverse: "rec_calc_rel z lm x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    88
inductive_cases calc_s_reverse: "rec_calc_rel s lm x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    90
inductive_cases calc_id_reverse: "rec_calc_rel (id m n) lm x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    91
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    92
inductive_cases calc_cn_reverse: "rec_calc_rel (Cn n f gs) lm x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    93
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    94
inductive_cases calc_mn_reverse:"rec_calc_rel (Mn n f) lm x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    95
end