Section Theorems.
(** Represents an arbitrary monoid.  Note: we use Variable rather than Parameter to ensure that the following theorems are generalized w.r.t m. *)
Variable m : Monoid.
(** Represents the set of monoid elements. *)
Let M := E m.
(** Accepts one monoid element, x, and asserts that x is the left identity element. *)
Definition op_is_id_l := is_id_l M {+}.
(** Accepts one monoid element, x, and asserts that x is the right identity element. *)
Definition op_is_id_r := is_id_r M {+}.
(** Accepts one monoid element, x, and asserts that x is the identity element. *)
Definition op_is_id := is_id M {+}.
Proof conj op_id_l op_id_r.
Proof
fun x H
=> H 0 || a = 0 @a by <- op_id_r x.
Proof
fun x H
=> H 0 || a = 0 @a by <- op_id_l x.
Proof
fun x
=> and_ind (fun H _ => op_id_l_uniq x H).
Proof
fun x y z H
=> f_equal ({+} z) H.
Proof
fun x y z H
=>  eq_refl (x + z)
|| x + z = a + z @a by <- H.
(** Accepts two monoid elements, x and y, and asserts  that y is x's left inverse. *)
Definition op_is_inv_l := is_inv_l M {+} 0 op_id.
(** Accepts two monoid elements, x and y, and asserts  that y is x's right inverse. *)
Definition op_is_inv_r := is_inv_r M {+} 0 op_id.
(** Accepts two monoid elements, x and y, and asserts  that y is x's inverse. *)
Definition op_is_inv := is_inv M {+} 0 op_id.
(** Accepts one argument, x, and asserts that x has a left inverse. *)
Definition has_inv_l
:= fun x => exists y : M, op_is_inv_l x y.
(** Accepts one argument, x, and asserts that x has a right inverse. *)
Definition has_inv_r
:= fun x => exists y : M, op_is_inv_r x y.
(** Accepts one argument, x, and asserts that x has an inverse. *)
Definition has_inv
:= fun x => exists y : M, op_is_inv x y.
Proof
fun x y H1 z H2
=> op_is_assoc y x z
|| y + a = (y + x) + z @a by <- H2
|| a = (y + x) + z     @a by <- op_id_r y
|| y = a + z           @a by <- H1
|| y = a               @a by <- op_id_l z.
Proof
fun x y
=> conj
(fun H : op_is_inv x y
=> conj (proj2 H) (proj1 H))
(fun H : op_is_inv y x
=> conj (proj2 H) (proj1 H)).
(** The next few lemmas define special cases where cancellation holds and culminate in the Unique Inverse theorem which asserts that, in a Monoid, every value has at most one inverse. *)
Proof
fun x y z H H0
=> ex_ind
(fun u H1
=> op_intro_l (z + x) (z + y) u H0
|| a = u + (z + y) @a by <- op_is_assoc u z x
|| (u + z) + x = a @a by <- op_is_assoc u z y
|| a + x = a + y   @a by <- H1
|| a = 0 + y       @a by <- op_id_l x
|| x = a           @a by <- op_id_l y)
H.
Proof
fun x y z H H0
=> ex_ind
(fun u H1
=>  op_intro_r (x + z) (y + z) u H0
|| a = (y + z) + u @a by op_is_assoc x z u
|| x + (z + u) = a @a by op_is_assoc y z u
|| x + a = y + a   @a by <- H1
|| a = y + 0       @a by <- op_id_r x
|| x = a           @a by <- op_id_r y)
H.
Proof
fun x H y z H0 H1
=> let H2
:  z + x = y + x
:= H1 || z + x = a @a by H0 in
let H3
:  z = y
:= op_cancel_r z y x H H2 in
H3.
Proof
fun x H y z H0 H1
=> let H2
:  x + z = x + y
:= H1 || x + z = a @a by H0 in
let H3
:  z = y
:= op_cancel_l z y x H H2 in
H3.
Proof
fun x y z H H0
=> op_inv_l_uniq x
(ex_intro (fun y => op_is_inv_r x y) y (proj2 H))
y z (proj1 H) (proj1 H0).
Proof op_id_l 0 : 0 + 0 = 0.
Proof op_id_r 0 : 0 + 0 = 0.
Proof conj op_inv_0_l op_inv_0_r.
Proof ex_intro (op_is_inv_l 0) 0 op_inv_0_l.

(** Proves that the identity element has a right inverse. *)
Theorem op_has_inv_r_0
:  has_inv_r 0.