/-
Copyright (c) 2021 Praneeth Kolichala. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Praneeth Kolichala
-/
import topology.constructions
import topology.homotopy.path

/-!
# Product of homotopies

In this file, we introduce definitions for the product of
homotopies. We show that the products of relative homotopies
are still relative homotopies. Finally, we specialize to the case
of path homotopies, and provide the definition for the product of path classes.
We show various lemmas associated with these products, such as the fact that
path products commute with path composition, and that projection is the inverse
of products.

## Definitions
### General homotopies
- `continuous_map.homotopy.pi homotopies`: Let f and g be a family of functions
  indexed on I, such that for each i ∈ I, fᵢ and gᵢ are maps from A to Xᵢ.
  Let `homotopies` be a family of homotopies from fᵢ to gᵢ for each i.
  Then `homotopy.pi homotopies` is the canonical homotopy
  from ∏ f to ∏ g, where ∏ f is the product map from A to Πi, Xᵢ,
  and similarly for ∏ g.

- `continuous_map.homotopy_rel.pi homotopies`: Same as `continuous_map.homotopy.pi`, but
  all homotopies are done relative to some set S ⊆ A.

- `continuous_map.homotopy.prod F G` is the product of homotopies F and G,
   where F is a homotopy between f₀ and f₁, G is a homotopy between g₀ and g₁.
   The result F × G is a homotopy between (f₀ × g₀) and (f₁ × g₁).
   Again, all homotopies are done relative to S.

- `continuous_map.homotopy_rel.prod F G`: Same as `continuous_map.homotopy.prod`, but
  all homotopies are done relative to some set S ⊆ A.

### Path products
- `path.homotopic.pi` The product of a family of path classes, where a path class is an equivalence
  class of paths up to path homotopy.

- `path.homotopic.prod` The product of two path classes.
-/

noncomputable theory

namespace continuous_map
open continuous_map

section pi

variables {I A : Type*} {X : I → Type*} [Π i, topological_space (X i)] [topological_space A]
  {f g : Π i, C(A, X i)} {S : set A}

/-- The product homotopy of `homotopies` between functions `f` and `g` -/
@[simps]
def homotopy.pi (homotopies : Π i, homotopy (f i) (g i)) : homotopy (pi f) (pi g) :=
{ to_fun := λ t i, homotopies i t,
  map_zero_left' := λ t, by { ext i, simp only [pi_eval, homotopy.apply_zero] },
  map_one_left' := λ t, by { ext i, simp only [pi_eval, homotopy.apply_one] } }

/-- The relative product homotopy of `homotopies` between functions `f` and `g` -/
@[simps]
def homotopy_rel.pi (homotopies : Π i : I, homotopy_rel (f i) (g i) S) :
  homotopy_rel (pi f) (pi g) S :=
{ prop' :=
  begin
    intros t x hx,
    dsimp only [coe_mk, pi_eval, to_fun_eq_coe, homotopy_with.coe_to_continuous_map],
    simp only [function.funext_iff, ← forall_and_distrib],
    intro i,
    exact (homotopies i).prop' t x hx,
  end,
  ..(homotopy.pi (λ i, (homotopies i).to_homotopy)), }

end pi

section prod

variables {α β : Type*} [topological_space α] [topological_space β]
  {A : Type*} [topological_space A]
  {f₀ f₁ : C(A, α)} {g₀ g₁ : C(A, β)} {S : set A}

/-- The product of homotopies `F` and `G`,
  where `F` takes `f₀` to `f₁`  and `G` takes `g₀` to `g₁` -/
@[simps]
def homotopy.prod (F : homotopy f₀ f₁) (G : homotopy g₀ g₁) :
  homotopy (prod_mk f₀ g₀) (prod_mk f₁ g₁) :=
{ to_fun := λ t, (F t, G t),
  map_zero_left' := λ x, by simp only [prod_eval, homotopy.apply_zero],
  map_one_left' := λ x, by simp only [prod_eval, homotopy.apply_one] }

/-- The relative product of homotopies `F` and `G`,
  where `F` takes `f₀` to `f₁`  and `G` takes `g₀` to `g₁` -/
@[simps]
def homotopy_rel.prod (F : homotopy_rel f₀ f₁ S) (G : homotopy_rel g₀ g₁ S) :
  homotopy_rel (prod_mk f₀ g₀) (prod_mk f₁ g₁) S :=
{ prop' :=
  begin
    intros t x hx,
    have hF := F.prop' t x hx,
    have hG := G.prop' t x hx,
    simp only [coe_mk, prod_eval, prod.mk.inj_iff, homotopy.prod] at hF hG ⊢,
    exact ⟨⟨hF.1, hG.1⟩, ⟨hF.2, hG.2⟩⟩,
  end,
  ..(homotopy.prod F.to_homotopy G.to_homotopy) }

end prod
end continuous_map

namespace path.homotopic
local attribute [instance] path.homotopic.setoid
local infix ` ⬝ `:70 := quotient.comp

section pi

variables {ι : Type*} {X : ι → Type*} [∀ i, topological_space (X i)]
  {as bs cs : Π i, X i}

/-- The product of a family of path homotopies. This is just a specialization of `homotopy_rel` -/
def pi_homotopy (γ₀ γ₁ : Π i, path (as i) (bs i)) (H : ∀ i, path.homotopy (γ₀ i) (γ₁ i)) :
  path.homotopy (path.pi γ₀) (path.pi γ₁) := continuous_map.homotopy_rel.pi H

/-- The product of a family of path homotopy classes -/
def pi (γ : Π i, path.homotopic.quotient (as i) (bs i)) : path.homotopic.quotient as bs :=
(quotient.map path.pi
  (λ x y hxy, nonempty.map (pi_homotopy x y) (classical.nonempty_pi.mpr hxy)))
  (quotient.choice γ)

lemma pi_lift (γ : Π i, path (as i) (bs i)) : path.homotopic.pi (λ i, ⟦γ i⟧) = ⟦path.pi γ⟧ :=
by { unfold pi, simp, }

/-- Composition and products commute.
  This is `path.trans_pi_eq_pi_trans` descended to path homotopy classes -/
lemma comp_pi_eq_pi_comp
  (γ₀ : Π i, path.homotopic.quotient (as i) (bs i))
  (γ₁ : Π i, path.homotopic.quotient (bs i) (cs i)) :
  pi γ₀ ⬝ pi γ₁ = pi (λ i, γ₀ i ⬝ γ₁ i) :=
begin
  apply quotient.induction_on_pi γ₁,
  apply quotient.induction_on_pi γ₀,
  intros,
  simp only [pi_lift],
  rw [← path.homotopic.comp_lift,
      path.trans_pi_eq_pi_trans,
      ← pi_lift],
  refl,
end

/-- Abbreviation for projection onto the ith coordinate -/
@[reducible]
def proj (i : ι) (p : path.homotopic.quotient as bs) : path.homotopic.quotient (as i) (bs i) :=
p.map_fn ⟨_, continuous_apply i⟩

/-- Lemmas showing projection is the inverse of pi -/
@[simp] lemma proj_pi (i : ι) (paths : Π i, path.homotopic.quotient (as i) (bs i)) :
  proj i (pi paths) = paths i :=
begin
  apply quotient.induction_on_pi paths,
  intro, unfold proj,
  rw [pi_lift, ← path.homotopic.map_lift],
  congr, ext, refl,
end

@[simp] lemma pi_proj (p : path.homotopic.quotient as bs) : pi (λ i, proj i p) = p :=
begin
  apply quotient.induction_on p,
  intro, unfold proj,
  simp_rw ← path.homotopic.map_lift,
  rw pi_lift,
  congr, ext, refl,
end

end pi

section prod

variables {α β : Type*} [topological_space α] [topological_space β]
  {a₁ a₂ a₃ : α} {b₁ b₂ b₃ : β}
  {p₁ p₁' : path a₁ a₂} {p₂ p₂' : path b₁ b₂}
  (q₁ : path.homotopic.quotient a₁ a₂) (q₂ : path.homotopic.quotient b₁ b₂)

/-- The product of homotopies h₁ and h₂.
    This is `homotopy_rel.prod` specialized for path homotopies. -/
def prod_homotopy (h₁ : path.homotopy p₁ p₁') (h₂ : path.homotopy p₂ p₂') :
  path.homotopy (p₁.prod p₂) (p₁'.prod p₂') := continuous_map.homotopy_rel.prod h₁ h₂

/-- The product of path classes q₁ and q₂. This is `path.prod` descended to the quotient -/
def prod (q₁ : path.homotopic.quotient a₁ a₂) (q₂ : path.homotopic.quotient b₁ b₂) :
  path.homotopic.quotient (a₁, b₁) (a₂, b₂) :=
quotient.map₂ path.prod (λ p₁ p₁' h₁ p₂ p₂' h₂, nonempty.map2 prod_homotopy h₁ h₂) q₁ q₂

variables (p₁ p₁' p₂ p₂')
lemma prod_lift : prod ⟦p₁⟧ ⟦p₂⟧ = ⟦p₁.prod p₂⟧ := rfl

variables (r₁ : path.homotopic.quotient a₂ a₃) (r₂ : path.homotopic.quotient b₂ b₃)
/-- Products commute with path composition.
    This is `trans_prod_eq_prod_trans` descended to the quotient.-/
lemma comp_prod_eq_prod_comp : (prod q₁ q₂) ⬝ (prod r₁ r₂) = prod (q₁ ⬝ r₁) (q₂ ⬝ r₂) :=
begin
  apply quotient.induction_on₂ q₁ q₂,
  apply quotient.induction_on₂ r₁ r₂,
  intros,
  simp only [prod_lift, ← path.homotopic.comp_lift, path.trans_prod_eq_prod_trans],
end

variables {c₁ c₂ : α × β}

/-- Abbreviation for projection onto the left coordinate of a path class -/
@[reducible]
def proj_left (p : path.homotopic.quotient c₁ c₂) : path.homotopic.quotient c₁.1 c₂.1 :=
p.map_fn ⟨_, continuous_fst⟩

/-- Abbreviation for projection onto the right coordinate of a path class -/
@[reducible]
def proj_right (p : path.homotopic.quotient c₁ c₂) : path.homotopic.quotient c₁.2 c₂.2 :=
p.map_fn ⟨_, continuous_snd⟩

/-- Lemmas showing projection is the inverse of product -/
@[simp] lemma proj_left_prod : proj_left (prod q₁ q₂) = q₁ :=
begin
  apply quotient.induction_on₂ q₁ q₂,
  intros p₁ p₂,
  unfold proj_left,
  rw [prod_lift, ← path.homotopic.map_lift],
  congr, ext, refl,
end

@[simp] lemma proj_right_prod : proj_right (prod q₁ q₂) = q₂ :=
begin
  apply quotient.induction_on₂ q₁ q₂,
  intros p₁ p₂,
  unfold proj_right,
  rw [prod_lift, ← path.homotopic.map_lift],
  congr, ext, refl,
end

@[simp] lemma prod_proj_left_proj_right (p : path.homotopic.quotient (a₁, b₁) (a₂, b₂))
  : prod (proj_left p) (proj_right p) = p :=
begin
  apply quotient.induction_on p,
  intro p',
  unfold proj_left, unfold proj_right,
  simp only [← path.homotopic.map_lift, prod_lift],
  congr, ext; refl,
end

end prod

end path.homotopic


/-
Copyright (c) 2017 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker
-/
import algebra.group.basic
import logic.nontrivial

/-!
# Units (i.e., invertible elements) of a multiplicative monoid
-/

universe u
variable {α : Type u}

/-- Units of a monoid, bundled version. An element of a `monoid` is a unit if it has a two-sided
inverse. This version bundles the inverse element so that it can be computed. For a predicate
see `is_unit`. -/
structure units (α : Type u) [monoid α] :=
(val : α)
(inv : α)
(val_inv : val * inv = 1)
(inv_val : inv * val = 1)

/-- Units of an add_monoid, bundled version. An element of an add_monoid is a unit if it has a
    two-sided additive inverse. This version bundles the inverse element so that it can be
    computed. For a predicate see `is_add_unit`. -/
structure add_units (α : Type u) [add_monoid α] :=
(val : α)
(neg : α)
(val_neg : val + neg = 0)
(neg_val : neg + val = 0)

attribute [to_additive add_units] units

section has_elem

@[to_additive] lemma unique_has_one {α : Type*} [unique α] [has_one α] :
  default α = 1 :=
unique.default_eq 1

end has_elem

namespace units

variables [monoid α]

@[to_additive] instance : has_coe (units α) α := ⟨val⟩

@[to_additive] instance : has_inv (units α) := ⟨λ u, ⟨u.2, u.1, u.4, u.3⟩⟩

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe (u : units α) : α := u

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe_inv (u : units α) : α := ↑(u⁻¹)

initialize_simps_projections units (val → coe as_prefix, inv → coe_inv as_prefix)
initialize_simps_projections add_units (val → coe as_prefix, neg → coe_neg as_prefix)

@[simp, to_additive] lemma coe_mk (a : α) (b h₁ h₂) : ↑(units.mk a b h₁ h₂) = a := rfl

@[ext, to_additive] theorem ext :
  function.injective (coe : units α → α)
| ⟨v, i₁, vi₁, iv₁⟩ ⟨v', i₂, vi₂, iv₂⟩ e :=
  by change v = v' at e; subst v'; congr;
      simpa only [iv₂, vi₁, one_mul, mul_one] using mul_assoc i₂ v i₁

@[norm_cast, to_additive] theorem eq_iff {a b : units α} :
  (a : α) = b ↔ a = b := ext.eq_iff

@[to_additive] theorem ext_iff {a b : units α} :
  a = b ↔ (a : α) = b := eq_iff.symm

@[to_additive] instance [decidable_eq α] : decidable_eq (units α) :=
λ a b, decidable_of_iff' _ ext_iff

@[simp, to_additive] theorem mk_coe (u : units α) (y h₁ h₂) :
  mk (u : α) y h₁ h₂ = u :=
ext rfl

/-- Copy a unit, adjusting definition equalities. -/
@[to_additive /-"Copy an `add_unit`, adjusting definitional equalities."-/, simps]
def copy (u : units α) (val : α) (hv : val = u) (inv : α) (hi : inv = ↑(u⁻¹)) : units α :=
{ val := val, inv := inv,
  inv_val := hv.symm ▸ hi.symm ▸ u.inv_val, val_inv := hv.symm ▸ hi.symm ▸ u.val_inv }

@[to_additive]
lemma copy_eq (u : units α) (val hv inv hi) :
  u.copy val hv inv hi = u :=
ext hv

/-- Units of a monoid form a group. -/
@[to_additive] instance : group (units α) :=
{ mul := λ u₁ u₂, ⟨u₁.val * u₂.val, u₂.inv * u₁.inv,
    by rw [mul_assoc, ← mul_assoc u₂.val, val_inv, one_mul, val_inv],
    by rw [mul_assoc, ← mul_assoc u₁.inv, inv_val, one_mul, inv_val]⟩,
  one := ⟨1, 1, one_mul 1, one_mul 1⟩,
  mul_one := λ u, ext $ mul_one u,
  one_mul := λ u, ext $ one_mul u,
  mul_assoc := λ u₁ u₂ u₃, ext $ mul_assoc u₁ u₂ u₃,
  inv := has_inv.inv,
  mul_left_inv := λ u, ext u.inv_val }

variables (a b : units α) {c : units α}
@[simp, norm_cast, to_additive] lemma coe_mul : (↑(a * b) : α) = a * b := rfl

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : units α) : α) = 1 := rfl

