Closure.thy
changeset 5 074d9a4b2bc9
child 162 e93760534354
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Closure.thy	Tue Oct 19 11:51:05 2010 +0000
@@ -0,0 +1,223 @@
+theory "RegSet"
+  imports "Main" 
+begin
+
+
+text {* Sequential composition of sets *}
+
+definition
+  lang_seq :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ; _" [100,100] 100)
+where 
+  "L1 ; L2 = {s1@s2 | s1 s2. s1 \<in> L1 \<and> s2 \<in> L2}"
+
+
+section {* Kleene star for sets *}
+
+inductive_set
+  Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+  for L :: "string set"
+where
+  start[intro]: "[] \<in> L\<star>"
+| step[intro]:  "\<lbrakk>s1 \<in> L; s2 \<in> L\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> L\<star>"
+
+
+text {* A standard property of star *}
+
+lemma lang_star_cases:
+  shows "L\<star> =  {[]} \<union> L ; L\<star>"
+proof
+  { fix x
+    have "x \<in> L\<star> \<Longrightarrow> x \<in> {[]} \<union> L ; L\<star>"
+      unfolding lang_seq_def
+    by (induct rule: Star.induct) (auto)
+  }
+  then show "L\<star> \<subseteq> {[]} \<union> L ; L\<star>" by auto
+next
+  show "{[]} \<union> L ; L\<star> \<subseteq> L\<star>" 
+    unfolding lang_seq_def by auto
+qed
+
+
+lemma lang_star_cases2:
+  shows "[] \<notin> L \<Longrightarrow> L\<star> - {[]} =  L ; L\<star>"
+by (subst lang_star_cases)
+   (simp add: lang_seq_def)
+
+
+section {* Regular Expressions *}
+
+datatype rexp =
+  NULL
+| EMPTY
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+
+
+section {* Semantics of Regular Expressions *}
+
+fun
+  L :: "rexp \<Rightarrow> string set"
+where
+  "L (NULL) = {}"
+| "L (EMPTY) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+| "L (STAR r) = (L r)\<star>"
+
+abbreviation
+  CUNIV :: "string set"
+where
+  "CUNIV \<equiv> (\<lambda>x. [x]) ` (UNIV::char set)"
+
+lemma CUNIV_star_minus:
+  "(CUNIV\<star> - {[c]}) = {[]} \<union> (CUNIV - {[c]}; (CUNIV\<star>))"
+apply(subst lang_star_cases)
+apply(simp add: lang_seq_def)
+oops
+
+
+lemma string_in_CUNIV:
+  shows "s \<in> CUNIV\<star>"
+proof (induct s)
+  case Nil
+  show "[] \<in> CUNIV\<star>" by (rule start)
+next
+  case (Cons c s)
+  have "[c] \<in> CUNIV" by simp
+  moreover
+  have "s \<in> CUNIV\<star>" by fact
+  ultimately have "[c] @ s \<in> CUNIV\<star>" by (rule step)
+  then show "c # s \<in> CUNIV\<star>" by simp
+qed
+
+lemma UNIV_CUNIV_star: 
+  shows "UNIV = CUNIV\<star>"
+using string_in_CUNIV
+by (auto)
+
+abbreviation 
+  reg :: "string set => bool"
+where
+  "reg L1 \<equiv> (\<exists>r. L r = L1)"
+
+lemma reg_null [intro]:
+  shows "reg {}"
+by (metis L.simps(1))
+
+lemma reg_empty [intro]:
+  shows "reg {[]}"
+by (metis L.simps(2))
+
+lemma reg_star [intro]:
+  shows "reg L1 \<Longrightarrow> reg (L1\<star>)"
+by (metis L.simps(6))
+
+lemma reg_seq [intro]:
+  assumes a: "reg L1" "reg L2"
+  shows "reg (L1 ; L2)"
+using a
+by (metis L.simps(4)) 
+
+lemma reg_union [intro]:
+  assumes a: "reg L1" "reg L2"
+  shows "reg (L1 \<union> L2)"
+using a
+by (metis L.simps(5)) 
+
+lemma reg_string [intro]:
+  fixes s::string
+  shows "reg {s}"
+proof (induct s)
+  case Nil
+  show "reg {[]}" by (rule reg_empty)
+next
+  case (Cons c s)
+  have "reg {s}" by fact
+  then obtain r where "L r = {s}" by auto
+  then have "L (SEQ (CHAR c) r) = {[c]} ; {s}" by simp
+  also have "\<dots> = {c # s}" by (simp add: lang_seq_def)
+  finally show "reg {c # s}" by blast 
+qed
+
+lemma reg_finite [intro]:
+  assumes a: "finite L1"
+  shows "reg L1"
+using a
+proof(induct)
+  case empty
+  show "reg {}" by (rule reg_null)
+next
+  case (insert s S)
+  have "reg {s}" by (rule reg_string)
+  moreover 
+  have "reg S" by fact
+  ultimately have "reg ({s} \<union> S)" by (rule reg_union)
+  then show "reg (insert s S)" by simp
+qed
+  
+lemma reg_cuniv [intro]:
+  shows "reg (CUNIV)"
+by (rule reg_finite) (auto)
+
+lemma reg_univ:
+  shows "reg (UNIV::string set)"
+proof -
+  have "reg CUNIV" by (rule reg_cuniv)
+  then have "reg (CUNIV\<star>)" by (rule reg_star)
+  then show "reg UNIV" by (simp add: UNIV_CUNIV_star)
+qed
+
+lemma reg_finite_subset:
+  assumes a: "finite L1"
+  and     b: "reg L1" "L2 \<subseteq> L1"
+  shows "reg L2"
+using a b
+apply(induct arbitrary: L2)
+apply(simp add: reg_empty)
+oops
+
+
+lemma reg_not:
+  shows "reg (UNIV - L r)"
+proof (induct r)
+  case NULL
+  have "reg UNIV" by (rule reg_univ)
+  then show "reg (UNIV - L NULL)" by simp
+next
+  case EMPTY
+  have "[] \<notin> CUNIV" by auto
+  moreover
+  have "reg (CUNIV; CUNIV\<star>)" by auto
+  ultimately have "reg (CUNIV\<star> - {[]})" 
+    using lang_star_cases2 by simp
+  then show "reg (UNIV - L EMPTY)" by (simp add: UNIV_CUNIV_star)
+next
+  case (CHAR c)
+  then show "?case"
+    apply(simp)
+   
+using reg_UNIV
+apply(simp)
+apply(simp add: char_star2[symmetric])
+apply(rule reg_seq)
+apply(rule reg_cuniv)
+apply(rule reg_star)
+apply(rule reg_cuniv)
+oops
+
+
+
+end    
+   
+
+
+
+  
+
+  
+  
+
+