author  hoelzl 
Tue, 07 Jul 2015 18:01:30 +0200  
changeset 60681  9ce7463350a9 
parent 58889  5b7a9633cfa8 
child 60758  d8d85a8172b5 
permissions  rwrr 
10213  1 
(* Title: HOL/Transitive_Closure.thy 
2 
Author: Lawrence C Paulson, Cambridge University Computer Laboratory 

3 
Copyright 1992 University of Cambridge 

4 
*) 

5 

58889  6 
section {* Reflexive and Transitive closure of a relation *} 
12691  7 

15131  8 
theory Transitive_Closure 
46664
1f6c140f9c72
moved predicate relations and conversion rules between set and predicate relations from Predicate.thy to Relation.thy; moved Predicate.thy upwards in theory hierarchy
haftmann
parents:
46638
diff
changeset

9 
imports Relation 
15131  10 
begin 
12691  11 

48891  12 
ML_file "~~/src/Provers/trancl.ML" 
13 

12691  14 
text {* 
15 
@{text rtrancl} is reflexive/transitive closure, 

16 
@{text trancl} is transitive closure, 

17 
@{text reflcl} is reflexive closure. 

18 

19 
These postfix operators have \emph{maximum priority}, forcing their 

20 
operands to be atomic. 

21 
*} 

10213  22 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

23 
inductive_set 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

24 
rtrancl :: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" ("(_^*)" [1000] 999) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

25 
for r :: "('a \<times> 'a) set" 
22262  26 
where 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

27 
rtrancl_refl [intro!, Pure.intro!, simp]: "(a, a) : r^*" 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

28 
 rtrancl_into_rtrancl [Pure.intro]: "(a, b) : r^* ==> (b, c) : r ==> (a, c) : r^*" 
11327
cd2c27a23df1
Transitive closure is now defined via "inductive".
berghofe
parents:
11115
diff
changeset

29 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

30 
inductive_set 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

31 
trancl :: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" ("(_^+)" [1000] 999) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

32 
for r :: "('a \<times> 'a) set" 
22262  33 
where 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

34 
r_into_trancl [intro, Pure.intro]: "(a, b) : r ==> (a, b) : r^+" 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

35 
 trancl_into_trancl [Pure.intro]: "(a, b) : r^+ ==> (b, c) : r ==> (a, c) : r^+" 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

36 

41792
ff3cb0c418b7
renamed "nitpick\_def" to "nitpick_unfold" to reflect its new semantics
blanchet
parents:
39302
diff
changeset

37 
declare rtrancl_def [nitpick_unfold del] 
ff3cb0c418b7
renamed "nitpick\_def" to "nitpick_unfold" to reflect its new semantics
blanchet
parents:
39302
diff
changeset

38 
rtranclp_def [nitpick_unfold del] 
ff3cb0c418b7
renamed "nitpick\_def" to "nitpick_unfold" to reflect its new semantics
blanchet
parents:
39302
diff
changeset

39 
trancl_def [nitpick_unfold del] 
ff3cb0c418b7
renamed "nitpick\_def" to "nitpick_unfold" to reflect its new semantics
blanchet
parents:
39302
diff
changeset

40 
tranclp_def [nitpick_unfold del] 
33878
85102f57b4a8
removed "nitpick_def" attributes from (r)trancl(p), since "Nitpick.thy" overrides these
blanchet
parents:
33656
diff
changeset

41 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

42 
notation 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

