/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.derivative
import data.polynomial.ring_division
import ring_theory.euclidean_domain

/-!
# Theory of univariate polynomials

This file starts looking like the ring theory of $ R[X] $

-/

noncomputable theory
open_locale classical big_operators polynomial

namespace polynomial
universes u v w y z
variables {R : Type u} {S : Type v} {k : Type y} {A : Type z} {a b : R} {n : ℕ}

section is_domain
variables [comm_ring R] [is_domain R]

lemma roots_C_mul (p : R[X]) {a : R} (hzero : a ≠ 0) : (C a * p).roots = p.roots :=
begin
  by_cases hpzero : p = 0,
  { simp only [hpzero, mul_zero] },
  rw multiset.ext,
  intro b,
  have prodzero : C a * p ≠ 0,
  { simp only [hpzero, or_false, ne.def, mul_eq_zero, C_eq_zero, hzero, not_false_iff] },
  rw [count_roots, count_roots, root_multiplicity_mul prodzero],
  have mulzero : root_multiplicity b (C a) = 0,
  { simp only [hzero, root_multiplicity_eq_zero, eval_C, is_root.def, not_false_iff] },
  simp only [mulzero, zero_add]
end

lemma derivative_root_multiplicity_of_root [char_zero R] {p : R[X]} {t : R} (hpt : p.is_root t) :
  p.derivative.root_multiplicity t = p.root_multiplicity t - 1 :=
begin
  rcases eq_or_ne p 0 with rfl | hp,
  { simp },
  nth_rewrite 0 [←p.div_by_monic_mul_pow_root_multiplicity_eq t],
  simp only [derivative_pow, derivative_mul, derivative_sub, derivative_X,
             derivative_C, sub_zero, mul_one],
  set n := p.root_multiplicity t - 1,
  have hn : n + 1 = _ := tsub_add_cancel_of_le ((root_multiplicity_pos hp).mpr hpt),
  rw ←hn,
  set q := p /ₘ (X - C t) ^ (n + 1) with hq,
  convert_to root_multiplicity t ((X - C t) ^ n * (derivative q * (X - C t) + q * ↑(n + 1))) = n,
  { congr,
    rw [mul_add, mul_left_comm $ (X - C t) ^ n, ←pow_succ'],
    congr' 1,
    rw [mul_left_comm $ (X - C t) ^ n, mul_comm $ (X - C t) ^ n] },
  have h : (derivative q * (X - C t) + q * ↑(n + 1)).eval t ≠ 0,
  { suffices : eval t q * ↑(n + 1) ≠ 0,
    { simpa },
    refine mul_ne_zero _ (nat.cast_ne_zero.mpr n.succ_ne_zero),
    convert eval_div_by_monic_pow_root_multiplicity_ne_zero t hp,
    exact hn ▸ hq },
  rw [root_multiplicity_mul, root_multiplicity_X_sub_C_pow, root_multiplicity_eq_zero h, add_zero],
  refine mul_ne_zero (pow_ne_zero n $ X_sub_C_ne_zero t) _,
  contrapose! h,
  rw [h, eval_zero]
end

lemma root_multiplicity_sub_one_le_derivative_root_multiplicity [char_zero R] (p : R[X]) (t : R) :
  p.root_multiplicity t - 1 ≤ p.derivative.root_multiplicity t :=
begin
  by_cases p.is_root t,
  { exact (derivative_root_multiplicity_of_root h).symm.le },
  { rw [root_multiplicity_eq_zero h, zero_tsub],
    exact zero_le _ }
end

section normalization_monoid
variables [normalization_monoid R]

instance : normalization_monoid R[X] :=
{ norm_unit := λ p, ⟨C ↑(norm_unit (p.leading_coeff)), C ↑(norm_unit (p.leading_coeff))⁻¹,
    by rw [← ring_hom.map_mul, units.mul_inv, C_1], by rw [← ring_hom.map_mul, units.inv_mul, C_1]⟩,
  norm_unit_zero := units.ext (by simp),
  norm_unit_mul := λ p q hp0 hq0, units.ext (begin
      dsimp,
      rw [ne.def, ← leading_coeff_eq_zero] at *,
      rw [leading_coeff_mul, norm_unit_mul hp0 hq0, units.coe_mul, C_mul],
    end),
  norm_unit_coe_units := λ u,
    units.ext begin
      rw [← mul_one u⁻¹, units.coe_mul, units.eq_inv_mul_iff_mul_eq],
      dsimp,
      rcases polynomial.is_unit_iff.1 ⟨u, rfl⟩ with ⟨_, ⟨w, rfl⟩, h2⟩,
      rw [← h2, leading_coeff_C, norm_unit_coe_units, ← C_mul, units.mul_inv, C_1],
    end }

@[simp]
lemma coe_norm_unit {p : R[X]} :
  (norm_unit p : R[X]) = C ↑(norm_unit p.leading_coeff) :=
by simp [norm_unit]

lemma leading_coeff_normalize (p : R[X]) :
  leading_coeff (normalize p) = normalize (leading_coeff p) := by simp

lemma monic.normalize_eq_self {p : R[X]} (hp : p.monic) :
  normalize p = p :=
by simp only [polynomial.coe_norm_unit, normalize_apply, hp.leading_coeff, norm_unit_one,
  units.coe_one, polynomial.C.map_one, mul_one]

lemma roots_normalize {p : R[X]} : (normalize p).roots = p.roots :=
by rw [normalize_apply, mul_comm, coe_norm_unit,
  roots_C_mul _ (norm_unit (leading_coeff p)).ne_zero]

end normalization_monoid

end is_domain

section division_ring
variables [division_ring R] {p q : R[X]}

lemma degree_pos_of_ne_zero_of_nonunit (hp0 : p ≠ 0) (hp : ¬is_unit p) :
  0 < degree p :=
lt_of_not_ge (λ h, begin
  rw [eq_C_of_degree_le_zero h] at hp0 hp,
  exact hp (is_unit.map C
    (is_unit.mk0 (coeff p 0) (mt C_inj.2 (by simpa using hp0)))),
end)

lemma monic_mul_leading_coeff_inv (h : p ≠ 0) :
  monic (p * C (leading_coeff p)⁻¹) :=
by rw [monic, leading_coeff_mul, leading_coeff_C,
  mul_inv_cancel (show leading_coeff p ≠ 0, from mt leading_coeff_eq_zero.1 h)]

lemma degree_mul_leading_coeff_inv (p : R[X]) (h : q ≠ 0) :
  degree (p * C (leading_coeff q)⁻¹) = degree p :=
have h₁ : (leading_coeff q)⁻¹ ≠ 0 :=
  inv_ne_zero (mt leading_coeff_eq_zero.1 h),
by rw [degree_mul, degree_C h₁, add_zero]

@[simp] lemma map_eq_zero [semiring S] [nontrivial S] (f : R →+* S) :
  p.map f = 0 ↔ p = 0 :=
by simp only [polynomial.ext_iff, f.map_eq_zero, coeff_map, coeff_zero]

lemma map_ne_zero [semiring S] [nontrivial S] {f : R →+* S} (hp : p ≠ 0) : p.map f ≠ 0 :=
mt (map_eq_zero f).1 hp

end division_ring

section field
variables [field R] {p q : R[X]}

lemma is_unit_iff_degree_eq_zero : is_unit p ↔ degree p = 0 :=
⟨degree_eq_zero_of_is_unit,
  λ h, have degree p ≤ 0, by simp [*, le_refl],
    have hc : coeff p 0 ≠ 0, from λ hc,
        by rw [eq_C_of_degree_le_zero this, hc] at h;
        simpa using h,
    is_unit_iff_dvd_one.2 ⟨C (coeff p 0)⁻¹, begin
      conv in p { rw eq_C_of_degree_le_zero this },
      rw [← C_mul, _root_.mul_inv_cancel hc, C_1]
    end⟩⟩

theorem irreducible_of_monic {p : R[X]} (hp1 : p.monic) (hp2 : p ≠ 1) :
  irreducible p ↔ (∀ f g : R[X], f.monic → g.monic → f * g = p → f = 1 ∨ g = 1) :=
⟨λ hp3 f g hf hg hfg, or.cases_on (hp3.is_unit_or_is_unit hfg.symm)
  (assume huf : is_unit f, or.inl $ eq_one_of_is_unit_of_monic hf huf)
  (assume hug : is_unit g, or.inr $ eq_one_of_is_unit_of_monic hg hug),
λ hp3, ⟨mt (eq_one_of_is_unit_of_monic hp1) hp2, λ f g hp,
have hf : f ≠ 0, from λ hf, by { rw [hp, hf, zero_mul] at hp1, exact not_monic_zero hp1 },
have hg : g ≠ 0, from λ hg, by { rw [hp, hg, mul_zero] at hp1, exact not_monic_zero hp1 },
or.imp (λ hf, is_unit_of_mul_eq_one _ _ hf) (λ hg, is_unit_of_mul_eq_one _ _ hg) $
hp3 (f * C f.leading_coeff⁻¹) (g * C g.leading_coeff⁻¹)
  (monic_mul_leading_coeff_inv hf) (monic_mul_leading_coeff_inv hg) $
by rw [mul_assoc, mul_left_comm _ g, ← mul_assoc, ← C_mul, ← mul_inv, ← leading_coeff_mul,
    ← hp, monic.def.1 hp1, inv_one, C_1, mul_one]⟩⟩

/-- Division of polynomials. See `polynomial.div_by_monic` for more details.-/
def div (p q : R[X]) :=
C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹))

/-- Remainder of polynomial division. See `polynomial.mod_by_monic` for more details. -/
def mod (p q : R[X]) :=
p %ₘ (q * C (leading_coeff q)⁻¹)

private lemma quotient_mul_add_remainder_eq_aux (p q : R[X]) :
  q * div p q + mod p q = p :=
if h : q = 0 then by simp only [h, zero_mul, mod, mod_by_monic_zero, zero_add]
else begin
  conv {to_rhs, rw ← mod_by_monic_add_div p (monic_mul_leading_coeff_inv h)},
  rw [div, mod, add_comm, mul_assoc]
end

private lemma remainder_lt_aux (p : R[X]) (hq : q ≠ 0) :
  degree (mod p q) < degree q :=
by rw ← degree_mul_leading_coeff_inv q hq; exact
  degree_mod_by_monic_lt p (monic_mul_leading_coeff_inv hq)

instance : has_div R[X] := ⟨div⟩

instance : has_mod R[X] := ⟨mod⟩

lemma div_def : p / q = C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹)) := rfl

lemma mod_def : p % q = p %ₘ (q * C (leading_coeff q)⁻¹) := rfl

lemma mod_by_monic_eq_mod (p : R[X]) (hq : monic q) : p %ₘ q = p % q :=
show p %ₘ q = p %ₘ (q * C (leading_coeff q)⁻¹), by simp only [monic.def.1 hq, inv_one, mul_one, C_1]

lemma div_by_monic_eq_div (p : R[X]) (hq : monic q) : p /ₘ q = p / q :=
show p /ₘ q = C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹)),
by simp only [monic.def.1 hq, inv_one, C_1, one_mul, mul_one]

lemma mod_X_sub_C_eq_C_eval (p : R[X]) (a : R) : p % (X - C a) = C (p.eval a) :=
mod_by_monic_eq_mod p (monic_X_sub_C a) ▸ mod_by_monic_X_sub_C_eq_C_eval _ _

lemma mul_div_eq_iff_is_root : (X - C a) * (p / (X - C a)) = p ↔ is_root p a :=
div_by_monic_eq_div p (monic_X_sub_C a) ▸ mul_div_by_monic_eq_iff_is_root

instance : euclidean_domain R[X] :=
{ quotient := (/),
  quotient_zero := by simp [div_def],
  remainder := (%),
  r := _,
  r_well_founded := degree_lt_wf,
  quotient_mul_add_remainder_eq := quotient_mul_add_remainder_eq_aux,
  remainder_lt := λ p q hq, remainder_lt_aux _ hq,
  mul_left_not_lt := λ p q hq, not_lt_of_ge (degree_le_mul_left _ hq),
  .. polynomial.comm_ring,
  .. polynomial.nontrivial }

lemma mod_eq_self_iff (hq0 : q ≠ 0) : p % q = p ↔ degree p < degree q :=
⟨λ h, h ▸ euclidean_domain.mod_lt _ hq0,
λ h, have ¬degree (q * C (leading_coeff q)⁻¹) ≤ degree p :=
  not_le_of_gt $ by rwa degree_mul_leading_coeff_inv q hq0,
begin
  rw [mod_def, mod_by_monic, dif_pos (monic_mul_leading_coeff_inv hq0)],
  unfold div_mod_by_monic_aux,
  simp only [this, false_and, if_false]
end⟩

lemma div_eq_zero_iff (hq0 : q ≠ 0) : p / q = 0 ↔ degree p < degree q :=
⟨λ h, by have := euclidean_domain.div_add_mod p q;
  rwa [h, mul_zero, zero_add, mod_eq_self_iff hq0] at this,
λ h, have hlt : degree p < degree (q * C (leading_coeff q)⁻¹),
    by rwa degree_mul_leading_coeff_inv q hq0,
  have hm : monic (q * C (leading_coeff q)⁻¹) := monic_mul_leading_coeff_inv hq0,
  by rw [div_def, (div_by_monic_eq_zero_iff hm).2 hlt, mul_zero]⟩

lemma degree_add_div (hq0 : q ≠ 0) (hpq : degree q ≤ degree p) :
  degree q + degree (p / q) = degree p :=
have degree (p % q) < degree (q * (p / q)) :=
  calc degree (p % q) < degree q : euclidean_domain.mod_lt _ hq0
  ... ≤ _ : degree_le_mul_left _ (mt (div_eq_zero_iff hq0).1 (not_lt_of_ge hpq)),
by conv_rhs { rw [← euclidean_domain.div_add_mod p q,
    degree_add_eq_left_of_degree_lt this, degree_mul] }

lemma degree_div_le (p q : R[X]) : degree (p / q) ≤ degree p :=
if hq : q = 0 then by simp [hq]
else by rw [div_def, mul_comm, degree_mul_leading_coeff_inv _ hq];
  exact degree_div_by_monic_le _ _

lemma degree_div_lt (hp : p ≠ 0) (hq : 0 < degree q) : degree (p / q) < degree p :=
have hq0 : q ≠ 0, from λ hq0, by simpa [hq0] using hq,
by rw [div_def, mul_comm, degree_mul_leading_coeff_inv _ hq0];
  exact degree_div_by_monic_lt _ (monic_mul_leading_coeff_inv hq0) hp
    (by rw degree_mul_leading_coeff_inv _ hq0; exact hq)

