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

universes u₁ u₂ u₃ u₄

namespace Mathlib

/-!
# Quotients of non-commutative rings

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

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

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

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

namespace ring_quot

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

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

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

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

end ring_quot

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

namespace ring_quot

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end Mathlib


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import topology.uniform_space.uniform_convergence
import topology.uniform_space.uniform_embedding
import topology.uniform_space.complete_separated
import topology.algebra.group
import tactic.abel

/-!
# Uniform structure on topological groups

This file defines uniform groups and its additive counterpart. These typeclasses should be
preferred over using `[topological_space α] [topological_group α]` since every topological
group naturally induces a uniform structure.

## Main declarations
* `uniform_group` and `uniform_add_group`: Multiplicative and additive uniform groups, that
  i.e., groups with uniformly continuous `(*)` and `(⁻¹)` / `(+)` and `(-)`.

## Main results

* `topological_add_group.to_uniform_space` and `topological_add_group_is_uniform` can be used to
  construct a canonical uniformity for a topological add group.

* extension of ℤ-bilinear maps to complete groups (useful for ring completions)
-/

noncomputable theory
open_locale classical uniformity topological_space filter pointwise

section uniform_group
open filter set

variables {α : Type*} {β : Type*}

/-- A uniform group is a group in which multiplication and inversion are uniformly continuous. -/
class uniform_group (α : Type*) [uniform_space α] [group α] : Prop :=
(uniform_continuous_div : uniform_continuous (λp:α×α, p.1 / p.2))

/-- A uniform additive group is an additive group in which addition
  and negation are uniformly continuous.-/
class uniform_add_group (α : Type*) [uniform_space α] [add_group α] : Prop :=
(uniform_continuous_sub : uniform_continuous (λp:α×α, p.1 - p.2))

attribute [to_additive] uniform_group

@[to_additive] theorem uniform_group.mk' {α} [uniform_space α] [group α]
  (h₁ : uniform_continuous (λp:α×α, p.1 * p.2))
  (h₂ : uniform_continuous (λp:α, p⁻¹)) : uniform_group α :=
⟨by simpa only [div_eq_mul_inv] using
  h₁.comp (uniform_continuous_fst.prod_mk (h₂.comp uniform_continuous_snd))⟩

variables [uniform_space α] [group α] [uniform_group α]

@[to_additive] lemma uniform_continuous_div : uniform_continuous (λp:α×α, p.1 / p.2) :=
uniform_group.uniform_continuous_div

@[to_additive] lemma uniform_continuous.div [uniform_space β] {f : β → α} {g : β → α}
  (hf : uniform_continuous f) (hg : uniform_continuous g) : uniform_continuous (λx, f x / g x) :=
uniform_continuous_div.comp (hf.prod_mk hg)

@[to_additive] lemma uniform_continuous.inv [uniform_space β] {f : β → α}
  (hf : uniform_continuous f) : uniform_continuous (λx, (f x)⁻¹) :=
have uniform_continuous (λx, 1 / f x),
  from uniform_continuous_const.div hf,
by simp * at *

@[to_additive] lemma uniform_continuous_inv : uniform_continuous (λx:α, x⁻¹) :=
uniform_continuous_id.inv

@[to_additive] lemma uniform_continuous.mul [uniform_space β] {f : β → α} {g : β → α}
  (hf : uniform_continuous f) (hg : uniform_continuous g) : uniform_continuous (λx, f x * g x) :=
have uniform_continuous (λx, f x / (g x)⁻¹), from hf.div hg.inv,
by simp * at *

@[to_additive] lemma uniform_continuous_mul : uniform_continuous (λp:α×α, p.1 * p.2) :=
uniform_continuous_fst.mul uniform_continuous_snd

@[priority 10, to_additive]
instance uniform_group.to_topological_group : topological_group α :=
{ continuous_mul := uniform_continuous_mul.continuous,
  continuous_inv := uniform_continuous_inv.continuous }

@[to_additive] instance [uniform_space β] [group β] [uniform_group β] : uniform_group (α × β) :=
⟨((uniform_continuous_fst.comp uniform_continuous_fst).div
  (uniform_continuous_fst.comp uniform_continuous_snd)).prod_mk
 ((uniform_continuous_snd.comp uniform_continuous_fst).div
  (uniform_continuous_snd.comp uniform_continuous_snd))⟩

@[to_additive] lemma uniformity_translate_mul (a : α) :
  (𝓤 α).map (λx:α×α, (x.1 * a, x.2 * a)) = 𝓤 α :=
le_antisymm
  (uniform_continuous_id.mul uniform_continuous_const)
  (calc 𝓤 α =
    ((𝓤 α).map (λx:α×α, (x.1 * a⁻¹, x.2 * a⁻¹))).map (λx:α×α, (x.1 * a, x.2 * a)) :
      by simp [filter.map_map, (∘)]; exact filter.map_id.symm
    ... ≤ (𝓤 α).map (λx:α×α, (x.1 * a, x.2 * a)) :
      filter.map_mono (uniform_continuous_id.mul uniform_continuous_const))

@[to_additive] lemma uniform_embedding_translate_mul (a : α) : uniform_embedding (λx:α, x * a) :=
{ comap_uniformity := begin
    rw [← uniformity_translate_mul a, comap_map] {occs := occurrences.pos [1]},
    rintros ⟨p₁, p₂⟩ ⟨q₁, q₂⟩,
    simp [prod.eq_iff_fst_eq_snd_eq] {contextual := tt}
  end,
  inj := mul_left_injective a }

namespace mul_opposite

@[to_additive] instance : uniform_group αᵐᵒᵖ :=
⟨uniform_continuous_op.comp ((uniform_continuous_unop.comp uniform_continuous_snd).inv.mul $
  uniform_continuous_unop.comp uniform_continuous_fst)⟩

end mul_opposite

section
variables (α)

@[to_additive] lemma uniformity_eq_comap_nhds_one : 𝓤 α = comap (λx:α×α, x.2 / x.1) (𝓝 (1:α)) :=
begin
  rw [nhds_eq_comap_uniformity, filter.comap_comap],
  refine le_antisymm (filter.map_le_iff_le_comap.1 _) _,
  { assume s hs,
    rcases mem_uniformity_of_uniform_continuous_invariant uniform_continuous_div hs
      with ⟨t, ht, hts⟩,
    refine mem_map.2 (mem_of_superset ht _),
    rintros ⟨a, b⟩,
    simpa [subset_def] using hts a b a },
  { assume s hs,
    rcases mem_uniformity_of_uniform_continuous_invariant uniform_continuous_mul hs
      with ⟨t, ht, hts⟩,
    refine ⟨_, ht, _⟩,
    rintros ⟨a, b⟩, simpa [subset_def] using hts 1 (b / a) a }
end

@[to_additive] lemma uniformity_eq_comap_nhds_one_swapped :
  𝓤 α = comap (λx:α×α, x.1 / x.2) (𝓝 (1:α)) :=
by { rw [← comap_swap_uniformity, uniformity_eq_comap_nhds_one, comap_comap, (∘)], refl }

open mul_opposite

@[to_additive]
lemma uniformity_eq_comap_inv_mul_nhds_one : 𝓤 α = comap (λx:α×α, x.1⁻¹ * x.2) (𝓝 (1:α)) :=
begin
  rw [← comap_uniformity_mul_opposite, uniformity_eq_comap_nhds_one, ← op_one, ← comap_unop_nhds,
    comap_comap, comap_comap],
  simp [(∘)]
end

@[to_additive] lemma uniformity_eq_comap_inv_mul_nhds_one_swapped :
  𝓤 α = comap (λx:α×α, x.2⁻¹ * x.1) (𝓝 (1:α)) :=
by { rw [← comap_swap_uniformity, uniformity_eq_comap_inv_mul_nhds_one, comap_comap, (∘)], refl }

end

@[to_additive] lemma filter.has_basis.uniformity_of_nhds_one {ι} {p : ι → Prop} {U : ι → set α}
  (h : (𝓝 (1 : α)).has_basis p U) :
  (𝓤 α).has_basis p (λ i, {x : α × α | x.2 / x.1 ∈ U i}) :=
by { rw uniformity_eq_comap_nhds_one, exact h.comap _ }

@[to_additive] lemma filter.has_basis.uniformity_of_nhds_one_inv_mul
  {ι} {p : ι → Prop} {U : ι → set α} (h : (𝓝 (1 : α)).has_basis p U) :
  (𝓤 α).has_basis p (λ i, {x : α × α | x.1⁻¹ * x.2 ∈ U i}) :=
by { rw uniformity_eq_comap_inv_mul_nhds_one, exact h.comap _ }

@[to_additive] lemma filter.has_basis.uniformity_of_nhds_one_swapped
  {ι} {p : ι → Prop} {U : ι → set α} (h : (𝓝 (1 : α)).has_basis p U) :
  (𝓤 α).has_basis p (λ i, {x : α × α | x.1 / x.2 ∈ U i}) :=
by { rw uniformity_eq_comap_nhds_one_swapped, exact h.comap _ }

@[to_additive] lemma filter.has_basis.uniformity_of_nhds_one_inv_mul_swapped
  {ι} {p : ι → Prop} {U : ι → set α} (h : (𝓝 (1 : α)).has_basis p U) :
  (𝓤 α).has_basis p (λ i, {x : α × α | x.2⁻¹ * x.1 ∈ U i}) :=
by { rw uniformity_eq_comap_inv_mul_nhds_one_swapped, exact h.comap _ }

@[to_additive] lemma group_separation_rel (x y : α) :
  (x, y) ∈ separation_rel α ↔ x / y ∈ closure ({1} : set α) :=
have embedding (λa, a * (y / x)), from (uniform_embedding_translate_mul (y / x)).embedding,
show (x, y) ∈ ⋂₀ (𝓤 α).sets ↔ x / y ∈ closure ({1} : set α),
begin
  rw [this.closure_eq_preimage_closure_image, uniformity_eq_comap_nhds_one α, sInter_comap_sets],
  simp [mem_closure_iff_nhds, inter_singleton_nonempty, sub_eq_add_neg, add_assoc]
end

@[to_additive] lemma uniform_continuous_of_tendsto_one
  [uniform_space β] [group β] [uniform_group β] {f : α →* β} (h : tendsto f (𝓝 1) (𝓝 1)) :
  uniform_continuous f :=
begin
  have : ((λx:β×β, x.2 / x.1) ∘ (λx:α×α, (f x.1, f x.2))) = (λx:α×α, f (x.2 / x.1)),
  { simp only [f.map_div] },
  rw [uniform_continuous, uniformity_eq_comap_nhds_one α, uniformity_eq_comap_nhds_one β,
    tendsto_comap_iff, this],
  exact tendsto.comp h tendsto_comap
end

@[to_additive] lemma monoid_hom.uniform_continuous_of_continuous_at_one
  [uniform_space β] [group β] [uniform_group β]
  (f : α →* β) (hf : continuous_at f 1) :
  uniform_continuous f :=
uniform_continuous_of_tendsto_one (by simpa using hf.tendsto)

