import
  IMO2020.N5.regular_map
  IMO2020.N5.legendre_stack_map
  extra.number_theory.divisor_closed_prop

/-! # IMO 2020 N5, Generalized Version -/

namespace IMOSL
namespace IMO2020N5

open additive_map extra additive
open_locale classical

def good {α : Type*} (f : ℕ → α) (n : ℕ) := ∀ a b : ℕ, a ≠ 0 → b ≠ 0 → a + b = n → f a = f b

section extra_lemmas

lemma padic_add_eq_p_pow (p : ℕ) [fact (p.prime)] {a b k : ℕ} (ha : a ≠ 0) (hb : b ≠ 0)
  (h : a + b = p ^ k) : padic_val_nat p a = padic_val_nat p b :=
begin
  revert a b k ha hb h,
  suffices : ∀ {a b k : ℕ}, a ≠ 0 → b ≠ 0 → a + b = p ^ k → padic_val_nat p a ≤ padic_val_nat p b,
    intros a b k ha hb h; exact le_antisymm (this ha hb h) (this hb ha (by rw [add_comm, h])),
  intros a b k ha hb h,
  suffices : ∀ n : ℕ, p ^ n ∣ a → p ^ n ∣ b,
  { replace this := this (padic_val_nat p a) pow_padic_val_nat_dvd,
    rwa [padic_val_nat_dvd_iff, or_iff_right hb] at this },
  intros n h0,
  rw [nat.dvd_add_iff_right h0, h, nat.pow_dvd_pow_iff_le_right (fact.out p.prime).one_lt],
  refine le_of_lt (lt_of_not_le (λ h1, _)),
  rw [← nat.pow_dvd_pow_iff_le_right (fact.out p.prime).one_lt, ← h] at h1,
  replace h0 := nat.le_of_dvd (zero_lt_iff.mpr ha) (dvd_trans h1 h0),
  rw [add_le_iff_nonpos_right, le_zero_iff] at h0,
  exact hb h0
end

end extra_lemmas

section infinite_good_iff

variables {M : Type*} [add_cancel_comm_monoid M] (f : additive_map M)

/-- `1` is always `f`-good. -/
private lemma good_one : good f 1 :=
begin
  rintros a b ha hb h,
  rw ← zero_lt_iff at ha hb,
  exfalso; refine ne_of_gt _ h,
  rw ← nat.succ_le_iff at ha hb ⊢,
  exact add_le_add ha hb
end

/-- `0` is always `f`-good. -/
private lemma good_zero : good f 0 :=
  λ a b ha hb h, by exfalso; exact ha (add_eq_zero_iff.mp h).left

/-- The `f`-good predicate is divisor-closed. -/
private lemma good_dc : divisor_closed (good f) :=
begin
  rintros n h h0 d ⟨c, rfl⟩,
  rcases eq_or_ne c 0 with rfl | hc,
  exfalso; exact h d.mul_zero,
  intros a b ha hb h1,
  replace h0 := h0 _ _ (mul_ne_zero ha hc) (mul_ne_zero hb hc) (by rw [← add_mul, h1]),
  rwa [map_mul f ha hc, map_mul f hb hc, add_left_inj] at h0
end

/-- The `f`-good predicate is infinite iff `f` is either `wide` or `p`-strong for some prime `p`. -/
theorem good_infinite_iff_wide_or_strong :
  (set_of (good f)).infinite ↔ wide (good f) ∨ ∃ p : ℕ, p.prime ∧ strong p (good f) :=
  dc_infinite_iff_wide_or_strong (good_dc f)

end infinite_good_iff

section good_prime_props

variables {M : Type*} [add_cancel_comm_monoid M] {p : ℕ} [fact p.prime] {f : additive_map M} (h : good f p)
include h

private theorem good_prime_mul_lt_p {k m : ℕ} (hk : k ≠ 0) (hkp : k < p) (hm : m ≠ 0) (hmp : m < p) :
  f (k * m % p) = f k + f m :=
begin
  have hp := fact.out p.prime,
  revert m hm hmp; induction k using nat.strong_induction_on with k k_ih; intros m hm hmp,
  induction m using nat.strong_induction_on with m m_ih,
  cases lt_or_le (k * m) p with h0 h0,
  rw [nat.mod_eq_of_lt h0, map_mul f hk hm],
  let c := p / m,
  let d := p % m,
  have X : ∀ a b : ℕ, b % a ≠ 0 ↔ ¬a ∣ b :=
    λ a b, by rw [ne.def, nat.dvd_iff_mod_eq_zero],

  have hd : d ≠ 0 :=
  begin
    rw X; intros h1,
    rw [← zero_lt_iff, ← nat.succ_le_iff, le_iff_eq_or_lt, eq_comm] at hm,
    rcases hm with rfl | hm,
    rw mul_one at h0; exact not_le_of_lt hkp h0,
    replace hm := nat.min_fac_le_of_dvd hm h1,
    rw nat.prime.min_fac_eq hp at hm; exact not_le_of_lt hmp hm
  end,
  rw ← zero_lt_iff at hm,
  replace m_ih : f (k * d % p) = f k + f d :=
    m_ih d (p.mod_lt hm) hd (lt_trans (p.mod_lt hm) hmp),
  have hc : c ≠ 0 :=
    by rw [ne.def, nat.div_eq_zero_iff hm]; exact lt_asymm hmp,
  replace h0 : c < k :=
  begin
    rw le_iff_lt_or_eq at h0,
    rcases h0 with h0 | h0,
    rwa nat.div_lt_iff_lt_mul hm,
    simp only [d, h0, nat.mul_mod_left, not_lt_zero'] at hd,
    exfalso; exact hd rfl
  end,
  replace k_ih := @k_ih c h0 hc (lt_trans h0 hkp),
  have h1 : c * m + d = p := nat.div_add_mod' p m,
  have h2 : ∀ n : ℕ, n ≠ 0 → n < p → ¬p ∣ n :=
    λ n hn0, nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr hn0),
  have hcp := lt_trans h0 hkp,
  have hdp := lt_trans (p.mod_lt hm) hmp,
  replace hkp := h2 k hk hkp,
  rw zero_lt_iff at hm,
  replace hmp := h2 m hm hmp,
  have hkcmp := hp.not_dvd_mul hkp (hp.not_dvd_mul (h2 c hc hcp) hmp),
  rw [← add_left_inj (f c), add_assoc, add_comm (f m), add_comm,
      ← map_mul f hc hm, h _ d (mul_ne_zero hc hm) hd h1,
      ← m_ih, ← k_ih (by rw X; exact hp.not_dvd_mul hkp hmp) (nat.mod_lt _ hp.pos),
      ← nat.mod_eq_of_lt hcp, ← nat.mul_mod, mul_left_comm],
  refine h _ _ _ _ _,
  rw X; exact hkcmp,
  rw X; refine hp.not_dvd_mul hkp (h2 d hd hdp),
  rw [← nat.add_mod_add_of_le_add_mod, ← mul_add, h1, nat.mul_mod_left, zero_add],
  refine nat.le_mod_add_mod_of_dvd_add_of_not_dvd _ hkcmp,
  rw [← mul_add, h1, mul_comm]; use k
end

/-- The above result, but given completely in modulo `p`. -/
private theorem good_prime_mul_mod_p {k m : ℕ} (hkp : ¬p ∣ k) (hmp : ¬p ∣ m) :
  f (k * m % p) = f (k % p) + f (m % p) :=
begin
  rw [nat.dvd_iff_mod_eq_zero, ← ne.def] at hkp hmp,
  have hp := fact.out p.prime,
  rw [← good_prime_mul_lt_p h hkp (k.mod_lt hp.pos) hmp (m.mod_lt hp.pos), ← nat.mul_mod]
end

/-- A corollary of `good_prime_mul_mod_p` with power in place of multiplication. -/
private theorem good_prime_pow_mod_p {k : ℕ} (hkp : ¬p ∣ k) (t : ℕ) :
  f (k ^ t % p) = t • f (k % p) :=
