Section APD.
Variable X V R : Ensf.
Variable S' : Elt.
Hypothesis Gram : isGram X V R S'.
apply isGram4 with S'.
exact Gram.
Qed.
Let P := union X V.
Let f_R_d (a : Elt) :=
couple (word (cons (first a) nil)) (couple (eps X) (second a)).
Let f_X_d (x : Elt) := couple (word (cons x nil)) (couple x (word nil)).
Let d := union (map f_R_d R) (map f_X_d X).
Let wd := cons S' nil.
Let wa := nil.
red in |- *.
intros x dans_x_d.
elimtype (dans x (map f_R_d R) \/ dans x (map f_X_d X)).
intros dans_x.
elimtype (exists y : Elt, dans y R /\ x = f_R_d y).
intros y temp; elim temp; clear temp.
unfold f_R_d in |- *.
intros dans_y_R eg_x_f_y.
exists (cons (first y) nil).
apply inmonoid_cons.
trivial.
elim (Regles_X_V_R y dans_y_R).
intros f_y dans_f_y_V temp; elim temp; clear temp.
intros u eg_y inmono_u.
rewrite eg_y.
unfold first in |- *.
unfold P in |- *.
auto.
exists (eps X).
auto.
exists (word_inv (second y)).
elim (Regles_X_V_R y dans_y_R).
intros f_y dans_f_y_V temp; elim temp; clear temp.
intros u eg_y inmono_u.
rewrite eg_y.
unfold second in |- *.
unfold word_inv in |- *.
assumption.
elim (Regles_X_V_R y dans_y_R).
intros f_y dans_f_y_V temp; elim temp; clear temp.
intros u eg_y inmono_u.
replace (word (word_inv (second y))) with (second y).
assumption.
replace (second y) with (word u).
apply refl_equal.
rewrite eg_y.
apply refl_equal.
apply dans_map.
assumption.
intros dans_x.
elimtype (exists y : Elt, dans y X /\ x = f_X_d y).
intros y temp; elim temp; clear temp.
unfold f_X_d in |- *.
intros dans_y_X eg_x_f_y.
exists (cons y nil).
apply inmonoid_cons.
trivial.
unfold P in |- *.
auto.
exists y.
auto.
exists nil.
trivial.
assumption.
apply dans_map.
assumption.
auto.
Qed.
red in |- *.
split.
unfold wd in |- *.
apply inmonoid_cons.
trivial.
unfold P in |- *.
apply union_d.
apply isGram3 with X R.
exact Gram.
split.
apply inmonoid_nil.
exact Trans.
Qed.
intro u.
pattern u in |- *.
apply Word_rec.
exists nil.
exists nil.
auto.
intros x w Hyp.
elim Hyp.
intros a' spec; elim spec.
intros b' temp; elim temp; clear temp.
intros inmonoid_a' temp; elim temp; clear temp.
intros spec_App spec_or.
elimtype ({dans x X} + {~ dans x X}).
intro dans_x_X.
exists (cons x a').
exists b'.
split.
apply inmonoid_cons; assumption.
split.
unfold Append in |- *.
simpl in |- *.
auto.
elim spec_or; intro; assumption.
intro N_dans_x_X.
exists nil.
exists (cons x w).
split.
auto.
split.
auto.
apply or_intror.
exists x.
assumption.
exists w.
apply refl_equal.
exact (Dans_spec x X).
Qed.
Definition cut (u : Word) :=
let (a, s) := cut_spec u in (a, let (b, s2) := s in b).
Definition cut1 (u : Word) := fst (cut u).
Definition cut2 (u : Word) := snd (cut u).
intros u a b a' b' temp1 temp2; elim temp1; elim temp2; clear temp1;
clear temp2.
intros inmon temp inmon' temp'; elim temp; elim temp'; clear temp;
clear temp'.
intros App spec_or App' spec_or'.
elimtype
(exists w : Word,
a = Append a' w /\ b' = Append w b \/ a' = Append a w /\ b = Append w b').
intros x temp; elim temp; clear temp.
pattern a' at 2 in |- *.
replace a' with (Append a' nil).
generalize x; clear x; simple induction x.
intro temp; elim temp.
auto.
intros x0 w Hyp temp; elim temp; clear temp.
intros a_eg b'_eg.
absurd (dans x0 X).
elim spec_or'.
rewrite b'_eg.
intro cons_nil.
absurd (cons x0 (Append w b) = nil).
discriminate.
assumption.
intro temp; elim temp; clear temp.
intros x1 N_dans_x1 temp; elim temp; clear temp.
intros w' b'_eg_2.
replace x0 with x1.
assumption.
apply cons_cons_inv1 with w' (Append w b).
rewrite <- b'_eg_2.
assumption.
apply inmonoid_cons_inv2 with w.
apply inmonoid_Append_inv2 with a'.
rewrite <- a_eg.
assumption.
apply Append_w_nil.
pattern a at 2 in |- *.
replace a with (Append a nil).
generalize x; clear x; simple induction x.
intro temp; elim temp.
auto.
intros x0 w Hyp temp; elim temp; clear temp.
intros a'_eg b_eg.
absurd (dans x0 X).
elim spec_or.
rewrite b_eg.
intro cons_nil.
absurd (cons x0 (Append w b') = nil).
discriminate.
assumption.
intro temp; elim temp; clear temp.
intros x1 N_dans_x1 temp; elim temp; clear temp.
intros w' b_eg_2.
replace x0 with x1.
assumption.
apply cons_cons_inv1 with w' (Append w b').
rewrite <- b_eg_2.
assumption.
apply inmonoid_cons_inv2 with w.
apply inmonoid_Append_inv2 with a.
rewrite <- a'_eg.
assumption.
apply Append_w_nil.
apply Append_Append.
rewrite App'; assumption.
Qed.
intro w.
unfold cut1, cut in |- *.
elim (cut_spec w).
intros a temp; elim temp; clear temp.
intros b temp; elim temp; clear temp.
simpl in |- *; auto.
Qed.
intro w.
unfold cut1, cut2, cut in |- *.
elim (cut_spec w).
intros a temp; elim temp; clear temp.
intros b temp; elim temp; clear temp.
intros inm temp; elim temp.
simpl in |- *; auto.
Qed.
intros a w dans_a_X.
unfold cut1, cut in |- *.
elim (cut_spec w).
intros x temp; elim temp; clear temp.
intros b temp; elim temp; clear temp.
intros inmon_X_x temp; elim temp; clear temp.
elim (cut_spec (cons a w)).
intros x' temp; elim temp; clear temp.
intros b' temp; elim temp; clear temp.
intros inmon_X_x' temp; elim temp; clear temp.
intros App_eg' spec' App_eg spec.
simpl in |- *.
cut (inmonoid X x').
cut (Append x' b' = cons a w).
clear inmon_X_x' App_eg'.
generalize x'; clear x'; simple induction x'.
intro App_nil_b'_eg_cons_a_w.
absurd (dans a X).
elim spec'.
intro b'_nil.
absurd (cons a w = nil).
discriminate.
rewrite <- b'_nil.
rewrite <- App_nil_b'_eg_cons_a_w.
trivial.
intro temp; elim temp; clear temp.
intros x0 N_dans_x0_X temp; elim temp; clear temp.
intros w1 eg_b'_cons.
replace a with x0.
assumption.
apply cons_cons_inv1 with w1 w.
rewrite <- eg_b'_cons.
assumption.
assumption.
intros x0 w0 Hyp App_eg_cons inmon_cons.
apply cons_cons.
apply cons_cons_inv1 with (Append w0 b') w.
assumption.
apply cut_unicite with w b' b.
split.
apply inmonoid_cons_inv with x0; assumption.
split.
apply cons_cons_inv2 with x0 a.
assumption.
assumption.
split; auto.
assumption.
assumption.
Qed.
intros u v.
generalize u; clear u; simple induction u.
auto.
intros x w Hyp inmon_x_w.
replace (cut1 (Append (cons x w) v)) with (cons x (cut1 (Append w v))).
replace (Append (cons x w) (cut1 v)) with (cons x (Append w (cut1 v))).
apply cons_cons.
trivial.
apply Hyp.
apply inmonoid_cons_inv with x; assumption.
trivial.
apply sym_equal.
unfold Append in |- *.
simpl in |- *.
apply cut1_cons.
apply inmonoid_cons_inv2 with w.
trivial.
Qed.
Axiom
cut2_cons :
forall (A : Elt) (v : Word), dans A X -> cut2 (cons A v) = cut2 v.
intros A v N_dans_A_X.
unfold cut2, cut in |- *.
elim (cut_spec (cons A v)).
intros a temp; elim temp; clear temp.
intros b temp; elim temp; clear temp.
intros inmon_a temp; elim temp; clear temp.
intros App_eg spec_or.
cut (inmonoid X a).
cut (Append a b = cons A v).
clear App_eg inmon_a.
generalize a; clear a; simple induction a.
auto.
intros x w Hyp App_eg_x_w inmon.
absurd (dans A X).
assumption.
replace A with x.
apply inmonoid_cons_inv2 with w.
assumption.
apply cons_cons_inv1 with (Append w b) v.
assumption.
assumption.
assumption.
Qed.

Lemma Deriveg_imp_Deriveg_cut :
forall x y : Word,
Deriveg X R x y ->
ex2 (fun w : Word => Append (cut1 x) w = y)
(fun w : Word => Deriveg X R (cut2 x) w).