@[simp, norm_cast, to_additive] lemma coe_eq_one {a : units α} : (a : α) = 1 ↔ a = 1 :=
by rw [←units.coe_one, eq_iff]

@[simp, to_additive] lemma inv_mk (x y : α) (h₁ h₂) : (mk x y h₁ h₂)⁻¹ = mk y x h₂ h₁ := rfl

@[simp, to_additive] lemma val_eq_coe : a.val = (↑a : α) := rfl

@[simp, to_additive] lemma inv_eq_coe_inv : a.inv = ((a⁻¹ : units α) : α) := rfl

@[simp, to_additive] lemma inv_mul : (↑a⁻¹ * a : α) = 1 := inv_val _
@[simp, to_additive] lemma mul_inv : (a * ↑a⁻¹ : α) = 1 := val_inv _

@[to_additive] lemma inv_mul_of_eq {u : units α} {a : α} (h : ↑u = a) : ↑u⁻¹ * a = 1 :=
by { rw [←h, u.inv_mul], }

@[to_additive] lemma mul_inv_of_eq {u : units α} {a : α} (h : ↑u = a) : a * ↑u⁻¹ = 1 :=
by { rw [←h, u.mul_inv], }

@[simp, to_additive] lemma mul_inv_cancel_left (a : units α) (b : α) : (a:α) * (↑a⁻¹ * b) = b :=
by rw [← mul_assoc, mul_inv, one_mul]

@[simp, to_additive] lemma inv_mul_cancel_left (a : units α) (b : α) : (↑a⁻¹:α) * (a * b) = b :=
by rw [← mul_assoc, inv_mul, one_mul]

@[simp, to_additive] lemma mul_inv_cancel_right (a : α) (b : units α) : a * b * ↑b⁻¹ = a :=
by rw [mul_assoc, mul_inv, mul_one]

@[simp, to_additive] lemma inv_mul_cancel_right (a : α) (b : units α) : a * ↑b⁻¹ * b = a :=
by rw [mul_assoc, inv_mul, mul_one]

@[to_additive] instance : inhabited (units α) := ⟨1⟩

@[to_additive] instance {α} [comm_monoid α] : comm_group (units α) :=
{ mul_comm := λ u₁ u₂, ext $ mul_comm _ _, ..units.group }

@[to_additive] instance [has_repr α] : has_repr (units α) := ⟨repr ∘ val⟩

@[simp, to_additive] theorem mul_right_inj (a : units α) {b c : α} : (a:α) * b = a * c ↔ b = c :=
⟨λ h, by simpa only [inv_mul_cancel_left] using congr_arg ((*) ↑(a⁻¹ : units α)) h, congr_arg _⟩

@[simp, to_additive] theorem mul_left_inj (a : units α) {b c : α} : b * a = c * a ↔ b = c :=
⟨λ h, by simpa only [mul_inv_cancel_right] using congr_arg (* ↑(a⁻¹ : units α)) h, congr_arg _⟩

@[to_additive] theorem eq_mul_inv_iff_mul_eq {a b : α} : a = b * ↑c⁻¹ ↔ a * c = b :=
⟨λ h, by rw [h, inv_mul_cancel_right], λ h, by rw [← h, mul_inv_cancel_right]⟩

@[to_additive] theorem eq_inv_mul_iff_mul_eq {a c : α} : a = ↑b⁻¹ * c ↔ ↑b * a = c :=
⟨λ h, by rw [h, mul_inv_cancel_left], λ h, by rw [← h, inv_mul_cancel_left]⟩

@[to_additive] theorem inv_mul_eq_iff_eq_mul {b c : α} : ↑a⁻¹ * b = c ↔ b = a * c :=
⟨λ h, by rw [← h, mul_inv_cancel_left], λ h, by rw [h, inv_mul_cancel_left]⟩

@[to_additive]

lemma inv_eq_of_mul_eq_one {u : units α} {a : α} (h : ↑u * a = 1) : ↑u⁻¹ = a :=
calc ↑u⁻¹ = ↑u⁻¹ * 1 : by rw mul_one
      ... = ↑u⁻¹ * ↑u * a : by rw [←h, ←mul_assoc]
      ... = a : by rw [u.inv_mul, one_mul]

lemma inv_unique {u₁ u₂ : units α} (h : (↑u₁ : α) = ↑u₂) : (↑u₁⁻¹ : α) = ↑u₂⁻¹ :=
inv_eq_of_mul_eq_one $ by rw [h, u₂.mul_inv]

end units

