/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker
-/

import algebra.associated
import algebra.group_power.lemmas

/-!
# Monoids with normalization functions, `gcd`, and `lcm`

This file defines extra structures on `comm_cancel_monoid_with_zero`s, including `is_domain`s.

## Main Definitions

* `normalization_monoid`
* `gcd_monoid`
* `normalized_gcd_monoid`
* `gcd_monoid_of_gcd`, `gcd_monoid_of_exists_gcd`, `normalized_gcd_monoid_of_gcd`,
  `normalized_gcd_monoid_of_exists_gcd`
* `gcd_monoid_of_lcm`, `gcd_monoid_of_exists_lcm`, `normalized_gcd_monoid_of_lcm`,
  `normalized_gcd_monoid_of_exists_lcm`

For the `normalized_gcd_monoid` instances on `ℕ` and `ℤ`, see `ring_theory.int.basic`.

## Implementation Notes

* `normalization_monoid` is defined by assigning to each element a `norm_unit` such that multiplying
by that unit normalizes the monoid, and `normalize` is an idempotent monoid homomorphism. This
definition as currently implemented does casework on `0`.

* `gcd_monoid` contains the definitions of `gcd` and `lcm` with the usual properties. They are
  both determined up to a unit.

* `normalized_gcd_monoid` extends `normalization_monoid`, so the `gcd` and `lcm` are always
  normalized. This makes `gcd`s of polynomials easier to work with, but excludes Euclidean domains,
  and monoids without zero.

* `gcd_monoid_of_gcd` and `normalized_gcd_monoid_of_gcd` noncomputably construct a `gcd_monoid`
  (resp. `normalized_gcd_monoid`) structure just from the `gcd` and its properties.

* `gcd_monoid_of_exists_gcd` and `normalized_gcd_monoid_of_exists_gcd` noncomputably construct a
  `gcd_monoid` (resp. `normalized_gcd_monoid`) structure just from a proof that any two elements
  have a (not necessarily normalized) `gcd`.

* `gcd_monoid_of_lcm` and `normalized_gcd_monoid_of_lcm` noncomputably construct a `gcd_monoid`
  (resp. `normalized_gcd_monoid`) structure just from the `lcm` and its properties.

* `gcd_monoid_of_exists_lcm` and `normalized_gcd_monoid_of_exists_lcm` noncomputably construct a
  `gcd_monoid` (resp. `normalized_gcd_monoid`) structure just from a proof that any two elements
  have a (not necessarily normalized) `lcm`.

## TODO

* Port GCD facts about nats, definition of coprime
* Generalize normalization monoids to commutative (cancellative) monoids with or without zero

## Tags

divisibility, gcd, lcm, normalize
-/

variables {α : Type*}

/-- Normalization monoid: multiplying with `norm_unit` gives a normal form for associated
elements. -/
@[protect_proj] class normalization_monoid (α : Type*)
  [comm_cancel_monoid_with_zero α] :=
(norm_unit : α → units α)
(norm_unit_zero      : norm_unit 0 = 1)
(norm_unit_mul       : ∀{a b}, a ≠ 0 → b ≠ 0 → norm_unit (a * b) = norm_unit a * norm_unit b)
(norm_unit_coe_units : ∀(u : units α), norm_unit u = u⁻¹)

export normalization_monoid (norm_unit norm_unit_zero norm_unit_mul norm_unit_coe_units)

attribute [simp] norm_unit_coe_units norm_unit_zero norm_unit_mul

section normalization_monoid
variables [comm_cancel_monoid_with_zero α] [normalization_monoid α]

@[simp] theorem norm_unit_one : norm_unit (1:α) = 1 :=
norm_unit_coe_units 1

/-- Chooses an element of each associate class, by multiplying by `norm_unit` -/
def normalize : monoid_with_zero_hom α α :=
{ to_fun := λ x, x * norm_unit x,
  map_zero' := by simp,
  map_one' := by rw [norm_unit_one, units.coe_one, mul_one],
  map_mul' := λ x y,
  classical.by_cases (λ hx : x = 0, by rw [hx, zero_mul, zero_mul, zero_mul]) $ λ hx,
  classical.by_cases (λ hy : y = 0, by rw [hy, mul_zero, zero_mul, mul_zero]) $ λ hy,
  by simp only [norm_unit_mul hx hy, units.coe_mul]; simp only [mul_assoc, mul_left_comm y], }

theorem associated_normalize (x : α) : associated x (normalize x) :=
⟨_, rfl⟩

theorem normalize_associated (x : α) : associated (normalize x) x :=
(associated_normalize _).symm

lemma associates.mk_normalize (x : α) : associates.mk (normalize x) = associates.mk x :=
associates.mk_eq_mk_iff_associated.2 (normalize_associated _)

@[simp] lemma normalize_apply (x : α) : normalize x = x * norm_unit x := rfl

@[simp] lemma normalize_zero : normalize (0 : α) = 0 := normalize.map_zero

@[simp] lemma normalize_one : normalize (1 : α) = 1 := normalize.map_one

lemma normalize_coe_units (u : units α) : normalize (u : α) = 1 := by simp

lemma normalize_eq_zero {x : α} : normalize x = 0 ↔ x = 0 :=
⟨λ hx, (associated_zero_iff_eq_zero x).1 $ hx ▸ associated_normalize _,
  by rintro rfl; exact normalize_zero⟩

lemma normalize_eq_one {x : α} : normalize x = 1 ↔ is_unit x :=
⟨λ hx, is_unit_iff_exists_inv.2 ⟨_, hx⟩, λ ⟨u, hu⟩, hu ▸ normalize_coe_units u⟩

@[simp] theorem norm_unit_mul_norm_unit (a : α) : norm_unit (a * norm_unit a) = 1 :=
begin
  nontriviality α using [subsingleton.elim a 0],
  obtain rfl|h := eq_or_ne a 0,
  { rw [norm_unit_zero, zero_mul, norm_unit_zero] },
  { rw [norm_unit_mul h (units.ne_zero _), norm_unit_coe_units, mul_inv_eq_one] }
end

theorem normalize_idem (x : α) : normalize (normalize x) = normalize x := by simp

theorem normalize_eq_normalize {a b : α}
  (hab : a ∣ b) (hba : b ∣ a) : normalize a = normalize b :=
begin
  nontriviality α,
  rcases associated_of_dvd_dvd hab hba with ⟨u, rfl⟩,
  refine classical.by_cases (by rintro rfl; simp only [zero_mul]) (assume ha : a ≠ 0, _),
  suffices : a * ↑(norm_unit a) = a * ↑u * ↑(norm_unit a) * ↑u⁻¹,
    by simpa only [normalize_apply, mul_assoc, norm_unit_mul ha u.ne_zero, norm_unit_coe_units],
  calc a * ↑(norm_unit a) = a * ↑(norm_unit a) * ↑u * ↑u⁻¹:
      (units.mul_inv_cancel_right _ _).symm
    ... = a * ↑u * ↑(norm_unit a) * ↑u⁻¹ : by rw mul_right_comm a
end

lemma normalize_eq_normalize_iff {x y : α} : normalize x = normalize y ↔ x ∣ y ∧ y ∣ x :=
⟨λ h, ⟨units.dvd_mul_right.1 ⟨_, h.symm⟩, units.dvd_mul_right.1 ⟨_, h⟩⟩,
λ ⟨hxy, hyx⟩, normalize_eq_normalize hxy hyx⟩

theorem dvd_antisymm_of_normalize_eq {a b : α}
  (ha : normalize a = a) (hb : normalize b = b) (hab : a ∣ b) (hba : b ∣ a) :
  a = b :=
ha ▸ hb ▸ normalize_eq_normalize hab hba

--can be proven by simp
lemma dvd_normalize_iff {a b : α} : a ∣ normalize b ↔ a ∣ b :=
units.dvd_mul_right

--can be proven by simp
lemma normalize_dvd_iff {a b : α} : normalize a ∣ b ↔ a ∣ b :=
units.mul_right_dvd

end normalization_monoid

namespace associates
variables [comm_cancel_monoid_with_zero α] [normalization_monoid α]

local attribute [instance] associated.setoid

/-- Maps an element of `associates` back to the normalized element of its associate class -/
protected def out : associates α → α :=
quotient.lift (normalize : α → α) $ λ a b ⟨u, hu⟩, hu ▸
normalize_eq_normalize ⟨_, rfl⟩ (units.mul_right_dvd.2 $ dvd_refl a)

lemma out_mk (a : α) : (associates.mk a).out = normalize a := rfl

@[simp] lemma out_one : (1 : associates α).out = 1 :=
normalize_one

lemma out_mul (a b : associates α) : (a * b).out = a.out * b.out :=
quotient.induction_on₂ a b $ assume a b,
by simp only [associates.quotient_mk_eq_mk, out_mk, mk_mul_mk, normalize.map_mul]

lemma dvd_out_iff (a : α) (b : associates α) : a ∣ b.out ↔ associates.mk a ≤ b :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

lemma out_dvd_iff (a : α) (b : associates α) : b.out ∣ a ↔ b ≤ associates.mk a :=
quotient.induction_on b $
  by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

@[simp] lemma out_top : (⊤ : associates α).out = 0 :=
normalize_zero

@[simp] lemma normalize_out (a : associates α) : normalize a.out = a.out :=
quotient.induction_on a normalize_idem

end associates

/-- GCD monoid: a `comm_cancel_monoid_with_zero` with `gcd` (greatest common divisor) and
`lcm` (least common multiple) operations, determined up to a unit. The type class focuses on `gcd`
and we derive the corresponding `lcm` facts from `gcd`.
-/
@[protect_proj] class gcd_monoid (α : Type*) [comm_cancel_monoid_with_zero α] :=
(gcd : α → α → α)
(lcm : α → α → α)
(gcd_dvd_left   : ∀a b, gcd a b ∣ a)
(gcd_dvd_right  : ∀a b, gcd a b ∣ b)
(dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
(gcd_mul_lcm    : ∀a b, associated (gcd a b * lcm a b) (a * b))
(lcm_zero_left  : ∀a, lcm 0 a = 0)
(lcm_zero_right : ∀a, lcm a 0 = 0)

/-- Normalized GCD monoid: a `comm_cancel_monoid_with_zero` with normalization and `gcd`
(greatest common divisor) and `lcm` (least common multiple) operations. In this setting `gcd` and
`lcm` form a bounded lattice on the associated elements where `gcd` is the infimum, `lcm` is the
supremum, `1` is bottom, and `0` is top. The type class focuses on `gcd` and we derive the
corresponding `lcm` facts from `gcd`.
-/
class normalized_gcd_monoid (α : Type*) [comm_cancel_monoid_with_zero α]
  extends normalization_monoid α, gcd_monoid α :=
(normalize_gcd : ∀a b, normalize (gcd a b) = gcd a b)
(normalize_lcm : ∀a b, normalize (lcm a b) = lcm a b)

export gcd_monoid (gcd lcm gcd_dvd_left gcd_dvd_right dvd_gcd  lcm_zero_left lcm_zero_right)

attribute [simp] lcm_zero_left lcm_zero_right

section gcd_monoid
variables [comm_cancel_monoid_with_zero α]

@[simp] theorem normalize_gcd [normalized_gcd_monoid α] : ∀a b:α, normalize (gcd a b) = gcd a b :=
normalized_gcd_monoid.normalize_gcd

theorem gcd_mul_lcm [gcd_monoid α] : ∀a b:α, associated (gcd a b * lcm a b) (a * b) :=
gcd_monoid.gcd_mul_lcm

section gcd

theorem dvd_gcd_iff [gcd_monoid α] (a b c : α) : a ∣ gcd b c ↔ (a ∣ b ∧ a ∣ c) :=
iff.intro
  (assume h, ⟨h.trans (gcd_dvd_left _ _), h.trans (gcd_dvd_right _ _)⟩)
  (assume ⟨hab, hac⟩, dvd_gcd hab hac)

theorem gcd_comm [normalized_gcd_monoid α] (a b : α) : gcd a b = gcd b a :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_comm' [gcd_monoid α] (a b : α) : associated (gcd a b) (gcd b a) :=
associated_of_dvd_dvd
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_assoc [normalized_gcd_monoid α] (m n k : α) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd
    ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n))
    (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k)))
    ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k)))

theorem gcd_assoc' [gcd_monoid α] (m n k : α) : associated (gcd (gcd m n) k) (gcd m (gcd n k)) :=
associated_of_dvd_dvd
  (dvd_gcd
    ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n))
    (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k)))
    ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k)))

instance [normalized_gcd_monoid α] : is_commutative α gcd := ⟨gcd_comm⟩
instance [normalized_gcd_monoid α] : is_associative α gcd := ⟨gcd_assoc⟩

theorem gcd_eq_normalize [normalized_gcd_monoid α] {a b c : α}
  (habc : gcd a b ∣ c) (hcab : c ∣ gcd a b) :
  gcd a b = normalize c :=
normalize_gcd a b ▸ normalize_eq_normalize habc hcab