begin
  induction t with t t_ih,
  rw [zero_smul, pow_zero, nat.mod_eq_of_lt (fact.out p.prime).one_lt, additive_map.map_one],
  rw [nat.succ_eq_add_one, pow_succ', add_smul, one_smul, good_prime_mul_mod_p h _ hkp, t_ih],
  rw ← nat.prime.coprime_iff_not_dvd (fact.out p.prime) at hkp ⊢,
  exact nat.coprime.pow_right t hkp
end

end good_prime_props

section pstrong_maps

variables {M : Type*} [add_cancel_comm_monoid M] {p : ℕ} [fact p.prime] (f : additive_map M)

private lemma pstrong_mod_p_induct {a : ℕ} (h : good f (p ^ a))
  {k : ℕ} (hkp : ¬p ∣ k) (h0 : k < p ^ a) : f k = f (k % p) :=
begin
  have hp := fact.out p.prime,
  rcases a.eq_zero_or_pos with rfl | h1,
  rw [pow_zero, nat.lt_one_iff] at h0,
  rw [h0, nat.zero_mod],
  revert hkp h0 k h; refine nat.le_induction _ _ a h1; clear h1 a,
  rw pow_one; intros h k hkp h0,
  rw nat.mod_eq_of_lt h0,
  intros n hn1 n_ih h k h0 h1,
  induction k using nat.strong_induction_on with k k_ih,
  cases lt_or_le k (p ^ n) with h2 h2,
  exact n_ih (good_dc f _ (pow_ne_zero _ hp.ne_zero) h _ ⟨p, pow_succ' p n⟩) h0 h2,
  clear n_ih,

  let c := p ^ (n + 1) / k,
  let d := p ^ (n + 1) % k,
  have X : ∀ a b : ℕ, b % a ≠ 0 ↔ ¬a ∣ b := λ a b, by rw [ne.def, nat.dvd_iff_mod_eq_zero],
  have hk : k ≠ 0 := by rintros rfl; exact h0 ⟨0, by rw mul_zero⟩,
  have hc : c ≠ 0 := ne_of_gt (nat.div_pos (le_of_lt h1) (zero_lt_iff.mpr hk)),
  have hd : d ≠ 0 := begin
    rw [X, nat.dvd_prime_pow hp]; rintros ⟨t, ht, rfl⟩,
    rw pow_le_pow_iff hp.one_lt at h2,
    replace h2 := pow_dvd_pow p (le_trans hn1 h2),
    rw pow_one at h2; exact h0 h2
  end,
  replace h2 : c < p :=
  begin
    rw le_iff_eq_or_lt at h2,
    rcases h2 with rfl | h2,
    exfalso; apply h0,
    replace hn1 := pow_dvd_pow p hn1,
    rwa pow_one at hn1,
    rwa [nat.div_lt_iff_lt_mul (zero_lt_iff.mpr hk), pow_succ, mul_lt_mul_left hp.pos]
  end,
  have h3 : c * k + d = p ^ (n + 1) := nat.div_add_mod' _ k,
  rw [← add_right_inj (f c), ← additive_map.map_mul f hc hk, h _ _ (mul_ne_zero hc hk) hd h3],
  replace h3 : p ∣ d + c * k := ⟨p ^ n, by rw [add_comm, h3, pow_succ]⟩,
  have h4 : ¬p ∣ c := nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr hc) h2,
  have h5 := nat.prime.not_dvd_mul hp h4 h0,
  have h6 : ¬p ∣ d := λ h6, by rw nat.dvd_add_right h6 at h3; exact h5 h3,
  have h7 : d < k := (p ^ (n + 1)).mod_lt (zero_lt_iff.mpr hk),
  replace k_ih := k_ih d h7 h6 (lt_trans h7 h1),
  replace h : good f p := good_dc f _ (pow_ne_zero _ hp.ne_zero) h _ ⟨p ^ n, by rw pow_succ⟩,
  rw [k_ih, ← nat.mod_eq_of_lt h2, ← good_prime_mul_mod_p h h4 h0,
      h (c * k % p) (d % p) (by rwa X) (by rwa X)],
  rw [add_comm, ← nat.add_mod_add_of_le_add_mod, nat.mod_eq_zero_of_dvd h3, zero_add],
  exact nat.le_mod_add_mod_of_dvd_add_of_not_dvd h3 h6
end

private lemma pstrong_is_regular (h : strong p (good f)) : is_regular_map M p f :=
begin
  have hp := fact.out p.prime,
  rw is_regular_map.iff; intros t h0,
  refine pstrong_mod_p_induct f (h t) _ (nat.lt_pow_self hp.one_lt t),
  rwa [nat.coprime_comm, nat.prime.coprime_iff_not_dvd hp] at h0
end

private lemma regular_pstrong_iff (c : M) (χ : additive (zmod p)ˣ →+ M) :
  strong p (good (regular_map M p (c, χ))) ↔ χ (of_mul (-1)) = 0 :=
begin
  have hp := fact.out p.prime,
  have h0 := hp.one_lt,
  refine ⟨λ h, _, λ h, _⟩,
  { have h1 := ne_of_gt (nat.sub_pos_of_lt h0),
    replace h := h 1 1 (p - 1) one_ne_zero h1
      (by rw [pow_one, add_comm, nat.sub_add_cancel (le_of_lt h0)]),
    rwa [regular_map.map_ne_zero _ one_ne_zero, padic_val_nat.one, zero_smul, zero_add,
         regular_map.map_ne_zero _ h1, padic_val_nat.eq_zero_of_not_dvd, zero_smul, zero_add,
         zmod.ord_compl.map_coprime_p_dvd_add p.coprime_one_left (_ : p ∣ 1 + (p - 1)),
         zmod.ord_compl.map_one, of_mul_one, add_monoid_hom.map_zero, eq_comm] at h,
    rw [add_comm, nat.sub_add_cancel (le_of_lt h0)],
    intros h2; refine not_lt_of_le (nat.le_of_dvd (zero_lt_iff.mpr h1) h2) _,
    exact nat.sub_lt hp.pos one_pos },
  { intros t a b ha hb h1,
    rw [regular_map.map_ne_zero _ ha, regular_map.map_ne_zero _ hb,
        padic_add_eq_p_pow p ha hb h1, add_right_inj],
    obtain ⟨k, u, v, rfl, rfl, hu, hv⟩ : ∃ k u v : ℕ,
      p ^ k * u = a ∧ p ^ k * v = b ∧ p.coprime u ∧ p.coprime v :=
    begin
      refine ⟨padic_val_nat p a, ord_compl[p] a, ord_compl[p] b, _, _,
        nat.coprime_ord_compl hp ha, nat.coprime_ord_compl hp hb⟩,
      rw [← nat.factorization_def _ hp, nat.ord_proj_mul_ord_compl_eq_self],
      rw [padic_add_eq_p_pow p ha hb h1, ← nat.factorization_def _ hp,
          nat.ord_proj_mul_ord_compl_eq_self]
    end,
    clear ha hb; rw ← mul_add at h1,
    rw nat.coprime_comm at hu hv,
    rw [zmod.ord_compl.map_self_pow_mul, zmod.ord_compl.map_self_pow_mul],
    suffices : zmod.ord_compl p v = -zmod.ord_compl p u,
      rw [this, ← neg_one_mul, of_mul_mul, add_monoid_hom.map_add, h, zero_add],
    clear h c χ _inst_1 M; refine zmod.ord_compl.map_coprime_p_dvd_add hu _,
    have h2 : p ^ k ∣ p ^ t := ⟨u + v, h1.symm⟩,
    rw [nat.pow_dvd_pow_iff_le_right h0, le_iff_exists_add] at h2,
    rcases h2 with ⟨c, rfl⟩,
    rw [pow_add, mul_eq_mul_left_iff, or_iff_left (pow_ne_zero _ hp.ne_zero)] at h1,
    use p ^ (c - 1); rw [h1, ← pow_succ, nat.sub_add_cancel],
    rw [← not_lt, nat.lt_one_iff]; rintros rfl,
    rw [pow_zero, nat.add_eq_one_iff] at h1,
    have X : ¬nat.coprime 0 p := by rw nat.coprime_zero_left; exact ne_of_gt h0,
    rcases h1 with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩,
    exacts [X hu, X hv] }
end

/-- Characterizations of `p`-strong maps -/
theorem pstrong_iff : strong p (good f) ↔
  ∃ (c : M) (χ : additive (zmod p)ˣ →+ M), χ (of_mul (-1)) = 0 ∧ f = regular_map M p (c, χ) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { obtain ⟨⟨c, χ⟩, rfl⟩ := pstrong_is_regular f h,
    rw regular_pstrong_iff at h,
    exact ⟨c, χ, h, rfl⟩ },
  { rcases h with ⟨c, χ, h, rfl⟩,
    rw regular_pstrong_iff; exact h }
end

end pstrong_maps

section torsion_free

variables {M : Type*} [add_cancel_comm_monoid M] [no_zero_smul_divisors ℕ M]

private lemma torsion_free_good_vals {f : additive_map M} {p : ℕ} (h : p.prime) (h0 : good f p)
  {k : ℕ} (h1 : k ≠ 0) (h2 : k < p) : f k = 0 :=
begin
  haveI : fact p.prime := ⟨h⟩,
  have h3 := nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr h1) h2,
  have h4 := good_prime_pow_mod_p h0 h3 p.totient,
  rw [← h.coprime_iff_not_dvd, nat.coprime_comm] at h3,
  replace h3 := nat.modeq.pow_totient h3,
  rw [nat.modeq, nat.mod_eq_of_lt h.one_lt] at h3,
  rw [h3, additive_map.map_one, nat.mod_eq_of_lt h2, eq_comm, smul_eq_zero, or_comm] at h4,
  cases h4 with h4 h4,
  exact h4,
  exfalso; exact ne_of_gt (nat.totient_pos h.pos) h4
end

private lemma torsion_free_wide_maps {f : additive_map M} : wide (good f) ↔ f = 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { ext k; rw zero_apply,
    rcases eq_or_ne k 0 with rfl | h0,
    rw additive_map.map_zero,
    obtain ⟨p, ⟨h1, h2⟩, h3⟩ := set.infinite.exists_nat_lt h k,
    exact torsion_free_good_vals h1 h2 h0 h3 },
  { subst h; unfold wide,
    convert nat.infinite_set_of_prime; ext p,
    refine and_iff_left (λ a b _ _ _, _),
    rw [additive_map.zero_apply, additive_map.zero_apply] }
end

private lemma torsion_free_pstrong_maps {f : additive_map M} {p : ℕ} (h : p.prime) :
  strong p (good f) ↔ (f : ℕ → M) = λ n, padic_val_nat p n • f p :=
begin
  haveI _inst_3 : fact p.prime := ⟨h⟩,
  refine ⟨λ h0, _, λ h0 k a b ha hb h, _⟩,
  { replace h : ∀ k : ℕ, k ≠ 0 → k < p → f k = 0 :=
      λ k, torsion_free_good_vals h (by convert h0 1; rw pow_one),
    rw pstrong_iff at h0,
    rcases h0 with ⟨c, χ, -, rfl⟩; ext x,
    rw ← regular_map.snd_eq_zero_iff at h; simp only [] at h; subst h,
    rcases eq_or_ne x 0 with rfl | h0,
    rw [regular_map.map_zero, padic_val_nat.zero, zero_smul],
    rw [regular_map.map_p, regular_map.map_ne_zero _ h0],
    simp only [add_monoid_hom.zero_apply, add_zero] },
  { rw h0; simp only [],
    rw padic_add_eq_p_pow p ha hb h }
end

/-- Characterizations of additive maps `f` with infinitely many `f`-good positive integers. -/
theorem good_infinite_iff_wide_case (f : additive_map M) : (set_of (good f)).infinite ↔
  ∃ p : ℕ, p.prime ∧ (f : ℕ → M) = λ n, padic_val_nat p n • f p :=
begin
  rw [good_infinite_iff_wide_or_strong, torsion_free_wide_maps]; split,
  { rintros (rfl | ⟨p, hp, h⟩),
    refine ⟨2, nat.prime_two, _⟩,
    ext x; rw [additive_map.zero_apply, additive_map.zero_apply, smul_zero],
    exact ⟨p, hp, (torsion_free_pstrong_maps hp).mp h⟩ },
  { rintros ⟨p, hp, h⟩,
    right; exact ⟨p, hp, (torsion_free_pstrong_maps hp).mpr h⟩ }
end

end torsion_free

section wide_map_construction

variables {M : Type*} [add_comm_monoid M]

private lemma wide_if_χ₄_eq_one {c : M} (hc : 2 • c = 0) {p : legendre_stack} (h : p.χ₄ = 1) :
  wide (good (p.map c hc)) :=
