| author | haftmann | 
| Thu, 29 Oct 2009 11:41:38 +0100 | |
| changeset 33320 | 73998ef6ea91 | 
| parent 33026 | 8f35633c4922 | 
| child 37671 | fa53d267dab3 | 
| permissions | -rw-r--r-- | 
| 33026 | 1 | (* Title: HOL/Isar_Examples/Fibonacci.thy | 
| 8051 | 2 | Author: Gertrud Bauer | 
| 3 | Copyright 1999 Technische Universitaet Muenchen | |
| 4 | ||
| 5 | The Fibonacci function. Demonstrates the use of recdef. Original | |
| 6 | tactic script by Lawrence C Paulson. | |
| 7 | ||
| 8 | Fibonacci numbers: proofs of laws taken from | |
| 9 | ||
| 10 | R. L. Graham, D. E. Knuth, O. Patashnik. | |
| 11 | Concrete Mathematics. | |
| 12 | (Addison-Wesley, 1989) | |
| 13 | *) | |
| 14 | ||
| 10007 | 15 | header {* Fib and Gcd commute *}
 | 
| 8051 | 16 | |
| 27366 | 17 | theory Fibonacci | 
| 18 | imports Primes | |
| 19 | begin | |
| 8051 | 20 | |
| 21 | text_raw {*
 | |
| 22 |  \footnote{Isar version by Gertrud Bauer.  Original tactic script by
 | |
| 8052 | 23 | Larry Paulson. A few proofs of laws taken from | 
| 8051 | 24 |  \cite{Concrete-Math}.}
 | 
| 10007 | 25 | *} | 
| 8051 | 26 | |
| 27 | ||
| 10007 | 28 | subsection {* Fibonacci numbers *}
 | 
| 8051 | 29 | |
| 27366 | 30 | fun fib :: "nat \<Rightarrow> nat" where | 
| 18153 | 31 | "fib 0 = 0" | 
| 27366 | 32 | | "fib (Suc 0) = 1" | 
| 33 | | "fib (Suc (Suc x)) = fib x + fib (Suc x)" | |
| 8051 | 34 | |
| 10007 | 35 | lemma [simp]: "0 < fib (Suc n)" | 
| 18153 | 36 | by (induct n rule: fib.induct) simp_all | 
| 8051 | 37 | |
| 38 | ||
| 10007 | 39 | text {* Alternative induction rule. *}
 | 
| 8051 | 40 | |
| 8304 | 41 | theorem fib_induct: | 
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 42 | "P 0 ==> P 1 ==> (!!n. P (n + 1) ==> P n ==> P (n + 2)) ==> P (n::nat)" | 
| 18153 | 43 | by (induct rule: fib.induct) simp_all | 
| 8051 | 44 | |
| 45 | ||
| 10007 | 46 | subsection {* Fib and gcd commute *}
 | 
| 8051 | 47 | |
| 10007 | 48 | text {* A few laws taken from \cite{Concrete-Math}. *}
 | 
| 8051 | 49 | |
| 9659 | 50 | lemma fib_add: | 
| 8051 | 51 | "fib (n + k + 1) = fib (k + 1) * fib (n + 1) + fib k * fib n" | 
| 9659 | 52 | (is "?P n") | 
| 10007 | 53 |   -- {* see \cite[page 280]{Concrete-Math} *}
 | 
