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