nipkow@10213: (* Title: HOL/Transitive_Closure.thy nipkow@10213: Author: Lawrence C Paulson, Cambridge University Computer Laboratory nipkow@10213: Copyright 1992 University of Cambridge nipkow@10213: *) nipkow@10213: wenzelm@12691: header {* Reflexive and Transitive closure of a relation *} wenzelm@12691: nipkow@15131: theory Transitive_Closure berghofe@22262: imports Predicate wenzelm@21589: uses "~~/src/Provers/trancl.ML" nipkow@15131: begin wenzelm@12691: wenzelm@12691: text {* wenzelm@12691: @{text rtrancl} is reflexive/transitive closure, wenzelm@12691: @{text trancl} is transitive closure, wenzelm@12691: @{text reflcl} is reflexive closure. wenzelm@12691: wenzelm@12691: These postfix operators have \emph{maximum priority}, forcing their wenzelm@12691: operands to be atomic. wenzelm@12691: *} nipkow@10213: berghofe@23743: inductive_set berghofe@23743: rtrancl :: "('a \ 'a) set \ ('a \ 'a) set" ("(_^*)" [1000] 999) berghofe@23743: for r :: "('a \ 'a) set" berghofe@22262: where berghofe@23743: rtrancl_refl [intro!, Pure.intro!, simp]: "(a, a) : r^*" berghofe@23743: | rtrancl_into_rtrancl [Pure.intro]: "(a, b) : r^* ==> (b, c) : r ==> (a, c) : r^*" berghofe@11327: berghofe@23743: inductive_set berghofe@23743: trancl :: "('a \ 'a) set \ ('a \ 'a) set" ("(_^+)" [1000] 999) berghofe@23743: for r :: "('a \ 'a) set" berghofe@22262: where berghofe@23743: r_into_trancl [intro, Pure.intro]: "(a, b) : r ==> (a, b) : r^+" berghofe@23743: | trancl_into_trancl [Pure.intro]: "(a, b) : r^+ ==> (b, c) : r ==> (a, c) : r^+" berghofe@13704: berghofe@23743: notation berghofe@23743: rtranclp ("(_^**)" [1000] 1000) and berghofe@23743: tranclp ("(_^++)" [1000] 1000) nipkow@10213: wenzelm@19656: abbreviation berghofe@23743: reflclp :: "('a => 'a => bool) => 'a => 'a => bool" ("(_^==)" [1000] 1000) where haftmann@22422: "r^== == sup r op =" berghofe@22262: berghofe@22262: abbreviation berghofe@23743: reflcl :: "('a \ 'a) set => ('a \ 'a) set" ("(_^=)" [1000] 999) where wenzelm@19656: "r^= == r \ Id" nipkow@10213: wenzelm@21210: notation (xsymbols) berghofe@23743: rtranclp ("(_\<^sup>*\<^sup>*)" [1000] 1000) and berghofe@23743: tranclp ("(_\<^sup>+\<^sup>+)" [1000] 1000) and berghofe@23743: reflclp ("(_\<^sup>=\<^sup>=)" [1000] 1000) and berghofe@23743: rtrancl ("(_\<^sup>*)" [1000] 999) and berghofe@23743: trancl ("(_\<^sup>+)" [1000] 999) and berghofe@23743: reflcl ("(_\<^sup>=)" [1000] 999) wenzelm@12691: wenzelm@21210: notation (HTML output) berghofe@23743: rtranclp ("(_\<^sup>*\<^sup>*)" [1000] 1000) and berghofe@23743: tranclp ("(_\<^sup>+\<^sup>+)" [1000] 1000) and berghofe@23743: reflclp ("(_\<^sup>=\<^sup>=)" [1000] 1000) and berghofe@23743: rtrancl ("(_\<^sup>*)" [1000] 999) and berghofe@23743: trancl ("(_\<^sup>+)" [1000] 999) and berghofe@23743: reflcl ("(_\<^sup>=)" [1000] 999) kleing@14565: wenzelm@12691: nipkow@26271: subsection {* Reflexive closure *} nipkow@26271: nipkow@30198: lemma refl_reflcl[simp]: "refl(r^=)" nipkow@30198: by(simp add:refl_on_def) nipkow@26271: nipkow@26271: lemma antisym_reflcl[simp]: "antisym(r^=) = antisym r" nipkow@26271: by(simp add:antisym_def) nipkow@26271: nipkow@26271: lemma trans_reflclI[simp]: "trans r \ trans(r^=)" nipkow@26271: unfolding trans_def by blast nipkow@26271: nipkow@26271: wenzelm@12691: subsection {* Reflexive-transitive closure *} wenzelm@12691: berghofe@23743: lemma reflcl_set_eq [pred_set_conv]: "(sup (\x y. (x, y) \ r) op =) = (\x y. (x, y) \ r Un Id)" berghofe@22262: by (simp add: expand_fun_eq) berghofe@22262: wenzelm@12691: lemma r_into_rtrancl [intro]: "!!p. p \ r ==> p \ r^*" wenzelm@12691: -- {* @{text rtrancl} of @{text r} contains @{text r} *} wenzelm@12691: apply (simp only: split_tupled_all) wenzelm@12691: apply (erule rtrancl_refl [THEN rtrancl_into_rtrancl]) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemma r_into_rtranclp [intro]: "r x y ==> r^** x y" berghofe@22262: -- {* @{text rtrancl} of @{text r} contains @{text r} *} berghofe@23743: by (erule rtranclp.rtrancl_refl [THEN rtranclp.rtrancl_into_rtrancl]) berghofe@22262: berghofe@23743: lemma rtranclp_mono: "r \ s ==> r^** \ s^**" wenzelm@12691: -- {* monotonicity of @{text rtrancl} *} berghofe@22262: apply (rule predicate2I) berghofe@23743: apply (erule rtranclp.induct) berghofe@23743: apply (rule_tac [2] rtranclp.rtrancl_into_rtrancl, blast+) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas rtrancl_mono = rtranclp_mono [to_set] berghofe@22262: wenzelm@26179: theorem rtranclp_induct [consumes 1, case_names base step, induct set: rtranclp]: berghofe@22262: assumes a: "r^** a b" berghofe@22262: and cases: "P a" "!!y z. [| r^** a y; r y z; P y |] ==> P z" wenzelm@12937: shows "P b" wenzelm@12691: proof - wenzelm@12691: from a have "a = a --> P b" nipkow@17589: by (induct "%x y. x = a --> P y" a b) (iprover intro: cases)+ wenzelm@26179: then show ?thesis by iprover wenzelm@12691: qed wenzelm@12691: berghofe@25425: lemmas rtrancl_induct [induct set: rtrancl] = rtranclp_induct [to_set] berghofe@22262: berghofe@23743: lemmas rtranclp_induct2 = berghofe@23743: rtranclp_induct[of _ "(ax,ay)" "(bx,by)", split_rule, berghofe@22262: consumes 1, case_names refl step] berghofe@22262: nipkow@14404: lemmas rtrancl_induct2 = nipkow@14404: rtrancl_induct[of "(ax,ay)" "(bx,by)", split_format (complete), nipkow@14404: consumes 1, case_names refl step] wenzelm@18372: nipkow@30198: lemma refl_rtrancl: "refl (r^*)" nipkow@30198: by (unfold refl_on_def) fast huffman@19228: wenzelm@26179: text {* Transitivity of transitive closure. *} wenzelm@26179: lemma trans_rtrancl: "trans (r^*)" berghofe@12823: proof (rule transI) berghofe@12823: fix x y z berghofe@12823: assume "(x, y) \ r\<^sup>*" berghofe@12823: assume "(y, z) \ r\<^sup>*" wenzelm@26179: then show "(x, z) \ r\<^sup>*" wenzelm@26179: proof induct wenzelm@26179: case base wenzelm@26179: show "(x, y) \ r\<^sup>*" by fact wenzelm@26179: next wenzelm@26179: case (step u v) wenzelm@26179: from `(x, u) \ r\<^sup>*` and `(u, v) \ r` wenzelm@26179: show "(x, v) \ r\<^sup>*" .. wenzelm@26179: qed berghofe@12823: qed wenzelm@12691: wenzelm@12691: lemmas rtrancl_trans = trans_rtrancl [THEN transD, standard] wenzelm@12691: berghofe@23743: lemma rtranclp_trans: berghofe@22262: assumes xy: "r^** x y" berghofe@22262: and yz: "r^** y z" berghofe@22262: shows "r^** x z" using yz xy berghofe@22262: by induct iprover+ berghofe@22262: wenzelm@26174: lemma rtranclE [cases set: rtrancl]: wenzelm@26174: assumes major: "(a::'a, b) : r^*" wenzelm@26174: obtains wenzelm@26174: (base) "a = b" wenzelm@26174: | (step) y where "(a, y) : r^*" and "(y, b) : r" wenzelm@12691: -- {* elimination of @{text rtrancl} -- by induction on a special formula *} wenzelm@18372: apply (subgoal_tac "(a::'a) = b | (EX y. (a,y) : r^* & (y,b) : r)") wenzelm@18372: apply (rule_tac [2] major [THEN rtrancl_induct]) wenzelm@18372: prefer 2 apply blast wenzelm@18372: prefer 2 apply blast wenzelm@26174: apply (erule asm_rl exE disjE conjE base step)+ wenzelm@18372: done wenzelm@12691: paulson@22080: lemma rtrancl_Int_subset: "[| Id \ s; r O (r^* \ s) \ s|] ==> r^* \ s" paulson@22080: apply (rule subsetI) paulson@22080: apply (rule_tac p="x" in PairE, clarify) paulson@22080: apply (erule rtrancl_induct, auto) paulson@22080: done paulson@22080: berghofe@23743: lemma converse_rtranclp_into_rtranclp: berghofe@22262: "r a b \ r\<^sup>*\<^sup>* b c \ r\<^sup>*\<^sup>* a c" berghofe@23743: by (rule rtranclp_trans) iprover+ berghofe@22262: berghofe@23743: lemmas converse_rtrancl_into_rtrancl = converse_rtranclp_into_rtranclp [to_set] wenzelm@12691: wenzelm@12691: text {* wenzelm@12691: \medskip More @{term "r^*"} equations and inclusions. wenzelm@12691: *} wenzelm@12691: berghofe@23743: lemma rtranclp_idemp [simp]: "(r^**)^** = r^**" berghofe@22262: apply (auto intro!: order_antisym) berghofe@23743: apply (erule rtranclp_induct) berghofe@23743: apply (rule rtranclp.rtrancl_refl) berghofe@23743: apply (blast intro: rtranclp_trans) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas rtrancl_idemp [simp] = rtranclp_idemp [to_set] berghofe@22262: wenzelm@12691: lemma rtrancl_idemp_self_comp [simp]: "R^* O R^* = R^*" wenzelm@12691: apply (rule set_ext) wenzelm@12691: apply (simp only: split_tupled_all) wenzelm@12691: apply (blast intro: rtrancl_trans) wenzelm@12691: done wenzelm@12691: wenzelm@12691: lemma rtrancl_subset_rtrancl: "r \ s^* ==> r^* \ s^*" wenzelm@26179: apply (drule rtrancl_mono) wenzelm@26179: apply simp wenzelm@26179: done wenzelm@12691: berghofe@23743: lemma rtranclp_subset: "R \ S ==> S \ R^** ==> S^** = R^**" berghofe@23743: apply (drule rtranclp_mono) wenzelm@26179: apply (drule rtranclp_mono) wenzelm@26179: apply simp wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas rtrancl_subset = rtranclp_subset [to_set] berghofe@22262: berghofe@23743: lemma rtranclp_sup_rtranclp: "(sup (R^**) (S^**))^** = (sup R S)^**" berghofe@23743: by (blast intro!: rtranclp_subset intro: rtranclp_mono [THEN predicate2D]) wenzelm@12691: berghofe@23743: lemmas rtrancl_Un_rtrancl = rtranclp_sup_rtranclp [to_set] berghofe@22262: berghofe@23743: lemma rtranclp_reflcl [simp]: "(R^==)^** = R^**" berghofe@23743: by (blast intro!: rtranclp_subset) berghofe@22262: berghofe@23743: lemmas rtrancl_reflcl [simp] = rtranclp_reflcl [to_set] wenzelm@12691: wenzelm@12691: lemma rtrancl_r_diff_Id: "(r - Id)^* = r^*" wenzelm@12691: apply (rule sym) paulson@14208: apply (rule rtrancl_subset, blast, clarify) wenzelm@12691: apply (rename_tac a b) wenzelm@26179: apply (case_tac "a = b") wenzelm@26179: apply blast wenzelm@12691: apply (blast intro!: r_into_rtrancl) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemma rtranclp_r_diff_Id: "(inf r op ~=)^** = r^**" berghofe@22262: apply (rule sym) berghofe@23743: apply (rule rtranclp_subset) wenzelm@26179: apply blast+ berghofe@22262: done berghofe@22262: berghofe@23743: theorem rtranclp_converseD: berghofe@22262: assumes r: "(r^--1)^** x y" berghofe@22262: shows "r^** y x" berghofe@12823: proof - berghofe@12823: from r show ?thesis berghofe@23743: by induct (iprover intro: rtranclp_trans dest!: conversepD)+ berghofe@12823: qed wenzelm@12691: berghofe@23743: lemmas rtrancl_converseD = rtranclp_converseD [to_set] berghofe@22262: berghofe@23743: theorem rtranclp_converseI: wenzelm@26179: assumes "r^** y x" berghofe@22262: shows "(r^--1)^** x y" wenzelm@26179: using assms wenzelm@26179: by induct (iprover intro: rtranclp_trans conversepI)+ wenzelm@12691: berghofe@23743: lemmas rtrancl_converseI = rtranclp_converseI [to_set] berghofe@22262: wenzelm@12691: lemma rtrancl_converse: "(r^-1)^* = (r^*)^-1" wenzelm@12691: by (fast dest!: rtrancl_converseD intro!: rtrancl_converseI) wenzelm@12691: huffman@19228: lemma sym_rtrancl: "sym r ==> sym (r^*)" huffman@19228: by (simp only: sym_conv_converse_eq rtrancl_converse [symmetric]) huffman@19228: berghofe@23743: theorem converse_rtranclp_induct[consumes 1]: berghofe@22262: assumes major: "r^** a b" berghofe@22262: and cases: "P b" "!!y z. [| r y z; r^** z b; P z |] ==> P y" wenzelm@12937: shows "P a" wenzelm@26179: using rtranclp_converseI [OF major] wenzelm@26179: by induct (iprover intro: cases dest!: conversepD rtranclp_converseD)+ wenzelm@12691: berghofe@25425: lemmas converse_rtrancl_induct = converse_rtranclp_induct [to_set] berghofe@22262: berghofe@23743: lemmas converse_rtranclp_induct2 = wenzelm@26179: converse_rtranclp_induct [of _ "(ax,ay)" "(bx,by)", split_rule, berghofe@22262: consumes 1, case_names refl step] berghofe@22262: nipkow@14404: lemmas converse_rtrancl_induct2 = wenzelm@26179: converse_rtrancl_induct [of "(ax,ay)" "(bx,by)", split_format (complete), nipkow@14404: consumes 1, case_names refl step] wenzelm@12691: berghofe@23743: lemma converse_rtranclpE: berghofe@22262: assumes major: "r^** x z" wenzelm@18372: and cases: "x=z ==> P" berghofe@22262: "!!y. [| r x y; r^** y z |] ==> P" wenzelm@18372: shows P berghofe@22262: apply (subgoal_tac "x = z | (EX y. r x y & r^** y z)") berghofe@23743: apply (rule_tac [2] major [THEN converse_rtranclp_induct]) wenzelm@18372: prefer 2 apply iprover wenzelm@18372: prefer 2 apply iprover wenzelm@18372: apply (erule asm_rl exE disjE conjE cases)+ wenzelm@18372: done wenzelm@12691: berghofe@23743: lemmas converse_rtranclE = converse_rtranclpE [to_set] berghofe@22262: berghofe@23743: lemmas converse_rtranclpE2 = converse_rtranclpE [of _ "(xa,xb)" "(za,zb)", split_rule] berghofe@22262: berghofe@22262: lemmas converse_rtranclE2 = converse_rtranclE [of "(xa,xb)" "(za,zb)", split_rule] wenzelm@12691: wenzelm@12691: lemma r_comp_rtrancl_eq: "r O r^* = r^* O r" wenzelm@12691: by (blast elim: rtranclE converse_rtranclE wenzelm@12691: intro: rtrancl_into_rtrancl converse_rtrancl_into_rtrancl) wenzelm@12691: krauss@20716: lemma rtrancl_unfold: "r^* = Id Un r O r^*" paulson@15551: by (auto intro: rtrancl_into_rtrancl elim: rtranclE) paulson@15551: wenzelm@12691: wenzelm@12691: subsection {* Transitive closure *} wenzelm@10331: berghofe@13704: lemma trancl_mono: "!!p. p \ r^+ ==> r \ s ==> p \ s^+" berghofe@23743: apply (simp add: split_tupled_all) berghofe@13704: apply (erule trancl.induct) wenzelm@26179: apply (iprover dest: subsetD)+ wenzelm@12691: done wenzelm@12691: berghofe@13704: lemma r_into_trancl': "!!p. p : r ==> p : r^+" berghofe@13704: by (simp only: split_tupled_all) (erule r_into_trancl) berghofe@13704: wenzelm@12691: text {* wenzelm@12691: \medskip Conversions between @{text trancl} and @{text rtrancl}. wenzelm@12691: *} wenzelm@12691: berghofe@23743: lemma tranclp_into_rtranclp: "r^++ a b ==> r^** a b" berghofe@23743: by (erule tranclp.induct) iprover+ wenzelm@12691: berghofe@23743: lemmas trancl_into_rtrancl = tranclp_into_rtranclp [to_set] berghofe@22262: berghofe@23743: lemma rtranclp_into_tranclp1: assumes r: "r^** a b" berghofe@22262: shows "!!c. r b c ==> r^++ a c" using r nipkow@17589: by induct iprover+ wenzelm@12691: berghofe@23743: lemmas rtrancl_into_trancl1 = rtranclp_into_tranclp1 [to_set] berghofe@22262: berghofe@23743: lemma rtranclp_into_tranclp2: "[| r a b; r^** b c |] ==> r^++ a c" wenzelm@12691: -- {* intro rule from @{text r} and @{text rtrancl} *} wenzelm@26179: apply (erule rtranclp.cases) wenzelm@26179: apply iprover berghofe@23743: apply (rule rtranclp_trans [THEN rtranclp_into_tranclp1]) wenzelm@26179: apply (simp | rule r_into_rtranclp)+ wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas rtrancl_into_trancl2 = rtranclp_into_tranclp2 [to_set] berghofe@22262: wenzelm@26179: text {* Nice induction rule for @{text trancl} *} wenzelm@26179: lemma tranclp_induct [consumes 1, case_names base step, induct pred: tranclp]: wenzelm@26179: assumes "r^++ a b" berghofe@22262: and cases: "!!y. r a y ==> P y" berghofe@22262: "!!y z. r^++ a y ==> r y z ==> P y ==> P z" berghofe@13704: shows "P b" wenzelm@12691: proof - wenzelm@26179: from `r^++ a b` have "a = a --> P b" nipkow@17589: by (induct "%x y. x = a --> P y" a b) (iprover intro: cases)+ wenzelm@26179: then show ?thesis by iprover wenzelm@12691: qed wenzelm@12691: berghofe@25425: lemmas trancl_induct [induct set: trancl] = tranclp_induct [to_set] berghofe@22262: berghofe@23743: lemmas tranclp_induct2 = wenzelm@26179: tranclp_induct [of _ "(ax,ay)" "(bx,by)", split_rule, wenzelm@26179: consumes 1, case_names base step] berghofe@22262: paulson@22172: lemmas trancl_induct2 = wenzelm@26179: trancl_induct [of "(ax,ay)" "(bx,by)", split_format (complete), wenzelm@26179: consumes 1, case_names base step] paulson@22172: berghofe@23743: lemma tranclp_trans_induct: berghofe@22262: assumes major: "r^++ x y" berghofe@22262: and cases: "!!x y. r x y ==> P x y" berghofe@22262: "!!x y z. [| r^++ x y; P x y; r^++ y z; P y z |] ==> P x z" wenzelm@18372: shows "P x y" wenzelm@12691: -- {* Another induction rule for trancl, incorporating transitivity *} berghofe@23743: by (iprover intro: major [THEN tranclp_induct] cases) wenzelm@12691: berghofe@23743: lemmas trancl_trans_induct = tranclp_trans_induct [to_set] berghofe@23743: wenzelm@26174: lemma tranclE [cases set: trancl]: wenzelm@26174: assumes "(a, b) : r^+" wenzelm@26174: obtains wenzelm@26174: (base) "(a, b) : r" wenzelm@26174: | (step) c where "(a, c) : r^+" and "(c, b) : r" wenzelm@26174: using assms by cases simp_all wenzelm@10980: paulson@22080: lemma trancl_Int_subset: "[| r \ s; r O (r^+ \ s) \ s|] ==> r^+ \ s" paulson@22080: apply (rule subsetI) wenzelm@26179: apply (rule_tac p = x in PairE) wenzelm@26179: apply clarify wenzelm@26179: apply (erule trancl_induct) wenzelm@26179: apply auto paulson@22080: done paulson@22080: krauss@20716: lemma trancl_unfold: "r^+ = r Un r O r^+" paulson@15551: by (auto intro: trancl_into_trancl elim: tranclE) paulson@15551: wenzelm@26179: text {* Transitivity of @{term "r^+"} *} wenzelm@26179: lemma trans_trancl [simp]: "trans (r^+)" berghofe@13704: proof (rule transI) berghofe@13704: fix x y z wenzelm@26179: assume "(x, y) \ r^+" berghofe@13704: assume "(y, z) \ r^+" wenzelm@26179: then show "(x, z) \ r^+" wenzelm@26179: proof induct wenzelm@26179: case (base u) wenzelm@26179: from `(x, y) \ r^+` and `(y, u) \ r` wenzelm@26179: show "(x, u) \ r^+" .. wenzelm@26179: next wenzelm@26179: case (step u v) wenzelm@26179: from `(x, u) \ r^+` and `(u, v) \ r` wenzelm@26179: show "(x, v) \ r^+" .. wenzelm@26179: qed berghofe@13704: qed wenzelm@12691: wenzelm@12691: lemmas trancl_trans = trans_trancl [THEN transD, standard] wenzelm@12691: berghofe@23743: lemma tranclp_trans: berghofe@22262: assumes xy: "r^++ x y" berghofe@22262: and yz: "r^++ y z" berghofe@22262: shows "r^++ x z" using yz xy berghofe@22262: by induct iprover+ berghofe@22262: wenzelm@26179: lemma trancl_id [simp]: "trans r \ r^+ = r" wenzelm@26179: apply auto wenzelm@26179: apply (erule trancl_induct) wenzelm@26179: apply assumption wenzelm@26179: apply (unfold trans_def) wenzelm@26179: apply blast wenzelm@26179: done nipkow@19623: wenzelm@26179: lemma rtranclp_tranclp_tranclp: wenzelm@26179: assumes "r^** x y" wenzelm@26179: shows "!!z. r^++ y z ==> r^++ x z" using assms berghofe@23743: by induct (iprover intro: tranclp_trans)+ wenzelm@12691: berghofe@23743: lemmas rtrancl_trancl_trancl = rtranclp_tranclp_tranclp [to_set] berghofe@22262: berghofe@23743: lemma tranclp_into_tranclp2: "r a b ==> r^++ b c ==> r^++ a c" berghofe@23743: by (erule tranclp_trans [OF tranclp.r_into_trancl]) berghofe@22262: berghofe@23743: lemmas trancl_into_trancl2 = tranclp_into_tranclp2 [to_set] wenzelm@12691: wenzelm@12691: lemma trancl_insert: wenzelm@12691: "(insert (y, x) r)^+ = r^+ \ {(a, b). (a, y) \ r^* \ (x, b) \ r^*}" wenzelm@12691: -- {* primitive recursion for @{text trancl} over finite relations *} wenzelm@12691: apply (rule equalityI) wenzelm@12691: apply (rule subsetI) wenzelm@12691: apply (simp only: split_tupled_all) paulson@14208: apply (erule trancl_induct, blast) wenzelm@12691: apply (blast intro: rtrancl_into_trancl1 trancl_into_rtrancl r_into_trancl trancl_trans) wenzelm@12691: apply (rule subsetI) wenzelm@12691: apply (blast intro: trancl_mono rtrancl_mono wenzelm@12691: [THEN [2] rev_subsetD] rtrancl_trancl_trancl rtrancl_into_trancl2) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemma tranclp_converseI: "(r^++)^--1 x y ==> (r^--1)^++ x y" berghofe@22262: apply (drule conversepD) berghofe@23743: apply (erule tranclp_induct) berghofe@23743: apply (iprover intro: conversepI tranclp_trans)+ wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas trancl_converseI = tranclp_converseI [to_set] berghofe@22262: berghofe@23743: lemma tranclp_converseD: "(r^--1)^++ x y ==> (r^++)^--1 x y" berghofe@22262: apply (rule conversepI) berghofe@23743: apply (erule tranclp_induct) berghofe@23743: apply (iprover dest: conversepD intro: tranclp_trans)+ berghofe@13704: done wenzelm@12691: berghofe@23743: lemmas trancl_converseD = tranclp_converseD [to_set] berghofe@22262: berghofe@23743: lemma tranclp_converse: "(r^--1)^++ = (r^++)^--1" berghofe@22262: by (fastsimp simp add: expand_fun_eq berghofe@23743: intro!: tranclp_converseI dest!: tranclp_converseD) berghofe@22262: berghofe@23743: lemmas trancl_converse = tranclp_converse [to_set] wenzelm@12691: huffman@19228: lemma sym_trancl: "sym r ==> sym (r^+)" huffman@19228: by (simp only: sym_conv_converse_eq trancl_converse [symmetric]) huffman@19228: berghofe@23743: lemma converse_tranclp_induct: berghofe@22262: assumes major: "r^++ a b" berghofe@22262: and cases: "!!y. r y b ==> P(y)" berghofe@22262: "!!y z.[| r y z; r^++ z b; P(z) |] ==> P(y)" wenzelm@18372: shows "P a" berghofe@23743: apply (rule tranclp_induct [OF tranclp_converseI, OF conversepI, OF major]) wenzelm@18372: apply (rule cases) berghofe@22262: apply (erule conversepD) berghofe@23743: apply (blast intro: prems dest!: tranclp_converseD conversepD) wenzelm@18372: done wenzelm@12691: berghofe@23743: lemmas converse_trancl_induct = converse_tranclp_induct [to_set] berghofe@22262: berghofe@23743: lemma tranclpD: "R^++ x y ==> EX z. R x z \ R^** z y" wenzelm@26179: apply (erule converse_tranclp_induct) wenzelm@26179: apply auto berghofe@23743: apply (blast intro: rtranclp_trans) wenzelm@12691: done wenzelm@12691: berghofe@23743: lemmas tranclD = tranclpD [to_set] berghofe@22262: kleing@25295: lemma tranclD2: kleing@25295: "(x, y) \ R\<^sup>+ \ \z. (x, z) \ R\<^sup>* \ (z, y) \ R" kleing@25295: by (blast elim: tranclE intro: trancl_into_rtrancl) kleing@25295: nipkow@13867: lemma irrefl_tranclI: "r^-1 \ r^* = {} ==> (x, x) \ r^+" wenzelm@18372: by (blast elim: tranclE dest: trancl_into_rtrancl) wenzelm@12691: wenzelm@12691: lemma irrefl_trancl_rD: "!!X. ALL x. (x, x) \ r^+ ==> (x, y) \ r ==> x \ y" wenzelm@12691: by (blast dest: r_into_trancl) wenzelm@12691: wenzelm@12691: lemma trancl_subset_Sigma_aux: wenzelm@12691: "(a, b) \ r^* ==> r \ A \ A ==> a = b \ a \ A" wenzelm@18372: by (induct rule: rtrancl_induct) auto wenzelm@12691: wenzelm@12691: lemma trancl_subset_Sigma: "r \ A \ A ==> r^+ \ A \ A" berghofe@13704: apply (rule subsetI) berghofe@13704: apply (simp only: split_tupled_all) berghofe@13704: apply (erule tranclE) wenzelm@26179: apply (blast dest!: trancl_into_rtrancl trancl_subset_Sigma_aux)+ wenzelm@12691: done nipkow@10996: berghofe@23743: lemma reflcl_tranclp [simp]: "(r^++)^== = r^**" berghofe@22262: apply (safe intro!: order_antisym) berghofe@23743: apply (erule tranclp_into_rtranclp) berghofe@23743: apply (blast elim: rtranclp.cases dest: rtranclp_into_tranclp1) wenzelm@11084: done nipkow@10996: berghofe@23743: lemmas reflcl_trancl [simp] = reflcl_tranclp [to_set] berghofe@22262: wenzelm@11090: lemma trancl_reflcl [simp]: "(r^=)^+ = r^*" wenzelm@11084: apply safe paulson@14208: apply (drule trancl_into_rtrancl, simp) paulson@14208: apply (erule rtranclE, safe) paulson@14208: apply (rule r_into_trancl, simp) wenzelm@11084: apply (rule rtrancl_into_trancl1) paulson@14208: apply (erule rtrancl_reflcl [THEN equalityD2, THEN subsetD], fast) wenzelm@11084: done nipkow@10996: wenzelm@11090: lemma trancl_empty [simp]: "{}^+ = {}" wenzelm@11084: by (auto elim: trancl_induct) nipkow@10996: wenzelm@11090: lemma rtrancl_empty [simp]: "{}^* = Id" wenzelm@11084: by (rule subst [OF reflcl_trancl]) simp nipkow@10996: berghofe@23743: lemma rtranclpD: "R^** a b ==> a = b \ a \ b \ R^++ a b" berghofe@23743: by (force simp add: reflcl_tranclp [symmetric] simp del: reflcl_tranclp) berghofe@22262: berghofe@23743: lemmas rtranclD = rtranclpD [to_set] wenzelm@11084: kleing@16514: lemma rtrancl_eq_or_trancl: kleing@16514: "(x,y) \ R\<^sup>* = (x=y \ x\y \ (x,y) \ R\<^sup>+)" kleing@16514: by (fast elim: trancl_into_rtrancl dest: rtranclD) nipkow@10996: wenzelm@12691: text {* @{text Domain} and @{text Range} *} nipkow@10996: wenzelm@11090: lemma Domain_rtrancl [simp]: "Domain (R^*) = UNIV" wenzelm@11084: by blast nipkow@10996: wenzelm@11090: lemma Range_rtrancl [simp]: "Range (R^*) = UNIV" wenzelm@11084: by blast nipkow@10996: wenzelm@11090: lemma rtrancl_Un_subset: "(R^* \ S^*) \ (R Un S)^*" wenzelm@11084: by (rule rtrancl_Un_rtrancl [THEN subst]) fast nipkow@10996: wenzelm@11090: lemma in_rtrancl_UnI: "x \ R^* \ x \ S^* ==> x \ (R \ S)^*" wenzelm@11084: by (blast intro: subsetD [OF rtrancl_Un_subset]) nipkow@10996: wenzelm@11090: lemma trancl_domain [simp]: "Domain (r^+) = Domain r" wenzelm@11084: by (unfold Domain_def) (blast dest: tranclD) nipkow@10996: wenzelm@11090: lemma trancl_range [simp]: "Range (r^+) = Range r" nipkow@26271: unfolding Range_def by(simp add: trancl_converse [symmetric]) nipkow@10996: paulson@11115: lemma Not_Domain_rtrancl: wenzelm@12691: "x ~: Domain R ==> ((x, y) : R^*) = (x = y)" wenzelm@12691: apply auto wenzelm@26179: apply (erule rev_mp) wenzelm@26179: apply (erule rtrancl_induct) wenzelm@26179: apply auto wenzelm@26179: done berghofe@11327: haftmann@29609: lemma trancl_subset_Field2: "r^+ <= Field r \ Field r" haftmann@29609: apply clarify haftmann@29609: apply (erule trancl_induct) haftmann@29609: apply (auto simp add: Field_def) haftmann@29609: done haftmann@29609: haftmann@29609: lemma finite_trancl: "finite (r^+) = finite r" haftmann@29609: apply auto haftmann@29609: prefer 2 haftmann@29609: apply (rule trancl_subset_Field2 [THEN finite_subset]) haftmann@29609: apply (rule finite_SigmaI) haftmann@29609: prefer 3 haftmann@29609: apply (blast intro: r_into_trancl' finite_subset) haftmann@29609: apply (auto simp add: finite_Field) haftmann@29609: done haftmann@29609: wenzelm@12691: text {* More about converse @{text rtrancl} and @{text trancl}, should wenzelm@12691: be merged with main body. *} kleing@12428: nipkow@14337: lemma single_valued_confluent: nipkow@14337: "\ single_valued r; (x,y) \ r^*; (x,z) \ r^* \ nipkow@14337: \ (y,z) \ r^* \ (z,y) \ r^*" wenzelm@26179: apply (erule rtrancl_induct) wenzelm@26179: apply simp wenzelm@26179: apply (erule disjE) wenzelm@26179: apply (blast elim:converse_rtranclE dest:single_valuedD) wenzelm@26179: apply(blast intro:rtrancl_trans) wenzelm@26179: done nipkow@14337: wenzelm@12691: lemma r_r_into_trancl: "(a, b) \ R ==> (b, c) \ R ==> (a, c) \ R^+" kleing@12428: by (fast intro: trancl_trans) kleing@12428: kleing@12428: lemma trancl_into_trancl [rule_format]: wenzelm@12691: "(a, b) \ r\<^sup>+ ==> (b, c) \ r --> (a,c) \ r\<^sup>+" wenzelm@12691: apply (erule trancl_induct) kleing@12428: apply (fast intro: r_r_into_trancl) kleing@12428: apply (fast intro: r_r_into_trancl trancl_trans) kleing@12428: done kleing@12428: berghofe@23743: lemma tranclp_rtranclp_tranclp: berghofe@22262: "r\<^sup>+\<^sup>+ a b ==> r\<^sup>*\<^sup>* b c ==> r\<^sup>+\<^sup>+ a c" berghofe@23743: apply (drule tranclpD) wenzelm@26179: apply (elim exE conjE) berghofe@23743: apply (drule rtranclp_trans, assumption) berghofe@23743: apply (drule rtranclp_into_tranclp2, assumption, assumption) kleing@12428: done kleing@12428: berghofe@23743: lemmas trancl_rtrancl_trancl = tranclp_rtranclp_tranclp [to_set] berghofe@22262: wenzelm@12691: lemmas transitive_closure_trans [trans] = wenzelm@12691: r_r_into_trancl trancl_trans rtrancl_trans berghofe@23743: trancl.trancl_into_trancl trancl_into_trancl2 berghofe@23743: rtrancl.rtrancl_into_rtrancl converse_rtrancl_into_rtrancl wenzelm@12691: rtrancl_trancl_trancl trancl_rtrancl_trancl kleing@12428: berghofe@23743: lemmas transitive_closurep_trans' [trans] = berghofe@23743: tranclp_trans rtranclp_trans berghofe@23743: tranclp.trancl_into_trancl tranclp_into_tranclp2 berghofe@23743: rtranclp.rtrancl_into_rtrancl converse_rtranclp_into_rtranclp berghofe@23743: rtranclp_tranclp_tranclp tranclp_rtranclp_tranclp berghofe@22262: kleing@12428: declare trancl_into_rtrancl [elim] berghofe@11327: paulson@15551: ballarin@15076: subsection {* Setup of transitivity reasoner *} ballarin@15076: wenzelm@26340: ML {* ballarin@15076: ballarin@15076: structure Trancl_Tac = Trancl_Tac_Fun ( ballarin@15076: struct wenzelm@26340: val r_into_trancl = @{thm trancl.r_into_trancl}; wenzelm@26340: val trancl_trans = @{thm trancl_trans}; wenzelm@26340: val rtrancl_refl = @{thm rtrancl.rtrancl_refl}; wenzelm@26340: val r_into_rtrancl = @{thm r_into_rtrancl}; wenzelm@26340: val trancl_into_rtrancl = @{thm trancl_into_rtrancl}; wenzelm@26340: val rtrancl_trancl_trancl = @{thm rtrancl_trancl_trancl}; wenzelm@26340: val trancl_rtrancl_trancl = @{thm trancl_rtrancl_trancl}; wenzelm@26340: val rtrancl_trans = @{thm rtrancl_trans}; ballarin@15096: berghofe@30107: fun decomp (@{const Trueprop} $ t) = wenzelm@18372: let fun dec (Const ("op :", _) $ (Const ("Pair", _) $ a $ b) $ rel ) = berghofe@23743: let fun decr (Const ("Transitive_Closure.rtrancl", _ ) $ r) = (r,"r*") berghofe@23743: | decr (Const ("Transitive_Closure.trancl", _ ) $ r) = (r,"r+") wenzelm@18372: | decr r = (r,"r"); berghofe@26801: val (rel,r) = decr (Envir.beta_eta_contract rel); wenzelm@18372: in SOME (a,b,rel,r) end wenzelm@18372: | dec _ = NONE berghofe@30107: in dec t end berghofe@30107: | decomp _ = NONE; wenzelm@18372: wenzelm@21589: end); ballarin@15076: berghofe@22262: structure Tranclp_Tac = Trancl_Tac_Fun ( berghofe@22262: struct wenzelm@26340: val r_into_trancl = @{thm tranclp.r_into_trancl}; wenzelm@26340: val trancl_trans = @{thm tranclp_trans}; wenzelm@26340: val rtrancl_refl = @{thm rtranclp.rtrancl_refl}; wenzelm@26340: val r_into_rtrancl = @{thm r_into_rtranclp}; wenzelm@26340: val trancl_into_rtrancl = @{thm tranclp_into_rtranclp}; wenzelm@26340: val rtrancl_trancl_trancl = @{thm rtranclp_tranclp_tranclp}; wenzelm@26340: val trancl_rtrancl_trancl = @{thm tranclp_rtranclp_tranclp}; wenzelm@26340: val rtrancl_trans = @{thm rtranclp_trans}; berghofe@22262: berghofe@30107: fun decomp (@{const Trueprop} $ t) = berghofe@22262: let fun dec (rel $ a $ b) = berghofe@23743: let fun decr (Const ("Transitive_Closure.rtranclp", _ ) $ r) = (r,"r*") berghofe@23743: | decr (Const ("Transitive_Closure.tranclp", _ ) $ r) = (r,"r+") berghofe@22262: | decr r = (r,"r"); berghofe@22262: val (rel,r) = decr rel; berghofe@26801: in SOME (a, b, rel, r) end berghofe@22262: | dec _ = NONE berghofe@30107: in dec t end berghofe@30107: | decomp _ = NONE; berghofe@22262: berghofe@22262: end); wenzelm@26340: *} berghofe@22262: wenzelm@26340: declaration {* fn _ => wenzelm@26340: Simplifier.map_ss (fn ss => ss wenzelm@26340: addSolver (mk_solver "Trancl" (fn _ => Trancl_Tac.trancl_tac)) wenzelm@26340: addSolver (mk_solver "Rtrancl" (fn _ => Trancl_Tac.rtrancl_tac)) wenzelm@26340: addSolver (mk_solver "Tranclp" (fn _ => Tranclp_Tac.trancl_tac)) wenzelm@26340: addSolver (mk_solver "Rtranclp" (fn _ => Tranclp_Tac.rtrancl_tac))) ballarin@15076: *} ballarin@15076: wenzelm@21589: (* Optional methods *) ballarin@15076: ballarin@15076: method_setup trancl = wenzelm@30549: {* Scan.succeed (K (SIMPLE_METHOD' Trancl_Tac.trancl_tac)) *} wenzelm@18372: {* simple transitivity reasoner *} ballarin@15076: method_setup rtrancl = wenzelm@30549: {* Scan.succeed (K (SIMPLE_METHOD' Trancl_Tac.rtrancl_tac)) *} ballarin@15076: {* simple transitivity reasoner *} berghofe@22262: method_setup tranclp = wenzelm@30549: {* Scan.succeed (K (SIMPLE_METHOD' Tranclp_Tac.trancl_tac)) *} berghofe@22262: {* simple transitivity reasoner (predicate version) *} berghofe@22262: method_setup rtranclp = wenzelm@30549: {* Scan.succeed (K (SIMPLE_METHOD' Tranclp_Tac.rtrancl_tac)) *} berghofe@22262: {* simple transitivity reasoner (predicate version) *} ballarin@15076: nipkow@10213: end