src/HOL/Isar_examples/Fibonacci.thy
author paulson
Tue, 23 May 2000 18:06:22 +0200
changeset 8935 548901d05a0e
parent 8814 0a5edcbe0695
child 9659 b9cf6801f3da
permissions -rw-r--r--
added type constraint ::nat because 0 is now overloaded
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8051
wenzelm
parents:
diff changeset
     1
(*  Title:      HOL/Isar_examples/Fibonacci.thy
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
wenzelm
parents:
diff changeset
     3
    Author:     Gertrud Bauer
wenzelm
parents:
diff changeset
     4
    Copyright   1999 Technische Universitaet Muenchen
wenzelm
parents:
diff changeset
     5
wenzelm
parents:
diff changeset
     6
The Fibonacci function.  Demonstrates the use of recdef.  Original
wenzelm
parents:
diff changeset
     7
tactic script by Lawrence C Paulson.
wenzelm
parents:
diff changeset
     8
wenzelm
parents:
diff changeset
     9
Fibonacci numbers: proofs of laws taken from
wenzelm
parents:
diff changeset
    10
wenzelm
parents:
diff changeset
    11
  R. L. Graham, D. E. Knuth, O. Patashnik.
wenzelm
parents:
diff changeset
    12
  Concrete Mathematics.
wenzelm
parents:
diff changeset
    13
  (Addison-Wesley, 1989)
wenzelm
parents:
diff changeset
    14
*)
wenzelm
parents:
diff changeset
    15
wenzelm
parents:
diff changeset
    16
header {* Fib and Gcd commute *};
wenzelm
parents:
diff changeset
    17
wenzelm
parents:
diff changeset
    18
theory Fibonacci = Primes:;
wenzelm
parents:
diff changeset
    19
wenzelm
parents:
diff changeset
    20
text_raw {*
wenzelm
parents:
diff changeset
    21
 \footnote{Isar version by Gertrud Bauer.  Original tactic script by
8052
wenzelm
parents: 8051
diff changeset
    22
 Larry Paulson.  A few proofs of laws taken from
8051
wenzelm
parents:
diff changeset
    23
 \cite{Concrete-Math}.}
wenzelm
parents:
diff changeset
    24
*};
wenzelm
parents:
diff changeset
    25
wenzelm
parents:
diff changeset
    26
wenzelm
parents:
diff changeset
    27
subsection {* Fibonacci numbers *};
wenzelm
parents:
diff changeset
    28
wenzelm
parents:
diff changeset
    29
consts fib :: "nat => nat";
wenzelm
parents:
diff changeset
    30
recdef fib less_than
wenzelm
parents:
diff changeset
    31
 "fib 0 = 0"
wenzelm
parents:
diff changeset
    32
 "fib 1 = 1"
8814
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
    33
 "fib (Suc (Suc x)) = fib x + fib (Suc x)";
8051
wenzelm
parents:
diff changeset
    34
wenzelm
parents:
diff changeset
    35
lemma [simp]: "0 < fib (Suc n)";
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
    36
  by (induct n rule: fib.induct) (simp+);
8051
wenzelm
parents:
diff changeset
    37
wenzelm
parents:
diff changeset
    38
wenzelm
parents:
diff changeset
    39
text {* Alternative induction rule. *};
wenzelm
parents:
diff changeset
    40
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
    41
theorem fib_induct:
8051
wenzelm
parents:
diff changeset
    42
"[| P 0; P 1; !!n. [| P (n + 1); P n |] ==> P (n + 2) |] ==> P n";
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
    43
  by (induct rule: fib.induct, simp+);
8051
wenzelm
parents:
diff changeset
    44
wenzelm
parents:
diff changeset
    45
wenzelm
parents:
diff changeset
    46
wenzelm
parents:
diff changeset
    47
subsection {* Fib and gcd commute *};
wenzelm
parents:
diff changeset
    48
wenzelm
parents:
diff changeset
    49
text {* A few laws taken from \cite{Concrete-Math}. *};
wenzelm
parents:
diff changeset
    50
wenzelm
parents:
diff changeset
    51
lemma fib_add: 
wenzelm
parents:
diff changeset
    52
  "fib (n + k + 1) = fib (k + 1) * fib (n + 1) + fib k * fib n"
wenzelm
parents:
diff changeset
    53
  (is "?P n");
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
    54
proof (induct ?P n rule: fib_induct) -- {* see \cite[page 280]{Concrete-Math} *};
8051
wenzelm
parents:
diff changeset
    55
  show "?P 0"; by simp;
wenzelm
parents:
diff changeset
    56
  show "?P 1"; by simp;
wenzelm
parents:
diff changeset
    57
  fix n;
wenzelm
parents:
diff changeset
    58
  have "fib (n + 2 + k + 1)
wenzelm
parents:
diff changeset
    59
    = fib (n + k + 1) + fib (n + 1 + k + 1)"; by simp;
wenzelm
parents:
diff changeset
    60
  also; assume "fib (n + k + 1)
wenzelm
parents:
diff changeset
    61
    = fib (k + 1) * fib (n + 1) + fib k * fib n"