/-- A homomorphism from a uniform group to a discrete uniform group is continuous if and only if
its kernel is open. -/
@[to_additive "A homomorphism from a uniform additive group to a discrete uniform additive group is
continuous if and only if its kernel is open."]
lemma uniform_group.uniform_continuous_iff_open_ker [uniform_space β] [discrete_topology β]
  [group β] [uniform_group β] {f : α →* β} : uniform_continuous f ↔ is_open (f.ker : set α) :=
begin
  refine ⟨λ hf, _, λ hf, _⟩,
  { apply (is_open_discrete ({1} : set β)).preimage (uniform_continuous.continuous hf) },
  { apply monoid_hom.uniform_continuous_of_continuous_at_one,
    rw [continuous_at, nhds_discrete β, map_one, tendsto_pure],
    exact hf.mem_nhds (map_one f) }
end

@[to_additive] lemma uniform_continuous_monoid_hom_of_continuous [uniform_space β]
  [group β] [uniform_group β] {f : α →* β} (h : continuous f) : uniform_continuous f :=
uniform_continuous_of_tendsto_one $
  suffices tendsto f (𝓝 1) (𝓝 (f 1)), by rwa f.map_one at this,
  h.tendsto 1

@[to_additive] lemma cauchy_seq.mul {ι : Type*} [semilattice_sup ι] {u v : ι → α}
  (hu : cauchy_seq u) (hv : cauchy_seq v) : cauchy_seq (u * v) :=
uniform_continuous_mul.comp_cauchy_seq (hu.prod hv)

@[to_additive] lemma cauchy_seq.mul_const {ι : Type*} [semilattice_sup ι]
  {u : ι → α} {x : α} (hu : cauchy_seq u) : cauchy_seq (λ n, u n * x) :=
(uniform_continuous_id.mul uniform_continuous_const).comp_cauchy_seq hu

@[to_additive] lemma cauchy_seq.const_mul {ι : Type*} [semilattice_sup ι]
  {u : ι → α} {x : α} (hu : cauchy_seq u) : cauchy_seq (λ n, x * u n) :=
(uniform_continuous_const.mul uniform_continuous_id).comp_cauchy_seq hu

@[to_additive] lemma cauchy_seq.inv {ι : Type*} [semilattice_sup ι]
  {u : ι → α} (h : cauchy_seq u) : cauchy_seq (u⁻¹) :=
uniform_continuous_inv.comp_cauchy_seq h

@[to_additive] lemma totally_bounded_iff_subset_finite_Union_nhds_one {s : set α} :
  totally_bounded s ↔ ∀ U ∈ 𝓝 (1 : α), ∃ (t : set α), t.finite ∧ s ⊆ ⋃ y ∈ t, y • U :=
(𝓝 (1 : α)).basis_sets.uniformity_of_nhds_one_inv_mul_swapped.totally_bounded_iff.trans $
  by simp [← preimage_smul_inv, preimage]

end uniform_group

section topological_comm_group
open filter
variables (G : Type*) [comm_group G] [topological_space G] [topological_group G]

/-- The right uniformity on a topological group. -/
@[to_additive "The right uniformity on a topological group"]
def topological_group.to_uniform_space : uniform_space G :=
{ uniformity          := comap (λp:G×G, p.2 / p.1) (𝓝 1),
  refl                :=
    by refine map_le_iff_le_comap.1 (le_trans _ (pure_le_nhds 1));
      simp [set.subset_def] {contextual := tt},
  symm                :=
  begin
    suffices : tendsto (λp:G×G, (p.2 / p.1)⁻¹) (comap (λp:G×G, p.2 / p.1) (𝓝 1)) (𝓝 1⁻¹),
    { simpa [tendsto_comap_iff], },
    exact tendsto.comp (tendsto.inv tendsto_id) tendsto_comap
  end,
  comp                :=
  begin
    intros D H,
    rw mem_lift'_sets,
    { rcases H with ⟨U, U_nhds, U_sub⟩,
      rcases exists_nhds_one_split U_nhds with ⟨V, ⟨V_nhds, V_sum⟩⟩,
      existsi ((λp:G×G, p.2 / p.1) ⁻¹' V),
      have H : (λp:G×G, p.2 / p.1) ⁻¹' V ∈ comap (λp:G×G, p.2 / p.1) (𝓝 (1 : G)),
        by existsi [V, V_nhds] ; refl,
      existsi H,
      have comp_rel_sub :
        comp_rel ((λp:G×G, p.2 / p.1) ⁻¹' V) ((λp, p.2 / p.1) ⁻¹' V) ⊆ (λp:G×G, p.2 / p.1) ⁻¹' U,
      begin
        intros p p_comp_rel,
        rcases p_comp_rel with ⟨z, ⟨Hz1, Hz2⟩⟩,
        simpa [sub_eq_add_neg, add_comm, add_left_comm] using V_sum _ Hz1 _ Hz2
      end,
      exact set.subset.trans comp_rel_sub U_sub },
    { exact monotone_comp_rel monotone_id monotone_id }
  end,
  is_open_uniformity  :=
  begin
    intro S,
    let S' := λ x, {p : G × G | p.1 = x → p.2 ∈ S},
    show is_open S ↔ ∀ (x : G), x ∈ S → S' x ∈ comap (λp:G×G, p.2 / p.1) (𝓝 (1 : G)),
    rw [is_open_iff_mem_nhds],
    refine forall₂_congr (λ a ha, _),
    rw [← nhds_translation_div, mem_comap, mem_comap],
    refine exists₂_congr (λ t ht, _),
    show (λ (y : G), y / a) ⁻¹' t ⊆ S ↔ (λ (p : G × G), p.snd / p.fst) ⁻¹' t ⊆ S' a,
    split,
    { rintros h ⟨x, y⟩ hx rfl, exact h hx },
    { rintros h x hx, exact @h (a, x) hx rfl }
  end }

variables {G}

@[to_additive] lemma topological_group.tendsto_uniformly_iff
  {ι α : Type*} (F : ι → α → G) (f : α → G) (p : filter ι) :
  @tendsto_uniformly α G ι (topological_group.to_uniform_space G) F f p
    ↔ ∀ u ∈ 𝓝 (1 : G), ∀ᶠ i in p, ∀ a, F i a / f a ∈ u :=
⟨λ h u hu, h _ ⟨u, hu, λ _, id⟩, λ h v ⟨u, hu, hv⟩,
  mem_of_superset (h u hu) (λ i hi a, hv (by exact hi a))⟩

@[to_additive] lemma topological_group.tendsto_uniformly_on_iff
  {ι α : Type*} (F : ι → α → G) (f : α → G) (p : filter ι) (s : set α) :
  @tendsto_uniformly_on α G ι (topological_group.to_uniform_space G) F f p s
    ↔ ∀ u ∈ 𝓝 (1 : G), ∀ᶠ i in p, ∀ a ∈ s, F i a / f a ∈ u :=
⟨λ h u hu, h _ ⟨u, hu, λ _, id⟩, λ h v ⟨u, hu, hv⟩,
  mem_of_superset (h u hu) (λ i hi a ha, hv (by exact hi a ha))⟩

@[to_additive] lemma topological_group.tendsto_locally_uniformly_iff
  {ι α : Type*} [topological_space α] (F : ι → α → G) (f : α → G) (p : filter ι) :
  @tendsto_locally_uniformly α G ι (topological_group.to_uniform_space G) _ F f p
    ↔ ∀ (u ∈ 𝓝 (1 : G)) (x : α), ∃ (t ∈ 𝓝 x), ∀ᶠ i in p, ∀ a ∈ t, F i a / f a ∈ u :=
⟨λ h u hu, h _ ⟨u, hu, λ _, id⟩, λ h v ⟨u, hu, hv⟩ x, exists_imp_exists (by exact λ a,
  exists_imp_exists (λ ha hp, mem_of_superset hp (λ i hi a ha, hv (by exact hi a ha)))) (h u hu x)⟩

@[to_additive] lemma topological_group.tendsto_locally_uniformly_on_iff
  {ι α : Type*} [topological_space α] (F : ι → α → G) (f : α → G) (p : filter ι) (s : set α) :
  @tendsto_locally_uniformly_on α G ι (topological_group.to_uniform_space G) _ F f p s
    ↔ ∀ (u ∈ 𝓝 (1 : G)) (x ∈ s), ∃ (t ∈ 𝓝[s] x), ∀ᶠ i in p, ∀ a ∈ t, F i a / f a ∈ u :=
⟨λ h u hu, h _ ⟨u, hu, λ _, id⟩, λ h v ⟨u, hu, hv⟩ x, exists_imp_exists (by exact λ a,
  exists_imp_exists (λ ha hp, mem_of_superset hp (λ i hi a ha, hv (by exact hi a ha)))) ∘ h u hu x⟩

end topological_comm_group

section topological_comm_group
universes u v w x
open filter

variables (G : Type*) [comm_group G] [topological_space G] [topological_group G]

section
local attribute [instance] topological_group.to_uniform_space

@[to_additive] lemma uniformity_eq_comap_nhds_one' :
  𝓤 G = comap (λp:G×G, p.2 / p.1) (𝓝 (1 : G)) := rfl

variable {G}
@[to_additive] lemma topological_group_is_uniform : uniform_group G :=
have tendsto
    ((λp:(G×G), p.1 / p.2) ∘ (λp:(G×G)×(G×G), (p.1.2 / p.1.1, p.2.2 / p.2.1)))
    (comap (λp:(G×G)×(G×G), (p.1.2 / p.1.1, p.2.2 / p.2.1)) ((𝓝 1).prod (𝓝 1)))
    (𝓝 (1 / 1)) :=
  (tendsto_fst.div' tendsto_snd).comp tendsto_comap,
begin
  constructor,
  rw [uniform_continuous, uniformity_prod_eq_prod, tendsto_map'_iff,
    uniformity_eq_comap_nhds_one' G, tendsto_comap_iff, prod_comap_comap_eq],
  simpa [(∘), div_eq_mul_inv, mul_comm, mul_left_comm] using this
end

local attribute [instance] topological_group_is_uniform

open set

@[to_additive] lemma topological_group.separated_iff_one_closed :
  separated_space G ↔ is_closed ({1} : set G) :=
begin
  rw [separated_space_iff, ← closure_eq_iff_is_closed],
  split; intro h,
  { apply subset.antisymm,
    { intros x x_in,
      have := group_separation_rel x 1,
      rw div_one' at this,
      rw [← this, h] at x_in,
      change x = 1 at x_in,
      simp [x_in] },
    { exact subset_closure } },
  { ext p,
    cases p with x y,
    rw [group_separation_rel x, h, mem_singleton_iff, div_eq_one],
    refl }
end

@[to_additive] lemma topological_group.separated_of_one_sep
  (H : ∀ x : G, x ≠ 1 → ∃ U ∈ nhds (1 : G), x ∉ U) : separated_space G:=
begin
  rw [topological_group.separated_iff_one_closed, ← is_open_compl_iff, is_open_iff_mem_nhds],
  intros x x_not,
  have : x ≠ 1, from mem_compl_singleton_iff.mp x_not,
  rcases H x this with ⟨U, U_in, xU⟩,
  rw ← nhds_one_symm G at U_in,
  rcases U_in with ⟨W, W_in, UW⟩,
  rw ← nhds_translation_mul_inv,
  use [W, W_in],
  rw subset_compl_comm,
  suffices : x⁻¹ ∉ W, by simpa,
  exact λ h, xU (UW h)
end

end

@[to_additive] lemma uniform_group.to_uniform_space_eq {G : Type*} [u : uniform_space G]
  [comm_group G] [uniform_group G] : topological_group.to_uniform_space G = u :=
begin
  ext : 1,
  show @uniformity G (topological_group.to_uniform_space G) = 𝓤 G,
  rw [uniformity_eq_comap_nhds_one' G, uniformity_eq_comap_nhds_one G]
end

end topological_comm_group

open comm_group filter set function

section
variables {α : Type*} {β : Type*}
variables [topological_space α] [comm_group α] [topological_group α]

-- β is a dense subgroup of α, inclusion is denoted by e
variables [topological_space β] [comm_group β]
variables {e : β →* α} (de : dense_inducing e)
include de

@[to_additive] lemma tendsto_div_comap_self (x₀ : α) :
  tendsto (λt:β×β, t.2 / t.1) (comap (λp:β×β, (e p.1, e p.2)) $ 𝓝 (x₀, x₀)) (𝓝 1) :=
begin
  have comm : (λx:α×α, x.2/x.1) ∘ (λt:β×β, (e t.1, e t.2)) = e ∘ (λt:β×β, t.2 / t.1),
  { ext t,
    change e t.2 / e t.1 = e (t.2 / t.1),
    rwa ← e.map_div t.2 t.1 },
  have lim : tendsto (λ x : α × α, x.2/x.1) (𝓝 (x₀, x₀)) (𝓝 (e 1)),
  { simpa using (continuous_div'.comp (@continuous_swap α α _ _)).tendsto (x₀, x₀) },
  simpa using de.tendsto_comap_nhds_nhds lim comm
end
end

namespace dense_inducing
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
variables {G : Type*}

-- β is a dense subgroup of α, inclusion is denoted by e
-- δ is a dense subgroup of γ, inclusion is denoted by f
variables [topological_space α] [add_comm_group α] [topological_add_group α]
variables [topological_space β] [add_comm_group β] [topological_add_group β]
variables [topological_space γ] [add_comm_group γ] [topological_add_group γ]
variables [topological_space δ] [add_comm_group δ] [topological_add_group δ]
variables [uniform_space G] [add_comm_group G] [uniform_add_group G] [separated_space G]
  [complete_space G]
variables {e : β →+ α} (de : dense_inducing e)
variables {f : δ →+ γ} (df : dense_inducing f)

variables {φ : β →+ δ →+ G}
local notation `Φ` := λ p : β × δ, φ p.1 p.2

variables  (hφ : continuous Φ)

include de df hφ

variables {W' : set G} (W'_nhd : W' ∈ 𝓝 (0 : G))
include W'_nhd

private lemma extend_Z_bilin_aux (x₀ : α) (y₁ : δ) :
  ∃ U₂ ∈ comap e (𝓝 x₀), ∀ x x' ∈ U₂, Φ (x' - x, y₁) ∈ W' :=
begin
  let Nx := 𝓝 x₀,
  let ee := λ u : β × β, (e u.1, e u.2),

  have lim1 : tendsto (λ a : β × β, (a.2 - a.1, y₁)) (comap e Nx ×ᶠ comap e Nx) (𝓝 (0, y₁)),
  { have := tendsto.prod_mk (tendsto_sub_comap_self de x₀)
      (tendsto_const_nhds : tendsto (λ (p : β × β), y₁) (comap ee $ 𝓝 (x₀, x₀)) (𝓝 y₁)),
    rw [nhds_prod_eq, prod_comap_comap_eq, ←nhds_prod_eq],
    exact (this : _) },
  have lim2 : tendsto Φ (𝓝 (0, y₁)) (𝓝 0), by simpa using hφ.tendsto (0, y₁),
  have lim := lim2.comp lim1,
  rw tendsto_prod_self_iff at lim,
  simp_rw ball_mem_comm,
  exact lim W' W'_nhd
end

private lemma extend_Z_bilin_key (x₀ : α) (y₀ : γ) :
  ∃ U ∈ comap e (𝓝 x₀), ∃ V ∈ comap f (𝓝 y₀),
    ∀ x x' ∈ U, ∀ y y' ∈ V, Φ (x', y') - Φ (x, y) ∈ W' :=
begin
  let Nx := 𝓝 x₀,
  let Ny := 𝓝 y₀,
  let dp := dense_inducing.prod de df,
  let ee := λ u : β × β, (e u.1, e u.2),
  let ff := λ u : δ × δ, (f u.1, f u.2),

  have lim_φ : filter.tendsto Φ (𝓝 (0, 0)) (𝓝 0),
  { simpa using hφ.tendsto (0, 0) },

  have lim_φ_sub_sub : tendsto (λ (p : (β × β) × (δ × δ)), Φ (p.1.2 - p.1.1, p.2.2 - p.2.1))
    ((comap ee $ 𝓝 (x₀, x₀)) ×ᶠ (comap ff $ 𝓝 (y₀, y₀))) (𝓝 0),
  { have lim_sub_sub :  tendsto (λ (p : (β × β) × δ × δ), (p.1.2 - p.1.1, p.2.2 - p.2.1))
      ((comap ee (𝓝 (x₀, x₀))) ×ᶠ (comap ff (𝓝 (y₀, y₀)))) (𝓝 0 ×ᶠ 𝓝 0),
    { have := filter.prod_mono (tendsto_sub_comap_self de x₀) (tendsto_sub_comap_self df y₀),
      rwa prod_map_map_eq at this },
    rw ← nhds_prod_eq at lim_sub_sub,
    exact tendsto.comp lim_φ lim_sub_sub },

  rcases exists_nhds_zero_quarter W'_nhd with ⟨W, W_nhd, W4⟩,

  have : ∃ U₁ ∈ comap e (𝓝 x₀), ∃ V₁ ∈ comap f (𝓝 y₀),
    ∀ x x' ∈ U₁, ∀ y y' ∈ V₁,  Φ (x'-x, y'-y) ∈ W,
  { have := tendsto_prod_iff.1 lim_φ_sub_sub W W_nhd,
    repeat { rw [nhds_prod_eq, ←prod_comap_comap_eq] at this },
    rcases this with ⟨U, U_in, V, V_in, H⟩,
    rw [mem_prod_same_iff] at U_in V_in,
    rcases U_in with ⟨U₁, U₁_in, HU₁⟩,
    rcases V_in with ⟨V₁, V₁_in, HV₁⟩,
    existsi [U₁, U₁_in, V₁, V₁_in],
    intros x x_in x' x'_in y y_in y' y'_in,
    exact H _ _ (HU₁ (mk_mem_prod x_in x'_in)) (HV₁ (mk_mem_prod y_in y'_in)) },
  rcases this with ⟨U₁, U₁_nhd, V₁, V₁_nhd, H⟩,

  obtain ⟨x₁, x₁_in⟩ : U₁.nonempty :=
    ((de.comap_nhds_ne_bot _).nonempty_of_mem U₁_nhd),
  obtain ⟨y₁, y₁_in⟩ : V₁.nonempty :=
    ((df.comap_nhds_ne_bot _).nonempty_of_mem V₁_nhd),

  have cont_flip : continuous (λ p : δ × β, φ.flip p.1 p.2),
  { show continuous (Φ ∘ prod.swap), from hφ.comp continuous_swap },
  rcases (extend_Z_bilin_aux de df hφ W_nhd x₀ y₁) with ⟨U₂, U₂_nhd, HU⟩,
  rcases (extend_Z_bilin_aux df de cont_flip W_nhd y₀ x₁) with ⟨V₂, V₂_nhd, HV⟩,

  existsi [U₁ ∩ U₂, inter_mem U₁_nhd U₂_nhd,
            V₁ ∩ V₂, inter_mem V₁_nhd V₂_nhd],

  rintros x ⟨xU₁, xU₂⟩ x' ⟨x'U₁, x'U₂⟩ y ⟨yV₁, yV₂⟩ y' ⟨y'V₁, y'V₂⟩,
  have key_formula : φ x' y' - φ x y =
    φ(x' - x) y₁ + φ (x' - x) (y' - y₁) + φ x₁ (y' - y) + φ (x - x₁) (y' - y),
  { simp, abel },
  rw key_formula,
  have h₁ := HU x xU₂ x' x'U₂,
  have h₂ := H x xU₁ x' x'U₁ y₁ y₁_in y' y'V₁,
  have h₃ := HV y yV₂ y' y'V₂,
  have h₄ := H x₁ x₁_in x xU₁ y yV₁ y' y'V₁,
  exact W4 h₁ h₂ h₃ h₄
end

omit W'_nhd

open dense_inducing

/-- Bourbaki GT III.6.5 Theorem I:
ℤ-bilinear continuous maps from dense images into a complete Hausdorff group extend by continuity.
Note: Bourbaki assumes that α and β are also complete Hausdorff, but this is not necessary. -/
theorem extend_Z_bilin  : continuous (extend (de.prod df) Φ) :=
begin
  refine continuous_extend_of_cauchy _ _,
  rintro ⟨x₀, y₀⟩,
  split,
  { apply ne_bot.map,
    apply comap_ne_bot,

    intros U h,
    rcases mem_closure_iff_nhds.1 ((de.prod df).dense (x₀, y₀)) U h with ⟨x, x_in, ⟨z, z_x⟩⟩,
    existsi z,
    cc },
  { suffices : map (λ (p : (β × δ) × (β × δ)), Φ p.2 - Φ p.1)
      (comap (λ (p : (β × δ) × β × δ), ((e p.1.1, f p.1.2), (e p.2.1, f p.2.2)))
         (𝓝 (x₀, y₀) ×ᶠ 𝓝 (x₀, y₀))) ≤ 𝓝 0,
    by rwa [uniformity_eq_comap_nhds_zero G, prod_map_map_eq, ←map_le_iff_le_comap, filter.map_map,
        prod_comap_comap_eq],

    intros W' W'_nhd,

    have key := extend_Z_bilin_key de df hφ W'_nhd x₀ y₀,
    rcases key with ⟨U, U_nhd, V, V_nhd, h⟩,
    rw mem_comap at U_nhd,
    rcases U_nhd with ⟨U', U'_nhd, U'_sub⟩,
    rw mem_comap at V_nhd,
    rcases V_nhd with ⟨V', V'_nhd, V'_sub⟩,

    rw [mem_map, mem_comap, nhds_prod_eq],
    existsi (U' ×ˢ V') ×ˢ (U' ×ˢ V'),
    rw mem_prod_same_iff,

    simp only [exists_prop],
    split,
    { change U' ∈ 𝓝 x₀ at U'_nhd,
      change V' ∈ 𝓝 y₀ at V'_nhd,
      have := prod_mem_prod U'_nhd V'_nhd,
      tauto },
    { intros p h',
      simp only [set.mem_preimage, set.prod_mk_mem_set_prod_eq] at h',
      rcases p with ⟨⟨x, y⟩, ⟨x', y'⟩⟩,
      apply h ; tauto } }
end
end dense_inducing


/-
Copyright (c) 2022 Jeoff Lee. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeoff Lee
-/
import tactic.linear_combination
import ring_theory.roots_of_unity
import ring_theory.polynomial.cyclotomic.basic

/-!
# The Solution of a Cubic

This file proves Theorem 37 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

In this file, we give the solutions to the cubic equation `a * x^3 + b * x^2 + c * x + d = 0`
over a field `K` that has characteristic neither 2 nor 3, that has a third primitive root of
unity, and in which certain other quantities admit square and cube roots.

This is based on the [Cardano's Formula](https://en.wikipedia.org/wiki/Cubic_equation#Cardano's_formula).

## Main statements

- `cubic_eq_zero_iff` : gives the roots of the cubic equation
where the discriminant `p = 3 * a * c - b^2` is nonzero.
- `cubic_eq_zero_iff_of_p_eq_zero` : gives the roots of the cubic equation
where the discriminant equals zero.

## References

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL-ex/Cubic_Quartic.html) was written by Amine Chaieb.

## Tags

polynomial, cubic, root
-/

section field

open polynomial

variables {K : Type*} [field K]
variables [invertible (2 : K)] [invertible (3 : K)]
variables (a b c d : K)
variables {ω p q r s t : K}

lemma cube_root_of_unity_sum (hω : is_primitive_root ω 3) : 1 + ω + ω^2 = 0 :=
begin
  convert is_root_cyclotomic (nat.succ_pos _) hω,
  rw [cyclotomic_eq_geom_sum nat.prime_three, eval_geom_sum],
  simp only [geom_sum_succ, geom_sum_zero],
  ring,
end

/-- The roots of a monic cubic whose quadratic term is zero and whose discriminant is nonzero. -/
lemma cubic_basic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp_nonzero : p ≠ 0)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + 3 * p * x - 2 * q = 0 ↔
    x = s       - t        ∨
    x = s * ω   - t * ω^2  ∨
    x = s * ω^2 - t * ω    :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  rw h₁,
  refine eq.congr _ rfl,
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    linear_combination (ht, -1) (hs_nonzero, t) },
  rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
  have H := cube_root_of_unity_sum hω,
  linear_combination
    (hr, 1)
    (hs3, - q + r + s ^ 3)
    (ht, -3 * x * s ^ 3 - (t * s) ^ 2 - (t * s) * p - p ^ 2)
    (H, (x ^ 2 * (s - t) + x * (- ω * (s ^ 2 + t ^ 2) + s * t * (3 + ω ^ 2 - ω))
        - (-(s ^ 3 - t ^ 3) * (ω - 1) + s^2 * t * ω ^ 2 - s * t^2 * ω ^ 2)) * s ^ 3),
end

/-- Roots of a monic cubic whose discriminant is nonzero. -/
lemma cubic_monic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * c - b^2) / 9)
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * b * c - 2 * b^3 - 27 * d) / 54)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / 3 ∨
    x = s * ω   - t * ω^2 - b / 3 ∨
    x = s * ω^2 - t * ω   - b / 3 :=
begin
  let y := x + b / 3,
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : x^3 + b * x^2 + c * x + d = y^3 + 3 * p * y - 2 * q,
  { dsimp only [y],
    rw [hp, hq],
    field_simp [h9, h54], ring, },
  rw [h₁, cubic_basic_eq_zero_iff hω hp_nonzero hr hs3 ht y],
  dsimp only [y],
  simp_rw [eq_sub_iff_add_eq],
end

/-- **The Solution of Cubic**.
  The roots of a cubic polynomial whose discriminant is nonzero. -/
theorem cubic_eq_zero_iff (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * a * c - b^2) / (9 * a^2))
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / (3 * a) ∨
    x = s * ω   - t * ω^2 - b / (3 * a) ∨
    x = s * ω^2 - t * ω   - b / (3 * a) :=
