| author | wenzelm | 
| Sat, 11 Nov 2017 16:01:02 +0100 | |
| changeset 67045 | 6c94f749410a | 
| 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: 
65417 
diff
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: 
11701 
diff
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: 
11701 
diff
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: 
11701 
diff
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: 
62348 
diff
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: 
11701 
diff
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: 
55656 
diff
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  |