begin
  refine set.infinite_of_injective_forall_mem p.ascending.injective (λ n, ⟨p.is_prime n, _⟩),
  intros a b ha hb h0,
  replace hb : a < p n := by rwa [← h0, lt_add_iff_pos_right, zero_lt_iff],
  rw [eq_comm, add_comm, ← nat.sub_eq_iff_eq_add (le_of_lt hb)] at h0,
  rw [← p.map_p_sub_χ₄_eq_one hc h ha hb, h0]
end

/-- Non-zero wide map exists over `M` if `M` is not 2-torsion free. -/
theorem exists_nonzero_wide_if_not_two_torsion_free (h : ∃ c : M, c ≠ 0 ∧ 2 • c = 0) :
  ∃ f : additive_map M, f ≠ 0 ∧ wide (good f) :=
begin
  rcases h with ⟨c, h, hc⟩,
  cases exists_legendre_stack_χ₄_eq_one with p hp,
  exact ⟨p.map c hc, p.map_is_non_zero hc h, wide_if_χ₄_eq_one hc hp⟩
end

/-- Non-zero wide map exists over `zmod 2`. -/
theorem exists_nonzero_wide_zmod2 : ∃ f : additive_map (zmod 2), f ≠ 0 ∧ wide (good f) :=
  exists_nonzero_wide_if_not_two_torsion_free
    ⟨1, one_ne_zero, by rw [nat.smul_one_eq_coe, nat.cast_two]; refl⟩

end wide_map_construction

section wide_regular_distinction

/-- Wide regular maps must be zero -/
theorem wide_regular_map_is_zero {M : Type*} [add_cancel_comm_monoid M] {p : ℕ} [fact p.prime]
  {f : additive_map M} (h : is_regular_map M p f) (h0 : wide (good f)) : f = 0 :=
begin
  rw is_regular_map.zero_iff_at_le_p h,
  intros k h1 h2,
  rw is_regular_map.iff at h,
  replace h0 := set.infinite.exists_nat_lt h0 (p * p),
  rcases h0 with ⟨q, ⟨h0, h3⟩, h4⟩,
  have X := (fact.out p.prime).ne_zero,
  have X0 : k * p < q := lt_of_le_of_lt (mul_le_mul_right' h2 p) h4,
  have X1 : p < q := lt_of_le_of_lt p.le_mul_self h4,
  have X2 : q.coprime p := (nat.coprime_primes h0 (fact.out p.prime)).mpr (ne_of_gt X1),
  rw [← add_left_inj (f p), zero_add, ← additive_map.map_mul f h1 X,
      h3 (k * p) (q - k * p) (mul_ne_zero h1 X) (ne_of_gt (by rwa tsub_pos_iff_lt)),
      h3 p (q - p) X (ne_of_gt (by rwa tsub_pos_iff_lt)), h, h (q - p)],
  congr' 1,
  rw [← nat.add_mul_mod_self_right _ k, nat.sub_add_cancel (le_of_lt X0),
      ← nat.add_mod_right (q - p) p, nat.sub_add_cancel (le_of_lt X1)],
  rwa [← nat.coprime_add_self_left, nat.sub_add_cancel (le_of_lt X1)],
  rwa [← nat.coprime_add_mul_right_left _ _ k, nat.sub_add_cancel (le_of_lt X0)],
  rw [add_comm, nat.sub_add_cancel (le_of_lt X1)],
  rw [add_comm, nat.sub_add_cancel (le_of_lt X0)]
end

end wide_regular_distinction

end IMO2020N5
end IMOSL


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer
-/
import algebraic_geometry.locally_ringed_space
import algebraic_geometry.structure_sheaf
import logic.equiv.transfer_instance
import ring_theory.localization.localization_localization
import topology.sheaves.sheaf_condition.sites
import topology.sheaves.functors

/-!
# $Spec$ as a functor to locally ringed spaces.

We define the functor $Spec$ from commutative rings to locally ringed spaces.

## Implementation notes

We define $Spec$ in three consecutive steps, each with more structure than the last:

1. `Spec.to_Top`, valued in the category of topological spaces,
2. `Spec.to_SheafedSpace`, valued in the category of sheafed spaces and
3. `Spec.to_LocallyRingedSpace`, valued in the category of locally ringed spaces.

Additionally, we provide `Spec.to_PresheafedSpace` as a composition of `Spec.to_SheafedSpace` with
a forgetful functor.

## Related results

The adjunction `Γ ⊣ Spec` is constructed in `algebraic_geometry/Gamma_Spec_adjunction.lean`.

-/

noncomputable theory
universes u v

namespace algebraic_geometry
open opposite
open category_theory
open structure_sheaf Spec (structure_sheaf)

/--
The spectrum of a commutative ring, as a topological space.
-/
def Spec.Top_obj (R : CommRing) : Top := Top.of (prime_spectrum R)

/--
The induced map of a ring homomorphism on the ring spectra, as a morphism of topological spaces.
-/
def Spec.Top_map {R S : CommRing} (f : R ⟶ S) :
  Spec.Top_obj S ⟶ Spec.Top_obj R :=
prime_spectrum.comap f

@[simp] lemma Spec.Top_map_id (R : CommRing) :
  Spec.Top_map (𝟙 R) = 𝟙 (Spec.Top_obj R) :=
prime_spectrum.comap_id

lemma Spec.Top_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.Top_map (f ≫ g) = Spec.Top_map g ≫ Spec.Top_map f :=
prime_spectrum.comap_comp _ _

/--
The spectrum, as a contravariant functor from commutative rings to topological spaces.
-/
@[simps] def Spec.to_Top : CommRingᵒᵖ ⥤ Top :=
{ obj := λ R, Spec.Top_obj (unop R),
  map := λ R S f, Spec.Top_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.Top_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.Top_map_comp] }

/--
The spectrum of a commutative ring, as a `SheafedSpace`.
-/
@[simps] def Spec.SheafedSpace_obj (R : CommRing) : SheafedSpace CommRing :=
{ carrier := Spec.Top_obj R,
  presheaf := (structure_sheaf R).1,
  is_sheaf := (structure_sheaf R).2 }

