Section FreeGroups.
Variable generators: Type.
Hypothesis generator_eq_dec: forall g1 g2:generators,
{ g1=g2 } + { g1<>g2 }.
Inductive alphabet: Type :=
| intro_gen: generators -> alphabet
| intro_gen_inv: generators -> alphabet.
Definition group_str := list alphabet.
Definition opposite (letter:alphabet) :=
match letter with
| intro_gen a => intro_gen_inv a
| intro_gen_inv a => intro_gen a
end.
Inductive non_reduced: group_str -> Prop :=
| intro_letter_inverse: forall (S T: group_str) (a: alphabet),
non_reduced (S ++ (opposite a) :: a :: T).
Definition reduced (S: group_str) : Prop :=
not (non_reduced S).
Definition alphabet_eq_dec: forall a b:alphabet,
{a=b} + {a<>b}.
intros.
decide equality.
Qed.
(* define the left action of each letter on the set of reduced words *)
Definition letter_action (a:alphabet) (S:group_str) : group_str :=
match S with
| nil => a :: nil
| b :: S0 => (if alphabet_eq_dec a (opposite b) then S0
else a :: b :: S0)
end.
Fixpoint group_str_action (S T:group_str) :=
match S with
| nil => T
| a :: S0 => letter_action a (group_str_action S0 T)
end.
Definition reduction (S:group_str) :=
group_str_action S nil.
(* define two strings to be equivalent if one can be reached from the other by a sequence of inserting or deleting opposite pairs *)
Inductive group_str_equiv : group_str -> group_str -> Prop :=
| insert_opposite_pair: forall (S T:group_str) (a:alphabet),
group_str_equiv (S ++ T) (S ++ opposite a :: a :: T)
| group_str_equiv_refl: forall S:group_str, group_str_equiv S S
| group_str_equiv_sym: forall S T:group_str,
group_str_equiv S T -> group_str_equiv T S
| group_str_equiv_trans: forall S T U:group_str,
group_str_equiv S T -> group_str_equiv T U ->
group_str_equiv S U.
Notation "S ~~ T" := (group_str_equiv S T) (at level 80).
Add Parametric Relation: group_str group_str_equiv
reflexivity proved by group_str_equiv_refl
symmetry proved by group_str_equiv_sym
transitivity proved by group_str_equiv_trans
as group_str_equiv_rel.
Add Parametric Morphism: (@cons alphabet) with signature
(@eq alphabet) ==> (group_str_equiv) ==> (group_str_equiv) as
cons_group_str_mor.
Add Parametric Morphism: (@app alphabet) with signature
(group_str_equiv) ==> (group_str_equiv) ==> (group_str_equiv) as
concat_mor.
Add Parametric Morphism: reduction with signature
(group_str_equiv) ==> (@eq group_str) as reduction_mor.
Definition reduced_string_product (S1 S2:group_str) : group_str :=
reduction (S1 ++ S2).

Lemma empty_str_is_right_id: forall S:group_str, reduced S ->
reduced_string_product S nil = S.