| 11809 | 54 | proof (induct n rule: fib_induct) | 
| 10007 | 55 | show "?P 0" by simp | 
| 56 | show "?P 1" by simp | |
| 57 | fix n | |
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 58 | have "fib (n + 2 + k + 1) | 
| 10007 | 59 | = fib (n + k + 1) + fib (n + 1 + k + 1)" by simp | 
| 60 | also assume "fib (n + k + 1) | |
| 8051 | 61 | = fib (k + 1) * fib (n + 1) + fib k * fib n" | 
| 10007 | 62 | (is " _ = ?R1") | 
| 63 | also assume "fib (n + 1 + k + 1) | |
| 8051 | 64 | = fib (k + 1) * fib (n + 1 + 1) + fib k * fib (n + 1)" | 
| 10007 | 65 | (is " _ = ?R2") | 
| 66 | also have "?R1 + ?R2 | |
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 67 | = fib (k + 1) * fib (n + 2 + 1) + fib k * fib (n + 2)" | 
| 10007 | 68 | by (simp add: add_mult_distrib2) | 
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 69 | finally show "?P (n + 2)" . | 
| 10007 | 70 | qed | 
| 8051 | 71 | |
| 27556 | 72 | lemma gcd_fib_Suc_eq_1: "gcd (fib n) (fib (n + 1)) = 1" (is "?P n") | 
| 11809 | 73 | proof (induct n rule: fib_induct) | 
| 10007 | 74 | show "?P 0" by simp | 
| 75 | show "?P 1" by simp | |
| 76 | fix n | |
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 77 | have "fib (n + 2 + 1) = fib (n + 1) + fib (n + 2)" | 
| 10007 | 78 | by simp | 
| 27556 | 79 | also have "gcd (fib (n + 2)) ... = gcd (fib (n + 2)) (fib (n + 1))" | 
| 10007 | 80 | by (simp only: gcd_add2') | 
| 27556 | 81 | also have "... = gcd (fib (n + 1)) (fib (n + 1 + 1))" | 
| 10007 | 82 | by (simp add: gcd_commute) | 
| 83 | also assume "... = 1" | |
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 84 | finally show "?P (n + 2)" . | 
| 10007 | 85 | qed | 
| 8051 | 86 | |
| 27556 | 87 | lemma gcd_mult_add: "0 < n ==> gcd (n * k + m) n = gcd m n" | 
| 10007 | 88 | proof - | 
| 89 | assume "0 < n" | |
| 27556 | 90 | then have "gcd (n * k + m) n = gcd n (m mod n)" | 
| 10007 | 91 | by (simp add: gcd_non_0 add_commute) | 
| 27556 | 92 | also from `0 < n` have "... = gcd m n" by (simp add: gcd_non_0) | 
| 10007 | 93 | finally show ?thesis . | 
| 94 | qed | |
| 8051 | 95 | |
| 27556 | 96 | lemma gcd_fib_add: "gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n)" | 
| 10007 | 97 | proof (cases m) | 
| 18153 | 98 | case 0 | 
| 99 | then show ?thesis by simp | |
| 10007 | 100 | next | 
| 18153 | 101 | case (Suc k) | 
| 27556 | 102 | then have "gcd (fib m) (fib (n + m)) = gcd (fib (n + k + 1)) (fib (k + 1))" | 
| 10007 | 103 | by (simp add: gcd_commute) | 
| 104 | also have "fib (n + k + 1) | |
| 105 | = fib (k + 1) * fib (n + 1) + fib k * fib n" | |
| 106 | by (rule fib_add) | |
| 27556 | 107 | also have "gcd ... (fib (k + 1)) = gcd (fib k * fib n) (fib (k + 1))" | 
| 10007 | 108 | by (simp add: gcd_mult_add) | 
| 27556 | 109 | also have "... = gcd (fib n) (fib (k + 1))" | 
| 10007 | 110 | by (simp only: gcd_fib_Suc_eq_1 gcd_mult_cancel) | 
| 27556 | 111 | also have "... = gcd (fib m) (fib n)" | 
| 18153 | 112 | using Suc by (simp add: gcd_commute) | 
| 10007 | 113 | finally show ?thesis . | 
| 114 | qed | |
| 8051 | 115 | |
| 9659 | 116 | lemma gcd_fib_diff: | 
| 18153 | 117 | assumes "m <= n" | 
| 27556 | 118 | shows "gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" | 
| 10007 | 119 | proof - | 
| 27556 | 120 | have "gcd (fib m) (fib (n - m)) = gcd (fib m) (fib (n - m + m))" | 
| 10007 | 121 | by (simp add: gcd_fib_add) | 
| 18153 | 122 | also from `m <= n` have "n - m + m = n" by simp | 
| 10007 | 123 | finally show ?thesis . | 
| 124 | qed | |
| 8051 | 125 | |
| 9659 | 126 | lemma gcd_fib_mod: | 
| 18241 | 127 | assumes "0 < m" | 
| 27556 | 128 | shows "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)" | 
| 18153 | 129 | proof (induct n rule: nat_less_induct) | 
| 130 | case (1 n) note hyp = this | |
| 131 | show ?case | |
| 132 | proof - | |
| 133 | have "n mod m = (if n < m then n else (n - m) mod m)" | |
| 134 | by (rule mod_if) | |
| 27556 | 135 | also have "gcd (fib m) (fib ...) = gcd (fib m) (fib n)" | 
| 18153 | 136 | proof (cases "n < m") | 
| 137 | case True then show ?thesis by simp | |
| 138 | next | |
| 139 | case False then have "m <= n" by simp | |
| 18241 | 140 | from `0 < m` and False have "n - m < n" by simp | 
| 27556 | 141 | with hyp have "gcd (fib m) (fib ((n - m) mod m)) | 
| 142 | = gcd (fib m) (fib (n - m))" by simp | |
| 143 | also have "... = gcd (fib m) (fib n)" | |
| 18153 | 144 | using `m <= n` by (rule gcd_fib_diff) | 
| 27556 | 145 | finally have "gcd (fib m) (fib ((n - m) mod m)) = | 
| 146 | gcd (fib m) (fib n)" . | |
| 18153 | 147 | with False show ?thesis by simp | 
| 10408 | 148 | qed | 
| 18153 | 149 | finally show ?thesis . | 
| 10007 | 150 | qed | 
| 151 | qed | |
| 8051 | 152 | |
| 153 | ||
| 27556 | 154 | theorem fib_gcd: "fib (gcd m n) = gcd (fib m) (fib n)" (is "?P m n") | 
| 11809 | 155 | proof (induct m n rule: gcd_induct) | 
| 27556 | 156 | fix m show "fib (gcd m 0) = gcd (fib m) (fib 0)" by simp | 
| 10007 | 157 | fix n :: nat assume n: "0 < n" | 
| 27556 | 158 | then have "gcd m n = gcd n (m mod n)" by (rule gcd_non_0) | 
| 159 | also assume hyp: "fib ... = gcd (fib n) (fib (m mod n))" | |
| 160 | also from n have "... = gcd (fib n) (fib m)" by (rule gcd_fib_mod) | |
| 161 | also have "... = gcd (fib m) (fib n)" by (rule gcd_commute) | |
| 162 | finally show "fib (gcd m n) = gcd (fib m) (fib n)" . | |
| 10007 | 163 | qed | 
| 8051 | 164 | |
| 10007 | 165 | end |