(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************************)
(*                 The Calculus of Inductive Constructions                  *)
(*                                                                          *)
(*                                Projet Coq                                *)
(*                                                                          *)
(*                     INRIA                        ENS-CNRS                *)
(*              Rocquencourt                        Lyon                    *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              Nov 25th 1994                               *)
(*                                                                          *)
(****************************************************************************)
(*                                 RatReg.v                                 *)
(****************************************************************************)
(*              Formal Language Theory                                      *)
(*                                                                          *)
(*              Judicael Courant - Jean-Christophe Filliatre                *)
(*                                                                          *)
(*              Developped in V5.8  June-July 1993                          *)
(*              Ported     to V5.10 October 1994                            *)
(****************************************************************************)
(************************************************************************)
(*									*)
(*            Un langage reduit a un mot est regulier.			*)
(*									*)
(************************************************************************)
(*  Le mot vide est reconnu par un automate reduit a un etat (zero)	*)
(*  et sans transition.							*)
unfold reconnait at 1 in |- *.
split.
apply inmonoid_nil.
exists zero; exists zero.
auto.
Qed.
(* Seul le mot vide est reconnu par l'automate ci-dessus.		*)
unfold reconnait at 1 in |- *.
simple induction w.
auto.
intros x w0 H H0.
clear H.
elim H0; intros; clear H0.
elim H1; intros; clear H1.
elim H0; intros; clear H0.
elim H1; intros; clear H1.
elim H2; intros; clear H2.
cut
(Chemin x0 x1 (singleton zero) (prodcart empty (prodcart alph empty))
(cons x w0)).
2: auto.
unfold Chemin in |- *; simpl in |- *.
intro H2.
absurd (dans x0 empty).
auto.
elim H2; intros; clear H2.
elim H4; intros; clear H4.
elim H5; intros; clear H5.
elim H6; intros; clear H6.
cut (dans x0 empty /\ dans (couple x x2) (prodcart alph empty)).
2: apply coupl2; assumption.
tauto.
Qed.
(*									*)
(*  Pour pouvoir construire un automate qui reconnait (cons a w) a	*)
(*  partir d'un automate qui reconnait w, il faut un resultat un peu	*)
(*  plus precis que "il existe un automate tel que...".			*)
(*									*)
(*  On precise que cet automate a un unique etat de depart.		*)
(*									*)
exists (singleton zero).
exists zero.
exists (singleton zero).
exists (prodcart empty (prodcart alph empty)).
split.
red in |- *; auto.
red in |- *; split.
red in |- *.
symmetry  in |- *; apply lwordnil_is_reg2.
assumption.
intro.
compute in H.
rewrite <- H.
apply lwordnil_is_reg1.
Qed.
(*  D'ou bien sur...							*)
cut
(exists q : Ensf,
(exists e : Elt,
(exists qa : Ensf,
(exists d : Ensf,
automate q (singleton e) qa d /\
eqwordset (reconnait q (singleton e) qa d) (lword nil))))).
2: apply lwordnil_is_regS; auto.
intro H; elim H; clear H.
intros q H; elim H; clear H.
intros e H; elim H; clear H.
intros qa H; elim H; clear H.
intros d H; elim H; clear H.
intros.
red in |- *.
exists q.
exists (singleton e).
exists qa.
exists d.
auto.
Qed.
(*  Le gros morceau...							*)
(*  On commence par montrer que si on a un chemin pour w alors on	*)
(*  toujours ce chemin en rajoutant un etat et une transition.		*)
simple induction w.
intros.
cut (Chemin e1 e2 q d nil); auto.
intro.
cut (dans e1 q /\ e1 = e2 :>Elt); auto.
intro H1; elim H1; auto.
intros x w0 H e0 e1 e2 e3 a q d H0.
cut (Chemin e1 e2 q d (cons x w0)); auto.
intro.
cut
(exists e : Elt,
chemin e e2 q d w0 /\
dans e1 q /\ dans x alph /\ dans (couple e1 (couple x e)) d);
auto.
intro H2; elim H2; clear H2.
intros e H2; elim H2; clear H2.
intros H2 H3; elim H3; clear H3.
intros H3 H4; elim H4; clear H4.
intros H4 H5.
apply (chemin_cons e e2 (add e0 q) (add (couple e0 (couple a e3)) d) w0 e1 x);
auto.
Qed.
(*  Si un automate reconnait un mot w sans utiliser l'etat e0 alors	*)
(*  l'automate obtenu en supprimant cet etat ainsi que la transition	*)
(*  correspondante reconnait toujours w.				*)
simple induction w.
intros.
cut (Chemin e e2 (add e0 q) (add (couple e0 (couple a e3)) d) nil);
auto.
intro.
cut (dans e (add e0 q) /\ e = e2 :>Elt); auto.
intro H4; elim H4; auto.
intros x w0 H e0 e e2 e3 a q d H0 H1 H2 H3.
cut (Chemin e e2 (add e0 q) (add (couple e0 (couple a e3)) d) (cons x w0));
auto.
intro.
cut
(exists e12 : Elt,
chemin e12 e2 (add e0 q) (add (couple e0 (couple a e3)) d) w0 /\
dans e (add e0 q) /\
dans x alph /\
dans (couple e (couple x e12)) (add (couple e0 (couple a e3)) d));
auto.
intro H5; elim H5; clear H5.
intros e12 H5; elim H5; clear H5.
intros H5 H6; elim H6; clear H6.
intros H6 H7; elim H7; clear H7.
intros H7 H8.
apply (chemin_cons e12 e2 q d w0 e x); auto.
apply (H e0 e12 e2 e3 a q d); auto.
cut
(couple e0 (couple a e3) = couple e (couple x e12) :>Elt \/
dans (couple e (couple x e12)) d).
2: apply dans_add; auto.
intro H9; elim H9; clear H9.
intro H9; injection H9 as H12 H11 H10.
absurd (dans e0 q); auto.
rewrite H12; auto.
intro.
cut (dans (couple e (couple x e12)) (prodcart q (prodcart alph q))).
2: apply
(dans_trans (couple e (couple x e12)) d (prodcart q (prodcart alph q)));
auto.
intro.
cut (dans e q /\ dans (couple x e12) (prodcart alph q)); auto.
2: apply coupl2; auto.
intro H11; elim H11; clear H11.
intros.
cut (dans x alph /\ dans e12 q).
2: apply coupl2; auto.
tauto.
cut
(couple e0 (couple a e3) = couple e (couple x e12) :>Elt \/
dans (couple e (couple x e12)) d).
2: apply dans_add; auto.
intro H9; elim H9; clear H9.
intro H9; injection H9 as H12 H11 H10.
absurd (dans e0 q); auto.
rewrite H12; auto.
auto.
Qed.
(*  Si un automate reconnait w alors en lui rajoutant un etat e0	*)
(*  et la bonne trnasition il reconnait (cons a w).			*)
unfold reconnait in |- *.
intros.
elim H; clear H.
intros H H2; elim H2; clear H2.
intros e12 H2; elim H2; clear H2.
intros e2 H2; elim H2; clear H2.
intros H2 H3.
split; auto.
exists e0.
exists e2.
split; auto.
elim H3; clear H3; intros H3 H4.
split; auto.
cut (e12 = e :>Elt); auto.
intro H5; rewrite <- H5.
apply
(chemin_cons e12 e2 (add e0 q) (add (couple e0 (couple a e12)) d) w e0 a);
auto.
apply extension_qd; auto.
Qed.
(*									*)
(*  Si un automate (q (singleton e) qa d) reconnait exactement {w0}	*)
(*  et si e0 n'est pas dans q alors l'automate ((add e0 q) 		*)
(*  (singleton e0) qa (add (e0,a,e) d)) reconnait exactement		*)
(*  {cons a w0}.							*)
(*									*)
Axiom
auto_cons :
forall (q qa d : Ensf) (e0 e a : Elt) (w0 : Word),
dans a alph ->
automate q (singleton e) qa d ->
eqwordset (reconnait q (singleton e) qa d) (lword w0) ->
~ dans e0 q ->
eqwordset
(reconnait (add e0 q) (singleton e0) qa
(add (couple e0 (couple a e)) d)) (lword (cons a w0)).
(*--- Cette preuve est correcte mais tres longue : on laisse l'axiome... PASSER CETTE PREUVE EN V5.10  Lemma auto_cons : (q,qa,d:Ensf)(e0,e,a:Elt)(w0:Word) (dans a alph) -> (automate q (singleton e) qa d) -> (eqwordset (reconnait q (singleton e) qa d) (lword w0) ) -> ~(dans e0 q) -> (eqwordset (reconnait (add e0 q) (singleton e0) qa (add (couple e0 (couple a e)) d) ) (lword (cons a w0)) ). Goal. Unfold eqwordset. Unfold lword. Intros q qa d e0 e a w0 dans_a_alph H H0 H1 w; Pattern w; Apply induction_word. Split. Intro. Elim H2; Clear H2. Intros H2 H3; Elim H3; Clear H3. Intros e1 H3; Elim H3; Clear H3. Intros e2 H3; Elim H3; Clear H3. Intros H3 H4; Elim H4; Clear H4. Intros. Cut <Elt>e1=e0; Auto. Intro. Elim H. Intros H7 H8. Cut <Elt>e1=e2. 2:Cut (Chemin e1 e2 (add e0 q) (add (couple e0 (couple a e)) d) nil); Auto. 2:Intro; Cut ( (dans e1 (add e0 q)) /\ (<Elt>e1=e2) ); Auto. 2:Intro H10; Elim H10; Auto. Intro H9. Cut (dans e2 q). 2:Apply (dans_trans e2 qa q); Auto. Intro H10. Absurd (dans e0 q); Auto. Rewrite <- H6. Rewrite H9. Assumption.  Intro. Cut False. Apply False_imp_P. Apply (diff_cons_nil a w0); Auto. Apply (diff_cons_nil a w0); Auto.  Intros. Split. Intro H3; Elim H3; Clear H3. Intros H3 H4; Elim H4; Clear H4. Intros e1 H4; Elim H4; Clear H4. Intros e2 H4; Elim H4; Clear H4. Intros H4 H5; Elim H5; Clear H5. Intros H5 H6.   Cut (Chemin e1 e2 (add e0 q) (add (couple e0 (couple a e)) d) (cons x w1)); Auto. Intro H7; Elim H7; Clear H7. Intros e12 H7; Elim H7; Clear H7. Intros H7 H8; Elim H8; Clear H8. Intros H8 H9; Elim H9; Clear H9. Intros H9 H10. Cut <Elt>e1=e0; Auto. Intro H11; Clear H4.  Cut (inclus d (prodcart q (prodcart alph q))). 2:Apply (automate_def1 q (singleton e) qa d); Auto. Intro H12. Cut (<Elt>(couple e0 (couple a e))=(couple e1 (couple x e12)) \/ (dans (couple e1 (couple x e12)) d)). 2:Apply dans_add; Auto. Intro H4; Elim H4; Clear H4.  Intro. Cut <Elt>a=x. Intro. 2:Cut <Elt>(couple a e)=(couple x e12). 2:Intro. 2:Replace a with (first (couple a e)); Auto. 2:Replace x with (first (couple x e12)); Auto. 2:Apply (f_equal Elt Elt); Auto. 2:Replace (couple a e) with (second (couple e0 (couple a e))); Auto. 2:Replace (couple x e12) with (second (couple e1 (couple x e12))); Auto. 2:Apply (f_equal Elt Elt); Auto.  Apply cons_cons; Auto.  2:Intro. 2:Absurd (dans e0 q); Auto. 2:Cut (dans (couple e1 (couple x e12)) (prodcart q (prodcart alph q))). 2:Intro. 3:Apply (dans_trans (couple e1 (couple x e12)) d); Auto. 2:Cut (dans e1 q). 2:Rewrite H11; Auto. 2:Cut ( (dans e1 q) /\ (dans (couple x e12) (prodcart alph q))); Auto. 2:Intro H14; Elim H14; Clear H14. 2:Auto. 2:Apply coupl2; Auto.  Cut <Elt>e12=e. 2:Replace e12 with (second (second (couple e1 (couple x e12)))); Auto. 2:Replace e with (second (second (couple e0 (couple a e)))); Auto. 2:Apply (f_equal Elt Elt). 2:Apply (f_equal Elt Elt); Auto. Intro.  Cut (chemin e e2 (add e0 q) (add (couple e0 (couple a e)) d) w1). 2:Cut (chemin e12 e2 (add e0 q) (add (couple e0 (couple a e)) d) w1); Auto. 2:Rewrite H14; Auto. Clear H7; Intro H7.  Cut (reconnait q (singleton e) qa d w1). Elim (H0 w1). Auto. Unfold reconnait. Split. Apply (inmonoid_cons_inv alph w1 x); Auto. Exists e. Exists e2. Split; Auto. Split; Auto.  Apply (restriction_aut w1 e0 e e2 e a q d ); Auto. Cut (inclus (singleton e) q). Intro; Apply inclus_singl; Auto. Apply (automate_def2 q (singleton e) qa d); Auto.  Intro H3. Cut ((<Elt>a=x)/\(<Word>w0=w1)). 2:Apply cons_cons_inv; Auto. Intro H4; Elim H4; Clear H4. Intros. Rewrite <- H4. Rewrite <- H5.  Apply extension_aut; Auto. Elim (H0 w0). Auto. Save. ----*)
(*									*)
(*  Un langage reduit a un seul mot est regulier. 			*)
(*  A partir d'un automate qui reconnait {w} on rajoute un nouvel etat	*)
(*  (en utilisant le lemme exist_other) et la relation adequate		*)
(*  pour construire un automate reconnaissant {cons a w}.		*)
(*									*)
simple induction w.
intro.
apply lwordnil_is_regS.
intros a w0 H H4.
cut (inmonoid alph w0).
2: apply (inmonoid_cons_inv alph w0 a); auto.
intro H5.
cut
(exists q : Ensf,
(exists e : Elt,
(exists qa : Ensf,
(exists d : Ensf,
automate q (singleton e) qa d /\
eqwordset (reconnait q (singleton e) qa d) (lword w0)))));
auto.
clear H; intro H; elim H; clear H.
intros q H0; elim H0; clear H0.
intros e H0; elim H0; clear H0.
intros qa H0; elim H0; clear H0.
intros d H0; elim H0; clear H0.
intros.
cut (exists e0 : Elt, ~ dans e0 q).
2: apply exist_other; auto.
intro H2; elim H2; clear H2.
intros e0 H2.
exists (add e0 q).
exists e0.
exists qa.
exists (add (couple e0 (couple a e)) d).
elim H; clear H.
intros H H1.
elim H1; clear H1.
intros.
split.
red in |- *.
split; auto.
split; auto.
apply add_inclus.
apply coupl2_inv; auto.
apply coupl2_inv.
apply (inmonoid_cons_inv2 alph a w0); auto.
cut (dans e q); auto.
apply (inclus_trans d (prodcart q (prodcart alph q))); auto.
apply auto_cons; auto.
apply (inmonoid_cons_inv2 alph a w0); auto.
unfold automate in |- *; auto.
Qed.
(*									*)
(*  Finalement, on montre qu'un langage reduit a un mot est regulier : 	*)
(*									*)
unfold isregular in |- *.
intros.
cut
(exists q : Ensf,
(exists e : Elt,
(exists qa : Ensf,
(exists d : Ensf,
automate q (singleton e) qa d /\
eqwordset (reconnait q (singleton e) qa d) (lword w))))).
2: apply lword_is_regS; auto.
intro H0; elim H0; clear H0.
intros q H0; elim H0; clear H0.
intros e H0; elim H0; clear H0.
intros qa H0; elim H0; clear H0.
intros d H0; elim H0; clear H0.
intros H0 H1.
exists q.
exists (singleton e).
exists qa.
exists d.
auto.
Qed.
(************************************************************************)
(*									*)
(*      L'union de 2 langages reguliers est un langage regulier.	*)
(*									*)
(************************************************************************)
(*									*)
(*  A partir d'une relation d1 (partie de q1 x alph x q1) on construit	*)
(*  la relation d1', qui est la meme relation, mais pour les etats	*)
(*  (e,zero) au lieu de e.						*)
(*  De meme pour une relation d2 avec e -> (e,un).			*)
(*									*)
Definition est_dans_d'_2 (d : Ensf) (e y : Elt) : Prop :=
match y return Prop with
| natural n =>
(* natural *)  False (* couple  *)
| couple a e' =>
dans (couple (first e) (couple a (first e'))) d
(* up      *)
| up e => False
(* word    *)
| word w => False
end.
Definition est_dans_d' (d1 : Ensf) (x : Elt) : Prop :=
match x return Prop with
| natural n =>
(* natural *)  False (* couple  *)
| couple e y => est_dans_d'_2 d1 e y
(* up      *)
| up e => False
(* word    *)
| word w => False
end.
Definition injg_d1 (q1 d1 : Ensf) : Ensf :=
tq (est_dans_d' d1)
(prodcart (map injgauche q1) (prodcart alph (map injgauche q1))).
Definition injd_d2 (q2 d2 : Ensf) : Ensf :=
tq (est_dans_d' d2)
(prodcart (map injdroite q2) (prodcart alph (map injdroite q2))).
intros.
apply union_inclus.
apply
inclus_trans
with (prodcart (map injgauche q1) (prodcart alph (map injgauche q1))).
unfold injg_d1 in |- *.
apply inclus_tq.
unfold union_disj in |- *.
auto.
apply
inclus_trans
with (prodcart (map injdroite q2) (prodcart alph (map injdroite q2))).
unfold injd_d2 in |- *.
apply inclus_tq.
unfold union_disj in |- *.
auto.
Qed.
(* 									*)
(*  Deux petits lemmes sur la relation de transition construite		*)
(*  ci-dessus.								*)
(*									*)
intros.
cut
(dans (couple e1 (couple x e)) (injg_d1 q1 d1) \/
dans (couple e1 (couple x e)) (injd_d2 q2 d2)); auto.
intro Ht; elim Ht; clear Ht.
unfold injg_d1 in |- *.
intro.
cut
(dans (couple e1 (couple x e))
(prodcart (map injgauche q1) (prodcart alph (map injgauche q1))) /\
est_dans_d' d1 (couple e1 (couple x e))).
2: apply dans_tq_imp; auto.
intro Ht; elim Ht; clear Ht; intros H2 H3.
cut
(dans e1 (map injgauche q1) /\
dans (couple x e) (prodcart alph (map injgauche q1))).
2: apply coupl2; auto.
intro Ht; elim Ht; clear Ht; intros H4 H5.
cut (dans x alph /\ dans e (map injgauche q1)).
2: apply coupl2; auto.
intro Ht; elim Ht; clear Ht; auto.
unfold injd_d2 in |- *.
intro.
cut
(dans (couple e1 (couple x e))
(prodcart (map injdroite q2) (prodcart alph (map injdroite q2))) /\
est_dans_d' d2 (couple e1 (couple x e))).
2: apply dans_tq_imp; auto.
intro Ht; elim Ht; clear Ht; intros H2 H3.
cut
(dans e1 (map injdroite q2) /\
dans (couple x e) (prodcart alph (map injdroite q2))).
2: apply coupl2; auto.
intro Ht; elim Ht; clear Ht; intros H4 H5.
absurd (dans e1 (map injdroite q2)); auto.
apply absurd_injg_injd with q1; auto.
Qed.

Lemma restriction_transition_d1 :
forall (q1 d1 q2 d2 : Ensf) (e1 x e : Elt),
dans (couple e1 (couple x e)) (union (injg_d1 q1 d1) (injd_d2 q2 d2)) ->
dans e1 (map injgauche q1) ->
dans (couple (first e1) (couple x (first e))) d1.