src/HOL/Proofs/Extraction/Greatest_Common_Divisor.thy
author wenzelm
Wed, 30 Dec 2015 18:25:39 +0100
changeset 61986 2461779da2b8
parent 58889 5b7a9633cfa8
child 63361 d10eab0672f9
permissions -rw-r--r--
isabelle update_cartouches -c -t;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
39157
b98909faaea8 more explicit HOL-Proofs sessions, including former ex/Hilbert_Classical.thy which works in parallel mode without the antiquotation option "margin" (which is still critical);
wenzelm
parents: 37678
diff changeset
     1
(*  Title:      HOL/Proofs/Extraction/Greatest_Common_Divisor.thy
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     2
    Author:     Stefan Berghofer, TU Muenchen
39157
b98909faaea8 more explicit HOL-Proofs sessions, including former ex/Hilbert_Classical.thy which works in parallel mode without the antiquotation option "margin" (which is still critical);
wenzelm
parents: 37678
diff changeset
     3
    Author:     Helmut Schwichtenberg, LMU Muenchen
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     4
*)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     5
61986
2461779da2b8 isabelle update_cartouches -c -t;
wenzelm
parents: 58889
diff changeset
     6
section \<open>Greatest common divisor\<close>
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     7
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     8
theory Greatest_Common_Divisor
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
     9
imports QuotRem
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    10
begin
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    11
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    12
theorem greatest_common_divisor:
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    13
  "\<And>n::nat. Suc m < n \<Longrightarrow> \<exists>k n1 m1. k * n1 = n \<and> k * m1 = Suc m \<and>
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    14
     (\<forall>l l1 l2. l * l1 = n \<longrightarrow> l * l2 = Suc m \<longrightarrow> l \<le> k)"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    15
proof (induct m rule: nat_wf_ind)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    16
  case (1 m n)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    17
  from division obtain r q where h1: "n = Suc m * q + r" and h2: "r \<le> m"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    18
    by iprover
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    19
  show ?case
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    20
  proof (cases r)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    21
    case 0
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    22
    with h1 have "Suc m * q = n" by simp
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    23
    moreover have "Suc m * 1 = Suc m" by simp
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    24
    moreover {
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    25
      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
    26
        by (cases l2) simp_all }
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    27
    ultimately show ?thesis by iprover
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    28
  next
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    29
    case (Suc nat)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    30
    with h2 have h: "nat < m" by simp
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    31
    moreover from h have "Suc nat < Suc m" by simp
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    32
    ultimately have "\<exists>k m1 r1. k * m1 = Suc m \<and> k * r1 = Suc nat \<and>
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    33
      (\<forall>l l1 l2. l * l1 = Suc m \<longrightarrow> l * l2 = Suc nat \<longrightarrow> l \<le> k)"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    34
      by (rule 1)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    35
    then obtain k m1 r1 where
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    36
      h1': "k * m1 = Suc m"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    37
      and h2': "k * r1 = Suc nat"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    38
      and h3': "\<And>l l1 l2. l * l1 = Suc m \<Longrightarrow> l * l2 = Suc nat \<Longrightarrow> l \<le> k"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    39
      by iprover
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    40
    have mn: "Suc m < n" by (rule 1)
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    41
    from h1 h1' h2' Suc have "k * (m1 * q + r1) = n" 
57512
cc97b347b301 reduced name variants for assoc and commute on plus and mult
haftmann
parents: 45170
diff changeset
    42
      by (simp add: add_mult_distrib2 mult.assoc [symmetric])
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    43
    moreover have "\<And>l l1 l2. l * l1 = n \<Longrightarrow> l * l2 = Suc m \<Longrightarrow> l \<le> k"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    44
    proof -
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    45
      fix l l1 l2
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    46
      assume ll1n: "l * l1 = n"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    47
      assume ll2m: "l * l2 = Suc m"
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    48
      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
    49
        by (simp add: diff_mult_distrib2 h1 Suc [symmetric] mn ll1n ll2m [symmetric])
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    50
      ultimately show "l \<le> k" by (rule h3')
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    51
    qed
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    52
    ultimately show ?thesis using h1' by iprover
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    53
  qed
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    54
qed
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    55
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    56
extract greatest_common_divisor
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    57
61986
2461779da2b8 isabelle update_cartouches -c -t;
wenzelm
parents: 58889
diff changeset
    58
text \<open>
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    59
The extracted program for computing the greatest common divisor is
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    60
@{thm [display] greatest_common_divisor_def}
61986
2461779da2b8 isabelle update_cartouches -c -t;
wenzelm
parents: 58889
diff changeset
    61
\<close>
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    62
27982
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    63
instantiation nat :: default
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    64
begin
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    65
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    66
definition "default = (0::nat)"
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    67
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    68
instance ..
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    69
27982
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    70
end
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    71
37678
0040bafffdef "prod" and "sum" replace "*" and "+" respectively
haftmann
parents: 36862
diff changeset
    72
instantiation prod :: (default, default) default
27982
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    73
begin
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    74
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    75
definition "default = (default, default)"
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    76
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    77
instance ..
25422
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    78
37e991068d96 New case studies for program extraction.
berghofe
parents:
diff changeset
    79
end
27982
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    80
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    81
instantiation "fun" :: (type, default) default
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    82
begin
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    83
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    84
definition "default = (\<lambda>x. default)"
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    85
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    86
instance ..
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    87
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    88
end
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    89
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    90
lemma "greatest_common_divisor 7 12 = (4, 3, 2)" by eval
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    91
2aaa4a5569a6 default replaces arbitrary
haftmann
parents: 25422
diff changeset
    92
end