diff -r a9de39608b1a -r 2a24c2015a61 src/HOL/Transitive_Closure.thy --- a/src/HOL/Transitive_Closure.thy Sun Mar 29 15:44:54 2020 +0100 +++ b/src/HOL/Transitive_Closure.thy Sun Mar 29 21:30:52 2020 +0100 @@ -87,9 +87,7 @@ lemma r_into_rtrancl [intro]: "\p. p \ r \ p \ r\<^sup>*" \ \\rtrancl\ of \r\ contains \r\\ - apply (simp only: split_tupled_all) - apply (erule rtrancl_refl [THEN rtrancl_into_rtrancl]) - done + by (simp add: split_tupled_all rtrancl_refl [THEN rtrancl_into_rtrancl]) lemma r_into_rtranclp [intro]: "r x y \ r\<^sup>*\<^sup>* x y" \ \\rtrancl\ of \r\ contains \r\\ @@ -97,10 +95,11 @@ lemma rtranclp_mono: "r \ s \ r\<^sup>*\<^sup>* \ s\<^sup>*\<^sup>*" \ \monotonicity of \rtrancl\\ - apply (rule predicate2I) - apply (erule rtranclp.induct) - apply (rule_tac [2] rtranclp.rtrancl_into_rtrancl, blast+) - done +proof (rule predicate2I) + show "s\<^sup>*\<^sup>* x y" if "r \ s" "r\<^sup>*\<^sup>* x y" for x y + using \r\<^sup>*\<^sup>* x y\ \r \ s\ + by (induction rule: rtranclp.induct) (blast intro: rtranclp.rtrancl_into_rtrancl)+ +qed lemma mono_rtranclp[mono]: "(\a b. x a b \ y a b) \ x\<^sup>*\<^sup>* a b \ y\<^sup>*\<^sup>* a b" using rtranclp_mono[of x y] by auto @@ -164,9 +163,7 @@ qed lemma rtrancl_Int_subset: "Id \ s \ (r\<^sup>* \ s) O r \ s \ r\<^sup>* \ s" - apply clarify - apply (erule rtrancl_induct, auto) - done + by (fastforce elim: rtrancl_induct) lemma converse_rtranclp_into_rtranclp: "r a b \ r\<^sup>*\<^sup>* b c \ r\<^sup>*\<^sup>* a c" by (rule rtranclp_trans) iprover+ @@ -176,27 +173,23 @@ text \\<^medskip> More \<^term>\r\<^sup>*\ equations and inclusions.\ lemma rtranclp_idemp [simp]: "(r\<^sup>*\<^sup>*)\<^sup>*\<^sup>* = r\<^sup>*\<^sup>*" - apply (auto intro!: order_antisym) - apply (erule rtranclp_induct) - apply (rule rtranclp.rtrancl_refl) - apply (blast intro: rtranclp_trans) - done +proof - + have "r\<^sup>*\<^sup>*\<^sup>*\<^sup>* x y \ r\<^sup>*\<^sup>* x y" for x y + by (induction rule: rtranclp_induct) (blast intro: rtranclp_trans)+ + then show ?thesis + by (auto intro!: order_antisym) +qed lemmas rtrancl_idemp [simp] = rtranclp_idemp [to_set] lemma rtrancl_idemp_self_comp [simp]: "R\<^sup>* O R\<^sup>* = R\<^sup>*" - apply (rule set_eqI) - apply (simp only: split_tupled_all) - apply (blast intro: rtrancl_trans) - done + by (force intro: rtrancl_trans) lemma rtrancl_subset_rtrancl: "r \ s\<^sup>* \ r\<^sup>* \ s\<^sup>*" -by (drule rtrancl_mono, simp) + by (drule rtrancl_mono, simp) lemma rtranclp_subset: "R \ S \ S \ R\<^sup>*\<^sup>* \ S\<^sup>*\<^sup>* = R\<^sup>*\<^sup>*" - apply (drule rtranclp_mono) - apply (drule rtranclp_mono, simp) - done + by (fastforce dest: rtranclp_mono) lemmas rtrancl_subset = rtranclp_subset [to_set] @@ -319,11 +312,15 @@ subsection \Transitive closure\ -lemma trancl_mono: "\p. p \ r\<^sup>+ \ r \ s \ p \ s\<^sup>+" - apply (simp add: split_tupled_all) - apply (erule trancl.induct) - apply (iprover dest: subsetD)+ - done +lemma trancl_mono: + assumes "p \ r\<^sup>+" "r \ s" + shows "p \ s\<^sup>+" +proof - + have "\(a, b) \ r\<^sup>+; r \ s\ \ (a, b) \ s\<^sup>+" for a b + by (induction rule: trancl.induct) (iprover dest: subsetD)+ + with assms show ?thesis + by (cases p) force +qed lemma r_into_trancl': "\p. p \ r \ p \ r\<^sup>+" by (simp only: split_tupled_all) (erule r_into_trancl) @@ -342,12 +339,19 @@ lemmas rtrancl_into_trancl1 = rtranclp_into_tranclp1 [to_set] -lemma rtranclp_into_tranclp2: "r a b \ r\<^sup>*\<^sup>* b c \ r\<^sup>+\<^sup>+ a c" +lemma rtranclp_into_tranclp2: + assumes "r a b" "r\<^sup>*\<^sup>* b c" shows "r\<^sup>+\<^sup>+ a c" \ \intro rule from \r\ and \rtrancl\\ - apply (erule rtranclp.cases, iprover) - apply (rule rtranclp_trans [THEN rtranclp_into_tranclp1]) - apply (simp | rule r_into_rtranclp)+ - done + using \r\<^sup>*\<^sup>* b c\ +proof (cases rule: rtranclp.cases) + case rtrancl_refl + with assms show ?thesis + by iprover +next + case rtrancl_into_rtrancl + with assms show ?thesis + by (auto intro: rtranclp_trans [THEN rtranclp_into_tranclp1]) +qed lemmas rtrancl_into_trancl2 = rtranclp_into_tranclp2 [to_set] @@ -384,9 +388,7 @@ using assms by cases simp_all lemma trancl_Int_subset: "r \ s \ (r\<^sup>+ \ s) O r \ s \ r\<^sup>+ \ s" - apply clarify - apply (erule trancl_induct, auto) - done + by (fastforce simp add: elim: trancl_induct) lemma trancl_unfold: "r\<^sup>+ = r \ r\<^sup>+ O r" by (auto intro: trancl_into_trancl elim: tranclE) @@ -418,10 +420,7 @@ using assms(2,1) by induct iprover+ lemma trancl_id [simp]: "trans r \ r\<^sup>+ = r" - apply auto - apply (erule trancl_induct, assumption) - apply (unfold trans_def, blast) - done + unfolding trans_def by (fastforce simp add: elim: trancl_induct) lemma rtranclp_tranclp_tranclp: assumes "r\<^sup>*\<^sup>* x y" @@ -435,19 +434,30 @@ lemmas trancl_into_trancl2 = tranclp_into_tranclp2 [to_set] -lemma tranclp_converseI: "(r\<^sup>+\<^sup>+)\\ x y \ (r\\)\<^sup>+\<^sup>+ x y" - apply (drule conversepD) - apply (erule tranclp_induct) - apply (iprover intro: conversepI tranclp_trans)+ - done +lemma tranclp_converseI: + assumes "(r\<^sup>+\<^sup>+)\\ x y" shows "(r\\)\<^sup>+\<^sup>+ x y" + using conversepD [OF assms] +proof (induction rule: tranclp_induct) + case (base y) + then show ?case + by (iprover intro: conversepI) +next + case (step y z) + then show ?case + by (iprover intro: conversepI tranclp_trans) +qed lemmas trancl_converseI = tranclp_converseI [to_set] -lemma tranclp_converseD: "(r\\)\<^sup>+\<^sup>+ x y \ (r\<^sup>+\<^sup>+)\\ x y" - apply (rule conversepI) - apply (erule tranclp_induct) - apply (iprover dest: conversepD intro: tranclp_trans)+ - done +lemma tranclp_converseD: + assumes "(r\\)\<^sup>+\<^sup>+ x y" shows "(r\<^sup>+\<^sup>+)\\ x y" +proof - + have "r\<^sup>+\<^sup>+ y x" + using assms + by (induction rule: tranclp_induct) (iprover dest: conversepD intro: tranclp_trans)+ + then show ?thesis + by (rule conversepI) +qed lemmas trancl_converseD = tranclp_converseD [to_set] @@ -463,17 +473,21 @@ assumes major: "r\<^sup>+\<^sup>+ a b" and cases: "\y. r y b \ P y" "\y z. r y z \ r\<^sup>+\<^sup>+ z b \ P z \ P y" shows "P a" - apply (rule tranclp_induct [OF tranclp_converseI, OF conversepI, OF major]) - apply (blast intro: cases) - apply (blast intro: assms dest!: tranclp_converseD) - done +proof - + have "r\\\<^sup>+\<^sup>+ b a" + by (intro tranclp_converseI conversepI major) + then show ?thesis + by (induction rule: tranclp_induct) (blast intro: cases dest: tranclp_converseD)+ +qed lemmas converse_trancl_induct = converse_tranclp_induct [to_set] lemma tranclpD: "R\<^sup>+\<^sup>+ x y \ \z. R x z \ R\<^sup>*\<^sup>* z y" - apply (erule converse_tranclp_induct, auto) - apply (blast intro: rtranclp_trans) - done +proof (induction rule: converse_tranclp_induct) + case (step u v) + then show ?case + by (blast intro: rtranclp_trans) +qed auto lemmas tranclD = tranclpD [to_set] @@ -492,7 +506,7 @@ by iprover next case rtrancl_into_rtrancl - from this have "tranclp r y z" + then have "tranclp r y z" by (iprover intro: rtranclp_into_tranclp1) with \r x y\ step show P by iprover @@ -513,17 +527,15 @@ lemma trancl_subset_Sigma_aux: "(a, b) \ r\<^sup>* \ r \ A \ A \ a = b \ a \ A" by (induct rule: rtrancl_induct) auto -lemma trancl_subset_Sigma: "r \ A \ A \ r\<^sup>+ \ A \ A" - apply (clarsimp simp:) - apply (erule tranclE) - apply (blast dest!: trancl_into_rtrancl trancl_subset_Sigma_aux)+ - done +lemma trancl_subset_Sigma: + assumes "r \ A \ A" shows "r\<^sup>+ \ A \ A" +proof (rule trancl_Int_subset [OF assms]) + show "(r\<^sup>+ \ A \ A) O r \ A \ A" + using assms by auto +qed lemma reflclp_tranclp [simp]: "(r\<^sup>+\<^sup>+)\<^sup>=\<^sup>= = r\<^sup>*\<^sup>*" - apply (safe intro!: order_antisym) - apply (erule tranclp_into_rtranclp) - apply (blast elim: rtranclp.cases dest: rtranclp_into_tranclp1) - done + by (fast elim: rtranclp.cases tranclp_into_rtranclp dest: rtranclp_into_tranclp1) lemmas reflcl_trancl [simp] = reflclp_tranclp [to_set] @@ -629,19 +641,14 @@ qed lemma trancl_subset_Field2: "r\<^sup>+ \ Field r \ Field r" - apply clarify - apply (erule trancl_induct) - apply (auto simp: Field_def) - done + by (rule trancl_Int_subset) (auto simp: Field_def) lemma finite_trancl[simp]: "finite (r\<^sup>+) = finite r" proof show "finite (r\<^sup>+) \ finite r" by (blast intro: r_into_trancl' finite_subset) show "finite r \ finite (r\<^sup>+)" - apply (rule trancl_subset_Field2 [THEN finite_subset]) - apply (auto simp: finite_Field) - done + by (auto simp: finite_Field trancl_subset_Field2 [THEN finite_subset]) qed lemma finite_rtrancl_Image[simp]: assumes "finite R" "finite A" shows "finite (R\<^sup>* `` A)" @@ -665,9 +672,7 @@ next case (step y z) with xz \single_valued r\ show ?case - apply (auto simp: elim: converse_rtranclE dest: single_valuedD) - apply (blast intro: rtrancl_trans) - done + by (auto elim: converse_rtranclE dest: single_valuedD intro: rtrancl_trans) qed lemma r_r_into_trancl: "(a, b) \ R \ (b, c) \ R \ (a, c) \ R\<^sup>+" @@ -676,12 +681,14 @@ lemma trancl_into_trancl: "(a, b) \ r\<^sup>+ \ (b, c) \ r \ (a, c) \ r\<^sup>+" by (induct rule: trancl_induct) (fast intro: r_r_into_trancl trancl_trans)+ -lemma tranclp_rtranclp_tranclp: "r\<^sup>+\<^sup>+ a b \ r\<^sup>*\<^sup>* b c \ r\<^sup>+\<^sup>+ a c" - apply (drule tranclpD) - apply (elim exE conjE) - apply (drule rtranclp_trans, assumption) - apply (drule (2) rtranclp_into_tranclp2) - done +lemma tranclp_rtranclp_tranclp: + assumes "r\<^sup>+\<^sup>+ a b" "r\<^sup>*\<^sup>* b c" shows "r\<^sup>+\<^sup>+ a c" +proof - + obtain z where "r a z" "r\<^sup>*\<^sup>* z c" + using assms by (iprover dest: tranclpD rtranclp_trans) + then show ?thesis + by (blast dest: rtranclp_into_tranclp2) +qed lemma rtranclp_conversep: "r\\\<^sup>*\<^sup>* = r\<^sup>*\<^sup>*\\" by(auto simp add: fun_eq_iff intro: rtranclp_converseI rtranclp_converseD) @@ -717,13 +724,13 @@ lemma symclpI [simp, intro?]: shows symclpI1: "r x y \ symclp r x y" - and symclpI2: "r y x \ symclp r x y" -by(simp_all add: symclp_def) + and symclpI2: "r y x \ symclp r x y" + by(simp_all add: symclp_def) lemma symclpE [consumes 1, cases pred]: assumes "symclp r x y" obtains (base) "r x y" | (sym) "r y x" -using assms by(auto simp add: symclp_def) + using assms by(auto simp add: symclp_def) lemma symclp_pointfree: "symclp r = sup r r\\" by(auto simp add: symclp_def fun_eq_iff) @@ -962,12 +969,10 @@ lemma trancl_power: "p \ R\<^sup>+ \ (\n > 0. p \ R ^^ n)" proof - - have "((a, b) \ R\<^sup>+) = (\n>0. (a, b) \ R ^^ n)" for a b + have "(a, b) \ R\<^sup>+ \ (\n>0. (a, b) \ R ^^ n)" for a b proof safe show "(a, b) \ R\<^sup>+ \ \n>0. (a, b) \ R ^^ n" - apply (drule tranclD2) - apply (fastforce simp: rtrancl_is_UN_relpow relcomp_unfold) - done + by (fastforce simp: rtrancl_is_UN_relpow relcomp_unfold dest: tranclD2) show "(a, b) \ R\<^sup>+" if "n > 0" "(a, b) \ R ^^ n" for n proof (cases n) case (Suc m) @@ -1117,17 +1122,23 @@ fixes R :: "('a \ 'a) set" assumes "finite R" shows "R^^k \ (\n\{n. n \ card R}. R^^n)" - apply (cases k, force) - apply (use relpow_finite_bounded1[OF assms, of k] in auto) - done +proof (cases k) + case (Suc k') + then show ?thesis + using relpow_finite_bounded1[OF assms, of k] by auto +qed force lemma rtrancl_finite_eq_relpow: "finite R \ R\<^sup>* = (\n\{n. n \ card R}. R^^n)" by (fastforce simp: rtrancl_power dest: relpow_finite_bounded) -lemma trancl_finite_eq_relpow: "finite R \ R\<^sup>+ = (\n\{n. 0 < n \ n \ card R}. R^^n)" - apply (auto simp: trancl_power) - apply (auto dest: relpow_finite_bounded1) - done +lemma trancl_finite_eq_relpow: + assumes "finite R" shows "R\<^sup>+ = (\n\{n. 0 < n \ n \ card R}. R^^n)" +proof - + have "\a b n. \0 < n; (a, b) \ R ^^ n\ \ \x>0. x \ card R \ (a, b) \ R ^^ x" + using assms by (auto dest: relpow_finite_bounded1) + then show ?thesis + by (auto simp: trancl_power) +qed lemma finite_relcomp[simp,intro]: assumes "finite R" and "finite S" @@ -1189,7 +1200,7 @@ show ?thesis proof (cases "i = 1") case True - from this \(a, b) \ R ^^ i\ show ?thesis + with \(a, b) \ R ^^ i\ show ?thesis by (auto simp: ntrancl_def) next case False