diff -r c09598a97436 -r d8d85a8172b5 src/HOL/Transitive_Closure.thy --- a/src/HOL/Transitive_Closure.thy Sat Jul 18 21:44:18 2015 +0200 +++ b/src/HOL/Transitive_Closure.thy Sat Jul 18 22:58:50 2015 +0200 @@ -3,7 +3,7 @@ Copyright 1992 University of Cambridge *) -section {* Reflexive and Transitive closure of a relation *} +section \Reflexive and Transitive closure of a relation\ theory Transitive_Closure imports Relation @@ -11,14 +11,14 @@ ML_file "~~/src/Provers/trancl.ML" -text {* +text \ @{text rtrancl} is reflexive/transitive closure, @{text trancl} is transitive closure, @{text reflcl} is reflexive closure. These postfix operators have \emph{maximum priority}, forcing their operands to be atomic. -*} +\ inductive_set rtrancl :: "('a \ 'a) set \ ('a \ 'a) set" ("(_^*)" [1000] 999) @@ -68,7 +68,7 @@ reflcl ("(_\<^sup>=)" [1000] 999) -subsection {* Reflexive closure *} +subsection \Reflexive closure\ lemma refl_reflcl[simp]: "refl(r^=)" by(simp add:refl_on_def) @@ -82,23 +82,23 @@ lemma reflclp_idemp [simp]: "(P^==)^== = P^==" by blast -subsection {* Reflexive-transitive closure *} +subsection \Reflexive-transitive closure\ lemma reflcl_set_eq [pred_set_conv]: "(sup (\x y. (x, y) \ r) op =) = (\x y. (x, y) \ r \ Id)" by (auto simp add: fun_eq_iff) lemma r_into_rtrancl [intro]: "!!p. p \ r ==> p \ r^*" - -- {* @{text rtrancl} of @{text r} contains @{text r} *} + -- \@{text rtrancl} of @{text r} contains @{text r}\ apply (simp only: split_tupled_all) apply (erule rtrancl_refl [THEN rtrancl_into_rtrancl]) done lemma r_into_rtranclp [intro]: "r x y ==> r^** x y" - -- {* @{text rtrancl} of @{text r} contains @{text r} *} + -- \@{text rtrancl} of @{text r} contains @{text r}\ by (erule rtranclp.rtrancl_refl [THEN rtranclp.rtrancl_into_rtrancl]) lemma rtranclp_mono: "r \ s ==> r^** \ s^**" - -- {* monotonicity of @{text rtrancl} *} + -- \monotonicity of @{text rtrancl}\ apply (rule predicate2I) apply (erule rtranclp.induct) apply (rule_tac [2] rtranclp.rtrancl_into_rtrancl, blast+) @@ -129,7 +129,7 @@ lemma refl_rtrancl: "refl (r^*)" by (unfold refl_on_def) fast -text {* Transitivity of transitive closure. *} +text \Transitivity of transitive closure.\ lemma trans_rtrancl: "trans (r^*)" proof (rule transI) fix x y z @@ -141,7 +141,7 @@ show "(x, y) \ r\<^sup>*" by fact next case (step u v) - from `(x, u) \ r\<^sup>*` and `(u, v) \ r` + from \(x, u) \ r\<^sup>*\ and \(u, v) \ r\ show "(x, v) \ r\<^sup>*" .. qed qed @@ -159,7 +159,7 @@ obtains (base) "a = b" | (step) y where "(a, y) : r^*" and "(y, b) : r" - -- {* elimination of @{text rtrancl} -- by induction on a special formula *} + -- \elimination of @{text rtrancl} -- by induction on a special formula\ apply (subgoal_tac "(a::'a) = b | (EX y. (a,y) : r^* & (y,b) : r)") apply (rule_tac [2] major [THEN rtrancl_induct]) prefer 2 apply blast @@ -179,9 +179,9 @@ lemmas converse_rtrancl_into_rtrancl = converse_rtranclp_into_rtranclp [to_set] -text {* +text \ \medskip More @{term "r^*"} equations and inclusions. -*} +\ lemma rtranclp_idemp [simp]: "(r^**)^** = r^**" apply (auto intro!: order_antisym) @@ -336,7 +336,7 @@ qed -subsection {* Transitive closure *} +subsection \Transitive closure\ lemma trancl_mono: "!!p. p \ r^+ ==> r \ s ==> p \ s^+" apply (simp add: split_tupled_all) @@ -347,9 +347,9 @@ lemma r_into_trancl': "!!p. p : r ==> p : r^+" by (simp only: split_tupled_all) (erule r_into_trancl) -text {* +text \ \medskip Conversions between @{text trancl} and @{text rtrancl}. -*} +\ lemma tranclp_into_rtranclp: "r^++ a b ==> r^** a b" by (erule tranclp.induct) iprover+ @@ -363,7 +363,7 @@ lemmas rtrancl_into_trancl1 = rtranclp_into_tranclp1 [to_set] lemma rtranclp_into_tranclp2: "[| r a b; r^** b c |] ==> r^++ a c" - -- {* intro rule from @{text r} and @{text rtrancl} *} + -- \intro rule from @{text r} and @{text rtrancl}\ apply (erule rtranclp.cases) apply iprover apply (rule rtranclp_trans [THEN rtranclp_into_tranclp1]) @@ -372,7 +372,7 @@ lemmas rtrancl_into_trancl2 = rtranclp_into_tranclp2 [to_set] -text {* Nice induction rule for @{text trancl} *} +text \Nice induction rule for @{text trancl}\ lemma tranclp_induct [consumes 1, case_names base step, induct pred: tranclp]: assumes a: "r^++ a b" and cases: "!!y. r a y ==> P y" @@ -395,7 +395,7 @@ and cases: "!!x y. r x y ==> P x y" "!!x y z. [| r^++ x y; P x y; r^++ y z; P y z |] ==> P x z" shows "P x y" - -- {* Another induction rule for trancl, incorporating transitivity *} + -- \Another induction rule for trancl, incorporating transitivity\ by (iprover intro: major [THEN tranclp_induct] cases) lemmas trancl_trans_induct = tranclp_trans_induct [to_set] @@ -418,7 +418,7 @@ lemma trancl_unfold: "r^+ = r Un r^+ O r" by (auto intro: trancl_into_trancl elim: tranclE) -text {* Transitivity of @{term "r^+"} *} +text \Transitivity of @{term "r^+"}\ lemma trans_trancl [simp]: "trans (r^+)" proof (rule transI) fix x y z @@ -427,11 +427,11 @@ then show "(x, z) \ r^+" proof induct case (base u) - from `(x, y) \ r^+` and `(y, u) \ r` + from \(x, y) \ r^+\ and \(y, u) \ r\ show "(x, u) \ r^+" .. next case (step u v) - from `(x, u) \ r^+` and `(u, v) \ r` + from \(x, u) \ r^+\ and \(u, v) \ r\ show "(x, v) \ r^+" .. qed qed @@ -521,12 +521,12 @@ from this(2) show P proof (cases rule: rtranclp.cases) case rtrancl_refl - with `r x y` base show P by iprover + with \r x y\ base show P by iprover next case rtrancl_into_rtrancl from this have "tranclp r y z" by (iprover intro: rtranclp_into_tranclp1) - with `r x y` step show P by iprover + with \r x y\ step show P by iprover qed qed @@ -596,7 +596,7 @@ lemma trancl_insert: "(insert (y, x) r)^+ = r^+ \ {(a, b). (a, y) \ r^* \ (x, b) \ r^*}" - -- {* primitive recursion for @{text trancl} over finite relations *} + -- \primitive recursion for @{text trancl} over finite relations\ apply (rule equalityI) apply (rule subsetI) apply (simp only: split_tupled_all) @@ -617,7 +617,7 @@ by(simp add: rtrancl_trancl_reflcl del: reflcl_trancl) blast -text {* Simplifying nested closures *} +text \Simplifying nested closures\ lemma rtrancl_trancl_absorb[simp]: "(R^*)^+ = R^*" by (simp add: trans_rtrancl) @@ -629,7 +629,7 @@ by auto -text {* @{text Domain} and @{text Range} *} +text \@{text Domain} and @{text Range}\ lemma Domain_rtrancl [simp]: "Domain (R^*) = UNIV" by blast @@ -673,8 +673,8 @@ apply (auto simp add: finite_Field) done -text {* More about converse @{text rtrancl} and @{text trancl}, should - be merged with main body. *} +text \More about converse @{text rtrancl} and @{text trancl}, should + be merged with main body.\ lemma single_valued_confluent: "\ single_valued r; (x,y) \ r^*; (x,z) \ r^* \ @@ -720,9 +720,9 @@ declare trancl_into_rtrancl [elim] -subsection {* The power operation on relations *} +subsection \The power operation on relations\ -text {* @{text "R ^^ n = R O ... O R"}, the n-fold composition of @{text R} *} +text \@{text "R ^^ n = R O ... O R"}, the n-fold composition of @{text R}\ overloading relpow == "compow :: nat \ ('a \ 'a) set \ ('a \ 'a) set" @@ -744,7 +744,7 @@ shows "(\x y. (x, y) \ R) ^^ n = (\x y. (x, y) \ R ^^ n)" by (induct n) (simp_all add: relcompp_relcomp_eq) -text {* for code generation *} +text \for code generation\ definition relpow :: "nat \ ('a \ 'a) set \ ('a \ 'a) set" where relpow_code_def [code_abbrev]: "relpow = compow" @@ -973,7 +973,7 @@ "(P^**) x y \ \n. (P ^^ n) x y" by (auto dest: rtranclp_imp_Sup_relpowp) -text{* By Sternagel/Thiemann: *} +text\By Sternagel/Thiemann:\ lemma relpow_fun_conv: "((a,b) \ R ^^ n) = (\f. f 0 = a \ f n = b \ (\i R))" proof (induct n arbitrary: b) @@ -1011,19 +1011,19 @@ proof(induct k arbitrary: b) case 0 hence "R \ {}" by auto - with card_0_eq[OF `finite R`] have "card R >= Suc 0" by auto + with card_0_eq[OF \finite R\] have "card R >= Suc 0" by auto thus ?case using 0 by force next case (Suc k) then obtain a' where "(a,a') : R^^(Suc k)" and "(a',b) : R" by auto - from Suc(1)[OF `(a,a') : R^^(Suc k)`] + from Suc(1)[OF \(a,a') : R^^(Suc k)\] obtain n where "n \ card R" and "(a,a') \ R ^^ n" by auto - have "(a,b) : R^^(Suc n)" using `(a,a') \ R^^n` and `(a',b)\ R` by auto + have "(a,b) : R^^(Suc n)" using \(a,a') \ R^^n\ and \(a',b)\ R\ by auto { assume "n < card R" - hence ?case using `(a,b): R^^(Suc n)` Suc_leI[OF `n < card R`] by blast + hence ?case using \(a,b): R^^(Suc n)\ Suc_leI[OF \n < card R\] by blast } moreover { assume "n = card R" - from `(a,b) \ R ^^ (Suc n)`[unfolded relpow_fun_conv] + from \(a,b) \ R ^^ (Suc n)\[unfolded relpow_fun_conv] obtain f where "f 0 = a" and "f(Suc n) = b" and steps: "\i. i <= n \ (f i, f (Suc i)) \ R" by auto let ?p = "%i. (f i, f(Suc i))" @@ -1031,7 +1031,7 @@ have "?p ` ?N <= R" using steps by auto from card_mono[OF assms(1) this] have "card(?p ` ?N) <= card R" . - also have "\ < card ?N" using `n = card R` by simp + also have "\ < card ?N" using \n = card R\ by simp finally have "~ inj_on ?p ?N" by(rule pigeonhole) then obtain i j where i: "i <= n" and j: "j <= n" and ij: "i \ j" and pij: "?p i = ?p j" by(auto simp: inj_on_def) @@ -1045,7 +1045,7 @@ let ?n = "Suc(n - (j - i))" have abl: "(a,b) \ R ^^ ?n" unfolding relpow_fun_conv proof (rule exI[of _ ?g], intro conjI impI allI) - show "?g ?n = b" using `f(Suc n) = b` j ij by auto + show "?g ?n = b" using \f(Suc n) = b\ j ij by auto next fix k assume "k < ?n" show "(?g k, ?g (Suc k)) \ R" @@ -1062,19 +1062,19 @@ thus ?thesis using ij pij steps[OF i] by simp next case False - with `i \ k` have "i < k" by auto - hence small: "k + (j - i) <= n" using `ki \ k\ have "i < k" by auto + hence small: "k + (j - i) <= n" using \k by arith + show ?thesis using steps[OF small] \i by auto qed qed - qed (simp add: `f 0 = a`) + qed (simp add: \f 0 = a\) moreover have "?n <= n" using i j ij by arith - ultimately have ?case using `n = card R` by blast + ultimately have ?case using \n = card R\ by blast } - ultimately show ?case using `n \ card R` by force + ultimately show ?case using \n \ card R\ by force qed } - thus ?thesis using gr0_implies_Suc[OF `k>0`] by auto + thus ?thesis using gr0_implies_Suc[OF \k>0\] by auto qed lemma relpow_finite_bounded: @@ -1121,7 +1121,7 @@ done -subsection {* Bounded transitive closure *} +subsection \Bounded transitive closure\ definition ntrancl :: "nat \ ('a \ 'a) set \ ('a \ 'a) set" where @@ -1151,15 +1151,15 @@ have "(a, b) \ ntrancl n R O (Id \ R)" proof (cases "i = 1") case True - from this `(a, b) \ R ^^ i` show ?thesis + from this \(a, b) \ R ^^ i\ show ?thesis unfolding ntrancl_def by auto next case False - from this `0 < i` obtain j where j: "i = Suc j" "0 < j" + from this \0 < i\ obtain j where j: "i = Suc j" "0 < j" by (cases i) auto - from this `(a, b) \ R ^^ i` obtain c where c1: "(a, c) \ R ^^ j" and c2:"(c, b) \ R" + from this \(a, b) \ R ^^ i\ obtain c where c1: "(a, c) \ R ^^ j" and c2:"(c, b) \ R" by auto - from c1 j `i \ Suc (Suc n)` have "(a, c) \ ntrancl n R" + from c1 j \i \ Suc (Suc n)\ have "(a, c) \ ntrancl n R" unfolding ntrancl_def by fastforce from this c2 show ?thesis by fastforce qed @@ -1180,7 +1180,7 @@ by (cases "card R") (auto simp add: trancl_finite_eq_relpow relpow_empty ntrancl_def) -subsection {* Acyclic relations *} +subsection \Acyclic relations\ definition acyclic :: "('a * 'a) set => bool" where "acyclic r \ (!x. (x,x) ~: r^+)" @@ -1235,9 +1235,9 @@ done -subsection {* Setup of transitivity reasoner *} +subsection \Setup of transitivity reasoner\ -ML {* +ML \ structure Trancl_Tac = Trancl_Tac ( @@ -1284,30 +1284,30 @@ in dec t end | decomp _ = NONE; ); -*} +\ -setup {* +setup \ map_theory_simpset (fn ctxt => ctxt addSolver (mk_solver "Trancl" Trancl_Tac.trancl_tac) addSolver (mk_solver "Rtrancl" Trancl_Tac.rtrancl_tac) addSolver (mk_solver "Tranclp" Tranclp_Tac.trancl_tac) addSolver (mk_solver "Rtranclp" Tranclp_Tac.rtrancl_tac)) -*} +\ -text {* Optional methods. *} +text \Optional methods.\ method_setup trancl = - {* Scan.succeed (SIMPLE_METHOD' o Trancl_Tac.trancl_tac) *} - {* simple transitivity reasoner *} + \Scan.succeed (SIMPLE_METHOD' o Trancl_Tac.trancl_tac)\ + \simple transitivity reasoner\ method_setup rtrancl = - {* Scan.succeed (SIMPLE_METHOD' o Trancl_Tac.rtrancl_tac) *} - {* simple transitivity reasoner *} + \Scan.succeed (SIMPLE_METHOD' o Trancl_Tac.rtrancl_tac)\ + \simple transitivity reasoner\ method_setup tranclp = - {* Scan.succeed (SIMPLE_METHOD' o Tranclp_Tac.trancl_tac) *} - {* simple transitivity reasoner (predicate version) *} + \Scan.succeed (SIMPLE_METHOD' o Tranclp_Tac.trancl_tac)\ + \simple transitivity reasoner (predicate version)\ method_setup rtranclp = - {* Scan.succeed (SIMPLE_METHOD' o Tranclp_Tac.rtrancl_tac) *} - {* simple transitivity reasoner (predicate version) *} + \Scan.succeed (SIMPLE_METHOD' o Tranclp_Tac.rtrancl_tac)\ + \simple transitivity reasoner (predicate version)\ end