@[simp] theorem gcd_zero_left [normalized_gcd_monoid α] (a : α) : gcd 0 a = normalize a :=
gcd_eq_normalize (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

theorem gcd_zero_left' [gcd_monoid α] (a : α) : associated (gcd 0 a) a :=
associated_of_dvd_dvd (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

@[simp] theorem gcd_zero_right [normalized_gcd_monoid α] (a : α) : gcd a 0 = normalize a :=
gcd_eq_normalize (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

theorem gcd_zero_right' [gcd_monoid α] (a : α) : associated (gcd a 0) a :=
associated_of_dvd_dvd (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

@[simp] theorem gcd_eq_zero_iff [gcd_monoid α] (a b : α) : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
iff.intro
  (assume h, let ⟨ca, ha⟩ := gcd_dvd_left a b, ⟨cb, hb⟩ := gcd_dvd_right a b in
    by rw [h, zero_mul] at ha hb; exact ⟨ha, hb⟩)
  (assume ⟨ha, hb⟩, by
    { rw [ha, hb, ←zero_dvd_iff],
      apply dvd_gcd; refl })

@[simp] theorem gcd_one_left [normalized_gcd_monoid α] (a : α) : gcd 1 a = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_left' [gcd_monoid α] (a : α) : associated (gcd 1 a) 1 :=
associated_of_dvd_dvd (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_right [normalized_gcd_monoid α] (a : α) : gcd a 1 = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_right _ _) (one_dvd _)

@[simp] theorem gcd_one_right' [gcd_monoid α] (a : α) : associated (gcd a 1) 1 :=
associated_of_dvd_dvd (gcd_dvd_right _ _) (one_dvd _)

theorem gcd_dvd_gcd [gcd_monoid α] {a b c d: α} (hab : a ∣ b) (hcd : c ∣ d) : gcd a c ∣ gcd b d :=
dvd_gcd ((gcd_dvd_left _ _).trans hab) ((gcd_dvd_right _ _).trans hcd)

@[simp] theorem gcd_same [normalized_gcd_monoid α] (a : α) : gcd a a = normalize a :=
gcd_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_refl a))

@[simp] theorem gcd_mul_left [normalized_gcd_monoid α] (a b c : α) :
  gcd (a * b) (a * c) = normalize a * gcd b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, gcd_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices gcd (a * b) (a * c) = normalize (a * gcd b c),
  by simpa only [normalize.map_mul, normalize_gcd],
let ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c) in
gcd_eq_normalize
  (eq.symm ▸ mul_dvd_mul_left a $ show d ∣ gcd b c, from
    dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _))
  (dvd_gcd
    (mul_dvd_mul_left a $ gcd_dvd_left _ _)
    (mul_dvd_mul_left a $ gcd_dvd_right _ _))

theorem gcd_mul_left' [gcd_monoid α] (a b c : α) : associated (gcd (a * b) (a * c)) (a * gcd b c) :=
begin
  obtain rfl|ha := eq_or_ne a 0,
  { simp only [zero_mul, gcd_zero_left'] },
  obtain ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c),
  apply associated_of_dvd_dvd,
  { rw eq,
    apply mul_dvd_mul_left,
    exact dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _) },
  { exact (dvd_gcd
      (mul_dvd_mul_left a $ gcd_dvd_left _ _)
      (mul_dvd_mul_left a $ gcd_dvd_right _ _)) },
end

@[simp] theorem gcd_mul_right [normalized_gcd_monoid α] (a b c : α) :
  gcd (b * a) (c * a) = gcd b c * normalize a :=
by simp only [mul_comm, gcd_mul_left]

@[simp] theorem gcd_mul_right' [gcd_monoid α] (a b c : α) :
  associated (gcd (b * a) (c * a)) (gcd b c * a) :=
