import Geo.Background.Real
import Geo.Background.List
import Geo.Background.Vec
import Geo.Background.Set
import Geo.Background.Tuple

/-
Currently, we do not require NDGs in the constructions.
We will experiment with requiring them only for the theorems about the constructions,
and perhaps auto-generating them from the theorem statements.

So far I have found the `HasOn` typeclass to be convenient because of all the helper functions,
but so far the other typeclasses have mostly just preempted the ⟨⟩ notation without much benefit.
-/

namespace Geo

structure Point : Type := (x y : ℝ)

noncomputable instance : Inhabited Point := Inhabited.mk ⟨0, 0⟩ -- check with daniel

namespace Point

noncomputable def add (p₁ p₂ : Point) : Point := ⟨p₁.x + p₂.x, p₁.y + p₂.y⟩
noncomputable def sub (p₁ p₂ : Point) : Point := ⟨p₁.x - p₂.x, p₁.y - p₂.y⟩

noncomputable instance : HasAdd Point := ⟨add⟩
noncomputable instance : HasSub Point := ⟨sub⟩

noncomputable def dot (p₁ p₂ : Point) : ℝ :=
p₁.x * p₂.x + p₁.y * p₂.y

end Point

namespace Analytic

noncomputable def det₂ (a b c d : ℝ) : ℝ :=
a * d - b * c

noncomputable def det₃ (a b c d e f g h i : ℝ) : ℝ :=
a * det₂ e f h i - b * det₂ d f g i + c * det₂ d e g h

variables (a b c d e f : Point)

noncomputable def sqdist : ℝ := (a.x - b.x)^2 + (a.y - b.y)^2
noncomputable def dist   : ℝ := Real.sqrt $ sqdist a b
noncomputable def sarea2 : ℝ := (det₃ a.x a.y 1 b.x b.y 1 c.x c.y 1) -- twice the signed area
noncomputable def sprod  : ℝ := Point.dot (a - b) (c - b)

noncomputable def midp   : Point := ⟨a.x + b.x / 2, a.y + b.y / 2⟩

noncomputable def coll : Prop := sarea2 a b c = 0
noncomputable def para : Prop := (a.x - b.x) * (c.y - d.y) - (a.y - b.y) * (c.x - d.x) = 0
noncomputable def perp : Prop := (a.x - b.x) * (c.x - d.x) + (a.y - b.y) * (c.y - d.y) = 0

noncomputable def deg2π (degrees : ℝ) : ℝ2π := ⟨((π : ℝ) * (degrees / 180)) % (2 * π), WIP⟩
noncomputable def degπ  (degrees : ℝ) : ℝπ  := ⟨((π : ℝ) * (degrees / 180)) % π, WIP⟩

noncomputable def eqangle : Prop :=
sarea2 a b c * sprod d e f = sarea2 d e f * sprod a b c

axiom sqdistGe0 : sqdist a b ≥ 0
axiom distGe0   : dist a b ≥ 0

end Analytic

end Geo


import logic.equiv.basic
import data.set.basic

structure partition (X : Type) :=
(C : set (set X))
(Hnonempty : ∀ c ∈ C, c ≠ ∅)
(Hcover : ∀ x, ∃ c ∈ C, x ∈ c)
(Hunique : ∀ c d ∈ C, c ∩ d ≠ ∅ → c = d)

def partition.ext {X : Type} (P Q : partition X) (H : P.C = Q.C) : P = Q :=
begin
  cases P, cases Q,
  simpa using H,
end

def equivalence_class {X : Type} (R : X → X → Prop) (x : X) := {y : X | R x y}

lemma mem_class {X : Type} {R : X → X → Prop} (HR : equivalence R) (x : X) : x ∈ equivalence_class R x :=
begin
  cases HR with HRR HR,
  exact HRR x,
end