/--
The induced map of a ring homomorphism on the ring spectra, as a morphism of sheafed spaces.
-/
@[simps] def Spec.SheafedSpace_map {R S : CommRing.{u}} (f : R ⟶ S) :
  Spec.SheafedSpace_obj S ⟶ Spec.SheafedSpace_obj R :=
{ base := Spec.Top_map f,
  c :=
  { app := λ U, comap f (unop U) ((topological_space.opens.map (Spec.Top_map f)).obj (unop U))
      (λ p, id),
    naturality' := λ U V i, ring_hom.ext $ λ s, subtype.eq $ funext $ λ p, rfl } }

@[simp] lemma Spec.SheafedSpace_map_id {R : CommRing} :
  Spec.SheafedSpace_map (𝟙 R) = 𝟙 (Spec.SheafedSpace_obj R) :=
PresheafedSpace.ext _ _ (Spec.Top_map_id R) $ nat_trans.ext _ _ $ funext $ λ U,
begin
  dsimp,
  erw [PresheafedSpace.id_c_app, comap_id], swap,
  { rw [Spec.Top_map_id, topological_space.opens.map_id_obj_unop] },
  simpa,
end

lemma Spec.SheafedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.SheafedSpace_map (f ≫ g) = Spec.SheafedSpace_map g ≫ Spec.SheafedSpace_map f :=
PresheafedSpace.ext _ _ (Spec.Top_map_comp f g) $ nat_trans.ext _ _ $ funext $ λ U,
by { dsimp, rw category_theory.functor.map_id, rw category.comp_id, erw comap_comp f g, refl }

/--
Spec, as a contravariant functor from commutative rings to sheafed spaces.
-/
@[simps] def Spec.to_SheafedSpace : CommRingᵒᵖ ⥤ SheafedSpace CommRing :=
{ obj := λ R, Spec.SheafedSpace_obj (unop R),
  map := λ R S f, Spec.SheafedSpace_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.SheafedSpace_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.SheafedSpace_map_comp] }

/--
Spec, as a contravariant functor from commutative rings to presheafed spaces.
-/
def Spec.to_PresheafedSpace : CommRingᵒᵖ ⥤ PresheafedSpace CommRing :=
  Spec.to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace

@[simp] lemma Spec.to_PresheafedSpace_obj (R : CommRingᵒᵖ) :
  Spec.to_PresheafedSpace.obj R = (Spec.SheafedSpace_obj (unop R)).to_PresheafedSpace := rfl

lemma Spec.to_PresheafedSpace_obj_op (R : CommRing) :
  Spec.to_PresheafedSpace.obj (op R) = (Spec.SheafedSpace_obj R).to_PresheafedSpace := rfl

@[simp] lemma Spec.to_PresheafedSpace_map (R S : CommRingᵒᵖ) (f : R ⟶ S) :
  Spec.to_PresheafedSpace.map f = Spec.SheafedSpace_map f.unop := rfl

lemma Spec.to_PresheafedSpace_map_op (R S : CommRing) (f : R ⟶ S) :
  Spec.to_PresheafedSpace.map f.op = Spec.SheafedSpace_map f := rfl

lemma Spec.basic_open_hom_ext {X : RingedSpace} {R : CommRing} {α β : X ⟶ Spec.SheafedSpace_obj R}
  (w : α.base = β.base) (h : ∀ r : R, let U := prime_spectrum.basic_open r in
    (to_open R U ≫ α.c.app (op U)) ≫ X.presheaf.map (eq_to_hom (by rw w)) =
     to_open R U ≫ β.c.app (op U)) : α = β :=
begin
  ext1,
  { apply ((Top.sheaf.pushforward β.base).obj X.sheaf).hom_ext _
      prime_spectrum.is_basis_basic_opens,
    intro r,
    apply (structure_sheaf.to_basic_open_epi R r).1,
    simpa using h r },
  exact w,
end

/--
The spectrum of a commutative ring, as a `LocallyRingedSpace`.
-/
@[simps] def Spec.LocallyRingedSpace_obj (R : CommRing) : LocallyRingedSpace :=
{ local_ring := λ x, @@ring_equiv.local_ring _
    (show local_ring (localization.at_prime _), by apply_instance) _
    (iso.CommRing_iso_to_ring_equiv $ stalk_iso R x).symm,
  .. Spec.SheafedSpace_obj R }

@[elementwise]
lemma stalk_map_to_stalk {R S : CommRing} (f : R ⟶ S) (p : prime_spectrum S) :
  to_stalk R (prime_spectrum.comap f p) ≫
  PresheafedSpace.stalk_map (Spec.SheafedSpace_map f) p =
  f ≫ to_stalk S p :=
begin
  erw [← to_open_germ S ⊤ ⟨p, trivial⟩, ← to_open_germ R ⊤ ⟨prime_spectrum.comap f p, trivial⟩,
    category.assoc, PresheafedSpace.stalk_map_germ (Spec.SheafedSpace_map f) ⊤ ⟨p, trivial⟩,
    Spec.SheafedSpace_map_c_app, to_open_comp_comap_assoc],
  refl
end

/--
Under the isomorphisms `stalk_iso`, the map `stalk_map (Spec.SheafedSpace_map f) p` corresponds
to the induced local ring homomorphism `localization.local_ring_hom`.
-/
@[elementwise]
lemma local_ring_hom_comp_stalk_iso {R S : CommRing} (f : R ⟶ S) (p : prime_spectrum S) :
  (stalk_iso R (prime_spectrum.comap f p)).hom ≫
    @category_struct.comp _ _
      (CommRing.of (localization.at_prime (prime_spectrum.comap f p).as_ideal))
      (CommRing.of (localization.at_prime p.as_ideal)) _
      (localization.local_ring_hom (prime_spectrum.comap f p).as_ideal p.as_ideal f rfl)
      (stalk_iso S p).inv =
  PresheafedSpace.stalk_map (Spec.SheafedSpace_map f) p :=
(stalk_iso R (prime_spectrum.comap f p)).eq_inv_comp.mp $ (stalk_iso S p).comp_inv_eq.mpr $
localization.local_ring_hom_unique _ _ _ _ $ λ x, by
rw [stalk_iso_hom, stalk_iso_inv, comp_apply, comp_apply, localization_to_stalk_of,
  stalk_map_to_stalk_apply, stalk_to_fiber_ring_hom_to_stalk]

/--
The induced map of a ring homomorphism on the prime spectra, as a morphism of locally ringed spaces.
-/
@[simps] def Spec.LocallyRingedSpace_map {R S : CommRing} (f : R ⟶ S) :
  Spec.LocallyRingedSpace_obj S ⟶ Spec.LocallyRingedSpace_obj R :=
subtype.mk (Spec.SheafedSpace_map f) $ λ p, is_local_ring_hom.mk $ λ a ha,
begin
  -- Here, we are showing that the map on prime spectra induced by `f` is really a morphism of
  -- *locally* ringed spaces, i.e. that the induced map on the stalks is a local ring homomorphism.
  rw ← local_ring_hom_comp_stalk_iso_apply at ha,
  replace ha := (stalk_iso S p).hom.is_unit_map ha,
  rw coe_inv_hom_id at ha,
  replace ha := is_local_ring_hom.map_nonunit _ ha,
  convert ring_hom.is_unit_map (stalk_iso R (prime_spectrum.comap f p)).inv ha,
  rw coe_hom_inv_id,
end

@[simp] lemma Spec.LocallyRingedSpace_map_id (R : CommRing) :
  Spec.LocallyRingedSpace_map (𝟙 R) = 𝟙 (Spec.LocallyRingedSpace_obj R) :=
subtype.ext $ by { rw [Spec.LocallyRingedSpace_map_coe, Spec.SheafedSpace_map_id], refl }

lemma Spec.LocallyRingedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.LocallyRingedSpace_map (f ≫ g) =
  Spec.LocallyRingedSpace_map g ≫ Spec.LocallyRingedSpace_map f :=
subtype.ext $ by { rw [Spec.LocallyRingedSpace_map_coe, Spec.SheafedSpace_map_comp], refl }

/--
Spec, as a contravariant functor from commutative rings to locally ringed spaces.
-/
@[simps] def Spec.to_LocallyRingedSpace : CommRingᵒᵖ ⥤ LocallyRingedSpace :=
{ obj := λ R, Spec.LocallyRingedSpace_obj (unop R),
  map := λ R S f, Spec.LocallyRingedSpace_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.LocallyRingedSpace_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.LocallyRingedSpace_map_comp] }

section Spec_Γ
open algebraic_geometry.LocallyRingedSpace

/-- The counit morphism `R ⟶ Γ(Spec R)` given by `algebraic_geometry.structure_sheaf.to_open`.  -/
@[simps] def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) :=
structure_sheaf.to_open R ⊤

instance is_iso_to_Spec_Γ (R : CommRing) : is_iso (to_Spec_Γ R) :=
by { cases R, apply structure_sheaf.is_iso_to_global }

@[reassoc]
lemma Spec_Γ_naturality {R S : CommRing} (f : R ⟶ S) :
  f ≫ to_Spec_Γ S = to_Spec_Γ R ≫ Γ.map (Spec.to_LocallyRingedSpace.map f.op).op :=
by { ext, symmetry, apply localization.local_ring_hom_to_map }

/-- The counit (`Spec_Γ_identity.inv.op`) of the adjunction `Γ ⊣ Spec` is an isomorphism. -/
@[simps hom_app inv_app] def Spec_Γ_identity : Spec.to_LocallyRingedSpace.right_op ⋙ Γ ≅ 𝟭 _ :=
iso.symm $ nat_iso.of_components (λ R, as_iso (to_Spec_Γ R) : _) (λ _ _, Spec_Γ_naturality)

end Spec_Γ

/-- The stalk map of `Spec M⁻¹R ⟶ Spec R` is an iso for each `p : Spec M⁻¹R`. -/
lemma Spec_map_localization_is_iso (R : CommRing) (M : submonoid R)
  (x : prime_spectrum (localization M)) :
  is_iso (PresheafedSpace.stalk_map (Spec.to_PresheafedSpace.map
    (CommRing.of_hom (algebra_map R (localization M))).op) x) :=
begin
  erw ← local_ring_hom_comp_stalk_iso,
  apply_with is_iso.comp_is_iso { instances := ff },
  apply_instance,
  apply_with is_iso.comp_is_iso { instances := ff },
  /- I do not know why this is defeq to the goal, but I'm happy to accept that it is. -/
  exact (show is_iso (is_localization.localization_localization_at_prime_iso_localization
    M x.as_ideal).to_ring_equiv.to_CommRing_iso.hom, by apply_instance),
  apply_instance
end

end algebraic_geometry


import free quiver misc

open_locale classical

open category_theory is_free_groupoid

universe u
variables {G : Type u} [groupoid.{u u} G] [is_free_groupoid G] [inhabited G]
  (T : subquiver (symmy gpd_gens : quiver G))

def path_to_hom : Π {a : G}, (¡T).path (default G) a → ((default G) ⟶ a)
| _ quiver.path.nil := 𝟙 _
| _ (quiver.path.cons p ⟨sum.inl f, _⟩) := (path_to_hom p) ≫ (gpd_emb f)
| _ (quiver.path.cons p ⟨sum.inr f, _⟩) := (path_to_hom p) ≫ inv (gpd_emb f)

variable [is_arbor ¡T]

def favourite_hom (a : G) : (default G ⟶ a) :=
path_to_hom T (default _)

def to_End {a b : G} (p : a ⟶ b) : End (default G) :=
favourite_hom T a ≫ p ≫ inv (favourite_hom T b)

lemma favourite_hom_root : favourite_hom T (default G) = 𝟙 _ :=
begin
  change path_to_hom T _ = _,
  have : default ((¡T).path (default G) _) = quiver.path.nil,
  { apply unique.default_eq },
  rw this, refl,
end

lemma End_to_End (p : End (default G)) : to_End T p = p :=
by {rw [to_End, favourite_hom_root], simp }

lemma to_End_eq_id {a b : G} {e : gpd_gens a b} :
  (sum.inl e) ∈ T a b ∨ (sum.inr e) ∈ T b a
    → to_End T (gpd_emb e) = 𝟙 _ :=
begin
  rw [to_End, ←category.assoc, is_iso.comp_inv_eq, category.id_comp,
    favourite_hom, favourite_hom],
  rintro (h | h),
  { set to_b : (¡T).path (default G) b :=
      quiver.path.cons (default _) ⟨sum.inl e, h⟩,
    have : default _ = to_b := unique.default_eq _,
    rw this, refl },
  { set to_a : (¡T).path (default G) a :=
      quiver.path.cons (default _) ⟨sum.inr e, h⟩,
    have : default _ = to_a := unique.default_eq _,
    simp only [this, path_to_hom, is_iso.inv_hom_id, category.comp_id, category.assoc] },
end

def functor_of_mul_hom {X} [group X] (f : (End (default G)) →* X) :
  G ⥤ single_obj X :=
{ obj := λ _, (),
  map := λ a b p, f (to_End T p),
  map_id' := begin intro a, convert f.map_one, simp [to_End] end,
  map_comp' := begin
    intros a b c p q,
    change _ = _ * _,
    rw ←f.map_mul,
    apply congr_arg,
    simp only [to_End, is_iso.inv_hom_id_assoc, End.mul_def, category.assoc]
  end }