by simp only [mul_comm, gcd_mul_left']

theorem gcd_eq_left_iff [normalized_gcd_monoid α] (a b : α) (h : normalize a = a) :
  gcd a b = a ↔ a ∣ b :=
iff.intro (assume eq, eq ▸ gcd_dvd_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_gcd _ _) h (gcd_dvd_left _ _)
    (dvd_gcd (dvd_refl a) hab)

theorem gcd_eq_right_iff [normalized_gcd_monoid α] (a b : α) (h : normalize b = b) :
  gcd a b = b ↔ b ∣ a :=
by simpa only [gcd_comm a b] using gcd_eq_left_iff b a h

theorem gcd_dvd_gcd_mul_left [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd (dvd_mul_left _ _) dvd_rfl

theorem gcd_dvd_gcd_mul_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd (dvd_mul_right _ _) dvd_rfl

theorem gcd_dvd_gcd_mul_left_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd dvd_rfl (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right [gcd_monoid α] (m n k : α) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd dvd_rfl (dvd_mul_right _ _)

theorem associated.gcd_eq_left [normalized_gcd_monoid α] {m n : α} (h : associated m n) (k : α) :
  gcd m k = gcd n k :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd h.dvd dvd_rfl)
  (gcd_dvd_gcd h.symm.dvd dvd_rfl)

theorem associated.gcd_eq_right [normalized_gcd_monoid α] {m n : α} (h : associated m n) (k : α) :
  gcd k m = gcd k n :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (gcd_dvd_gcd dvd_rfl h.dvd)
  (gcd_dvd_gcd dvd_rfl h.symm.dvd)

lemma dvd_gcd_mul_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) : k ∣ (gcd k m) * n :=
(dvd_gcd (dvd_mul_right _ n) H).trans (gcd_mul_right' n k m).dvd

lemma dvd_mul_gcd_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) : k ∣ m * gcd k n :=
by { rw mul_comm at H ⊢, exact dvd_gcd_mul_of_dvd_mul H }

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`.

 Note: In general, this representation is highly non-unique. -/
lemma exists_dvd_and_dvd_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) :
  ∃ d₁ (hd₁ : d₁ ∣ m) d₂ (hd₂ : d₂ ∣ n), k = d₁ * d₂ :=
begin
  by_cases h0 : gcd k m = 0,
  { rw gcd_eq_zero_iff at h0,
    rcases h0 with ⟨rfl, rfl⟩,
    refine ⟨0, dvd_refl 0, n, dvd_refl n, _⟩,
    simp },
  { obtain ⟨a, ha⟩ := gcd_dvd_left k m,
    refine ⟨gcd k m, gcd_dvd_right _ _, a, _, ha⟩,
    suffices h : gcd k m * a ∣ gcd k m * n,
    { cases h with b hb,
      use b,
      rw mul_assoc at hb,
      apply mul_left_cancel₀ h0 hb },
    rw ← ha,
    exact dvd_gcd_mul_of_dvd_mul H }
end

theorem gcd_mul_dvd_mul_gcd [gcd_monoid α] (k m n : α) : gcd k (m * n) ∣ gcd k m * gcd k n :=
begin
  obtain ⟨m', hm', n', hn', h⟩ := (exists_dvd_and_dvd_of_dvd_mul $ gcd_dvd_right k (m * n)),
  replace h : gcd k (m * n) = m' * n' := h,
  rw h,
  have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _,
  apply mul_dvd_mul,
  { have hm'k : m' ∣ k := (dvd_mul_right m' n').trans hm'n',
    exact dvd_gcd hm'k hm' },
  { have hn'k : n' ∣ k := (dvd_mul_left n' m').trans hm'n',
    exact dvd_gcd hn'k hn' }
end

theorem gcd_pow_right_dvd_pow_gcd [gcd_monoid α] {a b : α} {k : ℕ} :
  gcd a (b ^ k) ∣ (gcd a b) ^ k :=
begin
  by_cases hg : gcd a b = 0,
  { rw gcd_eq_zero_iff at hg,
    rcases hg with ⟨rfl, rfl⟩,
    exact (gcd_zero_left' (0 ^ k : α)).dvd.trans
      (pow_dvd_pow_of_dvd (gcd_zero_left' (0 : α)).symm.dvd _) },
  { induction k with k hk,
    { simp only [pow_zero],
      exact (gcd_one_right' a).dvd, },
    rw [pow_succ, pow_succ],
    transitivity gcd a b * gcd a (b ^ k),
    apply gcd_mul_dvd_mul_gcd a b (b ^ k),
    exact (mul_dvd_mul_iff_left hg).mpr hk }
end

theorem gcd_pow_left_dvd_pow_gcd [gcd_monoid α] {a b : α} {k : ℕ} :
  gcd (a ^ k) b ∣ (gcd a b) ^ k :=
calc gcd (a ^ k) b
    ∣ gcd b (a ^ k) : (gcd_comm' _ _).dvd
... ∣ (gcd b a) ^ k : gcd_pow_right_dvd_pow_gcd
... ∣ (gcd a b) ^ k : pow_dvd_pow_of_dvd (gcd_comm' _ _).dvd _

theorem pow_dvd_of_mul_eq_pow [gcd_monoid α] {a b c d₁ d₂ : α} (ha : a ≠ 0)
  (hab : is_unit (gcd a b)) {k : ℕ} (h : a * b = c ^ k) (hc : c = d₁ * d₂)
  (hd₁ : d₁ ∣ a) : d₁ ^ k ≠ 0 ∧ d₁ ^ k ∣ a :=
begin
  have h1 : is_unit (gcd (d₁ ^ k) b),
  { apply is_unit_of_dvd_one,
    transitivity (gcd d₁ b) ^ k,
    { exact gcd_pow_left_dvd_pow_gcd },
    { apply is_unit.dvd, apply is_unit.pow, apply is_unit_of_dvd_one,
      apply dvd_trans _ hab.dvd,
      apply gcd_dvd_gcd hd₁ (dvd_refl b) } },
  have h2 : d₁ ^ k ∣ a * b, { use d₂ ^ k, rw [h, hc], exact mul_pow d₁ d₂ k },
  rw mul_comm at h2,
  have h3 : d₁ ^ k ∣ a,
  { apply (dvd_gcd_mul_of_dvd_mul h2).trans,
    rw is_unit.mul_left_dvd _ _ _ h1 },
  have h4 : d₁ ^ k ≠ 0,
  { intro hdk, rw hdk at h3, apply absurd (zero_dvd_iff.mp h3) ha },
  exact ⟨h4, h3⟩,
end

theorem exists_associated_pow_of_mul_eq_pow [gcd_monoid α] {a b c : α}
  (hab : is_unit (gcd a b)) {k : ℕ}
  (h : a * b = c ^ k) : ∃ (d : α), associated (d ^ k) a :=
begin
  casesI subsingleton_or_nontrivial α,
  { use 0, rw [subsingleton.elim a (0 ^ k)] },
  by_cases ha : a = 0,
  { use 0, rw ha,
    obtain (rfl | hk) := k.eq_zero_or_pos,
    { exfalso, revert h, rw [ha, zero_mul, pow_zero], apply zero_ne_one },
    { rw zero_pow hk } },
  by_cases hb : b = 0,
  { use 1, rw [one_pow],
    apply (associated_one_iff_is_unit.mpr hab).symm.trans,
    rw hb,
    exact gcd_zero_right' a },
  obtain (rfl | hk) := k.eq_zero_or_pos,
  { use 1, rw pow_zero at h ⊢, use units.mk_of_mul_eq_one _ _ h,
    rw [units.coe_mk_of_mul_eq_one, one_mul] },
  have hc : c ∣ a * b, { rw h, exact dvd_pow_self _ hk.ne' },
  obtain ⟨d₁, hd₁, d₂, hd₂, hc⟩ := exists_dvd_and_dvd_of_dvd_mul hc,
  use d₁,
  obtain ⟨h0₁, ⟨a', ha'⟩⟩ := pow_dvd_of_mul_eq_pow ha hab h hc hd₁,
  rw [mul_comm] at h hc,
  rw (gcd_comm' a b).is_unit_iff at hab,
  obtain ⟨h0₂, ⟨b', hb'⟩⟩ := pow_dvd_of_mul_eq_pow hb hab h hc hd₂,
  rw [ha', hb', hc, mul_pow] at h,
  have h' : a' * b' = 1,
  { apply (mul_right_inj' h0₁).mp, rw mul_one,
    apply (mul_right_inj' h0₂).mp, rw ← h,
    rw [mul_assoc, mul_comm a', ← mul_assoc _ b', ← mul_assoc b', mul_comm b'] },
  use units.mk_of_mul_eq_one _ _ h',
  rw [units.coe_mk_of_mul_eq_one, ha']
end

theorem exists_eq_pow_of_mul_eq_pow [gcd_monoid α] [unique (units α)] {a b c : α}
  (hab : is_unit (gcd a b)) {k : ℕ}
  (h : a * b = c ^ k) : ∃ (d : α), a = d ^ k :=
let ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow hab h in ⟨d, (associated_iff_eq.mp hd).symm⟩

end gcd

section lcm

lemma lcm_dvd_iff [gcd_monoid α] {a b c : α} : lcm a b ∣ c ↔ a ∣ c ∧ b ∣ c :=
begin
  by_cases this : a = 0 ∨ b = 0,
  { rcases this with rfl | rfl;
    simp only [iff_def, lcm_zero_left, lcm_zero_right, zero_dvd_iff, dvd_zero,
      eq_self_iff_true, and_true, imp_true_iff] {contextual:=tt} },
  { obtain ⟨h1, h2⟩ := not_or_distrib.1 this,
    have h : gcd a b ≠ 0, from λ H, h1 ((gcd_eq_zero_iff _ _).1 H).1,
    rw [← mul_dvd_mul_iff_left h, (gcd_mul_lcm a b).dvd_iff_dvd_left,
      ←(gcd_mul_right' c a b).dvd_iff_dvd_right, dvd_gcd_iff, mul_comm b c,
      mul_dvd_mul_iff_left h1, mul_dvd_mul_iff_right h2, and_comm] }
end

lemma dvd_lcm_left [gcd_monoid α] (a b : α) : a ∣ lcm a b := (lcm_dvd_iff.1 dvd_rfl).1

lemma dvd_lcm_right [gcd_monoid α] (a b : α) : b ∣ lcm a b := (lcm_dvd_iff.1 dvd_rfl).2

lemma lcm_dvd [gcd_monoid α] {a b c : α} (hab : a ∣ b) (hcb : c ∣ b) : lcm a c ∣ b :=
lcm_dvd_iff.2 ⟨hab, hcb⟩

@[simp] theorem lcm_eq_zero_iff [gcd_monoid α] (a b : α) : lcm a b = 0 ↔ a = 0 ∨ b = 0 :=
iff.intro
  (assume h : lcm a b = 0,
    have associated (a * b) 0 := (gcd_mul_lcm a b).symm.trans $
      by rw [h, mul_zero],
    by simpa only [associated_zero_iff_eq_zero, mul_eq_zero])
  (by rintro (rfl | rfl); [apply lcm_zero_left, apply lcm_zero_right])

@[simp] lemma normalize_lcm [normalized_gcd_monoid α] (a b : α) : normalize (lcm a b) = lcm a b :=
normalized_gcd_monoid.normalize_lcm a b

theorem lcm_comm [normalized_gcd_monoid α] (a b : α) : lcm a b = lcm b a :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_comm' [gcd_monoid α] (a b : α) : associated (lcm a b) (lcm b a) :=
associated_of_dvd_dvd
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_assoc [normalized_gcd_monoid α] (m n k : α) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) ((dvd_lcm_left _ _).trans (dvd_lcm_right _ _)))
    ((dvd_lcm_right _ _).trans (dvd_lcm_right _ _)))
  (lcm_dvd
    ((dvd_lcm_left _ _).trans (dvd_lcm_left _ _))
    (lcm_dvd ((dvd_lcm_right _ _).trans (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

theorem lcm_assoc' [gcd_monoid α] (m n k : α) : associated (lcm (lcm m n) k) (lcm m (lcm n k)) :=
associated_of_dvd_dvd
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) ((dvd_lcm_left _ _).trans (dvd_lcm_right _ _)))
    ((dvd_lcm_right _ _).trans (dvd_lcm_right _ _)))
  (lcm_dvd
    ((dvd_lcm_left _ _).trans (dvd_lcm_left _ _))
    (lcm_dvd ((dvd_lcm_right _ _).trans (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

instance [normalized_gcd_monoid α] : is_commutative α lcm := ⟨lcm_comm⟩
instance [normalized_gcd_monoid α] : is_associative α lcm := ⟨lcm_assoc⟩

lemma lcm_eq_normalize [normalized_gcd_monoid α] {a b c : α}
  (habc : lcm a b ∣ c) (hcab : c ∣ lcm a b) :
  lcm a b = normalize c :=
normalize_lcm a b ▸ normalize_eq_normalize habc hcab

theorem lcm_dvd_lcm [gcd_monoid α] {a b c d : α} (hab : a ∣ b) (hcd : c ∣ d) :
  lcm a c ∣ lcm b d :=
lcm_dvd (hab.trans (dvd_lcm_left _ _)) (hcd.trans (dvd_lcm_right _ _))

@[simp] theorem lcm_units_coe_left [normalized_gcd_monoid α] (u : units α) (a : α) :
  lcm ↑u a = normalize a :=
lcm_eq_normalize (lcm_dvd units.coe_dvd dvd_rfl) (dvd_lcm_right _ _)

@[simp] theorem lcm_units_coe_right [normalized_gcd_monoid α] (a : α) (u : units α) :
  lcm a ↑u = normalize a :=
(lcm_comm a u).trans $ lcm_units_coe_left _ _

@[simp] theorem lcm_one_left [normalized_gcd_monoid α] (a : α) : lcm 1 a = normalize a :=
lcm_units_coe_left 1 a

@[simp] theorem lcm_one_right [normalized_gcd_monoid α] (a : α) : lcm a 1 = normalize a :=
lcm_units_coe_right a 1

@[simp] theorem lcm_same [normalized_gcd_monoid α] (a : α) : lcm a a = normalize a :=
lcm_eq_normalize (lcm_dvd dvd_rfl dvd_rfl) (dvd_lcm_left _ _)

@[simp] theorem lcm_eq_one_iff [normalized_gcd_monoid α] (a b : α) : lcm a b = 1 ↔ a ∣ 1 ∧ b ∣ 1 :=
iff.intro
  (assume eq, eq ▸ ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩)
  (assume ⟨⟨c, hc⟩, ⟨d, hd⟩⟩,
    show lcm (units.mk_of_mul_eq_one a c hc.symm : α) (units.mk_of_mul_eq_one b d hd.symm) = 1,
      by rw [lcm_units_coe_left, normalize_coe_units])

@[simp] theorem lcm_mul_left [normalized_gcd_monoid α] (a b c : α) :
  lcm (a * b) (a * c) = normalize a * lcm b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, lcm_zero_left, normalize_zero]) $
assume ha : a ≠ 0,
suffices lcm (a * b) (a * c) = normalize (a * lcm b c),
  by simpa only [normalize.map_mul, normalize_lcm],
have a ∣ lcm (a * b) (a * c), from (dvd_mul_right _ _).trans (dvd_lcm_left _ _),
let ⟨d, eq⟩ := this in
lcm_eq_normalize
  (lcm_dvd (mul_dvd_mul_left a (dvd_lcm_left _ _)) (mul_dvd_mul_left a (dvd_lcm_right _ _)))
  (eq.symm ▸ (mul_dvd_mul_left a $ lcm_dvd
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_left _ _)
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_right _ _)))

@[simp] theorem lcm_mul_right [normalized_gcd_monoid α] (a b c : α) :
  lcm (b * a) (c * a) = lcm b c * normalize a :=
by simp only [mul_comm, lcm_mul_left]

theorem lcm_eq_left_iff [normalized_gcd_monoid α] (a b : α) (h : normalize a = a) :
  lcm a b = a ↔ b ∣ a :=
iff.intro (assume eq, eq ▸ dvd_lcm_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_lcm _ _) h (lcm_dvd (dvd_refl a) hab)
    (dvd_lcm_left _ _)

theorem lcm_eq_right_iff [normalized_gcd_monoid α] (a b : α) (h : normalize b = b) :
  lcm a b = b ↔ a ∣ b :=
by simpa only [lcm_comm b a] using lcm_eq_left_iff b a h

theorem lcm_dvd_lcm_mul_left [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm (k * m) n :=
lcm_dvd_lcm (dvd_mul_left _ _) dvd_rfl

theorem lcm_dvd_lcm_mul_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm (m * k) n :=
lcm_dvd_lcm (dvd_mul_right _ _) dvd_rfl

theorem lcm_dvd_lcm_mul_left_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm m (k * n) :=
lcm_dvd_lcm dvd_rfl (dvd_mul_left _ _)

theorem lcm_dvd_lcm_mul_right_right [gcd_monoid α] (m n k : α) : lcm m n ∣ lcm m (n * k) :=
lcm_dvd_lcm dvd_rfl (dvd_mul_right _ _)

theorem lcm_eq_of_associated_left [normalized_gcd_monoid α] {m n : α}
  (h : associated m n) (k : α) : lcm m k = lcm n k :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm h.dvd dvd_rfl)
  (lcm_dvd_lcm h.symm.dvd dvd_rfl)

theorem lcm_eq_of_associated_right [normalized_gcd_monoid α] {m n : α}
  (h : associated m n) (k : α) : lcm k m = lcm k n :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd_lcm dvd_rfl h.dvd)
  (lcm_dvd_lcm dvd_rfl h.symm.dvd)

end lcm

namespace gcd_monoid

theorem prime_of_irreducible [gcd_monoid α] {x : α} (hi: irreducible x) : prime x :=
⟨hi.ne_zero, ⟨hi.1, λ a b h,
begin
  cases gcd_dvd_left x a with y hy,
  cases hi.is_unit_or_is_unit hy with hu hu,
  { right, transitivity (gcd (x * b) (a * b)), apply dvd_gcd (dvd_mul_right x b) h,
    rw (gcd_mul_right' b x a).dvd_iff_dvd_left,
    exact (associated_unit_mul_left _ _ hu).dvd },
  { left,
    rw hy,
    exact dvd_trans (associated_mul_unit_left _ _ hu).dvd (gcd_dvd_right x a) }
end ⟩⟩

theorem irreducible_iff_prime [gcd_monoid α] {p : α} : irreducible p ↔ prime p :=
⟨prime_of_irreducible, prime.irreducible⟩

end gcd_monoid
end gcd_monoid

section unique_unit

variables [comm_cancel_monoid_with_zero α] [unique (units α)]

@[priority 100] -- see Note [lower instance priority]
instance normalization_monoid_of_unique_units : normalization_monoid α :=
{ norm_unit := λ x, 1,
  norm_unit_zero := rfl,
  norm_unit_mul := λ x y hx hy, (mul_one 1).symm,
  norm_unit_coe_units := λ u, subsingleton.elim _ _ }

@[simp] lemma norm_unit_eq_one (x : α) : norm_unit x = 1 := rfl

@[simp] lemma normalize_eq (x : α) : normalize x = x := mul_one x

end unique_unit

section is_domain

variables [comm_ring α] [is_domain α] [normalized_gcd_monoid α]

lemma gcd_eq_of_dvd_sub_right {a b c : α} (h : a ∣ b - c) : gcd a b = gcd a c :=
begin
  apply dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _);
  rw dvd_gcd_iff; refine ⟨gcd_dvd_left _ _, _⟩,
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a b with ⟨e, he⟩,
    rcases gcd_dvd_left a b with ⟨f, hf⟩,
    use e - f * d,
    rw [mul_sub, ← he, ← mul_assoc, ← hf, ← hd, sub_sub_cancel] },
  { rcases h with ⟨d, hd⟩,
    rcases gcd_dvd_right a c with ⟨e, he⟩,
    rcases gcd_dvd_left a c with ⟨f, hf⟩,
    use e + f * d,
    rw [mul_add, ← he, ← mul_assoc, ← hf, ← hd, ← add_sub_assoc, add_comm c b, add_sub_cancel] }
end

lemma gcd_eq_of_dvd_sub_left {a b c : α} (h : a ∣ b - c) : gcd b a = gcd c a :=
by rw [gcd_comm _ a, gcd_comm _ a, gcd_eq_of_dvd_sub_right h]

end is_domain

section constructors
noncomputable theory

open associates

variables [comm_cancel_monoid_with_zero α]

private lemma map_mk_unit_aux [decidable_eq α] {f : associates α →* α}
  (hinv : function.right_inverse f associates.mk) (a : α) :
    a * ↑(classical.some (associated_map_mk hinv a)) = f (associates.mk a) :=
classical.some_spec (associated_map_mk hinv a)

/-- Define `normalization_monoid` on a structure from a `monoid_hom` inverse to `associates.mk`. -/
def normalization_monoid_of_monoid_hom_right_inverse [decidable_eq α] (f : associates α →* α)
  (hinv : function.right_inverse f associates.mk) :
  normalization_monoid α :=
{ norm_unit := λ a, if a = 0 then 1 else
    classical.some (associates.mk_eq_mk_iff_associated.1 (hinv (associates.mk a)).symm),
  norm_unit_zero := if_pos rfl,
  norm_unit_mul := λ a b ha hb, by
  { rw [if_neg (mul_ne_zero ha hb), if_neg ha, if_neg hb, units.ext_iff, units.coe_mul],
    suffices : (a * b) * ↑(classical.some (associated_map_mk hinv (a * b))) =
      (a * ↑(classical.some (associated_map_mk hinv a))) *
      (b * ↑(classical.some (associated_map_mk hinv b))),
    { apply mul_left_cancel₀ (mul_ne_zero ha hb) _,
      simpa only [mul_assoc, mul_comm, mul_left_comm] using this },
    rw [map_mk_unit_aux hinv a, map_mk_unit_aux hinv (a * b), map_mk_unit_aux hinv b,
        ← monoid_hom.map_mul, associates.mk_mul_mk] },
  norm_unit_coe_units := λ u, by
  { nontriviality α,
    rw [if_neg (units.ne_zero u), units.ext_iff],
    apply mul_left_cancel₀ (units.ne_zero u),
    rw [units.mul_inv, map_mk_unit_aux hinv u,
      associates.mk_eq_mk_iff_associated.2 (associated_one_iff_is_unit.2 ⟨u, rfl⟩),
      associates.mk_one, monoid_hom.map_one] } }

/-- Define `gcd_monoid` on a structure just from the `gcd` and its properties. -/
noncomputable def gcd_monoid_of_gcd [decidable_eq α] (gcd : α → α → α)
  (gcd_dvd_left   : ∀a b, gcd a b ∣ a)
  (gcd_dvd_right  : ∀a b, gcd a b ∣ b)
  (dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b) :
  gcd_monoid α :=
{ gcd := gcd,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  lcm := λ a b, if a = 0 then 0 else classical.some ((gcd_dvd_left a b).trans (dvd.intro b rfl)),
  gcd_mul_lcm := λ a b, by
  { split_ifs with a0,
    { rw [mul_zero, a0, zero_mul] },
    { rw ←classical.some_spec ((gcd_dvd_left a b).trans (dvd.intro b rfl)) } },
  lcm_zero_left := λ a, if_pos rfl,
  lcm_zero_right := λ a, by
  { split_ifs with a0, { refl },
    have h := (classical.some_spec ((gcd_dvd_left a 0).trans (dvd.intro 0 rfl))).symm,
    have a0' : gcd a 0 ≠ 0,
    { contrapose! a0,
      rw [←associated_zero_iff_eq_zero, ←a0],
      exact associated_of_dvd_dvd (dvd_gcd (dvd_refl a) (dvd_zero a)) (gcd_dvd_left _ _) },
    apply or.resolve_left (mul_eq_zero.1 _) a0',
    rw [h, mul_zero] } }

/-- Define `normalized_gcd_monoid` on a structure just from the `gcd` and its properties. -/
noncomputable def normalized_gcd_monoid_of_gcd [normalization_monoid α] [decidable_eq α]
  (gcd : α → α → α)
  (gcd_dvd_left   : ∀a b, gcd a b ∣ a)
  (gcd_dvd_right  : ∀a b, gcd a b ∣ b)
  (dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
  (normalize_gcd  : ∀a b, normalize (gcd a b) = gcd a b) :
  normalized_gcd_monoid α :=
{ gcd := gcd,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  normalize_gcd := normalize_gcd,
  lcm := λ a b, if a = 0 then 0 else classical.some (dvd_normalize_iff.2
          ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
  normalize_lcm := λ a b, by
  { dsimp [normalize],
    split_ifs with a0,
    { exact @normalize_zero α _ _ },
    { have := (classical.some_spec (dvd_normalize_iff.2
                  ((gcd_dvd_left a b).trans (dvd.intro b rfl)))).symm,
      set l := classical.some (dvd_normalize_iff.2
          ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
      obtain rfl|hb := eq_or_ne b 0,
      { simp only [normalize_zero, mul_zero, mul_eq_zero] at this,
        obtain ha|hl := this,
        { apply (a0 _).elim,
          rw [←zero_dvd_iff, ←ha],
          exact gcd_dvd_left _ _ },
        { convert @normalize_zero α _ _ } },
      have h1 : gcd a b ≠ 0,
      { have hab : a * b ≠ 0 := mul_ne_zero a0 hb,
        contrapose! hab,
        rw [←normalize_eq_zero, ←this, hab, zero_mul] },
      have h2 : normalize (gcd a b * l) = gcd a b * l,
      { rw [this, normalize_idem] },
      rw ←normalize_gcd at this,
      rwa [normalize.map_mul, normalize_gcd, mul_right_inj' h1] at h2 } },
  gcd_mul_lcm := λ a b, by
  { split_ifs with a0,
    { rw [mul_zero, a0, zero_mul] },
    { rw ←classical.some_spec (dvd_normalize_iff.2 ((gcd_dvd_left a b).trans (dvd.intro b rfl))),
      exact normalize_associated (a * b) } },
  lcm_zero_left := λ a, if_pos rfl,
  lcm_zero_right := λ a, by
  { split_ifs with a0, { refl },
    rw ← normalize_eq_zero at a0,
    have h := (classical.some_spec (dvd_normalize_iff.2
                  ((gcd_dvd_left a 0).trans (dvd.intro 0 rfl)))).symm,
    have gcd0 : gcd a 0 = normalize a,
    { rw ← normalize_gcd,
      exact normalize_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_zero a)) },
    rw ← gcd0 at a0,
    apply or.resolve_left (mul_eq_zero.1 _) a0,
    rw [h, mul_zero, normalize_zero] },
  .. (infer_instance : normalization_monoid α) }

/-- Define `gcd_monoid` on a structure just from the `lcm` and its properties. -/
noncomputable def gcd_monoid_of_lcm [decidable_eq α] (lcm : α → α → α)
  (dvd_lcm_left   : ∀a b, a ∣ lcm a b)
  (dvd_lcm_right  : ∀a b, b ∣ lcm a b)
  (lcm_dvd        : ∀{a b c}, c ∣ a → b ∣ a → lcm c b ∣ a):
  gcd_monoid α :=
let exists_gcd := λ a b, lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl) in
{ lcm := lcm,
  gcd := λ a b, if a = 0 then b else (if b = 0 then a else
    classical.some (exists_gcd a b)),
  gcd_mul_lcm := λ a b, by
  { split_ifs,
    { rw [h, zero_dvd_iff.1 (dvd_lcm_left _ _), mul_zero, zero_mul] },
    { rw [h_1, zero_dvd_iff.1 (dvd_lcm_right _ _), mul_zero] },
    rw [mul_comm, ←classical.some_spec (exists_gcd a b)] },
  lcm_zero_left := λ a, zero_dvd_iff.1 (dvd_lcm_left _ _),
  lcm_zero_right := λ a, zero_dvd_iff.1 (dvd_lcm_right _ _),
  gcd_dvd_left := λ a b, by
  { split_ifs with h h_1,
    { rw h, apply dvd_zero },
    { exact dvd_rfl },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        mul_comm, mul_dvd_mul_iff_right h],
    apply dvd_lcm_right },
  gcd_dvd_right := λ a b, by
  { split_ifs with h h_1,
    { exact dvd_rfl },
    { rw h_1, apply dvd_zero },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        mul_dvd_mul_iff_right h_1],
    apply dvd_lcm_left },
  dvd_gcd := λ a b c ac ab, by
  { split_ifs,
    { exact ab },
    { exact ac },
    have h0 : lcm c b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd c b)],
    rcases ab with ⟨d, rfl⟩,
    rw mul_eq_zero at h_1,
    push_neg at h_1,
    rw [mul_comm a, ← mul_assoc, mul_dvd_mul_iff_right h_1.1],
    apply lcm_dvd (dvd.intro d rfl),
    rw [mul_comm, mul_dvd_mul_iff_right h_1.2],
    apply ac } }

/-- Define `normalized_gcd_monoid` on a structure just from the `lcm` and its properties. -/
noncomputable def normalized_gcd_monoid_of_lcm [normalization_monoid α] [decidable_eq α]
  (lcm : α → α → α)
  (dvd_lcm_left   : ∀a b, a ∣ lcm a b)
  (dvd_lcm_right  : ∀a b, b ∣ lcm a b)
  (lcm_dvd        : ∀{a b c}, c ∣ a → b ∣ a → lcm c b ∣ a)
  (normalize_lcm  : ∀a b, normalize (lcm a b) = lcm a b) :
  normalized_gcd_monoid α :=
let exists_gcd := λ a b, dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl)) in
{ lcm := lcm,
  gcd := λ a b, if a = 0 then normalize b else (if b = 0 then normalize a else
    classical.some (exists_gcd a b)),
  gcd_mul_lcm := λ a b, by
  { split_ifs with h h_1,
    { rw [h, zero_dvd_iff.1 (dvd_lcm_left _ _), mul_zero, zero_mul] },
    { rw [h_1, zero_dvd_iff.1 (dvd_lcm_right _ _), mul_zero, mul_zero] },
    rw [mul_comm, ←classical.some_spec (exists_gcd a b)],
    exact normalize_associated (a * b) },
  normalize_lcm := normalize_lcm,
  normalize_gcd := λ a b, by
  { dsimp [normalize],
    split_ifs with h h_1,
    { apply normalize_idem },
    { apply normalize_idem },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    apply mul_left_cancel₀ h0,
    refine trans _ (classical.some_spec (exists_gcd a b)),
    conv_lhs { congr, rw [← normalize_lcm a b] },
    erw [← normalize.map_mul, ← classical.some_spec (exists_gcd a b), normalize_idem] },
  lcm_zero_left := λ a, zero_dvd_iff.1 (dvd_lcm_left _ _),
  lcm_zero_right := λ a, zero_dvd_iff.1 (dvd_lcm_right _ _),
  gcd_dvd_left := λ a b, by
  { split_ifs,
    { rw h, apply dvd_zero },
    { exact (normalize_associated _).dvd },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_comm, mul_dvd_mul_iff_right h],
    apply dvd_lcm_right },
  gcd_dvd_right := λ a b, by
  { split_ifs,
    { exact (normalize_associated _).dvd },
    { rw h_1, apply dvd_zero },
    have h0 : lcm a b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (exists_gcd a b),
        normalize_dvd_iff, mul_dvd_mul_iff_right h_1],
    apply dvd_lcm_left },
  dvd_gcd := λ a b c ac ab, by
  { split_ifs,
    { apply dvd_normalize_iff.2 ab },
    { apply dvd_normalize_iff.2 ac },
    have h0 : lcm c b ≠ 0,
    { intro con,
      have h := lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl),
      rw [con, zero_dvd_iff, mul_eq_zero] at h,
      cases h; tauto },
    rw [← mul_dvd_mul_iff_left h0, ← classical.some_spec (dvd_normalize_iff.2
        (lcm_dvd (dvd.intro b rfl) (dvd.intro_left c rfl))), dvd_normalize_iff],
    rcases ab with ⟨d, rfl⟩,
    rw mul_eq_zero at h_1,
    push_neg at h_1,
    rw [mul_comm a, ← mul_assoc, mul_dvd_mul_iff_right h_1.1],
    apply lcm_dvd (dvd.intro d rfl),
    rw [mul_comm, mul_dvd_mul_iff_right h_1.2],
    apply ac },
  .. (infer_instance : normalization_monoid α) }

/-- Define a `gcd_monoid` structure on a monoid just from the existence of a `gcd`. -/
noncomputable def gcd_monoid_of_exists_gcd [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, d ∣ a ∧ d ∣ b ↔ d ∣ c) :
  gcd_monoid α :=
gcd_monoid_of_gcd
  (λ a b, (classical.some (h a b)))
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))

/-- Define a `normalized_gcd_monoid` structure on a monoid just from the existence of a `gcd`. -/
noncomputable def normalized_gcd_monoid_of_exists_gcd [normalization_monoid α] [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, d ∣ a ∧ d ∣ b ↔ d ∣ c) :
  normalized_gcd_monoid α :=
normalized_gcd_monoid_of_gcd
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b, normalize_dvd_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, dvd_normalize_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

/-- Define a `gcd_monoid` structure on a monoid just from the existence of an `lcm`. -/
noncomputable def gcd_monoid_of_exists_lcm [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, a ∣ d ∧ b ∣ d ↔ c ∣ d) :
  gcd_monoid α :=
gcd_monoid_of_lcm
  (λ a b, (classical.some (h a b)))
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b,
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))

/-- Define a `normalized_gcd_monoid` structure on a monoid just from the existence of an `lcm`. -/
noncomputable def normalized_gcd_monoid_of_exists_lcm [normalization_monoid α] [decidable_eq α]
  (h : ∀ a b : α, ∃ c : α, ∀ d : α, a ∣ d ∧ b ∣ d ↔ c ∣ d) :
  normalized_gcd_monoid α :=
normalized_gcd_monoid_of_lcm
  (λ a b, normalize (classical.some (h a b)))
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).1)
  (λ a b, dvd_normalize_iff.2
    (((classical.some_spec (h a b) (classical.some (h a b))).2 dvd_rfl)).2)
  (λ a b c ac ab, normalize_dvd_iff.2 ((classical.some_spec (h c b) a).1 ⟨ac, ab⟩))
  (λ a b, normalize_idem _)

end constructors

namespace comm_group_with_zero

variables (G₀ : Type*) [comm_group_with_zero G₀] [decidable_eq G₀]

@[priority 100] -- see Note [lower instance priority]
instance : normalized_gcd_monoid G₀ :=
{ norm_unit := λ x, if h : x = 0 then 1 else (units.mk0 x h)⁻¹,
  norm_unit_zero := dif_pos rfl,
  norm_unit_mul := λ x y x0 y0, units.eq_iff.1 (by simp [x0, y0, mul_comm]),
  norm_unit_coe_units := λ u, by { rw [dif_neg (units.ne_zero _), units.mk0_coe], apply_instance },
  gcd := λ a b, if a = 0 ∧ b = 0 then 0 else 1,
  lcm := λ a b, if a = 0 ∨ b = 0 then 0 else 1,
  gcd_dvd_left := λ a b, by { split_ifs with h, { rw h.1 }, { exact one_dvd _ } },
  gcd_dvd_right := λ a b, by { split_ifs with h, { rw h.2 }, { exact one_dvd _ } },
  dvd_gcd := λ a b c hac hab, begin
    split_ifs with h, { apply dvd_zero },
    cases not_and_distrib.mp h with h h;
      refine is_unit_iff_dvd_one.mp (is_unit_of_dvd_unit _ (is_unit.mk0 _ h));
      assumption
  end,
  gcd_mul_lcm := λ a b, begin
    by_cases ha : a = 0, { simp [ha] },
    by_cases hb : b = 0, { simp [hb] },
    rw [if_neg (not_and_of_not_left _ ha), one_mul, if_neg (not_or ha hb)],
    exact (associated_one_iff_is_unit.mpr ((is_unit.mk0 _ ha).mul (is_unit.mk0 _ hb))).symm
  end,
  lcm_zero_left := λ b, if_pos (or.inl rfl),
  lcm_zero_right := λ a, if_pos (or.inr rfl),
  -- `split_ifs` wants to split `normalize`, so handle the cases manually
  normalize_gcd := λ a b, if h : a = 0 ∧ b = 0 then by simp [if_pos h] else by simp [if_neg h],
  normalize_lcm := λ a b, if h : a = 0 ∨ b = 0 then by simp [if_pos h] else by simp [if_neg h] }

@[simp]
lemma coe_norm_unit {a : G₀} (h0 : a ≠ 0) : (↑(norm_unit a) : G₀) = a⁻¹ :=
by simp [norm_unit, h0]

lemma normalize_eq_one {a : G₀} (h0 : a ≠ 0) : normalize a = 1 :=
by simp [normalize_apply, h0]

end comm_group_with_zero


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

This is about localization of commutative rings and semirings.
The most common approach is to start with a commutative ring
`A` and a subset `S` that contains `1` and is closed under
multiplication.  We then define a set `A[S⁻¹]` of equivalence
classes of fractions `a/s` (with `a ∈ A` and `s ∈ S`), and
introduce a ring structure on `A[S⁻¹]`, and prove various
things about it.  In particular, we prove a universal property.

In this file, we deviate in various ways from the above approach.

Firstly, we work with semirings rather than rings.  This wider
generality has some applications in stable homotopy theory, for
example: given a finite group `G` it is useful to be able to
work with the Burnside semiring of isomorphism classes of finite
`G`-sets, or the representation semiring of isomorphism classes
of finite-dimensional representation, rather than immediately
passing to the group completion.

Secondly, it is technically convenient to take `S` to be a
commutative monoid equipped with a homomorphism `i` from
`S` to the multiplicative monoid of `A`, without insisting
that `i` is just the inclusion of a submonoid, or even that
`i` is injective.  For example, when forming `A[a⁻¹]` for a
single element `a`, we take `S = ℕ` and `i n = aⁿ`.  This
does not cause any real issues.  Triples `(A,S,i)` of this
type play a central role in the theory of log geometry, so
we have chosen to call them "prelog semirings".  We have
bundled the ingredients together as a structure; it is not
clear whether this is the best approach.

Next, to stay as long as possible in the constructive/
effectively computable world, it is useful to introduce as
much structure as possible on the set `A × S` of unreduced
fractions, before passing to equivalence classes.  All semiring
operations can be defined in this context, and most axioms are
satisfied, and the remaining axioms fail in a well-controlled
way.

One thing that is currently missing is as follows.  Suppose
we have `S` and `i` as before, and a semiring homomorphism
`f : A → B`.  Suppose that the homomorphism `f ∘ i` lands in
invertible elements of `B`, or more constructively, that
we have a given homomorphism `j : S → units B` lifting
`f ∘ i`.  (There are some wrinkles here about the fact that
unique existence statements do not give computable witnesses,
which is why we need to qualify the above statement.)  We
then get an induced map `A[S⁻¹] → B`.  We would like to have
a simple criterion for when this map is an isomorphism, or
equivalently when `B` also has the universal property that
characterises `A[S⁻¹]`.  It is not yet clear what is the best
way to formulate this.  Ideally, the resulting maps out of
`B` should be effectively computable in some natural cases.

-/

import algebra.ring group_theory.submonoid ring_theory.ideal.basic linear_algebra.basic
import tactic.ring tactic.abel

namespace localization_alt

universes u v w x

structure prelog_semiring :=
(A : Type u)
(S : Type v)
(A_comm_semiring : comm_semiring A)
(S_comm_monoid : comm_monoid S)
(i : S →* A)

namespace prelog_semiring
open prelog_semiring

instance to_comm_semiring (P : prelog_semiring) : comm_semiring P.A :=
 P.A_comm_semiring

instance to_comm_monoid_S (P : prelog_semiring) : comm_monoid P.S :=
 P.S_comm_monoid

instance to_comm_monoid_A (P : prelog_semiring) : comm_monoid P.A :=
 @comm_semiring.to_comm_monoid P.A P.A_comm_semiring

instance to_monoid_S (P : prelog_semiring) : monoid P.S :=
 @comm_monoid.to_monoid P.S (@prelog_semiring.to_comm_monoid_S P)

instance to_monoid_A (P : prelog_semiring) : monoid P.A :=
 @comm_monoid.to_monoid P.A (@prelog_semiring.to_comm_monoid_A P)

structure preloc (P : prelog_semiring) :=
(numer : P.A) (denom : P.S)

namespace preloc
open preloc

variable {P : prelog_semiring}

notation a `/₀` s := preloc.mk a s

@[ext]
lemma ext : ∀ (a₁ a₂ : P.A) (s₁ s₂ : P.S), a₁ = a₂ → s₁ = s₂ →
 (a₁ /₀ s₁) = (a₂ /₀ s₂) :=
 by { intros; congr; assumption }

lemma ext' : ∀ {x₁ x₂ : preloc P},
 x₁ = x₂ ↔ (x₁.numer = x₂.numer) ∧ (x₁.denom = x₂.denom)
| ⟨_,_⟩ ⟨_,_⟩ := by { simp }

instance : comm_monoid (preloc P) := begin
 let one : (preloc P) := (1 /₀ 1),
 let mul : (preloc P) → (preloc P) → (preloc P) :=
  λ x y, ((x.numer * y.numer) /₀ (x.denom * y.denom)),
 let one_mul : ∀ (x : preloc P), mul one x = x :=
 begin
  intro x,cases x with a s,
  exact congr (congr_arg preloc.mk (one_mul a)) (one_mul s),
 end,
 let mul_one : ∀ (x : preloc P), mul x one = x :=
 begin
  intro x,cases x with a s,
  exact congr (congr_arg preloc.mk (mul_one a)) (mul_one s),
 end,
 let mul_comm : ∀ x y, mul x y = mul y x :=
 begin
  intros x y,cases x with a s,cases y with b t,
  exact @congr P.S (preloc P) _ _ _ _
    (congr_arg (@preloc.mk P) (mul_comm a b)) (mul_comm s t),
 end,
 let mul_assoc : ∀ x y z, mul (mul x y) z = mul x (mul y z) :=
 begin
  intros x y z,cases x with a s, cases y with b t, cases z with c u,
  exact @congr P.S (preloc P) _ _ _ _
    (congr_arg (@preloc.mk P) (mul_assoc a b c)) (mul_assoc s t u),
 end,
 exact {
     one := one, mul := mul,
     mul_one := mul_one, one_mul := one_mul,
     mul_comm := mul_comm, mul_assoc := mul_assoc
 }
end

instance : add_comm_monoid (preloc P) := begin
 let zero : (preloc P) := (0 /₀ 1),
 let add : (preloc P) → (preloc P) → (preloc P) :=
  λ x y, ((x.numer * (P.i y.denom) + (P.i x.denom) * y.numer) /₀
          (x.denom * y.denom)),
 let zero_add : ∀ (x : preloc P), add zero x = x :=
 begin
  intro x,cases x with a s,
  let h0 := (congr_fun (congr_arg P.A_comm_semiring.mul P.i.map_one) a),
  let h1 := congr (congr_arg P.A_comm_semiring.add (zero_mul (P.i s))) h0,
  let h2 := h1.trans ((zero_add (1 * a)).trans (one_mul a)),
  exact congr (congr_arg preloc.mk h2) (one_mul s),
 end,
 let add_zero : ∀ (x : preloc P), add x zero = x :=
 begin
  intro x,cases x with a s,
  dsimp[zero,add],
  let h0 := (congr_arg ((*) a) P.i.map_one).trans (mul_one a),
  let h1 := (congr (congr_arg (+) h0) (mul_zero (P.i s))).trans (add_zero a),
  exact congr (congr_arg preloc.mk h1) (mul_one s),
 end,
 let add_comm : ∀ x y, add x y = add y x :=
 begin
  intros x y,cases x with a s,cases y with b t,
  dsimp[add],
  rw[mul_comm s t,mul_comm a (P.i t),mul_comm (P.i s) b,add_comm],
 end,
 let add_assoc : ∀ x y z, add (add x y) z = add x (add y z) :=
 begin
  intros x y z,cases x with a s, cases y with b t, cases z with c u,
  dsimp[add],
  rw[P.i.map_mul,P.i.map_mul,add_mul,mul_add],
  rw[add_assoc,mul_assoc s t u,mul_assoc a (P.i t) (P.i u),
     mul_assoc (P.i s) b (P.i u),mul_assoc (P.i s) (P.i t) c],
 end,
 exact {
     zero := zero, add := add,
     add_zero := add_zero, zero_add := zero_add,
     add_comm := add_comm, add_assoc := add_assoc
 },
end

lemma numer_def (a : P.A) (s : P.S) : (a /₀ s).numer = a := rfl
lemma denom_def (a : P.A) (s : P.S) : (a /₀ s).denom = s := rfl
lemma numer_zero : @preloc.numer P 0 = 0 := rfl
lemma denom_zero : @preloc.denom P 0 = 1 := rfl
lemma numer_one  : @preloc.numer P 1 = 1 := rfl
lemma denom_one  : @preloc.denom P 1 = 1 := rfl

lemma one_def  : (1 : preloc P) = (1 /₀ 1) := rfl
lemma mul_def (x y : preloc P) :
 x * y = ((x.numer * y.numer) /₀ (x.denom * y.denom)) := rfl
lemma mul_def' (a b : P.A) (s t : P.S) :
 (a /₀ s) * (b /₀ t) = ((a * b) /₀ (s * t)) := rfl
lemma zero_def : (0 : preloc P) = (0 /₀ 1) := rfl
lemma add_def (x y : preloc P) :
 x + y = (((x.numer * (P.i y.denom) + (P.i x.denom) * y.numer):P.A) /₀
          (x.denom * y.denom)) := rfl
lemma add_def' (a b : P.A) (s t : P.S) :
 (a /₀ s) + (b /₀ t) = (((a * (P.i t) + (P.i s) * b)) /₀ (s * t)) := rfl

def η₀ (a : P.A) : preloc P := a /₀ 1

lemma numer_eta (a : P.A) : (η₀ a).numer = a := rfl
lemma denom_eta (a : P.A) : (η₀ a).denom = 1 := rfl

lemma eta_map_zero : @η₀ P 0 = 0 := rfl
lemma eta_map_one  : @η₀ P 1 = 1 := rfl

lemma eta_map_mul (a b : P.A) : η₀ (a * b) = (η₀ a) * (η₀ b) :=
begin
 ext,
 rw[numer_eta,numer_eta],
 rw[denom_eta,denom_eta,mul_one]
end

lemma eta_map_add (a b : P.A) : η₀ (a + b) = (η₀ a) + (η₀ b) :=
begin
 ext,
 rw[numer_eta,numer_eta,denom_eta,denom_eta,
    P.i.map_one,mul_one,one_mul],
 rw[denom_eta,denom_eta,mul_one],
end

structure R (x x' : preloc P) :=
 (s : P.S)
 (e : P.i (s * x'.denom) * x.numer = P.i (s * x.denom) * x'.numer)

def R_refl (x : preloc P) : R x x :=
 {s := 1, e := rfl}

def R_symm {x x' : preloc P} (m : R x x') : R x' x :=
 {s := m.s, e := m.e.symm}

def R_trans {x x' x'' : preloc P} (m : R x x') (n : R x' x'') : R x x'' :=
begin
  rcases x with ⟨a,u⟩, rcases x' with ⟨a',u'⟩, rcases x'' with ⟨a'',u''⟩,
  let ss := m.s * n.s * u',
  let ee := calc
   P.i (ss * u'') * a = P.i (n.s * u'') * (P.i (m.s * u') * a)
    : by {repeat {rw[P.i.map_mul]}, ring,}
   ... = P.i (n.s * u'') * (P.i (m.s * u) * a') : by rw[m.e]
   ... = P.i (m.s * u) * (P.i (n.s * u'') * a') : by ring
   ... = P.i (m.s * u) * (P.i (n.s * u') * a'') : by rw[n.e]
   ... = P.i (ss * u) * a''
    : by {repeat {rw[P.i.map_mul]}, ring,},
   exact { s := ss, e := ee }
end

def R_zero : (R 0 0) := R_refl (0 : preloc P)

def R_one : (R 1 1) := R_refl (1 : preloc P)

def R_add {x y x' y' : preloc P} (m : R x x') (n : R y y') :
 R (x + y) (x' + y') :=
begin
 rcases x with ⟨a,u⟩, rcases x' with ⟨a',u'⟩,
 rcases y with ⟨b,v⟩, rcases y' with ⟨b',v'⟩,
 let ss := m.s * n.s,
 let ee := calc
     (P.i (ss * (u' * v'))) * (a * (P.i v) + (P.i u) * b)
       = P.i (n.s * v * v') * (P.i (m.s * u') * a) +
         P.i (m.s * u * u') * (P.i (n.s * v') * b)
         : by {repeat {rw[P.i.map_mul]}, ring,}
   ... = P.i (n.s * v * v') * (P.i (m.s * u) * a') +
         P.i (m.s * u * u') * (P.i (n.s * v) * b')
         : by rw[m.e,n.e]
   ... = (P.i (ss * (u * v))) * (a' * (P.i v') + (P.i u') * b')
         : by {repeat {rw[P.i.map_mul]}, ring,},
  exact { s := ss, e := ee },
end

def R_mul {x y x' y' : preloc P} (m : R x x') (n : R y y') :
 R (x * y) (x' * y') :=
begin
 rcases x with ⟨a,u⟩, rcases x' with ⟨a',u'⟩,
 rcases y with ⟨b,v⟩, rcases y' with ⟨b',v'⟩,
 let ss := m.s * n.s,
 let ee := calc
     (P.i (ss * (u' * v'))) * (a * b)
       = (P.i (m.s * u') * a) * (P.i (n.s * v') * b)
         : by {repeat {rw[P.i.map_mul]}, ring,}
   ... =  (P.i (m.s * u) * a') * (P.i (n.s * v) * b')
         : by rw[m.e,n.e]
   ... = (P.i (ss * (u * v))) * (a' * b')
         : by {repeat {rw[P.i.map_mul]}, ring,},
  exact { s := ss, e := ee },
end

def R_zero_mul : ∀ (x : preloc P), R (0 * x) 0
| ⟨a,u⟩ := {s := 1,e := begin
  show (P.i (1 * 1)) * (0 * a) = (P.i (1 * (1 * u))) * 0,
  rw[_root_.zero_mul,_root_.mul_zero,_root_.mul_zero],
end}

def R_mul_zero : ∀ (x : preloc P), R (x * 0) 0
| ⟨a,u⟩ := {s := 1,e := begin
  show (P.i (1 * 1)) * (a * 0) = (P.i (1 * (u * 1))) * 0,
  repeat {rw[_root_.mul_zero]},
end}

def R_mul_add (x y z : preloc P) : R (x * (y + z)) (x * y + x * z) :=
begin
 rcases x with ⟨a,u⟩, rcases y with ⟨b,v⟩, rcases z with ⟨c,w⟩,
 have e : (P.i (1 * ((u * v) * (u * w)))) *
            (a * (b * (P.i w) + (P.i v) * c)) =
          (P.i (1 * (u * (v *w)))) *
            ((a * b) * P.i (u * w) + P.i (u * v) * (a * c)) :=
  by {repeat {rw[P.i.map_mul]}, ring,},
  exact {s := 1, e := e},
end

def R_add_mul (x y z : preloc P) : R ((x + y) * z) (x * z + y * z) :=
begin
 rcases x with ⟨a,u⟩, rcases y with ⟨b,v⟩, rcases z with ⟨c,w⟩,
 have e : (P.i (1 * ((u * w) * (v * w)))) *
            ((a * (P.i v) + (P.i u) * b) * c) =
          (P.i (1 * (u * v *w))) *
            ((a * c) * P.i (v * w) + P.i (u * w) * (b * c)) :=
  by {repeat {rw[P.i.map_mul]}, ring,},
  exact {s := 1, e := e},
end

variable (P)

instance loc_equiv : setoid (preloc P) := {
 r := λ x x', nonempty (R x x'),
 iseqv := ⟨λ x,⟨R_refl x⟩,
  λ x x',by {rintro ⟨m⟩,exact ⟨R_symm m⟩},
  λ x x' x'',by {rintros ⟨m⟩ ⟨n⟩, exact ⟨R_trans m n⟩}⟩
}

lemma r_add {x y x' y' : preloc P} : ∀ (m : x ≈ x') (n : y ≈ y'),
 (x + y) ≈ (x' + y')
| ⟨m⟩ ⟨n⟩ := ⟨R_add m n⟩

lemma r_mul {x y x' y' : preloc P} : ∀ (m : x ≈ x') (n : y ≈ y'),
 (x * y) ≈ (x' * y')
| ⟨m⟩ ⟨n⟩ := ⟨R_mul m n⟩

end preloc

def loc (P : prelog_semiring) := quotient (preloc.loc_equiv P)

namespace loc

variable {P : prelog_semiring}

def mk0 : (preloc P) → (loc P) := quotient.mk
def mk (a : P.A) (s : P.S) : loc P := mk0 (a /₀ s)

notation a `/₁` s := loc.mk a s

instance : comm_semiring (loc P) := {
  zero := mk0 0,
  one := mk0 1,
  add := quotient.lift₂
          (λ x y, mk0 (x + y))
          (λ x y x' y' m n, quotient.sound (@preloc.r_add P x y x' y' m n)),
  mul := quotient.lift₂
          (λ x y, mk0 (x * y))
          (λ x y x' y' m n, quotient.sound (@preloc.r_mul P x y x' y' m n)),
  zero_add := λ x,by {rcases x,exact congr_arg mk0 (zero_add x),},
  add_zero := λ x,by {rcases x,exact congr_arg mk0 (add_zero x),},
  one_mul  := λ x,by {rcases x,exact congr_arg mk0 (one_mul x),},
  mul_one  := λ x,by {rcases x,exact congr_arg mk0 (mul_one x),},
  zero_mul := λ x,by {rcases x,exact quotient.sound ⟨preloc.R_zero_mul x⟩,},
  mul_zero := λ x,by {rcases x,exact quotient.sound ⟨preloc.R_mul_zero x⟩,},
  add_comm := λ x y,by {rcases x, rcases y, exact congr_arg mk0 (add_comm x y)},
  mul_comm := λ x y,by {rcases x, rcases y, exact congr_arg mk0 (mul_comm x y)},
  add_assoc := λ x y z,by {rcases x,rcases y,rcases z,
                           exact congr_arg mk0 (add_assoc x y z)},
  mul_assoc := λ x y z,by {rcases x,rcases y,rcases z,
                           exact congr_arg mk0 (mul_assoc x y z)},
  left_distrib := λ x y z,by {rcases x,rcases y,rcases z,
    exact quotient.sound ⟨@preloc.R_mul_add P x y z⟩,
  },
  right_distrib := λ x y z,by {rcases x,rcases y,rcases z,
    exact quotient.sound ⟨@preloc.R_add_mul P x y z⟩,
  },
}

def η {P : prelog_semiring} : P.A →+* (loc P) := {
 to_fun :=  λ a, a /₁ 1,
 map_zero' := rfl,
 map_one' := rfl,
 map_add' := λ a b,congr_arg mk0 (preloc.eta_map_add a b),
 map_mul' := λ a b, begin
  have := preloc.eta_map_mul a b,
  have := congr_arg mk0 this,
  exact this
 end
}

def ζ (s : P.S) : units (loc P) := begin
  let val : loc P := ((P.i s) /₁ 1),
  let inv : loc P := (1 /₁ s),
  let val_inv : val * inv = 1 := begin
   show mk0 (((P.i s) * 1) /₀ (1 * s)) = mk0 (1 /₀ 1),
   let h : (((P.i s) * 1) /₀ (1 * s)) ≈ (1 /₀ 1) :=
    ⟨{ s := 1 , e := by {simp[P.i.map_one],}}⟩ ,
   exact quotient.sound h,
  end,
  let inv_val := (mul_comm inv val).trans val_inv,
  exact { val := val, inv := inv, val_inv := val_inv, inv_val := inv_val },
end

end loc

end prelog_semiring

end localization_alt


import Mathlib.Algebra.Hom.Group
import Mathlib.GroupTheory.Submonoid.Operations
import UnitConjecture.Cocycle

/-!

## Metabelian groups

Metabelian groups are group extensions `1 → K → G → Q → 1` with both the kernel and the quotient Abelian.
Such an extension is determined by data:

* a group action of `Q` on `K` by automorphisms
* a cocyle `c: Q → Q → K`

We define the cocycle condition and construct a group structure on a structure extending `K × Q`.
The main step is to show that the cocyle condition implies associativity.
-/

namespace MetabelianGroup

variable {Q K : Type _} [AddGroup Q] [AddCommGroup K]
variable (c : Q → Q → K) [ccl : Cocycle c]

declare_aesop_rule_sets [Metabelian]

/-- The multiplication operation defined using the cocycle.
The cocycle condition is crucially used in showing associativity and other properties. -/
@[reducible, aesop norm unfold (rule_sets [Metabelian])]
def mul : (K × Q) → (K × Q) → (K × Q)
  | (k, q), (k', q') => (k + (q +ᵥ k') + c q q', q + q')

/-- The identity element of the Metabelian group,
  which is the ordered pair of the identities of the individual groups. -/
@[reducible, aesop norm unfold (rule_sets [Metabelian])]
def e : K × Q := (0, 0)

/-- The inverse operation of the Metabelian group. -/
@[reducible, aesop norm unfold (rule_sets [Metabelian])]
def inv : K × Q → K × Q
  | (k, q) => (- ((-q) +ᵥ (k  + c q (-q))), -q)

/-!
Some of the standard lemmas to show that `K × Q` has the structure of a group with the above operations.
-/

@[aesop norm (rule_sets [Metabelian])]
lemma left_id : ∀ (g : K × Q), mul c e g = g
  | (k, q) => by aesop (rule_sets [Cocycle, Metabelian])

@[aesop norm (rule_sets [Metabelian])]
lemma right_id : ∀ (g : K × Q), mul c g e = g
  | (k, q) => by aesop (rule_sets [Cocycle, Metabelian, AutAction])

@[aesop norm (rule_sets [Metabelian])]
lemma left_inv : ∀ (g : K × Q), mul c (inv c g) g = e
  | (k , q) => by
    have := Cocycle.inv_rel' c q
    aesop (rule_sets [Metabelian, Cocycle, AutAction])

@[aesop norm (rule_sets [Metabelian])]
lemma right_inv : ∀ (g : K × Q), mul c g (inv c g) = e
  | (k, q) => by aesop (rule_sets [Metabelian, Cocycle, AutAction])

@[aesop unsafe (rule_sets [Metabelian])]
theorem mul_assoc : ∀ (g g' g'' : K × Q), mul c (mul c g g') g'' =  mul c g (mul c g' g'')
  | (k, q), (k', q'), (k'', q'') => by
    aesop (rule_sets [Metabelian, Cocycle, AutAction])
        (options := {terminal := false, warnOnNonterminal := false})
    · simp only [add_assoc, add_left_cancel_iff]
      rw [add_left_comm, add_left_cancel_iff]
      -- The cocycle condition is precisely what is required for the associativity of multiplication
      exact ccl.cocycle_condition q q' q''
    · apply add_assoc

/-- A group structure on `K × Q` using the above multiplication operation. -/
instance metabelianGroup : Group (K × Q) :=
  {
    mul := mul c,
    one := e,
    inv := inv c,

    mul_one := right_id c,
    one_mul := left_id c,
    mul_assoc := mul_assoc c,

    mul_left_inv := left_inv c,
    div_eq_mul_inv := by intros; rfl
  }

@[aesop norm simp (rule_sets [Metabelian])]
theorem mul_def {k k' : K} {q q' : Q} : (k, q) * (k', q') = (k + (q +ᵥ k') + c q q', q + q') := rfl

lemma kernel_pow (k : K) (n : ℕ) : (k, (0 : Q)) ^ n = (n • k, (0 : Q)) := by
  induction n <;>
      aesop (rule_sets [Metabelian, Cocycle])
      (add norm simp [pow_zero, pow_succ, zero_nsmul, succ_nsmul])

section Exactness

/-!
### Exactness

A proof that the Metabelian group `G` constructed as above indeed lies in middle of
the short exact sequence `1 → K → G → Q → 1`.
-/

/-- The inclusion map from the kernel to the Metabelian group. -/
@[aesop norm unfold (rule_sets [Metabelian])]
def Kernel.inclusion : (Multiplicative K) →* (K × Q) :=
  { toFun := (·, (0 : Q)),
    map_one' := rfl,
    map_mul' := by aesop (rule_sets [Metabelian, Cocycle]) }

/-- A proof that the inclusion map is injective. -/
theorem Kernel.inclusion_inj : Function.Injective (Kernel.inclusion c) := by
  intros _ _; simp [Kernel.inclusion]

/--- The projection map from the Metabelian group to the quotient. -/
@[aesop norm unfold (rule_sets [Metabelian])]
def Quotient.projection : K × Q →* (Multiplicative Q) :=
  { toFun := Prod.snd,
    map_one' := rfl
    map_mul' := by intro ⟨_, _⟩ ⟨_, _⟩; rfl }

/-- A proof that the projection map is surjective. -/
theorem Quotient.projection_surj : Function.Surjective (Quotient.projection c) := by
  intro q; use ⟨(0 : K), q⟩

/-- A proof that the image of the first map is the kernel of the second map. -/
theorem exact_seq : MonoidHom.mrange (Kernel.inclusion c) = MonoidHom.mker (Quotient.projection c) := by
  ext ⟨_, _⟩; aesop (rule_sets [Metabelian]) (add norm [MonoidHom.mem_mker])

end Exactness

end MetabelianGroup


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.metric_space.gluing
! leanprover-community/mathlib commit e1a7bdeb4fd826b7e71d130d34988f0a2d26a177
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.MetricSpace.Isometry

/-!
# Metric space gluing

Gluing two metric spaces along a common subset. Formally, we are given

```
     Φ
  Z ---> X
  |
  |Ψ
  v
  Y
```
where `hΦ : Isometry Φ` and `hΨ : Isometry Ψ`.
We want to complete the square by a space `glue_space hΦ hΨ` and two isometries
`to_glue_l hΦ hΨ` and `to_glue_r hΦ hΨ` that make the square commute.
We start by defining a predistance on the disjoint union `X ⊕ Y`, for which
points `Φ p` and `Ψ p` are at distance 0. The (quotient) metric space associated
to this predistance is the desired space.

This is an instance of a more general construction, where `Φ` and `Ψ` do not have to be isometries,
but the distances in the image almost coincide, up to `2ε` say. Then one can almost glue the two
spaces so that the images of a point under `Φ` and `Ψ` are `ε`-close. If `ε > 0`, this yields a
metric space structure on `X ⊕ Y`, without the need to take a quotient. In particular,
this gives a natural metric space structure on `X ⊕ Y`, where the basepoints
are at distance 1, say, and the distances between other points are obtained by going through the two
basepoints.
(We also register the same metric space structure on a general disjoint union `Σ i, E i`).

We also define the inductive limit of metric spaces. Given
```
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
```
where the `X n` are metric spaces and `f n` isometric embeddings, we define the inductive
limit of the `X n`, also known as the increasing union of the `X n` in this context, if we
identify `X n` and `X (n+1)` through `f n`. This is a metric space in which all `X n` embed
isometrically and in a way compatible with `f n`.

-/

noncomputable section

universe u v w

open Function Set Uniformity Topology

namespace Metric

section ApproxGluing

variable {X : Type u} {Y : Type v} {Z : Type w}

variable [MetricSpace X] [MetricSpace Y] {Φ : Z → X} {Ψ : Z → Y} {ε : ℝ}

/-- Define a predistance on `X ⊕ Y`, for which `Φ p` and `Ψ p` are at distance `ε` -/
def glueDist (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : Sum X Y → Sum X Y → ℝ
  | .inl x, .inl y => dist x y
  | .inr x, .inr y => dist x y
  | .inl x, .inr y => (⨅ p, dist x (Φ p) + dist y (Ψ p)) + ε
  | .inr x, .inl y => (⨅ p, dist y (Φ p) + dist x (Ψ p)) + ε
#align metric.glue_dist Metric.glueDist

private theorem glueDist_self (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : ∀ x, glueDist Φ Ψ ε x x = 0
  | .inl _ => dist_self _
  | .inr _ => dist_self _

theorem glueDist_glued_points [Nonempty Z] (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (p : Z) :
    glueDist Φ Ψ ε (.inl (Φ p)) (.inr (Ψ p)) = ε := by
  have : (⨅ q, dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q)) = 0 := by
    have A : ∀ q, 0 ≤ dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q) := fun _ =>
      add_nonneg dist_nonneg dist_nonneg
    refine' le_antisymm _ (le_cinfᵢ A)
    have : 0 = dist (Φ p) (Φ p) + dist (Ψ p) (Ψ p) := by simp
    rw [this]
    exact cinfᵢ_le ⟨0, forall_range_iff.2 A⟩ p
  simp only [glueDist, this, zero_add]
#align metric.glue_dist_glued_points Metric.glueDist_glued_points

private theorem glueDist_comm (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) :
    ∀ x y, glueDist Φ Ψ ε x y = glueDist Φ Ψ ε y x
  | .inl _, .inl _ => dist_comm _ _
  | .inr _, .inr _ => dist_comm _ _
  | .inl _, .inr _ => rfl
  | .inr _, .inl _ => rfl

theorem glueDist_swap (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) :
    ∀ x y, glueDist Ψ Φ ε x.swap y.swap = glueDist Φ Ψ ε x y
  | .inl _, .inl _ => rfl
  | .inr _, .inr _ => rfl
  | .inl _, .inr _ => by simp only [glueDist, Sum.swap_inl, Sum.swap_inr, dist_comm, add_comm]
  | .inr _, .inl _ => by simp only [glueDist, Sum.swap_inl, Sum.swap_inr, dist_comm, add_comm]

theorem le_glueDist_inl_inr (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (x y) :
    ε ≤ glueDist Φ Ψ ε (.inl x) (.inr y) :=
  le_add_of_nonneg_left <| Real.infᵢ_nonneg fun _ => add_nonneg dist_nonneg dist_nonneg

theorem le_glueDist_inr_inl (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (x y) :
    ε ≤ glueDist Φ Ψ ε (.inr x) (.inl y) := by
  rw [glueDist_comm]; apply le_glueDist_inl_inr

variable [Nonempty Z]

private theorem glueDist_triangle_inl_inr_inr (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (x : X) (y z : Y) :
    glueDist Φ Ψ ε (.inl x) (.inr z) ≤
      glueDist Φ Ψ ε (.inl x) (.inr y) + glueDist Φ Ψ ε (.inr y) (.inr z) := by
  simp only [glueDist]
  rw [add_right_comm, add_le_add_iff_right]
  refine le_cinfᵢ_add fun p => cinfᵢ_le_of_le ⟨0, ?_⟩ p ?_
  · exact forall_range_iff.2 fun _ => add_nonneg dist_nonneg dist_nonneg
  · linarith [dist_triangle_left z (Ψ p) y]

private theorem glueDist_triangle_inl_inr_inl (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
    (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) (x : X) (y : Y) (z : X) :
    glueDist Φ Ψ ε (.inl x) (.inl z) ≤
      glueDist Φ Ψ ε (.inl x) (.inr y) + glueDist Φ Ψ ε (.inr y) (.inl z) := by
  simp_rw [glueDist, add_add_add_comm _ ε, add_assoc]
  refine le_cinfᵢ_add fun p => ?_
  rw [add_left_comm, add_assoc, ← two_mul]
  refine le_cinfᵢ_add fun q => ?_
  rw [dist_comm z]
  linarith [dist_triangle4 x (Φ p) (Φ q) z, dist_triangle_left (Ψ p) (Ψ q) y, (abs_le.1 (H p q)).2]

private theorem glueDist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
    (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) :
    ∀ x y z, glueDist Φ Ψ ε x z ≤ glueDist Φ Ψ ε x y + glueDist Φ Ψ ε y z
  | .inl x, .inl y, .inl z => dist_triangle _ _ _
  | .inr x, .inr y, .inr z => dist_triangle _ _ _
  | .inr x, .inl y, .inl z => by
    simp only [← glueDist_swap Φ]
    apply glueDist_triangle_inl_inr_inr
  | .inr x, .inr y, .inl z => by
    simpa only [glueDist_comm, add_comm] using glueDist_triangle_inl_inr_inr _ _ _ z y x
  | .inl x, .inl y, .inr z => by
    simpa only [← glueDist_swap Φ, glueDist_comm, add_comm, Sum.swap_inl, Sum.swap_inr]
      using glueDist_triangle_inl_inr_inr Ψ Φ ε z y x
  | .inl x, .inr y, .inr z => glueDist_triangle_inl_inr_inr ..
  | .inl x, .inr y, .inl z => glueDist_triangle_inl_inr_inl Φ Ψ ε H x y z
  | .inr x, .inl y, .inr z => by
    simp only [← glueDist_swap Φ]
    apply glueDist_triangle_inl_inr_inl
    simpa only [abs_sub_comm]

private theorem eq_of_glueDist_eq_zero (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε) :
    ∀ p q : Sum X Y, glueDist Φ Ψ ε p q = 0 → p = q
  | .inl x, .inl y, h => by rw [eq_of_dist_eq_zero h]
  | .inl x, .inr y, h => by exfalso; linarith [le_glueDist_inl_inr Φ Ψ ε x y]
  | .inr x, .inl y, h => by exfalso; linarith [le_glueDist_inr_inl Φ Ψ ε x y]
  | .inr x, .inr y, h => by rw [eq_of_dist_eq_zero h]

/-- Given two maps `Φ` and `Ψ` intro metric spaces `X` and `Y` such that the distances between
`Φ p` and `Φ q`, and between `Ψ p` and `Ψ q`, coincide up to `2 ε` where `ε > 0`, one can almost
glue the two spaces `X` and `Y` along the images of `Φ` and `Ψ`, so that `Φ p` and `Ψ p` are
at distance `ε`. -/
def glueMetricApprox (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε)
    (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) : MetricSpace (X ⊕ Y) where
  dist := glueDist Φ Ψ ε
  dist_self := glueDist_self Φ Ψ ε
  dist_comm := glueDist_comm Φ Ψ ε
  dist_triangle := glueDist_triangle Φ Ψ ε H
  edist_dist _ _ := by exact ENNReal.coe_nnreal_eq _
  eq_of_dist_eq_zero := eq_of_glueDist_eq_zero Φ Ψ ε ε0 _ _
#align metric.glue_metric_approx Metric.glueMetricApprox

end ApproxGluing

section Sum

/-!
### Metric on `X ⊕ Y`

A particular case of the previous construction is when one uses basepoints in `X` and `Y` and one
glues only along the basepoints, putting them at distance 1. We give a direct definition of
the distance, without `infᵢ`, as it is easier to use in applications, and show that it is equal to
the gluing distance defined above to take advantage of the lemmas we have already proved.
-/
variable {X : Type u} {Y : Type v} {Z : Type w}

variable [MetricSpace X] [MetricSpace Y]

/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
If the two spaces are bounded, one can say for instance that each point in the first is at distance
`diam X + diam Y + 1` of each point in the second.
Instead, we choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1,
arbitrarily, and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def Sum.dist : Sum X Y → Sum X Y → ℝ
  | .inl a, .inl a' => dist a a'
  | .inr b, .inr b' => dist b b'
  | .inl a, .inr b => dist a (Nonempty.some ⟨a⟩) + 1 + dist (Nonempty.some ⟨b⟩) b
  | .inr b, .inl a => dist b (Nonempty.some ⟨b⟩) + 1 + dist (Nonempty.some ⟨a⟩) a
#align metric.sum.dist Metric.Sum.dist

theorem Sum.dist_eq_glueDist {p q : X ⊕ Y} (x : X) (y : Y) :
    Sum.dist p q =
      glueDist (fun _ : Unit => Nonempty.some ⟨x⟩) (fun _ : Unit => Nonempty.some ⟨y⟩) 1 p q := by
  cases p <;> cases q <;> first |rfl|simp [Sum.dist, glueDist, dist_comm, add_comm,
    add_left_comm, add_assoc]
#align metric.sum.dist_eq_glue_dist Metric.Sum.dist_eq_glueDist

private theorem Sum.dist_comm (x y : X ⊕ Y) : Sum.dist x y = Sum.dist y x := by
  cases x <;> cases y <;> simp [Sum.dist, _root_.dist_comm, add_comm, add_left_comm, add_assoc]

theorem Sum.one_le_dist_inl_inr {x : X} {y : Y} : 1 ≤ Sum.dist (.inl x) (.inr y) :=
  le_trans (le_add_of_nonneg_right dist_nonneg) <|
    add_le_add_right (le_add_of_nonneg_left dist_nonneg) _
#align metric.sum.one_dist_le Metric.Sum.one_le_dist_inl_inr

theorem Sum.one_le_dist_inr_inl {x : X} {y : Y} : 1 ≤ Sum.dist (.inr y) (.inl x) := by
  rw [Sum.dist_comm]; exact Sum.one_le_dist_inl_inr
#align metric.sum.one_dist_le' Metric.Sum.one_le_dist_inr_inl

private theorem Sum.mem_uniformity (s : Set (Sum X Y × Sum X Y)) :
    s ∈ 𝓤 (X ⊕ Y) ↔ ∃ ε > 0, ∀ a b, Sum.dist a b < ε → (a, b) ∈ s := by
  constructor
  · rintro ⟨hsX, hsY⟩
    rcases mem_uniformity_dist.1 hsX with ⟨εX, εX0, hX⟩
    rcases mem_uniformity_dist.1 hsY with ⟨εY, εY0, hY⟩
    refine' ⟨min (min εX εY) 1, lt_min (lt_min εX0 εY0) zero_lt_one, _⟩
    rintro (a | a) (b | b) h
    · exact hX (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_left _ _)))
    · cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) Sum.one_le_dist_inl_inr
    · cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) Sum.one_le_dist_inr_inl
    · exact hY (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_right _ _)))
  · rintro ⟨ε, ε0, H⟩
    constructor <;> rw [Filter.mem_sets, Filter.mem_map, mem_uniformity_dist] <;>
      exact ⟨ε, ε0, fun h => H _ _ h⟩

/-- The distance on the disjoint union indeed defines a metric space. All the distance properties
follow from our choice of the distance. The harder work is to show that the uniform structure
defined by the distance coincides with the disjoint union uniform structure. -/
def metricSpaceSum : MetricSpace (X ⊕ Y) where
  dist := Sum.dist
  dist_self x := by cases x <;> simp only [Sum.dist, dist_self]
  dist_comm := Sum.dist_comm
  dist_triangle
    | .inl p, .inl q, .inl r => dist_triangle p q r
    | .inl p, .inr q, _ => by
      simp only [Sum.dist_eq_glueDist p q]
      exact glueDist_triangle _ _ _ (by norm_num) _ _ _
    | _, .inl q, .inr r => by
      simp only [Sum.dist_eq_glueDist q r]
      exact glueDist_triangle _ _ _ (by norm_num) _ _ _
    | .inr p, _, .inl r => by
      simp only [Sum.dist_eq_glueDist r p]
      exact glueDist_triangle _ _ _ (by norm_num) _ _ _
    | .inr p, .inr q, .inr r => dist_triangle p q r
  eq_of_dist_eq_zero {p q} h := by
    cases' p with p p <;> cases' q with q q
    · rw [eq_of_dist_eq_zero h]
    · exact eq_of_glueDist_eq_zero _ _ _ one_pos _ _ ((Sum.dist_eq_glueDist p q).symm.trans h)
    · exact eq_of_glueDist_eq_zero _ _ _ one_pos _ _ ((Sum.dist_eq_glueDist q p).symm.trans h)
    · rw [eq_of_dist_eq_zero h]
  edist_dist _ _ := by exact ENNReal.coe_nnreal_eq _
  toUniformSpace := Sum.uniformSpace
  uniformity_dist := uniformity_dist_of_mem_uniformity _ _ Sum.mem_uniformity
#align metric.metric_space_sum Metric.metricSpaceSum

attribute [local instance] metricSpaceSum

theorem Sum.dist_eq {x y : Sum X Y} : dist x y = Sum.dist x y := rfl
#align metric.sum.dist_eq Metric.Sum.dist_eq

/-- The left injection of a space in a disjoint union is an isometry -/
theorem isometry_inl : Isometry (Sum.inl : X → Sum X Y) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.isometry_inl Metric.isometry_inl

/-- The right injection of a space in a disjoint union is an isometry -/
theorem isometry_inr : Isometry (Sum.inr : Y → Sum X Y) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.isometry_inr Metric.isometry_inr

end Sum

namespace Sigma

/- Copy of the previous paragraph, but for arbitrary disjoint unions instead of the disjoint union
of two spaces. I.e., work with sigma types instead of sum types. -/
variable {ι : Type _} {E : ι → Type _} [∀ i, MetricSpace (E i)]

open Classical

/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
We choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def dist : (Σ i, E i) → (Σ i, E i) → ℝ
  | ⟨i, x⟩, ⟨j, y⟩ =>
    if h : i = j then
      haveI : E j = E i := by rw [h]
      Dist.dist x (cast this y)
    else Dist.dist x (Nonempty.some ⟨x⟩) + 1 + Dist.dist (Nonempty.some ⟨y⟩) y
#align metric.sigma.dist Metric.Sigma.dist

/-- A `Dist` instance on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
def instDist : Dist (Σi, E i) :=
  ⟨Sigma.dist⟩
#align metric.sigma.has_dist Metric.Sigma.instDist

attribute [local instance] Sigma.instDist

@[simp]

@[simp]
theorem dist_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
    dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ = dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨y⟩) y :=
  dif_neg h
#align metric.sigma.dist_ne Metric.Sigma.dist_ne

theorem one_le_dist_of_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
    1 ≤ dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ := by
  rw [Sigma.dist_ne h x y]
  linarith [@dist_nonneg _ _ x (Nonempty.some ⟨x⟩), @dist_nonneg _ _ (Nonempty.some ⟨y⟩) y]
#align metric.sigma.one_le_dist_of_ne Metric.Sigma.one_le_dist_of_ne

theorem fst_eq_of_dist_lt_one (x y : Σi, E i) (h : dist x y < 1) : x.1 = y.1 := by
  cases x; cases y
  contrapose! h
  apply one_le_dist_of_ne h
#align metric.sigma.fst_eq_of_dist_lt_one Metric.Sigma.fst_eq_of_dist_lt_one

protected theorem dist_triangle (x y z : Σi, E i) : dist x z ≤ dist x y + dist y z := by
  rcases x with ⟨i, x⟩; rcases y with ⟨j, y⟩; rcases z with ⟨k, z⟩
  rcases eq_or_ne i k with (rfl | hik)
  · rcases eq_or_ne i j with (rfl | hij)
    · simpa using dist_triangle x y z
    · simp only [Sigma.dist_same, Sigma.dist_ne hij, Sigma.dist_ne hij.symm]
      calc
        dist x z ≤ dist x (Nonempty.some ⟨x⟩) + 0 + 0 + (0 + 0 + dist (Nonempty.some ⟨z⟩) z) := by
          simpa only [zero_add, add_zero] using dist_triangle _ _ _
        _ ≤ _ := by apply_rules [add_le_add, le_rfl, dist_nonneg, zero_le_one]
  · rcases eq_or_ne i j with (rfl | hij)
    · simp only [Sigma.dist_ne hik, Sigma.dist_same]
      calc
        dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z ≤
            dist x y + dist y (Nonempty.some ⟨y⟩) + 1 + dist (Nonempty.some ⟨z⟩) z :=
          by apply_rules [add_le_add, le_rfl, dist_triangle]
        _ = _ := by abel
    · rcases eq_or_ne j k with (rfl | hjk)
      · simp only [Sigma.dist_ne hij, Sigma.dist_same]
        calc
          dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z ≤
              dist x (Nonempty.some ⟨x⟩) + 1 + (dist (Nonempty.some ⟨z⟩) y + dist y z) :=
            by apply_rules [add_le_add, le_rfl, dist_triangle]
          _ = _ := by abel
      · simp only [hik, hij, hjk, Sigma.dist_ne, Ne.def, not_false_iff]
        calc
          dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z =
              dist x (Nonempty.some ⟨x⟩) + 1 + 0 + (0 + 0 + dist (Nonempty.some ⟨z⟩) z) :=
            by simp only [add_zero, zero_add]
          _ ≤ _ := by apply_rules [add_le_add, zero_le_one, dist_nonneg, le_rfl]
#align metric.sigma.dist_triangle Metric.Sigma.dist_triangle

protected theorem isOpen_iff (s : Set (Σi, E i)) :
    IsOpen s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s := by
  constructor
  · rintro hs ⟨i, x⟩ hx
    obtain ⟨ε, εpos, hε⟩ : ∃ ε > 0, ball x ε ⊆ Sigma.mk i ⁻¹' s :=
      Metric.isOpen_iff.1 (isOpen_sigma_iff.1 hs i) x hx
    refine' ⟨min ε 1, lt_min εpos zero_lt_one, _⟩
    rintro ⟨j, y⟩ hy
    rcases eq_or_ne i j with (rfl | hij)
    · simp only [Sigma.dist_same, lt_min_iff] at hy
      exact hε (mem_ball'.2 hy.1)
    · apply (lt_irrefl (1 : ℝ) _).elim
      calc
        1 ≤ Sigma.dist ⟨i, x⟩ ⟨j, y⟩ := Sigma.one_le_dist_of_ne hij _ _
        _ < 1 := hy.trans_le (min_le_right _ _)
  · refine fun H => isOpen_sigma_iff.2 fun i => Metric.isOpen_iff.2 fun x hx => ?_
    obtain ⟨ε, εpos, hε⟩ : ∃ ε > 0, ∀ y, dist (⟨i, x⟩ : Σj, E j) y < ε → y ∈ s :=
      H ⟨i, x⟩ hx
    refine' ⟨ε, εpos, fun y hy => _⟩
    apply hε ⟨i, y⟩
    rw [Sigma.dist_same]
    exact mem_ball'.1 hy
#align metric.sigma.is_open_iff Metric.Sigma.isOpen_iff

/-- A metric space structure on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def metricSpace : MetricSpace (Σi, E i) := by
  refine' MetricSpace.ofDistTopology Sigma.dist _ _ Sigma.dist_triangle Sigma.isOpen_iff _
  · rintro ⟨i, x⟩
    simp [Sigma.dist]
  · rintro ⟨i, x⟩ ⟨j, y⟩
    rcases eq_or_ne i j with (rfl | h)
    · simp [Sigma.dist, dist_comm]
    · simp only [Sigma.dist, dist_comm, h, h.symm, not_false_iff, dif_neg]
      abel
  · rintro ⟨i, x⟩ ⟨j, y⟩
    rcases eq_or_ne i j with (rfl | hij)
    · simp [Sigma.dist]
    · intro h
      apply (lt_irrefl (1 : ℝ) _).elim
      calc
        1 ≤ Sigma.dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ := Sigma.one_le_dist_of_ne hij _ _
        _ < 1 := by rw [h]; exact zero_lt_one
#align metric.sigma.metric_space Metric.Sigma.metricSpace

attribute [local instance] Sigma.metricSpace

open Topology

open Filter

/-- The injection of a space in a disjoint union is an isometry -/
theorem isometry_mk (i : ι) : Isometry (Sigma.mk i : E i → Σk, E k) :=
  Isometry.of_dist_eq fun x y => by simp
#align metric.sigma.isometry_mk Metric.Sigma.isometry_mk

/-- A disjoint union of complete metric spaces is complete. -/
protected theorem completeSpace [∀ i, CompleteSpace (E i)] : CompleteSpace (Σi, E i) := by
  set s : ι → Set (Σi, E i) := fun i => Sigma.fst ⁻¹' {i}
  set U := { p : (Σk, E k) × Σk, E k | dist p.1 p.2 < 1 }
  have hc : ∀ i, IsComplete (s i) := fun i => by
    simp only [← range_sigmaMk]
    exact (isometry_mk i).uniformInducing.isComplete_range
  have hd : ∀ (i j), ∀ x ∈ s i, ∀ y ∈ s j, (x, y) ∈ U → i = j := fun i j x hx y hy hxy =>
    (Eq.symm hx).trans ((fst_eq_of_dist_lt_one _ _ hxy).trans hy)
  refine' completeSpace_of_isComplete_univ _
  convert isComplete_unionᵢ_separated hc (dist_mem_uniformity zero_lt_one) hd
  simp only [← preimage_unionᵢ, unionᵢ_of_singleton, preimage_univ]
#align metric.sigma.complete_space Metric.Sigma.completeSpace

end Sigma

section Gluing

-- Exact gluing of two metric spaces along isometric subsets.
variable {X : Type u} {Y : Type v} {Z : Type w}

variable [Nonempty Z] [MetricSpace Z] [MetricSpace X] [MetricSpace Y] {Φ : Z → X} {Ψ : Z → Y}
  {ε : ℝ}

attribute [local instance] UniformSpace.separationSetoid

/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a pseudo metric space
structure on `X ⊕ Y` by declaring that `Φ x` and `Ψ x` are at distance `0`. -/
def gluePremetric (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : PseudoMetricSpace (X ⊕ Y) where
  dist := glueDist Φ Ψ 0
  dist_self := glueDist_self Φ Ψ 0
  dist_comm := glueDist_comm Φ Ψ 0
  dist_triangle := glueDist_triangle Φ Ψ 0 fun p q => by rw [hΦ.dist_eq, hΨ.dist_eq]; simp
  edist_dist _ _ := by exact ENNReal.coe_nnreal_eq _
#align metric.glue_premetric Metric.gluePremetric

/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a
space  `glue_space hΦ hΨ` by identifying in `X ⊕ Y` the points `Φ x` and `Ψ x`. -/
def GlueSpace (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Type _ :=
  @UniformSpace.SeparationQuotient _ (gluePremetric hΦ hΨ).toUniformSpace
#align metric.glue_space Metric.GlueSpace

-- porting note: TODO: w/o `@`, tries to generate some `[MetricSpace _]` before finding `X` `Y`
instance : MetricSpace (@GlueSpace X Y Z _ _ _ _ _ _ hΦ hΨ) :=
  inferInstanceAs <| MetricSpace <|
    @UniformSpace.SeparationQuotient _ (gluePremetric hΦ hΨ).toUniformSpace

/-- The canonical map from `X` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def toGlueL (hΦ : Isometry Φ) (hΨ : Isometry Ψ) (x : X) : GlueSpace hΦ hΨ :=
  Quotient.mk'' (.inl x)
#align metric.to_glue_l Metric.toGlueL

/-- The canonical map from `Y` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def toGlueR (hΦ : Isometry Φ) (hΨ : Isometry Ψ) (y : Y) : GlueSpace hΦ hΨ :=
  Quotient.mk'' (.inr y)
#align metric.to_glue_r Metric.toGlueR

instance inhabitedLeft (hΦ : Isometry Φ) (hΨ : Isometry Ψ) [Inhabited X] :
    Inhabited (GlueSpace hΦ hΨ) :=
  ⟨toGlueL _ _ default⟩
#align metric.inhabited_left Metric.inhabitedLeft

instance inhabitedRight (hΦ : Isometry Φ) (hΨ : Isometry Ψ) [Inhabited Y] :
    Inhabited (GlueSpace hΦ hΨ) :=
  ⟨toGlueR _ _ default⟩
#align metric.inhabited_right Metric.inhabitedRight

theorem toGlue_commute (hΦ : Isometry Φ) (hΨ : Isometry Ψ) :
    toGlueL hΦ hΨ ∘ Φ = toGlueR hΦ hΨ ∘ Ψ := by
  let i : PseudoMetricSpace (X ⊕ Y) := gluePremetric hΦ hΨ
  let _ := i.toUniformSpace
  funext
  simp only [comp, toGlueL, toGlueR]
  refine' UniformSpace.SeparationQuotient.mk_eq_mk.2 (Metric.inseparable_iff.2 _)
  exact glueDist_glued_points Φ Ψ 0 _
#align metric.to_glue_commute Metric.toGlue_commute

theorem toGlueL_isometry (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Isometry (toGlueL hΦ hΨ) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.to_glue_l_isometry Metric.toGlueL_isometry

theorem toGlueR_isometry (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Isometry (toGlueR hΦ hΨ) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.to_glue_r_isometry Metric.toGlueR_isometry

end Gluing

--section
section InductiveLimit

/-!
### Inductive limit of metric spaces

In this section, we define the inductive limit of

```
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
```

where the `X n` are metric spaces and f n isometric embeddings. We do it by defining a premetric
space structure on `Σ n, X n`, where the predistance `dist x y` is obtained by pushing `x` and `y`
in a common `X k` using composition by the `f n`, and taking the distance there. This does not
depend on the choice of `k` as the `f n` are isometries. The metric space associated to this
premetric space is the desired inductive limit.
-/

open Nat

variable {X : ℕ → Type u} [∀ n, MetricSpace (X n)] {f : ∀ n, X n → X (n + 1)}

/-- Predistance on the disjoint union `Σ n, X n`. -/
def inductiveLimitDist (f : ∀ n, X n → X (n + 1)) (x y : Σn, X n) : ℝ :=
  dist (leRecOn (le_max_left x.1 y.1) (f _) x.2 : X (max x.1 y.1))
    (leRecOn (le_max_right x.1 y.1) (f _) y.2 : X (max x.1 y.1))
#align metric.inductive_limit_dist Metric.inductiveLimitDist

/-- The predistance on the disjoint union `Σ n, X n` can be computed in any `X k` for large
enough `k`. -/
theorem inductiveLimitDist_eq_dist (I : ∀ n, Isometry (f n)) (x y : Σn, X n) :
    ∀ m (hx : x.1 ≤ m) (hy : y.1 ≤ m), inductiveLimitDist f x y =
      dist (leRecOn hx (f _) x.2 : X m) (leRecOn hy (f _) y.2 : X m)
  | 0, hx, hy => by
    cases' x with i x; cases' y with j y
    obtain rfl : i = 0 := nonpos_iff_eq_zero.1 hx
    obtain rfl : j = 0 := nonpos_iff_eq_zero.1 hy
    rfl
  | (m + 1), hx, hy => by
    by_cases h : max x.1 y.1 = (m + 1)
    · generalize m + 1 = m' at *
      subst m'
      rfl
    · have : max x.1 y.1 ≤ succ m := by simp [hx, hy]
      have : max x.1 y.1 ≤ m := by simpa [h] using of_le_succ this
      have xm : x.1 ≤ m := le_trans (le_max_left _ _) this
      have ym : y.1 ≤ m := le_trans (le_max_right _ _) this
      rw [leRecOn_succ xm, leRecOn_succ ym, (I m).dist_eq]
      exact inductiveLimitDist_eq_dist I x y m xm ym
#align metric.inductive_limit_dist_eq_dist Metric.inductiveLimitDist_eq_dist

/-- Premetric space structure on `Σ n, X n`.-/
def inductivePremetric (I : ∀ n, Isometry (f n)) : PseudoMetricSpace (Σn, X n) where
  dist := inductiveLimitDist f
  dist_self x := by simp [dist, inductiveLimitDist]
  dist_comm x y := by
    let m := max x.1 y.1
    have hx : x.1 ≤ m := le_max_left _ _
    have hy : y.1 ≤ m := le_max_right _ _
    unfold dist; simp only
    rw [inductiveLimitDist_eq_dist I x y m hx hy, inductiveLimitDist_eq_dist I y x m hy hx,
      dist_comm]
  dist_triangle x y z := by
    let m := max (max x.1 y.1) z.1
    have hx : x.1 ≤ m := le_trans (le_max_left _ _) (le_max_left _ _)
    have hy : y.1 ≤ m := le_trans (le_max_right _ _) (le_max_left _ _)
    have hz : z.1 ≤ m := le_max_right _ _
    calc
      inductiveLimitDist f x z = dist (leRecOn hx (f _) x.2 : X m) (leRecOn hz (f _) z.2 : X m) :=
        inductiveLimitDist_eq_dist I x z m hx hz
      _ ≤ dist (leRecOn hx (f _) x.2 : X m) (leRecOn hy (f _) y.2 : X m) +
            dist (leRecOn hy (f _) y.2 : X m) (leRecOn hz (f _) z.2 : X m) :=
        (dist_triangle _ _ _)
      _ = inductiveLimitDist f x y + inductiveLimitDist f y z := by
        rw [inductiveLimitDist_eq_dist I x y m hx hy, inductiveLimitDist_eq_dist I y z m hy hz]
  edist_dist _ _ := by exact ENNReal.coe_nnreal_eq _
#align metric.inductive_premetric Metric.inductivePremetric

attribute [local instance] inductivePremetric

/-- The type giving the inductive limit in a metric space context. -/
def InductiveLimit (I : ∀ n, Isometry (f n)) : Type _ :=
  @UniformSpace.SeparationQuotient _ (inductivePremetric I).toUniformSpace
#align metric.inductive_limit Metric.InductiveLimit

instance : MetricSpace (InductiveLimit (f := f) I) :=
  inferInstanceAs <| MetricSpace <|
    @UniformSpace.SeparationQuotient _ (inductivePremetric I).toUniformSpace

/-- Mapping each `X n` to the inductive limit. -/
def toInductiveLimit (I : ∀ n, Isometry (f n)) (n : ℕ) (x : X n) : Metric.InductiveLimit I :=
  Quotient.mk'' (Sigma.mk n x)
#align metric.to_inductive_limit Metric.toInductiveLimit

instance (I : ∀ n, Isometry (f n)) [Inhabited (X 0)] : Inhabited (InductiveLimit I) :=
  ⟨toInductiveLimit _ 0 default⟩

/-- The map `to_inductive_limit n` mapping `X n` to the inductive limit is an isometry. -/
theorem toInductiveLimit_isometry (I : ∀ n, Isometry (f n)) (n : ℕ) :
    Isometry (toInductiveLimit I n) :=
  Isometry.of_dist_eq fun x y => by
    change inductiveLimitDist f ⟨n, x⟩ ⟨n, y⟩ = dist x y
    rw [inductiveLimitDist_eq_dist I ⟨n, x⟩ ⟨n, y⟩ n (le_refl n) (le_refl n), leRecOn_self,
      leRecOn_self]
#align metric.to_inductive_limit_isometry Metric.toInductiveLimit_isometry

/-- The maps `to_inductive_limit n` are compatible with the maps `f n`. -/
theorem toInductiveLimit_commute (I : ∀ n, Isometry (f n)) (n : ℕ) :
    toInductiveLimit I n.succ ∘ f n = toInductiveLimit I n := by
  let _ := inductivePremetric I
  funext x
  simp only [comp, toInductiveLimit]
  refine' UniformSpace.SeparationQuotient.mk_eq_mk.2 (Metric.inseparable_iff.2 _)
  show inductiveLimitDist f ⟨n.succ, f n x⟩ ⟨n, x⟩ = 0
  rw [inductiveLimitDist_eq_dist I ⟨n.succ, f n x⟩ ⟨n, x⟩ n.succ, leRecOn_self,
    leRecOn_succ, leRecOn_self, dist_self]
  exacts [le_rfl, le_succ _, le_rfl]
#align metric.to_inductive_limit_commute Metric.toInductiveLimit_commute

end InductiveLimit

--section
end Metric

--namespace


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_109
  (v : ℕ → ℕ)
  (h₀ : ∀ n, v n = 2 * n - 1) :
  (∑ k in (finset.erase (finset.range 101) 0), v k) % 7 = 4 :=
begin
  norm_num,
  simp [h₀],
  rw finset.sum_erase,
  swap,
  { simp, },
  norm_num [finset.sum_range_succ, h₀],
end