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

universes u v u_1

namespace Mathlib

/-!
# Multiplication and division of submodules of an algebra.

An interface for multiplication and division of sub-R-modules of an R-algebra A is developed.

## Main definitions

Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra.

* `1 : submodule R A`       : the R-submodule R of the R-algebra A
* `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be
                              the smallest submodule containing all the products `m * n`.
* `has_div (submodule R A)` : `I / J` is defined to be the submodule consisting of all `a : A` such
                              that `a • J ⊆ I`

It is proved that `submodule R A` is a semiring, and also an algebra over `set A`.

## Tags

multiplication of submodules, division of subodules, submodule semiring
-/

namespace submodule

/-- `1 : submodule R A` is the submodule R of A. -/
protected instance has_one {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : HasOne (submodule R A) :=
  { one := map (alg_hom.to_linear_map (algebra.of_id R A)) ⊤ }

theorem one_eq_map_top {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : 1 = map (alg_hom.to_linear_map (algebra.of_id R A)) ⊤ :=
  rfl

theorem one_eq_span {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : 1 = span R (singleton 1) := sorry

theorem one_le {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {P : submodule R A} : 1 ≤ P ↔ 1 ∈ P := sorry

/-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the
smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/
protected instance has_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : Mul (submodule R A) :=
  { mul := fun (M N : submodule R A) => supr fun (s : ↥M) => map (coe_fn (algebra.lmul R A) (subtype.val s)) N }

theorem mul_mem_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {m : A} {n : A} (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N :=
  le_supr (fun (s : ↥M) => map (coe_fn (algebra.lmul R A) (subtype.val s)) N) { val := m, property := hm } (m * n)
    (Exists.intro n { left := hn, right := rfl })

theorem mul_le {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {P : submodule R A} : M * N ≤ P ↔ ∀ (m : A), m ∈ M → ∀ (n : A), n ∈ N → m * n ∈ P := sorry

protected theorem mul_induction_on {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {C : A → Prop} {r : A} (hr : r ∈ M * N) (hm : ∀ (m : A), m ∈ M → ∀ (n : A), n ∈ N → C (m * n)) (h0 : C 0) (ha : ∀ (x y : A), C x → C y → C (x + y)) (hs : ∀ (r : R) (x : A), C x → C (r • x)) : C r :=
  iff.mpr mul_le hm r hr

theorem span_mul_span (R : Type u) [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (S : set A) (T : set A) : span R S * span R T = span R (S * T) := sorry

protected theorem mul_assoc {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) (P : submodule R A) : M * N * P = M * (N * P) := sorry

@[simp] theorem mul_bot {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) : M * ⊥ = ⊥ := sorry

@[simp] theorem bot_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) : ⊥ * M = ⊥ := sorry

@[simp] protected theorem one_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) : 1 * M = M := sorry

@[simp] protected theorem mul_one {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) : M * 1 = M := sorry

theorem mul_le_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {P : submodule R A} {Q : submodule R A} (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q :=
  iff.mpr mul_le fun (m : A) (hm : m ∈ M) (n : A) (hn : n ∈ N) => mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {P : submodule R A} (h : M ≤ N) : M * P ≤ N * P :=
  mul_le_mul h (le_refl P)

theorem mul_le_mul_right {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {P : submodule R A} (h : N ≤ P) : M * N ≤ M * P :=
  mul_le_mul (le_refl M) h

theorem mul_sup {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) (P : submodule R A) : M * (N ⊔ P) = M * N ⊔ M * P := sorry

theorem sup_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) (P : submodule R A) : (M ⊔ N) * P = M * P ⊔ N * P := sorry

theorem mul_subset_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) : ↑M * ↑N ⊆ ↑(M * N) := sorry

theorem map_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) {A' : Type u_1} [semiring A'] [algebra R A'] (f : alg_hom R A A') : map (alg_hom.to_linear_map f) (M * N) = map (alg_hom.to_linear_map f) M * map (alg_hom.to_linear_map f) N := sorry

theorem mem_span_mul_finite_of_mem_span_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {S : set A} {S' : set A} {x : A} (hx : x ∈ span R (S * S')) : ∃ (T : finset A), ∃ (T' : finset A), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ x ∈ span R (↑T * ↑T') := sorry

theorem mem_span_mul_finite_of_mem_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {P : submodule R A} {Q : submodule R A} {x : A} (hx : x ∈ P * Q) : ∃ (T : finset A), ∃ (T' : finset A), ↑T ⊆ ↑P ∧ ↑T' ⊆ ↑Q ∧ x ∈ span R (↑T * ↑T') := sorry

/-- Sub-R-modules of an R-algebra form a semiring. -/
protected instance semiring {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : semiring (submodule R A) :=
  semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry Mul.mul submodule.mul_assoc 1
    submodule.one_mul submodule.mul_one bot_mul mul_bot mul_sup sup_mul

theorem pow_subset_pow {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] (M : submodule R A) {n : ℕ} : ↑M ^ n ⊆ ↑(M ^ n) := sorry

/-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets
on either side). -/
def span.ring_hom {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] : set.set_semiring A →+* submodule R A :=
  ring_hom.mk (span R) sorry sorry sorry sorry

theorem mul_mem_mul_rev {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {M : submodule R A} {N : submodule R A} {m : A} {n : A} (hm : m ∈ M) (hn : n ∈ N) : n * m ∈ M * N :=
  mul_comm m n ▸ mul_mem_mul hm hn

protected theorem mul_comm {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] (M : submodule R A) (N : submodule R A) : M * N = N * M :=
  le_antisymm (iff.mpr mul_le fun (r : A) (hrm : r ∈ M) (s : A) (hsn : s ∈ N) => mul_mem_mul_rev hsn hrm)
    (iff.mpr mul_le fun (r : A) (hrn : r ∈ N) (s : A) (hsm : s ∈ M) => mul_mem_mul_rev hsm hrn)

/-- Sub-R-modules of an R-algebra A form a semiring. -/
protected instance comm_semiring {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] : comm_semiring (submodule R A) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry submodule.mul_comm

/-- R-submodules of the R-algebra A are a module over `set A`. -/
protected instance semimodule_set (R : Type u) [comm_semiring R] (A : Type v) [comm_semiring A] [algebra R A] : semimodule (set.set_semiring A) (submodule R A) :=
  semimodule.mk sorry sorry

theorem smul_def {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {s : set.set_semiring A} {P : submodule R A} : s • P = span R s * P :=
  rfl

theorem smul_le_smul {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {s : set.set_semiring A} {t : set.set_semiring A} {M : submodule R A} {N : submodule R A} (h₁ : set.set_semiring.down s ≤ set.set_semiring.down t) (h₂ : M ≤ N) : s • M ≤ t • N :=
  mul_le_mul (span_mono h₁) h₂

theorem smul_singleton {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] (a : A) (M : submodule R A) : set.up (singleton a) • M = map (algebra.lmul_left R a) M := sorry

/-- The elements of `I / J` are the `x` such that `x • J ⊆ I`.

In fact, we define `x ∈ I / J` to be `∀ y ∈ J, x * y ∈ I` (see `mem_div_iff_forall_mul_mem`),
which is equivalent to `x • J ⊆ I` (see `mem_div_iff_smul_subset`), but nicer to use in proofs.

This is the general form of the ideal quotient, traditionally written $I : J$.
-/
protected instance has_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] : Div (submodule R A) :=
  { div := fun (I J : submodule R A) => mk (set_of fun (x : A) => ∀ (y : A), y ∈ J → x * y ∈ I) sorry sorry sorry }

theorem mem_div_iff_forall_mul_mem {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {x : A} {I : submodule R A} {J : submodule R A} : x ∈ I / J ↔ ∀ (y : A), y ∈ J → x * y ∈ I :=
  iff.refl (x ∈ I / J)

theorem mem_div_iff_smul_subset {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {x : A} {I : submodule R A} {J : submodule R A} : x ∈ I / J ↔ x • ↑J ⊆ ↑I := sorry

theorem le_div_iff {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {I : submodule R A} {J : submodule R A} {K : submodule R A} : I ≤ J / K ↔ ∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J :=
  iff.refl (I ≤ J / K)

theorem le_div_iff_mul_le {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {I : submodule R A} {J : submodule R A} {K : submodule R A} : I ≤ J / K ↔ I * K ≤ J :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ≤ J / K ↔ I * K ≤ J)) (propext le_div_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J) ↔ I * K ≤ J)) (propext mul_le)))
      (iff.refl (∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J)))

@[simp] theorem one_le_one_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {I : submodule R A} : 1 ≤ 1 / I ↔ I ≤ 1 := sorry

theorem le_self_mul_one_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {I : submodule R A} (hI : I ≤ 1) : I ≤ I * (1 / I) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ≤ I * (1 / I))) (Eq.symm (mul_one I))))
    (mul_le_mul_right (iff.mpr one_le_one_div hI))

theorem mul_one_div_le_one {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {I : submodule R A} : I * (1 / I) ≤ 1 := sorry

@[simp] theorem map_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A] {B : Type u_1} [comm_ring B] [algebra R B] (I : submodule R A) (J : submodule R A) (h : alg_equiv R A B) : map (alg_equiv.to_linear_map h) (I / J) = map (alg_equiv.to_linear_map h) I / map (alg_equiv.to_linear_map h) J := sorry


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div
import Init.Data.Nat.Bitwise
import Init.Coe

open Nat

namespace Fin

instance coeToNat {n} : Coe (Fin n) Nat :=
  ⟨fun v => v.val⟩

def elim0.{u} {α : Sort u} : Fin 0 → α
  | ⟨_, h⟩ => absurd h (notLtZero _)

variable {n : Nat}

protected def ofNat {n : Nat} (a : Nat) : Fin (succ n) :=
  ⟨a % succ n, Nat.mod_lt _ (Nat.zeroLtSucc _)⟩

protected def ofNat' {n : Nat} (a : Nat) (h : n > 0) : Fin n :=
  ⟨a % n, Nat.mod_lt _ h⟩

private theorem mlt {b : Nat} : {a : Nat} → a < n → b % n < n
  | 0,   h => Nat.mod_lt _ h
  | a+1, h =>
    have : n > 0 := Nat.ltTrans (Nat.zeroLtSucc _) h;
    Nat.mod_lt _ this

protected def add : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + b) % n, mlt h⟩

protected def mul : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a * b) % n, mlt h⟩

protected def sub : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + (n - b)) % n, mlt h⟩

/-
Remark: mod/div/modn/land/lor can be defined without using (% n), but
we are trying to minimize the number of Nat theorems
needed to boostrap Lean.
-/

protected def mod : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a % b) % n, mlt h⟩

protected def div : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a / b) % n, mlt h⟩

protected def modn : Fin n → Nat → Fin n
  | ⟨a, h⟩, m => ⟨(a % m) % n, mlt h⟩

def land : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.land a b) % n, mlt h⟩

def lor : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.lor a b) % n, mlt h⟩

def xor : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.xor a b) % n, mlt h⟩

def shiftLeft : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a <<< b) % n, mlt h⟩

def shiftRight : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a >>> b) % n, mlt h⟩

instance : Add (Fin n) where
  add := Fin.add

instance : Sub (Fin n) where
  sub := Fin.sub

instance : Mul (Fin n) where
  mul := Fin.mul

instance : Mod (Fin n) where
  mod := Fin.mod

instance : Div (Fin n) where
  div := Fin.div

instance : AndOp (Fin n) where
  and := Fin.land
instance : OrOp (Fin n) where
  or := Fin.lor
instance : Xor (Fin n) where
  xor := Fin.xor
instance : ShiftLeft (Fin n) where
  shiftLeft := Fin.shiftLeft
instance : ShiftRight (Fin n) where
  shiftRight := Fin.shiftRight

instance : HMod (Fin n) Nat (Fin n) where
  hMod := Fin.modn

instance : OfNat (Fin (no_index (n+1))) i where
  ofNat := Fin.ofNat i

theorem vneOfNe {i j : Fin n} (h : i ≠ j) : val i ≠ val j :=
  fun h' => absurd (eqOfVeq h') h

theorem modn_lt : ∀ {m : Nat} (i : Fin n), m > 0 → (i % m).val < m
  | m, ⟨a, h⟩, hp =>  Nat.ltOfLeOfLt (mod_le _ _) (mod_lt _ hp)

end Fin

open Fin


import tactic
import data.int.gcd
import data.int.basic
import data.int.modeq

lemma gcd_linear_combo_signs {m n : ℤ} (h_m_pos : m > 0) (h_n_pos : n > 0)
                            : (m.gcd_a n ≤ 0 ∧ m.gcd_b n > 0) ∨ (m.gcd_a n > 0 ∧ m.gcd_b n ≤ 0) :=
begin

  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,

  by_contra, push_neg at h,
  have m_ne_0 : m ≠ 0 := by linarith,
  have gcd_pos := int.gcd_pos_of_non_zero_left n m_ne_0,

  have hx : (x ≤ 0 ∨ x > 0) := le_or_lt x 0,
  cases hx with hx_nonpos hx_pos,
  { have hy_nonpos := h.1(hx_nonpos),
    have hmx : m * x ≤ 0 := linarith.mul_nonpos hx_nonpos h_m_pos,
    have hny : n * y ≤ 0 := linarith.mul_nonpos hy_nonpos h_n_pos,
    have h_combo : m * x + n * y ≤ 0 := add_nonpos hmx hny,
    rw ← hxy at h_combo,
    linarith,
  },
  {
    -- could simplify argument

    have hy_pos := h.2(hx_pos),
    have hy2 : y ≥ 1 := by linarith,
    have hx2 : x ≥ 1 := by linarith,

    have hcn : n * y ≥ n :=  (le_mul_iff_one_le_right h_n_pos).mpr hy2,
    have hcm : m * x ≥ m :=  (le_mul_iff_one_le_right h_m_pos).mpr hx2,

    have hcmn : m * x + n * y ≥ m + n := add_le_add hcm hcn,
    rw ← hxy at hcmn,
    have h_gcd_dvd := int.gcd_dvd_left m n,
    have g_gcd_le : ↑(m.gcd n) ≤ m := int.le_of_dvd h_m_pos h_gcd_dvd,

    have hm_lt_sum : m < m + n := lt_add_of_pos_right m h_n_pos,
    linarith,
  },
end

lemma fun_coe_lemma_l {m n x y : ℤ } (h_m_nonneg : m ≥ 0) (h_n_nonneg : n ≥ 0) (hl : x ≤ 0 ∧ y > 0) (h_xy_nonneg : m * x + n * y ≥ 0)
  : (m * x + n * y).to_nat + m.to_nat * (-x).to_nat = n.to_nat * y.to_nat :=
begin
  zify,
  have hy_nonneg : y ≥ 0 := by linarith,
  have hx_neg_nonneg : -x ≥ 0 := by linarith,
  have hx := int.to_nat_of_nonneg hx_neg_nonneg,
  have hy := int.to_nat_of_nonneg hy_nonneg,
  have hm := int.to_nat_of_nonneg h_m_nonneg,
  have hn := int.to_nat_of_nonneg h_n_nonneg,
  have h := int.to_nat_of_nonneg h_xy_nonneg,
  rw [hx, hm, hn, hy, h],
  linarith,
end

lemma fun_coe_lemma_r {m n x y : ℤ } (h_m_nonneg : m ≥ 0) (h_n_nonneg : n ≥ 0) (hr : x > 0 ∧ y ≤ 0) (h_xy_nonneg : m * x + n * y ≥ 0)
  : (m * x + n * y).to_nat + n.to_nat * (-y).to_nat = m.to_nat * x.to_nat :=
begin
  zify,
  have hx_nonneg : x ≥ 0 := by linarith,
  have hy_neg_nonneg : -y ≥ 0 := by linarith,
  have hy := int.to_nat_of_nonneg hy_neg_nonneg,
  have hx := int.to_nat_of_nonneg hx_nonneg,
  have hm := int.to_nat_of_nonneg h_m_nonneg,
  have hn := int.to_nat_of_nonneg h_n_nonneg,
  have h := int.to_nat_of_nonneg h_xy_nonneg,
  rw [hx, hm, hn, hy, h],
  linarith,
end

--have hc : (↑(m.gcd n) * e).to_nat = (m.gcd n) * e.to_nat :=  sorry,

lemma fun_coe_lemma2 (n : ℕ) (e : ℤ) (hn : n ≥ 0) (he : e ≥ 0) : ((↑n * e).to_nat) = n * e.to_nat :=
begin
  zify,
  have hc1 : ↑(e.to_nat) = e := int.to_nat_of_nonneg he,
  rw hc1,
  have hc2 : ↑n * e ≥ 0,
  {
    refine mul_nonneg _ _,
    exact int.coe_zero_le n,
    linarith,
  },
  have hc3 := int.to_nat_of_nonneg hc2,
  assumption,
end

lemma a_pow_gcd_modeq_one_signs_left ( a m n : ℤ) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0) (hl : m.gcd_a n ≤ 0 ∧ m.gcd_b n > 0)
      : 1 ≡ a^(m.gcd n) [ZMOD (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1))] :=
begin
  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  have hx : -x ≥ 0 := by linarith,

  have hd1 : ↑d ∣ a^m.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),

  have hd1_mod : 1 ≡ a^m.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd1,

  have hd1x : 1^(int.to_nat(-x)) ≡ (a^m.to_nat)^(int.to_nat(-x)) [ZMOD d] := int.modeq.pow (-x).to_nat hd1_mod,
  simp only [one_pow] at hd1x,
  rw ← pow_mul at hd1x,

  have hd2 : ↑d ∣ a^n.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  have hd2_mod : 1 ≡ a^n.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd2,

  have hd2y : 1^(int.to_nat(y)) ≡ (a^n.to_nat)^(int.to_nat(y)) [ZMOD d] := int.modeq.pow (y).to_nat hd2_mod,
  simp only [one_pow] at hd2y,
  rw ← pow_mul at hd2y,

  have hd2y_dvd : ↑d ∣ a ^ (n.to_nat * y.to_nat) - 1 := (int.modeq_iff_dvd).mp hd2y,
  have hd1x_dvd : ↑d ∣ a ^ (m.to_nat * (-x).to_nat) - 1 := (int.modeq_iff_dvd).mp hd1x,

  have hd1x_dvd_mul : ↑d ∣ (a^g) * (a ^ (m.to_nat * (-x).to_nat) - 1) := dvd_mul_of_dvd_right hd1x_dvd (a^g),

  rw mul_sub at hd1x_dvd_mul,
  rw ← pow_add at hd1x_dvd_mul,
  simp only [mul_one] at hd1x_dvd_mul,

  have h_m_nonneg : m ≥ 0 := by linarith,
  have h_n_nonneg : n ≥ 0 := by linarith,
  have h_xy_nonneg : m * x + n * y ≥ 0,
  {
    have hgcd2 : int.of_nat(g) ≥ 0 := int.of_nat_nonneg g,
    rw ← hxy,
    exact hgcd2,
  },

  have hg := fun_coe_lemma_l h_m_nonneg h_n_nonneg hl h_xy_nonneg,
  apply_fun int.to_nat at hxy,
  simp only [int.to_nat_coe_nat] at hxy,
  rw ← hxy at hg,

  have hd1x_dvd_mul_neg : ↑d ∣ -(a ^ (g + m.to_nat * (-x).to_nat) - a ^ g) := (dvd_neg ↑d (a ^ (g + int.to_nat m * (-x).to_nat) - a ^ g)).mpr hd1x_dvd_mul,
  simp only [neg_sub] at hd1x_dvd_mul_neg,
  rw hg at hd1x_dvd_mul_neg,
  have hd3 : ↑d ∣ (a ^ g - a ^ (n.to_nat * y.to_nat)) + (a ^ (n.to_nat * y.to_nat) - 1) := dvd_add hd1x_dvd_mul_neg hd2y_dvd,
  simp only [sub_add_sub_cancel] at hd3,
  exact int.modeq_of_dvd hd3,

end

lemma a_pow_gcd_modeq_one_signs_right ( a m n : ℤ) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0) (hr : m.gcd_a n > 0 ∧ m.gcd_b n ≤ 0)
      : 1 ≡ a^(m.gcd n) [ZMOD (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1))] :=
begin
  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  have hx : -y ≥ 0 := by linarith,

  have hd1 : ↑d ∣ a^n.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  have hd1_mod : 1 ≡ a^n.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd1,

  have hd1y : 1^(int.to_nat(-y)) ≡ (a^n.to_nat)^(int.to_nat(-y)) [ZMOD d] := int.modeq.pow (-y).to_nat hd1_mod,
  simp only [one_pow] at hd1y,
  rw ← pow_mul at hd1y,

  have hd2 : ↑d ∣ a^m.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),
  have hd2_mod : 1 ≡ a^m.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd2,

  have hd2x : 1^(int.to_nat(x)) ≡ (a^m.to_nat)^(int.to_nat(x)) [ZMOD d] := int.modeq.pow (x).to_nat hd2_mod,
  simp only [one_pow] at hd2x,
  rw ← pow_mul at hd2x,

  have hd2x_dvd : ↑d ∣ a ^ (m.to_nat * x.to_nat) - 1 := (int.modeq_iff_dvd).mp hd2x,
  have hd1y_dvd : ↑d ∣ a ^ (n.to_nat * (-y).to_nat) - 1 := (int.modeq_iff_dvd).mp hd1y,

  have hd1y_dvd_mul : ↑d ∣ (a^g) * (a ^ (n.to_nat * (-y).to_nat) - 1) := dvd_mul_of_dvd_right hd1y_dvd (a^g),

  rw mul_sub at hd1y_dvd_mul,
  rw ← pow_add at hd1y_dvd_mul,
  simp only [mul_one] at hd1y_dvd_mul,

  have h_m_nonneg : m ≥ 0 := by linarith,
  have h_n_nonneg : n ≥ 0 := by linarith,
  have h_xy_nonneg : m * x + n * y ≥ 0,
  {
    have hgcd2 : int.of_nat(g) ≥ 0 := int.of_nat_nonneg g,
    rw ← hxy,
    exact hgcd2,
  },

  have hg := fun_coe_lemma_r h_m_nonneg h_n_nonneg hr h_xy_nonneg,
  apply_fun int.to_nat at hxy,
  simp only [int.to_nat_coe_nat] at hxy,
  rw ← hxy at hg,

  have hd1y_dvd_mul_neg : ↑d ∣ -(a ^ (g + n.to_nat * (-y).to_nat) - a ^ g) := (dvd_neg ↑d (a ^ (g + int.to_nat n * (-y).to_nat) - a ^ g)).mpr hd1y_dvd_mul,
  simp only [neg_sub] at hd1y_dvd_mul_neg,
  rw hg at hd1y_dvd_mul_neg,
  have hd3 : ↑d ∣ (a ^ g - a ^ (m.to_nat * x.to_nat)) + (a^ (m.to_nat * x.to_nat) - 1) := dvd_add hd1y_dvd_mul_neg hd2x_dvd,
  simp only [sub_add_sub_cancel] at hd3,
  exact int.modeq_of_dvd hd3,

end

lemma h_a_pow {a : ℤ} (h_a_pos : a > 0) (n : ℕ) : 1 ≤ a^n :=
begin
  have ha : a ≥ 1 := by linarith,
  exact one_le_pow_of_one_le ha n,
end

lemma gcd_pow {a m n : ℤ} (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
              : 1 ≡ a^((int.gcd m n)) [ZMOD (int.gcd (a^(m.to_nat) - 1) (a^(n.to_nat) - 1))] :=
begin
  -- g = gcd(m n); g = mx + ny; wlog y ≤ 0
  -- d = gcd(a^m - 1, a^n -1)
  -- d ∣ a^(mx) - 1 ; d ∣ a^(-ny) - 1 ; d ∣ -a^g (a^-ny - 1)
  -- d ∣ -a^g (a^-ny - 1) + a^(mx) - 1
  -- d ∣ a^g - a^(g-ny) + a^(mx) - 1 = a^g - 1

  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  cases h_xy_signs with hl hr,
  {
    exact a_pow_gcd_modeq_one_signs_left a m n h_a_pos h_m_pos h_n_pos hl,
  },
  {
    exact a_pow_gcd_modeq_one_signs_right a m n h_a_pos h_m_pos h_n_pos hr,
  }

end

lemma left_dvd_right (a m n : ℤ) (ha : a ≠ 1) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
                    : ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)) ∣  ( a^(int.gcd m n) - 1 ) :=

begin
  set d := ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have hd1 : d ∣ (a^m.to_nat - 1) := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),
  have hd2 : d ∣ (a^n.to_nat - 1) := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  rw ← int.modeq_iff_dvd at hd1,
  rw ← int.modeq_iff_dvd at hd2,
  {

    have h_gcd_pow := gcd_pow h_a_pos h_m_pos h_n_pos,

    have hk : 1 ≤ a ^ m.gcd n := h_a_pow h_a_pos (m.gcd n),
    exact int.modeq.dvd h_gcd_pow,
  },
end

lemma useful_lemma (a d e : ℤ) (h_a_pos : a > 0) : ((a^d.to_nat)^e.to_nat - 1 ≡ 0 [ZMOD a^d.to_nat - 1]) :=
begin
  have h1 : a^d.to_nat ≡ 1 [ZMOD a^d.to_nat - 1],
  {
    have hr : a^d.to_nat - 1 ∣ a^d.to_nat - 1 := dvd_rfl,
    have hz := int.modeq_zero_iff_dvd.mpr hr,
    have hr : 1 ≡ 1 [ZMOD a^d.to_nat - 1]  := int.modeq.rfl,
    have hzr : (a ^ d.to_nat - 1) + 1 ≡ 0 + 1 [ZMOD a ^ d.to_nat - 1] := int.modeq.add hz hr,
    have hl : a^d.to_nat = a^d.to_nat - 1 + 1,

    { have h_ad_pos : a^d.to_nat > 0 := pow_pos h_a_pos (int.to_nat d),
      linarith,
    },
    rwa [← hl, zero_add] at hzr,
  },
  have h2 : (a^d.to_nat)^e.to_nat ≡ 1 [ZMOD a^d.to_nat - 1],
  {
    have hp := int.modeq.pow e.to_nat h1,
    rwa one_pow e.to_nat at hp,
  },
  have hge1 : (a ^ d.to_nat) ^ e.to_nat ≥ 1,
  {
    rw ← pow_mul,
    exact h_a_pow h_a_pos (int.to_nat d * int.to_nat e),
  },
  suffices h : ((a ^ d.to_nat) ^ e.to_nat) - 1 + 1 ≡ 0 + 1 [ZMOD a ^ d.to_nat - 1],
  exact int.modeq.add_right_cancel' 1 h,
  simp,

  have h_ade_pos : (a^d.to_nat)^e.to_nat > 0 := pow_pos (pow_pos h_a_pos d.to_nat) e.to_nat,
  assumption,

end

lemma dvd_prod {d a k : ℕ} (hd : d ∣ a) : (d ∣ k * a) :=
begin
  exact dvd_mul_of_dvd_right hd k,
end

/-

proof based on:

https://math.stackexchange.com/questions/11567/gcdbx-1-by-1-b-z-1-dots-b-gcdx-y-z-dots-1

-/

theorem gcd_pows_minus_one (a m n : ℤ) (ha : a ≠ 1) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
                        : ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)) = a^(int.gcd m n) - 1 :=
begin

have left_dvd_right := left_dvd_right a m n ha h_a_pos h_m_pos h_n_pos,
have right_dvd_left : a^(int.gcd m n) - 1 ∣ ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
{
  have h1 : ↑(int.gcd m n) ∣ n := int.gcd_dvd_right m n,
  have h2 : ↑(int.gcd m n) ∣ m := int.gcd_dvd_left m n,

  have h1_d := dvd_iff_exists_eq_mul_left.mp h1,
  have h2_d := dvd_iff_exists_eq_mul_left.mp h2,

  cases h1_d with e he,
  cases h2_d with f hf,

  have h_gcd_nonneg : m.gcd n ≥ 0 := zero_le (int.gcd m n),
  have h_gcd_nonneg' : ↑(m.gcd n) ≥ 0 := zero_le ↑(int.gcd m n),

  have h_e_nonneg : e ≥ 0,
  {
    by_contra, push_neg at h,
    have he2 : e * ↑(m.gcd n) ≤ 0 * ↑(m.gcd n) := by nlinarith,
    simp only [zero_mul] at he2,
    rw ← he at he2,
    linarith,
  },

  have h_f_nonneg : f ≥ 0,
  {
    by_contra, push_neg at h,
    have hf2 : f * ↑(m.gcd n) ≤ 0 * ↑(m.gcd n),
    {
      nlinarith,
    },
    simp only [zero_mul] at hf2,
    rw ← hf at hf2,
    linarith,
  },

  have h3 : a^n.to_nat - 1 = (a^(m.gcd n))^e.to_nat - 1,
  {
    nth_rewrite 0 he,
    rw mul_comm e (m.gcd n),
    suffices h : a ^ ((↑(m.gcd n) * e).to_nat) = (a ^ m.gcd n) ^ e.to_nat,
    rw h,

    --(n : ℕ) (e : ℤ) (hn : n ≥ 0) (he : e ≥ 0)

    have hc : (↑(m.gcd n) * e).to_nat = (m.gcd n) * e.to_nat := fun_coe_lemma2 (m.gcd n) e h_gcd_nonneg h_e_nonneg,
    rw hc,
    exact pow_mul a (int.gcd m n) e.to_nat,
  },
  have h4 : a^m.to_nat - 1 = (a^(m.gcd n))^f.to_nat - 1,
  {nth_rewrite 0 hf,
    rw mul_comm f (m.gcd n),
    suffices h : a ^ ((m.gcd n) * f.to_nat) = (a ^ m.gcd n) ^ f.to_nat,
    have hc : (↑(m.gcd n) * f).to_nat = (m.gcd n) * f.to_nat := fun_coe_lemma2 (m.gcd n) f h_gcd_nonneg h_f_nonneg,
    rw hc,
    simp only [sub_left_inj],
    exact pow_mul a (int.gcd m n) f.to_nat,
    exact pow_mul a (int.gcd m n) f.to_nat,
    },

  have h5 := int.modeq.symm( useful_lemma a (m.gcd n) e h_a_pos),
  have h6 := int.modeq.symm( useful_lemma a (m.gcd n) f h_a_pos),

  have hgcd: 0 ≤ m.gcd n := zero_le (int.gcd m n),
  simp at h5,
  simp at h6,

  rw ← h3 at h5,
  rw ← h4 at h6,

  rw int.modeq_iff_dvd at h5, simp only [sub_zero] at h5,
  rw int.modeq_iff_dvd at h6, simp only [sub_zero] at h6,
  exact int.dvd_gcd h6 h5,

},

have h_left_nonneg := int.coe_zero_le ((a ^ int.to_nat m - 1).gcd (a ^ int.to_nat n - 1)),
have h_right_nonneg1 := h_a_pow h_a_pos (int.gcd m n),
have h_right_nonneg : 0 ≤ (a^(int.gcd m n) - 1) := by linarith,

exact int.dvd_antisymm h_left_nonneg h_right_nonneg left_dvd_right right_dvd_left,

end


abbrev Zero α := OfNat α (nat_lit 0)

class Monoid (α : Type u) [Zero α] extends Add α where
  zero_add (a : α) : 0 + a = a
  add_zero (a : α) : a + 0 = a

attribute [simp] Monoid.zero_add Monoid.add_zero

variable {α : Type u} [Zero α] [Monoid α]

-- works
example (a : α) : 0 + a = a := by simp

example (a : α) : a + 0 = a := by simp


import tactic

/-
# Level 5 : Proving disjunctions
-/

namespace math3345 -- hide

/-
P and Q are propositions.
-/

variable P : Prop
variable Q : Prop

/- Lemma : no-side-bar

`h` is evidence that `(P ∧ Q)` so we can again extract evidence for
`P` by using `h.left` and extract evidence for `Q` with `h.right`.

To prove a disjunction, we use the tactics `left` or `right` to
replace the goal with the left-hand (or right-hand) side of the
disjunction.

So start with `left` or `right` to replace the goal with either `P` or
`Q`, and then finish the proof with `exact` followed by something.

-/
lemma using_disjunction (h : (P ∧ Q)) : (P ∨ Q) :=
begin
  sorry,

end

end math3345 -- hide


/-
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

! This file was ported from Lean 3 source module number_theory.pythagorean_triples
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Field.Basic
import Mathlib.RingTheory.Int.Basic
import Mathlib.Tactic.Ring
import Mathlib.Tactic.FieldSimp
import Mathlib.Data.Int.NatPrime
import Mathlib.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.
-/

theorem sq_ne_two_fin_zmod_four (z : ZMod 4) : z * z ≠ 2 := by
  change Fin 4 at z
  fin_cases z <;> norm_num [Fin.ext_iff, Fin.val_bit0, Fin.val_bit1]
#align sq_ne_two_fin_zmod_four sq_ne_two_fin_zmod_four

theorem Int.sq_ne_two_mod_four (z : ℤ) : z * z % 4 ≠ 2 := by
  suffices ¬z * z % (4 : ℕ) = 2 % (4 : ℕ) by exact this
  rw [← ZMod.int_cast_eq_int_cast_iff']
  simpa using sq_ne_two_fin_zmod_four _
#align int.sq_ne_two_mod_four Int.sq_ne_two_mod_four

noncomputable section

open Classical

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

/-- Pythagorean triples are interchangable, i.e `x * x + y * y = y * y + x * x = z * z`.
This comes from additive commutativity. -/
theorem pythagoreanTriple_comm {x y z : ℤ} : PythagoreanTriple x y z ↔ PythagoreanTriple y x z := by
  delta PythagoreanTriple
  rw [add_comm]
#align pythagorean_triple_comm pythagoreanTriple_comm

/-- The zeroth Pythagorean triple is all zeros. -/
theorem PythagoreanTriple.zero : PythagoreanTriple 0 0 0 := by
  simp only [PythagoreanTriple, MulZeroClass.zero_mul, zero_add]
#align pythagorean_triple.zero PythagoreanTriple.zero

namespace PythagoreanTriple

variable {x y z : ℤ} (h : PythagoreanTriple x y z)

theorem eq : x * x + y * y = z * z :=
  h
#align pythagorean_triple.eq PythagoreanTriple.eq

@[symm]
theorem symm : PythagoreanTriple y x z := by rwa [pythagoreanTriple_comm]
#align pythagorean_triple.symm PythagoreanTriple.symm

/-- A triple is still a triple if you multiply `x`, `y` and `z`
by a constant `k`. -/
theorem mul (k : ℤ) : PythagoreanTriple (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

#align pythagorean_triple.mul PythagoreanTriple.mul

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

/-- 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 unusedArguments]
def IsClassified (_ : PythagoreanTriple 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)) ∧
      Int.gcd m n = 1
#align pythagorean_triple.is_classified PythagoreanTriple.IsClassified

/-- 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 unusedArguments]
def IsPrimitiveClassified (_ : PythagoreanTriple x y z) :=
  ∃ 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)
#align pythagorean_triple.is_primitive_classified PythagoreanTriple.IsPrimitiveClassified

theorem mul_isClassified (k : ℤ) (hc : h.IsClassified) : (h.mul k).IsClassified := by
  obtain ⟨l, m, n, ⟨⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, co⟩⟩ := hc
  · use k * l, m, n
    apply And.intro _ co
    left
    constructor <;> ring
  · use k * l, m, n
    apply And.intro _ co
    right
    constructor <;> ring
#align pythagorean_triple.mul_is_classified PythagoreanTriple.mul_isClassified

theorem even_odd_of_coprime (hc : Int.gcd x y = 1) :
    x % 2 = 0 ∧ y % 2 = 1 ∨ x % 2 = 1 ∧ y % 2 = 0 := by
  cases' Int.emod_two_eq_zero_or_one x with hx hx <;>
    cases' Int.emod_two_eq_zero_or_one y with hy hy
  -- x even, y even
  · exfalso
    apply Nat.not_coprime_of_dvd_of_dvd (by decide : 1 < 2) _ _ hc
    · apply Int.dvd_natAbs_of_ofNat_dvd
      apply Int.dvd_of_emod_eq_zero hx
    · apply Int.dvd_natAbs_of_ofNat_dvd
      apply Int.dvd_of_emod_eq_zero hy
  -- x even, y odd
  · left
    exact ⟨hx, hy⟩
  -- x odd, y even
  · right
    exact ⟨hx, hy⟩
  -- x odd, y odd
  · exfalso
    obtain ⟨x0, y0, rfl, rfl⟩ : ∃ x0 y0, x = x0 * 2 + 1 ∧ y = y0 * 2 + 1 := by
      cases' exists_eq_mul_left_of_dvd (Int.dvd_sub_of_emod_eq hx) with x0 hx2
      cases' exists_eq_mul_left_of_dvd (Int.dvd_sub_of_emod_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]
    field_simp [Int.add_emod] -- Porting note: norm_num is not enough to close this
#align pythagorean_triple.even_odd_of_coprime PythagoreanTriple.even_odd_of_coprime

theorem gcd_dvd : (Int.gcd x y : ℤ) ∣ z := by
  by_cases h0 : Int.gcd x y = 0
  · have hx : x = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_left h0
    have hy : y = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_right h0
    have hz : z = 0 := by
      simpa only [PythagoreanTriple, hx, hy, add_zero, zero_eq_mul, MulZeroClass.mul_zero,
        or_self_iff] using h
    simp only [hz, dvd_zero]
  obtain ⟨k, x0, y0, _, 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.natAbs_ofNat, 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 _ _
#align pythagorean_triple.gcd_dvd PythagoreanTriple.gcd_dvd

theorem normalize : PythagoreanTriple (x / Int.gcd x y) (y / Int.gcd x y) (z / Int.gcd x y) := by
  by_cases h0 : Int.gcd x y = 0
  · have hx : x = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_left h0
    have hy : y = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_right h0
    have hz : z = 0 := by
      simpa only [PythagoreanTriple, hx, hy, add_zero, zero_eq_mul, MulZeroClass.mul_zero,
        or_self_iff] 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 := by
    norm_cast
    rwa [pos_iff_ne_zero] at k0
  rw [Int.gcd_mul_right, h2, Int.natAbs_ofNat, one_mul] at h⊢
  rw [mul_comm x0, mul_comm y0, mul_iff k hk] at h
  rwa [Int.mul_ediv_cancel _ hk, Int.mul_ediv_cancel _ hk, Int.mul_ediv_cancel_left _ hk]
#align pythagorean_triple.normalize PythagoreanTriple.normalize

theorem isClassified_of_isPrimitiveClassified (hp : h.IsPrimitiveClassified) : h.IsClassified := by
  obtain ⟨m, n, H⟩ := hp
  use 1, m, n
  rcases H with ⟨t, co, _⟩
  rw [one_mul, one_mul]
  exact ⟨t, co⟩
#align pythagorean_triple.is_classified_of_is_primitive_classified PythagoreanTriple.isClassified_of_isPrimitiveClassified

theorem isClassified_of_normalize_isPrimitiveClassified (hc : h.normalize.IsPrimitiveClassified) :
    h.IsClassified := by
  convert h.normalize.mul_isClassified (Int.gcd x y)
        (isClassified_of_isPrimitiveClassified h.normalize hc) <;>
    rw [Int.mul_ediv_cancel']
  · exact Int.gcd_dvd_left x y
  · exact Int.gcd_dvd_right x y
  · exact h.gcd_dvd
#align pythagorean_triple.is_classified_of_normalize_is_primitive_classified PythagoreanTriple.isClassified_of_normalize_isPrimitiveClassified

theorem isPrimitiveClassified_of_coprime_of_zero_left (hc : Int.gcd x y = 1) (hx : x = 0) :
    h.IsPrimitiveClassified := by
  subst x
  change Nat.gcd 0 (Int.natAbs y) = 1 at hc
  rw [Nat.gcd_zero_left (Int.natAbs y)] at hc
  cases' Int.natAbs_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
#align pythagorean_triple.is_primitive_classified_of_coprime_of_zero_left PythagoreanTriple.isPrimitiveClassified_of_coprime_of_zero_left

theorem coprime_of_coprime (hc : Int.gcd x y = 1) : Int.gcd y z = 1 := by
  by_contra 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_natAbs_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 _)
#align pythagorean_triple.coprime_of_coprime PythagoreanTriple.coprime_of_coprime

end PythagoreanTriple

section circleEquivGen

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

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

variable {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 circleEquivGen (hk : ∀ x : K, 1 + x ^ 2 ≠ 0) :
    K ≃ { p : K × K // p.1 ^ 2 + p.2 ^ 2 = 1 ∧ p.2 ≠ -1 } where
  toFun x :=
    ⟨⟨2 * x / (1 + x ^ 2), (1 - x ^ 2) / (1 + x ^ 2)⟩, by
      field_simp [hk x, div_pow]
      ring, by
      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⟩
  invFun p := (p : K × K).1 / ((p : K × K).2 + 1)
  left_inv x := by
    have h2 : (1 + 1 : K) = 2 := by norm_num -- Porting note: rfl is not enough to close this
    have h3 : (2 : K) ≠ 0 := by
      convert hk 1
      rw [one_pow 2, h2]
    field_simp [hk x, h2, add_assoc, add_comm, add_sub_cancel'_right, mul_comm]
  right_inv := fun ⟨⟨x, y⟩, hxy, hy⟩ => by
    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) := by
      rw [(add_neg_eq_iff_eq_add.mpr hxy.symm).symm]
      ring
    have h4 : (2 : K) ≠ 0 := by
      convert hk 1
      rw [one_pow 2]
      ring -- Porting note: rfl is not enough to close this
    simp only [Prod.mk.inj_iff, Subtype.mk_eq_mk]
    constructor
    · field_simp [h3]
      ring
    · field_simp [h3]
      rw [← add_neg_eq_iff_eq_add.mpr hxy.symm]
      ring
#align circle_equiv_gen circleEquivGen

@[simp]
theorem circleEquivGen_apply (hk : ∀ x : K, 1 + x ^ 2 ≠ 0) (x : K) :
    (circleEquivGen hk x : K × K) = ⟨2 * x / (1 + x ^ 2), (1 - x ^ 2) / (1 + x ^ 2)⟩ :=
  rfl
#align circle_equiv_apply circleEquivGen_apply

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

end circleEquivGen

private theorem 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 := by
  by_contra 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 := by
    convert dvd_add hp2 hp1 using 1
    ring
  have h2n : (p : ℤ) ∣ 2 * n ^ 2 := by
    convert dvd_sub hp2 hp1 using 1
    ring
  have hmc : p = 2 ∨ p ∣ Int.natAbs m := prime_two_or_dvd_of_dvd_two_mul_pow_self_two hp h2m
  have hnc : p = 2 ∨ p ∣ Int.natAbs n := prime_two_or_dvd_of_dvd_two_mul_pow_self_two hp h2n
  by_cases h2 : p = 2
  -- Porting note: norm_num is not enough to close h3
  · have h3 : (m ^ 2 + n ^ 2) % 2 = 1 := by field_simp [sq, Int.add_emod, Int.mul_emod, hm, hn]
    have h4 : (m ^ 2 + n ^ 2) % 2 = 0 := by
      apply Int.emod_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)

private theorem 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 := by
  rw [Int.gcd, ← Int.natAbs_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]

private theorem 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 := by
  by_contra 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 := by
    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.natAbs_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.emod_eq_zero_of_dvd
      -- Porting note: norm_num is not enough to close this
      field_simp [sq, Int.sub_emod, Int.mul_emod, hm, hn]
    apply mt (Int.dvd_gcd (Int.coe_nat_dvd_left.mpr hpm)) hnp
    apply (or_self_iff _).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_iff _).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

private theorem 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 := by
  rw [Int.gcd, ← Int.natAbs_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]

private theorem 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 := by
  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

private theorem 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 := by
  cases' exists_eq_mul_left_of_dvd (Int.dvd_sub_of_emod_eq hm) with m0 hm2
  cases' exists_eq_mul_left_of_dvd (Int.dvd_sub_of_emod_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
  have h2 : (m0 * 2 + 1) ^ 2 - (n0 * 2 + 1) ^ 2 = 2 * (2 * (m0 ^ 2 - n0 ^ 2 + m0 - n0)) := by ring
  have h3 : ((m0 * 2 + 1) ^ 2 - (n0 * 2 + 1) ^ 2) / 2 % 2 = 0 := by
    rw [h2, Int.mul_ediv_cancel_left, Int.mul_emod_right]
    exact by decide
  refine' ⟨⟨_, h1⟩, ⟨_, h2⟩, h3, _⟩
  have h20 : (2 : ℤ) ≠ 0 := by decide
  rw [h1, h2, Int.mul_ediv_cancel_left _ h20, Int.mul_ediv_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_natAbs_of_coe_dvd_sq hp
    convert dvd_add hp1 hp2
    ring
  · apply Int.Prime.dvd_natAbs_of_coe_dvd_sq hp
    convert dvd_sub hp2 hp1
    ring

namespace PythagoreanTriple

variable {x y z : ℤ} (h : PythagoreanTriple x y z)

theorem isPrimitiveClassified_aux (hc : x.gcd y = 1) (hzpos : 0 < z) {m n : ℤ}
    (hm2n2 : 0 < m ^ 2 + n ^ 2) (hv2 : (x : ℚ) / z = 2 * m * n / ((m : ℚ) ^ 2 + (n : ℚ) ^ 2))
    (hw2 : (y : ℚ) / z = ((m : ℚ) ^ 2 - (n : ℚ) ^ 2) / ((m : ℚ) ^ 2 + (n : ℚ) ^ 2))
    (H : Int.gcd (m ^ 2 - n ^ 2) (m ^ 2 + n ^ 2) = 1) (co : Int.gcd m n = 1)
    (pp : m % 2 = 0 ∧ n % 2 = 1 ∨ m % 2 = 1 ∧ n % 2 = 0) : h.IsPrimitiveClassified := by
  have hz : z ≠ 0
  apply ne_of_gt hzpos
  have h2 : y = m ^ 2 - n ^ 2 ∧ z = m ^ 2 + n ^ 2 := by
    apply Rat.div_int_inj hzpos hm2n2 (h.coprime_of_coprime hc) H
    rw [hw2]
    norm_cast
  use m, n
  apply And.intro _ (And.intro co pp)
  right
  refine' ⟨_, h2.left⟩
  rw [← Rat.coe_int_inj _ _, ← div_left_inj' ((mt (Rat.coe_int_inj z 0).mp) hz), hv2, h2.right]
  norm_cast
#align pythagorean_triple.is_primitive_classified_aux PythagoreanTriple.isPrimitiveClassified_aux

theorem isPrimitiveClassified_of_coprime_of_odd_of_pos (hc : Int.gcd x y = 1) (hyo : y % 2 = 1)
    (hzpos : 0 < z) : h.IsPrimitiveClassified := by
  by_cases h0 : x = 0
  · exact h.isPrimitiveClassified_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 := by
    field_simp [hz, sq]
    norm_cast
  have hvz : v ≠ 0 := by
    field_simp [hz]
    exact h0
  have hw1 : w ≠ -1 := by
    contrapose! hvz with hw1
    -- porting note: `contrapose` unfolds local names, refold them
    replace hw1 : w = -1 := hw1; show v = 0
    rw [hw1, neg_sq, one_pow, add_left_eq_self] at hq
    exact pow_eq_zero hq
  have hQ : ∀ x : ℚ, 1 + x ^ 2 ≠ 0 := by
    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 := (circleEquivGen hQ).symm ⟨⟨v, w⟩, hp⟩
  have ht4 : v = 2 * q / (1 + q ^ 2) ∧ w = (1 - q ^ 2) / (1 + q ^ 2) := by
    apply Prod.mk.inj
    have := ((circleEquivGen hQ).apply_symm_apply ⟨⟨v, w⟩, hp⟩).symm
    exact congr_arg Subtype.val this
  let m := (q.den : ℤ)
  let n := q.num
  have hm0 : m ≠ 0 := by
    norm_cast
    apply Rat.den_nz q
  have hq2 : q = n / m := (Rat.num_div_den q).symm
  have hm2n2 : 0 < m ^ 2 + n ^ 2 := by
    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 hm2n20 : (m : ℚ) ^ 2 + (n : ℚ) ^ 2 ≠ 0 := by
    norm_cast
    simpa only [Int.coe_nat_pow] using ne_of_gt hm2n2
  have hx1 {j k : ℚ} (h₁ : k ≠ 0) (h₂ : k ^ 2 + j ^ 2 ≠ 0) :
      (1 - (j / k) ^ 2) / (1 + (j / k) ^ 2) = (k ^ 2 - j ^ 2) / (k ^ 2 + j ^ 2) :=
    by field_simp
  have hw2 : w = ((m : ℚ) ^ 2 - (n : ℚ) ^ 2) / ((m : ℚ) ^ 2 + (n : ℚ) ^ 2) := by
    calc
      w = (1 - q ^ 2) / (1 + q ^ 2) := by apply ht4.2
      _ = (1 - (↑n / ↑m) ^ 2) / (1 + (↑n / ↑m) ^ 2) := by rw [hq2]
      _ = _ := by exact hx1 (Int.cast_ne_zero.mpr hm0) hm2n20
  have hx2 {j k : ℚ} (h₁ : k ≠ 0) (h₂ : k ^ 2 + j ^ 2 ≠ 0) :
      2 * (j / k) / (1 + (j / k) ^ 2) = 2 * k * j / (k ^ 2 + j ^ 2) :=
    have h₃ : k * (k ^ 2 + j ^ 2) ≠ 0 := mul_ne_zero h₁ h₂
    by field_simp; ring
  have hv2 : v = 2 * m * n / ((m : ℚ) ^ 2 + (n : ℚ) ^ 2) := by
    calc
      v = 2 * q / (1 + q ^ 2) := by apply ht4.1
      _ = 2 * (n / m) / (1 + (↑n / ↑m) ^ 2) := by rw [hq2]
      _ = _ := by exact hx2 (Int.cast_ne_zero.mpr hm0) hm2n20
  have hnmcp : Int.gcd n m = 1 := q.reduced
  have hmncp : Int.gcd m n = 1 := by
    rw [Int.gcd_comm]
    exact hnmcp
  cases' Int.emod_two_eq_zero_or_one m with hm2 hm2 <;>
    cases' Int.emod_two_eq_zero_or_one n with hn2 hn2
  · -- m even, n even
    exfalso
    have h1 : 2 ∣ (Int.gcd n m : ℤ) :=
      Int.dvd_gcd (Int.dvd_of_emod_eq_zero hn2) (Int.dvd_of_emod_eq_zero hm2)
    rw [hnmcp] at h1
    revert h1
    norm_num
  · -- m even, n odd
    apply h.isPrimitiveClassified_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.isPrimitiveClassified_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 :=
      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 := by
      apply Rat.div_int_inj hzpos _ (h.coprime_of_coprime hc) h1.2.2.2
      · show w = _
        rw [← Rat.divInt_eq_div, ← Rat.divInt_mul_right (by norm_num : (2 : ℤ) ≠ 0)]
        rw [Int.ediv_mul_cancel h1.1, Int.ediv_mul_cancel h1.2.1, hw2]
        norm_cast
      · apply (mul_lt_mul_right (by norm_num : 0 < (2 : ℤ))).mp
        rw [Int.ediv_mul_cancel h1.1, MulZeroClass.zero_mul]
        exact hm2n2
    rw [h2.1, h1.2.2.1] at hyo
    revert hyo
    norm_num
#align pythagorean_triple.is_primitive_classified_of_coprime_of_odd_of_pos PythagoreanTriple.isPrimitiveClassified_of_coprime_of_odd_of_pos

theorem isPrimitiveClassified_of_coprime_of_pos (hc : Int.gcd x y = 1) (hzpos : 0 < z) :
    h.IsPrimitiveClassified := by
  cases' h.even_odd_of_coprime hc with h1 h2
  · exact h.isPrimitiveClassified_of_coprime_of_odd_of_pos hc h1.right hzpos
  rw [Int.gcd_comm] at hc
  obtain ⟨m, n, H⟩ := h.symm.isPrimitiveClassified_of_coprime_of_odd_of_pos hc h2.left hzpos
  use m, n; tauto
#align pythagorean_triple.is_primitive_classified_of_coprime_of_pos PythagoreanTriple.isPrimitiveClassified_of_coprime_of_pos

theorem isPrimitiveClassified_of_coprime (hc : Int.gcd x y = 1) : h.IsPrimitiveClassified := by
  by_cases hz : 0 < z
  · exact h.isPrimitiveClassified_of_coprime_of_pos hc hz
  have h' : PythagoreanTriple x y (-z) := by simpa [PythagoreanTriple, neg_mul_neg] using h.eq
  apply h'.isPrimitiveClassified_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)
#align pythagorean_triple.is_primitive_classified_of_coprime PythagoreanTriple.isPrimitiveClassified_of_coprime

theorem classified : h.IsClassified := by
  by_cases h0 : Int.gcd x y = 0
  · have hx : x = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_left h0
    have hy : y = 0 := by
      apply Int.natAbs_eq_zero.mp
      apply Nat.eq_zero_of_gcd_eq_zero_right h0
    use 0, 1, 0
    field_simp [hx, hy]
  apply h.isClassified_of_normalize_isPrimitiveClassified
  apply h.normalize.isPrimitiveClassified_of_coprime
  apply Int.gcd_div_gcd_div_gcd (Nat.pos_of_ne_zero h0)
#align pythagorean_triple.classified PythagoreanTriple.classified

theorem coprime_classification :
    PythagoreanTriple 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) := by
  clear h -- porting note: don't want this variable, but can't use `include` / `omit`
  constructor
  · intro h
    obtain ⟨m, n, H⟩ := h.left.isPrimitiveClassified_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 := by
        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 := by
        rw [sq, ← h.left.eq]
        ring
      simpa using eq_or_eq_neg_of_sq_eq_sq _ _ this
  · delta PythagoreanTriple
    rintro ⟨m, n, ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, rfl | rfl, co, pp⟩ <;>
      first
      | constructor; ring; exact coprime_sq_sub_mul co pp
      | constructor; ring; rw [Int.gcd_comm]; exact coprime_sq_sub_mul co pp
#align pythagorean_triple.coprime_classification PythagoreanTriple.coprime_classification

/-- 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 : PythagoreanTriple 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 := by
  obtain ⟨m, n, ht1, ht2, ht3, ht4⟩ :=
    PythagoreanTriple.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_emod_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
      constructor
      · rw [h_odd.2]
        ring
      cases' ht2 with h_pos h_neg
      · apply And.intro h_pos
        constructor
        · delta Int.gcd
          rw [Int.natAbs_neg, Int.natAbs_neg]
          exact ht3
        · rw [Int.neg_emod_two, Int.neg_emod_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_emod_right] at h_parity
    exact zero_ne_one h_parity
#align pythagorean_triple.coprime_classification' PythagoreanTriple.coprime_classification'

/-- **Formula for Pythagorean Triples** -/
theorem classification :
    PythagoreanTriple 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)) := by
  constructor
  · 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 := by
        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 := by
        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 PythagoreanTriple <;> ring
#align pythagorean_triple.classification PythagoreanTriple.classification

end PythagoreanTriple


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.algebra.module.basic
import topology.instances.real
import topology.instances.rat

/-!
# Continuous additive maps are `ℝ`-linear

In this file we prove that a continuous map `f : E →+ F` between two topological vector spaces
over `ℝ` is `ℝ`-linear
-/

variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E]
  [has_continuous_smul ℝ E] {F : Type*} [add_comm_group F] [module ℝ F]
  [topological_space F] [has_continuous_smul ℝ F] [t2_space F]

namespace add_monoid_hom

/-- A continuous additive map between two vector spaces over `ℝ` is `ℝ`-linear. -/
lemma map_real_smul (f : E →+ F) (hf : continuous f) (c : ℝ) (x : E) :
  f (c • x) = c • f x :=
suffices (λ c : ℝ, f (c • x)) = λ c : ℝ, c • f x, from _root_.congr_fun this c,
rat.dense_embedding_coe_real.dense.equalizer
  (hf.comp $ continuous_id.smul continuous_const)
  (continuous_id.smul continuous_const)
  (funext $ λ r, map_rat_cast_smul f ℝ ℝ r x)

/-- Reinterpret a continuous additive homomorphism between two real vector spaces
as a continuous real-linear map. -/
def to_real_linear_map (f : E →+ F) (hf : continuous f) : E →L[ℝ] F :=
⟨{ to_fun := f, map_add' := f.map_add, map_smul' := f.map_real_smul hf }, hf⟩

@[simp] lemma coe_to_real_linear_map (f : E →+ F) (hf : continuous f) :
  ⇑(f.to_real_linear_map hf) = f := rfl

end add_monoid_hom

/-- Reinterpret a continuous additive equivalence between two real vector spaces
as a continuous real-linear map. -/
def add_equiv.to_real_linear_equiv (e : E ≃+ F) (h₁ : continuous e)
  (h₂ : continuous e.symm) : E ≃L[ℝ] F :=
{ .. e,
  .. e.to_add_monoid_hom.to_real_linear_map h₁ }

/-- A topological group carries at most one structure of a topological `ℝ`-module, so for any
topological `ℝ`-algebra `A` (e.g. `A = ℂ`) and any topological group that is both a topological
`ℝ`-module and a topological `A`-module, these structures agree. -/
@[priority 900]
instance real.is_scalar_tower [t2_space E] {A : Type*} [topological_space A]
  [ring A] [algebra ℝ A] [module A E] [has_continuous_smul ℝ A]
  [has_continuous_smul A E] : is_scalar_tower ℝ A E :=
⟨λ r x y, ((smul_add_hom A E).flip y).map_real_smul (continuous_id.smul continuous_const) r x⟩


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

! This file was ported from Lean 3 source module ring_theory.dedekind_domain.selmer_group
! leanprover-community/mathlib commit 2032a878972d5672e7c27c957e7a6e297b044973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Hom.Equiv.TypeTags
import Mathbin.Data.Zmod.Quotient
import Mathbin.RingTheory.DedekindDomain.AdicValuation
import Mathbin.RingTheory.Norm

/-!
# Selmer groups of fraction fields of Dedekind domains

Let $K$ be the field of fractions of a Dedekind domain $R$. For any set $S$ of prime ideals in the
height one spectrum of $R$, and for any natural number $n$, the Selmer group $K(S, n)$ is defined to
be the subgroup of the unit group $K^\times$ modulo $n$-th powers where each element has $v$-adic
valuation divisible by $n$ for all prime ideals $v$ away from $S$. In other words, this is precisely
$$ K(S, n) := \{x(K^\times)^n \in K^\times / (K^\times)^n \ \mid \
                \forall v \notin S, \ \mathrm{ord}_v(x) \equiv 0 \pmod n\}. $$

There is a fundamental short exact sequence
$$ 1 \to R_S^\times / (R_S^\times)^n \to K(S, n) \to \mathrm{Cl}_S(R)[n] \to 0, $$
where $R_S^\times$ is the $S$-unit group of $R$ and $\mathrm{Cl}_S(R)$ is the $S$-class group of
$R$. If the flanking groups are both finite, then $K(S, n)$ is finite by the first isomorphism
theorem. Such is the case when $R$ is the ring of integers of a number field $K$, $S$ is finite, and
$n$ is positive, in which case $R_S^\times$ is finitely generated by Dirichlet's unit theorem and
$\mathrm{Cl}_S(R)$ is finite by the class number theorem.

This file defines the Selmer group $K(S, n)$ and some basic facts.

## Main definitions

 * `is_dedekind_domain.selmer_group`: the Selmer group.
 * TODO: maps in the sequence.

## Main statements

 * TODO: proofs of exactness of the sequence.
 * TODO: proofs of finiteness for global fields.

## Notations

 * `K⟮S, n⟯`: the Selmer group with parameters `K`, `S`, and `n`.

## Implementation notes

The Selmer group is typically defined as a subgroup of the Galois cohomology group $H^1(K, \mu_n)$
with certain local conditions defined by $v$-adic valuations, where $\mu_n$ is the group of $n$-th
roots of unity over a separable closure of $K$. Here $H^1(K, \mu_n)$ is identified with
$K^\times / (K^\times)^n$ by the long exact sequence from Kummer theory and Hilbert's theorem 90,
and the fundamental short exact sequence becomes an easy consequence of the snake lemma. This file
will define all the maps explicitly for computational purposes, but isomorphisms to the Galois
cohomological definition will be provided when possible.

## References

https://doc.sagemath.org/html/en/reference/number_fields/sage/rings/number_field/selmer_group.html

## Tags

class group, selmer group, unit group
-/

-- mathport name: quot
local notation K "/" n => Kˣ ⧸ (powMonoidHom n : Kˣ →* Kˣ).range

namespace IsDedekindDomain

noncomputable section

open Classical DiscreteValuation nonZeroDivisors

universe u v

variable {R : Type u} [CommRing R] [IsDomain R] [IsDedekindDomain R] {K : Type v} [Field K]
  [Algebra R K] [IsFractionRing R K] (v : HeightOneSpectrum R)

/-! ### Valuations of non-zero elements -/

namespace HeightOneSpectrum

/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
def valuationOfNeZeroToFun (x : Kˣ) : Multiplicative ℤ :=
  let hx := IsLocalization.sec R⁰ (x : K)
  Multiplicative.ofAdd <|
    (-(Associates.mk v.asIdeal).count (Associates.mk <| Ideal.span {hx.fst}).factors : ℤ) -
      (-(Associates.mk v.asIdeal).count (Associates.mk <| Ideal.span {(hx : R)}).factors : ℤ)
#align is_dedekind_domain.height_one_spectrum.valuation_of_ne_zero_to_fun IsDedekindDomain.HeightOneSpectrum.valuationOfNeZeroToFun

@[simp]
theorem valuationOfNeZeroToFun_eq (x : Kˣ) :
    (v.valuationOfNeZeroToFun x : ℤₘ₀) = v.Valuation (x : K) :=
  by
  change _ = _ * _
  rw [Units.val_inv_eq_inv_val]
  change _ = ite _ _ _ * (ite (coe _ = _) _ _)⁻¹
  rw [IsLocalization.toLocalizationMap_sec,
    if_neg <| IsLocalization.sec_fst_ne_zero le_rfl x.ne_zero,
    if_neg <| nonZeroDivisors.coe_ne_zero _]
  any_goals exact IsDomain.to_nontrivial R
  rfl
#align is_dedekind_domain.height_one_spectrum.valuation_of_ne_zero_to_fun_eq IsDedekindDomain.HeightOneSpectrum.valuationOfNeZeroToFun_eq

/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
def valuationOfNeZero : Kˣ →* Multiplicative ℤ
    where
  toFun := v.valuationOfNeZeroToFun
  map_one' := by
    rw [← WithZero.coe_inj, valuation_of_ne_zero_to_fun_eq]
    exact map_one _
  map_mul' _ _ := by
    rw [← WithZero.coe_inj, WithZero.coe_mul]
    simp only [valuation_of_ne_zero_to_fun_eq]
    exact map_mul _ _ _
#align is_dedekind_domain.height_one_spectrum.valuation_of_ne_zero IsDedekindDomain.HeightOneSpectrum.valuationOfNeZero

@[simp]
theorem valuationOfNeZero_eq (x : Kˣ) : (v.valuationOfNeZero x : ℤₘ₀) = v.Valuation (x : K) :=
  valuationOfNeZeroToFun_eq v x
#align is_dedekind_domain.height_one_spectrum.valuation_of_ne_zero_eq IsDedekindDomain.HeightOneSpectrum.valuationOfNeZero_eq

@[simp]
theorem valuation_of_unit_eq (x : Rˣ) :
    v.valuationOfNeZero (Units.map (algebraMap R K : R →* K) x) = 1 :=
  by
  rw [← WithZero.coe_inj, valuation_of_ne_zero_eq, Units.coe_map, eq_iff_le_not_lt]
  constructor
  · exact v.valuation_le_one x
  · cases' x with x _ hx _
    change ¬v.valuation (algebraMap R K x) < 1
    apply_fun v.int_valuation  at hx
    rw [map_one, map_mul] at hx
    rw [not_lt, ← hx, ← mul_one <| v.valuation _, valuation_of_algebra_map,
      mul_le_mul_left₀ <| left_ne_zero_of_mul_eq_one hx]
    exact v.int_valuation_le_one _
#align is_dedekind_domain.height_one_spectrum.valuation_of_unit_eq IsDedekindDomain.HeightOneSpectrum.valuation_of_unit_eq

attribute [local semireducible] MulOpposite

/-- The multiplicative `v`-adic valuation on `Kˣ` modulo `n`-th powers. -/
def valuationOfNeZeroMod (n : ℕ) : (K/n) →* Multiplicative (ZMod n) :=
  (Int.quotientZmultiplesNatEquivZmod n).toMultiplicative.toMonoidHom.comp <|
    QuotientGroup.map (powMonoidHom n : Kˣ →* Kˣ).range (AddSubgroup.zmultiples (n : ℤ)).toSubgroup
      v.valuationOfNeZero
      (by
        rintro _ ⟨x, rfl⟩
        exact
          ⟨v.valuation_of_ne_zero x, by simpa only [powMonoidHom_apply, map_pow, Int.toAdd_pow] ⟩)
#align is_dedekind_domain.height_one_spectrum.valuation_of_ne_zero_mod IsDedekindDomain.HeightOneSpectrum.valuationOfNeZeroMod

@[simp]
theorem valuation_of_unit_mod_eq (n : ℕ) (x : Rˣ) :
    v.valuationOfNeZeroMod n (Units.map (algebraMap R K : R →* K) x : K/n) = 1 := by
  rw [valuation_of_ne_zero_mod, MonoidHom.comp_apply, ← QuotientGroup.coe_mk',
    QuotientGroup.map_mk', valuation_of_unit_eq, QuotientGroup.mk_one, map_one]
#align is_dedekind_domain.height_one_spectrum.valuation_of_unit_mod_eq IsDedekindDomain.HeightOneSpectrum.valuation_of_unit_mod_eq

end HeightOneSpectrum

/-! ### Selmer groups -/

variable {S S' : Set <| HeightOneSpectrum R} {n : ℕ}

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ∉ » S) -/
/-- The Selmer group `K⟮S, n⟯`. -/
def selmerGroup : Subgroup <| K/n
    where
  carrier := { x : K/n | ∀ (v) (_ : v ∉ S), (v : HeightOneSpectrum R).valuationOfNeZeroMod n x = 1 }
  one_mem' _ _ := by rw [map_one]
  mul_mem' _ _ hx hy v hv := by rw [map_mul, hx v hv, hy v hv, one_mul]
  inv_mem' _ hx v hv := by rw [map_inv, hx v hv, inv_one]
#align is_dedekind_domain.selmer_group IsDedekindDomain.selmerGroup

-- mathport name: «expr ⟮ , ⟯»
scoped[SelmerGroup] notation K "⟮" S "," n "⟯" => @selmerGroup _ _ _ _ K _ _ _ S n

namespace SelmerGroup

theorem monotone (hS : S ≤ S') : K⟮S,n⟯ ≤ K⟮S',n⟯ := fun _ hx v => hx v ∘ mt (@hS v)
#align is_dedekind_domain.selmer_group.monotone IsDedekindDomain.selmerGroup.monotone

/-- The multiplicative `v`-adic valuations on `K⟮S, n⟯` for all `v ∈ S`. -/
def valuation : K⟮S,n⟯ →* S → Multiplicative (ZMod n)
    where
  toFun x v := (v : HeightOneSpectrum R).valuationOfNeZeroMod n (x : K/n)
  map_one' := funext fun v => map_one _
  map_mul' x y := funext fun v => map_mul _ x y
#align is_dedekind_domain.selmer_group.valuation IsDedekindDomain.selmerGroup.valuation

theorem valuation_ker_eq :
    valuation.ker = K⟮(∅ : Set <| HeightOneSpectrum R),n⟯.subgroupOf (K⟮S,n⟯) :=
  by
  ext ⟨_, hx⟩
  constructor
  · intro hx' v _
    by_cases hv : v ∈ S
    · exact congr_fun hx' ⟨v, hv⟩
    · exact hx v hv
  · exact fun hx' => funext fun v => hx' v <| Set.not_mem_empty v
#align is_dedekind_domain.selmer_group.valuation_ker_eq IsDedekindDomain.selmerGroup.valuation_ker_eq

/-- The natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
def fromUnit {n : ℕ} : Rˣ →* K⟮(∅ : Set <| HeightOneSpectrum R),n⟯
    where
  toFun x :=
    ⟨QuotientGroup.mk <| Units.map (algebraMap R K).toMonoidHom x, fun v _ =>
      v.valuation_of_unit_mod_eq n x⟩
  map_one' := by simpa only [map_one]
  map_mul' _ _ := by simpa only [map_mul]
#align is_dedekind_domain.selmer_group.from_unit IsDedekindDomain.selmerGroup.fromUnit

theorem fromUnit_ker [hn : Fact <| 0 < n] :
    (@fromUnit R _ _ _ K _ _ _ n).ker = (powMonoidHom n : Rˣ →* Rˣ).range :=
  by
  ext ⟨_, _, _, _⟩
  constructor
  · intro hx
    rcases(QuotientGroup.eq_one_iff _).mp (Subtype.mk.inj hx) with ⟨⟨v, i, vi, iv⟩, hx⟩
    have hv : ↑(_ ^ n : Kˣ) = algebraMap R K _ := congr_arg Units.val hx
    have hi : ↑(_ ^ n : Kˣ)⁻¹ = algebraMap R K _ := congr_arg Units.inv hx
    rw [Units.val_pow_eq_pow_val] at hv
    rw [← inv_pow, Units.inv_mk, Units.val_pow_eq_pow_val] at hi
    rcases@IsIntegrallyClosed.exists_algebraMap_eq_of_isIntegral_pow R _ _ _ _ _ _ _ v _ hn.out
        (hv.symm ▸ isIntegral_algebraMap) with
      ⟨v', rfl⟩
    rcases@IsIntegrallyClosed.exists_algebraMap_eq_of_isIntegral_pow R _ _ _ _ _ _ _ i _ hn.out
        (hi.symm ▸ isIntegral_algebraMap) with
      ⟨i', rfl⟩
    rw [← map_mul, map_eq_one_iff _ <| NoZeroSMulDivisors.algebraMap_injective R K] at vi
    rw [← map_mul, map_eq_one_iff _ <| NoZeroSMulDivisors.algebraMap_injective R K] at iv
    rw [Units.val_mk, ← map_pow] at hv
    exact
      ⟨⟨v', i', vi, iv⟩, by
        simpa only [Units.ext_iff, powMonoidHom_apply, Units.val_pow_eq_pow_val] using
          NoZeroSMulDivisors.algebraMap_injective R K hv⟩
  · rintro ⟨_, hx⟩
    rw [← hx]
    exact
      subtype.mk_eq_mk.mpr
        ((QuotientGroup.eq_one_iff _).mpr ⟨_, by simp only [powMonoidHom_apply, map_pow]⟩)
#align is_dedekind_domain.selmer_group.from_unit_ker IsDedekindDomain.selmerGroup.fromUnit_ker

/-- The injection induced by the natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
def fromUnitLift [Fact <| 0 < n] : (R/n) →* K⟮(∅ : Set <| HeightOneSpectrum R),n⟯ :=
  (QuotientGroup.kerLift _).comp (QuotientGroup.quotientMulEquivOfEq fromUnit_ker).symm.toMonoidHom
#align is_dedekind_domain.selmer_group.from_unit_lift IsDedekindDomain.selmerGroup.fromUnitLift

theorem fromUnitLift_injective [Fact <| 0 < n] :
    Function.Injective <| @fromUnitLift R _ _ _ K _ _ _ n _ :=
  Function.Injective.comp (QuotientGroup.kerLift_injective _) (MulEquiv.injective _)
#align is_dedekind_domain.selmer_group.from_unit_lift_injective IsDedekindDomain.selmerGroup.fromUnitLift_injective

end SelmerGroup

end IsDedekindDomain


--Examples of how to work with groups in Lean

-- TODO
-- order of element
-- order of group
-- some standard theorems about finite groups
-- making a subgroup
-- making a quotient group
-- isomorphism theorems

-- relevant files:

import algebra.group.basic -- stuff like mul_self_iff_eq_one, mul_inv_eq_iff_eq_mul etc
import algebra.group.hom -- unbundled group homs
import data.equiv.basic
import bundled_group_homs
import group_theory.quotient_group
import data.set.basic
import slice_lattice

/- e.g.

class is_group_hom [group α] [group β] (f : α → β) : Prop :=
(map_mul : ∀ a b : α, f (a * b) = f a * f b)
-/

import group_theory.perm.sign -- signature of a permutation

import group_theory.subgroup -- subgroups

/-
/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
class is_subgroup (s : set α) extends is_submonoid s : Prop :=
(inv_mem {a} : a ∈ s → a⁻¹ ∈ s)

class normal_subgroup [group α] (s : set α) extends is_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : α, g * n * g⁻¹ ∈ s)

-/

import group_theory.quotient_group -- quotient groups

import bundled_subgroup

-- This gives us four functions subgroup.carrier, subgroup.one_mem,
-- subgroup.mul_mem and subgroup.inv_mem. They each eat a term
-- of type `subgroup <something>` and spit out the relevant set or proof.

-- a variable G, plus proof it's a group.

-- Subsets of a type are already bundled: they're called `set G`.
-- There's a map from `subgroup G` to `set G` which just sends
-- a subgroup `H` to its carrier set `H.carrier`; this is
-- subgroup.carrier. Let's make Lean apply it by default whenever
-- it's expecting a set and we give it a subgroup.

import bundled_quotients

namespace subgroup
variables {G : Type*} [group G]

-- Two subgroups with same underlying subset are the same subgroup.
@[extensionality] def ext (H K : subgroup G) (h : (H : set G) = K) : H = K :=
by cases H; cases K; cases h; refl

-- Do you know what a partial order is? You can look it up on Wikipedia.
-- It's not hard to check that the set of subsets of a set is a partial order.
-- Because `set G` is already well-established in mathlib, it is unsurprising to
-- see that it has already been given the structure of a partial order.

example : partial_order (set G) := by apply_instance

-- that proof works because `partial_order` is like `group`, it's a typeclass,
-- so we expect Lean to keep track of the proofs. This example just gets the proof
-- that `set G` is a partial order from its big database of proofs.

-- We would like a partial order on the sub*groups* of G, not just the subsets.
-- So we have a map `subgroup G` -> `set G` and we would like to "pull back" the
-- structure of a partial order on the target of that map, of partial order on the source.

-- Can this be done? "pullback" in Lean is called `comap` -- the computer science name for it.
-- Can you put a partial order on `subgroup G` by pulling it back from the one on `set G`?
-- Or can you do it directly? You'll have to prove the axioms for a partial order.

theorem carrier_injective : function.injective (subgroup.carrier : subgroup G → set G) := by ext

instance : partial_order (subgroup G) :=
{ le := λ H K, (H : set G) ⊆ K,
  le_refl := begin
  intro,
  simp,
  end,
  le_trans := λ _ _ _, set.subset.trans,
  le_antisymm := λ H K h1 h2, ext H K $ set.subset.antisymm h1 h2
  }

-- If you do it directly you'll have to define the inequality you want, which will look something like this:
-- λ H K, H.carrier ⊆ K.carrier ; and then you'll have to prove all the theorems. If you pull it back you
-- won't need to prove the theorems.

theorem le {G : Type*} [group G] {H K : subgroup G} : H ≤ K ↔ ∀ x: G, x ∈ H → x ∈ K :=
iff.rfl

open lattice

-- so let's work up to lattices. "inf H K" is just H intersect K -- but we need to check it's a subgroup.

example (X : Type) (A B : set X) : A ∩ B ⊆ A := set.inter_subset_left A B

protected def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  one_mem := begin
--  unfold has_inter.inter,
--  unfold set.inter,
  split,
    apply subgroup.one_mem,
  apply subgroup.one_mem,
  end,
  mul_mem := begin
  intros,
  split,
    apply subgroup.mul_mem,
      unfold has_inter.inter at a_1,
      unfold set.inter at a_1,
      cases a_1 with Hh Hk,
      assumption,
    cases a_2 with Hh Hk,
    assumption,
  apply subgroup.mul_mem,
    cases a_1 with Hh Hk,
    assumption,
  cases a_2 with Hh Hk,
  assumption,
  end,
  inv_mem := begin
  intros,
  cases a_1 with Hh Hk,
  split,
    apply subgroup.inv_mem,
    assumption,
  apply subgroup.inv_mem,
  assumption,
  end
  }

-- notation for inf is ⊓ (\glb) and as you can see from the definition of "carrier" above (the carrier
-- is the underlying set), it's just the intersection. `inf` stands for "infimum" and
-- "glb" for "greatest lower bound",
-- both rather pretentious names for the intersection.

instance : has_inf (subgroup G) := ⟨subgroup.inf⟩

-- half way to a lattice is a semilattice_inf: there are some axioms you need to check though.

instance subgroup.semilattice_inf : semilattice_inf (subgroup G) :=
{ inf := (⊓),
  inf_le_left := begin
  intros,
  show a.carrier ∩ b.carrier ⊆ a.carrier,
  simp,
  --exact set.inter_subset_left _ _,
  --unfold lattice.has_inf.inf,
  --unfold subgroup.inf,
  end,
  inf_le_right := begin
  intros,
  show a.carrier ∩ b.carrier ⊆ b.carrier,
  simp,
  end,
  le_inf := begin
  intros a b c,
  intros hab hac,
  change a.carrier ⊆ b.carrier at hab,
  change a.carrier ⊆ c.carrier at hac,
  show a.carrier ⊆ b.carrier ∩ c.carrier,
  simp,
  split,
    assumption,
  assumption,
  end,
  ..subgroup.partial_order}

def top : subgroup G :=
{ carrier := set.univ,
  one_mem := set.mem_univ _,
  mul_mem := λ _ _ _ _, set.mem_univ _,
  inv_mem := λ _ _, set.mem_univ _
}

instance subgroup.has_top : has_top (subgroup G) := ⟨top⟩

def bot : subgroup G :=
{ carrier := {1},
  one_mem := begin
    apply set.mem_singleton
  end,
  mul_mem := begin
    intros a b ha hb,
    rw set.mem_singleton_iff at ha hb ⊢,
    rw [ha, hb, mul_one],
  end,
  inv_mem := begin
    intros a ha,
    rw set.mem_singleton_iff at ha ⊢,
    rw ha,
    simp,
  end
}

instance subgroup.has_bot : has_bot (subgroup G) := ⟨bot⟩

-- Lean has quotients by normal subgroups.

-- old style method
example (G : Type*) [group G] (N : set G) [normal_subgroup N] := quotient_group.quotient N
-- This is G/N. Lean guesses G from N.

-- We want to make a term of type `equiv X Y` where X and Y are two collections of
--  subgroups and the `equiv` is this
-- strong kind of bijection -- a map from X to Y, and a map from Y to X, and two proofs,
-- namely that the composite maps X->Y->X and Y->X->Y are the relevant identity maps.

-- To do this we need to make the two sets. First the variables we're going to have:

variables {N : subgroup G} (h : is_normal_subgroup N)

-- Now notation for the quotient:

local notation `Q` := quotient_group.quotient' h

-- Now the first set (or "type", as Nicola Gambino would say).

example := subgroup Q

-- That's the subgroups of G/N. The other set is the subgroups of G which contain N.

instance subtype.has_bot : has_bot {H : subgroup G // N ≤ H} :=
⟨⟨N, le_refl N⟩⟩

def Inf (X : set (subgroup G)) : subgroup G :=
{ carrier := Inf (set.image subgroup.carrier X),
  one_mem := begin
  unfold Inf,
  unfold has_Inf.Inf,
  unfold complete_lattice.Inf,
  intro t,
  intro ht,
  rcases ht with ⟨J, hJ, rfl⟩,
  exact J.one_mem,
  end,
  mul_mem := begin
    intros a b ha hb,
    -- unfolding to find out what goal meant now all deleted
    intros H hH,
    replace ha := ha H hH,
    replace hb := hb H hH,
    rcases hH with ⟨J, hJ, rfl⟩,
    exact J.mul_mem ha hb
  end,
  inv_mem := begin
  intros a ha H hH,
  replace ha := ha H hH,
  rcases hH with ⟨J, hJ, rfl⟩,
  exact J.inv_mem ha,
  end }

instance subgroup.has_Inf : has_Inf (subgroup G) := ⟨Inf⟩

def sup (H K : subgroup G) : subgroup G := Inf {X | H ≤ X ∧ K ≤ X}

instance : has_sup (subgroup G) := ⟨sup⟩

def Sup (X : set (subgroup G)) : subgroup G := Inf {K | ∀ H : X, H.val ≤ K}

instance subgroup.has_Sup : has_Sup (subgroup G) := ⟨Sup⟩

instance subgroup.semilattice_sup : semilattice_sup (subgroup G) :=
{ sup := sup,
  le_sup_left := begin
  intros a b,
  rw le,
  intros x hx xX xXh,
  rcases xXh with ⟨J, hJ, rfl⟩,
  cases hJ with aJ bJ,
  change a.carrier ⊆ J.carrier at aJ,
  change x ∈ a.carrier at hx,
  apply aJ,
  assumption,
  end,
  le_sup_right := begin
  intros,
  rw le,
  intros x hx xX xXh,
  rcases xXh with ⟨J, hJ, rfl⟩,
  cases hJ with aJ bJ,
  change b.carrier ⊆ J.carrier at bJ,
  change x ∈ b.carrier at hx,
  apply bJ,
  assumption,
  end,
  sup_le := begin
  intros a b c,
  rw le,
  intro hac,
  rw le,
  intro hbc,
  rw le,
  unfold lattice.has_sup.sup,
  unfold sup,
  intros x aorb,

  sorry
  end,
   ..subgroup.partial_order}

instance subgroup.lattice : lattice (subgroup G) := { ..subgroup.semilattice_sup, ..subgroup.semilattice_inf}

lemma le_top (H : subgroup G) : H ≤ ⊤ :=
begin
  rw le,
  intros x xh,
  unfold lattice.has_top.top,
end

instance subgroup.order_top : order_top (subgroup G) := {le_top := le_top, ..subgroup.partial_order, ..subgroup.has_top, }

lemma bot_le (H : subgroup G) : ⊥ ≤ H :=
begin
  rw le,
  intros x xbot,
  unfold lattice.has_bot.bot at xbot,

  sorry
end

instance subgroup.order_bot : order_bot (subgroup G) := {bot_le := bot_le, ..subgroup.partial_order, ..subgroup.has_bot}

instance subgroup.bounded_lattice : bounded_lattice (subgroup G) := {..subgroup.lattice, ..subgroup.order_top, ..subgroup.order_bot}

instance subtype.has_Inf : has_Inf ({H : subgroup G // N ≤ H}) := ⟨
  λ X, ⟨Inf (set.image subtype.val X), begin sorry end ⟩
⟩

instance : complete_lattice (subgroup G) :=
{ le_Sup := begin
intros s a has,
rw le,
intros x hxa,
unfold has_Sup.Sup,
unfold Sup,
intros t ht,
rcases ht with ⟨J, hJ, rfl⟩,

sorry
end,
  Sup_le := begin
  intros s a b,
  unfold has_Sup.Sup,
  unfold Sup,
  intros j hJ,

  sorry
  end,
  Inf_le := begin
  intros,
  unfold has_Inf.Inf,

  sorry
  end,
  le_Inf := begin
  intros s a ha,
  unfold has_Inf.Inf,

  sorry
  end,
  ..subgroup.bounded_lattice, ..subgroup.has_Sup, ..subgroup.has_Inf}

/-
class complete_lattice (α : Type u) extends bounded_lattice α, has_Sup α, has_Inf α :=
(le_Sup : ∀s, ∀a∈s, a ≤ Sup s)
(Sup_le : ∀s a, (∀b∈s, b ≤ a) → Sup s ≤ a)
(Inf_le : ∀s, ∀a∈s, Inf s ≤ a)
(le_Inf : ∀s a, (∀b∈s, a ≤ b) → a ≤ Inf s)
-/

end subgroup

variables {G : Type*} [group G] {H : Type*} [group H]

namespace monoid_hom

def map (f : G →* H) (K : subgroup G) : subgroup H :=
{ carrier := f '' K,
  one_mem := begin
  use 1,
  split,
    apply subgroup.one_mem,
  apply monoid_hom.map_one,
  end,
  mul_mem := begin
  rintro j k ⟨j', hj', rfl⟩ ⟨k', hk', rfl⟩,
  rw [← monoid_hom.map_mul f j' k'],
  unfold set.image,
  dsimp,
  use j'*k',
  split,
    apply subgroup.mul_mem,
      assumption,
    assumption,
  refl,
  end,
  inv_mem := begin
  rintro j ⟨j', hj', rfl⟩,
  unfold set.image,
  dsimp,
  use j'⁻¹,
  split,
    apply subgroup.inv_mem,
    assumption,
  apply f.map_inv,
  end
}

def comap (f : G →* H) (K : subgroup H) : subgroup G :=
{ carrier := f ⁻¹' K,
  one_mem := begin
  unfold set.preimage,
  dsimp,
  rw monoid_hom.map_one f,
  apply subgroup.one_mem,
  end,
  mul_mem := begin
  intros,
  unfold set.preimage,
  dsimp,
  rw monoid_hom.map_mul f,
  apply subgroup.mul_mem,
    assumption,
  assumption,
  end,
  inv_mem := begin
  intros,
  unfold set.preimage,
  dsimp,
  rw f.map_inv,
  apply subgroup.inv_mem,
  assumption,
  end
}

-- We haven't make the kernel of a bundled hom into a bundled subgroup!
def ker (f : G →* H) : subgroup G :=
{ carrier := {g : G | f g = 1},
  one_mem := begin
  dsimp,
  apply monoid_hom.map_one,
  end,
  mul_mem := begin
  dsimp,
  intros,
  rw [monoid_hom.map_mul, a_1, a_2],
  simp,
  end,
  inv_mem := begin
  dsimp,
  intros,
  rw [f.map_inv, a_1],
  simp,
  end }

def mem_ker (f : G →* H) (x : G) : x ∈ f.ker ↔ f x = 1 := iff.rfl

theorem ker_normal (f : G →* H) : is_normal_subgroup (ker f) :=
begin
   constructor,
   -- see what you can do -- might not be logically necessary but it might also be good
   -- practice :-)
   intros n hn g,
   change n ∈ ker f at hn,
   rw mem_ker f n at hn,
   show g * n * g⁻¹ ∈ ker f,
   rw [mem_ker f (g * n * g⁻¹), mul_assoc g n g⁻¹, group_hom.map_mul f g (n * g⁻¹)],
   rw [group_hom.map_mul f n g⁻¹, hn, one_mul],
   rw [← group_hom.map_mul],
   simp,
end

theorem ker_mk' {G : Type*} [group G] {N : subgroup G} (h : is_normal_subgroup N) :
  ker (quotient_group.mk' h) = N :=
begin
  letI : normal_subgroup N.carrier := h,
  apply subgroup.ext,
  convert quotient_group.ker_mk N.carrier,
  ext,
  rw [monoid_hom.ker, is_group_hom.mem_ker],
  refl,
end

-- one lemma you'll need to prove that your map in the correspondence below is well-defined.
lemma ker_sub_comap (f : G →* H) (X : subgroup H): f.ker ≤ f.comap X := begin
  intro g,
  intro h,
  have h2 : f g = 1,
    exact h,
  show f g ∈ X,
  rw h2,
  exact X.one_mem,
end

end monoid_hom

-- OK here is the main theorem. First variables.

variables {N : subgroup G} (hN : is_normal_subgroup N)

-- notation Q for the quotient group G/N

local notation `Q` := quotient_group.quotient' hN

-- the kernel of the projection is N

open monoid_hom

open quotient_group

-- hey this Wikipedia page is great:
-- https://en.wikipedia.org/wiki/Correspondence_theorem_(group_theory)

lemma mem_of_map_mem {K : subgroup G} (HK : N ≤ K) (x : G)
  (hx : ⇑(mk' hN) x ∈ (quotient_group.mk' hN).map K) : x ∈ K :=
begin
cases hx with k hxk,
    cases hxk with kK hxkx,
    let f := (mk' hN),
    have hxkone : f (x*k⁻¹) = 1,
      calc f(x*k⁻¹) = f(x)*f(k⁻¹) : by apply f.map_mul
      ...           = f(k)*f(k⁻¹) : by rw hxkx
      ...           = f(k*k⁻¹) : by rw f.map_mul
      ...           = f(1) : by rw mul_inv_self
      ...           = 1 : f.map_one,
    rw ←mem_ker at hxkone,
    rw ker_mk' at hxkone,
    have hfh : x*k⁻¹ ∈ K,
      apply HK,
      assumption,
    convert K.mul_mem hfh kK,
    rw mul_assoc,
    rw inv_mul_self k,
    rw mul_one,
end

/-- Correspondence theorem for group theory -- first version -/

def correspondence : {H : subgroup G // N ≤ H} ≃ (subgroup Q) :=
{ to_fun := λ HN, (quotient_group.mk' hN).map HN.1,
  inv_fun := λ K, ⟨(quotient_group.mk' hN).comap K, begin
  rw subgroup.le,
  intro g,
  intro hg,
  show (quotient_group.mk' hN) g ∈ K,
  rw ←(ker_mk' hN) at hg,
  rw mem_ker at hg,
  rw hg,
  exact K.one_mem,
  end⟩,
  left_inv := begin
  rintro ⟨K, HK⟩,
  dsimp,
  apply subtype.ext.2,
  dsimp,
  rw subgroup.ext_iff,
  intro x,
  split,
    intro hx,
    change (quotient_group.mk' hN) x ∈ (map (mk' hN)) K at hx,
    apply mem_of_map_mem hN,
      assumption,
    assumption,
      -- f is (mk' hN)
      -- f(x) ∈ F(K) => ∃ k ∈ K st. f(x) = f(k)
      -- K is a subgroup => k⁻¹ exists ∈ K -- K.inv_mem kK
      -- f(x) = f(k) => f(x)f(k⁻¹) = f(k)f(k⁻¹) => f(xk⁻¹) = f(1) = 1 change, group_hom.map_mul,
      -- So xk⁻¹ ∈ ker f ⊆ K
      -- But K is closed under multiplication and xk⁻¹ * k = x, so x ∈ K.
  intro hx,
  show (quotient_group.mk' hN) x ∈ (map (mk' hN)) K,
  exact set.mem_image_of_mem (λ (a : G), ⇑(mk' hN) a) hx,
  end,
  right_inv :=
  begin
  intro K,
  dsimp,
  rw subgroup.ext_iff,
  intro x,
  split,
    intro hx,
    cases hx with k hxk,
    cases hxk with kK hxkx,
    change (quotient_group.mk' hN) k ∈ K at kK,
    rw hxkx at kK,
    assumption,
  intro hx,
  have hxk := mk'.surjective hN x,
  cases hxk with g hxkx,
  use g,
  split,
    show (quotient_group.mk' hN) g ∈ K,
    rwa hxkx,
  assumption,
  --cases
  -- x ∈ K => ∃ j ∈ F⁻¹(K) st. f(j)=x (surjectivity)
  -- So f(j) ∈ F(F⁻¹(K)) => x ∈ F(F⁻¹(K))

  end
}

-- That theorem above (I know it says definition, that's because the functions are data) is a first
-- version of the correspondence theorem. It says that there's a bijection of sets:
-- subgroups of G containing N <-> subgroups of Q=G/N

-- The next thing to do is to check that the correspondence respects ⊓, but I haven't quite decided
-- the best way to formalise that...

-- H (containing N) is a normal subgroup of G iff H/N is a normal subgroup of G/N

theorem normal_iff_normal (hN : is_normal_subgroup N) (H : subgroup G) (hH : N ≤ H) :
  is_normal_subgroup H ↔ is_normal_subgroup (correspondence hN ⟨H, hH⟩) :=
begin
  split,
    intro nsH,
    rw is_normal_subgroup_def at nsH ⊢,
    intros,
    --have NnormH : ∀ n : G, n ∈ N → ∀ h : G, h ∈ H → h * n * h⁻¹ ∈ N,
    --  exact normal_is_subgroup hN hH,
    --have hHNG : quotient' NnormH ≤ quotient' hN, error : failed to synthesize type class instance for
    have j := mk'.surjective hN g,
    cases j with t ht,
    have k := mk'.surjective hN n,
    cases k with l hl,
    have linH : l ∈ H,
      apply mem_of_map_mem hN hH,
      rw hl,
      apply a,
    have : t * l * t⁻¹ ∈ H,
    apply nsH,
      assumption,
    rw [←ht, ←hl],
    rw [←group_hom.map_mul, ←group_hom.map_inv, ←group_hom.map_mul],
    use t * l * t⁻¹,
    split,
      assumption,
    refl,
    -- hN : N is a normal subgroup of G, hsH : H is a normal subgroup of G
    -- Then H/N is a subgroup of G/N : hHNG
    -- So gN*hN*g⁻¹N=ghg⁻¹N : by the group rule for quoitients
    -- ghg⁻¹N ∈ H/N : nsH
    -- note H/N = ⇑(correspondence hN) ⟨H, hH⟩
  intro nscH,
  rw is_normal_subgroup_def at nscH ⊢,
  intros,
  have that : ⇑(mk' hN) n ∈ (correspondence hN) ⟨H, hH⟩,
    use n,
    split,
      assumption,
    refl,
  have := nscH (mk' hN n) that (mk' hN g),
  rw [←group_hom.map_mul, ←group_hom.map_inv, ←group_hom.map_mul] at this,
  apply mem_of_map_mem hN hH,
  assumption,
end

lemma mem_mem_inf (H₁ H₂ : subgroup G) (t : G): t ∈ H₁ ⊓ H₂ → t ∈ H₁ :=
begin
  intro tH,
  change t ∈ H₁.carrier,
  cases tH,
  assumption,
end

lemma mem_inf_mem (H₁ H₂ : subgroup G) (t : G): t ∈ H₁ ⊓ H₂ → t ∈ H₂ :=
begin
  intro tH,
  change t ∈ H₂.carrier,
  cases tH,
  assumption,
end

theorem correspondence.le_iff (hN : is_normal_subgroup N) (H₁ H₂ : subgroup G)
(h1 : N ≤ H₁) (h2 : N ≤ H₂) : correspondence hN ⟨H₁, h1⟩ ⊓ correspondence hN ⟨H₂, h2⟩ =
  correspondence hN ⟨H₁ ⊓ H₂, lattice.le_inf h1 h2⟩ :=
begin
  rw subgroup.ext_iff,
  intros,
  have j := mk'.surjective hN x,
  cases j with t ht,
  rw ←ht,
  have : N ≤ H₁ ⊓ H₂,
    change N.carrier ⊆ H₁.carrier ∩ H₂.carrier,
    simp,
    split,
      assumption,
    assumption,
  split,
    intro xh,
    cases xh with xh1 xh2,
    use t,
    split,
      apply mem_of_map_mem hN this,
      use t,
      split,
        split,
          apply mem_of_map_mem hN h1,
          assumption,
        apply mem_of_map_mem hN h2,
        assumption,
      refl,
    refl,
  intro xh,
  have htt : t ∈ H₁ ⊓ H₂,
    apply mem_of_map_mem hN this,
    apply xh,
  split,
    have htt1 : t ∈ H₁,
      apply mem_mem_inf H₁ H₂,
      assumption,
    use t,
    split,
      assumption,
    refl,
  have htt1 : t ∈ H₂,
      apply mem_inf_mem H₁ H₂,
      assumption,
    use t,
    split,
      assumption,
    refl,
end

theorem correspondence.inf_iff (hN : is_normal_subgroup N) (H₁ H₂ : subgroup G)
(h1 : N ≤ H₁) (h2 : N ≤ H₂) : correspondence hN ⟨H₁, h1⟩ ≤ correspondence hN ⟨H₂, h2⟩ ↔ H₁ ≤ H₂ :=
begin
  split,
    intro hh,
    rw subgroup.le at hh ⊢,
    intros x xh,
    have that : ⇑(mk' hN) x ∈ (correspondence hN) ⟨H₁, h1⟩,
      use x,
      split,
        assumption,
      refl,
    have := hh (mk' hN x) that,
    apply mem_of_map_mem hN h2,
    assumption,
  intro hh,
  rw subgroup.le at hh ⊢,
  intros x xh,
  have j := mk'.surjective hN x,
  cases j with t ht,
  rw ←ht at xh,
  have xhh : t ∈ H₁,
    apply mem_of_map_mem hN h1,
    assumption,
  have := hh t xhh,
  rw ←ht,
  use t,
  split,
    assumption,
  refl,
end

theorem correspondence.top (hN : is_normal_subgroup N) :
  correspondence hN ⟨⊤, λ _ _, set.mem_univ _⟩ = ⊤ :=
begin
  rw subgroup.ext_iff,
  intro,
  have hT : N ≤ ⊤,
    apply subgroup.le_top,
  have j := mk'.surjective hN x,
  cases j with t ht,
  rw ← ht,
  split,
    intro hx,
    apply mem_of_map_mem hN hT t,
    apply hx,
  intro hx,
  use t,
  split,
    assumption,
  refl,
end
--int.coe_nat_inj' : ∀ {m n : ℕ}, ↑m = ↑n ↔ m = n


import algebra.group_power tactic.norm_num algebra.big_operators

def factorial : ℕ → ℕ
| 0 := 1
| (n+1) := (factorial n) * (n+1)

theorem Q4 (n : ℕ) (H : n > 0) : factorial n < 3^n ↔ n ≤ 6 := sorry