@[simp] lemma degree_map [division_ring k] (p : R[X]) (f : R →+* k) :
  degree (p.map f) = degree p :=
p.degree_map_eq_of_injective f.injective

@[simp] lemma nat_degree_map [division_ring k] (f : R →+* k) :
  nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map _ f)

@[simp] lemma leading_coeff_map [division_ring k] (f : R →+* k) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
by simp only [← coeff_nat_degree, coeff_map f, nat_degree_map]

theorem monic_map_iff [division_ring k] {f : R →+* k} {p : R[X]} :
  (p.map f).monic ↔ p.monic :=
by rw [monic, leading_coeff_map, ← f.map_one, function.injective.eq_iff f.injective, monic]

theorem is_unit_map [field k] (f : R →+* k) :
  is_unit (p.map f) ↔ is_unit p :=
by simp_rw [is_unit_iff_degree_eq_zero, degree_map]

lemma map_mod [field k] (f : R →+* k) :
  (p % q).map f = p.map f % q.map f :=
if hq0 : q = 0 then by simp [hq0]
else by rw [mod_def, mod_def, leading_coeff_map f, ← f.map_inv, ← map_C f,
  ← polynomial.map_mul f, map_mod_by_monic f (monic_mul_leading_coeff_inv hq0)]

section
open euclidean_domain
theorem gcd_map [field k] (f : R →+* k) :
  gcd (p.map f) (q.map f) = (gcd p q).map f :=
gcd.induction p q (λ x, by simp_rw [polynomial.map_zero, euclidean_domain.gcd_zero_left]) $
                    λ x y hx ih,
by rw [gcd_val, ← map_mod, ih, ← gcd_val]
end

lemma eval₂_gcd_eq_zero [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hf : f.eval₂ ϕ α = 0) (hg : g.eval₂ ϕ α = 0) : (euclidean_domain.gcd f g).eval₂ ϕ α = 0 :=
by rw [euclidean_domain.gcd_eq_gcd_ab f g, polynomial.eval₂_add, polynomial.eval₂_mul,
       polynomial.eval₂_mul, hf, hg, zero_mul, zero_mul, zero_add]

lemma eval_gcd_eq_zero {f g : R[X]} {α : R} (hf : f.eval α = 0) (hg : g.eval α = 0) :
  (euclidean_domain.gcd f g).eval α = 0 := eval₂_gcd_eq_zero hf hg

lemma root_left_of_root_gcd [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hα : (euclidean_domain.gcd f g).eval₂ ϕ α = 0) : f.eval₂ ϕ α = 0 :=
by { cases euclidean_domain.gcd_dvd_left f g with p hp,
     rw [hp, polynomial.eval₂_mul, hα, zero_mul] }

lemma root_right_of_root_gcd [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hα : (euclidean_domain.gcd f g).eval₂ ϕ α = 0) : g.eval₂ ϕ α = 0 :=
by { cases euclidean_domain.gcd_dvd_right f g with p hp,
     rw [hp, polynomial.eval₂_mul, hα, zero_mul] }

lemma root_gcd_iff_root_left_right [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k} :
  (euclidean_domain.gcd f g).eval₂ ϕ α = 0 ↔ (f.eval₂ ϕ α = 0) ∧ (g.eval₂ ϕ α = 0) :=
⟨λ h, ⟨root_left_of_root_gcd h, root_right_of_root_gcd h⟩, λ h, eval₂_gcd_eq_zero h.1 h.2⟩

lemma is_root_gcd_iff_is_root_left_right {f g : R[X]} {α : R} :
  (euclidean_domain.gcd f g).is_root α ↔ f.is_root α ∧ g.is_root α :=
root_gcd_iff_root_left_right

theorem is_coprime_map [field k] (f : R →+* k) :
  is_coprime (p.map f) (q.map f) ↔ is_coprime p q :=
by rw [← euclidean_domain.gcd_is_unit_iff, ← euclidean_domain.gcd_is_unit_iff, gcd_map, is_unit_map]

lemma mem_roots_map [field k] {f : R →+* k} {x : k} (hp : p ≠ 0) :
  x ∈ (p.map f).roots ↔ p.eval₂ f x = 0 :=
begin
  rw mem_roots (show p.map f ≠ 0, by exact map_ne_zero hp),
  dsimp only [is_root],
  rw polynomial.eval_map,
end

lemma mem_root_set [field k] [algebra R k] {x : k} (hp : p ≠ 0) :
  x ∈ p.root_set k ↔ aeval x p = 0 :=
iff.trans multiset.mem_to_finset (mem_roots_map hp)

lemma root_set_C_mul_X_pow {R S : Type*} [field R] [field S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (C a * X ^ n).root_set S = {0} :=
begin
  ext x,
  rw [set.mem_singleton_iff, mem_root_set, aeval_mul, aeval_C, aeval_X_pow, mul_eq_zero],
  { simp_rw [ring_hom.map_eq_zero, pow_eq_zero_iff (nat.pos_of_ne_zero hn), or_iff_right_iff_imp],
    exact λ ha', (ha ha').elim },
  { exact mul_ne_zero (mt C_eq_zero.mp ha) (pow_ne_zero n X_ne_zero) },
end