begin
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : a * x^3 + b * x^2 + c * x + d = a * (x^3 + b/a * x^2 + c/a * x + d/a),
  { field_simp, ring },
  have h₂ : ∀ x, a * x = 0 ↔ x = 0, { intros x, simp [ha], },
  have hp' : p = (3 * (c/a) - (b/a) ^ 2) / 9, { field_simp [hp, h9], ring_nf },
  have hq' : q = (9 * (b/a) * (c/a) - 2 * (b/a) ^ 3 - 27 * (d/a)) / 54,
  { field_simp [hq, h54], ring_nf },
  rw [h₁, h₂, cubic_monic_eq_zero_iff (b/a) (c/a) (d/a) hω hp' hp_nonzero hq' hr hs3 ht x],
  have h₄ := calc b / a / 3 = b / (a * 3) : by { field_simp [ha] }
                        ... = b / (3 * a) : by rw mul_comm,
  rw [h₄],
end

/-- the solution of the cubic equation when p equals zero. -/
lemma cubic_eq_zero_iff_of_p_eq_zero (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hpz : 3 * a * c - b^2 = 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hs3 : s^3 = 2 * q)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - b / (3 * a) ∨
    x = s * ω   - b / (3 * a) ∨
    x = s * ω^2 - b / (3 * a) :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have hb2 : b^2 = 3 * a * c, { rw sub_eq_zero at hpz, rw hpz },
  have hb3 : b^3 = 3 * a * b * c, { rw [pow_succ, hb2], ring },
  have h₂ :=
    calc  a * x^3 + b * x^2 + c * x + d
        = a * (x + b/(3*a))^3 + (c - b^2/(3*a)) * x + (d - b^3*a/(3*a)^3)
          : by { field_simp, ring }
    ... = a * (x + b/(3*a))^3 + (d - (9*a*b*c-2*b^3)*a/(3*a)^3)
          : by { simp only [hb2, hb3], field_simp, ring }
    ... = a * ((x + b/(3*a))^3 - s^3)
          : by { rw [hs3, hq], field_simp [h54], ring, },
  have h₃ : ∀ x, a * x = 0 ↔ x = 0, { intro x, simp [ha] },
  have h₄ : ∀ x : K, x^3 - s^3 = (x - s) * (x - s * ω) * (x - s * ω^2),
  { intro x,
    calc  x^3 - s^3
        = (x - s) * (x^2 + x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + (1+ω+ω^2)*x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + ω^3*s^2)
        : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], simp, }
    ... = (x - s) * (x - s * ω) * (x - s * ω^2) : by ring },
  rw [h₁, h₂, h₃, h₄ (x + b/(3*a))],
  ring_nf,
