author | huffman |
Fri, 05 Mar 2010 14:05:25 -0800 | |
changeset 35596 | 49a02dab35ed |
parent 32960 | 69916a850301 |
child 36862 | 952b2b102a0a |
permissions | -rw-r--r-- |
25422 | 1 |
(* Title: HOL/Extraction/Greatest_Common_Divisor.thy |
2 |
ID: $Id$ |
|
3 |
Author: Stefan Berghofer, TU Muenchen |
|
4 |
Helmut Schwichtenberg, LMU Muenchen |
|
5 |
*) |
|
6 |
||
7 |
header {* Greatest common divisor *} |
|
8 |
||
9 |
theory Greatest_Common_Divisor |
|
10 |
imports QuotRem |
|
11 |
begin |
|
12 |
||
13 |
theorem greatest_common_divisor: |
|
14 |
"\<And>n::nat. Suc m < n \<Longrightarrow> \<exists>k n1 m1. k * n1 = n \<and> k * m1 = Suc m \<and> |
|
15 |
(\<forall>l l1 l2. l * l1 = n \<longrightarrow> l * l2 = Suc m \<longrightarrow> l \<le> k)" |
|
16 |
proof (induct m rule: nat_wf_ind) |
|
17 |
case (1 m n) |
|
18 |
from division obtain r q where h1: "n = Suc m * q + r" and h2: "r \<le> m" |
|
19 |
by iprover |
|
20 |
show ?case |
|
21 |
proof (cases r) |
|
22 |
case 0 |
|
23 |
with h1 have "Suc m * q = n" by simp |
|
24 |
moreover have "Suc m * 1 = Suc m" by simp |
|
25 |
moreover { |
|
26 |
fix l2 have "\<And>l l1. l * l1 = n \<Longrightarrow> l * l2 = Suc m \<Longrightarrow> l \<le> Suc m" |
|
32960
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
27982
diff
changeset
|
27 |
by (cases l2) simp_all } |
25422 | 28 |
ultimately show ?thesis by iprover |
29 |
next |
|
30 |
case (Suc nat) |
|
31 |
with h2 have h: "nat < m" by simp |
|
32 |
moreover from h have "Suc nat < Suc m" by simp |
|
33 |
ultimately have "\<exists>k m1 r1. k * m1 = Suc m \<and> k * r1 = Suc nat \<and> |
|
34 |
(\<forall>l l1 l2. l * l1 = Suc m \<longrightarrow> l * l2 = Suc nat \<longrightarrow> l \<le> k)" |
|
35 |
by (rule 1) |
|
36 |
then obtain k m1 r1 where |
|
37 |
h1': "k * m1 = Suc m" |
|
38 |
and h2': "k * r1 = Suc nat" |
|
39 |
and h3': "\<And>l l1 l2. l * l1 = Suc m \<Longrightarrow> l * l2 = Suc nat \<Longrightarrow> l \<le> k" |
|
40 |
by iprover |
|
41 |
have mn: "Suc m < n" by (rule 1) |
|
42 |
from h1 h1' h2' Suc have "k * (m1 * q + r1) = n" |
|
43 |
by (simp add: add_mult_distrib2 nat_mult_assoc [symmetric]) |
|
44 |
moreover have "\<And>l l1 l2. l * l1 = n \<Longrightarrow> l * l2 = Suc m \<Longrightarrow> l \<le> k" |
|
45 |
proof - |
|
46 |
fix l l1 l2 |
|
47 |
assume ll1n: "l * l1 = n" |
|
48 |
assume ll2m: "l * l2 = Suc m" |
|
49 |
moreover have "l * (l1 - l2 * q) = Suc nat" |
|
32960
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
27982
diff
changeset
|
50 |
by (simp add: diff_mult_distrib2 h1 Suc [symmetric] mn ll1n ll2m [symmetric]) |
25422 | 51 |
ultimately show "l \<le> k" by (rule h3') |
52 |
qed |
|
53 |
ultimately show ?thesis using h1' by iprover |
|
54 |
qed |
|
55 |
qed |
|
56 |
||
57 |
extract greatest_common_divisor |
|
58 |
||
59 |
text {* |
|
60 |
The extracted program for computing the greatest common divisor is |
|
61 |
@{thm [display] greatest_common_divisor_def} |
|
62 |
*} |
|
63 |
||
27982 | 64 |
instantiation nat :: default |
65 |
begin |
|
66 |
||
67 |
definition "default = (0::nat)" |
|
68 |
||
69 |
instance .. |
|
25422 | 70 |
|
27982 | 71 |
end |
25422 | 72 |
|
27982 | 73 |
instantiation * :: (default, default) default |
74 |
begin |
|
75 |
||
76 |
definition "default = (default, default)" |
|
77 |
||
78 |
instance .. |
|
25422 | 79 |
|
80 |
end |
|
27982 | 81 |
|
82 |
instantiation "fun" :: (type, default) default |
|
83 |
begin |
|
84 |
||
85 |
definition "default = (\<lambda>x. default)" |
|
86 |
||
87 |
instance .. |
|
88 |
||
89 |
end |
|
90 |
||
91 |
consts_code |
|
92 |
default ("(error \"default\")") |
|
93 |
||
94 |
lemma "greatest_common_divisor 7 12 = (4, 3, 2)" by evaluation |
|
95 |
lemma "greatest_common_divisor 7 12 = (4, 3, 2)" by eval |
|
96 |
||
97 |
end |