/-- For `a, b` in a `comm_monoid` such that `a * b = 1`, makes a unit out of `a`. -/
@[to_additive "For `a, b` in an `add_comm_monoid` such that `a + b = 0`, makes an add_unit
out of `a`."]
def units.mk_of_mul_eq_one [comm_monoid α] (a b : α) (hab : a * b = 1) :
  units α :=
⟨a, b, hab, (mul_comm b a).trans hab⟩

@[simp, to_additive] lemma units.coe_mk_of_mul_eq_one [comm_monoid α] {a b : α} (h : a * b = 1) :
  (units.mk_of_mul_eq_one a b h : α) = a := rfl

section monoid
variables [monoid α] {a b c : α}

/-- Partial division. It is defined when the
  second argument is invertible, and unlike the division operator
  in `division_ring` it is not totalized at zero. -/
def divp (a : α) (u) : α := a * (u⁻¹ : units α)

infix ` /ₚ `:70 := divp

@[simp] theorem divp_self (u : units α) : (u : α) /ₚ u = 1 := units.mul_inv _

@[simp] theorem divp_one (a : α) : a /ₚ 1 = a := mul_one _

theorem divp_assoc (a b : α) (u : units α) : a * b /ₚ u = a * (b /ₚ u) :=
mul_assoc _ _ _

@[simp] theorem divp_inv (u : units α) : a /ₚ u⁻¹ = a * u := rfl

@[simp] theorem divp_mul_cancel (a : α) (u : units α) : a /ₚ u * u = a :=
(mul_assoc _ _ _).trans $ by rw [units.inv_mul, mul_one]

@[simp] theorem mul_divp_cancel (a : α) (u : units α) : (a * u) /ₚ u = a :=
(mul_assoc _ _ _).trans $ by rw [units.mul_inv, mul_one]

@[simp] theorem divp_left_inj (u : units α) {a b : α} : a /ₚ u = b /ₚ u ↔ a = b :=
units.mul_left_inj _

theorem divp_divp_eq_divp_mul (x : α) (u₁ u₂ : units α) : (x /ₚ u₁) /ₚ u₂ = x /ₚ (u₂ * u₁) :=
by simp only [divp, mul_inv_rev, units.coe_mul, mul_assoc]

theorem divp_eq_iff_mul_eq {x : α} {u : units α} {y : α} : x /ₚ u = y ↔ y * u = x :=
u.mul_left_inj.symm.trans $ by rw [divp_mul_cancel]; exact ⟨eq.symm, eq.symm⟩

theorem divp_eq_one_iff_eq {a : α} {u : units α} : a /ₚ u = 1 ↔ a = u :=
(units.mul_left_inj u).symm.trans $ by rw [divp_mul_cancel, one_mul]

@[simp] theorem one_divp (u : units α) : 1 /ₚ u = ↑u⁻¹ :=
one_mul _

end monoid

section comm_monoid

variables [comm_monoid α]

theorem divp_eq_divp_iff {x y : α} {ux uy : units α} :
  x /ₚ ux = y /ₚ uy ↔ x * uy = y * ux :=
by rw [divp_eq_iff_mul_eq, mul_comm, ← divp_assoc, divp_eq_iff_mul_eq, mul_comm y ux]

theorem divp_mul_divp (x y : α) (ux uy : units α) :
  (x /ₚ ux) * (y /ₚ uy) = (x * y) /ₚ (ux * uy) :=
by rw [← divp_divp_eq_divp_mul, divp_assoc, mul_comm x, divp_assoc, mul_comm]

end comm_monoid

/-!
# `is_unit` predicate

In this file we define the `is_unit` predicate on a `monoid`, and
prove a few basic properties. For the bundled version see `units`. See
also `prime`, `associated`, and `irreducible` in `algebra/associated`.

-/

section is_unit

variables {M : Type*} {N : Type*}

/-- An element `a : M` of a monoid is a unit if it has a two-sided inverse.
The actual definition says that `a` is equal to some `u : units M`, where
`units M` is a bundled version of `is_unit`. -/
@[to_additive is_add_unit "An element `a : M` of an add_monoid is an `add_unit` if it has
a two-sided additive inverse. The actual definition says that `a` is equal to some
`u : add_units M`, where `add_units M` is a bundled version of `is_add_unit`."]
def is_unit [monoid M] (a : M) : Prop := ∃ u : units M, (u : M) = a

@[nontriviality] lemma is_unit_of_subsingleton [monoid M] [subsingleton M] (a : M) : is_unit a :=
⟨⟨a, a, subsingleton.elim _ _, subsingleton.elim _ _⟩, rfl⟩

instance [monoid M] [subsingleton M] : unique (units M) :=
{ default := 1,
  uniq := λ a, units.coe_eq_one.mp $ subsingleton.elim (a : M) 1 }

@[simp, to_additive is_add_unit_add_unit]
protected lemma units.is_unit [monoid M] (u : units M) : is_unit (u : M) := ⟨u, rfl⟩

@[simp, to_additive is_add_unit_zero]
theorem is_unit_one [monoid M] : is_unit (1:M) := ⟨1, rfl⟩

@[to_additive is_add_unit_of_add_eq_zero] theorem is_unit_of_mul_eq_one [comm_monoid M]
  (a b : M) (h : a * b = 1) : is_unit a :=
⟨units.mk_of_mul_eq_one a b h, rfl⟩

@[to_additive is_add_unit.exists_neg] theorem is_unit.exists_right_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, a * b = 1 :=
by { rcases h with ⟨⟨a, b, hab, _⟩, rfl⟩, exact ⟨b, hab⟩ }

@[to_additive is_add_unit.exists_neg'] theorem is_unit.exists_left_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, b * a = 1 :=
by { rcases h with ⟨⟨a, b, _, hba⟩, rfl⟩, exact ⟨b, hba⟩ }

@[to_additive is_add_unit_iff_exists_neg] theorem is_unit_iff_exists_inv [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, a * b = 1 :=
⟨λ h, h.exists_right_inv,
 λ ⟨b, hab⟩, is_unit_of_mul_eq_one _ b hab⟩

@[to_additive is_add_unit_iff_exists_neg'] theorem is_unit_iff_exists_inv' [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, b * a = 1 :=
by simp [is_unit_iff_exists_inv, mul_comm]

@[to_additive]
lemma is_unit.mul [monoid M] {x y : M} : is_unit x → is_unit y → is_unit (x * y) :=
by { rintros ⟨x, rfl⟩ ⟨y, rfl⟩, exact ⟨x * y, units.coe_mul _ _⟩ }

/-- Multiplication by a `u : units M` on the right doesn't affect `is_unit`. -/
@[simp, to_additive is_add_unit_add_add_units "Addition of a `u : add_units M` on the right doesn't
affect `is_add_unit`."]
theorem units.is_unit_mul_units [monoid M] (a : M) (u : units M) :
  is_unit (a * u) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (a * ↑u * ↑u⁻¹), by existsi v * u⁻¹; rw [←hv, units.coe_mul],
    by rwa [mul_assoc, units.mul_inv, mul_one] at this)
  (λ v, v.mul u.is_unit)

/-- Multiplication by a `u : units M` on the left doesn't affect `is_unit`. -/
@[simp, to_additive is_add_unit_add_units_add "Addition of a `u : add_units M` on the left doesn't
affect `is_add_unit`."]
theorem units.is_unit_units_mul {M : Type*} [monoid M] (u : units M) (a : M) :
  is_unit (↑u * a) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (↑u⁻¹ * (↑u * a)), by existsi u⁻¹ * v; rw [←hv, units.coe_mul],
    by rwa [←mul_assoc, units.inv_mul, one_mul] at this)
  u.is_unit.mul

@[to_additive is_add_unit_of_add_is_add_unit_left]
theorem is_unit_of_mul_is_unit_left [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit x :=
let ⟨z, hz⟩ := is_unit_iff_exists_inv.1 hu in
is_unit_iff_exists_inv.2 ⟨y * z, by rwa ← mul_assoc⟩

@[to_additive] theorem is_unit_of_mul_is_unit_right [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit y :=
@is_unit_of_mul_is_unit_left _ _ y x $ by rwa mul_comm

@[simp]
lemma is_unit.mul_iff [comm_monoid M] {x y : M} : is_unit (x * y) ↔ is_unit x ∧ is_unit y :=
⟨λ h, ⟨is_unit_of_mul_is_unit_left h, is_unit_of_mul_is_unit_right h⟩,
  λ h, is_unit.mul h.1 h.2⟩

@[to_additive] theorem is_unit.mul_right_inj [monoid M] {a b c : M} (ha : is_unit a) :
  a * b = a * c ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_right_inj]

@[to_additive] theorem is_unit.mul_left_inj [monoid M] {a b c : M} (ha : is_unit a) :
  b * a = c * a ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_left_inj]

/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/
noncomputable def is_unit.unit [monoid M] {a : M} (h : is_unit a) : units M :=
(classical.some h).copy a (classical.some_spec h).symm _ rfl

lemma is_unit.unit_spec [monoid M] {a : M} (h : is_unit a) : ↑h.unit = a :=
rfl

lemma is_unit.coe_inv_mul [monoid M] {a : M} (h : is_unit a) :
  ↑(h.unit)⁻¹ * a = 1 :=
units.mul_inv _

lemma is_unit.mul_coe_inv [monoid M] {a : M} (h : is_unit a) :
  a * ↑(h.unit)⁻¹ = 1 :=
begin
  convert units.mul_inv _,
  simp [h.unit_spec]
end

end is_unit

section noncomputable_defs

variables {M : Type*}

/-- Constructs a `group` structure on a `monoid` consisting only of units. -/
noncomputable def group_of_is_unit [hM : monoid M] (h : ∀ (a : M), is_unit a) : group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
.. hM }

/-- Constructs a `comm_group` structure on a `comm_monoid` consisting only of units. -/
noncomputable def comm_group_of_is_unit [hM : comm_monoid M] (h : ∀ (a : M), is_unit a) :
  comm_group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
.. hM }

end noncomputable_defs


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes,
  Johannes Hölzl, Yury Kudryashov
-/
import algebra.group_power.basic
import algebra.ring.basic

/-!
# Instances on spaces of monoid and group morphisms

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We endow the space of monoid morphisms `M →* N` with a `comm_monoid` structure when the target is
commutative, through pointwise multiplication, and with a `comm_group` structure when the target
is a commutative group. We also prove the same instances for additive situations.

Since these structures permit morphisms of morphisms, we also provide some composition-like
operations.

Finally, we provide the `ring` structure on `add_monoid.End`.
-/

universes uM uN uP uQ
variables {M : Type uM} {N : Type uN} {P : Type uP} {Q : Type uQ}

/-- `(M →* N)` is a `comm_monoid` if `N` is commutative. -/
@[to_additive "`(M →+ N)` is an `add_comm_monoid` if `N` is commutative."]
instance [mul_one_class M] [comm_monoid N] : comm_monoid (M →* N) :=
{ mul := (*),
  mul_assoc := by intros; ext; apply mul_assoc,
  one := 1,
  one_mul := by intros; ext; apply one_mul,
  mul_one := by intros; ext; apply mul_one,
  mul_comm := by intros; ext; apply mul_comm,
  npow := λ n f,
  { to_fun := λ x, (f x) ^ n,
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_pow] },
  npow_zero' := λ f, by { ext x, simp },
  npow_succ' := λ n f, by { ext x, simp [pow_succ] } }

/-- If `G` is a commutative group, then `M →* G` is a commutative group too. -/
@[to_additive "If `G` is an additive commutative group, then `M →+ G` is an additive commutative
group too."]
instance {M G} [mul_one_class M] [comm_group G] : comm_group (M →* G) :=
{ inv := has_inv.inv,
  div := has_div.div,
  div_eq_mul_inv := by { intros, ext, apply div_eq_mul_inv },
  mul_left_inv := by intros; ext; apply mul_left_inv,
  zpow := λ n f, { to_fun := λ x, (f x) ^ n,
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_zpow] },
  zpow_zero' := λ f, by { ext x, simp },
  zpow_succ' := λ n f, by { ext x, simp [zpow_of_nat, pow_succ] },
  zpow_neg'  := λ n f, by { ext x, simp },
  ..monoid_hom.comm_monoid }

instance [add_comm_monoid M] : add_comm_monoid (add_monoid.End M) :=
add_monoid_hom.add_comm_monoid

instance [add_comm_monoid M] : semiring (add_monoid.End M) :=
{ zero_mul := λ x, add_monoid_hom.ext $ λ i, rfl,
  mul_zero := λ x, add_monoid_hom.ext $ λ i, add_monoid_hom.map_zero _,
  left_distrib := λ x y z, add_monoid_hom.ext $ λ i, add_monoid_hom.map_add _ _ _,
  right_distrib := λ x y z, add_monoid_hom.ext $ λ i, rfl,
  nat_cast := λ n, n • 1,
  nat_cast_zero := add_monoid.nsmul_zero' _,
  nat_cast_succ := λ n, (add_monoid.nsmul_succ' n 1).trans (add_comm _ _),
  .. add_monoid.End.monoid M,
  .. add_monoid_hom.add_comm_monoid }

/-- See also `add_monoid.End.nat_cast_def`. -/
@[simp] lemma add_monoid.End.nat_cast_apply [add_comm_monoid M] (n : ℕ) (m : M) :
  (↑n : add_monoid.End M) m = n • m := rfl

instance [add_comm_group M] : add_comm_group (add_monoid.End M) :=
add_monoid_hom.add_comm_group

instance [add_comm_group M] : ring (add_monoid.End M) :=
{ int_cast := λ z, z • 1,
  int_cast_of_nat := of_nat_zsmul _,
  int_cast_neg_succ_of_nat  := zsmul_neg_succ_of_nat _,
  .. add_monoid.End.semiring,
  .. add_monoid_hom.add_comm_group }

/-- See also `add_monoid.End.int_cast_def`. -/
@[simp] lemma add_monoid.End.int_cast_apply [add_comm_group M] (z : ℤ) (m : M) :
  (↑z : add_monoid.End M) m = z • m := rfl

/-!
### Morphisms of morphisms

The structures above permit morphisms that themselves produce morphisms, provided the codomain
is commutative.
-/

namespace monoid_hom

@[to_additive]
lemma ext_iff₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  {f g : M →* N →* P} :
  f = g ↔ (∀ x y, f x y = g x y) :=
monoid_hom.ext_iff.trans $ forall_congr $ λ _, monoid_hom.ext_iff

/-- `flip` arguments of `f : M →* N →* P` -/
@[to_additive "`flip` arguments of `f : M →+ N →+ P`"]
def flip {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P} (f : M →* N →* P) :
  N →* M →* P :=
{ to_fun := λ y, ⟨λ x, f x y, by rw [f.map_one, one_apply], λ x₁ x₂, by rw [f.map_mul, mul_apply]⟩,
  map_one' := ext $ λ x, (f x).map_one,
  map_mul' := λ y₁ y₂, ext $ λ x, (f x).map_mul y₁ y₂ }

@[simp, to_additive] lemma flip_apply
  {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (x : M) (y : N) :
  f.flip y x = f x y :=
rfl

@[to_additive]
lemma map_one₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (n : N) : f 1 n = 1 :=
(flip f n).map_one

@[to_additive]
lemma map_mul₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (m₁ m₂ : M) (n : N) : f (m₁ * m₂) n = f m₁ n * f m₂ n :=
(flip f n).map_mul _ _

@[to_additive]
lemma map_inv₂ {mM : group M} {mN : mul_one_class N} {mP : comm_group P}
  (f : M →* N →* P) (m : M) (n : N) : f m⁻¹ n = (f m n)⁻¹ :=
(flip f n).map_inv _

@[to_additive]
lemma map_div₂ {mM : group M} {mN : mul_one_class N} {mP : comm_group P}
  (f : M →* N →* P) (m₁ m₂ : M) (n : N) : f (m₁ / m₂) n = f m₁ n / f m₂ n :=
(flip f n).map_div _ _

/-- Evaluation of a `monoid_hom` at a point as a monoid homomorphism. See also `monoid_hom.apply`
for the evaluation of any function at a point. -/
@[to_additive "Evaluation of an `add_monoid_hom` at a point as an additive monoid homomorphism.
See also `add_monoid_hom.apply` for the evaluation of any function at a point.", simps]
def eval [mul_one_class M] [comm_monoid N] : M →* (M →* N) →* N := (monoid_hom.id (M →* N)).flip

/-- The expression `λ g m, g (f m)` as a `monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `monoid_hom`. -/
@[to_additive "The expression `λ g m, g (f m)` as a `add_monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `add_monoid_hom`.

This also exists in a `linear_map` version, `linear_map.lcomp`.", simps]
def comp_hom' [mul_one_class M] [mul_one_class N] [comm_monoid P] (f : M →* N) :
  (N →* P) →* M →* P :=
flip $ eval.comp f

/-- Composition of monoid morphisms (`monoid_hom.comp`) as a monoid morphism.

Note that unlike `monoid_hom.comp_hom'` this requires commutativity of `N`. -/
@[to_additive "Composition of additive monoid morphisms (`add_monoid_hom.comp`) as an additive
monoid morphism.

Note that unlike `add_monoid_hom.comp_hom'` this requires commutativity of `N`.

This also exists in a `linear_map` version, `linear_map.llcomp`.", simps]
def comp_hom [mul_one_class M] [comm_monoid N] [comm_monoid P] :
  (N →* P) →* (M →* N) →* (M →* P) :=
{ to_fun := λ g, { to_fun := g.comp, map_one' := comp_one g, map_mul' := comp_mul g },
  map_one' := by { ext1 f, exact one_comp f },
  map_mul' := λ g₁ g₂, by { ext1 f, exact mul_comp g₁ g₂ f } }

/-- Flipping arguments of monoid morphisms (`monoid_hom.flip`) as a monoid morphism. -/
@[to_additive "Flipping arguments of additive monoid morphisms (`add_monoid_hom.flip`)
as an additive monoid morphism.", simps]
def flip_hom {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  : (M →* N →* P) →* (N →* M →* P) :=
{ to_fun := monoid_hom.flip, map_one' := rfl, map_mul' := λ f g, rfl }

/-- The expression `λ m q, f m (g q)` as a `monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `monoid_hom.comp`. -/
@[to_additive "The expression `λ m q, f m (g q)` as an `add_monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `add_monoid_hom.comp`.

This also exists as a `linear_map` version, `linear_map.compl₂`"]
def compl₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [mul_one_class Q]
  (f : M →* N →* P) (g : Q →* N) : M →* Q →* P :=
(comp_hom' g).comp f

@[simp, to_additive]
lemma compl₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [mul_one_class Q]
  (f : M →* N →* P) (g : Q →* N) (m : M) (q : Q) :
  (compl₂ f g) m q = f m (g q) := rfl

/-- The expression `λ m n, g (f m n)` as a `monoid_hom`. -/
@[to_additive "The expression `λ m n, g (f m n)` as an `add_monoid_hom`.

This also exists as a linear_map version, `linear_map.compr₂`"]
def compr₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) : M →* N →* Q :=
(comp_hom g).comp f

@[simp, to_additive]
lemma compr₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) (m : M) (n : N) :
  (compr₂ f g) m n = g (f m n) := rfl

end monoid_hom

/-!
### Miscellaneous definitions

Due to the fact this file imports `algebra.group_power.basic`, it is not possible to import it in
some of the lower-level files like `algebra.ring.basic`. The following lemmas should be rehomed
if the import structure permits them to be.
-/

section semiring

variables {R S : Type*} [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]

/-- Multiplication of an element of a (semi)ring is an `add_monoid_hom` in both arguments.

This is a more-strongly bundled version of `add_monoid_hom.mul_left` and `add_monoid_hom.mul_right`.

Stronger versions of this exists for algebras as `linear_map.mul`, `non_unital_alg_hom.mul`
and `algebra.lmul`.
-/
def add_monoid_hom.mul : R →+ R →+ R :=
{ to_fun := add_monoid_hom.mul_left,
  map_zero' := add_monoid_hom.ext $ zero_mul,
  map_add' := λ a b, add_monoid_hom.ext $ add_mul a b }

lemma add_monoid_hom.mul_apply (x y : R) : add_monoid_hom.mul x y = x * y := rfl

@[simp]
lemma add_monoid_hom.coe_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R) = add_monoid_hom.mul_left := rfl

@[simp]
lemma add_monoid_hom.coe_flip_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R).flip = add_monoid_hom.mul_right := rfl

/-- An `add_monoid_hom` preserves multiplication if pre- and post- composition with
`add_monoid_hom.mul` are equivalent. By converting the statement into an equality of
`add_monoid_hom`s, this lemma allows various specialized `ext` lemmas about `→+` to then be applied.
-/
lemma add_monoid_hom.map_mul_iff (f : R →+ S) :
  (∀ x y, f (x * y) = f x * f y) ↔
    (add_monoid_hom.mul : R →+ R →+ R).compr₂ f = (add_monoid_hom.mul.comp f).compl₂ f :=
iff.symm add_monoid_hom.ext_iff₂

/-- The left multiplication map: `(a, b) ↦ a * b`. See also `add_monoid_hom.mul_left`. -/
@[simps] def add_monoid.End.mul_left : R →+ add_monoid.End R := add_monoid_hom.mul

/-- The right multiplication map: `(a, b) ↦ b * a`. See also `add_monoid_hom.mul_right`. -/
@[simps] def add_monoid.End.mul_right : R →+ add_monoid.End R :=
(add_monoid_hom.mul : R →+ add_monoid.End R).flip

end semiring


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis

The power operation on monoids and groups. We separate this from group, because it depends on
nat, which in turn depends on other parts of algebra.

We have "pow a n" for natural number powers, and "gpow a i" for integer powers. The notation
a^n is used for the first, but users can locally redefine it to gpow when needed.

Note: power adopts the convention that 0^0=1.
-/
import algebra.char_zero data.int.basic algebra.group algebra.ordered_field data.list.basic

universes u v
variable {α : Type u}

@[simp] theorem inv_one [division_ring α] : (1⁻¹ : α) = 1 := by rw [inv_eq_one_div, one_div_one]

@[simp] theorem inv_inv' [discrete_field α] {a:α} : a⁻¹⁻¹ = a :=
by rw [inv_eq_one_div, inv_eq_one_div, div_div_eq_mul_div]; simp [div_one]

/-- The power operation in a monoid. `a^n = a*a*...*a` n times. -/
def monoid.pow [monoid α] (a : α) : ℕ → α
| 0     := 1
| (n+1) := a * monoid.pow n

def add_monoid.smul [add_monoid α] (n : ℕ) (a : α) : α :=
@monoid.pow (multiplicative α) _ a n

precedence `•`:70
local infix ` • ` := add_monoid.smul

@[priority 5] instance monoid.has_pow [monoid α] : has_pow α ℕ := ⟨monoid.pow⟩

 /- monoid -/
section monoid
variables [monoid α] {β : Type u} [add_monoid β]

@[simp] theorem pow_zero (a : α) : a^0 = 1 := rfl
@[simp] theorem add_monoid.zero_smul (a : β) : 0 • a = 0 := rfl
attribute [to_additive add_monoid.zero_smul] pow_zero

theorem pow_succ (a : α) (n : ℕ) : a^(n+1) = a * a^n := rfl
theorem succ_smul (a : β) (n : ℕ) : (n+1)•a = a + n•a := rfl
attribute [to_additive succ_smul] pow_succ

@[simp] theorem pow_one (a : α) : a^1 = a := mul_one _
@[simp] theorem add_monoid.one_smul (a : β) : 1•a = a := add_zero _
attribute [to_additive add_monoid.one_smul] pow_one

theorem pow_mul_comm' (a : α) (n : ℕ) : a^n * a = a * a^n :=
by induction n with n ih; simp [*, pow_succ, mul_assoc]
theorem smul_add_comm' : ∀ (a : β) (n : ℕ), n•a + a = a + n•a :=
@pow_mul_comm' (multiplicative β) _

theorem pow_succ' (a : α) (n : ℕ) : a^(n+1) = a^n * a :=
by simp [pow_succ, pow_mul_comm']
theorem succ_smul' (a : β) (n : ℕ) : (n+1)•a = n•a + a :=
by simp [succ_smul, smul_add_comm']
attribute [to_additive succ_smul'] pow_succ'

theorem pow_two (a : α) : a^2 = a * a :=
by simp [pow_succ]
theorem two_smul (a : β) : 2•a = a + a :=
by simp [succ_smul]
attribute [to_additive two_smul] pow_two

theorem pow_add (a : α) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n; simp [*, pow_succ', nat.add_succ, mul_assoc]
theorem add_monoid.add_smul : ∀ (a : β) (m n : ℕ), (m + n)•a = m•a + n•a :=
@pow_add (multiplicative β) _
attribute [to_additive add_monoid.add_smul] pow_add

@[simp] theorem one_pow (n : ℕ) : (1 : α)^n = (1:α) :=
by induction n; simp [*, pow_succ]
@[simp] theorem add_monoid.smul_zero (n : ℕ) : n•(0 : β) = (0:β) :=
by induction n; simp [*, succ_smul]
attribute [to_additive add_monoid.smul_zero] one_pow

theorem pow_mul (a : α) (m : ℕ) : ∀ n, a^(m * n) = (a^m)^n
| 0     := by simp
| (n+1) := by rw [nat.mul_succ, pow_add, pow_succ', pow_mul]
theorem add_monoid.mul_smul' : ∀ (a : β) (m n : ℕ), m * n • a = n•(m•a) :=
@pow_mul (multiplicative β) _
attribute [to_additive add_monoid.mul_smul'] pow_mul

theorem pow_mul' (a : α) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [mul_comm, pow_mul]
theorem add_monoid.mul_smul (a : β) (m n : ℕ) : m * n • a = m•(n•a) :=
by rw [mul_comm, add_monoid.mul_smul']
attribute [to_additive add_monoid.mul_smul] pow_mul'

@[simp] theorem add_monoid.smul_one [has_one β] : ∀ n : ℕ, n • (1 : β) = n :=
nat.eq_cast _ (add_monoid.zero_smul _) (add_monoid.one_smul _) (add_monoid.add_smul _)

theorem pow_bit0 (a : α) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _
theorem bit0_smul (a : β) (n : ℕ) : bit0 n • a = n•a + n•a := add_monoid.add_smul _ _ _
attribute [to_additive bit0_smul] pow_bit0

theorem pow_bit1 (a : α) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]
theorem bit1_smul : ∀ (a : β) (n : ℕ), bit1 n • a = n•a + n•a + a :=
@pow_bit1 (multiplicative β) _
attribute [to_additive bit1_smul] pow_bit1

theorem pow_mul_comm (a : α) (m n : ℕ) : a^m * a^n = a^n * a^m :=
by rw [←pow_add, ←pow_add, add_comm]
theorem smul_add_comm : ∀ (a : β) (m n : ℕ), m•a + n•a = n•a + m•a :=
@pow_mul_comm (multiplicative β) _
attribute [to_additive smul_add_comm] pow_mul_comm

@[simp] theorem list.prod_repeat (a : α) : ∀ (n : ℕ), (list.repeat a n).prod = a ^ n
| 0 := rfl
| (n+1) := by simp [pow_succ, list.prod_repeat n]
@[simp] theorem list.sum_repeat : ∀ (a : β) (n : ℕ), (list.repeat a n).sum = n • a :=
@list.prod_repeat (multiplicative β) _
attribute [to_additive list.sum_repeat] list.prod_repeat

end monoid

@[simp] theorem nat.pow_eq_pow (p q : ℕ) :
  @has_pow.pow _ _ monoid.has_pow p q = p ^ q :=
by induction q; [refl, simp [nat.pow_succ, pow_succ, mul_comm, *]]

@[simp] theorem nat.smul_eq_mul (m n : ℕ) : m • n = m * n :=
by rw mul_comm; induction m; simp [succ_smul', nat.mul_succ, *]

/- commutative monoid -/

section comm_monoid
variables [comm_monoid α] {β : Type*} [add_comm_monoid β]

theorem mul_pow (a b : α) : ∀ n:ℕ, (a * b)^n = a^n * b^n
| 0     := by simp
| (n+1) := by simp [pow_succ, mul_assoc, mul_left_comm]; rw mul_pow
theorem add_monoid.smul_add : ∀ (a b : β) (n : ℕ), n•(a + b) = n•a + n•b :=
@mul_pow (multiplicative β) _
attribute [to_additive add_monoid.add_smul] mul_pow

end comm_monoid

section group
variables [group α] {β : Type*} [add_group β]

section nat

@[simp] theorem inv_pow (a : α) : ∀n:ℕ, (a⁻¹)^n = (a^n)⁻¹
| 0     := by simp
| (n+1) := by rw [pow_succ', pow_succ, mul_inv_rev, inv_pow]
@[simp] theorem add_monoid.neg_smul : ∀ (a : β) (n : ℕ), n•(-a) = -(n•a) :=
@inv_pow (multiplicative β) _
attribute [to_additive add_monoid.neg_smul] inv_pow

theorem pow_sub (a : α) {m n : ℕ} (h : m ≥ n) : a^(m - n) = a^m * (a^n)⁻¹ :=
have h1 : m - n + n = m, from nat.sub_add_cancel h,
have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1],
eq_mul_inv_of_mul_eq h2
theorem add_monoid.smul_sub : ∀ (a : β) {m n : ℕ}, m ≥ n → (m - n)•a = m•a - n•a :=
@pow_sub (multiplicative β) _
attribute [to_additive add_monoid.smul_sub] inv_pow

theorem pow_inv_comm (a : α) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
by rw inv_pow; exact inv_comm_of_comm (pow_mul_comm _ _ _)
theorem add_monoid.smul_neg_comm : ∀ (a : β) (m n : ℕ), m•(-a) + n•a = n•a + m•(-a) :=
@pow_inv_comm (multiplicative β) _
attribute [to_additive add_monoid.smul_neg_comm] pow_inv_comm
end nat

open int

/--
The power operation in a group. This extends `monoid.pow` to negative integers
with the definition `a^(-n) = (a^n)⁻¹`.
-/
def gpow (a : α) : ℤ → α
| (of_nat n) := a^n
| -[1+n]     := (a^(nat.succ n))⁻¹

def gsmul (n : ℤ) (a : β) : β :=
@gpow (multiplicative β) _ a n

@[priority 10] instance group.has_pow : has_pow α ℤ := ⟨gpow⟩

local infix ` • `:70 := gsmul
local infix ` •ℕ `:70 := add_monoid.smul

@[simp] theorem gpow_coe_nat (a : α) (n : ℕ) : a ^ (n:ℤ) = a ^ n := rfl
@[simp] theorem gsmul_coe_nat (a : β) (n : ℕ) : (n:ℤ) • a = n •ℕ a := rfl
attribute [to_additive gsmul_coe_nat] gpow_coe_nat

@[simp] theorem gpow_of_nat (a : α) (n : ℕ) : a ^ of_nat n = a ^ n := rfl
@[simp] theorem gsmul_of_nat (a : β) (n : ℕ) : of_nat n • a = n •ℕ a := rfl
attribute [to_additive gsmul_of_nat] gpow_of_nat

@[simp] theorem gpow_neg_succ (a : α) (n : ℕ) : a ^ -[1+n] = (a ^ n.succ)⁻¹ := rfl
@[simp] theorem gsmul_neg_succ (a : β) (n : ℕ) : -[1+n] • a = - (n.succ •ℕ a) := rfl
attribute [to_additive gsmul_neg_succ] gpow_neg_succ

local attribute [ematch] le_of_lt
open nat

@[simp] theorem gpow_zero (a : α) : a ^ (0:ℤ) = 1 := rfl
@[simp] theorem zero_gsmul (a : β) : (0:ℤ) • a = 0 := rfl
attribute [to_additive zero_gsmul] gpow_zero

@[simp] theorem gpow_one (a : α) : a ^ (1:ℤ) = a := mul_one _
@[simp] theorem one_gsmul (a : β) : (1:ℤ) • a = a := add_zero _
attribute [to_additive one_gsmul] gpow_one

@[simp] theorem one_gpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := one_pow _
| -[1+ n] := by simp
@[simp] theorem gsmul_zero : ∀ (n : ℤ), n • (0 : β) = 0 :=
@one_gpow (multiplicative β) _
attribute [to_additive gsmul_zero] one_gpow

@[simp] theorem gpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := rfl
| 0       := one_inv.symm
| -[1+ n] := (inv_inv _).symm
@[simp] theorem neg_gsmul : ∀ (a : β) (n : ℤ), -n • a = -(n • a) :=
@gpow_neg (multiplicative β) _
attribute [to_additive neg_gsmul] gpow_neg

theorem gpow_neg_one (x : α) : x ^ (-1:ℤ) = x⁻¹ := by simp
theorem neg_one_gsmul (x : β) : (-1:ℤ) • x = -x := by simp
attribute [to_additive neg_one_gsmul] gpow_neg_one

@[to_additive neg_gsmul]
theorem inv_gpow (a : α) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := inv_pow a n
| -[1+ n] := by simp [inv_pow]

private lemma gpow_add_aux (a : α) (m n : nat) :
  a ^ ((of_nat m) + -[1+n]) = a ^ of_nat m * a ^ -[1+n] :=
or.elim (nat.lt_or_ge m (nat.succ n))
 (assume : m < succ n,
  have m ≤ n, from le_of_lt_succ this,
  suffices a ^ -[1+ n-m] = a ^ of_nat m * a ^ -[1+n], by simp [*, of_nat_add_neg_succ_of_nat_of_lt],
  suffices (a ^ nat.succ (n - m))⁻¹ = a ^ of_nat m * a ^ -[1+n], from this,
  suffices (a ^ (nat.succ n - m))⁻¹ = a ^ of_nat m * a ^ -[1+n], by rw ←succ_sub; assumption,
  by rw pow_sub; finish [gpow])
 (assume : m ≥ succ n,
  suffices a ^ (of_nat (m - succ n)) = (a ^ (of_nat m)) * (a ^ -[1+ n]),
    by rw [of_nat_add_neg_succ_of_nat_of_ge]; assumption,
  suffices a ^ (m - succ n) = a ^ m * (a ^ n.succ)⁻¹, from this,
  by rw pow_sub; assumption)

theorem gpow_add (a : α) : ∀ (i j : ℤ), a ^ (i + j) = a ^ i * a ^ j
| (of_nat m) (of_nat n) := pow_add _ _ _
| (of_nat m) -[1+n]     := gpow_add_aux _ _ _
| -[1+m]     (of_nat n) := by rw [add_comm, gpow_add_aux,
  gpow_neg_succ, gpow_of_nat, ← inv_pow, ← pow_inv_comm]
| -[1+m]     -[1+n]     :=
  suffices (a ^ (m + succ (succ n)))⁻¹ = (a ^ m.succ)⁻¹ * (a ^ n.succ)⁻¹, from this,
  by rw [← succ_add_eq_succ_add, add_comm, _root_.pow_add, mul_inv_rev]

theorem add_gsmul : ∀ (a : β) (i j : ℤ), (i + j) • a = i • a + j • a :=
@gpow_add (multiplicative β) _

theorem gpow_mul_comm (a : α) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i :=
by rw [← gpow_add, ← gpow_add, add_comm]
theorem gsmul_add_comm : ∀ (a : β) (i j), i • a + j • a = j • a + i • a :=
@gpow_mul_comm (multiplicative β) _
attribute [to_additive gsmul_add_comm] gpow_mul_comm

theorem gpow_mul (a : α) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := pow_mul _ _ _
| (m : ℕ) -[1+ n] := (gpow_neg _ (m * succ n)).trans $
  show (a ^ (m * succ n))⁻¹ = _, by rw pow_mul; refl
| -[1+ m] (n : ℕ) := (gpow_neg _ (succ m * n)).trans $
  show (a ^ (m.succ * n))⁻¹ = _, by simp [pow_mul]
| -[1+ m] -[1+ n] := (pow_mul a (succ m) (succ n)).trans $ by simp
theorem gsmul_mul' : ∀ (a : β) (m n : ℤ), m * n • a = n • (m • a) :=
@gpow_mul (multiplicative β) _
attribute [to_additive gsmul_mul'] gpow_mul

theorem gpow_mul' (a : α) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, gpow_mul]
theorem gsmul_mul (a : β) (m n : ℤ) : m * n • a = m • (n • a) :=
by rw [mul_comm, gsmul_mul']
attribute [to_additive gsmul_mul] gpow_mul'

theorem gpow_bit0 (a : α) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := gpow_add _ _ _
theorem bit0_gsmul (a : β) (n : ℤ) : bit0 n • a = n • a + n • a := gpow_add _ _ _
attribute [to_additive bit0_gsmul] gpow_bit0

theorem gpow_bit1 (a : α) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
by rw [bit1, gpow_add]; simp [gpow_bit0]
theorem bit1_gsmul : ∀ (a : β) (n : ℤ), bit1 n • a = n • a + n • a + a :=
@gpow_bit1 (multiplicative β) _
attribute [to_additive bit1_gsmul] gpow_bit1

end group

namespace is_group_hom
variables {β : Type v} [group α] [group β] (f : α → β) [is_group_hom f]

theorem pow (a : α) (n : ℕ) : f (a ^ n) = f a ^ n :=
by induction n; simp [*, pow_succ, is_group_hom.mul f, is_group_hom.one f]

theorem gpow (a : α) (n : ℤ) : f (a ^ n) = f a ^ n :=
by cases n; simp [is_group_hom.pow f, is_group_hom.inv f]

end is_group_hom

local infix ` •ℤ `:70 := gsmul

section comm_monoid
variables [comm_group α] {β : Type*} [add_comm_group β]

theorem mul_gpow (a b : α) : ∀ n:ℤ, (a * b)^n = a^n * b^n
| (n : ℕ) := mul_pow a b n
| -[1+ n] := by simp [pow_succ, mul_pow, mul_inv, mul_comm, mul_left_comm]
theorem gsmul_add : ∀ (a b : β) (n : ℤ), n •ℤ (a + b) = n •ℤ a + n •ℤ b :=
@mul_gpow (multiplicative β) _
attribute [to_additive gsmul_add] mul_gpow

end comm_monoid

theorem add_monoid.smul_eq_mul' [semiring α] (a : α) : ∀ n : ℕ, n • a = a * n
| 0 := by simp
| (n+1) := by simp [add_monoid.smul_eq_mul' n, mul_add, succ_smul']

theorem add_monoid.smul_eq_mul [semiring α] (n : ℕ) (a : α) : n • a = n * a :=
by rw [add_monoid.smul_eq_mul', nat.mul_cast_comm]

theorem add_monoid.mul_smul_left [semiring α] (a b : α) (n : ℕ) : n • (a * b) = a * (n • b) :=
by rw [add_monoid.smul_eq_mul', add_monoid.smul_eq_mul', mul_assoc]

theorem add_monoid.mul_smul_assoc [semiring α] (a b : α) (n : ℕ) : n • (a * b) = n • a * b :=
by rw [add_monoid.smul_eq_mul, add_monoid.smul_eq_mul, mul_assoc]

lemma zero_pow [semiring α] : ∀ {n : ℕ}, 0 < n → (0 : α) ^ n = 0
| (n+1) _ := zero_mul _

@[simp] theorem nat.cast_pow [semiring α] (n m : ℕ) : (↑(n ^ m) : α) = ↑n ^ m :=
by induction m; simp [*, nat.succ_eq_add_one, nat.pow_add, pow_add]

@[simp] theorem int.coe_nat_pow (n m : ℕ) : ((n ^ m : ℕ) : ℤ) = n ^ m :=
by induction m; simp [*, pow_succ', nat.pow_succ]

theorem is_semiring_hom.map_pow {β} [semiring α] [semiring β]
  (f : α → β) [is_semiring_hom f] (x : α) (n : ℕ) : f (x ^ n) = f x ^ n :=
by induction n; simp [*, is_semiring_hom.map_one f, is_semiring_hom.map_mul f, pow_succ]

theorem neg_one_pow_eq_or {R} [ring R] : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := by simp
| (n+1) := by cases neg_one_pow_eq_or n; simp [pow_succ, h]

theorem gsmul_eq_mul [ring α] (a : α) : ∀ n, n •ℤ a = n * a
| (n : ℕ) := by simp [add_monoid.smul_eq_mul]
| -[1+ n] := by simp [add_monoid.smul_eq_mul, -add_comm, add_mul]

theorem gsmul_eq_mul' [ring α] (a : α) (n : ℤ) : n •ℤ a = a * n :=
by rw [gsmul_eq_mul, int.mul_cast_comm]

theorem mul_gsmul_left [ring α] (a b : α) (n : ℤ) : n •ℤ (a * b) = a * (n •ℤ b) :=
by rw [gsmul_eq_mul', gsmul_eq_mul', mul_assoc]

theorem mul_gsmul_assoc [ring α] (a b : α) (n : ℤ) : n •ℤ (a * b) = n •ℤ a * b :=
by rw [gsmul_eq_mul, gsmul_eq_mul, mul_assoc]

@[simp] theorem int.cast_pow [ring α] (n : ℤ) (m : ℕ) : (↑(n ^ m) : α) = ↑n ^ m :=
by induction m; simp [*, nat.succ_eq_add_one,pow_add]

theorem pow_ne_zero [domain α] {a : α} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
by induction n with n ih; simp [pow_succ, mul_eq_zero, *]

@[simp] theorem one_div_pow [division_ring α] {a : α} (ha : a ≠ 0) : ∀ n : ℕ, (1 / a) ^ n = 1 / a ^ n
| 0     := by simp
| (n+1) := by rw [pow_succ', pow_succ,
  ← division_ring.one_div_mul_one_div (pow_ne_zero n ha) ha, one_div_pow]

@[simp] theorem division_ring.inv_pow [division_ring α] {a : α} (ha : a ≠ 0) (n : ℕ) : a⁻¹ ^ n = (a ^ n)⁻¹ :=
by simp [inv_eq_one_div, -one_div_eq_inv, ha]

@[simp] theorem div_pow [field α] (a : α) {b : α} (hb : b ≠ 0) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n :=
by rw [div_eq_mul_one_div, mul_pow, one_div_pow hb, ← div_eq_mul_one_div]

theorem add_monoid.smul_nonneg [ordered_comm_monoid α] {a : α} (H : 0 ≤ a) : ∀ n : ℕ, 0 ≤ n • a
| 0     := le_refl _
| (n+1) := add_nonneg' H (add_monoid.smul_nonneg n)

lemma pow_abs [decidable_linear_ordered_comm_ring α] (a : α) (n : ℕ) : (abs a)^n = abs (a^n) :=
by induction n; simp [*, pow_succ, abs_mul]

lemma pow_inv [division_ring α] (a : α) : ∀ n : ℕ, a ≠ 0 → (a^n)⁻¹ = (a⁻¹)^n
| 0     ha := by simp [pow_zero]
| (n+1) ha := by rw [pow_succ, pow_succ', mul_inv_eq (pow_ne_zero _ ha) ha, pow_inv _ ha]

section linear_ordered_semiring
variable [linear_ordered_semiring α]

theorem pow_pos {a : α} (H : 0 < a) : ∀ (n : ℕ), 0 < a ^ n
| 0     := by simp [zero_lt_one]
| (n+1) := by simpa [pow_succ] using mul_pos H (pow_pos _)

theorem pow_nonneg {a : α} (H : 0 ≤ a) : ∀ (n : ℕ), 0 ≤ a ^ n
| 0     := by simp [zero_le_one]
| (n+1) := by simpa [pow_succ] using mul_nonneg H (pow_nonneg _)

theorem one_le_pow_of_one_le {a : α} (H : 1 ≤ a) : ∀ (n : ℕ), 1 ≤ a ^ n
| 0     := by simp; apply le_refl
| (n+1) :=
  begin
   simp [pow_succ], rw ← one_mul (1 : α),
   apply mul_le_mul,
   assumption,
   apply one_le_pow_of_one_le,
   apply zero_le_one,
   transitivity, apply zero_le_one, assumption
  end

theorem pow_ge_one_add_mul {a : α} (H : a ≥ 0) :
  ∀ (n : ℕ), 1 + n • a ≤ (1 + a) ^ n
| 0     := by simp
| (n+1) := begin
  rw [pow_succ', succ_smul'],
  refine le_trans _ (mul_le_mul_of_nonneg_right
    (pow_ge_one_add_mul n) (add_nonneg zero_le_one H)),
  rw [mul_add, mul_one, ← add_assoc, add_le_add_iff_left],
  simpa using mul_le_mul_of_nonneg_right
    ((le_add_iff_nonneg_right 1).2 (add_monoid.smul_nonneg H n)) H
end

theorem pow_le_pow {a : α} {n m : ℕ} (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
let ⟨k, hk⟩ := nat.le.dest h in
calc a ^ n = a ^ n * 1 : by simp
  ... ≤ a ^ n * a ^ k : mul_le_mul_of_nonneg_left
    (one_le_pow_of_one_le ha _)
    (pow_nonneg (le_trans zero_le_one ha) _)
  ... = a ^ m : by rw [←hk, pow_add]

end linear_ordered_semiring

theorem pow_two_nonneg [linear_ordered_ring α] (a : α) : 0 ≤ a ^ 2 :=
by rw pow_two; exact mul_self_nonneg _

theorem pow_ge_one_add_sub_mul [linear_ordered_ring α]
  {a : α} (H : a ≥ 1) (n : ℕ) : 1 + n • (a - 1) ≤ a ^ n :=
by simpa using pow_ge_one_add_mul (sub_nonneg.2 H) n

namespace int

lemma units_pow_two (u : units ℤ) : u ^ 2 = 1 :=
(units_eq_one_or u).elim (λ h, h.symm ▸ rfl) (λ h, h.symm ▸ rfl)

lemma units_pow_eq_pow_mod_two (u : units ℤ) (n : ℕ) : u ^ n = u ^ (n % 2) :=
by conv {to_lhs, rw ← nat.mod_add_div n 2}; simp [pow_add, pow_mul, units_pow_two]

end int


variable p : Prop
example : ¬(p <-> ¬p) :=
assume h : (p <-> ¬p),
have h1 : not p, from
    assume h2 : p,
    show false, from (iff.mp h h2) h2,
show false, from h1 (iff.mpr h h1)


import linear_algebra.sesquilinear_form

universes u v

structure hermitian_form (R : Type u) (M : Type v) [ring R] (I : R ≃+* Rᵒᵖ)
  [add_comm_group M] [module R M] extends sesq_form R M I :=
(sesq_comm: ∀ (x y : M), (I (sesq x y)).unop = sesq y x)

variables {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M]
variables {I : R ≃+* Rᵒᵖ} {H : hermitian_form R M I}

instance : has_coe_to_fun (hermitian_form R M I) :=
⟨_, λ H, H.to_sesq_form.sesq⟩

lemma hermitian_form.comm (H : hermitian_form R M I) : ∀ (x y : M), (I (H x y)).unop = H y x :=
by apply hermitian_form.sesq_comm


theorem add_right_cancel (a t b : mynat) : a + t = b + t → a = b :=
begin
induction t with k Pk,
intro h,
repeat { rw add_zero at h },
exact h,

intro h_2,
repeat { rw add_succ at h_2 },
have q := succ_inj h_2,
exact Pk(q),
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.algebra.basic
import Mathlib.ring_theory.ideal.basic
import Mathlib.PostPort

universes u₁ u₂ u₃ u₄

namespace Mathlib

/-!
# Quotients of non-commutative rings

Unfortunately, ideals have only been developed in the commutative case as `ideal`,
and it's not immediately clear how one should formalise ideals in the non-commutative case.

In this file, we directly define the quotient of a semiring by any relation,
by building a bigger relation that represents the ideal generated by that relation.

We prove the universal properties of the quotient,
and recommend avoiding relying on the actual definition!

Since everything runs in parallel for quotients of `R`-algebras, we do that case at the same time.
-/

namespace ring_quot

/--
Given an arbitrary relation `r` on a ring, we strengthen it to a relation `rel r`,
such that the equivalence relation generated by `rel r` has `x ~ y` if and only if
`x - y` is in the ideal generated by elements `a - b` such that `r a b`.
-/
inductive rel {R : Type u₁} [semiring R] (r : R → R → Prop) : R → R → Prop
where
| of : ∀ {x y : R}, r x y → rel r x y
| add_left : ∀ {a b c : R}, rel r a b → rel r (a + c) (b + c)
| mul_left : ∀ {a b c : R}, rel r a b → rel r (a * c) (b * c)
| mul_right : ∀ {a b c : R}, rel r b c → rel r (a * b) (a * c)

theorem rel.add_right {R : Type u₁} [semiring R] {r : R → R → Prop} {a : R} {b : R} {c : R} (h : rel r b c) : rel r (a + b) (a + c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (rel r (a + b) (a + c))) (add_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (rel r (b + a) (a + c))) (add_comm a c))) (rel.add_left h))

theorem rel.neg {R : Type u₁} [ring R] {r : R → R → Prop} {a : R} {b : R} (h : rel r a b) : rel r (-a) (-b) := sorry

theorem rel.smul {S : Type u₂} [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {r : A → A → Prop} (k : S) {a : A} {b : A} (h : rel r a b) : rel r (k • a) (k • b) := sorry

end ring_quot

/-- The quotient of a ring by an arbitrary relation. -/
def ring_quot {R : Type u₁} [semiring R] (r : R → R → Prop) :=
  Quot sorry

namespace ring_quot

protected instance semiring {R : Type u₁} [semiring R] (r : R → R → Prop) : semiring (ring_quot r) :=
  semiring.mk (quot.map₂ Add.add rel.add_right rel.add_left) sorry (Quot.mk (rel r) 0) sorry sorry sorry
    (quot.map₂ Mul.mul rel.mul_right rel.mul_left) sorry (Quot.mk (rel r) 1) sorry sorry sorry sorry sorry sorry

protected instance ring {R : Type u₁} [ring R] (r : R → R → Prop) : ring (ring_quot r) :=
  ring.mk semiring.add sorry semiring.zero sorry sorry (quot.map (fun (a : R) => -a) rel.neg)
    (add_comm_group.sub._default semiring.add sorry semiring.zero sorry sorry (quot.map (fun (a : R) => -a) rel.neg))
    sorry sorry semiring.mul sorry semiring.one sorry sorry sorry sorry

protected instance comm_semiring {R : Type u₁} [comm_semiring R] (r : R → R → Prop) : comm_semiring (ring_quot r) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

protected instance comm_ring {R : Type u₁} [comm_ring R] (r : R → R → Prop) : comm_ring (ring_quot r) :=
  comm_ring.mk comm_semiring.add sorry comm_semiring.zero sorry sorry ring.neg ring.sub sorry sorry comm_semiring.mul
    sorry comm_semiring.one sorry sorry sorry sorry sorry

protected instance algebra {S : Type u₂} [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] (s : A → A → Prop) : algebra S (ring_quot s) :=
  algebra.mk (ring_hom.mk (fun (r : S) => Quot.mk (rel s) (coe_fn (algebra_map S A) r)) sorry sorry sorry sorry) sorry
    sorry

protected instance inhabited {R : Type u₁} [semiring R] (r : R → R → Prop) : Inhabited (ring_quot r) :=
  { default := 0 }

/--
The quotient map from a ring to its quotient, as a homomorphism of rings.
-/
def mk_ring_hom {R : Type u₁} [semiring R] (r : R → R → Prop) : R →+* ring_quot r :=
  ring_hom.mk (Quot.mk (rel r)) sorry sorry sorry sorry

theorem mk_ring_hom_rel {R : Type u₁} [semiring R] {r : R → R → Prop} {x : R} {y : R} (w : r x y) : coe_fn (mk_ring_hom r) x = coe_fn (mk_ring_hom r) y :=
  quot.sound (rel.of w)

theorem mk_ring_hom_surjective {R : Type u₁} [semiring R] (r : R → R → Prop) : function.surjective ⇑(mk_ring_hom r) := sorry

theorem ring_quot_ext {R : Type u₁} [semiring R] {T : Type u₄} [semiring T] {r : R → R → Prop} (f : ring_quot r →+* T) (g : ring_quot r →+* T) (w : ring_hom.comp f (mk_ring_hom r) = ring_hom.comp g (mk_ring_hom r)) : f = g := sorry

/--
Any ring homomorphism `f : R →+* T` which respects a relation `r : R → R → Prop`
factors uniquely through a morphism `ring_quot r →+* T`.
-/
def lift {R : Type u₁} [semiring R] {T : Type u₄} [semiring T] {r : R → R → Prop} : (Subtype fun (f : R →+* T) => ∀ {x y : R}, r x y → coe_fn f x = coe_fn f y) ≃ (ring_quot r →+* T) :=
  equiv.mk
    (fun (f' : Subtype fun (f : R →+* T) => ∀ {x y : R}, r x y → coe_fn f x = coe_fn f y) =>
      let f : R →+* T := ↑f';
      ring_hom.mk (Quot.lift ⇑f sorry) (ring_hom.map_one f) sorry (ring_hom.map_zero f) sorry)
    (fun (F : ring_quot r →+* T) => { val := ring_hom.comp F (mk_ring_hom r), property := sorry }) sorry sorry

@[simp] theorem lift_mk_ring_hom_apply {R : Type u₁} [semiring R] {T : Type u₄} [semiring T] (f : R →+* T) {r : R → R → Prop} (w : ∀ {x y : R}, r x y → coe_fn f x = coe_fn f y) (x : R) : coe_fn (coe_fn lift { val := f, property := w }) (coe_fn (mk_ring_hom r) x) = coe_fn f x :=
  rfl

-- note this is essentially `lift.symm_apply_eq.mp h`

theorem lift_unique {R : Type u₁} [semiring R] {T : Type u₄} [semiring T] (f : R →+* T) {r : R → R → Prop} (w : ∀ {x y : R}, r x y → coe_fn f x = coe_fn f y) (g : ring_quot r →+* T) (h : ring_hom.comp g (mk_ring_hom r) = f) : g = coe_fn lift { val := f, property := w } := sorry

theorem eq_lift_comp_mk_ring_hom {R : Type u₁} [semiring R] {T : Type u₄} [semiring T] {r : R → R → Prop} (f : ring_quot r →+* T) : f =
  coe_fn lift
    { val := ring_hom.comp f (mk_ring_hom r),
      property :=
        fun (x y : R) (h : r x y) =>
          id
            (eq.mpr
              (id
                (Eq._oldrec (Eq.refl (coe_fn f (coe_fn (mk_ring_hom r) x) = coe_fn f (coe_fn (mk_ring_hom r) y)))
                  (mk_ring_hom_rel h)))
              (Eq.refl (coe_fn f (coe_fn (mk_ring_hom r) y)))) } :=
  Eq.symm (equiv.apply_symm_apply lift f)

/-!
We now verify that in the case of a commutative ring, the `ring_quot` construction
agrees with the quotient by the appropriate ideal.
-/

/-- The universal ring homomorphism from `ring_quot r` to `(ideal.of_rel r).quotient`. -/
def ring_quot_to_ideal_quotient {B : Type u₁} [comm_ring B] (r : B → B → Prop) : ring_quot r →+* ideal.quotient (ideal.of_rel r) :=
  coe_fn lift { val := ideal.quotient.mk (ideal.of_rel r), property := sorry }

@[simp] theorem ring_quot_to_ideal_quotient_apply {B : Type u₁} [comm_ring B] (r : B → B → Prop) (x : B) : coe_fn (ring_quot_to_ideal_quotient r) (coe_fn (mk_ring_hom r) x) = coe_fn (ideal.quotient.mk (ideal.of_rel r)) x :=
  rfl

/-- The universal ring homomorphism from `(ideal.of_rel r).quotient` to `ring_quot r`. -/
def ideal_quotient_to_ring_quot {B : Type u₁} [comm_ring B] (r : B → B → Prop) : ideal.quotient (ideal.of_rel r) →+* ring_quot r :=
  ideal.quotient.lift (ideal.of_rel r) (mk_ring_hom r) sorry

@[simp] theorem ideal_quotient_to_ring_quot_apply {B : Type u₁} [comm_ring B] (r : B → B → Prop) (x : B) : coe_fn (ideal_quotient_to_ring_quot r) (coe_fn (ideal.quotient.mk (ideal.of_rel r)) x) = coe_fn (mk_ring_hom r) x :=
  rfl

/--
The ring equivalence between `ring_quot r` and `(ideal.of_rel r).quotient`
-/
def ring_quot_equiv_ideal_quotient {B : Type u₁} [comm_ring B] (r : B → B → Prop) : ring_quot r ≃+* ideal.quotient (ideal.of_rel r) :=
  ring_equiv.of_hom_inv (ring_quot_to_ideal_quotient r) (ideal_quotient_to_ring_quot r) sorry sorry

/-- Transfer a star_ring instance through a quotient, if the quotient is invariant to `star` -/
def star_ring {R : Type u₁} [semiring R] [star_ring R] (r : R → R → Prop) (hr : ∀ {a b : R}, r a b → r (star a) (star b)) : star_ring (ring_quot r) :=
  star_ring.mk sorry

/--
The quotient map from an `S`-algebra to its quotient, as a homomorphism of `S`-algebras.
-/
def mk_alg_hom (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] (s : A → A → Prop) : alg_hom S A (ring_quot s) :=
  alg_hom.mk (ring_hom.to_fun (mk_ring_hom s)) sorry sorry sorry sorry sorry

@[simp] theorem mk_alg_hom_coe (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] (s : A → A → Prop) : ↑(mk_alg_hom S s) = mk_ring_hom s :=
  rfl

theorem mk_alg_hom_rel (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {s : A → A → Prop} {x : A} {y : A} (w : s x y) : coe_fn (mk_alg_hom S s) x = coe_fn (mk_alg_hom S s) y :=
  quot.sound (rel.of w)

theorem mk_alg_hom_surjective (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] (s : A → A → Prop) : function.surjective ⇑(mk_alg_hom S s) := sorry

theorem ring_quot_ext' (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {B : Type u₄} [semiring B] [algebra S B] {s : A → A → Prop} (f : alg_hom S (ring_quot s) B) (g : alg_hom S (ring_quot s) B) (w : alg_hom.comp f (mk_alg_hom S s) = alg_hom.comp g (mk_alg_hom S s)) : f = g := sorry

/--
Any `S`-algebra homomorphism `f : A →ₐ[S] B` which respects a relation `s : A → A → Prop`
factors uniquely through a morphism `ring_quot s →ₐ[S]  B`.
-/
def lift_alg_hom (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {B : Type u₄} [semiring B] [algebra S B] {s : A → A → Prop} : (Subtype fun (f : alg_hom S A B) => ∀ {x y : A}, s x y → coe_fn f x = coe_fn f y) ≃ alg_hom S (ring_quot s) B :=
  equiv.mk
    (fun (f' : Subtype fun (f : alg_hom S A B) => ∀ {x y : A}, s x y → coe_fn f x = coe_fn f y) =>
      let f : alg_hom S A B := ↑f';
      alg_hom.mk (Quot.lift ⇑f sorry) (alg_hom.map_one f) sorry (alg_hom.map_zero f) sorry sorry)
    (fun (F : alg_hom S (ring_quot s) B) => { val := alg_hom.comp F (mk_alg_hom S s), property := sorry }) sorry sorry

@[simp] theorem lift_alg_hom_mk_alg_hom_apply (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {B : Type u₄} [semiring B] [algebra S B] (f : alg_hom S A B) {s : A → A → Prop} (w : ∀ {x y : A}, s x y → coe_fn f x = coe_fn f y) (x : A) : coe_fn (coe_fn (lift_alg_hom S) { val := f, property := w }) (coe_fn (mk_alg_hom S s) x) = coe_fn f x :=
  rfl

-- note this is essentially `(lift_alg_hom S).symm_apply_eq.mp h`

theorem lift_alg_hom_unique (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {B : Type u₄} [semiring B] [algebra S B] (f : alg_hom S A B) {s : A → A → Prop} (w : ∀ {x y : A}, s x y → coe_fn f x = coe_fn f y) (g : alg_hom S (ring_quot s) B) (h : alg_hom.comp g (mk_alg_hom S s) = f) : g = coe_fn (lift_alg_hom S) { val := f, property := w } := sorry

theorem eq_lift_alg_hom_comp_mk_alg_hom (S : Type u₂) [comm_semiring S] {A : Type u₃} [semiring A] [algebra S A] {B : Type u₄} [semiring B] [algebra S B] {s : A → A → Prop} (f : alg_hom S (ring_quot s) B) : f =
  coe_fn (lift_alg_hom S)
    { val := alg_hom.comp f (mk_alg_hom S s),
      property :=
        fun (x y : A) (h : s x y) =>
          id
            (eq.mpr
              (id
                (Eq._oldrec (Eq.refl (coe_fn f (coe_fn (mk_alg_hom S s) x) = coe_fn f (coe_fn (mk_alg_hom S s) y)))
                  (mk_alg_hom_rel S h)))
              (Eq.refl (coe_fn f (coe_fn (mk_alg_hom S s) y)))) } :=
  Eq.symm (equiv.apply_symm_apply (lift_alg_hom S) f)