wenzelm
parents:
diff changeset
    62
      (is " _ = ?R1");
wenzelm
parents:
diff changeset
    63
  also; assume "fib (n + 1 + k + 1)
wenzelm
parents:
diff changeset
    64
    = fib (k + 1) * fib (n + 1 + 1) + fib k * fib (n + 1)"
wenzelm
parents:
diff changeset
    65
      (is " _ = ?R2");
wenzelm
parents:
diff changeset
    66
  also; have "?R1 + ?R2
wenzelm
parents:
diff changeset
    67
    = fib (k + 1) * fib (n + 2 + 1) + fib k * fib (n + 2)";
wenzelm
parents:
diff changeset
    68
    by (simp add: add_mult_distrib2);
wenzelm
parents:
diff changeset
    69
  finally; show "?P (n + 2)"; .;
wenzelm
parents:
diff changeset
    70
qed;
wenzelm
parents:
diff changeset
    71
wenzelm
parents:
diff changeset
    72
lemma gcd_fib_Suc_eq_1: "gcd (fib n, fib (n + 1)) = 1" (is "?P n");
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
    73
proof (induct ?P n rule: fib_induct); 
8051
wenzelm
parents:
diff changeset
    74
  show "?P 0"; by simp;
wenzelm
parents:
diff changeset
    75
  show "?P 1"; by simp;
wenzelm
parents:
diff changeset
    76
  fix n; 
wenzelm
parents:
diff changeset
    77
  have "fib (n + 2 + 1) = fib (n + 1) + fib (n + 2)"; 
wenzelm
parents:
diff changeset
    78
    by simp;
8814
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
    79
  also; have "gcd (fib (n + 2), ...) = gcd (fib (n + 2), fib (n + 1))";
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
    80
    by (simp only: gcd_add2);
8051
wenzelm
parents:
diff changeset
    81
  also; have "... = gcd (fib (n + 1), fib (n + 1 + 1))";
wenzelm
parents:
diff changeset
    82
    by (simp add: gcd_commute);
wenzelm
parents:
diff changeset
    83
  also; assume "... = 1";
wenzelm
parents:
diff changeset
    84
  finally; show "?P (n + 2)"; .;
wenzelm
parents:
diff changeset
    85
qed;
wenzelm
parents:
diff changeset
    86
wenzelm
parents:
diff changeset
    87
lemma gcd_mult_add: "0 < n ==> gcd (n * k + m, n) = gcd (m, n)";
wenzelm
parents:
diff changeset
    88
proof -;
wenzelm
parents:
diff changeset
    89
  assume "0 < n";
wenzelm
parents:
diff changeset
    90
  hence "gcd (n * k + m, n) = gcd (n, m mod n)"; 
wenzelm
parents:
diff changeset
    91
    by (simp add: gcd_non_0 add_commute);
wenzelm
parents:
diff changeset
    92
  also; have "... = gcd (m, n)"; by (simp! add: gcd_non_0);
wenzelm
parents:
diff changeset
    93
  finally; show ?thesis; .;
wenzelm
parents:
diff changeset
    94
qed;
wenzelm
parents:
diff changeset
    95
wenzelm
parents:
diff changeset
    96
lemma gcd_fib_add: "gcd (fib m, fib (n + m)) = gcd (fib m, fib n)"; 
8814
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
    97
proof (cases m);
8051
wenzelm
parents:
diff changeset
    98
  assume "m = 0";
8814
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
    99
  thus ?thesis; by simp;
8051
wenzelm
parents:
diff changeset
   100
next;
wenzelm
parents:
diff changeset
   101
  fix k; assume "m = Suc k"; 
wenzelm
parents:
diff changeset
   102
  hence "gcd (fib m, fib (n + m)) = gcd (fib (n + k + 1), fib (k + 1))";
wenzelm
parents:
diff changeset
   103
    by (simp add: gcd_commute);
wenzelm
parents:
diff changeset
   104
  also; have "fib (n + k + 1) 
wenzelm
parents:
diff changeset
   105
    = fib (k + 1) * fib (n + 1) + fib k * fib n";
wenzelm
parents:
diff changeset
   106
    by (rule fib_add);
wenzelm
parents:
diff changeset
   107
  also; have "gcd (..., fib (k + 1)) = gcd (fib k * fib n, fib (k + 1))"; 
wenzelm
parents:
diff changeset
   108
    by (simp add: gcd_mult_add);
wenzelm
parents:
diff changeset
   109
  also; have "... = gcd (fib n, fib (k + 1))"; 
wenzelm
parents:
diff changeset
   110
    by (simp only: gcd_fib_Suc_eq_1 gcd_mult_cancel);
wenzelm
parents:
diff changeset
   111
  also; have "... = gcd (fib m, fib n)"; 
wenzelm
parents:
diff changeset
   112
    by (simp! add: gcd_commute);
wenzelm
parents:
diff changeset
   113
  finally; show ?thesis; .;
wenzelm
parents:
diff changeset
   114
qed;
wenzelm
parents:
diff changeset
   115