-- an automorphism group in a free groupoid is freely generated by the
-- complement of a spanning tree.
-- conceptually, this is because
-- `(End r ⟶ X) ≃ (G ⥤ single_obj X / natural isos taking value 1 on r)`
--             `≃ functors G ⥤ single_obj X mapping spanning tree to 1 `
--             `≃ set functions on complement of spanning tree`.
def contract : is_free_group (End (default G)) :=
{ gp_gens := set.compl (tree_symmy T),
  gp_emb := λ tp, to_End T (gpd_emb tp.val.edge),
  gp_lift := begin
    introsI X _ f,
    let f' : valu gpd_gens X := λ a b e,
      if h : (sum.inl e ∈ T a b ∨ sum.inr e ∈ T b a) then 1
      else f ⟨⟨a, b, e⟩, h⟩,
    rcases gpd_lift @f' with ⟨F, hF, uF⟩,
    have F_path_to_hom : ∀ {a : G} {p : (¡T).path (default G) a},
      F.map (path_to_hom T p) = 1,
    { intros a p,
      induction p with b c p e ih,
      { apply F.map_id },
      rcases e with ⟨e, eT⟩,
      rcases e with e | e,
      { change F.map (_ ≫ _ ) = _,
        rw [functor.map_comp, ih, ←hF],
        change _ ≫ dite _ _ _ = _,
        rw dif_pos (or.inl eT),
        apply mul_one },
      { change F.map (_ ≫ inv _) = _,
        rw [F.map_comp, ih, F.map_inv],
        suffices : F.map (gpd_emb e) = 1,
        { rw [is_iso.comp_inv_eq, this], symmetry, apply mul_one },
        rw ←hF,
        change dite _ _ _ = _,
        rw dif_pos (or.inr eT) } },
    let ghom : (End (default G)) →* X := functor.map_End (default G) F,
    have sane : functor_of_mul_hom T ghom = F,
    { apply functor.hext,
      { intro, apply unit.ext },
      intros, apply heq_of_eq,
      change F.map ((path_to_hom T _) ≫ _ ≫ inv (path_to_hom T _)) =
        (show single_obj.star X ⟶ (), from F.map f_1),
      rw [F.map_comp, F.map_comp, F.map_inv, ←category.assoc,
          is_iso.comp_inv_eq, F_path_to_hom, F_path_to_hom],
      change _ * _ = _ * _,
      rw [mul_one, one_mul],
    },
    refine ⟨ghom, _, _⟩,
    { intro tp,
      change f _ = (functor_of_mul_hom T ghom).map _,
      rw [sane, ←hF], change f _ = dite _ _ _,
      rw dif_neg,
      { apply congr_arg, ext; refl },
      exact tp.property },
    { intros z zh,
      have : functor_of_mul_hom T z = F,
      { apply uF, intros a b e,
        change dite _ _ _ = z (to_End T _),
        split_ifs,
        { rw to_End_eq_id T h, exact z.map_one.symm },
        { apply zh } },
      ext,
      have : (functor_of_mul_hom T z).map x = (functor_of_mul_hom T ghom).map x,
      { rw [this, sane] },
      convert this; rw End_to_End },
  end }


import data.real.basic
import group_theory.finiteness
import algebra.group.defs

noncomputable theory

open set
open group
open subgroup
open add_group
open function

-- Let G be a group and S the set of representants of G/mG
variables (G : Type*) [add_comm_group G]

def fin_quotient (S : set G) [fintype S] (m : ℕ) := -- m ≥ 2
  ∀ g₀ : G, ∃ g : G, g₀ - m•g ∈ S

open_locale big_operators
def finite_set_generates (S : set G) [fintype S] :=
  ∀ (g : G), ∃ ι : G → ℤ, g = (∑ s in S.to_finset, (ι s)•s)

-- variables {S : set G} (hS_fin : finite S) (hS_ne : S.nonempty)

-- Heights formulated with a general m
structure height :=
  -- (nonneg : ∀ g : G, 0 ≤ ht g)
  (hfun : G → ℝ)
  (C₁ : G → ℝ) (C₁_pos : ∀ g : G, 0 ≤ C₁ g)
  (upper_bound : ∀ g₀ : G, ∀ g : G, hfun(g + g₀) ≤ 2*hfun g  + C₁ g₀)
  (m : ℕ) (Hm : m ≥ 2)
  (C₂ : ℝ) (C₂_pos : 0 ≤ C₂)
  (lower_bound : ∀ g : G, hfun (m•g) ≥ (m^2)*(hfun g) - C₂)
  (finite_boxes : ∀ C₃ : ℝ, {g : G | hfun g ≤ C₃}.finite)

-- variables {ht : G → ℝ} [height ht]
-- variables (hfinquot : fin_quotient S (height.m ht))

-- Needed lemma to define C
lemma Rnonempty {S : set G} [fintype S]
  (hS : S.nonempty) {f : G → ℝ}: (f '' S).to_finset.nonempty :=
begin
  obtain ⟨x, hx⟩ := hS,
  use f x,
  finish,
end

-- let C := max{C₁ -Q | Q : S} + C₂
def C {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (ht.m)) : ℝ :=
  (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) + ht.C₂

-- variable {Cₛ : ℝ} [(C ht S.hs_ne h) Cₛ]

-- If x ∈ S, C₁ -x ≤ max{C₁ -Q | Q : S}
lemma C₁_x_le_max_C1 {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (ht.m)) (x : G) (hx: x ∈ S):
  ht.C₁ (-x) ≤ (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) :=
begin
  apply finset.le_max',
  simp,
  use x,
  tauto,
end

-- 0 ≤ max{C₁ -Q | Q : S}
lemma max_pos_is_pos  {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (ht.m)) :
  (0 : ℝ) ≤ (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) :=