end

end field


--variable (α : ℕ) (b c d a e x: ℕ)

--variable(hab : a = b) (hcb : c = b) (hcd : c = d)

--example : a = d :=

--Eq.trans (Eq.trans hab (Eq.symm hcb)) hcd

--theorem T : a = e :=
 -- calc
   -- a = b     := h1
 --   _ = c + 1 := h2
 --   _ = d + 1 := congrArg Nat.succ h3
 --   _ = 1 + d := Nat.add_comm d 1
  --  _ = e     := Eq.symm h4

example : ∃ x : Nat , x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  ⟨1, h⟩

-- ∀x ∈ ℕ, 0 * x = x * 0 = 0

example : ∀ x : Nat, x * 0 = 0 :=
  λ(a1 : Nat) =>
    rfl

-- ∀x ∈ ℕ, 0 * x = 0
example : ∀ x : Nat, 0 * x = 0 :=
  λ(a1 : Nat) =>
    Nat.recOn a1 (rfl : 0 * 0 = 0) (λ(n : Nat) =>
      λ(h1 : 0 * n = 0) => by
        calc
          0 * (n+1) = (0 * n) + 0 := rfl
          _ = 0 + 0               := by rw[h1]
          _ = 0                   := rfl
        )

--

def ChrisSum (p : Nat) : Nat :=
  match p with
    | 0 => 0
    | n + 1 => ChrisSum n + (n+1)

-- ChrisSum n = n * (n+1)/2

example : ∀ x : Nat, ChrisSum x = x * (x+1) / 2 :=
  λ(a : Nat) =>
    Nat.recOn a (rfl) (λ(n : Nat) =>
      λ(h1 : ChrisSum n = n * (n+1) / 2) =>
        calc
          ChrisSum (n+1) = ChrisSum n + (n+1)   := rfl
          _ = (n * (n+1) / 2) + (n+1)           := by rw[h1]
          _ = ((n+1) * n /2) + (n+1)            := by rw[Nat.mul_comm]
          _ = ((n+1) * n /2) + (n+1)*1          := by rw[Nat.mul_one]
          _ = (n+1)*(n/2) + (n+1)*1             := sorry
          _ = (n+1)*(n/2 + 1)                   := by rw[Nat.left_distrib]
          _ = (n+1)*(n/2 + 2/2)                 := rfl
          _ = (n+1)*((n+2)/2)                   := sorry
          _ = (n+1)*(n+2)/2                     := sorry
    )

def GrahamSum (p : Nat) : Nat :=
  match p with
    | 0 => 0
    | n + 1 => GrahamSum n + (2*(n+1)-1)

example : ∀ x : Nat, GrahamSum x = x*x :=
  λ(a : Nat) =>
    Nat.recOn a (rfl) (λ(n : Nat) =>
      λ(h1 : GrahamSum n = n*n) =>
        calc
          GrahamSum (n+1) = GrahamSum n + 2*(n+1) - 1            := rfl
          _ = (n * n) + 2*(n+1) - 1                                := by rw[h1]
          _ = (n * n) + (2*n + 2*1) - 1                            := by rw[Nat.left_distrib]
          _ = (n * n) + (2*n + 2) - 1                              := rfl
          _ = (n * n) + 2*n + 2 - 1                                := by rw[Nat.add_assoc]
          _ = (n * n) + 2*n + 1                                    := rfl
          _ = ((n*n) + 2*n) + 1                                    := by rw[Nat.add_assoc]
          _ = ((n*n) + (2*n)) + 1                                  := rfl
          _ = ((n*n) + (n*2)) + 1                                  := by simp[Nat.mul_comm]
          _ = (n * (n + 2)) + 1                                    := by rw[<-Nat.left_distrib]
          _ =
          _  = (n+1)*(n+1)                                         := sorry
    )


import M4R.Algebra.Group

namespace M4R

  class NCSemiring (α : Type _) extends CommMonoid α, One α, Mul α where
    mul_one           : ∀ a : α, a * 1 = a
    one_mul           : ∀ a : α, 1 * a = a
    mul_assoc         : ∀ a b c : α, (a * b) * c = a * (b * c)
    mul_distrib_left  : ∀ a b c : α, a * (b + c) = a * b + a * c
    mul_distrib_right : ∀ a b c : α, (a + b) * c = a * c + b * c
    mul_zero          : ∀ a : α, a * 0 = 0
    zero_mul          : ∀ a : α, 0 * a = 0

  class Semiring (α : Type _) extends NCSemiring α where
    mul_comm  : ∀ a b : α, a * b = b * a

  class NCRing (α : Type _) extends NCSemiring α, Group α

  class Ring (α : Type _) extends NCRing α, Semiring α

  class NonTrivialNCSemiring (α : Type _) extends NCSemiring α, NonTrivial α

  class NonTrivialSemiring (α : Type _) extends Semiring α, NonTrivialNCSemiring α

  class NonTrivialNCRing (α : Type _) extends NCRing α, NonTrivialNCSemiring α

  class NonTrivialRing (α : Type _) extends Ring α, NonTrivialNCRing α

  structure SubSemiring (α : Type _) [NCSemiring α] extends SubMonoid α where
    has_one    : 1 ∈ subset
    mul_closed : ∀ a ∈ subset, ∀ b ∈ subset,  a * b ∈ subset
  instance SubSemiringMem [NCSemiring α] : Mem α (SubSemiring α) where mem := fun x S => x ∈ S.subset

  structure SubRing (α : Type _) [NCRing α] extends SubSemiring α, SubGroup α
  instance SubRingMem [NCRing α] : Mem α (SubRing α) where mem := fun x S => x ∈ S.subset

  namespace NCSemiring
    protected def ofNat [NCSemiring α] (n : Nat) : α :=
      match n with
      | Nat.zero   => 0
      | Nat.succ m => match m with
        | Nat.zero => 1
        | _        => (NCSemiring.ofNat m) + 1
    instance RingOfNatCoe [NCSemiring α] : Coe Nat α where coe := NCSemiring.ofNat

    protected def pow_nat [NCSemiring α] (a : α) (n : Nat) : α :=
      match n with
      | Nat.zero   => 1
      | Nat.succ m => match m with
        | Nat.zero => a
        | _        => (NCSemiring.pow_nat a m) * a
    instance RingPowNat [NCSemiring α] : Pow α Nat where pow := NCSemiring.pow_nat

    theorem all_trivial [NCSemiring α] (h10 : (1 : α) = 0) (x : α) : x = 0 := by
      rw [←mul_one x, h10, mul_zero]

  end NCSemiring

  namespace Semiring

    def divides [Semiring α] (a b : α) : Prop := ∃ c, a * c = b
    instance [Semiring α] : Divides α where
      divides := divides

    def isUnit [Semiring α] (a : α) : Prop := a ÷ 1

    def associates [Semiring α] (a b : α) : Prop := ∃ c, isUnit c ∧ a * c = b
    instance SemiringAssociateEq [Semiring α] : RingEq α where
      ringeq := associates

    def irreducible [Semiring α] (a : α) : Prop :=
      a ≠ 0 ∧ ¬isUnit a ∧ ∀ x y, x * y = a → (isUnit x ∨ isUnit y)

  end Semiring

  protected instance NCRing.toAbelianGroup [NCRing α] : AbelianGroup α where
    add_comm := CommMonoid.add_comm

end M4R


import data.real.basic
import topology.basic
open function
open set

namespace xena -- hide
/-
# Chapter 7 : Cardinality

## Level 2

A classical result about finite sets.
-/

-- begin hide
local attribute [instance] classical.prop_decidable
-- end hide

/- Lemma
If $f : X \to Y$ is an injective function and $Y$ is finite, then
$X$ is also finite.
-/
theorem finite_inj (X Y : set ℝ) (f : X → Y) (hY : finite Y) :
    injective f → finite X :=
begin
    intro hf,
    have h1 := finite.fintype hY, -- can't get f(X) ⊆ Y, type coercion problem
    --have H1 := card_image_of_injective,
    sorry,
end

end xena -- hide

-- begin hide
--#check finite_subsets_of_finite
-- end hide


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring_exp
import Mathlib.data.nat.parity
import Mathlib.data.nat.choose.sum
import Mathlib.PostPort

namespace Mathlib

/-!
# Primorial

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ :=
  finset.prod (finset.filter nat.prime (finset.range (n + 1))) fun (p : ℕ) => p

theorem primorial_succ {n : ℕ} (n_big : 1 < n) (r : n % bit0 1 = 1) :
    primorial (n + 1) = primorial n :=
  sorry

theorem dvd_choose_of_middling_prime (p : ℕ) (is_prime : nat.prime p) (m : ℕ) (p_big : m + 1 < p)
    (p_small : p ≤ bit0 1 * m + 1) : p ∣ nat.choose (bit0 1 * m + 1) (m + 1) :=
  sorry

theorem prod_primes_dvd {s : finset ℕ} (n : ℕ) (h : ∀ (a : ℕ), a ∈ s → nat.prime a)
    (div : ∀ (a : ℕ), a ∈ s → a ∣ n) : (finset.prod s fun (p : ℕ) => p) ∣ n :=
  sorry

theorem primorial_le_4_pow (n : ℕ) : primorial n ≤ bit0 (bit0 1) ^ n := sorry

