src/HOL/Hoare/Examples.ML
author wenzelm
Mon, 09 Mar 1998 16:17:28 +0100
changeset 4710 05e57f1879ee
parent 4359 6f2986464280
child 5069 3ea049f7979d
permissions -rw-r--r--
eliminated pred function;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1335
diff changeset
     1
(*  Title:      HOL/Hoare/Examples.thy
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1335
diff changeset
     3
    Author:     Norbert Galm
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     4
    Copyright   1995 TUM
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     5
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     6
Various arithmetic examples.
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     7
*)
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     8
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
     9
open Examples;
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    10
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    11
(*** multiplication by successive addition ***)
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    12
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    13
goal thy
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    14
 "{m=0 & s=0} \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    15
\ WHILE m ~= a DO {s = m*b} s := s+b; m := Suc(m) END\
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    16
\ {s = a*b}";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1875
diff changeset
    17
by (hoare_tac 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    18
by (ALLGOALS (asm_full_simp_tac (simpset() addsimps add_ac)));
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    19
qed "multiply_by_add";
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    20
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    21
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    22
(*** Euclid's algorithm for GCD ***)
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    23
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    24
goal thy
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    25
" {0<A & 0<B & a=A & b=B}   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    26
\ WHILE a ~= b  \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    27
\ DO  {0<a & 0<b & gcd A B = gcd a b} \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    28
\      IF a<b   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    29
\      THEN   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    30
\           b:=b-a   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    31
\      ELSE   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    32
\           a:=a-b   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    33
\      END   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    34
\ END   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    35
\ {a = gcd A B}";
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    36
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    37
by (hoare_tac 1);
3372
6e472c8f0011 Replacement of "divides" by "dvd" from Divides.thy, and updating of proofs
paulson
parents: 2031
diff changeset
    38
(*Now prove the verification conditions*)
4153
e534c4c32d54 Ran expandshort, especially to introduce Safe_tac
paulson
parents: 4089
diff changeset
    39
by Safe_tac;
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1335
diff changeset
    40
by (etac less_imp_diff_positive 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    41
by (asm_simp_tac (simpset() addsimps [less_imp_le, gcd_diff_r]) 1);
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    42
by (asm_full_simp_tac (simpset() addsimps [not_less_iff_le, gcd_diff_l]) 2);
3372
6e472c8f0011 Replacement of "divides" by "dvd" from Divides.thy, and updating of proofs
paulson
parents: 2031
diff changeset
    43
by (etac gcd_nnn 2);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    44
by (full_simp_tac (simpset() addsimps [not_less_iff_le, le_eq_less_or_eq]) 1);
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    45
by (blast_tac (claset() addIs [less_imp_diff_positive]) 1);
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    46
qed "Euclid_GCD";
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    47
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    48
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    49
(*** Power by interated squaring and multiplication ***)
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    50
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    51
goal thy
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    52
" {a=A & b=B}   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    53
\ c:=1;   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    54
\ WHILE b~=0   \
4359
6f2986464280 Simplified proofs.
nipkow
parents: 4356
diff changeset
    55
\ DO {A^B = c * a^b}   \
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    56
\      WHILE b mod 2=0   \
4359
6f2986464280 Simplified proofs.
nipkow
parents: 4356
diff changeset
    57
\      DO  {A^B = c * a^b}  \
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    58
\           a:=a*a;   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    59
\           b:=b div 2   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    60
\      END;   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    61
\      c:=c*a;   \
4710
05e57f1879ee eliminated pred function;
wenzelm
parents: 4359
diff changeset
    62
\      b:= b - 1 \
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    63
\ END   \
4359
6f2986464280 Simplified proofs.
nipkow
parents: 4356
diff changeset
    64
\ {c = A^B}";
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    65
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    66
by (hoare_tac 1);
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    67
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    68
by (res_inst_tac [("n","b")] natE 1);
4356
0dfd34f0d33d Replaced n ~= 0 by 0 < n
nipkow
parents: 4153
diff changeset
    69
by (hyp_subst_tac 1);
0dfd34f0d33d Replaced n ~= 0 by 0 < n
nipkow
parents: 4153
diff changeset
    70
by (asm_full_simp_tac (simpset() addsimps [mod_less]) 1);
4359
6f2986464280 Simplified proofs.
nipkow
parents: 4356
diff changeset
    71
by (asm_simp_tac (simpset() addsimps [mult_assoc]) 1);
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    72
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    73
qed "power_by_mult";
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    74
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    75
(*** factorial ***)
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    76
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    77
goal thy
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    78
" {a=A}   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    79
\ b:=1;   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    80
\ WHILE a~=0    \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    81
\ DO  {fac A = b*fac a} \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    82
\      b:=b*a;   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    83
\      a:=a-1   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    84
\ END   \
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    85
\ {b = fac A}";
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    86
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    87
by (hoare_tac 1);
4153
e534c4c32d54 Ran expandshort, especially to introduce Safe_tac
paulson
parents: 4089
diff changeset
    88
by Safe_tac;
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    89
by (res_inst_tac [("n","a")] natE 1);
1798
c055505f36d1 Explicitly included add_mult_distrib & add_mult_distrib2
paulson
parents: 1465
diff changeset
    90
by (ALLGOALS
c055505f36d1 Explicitly included add_mult_distrib & add_mult_distrib2
paulson
parents: 1465
diff changeset
    91
    (asm_simp_tac
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3372
diff changeset
    92
     (simpset() addsimps [add_mult_distrib,add_mult_distrib2,mult_assoc])));
1875
54c0462f8fb2 Classical tactics now use default claset.
berghofe
parents: 1798
diff changeset
    93
by (Fast_tac 1);
1335
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    94
5e1c0540f285 New directory.
nipkow
parents:
diff changeset
    95
qed"factorial";