Theory Smart_Constructors_Normalization

theory Smart_Constructors_Normalization
imports Equivalence_Checking
(* Author: Dmitriy Traytel *)

header {* Normalization of $\Pi$-Extended Regular Expressions*}

(*<*)
theory Smart_Constructors_Normalization
imports Equivalence_Checking
begin
(*>*)

subsection {* Normalizing Constructors *}

lemma not_less_Zero[elim!]: "r < Zero ==> P"
by (induct r) (auto simp: less_rexp_def)

fun nPlus :: "'a::linorder rexp => 'a rexp => 'a rexp"
where
"nPlus Zero r = r"
| "nPlus r Zero = r"
| "nPlus (Plus r1 r2) (Plus s1 s2) =
(if r1 < s1 then Plus r1 (nPlus r2 (Plus s1 s2))
else if s1 < r1 then Plus s1 (nPlus (Plus r1 r2) s2)
else nPlus (Plus r1 r2) s2)"

| "nPlus (Plus r1 r2) s =
(if s = Not Zero then Not Zero
else if r1 < s then Plus r1 (nPlus r2 s)
else if s < r1 then Plus s (Plus r1 r2)
else Plus r1 r2)"

| "nPlus r (Plus s1 s2) =
(if r = Not Zero then Not Zero
else if r < s1 then Plus r (Plus s1 s2)
else if s1 < r then Plus s1 (nPlus r s2)
else Plus s1 s2)"

| "nPlus r s =
(if r = Not Zero ∨ s = Not Zero then Not Zero
else if r < s then Plus r s
else if s < r then Plus s r
else r)"


fun nTimes :: "'a rexp => 'a rexp => 'a rexp"
where
"nTimes Zero _ = Zero"
| "nTimes _ Zero = Zero"
| "nTimes One r = r"
| "nTimes r One = r"
| "nTimes (Times r s) t = Times r (nTimes s t)"
| "nTimes r s = Times r s"

fun nStar :: "'a rexp => 'a rexp"
where
"nStar Zero = One"
| "nStar One = One"
| "nStar (Star r) = nStar r"
| "nStar r = Star r"

fun nInter :: "'a::linorder rexp => 'a rexp => 'a rexp"
where
"nInter Zero _ = Zero"
| "nInter _ Zero = Zero"
| "nInter (Inter r1 r2) (Inter s1 s2) =
(if r1 < s1 then Inter r1 (nInter r2 (Inter s1 s2))
else if s1 < r1 then Inter s1 (nInter (Inter r1 r2) s2)
else nInter (Inter r1 r2) s2)"

| "nInter (Inter r1 r2) s =
(if s = Not Zero then Inter r1 r2
else if r1 < s then Inter r1 (nInter r2 s)
else if s < r1 then Inter s (Inter r1 r2)
else Inter r1 r2)"

| "nInter r (Inter s1 s2) =
(if r = Not Zero then Inter s1 s2
else if r < s1 then Inter r (Inter s1 s2)
else if s1 < r then Inter s1 (nInter r s2)
else Inter s1 s2)"

| "nInter r s =
(if r = Not Zero then s
else if s = Not Zero then r
else if r < s then Inter r s
else if s < r then Inter s r
else r)"


fun nNot :: "'a::linorder rexp => 'a rexp"
where
"nNot (Not r) = r"
| "nNot (Plus r s) = nInter (nNot r) (nNot s)"
| "nNot (Inter r s) = nPlus (nNot r) (nNot s)"
| "nNot r = Not r"

fun nPr :: "'a rexp => 'a rexp"
where
"nPr Zero = Zero"
| "nPr One = One"
| "nPr (Plus r s) = Plus (nPr r) (nPr s)"
| "nPr (Times r s) = Times (nPr r) (nPr s)"
| "nPr (Star r) = Star (nPr r)"
| "nPr r = Pr r"

fun norm :: "('a::linorder) rexp => 'a rexp" where
"norm Zero = Zero"
| "norm One = One"
| "norm (Atom a) = Atom a"
| "norm (Plus r s) = nPlus (norm r) (norm s)"
| "norm (Times r s) = nTimes (norm r) (norm s)"
| "norm (Star r) = nStar (norm r)"
| "norm (Not r) = nNot (norm r)"
| "norm (Inter r s) = nInter (norm r) (norm s)"
| "norm (Pr r) = nPr (norm r)"

