import ring_theory.ideal.basic
import ring_theory.localization.at_prime

noncomputable theory

variables (R : Type*) [comm_ring R]

/--
a chain of prime ideal of length `n` is `𝔭₀ ⊂ 𝔭₁ ⊂ ... ⊂ 𝔭ₙ` where all `𝔭ᵢ`s are prime ideals.
-/
structure prime_ideal_chain :=
(len : ℕ)
(chain : fin (len + 1) → ideal R)
(is_chain : strict_mono chain)
[is_prime : ∀ i, (chain i).is_prime]

namespace prime_ideal_chain

/--
If `R` is not the zero ring, then there is at least one prime ideal chain for `R` has a maximal
ideal.
-/
instance [nontrivial R] : nonempty (prime_ideal_chain R) :=
nonempty.intro
{ len := 0,
  chain := λ _, (ideal.exists_maximal R).some,
  is_chain := by { rintros ⟨i, (hi : i < 1)⟩ ⟨j, (hj : j < 1)⟩ (hij : i < j), exfalso, linarith, },
  is_prime := λ _, (ideal.exists_maximal R).some_spec.is_prime }

instance [nontrivial R] : inhabited (prime_ideal_chain R) :=
{ default :=
  { len := 0,
    chain := λ _, (ideal.exists_maximal R).some,
    is_chain := by { rintros ⟨i, (hi : i < 1)⟩ ⟨j, (hj : j < 1)⟩ (hij : i < j), exfalso, linarith, },
    is_prime := λ _, (ideal.exists_maximal R).some_spec.is_prime } }

/--
Two prime ideal chains are equal when they have the same length and the same prime ideals.
-/
@[ext]
lemma ext (M N : prime_ideal_chain R)
(len_eq : M.len = N.len)
(chain_eq : ∀ (i : fin (M.len + 1)), M.chain i = N.chain i) :
M = N :=
begin
cases M with h l m,
cases N with h' l' m',
dsimp at *,
subst len_eq,
congr,
ext,
rw chain_eq,
norm_num,
end

end prime_ideal_chain

/--
A ring `R` is said to be finite dimensional if there is a prime ideal chain with the maximal length.
Note that according to this definition, the zero ring is not finite dimensional, for it has no prime
ideal chains.
-/
class finite_dimensional_ring : Prop :=
(fin_dim : ∃ (M : prime_ideal_chain R), ∀ (N : prime_ideal_chain R), N.len ≤ M.len)

/--
If `R` is not the zero ring, then `R` is finite dimensional iff all prime ideal chains of `R` have
length bounded by some `n ∈ ℕ`
-/
lemma finite_dimensional_ring.iff_len_bounded [nontrivial R] :
  finite_dimensional_ring R ↔
  ∃ (n : ℕ), ∀ (N : prime_ideal_chain R), N.len ≤ n :=
{ mp := λ h, ⟨h.fin_dim.some.len, h.fin_dim.some_spec⟩,
  mpr := λ h,
  { fin_dim := ⟨(@nat.Sup_mem (set.range (prime_ideal_chain.len : prime_ideal_chain R → ℕ))
      ⟨(default : prime_ideal_chain R).len, ⟨_, rfl⟩⟩ ⟨h.some, begin
        rintros _ ⟨x, rfl⟩,
        exact h.some_spec _,
      end⟩).some, λ N, begin
        classical,
        generalize_proofs H,
        rw H.some_spec,
        rw nat.Sup_def ⟨h.some, _⟩,
        swap,
        { rintros _ ⟨m, rfl⟩,
          refine h.some_spec _, },
        generalize_proofs H2,
        exact nat.find_spec H2 _ ⟨_, rfl⟩,
      end⟩ } }

/--
The Krull dimension of a ring is the length of maximal chain if the ring is finite dimensional and
0 otherwise.
Notes on implementation:
alternatively `krull_dim` should take value in `with_top (with_bot ℕ)` where the zero ring then
would have dimension negative infinity (`⊥`) and any infinite dimensional ring will have dimension
positive infinity (`⊤`).
-/
def krull_dim : ℕ :=
@@dite (finite_dimensional_ring R) (classical.dec _) (λ H, H.fin_dim.some.len) (λ _, 0)

/--
If `R` is finite dimensional, then it has a prime ideal chain with the greatest length.
-/
def maximal_chain [finite_dimensional_ring R] : prime_ideal_chain R :=
finite_dimensional_ring.fin_dim.some

lemma maximal_chain_is_maximal [finite_dimensional_ring R] (M : prime_ideal_chain R) :
  M.len ≤ (maximal_chain R).len :=
finite_dimensional_ring.fin_dim.some_spec M

/--
If `R` is finite dimensional, then its dimension is the length of the longest prime ideal chain.
-/
lemma krull_dim_eq_len [finite_dimensional_ring R] : krull_dim R = (maximal_chain R).len :=
begin
  dunfold krull_dim,
  split_ifs,
  refl,
end

/--
If `R` is infinite dimensional, then its dimension, according to our convention, is zero.
-/
lemma krull_dim_eq_zero (not_finite : ¬ finite_dimensional_ring R) : krull_dim R = 0 :=
begin
  dunfold krull_dim,
  split_ifs,
  refl,
end

section

variables {R}

/--
Pulling back a chain of prime ideal chain of `S` along a surjective ring homomorphism `f : R ⟶ S`
to obtain a prime idael chain of `R` by `𝔭ᵢ ↦ f⁻¹ 𝔭ᵢ`.
-/
@[simps] def prime_ideal_chain.comap {S : Type*} [comm_ring S] (N : prime_ideal_chain S)
  (f : R →+* S) (hf : function.surjective f) : prime_ideal_chain R :=
{ len := N.len,
    chain := λ j, (N.chain j).comap f,
    is_chain := λ i j h, begin
      dsimp,
      rw lt_iff_le_and_ne,
      split,
      { refine ideal.comap_mono _,
        refine le_of_lt (N.is_chain h), },
      { have neq := ne_of_lt (N.is_chain h),
        contrapose! neq,
        ext1 s,
        obtain ⟨r, rfl⟩:= hf s,
        rw [← ideal.mem_comap, neq, ideal.mem_comap], },
    end,
    is_prime := λ j, begin
      haveI := N.is_prime j,
      refine ideal.comap_is_prime _ _,
    end }

/--
If `R` is finite dimensional and `R ⟶ S` is a surjective ring homomorphism, then every prime ideal
chain of `S` has length at most `krull_dim R`
-/
theorem prime_ideal_chain.length_bounded {S : Type*} [comm_ring S]
  (N : prime_ideal_chain S) [finite_dimensional_ring R]
  (f : R →+* S) (hf : function.surjective f) :
  N.len ≤ krull_dim R :=
begin
  rw [show N.len = (N.comap f hf).len, from rfl, krull_dim_eq_len],
  apply maximal_chain_is_maximal,
end

end

/--
If `R` is finite dimensional and `R ⟶ S` is a surjective ring homomorphism, then `S` is finite
dimensional as well.
-/
lemma finite_dimensional_of_surj [finite_dimensional_ring R]
  (S : Type*) [comm_ring S] [nontrivial S]
  (f : R →+* S) (hf : function.surjective f) : finite_dimensional_ring S :=
begin
  rw finite_dimensional_ring.iff_len_bounded,
  exact ⟨krull_dim R, λ N, N.length_bounded f hf ⟩,
end

/--
If `R` is finite dimensional and `R ⟶ S` is a surjective ring homomorphism,
then `krull_dim S ≤ krull_dim R`.
-/
theorem krull_dim_le_of_surj [finite_dimensional_ring R]
  (S : Type*) [comm_ring S] [nontrivial S]
  (f : R →+* S) (hf : function.surjective f) : krull_dim S ≤ krull_dim R :=
begin
  haveI : finite_dimensional_ring S := finite_dimensional_of_surj R S f hf,
  rw krull_dim_eq_len,
  exact (maximal_chain S).length_bounded f hf,
end

/--
If `R` is finite dimensional and nontrivial and `S` is isomorphic
to `R`, then `krull_dim R = krull_dim S`.
-/
theorem krull_dim_eq_of_findim_nontriv_isom
  [finite_dimensional_ring R] [nontrivial R]
  (S : Type*) [comm_ring S] (e : R ≃+* S) :
  krull_dim R = krull_dim S :=
begin
  haveI : nontrivial S,
    exact function.injective.nontrivial
    (equiv_like.injective e),
  haveI : finite_dimensional_ring S,
    exact finite_dimensional_of_surj R S e
    (equiv_like.surjective e),
  have hRS : krull_dim R ≤ krull_dim S,
    exact krull_dim_le_of_surj S R (ring_equiv.symm e)
    (equiv_like.surjective (ring_equiv.symm e)),
  have hSR : krull_dim S ≤ krull_dim R,
    exact krull_dim_le_of_surj R S e
    (equiv_like.surjective e),
  exact le_antisymm hRS hSR,
end

/--
If `R` is nontrivial and `S` is isomorphic to `R`, then `krull_dim R = krull_dim S`.
-/
theorem krull_dim_eq_of_nontriv_isom [nontrivial R]
  (S : Type*) [comm_ring S] (e : R ≃+* S) :
  krull_dim R = krull_dim S :=
begin
  by_cases hf : finite_dimensional_ring R,
  haveI : finite_dimensional_ring R,
    exact hf,
  exact krull_dim_eq_of_findim_nontriv_isom R S e,
  have hi : ¬finite_dimensional_ring S,
    contrapose hf,
    rw not_not at hf ⊢,
    haveI : finite_dimensional_ring S,
      exact hf,
    exact finite_dimensional_of_surj S R (ring_equiv.symm e)
    (equiv_like.surjective (ring_equiv.symm e)),
  have h1 : krull_dim R = 0,
    exact krull_dim_eq_zero R hf,
  have h2 : krull_dim S = 0,
    exact krull_dim_eq_zero S hi,
  rw h1,
  rw h2,
end

/--
If `R` is trivial, then according to our definition, `R` is not finite dimensional.
-/
lemma not_fin_dim_of_triv [ht : ¬nontrivial R] :
  ¬finite_dimensional_ring R :=
begin
  by_contra hf,
    have hI : ∃ (I : ideal R), I.is_prime,
      use hf.fin_dim.some.chain 0,
      exact hf.fin_dim.some.is_prime 0,
    cases hI with I hI',
    have haz : ∀ (x : R), x = 0,
      intro x,
      by_contra,
      have htR : ¬(∃ (x y : R), x ≠ y),
        rw ←nontrivial_iff,
        exact ht,
      have nhtR : ∃ (x y : R), x ≠ y,
        use x,
        use 0,
      exact htR nhtR,
    have hIeqT : I = ⊤,
      ext x,
      split,
      intro,
      triv,
      rw (haz x),
      intro,
      exact ideal.zero_mem I,
    exact ideal.is_prime.ne_top hI' hIeqT,
end

/--
If `R` and `S` are isomorphic, then `krull_dim R = krull_dim S`.
-/
theorem krull_dim_eq_of_isom (S : Type*) [comm_ring S]
  [e : R ≃+* S] : krull_dim R = krull_dim S :=
begin
  by_cases hnt : nontrivial R,
  haveI : nontrivial R := hnt,
  exact krull_dim_eq_of_nontriv_isom R S e,
  have htS : ¬nontrivial S,
    intro hntS,
    have hntR : nontrivial R,
      rw nontrivial_iff at hntS ⊢,
      cases hntS with x h,
      cases h with y h',
      use ring_equiv.symm e x,
      use ring_equiv.symm e y,
      intro hxeye,
      exact h' ((ring_equiv.injective (ring_equiv.symm e))
      hxeye),
    exact hnt hntR,
  have hnfR : ¬finite_dimensional_ring R,
    exact (@not_fin_dim_of_triv R _ hnt),
  have hnfS : ¬finite_dimensional_ring S,
    exact (@not_fin_dim_of_triv S _ htS),
  have h1 : krull_dim R = 0,
    exact krull_dim_eq_zero R hnfR,
  have h2 : krull_dim S = 0,
    exact krull_dim_eq_zero S hnfS,
  rw h1,
  rw h2,
end

/--
If `R` is finite dimensional, `I` is an ideal of `R`, and `R ⧸ I` is
nontrivial, then `krull_dim (R ⧸ I) ≤ krull_dim R`.
-/
theorem krull_dim_le_of_quot [finite_dimensional_ring R] (I : ideal R) [nontrivial (R ⧸ I)] :
  krull_dim (R ⧸ I) ≤ krull_dim R :=
begin
  haveI : finite_dimensional_ring (R ⧸ I) :=
    finite_dimensional_of_surj R (R ⧸ I) (ideal.quotient.mk I) ideal.quotient.mk_surjective,
  exact krull_dim_le_of_surj _ _ (ideal.quotient.mk I) ideal.quotient.mk_surjective,
end

section height

variables {R}

/--
The height of a prime ideal `𝔭` is defined to be `krull_dim R_𝔭`
-/
def ideal.height (p : ideal R) [p.is_prime] : ℕ :=
krull_dim (localization.at_prime p)

example (p : ideal R) [p.is_prime] : ℕ := p.height

end height


open classical

variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

theorem not_p_iff_not_p {p : Prop} : ¬(p ↔ ¬p) :=
assume h : p ↔ ¬p,
have hnp : ¬p, from (assume hp : p, (h.mp hp) hp),
hnp (h.mpr hnp)

-- via not_p_iff_not_p
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
not_p_iff_not_p (h barber)

-- standalone
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
have hparadox : shaves barber barber ↔ ¬shaves barber barber, from
    (h barber),
