Finite.ML
author lcp
Thu, 06 Apr 1995 11:49:42 +0200
changeset 246 0f9230a24164
parent 171 16c4ea954511
permissions -rw-r--r--
Deleted extra space in clos_mk.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     1
(*  Title: 	HOL/Finite.thy
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     2
    ID:         $Id$
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     3
    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     4
    Copyright   1994  University of Cambridge
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     5
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     6
Finite powerset operator
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     7
*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     8
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
     9
open Finite;
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    10
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    11
goalw Finite.thy Fin.defs "!!A B. A<=B ==> Fin(A) <= Fin(B)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    12
br lfp_mono 1;
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    13
by (REPEAT (ares_tac basic_monos 1));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    14
qed "Fin_mono";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    15
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    16
goalw Finite.thy Fin.defs "Fin(A) <= Pow(A)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    17
by (fast_tac (set_cs addSIs [lfp_lowerbound]) 1);
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    18
qed "Fin_subset_Pow";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    19
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    20
(* A : Fin(B) ==> A <= B *)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    21
val FinD = Fin_subset_Pow RS subsetD RS PowD;
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    22
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    23
(*Discharging ~ x:y entails extra work*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    24
val major::prems = goal Finite.thy 
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    25
    "[| F:Fin(A);  P({}); \
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    26
\	!!F x. [| x:A;  F:Fin(A);  x~:F;  P(F) |] ==> P(insert(x,F)) \
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    27
\    |] ==> P(F)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    28
by (rtac (major RS Fin.induct) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    29
by (excluded_middle_tac "a:b" 2);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    30
by (etac (insert_absorb RS ssubst) 3 THEN assume_tac 3);   (*backtracking!*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    31
by (REPEAT (ares_tac prems 1));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    32
qed "Fin_induct";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    33
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    34
(** Simplification for Fin **)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    35
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    36
val Fin_ss = set_ss addsimps Fin.intrs;
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    37
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    38
(*The union of two finite sets is finite*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    39
val major::prems = goal Finite.thy
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    40
    "[| F: Fin(A);  G: Fin(A) |] ==> F Un G : Fin(A)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    41
by (rtac (major RS Fin_induct) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    42
by (ALLGOALS (asm_simp_tac (Fin_ss addsimps (prems@[Un_insert_left]))));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    43
qed "Fin_UnI";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    44
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    45
(*Every subset of a finite set is finite*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    46
val [subs,fin] = goal Finite.thy "[| A<=B;  B: Fin(M) |] ==> A: Fin(M)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    47
by (EVERY1 [subgoal_tac "ALL C. C<=B --> C: Fin(M)",
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    48
	    rtac mp, etac spec,
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    49
	    rtac subs]);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    50
by (rtac (fin RS Fin_induct) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    51
by (simp_tac (Fin_ss addsimps [subset_Un_eq]) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    52
by (safe_tac (set_cs addSDs [subset_insert_iff RS iffD1]));
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    53
by (eres_inst_tac [("t","C")] (insert_Diff RS subst) 2);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    54
by (ALLGOALS (asm_simp_tac Fin_ss));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    55
qed "Fin_subset";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    56
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    57
(*The image of a finite set is finite*)
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    58
val major::_ = goal Finite.thy
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    59
    "F: Fin(A) ==> h``F : Fin(h``A)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    60
by (rtac (major RS Fin_induct) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    61
by (simp_tac Fin_ss 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    62
by (asm_simp_tac (set_ss addsimps [image_eqI RS Fin.insertI, image_insert]) 1);
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    63
qed "Fin_imageI";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    64
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    65
val major::prems = goal Finite.thy 
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    66
    "[| c: Fin(A);  b: Fin(A);  				\
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    67
\       P(b);       						\
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    68
\       !!(x::'a) y. [| x:A; y: Fin(A);  x:y;  P(y) |] ==> P(y-{x}) \
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    69
\    |] ==> c<=b --> P(b-c)";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    70
by (rtac (major RS Fin_induct) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    71
by (rtac (Diff_insert RS ssubst) 2);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    72
by (ALLGOALS (asm_simp_tac
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    73
                (Fin_ss addsimps (prems@[Diff_subset RS Fin_subset]))));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    74
qed "Fin_empty_induct_lemma";
128
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    75
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    76
val prems = goal Finite.thy 
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    77
    "[| b: Fin(A);  						\
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    78
\       P(b);        						\
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    79
\       !!x y. [| x:A; y: Fin(A);  x:y;  P(y) |] ==> P(y-{x}) \
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    80
\    |] ==> P({})";
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    81
by (rtac (Diff_cancel RS subst) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    82
by (rtac (Fin_empty_induct_lemma RS mp) 1);
89669c58e506 INSTALLATION OF INDUCTIVE DEFINITIONS
lcp
parents:
diff changeset
    83
by (REPEAT (ares_tac (subset_refl::prems) 1));
171
16c4ea954511 replaced 'val ... = result()' by 'qed "..."'
clasohm
parents: 128
diff changeset
    84
qed "Fin_empty_induct";