wenzelm
parents:
diff changeset
   116
lemma gcd_fib_diff: 
wenzelm
parents:
diff changeset
   117
  "m <= n ==> gcd (fib m, fib (n - m)) = gcd (fib m, fib n)";
wenzelm
parents:
diff changeset
   118
proof -; 
wenzelm
parents:
diff changeset
   119
  assume "m <= n";
wenzelm
parents:
diff changeset
   120
  have "gcd (fib m, fib (n - m)) = gcd (fib m, fib (n - m + m))"; 
wenzelm
parents:
diff changeset
   121
    by (simp add: gcd_fib_add);
wenzelm
parents:
diff changeset
   122
  also; have "n - m + m = n"; by (simp!); 
wenzelm
parents:
diff changeset
   123
  finally; show ?thesis; .;
wenzelm
parents:
diff changeset
   124
qed;
wenzelm
parents:
diff changeset
   125
8814
0a5edcbe0695 adapted to new arithmetic simprocs;
wenzelm
parents: 8624
diff changeset
   126
lemma if_cases:    (* FIXME move to HOL.thy (!?) *)
8051
wenzelm
parents:
diff changeset
   127
  "[| Q ==> P x; ~ Q ==> P y |] ==> P (if Q then x else y)"; by simp;
wenzelm
parents:
diff changeset
   128
wenzelm
parents:
diff changeset
   129
lemma gcd_fib_mod: 
wenzelm
parents:
diff changeset
   130
  "0 < m ==> gcd (fib m, fib (n mod m)) = gcd (fib m, fib n)";
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
   131
proof (induct n rule: less_induct);
8051
wenzelm
parents:
diff changeset
   132
  fix n; 
wenzelm
parents:
diff changeset
   133
  assume m: "0 < m"
wenzelm
parents:
diff changeset
   134
  and hyp: "ALL ma. ma < n 
wenzelm
parents:
diff changeset
   135
           --> gcd (fib m, fib (ma mod m)) = gcd (fib m, fib ma)";
wenzelm
parents:
diff changeset
   136
  have "n mod m = (if n < m then n else (n - m) mod m)";
wenzelm
parents:
diff changeset
   137
    by (rule mod_if);
wenzelm
parents:
diff changeset
   138
  also; have "gcd (fib m, fib ...) = gcd (fib m, fib n)";
wenzelm
parents:
diff changeset
   139
  proof (rule if_cases);
wenzelm
parents:
diff changeset
   140
    assume "~ n < m"; hence m_le_n: "m <= n"; by simp;
wenzelm
parents:
diff changeset
   141
    have "n - m < n"; by (simp! add: diff_less);
wenzelm
parents:
diff changeset
   142
    with hyp; have "gcd (fib m, fib ((n - m) mod m))
wenzelm
parents:
diff changeset
   143
       = gcd (fib m, fib (n - m))"; by simp;
wenzelm
parents:
diff changeset
   144
    also; from m_le_n; have "... = gcd (fib m, fib n)"; 
wenzelm
parents:
diff changeset
   145
      by (rule gcd_fib_diff);
wenzelm
parents:
diff changeset
   146
    finally; show "gcd (fib m, fib ((n - m) mod m)) = gcd (fib m, fib n)"; .;
wenzelm
parents:
diff changeset
   147
  qed simp;
wenzelm
parents:
diff changeset
   148
  finally; show "gcd (fib m, fib (n mod m)) = gcd (fib m, fib n)"; .;
wenzelm
parents:
diff changeset
   149
qed;
wenzelm
parents:
diff changeset
   150
wenzelm
parents:
diff changeset
   151
wenzelm
parents:
diff changeset
   152
theorem fib_gcd: "fib (gcd (m, n)) = gcd (fib m, fib n)" (is "?P m n");
8304
e132d147374b even better induct setup;
wenzelm
parents: 8281
diff changeset
   153
proof (induct ?P m n rule: gcd_induct);
8051
wenzelm
parents:
diff changeset
   154
  fix m; show "fib (gcd (m, 0)) = gcd (fib m, fib 0)"; by simp;
8935
548901d05a0e added type constraint ::nat because 0 is now overloaded
paulson
parents: 8814
diff changeset
   155
  fix n :: nat; assume n: "0 < n";
8051
wenzelm
parents:
diff changeset
   156
  hence "gcd (m, n) = gcd (n, m mod n)"; by (rule gcd_non_0);
wenzelm
parents:
diff changeset
   157
  also; assume hyp: "fib ... = gcd (fib n, fib (m mod n))";
wenzelm
parents:
diff changeset
   158
  also; from n; have "... = gcd (fib n, fib m)"; by (rule gcd_fib_mod);
wenzelm
parents:
diff changeset
   159
  also; have "... = gcd (fib m, fib n)"; by (rule gcd_commute);
wenzelm
parents:
diff changeset
   160
  finally; show "fib (gcd (m, n)) = gcd (fib m, fib n)"; .;
wenzelm
parents:
diff changeset
   161
qed;
wenzelm
parents:
diff changeset
   162
wenzelm
parents:
diff changeset
   163
end;