have hn_self_shave : ¬shaves barber barber, from
    (show shaves barber barber → false, from
        assume h_self_shave : shaves barber barber,
        absurd h_self_shave (hparadox.mp h_self_shave)),
absurd (hparadox.mpr hn_self_shave) hn_self_shave


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland

! This file was ported from Lean 3 source module data.pnat.prime
! leanprover-community/mathlib commit 09597669f02422ed388036273d8848119699c22f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Prime
import Mathlib.Data.PNat.Basic

/-!
# Primality and GCD on pnat

This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, analogous to those on
`Nat`.
-/

namespace Nat.Primes

-- Porting note: new definition
/-- The canonical map from `Nat.Primes` to `ℕ+` -/
@[coe] def toPNat : Nat.Primes → ℕ+ :=
  fun p => ⟨(p : ℕ), p.property.pos⟩

instance coePNat : Coe Nat.Primes ℕ+ :=
  ⟨toPNat⟩
#align nat.primes.coe_pnat Nat.Primes.coePNat

@[norm_cast]
theorem coe_pnat_nat (p : Nat.Primes) : ((p : ℕ+) : ℕ) = p :=
  rfl
#align nat.primes.coe_pnat_nat Nat.Primes.coe_pnat_nat

@[norm_cast]
theorem coe_pnat_inj (p q : Nat.Primes) : (p : ℕ+) = (q : ℕ+) ↔ p = q :=
  coe_pnat_injective.eq_iff
#align nat.primes.coe_pnat_inj Nat.Primes.coe_pnat_inj

end Nat.Primes

namespace PNat

open Nat

/-- The greatest common divisor (gcd) of two positive natural numbers,
  viewed as positive natural number. -/
def gcd (n m : ℕ+) : ℕ+ :=
  ⟨Nat.gcd (n : ℕ) (m : ℕ), Nat.gcd_pos_of_pos_left (m : ℕ) n.pos⟩
#align pnat.gcd PNat.gcd

/-- The least common multiple (lcm) of two positive natural numbers,
  viewed as positive natural number. -/
def lcm (n m : ℕ+) : ℕ+ :=
  ⟨Nat.lcm (n : ℕ) (m : ℕ), by
    let h := mul_pos n.pos m.pos
    rw [← gcd_mul_lcm (n : ℕ) (m : ℕ), mul_comm] at h
    exact pos_of_dvd_of_pos (Dvd.intro (Nat.gcd (n : ℕ) (m : ℕ)) rfl) h⟩
#align pnat.lcm PNat.lcm

@[simp, norm_cast]
theorem gcd_coe (n m : ℕ+) : (gcd n m : ℕ) = Nat.gcd n m :=
  rfl
#align pnat.gcd_coe PNat.gcd_coe

@[simp, norm_cast]
theorem lcm_coe (n m : ℕ+) : (lcm n m : ℕ) = Nat.lcm n m :=
  rfl
#align pnat.lcm_coe PNat.lcm_coe

theorem gcd_dvd_left (n m : ℕ+) : gcd n m ∣ n :=
  dvd_iff.2 (Nat.gcd_dvd_left (n : ℕ) (m : ℕ))
#align pnat.gcd_dvd_left PNat.gcd_dvd_left

theorem gcd_dvd_right (n m : ℕ+) : gcd n m ∣ m :=
  dvd_iff.2 (Nat.gcd_dvd_right (n : ℕ) (m : ℕ))
#align pnat.gcd_dvd_right PNat.gcd_dvd_right

theorem dvd_gcd {m n k : ℕ+} (hm : k ∣ m) (hn : k ∣ n) : k ∣ gcd m n :=
  dvd_iff.2 (Nat.dvd_gcd (dvd_iff.1 hm) (dvd_iff.1 hn))
#align pnat.dvd_gcd PNat.dvd_gcd

theorem dvd_lcm_left (n m : ℕ+) : n ∣ lcm n m :=
  dvd_iff.2 (Nat.dvd_lcm_left (n : ℕ) (m : ℕ))
#align pnat.dvd_lcm_left PNat.dvd_lcm_left

theorem dvd_lcm_right (n m : ℕ+) : m ∣ lcm n m :=
  dvd_iff.2 (Nat.dvd_lcm_right (n : ℕ) (m : ℕ))
#align pnat.dvd_lcm_right PNat.dvd_lcm_right

theorem lcm_dvd {m n k : ℕ+} (hm : m ∣ k) (hn : n ∣ k) : lcm m n ∣ k :=
  dvd_iff.2 (@Nat.lcm_dvd (m : ℕ) (n : ℕ) (k : ℕ) (dvd_iff.1 hm) (dvd_iff.1 hn))
#align pnat.lcm_dvd PNat.lcm_dvd

theorem gcd_mul_lcm (n m : ℕ+) : gcd n m * lcm n m = n * m :=
  Subtype.eq (Nat.gcd_mul_lcm (n : ℕ) (m : ℕ))
#align pnat.gcd_mul_lcm PNat.gcd_mul_lcm

theorem eq_one_of_lt_two {n : ℕ+} : n < 2 → n = 1 := by
  intro h; apply le_antisymm; swap; apply PNat.one_le
  exact PNat.lt_add_one_iff.1 h
#align pnat.eq_one_of_lt_two PNat.eq_one_of_lt_two

section Prime

/-! ### Prime numbers -/

/-- Primality predicate for `ℕ+`, defined in terms of `Nat.Prime`. -/
def Prime (p : ℕ+) : Prop :=
  (p : ℕ).Prime
#align pnat.prime PNat.Prime

theorem Prime.one_lt {p : ℕ+} : p.Prime → 1 < p :=
  Nat.Prime.one_lt
#align pnat.prime.one_lt PNat.Prime.one_lt

theorem prime_two : (2 : ℕ+).Prime :=
  Nat.prime_two
#align pnat.prime_two PNat.prime_two

theorem dvd_prime {p m : ℕ+} (pp : p.Prime) : m ∣ p ↔ m = 1 ∨ m = p := by
  rw [PNat.dvd_iff]
  rw [Nat.dvd_prime pp]
  simp
#align pnat.dvd_prime PNat.dvd_prime

theorem Prime.ne_one {p : ℕ+} : p.Prime → p ≠ 1 := by
  intro pp
  intro contra
  apply Nat.Prime.ne_one pp
  rw [PNat.coe_eq_one_iff]
  apply contra
#align pnat.prime.ne_one PNat.Prime.ne_one

@[simp]
theorem not_prime_one : ¬(1 : ℕ+).Prime :=
  Nat.not_prime_one
#align pnat.not_prime_one PNat.not_prime_one

theorem Prime.not_dvd_one {p : ℕ+} : p.Prime → ¬p ∣ 1 := fun pp : p.Prime => by
  rw [dvd_iff]
  apply Nat.Prime.not_dvd_one pp
#align pnat.prime.not_dvd_one PNat.Prime.not_dvd_one

theorem exists_prime_and_dvd {n : ℕ+} (hn : n ≠ 1) : ∃ p : ℕ+, p.Prime ∧ p ∣ n := by
  obtain ⟨p, hp⟩ := Nat.exists_prime_and_dvd (mt coe_eq_one_iff.mp hn)
  exists (⟨p, Nat.Prime.pos hp.left⟩ : ℕ+); rw [dvd_iff]; apply hp
#align pnat.exists_prime_and_dvd PNat.exists_prime_and_dvd

end Prime

section Coprime

/-! ### Coprime numbers and gcd -/

/-- Two pnats are coprime if their gcd is 1. -/
def Coprime (m n : ℕ+) : Prop :=
  m.gcd n = 1
#align pnat.coprime PNat.Coprime

@[simp, norm_cast]
theorem coprime_coe {m n : ℕ+} : Nat.coprime ↑m ↑n ↔ m.Coprime n := by
  unfold coprime Coprime
  rw [← coe_inj]
  simp
#align pnat.coprime_coe PNat.coprime_coe

theorem Coprime.mul {k m n : ℕ+} : m.Coprime k → n.Coprime k → (m * n).Coprime k := by
  repeat' rw [← coprime_coe]
  rw [mul_coe]
  apply Nat.coprime.mul
#align pnat.coprime.mul PNat.Coprime.mul

theorem Coprime.mul_right {k m n : ℕ+} : k.Coprime m → k.Coprime n → k.Coprime (m * n) := by
  repeat' rw [← coprime_coe]
  rw [mul_coe]
  apply Nat.coprime.mul_right
#align pnat.coprime.mul_right PNat.Coprime.mul_right

theorem gcd_comm {m n : ℕ+} : m.gcd n = n.gcd m := by
  apply eq
  simp only [gcd_coe]
  apply Nat.gcd_comm
#align pnat.gcd_comm PNat.gcd_comm

theorem gcd_eq_left_iff_dvd {m n : ℕ+} : m ∣ n ↔ m.gcd n = m := by
  rw [dvd_iff]
  rw [Nat.gcd_eq_left_iff_dvd]
  rw [← coe_inj]
  simp
#align pnat.gcd_eq_left_iff_dvd PNat.gcd_eq_left_iff_dvd

theorem gcd_eq_right_iff_dvd {m n : ℕ+} : m ∣ n ↔ n.gcd m = m := by
  rw [gcd_comm]
  apply gcd_eq_left_iff_dvd
#align pnat.gcd_eq_right_iff_dvd PNat.gcd_eq_right_iff_dvd

theorem Coprime.gcd_mul_left_cancel (m : ℕ+) {n k : ℕ+} :
    k.Coprime n → (k * m).gcd n = m.gcd n := by
  intro h; apply eq; simp only [gcd_coe, mul_coe]
  apply Nat.coprime.gcd_mul_left_cancel; simpa
#align pnat.coprime.gcd_mul_left_cancel PNat.Coprime.gcd_mul_left_cancel

theorem Coprime.gcd_mul_right_cancel (m : ℕ+) {n k : ℕ+} : k.Coprime n → (m * k).gcd n = m.gcd n :=
  by rw [mul_comm]; apply Coprime.gcd_mul_left_cancel
#align pnat.coprime.gcd_mul_right_cancel PNat.Coprime.gcd_mul_right_cancel

theorem Coprime.gcd_mul_left_cancel_right (m : ℕ+) {n k : ℕ+} :
    k.Coprime m → m.gcd (k * n) = m.gcd n := by
  intro h; iterate 2 rw [gcd_comm]; symm;
  apply Coprime.gcd_mul_left_cancel _ h
#align pnat.coprime.gcd_mul_left_cancel_right PNat.Coprime.gcd_mul_left_cancel_right

theorem Coprime.gcd_mul_right_cancel_right (m : ℕ+) {n k : ℕ+} :
    k.Coprime m → m.gcd (n * k) = m.gcd n := by
  rw [mul_comm];
  apply Coprime.gcd_mul_left_cancel_right
#align pnat.coprime.gcd_mul_right_cancel_right PNat.Coprime.gcd_mul_right_cancel_right

@[simp]
theorem one_gcd {n : ℕ+} : gcd 1 n = 1 := by
  rw [← gcd_eq_left_iff_dvd]
  apply one_dvd
#align pnat.one_gcd PNat.one_gcd

@[simp]
theorem gcd_one {n : ℕ+} : gcd n 1 = 1 := by
  rw [gcd_comm]
  apply one_gcd
#align pnat.gcd_one PNat.gcd_one

@[symm]
theorem Coprime.symm {m n : ℕ+} : m.Coprime n → n.Coprime m := by
  unfold Coprime
  rw [gcd_comm]
  simp
#align pnat.coprime.symm PNat.Coprime.symm

@[simp]
theorem one_coprime {n : ℕ+} : (1 : ℕ+).Coprime n :=
  one_gcd
#align pnat.one_coprime PNat.one_coprime

@[simp]
theorem coprime_one {n : ℕ+} : n.Coprime 1 :=
  Coprime.symm one_coprime
#align pnat.coprime_one PNat.coprime_one

theorem Coprime.coprime_dvd_left {m k n : ℕ+} : m ∣ k → k.Coprime n → m.Coprime n := by
  rw [dvd_iff]
  repeat' rw [← coprime_coe]
  apply Nat.coprime.coprime_dvd_left
#align pnat.coprime.coprime_dvd_left PNat.Coprime.coprime_dvd_left

theorem Coprime.factor_eq_gcd_left {a b m n : ℕ+} (cop : m.Coprime n) (am : a ∣ m) (bn : b ∣ n) :
    a = (a * b).gcd m := by
  rw [gcd_eq_left_iff_dvd] at am
  conv_lhs => rw [← am]
  rw [eq_comm]
  apply Coprime.gcd_mul_right_cancel a
  apply Coprime.coprime_dvd_left bn cop.symm
#align pnat.coprime.factor_eq_gcd_left PNat.Coprime.factor_eq_gcd_left

theorem Coprime.factor_eq_gcd_right {a b m n : ℕ+} (cop : m.Coprime n) (am : a ∣ m) (bn : b ∣ n) :
    a = (b * a).gcd m := by rw [mul_comm]; apply Coprime.factor_eq_gcd_left cop am bn
#align pnat.coprime.factor_eq_gcd_right PNat.Coprime.factor_eq_gcd_right

theorem Coprime.factor_eq_gcd_left_right {a b m n : ℕ+} (cop : m.Coprime n) (am : a ∣ m)
    (bn : b ∣ n) : a = m.gcd (a * b) := by rw [gcd_comm]; apply Coprime.factor_eq_gcd_left cop am bn
#align pnat.coprime.factor_eq_gcd_left_right PNat.Coprime.factor_eq_gcd_left_right

