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.
Proof ex_intro (op_is_inv_r 0) 0 op_inv_0_r.
Proof ex_intro (op_is_inv 0) 0 op_inv_0.
Proof
fun x H
=> proj1 H
|| a = 0 @a by <- op_id_l x.
Proof
conj op_inv_0
(fun x H => eq_sym (op_inv_0_eq_0 x H)).
(** Every monoid has a subset of elements that possess inverses. This can be seen by noting that, by definition, every monoid has an identity element (this is what distinguishes a monoid from a semigroup) and the identity element is its own inverse. The following theorems explore the behavior of those elements that possess inverses. They will prove especially ueseful when we consider groups where every element possess an inverse. *)
(** Accepts two arguments: x; and H, a proof that x has an inverse; and returns x's inverse, y, along with a proof that y is x's inverse. *)
Definition op_neg_strong
:  forall x : M, has_inv x -> { y | op_is_inv x y }
:= fun x H
=> constructive_definite_description (op_is_inv x)
(ex_ind
(fun y (H0 : op_is_inv x y)
=> ex_intro
(fun y => op_is_inv x y /\ forall z, op_is_inv x z -> y = z)
y
(conj H0 (fun z H1 => eq_sym (op_inv_uniq x y z H0 H1))))
H).
(** Accepts two arguments: x; and H, a proof that x has an inverse. and returns x's inverse. *)
Definition op_neg
:  forall x : M, has_inv x -> M
:= fun x H => proj1_sig (op_neg_strong x H).
Notation "{-}" := (op_neg) : monoid_scope.
Proof
fun x H
=> proj2_sig (op_neg_strong x H).
Proof
fun x H
=> (proj1 (op_inv_sym x ({-} x H))) (op_neg_def x H).
Proof
fun x H
=> ex_intro
(op_is_inv ({-} x H))
x
(op_neg_inv x H).
Proof
fun x H y H0 H1
=> let H2
:  x + ({-} x H) = y + ({-} x H)
:= (proj2 (op_neg_def x H) : x + ({-} x H) = 0)
|| x + ({-} x H) = a     @a by proj2 (op_neg_def y H0)
|| x + ({-} x H) = y + a @a by H1 in
let H3
:  x = y
:= op_cancel_r x y ({-} x H)
(ex_intro
(op_is_inv_r ({-} x H))
x
(proj2 (proj1 (op_inv_sym x ({-} x H)) (op_neg_def x H))))
H2 in
H3.
Proof
fun x H H0
=> let H1
:  op_is_inv ({-} x H) ({-} ({-} x H) H0)
:= op_neg_def ({-} x H) H0 in
let H3
:  op_is_inv ({-} x H) x
:= op_neg_inv x H in
op_inv_uniq ({-} x H) x ({-} ({-} x H) H0) H3 H1.
Proof
fun x H
=> op_cancel_neg_gen x H (op_neg_inv_ex x H).

(** Proves that negation is onto over the subset of invertable values. *)
Theorem op_neg_onto
:  forall (y : M) (H : has_inv y), exists (x : M) (H0 : has_inv x), {-} x H0 = y.