begin
  let hS' := hS,
  obtain ⟨x, hx⟩ := hS,

  calc
  (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS')) ≥ ht.C₁ (-x) : C₁_x_le_max_C1 G ht hS' h x hx
  ... ≥ 0 : ht.C₁_pos (-x),
end

-- If s∈S, then C₁ -s ≤ C
lemma C₁S_le_C {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (ht.m))
  (s : G) (hs : s ∈ S) : ht.C₁ (-s) ≤ (C G ht hS h) :=
begin
  calc
  (ht.C₁ (-s)) ≤ (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) :  C₁_x_le_max_C1 G ht hS h s hs
  ... ≤ (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) + ht.C₂ :
    by linarith [ht.C₂_pos],
end

-- C₂ ≤ C
lemma C₂_le_C {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (height.m ht)) :
  ht.C₂ ≤ (C G ht hS h) :=
begin
  calc
  ht.C₂ ≤ (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) + ht.C₂ :
    by linarith [max_pos_is_pos G ht hS h],
end

-- This C has the two important properties that combine C₁ and C₂
-- C₁
lemma useful_C_1 {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (g g₀ : G) (hg₀ : g₀ ∈ S) :
  (ht.hfun (g - g₀) ≤ 2*(ht.hfun g) + (C G ht hS h))
:=
begin
  calc
  ht.hfun (g - g₀) = ht.hfun (g + -g₀)       : by ring_nf
  ... ≤ 2*(ht.hfun g) + ht.C₁ (-g₀)          : ht.upper_bound (-g₀) g
  ... ≤ 2*(ht.hfun g) + (C G ht hS h)        : by linarith [C₁S_le_C G ht hS h g₀ hg₀],
end

-- Alternative version
lemma useful_C_1' {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (g g₀ : G) (hg₀ : g₀ ∈ S) :
  ht.hfun (g - g₀) + ht.C₂ ≤ 2*(ht.hfun g) + (C G ht hS h) :=
begin
  have HC : (C G ht hS h) = (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) + ht.C₂,
  refl,

  calc
  ht.hfun (g - g₀) + ht.C₂ = ht.hfun (g + -g₀) + ht.C₂ :
    by {ring_nf, linarith}
  ... ≤ 2*(ht.hfun g) + ht.C₁ (-g₀) + ht.C₂ :
    by linarith [ht.upper_bound (-g₀) g]
  ... ≤ 2*(ht.hfun g) + (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS)) + ht.C₂ :
    by linarith [ C₁_x_le_max_C1 G ht hS h g₀ hg₀]
  ... = 2*(ht.hfun g) + (C G ht hS h) :
    by linarith [HC],
end

-- (finset.max' ((λ s, ht.C₁ (-s)) '' S).to_finset (Rnonempty G hS_fin hS)) + ht.C₂

-- C₂
lemma useful_C_2 {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (g : G) :
  (ht.hfun (ht.m•g) ≥ ((ht.m)^2)*(ht.hfun g) - (C G ht hS h)) :=
begin
  calc
  ht.hfun (ht.m•g) ≥ ((ht.m)^2)*(ht.hfun g) - ht.C₂    : ht.lower_bound g
  ... ≥ ((ht.m)^2)*(ht.hfun g) - ht.C₂                 : by simp
  ... ≥ ((ht.m)^2)*(ht.hfun g) - (C G ht hS h)         : by linarith [C₂_le_C G ht hS h],
end

-- Reorder of the terms
lemma useful_C_2' {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (g : G) :
  (((ht.m)^2 : ℝ)*(ht.hfun g) ≤ ht.hfun (ht.m•g) + (C G ht hS h) ) :=
begin
  linarith [useful_C_2 G ht hS h g],
end

-- Set of generators: S ∪ {g : G | ht g ≤ C}
def U {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (height.m ht)) : set G :=
  S ∪ {g : G | ht.hfun g ≤ (C G ht hS h)}

def func {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) : G → G :=
  λ g₀, Exists.some (h g₀)

lemma func_spec {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (g₀ : G) :
  g₀ - ht.m • (func _ ht hS h g₀) ∈ S := Exists.some_spec (h g₀)

lemma fin_quot_property {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G) :
  ∃ (s g : G), s ∈ S ∧ ht.m • g = P - s :=
begin
  specialize h P,
  obtain ⟨g, H⟩ := h,
  use P - ht.m • g,
  use g,
  finish,
end

lemma P_inequality {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G):
  ∃ (g : G), ((ht.m)^2 : ℝ)*ht.hfun g ≤ 2*ht.hfun (P) + (C G ht hS h) :=
begin
  have H := fin_quot_property G ht hS h P,
  rcases H with ⟨s, g, Hsg⟩,
  use g,
  calc
  ((ht.m)^2 : ℝ)*(ht.hfun g) ≤ ht.hfun (ht.m•g) + ht.C₂  : by linarith [ht.lower_bound g]
  ... = ht.hfun (P - s) + ht.C₂                          : by rw Hsg.2
  ... ≤ 2*ht.hfun (P) + (C G ht hS h)                    : useful_C_1' G ht hS h P s Hsg.1,
end

-- Idea de la seqüencia:
-- seq_P 0 = P
-- seq_P succ n := el Q : G tal que seq_P n - Qₐ{iₙ} = mQ
noncomputable def seq_P {S : set G} [fintype S] (ht : height G)
  (P : G) (hS : S.nonempty) (h : fin_quotient G S ht.m) : ℕ → G
| 0 := P
| (n+1) := (func G ht hS h) (seq_P n)

-- Falta lemma diferents altures => diferents punts ?

-- m P_n+1 = P_n - s
lemma Pᵢ_property {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G) (n : ℕ):
  ∃ (s : S), ht.m • ((seq_P G ht P hS h) (n+1)) = ((seq_P G ht P hS h) n) - s:=

begin
  unfold seq_P,
  generalize hh : seq_P G ht P hS h n = Q,
  use Q - ht.m • func G ht hS h Q,
  exact func_spec _ ht hS h Q,
  simp,
end

-- m^2 h (P_n+1) ≤ 2 h (P_n) + C
lemma Pᵢ_inequality {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G) (n : ℕ):
  ((ht.m)^2 : ℝ)*ht.hfun ((seq_P G ht P hS h) (n+1)) ≤ 2*ht.hfun ((seq_P G ht P hS h) n) + (C G ht hS h) :=
begin
  obtain ⟨s, H⟩ := Pᵢ_property G ht hS h P n,

  calc
  ((ht.m)^2 : ℝ)*(ht.hfun ((seq_P G ht P hS h) (n+1))) ≤ ht.hfun (ht.m•((seq_P G ht P hS h) (n+1))) + ht.C₂  : by linarith [ht.lower_bound ((seq_P G ht P hS h) (n+1))]
  ... = ht.hfun (((seq_P G ht P hS h) n) - s) + ht.C₂  : by rw H
  ... ≤ 2*ht.hfun ((seq_P G ht P hS h) n) + (C G ht hS h)  : useful_C_1' G ht hS h ((seq_P G ht P hS h) n) s _,simp,
end

-- Rearrangement
lemma Pᵢ_inequality' {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G) (n : ℕ):
  ht.hfun ((seq_P G ht P hS h) (n+1)) ≤ (3/((ht.m)^2 : ℝ))*ht.hfun ((seq_P G ht P hS h) n) - (1/((ht.m)^2 : ℝ))*(ht.hfun ((seq_P G ht P hS h) n) - (C G ht hS h)) :=
begin
  have H := Pᵢ_inequality G ht hS h P n,
  calc
  ht.hfun ((seq_P G ht P hS h) (n+1)) ≤ (2*ht.hfun ((seq_P G ht P hS h) n) + (C G ht hS h))/((ht.m)^2 : ℝ) : sorry
  ... = (3/((ht.m)^2 : ℝ))*ht.hfun ((seq_P G ht P hS h) n) - (1/((ht.m)^2 : ℝ))*(ht.hfun ((seq_P G ht P hS h) n) - (C G ht hS h)) : sorry,
end

-- Sufficient condition for Pᵢ to be decreasing
lemma Pᵢ_decreasing {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S ht.m) (P : G) (n : ℕ)
  (H : (C G ht hS h) ≤ ht.hfun((seq_P G ht P hS h) n)):
  ht.hfun((seq_P G ht P hS h) (n+1)) ≤ ht.hfun((seq_P G ht P hS h) n) :=
begin
  sorry
end

-- lemma set_Pᵢ_w_n_elem_ht_le_C {S : set G} [fintype S] (ht : height G)
--   (hS : S.nonempty) (h : fin_quotient G S (height.m ht)) (P : G)
lemma elem_with_height_less_C {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (height.m ht)) (P : G) :
  ∃ (n : ℕ), ht.hfun ((seq_P G ht P hS h) n) ≤ (C G ht hS h) :=
begin
  by_contradiction HC,
  push_neg at HC,

  sorry

  -- Idea de la demo:
  -- Suposem el contrari
  -- Llavors per les desigualtats veiem que l'altura es va fent petita (altres lemmes?)
  -- Dir que tots els punts son diferents
  -- Dir que el conjunt de punts amb altura  ≤ ht P és infinit
  -- Arribem a contradicció
end

-- Descent theorem
theorem Descent_theorem {S : set G} [fintype S] (ht : height G)
  (hS : S.nonempty) (h : fin_quotient G S (height.m ht)) :
  finite_set_generates G S :=
begin

  -- Usar el lema usefull_C per obtenir la C
  -- Donar el subconjunt generador S ∪ {g : G | ht g ≤ C} (per propietats és finit)
  -- A partir d'aquí no entenc com funciona...
  -- Donat un P
  -- Definim la seq. {P_j} (amb les seves definicions/hipotesis)
  -- Veiem que dins de la seq. hi ha elements d'altura ≤ C, diem-li Pⱼ
  -- S'ha d veure que podem escriure P com a combinació de Qᵢ i algun Pⱼ
  -- Ho usem pel Pⱼ que té altura ≤ C

  sorry
end


import analysis.calculus.mean_value
import data.nat.factorial.basic
import data.nat.choose.basic
import basic
import exp
open polynomial

open set filter

noncomputable theory

lemma hermite_zero_zero : coeff (hermite 0) 0 = 1 := coeff_one_zero

lemma hermite_one_zero : coeff (hermite 1) 0 = 0 :=
begin
  rw hermite_one,
  exact coeff_X_zero,
end

lemma hermite_one_one : coeff (hermite 1) 1 = 1 :=
begin
  rw hermite_one,
  exact coeff_X_one,
end

lemma x_sub_dx_coeff (p : polynomial ℝ) (k : ℕ) :
coeff (x_sub_dx p) k = coeff (X*p) k - coeff (p.derivative) k := by simp

lemma hermite_coeff_recur (n k : ℕ) :
coeff (hermite (n + 1)) (k + 1) = coeff (hermite n) k - (k+2)*(coeff (hermite n) (k+2)) :=
begin
  rw [hermite_succ, x_sub_dx_coeff, coeff_X_mul, coeff_derivative, mul_comm],
  suffices : ((k+1 : ℕ) : ℝ) + 1 = k + 2,
  { rw this, },
  { simp only [nat.cast_add, nat.cast_one],
    ring, },
end

lemma hermite_coeff_upper (n k : ℕ) : coeff (hermite n) (n+k+1) = 0 :=
begin
  induction n with n ih generalizing k,
  { apply coeff_C },
  {  rw [hermite_coeff_recur,
      (by linarith : n + 1 + k = n + k + 1),
      (by linarith : n + k + 1 + 2 = n + (k + 2) + 1),
      ih k, ih (k+2), mul_zero, sub_zero] }
end

lemma hermite_coeff_upper' (n k : ℕ) (hnk : n < k) : coeff (hermite n) k = 0 :=
begin
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_lt hnk,
  apply hermite_coeff_upper
end

lemma hermite_coeff_top (n : ℕ) : coeff (hermite n) n = 1 :=
begin
  induction n with n ih,
  { apply coeff_C },
  { rw [hermite_coeff_recur, ih, hermite_coeff_upper, mul_zero, sub_zero] }
end

lemma hermite_coeff_recur_zero (n : ℕ) :
coeff (hermite (n + 1)) 0 = -(coeff (hermite n) 1) :=
begin
  rw [hermite_succ, x_sub_dx_def, coeff_sub, coeff_X_mul_zero, coeff_derivative, zero_sub, zero_add],
  norm_num
end

lemma hermite_coeff_odd_zero (n k : ℕ) : odd (n + k) → coeff (hermite n) k = 0 :=
begin
  induction n with n ih generalizing k,
  { intro h,
    rw zero_add at h,
    apply hermite_coeff_upper',
    cases k,
    { exfalso,
      exact nat.even_iff_not_odd.mp (even_zero) h },
    { exact ne_zero.pos (nat.succ k) } },
  { intro h,
    induction k with k ihk,
    { rw hermite_coeff_recur_zero,
      rw [ih 1 h, neg_zero] },
    { rw [hermite_coeff_recur, ih k, ih (k+2)],
      { ring },
      { rwa (by simp [nat.succ_add, nat.add_succ] : n.succ + k.succ = n + (k + 2)) at h },
      { rw (by simp [nat.succ_add, nat.add_succ] : n.succ + k.succ = n + k + 2) at h,
        exact (nat.odd_add.mp h).mpr even_two }}}
end


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

# Ring-theoretic supplement of data.polynomial.

## Main results
* `mv_polynomial.integral_domain`:
  If a ring is an integral domain, then so is its polynomial ring over finitely many variables.
* `polynomial.is_noetherian_ring`:
  Hilbert basis theorem, that if a ring is noetherian then so is its polynomial ring.
* `polynomial.wf_dvd_monoid`:
  If an integral domain is a `wf_dvd_monoid`, then so is its polynomial ring.
* `polynomial.unique_factorization_monoid`:
  If an integral domain is a `unique_factorization_monoid`, then so is its polynomial ring.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.char_p.basic
import Mathlib.data.mv_polynomial.comm_ring
import Mathlib.data.mv_polynomial.equiv
import Mathlib.data.polynomial.field_division
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.ring_theory.polynomial.content
import Mathlib.PostPort

universes u u_1 v w

namespace Mathlib

namespace polynomial

protected instance char_p {R : Type u} [semiring R] (p : ℕ) [h : char_p R p] :
    char_p (polynomial R) p :=
  sorry

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree ≤ `n`. -/
def degree_le (R : Type u) [comm_ring R] (n : with_bot ℕ) : submodule R (polynomial R) :=
  infi fun (k : ℕ) => infi fun (h : ↑k > n) => linear_map.ker (lcoeff R k)

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree < `n`. -/
def degree_lt (R : Type u) [comm_ring R] (n : ℕ) : submodule R (polynomial R) :=
  infi fun (k : ℕ) => infi fun (h : k ≥ n) => linear_map.ker (lcoeff R k)

theorem mem_degree_le {R : Type u} [comm_ring R] {n : with_bot ℕ} {f : polynomial R} :
    f ∈ degree_le R n ↔ degree f ≤ n :=
  sorry

theorem degree_le_mono {R : Type u} [comm_ring R] {m : with_bot ℕ} {n : with_bot ℕ} (H : m ≤ n) :
    degree_le R m ≤ degree_le R n :=
  fun (f : polynomial R) (hf : f ∈ degree_le R m) =>
    iff.mpr mem_degree_le (le_trans (iff.mp mem_degree_le hf) H)

theorem degree_le_eq_span_X_pow {R : Type u} [comm_ring R] {n : ℕ} :
    degree_le R ↑n =
        submodule.span R ↑(finset.image (fun (n : ℕ) => X ^ n) (finset.range (n + 1))) :=
  sorry

theorem mem_degree_lt {R : Type u} [comm_ring R] {n : ℕ} {f : polynomial R} :
    f ∈ degree_lt R n ↔ degree f < ↑n :=
  sorry

theorem degree_lt_mono {R : Type u} [comm_ring R] {m : ℕ} {n : ℕ} (H : m ≤ n) :
    degree_lt R m ≤ degree_lt R n :=
  fun (f : polynomial R) (hf : f ∈ degree_lt R m) =>
    iff.mpr mem_degree_lt (lt_of_lt_of_le (iff.mp mem_degree_lt hf) (iff.mpr with_bot.coe_le_coe H))

theorem degree_lt_eq_span_X_pow {R : Type u} [comm_ring R] {n : ℕ} :
    degree_lt R n = submodule.span R ↑(finset.image (fun (n : ℕ) => X ^ n) (finset.range n)) :=
  sorry

/-- The first `n` coefficients on `degree_lt n` form a linear equivalence with `fin n → F`. -/
def degree_lt_equiv (F : Type u_1) [field F] (n : ℕ) :
    linear_equiv F (↥(degree_lt F n)) (fin n → F) :=
  linear_equiv.mk (fun (p : ↥(degree_lt F n)) (n_1 : fin n) => coeff ↑p ↑n_1) sorry sorry
    (fun (f : fin n → F) =>
      { val := finset.sum finset.univ fun (i : fin n) => coe_fn (monomial ↑i) (f i),
        property := sorry })
    sorry sorry

/-- Given a polynomial, return the polynomial whose coefficients are in
the ring closure of the original coefficients. -/
def restriction {R : Type u} [comm_ring R] (p : polynomial R) :
    polynomial ↥(ring.closure ↑(finsupp.frange p)) :=
  finsupp.mk (finsupp.support p) (fun (i : ℕ) => { val := finsupp.to_fun p i, property := sorry })
    sorry

@[simp] theorem coeff_restriction {R : Type u} [comm_ring R] {p : polynomial R} {n : ℕ} :
    ↑(coeff (restriction p) n) = coeff p n :=
  rfl

@[simp] theorem coeff_restriction' {R : Type u} [comm_ring R] {p : polynomial R} {n : ℕ} :
    subtype.val (coeff (restriction p) n) = coeff p n :=
  rfl

@[simp] theorem map_restriction {R : Type u} [comm_ring R] (p : polynomial R) :
    map (algebra_map (↥(ring.closure ↑(finsupp.frange p))) R) (restriction p) = p :=
  sorry

@[simp] theorem degree_restriction {R : Type u} [comm_ring R] {p : polynomial R} :
    degree (restriction p) = degree p :=
  rfl

@[simp] theorem nat_degree_restriction {R : Type u} [comm_ring R] {p : polynomial R} :
    nat_degree (restriction p) = nat_degree p :=
  rfl

@[simp] theorem monic_restriction {R : Type u} [comm_ring R] {p : polynomial R} :
    monic (restriction p) ↔ monic p :=
  { mp := fun (H : monic (restriction p)) => congr_arg subtype.val H,
    mpr := fun (H : monic p) => subtype.eq H }

@[simp] theorem restriction_zero {R : Type u} [comm_ring R] : restriction 0 = 0 := rfl

@[simp] theorem restriction_one {R : Type u} [comm_ring R] : restriction 1 = 1 := sorry

theorem eval₂_restriction {R : Type u} [comm_ring R] {S : Type v} [ring S] {f : R →+* S} {x : S}
    {p : polynomial R} :
    eval₂ f x p =
        eval₂ (ring_hom.comp f (is_subring.subtype (ring.closure ↑(finsupp.frange p)))) x
          (restriction p) :=
  id (Eq.refl (finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e))

/-- Given a polynomial `p` and a subring `T` that contains the coefficients of `p`,
return the corresponding polynomial whose coefficients are in `T. -/
def to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T]
    (hp : ↑(finsupp.frange p) ⊆ T) : polynomial ↥T :=
  finsupp.mk (finsupp.support p) (fun (i : ℕ) => { val := finsupp.to_fun p i, property := sorry })
    sorry

@[simp] theorem coeff_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) {n : ℕ} :
    ↑(coeff (to_subring p T hp) n) = coeff p n :=
  rfl

@[simp] theorem coeff_to_subring' {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) {n : ℕ} :
    subtype.val (coeff (to_subring p T hp) n) = coeff p n :=
  rfl

@[simp] theorem degree_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : degree (to_subring p T hp) = degree p :=
  rfl

@[simp] theorem nat_degree_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : nat_degree (to_subring p T hp) = nat_degree p :=
  rfl

@[simp] theorem monic_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : monic (to_subring p T hp) ↔ monic p :=
  { mp := fun (H : monic (to_subring p T hp)) => congr_arg subtype.val H,
    mpr := fun (H : monic p) => subtype.eq H }

@[simp] theorem to_subring_zero {R : Type u} [comm_ring R] (T : set R) [is_subring T] :
    to_subring 0 T (set.empty_subset T) = 0 :=
  rfl

@[simp] theorem to_subring_one {R : Type u} [comm_ring R] (T : set R) [is_subring T] :
    to_subring 1 T
          (set.subset.trans (iff.mpr finset.coe_subset finsupp.frange_single)
            (iff.mpr finset.singleton_subset_set_iff is_submonoid.one_mem)) =
        1 :=
  sorry

@[simp] theorem map_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R)
    [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) :
    map (is_subring.subtype T) (to_subring p T hp) = p :=
  ext fun (n : ℕ) => coeff_map (is_subring.subtype T) n

/-- Given a polynomial whose coefficients are in some subring, return
the corresponding polynomial whose coefificents are in the ambient ring. -/
def of_subring {R : Type u} [comm_ring R] (T : set R) [is_subring T] (p : polynomial ↥T) :
    polynomial R :=
  finsupp.mk (finsupp.support p) (subtype.val ∘ finsupp.to_fun p) sorry

@[simp] theorem frange_of_subring {R : Type u} [comm_ring R] (T : set R) [is_subring T]
    {p : polynomial ↥T} : ↑(finsupp.frange (of_subring T p)) ⊆ T :=
  sorry

end polynomial

namespace ideal

/-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself -/
theorem polynomial_mem_ideal_of_coeff_mem_ideal {R : Type u} [comm_ring R]
    (I : ideal (polynomial R)) (p : polynomial R)
    (hp : ∀ (n : ℕ), polynomial.coeff p n ∈ comap polynomial.C I) : p ∈ I :=
  polynomial.sum_C_mul_X_eq p ▸
    submodule.sum_mem I
      fun (n : ℕ) (hn : n ∈ finsupp.support p) => mul_mem_right I (polynomial.X ^ n) (hp n)

/-- The push-forward of an ideal `I` of `R` to `polynomial R` via inclusion
 is exactly the set of polynomials whose coefficients are in `I` -/
theorem mem_map_C_iff {R : Type u} [comm_ring R] {I : ideal R} {f : polynomial R} :
    f ∈ map polynomial.C I ↔ ∀ (n : ℕ), polynomial.coeff f n ∈ I :=
  sorry

theorem quotient_map_C_eq_zero {R : Type u} [comm_ring R] {I : ideal R} (a : R) (H : a ∈ I) :
    coe_fn (ring_hom.comp (quotient.mk (map polynomial.C I)) polynomial.C) a = 0 :=
  sorry

theorem eval₂_C_mk_eq_zero {R : Type u} [comm_ring R] {I : ideal R} (f : polynomial R)
    (H : f ∈ map polynomial.C I) :
    coe_fn (polynomial.eval₂_ring_hom (ring_hom.comp polynomial.C (quotient.mk I)) polynomial.X) f =
        0 :=
  sorry

/-- If `I` is an ideal of `R`, then the ring polynomials over the quotient ring `I.quotient` is
isomorphic to the quotient of `polynomial R` by the ideal `map C I`,
where `map C I` contains exactly the polynomials whose coefficients all lie in `I` -/
def polynomial_quotient_equiv_quotient_polynomial {R : Type u} [comm_ring R] (I : ideal R) :
    polynomial (quotient I) ≃+* quotient (map polynomial.C I) :=
  ring_equiv.mk
    ⇑(polynomial.eval₂_ring_hom
        (quotient.lift I (ring_hom.comp (quotient.mk (map polynomial.C I)) polynomial.C)
          quotient_map_C_eq_zero)
        (coe_fn (quotient.mk (map polynomial.C I)) polynomial.X))
    ⇑(quotient.lift (map polynomial.C I)
        (polynomial.eval₂_ring_hom (ring_hom.comp polynomial.C (quotient.mk I)) polynomial.X)
        eval₂_C_mk_eq_zero)
    sorry sorry sorry sorry

/-- If `P` is a prime ideal of `R`, then `R[x]/(P)` is an integral domain. -/
theorem is_integral_domain_map_C_quotient {R : Type u} [comm_ring R] {P : ideal R}
    (H : is_prime P) : is_integral_domain (quotient (map polynomial.C P)) :=
  ring_equiv.is_integral_domain (polynomial (quotient P))
    (integral_domain.to_is_integral_domain (polynomial (quotient P)))
    (ring_equiv.symm (polynomial_quotient_equiv_quotient_polynomial P))

/-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
theorem is_prime_map_C_of_is_prime {R : Type u} [comm_ring R] {P : ideal R} (H : is_prime P) :
    is_prime (map polynomial.C P) :=
  iff.mp (quotient.is_integral_domain_iff_prime (map polynomial.C P))
    (is_integral_domain_map_C_quotient H)

/-- Given any ring `R` and an ideal `I` of `polynomial R`, we get a map `R → R[x] → R[x]/I`.
  If we let `R` be the image of `R` in `R[x]/I` then we also have a map `R[x] → R'[x]`.
  In particular we can map `I` across this map, to get `I'` and a new map `R' → R'[x] → R'[x]/I`.
  This theorem shows `I'` will not contain any non-zero constant polynomials
  -/
theorem eq_zero_of_polynomial_mem_map_range {R : Type u} [comm_ring R] (I : ideal (polynomial R))
    (x : ↥(ring_hom.range (ring_hom.comp (quotient.mk I) polynomial.C)))
    (hx :
      coe_fn polynomial.C x ∈
        map
          (polynomial.map_ring_hom
            (ring_hom.range_restrict (ring_hom.comp (quotient.mk I) polynomial.C)))
          I) :
    x = 0 :=
  sorry

/-- `polynomial R` is never a field for any ring `R`. -/
theorem polynomial_not_is_field {R : Type u} [comm_ring R] : ¬is_field (polynomial R) := sorry

/-- The only constant in a maximal ideal over a field is `0`. -/
theorem eq_zero_of_constant_mem_of_maximal {R : Type u} [comm_ring R] (hR : is_field R)
    (I : ideal (polynomial R)) [hI : is_maximal I] (x : R) (hx : coe_fn polynomial.C x ∈ I) :
    x = 0 :=
  sorry

/-- Transport an ideal of `R[X]` to an `R`-submodule of `R[X]`. -/
def of_polynomial {R : Type u} [comm_ring R] (I : ideal (polynomial R)) :
    submodule R (polynomial R) :=
  submodule.mk (submodule.carrier I) sorry sorry sorry

theorem mem_of_polynomial {R : Type u} [comm_ring R] {I : ideal (polynomial R)} (x : polynomial R) :
    x ∈ of_polynomial I ↔ x ∈ I :=
  iff.rfl

/-- Given an ideal `I` of `R[X]`, make the `R`-submodule of `I`
consisting of polynomials of degree ≤ `n`. -/
def degree_le {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : with_bot ℕ) :
    submodule R (polynomial R) :=
  polynomial.degree_le R n ⊓ of_polynomial I

/-- Given an ideal `I` of `R[X]`, make the ideal in `R` of
leading coefficients of polynomials in `I` with degree ≤ `n`. -/
def leading_coeff_nth {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : ℕ) : ideal R :=
  submodule.map (polynomial.lcoeff R n) (degree_le I ↑n)

theorem mem_leading_coeff_nth {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : ℕ)
    (x : R) :
    x ∈ leading_coeff_nth I n ↔
        ∃ (p : polynomial R),
          ∃ (H : p ∈ I), polynomial.degree p ≤ ↑n ∧ polynomial.leading_coeff p = x :=
  sorry

theorem mem_leading_coeff_nth_zero {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (x : R) :
    x ∈ leading_coeff_nth I 0 ↔ coe_fn polynomial.C x ∈ I :=
  sorry

theorem leading_coeff_nth_mono {R : Type u} [comm_ring R] (I : ideal (polynomial R)) {m : ℕ} {n : ℕ}
    (H : m ≤ n) : leading_coeff_nth I m ≤ leading_coeff_nth I n :=
  sorry

/-- Given an ideal `I` in `R[X]`, make the ideal in `R` of the
leading coefficients in `I`. -/
def leading_coeff {R : Type u} [comm_ring R] (I : ideal (polynomial R)) : ideal R :=
  supr fun (n : ℕ) => leading_coeff_nth I n

theorem mem_leading_coeff {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (x : R) :
    x ∈ leading_coeff I ↔ ∃ (p : polynomial R), ∃ (H : p ∈ I), polynomial.leading_coeff p = x :=
  sorry

theorem is_fg_degree_le {R : Type u} [comm_ring R] (I : ideal (polynomial R)) [is_noetherian_ring R]
    (n : ℕ) : submodule.fg (degree_le I ↑n) :=
  sorry

end ideal

namespace polynomial

protected instance wf_dvd_monoid {R : Type u_1} [integral_domain R] [wf_dvd_monoid R] :
    wf_dvd_monoid (polynomial R) :=
  sorry

end polynomial

/-- Hilbert basis theorem: a polynomial ring over a noetherian ring is a noetherian ring. -/
protected instance polynomial.is_noetherian_ring {R : Type u} [comm_ring R] [is_noetherian_ring R] :
    is_noetherian_ring (polynomial R) :=
  sorry

namespace polynomial

theorem exists_irreducible_of_degree_pos {R : Type u} [integral_domain R] [wf_dvd_monoid R]
    {f : polynomial R} (hf : 0 < degree f) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f :=
  wf_dvd_monoid.exists_irreducible_factor
    (fun (huf : is_unit f) => ne_of_gt hf (degree_eq_zero_of_is_unit huf))
    fun (hf0 : f = 0) => not_lt_of_lt hf (Eq.symm hf0 ▸ Eq.symm degree_zero ▸ with_bot.bot_lt_coe 0)

theorem exists_irreducible_of_nat_degree_pos {R : Type u} [integral_domain R] [wf_dvd_monoid R]
    {f : polynomial R} (hf : 0 < nat_degree f) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f :=
  sorry

theorem exists_irreducible_of_nat_degree_ne_zero {R : Type u} [integral_domain R] [wf_dvd_monoid R]
    {f : polynomial R} (hf : nat_degree f ≠ 0) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f :=
  exists_irreducible_of_nat_degree_pos (nat.pos_of_ne_zero hf)

theorem linear_independent_powers_iff_eval₂ {R : Type u} {M : Type w} [comm_ring R]
    [add_comm_group M] [module R M] (f : linear_map R M M) (v : M) :
    (linear_independent R fun (n : ℕ) => coe_fn (f ^ n) v) ↔
        ∀ (p : polynomial R), coe_fn (coe_fn (aeval f) p) v = 0 → p = 0 :=
  sorry

theorem disjoint_ker_aeval_of_coprime {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M]
    [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R}
    (hpq : is_coprime p q) :
    disjoint (linear_map.ker (coe_fn (aeval f) p)) (linear_map.ker (coe_fn (aeval f) q)) :=
  sorry

theorem sup_aeval_range_eq_top_of_coprime {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M]
    [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R}
    (hpq : is_coprime p q) :
    linear_map.range (coe_fn (aeval f) p) ⊔ linear_map.range (coe_fn (aeval f) q) = ⊤ :=
  sorry

theorem sup_ker_aeval_le_ker_aeval_mul {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M]
    [module R M] {f : linear_map R M M} {p : polynomial R} {q : polynomial R} :
    linear_map.ker (coe_fn (aeval f) p) ⊔ linear_map.ker (coe_fn (aeval f) q) ≤
        linear_map.ker (coe_fn (aeval f) (p * q)) :=
  sorry

theorem sup_ker_aeval_eq_ker_aeval_mul_of_coprime {R : Type u} {M : Type w} [comm_ring R]
    [add_comm_group M] [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R}
    (hpq : is_coprime p q) :
    linear_map.ker (coe_fn (aeval f) p) ⊔ linear_map.ker (coe_fn (aeval f) q) =
        linear_map.ker (coe_fn (aeval f) (p * q)) :=
  sorry

end polynomial

namespace mv_polynomial

theorem is_noetherian_ring_fin_0 {R : Type u} [comm_ring R] [is_noetherian_ring R] :
    is_noetherian_ring (mv_polynomial (fin 0) R) :=
  is_noetherian_ring_of_ring_equiv R
    (ring_equiv.trans (ring_equiv.symm (pempty_ring_equiv R))
      (ring_equiv_of_equiv R (equiv.symm fin_zero_equiv')))

theorem is_noetherian_ring_fin {R : Type u} [comm_ring R] [is_noetherian_ring R] {n : ℕ} :
    is_noetherian_ring (mv_polynomial (fin n) R) :=
  sorry

/-- The multivariate polynomial ring in finitely many variables over a noetherian ring
is itself a noetherian ring. -/
protected instance is_noetherian_ring {R : Type u} {σ : Type v} [comm_ring R] [fintype σ]
    [is_noetherian_ring R] : is_noetherian_ring (mv_polynomial σ R) :=
  trunc.induction_on (fintype.equiv_fin σ)
    fun (e : σ ≃ fin (fintype.card σ)) =>
      is_noetherian_ring_of_ring_equiv (mv_polynomial (fin (fintype.card σ)) R)
        (ring_equiv_of_equiv R (equiv.symm e))

theorem is_integral_domain_fin_zero (R : Type u) [comm_ring R] (hR : is_integral_domain R) :
    is_integral_domain (mv_polynomial (fin 0) R) :=
  ring_equiv.is_integral_domain R hR
    (ring_equiv.trans (ring_equiv_of_equiv R fin_zero_equiv') (pempty_ring_equiv R))

/-- Auxilliary lemma:
Multivariate polynomials over an integral domain
with variables indexed by `fin n` form an integral domain.
This fact is proven inductively,
and then used to prove the general case without any finiteness hypotheses.
See `mv_polynomial.integral_domain` for the general case. -/
theorem is_integral_domain_fin (R : Type u) [comm_ring R] (hR : is_integral_domain R) (n : ℕ) :
    is_integral_domain (mv_polynomial (fin n) R) :=
  sorry

theorem is_integral_domain_fintype (R : Type u) (σ : Type v) [comm_ring R] [fintype σ]
    (hR : is_integral_domain R) : is_integral_domain (mv_polynomial σ R) :=
  sorry

/-- Auxilliary definition:
Multivariate polynomials in finitely many variables over an integral domain form an integral domain.
This fact is proven by transport of structure from the `mv_polynomial.integral_domain_fin`,
and then used to prove the general case without finiteness hypotheses.
See `mv_polynomial.integral_domain` for the general case. -/
def integral_domain_fintype (R : Type u) (σ : Type v) [integral_domain R] [fintype σ] :
    integral_domain (mv_polynomial σ R) :=
  is_integral_domain.to_integral_domain (mv_polynomial σ R) sorry

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {R : Type u} [integral_domain R] {σ : Type v}
    (p : mv_polynomial σ R) (q : mv_polynomial σ R) (h : p * q = 0) : p = 0 ∨ q = 0 :=
  sorry

/-- The multivariate polynomial ring over an integral domain is an integral domain. -/
protected instance integral_domain {R : Type u} {σ : Type v} [integral_domain R] :
    integral_domain (mv_polynomial σ R) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub
    sorry sorry comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry sorry
    mv_polynomial.eq_zero_or_eq_zero_of_mul_eq_zero

theorem map_mv_polynomial_eq_eval₂ {R : Type u} {σ : Type v} [comm_ring R] {S : Type u_1}
    [comm_ring S] [fintype σ] (ϕ : mv_polynomial σ R →+* S) (p : mv_polynomial σ R) :
    coe_fn ϕ p = eval₂ (ring_hom.comp ϕ C) (fun (s : σ) => coe_fn ϕ (X s)) p :=
  sorry

end mv_polynomial

namespace polynomial

protected instance unique_factorization_monoid {D : Type u} [integral_domain D]
    [unique_factorization_monoid D] : unique_factorization_monoid (polynomial D) :=
  Mathlib.ufm_of_gcd_of_wf_dvd_monoid

end Mathlib