| author | wenzelm | 
| Fri, 03 Nov 2017 19:16:41 +0100 | |
| changeset 66996 | 22ca0f37f491 | 
| parent 66453 | cc19f7ca2ed6 | 
| child 67051 | e7e54a0b9197 | 
| permissions | -rw-r--r-- | 
| 33026 | 1 | (* Title: HOL/Isar_Examples/Fibonacci.thy | 
| 8051 | 2 | Author: Gertrud Bauer | 
| 3 | Copyright 1999 Technische Universitaet Muenchen | |
| 4 | ||
| 54892 | 5 | The Fibonacci function. Original | 
| 8051 | 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 | ||
| 58882 | 15 | section \<open>Fib and Gcd commute\<close> | 
| 8051 | 16 | |
| 27366 | 17 | theory Fibonacci | 
| 66453 
cc19f7ca2ed6
session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
 wenzelm parents: 
65417diff
changeset | 18 | imports "HOL-Computational_Algebra.Primes" | 
| 27366 | 19 | begin | 
| 8051 | 20 | |
| 61932 | 21 | text_raw \<open>\<^footnote>\<open>Isar version by Gertrud Bauer. Original tactic script by Larry | 
| 22 |   Paulson. A few proofs of laws taken from @{cite "Concrete-Math"}.\<close>\<close>
 | |
| 8051 | 23 | |
| 24 | ||
| 37672 | 25 | declare One_nat_def [simp] | 
| 26 | ||
| 27 | ||
| 58614 | 28 | subsection \<open>Fibonacci numbers\<close> | 
| 8051 | 29 | |
| 63095 | 30 | fun fib :: "nat \<Rightarrow> nat" | 
| 63585 | 31 | where | 
| 32 | "fib 0 = 0" | |
| 33 | | "fib (Suc 0) = 1" | |
| 34 | | "fib (Suc (Suc x)) = fib x + fib (Suc x)" | |
| 8051 | 35 | |
| 37672 | 36 | lemma [simp]: "fib (Suc n) > 0" | 
| 18153 | 37 | by (induct n rule: fib.induct) simp_all | 
| 8051 | 38 | |
| 39 | ||
| 58614 | 40 | text \<open>Alternative induction rule.\<close> | 
| 8051 | 41 | |
| 63095 | 42 | theorem fib_induct: "P 0 \<Longrightarrow> P 1 \<Longrightarrow> (\<And>n. P (n + 1) \<Longrightarrow> P n \<Longrightarrow> P (n + 2)) \<Longrightarrow> P n" | 
| 43 | for n :: nat | |
| 18153 | 44 | by (induct rule: fib.induct) simp_all | 
| 8051 | 45 | |
| 46 | ||
| 58614 | 47 | subsection \<open>Fib and gcd commute\<close> | 
| 8051 | 48 | |
| 58614 | 49 | text \<open>A few laws taken from @{cite "Concrete-Math"}.\<close>
 | 
| 8051 | 50 | |
| 63095 | 51 | lemma fib_add: "fib (n + k + 1) = fib (k + 1) * fib (n + 1) + fib k * fib n" | 
| 9659 | 52 | (is "?P n") | 
| 61799 | 53 |   \<comment> \<open>see @{cite \<open>page 280\<close> "Concrete-Math"}\<close>
 | 
| 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 | 
| 63095 | 60 | also assume "fib (n + k + 1) = fib (k + 1) * fib (n + 1) + fib k * fib n" (is " _ = ?R1") | 
| 61 | also assume "fib (n + 1 + k + 1) = fib (k + 1) * fib (n + 1 + 1) + fib k * fib (n + 1)" | |
| 62 | (is " _ = ?R2") | |
| 63 | also have "?R1 + ?R2 = fib (k + 1) * fib (n + 2 + 1) + fib k * fib (n + 2)" | |
| 10007 | 64 | by (simp add: add_mult_distrib2) | 
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 65 | finally show "?P (n + 2)" . | 
| 10007 | 66 | qed | 
| 8051 | 67 | |
| 63095 | 68 | lemma gcd_fib_Suc_eq_1: "gcd (fib n) (fib (n + 1)) = 1" | 
| 69 | (is "?P n") | |
| 11809 | 70 | proof (induct n rule: fib_induct) | 
| 10007 | 71 | show "?P 0" by simp | 
| 72 | show "?P 1" by simp | |
| 73 | fix n | |
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 74 | have "fib (n + 2 + 1) = fib (n + 1) + fib (n + 2)" | 
| 10007 | 75 | by simp | 
| 55640 | 76 | also have "\<dots> = fib (n + 2) + fib (n + 1)" | 
| 77 | by simp | |
| 78 | also have "gcd (fib (n + 2)) \<dots> = gcd (fib (n + 2)) (fib (n + 1))" | |
| 62429 
25271ff79171
Tuned Euclidean Rings/GCD rings
 Manuel Eberl <eberlm@in.tum.de> parents: 
62348diff
changeset | 79 | by (rule gcd_add2) | 
| 55640 | 80 | also have "\<dots> = gcd (fib (n + 1)) (fib (n + 1 + 1))" | 
| 62348 | 81 | by (simp add: gcd.commute) | 
| 55640 | 82 | also assume "\<dots> = 1" | 
| 11704 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 wenzelm parents: 
11701diff
changeset | 83 | finally show "?P (n + 2)" . | 
| 10007 | 84 | qed | 
| 8051 | 85 | |
| 55640 | 86 | lemma gcd_mult_add: "(0::nat) < n \<Longrightarrow> gcd (n * k + m) n = gcd m n" | 
| 10007 | 87 | proof - | 
| 88 | assume "0 < n" | |
| 27556 | 89 | then have "gcd (n * k + m) n = gcd n (m mod n)" | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
55656diff
changeset | 90 | by (simp add: gcd_non_0_nat add.commute) | 
| 58614 | 91 | also from \<open>0 < n\<close> have "\<dots> = gcd m n" | 
| 55640 | 92 | by (simp add: gcd_non_0_nat) | 
| 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))" | 
| 62348 | 103 | by (simp add: gcd.commute) | 
| 63095 | 104 | also have "fib (n + k + 1) = fib (k + 1) * fib (n + 1) + fib k * fib n" | 
| 10007 | 105 | by (rule fib_add) | 
| 55640 | 106 | also have "gcd \<dots> (fib (k + 1)) = gcd (fib k * fib n) (fib (k + 1))" | 
| 10007 | 107 | by (simp add: gcd_mult_add) | 
| 55640 | 108 | also have "\<dots> = gcd (fib n) (fib (k + 1))" | 
| 62348 | 109 | by (simp only: gcd_fib_Suc_eq_1 gcd_mult_cancel) | 
| 55640 | 110 | also have "\<dots> = gcd (fib m) (fib n)" | 
| 62348 | 111 | using Suc by (simp add: gcd.commute) | 
| 10007 | 112 | finally show ?thesis . | 
| 113 | qed | |
| 8051 | 114 | |
| 63095 | 115 | lemma gcd_fib_diff: "gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" if "m \<le> n" | 
| 10007 | 116 | proof - | 
| 27556 | 117 | have "gcd (fib m) (fib (n - m)) = gcd (fib m) (fib (n - m + m))" | 
| 10007 | 118 | by (simp add: gcd_fib_add) | 
| 58614 | 119 | also from \<open>m \<le> n\<close> have "n - m + m = n" | 
| 55640 | 120 | by simp | 
| 10007 | 121 | finally show ?thesis . | 
| 122 | qed | |
| 8051 | 123 | |
| 63095 | 124 | lemma gcd_fib_mod: "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)" if "0 < m" | 
| 18153 | 125 | proof (induct n rule: nat_less_induct) | 
| 63095 | 126 | case hyp: (1 n) | 
| 18153 | 127 | show ?case | 
| 128 | proof - | |
| 129 | have "n mod m = (if n < m then n else (n - m) mod m)" | |
| 130 | by (rule mod_if) | |
| 55640 | 131 | also have "gcd (fib m) (fib \<dots>) = gcd (fib m) (fib n)" | 
| 18153 | 132 | proof (cases "n < m") | 
| 55640 | 133 | case True | 
| 134 | then show ?thesis by simp | |
| 18153 | 135 | next | 
| 55640 | 136 | case False | 
| 137 | then have "m \<le> n" by simp | |
| 58614 | 138 | from \<open>0 < m\<close> and False have "n - m < n" | 
| 55640 | 139 | by simp | 
| 27556 | 140 | with hyp have "gcd (fib m) (fib ((n - m) mod m)) | 
| 37671 | 141 | = gcd (fib m) (fib (n - m))" by simp | 
| 55640 | 142 | also have "\<dots> = gcd (fib m) (fib n)" | 
| 58614 | 143 | using \<open>m \<le> n\<close> by (rule gcd_fib_diff) | 
| 27556 | 144 | finally have "gcd (fib m) (fib ((n - m) mod m)) = | 
| 37671 | 145 | gcd (fib m) (fib n)" . | 
| 18153 | 146 | with False show ?thesis by simp | 
| 10408 | 147 | qed | 
| 18153 | 148 | finally show ?thesis . | 
| 10007 | 149 | qed | 
| 150 | qed | |
| 8051 | 151 | |
| 63095 | 152 | theorem fib_gcd: "fib (gcd m n) = gcd (fib m) (fib n)" | 
| 153 | (is "?P m n") | |
| 37672 | 154 | proof (induct m n rule: gcd_nat_induct) | 
| 63095 | 155 | fix m n :: nat | 
| 55640 | 156 | show "fib (gcd m 0) = gcd (fib m) (fib 0)" | 
| 157 | by simp | |
| 158 | assume n: "0 < n" | |
| 159 | then have "gcd m n = gcd n (m mod n)" | |
| 160 | by (simp add: gcd_non_0_nat) | |
| 161 | also assume hyp: "fib \<dots> = gcd (fib n) (fib (m mod n))" | |
| 162 | also from n have "\<dots> = gcd (fib n) (fib m)" | |
| 163 | by (rule gcd_fib_mod) | |
| 164 | also have "\<dots> = gcd (fib m) (fib n)" | |
| 62348 | 165 | by (rule gcd.commute) | 
| 27556 | 166 | finally show "fib (gcd m n) = gcd (fib m) (fib n)" . | 
| 10007 | 167 | qed | 
| 8051 | 168 | |
| 10007 | 169 | end |