src/HOL/RelPow.ML
author nipkow
Mon, 19 Feb 1996 18:04:41 +0100
changeset 1515 4ed79ebab64d
parent 1496 c443b2adaf52
child 1552 6f71b5d46700
permissions -rw-r--r--
Introduced normalize_thm into HOL.ML Corrected some dependencies among Sum, Prod and mono. Extended RelPow
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/RelPow.ML
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     4
    Copyright   1996  TU Muenchen
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     5
*)
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     6
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     7
open RelPow;
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     8
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
     9
val [rel_pow_0, rel_pow_Suc] = nat_recs rel_pow_def;
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    10
Addsimps [rel_pow_0];
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    11
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    12
goal RelPow.thy "(x,x) : R^0";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    13
by(Simp_tac 1);
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    14
qed "rel_pow_0_I";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    15
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    16
goal RelPow.thy "!!R. [| (x,y) : R^n; (y,z):R |] ==> (x,z):R^(Suc n)";
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    17
by(simp_tac (!simpset addsimps [rel_pow_Suc]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    18
by(fast_tac comp_cs 1);
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    19
qed "rel_pow_Suc_I";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    20
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    21
goal RelPow.thy "!z. (x,y) : R --> (y,z):R^n -->  (x,z):R^(Suc n)";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    22
by(nat_ind_tac "n" 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    23
by(simp_tac (!simpset addsimps [rel_pow_Suc]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    24
by(fast_tac comp_cs 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    25
by(asm_full_simp_tac (!simpset addsimps [rel_pow_Suc]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    26
by(fast_tac comp_cs 1);
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    27
qed_spec_mp "rel_pow_Suc_I2";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    28
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    29
goal RelPow.thy "!!R. [| (x,y) : R^0; x=y ==> P |] ==> P";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    30
by(Asm_full_simp_tac 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    31
qed "rel_pow_0_E";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    32
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    33
val [major,minor] = goal RelPow.thy
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    34
  "[| (x,z) : R^(Suc n);  !!y. [| (x,y) : R^n; (y,z) : R |] ==> P |] ==> P";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    35
by(cut_facts_tac [major] 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    36
by(asm_full_simp_tac (!simpset addsimps [rel_pow_Suc]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    37
by(fast_tac (comp_cs addIs [minor]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    38
qed "rel_pow_Suc_E";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    39
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    40
val [p1,p2,p3] = goal RelPow.thy
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    41
    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;        \
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    42
\       !!y m. [| n = Suc m; (x,y) : R^m; (y,z) : R |] ==> P  \
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    43
\    |] ==> P";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    44
by(res_inst_tac [("n","n")] natE 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    45
by(cut_facts_tac [p1] 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    46
by(asm_full_simp_tac (!simpset addsimps [p2]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    47
by(cut_facts_tac [p1] 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    48
by(Asm_full_simp_tac 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    49
be rel_pow_Suc_E 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    50
by(REPEAT(ares_tac [p3] 1));
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    51
qed "rel_pow_E";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    52
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    53
goal RelPow.thy "!x z. (x,z):R^(Suc n) --> (? y. (x,y):R & (y,z):R^n)";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    54
by(nat_ind_tac "n" 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    55
by(fast_tac (HOL_cs addIs [rel_pow_0_I] addEs [rel_pow_0_E,rel_pow_Suc_E]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    56
by(fast_tac (HOL_cs addIs [rel_pow_Suc_I] addEs[rel_pow_0_E,rel_pow_Suc_E]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    57
qed_spec_mp "rel_pow_Suc_D2";
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    58
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    59
val [p1,p2,p3] = goal RelPow.thy
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    60
    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;        \
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    61
\       !!y m. [| n = Suc m; (x,y) : R; (y,z) : R^m |] ==> P  \
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    62
\    |] ==> P";
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    63
by(res_inst_tac [("n","n")] natE 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    64
by(cut_facts_tac [p1] 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    65
by(asm_full_simp_tac (!simpset addsimps [p2]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    66
by(cut_facts_tac [p1] 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    67
by(Asm_full_simp_tac 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    68
bd rel_pow_Suc_D2 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    69
be exE 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    70
be p3 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    71
be conjunct1 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    72
be conjunct2 1;
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    73
qed "rel_pow_E2";
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    74
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    75
goal RelPow.thy "!!p. p:R^* ==> p : (UN n. R^n)";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    76
by(split_all_tac 1);
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    77
be rtrancl_induct 1;
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    78
by(ALLGOALS (fast_tac (rel_cs addIs [rel_pow_0_I,rel_pow_Suc_I])));
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    79
qed "rtrancl_imp_UN_rel_pow";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    80
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    81
goal RelPow.thy "!y. (x,y):R^n --> (x,y):R^*";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    82
by(nat_ind_tac "n" 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    83
by(fast_tac (HOL_cs addIs [rtrancl_refl] addEs [rel_pow_0_E]) 1);
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    84
by(fast_tac (trancl_cs addEs [rel_pow_Suc_E,rtrancl_into_rtrancl]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    85
val lemma = result() RS spec RS mp;
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    86
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    87
goal RelPow.thy "!!p. p:R^n ==> p:R^*";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    88
by(split_all_tac 1);
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    89
be lemma 1;
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    90
qed "rel_pow_imp_rtrancl";
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    91
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    92
goal RelPow.thy "R^* = (UN n. R^n)";
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    93
by(fast_tac (eq_cs addIs [rtrancl_imp_UN_rel_pow,rel_pow_imp_rtrancl]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    94
qed "rtrancl_is_UN_rel_pow";