example (X : Type) : {R : X → X → Prop // equivalence R} ≃ partition X :=
{ to_fun := λ R, {
    C := { S : set X | ∃ x : X, S = equivalence_class R x},
    Hnonempty := begin
      intro c,
      intro hc,
      cases hc with x hx,
      rw set.ne_empty_iff_nonempty,
      use x,
      rw hx,
      exact mem_class R.2 x,
    end,
    Hcover := begin
      intro x,
      use equivalence_class R x,
      existsi _,
      { exact mem_class R.2 x },
      use x,
    end,
    Hunique := begin
      intros c hc d hd hcd,
      rw set.ne_empty_iff_nonempty at hcd,
      cases hcd with x hx,
      cases hc with a ha,
      cases hd with b hb,
      cases R with  R HR,
      cases hx with hxc hxd,
      rw ha at *,
      rw hb at *,
      change R a x at hxc,
      change R b x at hxd,
      rcases HR with ⟨HRR, HRS, HRT⟩,
      apply set.subset.antisymm,
      { intros y hy,
        change R a y at hy,
        change R b y,
        refine HRT hxd _,
        refine HRT _ hy,
        apply HRS,
        assumption
      },
      { intros y hy,
        change R a y,
        change R b y at hy,
        refine HRT hxc _,
        refine HRT _ hy,
        apply HRS,
        assumption,
      }
    end },
  inv_fun := λ P, ⟨λ x y, ∃ c ∈ P.C, x ∈ c ∧ y ∈ c, begin
    split,
    { intro x,
      cases P.Hcover x with c hc,
      cases hc with hc hxc,
      use c,
      use hc,
      split; assumption,
    },
    split,
    { intros x y hxy,
      cases hxy with c hc,
      cases hc with hc1 hc2,
      use c,
      use hc1,
      cases hc2 with hx hy,
      split; assumption
    },
    { rintros x y z ⟨c, hc, hxc, hyc⟩ ⟨d, hd, hyd, hzd⟩,
      use c,
      use hc,
      split,
      exact hxc,
      have hcd : c = d,
      { apply P.Hunique c hc d hd,
        rw set.ne_empty_iff_nonempty,
        use y,
        split,
        use hyc,
        use hyd,
      },
      rw hcd,
      use hzd,
    }
  end⟩,
  left_inv := begin
    rintro ⟨R, HRR, HRS, HRT⟩,
    ext x y,
    suffices : (∃ (c : set X), (∃ (x : X), c = equivalence_class R x) ∧ x ∈ c ∧ y ∈ c) ↔ R x y,
      simpa,
    split,
    { rintro ⟨c, ⟨z, rfl⟩, ⟨hx, hy⟩⟩,
      refine HRT _ hy,
      apply HRS,
      exact hx,
    },
    { intro H,
      use equivalence_class R x,
      use x,
      split,
      exact HRR x,
      exact H,
    }
  end,
  right_inv := begin
    intro P,
    dsimp,
    cases P with C _ _ _,
    dsimp,
    apply partition.ext,
    dsimp, -- dsimps everywhere
    ext c,
    split,
    { intro h,
      dsimp at h,
      cases h with x hx,
      rw hx, clear hx,
      rcases P_Hcover x with ⟨d, hd, hxd⟩,
      convert hd, -- not taught in NNG
      clear c,
      ext y,
      split,
      { intro hy,
        unfold equivalence_class at hy,
        dsimp at hy,
        rcases hy with ⟨e, he, hxe, hye⟩,
        convert hye, -- not taught
        refine P_Hunique d hd e he _,
        rw set.ne_empty_iff_nonempty,
        use x,
        split;assumption
      },
      { intro hyd,
        unfold equivalence_class, dsimp,
        use d,
        use hd,
        split;assumption
      },
    },
    { intro hc,
      dsimp,
      have h := P_Hnonempty c hc,
      rw set.ne_empty_iff_nonempty at h,
      cases h with x hxc,
      use x,
      unfold equivalence_class,
      ext y,
      split,
      { intro hyc,
        dsimp,
        use c,
        use hc,
        split;assumption,
      },
      { intro h,
        dsimp at h,
        rcases h with ⟨d, hd, hxd, hyd⟩,
        convert hyd,
        apply P_Hunique c hc d hd,
        rw set.ne_empty_iff_nonempty,
        use x,
        split;assumption
      }
    }
  end }


import group_theory.subgroup
import algebra
import tactic
import logic.function.basic
import order.zorn
import data.set.disjointed
open function

-- Injective abelian group
class is_inj_abgp (G : Type) [add_comm_group G] : Prop :=
  (inj_extd : ∀ (H K : Type) [add_comm_group H] [add_comm_group K]
  (i : H →+ K)
  (h_subHK : injective i), (∀f : H →+ G, ∃f_extd : K →+ G, (∀h : H, f_extd (i h) = f h)))

-- Divisible abelian group
class is_div_abgp (G : Type) [add_comm_group G] : Prop :=
  (nat_div : ∀ (n : ℤ) (g : G) (n_nonzero : n ≠ 0), ∃ (h : G), n •ℤ h = g)
  -- •ℤ is the ℤ-scalar mult.

-- Injective abelian group is divisible.
theorem inj_is_div_abgp (G : Type) [add_comm_group G] : is_inj_abgp G → is_div_abgp G :=
begin
  /-
  Outline:
    Construct a morphism f: ℤ → G given by g-mult.
    Construct a morphism i: ℤ → ℤ given by n-mult.
    Apply these to the injectivity hypothesis
    Let the image of 1 be g0
    Since n*1 = n, n*g0 = g.
  -/

  -- Setup
  intro G_is_inj,
  refine ⟨_⟩, -- Elaborate the goal
  intros n g n_nonzero,

  -- Define two functions f and i
  set f: ℤ →+ G := {to_fun := λ n, n •ℤ g,
    map_zero' := by simp,
    map_add' := by exact add_gsmul g} with fdef,
  set i: ℤ →+ ℤ := {to_fun := λ m, m •ℤ n,
    map_zero' := by simp,
    map_add' := by exact add_gsmul n} with idef,

  -- i is injective (Clean this section)
  have i_inj : injective i :=
    begin
      rw function.injective,
      intros a b h_iaib,
      rw idef at h_iaib,
      simp at h_iaib,
      cases h_iaib, exact h_iaib, tauto,
    end,

  -- Feed our earlier constructions into the assumption that G is injective
  cases G_is_inj,
  specialize G_is_inj ℤ ℤ i i_inj f,
  cases G_is_inj with f_extd G_is_inj_h,
  specialize G_is_inj_h 1,

  -- Start with f 1 = g and change this to n •ℤ ⇑f_extd 1 = g
  have h_f1_is_g : f 1 = g, by apply one_gsmul g,
  rw h_f1_is_g at G_is_inj_h,
  rw (by simp : i 1 = n) at G_is_inj_h,
  rw ← (by simp : n •ℤ 1 = n) at G_is_inj_h,
  rw ← (by exact (add_monoid_hom.map_gsmul f_extd 1 n).symm
    : n •ℤ (f_extd 1) = f_extd (n •ℤ 1))
    at G_is_inj_h,

  -- Use f_extd 1 and finish
  use (f_extd 1), exact G_is_inj_h,
end

/-
Takes the data of H ⊆ K and f: H → G
and asks for an intermediate H ⊆ H1 ⊆ K such that
f_extd: H1 → G is a lift of f: H → G.
-/
structure extd_abhom
{H K G : Type} [add_comm_group H] [add_comm_group K] [add_comm_group G]
(i0 : H →+ K) (i0_inj: injective i0) (f : H →+ G) :=
  (H1: Type)
  [h_H1: add_comm_group H1]
  (i1 : H →+ H1)
  (i2 : H1 →+ K)
  (i1_inj: injective i1)
  (i2_inj: injective i2)
  (h_comm_HH1K : i2 ∘ i1 = i0) -- commuting inclusions
  (f_extd : H1 →+ G)
  (h_lift: f_extd ∘ i1 = f) -- f_extd is a lift of f

-- Declare that H1 in an extd_abhom is an add_comm_group.
instance {H K G : Type} [add_comm_group H] [add_comm_group K] [add_comm_group G] (i0 : H →+ K) (i0_inj: injective i0) (f : H →+ G)
{f_ex : extd_abhom i0 i0_inj f} : add_comm_group f_ex.H1 := f_ex.h_H1

/-
Partial order on extd_abhom
Each time we need to sandwich between H,K and fix the target G.
-/
def ord_extd_abhom
{H K G : Type} [add_comm_group H] [add_comm_group K] [add_comm_group G]
{i0 : H →+ K} {i0_inj: injective i0} {f : H →+ G}
: (extd_abhom i0 i0_inj f) → (extd_abhom i0 i0_inj f) → Prop :=
begin
  intros hom1 hom2,
  exact (∃j : hom1.H1 →+ hom2.H1, ∃j_inj : injective j, -- hom.H1 ⊆ hom2.H1
  (hom2.i2 ∘ j = hom1.i2) ∧ -- comm. of inclusion
  (j ∘ hom1.i1 = hom2.i1) ∧ -- comm. of inclusion
  (hom2.f_extd ∘ j = hom1.f_extd)), -- comm. of lifts
end

def ord_extd_abhom_trans {H K G : Type} [add_comm_group H] [add_comm_group K] [add_comm_group G]
(i0 : H →+ K) (i0_inj: injective i0) (f : H →+ G) {f1 f2 f3 : extd_abhom i0 i0_inj f}
:
ord_extd_abhom f1 f2 → ord_extd_abhom f2 f3 → ord_extd_abhom f1 f3 :=
begin
  -- intros f1 f2 f3,
  intros ex_f1f2 ex_f2f3,

  -- Notations
  set H1 := f1.H1,
  set H2 := f2.H1,
  set H3 := f3.H1,

  let i11 := f1.i1, let i11_inj := f1.i1_inj,
  let i21 := f2.i1, let i21_inj := f2.i1_inj,
  let i31 := f3.i1, let i31_inj := f3.i1_inj,

  let i12 := f1.i2, let i12_inj := f1.i2_inj,
  let i22 := f2.i2, let i22_inj := f2.i2_inj,
  let i32 := f3.i2, let i32_inj := f3.i2_inj,

  rcases ex_f1f2 with ⟨j1, j1_inj, i12_comm, i12_comm2, ex12_comm⟩,
  rcases ex_f2f3 with ⟨j2, j2_inj, i23_comm, i23_comm2, ex23_comm⟩,

  -- j3 is to be used.
  let j3 := j2.comp j1, -- composition in add_comm_group morphisms
  have j3_inj : injective j3 := by tauto,

  use j3, use j3_inj,
  split,
  -- Show that i32 ∘ j3 = i12
    calc
    (f3.i2) ∘ j3 = (i32 ∘ j2) ∘ j1 : by refl
    ... = i22 ∘ j1 : by tauto
    ... = i12 : by tauto, -- by exact i12_comm,
  split,
  -- Show that j3 ∘ i11 = i31
    calc
    j3 ∘ (f1.i1) = (j2 ∘ j1) ∘ i11 : by refl
    ... = j2 ∘ i21 : by tauto
    ... = i31 : by tauto, -- by exact i23_comm2,
  -- Show that extension property is transitive
    calc
    f3.f_extd ∘ j3 = (f3.f_extd ∘ j2) ∘ j1 : by refl
    ... = f2.f_extd ∘ j1 : by tauto
    ... = f1.f_extd : by tauto, -- by exact ex12_comm,
end

-- Every chain of extd_abhom's have an upper bound.
def ord_extd_abhom_upper {H K G : Type} [add_comm_group H] [add_comm_group K] [add_comm_group G] {i0 : H →+ K} {i0_inj: injective i0} {f : H →+ G}
: ∀(chain : set (extd_abhom i0 i0_inj f)), zorn.chain ord_extd_abhom chain
→ (∃ (ub : extd_abhom i0 i0_inj f), ∀ (a : extd_abhom i0 i0_inj f), a ∈ chain → ord_extd_abhom a ub) :=
begin
  intros chain is_chain,
  rw zorn.chain at is_chain,
  sorry,
end

lemma exists_notin_of_ne_top {G : Type} [add_comm_group G] {H : add_subgroup G} (h : H ≠ ⊤) :
∃ x : G, x ∉ H :=
begin
  revert h,
  contrapose!,
  intro h,
  rw eq_top_iff,
  intros y hy,
  apply h,
end

lemma extd_mor_from_add_subgps
{G : Type} [add_group G] (H1 H2 : add_subgroup G) (f1 : H1 →+ G) (f2 : H2 →+ G)
(h : ∀ (x1 : H1) (x2 : H2), (x1 : G) = (x2 : G) → f1 x1 = f2 x2) :
  ∃ f : ↥(H1 ⊔ H2) →+ G,
    f.comp (add_subgroup.inclusion le_sup_left) = f1 ∧
    f.comp (add_subgroup.inclusion le_sup_right) = f2 :=
begin
  sorry,
end

-- Divisble abelian group is injective.
theorem div_is_inj_abgp (G : Type) [add_comm_group G] : is_div_abgp G → is_inj_abgp G :=
begin
  /-
  Outline:
    Find maximally extendible H0 such that H ⊆ H0 ⊆ K
    This is done using Zorn's lemma.
    Proof by contradiction; if H0 = K, we are done. So suppose otherwise.
    If H0 ⊆ K and not the same, then ∃ k ∈ K, k ∉ H0
    Either (ℤ ⬝ k) ∩ H = {0} or not
    If empty intersection, map anywhere
    If nonempty intersection, n ⬝ k ∈ H, nonzero.
    Let g = f (n ⬝ k)
    find g0 such that n ⬝ g0 = g by div_abgp G
    Define an extension f1 : (H ∨ ⟨k⟩) → G by mapping k to g0
    Show well-definedness (?)
    Contradiction to maximality.
  -/

  intro divG,
  refine ⟨_⟩,
  intros H K H_is_abgp K_is_abgp i0 i0_inj f, -- For any H ⊆ K, f: H → G,
  resetI, -- telling that H, K are groups, from local context to type class

  -- Zorn's Lemma
  have exist_max_extn : ( ∃ (m : extd_abhom i0 i0_inj f), ∀ (a : extd_abhom i0 i0_inj f), ord_extd_abhom m a → ord_extd_abhom a m ) :=
  zorn.exists_maximal_of_chains_bounded ord_extd_abhom_upper (λ _ _ _ , ord_extd_abhom_trans i0 i0_inj f),
  cases exist_max_extn with max_extn h_max_extn,

  -- Notations
  let max_H1 := max_extn.H1,
  let max_i1 := max_extn.i1,
  let max_i2 := max_extn.i2,
  let max_f := max_extn.f_extd,
  have max_h_H1 := max_extn.h_H1,
  have max_i1_inj := max_extn.i1_inj,
  have max_i2_inj := max_extn.i2_inj,
  have max_f_lift := max_extn.h_lift,

  let max_H1_sub := max_i2.range,

  -- Proof by contradiction on the maximal extension taking up everything
  have max_H1_is_K : max_H1_sub = ⊤,
  by_contra not_top,

  have not_top_2 : max_H1_sub ≠ ⊤ := by tauto,
  have not_top_has_elt := exists_notin_of_ne_top not_top_2,
  cases not_top_has_elt with k k_notin_top,
  clear not_top,
  clear not_top_2,

  let k_gp : add_subgroup K := add_subgroup.closure {k},
  let max_H1_bigger : add_subgroup K := max_H1_sub ⊔ k_gp,
  by_cases h : (∃n ∈ ℕ, n •ℕ k ∈ max_H1_sub),

  /-
  (f1 : H1 →+ G) (f2 : H2 →+ G)
  (h : ∀ (x1 : H1) (x2 : H2), (x1 : G) = (x2 : G) → f1 x1 = f2 x2) :
  ∃ f : ↥(H1 ⊔ H2) →+ G,
    f.comp (add_subgroup.inclusion le_sup_left) = f1 ∧
    f.comp (add_subgroup.inclusion le_sup_right) = f2 :=
  -/

  -- Assuming that n.k is in max_H1 for some n > 0
  -- have mult_k_into_maxH1 : (∃n : ℕ, ∃h : max_H1_sub, n •ℕ k = h),
  sorry,
end

-- An abelian group is injective iff divisible.
theorem inj_iff_div_abgp (G : Type) [add_comm_group G] : is_inj_abgp G ↔ is_div_abgp G :=
begin
  split, exact inj_is_div_abgp G, exact div_is_inj_abgp G,
end


inductive Expr where
  | nat  : Nat → Expr
  | plus : Expr → Expr → Expr
  | bool : Bool → Expr
  | and  : Expr → Expr → Expr

inductive Ty where
  | nat
  | bool
  deriving DecidableEq

inductive HasType : Expr → Ty → Prop
  | nat  : HasType (.nat v) .nat
  | plus : HasType a .nat → HasType b .nat → HasType (.plus a b) .nat
  | bool : HasType (.bool v) .bool
  | and  : HasType a .bool → HasType b .bool → HasType (.and a b) .bool

theorem HasType.det (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
  cases h₁ <;> cases h₂ <;> rfl

inductive Maybe (p : α → Prop) where
  | found : (a : α) → p a → Maybe p
  | unknown

notation "{{ " x " | " p " }}" => Maybe (fun x => p)

def Expr.typeCheck (e : Expr) : {{ ty | HasType e ty }} :=
  match e with
  | nat ..   => .found .nat .nat
  | bool ..  => .found .bool .bool
  | plus a b =>
    match a.typeCheck, b.typeCheck with
    | .found .nat h₁, .found .nat h₂ => .found .nat (.plus h₁ h₂)
                --^ $/lean/plainTermGoal
     | _, _ => .unknown
  | and a b =>
    match a.typeCheck, b.typeCheck with
    | .found .bool h₁, .found .bool h₂ => .found .bool (.and h₁ h₂)
    | _, _ => .unknown


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang

! This file was ported from Lean 3 source module algebra.category.Group.epi_mono
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Group.EquivalenceGroupAddGroup
import Mathbin.GroupTheory.QuotientGroup

/-!
# Monomorphisms and epimorphisms in `Group`
In this file, we prove monomorphisms in category of group are injective homomorphisms and
epimorphisms are surjective homomorphisms.
-/

noncomputable section

universe u v

namespace MonoidHom

open QuotientGroup

variable {A : Type u} {B : Type v}

section

variable [Group A] [Group B]

@[to_additive AddMonoidHom.ker_eq_bot_of_cancel]
theorem ker_eq_bot_of_cancel {f : A →* B} (h : ∀ u v : f.ker →* A, f.comp u = f.comp v → u = v) :
    f.ker = ⊥ := by simpa using _root_.congr_arg range (h f.ker.subtype 1 (by tidy))
#align monoid_hom.ker_eq_bot_of_cancel MonoidHom.ker_eq_bot_of_cancel
#align add_monoid_hom.ker_eq_bot_of_cancel AddMonoidHom.ker_eq_bot_of_cancel

end

section

variable [CommGroup A] [CommGroup B]

@[to_additive AddMonoidHom.range_eq_top_of_cancel]
theorem range_eq_top_of_cancel {f : A →* B}
    (h : ∀ u v : B →* B ⧸ f.range, u.comp f = v.comp f → u = v) : f.range = ⊤ :=
  by
  specialize h 1 (QuotientGroup.mk' _) _
  · ext1
    simp only [one_apply, coe_comp, coe_mk', Function.comp_apply]
    rw [show (1 : B ⧸ f.range) = (1 : B) from QuotientGroup.mk_one _, QuotientGroup.eq, inv_one,
      one_mul]
    exact ⟨x, rfl⟩
  replace h : (QuotientGroup.mk' _).ker = (1 : B →* B ⧸ f.range).ker := by rw [h]
  rwa [ker_one, QuotientGroup.ker_mk'] at h
#align monoid_hom.range_eq_top_of_cancel MonoidHom.range_eq_top_of_cancel
#align add_monoid_hom.range_eq_top_of_cancel AddMonoidHom.range_eq_top_of_cancel

end

end MonoidHom

section

open CategoryTheory

namespace GroupCat

variable {A B : GroupCat.{u}} (f : A ⟶ B)

@[to_additive AddGroupCat.ker_eq_bot_of_mono]
theorem ker_eq_bot_of_mono [Mono f] : f.ker = ⊥ :=
  MonoidHom.ker_eq_bot_of_cancel fun u v =>
    (@cancel_mono _ _ _ _ _ f _ (show GroupCat.of f.ker ⟶ A from u) _).1
#align Group.ker_eq_bot_of_mono GroupCat.ker_eq_bot_of_mono
#align AddGroup.ker_eq_bot_of_mono AddGroupCat.ker_eq_bot_of_mono

@[to_additive AddGroupCat.mono_iff_ker_eq_bot]
theorem mono_iff_ker_eq_bot : Mono f ↔ f.ker = ⊥ :=
  ⟨fun h => @ker_eq_bot_of_mono f h, fun h =>
    ConcreteCategory.mono_of_injective _ <| (MonoidHom.ker_eq_bot_iff f).1 h⟩
#align Group.mono_iff_ker_eq_bot GroupCat.mono_iff_ker_eq_bot
#align AddGroup.mono_iff_ker_eq_bot AddGroupCat.mono_iff_ker_eq_bot

@[to_additive AddGroupCat.mono_iff_injective]
theorem mono_iff_injective : Mono f ↔ Function.Injective f :=
  Iff.trans (mono_iff_ker_eq_bot f) <| MonoidHom.ker_eq_bot_iff f
#align Group.mono_iff_injective GroupCat.mono_iff_injective
#align AddGroup.mono_iff_injective AddGroupCat.mono_iff_injective

namespace SurjectiveOfEpiAuxs

-- mathport name: exprX
local notation "X" => Set.range (Function.swap leftCoset f.range.carrier)

/-- Define `X'` to be the set of all left cosets with an extra point at "infinity".
-/
@[nolint has_nonempty_instance]
inductive XWithInfinity
  | from_coset : Set.range (Function.swap leftCoset f.range.carrier) → X_with_infinity
  | infinity : X_with_infinity
#align Group.surjective_of_epi_auxs.X_with_infinity GroupCat.SurjectiveOfEpiAuxs.XWithInfinity

open XWithInfinity Equiv.Perm

open Coset

-- mathport name: exprX'
local notation "X'" => XWithInfinity f

-- mathport name: «expr∞»
local notation "∞" => XWithInfinity.infinity

-- mathport name: exprSX'
local notation "SX'" => Equiv.Perm X'

instance : SMul B X'
    where smul b x :=
    match x with
    | from_coset y =>
      from_coset
        ⟨b *l y, by
          rw [← Subtype.val_eq_coe, ← y.2.choose_spec, leftCoset_assoc]
          use b * y.2.some⟩
    | ∞ => ∞

theorem mul_smul (b b' : B) (x : X') : (b * b') • x = b • b' • x :=
  match x with
  | from_coset y => by
    change from_coset _ = from_coset _
    simp only [← Subtype.val_eq_coe, leftCoset_assoc]
  | ∞ => rfl
#align Group.surjective_of_epi_auxs.mul_smul GroupCat.SurjectiveOfEpiAuxs.mul_smul

theorem one_smul (x : X') : (1 : B) • x = x :=
  match x with
  | from_coset y => by
    change from_coset _ = from_coset _
    simp only [← Subtype.val_eq_coe, one_leftCoset, Subtype.ext_iff_val]
  | ∞ => rfl
#align Group.surjective_of_epi_auxs.one_smul GroupCat.SurjectiveOfEpiAuxs.one_smul

theorem from_coset_eq_of_mem_range {b : B} (hb : b ∈ f.range) :
    from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ =
      from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ :=
  by
  congr
  change b *l f.range = f.range
  nth_rw 2 [show (f.range : Set B) = 1 *l f.range from (one_leftCoset _).symm]
  rw [leftCoset_eq_iff, mul_one]
  exact Subgroup.inv_mem _ hb
#align Group.surjective_of_epi_auxs.from_coset_eq_of_mem_range GroupCat.SurjectiveOfEpiAuxs.from_coset_eq_of_mem_range

theorem from_coset_ne_of_nin_range {b : B} (hb : b ∉ f.range) :
    from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ ≠
      from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ :=
  by
  intro r
  simp only [Subtype.mk_eq_mk] at r
  change b *l f.range = f.range at r
  nth_rw 2 [show (f.range : Set B) = 1 *l f.range from (one_leftCoset _).symm] at r
  rw [leftCoset_eq_iff, mul_one] at r
  exact hb (inv_inv b ▸ Subgroup.inv_mem _ r)
#align Group.surjective_of_epi_auxs.from_coset_ne_of_nin_range GroupCat.SurjectiveOfEpiAuxs.from_coset_ne_of_nin_range

instance : DecidableEq X' :=
  Classical.decEq _

/-- Let `τ` be the permutation on `X'` exchanging `f.range` and the point at infinity.
-/
noncomputable def tau : SX' :=
  Equiv.swap (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) ∞
#align Group.surjective_of_epi_auxs.tau GroupCat.SurjectiveOfEpiAuxs.tau

-- mathport name: exprτ
local notation "τ" => tau f

theorem τ_apply_infinity : τ ∞ = from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ :=
  Equiv.swap_apply_right _ _
#align Group.surjective_of_epi_auxs.τ_apply_infinity GroupCat.SurjectiveOfEpiAuxs.τ_apply_infinity

theorem τ_apply_from_coset : τ (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) = ∞ :=
  Equiv.swap_apply_left _ _
#align Group.surjective_of_epi_auxs.τ_apply_from_coset GroupCat.SurjectiveOfEpiAuxs.τ_apply_from_coset

theorem τ_apply_from_coset' (x : B) (hx : x ∈ f.range) :
    τ (from_coset ⟨x *l f.range.carrier, ⟨x, rfl⟩⟩) = ∞ :=
  (from_coset_eq_of_mem_range _ hx).symm ▸ τ_apply_from_coset _
#align Group.surjective_of_epi_auxs.τ_apply_from_coset' GroupCat.SurjectiveOfEpiAuxs.τ_apply_from_coset'

theorem τ_symm_apply_from_coset :
    (Equiv.symm τ) (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) = ∞ := by
  rw [tau, Equiv.symm_swap, Equiv.swap_apply_left]
#align Group.surjective_of_epi_auxs.τ_symm_apply_from_coset GroupCat.SurjectiveOfEpiAuxs.τ_symm_apply_from_coset

theorem τ_symm_apply_infinity :
    (Equiv.symm τ) ∞ = from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ := by
  rw [tau, Equiv.symm_swap, Equiv.swap_apply_right]
#align Group.surjective_of_epi_auxs.τ_symm_apply_infinity GroupCat.SurjectiveOfEpiAuxs.τ_symm_apply_infinity

/-- Let `g : B ⟶ S(X')` be defined as such that, for any `β : B`, `g(β)` is the function sending
point at infinity to point at infinity and sending coset `y` to `β *l y`.
-/
def g : B →* SX'
    where
  toFun β :=
    { toFun := fun x => β • x
      invFun := fun x => β⁻¹ • x
      left_inv := fun x => by
        dsimp only
        rw [← mul_smul, mul_left_inv, one_smul]
      right_inv := fun x => by
        dsimp only
        rw [← mul_smul, mul_right_inv, one_smul] }
  map_one' := by
    ext
    simp [one_smul]
  map_mul' b1 b2 := by
    ext
    simp [mul_smul]
#align Group.surjective_of_epi_auxs.G GroupCat.SurjectiveOfEpiAuxs.g

-- mathport name: exprg
local notation "g" => g f

/-- Define `h : B ⟶ S(X')` to be `τ g τ⁻¹`
-/
def h : B →* SX' where
  toFun β := (τ.symm.trans (g β)).trans τ
  map_one' := by
    ext
    simp
  map_mul' b1 b2 := by
    ext
    simp
#align Group.surjective_of_epi_auxs.H GroupCat.SurjectiveOfEpiAuxs.h

-- mathport name: exprh
local notation "h" => h f

/-!
The strategy is the following: assuming `epi f`
* prove that `f.range = {x | h x = g x}`;
* thus `f ≫ h = f ≫ g` so that `h = g`;
* but if `f` is not surjective, then some `x ∉ f.range`, then `h x ≠ g x` at the coset `f.range`.
-/

theorem g_apply_from_coset (x : B) (y : X) : (g x) (from_coset y) = from_coset ⟨x *l y, by tidy⟩ :=
  rfl
#align Group.surjective_of_epi_auxs.g_apply_from_coset GroupCat.SurjectiveOfEpiAuxs.g_apply_from_coset

theorem g_apply_infinity (x : B) : (g x) ∞ = ∞ :=
  rfl
#align Group.surjective_of_epi_auxs.g_apply_infinity GroupCat.SurjectiveOfEpiAuxs.g_apply_infinity

theorem h_apply_infinity (x : B) (hx : x ∈ f.range) : (h x) ∞ = ∞ :=
  by
  simp only [H, MonoidHom.coe_mk, Equiv.toFun_as_coe, Equiv.coe_trans, Function.comp_apply]
  rw [τ_symm_apply_infinity, g_apply_from_coset]
  simpa only [← Subtype.val_eq_coe] using τ_apply_from_coset' f x hx
#align Group.surjective_of_epi_auxs.h_apply_infinity GroupCat.SurjectiveOfEpiAuxs.h_apply_infinity

theorem h_apply_from_coset (x : B) :
    (h x) (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) =
      from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ :=
  by simp [H, τ_symm_apply_from_coset, g_apply_infinity, τ_apply_infinity]
#align Group.surjective_of_epi_auxs.h_apply_from_coset GroupCat.SurjectiveOfEpiAuxs.h_apply_from_coset

theorem h_apply_from_coset' (x : B) (b : B) (hb : b ∈ f.range) :
    (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) =
      from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ :=
  (from_coset_eq_of_mem_range _ hb).symm ▸ h_apply_from_coset f x
#align Group.surjective_of_epi_auxs.h_apply_from_coset' GroupCat.SurjectiveOfEpiAuxs.h_apply_from_coset'

theorem h_apply_from_coset_nin_range (x : B) (hx : x ∈ f.range) (b : B) (hb : b ∉ f.range) :
    (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) =
      from_coset ⟨x * b *l f.range.carrier, ⟨x * b, rfl⟩⟩ :=
  by
  simp only [H, tau, MonoidHom.coe_mk, Equiv.toFun_as_coe, Equiv.coe_trans, Function.comp_apply]
  rw [Equiv.symm_swap,
    @Equiv.swap_apply_of_ne_of_ne X' _ (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) ∞
      (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) (from_coset_ne_of_nin_range _ hb) (by simp)]
  simp only [g_apply_from_coset, ← Subtype.val_eq_coe, leftCoset_assoc]
  refine' Equiv.swap_apply_of_ne_of_ne (from_coset_ne_of_nin_range _ fun r => hb _) (by simp)
  convert Subgroup.mul_mem _ (Subgroup.inv_mem _ hx) r
  rw [← mul_assoc, mul_left_inv, one_mul]
#align Group.surjective_of_epi_auxs.h_apply_from_coset_nin_range GroupCat.SurjectiveOfEpiAuxs.h_apply_from_coset_nin_range

theorem agree : f.range.carrier = { x | h x = g x } :=
  by
  refine' Set.ext fun b => ⟨_, fun hb : h b = g b => by_contradiction fun r => _⟩
  · rintro ⟨a, rfl⟩
    change h (f a) = g (f a)
    ext ⟨⟨_, ⟨y, rfl⟩⟩⟩
    · rw [g_apply_from_coset]
      by_cases m : y ∈ f.range
      · rw [h_apply_from_coset' _ _ _ m, from_coset_eq_of_mem_range _ m]
        change from_coset _ = from_coset ⟨f a *l (y *l _), _⟩
        simpa only [← from_coset_eq_of_mem_range _ (Subgroup.mul_mem _ ⟨a, rfl⟩ m), leftCoset_assoc]
      · rw [h_apply_from_coset_nin_range _ _ ⟨_, rfl⟩ _ m]
        simpa only [← Subtype.val_eq_coe, leftCoset_assoc]
    · rw [g_apply_infinity, h_apply_infinity _ _ ⟨_, rfl⟩]
  · have eq1 :
      (h b) (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) =
        from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩ :=
      by simp [H, tau, g_apply_infinity]
    have eq2 :
      (g b) (from_coset ⟨f.range.carrier, ⟨1, one_leftCoset _⟩⟩) =
        from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ :=
      rfl
    exact (from_coset_ne_of_nin_range _ r).symm (by rw [← eq1, ← eq2, FunLike.congr_fun hb])
#align Group.surjective_of_epi_auxs.agree GroupCat.SurjectiveOfEpiAuxs.agree

theorem comp_eq : (f ≫ show B ⟶ GroupCat.of SX' from g) = f ≫ h :=
  FunLike.ext _ _ fun a => by
    simp only [comp_apply, show h (f a) = _ from (by simp [← agree] : f a ∈ { b | h b = g b })]
#align Group.surjective_of_epi_auxs.comp_eq GroupCat.SurjectiveOfEpiAuxs.comp_eq

theorem g_ne_h (x : B) (hx : x ∉ f.range) : g ≠ h :=
  by
  intro r
  replace r :=
    FunLike.congr_fun (FunLike.congr_fun r x) (from_coset ⟨f.range, ⟨1, one_leftCoset _⟩⟩)
  rw [H, g_apply_from_coset, MonoidHom.coe_mk, tau] at r
  simp only [MonoidHom.coe_range, Subtype.coe_mk, Equiv.symm_swap, Equiv.toFun_as_coe,
    Equiv.coe_trans, Function.comp_apply] at r
  erw [Equiv.swap_apply_left, g_apply_infinity, Equiv.swap_apply_right] at r
  exact from_coset_ne_of_nin_range _ hx r
#align Group.surjective_of_epi_auxs.g_ne_h GroupCat.SurjectiveOfEpiAuxs.g_ne_h

end SurjectiveOfEpiAuxs

theorem surjective_of_epi [Epi f] : Function.Surjective f :=
  by
  by_contra r
  push_neg  at r
  rcases r with ⟨b, hb⟩
  exact
    surjective_of_epi_auxs.g_ne_h f b (fun ⟨c, hc⟩ => hb _ hc)
      ((cancel_epi f).1 (surjective_of_epi_auxs.comp_eq f))
#align Group.surjective_of_epi GroupCat.surjective_of_epi

theorem epi_iff_surjective : Epi f ↔ Function.Surjective f :=
  ⟨fun h => @surjective_of_epi f h, ConcreteCategory.epi_of_surjective _⟩
#align Group.epi_iff_surjective GroupCat.epi_iff_surjective

theorem epi_iff_range_eq_top : Epi f ↔ f.range = ⊤ :=
  Iff.trans (epi_iff_surjective _) (Subgroup.eq_top_iff' f.range).symm
#align Group.epi_iff_range_eq_top GroupCat.epi_iff_range_eq_top

end GroupCat

namespace AddGroupCat

variable {A B : AddGroupCat.{u}} (f : A ⟶ B)

theorem epi_iff_surjective : Epi f ↔ Function.Surjective f :=
  by
  have i1 : epi f ↔ epi (Group_AddGroup_equivalence.inverse.map f) :=
    by
    refine' ⟨_, Group_AddGroup_equivalence.inverse.epi_of_epi_map⟩
    intro e'
    apply Group_AddGroup_equivalence.inverse.map_epi
  rwa [GroupCat.epi_iff_surjective] at i1
#align AddGroup.epi_iff_surjective AddGroupCat.epi_iff_surjective

theorem epi_iff_range_eq_top : Epi f ↔ f.range = ⊤ :=
  Iff.trans (epi_iff_surjective _) (AddSubgroup.eq_top_iff' f.range).symm
#align AddGroup.epi_iff_range_eq_top AddGroupCat.epi_iff_range_eq_top

end AddGroupCat

namespace GroupCat

variable {A B : GroupCat.{u}} (f : A ⟶ B)

@[to_additive]
instance forget_groupCat_preserves_mono : (forget GroupCat).PreservesMonomorphisms
    where preserves X Y f e := by rwa [mono_iff_injective, ← CategoryTheory.mono_iff_injective] at e
#align Group.forget_Group_preserves_mono GroupCat.forget_groupCat_preserves_mono
#align AddGroup.forget_Group_preserves_mono AddGroupCat.forget_groupCat_preserves_mono

@[to_additive]
instance forget_groupCat_preserves_epi : (forget GroupCat).PreservesEpimorphisms
    where preserves X Y f e := by rwa [epi_iff_surjective, ← CategoryTheory.epi_iff_surjective] at e
#align Group.forget_Group_preserves_epi GroupCat.forget_groupCat_preserves_epi
#align AddGroup.forget_Group_preserves_epi AddGroupCat.forget_groupCat_preserves_epi

end GroupCat

namespace CommGroupCat

variable {A B : CommGroupCat.{u}} (f : A ⟶ B)

@[to_additive AddCommGroupCat.ker_eq_bot_of_mono]
theorem ker_eq_bot_of_mono [Mono f] : f.ker = ⊥ :=
  MonoidHom.ker_eq_bot_of_cancel fun u v =>
    (@cancel_mono _ _ _ _ _ f _ (show CommGroupCat.of f.ker ⟶ A from u) _).1
#align CommGroup.ker_eq_bot_of_mono CommGroupCat.ker_eq_bot_of_mono
#align AddCommGroup.ker_eq_bot_of_mono AddCommGroupCat.ker_eq_bot_of_mono

@[to_additive AddCommGroupCat.mono_iff_ker_eq_bot]
theorem mono_iff_ker_eq_bot : Mono f ↔ f.ker = ⊥ :=
  ⟨fun h => @ker_eq_bot_of_mono f h, fun h =>
    ConcreteCategory.mono_of_injective _ <| (MonoidHom.ker_eq_bot_iff f).1 h⟩
#align CommGroup.mono_iff_ker_eq_bot CommGroupCat.mono_iff_ker_eq_bot
#align AddCommGroup.mono_iff_ker_eq_bot AddCommGroupCat.mono_iff_ker_eq_bot

@[to_additive AddCommGroupCat.mono_iff_injective]
theorem mono_iff_injective : Mono f ↔ Function.Injective f :=
  Iff.trans (mono_iff_ker_eq_bot f) <| MonoidHom.ker_eq_bot_iff f
#align CommGroup.mono_iff_injective CommGroupCat.mono_iff_injective
#align AddCommGroup.mono_iff_injective AddCommGroupCat.mono_iff_injective

@[to_additive]
theorem range_eq_top_of_epi [Epi f] : f.range = ⊤ :=
  MonoidHom.range_eq_top_of_cancel fun u v h =>
    (@cancel_epi _ _ _ _ _ f _ (show B ⟶ ⟨B ⧸ MonoidHom.range f⟩ from u) v).1 h
#align CommGroup.range_eq_top_of_epi CommGroupCat.range_eq_top_of_epi
#align AddCommGroup.range_eq_top_of_epi AddCommGroupCat.range_eq_top_of_epi

@[to_additive]
theorem epi_iff_range_eq_top : Epi f ↔ f.range = ⊤ :=
  ⟨fun hf => range_eq_top_of_epi _, fun hf =>
    ConcreteCategory.epi_of_surjective _ <| MonoidHom.range_top_iff_surjective.mp hf⟩
#align CommGroup.epi_iff_range_eq_top CommGroupCat.epi_iff_range_eq_top
#align AddCommGroup.epi_iff_range_eq_top AddCommGroupCat.epi_iff_range_eq_top

@[to_additive]
theorem epi_iff_surjective : Epi f ↔ Function.Surjective f := by
  rw [epi_iff_range_eq_top, MonoidHom.range_top_iff_surjective]
#align CommGroup.epi_iff_surjective CommGroupCat.epi_iff_surjective
#align AddCommGroup.epi_iff_surjective AddCommGroupCat.epi_iff_surjective

@[to_additive]
instance forget_commGroupCat_preserves_mono : (forget CommGroupCat).PreservesMonomorphisms
    where preserves X Y f e := by rwa [mono_iff_injective, ← CategoryTheory.mono_iff_injective] at e
#align CommGroup.forget_CommGroup_preserves_mono CommGroupCat.forget_commGroupCat_preserves_mono
#align AddCommGroup.forget_CommGroup_preserves_mono AddCommGroupCat.forget_commGroupCat_preserves_mono

@[to_additive]
instance forget_commGroupCat_preserves_epi : (forget CommGroupCat).PreservesEpimorphisms
    where preserves X Y f e := by rwa [epi_iff_surjective, ← CategoryTheory.epi_iff_surjective] at e
#align CommGroup.forget_CommGroup_preserves_epi CommGroupCat.forget_commGroupCat_preserves_epi
#align AddCommGroup.forget_CommGroup_preserves_epi AddCommGroupCat.forget_commGroupCat_preserves_epi

end CommGroupCat

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.basic
import ring_theory.int.basic
import tactic.ring
import tactic.ring_exp
import tactic.field_simp
import data.int.nat_prime
import data.zmod.basic

/-!
# Pythagorean Triples

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

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) :=
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

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 zero_lt_two, 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 ⟨t, co, pp⟩,
  rw [one_mul, one_mul],
  exact ⟨t, co⟩,
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 ((hpz).mul_right _) ((hpy).mul_right _),
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, 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 := mt eq_neg_of_add_eq_zero_left 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 (int.coe_nat_dvd_left.mpr hpn).mul_right 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

/-- **Formula for Pythagorean Triples** -/
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


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Chris Hughes
-/

import data.fintype.card
import data.polynomial.ring_division
import group_theory.specific_groups.cyclic
import algebra.geom_sum

/-!
# Integral domains

Assorted theorems about integral domains.

## Main theorems

* `is_cyclic_of_subgroup_integral_domain` : A finite subgroup of the units of an integral domain
                                            is cyclic.
* `field_of_integral_domain`              : A finite integral domain is a field.

## Tags

integral domain, finite integral domain, finite field
-/

section

open finset polynomial function
open_locale big_operators nat

variables {R : Type*} {G : Type*} [integral_domain R] [group G] [fintype G]

lemma card_nth_roots_subgroup_units (f : G →* R) (hf : injective f) {n : ℕ} (hn : 0 < n) (g₀ : G) :
  ({g ∈ univ | g ^ n = g₀} : finset G).card ≤ (nth_roots n (f g₀)).card :=
begin
  haveI : decidable_eq R := classical.dec_eq _,
  refine le_trans _ (nth_roots n (f g₀)).to_finset_card_le,
  apply card_le_card_of_inj_on f,
  { intros g hg,
    rw [sep_def, mem_filter] at hg,
    rw [multiset.mem_to_finset, mem_nth_roots hn, ← f.map_pow, hg.2] },
  { intros, apply hf, assumption }
end

/-- A finite subgroup of the unit group of an integral domain is cyclic. -/
lemma is_cyclic_of_subgroup_integral_domain (f : G →* R) (hf : injective f) : is_cyclic G :=
begin
  classical,
  apply is_cyclic_of_card_pow_eq_one_le,
  intros n hn,
  convert (le_trans (card_nth_roots_subgroup_units f hf hn 1) (card_nth_roots n (f 1)))
end

/-- The unit group of a finite integral domain is cyclic. -/
instance [fintype R] : is_cyclic (units R) :=
is_cyclic_of_subgroup_integral_domain (units.coe_hom R) $ units.ext

/-- Every finite integral domain is a field. -/
def field_of_integral_domain [decidable_eq R] [fintype R] : field R :=
{ inv := λ a, if h : a = 0 then 0
    else fintype.bij_inv (show function.bijective (* a),
      from fintype.injective_iff_bijective.1 $ λ _ _, mul_right_cancel' h) 1,
  mul_inv_cancel := λ a ha, show a * dite _ _ _ = _, by rw [dif_neg ha, mul_comm];
    exact fintype.right_inverse_bij_inv (show function.bijective (* a), from _) 1,
  inv_zero := dif_pos rfl,
  ..show integral_domain R, by apply_instance }

section

variables (S : set (units R)) [is_subgroup S] [fintype S]
local attribute [instance] subtype.group

/-- A finite subgroup of the units of an integral domain is cyclic. -/
instance subgroup_units_cyclic : is_cyclic S :=
begin
  refine is_cyclic_of_subgroup_integral_domain ⟨(coe : S → R), _, _⟩
    (units.ext.comp subtype.val_injective),
  { simp only [is_submonoid.coe_one, units.coe_one, coe_coe] },
  { intros, simp only [is_submonoid.coe_mul, units.coe_mul, coe_coe] },
end

end

lemma card_fiber_eq_of_mem_range {H : Type*} [group H] [decidable_eq H]
  (f : G →* H) {x y : H} (hx : x ∈ set.range f) (hy : y ∈ set.range f) :
  (univ.filter $ λ g, f g = x).card = (univ.filter $ λ g, f g = y).card :=
begin
  rcases hx with ⟨x, rfl⟩,
  rcases hy with ⟨y, rfl⟩,
  refine card_congr (λ g _, g * x⁻¹ * y) _ _ (λ g hg, ⟨g * y⁻¹ * x, _⟩),
  { simp only [mem_filter, one_mul, monoid_hom.map_mul, mem_univ, mul_right_inv,
      eq_self_iff_true, monoid_hom.map_mul_inv, and_self, forall_true_iff] {contextual := tt} },
  { simp only [mul_left_inj, imp_self, forall_2_true_iff], },
  { simp only [true_and, mem_filter, mem_univ] at hg,
    simp only [hg, mem_filter, one_mul, monoid_hom.map_mul, mem_univ, mul_right_inv,
      eq_self_iff_true, exists_prop_of_true, monoid_hom.map_mul_inv, and_self,
      mul_inv_cancel_right, inv_mul_cancel_right], }
end

section
local attribute [instance] subtype.group subtype.monoid range.is_submonoid
/-- In an integral domain, a sum indexed by a nontrivial homomorphism from a finite group is zero.
-/
lemma sum_hom_units_eq_zero (f : G →* R) (hf : f ≠ 1) : ∑ g : G, f g = 0 :=
begin
  classical,
  obtain ⟨x, hx⟩ : ∃ x : set.range f.to_hom_units, ∀ y : set.range f.to_hom_units, y ∈ powers x,
    from is_cyclic.exists_monoid_generator,
  have hx1 : x ≠ 1,
  { rintro rfl,
    apply hf,
    ext g,
    rw [monoid_hom.one_apply],
    cases hx ⟨f.to_hom_units g, g, rfl⟩ with n hn,
    rwa [subtype.ext_iff, units.ext_iff, subtype.coe_mk, monoid_hom.coe_to_hom_units,
      is_submonoid.coe_pow, units.coe_pow, is_submonoid.coe_one, units.coe_one,
      one_pow, eq_comm] at hn, },
  replace hx1 : (x : R) - 1 ≠ 0,
    from λ h, hx1 (subtype.eq (units.ext (sub_eq_zero.1 h))),
  let c := (univ.filter (λ g, f.to_hom_units g = 1)).card,
  calc ∑ g : G, f g
      = ∑ g : G, f.to_hom_units g : rfl
  ... = ∑ u : units R in univ.image f.to_hom_units,
    (univ.filter (λ g, f.to_hom_units g = u)).card • u : sum_comp (coe : units R → R) f.to_hom_units
  ... = ∑ u : units R in univ.image f.to_hom_units, c • u :
    sum_congr rfl (λ u hu, congr_arg2 _ _ rfl) -- remaining goal 1, proven below
  ... = ∑ b : set.range f.to_hom_units, c • ↑b : finset.sum_subtype _
      (by simp only [mem_image, set.mem_range, forall_const, iff_self, mem_univ,
                     exists_prop_of_true]) _
  ... = c • ∑ b : set.range f.to_hom_units, (b : R) : smul_sum.symm
  ... = c • 0 : congr_arg2 _ rfl _            -- remaining goal 2, proven below
  ... = 0 : smul_zero _,
  { -- remaining goal 1
    show (univ.filter (λ (g : G), f.to_hom_units g = u)).card = c,
    apply card_fiber_eq_of_mem_range f.to_hom_units,
    { simpa only [mem_image, mem_univ, exists_prop_of_true, set.mem_range] using hu, },
    { exact ⟨1, f.to_hom_units.map_one⟩ } },
  -- remaining goal 2
  show ∑ b : set.range f.to_hom_units, (b : R) = 0,
  calc ∑ b : set.range f.to_hom_units, (b : R)
      = ∑ n in range (order_of x), x ^ n :
    eq.symm $ sum_bij (λ n _, x ^ n)
      (by simp only [mem_univ, forall_true_iff])
      (by simp only [is_submonoid.coe_pow, eq_self_iff_true, units.coe_pow, coe_coe,
                     forall_true_iff])
      (λ m n hm hn, pow_injective_of_lt_order_of _
        (by simpa only [mem_range] using hm)
        (by simpa only [mem_range] using hn))
      (λ b hb, let ⟨n, hn⟩ := hx b in ⟨n % order_of x, mem_range.2 (nat.mod_lt _ (order_of_pos _)),
        by rw [← pow_eq_mod_order_of, hn]⟩)
  ... = 0 : _,
  rw [← mul_left_inj' hx1, zero_mul, ← geom_sum, geom_sum_mul, coe_coe],
  norm_cast,
  rw [pow_order_of_eq_one, is_submonoid.coe_one, units.coe_one, sub_self],
end
end

/-- In an integral domain, a sum indexed by a homomorphism from a finite group is zero,
unless the homomorphism is trivial, in which case the sum is equal to the cardinality of the group.
-/
lemma sum_hom_units (f : G →* R) [decidable (f = 1)] :
  ∑ g : G, f g = if f = 1 then fintype.card G else 0 :=
begin
  split_ifs with h h,
  { simp [h, card_univ] },
  { exact sum_hom_units_eq_zero f h }
end

end


/-
Copyright (c) 2016 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis

Bounded linear operators
-/
import .normed_space .real_limit algebra.module algebra.homomorphism
open real nat classical topology set
--open normed_vector_space (this confuses lots of stuff??)
noncomputable theory

namespace analysis

-- define bounded linear operators and basic instances
section bdd_lin_op
structure is_bdd_linear_map [class] {V W : Type} [normed_vector_space V] [normed_vector_space W] (f : V → W)
          extends is_module_hom ℝ f :=
  (op_norm : ℝ) (op_norm_pos : op_norm > 0) (op_norm_bound : ∀ v : V, ∥f v∥ ≤ op_norm * ∥v∥)

theorem is_bdd_linear_map_id [instance] (V : Type) [normed_vector_space V] : is_bdd_linear_map (λ x : V, x) :=
  begin
    fapply is_bdd_linear_map.mk,
    repeat (intros; reflexivity),
    exact 1,
    exact zero_lt_one,
    intro, rewrite one_mul, apply le.refl
  end

theorem is_bdd_linear_map_zero [instance] (V W : Type) [normed_vector_space V] [normed_vector_space W] :
        is_bdd_linear_map (λ x : V, (0 : W)) :=
  begin
    fapply is_bdd_linear_map.mk,
    all_goals intros,
    rewrite zero_add,
    rewrite smul_zero,
    exact 1,
    exact zero_lt_one,
    rewrite [norm_zero, one_mul],
    apply norm_nonneg
  end

theorem is_bdd_linear_map_add [instance] {V W : Type} [normed_vector_space V] [normed_vector_space W]
        (f g : V → W) [Hbf : is_bdd_linear_map f] [Hbg : is_bdd_linear_map g] :
        is_bdd_linear_map (λ x, f x + g x) :=
  begin
    fapply is_bdd_linear_map.mk,
    all_goals intros,
    {rewrite [hom_add f, hom_add g],-- (this takes 4 seconds: rewrite [2 hom_add])
    simp},
    {rewrite [hom_smul f, hom_smul g, smul_left_distrib]},
    {exact is_bdd_linear_map.op_norm _ _ f + is_bdd_linear_map.op_norm _ _ g},
    {apply add_pos,
    repeat apply is_bdd_linear_map.op_norm_pos},
    {apply le.trans,
    apply norm_triangle,
    rewrite right_distrib,
    apply add_le_add,
    repeat apply is_bdd_linear_map.op_norm_bound}
  end

theorem is_bdd_linear_map_smul [instance] {V W : Type} [normed_vector_space V] [normed_vector_space W]
        (f : V → W) (c : ℝ) [Hbf : is_bdd_linear_map f] : is_bdd_linear_map (λ x, c • f x) :=
  begin
    apply @decidable.cases_on (c = 0),
    exact _,
    {intro Hcz,
    rewrite Hcz,
    have Hfe : (λ x : V, (0 : ℝ) • f x) = (λ x : V, 0), from funext (λ x, !zero_smul),
    rewrite Hfe,
    apply is_bdd_linear_map_zero},
    intro Hcnz,
    fapply is_bdd_linear_map.mk,
    all_goals intros,
    {rewrite [hom_add f, smul_left_distrib]},
    {rewrite [hom_smul f, -*mul_smul, {c*r}mul.comm]},
    {exact (abs c) * is_bdd_linear_map.op_norm _ _ f},
    {have Hpos : abs c > 0, from abs_pos_of_ne_zero Hcnz,
    apply mul_pos,
    assumption,
    apply is_bdd_linear_map.op_norm_pos},
    {rewrite [norm_smul, mul.assoc],
    apply mul_le_mul_of_nonneg_left,
    apply is_bdd_linear_map.op_norm_bound,
    apply abs_nonneg}
  end

theorem is_bdd_linear_map_neg [instance] {V W : Type} [normed_vector_space V] [normed_vector_space W]
        (f : V → W) [Hbf : is_bdd_linear_map f] : is_bdd_linear_map (λ x, -f x) :=
  begin
    have H : (λ x : V, -f x) = (λ x : V, (-1 : ℝ) • f x), from funext (λ x, eq.symm !neg_one_smul),
    rewrite H,
    apply is_bdd_linear_map_smul
  end

-- this can't be an instance because things loop
theorem is_bdd_linear_map_comp {U V W : Type} [normed_vector_space U] [normed_vector_space V]
        [normed_vector_space W] (f : V → W) (g : U → V) [is_bdd_linear_map f] [is_bdd_linear_map g] :
        is_bdd_linear_map (λ u, f (g u)) :=
  begin
    fapply is_bdd_linear_map.mk,
    all_goals intros,
    {rewrite [hom_add g, hom_add f]},
    {rewrite [hom_smul g, hom_smul f]},
    {exact is_bdd_linear_map.op_norm _ _ f * is_bdd_linear_map.op_norm _ _ g},
    {apply mul_pos, repeat apply is_bdd_linear_map.op_norm_pos},
    {apply le.trans,
    apply is_bdd_linear_map.op_norm_bound _ _ f,
    apply le.trans,
    apply mul_le_mul_of_nonneg_left,
    apply is_bdd_linear_map.op_norm_bound _ _ g,
    apply le_of_lt !is_bdd_linear_map.op_norm_pos,
    rewrite *mul.assoc,
    apply le.refl}
  end

variables {V W : Type}
variables [HV : normed_vector_space V] [HW : normed_vector_space W]
include HV HW
variable f : V → W
variable [Hf : is_bdd_linear_map f]
include Hf

definition op_norm := is_bdd_linear_map.op_norm _ _ f

theorem op_norm_pos : op_norm f > 0 := is_bdd_linear_map.op_norm_pos _ _ f

theorem op_norm_bound (v : V) : ∥f v∥ ≤ (op_norm f) * ∥v∥ := is_bdd_linear_map.op_norm_bound  _ _ f v

theorem bdd_linear_map_continuous : continuous f :=
  begin
    apply continuous_of_forall_continuous_at,
    intro x,
    apply normed_vector_space.continuous_at_intro,
    intro ε Hε,
    existsi ε / (op_norm f),
    split,
    apply div_pos_of_pos_of_pos Hε !op_norm_pos,
    intro x' Hx',
    rewrite [-hom_sub f],
    apply lt_of_le_of_lt,
    apply op_norm_bound f,
    rewrite [-@mul_div_cancel' _ _ ε (op_norm f) (ne_of_gt !op_norm_pos)],
    apply mul_lt_mul_of_pos_left,
    exact Hx',
    apply op_norm_pos
  end

end bdd_lin_op

-- define Frechet derivative and basic properties

section frechet_deriv
variables {V W : Type}
variables [HV : normed_vector_space V] [HW : normed_vector_space W]
include HV HW

definition has_frechet_deriv_at (f A : V → W) [is_bdd_linear_map A] (x : V) :=
  (λ h : V, ∥f (x + h) - f x - A h ∥ / ∥ h ∥) ⟶ 0 [at 0]

lemma diff_quot_cts {f A : V → W} [HA : is_bdd_linear_map A] {y : V} (Hf : has_frechet_deriv_at f A y) :
      continuous_at (λ h, ∥f (y + h) - f y - A h∥ / ∥h∥) 0 :=
  begin
    apply normed_vector_space.continuous_at_intro,
    intro ε Hε,
    cases normed_vector_space.approaches_at_dest Hf Hε with δ Hδ,
    existsi δ,
    split,
    exact and.left Hδ,
    intro x' Hx',
    cases em (x' = 0) with Heq Hneq,
    {rewrite [Heq, norm_zero, div_zero, sub_zero, norm_zero], apply Hε},
    {rewrite [norm_zero, div_zero],
    apply and.right Hδ,
    repeat assumption}
  end

theorem is_bdd_linear_map_of_eq {A B : V → W} [HA : is_bdd_linear_map A] (HAB : A = B) :
        is_bdd_linear_map B :=
  begin
    fapply is_bdd_linear_map.mk,
    all_goals try rewrite -HAB,
    {apply hom_add},
    {apply hom_smul},
    {exact op_norm A},
    {exact op_norm_pos A},
    {rewrite -HAB, apply op_norm_bound}
  end

definition is_frechet_deriv_at_of_eq {f A : V → W} [is_bdd_linear_map A] {x : V}
           (Hfd : has_frechet_deriv_at f A x) {B : V → W} (HAB : A = B) :
           @has_frechet_deriv_at _ _ _ _ f B (is_bdd_linear_map_of_eq HAB) x :=
  begin
    unfold has_frechet_deriv_at,
    rewrite -HAB,
    apply Hfd
  end

theorem has_frechet_deriv_at_intro {f A : V → W} [is_bdd_linear_map A] {x : V}
        (H : ∀ ⦃ε : ℝ⦄, ε > 0 →
              (∃ δ : ℝ, δ > 0 ∧ ∀ ⦃x' : V⦄, x' ≠ 0 ∧ ∥x'∥ < δ → ∥f (x + x') - f x - A x'∥ / ∥x'∥ < ε)) :
        has_frechet_deriv_at f A x :=
  begin
    apply normed_vector_space.approaches_at_intro,
    intros ε Hε,
    cases H Hε with δ Hδ,
    cases Hδ with Hδ Hδ',
    existsi δ,
    split,
    assumption,
    intros x' Hx'1 Hx'2,
    show abs (∥f (x + x') - f x - A x'∥ / ∥x'∥ - 0) < ε, begin
      have H : ∥f (x + x') - f x - A x'∥ / ∥x'∥ ≥ 0,
        from div_nonneg_of_nonneg_of_nonneg !norm_nonneg !norm_nonneg,
      rewrite [sub_zero, abs_of_nonneg H],
      apply Hδ',
      split,
      assumption,
      rewrite [-sub_zero x'],
      apply Hx'1
    end
  end

theorem has_frechet_deriv_at_elim {f A : V → W} [is_bdd_linear_map A] {x : V} (H : has_frechet_deriv_at f A x) :
         ∀ ⦃ε : ℝ⦄, ε > 0 →
              (∃ δ : ℝ, δ > 0 ∧ ∀ ⦃x' : V⦄, x' ≠ 0 ∧ ∥x'∥ < δ → ∥f (x + x') - f x - A x'∥ / ∥x'∥ < ε) :=
  begin
    intros ε Hε,
    cases normed_vector_space.approaches_at_dest H Hε with δ Hδ,
    cases Hδ with Hδ Hδ',
    existsi δ,
    split,
    assumption,
    intros x' Hx',
    rewrite [-sub_zero x' at Hx' {2}],
    have Hδ'' : abs (∥f (x + x') - f x - A x'∥ / ∥x'∥ - 0) < ε, from Hδ' (and.right Hx') (and.left Hx'),
    have Hpos : ∥f (x + x') - f x - A x'∥ / ∥x'∥ ≥ 0, from div_nonneg_of_nonneg_of_nonneg !norm_nonneg !norm_nonneg,
    rewrite [sub_zero at Hδ'', abs_of_nonneg Hpos at Hδ''],
    assumption
  end

structure frechet_diffable_at [class] (f : V → W) (x : V) :=
  (A : V → W) [HA : is_bdd_linear_map A] (is_fr_der : has_frechet_deriv_at f A x)

variables f g : V → W
variable x : V

definition frechet_deriv_at [Hf : frechet_diffable_at f x] : V → W :=
  frechet_diffable_at.A _ _ f x

definition frechet_deriv_at_is_bdd_linear_map [instance] (f : V → W) (x : V) [Hf : frechet_diffable_at f x] :
           is_bdd_linear_map (frechet_deriv_at f x) :=
  frechet_diffable_at.HA _ _ f x

theorem frechet_deriv_spec [Hf : frechet_diffable_at f x] :
        (λ h : V, ∥f (x + h) - f x - (frechet_deriv_at f x h) ∥ / ∥ h ∥) ⟶ 0 [at 0] :=
  frechet_diffable_at.is_fr_der _ _ f x

theorem has_frechet_deriv_at_const (w : W) : has_frechet_deriv_at (λ v : V, w) (λ v : V, 0) x :=
  begin
    apply normed_vector_space.approaches_at_intro,
    intros ε Hε,
    existsi 1,
    split,
    exact zero_lt_one,
    intros x' Hx' _,
    rewrite [2 sub_self, norm_zero],
    krewrite [zero_div, sub_zero, norm_zero],
    assumption
  end

theorem has_frechet_deriv_at_id : has_frechet_deriv_at (λ v : V, v) (λ v : V, v) x :=
  begin
    apply normed_vector_space.approaches_at_intro,
    intros ε Hε,
    existsi 1,
    split,
    exact zero_lt_one,
    intros x' Hx' _,
    have x + x' - x - x' = 0, by simp,
    rewrite [this, norm_zero, zero_div, sub_self, norm_zero],
    exact Hε
  end

theorem has_frechet_deriv_at_smul (c : ℝ) {A : V → W} [is_bdd_linear_map A]
        (Hf : has_frechet_deriv_at f A x) : has_frechet_deriv_at (λ y, c • f y) (λ y, c • A y) x :=
  begin
    eapply @decidable.cases_on (abs c = 0),
    exact _,
    {intro Hc,
    have Hz : c = 0, from eq_zero_of_abs_eq_zero Hc,
    have Hfz : (λ y : V, (0 : ℝ) • f y) = (λ y : V, 0), from funext (λ y, !zero_smul),
    --have Hfz' : (λ x : V, (0 : ℝ) • A x) = (λ x : V, 0), from funext (λ y, !zero_smul),
    -- rewriting Hfz' produces type-incorrect term
    rewrite [Hz, Hfz],
    apply metric_space.approaches_at_intro,
    intro ε Hε,
    existsi 1,
    split,
    exact zero_lt_one,
    intro x' Hx' _,
    rewrite [zero_smul, *sub_zero, norm_zero],
    krewrite [zero_div, dist_self],
    exact Hε},
    intro Hcnz,
    apply normed_vector_space.approaches_at_intro,
    intros ε Hε,
    have Hεc : ε / abs c > 0, from div_pos_of_pos_of_pos Hε (lt_of_le_of_ne !abs_nonneg (ne.symm Hcnz)),
    cases normed_vector_space.approaches_at_dest Hf Hεc with δ Hδ,
    cases Hδ with Hδp Hδ,
    existsi δ,
    split,
    assumption,
    intro x' Hx' _,
    show abs ((∥c • f (x + x') - c • f x - c • A x'∥ / ∥x'∥ - 0)) < ε, begin
      rewrite [sub_zero, -2 smul_sub_left_distrib, norm_smul],
      krewrite mul_div_assoc,
      rewrite [abs_mul, abs_abs, -{ε}mul_div_cancel' Hcnz],
      apply mul_lt_mul_of_pos_left,
      have Hδ' : abs (∥f (x + x') - f x - A x'∥ / ∥x'∥ - 0) < ε / abs c, from Hδ Hx' a,
      rewrite sub_zero at Hδ',
      apply Hδ',
      apply lt_of_le_of_ne,
      apply abs_nonneg,
      apply ne.symm,
      apply Hcnz
    end
  end

theorem has_frechet_deriv_at_neg {A : V → W} [is_bdd_linear_map A]
        (Hf : has_frechet_deriv_at f A x) : has_frechet_deriv_at (λ y, - f y) (λ y, - A y) x :=
  begin
    apply has_frechet_deriv_at_intro,
    intros ε Hε,
    cases has_frechet_deriv_at_elim Hf Hε with δ Hδ,
    existsi δ,
    split,
    exact and.left Hδ,
    intro x' Hx',
    rewrite [-norm_neg, neg_sub, sub_neg_eq_add, sub_add_eq_sub_sub, sub_neg_eq_add,
             add_sub_assoc, add.comm, -sub_eq_add_neg],
    apply and.right Hδ,
    assumption
  end

theorem has_frechet_deriv_at_add (A B : V → W) [is_bdd_linear_map A] [is_bdd_linear_map B]
        (Hf : has_frechet_deriv_at f A x) (Hg : has_frechet_deriv_at g B x) :
        has_frechet_deriv_at (λ y, f y + g y) (λ y, A y + B y) x :=
  begin
    have Hle : ∀ h, ∥f (x + h) + g (x + h) - (f x + g x) - (A h + B h)∥ / ∥h∥ ≤
                  ∥f (x + h) - f x - A h∥ / ∥h∥ + ∥g (x + h) - g x - B h∥ / ∥h∥, begin
      intro h,
      cases em (∥h∥ > 0) with Hh Hh,
      krewrite div_add_div_same,
      apply div_le_div_of_le_of_pos,
      have Hfeq : f (x + h) + g (x + h) - (f x + g x) - (A h + B h) =
                       (f (x + h) - f x - A h) + (g (x + h) - g x - B h), by simp,
      rewrite Hfeq,
      apply norm_triangle,
      exact Hh,
      have Hhe : ∥h∥ = 0, from eq_of_le_of_ge (le_of_not_gt Hh) !norm_nonneg,
      krewrite [Hhe, *div_zero, zero_add],
      eapply le.refl
    end,
    have Hlimge : (λ h, ∥f (x + h) - f x - A h∥ / ∥h∥ + ∥g (x + h) - g x - B h∥ / ∥h∥) ⟶ 0 [at 0], begin
      rewrite [-zero_add 0],
      apply add_approaches,
      apply Hf,
      apply Hg
    end,
    have Hlimle : (λ (h : V), (0 : ℝ)) ⟶ 0 [at 0], by apply approaches_constant,
    apply approaches_squeeze Hlimle Hlimge,
    apply filter.eventually_of_forall,
    intro y,
    apply div_nonneg_of_nonneg_of_nonneg,
    repeat apply norm_nonneg,
    apply filter.eventually_of_forall,
    apply Hle
  end

open topology

theorem continuous_at_of_diffable_at [Hf : frechet_diffable_at f x] : continuous_at f x :=
  begin
    apply normed_vector_space.continuous_at_intro,
    intros ε Hε,
    note Hfds := normed_vector_space.approaches_at_dest (frechet_deriv_spec f x) Hε,
    cases Hfds with δ Hδ,
    cases Hδ with Hδ Hδ',
    existsi min δ ((ε / 2) / (ε + op_norm (frechet_deriv_at f x))),
    split,
    {apply lt_min,
    exact Hδ,
    repeat apply div_pos_of_pos_of_pos,
    exact Hε,
    apply two_pos,
    apply add_pos Hε !op_norm_pos},
    {intro x' Hx',
    cases em (x' - x = 0) with Heq Hneq,
    rewrite [eq_of_sub_eq_zero Heq, sub_self, norm_zero], assumption,
    have Hx'x : x' - x ≠ 0 ∧ ∥(x' - x) - 0∥ < δ, from and.intro Hneq begin
      rewrite sub_zero,
      apply lt_of_lt_of_le,
      apply Hx',
      apply min_le_left
    end,
    have Hx'xp : ∥x' - x∥ > 0, from norm_pos_of_ne_zero Hneq,
    have Hδ'' : abs (∥f (x + (x' - x)) - f x - frechet_deriv_at f x (x' - x)∥ / ∥x' - x∥ - 0) < ε,
      from Hδ' (and.right Hx'x) (and.left Hx'x),
    have Hnn : ∥f (x + (x' - x)) - f x - frechet_deriv_at f x (x' - x)∥ / ∥x' - x∥ ≥ 0,
      from div_nonneg_of_nonneg_of_nonneg !norm_nonneg !norm_nonneg,
    rewrite [sub_zero at Hδ'', abs_of_nonneg Hnn at Hδ'', add.comm at Hδ'', sub_add_cancel at Hδ''],
    note H1 := lt_mul_of_div_lt_of_pos Hx'xp Hδ'',
    have H2 : f x' - f x = f x' - f x - frechet_deriv_at f x (x' - x) + frechet_deriv_at f x (x' - x),
      by rewrite sub_add_cancel,  --by simp, (simp takes .5 seconds to do this!)
    rewrite H2,
    apply lt_of_le_of_lt,
    apply norm_triangle,
    apply lt.trans,
    apply add_lt_add_of_lt_of_le,
    apply H1,
    apply op_norm_bound (!frechet_deriv_at),
    rewrite [-add_halves ε at {2}],
    apply add_lt_add,
    let on := op_norm (frechet_deriv_at f x),
    exact calc
      ε * ∥x' - x∥ < ε * min δ ((ε / 2) / (ε + on)) : mul_lt_mul_of_pos_left Hx' Hε
              ... ≤ ε * ((ε / 2) / (ε + on)) : mul_le_mul_of_nonneg_left !min_le_right (le_of_lt Hε)
              ... < ε / 2 : mul_div_self_add_lt (div_pos_of_pos_of_pos Hε two_pos) Hε !op_norm_pos,
    exact calc
      on * ∥x' - x∥ < on * min δ ((ε / 2) / (ε + on)) : mul_lt_mul_of_pos_left Hx' !op_norm_pos
               ... ≤ on * ((ε / 2) / (ε + on)) : mul_le_mul_of_nonneg_left !min_le_right (le_of_lt !op_norm_pos)
               ... < ε / 2 : mul_div_add_self_lt (div_pos_of_pos_of_pos Hε two_pos) Hε !op_norm_pos}
  end

theorem continuous_at_of_has_frechet_deriv_at {A : V → W} [is_bdd_linear_map A]
        (H : has_frechet_deriv_at f A x) : continuous_at f x :=
  begin
    apply @continuous_at_of_diffable_at,
    existsi A,
    exact H
  end

end frechet_deriv

section comp

lemma div_mul_div_cancel {A : Type} [field A] (a b : A) {c : A} (Hc : c ≠ 0) : (a / c) * (c / b) = a / b :=
  by rewrite [-mul_div_assoc, div_mul_cancel _ Hc]

lemma div_add_eq_add_mul_div {A : Type} [field A] (a b c : A) (Hb : b ≠ 0) : (a / b) + c = (a + c * b) / b :=
  by rewrite [-div_add_div_same, mul_div_cancel _ Hb]

-- I'm not sure why smul_approaches doesn't unify where I use this?
private lemma real_limit_helper {U : Type} [normed_vector_space U] {f : U → ℝ} {a : ℝ} {x : U}
      (Hf : f ⟶ a [at x]) (c : ℝ) : (λ y, c * f y) ⟶ c * a [at x] :=
  begin
    apply smul_approaches,
    exact Hf
  end

variables {U V W : Type}
variables [HU : normed_vector_space U] [HV : normed_vector_space V] [HW : normed_vector_space W]
variables {f : V → W} {g : U → V}
variables {A : V → W} {B : U → V}
variables [HA : is_bdd_linear_map A] [HB : is_bdd_linear_map B]
variable {x : U}

include HU HV HW HA HB

-- this takes 2 seconds without clearing the contexts before simp
theorem has_frechet_deriv_at_comp (Hg : has_frechet_deriv_at g B x) (Hf : has_frechet_deriv_at f A (g x)) :
        @has_frechet_deriv_at _ _ _ _ (λ y, f (g y)) (λ y, A (B y)) !is_bdd_linear_map_comp x :=
  begin
    unfold has_frechet_deriv_at,
    note Hf' := has_frechet_deriv_at_elim Hf,
    note Hg' := has_frechet_deriv_at_elim Hg,
    have H : ∀ h, f (g (x + h)) - f (g x) - A (B h) =
             (A (g (x + h) - g x - B h)) + (-f (g x) + f (g (x + h)) + A (g x - g (x + h))),
      begin intro; rewrite [3 hom_sub A], clear [Hf, Hg, Hf', Hg'], simp end, -- .5 seconds for simp
    have H' : (λ h, ∥f (g (x + h)) - f (g x) - A (B h)∥ / ∥h∥) =
              (λ h, ∥(A (g (x + h) - g x - B h)) + (-f (g x) + f (g (x + h)) + A (g x - g (x + h)))∥ / ∥h∥),
      from funext (λ h, by rewrite H),
    rewrite H',
    clear [H, H'],
    apply approaches_squeeze, -- show the limit holds by bounding it by something that vanishes
    {apply approaches_constant},
    rotate 1,
    {apply filter.eventually_of_forall, intro, apply div_nonneg_of_nonneg_of_nonneg, repeat apply norm_nonneg},
    {apply filter.eventually_of_forall, intro,
    apply div_le_div_of_le_of_nonneg,
    apply norm_triangle,
    apply norm_nonneg},
    have H : (λ (y : U), (∥A (g (x + y) - g x - B y)∥ + ∥-f (g x) + f (g (x + y)) + A (g x - g (x + y))∥) / ∥y∥) =
      (λ (y : U), (∥A (g (x + y) - g x - B y)∥ / ∥y∥ + ∥-f (g x) + f (g (x + y)) + A (g x - g (x + y))∥ / ∥y∥)),
      from funext (λ y, by rewrite [div_add_div_same]),
    rewrite [H, -zero_add 0], -- the function is a sum of two things that both vanish
    clear H,
    apply add_approaches,
    {apply approaches_squeeze, -- show the lhs vanishes by squeezing it again
    {apply approaches_constant},
    rotate 1,
    {apply filter.eventually_of_forall, intro, apply div_nonneg_of_nonneg_of_nonneg, repeat apply norm_nonneg},
    {apply filter.eventually_of_forall, intro y,
    show ∥A (g (x + y) - g x - B y)∥ / ∥y∥ ≤ op_norm A * (∥(g (x + y) - g x - B y)∥ / ∥y∥), begin
      rewrite -mul_div_assoc,
      apply div_le_div_of_le_of_nonneg,
      apply op_norm_bound A,
      apply norm_nonneg
    end},
    {rewrite [-mul_zero (op_norm A)],
    apply real_limit_helper,
    apply Hg}}, -- we have shown the lhs vanishes. now the rhs
    {have H : ∀ y, (∥-f (g x) + f (g (x + y)) + A (g x - g (x + y))∥ / ∥y∥) =
      ((∥(f (g (x + y)) - f (g x)) - A (g (x + y) - g x) ∥ / ∥g (x + y) - g x∥) * (∥g (x + y) - g x∥ / ∥y∥)),
    begin
      intro,
      cases em (g (x + y) - g x = 0) with Heq Hneq,
      {note Heq' := eq_of_sub_eq_zero Heq,
      rewrite [Heq', neg_add_eq_sub, *sub_self, hom_zero A, add_zero, *norm_zero, div_zero, zero_div]},
      {rewrite [div_mul_div_cancel _ _ (norm_ne_zero_of_ne_zero Hneq), *sub_eq_add_neg,
        -hom_neg A],
      clear [Hf, Hg, Hf', Hg', Hneq],
      simp} --(.5 seconds)
    end,
    apply approaches_squeeze, -- again, by squeezing
    {apply approaches_constant},
    rotate 1,
    {apply filter.eventually_of_forall, intro, apply div_nonneg_of_nonneg_of_nonneg, repeat apply norm_nonneg},
    {apply filter.eventually_of_forall, intro y, rewrite H,
    apply mul_le_mul_of_nonneg_left,
    {show ∥g (x + y) - g x∥ / ∥y∥ ≤  ∥g (x + y) - g x - B y∥ / ∥y∥ + op_norm B, begin
      cases em (y = 0) with Heq Hneq,
      {rewrite [Heq, norm_zero, *div_zero, zero_add], apply le_of_lt, apply op_norm_pos},
      rewrite [div_add_eq_add_mul_div _ _ _ (norm_ne_zero_of_ne_zero Hneq)],
      apply div_le_div_of_le_of_nonneg,
      apply le.trans,
      rotate 1,
      apply add_le_add_left,
      apply op_norm_bound,
      apply norm_nonneg,
      rewrite [-neg_add_cancel_right (g (x + y) - g x) (B y) at {1}, -sub_eq_add_neg],
      apply norm_triangle
    end},
    {apply div_nonneg_of_nonneg_of_nonneg, repeat apply norm_nonneg}},
    -- now to show the bounding function vanishes. it is a product of a vanishing function and a convergent one
    apply mul_approaches_zero_of_approaches_zero_of_approaches,
    {have H' : (λ (y : U), ∥f (g (x + y)) - f (g x) - A (g (x + y) - g x)∥ / ∥g (x + y) - g x∥) =
            (λ (y : U), ∥f (g x + (g (x + y) - g x)) - f (g x) - A (g (x + y) - g x)∥ / ∥g (x + y) - g x∥),
      from funext (λ y, by rewrite [add.comm (g x), sub_add_cancel]), -- first, show lhs vanishes
    rewrite H',
    have Hgcts : continuous_at (λ y, g (x + y) - g x) 0, begin
      apply normed_vector_space.continuous_at_intro,
      intro ε Hε,
      cases normed_vector_space.continuous_at_dest (continuous_at_of_has_frechet_deriv_at g x Hg) _ Hε with δ Hδ,
      existsi δ,
      split,
      exact and.left Hδ,
      intro x' Hx',
      rewrite [add_zero, sub_self],
      rewrite sub_zero,
      apply and.right Hδ,
      have (x + x') - x = x' - 0, begin clear [Hg, Hf, Hf', Hg', H, H', Hδ, Hx'], simp end, -- (.6 seconds w/o clear, .1 with)
      rewrite this,
      apply Hx'
    end,
    have Hfcts : continuous_at (λ (x' : V), ∥f (g x + x') - f (g x) - A x'∥ / ∥x'∥) (g (x + 0) - g x), begin
      rewrite [add_zero, sub_self],
      apply diff_quot_cts,
      exact Hf
    end,
    have Heqz : ∥f (g x + (g (x + 0) - g x)) - f (g x) - A (g (x + 0) - g x)∥ / ∥g (x + 0) - g x∥ = 0,
      by rewrite [*add_zero, sub_self, norm_zero, div_zero],
    apply @tendsto_comp _ _ _ (λ y, g (x + y) - g x),
    apply tendsto_inf_left,
    apply tendsto_at_of_continuous_at Hgcts,
    note Hfcts' := tendsto_at_of_continuous_at Hfcts,
    rewrite Heqz at Hfcts',
    exact Hfcts'}, -- finally, show rhs converges to op_norm B
    {apply add_approaches,
    apply Hg,
    apply approaches_constant}}
  end

end comp

end analysis