theorem Coprime.factor_eq_gcd_right_right {a b m n : ℕ+} (cop : m.Coprime n) (am : a ∣ m)
    (bn : b ∣ n) : a = m.gcd (b * a) := by
  rw [gcd_comm]
  apply Coprime.factor_eq_gcd_right cop am bn
#align pnat.coprime.factor_eq_gcd_right_right PNat.Coprime.factor_eq_gcd_right_right

theorem Coprime.gcd_mul (k : ℕ+) {m n : ℕ+} (h : m.Coprime n) :
    k.gcd (m * n) = k.gcd m * k.gcd n := by
  rw [← coprime_coe] at h; apply eq
  simp only [gcd_coe, mul_coe]; apply Nat.coprime.gcd_mul k h
#align pnat.coprime.gcd_mul PNat.Coprime.gcd_mul

theorem gcd_eq_left {m n : ℕ+} : m ∣ n → m.gcd n = m := by
  rw [dvd_iff]
  intro h
  apply eq
  simp only [gcd_coe]
  apply Nat.gcd_eq_left h
#align pnat.gcd_eq_left PNat.gcd_eq_left

theorem Coprime.pow {m n : ℕ+} (k l : ℕ) (h : m.Coprime n) : (m ^ k).coprime (n ^ l) := by
  rw [← coprime_coe] at *; simp only [pow_coe]; apply Nat.coprime.pow; apply h
#align pnat.coprime.pow PNat.Coprime.pow

end Coprime

end PNat


import linear_algebra.projective_space.basic
import linear_algebra.linear_independent
import algebra.field.basic
import tactic
variables {K V : Type*} [field K] [add_comm_group V] [module K V]

open projectivization

--/-Projection into the quotient is a left inverse for the representative function-/
--lemma mk_left_inverse_of_rep (v : ℙ K V) :
--  (projectivization.mk K v.rep (rep_nonzero v)) = v :=
--mk_rep _

/-Composition of function and a finite indexing commute-/
lemma fin_comp_commutes₂ {α β : Type*} {a b : α} {f: α → β} : (f ∘ (![a, b])) = (![f a, f b]) :=
by { ext, fin_cases x; refl }

lemma fin_comp_commutes₃ {α β : Type*} {a b c : α} {f: α → β} : (f ∘ (![a, b, c])) = (![f a, f b, f c]) :=
by { ext, fin_cases x; refl }

/-Two nonzero vectors go to the same point in projective space iff one is in the span of the other-/
lemma mk_eq_mk_iff' (v w: V) (hv : v ≠ 0) (hw : w ≠ 0) : mk K v hv = mk K w hw ↔ ∃ a : K, a • w = v :=
begin
  rw mk_eq_mk_iff K v w hv hw,
  split,
  { rintro ⟨a, ha⟩,
    exact ⟨a, ha⟩ },
  { rintro ⟨a, ha⟩,
    refine ⟨units.mk0 a (λ c, hv.symm _), ha⟩,
    rwa [c, zero_smul] at ha }
end

/-Two points are equal iff their representatives are multiples of eachother-/
lemma eq_iff (v w : ℙ K V) : v = w ↔ ∃ a : Kˣ, a • w.rep = v.rep :=
begin
  conv_lhs { rw [← mk_rep v, ← mk_rep w] },
  rw mk_eq_mk_iff,
end

/- An inductive definition of independence wherein a linearly independent familty of nonzero vectors
gives an independent family in the projective space -/
inductive independent {ι : Type*} : (ι → ℙ K V) → Prop
| mk (f : ι → V) (hf : ∀ i : ι, f i ≠ 0) (hl : linear_independent K f) :
    independent (λ i, mk K (f i) (hf i))

-- The definitions of independence in a projective space are equivalent
lemma independent_iff (ι : Type*) (f : ι → (ℙ K V)) : (independent f) ↔
  (linear_independent K (projectivization.rep ∘ f)) :=
begin
  split,
  { rintro h, induction h with ff hff hh,
    choose a ha using λ (i : ι), exists_smul_eq_mk_rep K (ff i) (hff i),
    convert hh.units_smul a,
    ext i, exact (ha i).symm },
  { intro h,
    convert independent.mk _ _ h,
    { ext, simp only [mk_rep] },
    { intro i, apply rep_nonzero } }
end

/-An inductive definition of dependence wherein a linearly dependent family of nonzero vectors
gives a dependent family in the projective space -/
inductive dependent {ι : Type*} : (ι → ℙ K V) → Prop
| mk (f : ι → V) (hf : ∀ i : ι, f i ≠ 0) (h : ¬linear_independent K f) :
    dependent (λ i, mk K (f i) (hf i))

/-The definitons of dependence are equivalent-/
lemma dependent_iff (ι : Type*) (f : ι → (ℙ K V)) : (dependent f) ↔
  (¬ linear_independent K (projectivization.rep ∘ f)) :=