43 
rtranclp ("(_^**)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

44 
tranclp ("(_^++)" [1000] 1000) 
10213  45 

19656
09be06943252
tuned concrete syntax  abbreviation/const_syntax;
wenzelm
parents:
19623
diff
changeset

46 
abbreviation 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

47 
reflclp :: "('a => 'a => bool) => 'a => 'a => bool" ("(_^==)" [1000] 1000) where 
45137  48 
"r^== \<equiv> sup r op =" 
22262  49 

50 
abbreviation 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

51 
reflcl :: "('a \<times> 'a) set => ('a \<times> 'a) set" ("(_^=)" [1000] 999) where 
45137  52 
"r^= \<equiv> r \<union> Id" 
10213  53 

21210  54 
notation (xsymbols) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

55 
rtranclp ("(_\<^sup>*\<^sup>*)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

56 
tranclp ("(_\<^sup>+\<^sup>+)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

57 
reflclp ("(_\<^sup>=\<^sup>=)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

58 
rtrancl ("(_\<^sup>*)" [1000] 999) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

59 
trancl ("(_\<^sup>+)" [1000] 999) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

60 
reflcl ("(_\<^sup>=)" [1000] 999) 
12691  61 

21210  62 
notation (HTML output) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

63 
rtranclp ("(_\<^sup>*\<^sup>*)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

64 
tranclp ("(_\<^sup>+\<^sup>+)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

65 
reflclp ("(_\<^sup>=\<^sup>=)" [1000] 1000) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

66 
rtrancl ("(_\<^sup>*)" [1000] 999) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

67 
trancl ("(_\<^sup>+)" [1000] 999) and 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

68 
reflcl ("(_\<^sup>=)" [1000] 999) 
14565  69 

12691  70 

26271  71 
subsection {* Reflexive closure *} 
72 

30198  73 
lemma refl_reflcl[simp]: "refl(r^=)" 
74 
by(simp add:refl_on_def) 

26271  75 

76 
lemma antisym_reflcl[simp]: "antisym(r^=) = antisym r" 

77 
by(simp add:antisym_def) 

78 

79 
lemma trans_reflclI[simp]: "trans r \<Longrightarrow> trans(r^=)" 

80 
unfolding trans_def by blast 

81 

50616  82 
lemma reflclp_idemp [simp]: "(P^==)^== = P^==" 
83 
by blast 

26271  84 

12691  85 
subsection {* Reflexivetransitive closure *} 
86 

32883
7cbd93dacef3
inf/sup1/2_iff are mere duplicates of underlying definitions: dropped
haftmann
parents:
32601
diff
changeset

87 
lemma reflcl_set_eq [pred_set_conv]: "(sup (\<lambda>x y. (x, y) \<in> r) op =) = (\<lambda>x y. (x, y) \<in> r \<union> Id)" 
39302
d7728f65b353
renamed lemmas: ext_iff > fun_eq_iff, set_ext_iff > set_eq_iff, set_ext > set_eqI
nipkow
parents:
39198
diff
changeset

88 
by (auto simp add: fun_eq_iff) 
22262  89 

57284
886ff14f20cc
r_into_(r)trancl should not be [simp]: helps little and comlicates some AFP proofs
nipkow
parents:
57283
diff
changeset

90 
lemma r_into_rtrancl [intro]: "!!p. p \<in> r ==> p \<in> r^*" 
12691  91 
 {* @{text rtrancl} of @{text r} contains @{text r} *} 
92 
apply (simp only: split_tupled_all) 

93 
apply (erule rtrancl_refl [THEN rtrancl_into_rtrancl]) 

94 
done 

95 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

96 
lemma r_into_rtranclp [intro]: "r x y ==> r^** x y" 
22262  97 
 {* @{text rtrancl} of @{text r} contains @{text r} *} 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

98 
by (erule rtranclp.rtrancl_refl [THEN rtranclp.rtrancl_into_rtrancl]) 
22262  99 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

100 
lemma rtranclp_mono: "r \<le> s ==> r^** \<le> s^**" 
12691  101 
 {* monotonicity of @{text rtrancl} *} 
22262  102 
apply (rule predicate2I) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

103 
apply (erule rtranclp.induct) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

104 
apply (rule_tac [2] rtranclp.rtrancl_into_rtrancl, blast+) 
12691  105 
done 
106 

60681  107 
lemma mono_rtranclp[mono]: 
108 
"(\<And>a b. x a b \<longrightarrow> y a b) \<Longrightarrow> x^** a b \<longrightarrow> y^** a b" 

109 
using rtranclp_mono[of x y] by auto 

110 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

111 
lemmas rtrancl_mono = rtranclp_mono [to_set] 
22262  112 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

113 
theorem rtranclp_induct [consumes 1, case_names base step, induct set: rtranclp]: 
22262  114 
assumes a: "r^** a b" 
115 
and cases: "P a" "!!y z. [ r^** a y; r y z; P y ] ==> P z" 

34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

116 
shows "P b" using a 
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

117 
by (induct x\<equiv>a b) (rule cases)+ 
12691  118 

25425
9191942c4ead
Removed some case_names and consumes attributes that are now no longer
berghofe
parents:
25295
diff
changeset

119 
lemmas rtrancl_induct [induct set: rtrancl] = rtranclp_induct [to_set] 
22262  120 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

121 
lemmas rtranclp_induct2 = 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

122 
rtranclp_induct[of _ "(ax,ay)" "(bx,by)", split_rule, 
22262  123 
consumes 1, case_names refl step] 
124 

14404
4952c5a92e04
Transitive_Closure: added consumes and case_names attributes
nipkow
parents:
14398
diff
changeset

125 
lemmas rtrancl_induct2 = 
4952c5a92e04
Transitive_Closure: added consumes and case_names attributes
nipkow
parents:
14398
diff
changeset

126 
rtrancl_induct[of "(ax,ay)" "(bx,by)", split_format (complete), 
4952c5a92e04
Transitive_Closure: added consumes and case_names attributes
nipkow
parents:
14398
diff
changeset

127 
consumes 1, case_names refl step] 
18372  128 

30198  129 
lemma refl_rtrancl: "refl (r^*)" 
130 
by (unfold refl_on_def) fast 

19228  131 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

132 
text {* Transitivity of transitive closure. *} 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

133 
lemma trans_rtrancl: "trans (r^*)" 
12823  134 
proof (rule transI) 
135 
fix x y z 

136 
assume "(x, y) \<in> r\<^sup>*" 

137 
assume "(y, z) \<in> r\<^sup>*" 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

138 
then show "(x, z) \<in> r\<^sup>*" 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

139 
proof induct 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

140 
case base 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

141 
show "(x, y) \<in> r\<^sup>*" by fact 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

142 
next 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

143 
case (step u v) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

144 
from `(x, u) \<in> r\<^sup>*` and `(u, v) \<in> r` 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

145 
show "(x, v) \<in> r\<^sup>*" .. 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

146 
qed 
12823  147 
qed 
12691  148 

45607  149 
lemmas rtrancl_trans = trans_rtrancl [THEN transD] 
12691  150 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

151 
lemma rtranclp_trans: 
22262  152 
assumes xy: "r^** x y" 
153 
and yz: "r^** y z" 

154 
shows "r^** x z" using yz xy 

155 
by induct iprover+ 

156 

26174
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

157 
lemma rtranclE [cases set: rtrancl]: 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

158 
assumes major: "(a::'a, b) : r^*" 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

159 
obtains 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

160 
(base) "a = b" 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

161 
 (step) y where "(a, y) : r^*" and "(y, b) : r" 
12691  162 
 {* elimination of @{text rtrancl}  by induction on a special formula *} 
18372  163 
apply (subgoal_tac "(a::'a) = b  (EX y. (a,y) : r^* & (y,b) : r)") 
164 
apply (rule_tac [2] major [THEN rtrancl_induct]) 

165 
prefer 2 apply blast 

166 
prefer 2 apply blast 

26174
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

167 
apply (erule asm_rl exE disjE conjE base step)+ 
18372  168 
done 
12691  169 

32235
8f9b8d14fc9f
"more standard" argument order of relation composition (op O)
krauss
parents:
32215
diff
changeset

170 
lemma rtrancl_Int_subset: "[ Id \<subseteq> s; (r^* \<inter> s) O r \<subseteq> s] ==> r^* \<subseteq> s" 
22080
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

171 
apply (rule subsetI) 
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

172 
apply (rule_tac p="x" in PairE, clarify) 
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

173 
apply (erule rtrancl_induct, auto) 
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

174 
done 
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

175 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

176 
lemma converse_rtranclp_into_rtranclp: 
22262  177 
"r a b \<Longrightarrow> r\<^sup>*\<^sup>* b c \<Longrightarrow> r\<^sup>*\<^sup>* a c" 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

178 
by (rule rtranclp_trans) iprover+ 
22262  179 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

180 
lemmas converse_rtrancl_into_rtrancl = converse_rtranclp_into_rtranclp [to_set] 
12691  181 

182 
text {* 

183 
\medskip More @{term "r^*"} equations and inclusions. 

184 
*} 

185 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

186 
lemma rtranclp_idemp [simp]: "(r^**)^** = r^**" 
22262  187 
apply (auto intro!: order_antisym) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

188 
apply (erule rtranclp_induct) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

189 
apply (rule rtranclp.rtrancl_refl) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

190 
apply (blast intro: rtranclp_trans) 
12691  191 
done 
192 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

193 
lemmas rtrancl_idemp [simp] = rtranclp_idemp [to_set] 
22262  194 

12691  195 
lemma rtrancl_idemp_self_comp [simp]: "R^* O R^* = R^*" 
39302
d7728f65b353
renamed lemmas: ext_iff > fun_eq_iff, set_ext_iff > set_eq_iff, set_ext > set_eqI
nipkow
parents:
39198
diff
changeset

196 
apply (rule set_eqI) 
12691  197 
apply (simp only: split_tupled_all) 
198 
apply (blast intro: rtrancl_trans) 

199 
done 

200 

201 
lemma rtrancl_subset_rtrancl: "r \<subseteq> s^* ==> r^* \<subseteq> s^*" 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

202 
apply (drule rtrancl_mono) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

203 
apply simp 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

204 
done 
12691  205 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

206 
lemma rtranclp_subset: "R \<le> S ==> S \<le> R^** ==> S^** = R^**" 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

207 
apply (drule rtranclp_mono) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

208 
apply (drule rtranclp_mono) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

209 
apply simp 
12691  210 
done 
211 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

212 
lemmas rtrancl_subset = rtranclp_subset [to_set] 
22262  213 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

214 
lemma rtranclp_sup_rtranclp: "(sup (R^**) (S^**))^** = (sup R S)^**" 
50616  215 
by (blast intro!: rtranclp_subset intro: rtranclp_mono [THEN predicate2D]) 
12691  216 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

217 
lemmas rtrancl_Un_rtrancl = rtranclp_sup_rtranclp [to_set] 
22262  218 

50616  219 
lemma rtranclp_reflclp [simp]: "(R^==)^** = R^**" 
220 
by (blast intro!: rtranclp_subset) 

22262  221 

50616  222 
lemmas rtrancl_reflcl [simp] = rtranclp_reflclp [to_set] 
12691  223 

224 
lemma rtrancl_r_diff_Id: "(r  Id)^* = r^*" 

225 
apply (rule sym) 

14208  226 
apply (rule rtrancl_subset, blast, clarify) 
12691  227 
apply (rename_tac a b) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

228 
apply (case_tac "a = b") 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

229 
apply blast 
44921  230 
apply blast 
12691  231 
done 
232 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

233 
lemma rtranclp_r_diff_Id: "(inf r op ~=)^** = r^**" 
22262  234 
apply (rule sym) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

235 
apply (rule rtranclp_subset) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

236 
apply blast+ 
22262  237 
done 
238 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

239 
theorem rtranclp_converseD: 
22262  240 
assumes r: "(r^1)^** x y" 
241 
shows "r^** y x" 

12823  242 
proof  
243 
from r show ?thesis 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

244 
by induct (iprover intro: rtranclp_trans dest!: conversepD)+ 
12823  245 
qed 
12691  246 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

247 
lemmas rtrancl_converseD = rtranclp_converseD [to_set] 
22262  248 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

249 
theorem rtranclp_converseI: 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

250 
assumes "r^** y x" 
22262  251 
shows "(r^1)^** x y" 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

252 
using assms 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

253 
by induct (iprover intro: rtranclp_trans conversepI)+ 
12691  254 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

255 
lemmas rtrancl_converseI = rtranclp_converseI [to_set] 
22262  256 

12691  257 
lemma rtrancl_converse: "(r^1)^* = (r^*)^1" 
258 
by (fast dest!: rtrancl_converseD intro!: rtrancl_converseI) 

259 

19228  260 
lemma sym_rtrancl: "sym r ==> sym (r^*)" 
261 
by (simp only: sym_conv_converse_eq rtrancl_converse [symmetric]) 

262 

34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

263 
theorem converse_rtranclp_induct [consumes 1, case_names base step]: 
22262  264 
assumes major: "r^** a b" 
265 
and cases: "P b" "!!y z. [ r y z; r^** z b; P z ] ==> P y" 

12937
0c4fd7529467
clarified syntax of ``long'' statements: fixes/assumes/shows;
wenzelm
parents:
12823
diff
changeset

266 
shows "P a" 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

267 
using rtranclp_converseI [OF major] 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

268 
by induct (iprover intro: cases dest!: conversepD rtranclp_converseD)+ 
12691  269 

25425
9191942c4ead
Removed some case_names and consumes attributes that are now no longer
berghofe
parents:
25295
diff
changeset

270 
lemmas converse_rtrancl_induct = converse_rtranclp_induct [to_set] 
22262  271 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

272 
lemmas converse_rtranclp_induct2 = 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

273 
converse_rtranclp_induct [of _ "(ax,ay)" "(bx,by)", split_rule, 
22262  274 
consumes 1, case_names refl step] 
275 

14404
4952c5a92e04
Transitive_Closure: added consumes and case_names attributes
nipkow
parents:
14398
diff
changeset

276 
lemmas converse_rtrancl_induct2 = 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

277 
converse_rtrancl_induct [of "(ax,ay)" "(bx,by)", split_format (complete), 
14404
4952c5a92e04
Transitive_Closure: added consumes and case_names attributes
nipkow
parents:
14398
diff
changeset

278 
consumes 1, case_names refl step] 
12691  279 

34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

280 
lemma converse_rtranclpE [consumes 1, case_names base step]: 
22262  281 
assumes major: "r^** x z" 
18372  282 
and cases: "x=z ==> P" 
22262  283 
"!!y. [ r x y; r^** y z ] ==> P" 
18372  284 
shows P 
22262  285 
apply (subgoal_tac "x = z  (EX y. r x y & r^** y z)") 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

286 
apply (rule_tac [2] major [THEN converse_rtranclp_induct]) 
18372  287 
prefer 2 apply iprover 
288 
prefer 2 apply iprover 

289 
apply (erule asm_rl exE disjE conjE cases)+ 

290 
done 

12691  291 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

292 
lemmas converse_rtranclE = converse_rtranclpE [to_set] 
22262  293 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

294 
lemmas converse_rtranclpE2 = converse_rtranclpE [of _ "(xa,xb)" "(za,zb)", split_rule] 
22262  295 

296 
lemmas converse_rtranclE2 = converse_rtranclE [of "(xa,xb)" "(za,zb)", split_rule] 

12691  297 

298 
lemma r_comp_rtrancl_eq: "r O r^* = r^* O r" 

299 
by (blast elim: rtranclE converse_rtranclE 

300 
intro: rtrancl_into_rtrancl converse_rtrancl_into_rtrancl) 

301 

32235
8f9b8d14fc9f
"more standard" argument order of relation composition (op O)
krauss
parents:
32215
diff
changeset

302 
lemma rtrancl_unfold: "r^* = Id Un r^* O r" 
15551  303 
by (auto intro: rtrancl_into_rtrancl elim: rtranclE) 
304 

31690  305 
lemma rtrancl_Un_separatorE: 
306 
"(a,b) : (P \<union> Q)^* \<Longrightarrow> \<forall>x y. (a,x) : P^* \<longrightarrow> (x,y) : Q \<longrightarrow> x=y \<Longrightarrow> (a,b) : P^*" 

307 
apply (induct rule:rtrancl.induct) 

308 
apply blast 

309 
apply (blast intro:rtrancl_trans) 

310 
done 

311 

312 
lemma rtrancl_Un_separator_converseE: 

313 
"(a,b) : (P \<union> Q)^* \<Longrightarrow> \<forall>x y. (x,b) : P^* \<longrightarrow> (y,x) : Q \<longrightarrow> y=x \<Longrightarrow> (a,b) : P^*" 

314 
apply (induct rule:converse_rtrancl_induct) 

315 
apply blast 

316 
apply (blast intro:rtrancl_trans) 

317 
done 

318 

34970  319 
lemma Image_closed_trancl: 
320 
assumes "r `` X \<subseteq> X" shows "r\<^sup>* `` X = X" 

321 
proof  

322 
from assms have **: "{y. \<exists>x\<in>X. (x, y) \<in> r} \<subseteq> X" by auto 

323 
have "\<And>x y. (y, x) \<in> r\<^sup>* \<Longrightarrow> y \<in> X \<Longrightarrow> x \<in> X" 

324 
proof  

325 
fix x y 

326 
assume *: "y \<in> X" 

327 
assume "(y, x) \<in> r\<^sup>*" 

328 
then show "x \<in> X" 

329 
proof induct 

330 
case base show ?case by (fact *) 

331 
next 

332 
case step with ** show ?case by auto 

333 
qed 

334 
qed 

335 
then show ?thesis by auto 

336 
qed 

337 

12691  338 

339 
subsection {* Transitive closure *} 

10331  340 

13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

341 
lemma trancl_mono: "!!p. p \<in> r^+ ==> r \<subseteq> s ==> p \<in> s^+" 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

342 
apply (simp add: split_tupled_all) 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

343 
apply (erule trancl.induct) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

344 
apply (iprover dest: subsetD)+ 
12691  345 
done 
346 

57284
886ff14f20cc
r_into_(r)trancl should not be [simp]: helps little and comlicates some AFP proofs
nipkow
parents:
57283
diff
changeset

347 
lemma r_into_trancl': "!!p. p : r ==> p : r^+" 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

348 
by (simp only: split_tupled_all) (erule r_into_trancl) 
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

349 

12691  350 
text {* 
351 
\medskip Conversions between @{text trancl} and @{text rtrancl}. 

352 
*} 

353 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

354 
lemma tranclp_into_rtranclp: "r^++ a b ==> r^** a b" 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

355 
by (erule tranclp.induct) iprover+ 
12691  356 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

357 
lemmas trancl_into_rtrancl = tranclp_into_rtranclp [to_set] 
22262  358 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

359 
lemma rtranclp_into_tranclp1: assumes r: "r^** a b" 
22262  360 
shows "!!c. r b c ==> r^++ a c" using r 
17589  361 
by induct iprover+ 
12691  362 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

363 
lemmas rtrancl_into_trancl1 = rtranclp_into_tranclp1 [to_set] 
22262  364 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

365 
lemma rtranclp_into_tranclp2: "[ r a b; r^** b c ] ==> r^++ a c" 
12691  366 
 {* intro rule from @{text r} and @{text rtrancl} *} 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

367 
apply (erule rtranclp.cases) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

368 
apply iprover 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

369 
apply (rule rtranclp_trans [THEN rtranclp_into_tranclp1]) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

370 
apply (simp  rule r_into_rtranclp)+ 
12691  371 
done 
372 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

373 
lemmas rtrancl_into_trancl2 = rtranclp_into_tranclp2 [to_set] 
22262  374 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

375 
text {* Nice induction rule for @{text trancl} *} 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

376 
lemma tranclp_induct [consumes 1, case_names base step, induct pred: tranclp]: 
34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

377 
assumes a: "r^++ a b" 
22262  378 
and cases: "!!y. r a y ==> P y" 
379 
"!!y z. r^++ a y ==> r y z ==> P y ==> P z" 

34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

380 
shows "P b" using a 
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

381 
by (induct x\<equiv>a b) (iprover intro: cases)+ 
12691  382 

25425
9191942c4ead
Removed some case_names and consumes attributes that are now no longer
berghofe
parents:
25295
diff
changeset

383 
lemmas trancl_induct [induct set: trancl] = tranclp_induct [to_set] 
22262  384 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

385 
lemmas tranclp_induct2 = 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

386 
tranclp_induct [of _ "(ax,ay)" "(bx,by)", split_rule, 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

387 
consumes 1, case_names base step] 
22262  388 

22172  389 
lemmas trancl_induct2 = 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

390 
trancl_induct [of "(ax,ay)" "(bx,by)", split_format (complete), 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

391 
consumes 1, case_names base step] 
22172  392 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

393 
lemma tranclp_trans_induct: 
22262  394 
assumes major: "r^++ x y" 
395 
and cases: "!!x y. r x y ==> P x y" 

396 
"!!x y z. [ r^++ x y; P x y; r^++ y z; P y z ] ==> P x z" 

18372  397 
shows "P x y" 
12691  398 
 {* Another induction rule for trancl, incorporating transitivity *} 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

399 
by (iprover intro: major [THEN tranclp_induct] cases) 
12691  400 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

401 
lemmas trancl_trans_induct = tranclp_trans_induct [to_set] 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

402 

26174
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

403 
lemma tranclE [cases set: trancl]: 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

404 
assumes "(a, b) : r^+" 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

405 
obtains 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

406 
(base) "(a, b) : r" 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

407 
 (step) c where "(a, c) : r^+" and "(c, b) : r" 
9efd4c04eaa4
rtranclE, tranclE: tuned statement, added case_names;
wenzelm
parents:
25425
diff
changeset

408 
using assms by cases simp_all 
10980  409 

32235
8f9b8d14fc9f
"more standard" argument order of relation composition (op O)
krauss
parents:
32215
diff
changeset

410 
lemma trancl_Int_subset: "[ r \<subseteq> s; (r^+ \<inter> s) O r \<subseteq> s] ==> r^+ \<subseteq> s" 
22080
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

411 
apply (rule subsetI) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

412 
apply (rule_tac p = x in PairE) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

413 
apply clarify 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

414 
apply (erule trancl_induct) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

415 
apply auto 
22080
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

416 
done 
7bf8868ab3e4
induction rules for trancl/rtrancl expressed using subsets
paulson
parents:
21589
diff
changeset

417 

32235
8f9b8d14fc9f
"more standard" argument order of relation composition (op O)
krauss
parents:
32215
diff
changeset

418 
lemma trancl_unfold: "r^+ = r Un r^+ O r" 
15551  419 
by (auto intro: trancl_into_trancl elim: tranclE) 
420 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

421 
text {* Transitivity of @{term "r^+"} *} 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

422 
lemma trans_trancl [simp]: "trans (r^+)" 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

423 
proof (rule transI) 
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

424 
fix x y z 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

425 
assume "(x, y) \<in> r^+" 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

426 
assume "(y, z) \<in> r^+" 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

427 
then show "(x, z) \<in> r^+" 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

428 
proof induct 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

429 
case (base u) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

430 
from `(x, y) \<in> r^+` and `(y, u) \<in> r` 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

431 
show "(x, u) \<in> r^+" .. 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

432 
next 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

433 
case (step u v) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

434 
from `(x, u) \<in> r^+` and `(u, v) \<in> r` 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

435 
show "(x, v) \<in> r^+" .. 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

436 
qed 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

437 
qed 
12691  438 

45607  439 
lemmas trancl_trans = trans_trancl [THEN transD] 
12691  440 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

441 
lemma tranclp_trans: 
22262  442 
assumes xy: "r^++ x y" 
443 
and yz: "r^++ y z" 

444 
shows "r^++ x z" using yz xy 

445 
by induct iprover+ 

446 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

447 
lemma trancl_id [simp]: "trans r \<Longrightarrow> r^+ = r" 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

448 
apply auto 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

449 
apply (erule trancl_induct) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

450 
apply assumption 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

451 
apply (unfold trans_def) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

452 
apply blast 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

453 
done 
19623  454 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

455 
lemma rtranclp_tranclp_tranclp: 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

456 
assumes "r^** x y" 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

457 
shows "!!z. r^++ y z ==> r^++ x z" using assms 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

458 
by induct (iprover intro: tranclp_trans)+ 
12691  459 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

460 
lemmas rtrancl_trancl_trancl = rtranclp_tranclp_tranclp [to_set] 
22262  461 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

462 
lemma tranclp_into_tranclp2: "r a b ==> r^++ b c ==> r^++ a c" 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

463 
by (erule tranclp_trans [OF tranclp.r_into_trancl]) 
22262  464 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

465 
lemmas trancl_into_trancl2 = tranclp_into_tranclp2 [to_set] 
12691  466 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

467 
lemma tranclp_converseI: "(r^++)^1 x y ==> (r^1)^++ x y" 
22262  468 
apply (drule conversepD) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

469 
apply (erule tranclp_induct) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

470 
apply (iprover intro: conversepI tranclp_trans)+ 
12691  471 
done 
472 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

473 
lemmas trancl_converseI = tranclp_converseI [to_set] 
22262  474 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

475 
lemma tranclp_converseD: "(r^1)^++ x y ==> (r^++)^1 x y" 
22262  476 
apply (rule conversepI) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

477 
apply (erule tranclp_induct) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

478 
apply (iprover dest: conversepD intro: tranclp_trans)+ 
13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

479 
done 
12691  480 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

481 
lemmas trancl_converseD = tranclp_converseD [to_set] 
22262  482 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

483 
lemma tranclp_converse: "(r^1)^++ = (r^++)^1" 
44890
22f665a2e91c
new fastforce replacing fastsimp  less confusing name
nipkow
parents:
43596
diff
changeset

484 
by (fastforce simp add: fun_eq_iff 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

485 
intro!: tranclp_converseI dest!: tranclp_converseD) 
22262  486 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

487 
lemmas trancl_converse = tranclp_converse [to_set] 
12691  488 

19228  489 
lemma sym_trancl: "sym r ==> sym (r^+)" 
490 
by (simp only: sym_conv_converse_eq trancl_converse [symmetric]) 

491 

34909
a799687944af
Tuned some proofs; nicer case names for some of the induction / cases rules.
berghofe
parents:
33878
diff
changeset

492 
lemma converse_tranclp_induct [consumes 1, case_names base step]: 
22262  493 
assumes major: "r^++ a b" 
494 
and cases: "!!y. r y b ==> P(y)" 

495 
"!!y z.[ r y z; r^++ z b; P(z) ] ==> P(y)" 

18372  496 
shows "P a" 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

497 
apply (rule tranclp_induct [OF tranclp_converseI, OF conversepI, OF major]) 
18372  498 
apply (rule cases) 
22262  499 
apply (erule conversepD) 
35216  500 
apply (blast intro: assms dest!: tranclp_converseD) 
18372  501 
done 
12691  502 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

503 
lemmas converse_trancl_induct = converse_tranclp_induct [to_set] 
22262  504 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

505 
lemma tranclpD: "R^++ x y ==> EX z. R x z \<and> R^** z y" 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

506 
apply (erule converse_tranclp_induct) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

507 
apply auto 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

508 
apply (blast intro: rtranclp_trans) 
12691  509 
done 
510 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

511 
lemmas tranclD = tranclpD [to_set] 
22262  512 

31577  513 
lemma converse_tranclpE: 
514 
assumes major: "tranclp r x z" 

515 
assumes base: "r x z ==> P" 

516 
assumes step: "\<And> y. [ r x y; tranclp r y z ] ==> P" 

517 
shows P 

518 
proof  

519 
from tranclpD[OF major] 

520 
obtain y where "r x y" and "rtranclp r y z" by iprover 

521 
from this(2) show P 

522 
proof (cases rule: rtranclp.cases) 

523 
case rtrancl_refl 

524 
with `r x y` base show P by iprover 

525 
next 

526 
case rtrancl_into_rtrancl 

527 
from this have "tranclp r y z" 

528 
by (iprover intro: rtranclp_into_tranclp1) 

529 
with `r x y` step show P by iprover 

530 
qed 

531 
qed 

532 

533 
lemmas converse_tranclE = converse_tranclpE [to_set] 

534 

25295
12985023be5e
tranclD2 (tranclD at the other end) + trancl_power
kleing
parents:
23743
diff
changeset

535 
lemma tranclD2: 
12985023be5e
tranclD2 (tranclD at the other end) + trancl_power
kleing
parents:
23743
diff
changeset

536 
"(x, y) \<in> R\<^sup>+ \<Longrightarrow> \<exists>z. (x, z) \<in> R\<^sup>* \<and> (z, y) \<in> R" 
12985023be5e
tranclD2 (tranclD at the other end) + trancl_power
kleing
parents:
23743
diff
changeset

537 
by (blast elim: tranclE intro: trancl_into_rtrancl) 
12985023be5e
tranclD2 (tranclD at the other end) + trancl_power
kleing
parents:
23743
diff
changeset

538 

13867  539 
lemma irrefl_tranclI: "r^1 \<inter> r^* = {} ==> (x, x) \<notin> r^+" 
18372  540 
by (blast elim: tranclE dest: trancl_into_rtrancl) 
12691  541 

542 
lemma irrefl_trancl_rD: "!!X. ALL x. (x, x) \<notin> r^+ ==> (x, y) \<in> r ==> x \<noteq> y" 

543 
by (blast dest: r_into_trancl) 

544 

545 
lemma trancl_subset_Sigma_aux: 

546 
"(a, b) \<in> r^* ==> r \<subseteq> A \<times> A ==> a = b \<or> a \<in> A" 

18372  547 
by (induct rule: rtrancl_induct) auto 
12691  548 

549 
lemma trancl_subset_Sigma: "r \<subseteq> A \<times> A ==> r^+ \<subseteq> A \<times> A" 

13704
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

550 
apply (rule subsetI) 
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

551 
apply (simp only: split_tupled_all) 
854501b1e957
Transitive closure is now defined inductively as well.
berghofe
parents:
12937
diff
changeset

552 
apply (erule tranclE) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

553 
apply (blast dest!: trancl_into_rtrancl trancl_subset_Sigma_aux)+ 
12691  554 
done 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

555 

50616  556 
lemma reflclp_tranclp [simp]: "(r^++)^== = r^**" 
22262  557 
apply (safe intro!: order_antisym) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

558 
apply (erule tranclp_into_rtranclp) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

559 
apply (blast elim: rtranclp.cases dest: rtranclp_into_tranclp1) 
11084  560 
done 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

561 

50616  562 
lemmas reflcl_trancl [simp] = reflclp_tranclp [to_set] 
22262  563 

11090  564 
lemma trancl_reflcl [simp]: "(r^=)^+ = r^*" 
11084  565 
apply safe 
14208  566 
apply (drule trancl_into_rtrancl, simp) 
567 
apply (erule rtranclE, safe) 

568 
apply (rule r_into_trancl, simp) 

11084  569 
apply (rule rtrancl_into_trancl1) 
14208  570 
apply (erule rtrancl_reflcl [THEN equalityD2, THEN subsetD], fast) 
11084  571 
done 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

572 

45140  573 
lemma rtrancl_trancl_reflcl [code]: "r^* = (r^+)^=" 
574 
by simp 

575 

11090  576 
lemma trancl_empty [simp]: "{}^+ = {}" 
11084  577 
by (auto elim: trancl_induct) 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

578 

11090  579 
lemma rtrancl_empty [simp]: "{}^* = Id" 
11084  580 
by (rule subst [OF reflcl_trancl]) simp 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

581 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

582 
lemma rtranclpD: "R^** a b ==> a = b \<or> a \<noteq> b \<and> R^++ a b" 
50616  583 
by (force simp add: reflclp_tranclp [symmetric] simp del: reflclp_tranclp) 
22262  584 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

585 
lemmas rtranclD = rtranclpD [to_set] 
11084  586 

16514  587 
lemma rtrancl_eq_or_trancl: 
588 
"(x,y) \<in> R\<^sup>* = (x=y \<or> x\<noteq>y \<and> (x,y) \<in> R\<^sup>+)" 

589 
by (fast elim: trancl_into_rtrancl dest: rtranclD) 

10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

590 

33656
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

591 
lemma trancl_unfold_right: "r^+ = r^* O r" 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

592 
by (auto dest: tranclD2 intro: rtrancl_into_trancl1) 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

593 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

594 
lemma trancl_unfold_left: "r^+ = r O r^*" 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

595 
by (auto dest: tranclD intro: rtrancl_into_trancl2) 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

596 

57178  597 
lemma trancl_insert: 
598 
"(insert (y, x) r)^+ = r^+ \<union> {(a, b). (a, y) \<in> r^* \<and> (x, b) \<in> r^*}" 

599 
 {* primitive recursion for @{text trancl} over finite relations *} 

600 
apply (rule equalityI) 

601 
apply (rule subsetI) 

602 
apply (simp only: split_tupled_all) 

603 
apply (erule trancl_induct, blast) 

604 
apply (blast intro: rtrancl_into_trancl1 trancl_into_rtrancl trancl_trans) 

605 
apply (rule subsetI) 

606 
apply (blast intro: trancl_mono rtrancl_mono 

607 
[THEN [2] rev_subsetD] rtrancl_trancl_trancl rtrancl_into_trancl2) 

608 
done 

609 

610 
lemma trancl_insert2: 

611 
"(insert (a,b) r)^+ = r^+ \<union> {(x,y). ((x,a) : r^+ \<or> x=a) \<and> ((b,y) \<in> r^+ \<or> y=b)}" 

612 
by(auto simp add: trancl_insert rtrancl_eq_or_trancl) 

613 

614 
lemma rtrancl_insert: 

615 
"(insert (a,b) r)^* = r^* \<union> {(x,y). (x,a) : r^* \<and> (b,y) \<in> r^*}" 

616 
using trancl_insert[of a b r] 

617 
by(simp add: rtrancl_trancl_reflcl del: reflcl_trancl) blast 

618 

33656
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

619 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

620 
text {* Simplifying nested closures *} 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

621 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

622 
lemma rtrancl_trancl_absorb[simp]: "(R^*)^+ = R^*" 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

623 
by (simp add: trans_rtrancl) 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

624 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

625 
lemma trancl_rtrancl_absorb[simp]: "(R^+)^* = R^*" 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

626 
by (subst reflcl_trancl[symmetric]) simp 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

627 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

628 
lemma rtrancl_reflcl_absorb[simp]: "(R^*)^= = R^*" 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

629 
by auto 
fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

630 

fc1af6753233
a few lemmas for pointfree reasoning about transitive closure
krauss
parents:
32901
diff
changeset

631 

12691  632 
text {* @{text Domain} and @{text Range} *} 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

633 

11090  634 
lemma Domain_rtrancl [simp]: "Domain (R^*) = UNIV" 
11084  635 
by blast 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

636 

11090  637 
lemma Range_rtrancl [simp]: "Range (R^*) = UNIV" 
11084  638 
by blast 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

639 

11090  640 
lemma rtrancl_Un_subset: "(R^* \<union> S^*) \<subseteq> (R Un S)^*" 
11084  641 
by (rule rtrancl_Un_rtrancl [THEN subst]) fast 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

642 

11090  643 
lemma in_rtrancl_UnI: "x \<in> R^* \<or> x \<in> S^* ==> x \<in> (R \<union> S)^*" 
11084  644 
by (blast intro: subsetD [OF rtrancl_Un_subset]) 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

645 

11090  646 
lemma trancl_domain [simp]: "Domain (r^+) = Domain r" 
46752
e9e7209eb375
more fundamental predtoset conversions, particularly by means of inductive_set; associated consolidation of some theorem names (c.f. NEWS)
haftmann
parents:
46664
diff
changeset

647 
by (unfold Domain_unfold) (blast dest: tranclD) 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

648 

11090  649 
lemma trancl_range [simp]: "Range (r^+) = Range r" 
46752
e9e7209eb375
more fundamental predtoset conversions, particularly by means of inductive_set; associated consolidation of some theorem names (c.f. NEWS)
haftmann
parents:
46664
diff
changeset

650 
unfolding Domain_converse [symmetric] by (simp add: trancl_converse [symmetric]) 
10996
74e970389def
Moved some thms from Transitive_ClosureTr.ML to Transitive_Closure.thy
nipkow
parents:
10980
diff
changeset

651 

11115  652 
lemma Not_Domain_rtrancl: 
12691  653 
"x ~: Domain R ==> ((x, y) : R^*) = (x = y)" 
654 
apply auto 

26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

655 
apply (erule rev_mp) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

656 
apply (erule rtrancl_induct) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

657 
apply auto 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

658 
done 
11327
cd2c27a23df1
Transitive closure is now defined via "inductive".
berghofe
parents:
11115
diff
changeset

659 

29609  660 
lemma trancl_subset_Field2: "r^+ <= Field r \<times> Field r" 
661 
apply clarify 

662 
apply (erule trancl_induct) 

663 
apply (auto simp add: Field_def) 

664 
done 

665 

41987  666 
lemma finite_trancl[simp]: "finite (r^+) = finite r" 
29609  667 
apply auto 
668 
prefer 2 

669 
apply (rule trancl_subset_Field2 [THEN finite_subset]) 

670 
apply (rule finite_SigmaI) 

671 
prefer 3 

672 
apply (blast intro: r_into_trancl' finite_subset) 

673 
apply (auto simp add: finite_Field) 

674 
done 

675 

12691  676 
text {* More about converse @{text rtrancl} and @{text trancl}, should 
677 
be merged with main body. *} 

12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

678 

14337
e13731554e50
undid split_comp_eq[simp] because it leads to nontermination together with split_def!
nipkow
parents:
14208
diff
changeset

679 
lemma single_valued_confluent: 
e13731554e50
undid split_comp_eq[simp] because it leads to nontermination together with split_def!
nipkow
parents:
14208
diff
changeset

680 
"\<lbrakk> single_valued r; (x,y) \<in> r^*; (x,z) \<in> r^* \<rbrakk> 
e13731554e50
undid split_comp_eq[simp] because it leads to nontermination together with split_def!
nipkow
parents:
14208
diff
changeset

681 
\<Longrightarrow> (y,z) \<in> r^* \<or> (z,y) \<in> r^*" 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

682 
apply (erule rtrancl_induct) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

683 
apply simp 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

684 
apply (erule disjE) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

685 
apply (blast elim:converse_rtranclE dest:single_valuedD) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

686 
apply(blast intro:rtrancl_trans) 
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

687 
done 
14337
e13731554e50
undid split_comp_eq[simp] because it leads to nontermination together with split_def!
nipkow
parents:
14208
diff
changeset

688 

12691  689 
lemma r_r_into_trancl: "(a, b) \<in> R ==> (b, c) \<in> R ==> (a, c) \<in> R^+" 
12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

690 
by (fast intro: trancl_trans) 
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

691 

f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

692 
lemma trancl_into_trancl [rule_format]: 
12691  693 
"(a, b) \<in> r\<^sup>+ ==> (b, c) \<in> r > (a,c) \<in> r\<^sup>+" 
694 
apply (erule trancl_induct) 

12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

695 
apply (fast intro: r_r_into_trancl) 
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

696 
apply (fast intro: r_r_into_trancl trancl_trans) 
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

697 
done 
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

698 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

699 
lemma tranclp_rtranclp_tranclp: 
22262  700 
"r\<^sup>+\<^sup>+ a b ==> r\<^sup>*\<^sup>* b c ==> r\<^sup>+\<^sup>+ a c" 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

701 
apply (drule tranclpD) 
26179
bc5d582d6cfe
rtranclp_induct, tranclp_induct: added case_names;
wenzelm
parents:
26174
diff
changeset

702 
apply (elim exE conjE) 
23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

703 
apply (drule rtranclp_trans, assumption) 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

704 
apply (drule rtranclp_into_tranclp2, assumption, assumption) 
12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

705 
done 
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

706 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

707 
lemmas trancl_rtrancl_trancl = tranclp_rtranclp_tranclp [to_set] 
22262  708 

12691  709 
lemmas transitive_closure_trans [trans] = 
710 
r_r_into_trancl trancl_trans rtrancl_trans 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

711 
trancl.trancl_into_trancl trancl_into_trancl2 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

712 
rtrancl.rtrancl_into_rtrancl converse_rtrancl_into_rtrancl 
12691  713 
rtrancl_trancl_trancl trancl_rtrancl_trancl 
12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

714 

23743
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

715 
lemmas transitive_closurep_trans' [trans] = 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

716 
tranclp_trans rtranclp_trans 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

717 
tranclp.trancl_into_trancl tranclp_into_tranclp2 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

718 
rtranclp.rtrancl_into_rtrancl converse_rtranclp_into_rtranclp 
52fbc991039f
rtrancl and trancl are now defined using inductive_set.
berghofe
parents:
22422
diff
changeset

719 
rtranclp_tranclp_tranclp tranclp_rtranclp_tranclp 
22262  720 

12428
f3033eed309a
setup [trans] rules for calculational Isar reasoning
kleing
parents:
11327
diff
changeset

721 
declare trancl_into_rtrancl [elim] 
11327
cd2c27a23df1
Transitive closure is now defined via "inductive".
berghofe
parents:
11115
diff
changeset

722 

30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

723 
subsection {* The power operation on relations *} 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

724 

cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

725 
text {* @{text "R ^^ n = R O ... O R"}, the nfold composition of @{text R} *} 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

726 

30971  727 
overloading 
728 
relpow == "compow :: nat \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" 

47202  729 
relpowp == "compow :: nat \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool)" 
30971  730 
begin 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

731 

55575
a5e33e18fb5c
moved 'primrec' up (for real this time) and removed temporary 'old_primrec'
blanchet
parents:
55534
diff
changeset

732 
primrec relpow :: "nat \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" where 
30971  733 
"relpow 0 R = Id" 
32235
8f9b8d14fc9f
"more standard" argument order of relation composition (op O)
krauss
parents:
32215
diff
changeset

734 
 "relpow (Suc n) R = (R ^^ n) O R" 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

735 

55575
a5e33e18fb5c
moved 'primrec' up (for real this time) and removed temporary 'old_primrec'
blanchet
parents:
55534
diff
changeset

736 
primrec relpowp :: "nat \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool)" where 
47202  737 
"relpowp 0 R = HOL.eq" 
738 
 "relpowp (Suc n) R = (R ^^ n) OO R" 

739 

30971  740 
end 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

741 

47202  742 
lemma relpowp_relpow_eq [pred_set_conv]: 
743 
fixes R :: "'a rel" 

744 
shows "(\<lambda>x y. (x, y) \<in> R) ^^ n = (\<lambda>x y. (x, y) \<in> R ^^ n)" 

47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47202
diff
changeset

745 
by (induct n) (simp_all add: relcompp_relcomp_eq) 
47202  746 

46360
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

747 
text {* for code generation *} 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

748 

5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

749 
definition relpow :: "nat \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" where 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

750 
relpow_code_def [code_abbrev]: "relpow = compow" 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

751 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

752 
definition relpowp :: "nat \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool)" where 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

753 
relpowp_code_def [code_abbrev]: "relpowp = compow" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

754 

46360
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

755 
lemma [code]: 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

756 
"relpow (Suc n) R = (relpow n R) O R" 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

757 
"relpow 0 R = Id" 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

758 
by (simp_all add: relpow_code_def) 
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

759 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

760 
lemma [code]: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

761 
"relpowp (Suc n) R = (R ^^ n) OO R" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

762 
"relpowp 0 R = HOL.eq" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

763 
by (simp_all add: relpowp_code_def) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

764 

46360
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

765 
hide_const (open) relpow 
47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

766 
hide_const (open) relpowp 
46360
5cb81e3fa799
adding code generation for relpow by copying the ideas for code generation of funpow
bulwahn
parents:
46347
diff
changeset

767 

46362  768 
lemma relpow_1 [simp]: 
30971  769 
fixes R :: "('a \<times> 'a) set" 
770 
shows "R ^^ 1 = R" 

30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

771 
by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

772 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

773 
lemma relpowp_1 [simp]: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

774 
fixes P :: "'a \<Rightarrow> 'a \<Rightarrow> bool" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

775 
shows "P ^^ 1 = P" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

776 
by (fact relpow_1 [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

777 

46362  778 
lemma relpow_0_I: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

779 
"(x, x) \<in> R ^^ 0" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

780 
by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

781 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

782 
lemma relpowp_0_I: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

783 
"(P ^^ 0) x x" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

784 
by (fact relpow_0_I [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

785 

46362  786 
lemma relpow_Suc_I: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

787 
"(x, y) \<in> R ^^ n \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> (x, z) \<in> R ^^ Suc n" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

788 
by auto 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

789 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

790 
lemma relpowp_Suc_I: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

791 
"(P ^^ n) x y \<Longrightarrow> P y z \<Longrightarrow> (P ^^ Suc n) x z" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

792 
by (fact relpow_Suc_I [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

793 

46362  794 
lemma relpow_Suc_I2: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

795 
"(x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ n \<Longrightarrow> (x, z) \<in> R ^^ Suc n" 
44890
22f665a2e91c
new fastforce replacing fastsimp  less confusing name
nipkow
parents:
43596
diff
changeset

796 
by (induct n arbitrary: z) (simp, fastforce) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

797 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

798 
lemma relpowp_Suc_I2: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

799 
"P x y \<Longrightarrow> (P ^^ n) y z \<Longrightarrow> (P ^^ Suc n) x z" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

800 
by (fact relpow_Suc_I2 [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

801 

46362  802 
lemma relpow_0_E: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

803 
"(x, y) \<in> R ^^ 0 \<Longrightarrow> (x = y \<Longrightarrow> P) \<Longrightarrow> P" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

804 
by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

805 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

806 
lemma relpowp_0_E: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

807 
"(P ^^ 0) x y \<Longrightarrow> (x = y \<Longrightarrow> Q) \<Longrightarrow> Q" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

808 
by (fact relpow_0_E [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

809 

46362  810 
lemma relpow_Suc_E: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

811 
"(x, z) \<in> R ^^ Suc n \<Longrightarrow> (\<And>y. (x, y) \<in> R ^^ n \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> P) \<Longrightarrow> P" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

812 
by auto 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

813 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

814 
lemma relpowp_Suc_E: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

815 
"(P ^^ Suc n) x z \<Longrightarrow> (\<And>y. (P ^^ n) x y \<Longrightarrow> P y z \<Longrightarrow> Q) \<Longrightarrow> Q" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

816 
by (fact relpow_Suc_E [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

817 

46362  818 
lemma relpow_E: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

819 
"(x, z) \<in> R ^^ n \<Longrightarrow> (n = 0 \<Longrightarrow> x = z \<Longrightarrow> P) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

820 
\<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (x, y) \<in> R ^^ m \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> P) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

821 
\<Longrightarrow> P" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

822 
by (cases n) auto 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

823 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

824 
lemma relpowp_E: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

825 
"(P ^^ n) x z \<Longrightarrow> (n = 0 \<Longrightarrow> x = z \<Longrightarrow> Q) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

826 
\<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (P ^^ m) x y \<Longrightarrow> P y z \<Longrightarrow> Q) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

827 
\<Longrightarrow> Q" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

828 
by (fact relpow_E [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

829 

46362  830 
lemma relpow_Suc_D2: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

831 
"(x, z) \<in> R ^^ Suc n \<Longrightarrow> (\<exists>y. (x, y) \<in> R \<and> (y, z) \<in> R ^^ n)" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

832 
apply (induct n arbitrary: x z) 
46362  833 
apply (blast intro: relpow_0_I elim: relpow_0_E relpow_Suc_E) 
834 
apply (blast intro: relpow_Suc_I elim: relpow_0_E relpow_Suc_E) 

30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

835 
done 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

836 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

837 
lemma relpowp_Suc_D2: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

838 
"(P ^^ Suc n) x z \<Longrightarrow> \<exists>y. P x y \<and> (P ^^ n) y z" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

839 
by (fact relpow_Suc_D2 [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

840 

46362  841 
lemma relpow_Suc_E2: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

842 
"(x, z) \<in> R ^^ Suc n \<Longrightarrow> (\<And>y. (x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ n \<Longrightarrow> P) \<Longrightarrow> P" 
46362  843 
by (blast dest: relpow_Suc_D2) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

844 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

845 
lemma relpowp_Suc_E2: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

846 
"(P ^^ Suc n) x z \<Longrightarrow> (\<And>y. P x y \<Longrightarrow> (P ^^ n) y z \<Longrightarrow> Q) \<Longrightarrow> Q" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

847 
by (fact relpow_Suc_E2 [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

848 

46362  849 
lemma relpow_Suc_D2': 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

850 
"\<forall>x y z. (x, y) \<in> R ^^ n \<and> (y, z) \<in> R \<longrightarrow> (\<exists>w. (x, w) \<in> R \<and> (w, z) \<in> R ^^ n)" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

851 
by (induct n) (simp_all, blast) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

852 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

853 
lemma relpowp_Suc_D2': 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

854 
"\<forall>x y z. (P ^^ n) x y \<and> P y z \<longrightarrow> (\<exists>w. P x w \<and> (P ^^ n) w z)" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

855 
by (fact relpow_Suc_D2' [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

856 

46362  857 
lemma relpow_E2: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

858 
"(x, z) \<in> R ^^ n \<Longrightarrow> (n = 0 \<Longrightarrow> x = z \<Longrightarrow> P) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

859 
\<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ m \<Longrightarrow> P) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

860 
\<Longrightarrow> P" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

861 
apply (cases n, simp) 
55417
01fbfb60c33e
adapted to 'xxx_{case,rec}' renaming, to new theorem names, and to new variable names in theorems
blanchet
parents:
54412
diff
changeset

862 
apply (rename_tac nat) 
46362  863 
apply (cut_tac n=nat and R=R in relpow_Suc_D2', simp, blast) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

864 
done 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

865 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

866 
lemma relpowp_E2: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

867 
"(P ^^ n) x z \<Longrightarrow> (n = 0 \<Longrightarrow> x = z \<Longrightarrow> Q) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

868 
\<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> P x y \<Longrightarrow> (P ^^ m) y z \<Longrightarrow> Q) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

869 
\<Longrightarrow> Q" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

870 
by (fact relpow_E2 [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

871 

46362  872 
lemma relpow_add: "R ^^ (m+n) = R^^m O R^^n" 
45976  873 
by (induct n) auto 
31351  874 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

875 
lemma relpowp_add: "P ^^ (m + n) = P ^^ m OO P ^^ n" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

876 
by (fact relpow_add [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

877 

46362  878 
lemma relpow_commute: "R O R ^^ n = R ^^ n O R" 
45976  879 
by (induct n) (simp, simp add: O_assoc [symmetric]) 
31970
ccaadfcf6941
move rel_pow_commute: "R O R ^^ n = R ^^ n O R" to Transitive_Closure
krauss
parents:
31690
diff
changeset

880 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

881 
lemma relpowp_commute: "P OO P ^^ n = P ^^ n OO P" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

882 
by (fact relpow_commute [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

883 

46362  884 
lemma relpow_empty: 
45153  885 
"0 < n \<Longrightarrow> ({} :: ('a \<times> 'a) set) ^^ n = {}" 
886 
by (cases n) auto 

45116
f947eeef6b6f
adding lemma about rel_pow in Transitive_Closure for executable equation of the (refl) transitive closure
bulwahn
parents:
44921
diff
changeset

887 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

888 
lemma relpowp_bot: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

889 
"0 < n \<Longrightarrow> (\<bottom> :: 'a \<Rightarrow> 'a \<Rightarrow> bool) ^^ n = \<bottom>" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

890 
by (fact relpow_empty [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

891 

46362  892 
lemma rtrancl_imp_UN_relpow: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

893 
assumes "p \<in> R^*" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

894 
shows "p \<in> (\<Union>n. R ^^ n)" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

895 
proof (cases p) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

896 
case (Pair x y) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

897 
with assms have "(x, y) \<in> R^*" by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

898 
then have "(x, y) \<in> (\<Union>n. R ^^ n)" proof induct 
46362  899 
case base show ?case by (blast intro: relpow_0_I) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

900 
next 
46362  901 
case step then show ?case by (blast intro: relpow_Suc_I) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

902 
qed 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

903 
with Pair show ?thesis by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

904 
qed 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

905 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

906 
lemma rtranclp_imp_Sup_relpowp: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

907 
assumes "(P^**) x y" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

908 
shows "(\<Squnion>n. P ^^ n) x y" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

909 
using assms and rtrancl_imp_UN_relpow [to_pred] by blast 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

910 

46362  911 
lemma relpow_imp_rtrancl: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

912 
assumes "p \<in> R ^^ n" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

913 
shows "p \<in> R^*" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

914 
proof (cases p) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

915 
case (Pair x y) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

916 
with assms have "(x, y) \<in> R ^^ n" by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

917 
then have "(x, y) \<in> R^*" proof (induct n arbitrary: x y) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

918 
case 0 then show ?case by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

919 
next 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

920 
case Suc then show ?case 
46362  921 
by (blast elim: relpow_Suc_E intro: rtrancl_into_rtrancl) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

922 
qed 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

923 
with Pair show ?thesis by simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

924 
qed 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

925 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

926 
lemma relpowp_imp_rtranclp: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

927 
assumes "(P ^^ n) x y" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

928 
shows "(P^**) x y" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

929 
using assms and relpow_imp_rtrancl [to_pred] by blast 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

930 

46362  931 
lemma rtrancl_is_UN_relpow: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

932 
"R^* = (\<Union>n. R ^^ n)" 
46362  933 
by (blast intro: rtrancl_imp_UN_relpow relpow_imp_rtrancl) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

934 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

935 
lemma rtranclp_is_Sup_relpowp: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

936 
"P^** = (\<Squnion>n. P ^^ n)" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

937 
using rtrancl_is_UN_relpow [to_pred, of P] by auto 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

938 

30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

939 
lemma rtrancl_power: 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

940 
"p \<in> R^* \<longleftrightarrow> (\<exists>n. p \<in> R ^^ n)" 
46362  941 
by (simp add: rtrancl_is_UN_relpow) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

942 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

943 
lemma rtranclp_power: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

944 
"(P^**) x y \<longleftrightarrow> (\<exists>n. (P ^^ n) x y)" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

945 
by (simp add: rtranclp_is_Sup_relpowp) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

946 

30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

947 
lemma trancl_power: 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

948 
"p \<in> R^+ \<longleftrightarrow> (\<exists>n > 0. p \<in> R ^^ n)" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

949 
apply (cases p) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

950 
apply simp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

951 
apply (rule iffI) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

952 
apply (drule tranclD2) 
46362  953 
apply (clarsimp simp: rtrancl_is_UN_relpow) 
30971  954 
apply (rule_tac x="Suc n" in exI) 
47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47202
diff
changeset

955 
apply (clarsimp simp: relcomp_unfold) 
44890
22f665a2e91c
new fastforce replacing fastsimp  less confusing name
nipkow
parents:
43596
diff
changeset

956 
apply fastforce 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

957 
apply clarsimp 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

958 
apply (case_tac n, simp) 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

959 
apply clarsimp 
46362  960 
apply (drule relpow_imp_rtrancl) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

961 
apply (drule rtrancl_into_trancl1) apply auto 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

962 
done 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

963 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

964 
lemma tranclp_power: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

965 
"(P^++) x y \<longleftrightarrow> (\<exists>n > 0. (P ^^ n) x y)" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

966 
using trancl_power [to_pred, of P "(x, y)"] by simp 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

967 

46362  968 
lemma rtrancl_imp_relpow: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

969 
"p \<in> R^* \<Longrightarrow> \<exists>n. p \<in> R ^^ n" 
46362  970 
by (auto dest: rtrancl_imp_UN_relpow) 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

971 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

972 
lemma rtranclp_imp_relpowp: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

973 
"(P^**) x y \<Longrightarrow> \<exists>n. (P ^^ n) x y" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

974 
by (auto dest: rtranclp_imp_Sup_relpowp) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

975 

41987  976 
text{* By Sternagel/Thiemann: *} 
46362  977 
lemma relpow_fun_conv: 
41987  978 
"((a,b) \<in> R ^^ n) = (\<exists>f. f 0 = a \<and> f n = b \<and> (\<forall>i<n. (f i, f(Suc i)) \<in> R))" 
979 
proof (induct n arbitrary: b) 

980 
case 0 show ?case by auto 

981 
next 

982 
case (Suc n) 

983 
show ?case 

47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47202
diff
changeset

984 
proof (simp add: relcomp_unfold Suc) 
41987  985 
show "(\<exists>y. (\<exists>f. f 0 = a \<and> f n = y \<and> (\<forall>i<n. (f i,f(Suc i)) \<in> R)) \<and> (y,b) \<in> R) 
986 
= (\<exists>f. f 0 = a \<and> f(Suc n) = b \<and> (\<forall>i<Suc n. (f i, f (Suc i)) \<in> R))" 

987 
(is "?l = ?r") 

988 
proof 

989 
assume ?l 

990 
then obtain c f where 1: "f 0 = a" "f n = c" "\<And>i. i < n \<Longrightarrow> (f i, f (Suc i)) \<in> R" "(c,b) \<in> R" by auto 

991 
let ?g = "\<lambda> m. if m = Suc n then b else f m" 

992 
show ?r by (rule exI[of _ ?g], simp add: 1) 

993 
next 

994 
assume ?r 

995 
then obtain f where 1: "f 0 = a" "b = f (Suc n)" "\<And>i. i < Suc n \<Longrightarrow> (f i, f (Suc i)) \<in> R" by auto 

996 
show ?l by (rule exI[of _ "f n"], rule conjI, rule exI[of _ f], insert 1, auto) 

997 
qed 

998 
qed 

999 
qed 

1000 

47492
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

1001 
lemma relpowp_fun_conv: 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

1002 
"(P ^^ n) x y \<longleftrightarrow> (\<exists>f. f 0 = x \<and> f n = y \<and> (\<forall>i<n. P (f i) (f (Suc i))))" 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

1003 
by (fact relpow_fun_conv [to_pred]) 
2631a12fb2d1
duplicate "relpow" facts for "relpowp" (to emphasize that both worlds exist and obtain better search results with "find_theorems")
Christian Sternagel
parents:
47433
diff
changeset

1004 

46362  1005 
lemma relpow_finite_bounded1: 
41987  1006 
assumes "finite(R :: ('a*'a)set)" and "k>0" 
1007 
shows "R^^k \<subseteq> (UN n:{n. 0<n & n <= card R}. R^^n)" (is "_ \<subseteq> ?r") 

1008 
proof 

1009 
{ fix a b k 

1010 
have "(a,b) : R^^(Suc k) \<Longrightarrow> EX n. 0<n & n <= card R & (a,b) : R^^n" 

1011 
proof(induct k arbitrary: b) 

1012 
case 0 

1013 
hence "R \<noteq> {}" by auto 

1014 
with card_0_eq[OF `finite R`] have "card R >= Suc 0" by auto 

1015 
thus ?case using 0 by force 

1016 
next 

1017 
case (Suc k) 

1018 
then obtain a' where "(a,a') : R^^(Suc k)" and "(a',b) : R" by auto 

1019 
from Suc(1)[OF `(a,a') : R^^(Suc k)`] 

1020 
obtain n where "n \<le> card R" and "(a,a') \<in> R ^^ n" by auto 

1021 
have "(a,b) : R^^(Suc n)" using `(a,a') \<in> R^^n` and `(a',b)\<in> R` by auto 

1022 
{ assume "n < card R" 

1023 
hence ?case using `(a,b): R^^(Suc n)` Suc_leI[OF `n < card R`] by blast 

1024 
} moreover 

1025 
{ assume "n = card R" 

46362  1026 
from `(a,b) \<in> R ^^ (Suc n)`[unfolded relpow_fun_conv] 
41987  1027 
obtain f where "f 0 = a" and "f(Suc n) = b" 
1028 
and steps: "\<And>i. i <= n \<Longrightarrow> (f i, f (Suc i)) \<in> R" by auto 

1029 
let ?p = "%i. (f i, f(Suc i))" 

1030 
let ?N = "{i. i \<le> n}" 

1031 
have "?p ` ?N <= R" using steps by auto 

1032 
from card_mono[OF assms(1) this] 

1033 
have "card(?p ` ?N) <= card R" . 

1034 
also have "\<dots> < card ?N" using `n = card R` by simp 

1035 
finally have "~ inj_on ?p ?N" by(rule pigeonhole) 

1036 
then obtain i j where i: "i <= n" and j: "j <= n" and ij: "i \<noteq> j" and 

1037 
pij: "?p i = ?p j" by(auto simp: inj_on_def) 

1038 
let ?i = "min i j" let ?j = "max i j" 

1039 
have i: "?i <= n" and j: "?j <= n" and pij: "?p ?i = ?p ?j" 

1040 
and ij: "?i < ?j" 

1041 
using i j ij pij unfolding min_def max_def by auto 

1042 
from i j pij ij obtain i j where i: "i<=n" and j: "j<=n" and ij: "i<j" 

1043 
and pij: "?p i = ?p j" by blast 

1044 
let ?g = "\<lambda> l. if l \<le> i then f l else f (l + (j  i))" 

1045 
let ?n = "Suc(n  (j  i))" 

46362  1046 
have abl: "(a,b) \<in> R ^^ ?n" unfolding relpow_fun_conv 
41987  1047 
proof (rule exI[of _ ?g], intro conjI impI allI) 
1048 
show "?g ?n = b" using `f(Suc n) = b` j ij by auto 

1049 
next 

1050 
fix k assume "k < ?n" 

1051 
show "(?g k, ?g (Suc k)) \<in> R" 

1052 
proof (cases "k < i") 

1053 
case True 

1054 
with i have "k <= n" by auto 

1055 
from steps[OF this] show ?thesis using True by simp 

1056 
next 

1057 
case False 

1058 
hence "i \<le> k" by auto 

1059 
show ?thesis 

1060 
proof (cases "k = i") 

1061 
case True 

1062 
thus ?thesis using ij pij steps[OF i] by simp 

1063 
next 

1064 
case False 

1065 
with `i \<le> k` have "i < k" by auto 

1066 
hence small: "k + (j  i) <= n" using `k<?n` by arith 

1067 
show ?thesis using steps[OF small] `i<k` by auto 

1068 
qed 

1069 
qed 

1070 
qed (simp add: `f 0 = a`) 

1071 
moreover have "?n <= n" using i j ij by arith 

1072 
ultimately have ?case using `n = card R` by blast 

1073 
} 

1074 
ultimately show ?case using `n \<le> card R` by force 

1075 
qed 

1076 
} 

1077 
thus ?thesis using gr0_implies_Suc[OF `k>0`] by auto 

1078 
qed 

1079 

46362  1080 
lemma relpow_finite_bounded: 
41987  1081 
assumes "finite(R :: ('a*'a)set)" 
1082 
shows "R^^k \<subseteq> (UN n:{n. n <= card R}. R^^n)" 

1083 
apply(cases k) 

1084 
apply force 

46362  1085 
using relpow_finite_bounded1[OF assms, of k] by auto 
41987  1086 

46362  1087 
lemma rtrancl_finite_eq_relpow: 
41987  1088 
"finite R \<Longrightarrow> R^* = (UN n : {n. n <= card R}. R^^n)" 
46362  1089 
by(fastforce simp: rtrancl_power dest: relpow_finite_bounded) 
41987  1090 

46362  1091 
lemma trancl_finite_eq_relpow: 
41987  1092 
"finite R \<Longrightarrow> R^+ = (UN n : {n. 0 < n & n <= card R}. R^^n)" 
1093 
apply(auto simp add: trancl_power) 

46362  1094 
apply(auto dest: relpow_finite_bounded1) 
41987  1095 
done 
1096 

47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47202
diff
changeset

1097 
lemma finite_relcomp[simp,intro]: 
41987  1098 
assumes "finite R" and "finite S" 
1099 
shows "finite(R O S)" 

1100 
proof 

1101 
have "R O S = (UN (x,y) : R. \<Union>((%(u,v). if u=y then {(x,v)} else {}) ` S))" 

1102 
by(force simp add: split_def) 

1103 
thus ?thesis using assms by(clarsimp) 

1104 
qed 

1105 

1106 
lemma finite_relpow[simp,intro]: 

1107 
assumes "finite(R :: ('a*'a)set)" shows "n>0 \<Longrightarrow> finite(R^^n)" 

1108 
apply(induct n) 

1109 
apply simp 

1110 
apply(case_tac n) 

1111 
apply(simp_all add: assms) 

1112 
done 

1113 

46362  1114 
lemma single_valued_relpow: 
30954
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

1115 
fixes R :: "('a * 'a) set" 
cf50e67bc1d1
power operation on functions in theory Nat; power operation on relations in theory Transitive_Closure
haftmann
parents:
30549
diff
changeset

1116 
shows "single_valued R \<Longrightarrow> single_valued (R ^^ n)" 
41987  1117 
apply (induct n arbitrary: R) 
1118 
apply simp_all 

1119 
apply (rule single_valuedI) 

46362  1120 
apply (fast dest: single_valuedD elim: relpow_Suc_E) 
41987  1121 
done 
15551  1122 

45140  1123 

1124 
subsection {* Bounded transitive closure *} 

1125 

1126 
definition ntrancl :: "nat \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" 

1127 
where 

1128 
"ntrancl n R = (\<Union>i\<in>{i. 0 < i \<and> i \<le> Suc n}. R ^^ i)" 

1129 

1130 
lemma ntrancl_Zero [simp, code]: 

1131 
"ntrancl 0 R = R" 

1132 
proof 

1133 
show "R \<subseteq> ntrancl 0 R" 

1134 
unfolding ntrancl_def by fastforce 

1135 
next 

1136 
{ 

1137 
fix i have "0 < i \<and> i \<le> Suc 0 \<longleftrightarrow> i = 1" by auto 

1138 
} 

1139 
from this show "ntrancl 0 R \<le> R" 

1140 
unfolding ntrancl_def by auto 

1141 
qed 

1142 

46347
54870ad19af4
new code equation for ntrancl that allows computation of the transitive closure of sets on infinite types as well
bulwahn
parents:
46127
diff
changeset

1143 
lemma ntrancl_Suc [simp]: 
45140  1144 
"ntrancl (Suc n) R = ntrancl n R O (Id \<union> R)" 
1145 
proof 

1146 
{ 

1147 
fix a b 

1148 
assume "(a, b) \<in> ntrancl (Suc n) R" 

1149 
from this obtain i where "0 < i" "i \<le> Suc (Suc n)" "(a, b) \<in> R ^^ i" 

1150 
unfolding ntrancl_def by auto 

1151 
have "(a, b) \<in> ntrancl n R O (Id \<union> R)" 

1152 
proof (cases "i = 1") 

1153 
case True 

1154 
from this `(a, b) \<in> R ^^ i` show ?thesis 

1155 
unfolding ntrancl_def by auto 

1156 
next 

1157 
case False 

1158 
from this `0 < i` obtain j where j: "i = Suc j" "0 < j" 

1159 
by (cases i) auto 

1160 
from this `(a, b) \<in> R ^^ i` obtain c where c1: "(a, c) \<in> R ^^ j" and c2:"(c, b) \<in> R" 

1161 
by auto 

1162 
from c1 j `i \<le> Suc (Suc n)` have "(a, c) \<in> ntrancl n R" 

1163 
unfolding ntrancl_def by fastforce 

1164 
from this c2 show ?thesis by fastforce 

1165 
qed 

1166 
} 

1167 
from this show "ntrancl (Suc n) R \<subseteq> ntrancl n R O (Id \<union> R)" 

1168 
by auto 

1169 
next 

1170 
show "ntrancl n R O (Id \<union> R) \<subseteq> ntrancl (Suc n) R" 

1171 
unfolding ntrancl_def by fastforce 

1172 
qed 

1173 

46347
54870ad19af4
new code equation for ntrancl that allows computation of the transitive closure of sets on infinite types as well
bulwahn
parents:
46127
diff
changeset

1174 
lemma [code]: 
54870ad19af4
new code equation for ntrancl that allows computation of the transitive closure of sets on infinite types as well
bulwahn
parents:
46127
diff
changeset

1175 
"ntrancl (Suc n) r = (let r' = ntrancl n r in r' Un r' O r)" 
54870ad19af4
new code equation for ntrancl that allows computation of the transitive closure of sets on infinite types as well
bulwahn
parents:
46127
diff
changeset

1176 
unfolding Let_def by auto 
54870ad19af4
new code equation for ntrancl that allows computation of the transitive closure of sets on infinite types as well
bulwahn
parents:
46127
diff
changeset

1177 

45141
b2eb87bd541b
avoid very specific code equation for card; corrected spelling
haftmann
parents:
45140
diff
changeset

1178 
lemma finite_trancl_ntranl: 
45140  1179 
"finite R \<Longrightarrow> trancl R = ntrancl (card R  1) R" 
46362  1180 
by (cases "card R") (auto simp add: trancl_finite_eq_relpow relpow_empty ntrancl_def) 
45140  1181 

1182 

45139  1183 
subsection {* Acyclic relations *} 
1184 

1185 
definition acyclic :: "('a * 'a) set => bool" where 

1186 
"acyclic r \<longleftrightarrow> (!x. (x,x) ~: r^+)" 

1187 

1188 
abbreviation acyclicP :: "('a => 'a => bool) => bool" where 

1189 
"acyclicP r \<equiv> acyclic {(x, y). r x y}" 

1190 

46127  1191 
lemma acyclic_irrefl [code]: 
45139  1192 
"acyclic r \<longleftrightarrow> irrefl (r^+)" 
1193 
by (simp add: acyclic_def irrefl_def) 

1194 

1195 
lemma acyclicI: "ALL x. (x, x) ~: r^+ ==> acyclic r" 

1196 
by (simp add: acyclic_def) 

1197 

54412  1198 
lemma (in order) acyclicI_order: 
1199 
assumes *: "\<And>a b. (a, b) \<in> r \<Longrightarrow> f b < f a" 

1200 
shows "acyclic r" 

1201 
proof  

1202 
{ fix a b assume "(a, b) \<in> r\<^sup>+" 

1203 
then have "f b < f a" 

1204 
by induct (auto intro: * less_trans) } 

1205 
then show ?thesis 

1206 
by (auto intro!: acyclicI) 

1207 
qed 

1208 

45139  1209 
lemma acyclic_insert [iff]: 
1210 
"acyclic(insert (y,x) r) = (acyclic r & (x,y) ~: r^*)" 

1211 
apply (simp add: acyclic_def trancl_insert) 

1212 
apply (blast intro: rtrancl_trans) 

1213 
done 

1214 

1215 
lemma acyclic_converse [iff]: "acyclic(r^1) = acyclic r" 

1216 
by (simp add: acyclic_def trancl_converse) 

1217 

1218 
lemmas acyclicP_converse [iff] = acyclic_converse [to_pred] 

1219 

1220 
lemma acyclic_impl_antisym_rtrancl: "acyclic r ==> antisym(r^*)" 

1221 
apply (simp add: acyclic_def antisym_def) 

