diff -r b794db0b79db -r b1258b7d2789 Myhill_1.thy --- a/Myhill_1.thy Fri Jun 03 13:59:21 2011 +0000 +++ b/Myhill_1.thy Mon Jul 25 13:33:38 2011 +0000 @@ -1,5 +1,5 @@ theory Myhill_1 -imports Regular +imports More_Regular_Set "~~/src/HOL/Library/While_Combinator" begin @@ -12,12 +12,12 @@ text {* Myhill-Nerode relation *} definition - str_eq_rel :: "lang \ (string \ string) set" ("\_" [100] 100) + str_eq_rel :: "'a lang \ ('a list \ 'a list) set" ("\_" [100] 100) where "\A \ {(x, y). (\z. x @ z \ A \ y @ z \ A)}" definition - finals :: "lang \ lang set" + finals :: "'a lang \ 'a lang set" where "finals A \ {\A `` {s} | s . s \ A}" @@ -37,35 +37,35 @@ text {* The two kinds of terms in the rhs of equations. *} -datatype trm = - Lam "rexp" (* Lambda-marker *) - | Trn "lang" "rexp" (* Transition *) +datatype 'a trm = + Lam "'a rexp" (* Lambda-marker *) + | Trn "'a lang" "'a rexp" (* Transition *) fun - L_trm::"trm \ lang" + lang_trm::"'a trm \ 'a lang" where - "L_trm (Lam r) = L_rexp r" -| "L_trm (Trn X r) = X \ L_rexp r" + "lang_trm (Lam r) = lang r" +| "lang_trm (Trn X r) = X \ lang r" fun - L_rhs::"trm set \ lang" + lang_rhs::"('a trm) set \ 'a lang" where - "L_rhs rhs = \ (L_trm ` rhs)" + "lang_rhs rhs = \ (lang_trm ` rhs)" -lemma L_rhs_set: - shows "L_rhs {Trn X r | r. P r} = \{L_trm (Trn X r) | r. P r}" +lemma lang_rhs_set: + shows "lang_rhs {Trn X r | r. P r} = \{lang_trm (Trn X r) | r. P r}" by (auto) -lemma L_rhs_union_distrib: - fixes A B::"trm set" - shows "L_rhs A \ L_rhs B = L_rhs (A \ B)" +lemma lang_rhs_union_distrib: + fixes A B::"('a trm) set" + shows "lang_rhs A \ lang_rhs B = lang_rhs (A \ B)" by simp text {* Transitions between equivalence classes *} definition - transition :: "lang \ char \ lang \ bool" ("_ \_\_" [100,100,100] 100) + transition :: "'a lang \ 'a \ 'a lang \ bool" ("_ \_\_" [100,100,100] 100) where "Y \c\ X \ Y \ {[c]} \ X" @@ -74,9 +74,9 @@ definition "Init_rhs CS X \ if ([] \ X) then - {Lam EMPTY} \ {Trn Y (CHAR c) | Y c. Y \ CS \ Y \c\ X} + {Lam One} \ {Trn Y (Atom c) | Y c. Y \ CS \ Y \c\ X} else - {Trn Y (CHAR c)| Y c. Y \ CS \ Y \c\ X}" + {Trn Y (Atom c)| Y c. Y \ CS \ Y \c\ X}" definition "Init CS \ {(X, Init_rhs CS X) | X. X \ CS}" @@ -85,10 +85,10 @@ section {* Arden Operation on equations *} fun - Append_rexp :: "rexp \ trm \ trm" + Append_rexp :: "'a rexp \ 'a trm \ 'a trm" where - "Append_rexp r (Lam rexp) = Lam (SEQ rexp r)" -| "Append_rexp r (Trn X rexp) = Trn X (SEQ rexp r)" + "Append_rexp r (Lam rexp) = Lam (Times rexp r)" +| "Append_rexp r (Trn X rexp) = Trn X (Times rexp r)" definition @@ -96,7 +96,7 @@ definition "Arden X rhs \ - Append_rexp_rhs (rhs - {Trn X r | r. Trn X r \ rhs}) (STAR (\ {r. Trn X r \ rhs}))" + Append_rexp_rhs (rhs - {Trn X r | r. Trn X r \ rhs}) (Star (\ {r. Trn X r \ rhs}))" section {* Substitution Operation on equations *} @@ -106,7 +106,7 @@ (rhs - {Trn X r | r. Trn X r \ rhs}) \ (Append_rexp_rhs xrhs (\ {r. Trn X r \ rhs}))" definition - Subst_all :: "(lang \ trm set) set \ lang \ trm set \ (lang \ trm set) set" + Subst_all :: "('a lang \ ('a trm) set) set \ 'a lang \ ('a trm) set \ ('a lang \ ('a trm) set) set" where "Subst_all ES X xrhs \ {(Y, Subst yrhs X xrhs) | Y yrhs. (Y, yrhs) \ ES}" @@ -143,10 +143,10 @@ \ X rhs rhs'. (X, rhs) \ ES \ (X, rhs') \ ES \ rhs = rhs'" definition - "soundness ES \ \(X, rhs) \ ES. X = L_rhs rhs" + "soundness ES \ \(X, rhs) \ ES. X = lang_rhs rhs" definition - "ardenable rhs \ (\ Y r. Trn Y r \ rhs \ [] \ L_rexp r)" + "ardenable rhs \ (\ Y r. Trn Y r \ rhs \ [] \ lang r)" definition "ardenable_all ES \ \(X, rhs) \ ES. ardenable rhs" @@ -223,23 +223,23 @@ lemma trm_soundness: assumes finite:"finite rhs" - shows "L_rhs ({Trn X r| r. Trn X r \ rhs}) = X \ (L_rexp (\{r. Trn X r \ rhs}))" + shows "lang_rhs ({Trn X r| r. Trn X r \ rhs}) = X \ (lang (\{r. Trn X r \ rhs}))" proof - have "finite {r. Trn X r \ rhs}" by (rule finite_Trn[OF finite]) - then show "L_rhs ({Trn X r| r. Trn X r \ rhs}) = X \ (L_rexp (\{r. Trn X r \ rhs}))" - by (simp only: L_rhs_set L_trm.simps) (auto simp add: Seq_def) + then show "lang_rhs ({Trn X r| r. Trn X r \ rhs}) = X \ (lang (\{r. Trn X r \ rhs}))" + by (simp only: lang_rhs_set lang_trm.simps) (auto simp add: conc_def) qed lemma lang_of_append_rexp: - "L_trm (Append_rexp r trm) = L_trm trm \ L_rexp r" + "lang_trm (Append_rexp r trm) = lang_trm trm \ lang r" by (induct rule: Append_rexp.induct) - (auto simp add: seq_assoc) + (auto simp add: conc_assoc) lemma lang_of_append_rexp_rhs: - "L_rhs (Append_rexp_rhs rhs r) = L_rhs rhs \ L_rexp r" + "lang_rhs (Append_rexp_rhs rhs r) = lang_rhs rhs \ lang r" unfolding Append_rexp_rhs_def -by (auto simp add: Seq_def lang_of_append_rexp) +by (auto simp add: conc_def lang_of_append_rexp) subsubsection {* Intial Equational System *} @@ -263,7 +263,7 @@ have "X = \A `` {s @ [c]}" using has_str in_CS defined_by_str by blast then have "Y \ {[c]} \ X" - unfolding Y_def Image_def Seq_def + unfolding Y_def Image_def conc_def unfolding str_eq_rel_def by clarsimp moreover @@ -274,14 +274,14 @@ lemma l_eq_r_in_eqs: assumes X_in_eqs: "(X, rhs) \ Init (UNIV // \A)" - shows "X = L_rhs rhs" + shows "X = lang_rhs rhs" proof - show "X \ L_rhs rhs" + show "X \ lang_rhs rhs" proof fix x assume in_X: "x \ X" { assume empty: "x = []" - then have "x \ L_rhs rhs" using X_in_eqs in_X + then have "x \ lang_rhs rhs" using X_in_eqs in_X unfolding Init_def Init_rhs_def by auto } @@ -291,43 +291,42 @@ using rev_cases by blast have "X \ UNIV // \A" using X_in_eqs unfolding Init_def by auto then obtain Y where "Y \ UNIV // \A" "Y \ {[c]} \ X" "s \ Y" - using decom in_X every_eqclass_has_transition by blast - then have "x \ L_rhs {Trn Y (CHAR c)| Y c. Y \ UNIV // \A \ Y \c\ X}" + using decom in_X every_eqclass_has_transition by metis + then have "x \ lang_rhs {Trn Y (Atom c)| Y c. Y \ UNIV // \A \ Y \c\ X}" unfolding transition_def - using decom by (force simp add: Seq_def) - then have "x \ L_rhs rhs" using X_in_eqs in_X + using decom by (force simp add: conc_def) + then have "x \ lang_rhs rhs" using X_in_eqs in_X unfolding Init_def Init_rhs_def by simp } - ultimately show "x \ L_rhs rhs" by blast + ultimately show "x \ lang_rhs rhs" by blast qed next - show "L_rhs rhs \ X" using X_in_eqs + show "lang_rhs rhs \ X" using X_in_eqs unfolding Init_def Init_rhs_def transition_def by auto qed -lemma test: - assumes X_in_eqs: "(X, rhs) \ Init (UNIV // \A)" - shows "X = \ (L_trm ` rhs)" -using assms l_eq_r_in_eqs by (simp) lemma finite_Init_rhs: + fixes CS::"(('a::finite) lang) set" assumes finite: "finite CS" shows "finite (Init_rhs CS X)" proof- - def S \ "{(Y, c)| Y c. Y \ CS \ Y \ {[c]} \ X}" - def h \ "\ (Y, c). Trn Y (CHAR c)" - have "finite (CS \ (UNIV::char set))" using finite by auto + def S \ "{(Y, c)| Y c::'a. Y \ CS \ Y \ {[c]} \ X}" + def h \ "\ (Y, c::'a). Trn Y (Atom c)" + have "finite (CS \ (UNIV::('a::finite) set))" using finite by auto then have "finite S" using S_def by (rule_tac B = "CS \ UNIV" in finite_subset) (auto) - moreover have "{Trn Y (CHAR c) |Y c. Y \ CS \ Y \ {[c]} \ X} = h ` S" + moreover have "{Trn Y (Atom c) |Y c::'a. Y \ CS \ Y \ {[c]} \ X} = h ` S" unfolding S_def h_def image_def by auto ultimately - have "finite {Trn Y (CHAR c) |Y c. Y \ CS \ Y \ {[c]} \ X}" by auto + have "finite {Trn Y (Atom c) |Y c. Y \ CS \ Y \ {[c]} \ X}" by auto then show "finite (Init_rhs CS X)" unfolding Init_rhs_def transition_def by simp qed + lemma Init_ES_satisfies_invariant: + fixes A::"(('a::finite) lang)" assumes finite_CS: "finite (UNIV // \A)" shows "invariant (Init (UNIV // \A))" proof (rule invariantI) @@ -352,20 +351,20 @@ subsubsection {* Interation step *} lemma Arden_keeps_eq: - assumes l_eq_r: "X = L_rhs rhs" + assumes l_eq_r: "X = lang_rhs rhs" and not_empty: "ardenable rhs" and finite: "finite rhs" - shows "X = L_rhs (Arden X rhs)" + shows "X = lang_rhs (Arden X rhs)" proof - - def A \ "L_rexp (\{r. Trn X r \ rhs})" + def A \ "lang (\{r. Trn X r \ rhs})" def b \ "{Trn X r | r. Trn X r \ rhs}" - def B \ "L_rhs (rhs - b)" + def B \ "lang_rhs (rhs - b)" have not_empty2: "[] \ A" using finite_Trn[OF finite] not_empty unfolding A_def ardenable_def by simp - have "X = L_rhs rhs" using l_eq_r by simp - also have "\ = L_rhs (b \ (rhs - b))" unfolding b_def by auto - also have "\ = L_rhs b \ B" unfolding B_def by (simp only: L_rhs_union_distrib) + have "X = lang_rhs rhs" using l_eq_r by simp + also have "\ = lang_rhs (b \ (rhs - b))" unfolding b_def by auto + also have "\ = lang_rhs b \ B" unfolding B_def by (simp only: lang_rhs_union_distrib) also have "\ = X \ A \ B" unfolding b_def unfolding trm_soundness[OF finite] @@ -374,24 +373,24 @@ finally have "X = X \ A \ B" . then have "X = B \ A\" by (simp add: arden[OF not_empty2]) - also have "\ = L_rhs (Arden X rhs)" + also have "\ = lang_rhs (Arden X rhs)" unfolding Arden_def A_def B_def b_def - by (simp only: lang_of_append_rexp_rhs L_rexp.simps) - finally show "X = L_rhs (Arden X rhs)" by simp + by (simp only: lang_of_append_rexp_rhs lang.simps) + finally show "X = lang_rhs (Arden X rhs)" by simp qed lemma Append_keeps_finite: "finite rhs \ finite (Append_rexp_rhs rhs r)" -by (auto simp:Append_rexp_rhs_def) +by (auto simp: Append_rexp_rhs_def) lemma Arden_keeps_finite: "finite rhs \ finite (Arden X rhs)" -by (auto simp:Arden_def Append_keeps_finite) +by (auto simp: Arden_def Append_keeps_finite) lemma Append_keeps_nonempty: "ardenable rhs \ ardenable (Append_rexp_rhs rhs r)" -apply (auto simp:ardenable_def Append_rexp_rhs_def) -by (case_tac x, auto simp:Seq_def) +apply (auto simp: ardenable_def Append_rexp_rhs_def) +by (case_tac x, auto simp: conc_def) lemma nonempty_set_sub: "ardenable rhs \ ardenable (rhs - A)" @@ -411,24 +410,25 @@ by (simp only: Subst_def Append_keeps_nonempty nonempty_set_union nonempty_set_sub) lemma Subst_keeps_eq: - assumes substor: "X = L_rhs xrhs" + assumes substor: "X = lang_rhs xrhs" and finite: "finite rhs" - shows "L_rhs (Subst rhs X xrhs) = L_rhs rhs" (is "?Left = ?Right") + shows "lang_rhs (Subst rhs X xrhs) = lang_rhs rhs" (is "?Left = ?Right") proof- - def A \ "L_rhs (rhs - {Trn X r | r. Trn X r \ rhs})" - have "?Left = A \ L_rhs (Append_rexp_rhs xrhs (\{r. Trn X r \ rhs}))" + def A \ "lang_rhs (rhs - {Trn X r | r. Trn X r \ rhs})" + have "?Left = A \ lang_rhs (Append_rexp_rhs xrhs (\{r. Trn X r \ rhs}))" unfolding Subst_def - unfolding L_rhs_union_distrib[symmetric] + unfolding lang_rhs_union_distrib[symmetric] by (simp add: A_def) - moreover have "?Right = A \ L_rhs {Trn X r | r. Trn X r \ rhs}" + moreover have "?Right = A \ lang_rhs {Trn X r | r. Trn X r \ rhs}" proof- have "rhs = (rhs - {Trn X r | r. Trn X r \ rhs}) \ ({Trn X r | r. Trn X r \ rhs})" by auto thus ?thesis unfolding A_def - unfolding L_rhs_union_distrib + unfolding lang_rhs_union_distrib by simp qed - moreover have "L_rhs (Append_rexp_rhs xrhs (\{r. Trn X r \ rhs})) = L_rhs {Trn X r | r. Trn X r \ rhs}" + moreover + have "lang_rhs (Append_rexp_rhs xrhs (\{r. Trn X r \ rhs})) = lang_rhs {Trn X r | r. Trn X r \ rhs}" using finite substor by (simp only: lang_of_append_rexp_rhs trm_soundness) ultimately show ?thesis by simp qed @@ -441,8 +441,8 @@ assumes finite: "finite ES" shows "finite (Subst_all ES Y yrhs)" proof - - def eqns \ "{(X::lang, rhs) |X rhs. (X, rhs) \ ES}" - def h \ "\(X::lang, rhs). (X, Subst rhs Y yrhs)" + def eqns \ "{(X::'a lang, rhs) |X rhs. (X, rhs) \ ES}" + def h \ "\(X::'a lang, rhs). (X, Subst rhs Y yrhs)" have "finite (h ` eqns)" using finite h_def eqns_def by auto moreover have "Subst_all ES Y yrhs = h ` eqns" unfolding h_def eqns_def Subst_all_def by auto @@ -456,24 +456,24 @@ lemma append_rhs_keeps_cls: "rhss (Append_rexp_rhs rhs r) = rhss rhs" -apply (auto simp:rhss_def Append_rexp_rhs_def) -apply (case_tac xa, auto simp:image_def) -by (rule_tac x = "SEQ ra r" in exI, rule_tac x = "Trn x ra" in bexI, simp+) +apply (auto simp: rhss_def Append_rexp_rhs_def) +apply (case_tac xa, auto simp: image_def) +by (rule_tac x = "Times ra r" in exI, rule_tac x = "Trn x ra" in bexI, simp+) lemma Arden_removes_cl: "rhss (Arden Y yrhs) = rhss yrhs - {Y}" apply (simp add:Arden_def append_rhs_keeps_cls) -by (auto simp:rhss_def) +by (auto simp: rhss_def) lemma lhss_keeps_cls: "lhss (Subst_all ES Y yrhs) = lhss ES" -by (auto simp:lhss_def Subst_all_def) +by (auto simp: lhss_def Subst_all_def) lemma Subst_updates_cls: "X \ rhss xrhs \ rhss (Subst rhs X xrhs) = rhss rhs \ rhss xrhs - {X}" apply (simp only:Subst_def append_rhs_keeps_cls rhss_union_distrib) -by (auto simp:rhss_def) +by (auto simp: rhss_def) lemma Subst_all_keeps_validity: assumes sc: "validity (ES \ {(Y, yrhs)})" (is "validity ?A") @@ -490,17 +490,17 @@ moreover have "rhss xrhs' \ lhss ES" proof- have "rhss xrhs' \ rhss xrhs \ rhss (Arden Y yrhs) - {Y}" - proof- + proof - have "Y \ rhss (Arden Y yrhs)" - using Arden_removes_cl by simp - thus ?thesis using xrhs_xrhs' by (auto simp:Subst_updates_cls) + using Arden_removes_cl by auto + thus ?thesis using xrhs_xrhs' by (auto simp: Subst_updates_cls) qed moreover have "rhss xrhs \ lhss ES \ {Y}" using X_in sc apply (simp only:validity_def lhss_union_distrib) by (drule_tac x = "(X, xrhs)" in bspec, auto simp:lhss_def) moreover have "rhss (Arden Y yrhs) \ lhss ES \ {Y}" using sc - by (auto simp add:Arden_removes_cl validity_def lhss_def) + by (auto simp add: Arden_removes_cl validity_def lhss_def) ultimately show ?thesis by auto qed ultimately show ?thesis by simp @@ -512,7 +512,7 @@ assumes invariant_ES: "invariant (ES \ {(Y, yrhs)})" shows "invariant (Subst_all ES Y (Arden Y yrhs))" proof (rule invariantI) - have Y_eq_yrhs: "Y = L_rhs yrhs" + have Y_eq_yrhs: "Y = lang_rhs yrhs" using invariant_ES by (simp only:invariant_def soundness_def, blast) have finite_yrhs: "finite yrhs" using invariant_ES by (auto simp:invariant_def finite_rhs_def) @@ -520,7 +520,7 @@ using invariant_ES by (auto simp:invariant_def ardenable_all_def) show "soundness (Subst_all ES Y (Arden Y yrhs))" proof - - have "Y = L_rhs (Arden Y yrhs)" + have "Y = lang_rhs (Arden Y yrhs)" using Y_eq_yrhs invariant_ES finite_yrhs using finite_Trn[OF finite_yrhs] apply(rule_tac Arden_keeps_eq) @@ -530,7 +530,7 @@ done thus ?thesis using invariant_ES unfolding invariant_def finite_rhs_def2 soundness_def Subst_all_def - by (auto simp add: Subst_keeps_eq simp del: L_rhs.simps) + by (auto simp add: Subst_keeps_eq simp del: lang_rhs.simps) qed show "finite (Subst_all ES Y (Arden Y yrhs))" using invariant_ES by (simp add:invariant_def Subst_all_keeps_finite) @@ -557,13 +557,13 @@ proof - have "finite yrhs" using invariant_ES by (auto simp:invariant_def finite_rhs_def) - thus ?thesis using Arden_keeps_finite by simp + thus ?thesis using Arden_keeps_finite by auto qed ultimately show ?thesis by (simp add:Subst_all_keeps_finite_rhs) qed show "validity (Subst_all ES Y (Arden Y yrhs))" - using invariant_ES Subst_all_keeps_validity by (simp add:invariant_def) + using invariant_ES Subst_all_keeps_validity by (auto simp add: invariant_def) qed lemma Remove_in_card_measure: @@ -571,7 +571,7 @@ and in_ES: "(X, rhs) \ ES" shows "(Remove ES X rhs, ES) \ measure card" proof - - def f \ "\ x. ((fst x)::lang, Subst (snd x) X (Arden X rhs))" + def f \ "\ x. ((fst x)::'a lang, Subst (snd x) X (Arden X rhs))" def ES' \ "ES - {(X, rhs)}" have "Subst_all ES' X (Arden X rhs) = f ` ES'" apply (auto simp: Subst_all_def f_def image_def) @@ -674,6 +674,7 @@ subsubsection {* Conclusion of the proof *} lemma Solve: + fixes A::"('a::finite) lang" assumes fin: "finite (UNIV // \A)" and X_in: "X \ (UNIV // \A)" shows "\rhs. Solve X (Init (UNIV // \A)) = {(X, rhs)} \ invariant {(X, rhs)}" @@ -714,9 +715,10 @@ qed lemma every_eqcl_has_reg: + fixes A::"('a::finite) lang" assumes finite_CS: "finite (UNIV // \A)" and X_in_CS: "X \ (UNIV // \A)" - shows "\r. X = L_rexp r" + shows "\r. X = lang r" proof - from finite_CS X_in_CS obtain xrhs where Inv_ES: "invariant {(X, xrhs)}" @@ -735,14 +737,14 @@ using Arden_keeps_finite by auto then have fin: "finite {r. Lam r \ A}" by (rule finite_Lam) - have "X = L_rhs xrhs" using Inv_ES unfolding invariant_def soundness_def + have "X = lang_rhs xrhs" using Inv_ES unfolding invariant_def soundness_def by simp - then have "X = L_rhs A" using Inv_ES + then have "X = lang_rhs A" using Inv_ES unfolding A_def invariant_def ardenable_all_def finite_rhs_def by (rule_tac Arden_keeps_eq) (simp_all add: finite_Trn) - then have "X = L_rhs {Lam r | r. Lam r \ A}" using eq by simp - then have "X = L_rexp (\{r. Lam r \ A})" using fin by auto - then show "\r. X = L_rexp r" by blast + then have "X = lang_rhs {Lam r | r. Lam r \ A}" using eq by simp + then have "X = lang (\{r. Lam r \ A})" using fin by auto + then show "\r. X = lang r" by blast qed lemma bchoice_finite_set: @@ -756,20 +758,21 @@ done theorem Myhill_Nerode1: + fixes A::"('a::finite) lang" assumes finite_CS: "finite (UNIV // \A)" - shows "\r. A = L_rexp r" + shows "\r. A = lang r" proof - have fin: "finite (finals A)" using finals_in_partitions finite_CS by (rule finite_subset) - have "\X \ (UNIV // \A). \r. X = L_rexp r" + have "\X \ (UNIV // \A). \r. X = lang r" using finite_CS every_eqcl_has_reg by blast - then have a: "\X \ finals A. \r. X = L_rexp r" + then have a: "\X \ finals A. \r. X = lang r" using finals_in_partitions by auto - then obtain rs::"rexp set" where "\ (finals A) = \(L_rexp ` rs)" "finite rs" + then obtain rs::"('a rexp) set" where "\ (finals A) = \(lang ` rs)" "finite rs" using fin by (auto dest: bchoice_finite_set) - then have "A = L_rexp (\rs)" + then have "A = lang (\rs)" unfolding lang_is_union_of_finals[symmetric] by simp - then show "\r. A = L_rexp r" by blast + then show "\r. A = lang r" by blast qed