end Mathlib


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov
-/
import analysis.normed.group.basic
import linear_algebra.affine_space.affine_subspace
import linear_algebra.affine_space.midpoint

/-!
# Torsors of additive normed group actions.

This file defines torsors of additive normed group actions, with a
metric space structure.  The motivating case is Euclidean affine
spaces.
-/

noncomputable theory
open_locale nnreal topology
open filter

/-- A `normed_add_torsor V P` is a torsor of an additive seminormed group
action by a `seminormed_add_comm_group V` on points `P`. We bundle the pseudometric space
structure and require the distance to be the same as results from the
norm (which in fact implies the distance yields a pseudometric space, but
bundling just the distance and using an instance for the pseudometric space
results in type class problems). -/
class normed_add_torsor (V : out_param $ Type*) (P : Type*)
  [out_param $ seminormed_add_comm_group V] [pseudo_metric_space P]
  extends add_torsor V P :=
(dist_eq_norm' : ∀ (x y : P), dist x y = ‖(x -ᵥ y : V)‖)

/-- Shortcut instance to help typeclass inference out. -/
@[priority 100]
instance normed_add_torsor.to_add_torsor' {V P : Type*} [normed_add_comm_group V] [metric_space P]
  [normed_add_torsor V P] : add_torsor V P := normed_add_torsor.to_add_torsor

variables {α V P W Q : Type*} [seminormed_add_comm_group V] [pseudo_metric_space P]
  [normed_add_torsor V P] [normed_add_comm_group W] [metric_space Q] [normed_add_torsor W Q]

@[priority 100]
instance normed_add_torsor.to_has_isometric_vadd : has_isometric_vadd V P :=
⟨λ c, isometry.of_dist_eq $ λ x y, by simp [normed_add_torsor.dist_eq_norm']⟩

/-- A `seminormed_add_comm_group` is a `normed_add_torsor` over itself. -/
@[priority 100]
instance seminormed_add_comm_group.to_normed_add_torsor : normed_add_torsor V V :=
{ dist_eq_norm' := dist_eq_norm }

/-- A nonempty affine subspace of a `normed_add_torsor` is itself a `normed_add_torsor`. -/
@[nolint fails_quickly] -- Because of the add_torsor.nonempty instance.
instance affine_subspace.to_normed_add_torsor {R : Type*} [ring R] [module R V]
  (s : affine_subspace R P) [nonempty s] : normed_add_torsor s.direction s :=
{ dist_eq_norm' := λ x y, normed_add_torsor.dist_eq_norm' ↑x ↑y,
  ..affine_subspace.to_add_torsor s }

include V

section

variables (V W)

/-- The distance equals the norm of subtracting two points. In this
lemma, it is necessary to have `V` as an explicit argument; otherwise
`rw dist_eq_norm_vsub` sometimes doesn't work. -/
lemma dist_eq_norm_vsub (x y : P) : dist x y = ‖x -ᵥ y‖ := normed_add_torsor.dist_eq_norm' x y

/-- The distance equals the norm of subtracting two points. In this
lemma, it is necessary to have `V` as an explicit argument; otherwise
`rw dist_eq_norm_vsub'` sometimes doesn't work. -/
lemma dist_eq_norm_vsub' (x y : P) : dist x y = ‖y -ᵥ x‖ :=
(dist_comm _ _).trans (dist_eq_norm_vsub _ _ _)

end

lemma dist_vadd_cancel_left (v : V) (x y : P) :
  dist (v +ᵥ x) (v +ᵥ y) = dist x y :=
dist_vadd _ _ _

@[simp] lemma dist_vadd_cancel_right (v₁ v₂ : V) (x : P) :
  dist (v₁ +ᵥ x) (v₂ +ᵥ x) = dist v₁ v₂ :=
by rw [dist_eq_norm_vsub V, dist_eq_norm, vadd_vsub_vadd_cancel_right]

@[simp] lemma dist_vadd_left (v : V) (x : P) : dist (v +ᵥ x) x = ‖v‖ :=
by simp [dist_eq_norm_vsub V _ x]

@[simp] lemma dist_vadd_right (v : V) (x : P) : dist x (v +ᵥ x) = ‖v‖ :=
by rw [dist_comm, dist_vadd_left]

/-- Isometry between the tangent space `V` of a (semi)normed add torsor `P` and `P` given by
addition/subtraction of `x : P`. -/
@[simps] def isometry_equiv.vadd_const (x : P) : V ≃ᵢ P :=
{ to_equiv := equiv.vadd_const x,
  isometry_to_fun := isometry.of_dist_eq $ λ _ _, dist_vadd_cancel_right _ _ _ }

@[simp] lemma dist_vsub_cancel_left (x y z : P) : dist (x -ᵥ y) (x -ᵥ z) = dist y z :=
by rw [dist_eq_norm, vsub_sub_vsub_cancel_left, dist_comm, dist_eq_norm_vsub V]

/-- Isometry between the tangent space `V` of a (semi)normed add torsor `P` and `P` given by
subtraction from `x : P`. -/
@[simps] def isometry_equiv.const_vsub (x : P) : P ≃ᵢ V :=
{ to_equiv := equiv.const_vsub x,
  isometry_to_fun := isometry.of_dist_eq $ λ y z, dist_vsub_cancel_left _ _ _ }

@[simp] lemma dist_vsub_cancel_right (x y z : P) : dist (x -ᵥ z) (y -ᵥ z) = dist x y :=
(isometry_equiv.vadd_const z).symm.dist_eq x y

lemma dist_vadd_vadd_le (v v' : V) (p p' : P) :
  dist (v +ᵥ p) (v' +ᵥ p') ≤ dist v v' + dist p p' :=
by simpa using dist_triangle (v +ᵥ p) (v' +ᵥ p) (v' +ᵥ p')

lemma dist_vsub_vsub_le (p₁ p₂ p₃ p₄ : P) :
  dist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ dist p₁ p₃ + dist p₂ p₄ :=
by { rw [dist_eq_norm, vsub_sub_vsub_comm, dist_eq_norm_vsub V, dist_eq_norm_vsub V],
 exact norm_sub_le _ _ }

lemma nndist_vadd_vadd_le (v v' : V) (p p' : P) :
  nndist (v +ᵥ p) (v' +ᵥ p') ≤ nndist v v' + nndist p p' :=
by simp only [← nnreal.coe_le_coe, nnreal.coe_add, ← dist_nndist, dist_vadd_vadd_le]

lemma nndist_vsub_vsub_le (p₁ p₂ p₃ p₄ : P) :
  nndist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ nndist p₁ p₃ + nndist p₂ p₄ :=
by simp only [← nnreal.coe_le_coe, nnreal.coe_add, ← dist_nndist, dist_vsub_vsub_le]

lemma edist_vadd_vadd_le (v v' : V) (p p' : P) :
  edist (v +ᵥ p) (v' +ᵥ p') ≤ edist v v' + edist p p' :=
by { simp only [edist_nndist], apply_mod_cast nndist_vadd_vadd_le }

lemma edist_vsub_vsub_le (p₁ p₂ p₃ p₄ : P) :
  edist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ edist p₁ p₃ + edist p₂ p₄ :=
by { simp only [edist_nndist], apply_mod_cast nndist_vsub_vsub_le }

omit V

/-- The pseudodistance defines a pseudometric space structure on the torsor. This
is not an instance because it depends on `V` to define a `metric_space
P`. -/
def pseudo_metric_space_of_normed_add_comm_group_of_add_torsor (V P : Type*)
  [seminormed_add_comm_group V] [add_torsor V P] : pseudo_metric_space P :=
{ dist := λ x y, ‖(x -ᵥ y : V)‖,
  dist_self := λ x, by simp,
  dist_comm := λ x y, by simp only [←neg_vsub_eq_vsub_rev y x, norm_neg],
  dist_triangle := begin
    intros x y z,
    change ‖x -ᵥ z‖ ≤ ‖x -ᵥ y‖ + ‖y -ᵥ z‖,
    rw ←vsub_add_vsub_cancel,
    apply norm_add_le
  end }

/-- The distance defines a metric space structure on the torsor. This
is not an instance because it depends on `V` to define a `metric_space
P`. -/
def metric_space_of_normed_add_comm_group_of_add_torsor (V P : Type*)
  [normed_add_comm_group V] [add_torsor V P] :
  metric_space P :=
{ dist := λ x y, ‖(x -ᵥ y : V)‖,
  dist_self := λ x, by simp,
  eq_of_dist_eq_zero := λ x y h, by simpa using h,
  dist_comm := λ x y, by simp only [←neg_vsub_eq_vsub_rev y x, norm_neg],
  dist_triangle := begin
    intros x y z,
    change ‖x -ᵥ z‖ ≤ ‖x -ᵥ y‖ + ‖y -ᵥ z‖,
    rw ←vsub_add_vsub_cancel,
    apply norm_add_le
  end }

include V

lemma lipschitz_with.vadd [pseudo_emetric_space α] {f : α → V} {g : α → P} {Kf Kg : ℝ≥0}
  (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
  lipschitz_with (Kf + Kg) (f +ᵥ g) :=
λ x y,
calc edist (f x +ᵥ g x) (f y +ᵥ g y) ≤ edist (f x) (f y) + edist (g x) (g y) :
  edist_vadd_vadd_le _ _ _ _
... ≤ Kf * edist x y + Kg * edist x y :
  add_le_add (hf x y) (hg x y)
... = (Kf + Kg) * edist x y :
  (add_mul _ _ _).symm

lemma lipschitz_with.vsub [pseudo_emetric_space α] {f g : α → P} {Kf Kg : ℝ≥0}
  (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
  lipschitz_with (Kf + Kg) (f -ᵥ g) :=
λ x y,
calc edist (f x -ᵥ g x) (f y -ᵥ g y) ≤ edist (f x) (f y) + edist (g x) (g y) :
  edist_vsub_vsub_le _ _ _ _
... ≤ Kf * edist x y + Kg * edist x y :
  add_le_add (hf x y) (hg x y)
... = (Kf + Kg) * edist x y :
  (add_mul _ _ _).symm

lemma uniform_continuous_vadd : uniform_continuous (λ x : V × P, x.1 +ᵥ x.2) :=
(lipschitz_with.prod_fst.vadd lipschitz_with.prod_snd).uniform_continuous

lemma uniform_continuous_vsub : uniform_continuous (λ x : P × P, x.1 -ᵥ x.2) :=
(lipschitz_with.prod_fst.vsub lipschitz_with.prod_snd).uniform_continuous

@[priority 100] instance normed_add_torsor.to_has_continuous_vadd : has_continuous_vadd V P :=
{ continuous_vadd := uniform_continuous_vadd.continuous }

lemma continuous_vsub : continuous (λ x : P × P, x.1 -ᵥ x.2) :=
uniform_continuous_vsub.continuous

lemma filter.tendsto.vsub {l : filter α} {f g : α → P} {x y : P}
  (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) :
  tendsto (f -ᵥ g) l (𝓝 (x -ᵥ y)) :=
(continuous_vsub.tendsto (x, y)).comp (hf.prod_mk_nhds hg)

section

variables [topological_space α]

lemma continuous.vsub {f g : α → P} (hf : continuous f) (hg : continuous g) :
  continuous (f -ᵥ g) :=
continuous_vsub.comp (hf.prod_mk hg : _)

lemma continuous_at.vsub {f g : α → P}  {x : α} (hf : continuous_at f x) (hg : continuous_at g x) :
  continuous_at (f -ᵥ g) x :=
hf.vsub hg

lemma continuous_within_at.vsub {f g : α → P} {x : α} {s : set α}
  (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
  continuous_within_at (f -ᵥ g) s x :=
hf.vsub hg

end

section

variables {R : Type*} [ring R] [topological_space R] [module R V] [has_continuous_smul R V]

lemma filter.tendsto.line_map {l : filter α} {f₁ f₂ : α → P} {g : α → R} {p₁ p₂ : P} {c : R}
  (h₁ : tendsto f₁ l (𝓝 p₁)) (h₂ : tendsto f₂ l (𝓝 p₂)) (hg : tendsto g l (𝓝 c)) :
  tendsto (λ x, affine_map.line_map (f₁ x) (f₂ x) (g x)) l (𝓝 $ affine_map.line_map p₁ p₂ c) :=
(hg.smul (h₂.vsub h₁)).vadd h₁

lemma filter.tendsto.midpoint [invertible (2:R)] {l : filter α} {f₁ f₂ : α → P} {p₁ p₂ : P}
  (h₁ : tendsto f₁ l (𝓝 p₁)) (h₂ : tendsto f₂ l (𝓝 p₂)) :
  tendsto (λ x, midpoint R (f₁ x) (f₂ x)) l (𝓝 $ midpoint R p₁ p₂) :=
h₁.line_map h₂ tendsto_const_nhds

end


/-
Copyright (c) 2020 Paul van Wamelen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul van Wamelen
-/
import algebra.field
import ring_theory.int.basic
import algebra.group_with_zero.power
import tactic.ring
import tactic.ring_exp
import tactic.field_simp
import data.zmod.basic

/-!
# Pythagorean Triples

The main result is the classification of Pythagorean triples. The final result is for general
Pythagorean triples. It follows from the more interesting relatively prime case. We use the
"rational parametrization of the circle" method for the proof. The parametrization maps the point
`(x / z, y / z)` to the slope of the line through `(-1 , 0)` and `(x / z, y / z)`. This quickly
shows that `(x / z, y / z) = (2 * m * n / (m ^ 2 + n ^ 2), (m ^ 2 - n ^ 2) / (m ^ 2 + n ^ 2))` where
`m / n` is the slope. In order to identify numerators and denominators we now need results showing
that these are coprime. This is easy except for the prime 2. In order to deal with that we have to
analyze the parity of `x`, `y`, `m` and `n` and eliminate all the impossible cases. This takes up
the bulk of the proof below.
-/

lemma sq_ne_two_fin_zmod_four (z : zmod 4) : z * z ≠ 2 :=
begin
  change fin 4 at z,
  fin_cases z; norm_num [fin.ext_iff, fin.coe_bit0, fin.coe_bit1]
end

lemma int.sq_ne_two_mod_four (z : ℤ) : (z * z) % 4 ≠ 2 :=
suffices ¬ (z * z) % (4 : ℕ) = 2 % (4 : ℕ), by norm_num at this,
begin
  rw ← zmod.int_coe_eq_int_coe_iff',
  simpa using sq_ne_two_fin_zmod_four _
end

noncomputable theory
open_locale classical

/-- Three integers `x`, `y`, and `z` form a Pythagorean triple if `x * x + y * y = z * z`. -/
def pythagorean_triple (x y z : ℤ) : Prop := x * x + y * y = z * z

/-- Pythagorean triples are interchangable, i.e `x * x + y * y = y * y + x * x = z * z`.
This comes from additive commutativity. -/
lemma pythagorean_triple_comm {x y z : ℤ} :
 (pythagorean_triple x y z) ↔ (pythagorean_triple y x z) :=
by { delta pythagorean_triple, rw add_comm }

/-- The zeroth Pythagorean triple is all zeros. -/
lemma pythagorean_triple.zero : pythagorean_triple 0 0 0 :=
by simp only [pythagorean_triple, zero_mul, zero_add]

namespace pythagorean_triple

variables {x y z : ℤ} (h : pythagorean_triple x y z)

include h

lemma eq : x * x + y * y = z * z := h

@[symm]
lemma symm :
  pythagorean_triple y x z :=
by rwa [pythagorean_triple_comm]

/-- A triple is still a triple if you multiply `x`, `y` and `z`
by a constant `k`. -/
lemma mul (k : ℤ) : pythagorean_triple (k * x) (k * y) (k * z) :=
begin
  by_cases hk : k = 0,
  { simp only [pythagorean_triple, hk, zero_mul, zero_add], },
  { calc (k * x) * (k * x) + (k * y) * (k * y)
        = k ^ 2 * (x * x + y * y) : by ring
    ... = k ^ 2 * (z * z)         : by rw h.eq
    ... = (k * z) * (k * z)       : by ring }
end

omit h

/-- `(k*x, k*y, k*z)` is a Pythagorean triple if and only if
`(x, y, z)` is also a triple. -/
lemma mul_iff (k : ℤ) (hk : k ≠ 0) :
  pythagorean_triple (k * x) (k * y) (k * z) ↔ pythagorean_triple x y z :=
begin
  refine ⟨_, λ h, h.mul k⟩,
  simp only [pythagorean_triple],
  intro h,
  rw ← mul_left_inj' (mul_ne_zero hk hk),
  convert h using 1; ring,
end

include h

/-- A Pythagorean triple `x, y, z` is “classified” if there exist integers `k, m, n` such that
either
 * `x = k * (m ^ 2 - n ^ 2)` and `y = k * (2 * m * n)`, or
 * `x = k * (2 * m * n)` and `y = k * (m ^ 2 - n ^ 2)`. -/
@[nolint unused_arguments] def is_classified := ∃ (k m n : ℤ),
  ((x = k * (m ^ 2 - n ^ 2) ∧ y = k * (2 * m * n))
    ∨ (x = k * (2 * m * n) ∧ y = k * (m ^ 2 - n ^ 2)))
  ∧ int.gcd m n = 1

/-- A primitive pythogorean triple `x, y, z` is a pythagorean triple with `x` and `y` coprime.
 Such a triple is “primitively classified” if there exist coprime integers `m, n` such that either
 * `x = m ^ 2 - n ^ 2` and `y = 2 * m * n`, or
 * `x = 2 * m * n` and `y = m ^ 2 - n ^ 2`.
-/
@[nolint unused_arguments] def is_primitive_classified := ∃ (m n : ℤ),
  ((x = m ^ 2 - n ^ 2 ∧ y = 2 * m * n)
    ∨ (x = 2 * m * n ∧ y = m ^ 2 - n ^ 2))
  ∧ int.gcd m n = 1
  ∧ ((m % 2 = 0 ∧ n % 2 = 1) ∨ (m % 2 = 1 ∧ n % 2 = 0))

lemma mul_is_classified (k : ℤ) (hc : h.is_classified) : (h.mul k).is_classified :=
begin
  obtain ⟨l, m, n, ⟨⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, co⟩⟩ := hc,
  { use [k * l, m, n], apply and.intro _ co, left, split; ring },
  { use [k * l, m, n], apply and.intro _ co, right, split; ring },
end

lemma even_odd_of_coprime (hc : int.gcd x y = 1) :
  (x % 2 = 0 ∧ y % 2 = 1) ∨ (x % 2 = 1 ∧ y % 2 = 0) :=
begin
  cases int.mod_two_eq_zero_or_one x with hx hx;
    cases int.mod_two_eq_zero_or_one y with hy hy,
  { -- x even, y even
    exfalso,
    apply nat.not_coprime_of_dvd_of_dvd (dec_trivial : 1 < 2) _ _ hc,
    { apply int.dvd_nat_abs_of_of_nat_dvd, apply int.dvd_of_mod_eq_zero hx },
    { apply int.dvd_nat_abs_of_of_nat_dvd, apply int.dvd_of_mod_eq_zero hy } },
  { left, exact ⟨hx, hy⟩ },  -- x even, y odd
  { right, exact ⟨hx, hy⟩ }, -- x odd, y even
  { -- x odd, y odd
    exfalso,
    obtain ⟨x0, y0, rfl, rfl⟩ : ∃ x0 y0, x = x0* 2 + 1 ∧ y = y0 * 2 + 1,
    { cases exists_eq_mul_left_of_dvd (int.dvd_sub_of_mod_eq hx) with x0 hx2,
      cases exists_eq_mul_left_of_dvd (int.dvd_sub_of_mod_eq hy) with y0 hy2,
      rw sub_eq_iff_eq_add at hx2 hy2, exact ⟨x0, y0, hx2, hy2⟩ },
    apply int.sq_ne_two_mod_four z,
    rw show z * z = 4 * (x0 * x0 + x0 + y0 * y0 + y0) + 2, by { rw ← h.eq, ring },
    norm_num [int.add_mod] }
end

lemma gcd_dvd : (int.gcd x y : ℤ) ∣ z :=
begin
  by_cases h0 : int.gcd x y = 0,
  { have hx : x = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_left h0 },
    have hy : y = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_right h0 },
    have hz : z = 0,
    { simpa only [pythagorean_triple, hx, hy, add_zero, zero_eq_mul, mul_zero, or_self] using h },
    simp only [hz, dvd_zero], },
  obtain ⟨k, x0, y0, k0, h2, rfl, rfl⟩ :
    ∃ (k : ℕ) x0 y0, 0 < k ∧ int.gcd x0 y0 = 1 ∧ x = x0 * k ∧ y = y0 * k :=
    int.exists_gcd_one' (nat.pos_of_ne_zero h0),
  rw [int.gcd_mul_right, h2, int.nat_abs_of_nat, one_mul],
  rw [← int.pow_dvd_pow_iff (dec_trivial : 0 < 2), sq z, ← h.eq],
  rw (by ring : x0 * k * (x0 * k) + y0 * k * (y0 * k) = k ^ 2 * (x0 * x0 + y0 * y0)),
  exact dvd_mul_right _ _
end

lemma normalize : pythagorean_triple (x / int.gcd x y) (y / int.gcd x y) (z / int.gcd x y) :=
begin
  by_cases h0 : int.gcd x y = 0,
  { have hx : x = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_left h0 },
    have hy : y = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_right h0 },
    have hz : z = 0,
    { simpa only [pythagorean_triple, hx, hy, add_zero, zero_eq_mul, mul_zero, or_self] using h },
    simp only [hx, hy, hz, int.zero_div], exact zero },
  rcases h.gcd_dvd with ⟨z0, rfl⟩,
  obtain ⟨k, x0, y0, k0, h2, rfl, rfl⟩ :
    ∃ (k : ℕ) x0 y0, 0 < k ∧ int.gcd x0 y0 = 1 ∧ x = x0 * k ∧ y = y0 * k :=
    int.exists_gcd_one' (nat.pos_of_ne_zero h0),
  have hk : (k : ℤ) ≠ 0, { norm_cast, rwa pos_iff_ne_zero at k0 },
  rw [int.gcd_mul_right, h2, int.nat_abs_of_nat, one_mul] at h ⊢,
  rw [mul_comm x0, mul_comm y0, mul_iff k hk] at h,
  rwa [int.mul_div_cancel _ hk, int.mul_div_cancel _ hk, int.mul_div_cancel_left _ hk],
end

lemma is_classified_of_is_primitive_classified (hp : h.is_primitive_classified) :
  h.is_classified :=
begin
  obtain ⟨m, n, H⟩ := hp,
  use [1, m, n],
  rcases H with ⟨⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, co, pp⟩;
  { apply and.intro _ co, rw one_mul, rw one_mul, tauto }
end

lemma is_classified_of_normalize_is_primitive_classified
  (hc : h.normalize.is_primitive_classified) : h.is_classified :=
begin
  convert h.normalize.mul_is_classified (int.gcd x y)
    (is_classified_of_is_primitive_classified h.normalize hc);
  rw int.mul_div_cancel',
  { exact int.gcd_dvd_left x y },
  { exact int.gcd_dvd_right x y },
  { exact h.gcd_dvd }
end

lemma ne_zero_of_coprime (hc : int.gcd x y = 1) : z ≠ 0 :=
begin
  suffices : 0 < z * z, { rintro rfl, norm_num at this },
  rw [← h.eq, ← sq, ← sq],
  have hc' : int.gcd x y ≠ 0, { rw hc, exact one_ne_zero },
  cases int.ne_zero_of_gcd hc' with hxz hyz,
  { apply lt_add_of_pos_of_le (sq_pos_of_ne_zero x hxz) (sq_nonneg y) },
  { apply lt_add_of_le_of_pos (sq_nonneg x) (sq_pos_of_ne_zero y hyz) }
end

lemma is_primitive_classified_of_coprime_of_zero_left (hc : int.gcd x y = 1) (hx : x = 0) :
  h.is_primitive_classified :=
begin
  subst x,
  change nat.gcd 0 (int.nat_abs y) = 1 at hc,
  rw [nat.gcd_zero_left (int.nat_abs y)] at hc,
  cases int.nat_abs_eq y with hy hy,
  { use [1, 0], rw [hy, hc, int.gcd_zero_right], norm_num },
  { use [0, 1], rw [hy, hc, int.gcd_zero_left], norm_num }
end

lemma coprime_of_coprime (hc : int.gcd x y = 1) : int.gcd y z = 1 :=
begin
  by_contradiction H,
  obtain ⟨p, hp, hpy, hpz⟩ := nat.prime.not_coprime_iff_dvd.mp H,
  apply hp.not_dvd_one,
  rw [← hc],
  apply nat.dvd_gcd (int.prime.dvd_nat_abs_of_coe_dvd_sq hp _ _) hpy,
  rw [sq, eq_sub_of_add_eq h],
  rw [← int.coe_nat_dvd_left] at hpy hpz,
  exact dvd_sub (dvd_mul_of_dvd_left (hpz) _) (dvd_mul_of_dvd_left (hpy) _),
end

end pythagorean_triple

section circle_equiv_gen
/-!
### A parametrization of the unit circle

For the classification of pythogorean triples, we will use a parametrization of the unit circle.
-/

variables {K : Type*} [field K]

/--  A parameterization of the unit circle that is useful for classifying Pythagorean triples.
 (To be applied in the case where `K = ℚ`.) -/
def circle_equiv_gen (hk : ∀ x : K, 1 + x^2 ≠ 0) :
  K ≃ {p : K × K // p.1^2 + p.2^2 = 1 ∧ p.2 ≠ -1} :=
{ to_fun := λ x, ⟨⟨2 * x / (1 + x^2), (1 - x^2) / (1 + x^2)⟩,
    by { field_simp [hk x, div_pow], ring },
    begin
      simp only [ne.def, div_eq_iff (hk x), ←neg_mul_eq_neg_mul, one_mul, neg_add,
        sub_eq_add_neg, add_left_inj],
      simpa only [eq_neg_iff_add_eq_zero, one_pow] using hk 1,
    end⟩,
  inv_fun := λ p, (p : K × K).1 / ((p : K × K).2 + 1),
  left_inv := λ x,
  begin
    have h2 : (1 + 1 : K) = 2 := rfl,
    have h3 : (2 : K) ≠ 0, { convert hk 1, rw [one_pow 2, h2] },
    field_simp [hk x, h2, add_assoc, add_comm, add_sub_cancel'_right, mul_comm],
  end,
  right_inv := λ ⟨⟨x, y⟩, hxy, hy⟩,
  begin
    change x ^ 2 + y ^ 2 = 1 at hxy,
    have h2 : y + 1 ≠ 0, { apply mt eq_neg_of_add_eq_zero, exact hy },
    have h3 : (y + 1) ^ 2 + x ^ 2 = 2 * (y + 1),
    { rw [(add_neg_eq_iff_eq_add.mpr hxy.symm).symm], ring },
    have h4 : (2 : K) ≠ 0, { convert hk 1, rw one_pow 2, refl },
    simp only [prod.mk.inj_iff, subtype.mk_eq_mk],
    split,
    { field_simp [h3], ring },
    { field_simp [h3], rw [← add_neg_eq_iff_eq_add.mpr hxy.symm], ring }
  end }

@[simp] lemma circle_equiv_apply (hk : ∀ x : K, 1 + x^2 ≠ 0) (x : K) :
  (circle_equiv_gen hk x : K × K) = ⟨2 * x / (1 + x^2), (1 - x^2) / (1 + x^2)⟩ := rfl

@[simp] lemma circle_equiv_symm_apply (hk : ∀ x : K, 1 + x^2 ≠ 0)
  (v : {p : K × K // p.1^2 + p.2^2 = 1 ∧ p.2 ≠ -1}) :
  (circle_equiv_gen hk).symm v = (v : K × K).1 / ((v : K × K).2 + 1) := rfl

end circle_equiv_gen

private lemma coprime_sq_sub_sq_add_of_even_odd {m n : ℤ} (h : int.gcd m n = 1)
  (hm : m % 2 = 0) (hn : n % 2 = 1) :
  int.gcd (m ^ 2 - n ^ 2) (m ^ 2 + n ^ 2) = 1 :=
begin
  by_contradiction H,
  obtain ⟨p, hp, hp1, hp2⟩ := nat.prime.not_coprime_iff_dvd.mp H,
  rw ← int.coe_nat_dvd_left at hp1 hp2,
  have h2m : (p : ℤ) ∣ 2 * m ^ 2, { convert dvd_add hp2 hp1, ring },
  have h2n : (p : ℤ) ∣ 2 * n ^ 2, { convert dvd_sub hp2 hp1, ring },
  have hmc : p = 2 ∨ p ∣ int.nat_abs m :=
    prime_two_or_dvd_of_dvd_two_mul_pow_self_two hp h2m,
  have hnc : p = 2 ∨ p ∣ int.nat_abs n :=
    prime_two_or_dvd_of_dvd_two_mul_pow_self_two hp h2n,
  by_cases h2 : p = 2,
  { have h3 : (m ^ 2 + n ^ 2) % 2 = 1, { norm_num [sq, int.add_mod, int.mul_mod, hm, hn] },
    have h4 : (m ^ 2 + n ^ 2) % 2 = 0, { apply int.mod_eq_zero_of_dvd, rwa h2 at hp2 },
    rw h4 at h3, exact zero_ne_one h3 },
  { apply hp.not_dvd_one,
    rw ← h,
    exact nat.dvd_gcd (or.resolve_left hmc h2) (or.resolve_left hnc h2), }
end

private lemma coprime_sq_sub_sq_add_of_odd_even {m n : ℤ} (h : int.gcd m n = 1)
  (hm : m % 2 = 1) (hn : n % 2 = 0):
  int.gcd (m ^ 2 - n ^ 2) (m ^ 2 + n ^ 2) = 1 :=
begin
  rw [int.gcd, ← int.nat_abs_neg (m ^ 2 - n ^ 2)],
  rw [(by ring : -(m ^ 2 - n ^ 2) = n ^ 2 - m ^ 2), add_comm],
  apply coprime_sq_sub_sq_add_of_even_odd _ hn hm, rwa [int.gcd_comm],
end

private lemma coprime_sq_sub_mul_of_even_odd {m n : ℤ} (h : int.gcd m n = 1)
  (hm : m % 2 = 0) (hn : n % 2 = 1) :
  int.gcd (m ^ 2 - n ^ 2) (2 * m * n) = 1 :=
begin
  by_contradiction H,
  obtain ⟨p, hp, hp1, hp2⟩ := nat.prime.not_coprime_iff_dvd.mp H,
  rw ← int.coe_nat_dvd_left at hp1 hp2,
  have hnp : ¬ (p : ℤ) ∣ int.gcd m n,
  { rw h, norm_cast, exact mt nat.dvd_one.mp (nat.prime.ne_one hp) },
  cases int.prime.dvd_mul hp hp2 with hp2m hpn,
  { rw int.nat_abs_mul at hp2m,
    cases (nat.prime.dvd_mul hp).mp hp2m with hp2 hpm,
    { have hp2' : p = 2 := (nat.le_of_dvd zero_lt_two hp2).antisymm hp.two_le,
      revert hp1, rw hp2',
      apply mt int.mod_eq_zero_of_dvd,
      norm_num [sq, int.sub_mod, int.mul_mod, hm, hn],
    },
    apply mt (int.dvd_gcd (int.coe_nat_dvd_left.mpr hpm)) hnp,
    apply (or_self _).mp, apply int.prime.dvd_mul' hp,
    rw (by ring : n * n = - (m ^ 2 - n ^ 2) + m * m),
    apply dvd_add (dvd_neg_of_dvd hp1),
    exact dvd_mul_of_dvd_left (int.coe_nat_dvd_left.mpr hpm) m
  },
  rw int.gcd_comm at hnp,
  apply mt (int.dvd_gcd (int.coe_nat_dvd_left.mpr hpn)) hnp,
  apply (or_self _).mp, apply int.prime.dvd_mul' hp,
  rw (by ring : m * m = (m ^ 2 - n ^ 2) + n * n),
  apply dvd_add hp1,
  exact dvd_mul_of_dvd_left (int.coe_nat_dvd_left.mpr hpn) n
end

private lemma coprime_sq_sub_mul_of_odd_even {m n : ℤ} (h : int.gcd m n = 1)
  (hm : m % 2 = 1) (hn : n % 2 = 0) :
  int.gcd (m ^ 2 - n ^ 2) (2 * m * n) = 1 :=
begin
  rw [int.gcd, ← int.nat_abs_neg (m ^ 2 - n ^ 2)],
  rw [(by ring : 2 * m * n = 2 * n * m), (by ring : -(m ^ 2 - n ^ 2) = n ^ 2 - m ^ 2)],
  apply coprime_sq_sub_mul_of_even_odd _ hn hm, rwa [int.gcd_comm]
end

private lemma coprime_sq_sub_mul {m n : ℤ} (h : int.gcd m n = 1)
  (hmn : (m % 2 = 0 ∧ n % 2 = 1) ∨ (m % 2 = 1 ∧ n % 2 = 0)) :
  int.gcd (m ^ 2 - n ^ 2) (2 * m * n) = 1 :=
begin
  cases hmn with h1 h2,
  { exact coprime_sq_sub_mul_of_even_odd h h1.left h1.right },
  { exact coprime_sq_sub_mul_of_odd_even h h2.left h2.right }
end

private lemma coprime_sq_sub_sq_sum_of_odd_odd {m n : ℤ} (h : int.gcd m n = 1)
  (hm : m % 2 = 1) (hn : n % 2 = 1) :
  2 ∣ m ^ 2 + n ^ 2
  ∧ 2 ∣ m ^ 2 - n ^ 2
  ∧ ((m ^ 2 - n ^ 2) / 2) % 2 = 0
  ∧ int.gcd ((m ^ 2 - n ^ 2) / 2) ((m ^ 2 + n ^ 2) / 2) = 1 :=
begin
  cases exists_eq_mul_left_of_dvd (int.dvd_sub_of_mod_eq hm) with m0 hm2,
  cases exists_eq_mul_left_of_dvd (int.dvd_sub_of_mod_eq hn) with n0 hn2,
  rw sub_eq_iff_eq_add at hm2 hn2, subst m, subst n,
  have h1 : (m0 * 2 + 1) ^ 2 + (n0 * 2 + 1) ^ 2 = 2 * (2 * (m0 ^ 2 + n0 ^ 2 + m0 + n0) + 1),
  by ring_exp,
  have h2 : (m0 * 2 + 1) ^ 2 - (n0 * 2 + 1) ^ 2 = 2 * (2 * (m0 ^ 2 - n0 ^ 2 + m0 - n0)),
  by ring_exp,
  have h3 : ((m0 * 2 + 1) ^ 2 - (n0 * 2 + 1) ^ 2) / 2 % 2 = 0,
  { rw [h2, int.mul_div_cancel_left, int.mul_mod_right], exact dec_trivial },
  refine ⟨⟨_, h1⟩, ⟨_, h2⟩, h3, _⟩,
  have h20 : (2:ℤ) ≠ 0 := dec_trivial,
  rw [h1, h2, int.mul_div_cancel_left _ h20, int.mul_div_cancel_left _ h20],
  by_contra h4,
  obtain ⟨p, hp, hp1, hp2⟩ := nat.prime.not_coprime_iff_dvd.mp h4,
  apply hp.not_dvd_one,
  rw ← h,
  rw ← int.coe_nat_dvd_left at hp1 hp2,
  apply nat.dvd_gcd,
  { apply int.prime.dvd_nat_abs_of_coe_dvd_sq hp,
    convert dvd_add hp1 hp2, ring_exp },
  { apply int.prime.dvd_nat_abs_of_coe_dvd_sq hp,
    convert dvd_sub hp2 hp1, ring_exp },
end

namespace pythagorean_triple

variables {x y z : ℤ} (h : pythagorean_triple x y z)

include h

theorem is_primitive_classified_of_coprime_of_odd_of_pos
  (hc : int.gcd x y = 1) (hyo : y % 2 = 1) (hzpos : 0 < z) :
  h.is_primitive_classified :=
begin
  by_cases h0 : x = 0, { exact h.is_primitive_classified_of_coprime_of_zero_left hc h0 },
  let v := (x : ℚ) / z,
  let w := (y : ℚ) / z,
  have hz : z ≠ 0, apply ne_of_gt hzpos,
  have hq : v ^ 2 + w ^ 2 = 1,
  { field_simp [hz, sq], norm_cast, exact h },
  have hvz : v ≠ 0, { field_simp [hz], exact h0 },
  have hw1 : w ≠ -1,
  { contrapose! hvz with hw1,
    rw [hw1, neg_sq, one_pow, add_left_eq_self] at hq,
    exact pow_eq_zero hq, },
  have hQ : ∀ x : ℚ, 1 + x^2 ≠ 0,
  { intro q, apply ne_of_gt, exact lt_add_of_pos_of_le zero_lt_one (sq_nonneg q) },
  have hp : (⟨v, w⟩ : ℚ × ℚ) ∈ {p : ℚ × ℚ | p.1^2 + p.2^2 = 1 ∧ p.2 ≠ -1} := ⟨hq, hw1⟩,
  let q := (circle_equiv_gen hQ).symm ⟨⟨v, w⟩, hp⟩,
  have ht4 : v = 2 * q / (1 + q ^ 2) ∧ w = (1 - q ^ 2) / (1 + q ^ 2),
  { apply prod.mk.inj,
    have := ((circle_equiv_gen hQ).apply_symm_apply ⟨⟨v, w⟩, hp⟩).symm,
    exact congr_arg subtype.val this, },
  let m := (q.denom : ℤ),
  let n := q.num,
  have hm0 : m ≠ 0, { norm_cast, apply rat.denom_ne_zero q },
  have hq2 : q = n / m := (rat.num_div_denom q).symm,
  have hm2n2 : 0 < m ^ 2 + n ^ 2,
  { apply lt_add_of_pos_of_le _ (sq_nonneg n),
    exact lt_of_le_of_ne (sq_nonneg m) (ne.symm (pow_ne_zero 2 hm0)) },
  have hw2 : w = (m ^ 2 - n ^ 2) / (m ^ 2 + n ^ 2),
  { rw [ht4.2, hq2], field_simp [hm2n2, rat.denom_ne_zero q, -rat.num_div_denom] },
  have hm2n20 : (m : ℚ) ^ 2 + (n : ℚ) ^ 2 ≠ 0,
  { norm_cast, simpa only [int.coe_nat_pow] using ne_of_gt hm2n2 },
  have hv2 : v = 2 * m * n / (m ^ 2 + n ^ 2),
  { apply eq.symm, apply (div_eq_iff hm2n20).mpr, rw [ht4.1], field_simp [hQ q],
    rw [hq2] {occs := occurrences.pos [2, 3]},
    field_simp [rat.denom_ne_zero q, -rat.num_div_denom],
    ring },
  have hnmcp : int.gcd n m = 1 := q.cop,
  have hmncp : int.gcd m n = 1, { rw int.gcd_comm, exact hnmcp },
  cases int.mod_two_eq_zero_or_one m with hm2 hm2;
    cases int.mod_two_eq_zero_or_one n with hn2 hn2,
  { -- m even, n even
    exfalso,
    have h1 : 2 ∣ (int.gcd n m : ℤ),
    { exact int.dvd_gcd (int.dvd_of_mod_eq_zero hn2) (int.dvd_of_mod_eq_zero hm2) },
    rw hnmcp at h1, revert h1, norm_num },
  { -- m even, n odd
    apply h.is_primitive_classified_aux hc hzpos hm2n2 hv2 hw2 _ hmncp,
    { apply or.intro_left, exact and.intro hm2 hn2 },
    { apply coprime_sq_sub_sq_add_of_even_odd hmncp hm2 hn2 } },
  { -- m odd, n even
    apply h.is_primitive_classified_aux hc hzpos hm2n2 hv2 hw2 _ hmncp,
    { apply or.intro_right, exact and.intro hm2 hn2 },
    apply coprime_sq_sub_sq_add_of_odd_even hmncp hm2 hn2 },
  { -- m odd, n odd
    exfalso,
    have h1 : 2 ∣ m ^ 2 + n ^ 2 ∧ 2 ∣ m ^ 2 - n ^ 2
      ∧ ((m ^ 2 - n ^ 2) / 2) % 2 = 0 ∧ int.gcd ((m ^ 2 - n ^ 2) / 2) ((m ^ 2 + n ^ 2) / 2) = 1,
    { exact coprime_sq_sub_sq_sum_of_odd_odd hmncp hm2 hn2 },
    have h2 : y = (m ^ 2 - n ^ 2) / 2 ∧ z = (m ^ 2 + n ^ 2) / 2,
    { apply rat.div_int_inj hzpos _ (h.coprime_of_coprime hc) h1.2.2.2,
      { show w = _, rw [←rat.mk_eq_div, ←(rat.div_mk_div_cancel_left (by norm_num : (2 : ℤ) ≠ 0))],
        rw [int.div_mul_cancel h1.1, int.div_mul_cancel h1.2.1, hw2], norm_cast },
      { apply (mul_lt_mul_right (by norm_num : 0 < (2 : ℤ))).mp,
        rw [int.div_mul_cancel h1.1, zero_mul], exact hm2n2 } },
    rw [h2.1, h1.2.2.1] at hyo,
    revert hyo,
    norm_num }
end

theorem is_primitive_classified_of_coprime_of_pos (hc : int.gcd x y = 1) (hzpos : 0 < z):
  h.is_primitive_classified :=
begin
  cases h.even_odd_of_coprime hc with h1 h2,
  { exact (h.is_primitive_classified_of_coprime_of_odd_of_pos hc h1.right hzpos) },
  rw int.gcd_comm at hc,
  obtain ⟨m, n, H⟩ := (h.symm.is_primitive_classified_of_coprime_of_odd_of_pos hc h2.left hzpos),
  use [m, n], tauto
end

theorem is_primitive_classified_of_coprime (hc : int.gcd x y = 1) : h.is_primitive_classified :=
begin
  by_cases hz : 0 < z,
  { exact h.is_primitive_classified_of_coprime_of_pos hc hz },
  have h' : pythagorean_triple x y (-z),
  { simpa [pythagorean_triple, neg_mul_neg] using h.eq, },
  apply h'.is_primitive_classified_of_coprime_of_pos hc,
  apply lt_of_le_of_ne _ (h'.ne_zero_of_coprime hc).symm,
  exact le_neg.mp (not_lt.mp hz)
end

theorem classified : h.is_classified :=
begin
  by_cases h0 : int.gcd x y = 0,
  { have hx : x = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_left h0 },
    have hy : y = 0, { apply int.nat_abs_eq_zero.mp, apply nat.eq_zero_of_gcd_eq_zero_right h0 },
    use [0, 1, 0], norm_num [hx, hy], },
  apply h.is_classified_of_normalize_is_primitive_classified,
  apply h.normalize.is_primitive_classified_of_coprime,
  apply int.gcd_div_gcd_div_gcd (nat.pos_of_ne_zero h0),
end

omit h

theorem coprime_classification :
  pythagorean_triple x y z ∧ int.gcd x y = 1 ↔
  ∃ m n, ((x = m ^ 2 - n ^ 2 ∧ y = 2 * m * n) ∨
            (x = 2 * m * n ∧ y = m ^ 2 - n ^ 2))
          ∧ (z = m ^ 2 + n ^ 2 ∨ z = - (m ^ 2 + n ^ 2))
          ∧ int.gcd m n = 1
          ∧ ((m % 2 = 0 ∧ n % 2 = 1) ∨ (m % 2 = 1 ∧ n % 2 = 0)) :=
begin
  split,
  { intro h,
    obtain ⟨m, n, H⟩ := h.left.is_primitive_classified_of_coprime h.right,
    use [m, n],
    rcases H with ⟨⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, co, pp⟩,
    { refine ⟨or.inl ⟨rfl, rfl⟩, _, co, pp⟩,
      have : z ^ 2 = (m ^ 2 + n ^ 2) ^ 2,
      { rw [sq, ← h.left.eq], ring },
      simpa using eq_or_eq_neg_of_sq_eq_sq _ _ this },
    { refine ⟨or.inr ⟨rfl, rfl⟩, _, co, pp⟩,
      have : z ^ 2 = (m ^ 2 + n ^ 2) ^ 2,
      { rw [sq, ← h.left.eq], ring },
      simpa using eq_or_eq_neg_of_sq_eq_sq _ _ this } },
  { delta pythagorean_triple,
    rintro ⟨m, n, ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, rfl | rfl, co, pp⟩;
    { split, { ring }, exact coprime_sq_sub_mul co pp }
    <|>
    { split, { ring }, rw int.gcd_comm, exact coprime_sq_sub_mul co pp } }
end

/-- by assuming `x` is odd and `z` is positive we get a slightly more precise classification of
the pythagorean triple `x ^ 2 + y ^ 2 = z ^ 2`-/
theorem coprime_classification' {x y z : ℤ} (h : pythagorean_triple x y z)
  (h_coprime : int.gcd x y = 1) (h_parity : x % 2 = 1) (h_pos : 0 < z) :
  ∃ m n,  x = m ^ 2 - n ^ 2
        ∧ y = 2 * m * n
        ∧ z = m ^ 2 + n ^ 2
        ∧ int.gcd m n = 1
        ∧ ((m % 2 = 0 ∧ n % 2 = 1) ∨ (m % 2 = 1 ∧ n % 2 = 0))
        ∧ 0 ≤ m :=
begin
  obtain ⟨m, n, ht1, ht2, ht3, ht4⟩ :=
    pythagorean_triple.coprime_classification.mp (and.intro h h_coprime),
  cases le_or_lt 0 m with hm hm,
  { use [m, n],
    cases ht1 with h_odd h_even,
    { apply and.intro h_odd.1,
      apply and.intro h_odd.2,
      cases ht2 with h_pos h_neg,
      { apply and.intro h_pos (and.intro ht3 (and.intro ht4 hm)) },
      { exfalso, revert h_pos, rw h_neg,
        exact imp_false.mpr (not_lt.mpr (neg_nonpos.mpr (add_nonneg (sq_nonneg m)
          (sq_nonneg n)))) } },
    exfalso,
    rcases h_even with ⟨rfl, -⟩,
    rw [mul_assoc, int.mul_mod_right] at h_parity,
    exact zero_ne_one h_parity },
  { use [-m, -n],
    cases ht1 with h_odd h_even,
    { rw [neg_sq m],
      rw [neg_sq n],
      apply and.intro h_odd.1,
      split, { rw h_odd.2, ring },
      cases ht2 with h_pos h_neg,
      { apply and.intro h_pos,
        split,
        { delta int.gcd, rw [int.nat_abs_neg, int.nat_abs_neg], exact ht3 },
        { rw [int.neg_mod_two, int.neg_mod_two],
          apply and.intro ht4, linarith } },
      { exfalso, revert h_pos, rw h_neg,
        exact imp_false.mpr (not_lt.mpr (neg_nonpos.mpr (add_nonneg (sq_nonneg m)
          (sq_nonneg n)))) } },
    exfalso,
    rcases h_even with ⟨rfl, -⟩,
    rw [mul_assoc, int.mul_mod_right] at h_parity,
    exact zero_ne_one h_parity }
end

theorem classification :
  pythagorean_triple x y z ↔
  ∃ k m n, ((x = k * (m ^ 2 - n ^ 2) ∧ y = k * (2 * m * n)) ∨
            (x = k * (2 * m * n) ∧ y = k * (m ^ 2 - n ^ 2)))
          ∧ (z = k * (m ^ 2 + n ^ 2) ∨ z = - k * (m ^ 2 + n ^ 2)) :=
begin
  split,
  { intro h,
    obtain ⟨k, m, n, H⟩ := h.classified,
    use [k, m, n],
    rcases H with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩,
    { refine ⟨or.inl ⟨rfl, rfl⟩, _⟩,
      have : z ^ 2 = (k * (m ^ 2 + n ^ 2)) ^ 2,
      { rw [sq, ← h.eq], ring },
      simpa using eq_or_eq_neg_of_sq_eq_sq _ _ this },
    { refine ⟨or.inr ⟨rfl, rfl⟩, _⟩,
      have : z ^ 2 = (k * (m ^ 2 + n ^ 2)) ^ 2,
      { rw [sq, ← h.eq], ring },
      simpa using eq_or_eq_neg_of_sq_eq_sq _ _ this } },
  { rintro ⟨k, m, n, ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, rfl | rfl⟩;
    delta pythagorean_triple; ring }
end

end pythagorean_triple