lemma root_set_monomial {R S : Type*} [field R] [field S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (monomial n a).root_set S = {0} :=
by rw [←C_mul_X_pow_eq_monomial, root_set_C_mul_X_pow hn ha]

lemma root_set_X_pow {R S : Type*} [field R] [field S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) : (X ^ n : R[X]).root_set S = {0} :=
by { rw [←one_mul (X ^ n : R[X]), ←C_1, root_set_C_mul_X_pow hn], exact one_ne_zero }

lemma exists_root_of_degree_eq_one (h : degree p = 1) : ∃ x, is_root p x :=
⟨-(p.coeff 0 / p.coeff 1),
  have p.coeff 1 ≠ 0,
    by rw ← nat_degree_eq_of_degree_eq_some h;
    exact mt leading_coeff_eq_zero.1 (λ h0, by simpa [h0] using h),
  by conv in p { rw [eq_X_add_C_of_degree_le_one (show degree p ≤ 1, by rw h; exact le_rfl)] };
    simp [is_root, mul_div_cancel' _ this]⟩

lemma coeff_inv_units (u : R[X]ˣ) (n : ℕ) :
  ((↑u : R[X]).coeff n)⁻¹ = ((↑u⁻¹ : R[X]).coeff n) :=
begin
  rw [eq_C_of_degree_eq_zero (degree_coe_units u), eq_C_of_degree_eq_zero (degree_coe_units u⁻¹),
    coeff_C, coeff_C, inv_eq_one_div],
  split_ifs,
  { rw [div_eq_iff_mul_eq (coeff_coe_units_zero_ne_zero u), coeff_zero_eq_eval_zero,
      coeff_zero_eq_eval_zero, ← eval_mul, ← units.coe_mul, inv_mul_self];
    simp },
  { simp }
end

lemma monic_normalize (hp0 : p ≠ 0) : monic (normalize p) :=
begin
  rw [ne.def, ← leading_coeff_eq_zero, ← ne.def, ← is_unit_iff_ne_zero] at hp0,
  rw [monic, leading_coeff_normalize, normalize_eq_one],
  apply hp0,
end

lemma leading_coeff_div (hpq : q.degree ≤ p.degree) :
  (p / q).leading_coeff = p.leading_coeff / q.leading_coeff :=
begin
  by_cases hq : q = 0, { simp [hq] },
  rw [div_def, leading_coeff_mul, leading_coeff_C,
      leading_coeff_div_by_monic_of_monic (monic_mul_leading_coeff_inv hq) _,
      mul_comm, div_eq_mul_inv],
  rwa [degree_mul_leading_coeff_inv q hq]
end

lemma div_C_mul : p / (C a * q) = C a⁻¹ * (p / q) :=
begin
  by_cases ha : a = 0,
  { simp [ha] },
  simp only [div_def, leading_coeff_mul, mul_inv,
    leading_coeff_C, C.map_mul, mul_assoc],
  congr' 3,
  rw [mul_left_comm q, ← mul_assoc, ← C.map_mul, mul_inv_cancel ha,
      C.map_one, one_mul]
end

lemma C_mul_dvd (ha : a ≠ 0) : C a * p ∣ q ↔ p ∣ q :=
⟨λ h, dvd_trans (dvd_mul_left _ _) h, λ ⟨r, hr⟩, ⟨C a⁻¹ * r,
  by rw [mul_assoc, mul_left_comm p, ← mul_assoc, ← C.map_mul, _root_.mul_inv_cancel ha,
         C.map_one, one_mul, hr]⟩⟩

lemma dvd_C_mul (ha : a ≠ 0) : p ∣ polynomial.C a * q ↔ p ∣ q :=
⟨λ ⟨r, hr⟩, ⟨C a⁻¹ * r,
  by rw [mul_left_comm p, ← hr, ← mul_assoc, ← C.map_mul, _root_.inv_mul_cancel ha,
         C.map_one, one_mul]⟩,
 λ h, dvd_trans h (dvd_mul_left _ _)⟩

lemma coe_norm_unit_of_ne_zero (hp : p ≠ 0) : (norm_unit p : R[X]) = C p.leading_coeff⁻¹ :=
have p.leading_coeff ≠ 0 := mt leading_coeff_eq_zero.mp hp,
by simp [comm_group_with_zero.coe_norm_unit _ this]

lemma normalize_monic (h : monic p) : normalize p = p := by simp [h]

theorem map_dvd_map' [field k] (f : R →+* k) {x y : R[X]} : x.map f ∣ y.map f ↔ x ∣ y :=
if H : x = 0 then by rw [H, polynomial.map_zero, zero_dvd_iff, zero_dvd_iff, map_eq_zero]
else by rw [← normalize_dvd_iff, ← @normalize_dvd_iff R[X],
    normalize_apply, normalize_apply,
    coe_norm_unit_of_ne_zero H, coe_norm_unit_of_ne_zero (mt (map_eq_zero f).1 H),
    leading_coeff_map, ← f.map_inv, ← map_C, ← polynomial.map_mul,
    map_dvd_map _ f.injective (monic_mul_leading_coeff_inv H)]

lemma degree_normalize : degree (normalize p) = degree p := by simp

lemma prime_of_degree_eq_one (hp1 : degree p = 1) : prime p :=
have prime (normalize p),
  from monic.prime_of_degree_eq_one (hp1 ▸ degree_normalize)
    (monic_normalize (λ hp0, absurd hp1 (hp0.symm ▸ by simp; exact dec_trivial))),
(normalize_associated _).prime this

lemma irreducible_of_degree_eq_one (hp1 : degree p = 1) : irreducible p :=
(prime_of_degree_eq_one hp1).irreducible

theorem not_irreducible_C (x : R) : ¬irreducible (C x) :=
if H : x = 0 then by { rw [H, C_0], exact not_irreducible_zero }
else λ hx, irreducible.not_unit hx $ is_unit_C.2 $ is_unit_iff_ne_zero.2 H

theorem degree_pos_of_irreducible (hp : irreducible p) : 0 < p.degree :=
lt_of_not_ge $ λ hp0, have _ := eq_C_of_degree_le_zero hp0,
  not_irreducible_C (p.coeff 0) $ this ▸ hp

/-- If `f` is a polynomial over a field, and `a : K` satisfies `f' a ≠ 0`,
then `f / (X - a)` is coprime with `X - a`.
Note that we do not assume `f a = 0`, because `f / (X - a) = (f - f a) / (X - a)`. -/
lemma is_coprime_of_is_root_of_eval_derivative_ne_zero {K : Type*} [field K]
  (f : K[X]) (a : K) (hf' : f.derivative.eval a ≠ 0) :
  is_coprime (X - C a : K[X]) (f /ₘ (X - C a)) :=
begin
  refine or.resolve_left (euclidean_domain.dvd_or_coprime (X - C a) (f /ₘ (X - C a))
    (irreducible_of_degree_eq_one (polynomial.degree_X_sub_C a))) _,
  contrapose! hf' with h,
  have key : (X - C a) * (f /ₘ (X - C a)) = f - (f %ₘ (X - C a)),
  { rw [eq_sub_iff_add_eq, ← eq_sub_iff_add_eq', mod_by_monic_eq_sub_mul_div],
    exact monic_X_sub_C a },
  replace key := congr_arg derivative key,
  simp only [derivative_X, derivative_mul, one_mul, sub_zero, derivative_sub,
    mod_by_monic_X_sub_C_eq_C_eval, derivative_C] at key,
  have : (X - C a) ∣ derivative f := key ▸ (dvd_add h (dvd_mul_right _ _)),
  rw [← dvd_iff_mod_by_monic_eq_zero (monic_X_sub_C _), mod_by_monic_X_sub_C_eq_C_eval] at this,
  rw [← C_inj, this, C_0],
end

end field
end polynomial


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module algebra.lie.nilpotent
! leanprover-community/mathlib commit 938fead7abdc0cbbca8eba7a1052865a169dc102
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Solvable
import Mathbin.Algebra.Lie.Quotient
import Mathbin.Algebra.Lie.Normalizer
import Mathbin.LinearAlgebra.Eigenspace
import Mathbin.RingTheory.Nilpotent

/-!
# Nilpotent Lie algebras

Like groups, Lie algebras admit a natural concept of nilpotency. More generally, any Lie module
carries a natural concept of nilpotency. We define these here via the lower central series.

## Main definitions

  * `lie_module.lower_central_series`
  * `lie_module.is_nilpotent`

## Tags

lie algebra, lower central series, nilpotent
-/

universe u v w w₁ w₂

section NilpotentModules

variable {R : Type u} {L : Type v} {M : Type w}

variable [CommRing R] [LieRing L] [LieAlgebra R L] [AddCommGroup M] [Module R M]

variable [LieRingModule L M] [LieModule R L M]

variable (k : ℕ) (N : LieSubmodule R L M)

namespace LieSubmodule

/-- A generalisation of the lower central series. The zeroth term is a specified Lie submodule of
a Lie module. In the case when we specify the top ideal `⊤` of the Lie algebra, regarded as a Lie
module over itself, we get the usual lower central series of a Lie algebra.

It can be more convenient to work with this generalisation when considering the lower central series
of a Lie submodule, regarded as a Lie module in its own right, since it provides a type-theoretic
expression of the fact that the terms of the Lie submodule's lower central series are also Lie
submodules of the enclosing Lie module.

See also `lie_module.lower_central_series_eq_lcs_comap` and
`lie_module.lower_central_series_map_eq_lcs` below, as well as `lie_submodule.ucs`. -/
def lcs : LieSubmodule R L M → LieSubmodule R L M :=
  (fun N => ⁅(⊤ : LieIdeal R L), N⁆)^[k]
#align lie_submodule.lcs LieSubmodule.lcs

@[simp]
theorem lcs_zero (N : LieSubmodule R L M) : N.lcs 0 = N :=
  rfl
#align lie_submodule.lcs_zero LieSubmodule.lcs_zero

@[simp]
theorem lcs_succ : N.lcs (k + 1) = ⁅(⊤ : LieIdeal R L), N.lcs k⁆ :=
  Function.iterate_succ_apply' (fun N' => ⁅⊤, N'⁆) k N
#align lie_submodule.lcs_succ LieSubmodule.lcs_succ

end LieSubmodule

namespace LieModule

variable (R L M)

/-- The lower central series of Lie submodules of a Lie module. -/
def lowerCentralSeries : LieSubmodule R L M :=
  (⊤ : LieSubmodule R L M).lcs k
#align lie_module.lower_central_series LieModule.lowerCentralSeries

@[simp]
theorem lowerCentralSeries_zero : lowerCentralSeries R L M 0 = ⊤ :=
  rfl
#align lie_module.lower_central_series_zero LieModule.lowerCentralSeries_zero

@[simp]
theorem lowerCentralSeries_succ :
    lowerCentralSeries R L M (k + 1) = ⁅(⊤ : LieIdeal R L), lowerCentralSeries R L M k⁆ :=
  (⊤ : LieSubmodule R L M).lcs_succ k
#align lie_module.lower_central_series_succ LieModule.lowerCentralSeries_succ

end LieModule

namespace LieSubmodule

open LieModule

variable {R L M}

theorem lcs_le_self : N.lcs k ≤ N := by
  induction' k with k ih
  · simp
  · simp only [lcs_succ]
    exact (LieSubmodule.mono_lie_right _ _ ⊤ ih).trans (N.lie_le_right ⊤)
#align lie_submodule.lcs_le_self LieSubmodule.lcs_le_self

theorem lowerCentralSeries_eq_lcs_comap : lowerCentralSeries R L N k = (N.lcs k).comap N.incl :=
  by
  induction' k with k ih
  · simp
  · simp only [lcs_succ, lower_central_series_succ] at ih⊢
    have : N.lcs k ≤ N.incl.range := by
      rw [N.range_incl]
      apply lcs_le_self
    rw [ih, LieSubmodule.comap_bracket_eq _ _ N.incl N.ker_incl this]
#align lie_submodule.lower_central_series_eq_lcs_comap LieSubmodule.lowerCentralSeries_eq_lcs_comap

theorem lowerCentralSeries_map_eq_lcs : (lowerCentralSeries R L N k).map N.incl = N.lcs k :=
  by
  rw [lower_central_series_eq_lcs_comap, LieSubmodule.map_comap_incl, inf_eq_right]
  apply lcs_le_self
#align lie_submodule.lower_central_series_map_eq_lcs LieSubmodule.lowerCentralSeries_map_eq_lcs

end LieSubmodule

namespace LieModule

variable (R L M)

theorem antitone_lowerCentralSeries : Antitone <| lowerCentralSeries R L M :=
  by
  intro l k
  induction' k with k ih generalizing l <;> intro h
  · exact (le_zero_iff.mp h).symm ▸ le_rfl
  · rcases Nat.of_le_succ h with (hk | hk)
    · rw [lower_central_series_succ]
      exact (LieSubmodule.mono_lie_right _ _ ⊤ (ih hk)).trans (LieSubmodule.lie_le_right _ _)
    · exact hk.symm ▸ le_rfl
#align lie_module.antitone_lower_central_series LieModule.antitone_lowerCentralSeries

theorem trivial_iff_lower_central_eq_bot : IsTrivial L M ↔ lowerCentralSeries R L M 1 = ⊥ :=
  by
  constructor <;> intro h
  · erw [eq_bot_iff, LieSubmodule.lieSpan_le]
    rintro m ⟨x, n, hn⟩
    rw [← hn, h.trivial]
    simp
  · rw [LieSubmodule.eq_bot_iff] at h
    apply is_trivial.mk
    intro x m
    apply h
    apply LieSubmodule.subset_lieSpan
    use x, m
    rfl
#align lie_module.trivial_iff_lower_central_eq_bot LieModule.trivial_iff_lower_central_eq_bot

theorem iterate_toEndomorphism_mem_lowerCentralSeries (x : L) (m : M) (k : ℕ) :
    (toEndomorphism R L M x^[k]) m ∈ lowerCentralSeries R L M k :=
  by
  induction' k with k ih
  · simp only [Function.iterate_zero]
  · simp only [lower_central_series_succ, Function.comp_apply, Function.iterate_succ',
      to_endomorphism_apply_apply]
    exact LieSubmodule.lie_mem_lie _ _ (LieSubmodule.mem_top x) ih
#align lie_module.iterate_to_endomorphism_mem_lower_central_series LieModule.iterate_toEndomorphism_mem_lowerCentralSeries

variable {R L M}

theorem map_lowerCentralSeries_le {M₂ : Type w₁} [AddCommGroup M₂] [Module R M₂]
    [LieRingModule L M₂] [LieModule R L M₂] (k : ℕ) (f : M →ₗ⁅R,L⁆ M₂) :
    LieSubmodule.map f (lowerCentralSeries R L M k) ≤ lowerCentralSeries R L M₂ k :=
  by
  induction' k with k ih
  · simp only [LieModule.lowerCentralSeries_zero, le_top]
  · simp only [LieModule.lowerCentralSeries_succ, LieSubmodule.map_bracket_eq]
    exact LieSubmodule.mono_lie_right _ _ ⊤ ih
#align lie_module.map_lower_central_series_le LieModule.map_lowerCentralSeries_le

variable (R L M)

open LieAlgebra

theorem derivedSeries_le_lowerCentralSeries (k : ℕ) :
    derivedSeries R L k ≤ lowerCentralSeries R L L k :=
  by
  induction' k with k h
  · rw [derived_series_def, derived_series_of_ideal_zero, lower_central_series_zero]
    exact le_rfl
  · have h' : derivedSeries R L k ≤ ⊤ := by simp only [le_top]
    rw [derived_series_def, derived_series_of_ideal_succ, lower_central_series_succ]
    exact LieSubmodule.mono_lie _ _ _ _ h' h
#align lie_module.derived_series_le_lower_central_series LieModule.derivedSeries_le_lowerCentralSeries

/-- A Lie module is nilpotent if its lower central series reaches 0 (in a finite number of
steps). -/
class IsNilpotent : Prop where
  nilpotent : ∃ k, lowerCentralSeries R L M k = ⊥
#align lie_module.is_nilpotent LieModule.IsNilpotent

/-- See also `lie_module.is_nilpotent_iff_exists_ucs_eq_top`. -/
theorem isNilpotent_iff : IsNilpotent R L M ↔ ∃ k, lowerCentralSeries R L M k = ⊥ :=
  ⟨fun h => h.nilpotent, fun h => ⟨h⟩⟩
#align lie_module.is_nilpotent_iff LieModule.isNilpotent_iff

variable {R L M}

theorem LieSubmodule.isNilpotent_iff_exists_lcs_eq_bot (N : LieSubmodule R L M) :
    LieModule.IsNilpotent R L N ↔ ∃ k, N.lcs k = ⊥ :=
  by
  rw [is_nilpotent_iff]
  refine' exists_congr fun k => _
  rw [N.lower_central_series_eq_lcs_comap k, LieSubmodule.comap_incl_eq_bot,
    inf_eq_right.mpr (N.lcs_le_self k)]
#align lie_submodule.is_nilpotent_iff_exists_lcs_eq_bot LieSubmodule.isNilpotent_iff_exists_lcs_eq_bot

variable (R L M)

instance (priority := 100) trivialIsNilpotent [IsTrivial L M] : IsNilpotent R L M :=
  ⟨by
    use 1
    change ⁅⊤, ⊤⁆ = ⊥
    simp⟩
#align lie_module.trivial_is_nilpotent LieModule.trivialIsNilpotent

theorem nilpotent_endo_of_nilpotent_module [hM : IsNilpotent R L M] :
    ∃ k : ℕ, ∀ x : L, toEndomorphism R L M x ^ k = 0 :=
  by
  obtain ⟨k, hM⟩ := hM
  use k
  intro x; ext m
  rw [LinearMap.pow_apply, LinearMap.zero_apply, ← @LieSubmodule.mem_bot R L M, ← hM]
  exact iterate_to_endomorphism_mem_lower_central_series R L M x m k
#align lie_module.nilpotent_endo_of_nilpotent_module LieModule.nilpotent_endo_of_nilpotent_module

/-- For a nilpotent Lie module, the weight space of the 0 weight is the whole module.

This result will be used downstream to show that weight spaces are Lie submodules, at which time
it will be possible to state it in the language of weight spaces. -/
theorem infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent [IsNilpotent R L M] :
    (⨅ x : L, (toEndomorphism R L M x).maximalGeneralizedEigenspace 0) = ⊤ :=
  by
  ext m
  simp only [Module.End.mem_maximalGeneralizedEigenspace, Submodule.mem_top, sub_zero, iff_true_iff,
    zero_smul, Submodule.mem_infᵢ]
  intro x
  obtain ⟨k, hk⟩ := nilpotent_endo_of_nilpotent_module R L M
  use k; rw [hk]
  exact LinearMap.zero_apply m
#align lie_module.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent LieModule.infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent

/-- If the quotient of a Lie module `M` by a Lie submodule on which the Lie algebra acts trivially
is nilpotent then `M` is nilpotent.

This is essentially the Lie module equivalent of the fact that a central
extension of nilpotent Lie algebras is nilpotent. See `lie_algebra.nilpotent_of_nilpotent_quotient`
below for the corresponding result for Lie algebras. -/
theorem nilpotentOfNilpotentQuotient {N : LieSubmodule R L M} (h₁ : N ≤ maxTrivSubmodule R L M)
    (h₂ : IsNilpotent R L (M ⧸ N)) : IsNilpotent R L M :=
  by
  obtain ⟨k, hk⟩ := h₂
  use k + 1
  simp only [lower_central_series_succ]
  suffices lower_central_series R L M k ≤ N
    by
    replace this := LieSubmodule.mono_lie_right _ _ ⊤ (le_trans this h₁)
    rwa [ideal_oper_max_triv_submodule_eq_bot, le_bot_iff] at this
  rw [← LieSubmodule.Quotient.map_mk'_eq_bot_le, ← le_bot_iff, ← hk]
  exact map_lower_central_series_le k (LieSubmodule.Quotient.mk' N)
#align lie_module.nilpotent_of_nilpotent_quotient LieModule.nilpotentOfNilpotentQuotient

/-- Given a nilpotent Lie module `M` with lower central series `M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is
the natural number `k` (the number of inclusions).

For a non-nilpotent module, we use the junk value 0. -/
noncomputable def nilpotencyLength : ℕ :=
  infₛ { k | lowerCentralSeries R L M k = ⊥ }
#align lie_module.nilpotency_length LieModule.nilpotencyLength

theorem nilpotencyLength_eq_zero_iff [IsNilpotent R L M] :
    nilpotencyLength R L M = 0 ↔ Subsingleton M :=
  by
  let s := { k | lower_central_series R L M k = ⊥ }
  have hs : s.nonempty :=
    by
    obtain ⟨k, hk⟩ := (by infer_instance : IsNilpotent R L M)
    exact ⟨k, hk⟩
  change Inf s = 0 ↔ _
  rw [← LieSubmodule.subsingleton_iff R L M, ← subsingleton_iff_bot_eq_top, ←
    lower_central_series_zero, @eq_comm (LieSubmodule R L M)]
  refine' ⟨fun h => h ▸ Nat.infₛ_mem hs, fun h => _⟩
  rw [Nat.infₛ_eq_zero]
  exact Or.inl h
#align lie_module.nilpotency_length_eq_zero_iff LieModule.nilpotencyLength_eq_zero_iff

theorem nilpotencyLength_eq_succ_iff (k : ℕ) :
    nilpotencyLength R L M = k + 1 ↔
      lowerCentralSeries R L M (k + 1) = ⊥ ∧ lowerCentralSeries R L M k ≠ ⊥ :=
  by
  let s := { k | lower_central_series R L M k = ⊥ }
  change Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s
  have hs : ∀ k₁ k₂, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s :=
    by
    rintro k₁ k₂ h₁₂ (h₁ : lower_central_series R L M k₁ = ⊥)
    exact eq_bot_iff.mpr (h₁ ▸ antitone_lower_central_series R L M h₁₂)
  exact Nat.infₛ_upward_closed_eq_succ_iff hs k
#align lie_module.nilpotency_length_eq_succ_iff LieModule.nilpotencyLength_eq_succ_iff

/-- Given a non-trivial nilpotent Lie module `M` with lower central series
`M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is the `k-1`th term in the lower central series (the last
non-trivial term).

For a trivial or non-nilpotent module, this is the bottom submodule, `⊥`. -/
noncomputable def lowerCentralSeriesLast : LieSubmodule R L M :=
  match nilpotencyLength R L M with
  | 0 => ⊥
  | k + 1 => lowerCentralSeries R L M k
#align lie_module.lower_central_series_last LieModule.lowerCentralSeriesLast

theorem lowerCentralSeriesLast_le_max_triv :
    lowerCentralSeriesLast R L M ≤ maxTrivSubmodule R L M :=
  by
  rw [lower_central_series_last]
  cases' h : nilpotency_length R L M with k
  · exact bot_le
  · rw [le_max_triv_iff_bracket_eq_bot]
    rw [nilpotency_length_eq_succ_iff, lower_central_series_succ] at h
    exact h.1
#align lie_module.lower_central_series_last_le_max_triv LieModule.lowerCentralSeriesLast_le_max_triv

theorem nontrivial_lowerCentralSeriesLast [Nontrivial M] [IsNilpotent R L M] :
    Nontrivial (lowerCentralSeriesLast R L M) :=
  by
  rw [LieSubmodule.nontrivial_iff_ne_bot, lower_central_series_last]
  cases h : nilpotency_length R L M
  · rw [nilpotency_length_eq_zero_iff, ← not_nontrivial_iff_subsingleton] at h
    contradiction
  · rw [nilpotency_length_eq_succ_iff] at h
    exact h.2
#align lie_module.nontrivial_lower_central_series_last LieModule.nontrivial_lowerCentralSeriesLast

theorem nontrivial_max_triv_of_isNilpotent [Nontrivial M] [IsNilpotent R L M] :
    Nontrivial (maxTrivSubmodule R L M) :=
  Set.nontrivial_mono (lowerCentralSeriesLast_le_max_triv R L M)
    (nontrivial_lowerCentralSeriesLast R L M)
#align lie_module.nontrivial_max_triv_of_is_nilpotent LieModule.nontrivial_max_triv_of_isNilpotent

@[simp]
theorem coe_lcs_range_toEndomorphism_eq (k : ℕ) :
    (lowerCentralSeries R (toEndomorphism R L M).range M k : Submodule R M) =
      lowerCentralSeries R L M k :=
  by
  induction' k with k ih
  · simp
  · simp only [lower_central_series_succ, LieSubmodule.lieIdeal_oper_eq_linear_span', ←
      (lower_central_series R (to_endomorphism R L M).range M k).mem_coe_submodule, ih]
    congr
    ext m
    constructor
    · rintro ⟨⟨-, ⟨y, rfl⟩⟩, -, n, hn, rfl⟩
      exact ⟨y, LieSubmodule.mem_top _, n, hn, rfl⟩
    · rintro ⟨x, hx, n, hn, rfl⟩
      exact
        ⟨⟨to_endomorphism R L M x, LieHom.mem_range_self _ x⟩, LieSubmodule.mem_top _, n, hn, rfl⟩
#align lie_module.coe_lcs_range_to_endomorphism_eq LieModule.coe_lcs_range_toEndomorphism_eq

@[simp]
theorem isNilpotent_range_toEndomorphism_iff :
    IsNilpotent R (toEndomorphism R L M).range M ↔ IsNilpotent R L M := by
  constructor <;> rintro ⟨k, hk⟩ <;> use k <;>
      rw [← LieSubmodule.coe_to_submodule_eq_iff] at hk⊢ <;>
    simpa using hk
#align lie_module.is_nilpotent_range_to_endomorphism_iff LieModule.isNilpotent_range_toEndomorphism_iff

end LieModule

namespace LieSubmodule

variable {N₁ N₂ : LieSubmodule R L M}

/-- The upper (aka ascending) central series.

See also `lie_submodule.lcs`. -/
def ucs (k : ℕ) : LieSubmodule R L M → LieSubmodule R L M :=
  normalizer^[k]
#align lie_submodule.ucs LieSubmodule.ucs

@[simp]
theorem ucs_zero : N.ucs 0 = N :=
  rfl
#align lie_submodule.ucs_zero LieSubmodule.ucs_zero

@[simp]
theorem ucs_succ (k : ℕ) : N.ucs (k + 1) = (N.ucs k).normalizer :=
  Function.iterate_succ_apply' normalizer k N
#align lie_submodule.ucs_succ LieSubmodule.ucs_succ

theorem ucs_add (k l : ℕ) : N.ucs (k + l) = (N.ucs l).ucs k :=
  Function.iterate_add_apply normalizer k l N
#align lie_submodule.ucs_add LieSubmodule.ucs_add

@[mono]
theorem ucs_mono (k : ℕ) (h : N₁ ≤ N₂) : N₁.ucs k ≤ N₂.ucs k :=
  by
  induction' k with k ih; · simpa
  simp only [ucs_succ]
  mono
#align lie_submodule.ucs_mono LieSubmodule.ucs_mono

theorem ucs_eq_self_of_normalizer_eq_self (h : N₁.normalizer = N₁) (k : ℕ) : N₁.ucs k = N₁ :=
  by
  induction' k with k ih
  · simp
  · rwa [ucs_succ, ih]
#align lie_submodule.ucs_eq_self_of_normalizer_eq_self LieSubmodule.ucs_eq_self_of_normalizer_eq_self

/-- If a Lie module `M` contains a self-normalizing Lie submodule `N`, then all terms of the upper
central series of `M` are contained in `N`.

An important instance of this situation arises from a Cartan subalgebra `H ⊆ L` with the roles of
`L`, `M`, `N` played by `H`, `L`, `H`, respectively. -/
theorem ucs_le_of_normalizer_eq_self (h : N₁.normalizer = N₁) (k : ℕ) :
    (⊥ : LieSubmodule R L M).ucs k ≤ N₁ :=
  by
  rw [← ucs_eq_self_of_normalizer_eq_self h k]
  mono
  simp
#align lie_submodule.ucs_le_of_normalizer_eq_self LieSubmodule.ucs_le_of_normalizer_eq_self

theorem lcs_add_le_iff (l k : ℕ) : N₁.lcs (l + k) ≤ N₂ ↔ N₁.lcs l ≤ N₂.ucs k :=
  by
  revert l
  induction' k with k ih; · simp
  intro l
  rw [(by abel : l + (k + 1) = l + 1 + k), ih, ucs_succ, lcs_succ, top_lie_le_iff_le_normalizer]
#align lie_submodule.lcs_add_le_iff LieSubmodule.lcs_add_le_iff

theorem lcs_le_iff (k : ℕ) : N₁.lcs k ≤ N₂ ↔ N₁ ≤ N₂.ucs k :=
  by
  convert lcs_add_le_iff 0 k
  rw [zero_add]
#align lie_submodule.lcs_le_iff LieSubmodule.lcs_le_iff

theorem gc_lcs_ucs (k : ℕ) :
    GaloisConnection (fun N : LieSubmodule R L M => N.lcs k) fun N : LieSubmodule R L M =>
      N.ucs k :=
  fun N₁ N₂ => lcs_le_iff k
#align lie_submodule.gc_lcs_ucs LieSubmodule.gc_lcs_ucs

theorem ucs_eq_top_iff (k : ℕ) : N.ucs k = ⊤ ↔ LieModule.lowerCentralSeries R L M k ≤ N :=
  by
  rw [eq_top_iff, ← lcs_le_iff]
  rfl
#align lie_submodule.ucs_eq_top_iff LieSubmodule.ucs_eq_top_iff

theorem LieModule.isNilpotent_iff_exists_ucs_eq_top :
    LieModule.IsNilpotent R L M ↔ ∃ k, (⊥ : LieSubmodule R L M).ucs k = ⊤ :=
  by
  rw [LieModule.isNilpotent_iff]
  exact exists_congr fun k => by simp [ucs_eq_top_iff]
#align lie_module.is_nilpotent_iff_exists_ucs_eq_top LieModule.isNilpotent_iff_exists_ucs_eq_top

theorem ucs_comap_incl (k : ℕ) :
    ((⊥ : LieSubmodule R L M).ucs k).comap N.incl = (⊥ : LieSubmodule R L N).ucs k :=
  by
  induction' k with k ih
  · exact N.ker_incl
  · simp [← ih]
#align lie_submodule.ucs_comap_incl LieSubmodule.ucs_comap_incl

theorem isNilpotent_iff_exists_self_le_ucs :
    LieModule.IsNilpotent R L N ↔ ∃ k, N ≤ (⊥ : LieSubmodule R L M).ucs k := by
  simp_rw [LieModule.isNilpotent_iff_exists_ucs_eq_top, ← ucs_comap_incl, comap_incl_eq_top]
#align lie_submodule.is_nilpotent_iff_exists_self_le_ucs LieSubmodule.isNilpotent_iff_exists_self_le_ucs

end LieSubmodule

section Morphisms

open LieModule Function

variable {L₂ M₂ : Type _} [LieRing L₂] [LieAlgebra R L₂]

variable [AddCommGroup M₂] [Module R M₂] [LieRingModule L₂ M₂] [LieModule R L₂ M₂]

variable {f : L →ₗ⁅R⁆ L₂} {g : M →ₗ[R] M₂}

variable (hf : Surjective f) (hg : Surjective g) (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆)

include hf hg hfg

theorem Function.Surjective.lieModule_lcs_map_eq (k : ℕ) :
    (lowerCentralSeries R L M k : Submodule R M).map g = lowerCentralSeries R L₂ M₂ k :=
  by
  induction' k with k ih
  · simp [LinearMap.range_eq_top, hg]
  · suffices
      g '' { m | ∃ (x : L)(n : _), n ∈ lower_central_series R L M k ∧ ⁅x, n⁆ = m } =
        { m | ∃ (x : L₂)(n : _), n ∈ lower_central_series R L M k ∧ ⁅x, g n⁆ = m }
      by
      simp only [← LieSubmodule.mem_coeSubmodule] at this
      simp [← LieSubmodule.mem_coeSubmodule, ← ih, LieSubmodule.lieIdeal_oper_eq_linear_span',
        Submodule.map_span, -Submodule.span_image, this]
    ext m₂
    constructor
    · rintro ⟨m, ⟨x, n, hn, rfl⟩, rfl⟩
      exact ⟨f x, n, hn, hfg x n⟩
    · rintro ⟨x, n, hn, rfl⟩
      obtain ⟨y, rfl⟩ := hf x
      exact ⟨⁅y, n⁆, ⟨y, n, hn, rfl⟩, (hfg y n).symm⟩
#align function.surjective.lie_module_lcs_map_eq Function.Surjective.lieModule_lcs_map_eq

theorem Function.Surjective.lieModuleIsNilpotent [IsNilpotent R L M] : IsNilpotent R L₂ M₂ :=
  by
  obtain ⟨k, hk⟩ := id (by infer_instance : IsNilpotent R L M)
  use k
  rw [← LieSubmodule.coe_to_submodule_eq_iff] at hk⊢
  simp [← hf.lie_module_lcs_map_eq hg hfg k, hk]
#align function.surjective.lie_module_is_nilpotent Function.Surjective.lieModuleIsNilpotent

omit hf hg hfg

theorem Equiv.lieModule_isNilpotent_iff (f : L ≃ₗ⁅R⁆ L₂) (g : M ≃ₗ[R] M₂)
    (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆) : IsNilpotent R L M ↔ IsNilpotent R L₂ M₂ :=
  by
  constructor <;> intro h
  · have hg : surjective (g : M →ₗ[R] M₂) := g.surjective
    exact f.surjective.lie_module_is_nilpotent hg hfg
  · have hg : surjective (g.symm : M₂ →ₗ[R] M) := g.symm.surjective
    refine' f.symm.surjective.lie_module_is_nilpotent hg fun x m => _
    rw [LinearEquiv.coe_coe, LieEquiv.coe_to_lieHom, ← g.symm_apply_apply ⁅f.symm x, g.symm m⁆, ←
      hfg, f.apply_symm_apply, g.apply_symm_apply]
#align equiv.lie_module_is_nilpotent_iff Equiv.lieModule_isNilpotent_iff

@[simp]
theorem LieModule.isNilpotent_of_top_iff :
    IsNilpotent R (⊤ : LieSubalgebra R L) M ↔ IsNilpotent R L M :=
  Equiv.lieModule_isNilpotent_iff LieSubalgebra.topEquiv (1 : M ≃ₗ[R] M) fun x m => rfl
#align lie_module.is_nilpotent_of_top_iff LieModule.isNilpotent_of_top_iff

end Morphisms

end NilpotentModules

instance (priority := 100) LieAlgebra.isSolvableOfIsNilpotent (R : Type u) (L : Type v) [CommRing R]
    [LieRing L] [LieAlgebra R L] [hL : LieModule.IsNilpotent R L L] : LieAlgebra.IsSolvable R L :=
  by
  obtain ⟨k, h⟩ : ∃ k, LieModule.lowerCentralSeries R L L k = ⊥ := hL.nilpotent
  use k; rw [← le_bot_iff] at h⊢
  exact le_trans (LieModule.derivedSeries_le_lowerCentralSeries R L k) h
#align lie_algebra.is_solvable_of_is_nilpotent LieAlgebra.isSolvableOfIsNilpotent

section NilpotentAlgebras

variable (R : Type u) (L : Type v) (L' : Type w)

variable [CommRing R] [LieRing L] [LieAlgebra R L] [LieRing L'] [LieAlgebra R L']

/-- We say a Lie algebra is nilpotent when it is nilpotent as a Lie module over itself via the
adjoint representation. -/
abbrev LieAlgebra.IsNilpotent (R : Type u) (L : Type v) [CommRing R] [LieRing L] [LieAlgebra R L] :
    Prop :=
  LieModule.IsNilpotent R L L
#align lie_algebra.is_nilpotent LieAlgebra.IsNilpotent

open LieAlgebra

theorem LieAlgebra.nilpotent_ad_of_nilpotent_algebra [IsNilpotent R L] :
    ∃ k : ℕ, ∀ x : L, ad R L x ^ k = 0 :=
  LieModule.nilpotent_endo_of_nilpotent_module R L L
#align lie_algebra.nilpotent_ad_of_nilpotent_algebra LieAlgebra.nilpotent_ad_of_nilpotent_algebra

/-- See also `lie_algebra.zero_root_space_eq_top_of_nilpotent`. -/
theorem LieAlgebra.infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent [IsNilpotent R L] :
    (⨅ x : L, (ad R L x).maximalGeneralizedEigenspace 0) = ⊤ :=
  LieModule.infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent R L L
#align lie_algebra.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent LieAlgebra.infᵢ_max_gen_zero_eigenspace_eq_top_of_nilpotent

-- TODO Generalise the below to Lie modules if / when we define morphisms, equivs of Lie modules
-- covering a Lie algebra morphism of (possibly different) Lie algebras.
variable {R L L'}

open LieModule (lowerCentralSeries)

/-- Given an ideal `I` of a Lie algebra `L`, the lower central series of `L ⧸ I` is the same
whether we regard `L ⧸ I` as an `L` module or an `L ⧸ I` module.

TODO: This result obviously generalises but the generalisation requires the missing definition of
morphisms between Lie modules over different Lie algebras. -/
theorem coe_lowerCentralSeries_ideal_quot_eq {I : LieIdeal R L} (k : ℕ) :
    (lowerCentralSeries R L (L ⧸ I) k : Submodule R (L ⧸ I)) =
      lowerCentralSeries R (L ⧸ I) (L ⧸ I) k :=
  by
  induction' k with k ih
  · simp only [LieSubmodule.top_coeSubmodule, LieModule.lowerCentralSeries_zero]
  · simp only [LieModule.lowerCentralSeries_succ, LieSubmodule.lieIdeal_oper_eq_linear_span]
    congr
    ext x
    constructor
    · rintro ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩
      erw [← LieSubmodule.mem_coeSubmodule, ih, LieSubmodule.mem_coeSubmodule] at hz
      exact ⟨⟨LieSubmodule.Quotient.mk y, LieSubmodule.mem_top _⟩, ⟨z, hz⟩, rfl⟩
    · rintro ⟨⟨⟨y⟩, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩
      erw [← LieSubmodule.mem_coeSubmodule, ← ih, LieSubmodule.mem_coeSubmodule] at hz
      exact ⟨⟨y, LieSubmodule.mem_top _⟩, ⟨z, hz⟩, rfl⟩
#align coe_lower_central_series_ideal_quot_eq coe_lowerCentralSeries_ideal_quot_eq

/-- Note that the below inequality can be strict. For example the ideal of strictly-upper-triangular
2x2 matrices inside the Lie algebra of upper-triangular 2x2 matrices with `k = 1`. -/
theorem LieModule.coe_lowerCentralSeries_ideal_le {I : LieIdeal R L} (k : ℕ) :
    (lowerCentralSeries R I I k : Submodule R I) ≤ lowerCentralSeries R L I k :=
  by
  induction' k with k ih
  · simp
  · simp only [LieModule.lowerCentralSeries_succ, LieSubmodule.lieIdeal_oper_eq_linear_span]
    apply Submodule.span_mono
    rintro x ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩
    exact ⟨⟨y.val, LieSubmodule.mem_top _⟩, ⟨z, ih hz⟩, rfl⟩
#align lie_module.coe_lower_central_series_ideal_le LieModule.coe_lowerCentralSeries_ideal_le

/-- A central extension of nilpotent Lie algebras is nilpotent. -/
theorem LieAlgebra.nilpotent_of_nilpotent_quotient {I : LieIdeal R L} (h₁ : I ≤ center R L)
    (h₂ : IsNilpotent R (L ⧸ I)) : IsNilpotent R L :=
  by
  suffices LieModule.IsNilpotent R L (L ⧸ I) by
    exact LieModule.nilpotentOfNilpotentQuotient R L L h₁ this
  obtain ⟨k, hk⟩ := h₂
  use k
  simp [← LieSubmodule.coe_to_submodule_eq_iff, coe_lowerCentralSeries_ideal_quot_eq, hk]
#align lie_algebra.nilpotent_of_nilpotent_quotient LieAlgebra.nilpotent_of_nilpotent_quotient

theorem LieAlgebra.non_trivial_center_of_isNilpotent [Nontrivial L] [IsNilpotent R L] :
    Nontrivial <| center R L :=
  LieModule.nontrivial_max_triv_of_isNilpotent R L L
#align lie_algebra.non_trivial_center_of_is_nilpotent LieAlgebra.non_trivial_center_of_isNilpotent

theorem LieIdeal.map_lowerCentralSeries_le (k : ℕ) {f : L →ₗ⁅R⁆ L'} :
    LieIdeal.map f (lowerCentralSeries R L L k) ≤ lowerCentralSeries R L' L' k :=
  by
  induction' k with k ih
  · simp only [LieModule.lowerCentralSeries_zero, le_top]
  · simp only [LieModule.lowerCentralSeries_succ]
    exact le_trans (LieIdeal.map_bracket_le f) (LieSubmodule.mono_lie _ _ _ _ le_top ih)
#align lie_ideal.map_lower_central_series_le LieIdeal.map_lowerCentralSeries_le

theorem LieIdeal.lowerCentralSeries_map_eq (k : ℕ) {f : L →ₗ⁅R⁆ L'} (h : Function.Surjective f) :
    LieIdeal.map f (lowerCentralSeries R L L k) = lowerCentralSeries R L' L' k :=
  by
  have h' : (⊤ : LieIdeal R L).map f = ⊤ :=
    by
    rw [← f.ideal_range_eq_map]
    exact f.ideal_range_eq_top_of_surjective h
  induction' k with k ih
  · simp only [LieModule.lowerCentralSeries_zero]
    exact h'
  · simp only [LieModule.lowerCentralSeries_succ, LieIdeal.map_bracket_eq f h, ih, h']
#align lie_ideal.lower_central_series_map_eq LieIdeal.lowerCentralSeries_map_eq

theorem Function.Injective.lieAlgebra_isNilpotent [h₁ : IsNilpotent R L'] {f : L →ₗ⁅R⁆ L'}
    (h₂ : Function.Injective f) : IsNilpotent R L :=
  {
    nilpotent := by
      obtain ⟨k, hk⟩ := id h₁
      use k
      apply LieIdeal.bot_of_map_eq_bot h₂; rw [eq_bot_iff, ← hk]
      apply LieIdeal.map_lowerCentralSeries_le }
#align function.injective.lie_algebra_is_nilpotent Function.Injective.lieAlgebra_isNilpotent

theorem Function.Surjective.lieAlgebra_isNilpotent [h₁ : IsNilpotent R L] {f : L →ₗ⁅R⁆ L'}
    (h₂ : Function.Surjective f) : IsNilpotent R L' :=
  {
    nilpotent := by
      obtain ⟨k, hk⟩ := id h₁
      use k
      rw [← LieIdeal.lowerCentralSeries_map_eq k h₂, hk]
      simp only [LieIdeal.map_eq_bot_iff, bot_le] }
#align function.surjective.lie_algebra_is_nilpotent Function.Surjective.lieAlgebra_isNilpotent

theorem LieEquiv.nilpotent_iff_equiv_nilpotent (e : L ≃ₗ⁅R⁆ L') :
    IsNilpotent R L ↔ IsNilpotent R L' :=
  by
  constructor <;> intro h
  · exact e.symm.injective.lie_algebra_is_nilpotent
  · exact e.injective.lie_algebra_is_nilpotent
#align lie_equiv.nilpotent_iff_equiv_nilpotent LieEquiv.nilpotent_iff_equiv_nilpotent

theorem LieHom.isNilpotent_range [IsNilpotent R L] (f : L →ₗ⁅R⁆ L') : IsNilpotent R f.range :=
  f.surjective_rangeRestrict.lieAlgebra_isNilpotent
#align lie_hom.is_nilpotent_range LieHom.isNilpotent_range

/-- Note that this result is not quite a special case of
`lie_module.is_nilpotent_range_to_endomorphism_iff` which concerns nilpotency of the
`(ad R L).range`-module `L`, whereas this result concerns nilpotency of the `(ad R L).range`-module
`(ad R L).range`. -/
@[simp]
theorem LieAlgebra.isNilpotent_range_ad_iff : IsNilpotent R (ad R L).range ↔ IsNilpotent R L :=
  by
  refine' ⟨fun h => _, _⟩
  · have : (ad R L).ker = center R L := by simp
    exact
      LieAlgebra.nilpotent_of_nilpotent_quotient (le_of_eq this)
        ((ad R L).quotKerEquivRange.nilpotent_iff_equiv_nilpotent.mpr h)
  · intro h
    exact (ad R L).isNilpotent_range
#align lie_algebra.is_nilpotent_range_ad_iff LieAlgebra.isNilpotent_range_ad_iff

instance [h : LieAlgebra.IsNilpotent R L] : LieAlgebra.IsNilpotent R (⊤ : LieSubalgebra R L) :=
  LieSubalgebra.topEquiv.nilpotent_iff_equiv_nilpotent.mpr h

end NilpotentAlgebras

namespace LieIdeal

open LieModule

variable {R L : Type _} [CommRing R] [LieRing L] [LieAlgebra R L] (I : LieIdeal R L)

variable (M : Type _) [AddCommGroup M] [Module R M] [LieRingModule L M] [LieModule R L M]

variable (k : ℕ)

/-- Given a Lie module `M` over a Lie algebra `L` together with an ideal `I` of `L`, this is the
lower central series of `M` as an `I`-module. The advantage of using this definition instead of
`lie_module.lower_central_series R I M` is that its terms are Lie submodules of `M` as an
`L`-module, rather than just as an `I`-module.

See also `lie_ideal.coe_lcs_eq`. -/
def lcs : LieSubmodule R L M :=
  ((fun N => ⁅I, N⁆)^[k]) ⊤
#align lie_ideal.lcs LieIdeal.lcs

@[simp]
theorem lcs_zero : I.lcs M 0 = ⊤ :=
  rfl
#align lie_ideal.lcs_zero LieIdeal.lcs_zero

@[simp]
theorem lcs_succ : I.lcs M (k + 1) = ⁅I, I.lcs M k⁆ :=
  Function.iterate_succ_apply' (fun N => ⁅I, N⁆) k ⊤
#align lie_ideal.lcs_succ LieIdeal.lcs_succ

theorem lcs_top : (⊤ : LieIdeal R L).lcs M k = lowerCentralSeries R L M k :=
  rfl
#align lie_ideal.lcs_top LieIdeal.lcs_top

theorem coe_lcs_eq : (I.lcs M k : Submodule R M) = lowerCentralSeries R I M k :=
  by
  induction' k with k ih
  · simp
  · simp_rw [lower_central_series_succ, lcs_succ, LieSubmodule.lieIdeal_oper_eq_linear_span', ←
      (I.lcs M k).mem_coe_submodule, ih, LieSubmodule.mem_coeSubmodule, LieSubmodule.mem_top,
      exists_true_left, (I : LieSubalgebra R L).coe_bracket_of_module]
    congr
    ext m
    constructor
    · rintro ⟨x, hx, m, hm, rfl⟩
      exact ⟨⟨x, hx⟩, m, hm, rfl⟩
    · rintro ⟨⟨x, hx⟩, m, hm, rfl⟩
      exact ⟨x, hx, m, hm, rfl⟩
#align lie_ideal.coe_lcs_eq LieIdeal.coe_lcs_eq

end LieIdeal

section OfAssociative

variable (R : Type u) {A : Type v} [CommRing R] [Ring A] [Algebra R A]

theorem LieAlgebra.ad_nilpotent_of_nilpotent {a : A} (h : IsNilpotent a) :
    IsNilpotent (LieAlgebra.ad R A a) :=
  by
  rw [LieAlgebra.ad_eq_lmul_left_sub_lmul_right]
  have hl : IsNilpotent (LinearMap.mulLeft R a) := by rwa [LinearMap.isNilpotent_mulLeft_iff]
  have hr : IsNilpotent (LinearMap.mulRight R a) := by rwa [LinearMap.isNilpotent_mulRight_iff]
  have := @LinearMap.commute_mulLeft_right R A _ _ _ _ _ a a
  exact this.is_nilpotent_sub hl hr
#align lie_algebra.ad_nilpotent_of_nilpotent LieAlgebra.ad_nilpotent_of_nilpotent

variable {R}

theorem LieSubalgebra.isNilpotent_ad_of_isNilpotent_ad {L : Type v} [LieRing L] [LieAlgebra R L]
    (K : LieSubalgebra R L) {x : K} (h : IsNilpotent (LieAlgebra.ad R L ↑x)) :
    IsNilpotent (LieAlgebra.ad R K x) :=
  by
  obtain ⟨n, hn⟩ := h
  use n
  exact LinearMap.submodule_pow_eq_zero_of_pow_eq_zero (K.ad_comp_incl_eq x) hn
#align lie_subalgebra.is_nilpotent_ad_of_is_nilpotent_ad LieSubalgebra.isNilpotent_ad_of_isNilpotent_ad

theorem LieAlgebra.isNilpotent_ad_of_isNilpotent {L : LieSubalgebra R A} {x : L}
    (h : IsNilpotent (x : A)) : IsNilpotent (LieAlgebra.ad R L x) :=
  L.isNilpotent_ad_of_isNilpotent_ad <| LieAlgebra.ad_nilpotent_of_nilpotent R h
#align lie_algebra.is_nilpotent_ad_of_is_nilpotent LieAlgebra.isNilpotent_ad_of_isNilpotent

end OfAssociative


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.continued_fractions.computation.basic
import Mathlib.algebra.continued_fractions.translations
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Basic Translation Lemmas Between Structures Defined for Computing Continued Fractions

## Summary

This is a collection of simple lemmas between the different structures used for the computation
of continued fractions defined in `algebra.continued_fractions.computation.basic`. The file consists
of three sections:
1. Recurrences and inversion lemmas for `int_fract_pair.stream`: these lemmas give us inversion
   rules and recurrences for the computation of the stream of integer and fractional parts of a value.
2. Translation lemmas for the head term: these lemmas show us that the head term of the computed
   continued fraction of a value `v` is `⌊v⌋` and how this head term is moved along the structures
   used in the computation process.
3. Translation lemmas for the sequence: these lemmas show how the sequences of the involved
   structures (`int_fract_pair.stream`, `int_fract_pair.seq1`, and `generalized_continued_fraction.of`)
   are connected, i.e. how the values are moved along the structures and the termination of one
   sequence implies the termination of another sequence.

## Main Theorems

- `succ_nth_stream_eq_some_iff` gives as a recurrence to compute the `n + 1`th value of the sequence
  of integer and fractional parts of a value in case of non-termination.
- `succ_nth_stream_eq_none_iff` gives as a recurrence to compute the `n + 1`th value of the sequence
  of integer and fractional parts of a value in case of termination.
- `nth_of_eq_some_of_succ_nth_int_fract_pair_stream` and
  `nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero` show how the entries of the sequence
  of the computed continued fraction can be obtained from the stream of integer and fractional parts.
-/

namespace generalized_continued_fraction

/- Fix a discrete linear ordered floor field and a value `v`. -/

namespace int_fract_pair

/-!
### Recurrences and Inversion Lemmas for `int_fract_pair.stream`

Here we state some lemmas that give us inversion rules and recurrences for the computation of the
stream of integer and fractional parts of a value.
-/

theorem stream_eq_none_of_fr_eq_zero {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {ifp_n : int_fract_pair K} (stream_nth_eq : int_fract_pair.stream v n = some ifp_n) (nth_fr_eq_zero : fr ifp_n = 0) : int_fract_pair.stream v (n + 1) = none := sorry

/--
Gives a recurrence to compute the `n + 1`th value of the sequence of integer and fractional
parts of a value in case of termination.
-/
theorem succ_nth_stream_eq_none_iff {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} : int_fract_pair.stream v (n + 1) = none ↔
  int_fract_pair.stream v n = none ∨ ∃ (ifp : int_fract_pair K), int_fract_pair.stream v n = some ifp ∧ fr ifp = 0 := sorry

/--
Gives a recurrence to compute the `n + 1`th value of the sequence of integer and fractional
parts of a value in case of non-termination.
-/
theorem succ_nth_stream_eq_some_iff {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {ifp_succ_n : int_fract_pair K} : int_fract_pair.stream v (n + 1) = some ifp_succ_n ↔
  ∃ (ifp_n : int_fract_pair K),
    int_fract_pair.stream v n = some ifp_n ∧ fr ifp_n ≠ 0 ∧ int_fract_pair.of (fr ifp_n⁻¹) = ifp_succ_n := sorry

theorem exists_succ_nth_stream_of_fr_zero {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {ifp_succ_n : int_fract_pair K} (stream_succ_nth_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n) (succ_nth_fr_eq_zero : fr ifp_succ_n = 0) : ∃ (ifp_n : int_fract_pair K), int_fract_pair.stream v n = some ifp_n ∧ fr ifp_n⁻¹ = ↑(floor (fr ifp_n⁻¹)) := sorry

end int_fract_pair

/-!
### Translation of the Head Term

Here we state some lemmas that show us that the head term of the computed continued fraction of a
value `v` is `⌊v⌋` and how this head term is moved along the structures used in the computation
process.
-/

/-- The head term of the sequence with head of `v` is just the integer part of `v`. -/
@[simp] theorem int_fract_pair.seq1_fst_eq_of {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} : prod.fst (int_fract_pair.seq1 v) = int_fract_pair.of v :=
  rfl

theorem of_h_eq_int_fract_pair_seq1_fst_b {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} : h (generalized_continued_fraction.of v) = ↑(int_fract_pair.b (prod.fst (int_fract_pair.seq1 v))) := sorry

/-- The head term of the gcf of `v` is `⌊v⌋`. -/
@[simp] theorem of_h_eq_floor {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} : h (generalized_continued_fraction.of v) = ↑(floor v) := sorry

/-!
### Translation of the Sequences

Here we state some lemmas that show how the sequences of the involved structures
(`int_fract_pair.stream`, `int_fract_pair.seq1`, and `generalized_continued_fraction.of`) are
connected, i.e. how the values are moved along the structures and how the termination of one sequence
implies the termination of another sequence.
-/

theorem int_fract_pair.nth_seq1_eq_succ_nth_stream {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} : seq.nth (prod.snd (int_fract_pair.seq1 v)) n = int_fract_pair.stream v (n + 1) :=
  rfl

/-!
#### Translation of the Termination of the Sequences

Let's first show how the termination of one sequence implies the termination of another sequence.
-/

theorem of_terminated_at_iff_int_fract_pair_seq1_terminated_at {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} : terminated_at (generalized_continued_fraction.of v) n ↔ seq.terminated_at (prod.snd (int_fract_pair.seq1 v)) n := sorry

theorem of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} : terminated_at (generalized_continued_fraction.of v) n ↔ int_fract_pair.stream v (n + 1) = none := sorry

/-!
#### Translation of the Values of the Sequence

Now let's show how the values of the sequences correspond to one another.
-/

theorem int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {gp_n : pair K} (s_nth_eq : seq.nth (s (generalized_continued_fraction.of v)) n = some gp_n) : ∃ (ifp : int_fract_pair K), int_fract_pair.stream v (n + 1) = some ifp ∧ ↑(int_fract_pair.b ifp) = pair.b gp_n := sorry

/--
Shows how the entries of the sequence of the computed continued fraction can be obtained by the
integer parts of the stream of integer and fractional parts.
-/
theorem nth_of_eq_some_of_succ_nth_int_fract_pair_stream {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {ifp_succ_n : int_fract_pair K} (stream_succ_nth_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n) : seq.nth (s (generalized_continued_fraction.of v)) n = some (pair.mk 1 ↑(int_fract_pair.b ifp_succ_n)) := sorry

/--
Shows how the entries of the sequence of the computed continued fraction can be obtained by the
fractional parts of the stream of integer and fractional parts.
-/
theorem nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero {K : Type u_1} [linear_ordered_field K] [floor_ring K] {v : K} {n : ℕ} {ifp_n : int_fract_pair K} (stream_nth_eq : int_fract_pair.stream v n = some ifp_n) (nth_fr_ne_zero : int_fract_pair.fr ifp_n ≠ 0) : seq.nth (s (generalized_continued_fraction.of v)) n =
  some (pair.mk 1 ↑(int_fract_pair.b (int_fract_pair.of (int_fract_pair.fr ifp_n⁻¹)))) := sorry


import tactic.observe

example (a b c : ℕ) : a * (b * c) = (b * a) * c :=
begin
  observe : a * b = b * a,
  rw [← this, nat.mul_assoc],
end


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

! This file was ported from Lean 3 source module algebraic_geometry.projective_spectrum.scheme
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.ProjectiveSpectrum.StructureSheaf
import Mathbin.AlgebraicGeometry.Spec
import Mathbin.RingTheory.GradedAlgebra.Radical

/-!
# Proj as a scheme

This file is to prove that `Proj` is a scheme.

## Notation

* `Proj`      : `Proj` as a locally ringed space
* `Proj.T`    : the underlying topological space of `Proj`
* `Proj| U`   : `Proj` restricted to some open set `U`
* `Proj.T| U` : the underlying topological space of `Proj` restricted to open set `U`
* `pbo f`     : basic open set at `f` in `Proj`
* `Spec`      : `Spec` as a locally ringed space
* `Spec.T`    : the underlying topological space of `Spec`
* `sbo g`     : basic open set at `g` in `Spec`
* `A⁰_x`      : the degree zero part of localized ring `Aₓ`

## Implementation

In `src/algebraic_geometry/projective_spectrum/structure_sheaf.lean`, we have given `Proj` a
structure sheaf so that `Proj` is a locally ringed space. In this file we will prove that `Proj`
equipped with this structure sheaf is a scheme. We achieve this by using an affine cover by basic
open sets in `Proj`, more specifically:

1. We prove that `Proj` can be covered by basic open sets at homogeneous element of positive degree.
2. We prove that for any homogeneous element `f : A` of positive degree `m`, `Proj.T | (pbo f)` is
    homeomorphic to `Spec.T A⁰_f`:
  - forward direction `to_Spec`:
    for any `x : pbo f`, i.e. a relevant homogeneous prime ideal `x`, send it to
    `A⁰_f ∩ span {g / 1 | g ∈ x}` (see `Proj_iso_Spec_Top_component.to_Spec.carrier`). This ideal is
    prime, the proof is in `Proj_iso_Spec_Top_component.to_Spec.to_fun`. The fact that this function
    is continuous is found in `Proj_iso_Spec_Top_component.to_Spec`
  - backward direction `from_Spec`:
    for any `q : Spec A⁰_f`, we send it to `{a | ∀ i, aᵢᵐ/fⁱ ∈ q}`; we need this to be a
    homogeneous prime ideal that is relevant.
    * This is in fact an ideal, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal`;
    * This ideal is also homogeneous, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.homogeneous`;
    * This ideal is relevant, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.relevant`;
    * This ideal is prime, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.prime`.
    Hence we have a well defined function `Spec.T A⁰_f → Proj.T | (pbo f)`, this function is called
    `Proj_iso_Spec_Top_component.from_Spec.to_fun`. But to prove the continuity of this function,
    we need to prove `from_Spec ∘ to_Spec` and `to_Spec ∘ from_Spec` are both identities (TBC).

## Main Definitions and Statements

* `degree_zero_part`: the degree zero part of the localized ring `Aₓ` where `x` is a homogeneous
  element of degree `n` is the subring of elements of the form `a/f^m` where `a` has degree `mn`.

For a homogeneous element `f` of degree `n`
* `Proj_iso_Spec_Top_component.to_Spec`: `forward f` is the
  continuous map between `Proj.T| pbo f` and `Spec.T A⁰_f`
* `Proj_iso_Spec_Top_component.to_Spec.preimage_eq`: for any `a: A`, if `a/f^m` has degree zero,
  then the preimage of `sbo a/f^m` under `to_Spec f` is `pbo f ∩ pbo a`.

* [Robin Hartshorne, *Algebraic Geometry*][Har77]: Chapter II.2 Proposition 2.5
-/

noncomputable section

namespace AlgebraicGeometry

open DirectSum BigOperators Pointwise BigOperators

open DirectSum SetLike.GradedMonoid Localization

open Finset hiding mk_zero

variable {R A : Type _}

variable [CommRing R] [CommRing A] [Algebra R A]

variable (𝒜 : ℕ → Submodule R A)

variable [GradedAlgebra 𝒜]

open TopCat TopologicalSpace

open CategoryTheory Opposite

open ProjectiveSpectrum.StructureSheaf

-- mathport name: exprProj
local notation "Proj" => Proj.toLocallyRingedSpace 𝒜

-- mathport name: «exprProj.T»
-- `Proj` as a locally ringed space
local notation "Proj.T" => Proj.1.1.1

-- mathport name: «exprProj| »
-- the underlying topological space of `Proj`
local notation "Proj| " U => Proj.restrict (Opens.openEmbedding (U : Opens Proj.T))

-- mathport name: «exprProj.T| »
-- `Proj` restrict to some open set
local notation "Proj.T| " U =>
  (Proj.restrict (Opens.openEmbedding (U : Opens Proj.T))).toSheafedSpace.toPresheafedSpace.1

-- mathport name: «exprpbo »
-- the underlying topological space of `Proj` restricted to some open set
local notation "pbo " x => ProjectiveSpectrum.basicOpen 𝒜 x

-- mathport name: «exprsbo »
-- basic open sets in `Proj`
local notation "sbo " f => PrimeSpectrum.basicOpen f

-- mathport name: «exprSpec »
-- basic open sets in `Spec`
local notation "Spec " ring => Spec.locallyRingedSpaceObj (CommRingCat.of Ring)

-- mathport name: «exprSpec.T »
-- `Spec` as a locally ringed space
local notation "Spec.T " ring =>
  (Spec.locallyRingedSpaceObj (CommRingCat.of Ring)).toSheafedSpace.toPresheafedSpace.1

-- mathport name: «exprA⁰_ »
-- the underlying topological space of `Spec`
local notation "A⁰_ " f => HomogeneousLocalization.Away 𝒜 f

namespace ProjIsoSpecTopComponent

/-
This section is to construct the homeomorphism between `Proj` restricted at basic open set at
a homogeneous element `x` and `Spec A⁰ₓ` where `A⁰ₓ` is the degree zero part of the localized
ring `Aₓ`.
-/
namespace ToSpec

open Ideal

-- This section is to construct the forward direction :
-- So for any `x` in `Proj| (pbo f)`, we need some point in `Spec A⁰_f`, i.e. a prime ideal,
-- and we need this correspondence to be continuous in their Zariski topology.
variable {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : Proj| pbo f)

/--
For any `x` in `Proj| (pbo f)`, the corresponding ideal in `Spec A⁰_f`. This fact that this ideal
is prime is proven in `Top_component.forward.to_fun`-/
def carrier : Ideal (A⁰_ f) :=
  Ideal.comap (algebraMap (A⁰_ f) (Away f))
    (Ideal.span <| algebraMap A (Away f) '' x.val.asHomogeneousIdeal)
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.carrier AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.carrier

theorem mem_carrier_iff (z : A⁰_ f) :
    z ∈ carrier 𝒜 x ↔ z.val ∈ Ideal.span (algebraMap A (Away f) '' x.1.asHomogeneousIdeal) :=
  Iff.rfl
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.mem_carrier_iff

theorem MemCarrier.clear_denominator' [DecidableEq (Away f)] {z : Localization.Away f}
    (hz : z ∈ span (algebraMap A (Away f) '' x.val.asHomogeneousIdeal)) :
    ∃ (c : algebraMap A (Away f) '' x.1.asHomogeneousIdeal →₀ Away f)(N : ℕ)(acd :
      ∀ y ∈ c.support.image c, A),
      f ^ N • z =
        algebraMap A (Away f)
          (∑ i in c.support.attach,
            acd (c i) (Finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) :=
  by
  rw [← submodule_span_eq, Finsupp.span_eq_range_total, LinearMap.mem_range] at hz
  rcases hz with ⟨c, eq1⟩
  rw [Finsupp.total_apply, Finsupp.sum] at eq1
  obtain ⟨⟨_, N, rfl⟩, hN⟩ :=
    IsLocalization.exist_integer_multiples_of_finset (Submonoid.powers f) (c.support.image c)
  choose acd hacd using hN
  refine' ⟨c, N, acd, _⟩
  rw [← eq1, smul_sum, map_sum, ← sum_attach]
  congr 1
  ext i
  rw [_root_.map_mul, hacd, (Classical.choose_spec i.1.2).2, smul_eq_mul, smul_mul_assoc]
  rfl
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.mem_carrier.clear_denominator' AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.MemCarrier.clear_denominator'

theorem MemCarrier.clear_denominator [DecidableEq (Away f)] {z : A⁰_ f} (hz : z ∈ carrier 𝒜 x) :
    ∃ (c : algebraMap A (Away f) '' x.1.asHomogeneousIdeal →₀ Away f)(N : ℕ)(acd :
      ∀ y ∈ c.support.image c, A),
      f ^ N • z.val =
        algebraMap A (Away f)
          (∑ i in c.support.attach,
            acd (c i) (Finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) :=
  MemCarrier.clear_denominator' x <| (mem_carrier_iff 𝒜 x z).mpr hz
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.mem_carrier.clear_denominator AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.MemCarrier.clear_denominator

theorem disjoint : Disjoint (x.1.asHomogeneousIdeal.toIdeal : Set A) (Submonoid.powers f : Set A) :=
  by
  by_contra rid
  rw [Set.not_disjoint_iff] at rid
  choose g hg using rid
  obtain ⟨hg1, ⟨k, rfl⟩⟩ := hg
  by_cases k_ineq : 0 < k
  · erw [x.1.IsPrime.pow_mem_iff_mem _ k_ineq] at hg1
    exact x.2 hg1
  · erw [show k = 0 by linarith, pow_zero, ← Ideal.eq_top_iff_one] at hg1
    apply x.1.IsPrime.1
    exact hg1
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.disjoint AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.disjoint

theorem carrier_ne_top : carrier 𝒜 x ≠ ⊤ :=
  by
  have eq_top := Disjoint x
  classical
    contrapose! eq_top
    obtain ⟨c, N, acd, eq1⟩ :=
      mem_carrier.clear_denominator _ x ((Ideal.eq_top_iff_one _).mp eq_top)
    rw [Algebra.smul_def, HomogeneousLocalization.one_val, mul_one] at eq1
    change Localization.mk (f ^ N) 1 = mk (∑ _, _) 1 at eq1
    simp only [mk_eq_mk', IsLocalization.eq] at eq1
    rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩
    erw [one_mul, one_mul] at eq1
    change f ^ _ * f ^ _ = f ^ _ * _ at eq1
    rw [Set.not_disjoint_iff_nonempty_inter]
    refine'
      ⟨f ^ M * f ^ N, eq1.symm ▸ mul_mem_left _ _ (sum_mem _ fun i hi => mul_mem_left _ _ _),
        ⟨M + N, by rw [pow_add]⟩⟩
    generalize_proofs h₁ h₂
    exact (Classical.choose_spec h₂).1
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.carrier_ne_top AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.carrier_ne_top

variable (f)

/-- The function between the basic open set `D(f)` in `Proj` to the corresponding basic open set in
`Spec A⁰_f`. This is bundled into a continuous map in `Top_component.forward`.
-/
def toFun (x : Proj.T| pbo f) : Spec.T A⁰_ f :=
  ⟨carrier 𝒜 x, carrier_ne_top x, fun x1 x2 hx12 => by
    classical
      simp only [mem_carrier_iff] at hx12⊢
      let J := span (⇑(algebraMap A (away f)) '' x.val.as_homogeneous_ideal)
      suffices h : ∀ x y : Localization.Away f, x * y ∈ J → x ∈ J ∨ y ∈ J
      · rw [HomogeneousLocalization.mul_val] at hx12
        exact h x1.val x2.val hx12
      clear x1 x2 hx12
      intro x1 x2 hx12
      induction' x1 using Localization.induction_on with data_x1
      induction' x2 using Localization.induction_on with data_x2
      rcases data_x1, data_x2 with ⟨⟨a1, _, ⟨n1, rfl⟩⟩, ⟨a2, _, ⟨n2, rfl⟩⟩⟩
      rcases mem_carrier.clear_denominator' x hx12 with ⟨c, N, acd, eq1⟩
      simp only [Algebra.smul_def] at eq1
      change Localization.mk (f ^ N) 1 * (mk _ _ * mk _ _) = mk (∑ _, _) _ at eq1
      simp only [Localization.mk_mul, one_mul] at eq1
      simp only [mk_eq_mk', IsLocalization.eq] at eq1
      rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩
      rw [Submonoid.coe_one, one_mul] at eq1
      change f ^ _ * (_ * _) = f ^ _ * (f ^ _ * f ^ _ * _) at eq1
      rcases x.1.IsPrime.mem_or_mem (show a1 * a2 * f ^ N * f ^ M ∈ _ from _) with (h1 | rid2)
      rcases x.1.IsPrime.mem_or_mem h1 with (h1 | rid1)
      rcases x.1.IsPrime.mem_or_mem h1 with (h1 | h2)
      · left
        simp only [show (mk a1 ⟨f ^ n1, _⟩ : away f) = mk a1 1 * mk 1 ⟨f ^ n1, ⟨n1, rfl⟩⟩ by
            rw [Localization.mk_mul, mul_one, one_mul]]
        exact Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨_, h1, rfl⟩)
      · right
        simp only [show (mk a2 ⟨f ^ n2, _⟩ : away f) = mk a2 1 * mk 1 ⟨f ^ n2, ⟨n2, rfl⟩⟩ by
            rw [Localization.mk_mul, mul_one, one_mul]]
        exact Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨_, h2, rfl⟩)
      · exact False.elim (x.2 (x.1.IsPrime.mem_of_pow_mem N rid1))
      · exact False.elim (x.2 (x.1.IsPrime.mem_of_pow_mem M rid2))
      · rw [← mul_comm (f ^ M), ← mul_comm (f ^ N), eq1]
        refine' mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ fun i hi => mul_mem_left _ _ _))
        generalize_proofs h₁ h₂
        exact (Classical.choose_spec h₂).1⟩
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.to_fun AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.toFun

/-
The preimage of basic open set `D(a/f^n)` in `Spec A⁰_f` under the forward map from `Proj A` to
`Spec A⁰_f` is the basic open set `D(a) ∩ D(f)` in  `Proj A`. This lemma is used to prove that the
forward map is continuous.
-/
theorem preimage_eq (a b : A) (k : ℕ) (a_mem : a ∈ 𝒜 k) (b_mem1 : b ∈ 𝒜 k)
    (b_mem2 : b ∈ Submonoid.powers f) :
    toFun 𝒜 f ⁻¹'
        (@PrimeSpectrum.basicOpen (A⁰_ f) _ (Quotient.mk'' ⟨k, ⟨a, a_mem⟩, ⟨b, b_mem1⟩, b_mem2⟩) :
          Set (PrimeSpectrum (HomogeneousLocalization.Away 𝒜 f))) =
      { x | x.1 ∈ (pbo f) ⊓ pbo a } :=
  by
  classical
    ext1 y
    constructor <;> intro hy
    · refine' ⟨y.2, _⟩
      rw [Set.mem_preimage, SetLike.mem_coe, PrimeSpectrum.mem_basicOpen] at hy
      rw [ProjectiveSpectrum.mem_coe_basicOpen]
      intro a_mem_y
      apply hy
      rw [to_fun, mem_carrier_iff, HomogeneousLocalization.val_mk'', Subtype.coe_mk]
      dsimp
      rcases b_mem2 with ⟨k, hk⟩
      simp only [show (mk a ⟨b, ⟨k, hk⟩⟩ : away f) = mk 1 ⟨f ^ k, ⟨_, rfl⟩⟩ * mk a 1
          by
          rw [mk_mul, one_mul, mul_one]
          congr
          rw [hk]]
      exact Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨_, a_mem_y, rfl⟩)
    · change y.1 ∈ _ at hy
      rcases hy with ⟨hy1, hy2⟩
      rw [ProjectiveSpectrum.mem_coe_basicOpen] at hy1 hy2
      rw [Set.mem_preimage, to_fun, SetLike.mem_coe, PrimeSpectrum.mem_basicOpen]
      intro rid
      dsimp at rid
      rcases mem_carrier.clear_denominator 𝒜 _ rid with ⟨c, N, acd, eq1⟩
      rw [Algebra.smul_def] at eq1
      change Localization.mk (f ^ N) 1 * mk _ _ = mk (∑ _, _) _ at eq1
      rw [mk_mul, one_mul, mk_eq_mk', IsLocalization.eq] at eq1
      rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩
      rw [Submonoid.coe_one, one_mul] at eq1
      simp only [Subtype.coe_mk] at eq1
      rcases y.1.IsPrime.mem_or_mem (show a * f ^ N * f ^ M ∈ _ from _) with (H1 | H3)
      rcases y.1.IsPrime.mem_or_mem H1 with (H1 | H2)
      · exact hy2 H1
      · exact y.2 (y.1.IsPrime.mem_of_pow_mem N H2)
      · exact y.2 (y.1.IsPrime.mem_of_pow_mem M H3)
      · rw [mul_comm _ (f ^ N), mul_comm _ (f ^ M), eq1]
        refine' mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ fun i hi => mul_mem_left _ _ _))
        generalize_proofs h₁ h₂
        exact (Classical.choose_spec h₂).1
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec.preimage_eq AlgebraicGeometry.ProjIsoSpecTopComponent.ToSpec.preimage_eq

end ToSpec

section

variable {𝒜}

/-- The continuous function between the basic open set `D(f)` in `Proj` to the corresponding basic
open set in `Spec A⁰_f`.
-/
def toSpec {f : A} : (Proj.T| pbo f) ⟶ Spec.T A⁰_ f
    where
  toFun := ToSpec.toFun 𝒜 f
  continuous_toFun :=
    by
    apply is_topological_basis.continuous PrimeSpectrum.isTopologicalBasis_basic_opens
    rintro _ ⟨⟨k, ⟨a, ha⟩, ⟨b, hb1⟩, ⟨k', hb2⟩⟩, rfl⟩; dsimp
    erw [to_Spec.preimage_eq f a b k ha hb1 ⟨k', hb2⟩]
    refine' is_open_induced_iff.mpr ⟨(pbo f).1 ⊓ (pbo a).1, IsOpen.inter (pbo f).2 (pbo a).2, _⟩
    ext z; constructor <;> intro hz <;> simpa [Set.mem_preimage]
#align algebraic_geometry.Proj_iso_Spec_Top_component.to_Spec AlgebraicGeometry.ProjIsoSpecTopComponent.toSpec

end

namespace FromSpec

open GradedAlgebra SetLike

open Finset hiding mk_zero

open _Root_.HomogeneousLocalization

variable {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m)

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
private unsafe def mem_tac : tactic Unit :=
  let b : tactic Unit := sorry
  b <|> sorry
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.mem_tac algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.mem_tac

include f_deg

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/-- The function from `Spec A⁰_f` to `Proj|D(f)` is defined by `q ↦ {a | aᵢᵐ/fⁱ ∈ q}`, i.e. sending
`q` a prime ideal in `A⁰_f` to the homogeneous prime relevant ideal containing only and all the
elements `a : A` such that for every `i`, the degree 0 element formed by dividing the `m`-th power
of the `i`-th projection of `a` by the `i`-th power of the degree-`m` homogeneous element `f`,
lies in `q`.

The set `{a | aᵢᵐ/fⁱ ∈ q}`
* is an ideal, as proved in `carrier.as_ideal`;
* is homogeneous, as proved in `carrier.as_homogeneous_ideal`;
* is prime, as proved in `carrier.as_ideal.prime`;
* is relevant, as proved in `carrier.relevant`.
-/
def carrier (q : Spec.T A⁰_ f) : Set A :=
  { a |
    ∀ i,
      (Quotient.mk''
            ⟨m * i,
              ⟨proj 𝒜 i a ^ m, by
                run_tac
                  mem_tac⟩,
              ⟨f ^ i, by
                rw [mul_comm] <;>
                  run_tac
                    mem_tac⟩,
              ⟨_, rfl⟩⟩ :
          A⁰_ f) ∈
        q.1 }
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
theorem mem_carrier_iff (q : Spec.T A⁰_ f) (a : A) :
    a ∈ carrier f_deg q ↔
      ∀ i,
        (Quotient.mk''
              ⟨m * i,
                ⟨proj 𝒜 i a ^ m, by
                  run_tac
                    mem_tac⟩,
                ⟨f ^ i, by
                  rw [mul_comm] <;>
                    run_tac
                      mem_tac⟩,
                ⟨_, rfl⟩⟩ :
            A⁰_ f) ∈
          q.1 :=
  Iff.rfl
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.mem_carrier_iff AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.mem_carrier_iff

theorem mem_carrier_iff' (q : Spec.T A⁰_ f) (a : A) :
    a ∈ carrier f_deg q ↔
      ∀ i,
        (Localization.mk (proj 𝒜 i a ^ m) ⟨f ^ i, ⟨i, rfl⟩⟩ : Localization.Away f) ∈
          algebraMap (HomogeneousLocalization.Away 𝒜 f) (Localization.Away f) '' q.1.1 :=
  (mem_carrier_iff f_deg q a).trans
    (by
      constructor <;> intro h i <;> specialize h i
      · rw [Set.mem_image]
        refine' ⟨_, h, rfl⟩
      · rw [Set.mem_image] at h
        rcases h with ⟨x, h, hx⟩
        convert h
        rw [ext_iff_val, val_mk']
        dsimp only [Subtype.coe_mk]
        rw [← hx]
        rfl)
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.mem_carrier_iff' AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.mem_carrier_iff'

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
theorem carrier.add_mem (q : Spec.T A⁰_ f) {a b : A} (ha : a ∈ carrier f_deg q)
    (hb : b ∈ carrier f_deg q) : a + b ∈ carrier f_deg q :=
  by
  refine' fun i => (q.2.mem_or_mem _).elim id id
  change (Quotient.mk'' ⟨_, _, _, _⟩ : A⁰_ f) ∈ q.1; dsimp only [Subtype.coe_mk]
  simp_rw [← pow_add, map_add, add_pow, mul_comm, ← nsmul_eq_mul]
  let g : ℕ → A⁰_ f := fun j =>
    (m + m).choose j •
      if h2 : m + m < j then 0
      else
        if h1 : j ≤ m then
          Quotient.mk''
              ⟨m * i, ⟨proj 𝒜 i a ^ j * proj 𝒜 i b ^ (m - j), _⟩,
                ⟨_, by
                  rw [mul_comm] <;>
                    run_tac
                      mem_tac⟩,
                ⟨i, rfl⟩⟩ *
            Quotient.mk''
              ⟨m * i,
                ⟨proj 𝒜 i b ^ m, by
                  run_tac
                    mem_tac⟩,
                ⟨_, by
                  rw [mul_comm] <;>
                    run_tac
                      mem_tac⟩,
                ⟨i, rfl⟩⟩
        else
          Quotient.mk''
              ⟨m * i,
                ⟨proj 𝒜 i a ^ m, by
                  run_tac
                    mem_tac⟩,
                ⟨_, by
                  rw [mul_comm] <;>
                    run_tac
                      mem_tac⟩,
                ⟨i, rfl⟩⟩ *
            Quotient.mk''
              ⟨m * i, ⟨proj 𝒜 i a ^ (j - m) * proj 𝒜 i b ^ (m + m - j), _⟩,
                ⟨_, by
                  rw [mul_comm] <;>
                    run_tac
                      mem_tac⟩,
                ⟨i, rfl⟩⟩
  rotate_left
  · rw [(_ : m * i = _)]
    run_tac
      mem_tac
    rw [← add_smul, Nat.add_sub_of_le h1]
    rfl
  · rw [(_ : m * i = _)]
    run_tac
      mem_tac
    rw [← add_smul]
    congr
    zify [le_of_not_lt h2, le_of_not_le h1]
    abel
  convert_to(∑ i in range (m + m + 1), g i) ∈ q.1; swap
  · refine' q.1.sum_mem fun j hj => nsmul_mem _ _
    split_ifs
    exacts[q.1.zero_mem, q.1.mul_mem_left _ (hb i), q.1.mul_mem_right _ (ha i)]
  rw [ext_iff_val, val_mk']
  change _ = (algebraMap (HomogeneousLocalization.Away 𝒜 f) (Localization.Away f)) _
  dsimp only [Subtype.coe_mk]; rw [map_sum, mk_sum]
  apply Finset.sum_congr rfl fun j hj => _
  change _ = HomogeneousLocalization.val _
  rw [HomogeneousLocalization.smul_val]
  split_ifs with h2 h1
  · exact ((Finset.mem_range.1 hj).not_le h2).elim
  all_goals simp only [mul_val, zero_val, val_mk', Subtype.coe_mk, mk_mul, ← smul_mk]; congr 2
  · rw [mul_assoc, ← pow_add, add_comm (m - j), Nat.add_sub_assoc h1];
  · simp_rw [pow_add]
    rfl
  · rw [← mul_assoc, ← pow_add, Nat.add_sub_of_le (le_of_not_le h1)];
  · simp_rw [pow_add]
    rfl
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.add_mem AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.add_mem

variable (hm : 0 < m) (q : Spec.T A⁰_ f)

include hm

theorem carrier.zero_mem : (0 : A) ∈ carrier f_deg q := fun i =>
  by
  convert Submodule.zero_mem q.1 using 1
  rw [ext_iff_val, val_mk', zero_val]; simp_rw [map_zero, zero_pow hm]
  convert Localization.mk_zero _ using 1
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.zero_mem AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.zero_mem

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.4090330619.mem_tac -/
theorem carrier.smul_mem (c x : A) (hx : x ∈ carrier f_deg q) : c • x ∈ carrier f_deg q :=
  by
  revert c
  refine' DirectSum.Decomposition.inductionOn 𝒜 _ _ _
  · rw [zero_smul]
    exact carrier.zero_mem f_deg hm _
  · rintro n ⟨a, ha⟩ i
    simp_rw [Subtype.coe_mk, proj_apply, smul_eq_mul, coe_decompose_mul_of_left_mem 𝒜 i ha]
    split_ifs
    · convert_to(Quotient.mk'' ⟨_, ⟨a ^ m, pow_mem_graded m ha⟩, ⟨_, _⟩, ⟨n, rfl⟩⟩ *
              Quotient.mk''
                ⟨_,
                  ⟨proj 𝒜 (i - n) x ^ m, by
                    run_tac
                      mem_tac⟩,
                  ⟨_, _⟩, ⟨i - n, rfl⟩⟩ :
            A⁰_ f) ∈ q.1
      · erw [ext_iff_val, val_mk', mul_val, val_mk', val_mk', Subtype.coe_mk]
        simp_rw [mul_pow, Subtype.coe_mk]
        rw [Localization.mk_mul]
        congr
        erw [← pow_add, Nat.add_sub_of_le h]
      · exact Ideal.mul_mem_left _ _ (hx _)
        rw [smul_eq_mul, mul_comm]
        run_tac
          mem_tac
    · simp_rw [zero_pow hm]
      convert carrier.zero_mem f_deg hm q i
      rw [map_zero, zero_pow hm]
  · simp_rw [add_smul]
    exact fun _ _ => carrier.add_mem f_deg q
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.smul_mem AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.smul_mem

/-- For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as an ideal.
-/
def carrier.asIdeal : Ideal A where
  carrier := carrier f_deg q
  zero_mem' := carrier.zero_mem f_deg hm q
  add_mem' a b := carrier.add_mem f_deg q
  smul_mem' := carrier.smul_mem f_deg hm q
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.asIdeal

theorem carrier.asIdeal.homogeneous : (carrier.asIdeal f_deg hm q).Homogeneous 𝒜 := fun i a ha j =>
  (em (i = j)).elim (fun h => h ▸ by simpa only [proj_apply, decompose_coe, of_eq_same] using ha _)
    fun h =>
    by
    simp only [proj_apply, decompose_of_mem_ne 𝒜 (Submodule.coe_mem (decompose 𝒜 a i)) h,
      zero_pow hm]
    convert carrier.zero_mem f_deg hm q j; rw [map_zero, zero_pow hm]
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.homogeneous AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.asIdeal.homogeneous

/-- For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as a homogeneous ideal.
-/
def carrier.asHomogeneousIdeal : HomogeneousIdeal 𝒜 :=
  ⟨carrier.asIdeal f_deg hm q, carrier.asIdeal.homogeneous f_deg hm q⟩
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.as_homogeneous_ideal AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.asHomogeneousIdeal

theorem carrier.denom_not_mem : f ∉ carrier.asIdeal f_deg hm q := fun rid =>
  q.IsPrime.ne_top <|
    (Ideal.eq_top_iff_one _).mpr
      (by
        convert rid m
        simpa only [ext_iff_val, one_val, proj_apply, decompose_of_mem_same _ f_deg, val_mk'] using
          (mk_self (⟨_, m, rfl⟩ : Submonoid.powers f)).symm)
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.denom_not_mem AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.denom_not_mem

theorem carrier.relevant : ¬HomogeneousIdeal.irrelevant 𝒜 ≤ carrier.asHomogeneousIdeal f_deg hm q :=
  fun rid => carrier.denom_not_mem f_deg hm q <| rid <| DirectSum.decompose_of_mem_ne 𝒜 f_deg hm.ne'
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.relevant AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.relevant

theorem carrier.asIdeal.ne_top : carrier.asIdeal f_deg hm q ≠ ⊤ := fun rid =>
  carrier.denom_not_mem f_deg hm q (rid.symm ▸ Submodule.mem_top)
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.ne_top AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.asIdeal.ne_top

theorem carrier.asIdeal.prime : (carrier.asIdeal f_deg hm q).IsPrime :=
  (carrier.asIdeal.homogeneous f_deg hm q).isPrime_of_homogeneous_mem_or_mem
    (carrier.asIdeal.ne_top f_deg hm q) fun x y ⟨nx, hnx⟩ ⟨ny, hny⟩ hxy =>
    show (∀ i, _ ∈ _) ∨ ∀ i, _ ∈ _
      by
      rw [← and_forall_ne nx, and_iff_left, ← and_forall_ne ny, and_iff_left]
      · apply q.2.mem_or_mem
        convert hxy (nx + ny) using 1
        simp_rw [proj_apply, decompose_of_mem_same 𝒜 hnx, decompose_of_mem_same 𝒜 hny,
          decompose_of_mem_same 𝒜 (mul_mem hnx hny), mul_pow, pow_add]
        simpa only [ext_iff_val, val_mk', mul_val, mk_mul]
      all_goals
        intro n hn; convert q.1.zero_mem using 1
        rw [ext_iff_val, val_mk', zero_val]; simp_rw [proj_apply, Subtype.coe_mk]
        convert mk_zero _; rw [decompose_of_mem_ne 𝒜 _ hn.symm, zero_pow hm]
        · first |exact hnx|exact hny
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.prime AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.carrier.asIdeal.prime

variable (f_deg)

/-- The function `Spec A⁰_f → Proj|D(f)` by sending `q` to `{a | aᵢᵐ/fⁱ ∈ q}`.
-/
def toFun : (Spec.T A⁰_ f) → Proj.T| pbo f := fun q =>
  ⟨⟨carrier.asHomogeneousIdeal f_deg hm q, carrier.asIdeal.prime f_deg hm q,
      carrier.relevant f_deg hm q⟩,
    (ProjectiveSpectrum.mem_basicOpen _ f _).mp <| carrier.denom_not_mem f_deg hm q⟩
#align algebraic_geometry.Proj_iso_Spec_Top_component.from_Spec.to_fun AlgebraicGeometry.ProjIsoSpecTopComponent.FromSpec.toFun

end FromSpec

end ProjIsoSpecTopComponent

end AlgebraicGeometry


/-
Copyright (c) 2019 mathlib community. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Wojciech Nawrocki
-/
import data.rbtree.init
import data.num.basic
import order.basic

/-!
# Binary tree

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

Provides binary tree storage for values of any type, with O(lg n) retrieval.
See also `data.rbtree` for red-black trees - this version allows more operations
to be defined and is better suited for in-kernel computation.

We also specialize for `tree unit`, which is a binary tree without any
additional data. We provide the notation `a △ b` for making a `tree unit` with children
`a` and `b`.

## References

<https://leanprover-community.github.io/archive/stream/113488-general/topic/tactic.20question.html>
-/

/-- A binary tree with values stored in non-leaf nodes. -/
@[derive has_reflect, derive decidable_eq]
inductive {u} tree (α : Type u) : Type u
| nil : tree
| node : α → tree → tree → tree

namespace tree

universe u
variable {α : Type u}

/-- Construct a string representation of a tree. Provides a `has_repr` instance. -/
def repr [has_repr α] : tree α → string
| nil := "nil"
| (node a t1 t2) := "tree.node " ++ has_repr.repr a
                    ++ " (" ++ repr t1 ++ ") (" ++ repr t2 ++ ")"

instance [has_repr α] : has_repr (tree α) := ⟨tree.repr⟩

instance : inhabited (tree α) := ⟨nil⟩

/-- Makes a `tree α` out of a red-black tree. -/
def of_rbnode : rbnode α → tree α
| rbnode.leaf               := nil
| (rbnode.red_node l a r)   := node a (of_rbnode l) (of_rbnode r)
| (rbnode.black_node l a r) := node a (of_rbnode l) (of_rbnode r)

/-- Finds the index of an element in the tree assuming the tree has been
constructed according to the provided decidable order on its elements.
If it hasn't, the result will be incorrect. If it has, but the element
is not in the tree, returns none. -/
def index_of (lt : α → α → Prop) [decidable_rel lt]
  (x : α) : tree α → option pos_num
| nil := none
| (node a t₁ t₂) :=
  match cmp_using lt x a with
  | ordering.lt := pos_num.bit0 <$> index_of t₁
  | ordering.eq := some pos_num.one
  | ordering.gt := pos_num.bit1 <$> index_of t₂
  end

/-- Retrieves an element uniquely determined by a `pos_num` from the tree,
taking the following path to get to the element:
- `bit0` - go to left child
- `bit1` - go to right child
- `pos_num.one` - retrieve from here -/
def get : pos_num → tree α → option α
| _                nil            := none
| pos_num.one      (node a t₁ t₂) := some a
| (pos_num.bit0 n) (node a t₁ t₂) := t₁.get n
| (pos_num.bit1 n) (node a t₁ t₂) := t₂.get n

/-- Retrieves an element from the tree, or the provided default value
if the index is invalid. See `tree.get`. -/
def get_or_else (n : pos_num) (t : tree α) (v : α) : α :=
  (t.get n).get_or_else v

/-- Apply a function to each value in the tree.  This is the `map` function for the `tree` functor.
TODO: implement `traversable tree`. -/
def map {β} (f : α → β) : tree α → tree β
| nil := nil
| (node a l r) := node (f a) (map l) (map r)

/-- The number of internal nodes (i.e. not including leaves) of a binary tree -/
@[simp] def num_nodes : tree α → ℕ
| nil := 0
| (node _ a b) := a.num_nodes + b.num_nodes + 1

/-- The number of leaves of a binary tree -/
@[simp] def num_leaves : tree α → ℕ
| nil := 1
| (node _ a b) := a.num_leaves + b.num_leaves

/-- The height - length of the longest path from the root - of a binary tree -/
@[simp] def height : tree α → ℕ
| nil := 0
| (node _ a b) := max a.height b.height + 1

lemma num_leaves_eq_num_nodes_succ (x : tree α) : x.num_leaves = x.num_nodes + 1 :=
by { induction x; simp [*, nat.add_comm, nat.add_assoc, nat.add_left_comm], }

lemma num_leaves_pos (x : tree α) : 0 < x.num_leaves :=
by { rw num_leaves_eq_num_nodes_succ, exact x.num_nodes.zero_lt_succ, }

lemma height_le_num_nodes : ∀ (x : tree α), x.height ≤ x.num_nodes
| nil := le_rfl
| (node _ a b) := nat.succ_le_succ
    (max_le
      (trans a.height_le_num_nodes $ a.num_nodes.le_add_right _)
      (trans b.height_le_num_nodes $ b.num_nodes.le_add_left _))

/-- The left child of the tree, or `nil` if the tree is `nil` -/
@[simp] def left : tree α → tree α
| nil := nil
| (node _ l r) := l

/-- The right child of the tree, or `nil` if the tree is `nil` -/
@[simp] def right : tree α → tree α
| nil := nil
| (node _ l r) := r

/- Notation for making a node with `unit` data -/
localized "infixr ` △ `:65 := tree.node ()" in tree

/-- Recursion on `tree unit`; allows for a better `induction` which does not have to worry
  about the element of type `α = unit` -/
@[elab_as_eliminator]
def unit_rec_on {motive : tree unit → Sort*} (t : tree unit) (base : motive nil)
  (ind : ∀ x y, motive x → motive y → motive (x △ y)) : motive t :=
t.rec_on base (λ u, u.rec_on (by exact ind))

lemma left_node_right_eq_self : ∀ {x : tree unit} (hx : x ≠ nil), x.left △ x.right = x
| nil h := by trivial
| (a △ b) _ := rfl

end tree


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard.
Thanks: Imperial College London, leanprover-community
-/

-- Import levels 1 to 4
import complex.kb_solutions.Level_04_norm_sq

/-
If you know what "the reals don't have decidable
equality" means then you know why the next line
is there, and if you don't then you probably don't care.
-/

noncomputable theory

/-! # Level 5 : the complex numbers are a field -/

namespace complex

/-

Before we start, it's worth pointing out that a field,
for Lean, is a non-zero commutative ring K equipped
with an inverse map `inv: K → K`, with notation z⁻¹,
satisfying 0⁻¹=0 and if z is non-zero then z*z⁻¹=1.
It's easy to check that this is equivalent to the
usual definition, where 0⁻¹ is simply not defined at all.

-/
/-- The inverse of a complex number-/
def inv (z : ℂ) : ℂ := ⟨re(z)/norm_sq(z), -im(z)/norm_sq(z)⟩

-- notation for inverse
instance : has_inv ℂ := ⟨inv⟩

example : ℂ := 1⁻¹

example : ℂ := 0⁻¹ -- we have no data about this object

@[simp] lemma inv_re (z : ℂ) :
  re(z⁻¹) = re(z)/norm_sq(z) := rfl

@[simp] lemma inv_im (z : ℂ) :
  im(z⁻¹) = -im(z)/norm_sq(z) := rfl

lemma zero_ne_one : (0 : ℂ) ≠ 1 :=
by intro h; simp [ext_iff, *] at *

/-- The complex numbers are a field -/
instance : field ℂ :=
{ inv := has_inv.inv,
  inv_zero := begin
    ext;
    simp,
  end,
  exists_pair_ne := begin
    use 0,
    use 1,
    exact zero_ne_one,
  end,
  mul_inv_cancel := begin
    intro z,
    intro hz,
    rw ←norm_sq_ne_zero at hz,
    ext; simp [norm_sq] at *;
    { field_simp [hz], -- clears denominators
      ring},
  end,
  ..complex.comm_ring }

-- finale
def div (z w : ℂ) : ℂ := z * w⁻¹

-- notation
instance : has_div ℂ := ⟨complex.div⟩

example : (1 : ℂ) / 0 = 0 :=
begin
  ext;
  simp,
end

end complex