context alphabet
begin

lemma wf_nPlus[simp]: "[|wf n r; wf n s|] ==> wf n (nPlus r s)"
by (induct r s rule: nPlus.induct) auto

lemma wf_nTimes[simp]: "[|wf n r; wf n s|] ==> wf n (nTimes r s)"
by (induct r s rule: nTimes.induct) auto

lemma wf_nStar[simp]: "wf n r ==> wf n (nStar r)"
by (induct r rule: nStar.induct) auto

lemma wf_nInter[simp]: "[|wf n r; wf n s|] ==> wf n (nInter r s)"
by (induct r s rule: nInter.induct) auto

lemma wf_nNot[simp]: "wf n r ==> wf n (nNot r)"
by (induct r rule: nNot.induct) auto

lemma wf_nPr[simp]: "wf (Suc n) r ==> wf n (nPr r)"
by (induct r rule: nPr.induct) auto

lemma wf_norm[simp]: "wf n r ==> wf n (norm r)"
by (induct r arbitrary: n) auto

end

context project
begin

lemma Plus_Not_Zero:
"wf n r ==> lang n (Plus (Not Zero) r) = lang n (Not Zero)"
"wf n r ==> lang n (Plus r (Not Zero)) = lang n (Not Zero)"
by (auto dest!: lang_subset_lists)

lemma Inter_Not_Zero:
"wf n r ==> lang n (Inter (Not Zero) r) = lang n r"
"wf n r ==> lang n (Inter r (Not Zero)) = lang n r"
by (auto dest!: lang_subset_lists)

lemma lang_nPlus[simp]: "[|wf n r; wf n s|] ==> lang n (nPlus r s) = lang n (Plus r s)"
by (induct r s rule: nPlus.induct)
(auto, auto dest!: lang_subset_lists dest: project
subsetD[OF conc_subset_lists, unfolded in_lists_conv_set, rotated -1]
subsetD[OF star_subset_lists, unfolded in_lists_conv_set, rotated -1])

lemma lang_nTimes[simp]: "lang n (nTimes r s) = lang n (Times r s)"
by (induct r s rule: nTimes.induct) (auto simp: conc_assoc conc_Un_distrib)

lemma lang_nStar[simp]: "lang n (nStar r) = lang n (Star r)"
by (induct r rule: nStar.induct) auto

lemma lang_nInter[simp]: "[|wf n r; wf n s|] ==> lang n (nInter r s) = lang n (Inter r s)"
by (induct r s rule: nInter.induct)
(auto, auto dest!: lang_subset_lists dest: project
subsetD[OF conc_subset_lists, unfolded in_lists_conv_set, rotated -1]
subsetD[OF star_subset_lists, unfolded in_lists_conv_set, rotated -1])

lemma lang_nNot[simp]: "wf n r ==> lang n (nNot r) = lang n (Not r)"
by (induct r rule: nNot.induct) (auto dest!: lang_subset_lists)

lemma lang_nPr[simp]: "lang n (nPr r) = lang n (Pr r)"
by (induct r rule: nPr.induct) auto

lemma lang_norm[simp]: "wf n r ==> lang n (norm r) = lang n r"
by (induct r arbitrary: n) auto

end
(*
context embed
begin

lemma norm_replicate_Zero[simp]: "norm (PLUS (replicate n Zero)) = Zero"
proof (induct n)
case (Suc n) thus ?case by (cases n) auto
qed simp

lemma nPlus_Zero[simp]: "nPlus r Zero = r"
by (induct r) auto

lemma "norm «r» = norm r"
proof (induct r)
case (Plus r s)
show ?case apply (auto simp: Plus[symmetric] toplevel_summands_ACI_norm)
apply (induct r s rule: nPlus.induct)
apply (auto simp: toplevel_summands_ACI_norm toplevel_summands_flatten_ACI_norm_image_Union)
sorry
qed auto

lemma "norm (lderiv a (norm r)) = norm (lderiv a r)"
proof (induct r)
case (Plus r s) thus ?case sorry
next
case (Times r s) thus ?case sorry
next
case (Star r) thus ?case sorry
next
case (Not r) thus ?case sorry
next
case (Inter r s) thus ?case sorry
next
case (Pr r) thus ?case apply (induct r rule: nPr.induct)
apply (auto simp: Let_def map_replicate_const split: split_if_asm)
qed simp_all

end
*)

end