begin
  split,
  { rw ← independent_iff,
    intros h1, induction h1 with ff hff hh1,
    contrapose! hh1, rw independent_iff at hh1,
    choose a ha using λ (i : ι), exists_smul_eq_mk_rep K (ff i) (hff i),
    convert hh1.units_smul a⁻¹,
    ext i, simp only [← ha, inv_smul_smul, pi.smul_apply', pi.inv_apply, function.comp_app] },
  { intro h,
    convert dependent.mk _ _ h,
    { ext, simp only [mk_rep] },
    { intro i, apply rep_nonzero } }
end

/-Dependence is the negation of independence-/
lemma dependent_iff_not_independent {ι : Type*} (f : ι → ℙ K V) :
  dependent f ↔ ¬ independent f :=
by { rw [dependent_iff, independent_iff] }

/-Independence is the negation of dependence-/
lemma independent_iff_not_dependent {ι : Type*} (f : ι → ℙ K V) :
  independent f ↔ ¬ dependent f :=
by { rw [dependent_iff, independent_iff, not_not] }

/-A pair of points in a projective space are dependent iff they are equal-/
@[simp] lemma pair_dependent_iff_eq (u v : ℙ K V) : (dependent ![u, v]) ↔ u = v :=
begin
  rw dependent_iff_not_independent,
  split,
  { intro h, rw independent_iff at h,
    rw linear_independent_fin2 at h,
    simp at h,
    specialize h (rep_nonzero v),
    cases h with a ha,
    rw [← (mk_rep u), ←(mk_rep v),
      mk_eq_mk_iff' u.rep v.rep (rep_nonzero u) (rep_nonzero v)],
    use a,
    assumption  },
  { intro h, rw independent_iff,
    rw [h, linear_independent_fin2],
    simp,
    intro hv,
    use 1,
    simp, },
end

/-A pair of points in a projective space are independent iff they are not equal-/
@[simp] lemma pair_independent_iff_neq (u v : ℙ K V) : (independent ![u, v]) ↔
  u ≠ v :=
by {  rw independent_iff_not_dependent, simp,  }

lemma nt_lin_comb_implies_in_span {u v : V} {a b : K} (ha : a ≠ 0) (hz : a • u + b • v = 0) :
  (-a⁻¹*b) • v = u :=
begin
have huv : a • u = -(b • v), by {rw ← eq_neg_iff_add_eq_zero at hz, exact hz},
have hv : u = (- a⁻¹*b) • v, by
  {  calc
  u = 1 • u : (one_smul _ (u)).symm
  ... = (a⁻¹ * a) • u : by {  rw (inv_mul_cancel ha), simp  }
  ... = (- a⁻¹*b) • v : by {  rw [mul_smul, huv, mul_smul], simp  }  },
exact hv.symm
end

lemma dependent_iff_reps_dependent₂ (u v : ℙ K V) : dependent ![u, v] ↔
  ∃ (a b : K) (hnt : ![a, b] ≠ 0), a • u.rep + b • v.rep = 0 :=
begin
  rw [dependent_iff, fin_comp_commutes₂, linear_independent_fin2],
  split,
  { intro h,
    simp at h,
    specialize h (rep_nonzero v),
    cases h with a ha,
    use [-1, a],
    split; simp,
    rw ha,
    simp,  },
  { rintros ⟨a, b, ⟨hnt, hz⟩⟩,
    simp,
    intro hv,
    suffices ha : a ≠ 0, by {  use (-a⁻¹*b), exact nt_lin_comb_implies_in_span ha hz,  },
    by_contradiction,
    rw h at hz,
    simp at *,
    cases hz,
    { exact hnt h hz },
    { exact rep_nonzero v hz, } }
end

open_locale big_operators

lemma dependent_iff_reps_dependent₃ (u v w : ℙ K V) : dependent ![u, v, w] ↔
  ∃ (a b c : K) (hnt : ![a, b, c] ≠ 0), a • u.rep + b • v.rep + c • w.rep = 0 :=
begin
  rw [dependent_iff, fintype.not_linear_independent_iff],
  simp only [fin.sum_univ_succ, function.comp_app, matrix.cons_val_zero, matrix.cons_val_succ,
    fin.succ_zero_eq_one, fintype.univ_of_subsingleton, fin.mk_eq_subtype_mk, fin.mk_zero,
    finset.sum_singleton, fin.succ_one_eq_two, eq_iff_true_of_subsingleton, and_true,
    not_and, exists_prop, add_assoc],
  split,
  { rintro ⟨g,h1,⟨i,h2⟩⟩,
    refine ⟨g 0, g 1, g 2, _, h1⟩,
    rw function.ne_iff, use i, fin_cases i; exact h2 },
  { rintros ⟨a,b,c,h1,h2⟩,
    refine ⟨![a,b,c], h2, _⟩,
    rwa ← function.ne_iff, }
end

/-A nontrivial linear combination of representatives which is zero implies both scalars are nonzero-/
lemma lc_implies_both_nz {u v : ℙ K V} {a b : K} (ht: ![a, b] ≠ 0) (hs : a • u.rep + b • v.rep = 0) : a ≠ 0 ∧ b ≠ 0 :=
begin
split;
by_contradiction;
rw h at hs;
simp at hs;
cases hs,
  {  have hz : ![a,b] = 0, by {  simp at *, split; assumption,  },
  exact ht hz,  },
  {  exact rep_nonzero v hs,  },
  {  have hz : ![a,b] = 0, by {  simp at *, split; assumption,  },
  exact ht hz,  },
  {  exact rep_nonzero u hs,  },
end

/-If in a -/
@[simp] lemma nontrivial_and_zero₁ {a b c : K} (ht : ![a, b, c] ≠ 0)
  (ha : a = (0 : K)) : ![b, c] ≠ 0 :=
begin
simp at *,
intro hb,
by_contradiction,
exact ((ht ha) hb) h,
end

@[simp] lemma nontrivial_and_zero₂ {a b c : K} (ht : ![a, b, c] ≠ 0)
  (hb : b = (0 : K)) : ![a, c] ≠ 0 :=
begin
simp at *,
intro ha,
by_contradiction,
exact ((ht ha) hb) h,
end

lemma neq_implies_sc_neq_zero {u v w : ℙ K V} {a b c : K} (hneq : v ≠ w)
  (hnz : ![a, b, c] ≠ 0) (hsz : a • u.rep + b • v.rep + c • w.rep = 0) : a ≠ 0 :=
begin
by_contradiction,
rw h at hsz,
simp at hsz,
have hz, from nontrivial_and_zero₁ hnz h,
have h2, from lc_implies_both_nz hz hsz,
cases h2 with hb hc,
have heq : v = w, by
  {  rw [← mk_rep v, ← mk_rep w,
  mk_eq_mk_iff' v.rep w.rep (rep_nonzero v) (rep_nonzero w)],
  use -b⁻¹*c,
  exact nt_lin_comb_implies_in_span hb hsz,  },
exact hneq heq,
end

/-Three points of a projective geometry are collinear if they are dependent-/
def collinear (u v w : ℙ K V) : Prop :=
  dependent _ ![u, v, w]

/--The collinear relation satisfies the axioms of a projective geometry as defined in
Modern Projective Geometry by Faure and Frolicher-/

/-Any two points of a projective space are collinear-/
lemma L1 (u v : ℙ K V) : collinear u v u :=
begin
unfold collinear,
rw dependent_iff_reps_dependent₃,
use [1, 0, -1],
split;
simp,
end

/-Two distinct points determine a line-/
lemma L2 (a b p q : ℙ K V) (h1 : collinear a p q) (h2 : collinear b p q)
  (hneq : p ≠ q) : collinear a b p :=
begin
unfold collinear at *,
rw dependent_iff_reps_dependent₃ at *,
rcases h1 with ⟨x₁, y₁, z₁, ⟨h1nt, h1z⟩⟩,
rcases h2 with ⟨x₂, y₂, z₂, ⟨h2nt, h2z⟩⟩,
cases classical.em (z₁ = 0) with hz₁ hz₁,
  { rw hz₁ at h1z,
  use [x₁, 0, y₁],
  split,
    {  by_contradiction,
    simp at *,
    exact h1nt h.1 h.2 hz₁,  },
    {  simp at *, assumption  },  },
  {  use  [- z₂*z₁⁻¹*x₁, x₂, y₂ - z₂*z₁⁻¹*y₁],
  split,
    {  have hx₂ : x₂ ≠ 0, from neq_implies_sc_neq_zero hneq h2nt h2z,
    simp, intros _ _, contradiction,  },
    {  have h2: 0 + (-z₂*z₁⁻¹) • (x₁ • a.rep + y₁ • p.rep + z₁ • q.rep)  = 0, by {  rw h1z, simp  },
    nth_rewrite 0 [ ← h2z] at h2,
    rw [smul_add, smul_add, ← mul_smul(-z₂*z₁⁻¹) z₁,
      (@mul_assoc K _ (-z₂) z₁⁻¹ z₁), inv_mul_cancel hz₁] at h2,
    simp at h2,
    rw ← h2,
    abel,
    repeat {  rw ← mul_smul  },
    rw [add_left_cancel_iff, add_comm (y₂ • p.rep) _, add_assoc _ _ (y₂ • p.rep)],
    simp,
    rw [add_comm],
    abel,
    rw [add_smul, add_left_cancel_iff, smul_assoc],  },  },
end

/-If a point belongs to two lines, then-/
lemma L3 (a b c d p : ℙ K V) (h1 : collinear p a b) (h2 : collinear p c d) :
  ∃ q : ℙ K V, collinear q a c ∧ collinear q b d :=
begin
unfold collinear at *,
rw dependent_iff_reps_dependent₃ at *,
rcases h1 with ⟨x₁, y₁, z₁, ⟨h1nt, h1z⟩⟩,
rcases h2 with ⟨x₂, y₂, z₂, ⟨h2nt, h2z⟩⟩,
simp_rw dependent_iff_reps_dependent₃,
cases classical.em (c = a) with hca hnca,
  {  rw hca,
  use b,
  split,
    {  use [ 0, -1, 1], simp  },
    {  use [-1, 1, 0], simp  }  },
  {  cases classical.em (x₁ = 0) with hx₁ hx₁,
    {  rw hx₁ at h1z,
    simp at h1z,
    have hab : a = b, by {rw [← pair_dependent_iff_eq, dependent_iff_reps_dependent₂], use [y₁, z₁], split, exact nontrivial_and_zero₁ h1nt hx₁, assumption,  },
    rw hab,
    use b,
    split; use [1,-1,0]; split; simp,  },
    {  cases classical.em (x₂ = 0) with hx₂ hx₂,
      {  rw hx₂ at h2z,
      simp at h2z,
      have hcd : c = d, by {  rw [← pair_dependent_iff_eq, dependent_iff_reps_dependent₂], use [y₂, z₂], split, exact nontrivial_and_zero₁ h2nt hx₂, assumption,  },
      rw hcd,
      use d,
      split; use [1, 0, -1]; split; simp,  },
      cases classical.em (y₂ = 0) with hy₂ hy₂,
        {  use a,
        rw hy₂ at h2z,
        simp at h2z,
        have hpd : p = d, by {  rw [← pair_dependent_iff_eq, dependent_iff_reps_dependent₂], use [x₂, z₂], split, exact nontrivial_and_zero₂ h2nt hy₂, exact h2z  },
        split,
          {  use [1, -1, 0], simp,  },
          {  rw ← hpd, use [y₁, z₁, x₁], simp, split,
            {  simp at h1nt, intros hy₁ hz₁, by_contradiction, exact h1nt h hy₁ hz₁  },
            {  rw [add_comm, ← add_assoc], exact h1z  },  },  },
        {  let q := (x₂⁻¹*y₂) • c.rep + (-x₁⁻¹*y₁) • a.rep,
        have hqneq : q ≠ 0, by
          {  by_contradiction,
          have hq : (x₂⁻¹*y₂) • c.rep + (-x₁⁻¹*y₁) • a.rep = 0, from h,
          have hx₂y₂ : x₂⁻¹*y₂ ≠ 0, by {  refine mul_ne_zero _ hy₂,  exact left_ne_zero_of_mul_eq_one (inv_mul_cancel hx₂),  },
          have tttt, from nt_lin_comb_implies_in_span hx₂y₂ hq,
          have hca : c = a, by {  rw [← mk_rep a, ← mk_rep c, mk_eq_mk_iff'], use -(x₂⁻¹*y₂)⁻¹*(-x₁⁻¹*y₁), exact tttt  },
          exact hnca hca, },
        use mk K q hqneq,
        have hk, from exists_smul_eq_mk_rep K q hqneq,
        cases hk with k hk,
        have hk' : (k : K) • q = (mk K q hqneq).rep, by {  exact hk  },
        have hnk : (k : K) ≠ 0, by {  rw ← units.exists_iff_ne_zero, use k  },
        rw ← hk',
        split,
          {  use [((↑k)⁻¹ : K), x₁⁻¹*y₁, -x₂⁻¹*y₂ ],
          rw [← mul_smul _ _ q, inv_mul_cancel hnk],
          simp,  },
          {  use [x₂*((↑k)⁻¹ : K), -(x₂*x₁⁻¹*z₁), z₂],
          split,
            {  simp, intro hzx₂, exfalso, exact hx₂ hzx₂  },
            { rw [← mul_smul _ _ q, mul_assoc, inv_mul_cancel hnk],
            simp,
            have h2 : 0 + (-x₂*x₁⁻¹) • (x₁ • p.rep + y₁ • a.rep + z₁ • b.rep) = 0, by {  rw h1z, simp  },
            nth_rewrite 0 [← h2z] at h2,
            repeat {  rw [smul_add, ← mul_smul] at h2  },
            repeat {  rw ← mul_smul  },
            rw [← mul_assoc, mul_inv_cancel hx₂],
            simp,
            rw [mul_assoc (-x₂) _ _, inv_mul_cancel hx₁, ← mul_smul] at h2,
            simp at h2,
            abel at h2,
            abel,
            rw ← mul_assoc x₂ x₁⁻¹ _,
            exact h2,  },  },  },  },  },
end

/- Dependence of points in the projective space is preserved by linear equivalences -/

variables {W : Type*} [add_comm_group W] [module K W]
variable (T : V ≃ₗ[K] W)

/- Projecting a nonzero vector to the quotient and evaluating an injective linear map
at that vector commute -/
@[simp] lemma map_mk_eq_mk' (T : V →ₗ[K] W) (hT : function.injective T)
  (v : V) (hv : v ≠ 0) :
  map T hT (mk K v hv) = mk K (T v) (by {rw ← (T.map_zero), exact hT.ne hv}) := by {  refl  }

lemma map_mk_eq_mk (v : V) (hv : v ≠ 0) :
  map T.to_linear_map T.injective (mk K v hv) =
  mk _ (T v) (T.map_ne_zero_iff.mpr hv) :=
  by {  refl  }

/-The map induced by an Isomorphism of vector spaces preserves independence-/
/- lemma independent_comp_iso_independent {ι : Type*} (f : ι → ℙ K V) (hi : independent _ f) :
  independent _ ((map T.to_linear_map T.injective) ∘ f) :=
begin
unfold independent at *,
suffices hsmul: ∃ g : ι → Kˣ, (projectivization.rep ∘ map T.to_linear_map T.injective ∘ f) = g • (T.to_linear_map ∘ projectivization.rep ∘ f), by
  {cases hsmul with g hg,
  rw hg,
  suffices h : linear_independent K (T.to_linear_map ∘ projectivization.rep ∘ f) ↔ linear_independent K (projectivization.rep ∘ f), by
    {rw ← h  at hi,
    exact linear_independent.units_smul hi g},

  have ht : linear_independent K (T.to_linear_map ∘ projectivization.rep ∘ f) ↔ linear_independent K (projectivization.rep ∘ f), from linear_map.linear_independent_iff T.to_linear_map (linear_equiv.ker T),
  exact ht  },
have g : ι → Kˣ, by
  {intro i,
  have ht, from map_mk_eq_mk' (T.to_linear_map) (T.injective) (projectivization.rep (f i)) (rep_nonzero (f i)),
  rw eq_iff _ _ at ht,

  },

end -/

/- Independence of points is preserved by linear equivalences-/
lemma independent_comp_iso_independent {ι : Type*} (f : ι → ℙ K V) (hi : independent _ f) :
  independent _ ((map T.to_linear_map T.injective) ∘ f) :=
begin
unfold independent at hi,
have hli, from linear_independent.map' hi T.to_linear_map (linear_equiv.ker T),
have hli', from independent'.mk (by {simp, intro i, exact rep_nonzero (f i), }) hli,
rw independent_iff,
  split,
  {sorry},
  {sorry},

end

/- Points are independent iff they are independent under the map induced by a linear equivalence-/
lemma independent_iff_iso_independent {ι : Type*} (f : ι → ℙ K V) :
  independent _ f ↔ independent _ ((map T.to_linear_map T.injective) ∘ f) :=
begin
split,
  { intro h,
    exact independent_comp_iso_independent _ f h},
  {intro h,
  have hT, from independent_comp_iso_independent T.symm ((map T.to_linear_map T.injective) ∘ f) h,
  rw [← function.comp.assoc, ← map_comp] at hT,
  suffices hid : map (T.symm.to_linear_map.comp T.to_linear_map) _ = map linear_map.id _, by
    {rw [hid, map_id] at hT,
    simp at hT,
    exact hT,},
  ext,
  unfold map,
  simp,},
end

/-Points are dependent iff they are dependent under the map induced by a linear equivalence-/
lemma dependent_iff_iso_dependent {ι : Type*} (f : ι → ℙ K V) :
  dependent _ f ↔ dependent _ ((map T.to_linear_map T.injective) ∘ f) :=
begin
rw [dependent_iff_not_independent, dependent_iff_not_independent, not_iff_not],
exact independent_iff_iso_independent _ _,
end

lemma independent_iff_independent₂ (u v : ℙ K V) : independent _ ![u, v] ↔
  independent _ ![map T.to_linear_map T.injective u, map T.to_linear_map T.injective v] :=
begin
rw ← fin_comp_commutes₂,
exact independent_iff_iso_independent _ _,
end

lemma independent_iff_independent₃ (u v w: ℙ K V) : independent _ ![u, v, w] ↔
  independent _ ![map T.to_linear_map T.injective u, map T.to_linear_map T.injective v,
  map T.to_linear_map T.injective w] :=
begin
rw ← fin_comp_commutes₃,
exact independent_iff_iso_independent _ _,
end

lemma dependent_iff_dependent₂ (u v : ℙ K V) : dependent _ ![u, v] ↔
  dependent _ ![map T.to_linear_map T.injective u, map T.to_linear_map T.injective v] :=
begin
rw ← fin_comp_commutes₂,
exact dependent_iff_iso_dependent _ _,
end

lemma dependent_iff_dependent₃ (u v w: ℙ K V) : dependent _ ![u, v, w] ↔
  dependent _ ![map T.to_linear_map T.injective u, map T.to_linear_map T.injective v,
  map T.to_linear_map T.injective w] :=
begin
rw ← fin_comp_commutes₃,
exact dependent_iff_iso_dependent _ _,
end


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import data.fintype.parity
import number_theory.legendre_symbol.zmod_char
import field_theory.finite.basic
import number_theory.legendre_symbol.gauss_sum

/-!
# Quadratic characters of finite fields

This file defines the quadratic character on a finite field `F` and proves
some basic statements about it.

## Tags

quadratic character
-/

/-!
### Definition of the quadratic character

We define the quadratic character of a finite field `F` with values in ℤ.
-/

section define

/-- Define the quadratic character with values in ℤ on a monoid with zero `α`.
It takes the value zero at zero; for non-zero argument `a : α`, it is `1`
if `a` is a square, otherwise it is `-1`.

This only deserves the name "character" when it is multiplicative,
e.g., when `α` is a finite field. See `quadratic_char_fun_mul`.

We will later define `quadratic_char` to be a multiplicative character
of type `mul_char F ℤ`, when the domain is a finite field `F`.
-/
def quadratic_char_fun (α : Type*) [monoid_with_zero α] [decidable_eq α]
  [decidable_pred (is_square : α → Prop)] (a : α) : ℤ :=
if a = 0 then 0 else if is_square a then 1 else -1

end define

/-!
### Basic properties of the quadratic character

We prove some properties of the quadratic character.
We work with a finite field `F` here.
The interesting case is when the characteristic of `F` is odd.
-/

section quadratic_char

open mul_char

variables {F : Type*} [field F] [fintype F] [decidable_eq F]

/-- Some basic API lemmas -/
lemma quadratic_char_fun_eq_zero_iff {a : F} : quadratic_char_fun F a = 0 ↔ a = 0 :=
begin
  simp only [quadratic_char_fun],
  by_cases ha : a = 0,
  { simp only [ha, eq_self_iff_true, if_true], },
  { simp only [ha, if_false, iff_false],
    split_ifs; simp only [neg_eq_zero, one_ne_zero, not_false_iff], },
end

@[simp]
lemma quadratic_char_fun_zero : quadratic_char_fun F 0 = 0 :=
by simp only [quadratic_char_fun, eq_self_iff_true, if_true, id.def]

@[simp]
lemma quadratic_char_fun_one : quadratic_char_fun F 1 = 1 :=
by simp only [quadratic_char_fun, one_ne_zero, is_square_one, if_true, if_false, id.def]

/-- If `ring_char F = 2`, then `quadratic_char_fun F` takes the value `1` on nonzero elements. -/
lemma quadratic_char_fun_eq_one_of_char_two (hF : ring_char F = 2) {a : F} (ha : a ≠ 0) :
  quadratic_char_fun F a = 1 :=
begin
  simp only [quadratic_char_fun, ha, if_false, ite_eq_left_iff],
  exact λ h, false.rec _ (h (finite_field.is_square_of_char_two hF a))
end

/-- If `ring_char F` is odd, then `quadratic_char_fun F a` can be computed in
terms of `a ^ (fintype.card F / 2)`. -/
lemma quadratic_char_fun_eq_pow_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
  quadratic_char_fun F a = if a ^ (fintype.card F / 2) = 1 then 1 else -1 :=
begin
  simp only [quadratic_char_fun, ha, if_false],
  simp_rw finite_field.is_square_iff hF ha,
end

/-- The quadratic character is multiplicative. -/
lemma quadratic_char_fun_mul (a b : F) :
  quadratic_char_fun F (a * b) = quadratic_char_fun F a * quadratic_char_fun F b :=
begin
  by_cases ha : a = 0,
  { rw [ha, zero_mul, quadratic_char_fun_zero, zero_mul], },
  -- now `a ≠ 0`
  by_cases hb : b = 0,
  { rw [hb, mul_zero, quadratic_char_fun_zero, mul_zero], },
  -- now `a ≠ 0` and `b ≠ 0`
  have hab := mul_ne_zero ha hb,
  by_cases hF : ring_char F = 2,
  { -- case `ring_char F = 2`
    rw [quadratic_char_fun_eq_one_of_char_two hF ha,
        quadratic_char_fun_eq_one_of_char_two hF hb,
        quadratic_char_fun_eq_one_of_char_two hF hab,
        mul_one], },
  { -- case of odd characteristic
    rw [quadratic_char_fun_eq_pow_of_char_ne_two hF ha,
        quadratic_char_fun_eq_pow_of_char_ne_two hF hb,
        quadratic_char_fun_eq_pow_of_char_ne_two hF hab,
        mul_pow],
    cases finite_field.pow_dichotomy hF hb with hb' hb',
    { simp only [hb', mul_one, eq_self_iff_true, if_true], },
    { have h := ring.neg_one_ne_one_of_char_ne_two hF, -- `-1 ≠ 1`
      simp only [hb', h, mul_neg, mul_one, if_false, ite_mul, neg_mul],
      cases finite_field.pow_dichotomy hF ha with ha' ha';
        simp only [ha', h, neg_neg, eq_self_iff_true, if_true, if_false], }, },
end

variables (F)

/-- The quadratic character as a multiplicative character. -/
@[simps] def quadratic_char : mul_char F ℤ :=
{ to_fun := quadratic_char_fun F,
  map_one' := quadratic_char_fun_one,
  map_mul' := quadratic_char_fun_mul,
  map_nonunit' := λ a ha, by { rw of_not_not (mt ne.is_unit ha), exact quadratic_char_fun_zero, } }

variables {F}

/-- The value of the quadratic character on `a` is zero iff `a = 0`. -/
lemma quadratic_char_eq_zero_iff {a : F} : quadratic_char F a = 0 ↔ a = 0 :=
quadratic_char_fun_eq_zero_iff

@[simp]
lemma quadratic_char_zero : quadratic_char F 0 = 0 :=
by simp only [quadratic_char_apply, quadratic_char_fun_zero]

/-- For nonzero `a : F`, `quadratic_char F a = 1 ↔ is_square a`. -/
lemma quadratic_char_one_iff_is_square {a : F} (ha : a ≠ 0) :
  quadratic_char F a = 1 ↔ is_square a :=
by simp only [quadratic_char_apply, quadratic_char_fun, ha, (dec_trivial : (-1 : ℤ) ≠ 1),
              if_false, ite_eq_left_iff, imp_false, not_not]

/-- The quadratic character takes the value `1` on nonzero squares. -/
lemma quadratic_char_sq_one' {a : F} (ha : a ≠ 0) : quadratic_char F (a ^ 2) = 1 :=
by simp only [quadratic_char_fun, ha, pow_eq_zero_iff, nat.succ_pos', is_square_sq, if_true,
              if_false, quadratic_char_apply]

/-- The square of the quadratic character on nonzero arguments is `1`. -/
lemma quadratic_char_sq_one {a : F} (ha : a ≠ 0) : (quadratic_char F a) ^ 2 = 1 :=
by rwa [pow_two, ← map_mul, ← pow_two, quadratic_char_sq_one']

/-- The quadratic character is `1` or `-1` on nonzero arguments. -/
lemma quadratic_char_dichotomy {a : F} (ha : a ≠ 0) :
  quadratic_char F a = 1 ∨ quadratic_char F a = -1 :=
sq_eq_one_iff.1 $ quadratic_char_sq_one ha

/-- The quadratic character is `1` or `-1` on nonzero arguments. -/
lemma quadratic_char_eq_neg_one_iff_not_one {a : F} (ha : a ≠ 0) :
  quadratic_char F a = -1 ↔ ¬ quadratic_char F a = 1 :=
begin
  refine ⟨λ h, _, λ h₂, (or_iff_right h₂).mp (quadratic_char_dichotomy ha)⟩,
  rw h,
  norm_num,
end

/-- For `a : F`, `quadratic_char F a = -1 ↔ ¬ is_square a`. -/
lemma quadratic_char_neg_one_iff_not_is_square {a : F} :
  quadratic_char F a = -1 ↔ ¬ is_square a :=
begin
  by_cases ha : a = 0,
  { simp only [ha, is_square_zero, mul_char.map_zero, zero_eq_neg, one_ne_zero, not_true], },
  { rw [quadratic_char_eq_neg_one_iff_not_one ha, quadratic_char_one_iff_is_square ha] },
end

/-- If `F` has odd characteristic, then `quadratic_char F` takes the value `-1`. -/
lemma quadratic_char_exists_neg_one (hF : ring_char F ≠ 2) : ∃ a, quadratic_char F a = -1 :=
(finite_field.exists_nonsquare hF).imp $ λ b h₁, quadratic_char_neg_one_iff_not_is_square.mpr h₁

/-- If `ring_char F = 2`, then `quadratic_char F` takes the value `1` on nonzero elements. -/
lemma quadratic_char_eq_one_of_char_two (hF : ring_char F = 2) {a : F} (ha : a ≠ 0) :
  quadratic_char F a = 1 :=
quadratic_char_fun_eq_one_of_char_two hF ha

/-- If `ring_char F` is odd, then `quadratic_char F a` can be computed in
terms of `a ^ (fintype.card F / 2)`. -/
lemma quadratic_char_eq_pow_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
  quadratic_char F a = if a ^ (fintype.card F / 2) = 1 then 1 else -1 :=
quadratic_char_fun_eq_pow_of_char_ne_two hF ha

lemma quadratic_char_eq_pow_of_char_ne_two' (hF : ring_char F ≠ 2) (a : F) :
  (quadratic_char F a : F) = a ^ (fintype.card F / 2) :=
begin
  by_cases ha : a = 0,
  { have : 0 < fintype.card F / 2 := nat.div_pos fintype.one_lt_card two_pos,
    simp only [ha, zero_pow this, quadratic_char_apply, quadratic_char_zero, int.cast_zero], },
  { rw [quadratic_char_eq_pow_of_char_ne_two hF ha],
    by_cases ha' : a ^ (fintype.card F / 2) = 1,
    { simp only [ha', eq_self_iff_true, if_true, int.cast_one], },
    { have ha'' := or.resolve_left (finite_field.pow_dichotomy hF ha) ha',
      simp only [ha'', int.cast_ite, int.cast_one, int.cast_neg, ite_eq_right_iff],
      exact eq.symm, } }
end

variables (F)

/-- The quadratic character is quadratic as a multiplicative character. -/
lemma quadratic_char_is_quadratic : (quadratic_char F).is_quadratic :=
begin
  intro a,
  by_cases ha : a = 0,
  { left, rw ha, exact quadratic_char_zero, },
  { right, exact quadratic_char_dichotomy ha, },
end

variables {F}

/-- The quadratic character is nontrivial as a multiplicative character
when the domain has odd characteristic. -/
lemma quadratic_char_is_nontrivial (hF : ring_char F ≠ 2) : (quadratic_char F).is_nontrivial :=
begin
  rcases quadratic_char_exists_neg_one hF with ⟨a, ha⟩,
  have hu : is_unit a := by { by_contra hf, rw map_nonunit _ hf at ha, norm_num at ha, },
  refine ⟨hu.unit, (_ : quadratic_char F a ≠ 1)⟩,
  rw ha,
  norm_num,
end

/-- The number of solutions to `x^2 = a` is determined by the quadratic character. -/
lemma quadratic_char_card_sqrts (hF : ring_char F ≠ 2) (a : F) :
  ↑{x : F | x^2 = a}.to_finset.card = quadratic_char F a + 1 :=
begin
  -- we consider the cases `a = 0`, `a` is a nonzero square and `a` is a nonsquare in turn
  by_cases h₀ : a = 0,
  { simp only [h₀, pow_eq_zero_iff, nat.succ_pos', int.coe_nat_succ, int.coe_nat_zero,
               mul_char.map_zero, set.set_of_eq_eq_singleton, set.to_finset_card,
               set.card_singleton], },
  { set s := {x : F | x^2 = a}.to_finset with hs,
    by_cases h : is_square a,
    { rw (quadratic_char_one_iff_is_square h₀).mpr h,
      rcases h with ⟨b, h⟩,
      rw [h, mul_self_eq_zero] at h₀,
      have h₁ : s = [b, -b].to_finset := by
      { ext x,
        simp only [finset.mem_filter, finset.mem_univ, true_and, list.to_finset_cons,
                   list.to_finset_nil, insert_emptyc_eq, finset.mem_insert, finset.mem_singleton],
        rw ← pow_two at h,
        simp only [hs, set.mem_to_finset, set.mem_set_of_eq, h],
        split,
        { exact eq_or_eq_neg_of_sq_eq_sq _ _, },
        { rintro (h₂ | h₂); rw h₂,
          simp only [neg_sq], }, },
      norm_cast,
      rw  [h₁, list.to_finset_cons, list.to_finset_cons, list.to_finset_nil],
      exact finset.card_doubleton
              (ne.symm (mt (ring.eq_self_iff_eq_zero_of_char_ne_two hF).mp h₀)), },
    { rw quadratic_char_neg_one_iff_not_is_square.mpr h,
      simp only [int.coe_nat_eq_zero, finset.card_eq_zero, set.to_finset_card,
                 fintype.card_of_finset, set.mem_set_of_eq, add_left_neg],
      ext x,
      simp only [iff_false, finset.mem_filter, finset.mem_univ, true_and, finset.not_mem_empty],
      rw is_square_iff_exists_sq at h,
      exact λ h', h ⟨_, h'.symm⟩, }, },
end

open_locale big_operators

/-- The sum over the values of the quadratic character is zero when the characteristic is odd. -/
lemma quadratic_char_sum_zero (hF : ring_char F ≠ 2) : ∑ (a : F), quadratic_char F a = 0 :=
is_nontrivial.sum_eq_zero (quadratic_char_is_nontrivial hF)

end quadratic_char

/-!
### Special values of the quadratic character

We express `quadratic_char F (-1)` in terms of `χ₄`.
-/

section special_values

open zmod mul_char

variables {F : Type*} [field F] [fintype F]

/-- The value of the quadratic character at `-1` -/
lemma quadratic_char_neg_one [decidable_eq F] (hF : ring_char F ≠ 2) :
  quadratic_char F (-1) = χ₄ (fintype.card F) :=
begin
  have h := quadratic_char_eq_pow_of_char_ne_two hF (neg_ne_zero.mpr one_ne_zero),
  rw [h, χ₄_eq_neg_one_pow (finite_field.odd_card_of_char_ne_two hF)],
  set n := fintype.card F / 2,
  cases (nat.even_or_odd n) with h₂ h₂,
  { simp only [even.neg_one_pow h₂, eq_self_iff_true, if_true], },
  { simp only [odd.neg_one_pow h₂, ite_eq_right_iff],
    exact λ hf, false.rec (1 = -1) (ring.neg_one_ne_one_of_char_ne_two hF hf), },
end

/-- `-1` is a square in `F` iff `#F` is not congruent to `3` mod `4`. -/
lemma finite_field.is_square_neg_one_iff : is_square (-1 : F) ↔ fintype.card F % 4 ≠ 3 :=
begin
  classical, -- suggested by the linter (instead of `[decidable_eq F]`)
  by_cases hF : ring_char F = 2,
  { simp only [finite_field.is_square_of_char_two hF, ne.def, true_iff],
    exact (λ hf, one_ne_zero  $ (nat.odd_of_mod_four_eq_three hf).symm.trans
                              $ finite_field.even_card_of_char_two hF) },
  { have h₁ := finite_field.odd_card_of_char_ne_two hF,
    rw [← quadratic_char_one_iff_is_square (neg_ne_zero.mpr (one_ne_zero' F)),
        quadratic_char_neg_one hF, χ₄_nat_eq_if_mod_four, h₁],
    simp only [nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
               imp_false, not_not],
    exact ⟨λ h, ne_of_eq_of_ne h (dec_trivial : 1 ≠ 3),
           or.resolve_right (nat.odd_mod_four_iff.mp h₁)⟩, },
end

/-- The value of the quadratic character at `2` -/
lemma quadratic_char_two [decidable_eq F] (hF : ring_char F ≠ 2) :
  quadratic_char F 2 = χ₈ (fintype.card F) :=
is_quadratic.eq_of_eq_coe (quadratic_char_is_quadratic F) is_quadratic_χ₈ hF
  ((quadratic_char_eq_pow_of_char_ne_two' hF 2).trans (finite_field.two_pow_card hF))

/-- `2` is a square in `F` iff `#F` is not congruent to `3` or `5` mod `8`. -/
lemma finite_field.is_square_two_iff :
  is_square (2 : F) ↔ fintype.card F % 8 ≠ 3 ∧ fintype.card F % 8 ≠ 5 :=
begin
  classical,
  by_cases hF : ring_char F = 2,
  focus
  { have h := finite_field.even_card_of_char_two hF,
    simp only [finite_field.is_square_of_char_two hF, true_iff], },
  rotate, focus
  { have h := finite_field.odd_card_of_char_ne_two hF,
    rw [← quadratic_char_one_iff_is_square (ring.two_ne_zero hF), quadratic_char_two hF,
        χ₈_nat_eq_if_mod_eight],
    simp only [h, nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
               imp_false, not_not], },
  all_goals
  { rw [← nat.mod_mod_of_dvd _ (by norm_num : 2 ∣ 8)] at h,
    have h₁ := nat.mod_lt (fintype.card F) (dec_trivial : 0 < 8),
    revert h₁ h,
    generalize : fintype.card F % 8 = n,
    dec_trivial!, }
end

/-- The value of the quadratic character at `-2` -/
lemma quadratic_char_neg_two [decidable_eq F] (hF : ring_char F ≠ 2) :
  quadratic_char F (-2) = χ₈' (fintype.card F) :=
begin
  rw [(by norm_num : (-2 : F) = (-1) * 2), map_mul, χ₈'_eq_χ₄_mul_χ₈, quadratic_char_neg_one hF,
      quadratic_char_two hF, @cast_nat_cast _ (zmod 4) _ _ _ (by norm_num : 4 ∣ 8)],
end

/-- `-2` is a square in `F` iff `#F` is not congruent to `5` or `7` mod `8`. -/
lemma finite_field.is_square_neg_two_iff :
  is_square (-2 : F) ↔ fintype.card F % 8 ≠ 5 ∧ fintype.card F % 8 ≠ 7 :=
begin
  classical,
  by_cases hF : ring_char F = 2,
  focus
  { have h := finite_field.even_card_of_char_two hF,
    simp only [finite_field.is_square_of_char_two hF, true_iff], },
  rotate, focus
  { have h := finite_field.odd_card_of_char_ne_two hF,
    rw [← quadratic_char_one_iff_is_square (neg_ne_zero.mpr (ring.two_ne_zero hF)),
        quadratic_char_neg_two hF, χ₈'_nat_eq_if_mod_eight],
    simp only [h, nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
               imp_false, not_not], },
  all_goals
  { rw [← nat.mod_mod_of_dvd _ (by norm_num : 2 ∣ 8)] at h,
    have h₁ := nat.mod_lt (fintype.card F) (dec_trivial : 0 < 8),
    revert h₁ h,
    generalize : fintype.card F % 8 = n,
    dec_trivial! }
end

/-- The relation between the values of the quadratic character of one field `F` at the
cardinality of another field `F'` and of the quadratic character of `F'` at the cardinality
of `F`. -/
lemma quadratic_char_card_card [decidable_eq F] (hF : ring_char F ≠ 2) {F' : Type*} [field F']
  [fintype F'] [decidable_eq F'] (hF' : ring_char F' ≠ 2) (h : ring_char F' ≠ ring_char F) :
  quadratic_char F (fintype.card F') = quadratic_char F' (quadratic_char F (-1) * fintype.card F) :=
begin
  let χ := (quadratic_char F).ring_hom_comp (algebra_map ℤ F'),
  have hχ₁ : χ.is_nontrivial,
  { obtain ⟨a, ha⟩ := quadratic_char_exists_neg_one hF,
    have hu : is_unit a,
    { contrapose ha,
      exact ne_of_eq_of_ne (map_nonunit (quadratic_char F) ha)
             (mt zero_eq_neg.mp one_ne_zero), },
    use hu.unit,
    simp only [is_unit.unit_spec, ring_hom_comp_apply, eq_int_cast, ne.def, ha],
    rw [int.cast_neg, int.cast_one],
    exact ring.neg_one_ne_one_of_char_ne_two hF', },
  have hχ₂ : χ.is_quadratic := is_quadratic.comp (quadratic_char_is_quadratic F) _,
  have h := char.card_pow_card hχ₁ hχ₂ h hF',
  rw [← quadratic_char_eq_pow_of_char_ne_two' hF'] at h,
  exact (is_quadratic.eq_of_eq_coe (quadratic_char_is_quadratic F')
             (quadratic_char_is_quadratic F) hF' h).symm,
end

/-- The value of the quadratic character at an odd prime `p` different from `ring_char F`. -/
lemma quadratic_char_odd_prime [decidable_eq F] (hF : ring_char F ≠ 2) {p : ℕ} [fact p.prime]
  (hp₁ : p ≠ 2) (hp₂ : ring_char F ≠ p) :
  quadratic_char F p = quadratic_char (zmod p) (χ₄ (fintype.card F) * fintype.card F) :=
begin
  rw [← quadratic_char_neg_one hF],
  have h := quadratic_char_card_card hF (ne_of_eq_of_ne (ring_char_zmod_n p) hp₁)
              (ne_of_eq_of_ne (ring_char_zmod_n p) hp₂.symm),
  rwa [card p] at h,
end

/-- An odd prime `p` is a square in `F` iff the quadratic character of `zmod p` does not
take the value `-1` on `χ₄(#F) * #F`. -/
lemma finite_field.is_square_odd_prime_iff (hF : ring_char F ≠ 2) {p : ℕ} [fact p.prime]
  (hp : p ≠ 2) :
  is_square (p : F) ↔ quadratic_char (zmod p) (χ₄ (fintype.card F) * fintype.card F) ≠ -1 :=
begin
  classical,
  by_cases hFp : ring_char F = p,
  { rw [show (p : F) = 0, by { rw ← hFp, exact ring_char.nat.cast_ring_char }],
    simp only [is_square_zero, ne.def, true_iff, map_mul],
    obtain ⟨n, _, hc⟩ := finite_field.card F (ring_char F),
    have hchar : ring_char F = ring_char (zmod p) := by {rw hFp, exact (ring_char_zmod_n p).symm},
    conv {congr, to_lhs, congr, skip, rw [hc, nat.cast_pow, map_pow, hchar, map_ring_char], },
    simp only [zero_pow n.pos, mul_zero, zero_eq_neg, one_ne_zero, not_false_iff], },
  { rw [← iff.not_left (@quadratic_char_neg_one_iff_not_is_square F _ _ _ _),
        quadratic_char_odd_prime hF hp],
    exact hFp, },
end

end special_values


/-
This file defines the at-most-k Boolean cardinality constraint.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import data.list.basic
import cnf.literal
import cnf.assignment
import cnf.clause
import cardinality.distinct

variables {V : Type*} [decidable_eq V] [inhabited V]

open assignment
open clause
open list
open nat
open distinct

def amk (k : nat) (l : list bool) : bool := l.count tt ≤ k

namespace amk

@[simp] theorem amk_nil (k : nat) : amk k [] = tt := rfl

@[simp] theorem amk_singleton_pos (k : nat) (b : bool) : amk (k + 1) [b] = tt :=
by { cases b; simp [amk, count_singleton'] }

protected def eval (k : nat) (τ : assignment V) (l : list (literal V)) : bool :=
  amk k (l.map (literal.eval τ))

variables (k : nat) (τ : assignment V) (l : list (literal V)) (lit : literal V)

@[simp] theorem eval_nil : amk.eval k τ [] = tt :=
by simp only [amk.eval, amk, count_nil, to_bool_true_eq_tt, zero_le, map_nil]

@[simp] theorem eval_singleton_pos : amk.eval (k + 1) τ [lit] = tt :=
by { cases h : lit.eval τ; simp [amk.eval, amk, count_singleton', h] }

@[simp] theorem eval_singleton_zero :
  (amk.eval 0 τ [lit] = tt) ↔ lit.eval τ = ff :=
begin
  cases h : (lit.eval τ),
  { split,
    { tautology },
    { intro _, simp [amk.eval, amk, h] } },
  { split,
    { intro hamk,
      simp [amk.eval, amk, h] at hamk,
      contradiction },
    { intro h, contradiction } }
end

theorem eval_tt_of_ge_length {k : nat} {l : list (literal V)} :
  k ≥ length l → ∀ (τ : assignment V), amk.eval k τ l = tt :=
begin
  intros hk τ,
  simp [amk.eval, amk],
  have := count_le_length tt (map (literal.eval τ) l),
  rw length_map at this,
  exact le_trans this hk
end

theorem eval_cons_pos {k : nat} {τ : assignment V} {lit : literal V} :
  lit.eval τ = tt → ∀ l, amk.eval (k + 1) τ (lit :: l) = amk.eval k τ l :=
assume hlit l, by simp [amk.eval, amk, hlit, succ_le_succ_iff]

theorem eval_cons_neg {k : nat} {τ : assignment V} {lit : literal V} :
  lit.eval τ = ff → ∀ l, amk.eval k τ (lit :: l) = amk.eval k τ l :=
assume hlit l, by simp [amk.eval, amk, hlit]

theorem eval_tt_of_le_of_eval_tt {τ : assignment V} {l : list (literal V)}
  {k₁ k₂ : nat} : k₁ ≤ k₂ → amk.eval k₁ τ l = tt → amk.eval k₂ τ l = tt :=
begin
  simp only [amk.eval, amk, ge_iff_le, to_bool_iff],
  intros hk h₁,
  exact le_trans h₁ hk
end

theorem eval_sublist {k : nat} {τ : assignment V} {l₁ l₂ : list (literal V)} :
  l₁ <+ l₂ → amk.eval k τ l₂ = tt → amk.eval k τ l₁ = tt :=
begin
  simp [amk.eval, amk],
  intros hs h,
  exact le_trans (sublist.count_le (sublist.map (literal.eval τ) hs) tt) h
end

theorem eval_drop {k : nat} {τ : assignment V} {l : list (literal V)} :
  amk.eval k τ l = tt → ∀ (i : nat), amk.eval k τ (l.drop i) = tt :=
assume hamk i, eval_sublist (drop_sublist i l) hamk

theorem eval_take {k : nat} {τ : assignment V} {l : list (literal V)} :
  amk.eval k τ l = tt → ∀ (i : nat), amk.eval k τ (l.take i) = tt :=
assume hamk i, eval_sublist (take_sublist i l) hamk

/-! # amz -/

theorem amz_of_amz_cons {τ : assignment V} {l : list (literal V)} {lit : literal V} :
  amk.eval 0 τ (lit :: l) = tt → amk.eval 0 τ l = tt :=
begin
  simp [amk.eval, amk], cases literal.eval τ lit; simp
end

-- The special case where k = 0 is handled
theorem amz_eval_tt_iff_forall_eval_ff :
  amk.eval 0 τ l = tt ↔ (∀ (lit : literal V), lit ∈ l → lit.eval τ = ff) :=
begin
  split,
  { simp [amk.eval, amk] },
  { intro h,
    rw [amk.eval, amk, to_bool_iff, le_zero_iff],
    apply count_eq_zero_of_not_mem,
    simpa }
end

-- Can be done with contrapose, somehow
theorem amz_eval_ff_iff_exists_eval_tt :
  amk.eval 0 τ l = ff ↔ (∃ (lit : literal V), lit ∈ l ∧ lit.eval τ = tt) :=
begin
  split,
  { contrapose, simp,
    exact (amz_eval_tt_iff_forall_eval_ff τ l).mpr },
  { contrapose, simp,
    exact (amz_eval_tt_iff_forall_eval_ff τ l).mp }
end

theorem eval_cons_pos_zero {τ : assignment V} {lit : literal V} :
  lit.eval τ = tt → ∀ l, amk.eval 0 τ (lit :: l) = ff :=
begin
  intros hlit l,
  apply (amz_eval_ff_iff_exists_eval_tt τ (lit :: l)).mpr,
  use [lit, mem_cons_self _ _, hlit]
end

/-! # back to general theorems -/

theorem eval_tail_pos {k i : nat} {τ : assignment V} {l : list (literal V)}
  {hi : i < length l} : (l.nth_le i hi).eval τ = tt →
  amk.eval (k + 1) τ (l.take (i + 1)) = amk.eval k τ (l.take i) :=
begin
  intro hamk,
  induction l with l₁ ls ih generalizing i k,
  { simp },
  { cases i,
    { simp },
    { rw [take, take],
      rw nth_le at hamk,
      rw [length, succ_lt_succ_iff] at hi,
      cases h₁ : (l₁.eval τ),
      { rw [eval_cons_neg h₁, eval_cons_neg h₁],
        exact ih hamk },
      { cases k,
        { rw eval_cons_pos_zero h₁, -- Can be tightened up
          rw eval_cons_pos h₁,
          by_contradiction,
          rw [eq_tt_eq_not_eq_ff, amz_eval_tt_iff_forall_eval_ff] at h,
          have : length (ls.take (i + 1)) = i + 1,
          { have h := length_take (i + 1) ls,
            have : min (i + 1) (length ls) = i + 1,
            { simp [succ_le_of_lt hi] },
            rw this at h,
            exact h },
          have hlen : i < length (ls.take (i + 1)),
          { rw this,
            exact lt_succ_self i },
          have hmem := nth_le_mem _ _ hlen,
          have : (ls.nth_le i _) = (ls.take (i.succ)).nth_le i hlen,
          { rw this at hlen,
            exact nth_le_take ls hi hlen },
          rw ← this at hmem,
          have hff := h _ hmem,
          have : literal.eval τ (ls.nth_le i hi) = tt,
          { assumption },
          rw this at hff,
          contradiction },
        { rw [eval_cons_pos h₁, eval_cons_pos h₁],
          exact ih hamk } } } }
end

theorem eval_tail_neg {k i : nat} {τ : assignment V} {l : list (literal V)}
  {hi : i < length l} : (l.nth_le i hi).eval τ = ff →
  amk.eval k τ (l.take (i + 1)) = amk.eval k τ (l.take i) :=
begin
  intro hamk,
  induction l with l₁ ls ih generalizing i k,
  { simp },
  { cases i,
    { simp at hamk, cases k; simp [hamk] },
    { rw [take, take],
      rw nth_le at hamk,
      rw [length, succ_lt_succ_iff] at hi,
      cases h₁ : (l₁.eval τ),
      { rw [eval_cons_neg h₁, eval_cons_neg h₁],
        exact ih hamk },
      { cases k,
        { rw [eval_cons_pos_zero h₁, eval_cons_pos_zero h₁] },
        { rw [eval_cons_pos h₁, eval_cons_pos h₁],
          exact ih hamk } } } }
end

-- Can probably be shortened with the correct order of cases
theorem exists_amk_split {k : nat} {τ : assignment V} {l : list (literal V)} :
  amk.eval k τ l = tt → ∀ {k₁ k₂ : nat}, k₁ + k₂ = k →
  ∃ {l₁ l₂ : list (literal V)}, l₁ ++ l₂ = l ∧
  amk.eval k₁ τ l₁ = tt ∧ amk.eval k₂ τ l₂ = tt :=
begin
  intros hamk k₁ k₂ hks,
  induction l with lit₁ ls ih generalizing k k₁ k₂,
  { use [[], []],
    simp },
  { cases k,
    { cases hlit₁ : (literal.eval τ lit₁),
      { rw eval_cons_neg hlit₁ at hamk,
        rcases ih hamk hks with ⟨l₁, l₂, hls, hl₁, hl₂⟩,
        use [(lit₁ :: l₁), l₂],
        simp [hls, eval_cons_neg hlit₁, hl₁, hl₂] },
      { rw [amz_eval_tt_iff_forall_eval_ff] at hamk,
        rw (hamk _ (mem_cons_self lit₁ ls)) at hlit₁,
        contradiction } },
    { cases k₁,
      { rw zero_add at hks, subst hks,
        use [[], lit₁ :: ls],
        simpa },
      { cases hlit₁ : (literal.eval τ lit₁),
        { rw eval_cons_neg hlit₁ at hamk,
          rcases ih hamk hks with ⟨l₁, l₂, hls, hl₁, hl₂⟩,
          use [(lit₁ :: l₁), l₂],
          simp [hls, eval_cons_neg hlit₁, hl₁, hl₂] },
        { rw succ_add at hks,
          rw eval_cons_pos hlit₁ at hamk,
          rcases ih hamk (succ.inj hks) with ⟨l₁, l₂, hls, hl₁, hl₂⟩,
          use [(lit₁ :: l₁), l₂],
          simp [hls, eval_cons_pos hlit₁, hl₁, hl₂] } } } }
end

theorem eval_eq_amk_of_eqod {τ₁ τ₂ : assignment V} {l : list (literal V)} :
  ∀ (k : nat), (eqod τ₁ τ₂ (clause.vars l)) → amk.eval k τ₁ l = amk.eval k τ₂ l :=
begin
  intros k heqod,
  induction l with l ls ih generalizing k,
  { simp only [eval_nil] },
  { have := eval_eq_of_eqod_of_var_mem heqod (mem_vars_of_mem (mem_cons_self l ls)),
    cases h : (l.eval τ₁),
    { rw eval_cons_neg h,
      rw this at h,
      rw eval_cons_neg h,
      exact ih (eqod_subset (vars_subset_of_vars_cons _ _) heqod) k },
    { cases k,
      { rw eval_cons_pos_zero h,
        rw this at h,
        rw eval_cons_pos_zero h },
      { rw eval_cons_pos h,
        rw this at h,
        rw eval_cons_pos h,
        exact ih (eqod_subset (vars_subset_of_vars_cons _ _) heqod) k } } }
end

/-! # amo -/

theorem amo_eval_tt_iff_distinct_eval_ff_of_eval_tt
  {τ : assignment V} {l : list (literal V)} :
  amk.eval 1 τ l = tt ↔ (∀ {lit₁ lit₂ : literal V},
  distinct lit₁ lit₂ l → lit₁.eval τ = tt → lit₂.eval τ = ff) :=
begin
  induction l with l₁ ls ih,
  { split,
    { intros _ lit₁ lit₂ hdis,
      exact absurd hdis (not_distinct_nil _ _) },
    { rw eval_nil, tautology } },
  { cases ls with l₂ ls,
    { split,
      { intros _ lit₁ lit₂ hdis,
        exact absurd hdis (not_distinct_singleton _ _ _) },
      { rw eval_singleton_pos, tautology } },
    { split,
      { intros heval lit₁ lit₂ hdis h₁,
        have hmem₂ := mem_tail_of_distinct_cons hdis,
        rcases hdis with ⟨i, j, hi, hj, hij, hil, hjl⟩,
        cases i,
        { rw nth_le at hil,
          rw [hil, eval_cons_pos h₁, amz_eval_tt_iff_forall_eval_ff] at heval,
          exact heval lit₂ hmem₂ },
        { cases j,
          { linarith },
          { have : distinct lit₁ lit₂ (l₂ :: ls),
            { rw [length, succ_lt_succ_iff] at hi hj,
              rw succ_lt_succ_iff at hij,
              rw nth_le at hil hjl,
              exact ⟨i, j, hi, hj, hij, hil, hjl⟩ },
            cases h : (literal.eval τ l₁),
            { rw eval_cons_neg h at heval,
              exact ih.mp heval this h₁ },
            { rw [eval_cons_pos h, amz_eval_tt_iff_forall_eval_ff] at heval,
              exact heval lit₂ hmem₂ } } } },
      { intro h,
        cases h₁ : (literal.eval τ l₁),
        { rw eval_cons_neg h₁,
          apply ih.mpr,
          intros lit₁ lit₂ hdis' h₁',
          exact h (distinct_cons_of_distinct l₁ hdis') h₁' },
        { rw [eval_cons_pos h₁, amz_eval_tt_iff_forall_eval_ff],
          intros x hx,
          exact h (distinct_cons_of_mem l₁ hx) h₁ } } } }
end

end amk


import data.nat.prime data.multiset
import data.list_extra data.multiset_extra

namespace nat

lemma list.coprime_prod {n : ℕ} {l : list ℕ} (h : list.all_prop (coprime n) l) :
 coprime n l.prod :=
begin
 induction l with m l ih,
 {rw[list.prod_nil],exact coprime_one_right n},
 {rw[list.all_prop] at h,rw[list.prod_cons],
  exact coprime.mul_right h.left (ih h.right),
 }
end

lemma multiset.coprime_prod {n : ℕ} {s : multiset ℕ}
 (h : multiset.all_prop (coprime n) s) : coprime n s.prod :=
begin
 rcases s with ⟨l⟩,
 have : quot.mk setoid.r l = (l : multiset ℕ) := rfl, rw[this] at *,
 rw[multiset.all_prop_coe] at h,rw[multiset.coe_prod],
 exact list.coprime_prod h
end

lemma list.coprime_prod_dvd_of_dvd {l : list ℕ} (hc : l.pairwise coprime)
 {n : ℕ} (hd : list.all_prop (λ p, p ∣ n) l) : l.prod ∣ n :=
begin
 induction l with m l ih,
 {rw[list.prod_nil],exact one_dvd n},
 {rw[list.pairwise_cons] at hc,
  rw[list.all_prop] at hd,rw[list.prod_cons],
  exact coprime.mul_dvd_of_dvd_of_dvd
   (list.coprime_prod (list.all_prop_iff.mpr hc.left))
    hd.left (ih hc.right hd.right),
 }
end

lemma multiset.coprime_prod_dvd_of_dvd {s : multiset ℕ} (hc : s.pairwise coprime)
 {n : ℕ} (hd : multiset.all_prop (λ p, p ∣ n) s) : s.prod ∣ n :=
begin
 rcases s with ⟨l⟩,
 have : quot.mk setoid.r l = (l : multiset ℕ) := rfl, rw[this] at *,
 have : symmetric coprime := λ n m, coprime.symm,
 rw[multiset.pairwise_coe_iff_pairwise this] at hc,
 rw[multiset.all_prop_coe] at hd,
 rw[multiset.coe_prod],
 exact list.coprime_prod_dvd_of_dvd hc hd,
end

lemma list.nodup_prime_coprime
 {l : list ℕ} (hd : l.nodup) (hp : list.all_prop nat.prime l) :
  l.pairwise coprime :=
begin
 let hp' := list.all_prop_iff.mp hp,
 apply @list.pairwise.imp_of_mem ℕ ne coprime l _ hd,
 {intros p q hpl hql hpq,exact (coprime_primes (hp' p hpl) (hp' q hql)).mpr hpq,},
end

lemma multiset.nodup_prime_coprime
 {s : multiset ℕ} (hd : s.nodup) (hp : multiset.all_prop nat.prime s) :
  s.pairwise coprime :=
begin
 rcases s with ⟨l⟩,
 have : quot.mk setoid.r l = (l : multiset ℕ) := rfl, rw[this] at *,
 rw[multiset.coe_nodup] at hd,
 rw[multiset.all_prop_coe] at hp,
 have : symmetric coprime := λ n m, coprime.symm,
 rw[multiset.pairwise_coe_iff_pairwise this],
 exact list.nodup_prime_coprime hd hp,
end

def padic_valuation (p : ℕ) (n : ℕ) : ℕ :=
  multiset.count p n.factors

def unique_factors (n : ℕ) := (n.factors : multiset ℕ).dedup

lemma mem_unique_factors {n : ℕ} (h : n ≠ 0) (p : ℕ) :
 p ∈ unique_factors n ↔ p.prime ∧ p ∣ n :=
begin
 dsimp[unique_factors],rw[multiset.mem_coe,list.mem_dedup],
 split,
 {intro h0,
  let h1 := ((nat.mem_factors h).mp h0).1,
  let h2 := (nat.mem_factors_iff_dvd h h1).mp h0,
  exact ⟨h1,h2⟩
 },{
  rintro ⟨h1,h2⟩,exact (nat.mem_factors_iff_dvd h h1).mpr h2,
 }
end

lemma unique_factors_coprime (n : ℕ) :
 (unique_factors n).pairwise coprime :=
begin
 by_cases h : n = 0,
 {rw[h],
  have : unique_factors 0 = 0 :=
   by { dsimp[unique_factors], rw[factors_zero], refl },
   rw[this],apply multiset.pairwise_zero},
 apply multiset.nodup_prime_coprime,
 {apply multiset.nodup_dedup},
 {rw[multiset.all_prop_iff],intros p hp,
  replace hp := multiset.mem_dedup.mp hp,
  rw[multiset.mem_coe] at hp,
  exact ((nat.mem_factors h).mp hp).1,
 }
end

def prime_power_factors (n : ℕ) :=
 (unique_factors n).map (λ p, p ^ (padic_valuation p n))

def prod_factors' (n : ℕ) (h : n ≠ 0) :
 (prime_power_factors n).prod = n :=
begin
 let f : multiset ℕ := n.factors,
 let f₁ := f.dedup,
 let u := λ p, multiset.prod (multiset.repeat p (multiset.count p f)),
 let v := λ p, p ^ (multiset.count p f),
 change (f₁.map v).prod = n,
 have : v = u := by {ext p,dsimp[u,v],rw[multiset.prod_repeat]},
 rw[this],
 let e : f.prod = n := by {rw[multiset.coe_prod],exact nat.prod_factors h},
 rw[← multiset.eq_repeat_count f] at e,
 rw[multiset.prod_bind] at e,
 exact e,
end

def square_free (n : ℕ) : Prop := ∀ k, (k * k) ∣ (n : ℕ) → k = 1

lemma square_free_iff (n : ℕ) :
 square_free n ↔ ∀ p, nat.prime p → ¬ (p * p ∣ n) :=
begin
 split,
 {intros h p p_prime hp,
  exact nat.prime.ne_one p_prime (h p hp),
 },{
  intros h k hk, by_contradiction hk',
  let p := nat.min_fac k,
  let p_prime := nat.min_fac_prime hk',
  let pp_dvd : p * p ∣ n :=
    dvd_trans (mul_dvd_mul k.min_fac_dvd k.min_fac_dvd) hk,
  exact (h p p_prime pp_dvd).elim
 }
end

def square_free_radical (n : ℕ) : ℕ :=
 (n.factors : multiset ℕ).dedup.prod

lemma square_free_radical_dvd (n : ℕ) :
 (square_free_radical n) ∣ n := begin
 by_cases hn : n = 0,
 {rw[hn],use 0,rw[mul_zero]},
 {
  let fl := n.factors,
  let fm : multiset ℕ := fl,
  let fs := fm.dedup,
  let ft := fm - fs,
  let hm : fm.prod = n :=
   (multiset.coe_prod fl).trans (nat.prod_factors hn),
  have hl : fs ≤ fm := multiset.dedup_le n.factors,
  have : fm = ft + fs := (tsub_add_cancel_of_le hl).symm,
  rw[this,multiset.prod_add,mul_comm] at hm,
  use ft.prod,exact hm.symm,
 }
end

lemma square_free_radical_primes {n : ℕ} (hn : n ≠ 0)
 {p : ℕ} (p_prime : nat.prime p) :
  p ∣ (square_free_radical n) ↔ p ∣ n :=
begin
 split,
 {intro h,exact dvd_trans h (square_free_radical_dvd n)},
 {intro p_dvd_n,
  let fl := n.factors,
  let fm : multiset ℕ := fl,
  let fs := fm.dedup,
  change p ∣ fs.prod,
  have : p ∈ fm := (nat.mem_factors_iff_dvd hn p_prime).mpr p_dvd_n,
  have : p ∈ fs := multiset.mem_dedup.mpr this,
  rw[← multiset.cons_erase this,multiset.prod_cons],
  apply dvd_mul_right,
 }
end

lemma square_free_radical_dvd_iff {n : ℕ} (hn : n ≠ 0) (m : ℕ) :
 (square_free_radical n) ∣ m ↔ ∀ p, nat.prime p → p ∣ n → p ∣ m := begin
split,
{intros h p p_prime p_dvd_n,
 exact dvd_trans ((square_free_radical_primes hn p_prime).mpr p_dvd_n) h,
},{
 intro h,dsimp[square_free_radical],
 apply multiset.coprime_prod_dvd_of_dvd (unique_factors_coprime n),
 rw[multiset.all_prop_iff],intros p hp,
 replace hp := (mem_unique_factors hn p).mp hp,
 exact h p hp.left hp.right,
}
end

lemma dvd_square_free_radical {n : ℕ} (hn : n ≠ 0) :
 ∃ (k : ℕ), n ∣ n.square_free_radical ^ k :=
begin
 let f : multiset ℕ := n.factors,
 let f₁ := f.dedup,
 rcases multiset.le_smul_dedup f with ⟨k,hk⟩,
 use k,change n ∣ f₁.prod ^ k,
 let f₂ := add_monoid.nsmul k f₁, change f ≤ f₂ at hk,
 have : f₂.prod = f₁.prod ^ k := by {
   dsimp[f₂],rw[multiset.prod_nsmul]
 },
 rw[← this],
 have : f.prod = n := by {rw[multiset.coe_prod,nat.prod_factors hn],},
 rw[← this,← tsub_add_cancel_of_le hk,multiset.prod_add],
 apply dvd_mul_left,
end

end nat


import .equipotent .data.fin.misc

universe u

def finitary (α : Type u) (n) := equipotent α (fin n)
def permutation (n) := finitary (fin n) n

namespace finitary

def eq_of_finitary_fin {m n} : finitary (fin m) n → m = n
:= assume H,
   decidable.by_contradiction $ assume ne,
     or.elim (lt_or_gt_of_ne ne)
       (assume Hlt, fin.not_injective_of_gt _ Hlt
         (bijection.injective_of_bijection H.bijection.inverse))
         (assume Hgt, fin.not_injective_of_gt _ Hgt (bijection.injective_of_bijection H.bijection))

variable {α : Type u}

lemma univalence {m n} : finitary α n → finitary α m → n = m :=
  assume Hn Hm,
     eq_of_finitary_fin (equipotent.trans (equipotent.symm Hn) Hm)

lemma {v} equipotent_of_eq {n} {β : Type v} : finitary α n → finitary β n → equipotent α β
:= assume Ha Hb, equipotent.trans Ha (equipotent.symm Hb)

def empty_0 : finitary empty 0 :=
{
    map := empty.rec _,
    bijection := {
        inv := fin.elim0,
        left_inverse_of_inv := empty.rec _,
        right_inverse_of_inv := take i, absurd i.is_lt (nat.not_lt_zero _)
    }
}
private lemma fin1_eq_zero : ∀ i : fin 1, i = 0
| ⟨0, is_lt⟩ := rfl
| ⟨n+1, is_lt⟩ := absurd (nat.lt_of_succ_lt_succ is_lt) (nat.not_lt_zero _)

instance : subsingleton (fin 1) := subsingleton.intro
  (λ i j, begin rw fin1_eq_zero i, rw fin1_eq_zero j end)
end finitary


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

-- BEGIN
variables {s t : ℕ → ℝ} {a b : ℝ}

#check sub_sub (a + b)

theorem converges_to_add
  (cs : converges_to s a) (ct : converges_to t b):
converges_to (λ n, s n + t n) (a + b) :=
begin
  intros ε εpos,
  dsimp,
  have ε2pos : 0 < ε / 2,
  { linarith },
  cases cs (ε / 2) ε2pos with Ns hs,
  cases ct (ε / 2) ε2pos with Nt ht,
  use max Ns Nt,
  intros n hn,
  specialize hs n (le_trans (le_max_left Ns Nt) hn),
  specialize ht n (le_trans (le_max_right Ns Nt) hn),
  rw (by ring : s n + t n - (a + b) = (s n - a) + (t n - b)),
  rw ← add_halves ε,
  have triangle := abs_add (s n - a) (t n - b),
  have lt_two_half_ε := add_lt_add hs ht,
  exact lt_of_le_of_lt triangle lt_two_half_ε,
end
-- END


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.fin.basic
import data.list.sort
import data.list.duplicate

/-!
# Equivalence between `fin (length l)` and elements of a list

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

Given a list `l`,

* if `l` has no duplicates, then `list.nodup.nth_le_equiv` is the equivalence between
  `fin (length l)` and `{x // x ∈ l}` sending `⟨i, hi⟩` to `⟨nth_le l i hi, _⟩` with the inverse
  sending `⟨x, hx⟩` to `⟨index_of x l, _⟩`;

* if `l` has no duplicates and contains every element of a type `α`, then
  `list.nodup.nth_le_equiv_of_forall_mem_list` defines an equivalence between
  `fin (length l)` and `α`;  if `α` does not have decidable equality, then
  there is a bijection `list.nodup.nth_le_bijection_of_forall_mem_list`;

* if `l` is sorted w.r.t. `(<)`, then `list.sorted.nth_le_iso` is the same bijection reinterpreted
  as an `order_iso`.

-/

namespace list

variable {α : Type*}

namespace nodup

/-- If `l` lists all the elements of `α` without duplicates, then `list.nth_le` defines
a bijection `fin l.length → α`.  See `list.nodup.nth_le_equiv_of_forall_mem_list`
for a version giving an equivalence when there is decidable equality. -/
@[simps]
def nth_le_bijection_of_forall_mem_list (l : list α) (nd : l.nodup) (h : ∀ (x : α), x ∈ l) :
  {f : fin l.length → α // function.bijective f} :=
⟨λ i, l.nth_le i i.property, λ i j h, fin.ext $ (nd.nth_le_inj_iff _ _).1 h,
 λ x, let ⟨i, hi, hl⟩ := list.mem_iff_nth_le.1 (h x) in ⟨⟨i, hi⟩, hl⟩⟩

variable [decidable_eq α]

/-- If `l` has no duplicates, then `list.nth_le` defines an equivalence between `fin (length l)` and
the set of elements of `l`. -/
@[simps]
def nth_le_equiv (l : list α) (H : nodup l) : fin (length l) ≃ {x // x ∈ l} :=
{ to_fun := λ i, ⟨nth_le l i i.2, nth_le_mem l i i.2⟩,
  inv_fun := λ x, ⟨index_of ↑x l, index_of_lt_length.2 x.2⟩,
  left_inv := λ i, by simp [H],
  right_inv := λ x, by simp }

/-- If `l` lists all the elements of `α` without duplicates, then `list.nth_le` defines
an equivalence between `fin l.length` and `α`.

See `list.nodup.nth_le_bijection_of_forall_mem_list` for a version without
decidable equality. -/
@[simps]
def nth_le_equiv_of_forall_mem_list (l : list α) (nd : l.nodup) (h : ∀ (x : α), x ∈ l) :
  fin l.length ≃ α :=
{ to_fun := λ i, l.nth_le i i.2,
  inv_fun := λ a, ⟨_, index_of_lt_length.2 (h a)⟩,
  left_inv := λ i, by simp [nd],
  right_inv := λ a, by simp }

end nodup

namespace sorted

variables [preorder α] {l : list α}

lemma nth_le_mono (h : l.sorted (≤)) :
  monotone (λ i : fin l.length, l.nth_le i i.2) :=
λ i j, h.rel_nth_le_of_le _ _

lemma nth_le_strict_mono (h : l.sorted (<)) :
  strict_mono (λ i : fin l.length, l.nth_le i i.2) :=
λ i j, h.rel_nth_le_of_lt _ _

variable [decidable_eq α]

/-- If `l` is a list sorted w.r.t. `(<)`, then `list.nth_le` defines an order isomorphism between
`fin (length l)` and the set of elements of `l`. -/
def nth_le_iso (l : list α) (H : sorted (<) l) : fin (length l) ≃o {x // x ∈ l} :=
{ to_equiv := H.nodup.nth_le_equiv l,
  map_rel_iff' := λ i j, H.nth_le_strict_mono.le_iff_le }

variables (H : sorted (<) l) {x : {x // x ∈ l}} {i : fin l.length}

@[simp] lemma coe_nth_le_iso_apply : (H.nth_le_iso l i : α) = nth_le l i i.2 := rfl
@[simp] lemma coe_nth_le_iso_symm_apply : ((H.nth_le_iso l).symm x : ℕ) = index_of ↑x l := rfl

end sorted

section sublist

/--
If there is `f`, an order-preserving embedding of `ℕ` into `ℕ` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`,
then `sublist l l'`.
-/

/--
A `l : list α` is `sublist l l'` for `l' : list α` iff
there is `f`, an order-preserving embedding of `ℕ` into `ℕ` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`.
-/
lemma sublist_iff_exists_order_embedding_nth_eq {l l' : list α} :
  l <+ l' ↔ ∃ (f : ℕ ↪o ℕ), ∀ (ix : ℕ), l.nth ix = l'.nth (f ix) :=
begin
  split,
  { intro H,
    induction H with xs ys y H IH xs ys x H IH,
    { simp },
    { obtain ⟨f, hf⟩ := IH,
      refine ⟨f.trans (order_embedding.of_strict_mono (+ 1) (λ _, by simp)), _⟩,
      simpa using hf },
    { obtain ⟨f, hf⟩ := IH,
      refine ⟨order_embedding.of_map_le_iff
        (λ (ix : ℕ), if ix = 0 then 0 else (f ix.pred).succ) _, _⟩,
      { rintro ⟨_|a⟩ ⟨_|b⟩;
        simp [nat.succ_le_succ_iff] },
      { rintro ⟨_|i⟩,
        { simp },
        { simpa using hf _ } } } },
  { rintro ⟨f, hf⟩,
    exact sublist_of_order_embedding_nth_eq f hf }
end

/--
A `l : list α` is `sublist l l'` for `l' : list α` iff
there is `f`, an order-preserving embedding of `fin l.length` into `fin l'.length` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`.
-/
lemma sublist_iff_exists_fin_order_embedding_nth_le_eq {l l' : list α} :
  l <+ l' ↔ ∃ (f : fin l.length ↪o fin l'.length),
    ∀ (ix : fin l.length), l.nth_le ix ix.is_lt = l'.nth_le (f ix) (f ix).is_lt :=
begin
  rw sublist_iff_exists_order_embedding_nth_eq,
  split,
  { rintro ⟨f, hf⟩,
    have h : ∀ {i : ℕ} (h : i < l.length), f i < l'.length,
    { intros i hi,
      specialize hf i,
      rw [nth_le_nth hi, eq_comm, nth_eq_some] at hf,
      obtain ⟨h, -⟩ := hf,
      exact h },
    refine ⟨order_embedding.of_map_le_iff (λ ix, ⟨f ix, h ix.is_lt⟩) _, _⟩,
    { simp },
    { intro i,
      apply option.some_injective,
      simpa [←nth_le_nth] using hf _ } },
  { rintro ⟨f, hf⟩,
    refine ⟨order_embedding.of_strict_mono
      (λ i, if hi : i < l.length then f ⟨i, hi⟩ else i + l'.length) _, _⟩,
    { intros i j h,
      dsimp only,
      split_ifs with hi hj hj hi,
      { simpa using h },
      { rw add_comm,
        exact lt_add_of_lt_of_pos (fin.is_lt _) (i.zero_le.trans_lt h) },
      { exact absurd (h.trans hj) hi },
      { simpa using h } },
    { intro i,
      simp only [order_embedding.coe_of_strict_mono],
      split_ifs with hi,
      { rw [nth_le_nth hi, nth_le_nth, ←hf],
        simp },
      { rw [nth_len_le, nth_len_le],
        { simp },
        { simpa using hi } } } }
end

/--
An element `x : α` of `l : list α` is a duplicate iff it can be found
at two distinct indices `n m : ℕ` inside the list `l`.
-/
lemma duplicate_iff_exists_distinct_nth_le {l : list α} {x : α} :
  l.duplicate x ↔ ∃ (n : ℕ) (hn : n < l.length) (m : ℕ) (hm : m < l.length) (h : n < m),
    x = l.nth_le n hn ∧ x = l.nth_le m hm :=
begin
  classical,
  rw [duplicate_iff_two_le_count, le_count_iff_replicate_sublist,
      sublist_iff_exists_fin_order_embedding_nth_le_eq],
  split,
  { rintro ⟨f, hf⟩,
    refine ⟨f ⟨0, by simp⟩, fin.is_lt _, f ⟨1, by simp⟩, fin.is_lt _, by simp, _, _⟩,
    { simpa using hf ⟨0, by simp⟩ },
    { simpa using hf ⟨1, by simp⟩ } },
  { rintro ⟨n, hn, m, hm, hnm, h, h'⟩,
    refine ⟨order_embedding.of_strict_mono (λ i, if (i : ℕ) = 0 then ⟨n, hn⟩ else ⟨m, hm⟩) _, _⟩,
    { rintros ⟨⟨_|i⟩, hi⟩ ⟨⟨_|j⟩, hj⟩,
      { simp },
      { simp [hnm] },
      { simp },
      { simp only [nat.lt_succ_iff, nat.succ_le_succ_iff, replicate, length, nonpos_iff_eq_zero]
          at hi hj,
        simp [hi, hj] } },
    { rintros ⟨⟨_|i⟩, hi⟩,
      { simpa using h },
      { simpa using h' } } }
end

end sublist

end list