src/HOL/RelPow.ML
author berghofe
Fri, 24 Jul 1998 13:03:20 +0200
changeset 5183 89f162de39cf
parent 5143 b94cd208f073
child 5278 a903b66822e2
permissions -rw-r--r--
Adapted to new datatype package.
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
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
     9
Goal "!!R:: ('a*'a)set. R^1 = R";
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    10
by (Simp_tac 1);
1693
7083f6b05423 Added R^1 = R
nipkow
parents: 1552
diff changeset
    11
qed "rel_pow_1";
7083f6b05423 Added R^1 = R
nipkow
parents: 1552
diff changeset
    12
Addsimps [rel_pow_1];
7083f6b05423 Added R^1 = R
nipkow
parents: 1552
diff changeset
    13
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    14
Goal "(x,x) : R^0";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    15
by (Simp_tac 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    16
qed "rel_pow_0_I";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    17
5143
b94cd208f073 Removal of leading "\!\!..." from most Goal commands
paulson
parents: 5069
diff changeset
    18
Goal "[| (x,y) : R^n; (y,z):R |] ==> (x,z):R^(Suc n)";
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    19
by (Simp_tac  1);
2922
580647a879cf Using Blast_tac
paulson
parents: 2741
diff changeset
    20
by (Blast_tac 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    21
qed "rel_pow_Suc_I";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    22
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    23
Goal "!z. (x,y) : R --> (y,z):R^n -->  (x,z):R^(Suc n)";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    24
by (nat_ind_tac "n" 1);
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    25
by (Simp_tac  1);
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    26
by (Asm_full_simp_tac 1);
2922
580647a879cf Using Blast_tac
paulson
parents: 2741
diff changeset
    27
by (Blast_tac 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    28
qed_spec_mp "rel_pow_Suc_I2";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    29
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    30
Goal "!!R. [| (x,y) : R^0; x=y ==> P |] ==> P";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    31
by (Asm_full_simp_tac 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    32
qed "rel_pow_0_E";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    33
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    34
val [major,minor] = goal RelPow.thy
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    35
  "[| (x,z) : R^(Suc n);  !!y. [| (x,y) : R^n; (y,z) : R |] ==> P |] ==> P";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    36
by (cut_facts_tac [major] 1);
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    37
by (Asm_full_simp_tac  1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    38
by (blast_tac (claset() addIs [minor]) 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    39
qed "rel_pow_Suc_E";
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    40
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    41
val [p1,p2,p3] = goal RelPow.thy
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    42
    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;        \
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    43
\       !!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
    44
\    |] ==> P";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    45
by (cut_facts_tac [p1] 1);
5183
89f162de39cf Adapted to new datatype package.
berghofe
parents: 5143
diff changeset
    46
by (exhaust_tac "n" 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    47
by (asm_full_simp_tac (simpset() addsimps [p2]) 1);
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    48
by (Asm_full_simp_tac 1);
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    49
by (etac compEpair 1);
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    50
by (REPEAT(ares_tac [p3] 1));
1515
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
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    53
Goal "!x z. (x,z):R^(Suc n) --> (? y. (x,y):R & (y,z):R^n)";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    54
by (nat_ind_tac "n" 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    55
by (blast_tac (claset() addIs [rel_pow_0_I] addEs [rel_pow_0_E,rel_pow_Suc_E]) 1);
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    56
by (blast_tac (claset() addIs [rel_pow_Suc_I] addEs[rel_pow_0_E,rel_pow_Suc_E]) 1);
1515
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
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    59
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    60
Goal
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    61
"!x y z. (x,y) : R^n & (y,z) : R --> (? w. (x,w) : R & (w,z) : R^n)";
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    62
by (nat_ind_tac "n" 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    63
by (fast_tac (claset() addss (simpset())) 1);
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    64
by (fast_tac (claset() addss (simpset())) 1);
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    65
qed_spec_mp "rel_pow_Suc_D2'";
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    66
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    67
val [p1,p2,p3] = goal RelPow.thy
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    68
    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;        \
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    69
\       !!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
    70
\    |] ==> P";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    71
by (cut_facts_tac [p1] 1);
5183
89f162de39cf Adapted to new datatype package.
berghofe
parents: 5143
diff changeset
    72
by (exhaust_tac "n" 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    73
by (asm_full_simp_tac (simpset() addsimps [p2]) 1);
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    74
by (Asm_full_simp_tac 1);
3023
01364e2f30ad Ran expandshort
paulson
parents: 2935
diff changeset
    75
by (etac compEpair 1);
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
    76
by (dtac (conjI RS rel_pow_Suc_D2') 1);
3023
01364e2f30ad Ran expandshort
paulson
parents: 2935
diff changeset
    77
by (assume_tac 1);
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    78
by (etac exE 1);
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    79
by (etac p3 1);
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    80
by (etac conjunct1 1);
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    81
by (etac conjunct2 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
    82
qed "rel_pow_E2";
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    83
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    84
Goal "!!p. p:R^* ==> p : (UN n. R^n)";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    85
by (split_all_tac 1);
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    86
by (etac rtrancl_induct 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    87
by (ALLGOALS (blast_tac (claset() addIs [rel_pow_0_I,rel_pow_Suc_I])));
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    88
qed "rtrancl_imp_UN_rel_pow";
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    89
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    90
Goal "!y. (x,y):R^n --> (x,y):R^*";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    91
by (nat_ind_tac "n" 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    92
by (blast_tac (claset() addIs [rtrancl_refl] addEs [rel_pow_0_E]) 1);
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
    93
by (blast_tac (claset() addEs [rel_pow_Suc_E]
3023
01364e2f30ad Ran expandshort
paulson
parents: 2935
diff changeset
    94
                       addIs [rtrancl_into_rtrancl]) 1);
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    95
val lemma = result() RS spec RS mp;
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
    96
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
    97
Goal "!!p. p:R^n ==> p:R^*";
1552
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    98
by (split_all_tac 1);
6f71b5d46700 Ran expandshort
paulson
parents: 1515
diff changeset
    99
by (etac lemma 1);
1515
4ed79ebab64d Introduced normalize_thm into HOL.ML
nipkow
parents: 1496
diff changeset
   100
qed "rel_pow_imp_rtrancl";
1496
c443b2adaf52 Added a few thms and the new theory RelPow.
nipkow
parents:
diff changeset
   101
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
   102
Goal "R^* = (UN n. R^n)";
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 4059
diff changeset
   103
by (blast_tac (claset() 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
   104
qed "rtrancl_is_UN_rel_pow";
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
   105
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
   106
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4759
diff changeset
   107
Goal "!!r::('a * 'a)set. Univalent r ==> Univalent (r^n)";
4759
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   108
by (rtac UnivalentI 1);
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   109
by (induct_tac "n" 1);
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   110
 by (Simp_tac 1);
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   111
by (fast_tac (claset() addDs [UnivalentD] addEs [rel_pow_Suc_E]) 1);
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   112
qed_spec_mp "Univalent_rel_pow";
2741
2b7f72cbe51f Minor changes due to primrec definition for ^
pusch
parents: 2056
diff changeset
   113
4759
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   114
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   115
33a03e70e641 added Univalent_rel_pow
oheimb
parents: 4089
diff changeset
   116