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

import algebra.char_p.basic
import algebra.geom_sum
import data.mv_polynomial.comm_ring
import data.mv_polynomial.equiv
import ring_theory.polynomial.content
import ring_theory.unique_factorization_domain

/-!
# Ring-theoretic supplement of data.polynomial.

## Main results
* `mv_polynomial.is_domain`:
  If a ring is an integral domain, then so is its polynomial ring over finitely many variables.
* `polynomial.is_noetherian_ring`:
  Hilbert basis theorem, that if a ring is noetherian then so is its polynomial ring.
* `polynomial.wf_dvd_monoid`:
  If an integral domain is a `wf_dvd_monoid`, then so is its polynomial ring.
* `polynomial.unique_factorization_monoid`, `mv_polynomial.unique_factorization_monoid`:
  If an integral domain is a `unique_factorization_monoid`, then so is its polynomial ring (of any
  number of variables).
-/

noncomputable theory
open_locale classical big_operators polynomial
open finset

universes u v w
variables {R : Type u} {S : Type*}

namespace polynomial

section semiring
variables [semiring R]

instance (p : ℕ) [h : char_p R p] : char_p R[X] p :=
let ⟨h⟩ := h in ⟨λ n, by rw [← map_nat_cast C, ← C_0, C_inj, h]⟩

variables (R)

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree ≤ `n`. -/
def degree_le (n : with_bot ℕ) : submodule R R[X] :=
⨅ k : ℕ, ⨅ h : ↑k > n, (lcoeff R k).ker

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree < `n`. -/
def degree_lt (n : ℕ) : submodule R R[X] :=
⨅ k : ℕ, ⨅ h : k ≥ n, (lcoeff R k).ker

variable {R}

theorem mem_degree_le {n : with_bot ℕ} {f : R[X]} :
  f ∈ degree_le R n ↔ degree f ≤ n :=
by simp only [degree_le, submodule.mem_infi, degree_le_iff_coeff_zero, linear_map.mem_ker]; refl

@[mono] theorem degree_le_mono {m n : with_bot ℕ} (H : m ≤ n) :
  degree_le R m ≤ degree_le R n :=
λ f hf, mem_degree_le.2 (le_trans (mem_degree_le.1 hf) H)

theorem degree_le_eq_span_X_pow {n : ℕ} :
  degree_le R n = submodule.span R ↑((finset.range (n+1)).image (λ n, (X : R[X])^n)) :=
begin
  apply le_antisymm,
  { intros p hp, replace hp := mem_degree_le.1 hp,
    rw [← polynomial.sum_monomial_eq p, polynomial.sum],
    refine submodule.sum_mem _ (λ k hk, _),
    show monomial _ _ ∈ _,
    have := with_bot.coe_le_coe.1 (finset.sup_le_iff.1 hp k hk),
    rw [← C_mul_X_pow_eq_monomial, C_mul'],
    refine submodule.smul_mem _ _ (submodule.subset_span $ finset.mem_coe.2 $
      finset.mem_image.2 ⟨_, finset.mem_range.2 (nat.lt_succ_of_le this), rfl⟩) },
  rw [submodule.span_le, finset.coe_image, set.image_subset_iff],
  intros k hk, apply mem_degree_le.2,
  exact (degree_X_pow_le _).trans
    (with_bot.coe_le_coe.2 $ nat.le_of_lt_succ $ finset.mem_range.1 hk)
end

theorem mem_degree_lt {n : ℕ} {f : R[X]} :
  f ∈ degree_lt R n ↔ degree f < n :=
by { simp_rw [degree_lt, submodule.mem_infi, linear_map.mem_ker, degree, finset.max_eq_sup_coe,
    finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff,
    with_bot.coe_lt_coe, lt_iff_not_le, ne, not_imp_not], refl }

@[mono] theorem degree_lt_mono {m n : ℕ} (H : m ≤ n) :
  degree_lt R m ≤ degree_lt R n :=
λ f hf, mem_degree_lt.2 (lt_of_lt_of_le (mem_degree_lt.1 hf) $ with_bot.coe_le_coe.2 H)

theorem degree_lt_eq_span_X_pow {n : ℕ} :
  degree_lt R n = submodule.span R ↑((finset.range n).image (λ n, X^n) : finset R[X]) :=
begin
  apply le_antisymm,
  { intros p hp, replace hp := mem_degree_lt.1 hp,
    rw [← polynomial.sum_monomial_eq p, polynomial.sum],
    refine submodule.sum_mem _ (λ k hk, _),
    show monomial _ _ ∈ _,
    have := with_bot.coe_lt_coe.1 ((finset.sup_lt_iff $ with_bot.bot_lt_coe n).1 hp k hk),
    rw [← C_mul_X_pow_eq_monomial, C_mul'],
    refine submodule.smul_mem _ _ (submodule.subset_span $ finset.mem_coe.2 $
      finset.mem_image.2 ⟨_, finset.mem_range.2 this, rfl⟩) },
  rw [submodule.span_le, finset.coe_image, set.image_subset_iff],
  intros k hk, apply mem_degree_lt.2,
  exact lt_of_le_of_lt (degree_X_pow_le _) (with_bot.coe_lt_coe.2 $ finset.mem_range.1 hk)
end

/-- The first `n` coefficients on `degree_lt n` form a linear equivalence with `fin n → R`. -/
def degree_lt_equiv (R) [semiring R] (n : ℕ) : degree_lt R n ≃ₗ[R] (fin n → R) :=
{ to_fun := λ p n, (↑p : R[X]).coeff n,
  inv_fun := λ f, ⟨∑ i : fin n, monomial i (f i),
    (degree_lt R n).sum_mem (λ i _, mem_degree_lt.mpr (lt_of_le_of_lt
      (degree_monomial_le i (f i)) (with_bot.coe_lt_coe.mpr i.is_lt)))⟩,
  map_add' := λ p q, by { ext, rw [submodule.coe_add, coeff_add], refl },
  map_smul' := λ x p, by { ext, rw [submodule.coe_smul, coeff_smul], refl },
  left_inv :=
  begin
    rintro ⟨p, hp⟩, ext1,
    simp only [submodule.coe_mk],
    by_cases hp0 : p = 0,
    { subst hp0, simp only [coeff_zero, linear_map.map_zero, finset.sum_const_zero] },
    rw [mem_degree_lt, degree_eq_nat_degree hp0, with_bot.coe_lt_coe] at hp,
    conv_rhs { rw [p.as_sum_range' n hp, ← fin.sum_univ_eq_sum_range] },
  end,
  right_inv :=
  begin
    intro f, ext i,
    simp only [finset_sum_coeff, submodule.coe_mk],
    rw [finset.sum_eq_single i, coeff_monomial, if_pos rfl],
    { rintro j - hji, rw [coeff_monomial, if_neg], rwa [← fin.ext_iff] },
    { intro h, exact (h (finset.mem_univ _)).elim }
  end }

@[simp] theorem degree_lt_equiv_eq_zero_iff_eq_zero {n : ℕ} {p : R[X]} (hp : p ∈ degree_lt R n) :
  degree_lt_equiv _ _ ⟨p, hp⟩ = 0 ↔ p = 0 :=
by rw [linear_equiv.map_eq_zero_iff, submodule.mk_eq_zero]

theorem eval_eq_sum_degree_lt_equiv {n : ℕ} {p : R[X]} (hp : p ∈ degree_lt R n) (x : R) :
  p.eval x = ∑ i, degree_lt_equiv _ _ ⟨p, hp⟩ i * (x ^ (i : ℕ)) :=
begin
  simp_rw [eval_eq_sum],
  exact (sum_fin _ (by simp_rw [zero_mul, forall_const]) (mem_degree_lt.mp hp)).symm
end

/-- The finset of nonzero coefficients of a polynomial. -/
def frange (p : R[X]) : finset R :=
finset.image (λ n, p.coeff n) p.support

lemma frange_zero : frange (0 : R[X]) = ∅ :=
rfl

lemma mem_frange_iff {p : R[X]} {c : R} :
  c ∈ p.frange ↔ ∃ n ∈ p.support, c = p.coeff n :=
by simp [frange, eq_comm]

lemma frange_one : frange (1 : R[X]) ⊆ {1} :=
begin
  simp [frange, finset.image_subset_iff],
  simp only [← C_1, coeff_C],
  assume n hn,
  simp only [exists_prop, ite_eq_right_iff, not_forall] at hn,
  simp [hn],
end

lemma coeff_mem_frange (p : R[X]) (n : ℕ) (h : p.coeff n ≠ 0) :
  p.coeff n ∈ p.frange :=
begin
  simp only [frange, exists_prop, mem_support_iff, finset.mem_image, ne.def],
  exact ⟨n, h, rfl⟩,
end

lemma geom_sum_X_comp_X_add_one_eq_sum (n : ℕ) :
  (∑ i in range n, (X : R[X]) ^ i).comp (X + 1) =
  (finset.range n).sum (λ (i : ℕ), (n.choose (i + 1) : R[X]) * X ^ i) :=
begin
  ext i,
  transitivity (n.choose (i + 1) : R), swap,
  { simp only [finset_sum_coeff, ← C_eq_nat_cast, coeff_C_mul_X_pow],
    rw [finset.sum_eq_single i, if_pos rfl],
    { simp only [@eq_comm _ i, if_false, eq_self_iff_true, implies_true_iff] {contextual := tt}, },
    { simp only [nat.lt_add_one_iff, nat.choose_eq_zero_of_lt, nat.cast_zero, finset.mem_range,
        not_lt, eq_self_iff_true, if_true, implies_true_iff] {contextual := tt}, } },
  induction n with n ih generalizing i,
  { simp only [geom_sum_zero, zero_comp, coeff_zero, nat.choose_zero_succ, nat.cast_zero], },
  simp only [geom_sum_succ', ih, add_comp, X_pow_comp, coeff_add, nat.choose_succ_succ,
    nat.cast_add, coeff_X_add_one_pow],
end

lemma monic.geom_sum {P : R[X]}
  (hP : P.monic) (hdeg : 0 < P.nat_degree) {n : ℕ} (hn : n ≠ 0) : (∑ i in range n, P ^ i).monic :=
begin
  nontriviality R,
  cases n, { exact (hn rfl).elim },
  rw [geom_sum_succ'],
  refine (hP.pow _).add_of_left _,
  refine lt_of_le_of_lt (degree_sum_le _ _) _,
  rw [finset.sup_lt_iff],
  { simp only [finset.mem_range, degree_eq_nat_degree (hP.pow _).ne_zero,
      with_bot.coe_lt_coe, hP.nat_degree_pow],
    intro k, exact nsmul_lt_nsmul hdeg },
  { rw [bot_lt_iff_ne_bot, ne.def, degree_eq_bot],
    exact (hP.pow _).ne_zero }
end

lemma monic_geom_sum_X {n : ℕ} (hn : n ≠ 0) :
  (∑ i in range n, (X : R[X]) ^ i).monic :=
begin
  nontriviality R,
  apply monic_X.geom_sum _ hn,
  simpa only [nat_degree_X] using zero_lt_one
end

end semiring

section ring
variables [ring R]

/-- Given a polynomial, return the polynomial whose coefficients are in
the ring closure of the original coefficients. -/
def restriction (p : R[X]) : polynomial (subring.closure (↑p.frange : set R)) :=
∑ i in p.support, monomial i (⟨p.coeff i,
  if H : p.coeff i = 0 then H.symm ▸ (subring.closure _).zero_mem
  else subring.subset_closure (p.coeff_mem_frange _ H)⟩ : (subring.closure (↑p.frange : set R)))

@[simp] theorem coeff_restriction {p : R[X]} {n : ℕ} :
  ↑(coeff (restriction p) n) = coeff p n :=
begin
  simp only [restriction, coeff_monomial, finset_sum_coeff, mem_support_iff, finset.sum_ite_eq',
    ne.def, ite_not],
  split_ifs,
  { rw h, refl },
  { refl }
end

@[simp] theorem coeff_restriction' {p : R[X]} {n : ℕ} :
  (coeff (restriction p) n).1 = coeff p n :=
coeff_restriction

@[simp] lemma support_restriction (p : R[X]) :
  support (restriction p) = support p :=
begin
  ext i,
  simp only [mem_support_iff, not_iff_not, ne.def],
  conv_rhs { rw [← coeff_restriction] },
  exact ⟨λ H, by { rw H, refl }, λ H, subtype.coe_injective H⟩
end

@[simp] theorem map_restriction {R : Type u} [comm_ring R]
  (p : R[X]) : p.restriction.map (algebra_map _ _) = p :=
ext $ λ n, by rw [coeff_map, algebra.algebra_map_of_subring_apply, coeff_restriction]

@[simp] theorem degree_restriction {p : R[X]} : (restriction p).degree = p.degree :=
by simp [degree]

@[simp] theorem nat_degree_restriction {p : R[X]} :
  (restriction p).nat_degree = p.nat_degree :=
by simp [nat_degree]

@[simp] theorem monic_restriction {p : R[X]} : monic (restriction p) ↔ monic p :=
begin
  simp only [monic, leading_coeff, nat_degree_restriction],
  rw [←@coeff_restriction _ _ p],
  exact ⟨λ H, by { rw H, refl }, λ H, subtype.coe_injective H⟩
end

@[simp] theorem restriction_zero : restriction (0 : R[X]) = 0 :=
by simp only [restriction, finset.sum_empty, support_zero]

@[simp] theorem restriction_one : restriction (1 : R[X]) = 1 :=
ext $ λ i, subtype.eq $ by rw [coeff_restriction', coeff_one, coeff_one]; split_ifs; refl

variables [semiring S] {f : R →+* S} {x : S}

theorem eval₂_restriction {p : R[X]} :
  eval₂ f x p =
  eval₂ (f.comp (subring.subtype (subring.closure (p.frange : set R)))) x p.restriction :=
begin
  simp only [eval₂_eq_sum, sum, support_restriction, ←@coeff_restriction _ _ p],
  refl,
end

section to_subring

variables (p : R[X]) (T : subring R)

/-- Given a polynomial `p` and a subring `T` that contains the coefficients of `p`,
return the corresponding polynomial whose coefficients are in `T`. -/
def to_subring (hp : (↑p.frange : set R) ⊆ T) : T[X] :=
∑ i in p.support, monomial i (⟨p.coeff i,
  if H : p.coeff i = 0 then H.symm ▸ T.zero_mem
  else hp (p.coeff_mem_frange _ H)⟩ : T)

variables (hp : (↑p.frange : set R) ⊆ T)
include hp

@[simp] theorem coeff_to_subring {n : ℕ} : ↑(coeff (to_subring p T hp) n) = coeff p n :=
begin
  simp only [to_subring, coeff_monomial, finset_sum_coeff, mem_support_iff, finset.sum_ite_eq',
    ne.def, ite_not],
  split_ifs,
  { rw h, refl },
  { refl }
end

@[simp] theorem coeff_to_subring' {n : ℕ} : (coeff (to_subring p T hp) n).1 = coeff p n :=
coeff_to_subring _ _ hp

@[simp] lemma support_to_subring :
  support (to_subring p T hp) = support p :=
begin
  ext i,
  simp only [mem_support_iff, not_iff_not, ne.def],
  conv_rhs { rw [← coeff_to_subring p T hp] },
  exact ⟨λ H, by { rw H, refl }, λ H, subtype.coe_injective H⟩
end

@[simp] theorem degree_to_subring : (to_subring p T hp).degree = p.degree :=
by simp [degree]

@[simp] theorem nat_degree_to_subring : (to_subring p T hp).nat_degree = p.nat_degree :=
by simp [nat_degree]

@[simp] theorem monic_to_subring : monic (to_subring p T hp) ↔ monic p :=
begin
  simp_rw [monic, leading_coeff, nat_degree_to_subring, ← coeff_to_subring p T hp],
  exact ⟨λ H, by { rw H, refl }, λ H, subtype.coe_injective H⟩
end

omit hp

@[simp] theorem to_subring_zero : to_subring (0 : R[X]) T (by simp [frange_zero]) = 0 :=
by { ext i, simp }

@[simp] theorem to_subring_one : to_subring (1 : R[X]) T
  (set.subset.trans frange_one $finset.singleton_subset_set_iff.2 T.one_mem) = 1 :=
ext $ λ i, subtype.eq $ by rw [coeff_to_subring', coeff_one, coeff_one]; split_ifs; refl

@[simp] theorem map_to_subring : (p.to_subring T hp).map (subring.subtype T) = p :=
by { ext n, simp [coeff_map] }

end to_subring

variables (T : subring R)

/-- Given a polynomial whose coefficients are in some subring, return
the corresponding polynomial whose coefficients are in the ambient ring. -/
def of_subring (p : T[X]) : R[X] :=
∑ i in p.support, monomial i (p.coeff i : R)

lemma coeff_of_subring (p : T[X]) (n : ℕ) :
  coeff (of_subring T p) n = (coeff p n : T) :=
begin
  simp only [of_subring, coeff_monomial, finset_sum_coeff, mem_support_iff, finset.sum_ite_eq',
    ite_eq_right_iff, ne.def, ite_not, not_not, ite_eq_left_iff],
  assume h,
  rw h,
  refl
end

@[simp] theorem frange_of_subring {p : T[X]} :
  (↑(p.of_subring T).frange : set R) ⊆ T :=
begin
  assume i hi,
  simp only [frange, set.mem_image, mem_support_iff, ne.def, finset.mem_coe, finset.coe_image]
    at hi,
  rcases hi with ⟨n, hn, h'n⟩,
  rw [← h'n, coeff_of_subring],
  exact subtype.mem (coeff p n : T)
end

end ring

section comm_ring
variables [comm_ring R]

section mod_by_monic

variables {q : R[X]}

lemma mem_ker_mod_by_monic (hq : q.monic) {p : R[X]} :
  p ∈ (mod_by_monic_hom q).ker ↔ q ∣ p :=
linear_map.mem_ker.trans (dvd_iff_mod_by_monic_eq_zero hq)

@[simp] lemma ker_mod_by_monic_hom (hq : q.monic) :
  (polynomial.mod_by_monic_hom q).ker = (ideal.span {q}).restrict_scalars R :=
submodule.ext (λ f, (mem_ker_mod_by_monic hq).trans ideal.mem_span_singleton.symm)

end mod_by_monic

end comm_ring

end polynomial

namespace ideal
open polynomial

section semiring
variables [semiring R]

/-- Transport an ideal of `R[X]` to an `R`-submodule of `R[X]`. -/
def of_polynomial (I : ideal R[X]) : submodule R R[X] :=
{ carrier := I.carrier,
  zero_mem' := I.zero_mem,
  add_mem' := λ _ _, I.add_mem,
  smul_mem' := λ c x H, by { rw [← C_mul'], exact I.mul_mem_left _ H } }

variables {I : ideal R[X]}
theorem mem_of_polynomial (x) : x ∈ I.of_polynomial ↔ x ∈ I := iff.rfl
variables (I)

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

/-- Given an ideal `I` of `R[X]`, make the ideal in `R` of
leading coefficients of polynomials in `I` with degree ≤ `n`. -/
def leading_coeff_nth (n : ℕ) : ideal R :=
(I.degree_le n).map $ lcoeff R n

/-- Given an ideal `I` in `R[X]`, make the ideal in `R` of the
leading coefficients in `I`. -/
def leading_coeff : ideal R :=
⨆ n : ℕ, I.leading_coeff_nth n

end semiring

section comm_semiring
variables [comm_semiring R] [semiring S]

/-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself -/
lemma polynomial_mem_ideal_of_coeff_mem_ideal (I : ideal R[X]) (p : R[X])
  (hp : ∀ (n : ℕ), (p.coeff n) ∈ I.comap (C : R →+* R[X])) : p ∈ I :=
sum_C_mul_X_pow_eq p ▸ submodule.sum_mem I (λ n hn, I.mul_mem_right _ (hp n))

/-- The push-forward of an ideal `I` of `R` to `R[X]` via inclusion
 is exactly the set of polynomials whose coefficients are in `I` -/
theorem mem_map_C_iff {I : ideal R} {f : R[X]} :
  f ∈ (ideal.map (C : R →+* R[X]) I : ideal R[X]) ↔ ∀ n : ℕ, f.coeff n ∈ I :=
begin
  split,
  { intros hf,
    apply submodule.span_induction hf,
    { intros f hf n,
      cases (set.mem_image _ _ _).mp hf with x hx,
      rw [← hx.right, coeff_C],
      by_cases (n = 0),
      { simpa [h] using hx.left },
      { simp [h] } },
    { simp },
    { exact λ f g hf hg n, by simp [I.add_mem (hf n) (hg n)] },
    { refine λ f g hg n, _,
      rw [smul_eq_mul, coeff_mul],
      exact I.sum_mem (λ c hc, I.mul_mem_left (f.coeff c.fst) (hg c.snd)) } },
  { intros hf,
    rw ← sum_monomial_eq f,
    refine (I.map C : ideal R[X]).sum_mem (λ n hn, _),
    simp [← C_mul_X_pow_eq_monomial],
    rw mul_comm,
    exact (I.map C : ideal R[X]).mul_mem_left _ (mem_map_of_mem _ (hf n)) }
end

lemma _root_.polynomial.ker_map_ring_hom (f : R →+* S) :
  (polynomial.map_ring_hom f).ker = f.ker.map (C : R →+* R[X]) :=
begin
  ext,
  rw [mem_map_C_iff, ring_hom.mem_ker, polynomial.ext_iff],
  simp_rw [coe_map_ring_hom, coeff_map, coeff_zero, ring_hom.mem_ker],
end

variable (I : ideal R[X])

theorem mem_leading_coeff_nth (n : ℕ) (x) :
  x ∈ I.leading_coeff_nth n ↔ ∃ p ∈ I, degree p ≤ n ∧ p.leading_coeff = x :=
begin
  simp only [leading_coeff_nth, degree_le, submodule.mem_map, lcoeff_apply, submodule.mem_inf,
    mem_degree_le],
  split,
  { rintro ⟨p, ⟨hpdeg, hpI⟩, rfl⟩,
    cases lt_or_eq_of_le hpdeg with hpdeg hpdeg,
    { refine ⟨0, I.zero_mem, bot_le, _⟩,
      rw [leading_coeff_zero, eq_comm],
      exact coeff_eq_zero_of_degree_lt hpdeg },
    { refine ⟨p, hpI, le_of_eq hpdeg, _⟩,
      rw [polynomial.leading_coeff, nat_degree, hpdeg], refl } },
  { rintro ⟨p, hpI, hpdeg, rfl⟩,
    have : nat_degree p + (n - nat_degree p) = n,
    { exact add_tsub_cancel_of_le (nat_degree_le_of_degree_le hpdeg) },
    refine ⟨p * X ^ (n - nat_degree p), ⟨_, I.mul_mem_right _ hpI⟩, _⟩,
    { apply le_trans (degree_mul_le _ _) _,
      apply le_trans (add_le_add (degree_le_nat_degree) (degree_X_pow_le _)) _,
      rw [← with_bot.coe_add, this],
      exact le_rfl },
    { rw [polynomial.leading_coeff, ← coeff_mul_X_pow p (n - nat_degree p), this] } }
end

theorem mem_leading_coeff_nth_zero (x) :
  x ∈ I.leading_coeff_nth 0 ↔ C x ∈ I :=
(mem_leading_coeff_nth _ _ _).trans
⟨λ ⟨p, hpI, hpdeg, hpx⟩, by rwa [← hpx, polynomial.leading_coeff,
  nat.eq_zero_of_le_zero (nat_degree_le_of_degree_le hpdeg),
  ← eq_C_of_degree_le_zero hpdeg],
λ hx, ⟨C x, hx, degree_C_le, leading_coeff_C x⟩⟩

theorem leading_coeff_nth_mono {m n : ℕ} (H : m ≤ n) :
  I.leading_coeff_nth m ≤ I.leading_coeff_nth n :=
begin
  intros r hr,
  simp only [set_like.mem_coe, mem_leading_coeff_nth] at hr ⊢,
  rcases hr with ⟨p, hpI, hpdeg, rfl⟩,
  refine ⟨p * X ^ (n - m), I.mul_mem_right _ hpI, _, leading_coeff_mul_X_pow⟩,
  refine le_trans (degree_mul_le _ _) _,
  refine le_trans (add_le_add hpdeg (degree_X_pow_le _)) _,
  rw [← with_bot.coe_add, add_tsub_cancel_of_le H],
  exact le_rfl
end

theorem mem_leading_coeff (x) :
  x ∈ I.leading_coeff ↔ ∃ p ∈ I, polynomial.leading_coeff p = x :=
begin
  rw [leading_coeff, submodule.mem_supr_of_directed],
  simp only [mem_leading_coeff_nth],
  { split, { rintro ⟨i, p, hpI, hpdeg, rfl⟩, exact ⟨p, hpI, rfl⟩ },
    rintro ⟨p, hpI, rfl⟩, exact ⟨nat_degree p, p, hpI, degree_le_nat_degree, rfl⟩ },
  intros i j, exact ⟨i + j, I.leading_coeff_nth_mono (nat.le_add_right _ _),
    I.leading_coeff_nth_mono (nat.le_add_left _ _)⟩
end

/--
If `I` is an ideal, and `pᵢ` is a finite family of polynomials each satisfying
`∀ k, (pᵢ)ₖ ∈ Iⁿⁱ⁻ᵏ` for some `nᵢ`, then `p = ∏ pᵢ` also satisfies `∀ k, pₖ ∈ Iⁿ⁻ᵏ` with `n = ∑ nᵢ`.
-/
lemma _root_.polynomial.coeff_prod_mem_ideal_pow_tsub {ι : Type*} (s : finset ι) (f : ι → R[X])
  (I : ideal R) (n : ι → ℕ) (h : ∀ (i ∈ s) k, (f i).coeff k ∈ I ^ (n i - k)) (k : ℕ) :
  (s.prod f).coeff k ∈ I ^ (s.sum n - k) :=
begin
  classical,
  induction s using finset.induction with a s ha hs generalizing k,
  { rw [sum_empty, prod_empty, coeff_one, zero_tsub, pow_zero, ideal.one_eq_top],
    exact submodule.mem_top },
  { rw [sum_insert ha, prod_insert ha, coeff_mul],
    apply sum_mem,
    rintro ⟨i, j⟩ e,
    obtain rfl : i + j = k := nat.mem_antidiagonal.mp e,
    apply ideal.pow_le_pow add_tsub_add_le_tsub_add_tsub,
    rw pow_add,
    exact ideal.mul_mem_mul (h _ (finset.mem_insert.mpr $ or.inl rfl) _)
      (hs (λ i hi k, h _ (finset.mem_insert.mpr $ or.inr hi) _) j) }
end

end comm_semiring

section ring
variables [ring R]

/-- `R[X]` is never a field for any ring `R`. -/
lemma polynomial_not_is_field : ¬ is_field R[X] :=
begin
  nontriviality R,
  intro hR,
  obtain ⟨p, hp⟩ := hR.mul_inv_cancel X_ne_zero,
  have hp0 : p ≠ 0,
  { rintro rfl,
    rw [mul_zero] at hp,
    exact zero_ne_one hp },
  have := degree_lt_degree_mul_X hp0,
  rw [←X_mul, congr_arg degree hp, degree_one, nat.with_bot.lt_zero_iff, degree_eq_bot] at this,
  exact hp0 this,
end

/-- The only constant in a maximal ideal over a field is `0`. -/
lemma eq_zero_of_constant_mem_of_maximal (hR : is_field R)
  (I : ideal R[X]) [hI : I.is_maximal] (x : R) (hx : C x ∈ I) : x = 0 :=
begin
  refine classical.by_contradiction (λ hx0, hI.ne_top ((eq_top_iff_one I).2 _)),
  obtain ⟨y, hy⟩ := hR.mul_inv_cancel hx0,
  convert I.mul_mem_left (C y) hx,
  rw [← C.map_mul, hR.mul_comm y x, hy, ring_hom.map_one],
end

end ring

section comm_ring
variables [comm_ring R]

/-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
lemma is_prime_map_C_iff_is_prime (P : ideal R) :
  is_prime (map (C : R →+* R[X]) P : ideal R[X]) ↔ is_prime P :=
begin
  -- Porting note: the following proof avoids quotient rings
  -- It can be golfed substantially by using something like
  -- `(quotient.is_domain_iff_prime (map C P : ideal R[X]))`
  split,
  { intro H,
    have := @comap_is_prime R R[X] (R →+* R[X]) _ _ _ C (map C P) H,
    convert this using 1,
    ext x,
    simp only [mem_comap, mem_map_C_iff],
    split,
    { rintro h (-|n),
      { simpa only [coeff_C_zero] using h },
      { simp only [coeff_C_ne_zero (nat.succ_ne_zero _), submodule.zero_mem] } },
    { intro h, simpa only [coeff_C_zero] using h 0 } },
  { intro h,
    constructor,
    { rw [ne.def, eq_top_iff_one, mem_map_C_iff, not_forall],
      use 0,
      rw [coeff_one_zero, ← eq_top_iff_one], exact h.1 },
    { intros f g, simp only [mem_map_C_iff], contrapose!,
      rintro ⟨hf, hg⟩,
      classical,
      let m := nat.find hf,
      let n := nat.find hg,
      refine ⟨m + n, _⟩,
      rw [coeff_mul, ← finset.insert_erase ((@finset.nat.mem_antidiagonal _ (m,n)).mpr rfl),
        finset.sum_insert (finset.not_mem_erase _ _), (P.add_mem_iff_left _).not],
      { apply mt h.2, rw [not_or_distrib], exact ⟨nat.find_spec hf, nat.find_spec hg⟩ },
      apply P.sum_mem,
      rintro ⟨i, j⟩ hij,
      rw [finset.mem_erase, finset.nat.mem_antidiagonal] at hij,
      simp only [ne.def, prod.mk.inj_iff, not_and_distrib] at hij,
      obtain (hi|hj) : i < m ∨ j < n,
      { rw [or_iff_not_imp_left, not_lt, le_iff_lt_or_eq],
        rintro (hmi|rfl),
        { rw [← not_le], intro hnj, exact (add_lt_add_of_lt_of_le hmi hnj).ne hij.2.symm, },
        { simpa only [eq_self_iff_true, not_true, false_or, add_right_inj, not_and_self]
            using hij, } },
      { rw [mul_comm], apply P.mul_mem_left, exact not_not.1 (nat.find_min hf hi) },
      { apply P.mul_mem_left, exact not_not.1 (nat.find_min hg hj) } } }
end

/-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
lemma is_prime_map_C_of_is_prime {P : ideal R} (H : is_prime P) :
  is_prime (map (C : R →+* R[X]) P : ideal R[X]) :=
(is_prime_map_C_iff_is_prime P).mpr H

theorem is_fg_degree_le [is_noetherian_ring R] (I : ideal R[X]) (n : ℕ) :
  submodule.fg (I.degree_le n) :=
is_noetherian_submodule_left.1 (is_noetherian_of_fg_of_noetherian _
  ⟨_, degree_le_eq_span_X_pow.symm⟩) _

end comm_ring

end ideal

variables {σ : Type v} {M : Type w}
variables [comm_ring R] [comm_ring S] [add_comm_group M] [module R M]

section prime
variables (σ) {r : R}

namespace polynomial
lemma prime_C_iff : prime (C r) ↔ prime r :=
⟨ comap_prime C (eval_ring_hom (0 : R)) (λ r, eval_C),
  λ hr, by { have := hr.1,
    rw ← ideal.span_singleton_prime at hr ⊢,
    { convert ideal.is_prime_map_C_of_is_prime hr using 1,
      rw [ideal.map_span, set.image_singleton] },
    exacts [λ h, this (C_eq_zero.1 h), this] } ⟩
end polynomial

namespace mv_polynomial

private lemma prime_C_iff_of_fintype [fintype σ] : prime (C r : mv_polynomial σ R) ↔ prime r :=
begin
  rw (rename_equiv R (fintype.equiv_fin σ)).to_mul_equiv.prime_iff,
  convert_to prime (C r) ↔ _, { congr, apply rename_C },
  { symmetry, induction fintype.card σ with d hd,
    { exact (is_empty_alg_equiv R (fin 0)).to_mul_equiv.symm.prime_iff },
    { rw [hd, ← polynomial.prime_C_iff],
      convert (fin_succ_equiv R d).to_mul_equiv.symm.prime_iff,
      rw ← fin_succ_equiv_comp_C_eq_C, refl } },
end

lemma prime_C_iff : prime (C r : mv_polynomial σ R) ↔ prime r :=
⟨ comap_prime C constant_coeff (constant_coeff_C _),
  λ hr, ⟨ λ h, hr.1 $ by { rw [← C_inj, h], simp },
    λ h, hr.2.1 $ by { rw ← constant_coeff_C _ r, exact h.map _ },
    λ a b hd, begin
      obtain ⟨s,a',b',rfl,rfl⟩ := exists_finset_rename₂ a b,
      rw ← algebra_map_eq at hd, have : algebra_map R _ r ∣ a' * b',
      { convert (kill_compl subtype.coe_injective).to_ring_hom.map_dvd hd, simpa, simp },
      rw ← rename_C (coe : s → σ), let f := (rename (coe : s → σ)).to_ring_hom,
      exact (((prime_C_iff_of_fintype s).2 hr).2.2 a' b' this).imp f.map_dvd f.map_dvd,
    end ⟩ ⟩

variable {σ}
lemma prime_rename_iff (s : set σ) {p : mv_polynomial s R} :
  prime (rename (coe : s → σ) p) ↔ prime p :=
begin
  classical, symmetry, let eqv := (sum_alg_equiv R _ _).symm.trans
    (rename_equiv R $ (equiv.sum_comm ↥sᶜ s).trans $ equiv.set.sum_compl s),
  rw [← prime_C_iff ↥sᶜ, eqv.to_mul_equiv.prime_iff], convert iff.rfl,
  suffices : (rename coe).to_ring_hom = eqv.to_alg_hom.to_ring_hom.comp C,
  { apply ring_hom.congr_fun this },
  { apply ring_hom_ext,
    { intro, dsimp [eqv], erw [iter_to_sum_C_C, rename_C, rename_C] },
    { intro, dsimp [eqv], erw [iter_to_sum_C_X, rename_X, rename_X], refl } },
end

end mv_polynomial

end prime

namespace polynomial

@[priority 100]
instance {R : Type*} [comm_ring R] [is_domain R] [wf_dvd_monoid R] :
  wf_dvd_monoid R[X] :=
{ well_founded_dvd_not_unit := begin
    classical,
    refine rel_hom_class.well_founded (⟨λ (p : R[X]),
        ((if p = 0 then ⊤ else ↑p.degree : with_top (with_bot ℕ)), p.leading_coeff), _⟩ :
        dvd_not_unit →r prod.lex (<) dvd_not_unit)
      (prod.lex_wf (with_top.well_founded_lt $ with_bot.well_founded_lt nat.lt_wf)
        ‹wf_dvd_monoid R›.well_founded_dvd_not_unit),
    rintros a b ⟨ane0, ⟨c, ⟨not_unit_c, rfl⟩⟩⟩,
    rw [polynomial.degree_mul, if_neg ane0],
    split_ifs with hac,
    { rw [hac, polynomial.leading_coeff_zero],
      apply prod.lex.left,
      exact lt_of_le_of_ne le_top with_top.coe_ne_top },
    have cne0 : c ≠ 0 := right_ne_zero_of_mul hac,
    simp only [cne0, ane0, polynomial.leading_coeff_mul],
    by_cases hdeg : c.degree = 0,
    { simp only [hdeg, add_zero],
      refine prod.lex.right _ ⟨_, ⟨c.leading_coeff, (λ unit_c, not_unit_c _), rfl⟩⟩,
      { rwa [ne, polynomial.leading_coeff_eq_zero] },
      rw [polynomial.is_unit_iff, polynomial.eq_C_of_degree_eq_zero hdeg],
      use [c.leading_coeff, unit_c],
      rw [polynomial.leading_coeff, polynomial.nat_degree_eq_of_degree_eq_some hdeg] },
    { apply prod.lex.left,
      rw polynomial.degree_eq_nat_degree cne0 at *,
      rw [with_top.coe_lt_coe, polynomial.degree_eq_nat_degree ane0,
          ← with_bot.coe_add, with_bot.coe_lt_coe],
      exact lt_add_of_pos_right _ (nat.pos_of_ne_zero (λ h, hdeg (h.symm ▸ with_bot.coe_zero))) },
  end }

end polynomial

/-- Hilbert basis theorem: a polynomial ring over a noetherian ring is a noetherian ring. -/
protected theorem polynomial.is_noetherian_ring [is_noetherian_ring R] :
  is_noetherian_ring R[X] :=
is_noetherian_ring_iff.2 ⟨assume I : ideal R[X],
let M := well_founded.min (is_noetherian_iff_well_founded.1 (by apply_instance))
  (set.range I.leading_coeff_nth) ⟨_, ⟨0, rfl⟩⟩ in
have hm : M ∈ set.range I.leading_coeff_nth := well_founded.min_mem _ _ _,
let ⟨N, HN⟩ := hm, ⟨s, hs⟩ := I.is_fg_degree_le N in
have hm2 : ∀ k, I.leading_coeff_nth k ≤ M := λ k, or.cases_on (le_or_lt k N)
  (λ h, HN ▸ I.leading_coeff_nth_mono h)
  (λ h x hx, classical.by_contradiction $ λ hxm,
    have ¬M < I.leading_coeff_nth k, by refine well_founded.not_lt_min
      (well_founded_submodule_gt _ _) _ _ _; exact ⟨k, rfl⟩,
    this ⟨HN ▸ I.leading_coeff_nth_mono (le_of_lt h), λ H, hxm (H hx)⟩),
have hs2 : ∀ {x}, x ∈ I.degree_le N → x ∈ ideal.span (↑s : set R[X]),
from hs ▸ λ x hx, submodule.span_induction hx (λ _ hx, ideal.subset_span hx) (ideal.zero_mem _)
  (λ _ _, ideal.add_mem _) (λ c f hf, f.C_mul' c ▸ ideal.mul_mem_left _ _ hf),
⟨s, le_antisymm
  (ideal.span_le.2 $ λ x hx, have x ∈ I.degree_le N, from hs ▸ submodule.subset_span hx, this.2) $
begin
  have : submodule.span R[X] ↑s = ideal.span ↑s, by refl,
  rw this,
  intros p hp, generalize hn : p.nat_degree = k,
  induction k using nat.strong_induction_on with k ih generalizing p,
  cases le_or_lt k N,
  { subst k, refine hs2 ⟨polynomial.mem_degree_le.2
      (le_trans polynomial.degree_le_nat_degree $ with_bot.coe_le_coe.2 h), hp⟩ },
  { have hp0 : p ≠ 0,
    { rintro rfl, cases hn, exact nat.not_lt_zero _ h },
    have : (0 : R) ≠ 1,
    { intro h, apply hp0, ext i, refine (mul_one _).symm.trans _,
      rw [← h, mul_zero], refl },
    haveI : nontrivial R := ⟨⟨0, 1, this⟩⟩,
    have : p.leading_coeff ∈ I.leading_coeff_nth N,
    { rw HN, exact hm2 k ((I.mem_leading_coeff_nth _ _).2
        ⟨_, hp, hn ▸ polynomial.degree_le_nat_degree, rfl⟩) },
    rw I.mem_leading_coeff_nth at this,
    rcases this with ⟨q, hq, hdq, hlqp⟩,
    have hq0 : q ≠ 0,
    { intro H, rw [← polynomial.leading_coeff_eq_zero] at H,
      rw [hlqp, polynomial.leading_coeff_eq_zero] at H, exact hp0 H },
    have h1 : p.degree = (q * polynomial.X ^ (k - q.nat_degree)).degree,
    { rw [polynomial.degree_mul', polynomial.degree_X_pow],
      rw [polynomial.degree_eq_nat_degree hp0, polynomial.degree_eq_nat_degree hq0],
      rw [← with_bot.coe_add, add_tsub_cancel_of_le, hn],
      { refine le_trans (polynomial.nat_degree_le_of_degree_le hdq) (le_of_lt h) },
      rw [polynomial.leading_coeff_X_pow, mul_one],
      exact mt polynomial.leading_coeff_eq_zero.1 hq0 },
    have h2 : p.leading_coeff = (q * polynomial.X ^ (k - q.nat_degree)).leading_coeff,
    { rw [← hlqp, polynomial.leading_coeff_mul_X_pow] },
    have := polynomial.degree_sub_lt h1 hp0 h2,
    rw [polynomial.degree_eq_nat_degree hp0] at this,
    rw ← sub_add_cancel p (q * polynomial.X ^ (k - q.nat_degree)),
    refine (ideal.span ↑s).add_mem _ ((ideal.span ↑s).mul_mem_right _ _),
    { by_cases hpq : p - q * polynomial.X ^ (k - q.nat_degree) = 0,
      { rw hpq, exact ideal.zero_mem _ },
      refine ih _ _ (I.sub_mem hp (I.mul_mem_right _ hq)) rfl,
      rwa [polynomial.degree_eq_nat_degree hpq, with_bot.coe_lt_coe, hn] at this },
    exact hs2 ⟨polynomial.mem_degree_le.2 hdq, hq⟩ }
end⟩⟩

attribute [instance] polynomial.is_noetherian_ring

namespace polynomial

theorem exists_irreducible_of_degree_pos
  {R : Type u} [comm_ring R] [is_domain R] [wf_dvd_monoid R]
  {f : R[X]} (hf : 0 < f.degree) : ∃ g, irreducible g ∧ g ∣ f :=
wf_dvd_monoid.exists_irreducible_factor
  (λ huf, ne_of_gt hf $ degree_eq_zero_of_is_unit huf)
  (λ hf0, not_lt_of_lt hf $ hf0.symm ▸ (@degree_zero R _).symm ▸ with_bot.bot_lt_coe _)

theorem exists_irreducible_of_nat_degree_pos
  {R : Type u} [comm_ring R] [is_domain R] [wf_dvd_monoid R]
  {f : R[X]} (hf : 0 < f.nat_degree) : ∃ g, irreducible g ∧ g ∣ f :=
exists_irreducible_of_degree_pos $ by { contrapose! hf, exact nat_degree_le_of_degree_le hf }

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

lemma linear_independent_powers_iff_aeval
  (f : M →ₗ[R] M) (v : M) :
  linear_independent R (λ n : ℕ, (f ^ n) v)
    ↔ ∀ (p : R[X]), aeval f p v = 0 → p = 0 :=
begin
  rw linear_independent_iff,
  simp only [finsupp.total_apply, aeval_endomorphism, forall_iff_forall_finsupp, sum, support,
    coeff, of_finsupp_eq_zero],
  exact iff.rfl,
end

lemma disjoint_ker_aeval_of_coprime
  (f : M →ₗ[R] M) {p q : R[X]} (hpq : is_coprime p q) :
  disjoint (aeval f p).ker (aeval f q).ker :=
begin
  rw disjoint_iff_inf_le,
  intros v hv,
  rcases hpq with ⟨p', q', hpq'⟩,
  simpa [linear_map.mem_ker.1 (submodule.mem_inf.1 hv).1,
         linear_map.mem_ker.1 (submodule.mem_inf.1 hv).2]
    using congr_arg (λ p : R[X], aeval f p v) hpq'.symm,
end

lemma sup_aeval_range_eq_top_of_coprime
  (f : M →ₗ[R] M) {p q : R[X]} (hpq : is_coprime p q) :
  (aeval f p).range ⊔ (aeval f q).range = ⊤ :=
begin
  rw eq_top_iff,
  intros v hv,
  rw submodule.mem_sup,
  rcases hpq with ⟨p', q', hpq'⟩,
  use aeval f (p * p') v,
  use linear_map.mem_range.2 ⟨aeval f p' v, by simp only [linear_map.mul_apply, aeval_mul]⟩,
  use aeval f (q * q') v,
  use linear_map.mem_range.2 ⟨aeval f q' v, by simp only [linear_map.mul_apply, aeval_mul]⟩,
  simpa only [mul_comm p p', mul_comm q q', aeval_one, aeval_add]
    using congr_arg (λ p : R[X], aeval f p v) hpq'
end

lemma sup_ker_aeval_le_ker_aeval_mul {f : M →ₗ[R] M} {p q : R[X]} :
  (aeval f p).ker ⊔ (aeval f q).ker ≤ (aeval f (p * q)).ker :=
begin
  intros v hv,
  rcases submodule.mem_sup.1 hv with ⟨x, hx, y, hy, hxy⟩,
  have h_eval_x : aeval f (p * q) x = 0,
  { rw [mul_comm, aeval_mul, linear_map.mul_apply, linear_map.mem_ker.1 hx, linear_map.map_zero] },
  have h_eval_y : aeval f (p * q) y = 0,
  { rw [aeval_mul, linear_map.mul_apply, linear_map.mem_ker.1 hy, linear_map.map_zero] },
  rw [linear_map.mem_ker, ←hxy, linear_map.map_add, h_eval_x, h_eval_y, add_zero],
end

lemma sup_ker_aeval_eq_ker_aeval_mul_of_coprime
  (f : M →ₗ[R] M) {p q : R[X]} (hpq : is_coprime p q) :
  (aeval f p).ker ⊔ (aeval f q).ker = (aeval f (p * q)).ker :=
begin
  apply le_antisymm sup_ker_aeval_le_ker_aeval_mul,
  intros v hv,
  rw submodule.mem_sup,
  rcases hpq with ⟨p', q', hpq'⟩,
  have h_eval₂_qpp' := calc
    aeval f (q * (p * p')) v = aeval f (p' * (p * q)) v :
      by rw [mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm q p]
    ... = 0 :
      by rw [aeval_mul, linear_map.mul_apply, linear_map.mem_ker.1 hv, linear_map.map_zero],
  have h_eval₂_pqq' := calc
    aeval f (p * (q * q')) v = aeval f (q' * (p * q)) v :
      by rw [←mul_assoc, mul_comm]
    ... = 0 :
      by rw [aeval_mul, linear_map.mul_apply, linear_map.mem_ker.1 hv, linear_map.map_zero],
  rw aeval_mul at h_eval₂_qpp' h_eval₂_pqq',
  refine ⟨aeval f (q * q') v, linear_map.mem_ker.1 h_eval₂_pqq',
          aeval f (p * p') v, linear_map.mem_ker.1 h_eval₂_qpp', _⟩,
  rw [add_comm, mul_comm p p', mul_comm q q'],
  simpa only [map_add, map_mul, aeval_one] using congr_arg (λ p : R[X], aeval f p v) hpq'
end

end polynomial

namespace mv_polynomial

lemma is_noetherian_ring_fin_0 [is_noetherian_ring R] :
  is_noetherian_ring (mv_polynomial (fin 0) R) :=
is_noetherian_ring_of_ring_equiv R
  ((mv_polynomial.is_empty_ring_equiv R pempty).symm.trans
   (rename_equiv R fin_zero_equiv'.symm).to_ring_equiv)

theorem is_noetherian_ring_fin [is_noetherian_ring R] :
  ∀ {n : ℕ}, is_noetherian_ring (mv_polynomial (fin n) R)
| 0 := is_noetherian_ring_fin_0
| (n+1) :=
  @is_noetherian_ring_of_ring_equiv (polynomial (mv_polynomial (fin n) R)) _ _ _
    (mv_polynomial.fin_succ_equiv _ n).to_ring_equiv.symm
    (@polynomial.is_noetherian_ring (mv_polynomial (fin n) R) _ (is_noetherian_ring_fin))

/-- The multivariate polynomial ring in finitely many variables over a noetherian ring
is itself a noetherian ring. -/
instance is_noetherian_ring [finite σ] [is_noetherian_ring R] :
  is_noetherian_ring (mv_polynomial σ R) :=
by casesI nonempty_fintype σ; exact
@is_noetherian_ring_of_ring_equiv (mv_polynomial (fin (fintype.card σ)) R) _ _ _
  (rename_equiv R (fintype.equiv_fin σ).symm).to_ring_equiv is_noetherian_ring_fin

/-- Auxiliary lemma:
Multivariate polynomials over an integral domain
with variables indexed by `fin n` form an integral domain.
This fact is proven inductively,
and then used to prove the general case without any finiteness hypotheses.
See `mv_polynomial.no_zero_divisors` for the general case. -/
lemma no_zero_divisors_fin (R : Type u) [comm_semiring R] [no_zero_divisors R] :
  ∀ (n : ℕ), no_zero_divisors (mv_polynomial (fin n) R)
| 0 := (mv_polynomial.is_empty_alg_equiv R _).injective.no_zero_divisors _ (map_zero _) (map_mul _)
| (n+1) := begin
    haveI := no_zero_divisors_fin n,
    exact (mv_polynomial.fin_succ_equiv R n).injective.no_zero_divisors _ (map_zero _) (map_mul _)
  end

/-- Auxiliary definition:
Multivariate polynomials in finitely many variables over an integral domain form an integral domain.
This fact is proven by transport of structure from the `mv_polynomial.no_zero_divisors_fin`,
and then used to prove the general case without finiteness hypotheses.
See `mv_polynomial.no_zero_divisors` for the general case. -/
lemma no_zero_divisors_of_finite (R : Type u) (σ : Type v) [comm_semiring R] [finite σ]
  [no_zero_divisors R] : no_zero_divisors (mv_polynomial σ R) :=
begin
  casesI nonempty_fintype σ,
  haveI := no_zero_divisors_fin R (fintype.card σ),
  exact (rename_equiv R (fintype.equiv_fin σ)).injective.no_zero_divisors _ (map_zero _) (map_mul _)
end

instance {R : Type u} [comm_semiring R] [no_zero_divisors R] {σ : Type v} :
  no_zero_divisors (mv_polynomial σ R) :=
⟨λ p q h, begin
  obtain ⟨s, p, rfl⟩ := exists_finset_rename p,
  obtain ⟨t, q, rfl⟩ := exists_finset_rename q,
  have :
    rename (subtype.map id (finset.subset_union_left s t) : {x // x ∈ s} → {x // x ∈ s ∪ t}) p *
    rename (subtype.map id (finset.subset_union_right s t) : {x // x ∈ t} → {x // x ∈ s ∪ t}) q = 0,
  { apply rename_injective _ subtype.val_injective, simpa using h },
  letI := mv_polynomial.no_zero_divisors_of_finite R {x // x ∈ (s ∪ t)},
  rw mul_eq_zero at this,
  cases this; [left, right],
  all_goals { simpa using congr_arg (rename subtype.val) this }
end⟩

/-- The multivariate polynomial ring over an integral domain is an integral domain. -/
instance {R : Type u} {σ : Type v} [comm_ring R] [is_domain R] : is_domain (mv_polynomial σ R) :=
begin
  apply no_zero_divisors.to_is_domain _,
  exact add_monoid_algebra.nontrivial,
  exact mv_polynomial.no_zero_divisors
end

lemma map_mv_polynomial_eq_eval₂ {S : Type*} [comm_ring S] [finite σ]
  (ϕ : mv_polynomial σ R →+* S) (p : mv_polynomial σ R) :
  ϕ p = mv_polynomial.eval₂ (ϕ.comp mv_polynomial.C) (λ s, ϕ (mv_polynomial.X s)) p :=
begin
  casesI nonempty_fintype σ,
  refine trans (congr_arg ϕ (mv_polynomial.as_sum p)) _,
  rw [mv_polynomial.eval₂_eq', ϕ.map_sum],
  congr,
  ext,
  simp only [monomial_eq, ϕ.map_pow, ϕ.map_prod, ϕ.comp_apply, ϕ.map_mul, finsupp.prod_pow],
end

/-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself,
multivariate version. -/
lemma mem_ideal_of_coeff_mem_ideal (I : ideal (mv_polynomial σ R)) (p : mv_polynomial σ R)
  (hcoe : ∀ (m : σ →₀ ℕ), p.coeff m ∈ I.comap (C : R →+* mv_polynomial σ R)) : p ∈ I :=
begin
  rw as_sum p,
  suffices : ∀ m ∈ p.support, monomial m (mv_polynomial.coeff m p) ∈ I,
  { exact submodule.sum_mem I this },
  intros m hm,
  rw [← mul_one (coeff m p), ← C_mul_monomial],
  suffices : C (coeff m p) ∈ I,
  { exact I.mul_mem_right (monomial m 1) this },
  simpa [ideal.mem_comap] using hcoe m
end

/-- The push-forward of an ideal `I` of `R` to `mv_polynomial σ R` via inclusion
 is exactly the set of polynomials whose coefficients are in `I` -/
theorem mem_map_C_iff {I : ideal R} {f : mv_polynomial σ R} :
  f ∈ (ideal.map (C : R →+* mv_polynomial σ R) I :
  ideal (mv_polynomial σ R)) ↔ ∀ (m : σ →₀ ℕ), f.coeff m ∈ I :=
begin
  split,
  { intros hf,
    apply submodule.span_induction hf,
    { intros f hf n,
      cases (set.mem_image _ _ _).mp hf with x hx,
      rw [← hx.right, coeff_C],
      by_cases (n = 0),
      { simpa [h] using hx.left },
      { simp [ne.symm h] } },
    { simp },
    { exact λ f g hf hg n, by simp [I.add_mem (hf n) (hg n)] },
    { refine λ f g hg n, _,
      rw [smul_eq_mul, coeff_mul],
      exact I.sum_mem (λ c hc, I.mul_mem_left (f.coeff c.fst) (hg c.snd)) } },
  { intros hf,
    rw as_sum f,
    suffices : ∀ m ∈ f.support, monomial m (coeff m f) ∈
      (ideal.map C I : ideal (mv_polynomial σ R)),
    { exact submodule.sum_mem _ this },
    intros m hm,
    rw [← mul_one (coeff m f), ← C_mul_monomial],
    suffices : C (coeff m f) ∈ (ideal.map C I : ideal (mv_polynomial σ R)),
    { exact ideal.mul_mem_right _ _ this },
    apply ideal.mem_map_of_mem _,
    exact hf m }
end

lemma ker_map (f : R →+* S) :
  (map f : mv_polynomial σ R →+* mv_polynomial σ S).ker = f.ker.map (C : R →+* mv_polynomial σ R) :=
begin
  ext,
  rw [mv_polynomial.mem_map_C_iff, ring_hom.mem_ker, mv_polynomial.ext_iff],
  simp_rw [coeff_map, coeff_zero, ring_hom.mem_ker],
end

end mv_polynomial

section unique_factorization_domain
variables {D : Type u} [comm_ring D] [is_domain D] [unique_factorization_monoid D] (σ)
open unique_factorization_monoid

namespace polynomial

@[priority 100]
instance unique_factorization_monoid : unique_factorization_monoid D[X] :=
begin
  haveI := arbitrary (normalization_monoid D),
  haveI := to_normalized_gcd_monoid D,
  exact ufm_of_gcd_of_wf_dvd_monoid
end

end polynomial

namespace mv_polynomial

private lemma unique_factorization_monoid_of_fintype [fintype σ] :
  unique_factorization_monoid (mv_polynomial σ D) :=
(rename_equiv D (fintype.equiv_fin σ)).to_mul_equiv.symm.unique_factorization_monoid $
begin
  induction fintype.card σ with d hd,
  { apply (is_empty_alg_equiv D (fin 0)).to_mul_equiv.symm.unique_factorization_monoid,
    apply_instance },
  { apply (fin_succ_equiv D d).to_mul_equiv.symm.unique_factorization_monoid,
    exactI polynomial.unique_factorization_monoid },
end

@[priority 100]
instance : unique_factorization_monoid (mv_polynomial σ D) :=
begin
  rw iff_exists_prime_factors,
  intros a ha, obtain ⟨s,a',rfl⟩ := exists_finset_rename a,
  obtain ⟨w,h,u,hw⟩ := iff_exists_prime_factors.1
    (unique_factorization_monoid_of_fintype s) a' (λ h, ha $ by simp [h]),
  exact ⟨ w.map (rename coe),
    λ b hb, let ⟨b',hb',he⟩ := multiset.mem_map.1 hb in he ▸ (prime_rename_iff ↑s).2 (h b' hb'),
    units.map (@rename s σ D _ coe).to_ring_hom.to_monoid_hom u,
    by erw [multiset.prod_hom, ← map_mul, hw] ⟩,
end

end mv_polynomial
end unique_factorization_domain


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.has_limits
import category_theory.discrete_category

/-!
# Categorical (co)products

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

This file defines (co)products as special cases of (co)limits.

A product is the categorical generalization of the object `Π i, f i` where `f : ι → C`. It is a
limit cone over the diagram formed by `f`, implemented by converting `f` into a functor
`discrete ι ⥤ C`.

A coproduct is the dual concept.

## Main definitions

* a `fan` is a cone over a discrete category
* `fan.mk` constructs a fan from an indexed collection of maps
* a `pi` is a `limit (discrete.functor f)`

Each of these has a dual.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.
-/

noncomputable theory

universes w v v₂ u u₂

open category_theory

namespace category_theory.limits

variables {β : Type w}
variables {C : Type u} [category.{v} C]

-- We don't need an analogue of `pair` (for binary products), `parallel_pair` (for equalizers),
-- or `(co)span`, since we already have `discrete.functor`.

local attribute [tidy] tactic.discrete_cases

/-- A fan over `f : β → C` consists of a collection of maps from an object `P` to every `f b`. -/
abbreviation fan (f : β → C) := cone (discrete.functor f)
/-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/
abbreviation cofan (f : β → C) := cocone (discrete.functor f)

/-- A fan over `f : β → C` consists of a collection of maps from an object `P` to every `f b`. -/
@[simps]
def fan.mk {f : β → C} (P : C) (p : Π b, P ⟶ f b) : fan f :=
{ X := P,
  π := { app := λ X, p X.as } }

/-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/
@[simps]
def cofan.mk {f : β → C} (P : C) (p : Π b, f b ⟶ P) : cofan f :=
{ X := P,
  ι := { app := λ X, p X.as } }

-- FIXME dualize as needed below (and rename?)

/-- Get the `j`th map in the fan -/
def fan.proj  {f : β → C} (p : fan f) (j : β) : p.X ⟶ f j := p.π.app (discrete.mk j)
@[simp] lemma fan_mk_proj {f : β → C} (P : C) (p : Π b, P ⟶ f b) (j : β) :
  (fan.mk P p).proj j = p j := rfl

/-- An abbreviation for `has_limit (discrete.functor f)`. -/
abbreviation has_product (f : β → C) := has_limit (discrete.functor f)

/-- An abbreviation for `has_colimit (discrete.functor f)`. -/
abbreviation has_coproduct (f : β → C) := has_colimit (discrete.functor f)

/-- Make a fan `f` into a limit fan by providing `lift`, `fac`, and `uniq` --
  just a convenience lemma to avoid having to go through `discrete` -/
@[simps] def mk_fan_limit {f : β → C} (t : fan f)
  (lift : Π s : fan f, s.X ⟶ t.X)
  (fac : ∀ (s : fan f) (j : β), lift s ≫ (t.proj j) = s.proj j)
  (uniq : ∀ (s : fan f) (m : s.X ⟶ t.X) (w : ∀ j : β, m ≫ t.proj j = s.proj j), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, by convert fac s j.as; simp,
  uniq' := λ s m w, uniq s m (λ j, w (discrete.mk j)), }

section
variables (C)

/-- An abbreviation for `has_limits_of_shape (discrete f)`. -/
abbreviation has_products_of_shape (β : Type v) := has_limits_of_shape.{v} (discrete β)
/-- An abbreviation for `has_colimits_of_shape (discrete f)`. -/
abbreviation has_coproducts_of_shape (β : Type v) := has_colimits_of_shape.{v} (discrete β)
end

/-- `pi_obj f` computes the product of a family of elements `f`.
(It is defined as an abbreviation for `limit (discrete.functor f)`,
so for most facts about `pi_obj f`, you will just use general facts about limits.) -/
abbreviation pi_obj (f : β → C) [has_product f] := limit (discrete.functor f)
/-- `sigma_obj f` computes the coproduct of a family of elements `f`.
(It is defined as an abbreviation for `colimit (discrete.functor f)`,
so for most facts about `sigma_obj f`, you will just use general facts about colimits.) -/
abbreviation sigma_obj (f : β → C) [has_coproduct f] := colimit (discrete.functor f)

notation `∏ ` f:20 := pi_obj f
notation `∐ ` f:20 := sigma_obj f

/-- The `b`-th projection from the pi object over `f` has the form `∏ f ⟶ f b`. -/
abbreviation pi.π (f : β → C) [has_product f] (b : β) : ∏ f ⟶ f b :=
limit.π (discrete.functor f) (discrete.mk b)
/-- The `b`-th inclusion into the sigma object over `f` has the form `f b ⟶ ∐ f`. -/
abbreviation sigma.ι (f : β → C) [has_coproduct f] (b : β) : f b ⟶ ∐ f :=
colimit.ι (discrete.functor f) (discrete.mk b)

/-- The fan constructed of the projections from the product is limiting. -/
def product_is_product (f : β → C) [has_product f] :
  is_limit (fan.mk _ (pi.π f)) :=
is_limit.of_iso_limit (limit.is_limit (discrete.functor f)) (cones.ext (iso.refl _) (by tidy))

/-- The cofan constructed of the inclusions from the coproduct is colimiting. -/
def coproduct_is_coproduct (f : β → C) [has_coproduct f] :
  is_colimit (cofan.mk _ (sigma.ι f)) :=
is_colimit.of_iso_colimit (colimit.is_colimit (discrete.functor f)) (cocones.ext (iso.refl _)
  (by tidy))

/-- A collection of morphisms `P ⟶ f b` induces a morphism `P ⟶ ∏ f`. -/
abbreviation pi.lift {f : β → C} [has_product f] {P : C} (p : Π b, P ⟶ f b) : P ⟶ ∏ f :=
limit.lift _ (fan.mk P p)
/-- A collection of morphisms `f b ⟶ P` induces a morphism `∐ f ⟶ P`. -/
abbreviation sigma.desc {f : β → C} [has_coproduct f] {P : C} (p : Π b, f b ⟶ P) : ∐ f ⟶ P :=
colimit.desc _ (cofan.mk P p)

/--
Construct a morphism between categorical products (indexed by the same type)
from a family of morphisms between the factors.
-/
abbreviation pi.map {f g : β → C} [has_product f] [has_product g]
  (p : Π b, f b ⟶ g b) : ∏ f ⟶ ∏ g :=
lim_map (discrete.nat_trans (λ X, p X.as))

instance pi.map_mono {f g : β → C} [has_product f] [has_product g]
  (p : Π b, f b ⟶ g b) [Π i, mono (p i)] : mono $ pi.map p :=
@@limits.lim_map_mono _ _ _ _ _ (by { dsimp, apply_instance })

/--
Construct an isomorphism between categorical products (indexed by the same type)
from a family of isomorphisms between the factors.
-/
abbreviation pi.map_iso {f g : β → C} [has_products_of_shape β C]
  (p : Π b, f b ≅ g b) : ∏ f ≅ ∏ g :=
lim.map_iso (discrete.nat_iso (λ X, p X.as))
/--
Construct a morphism between categorical coproducts (indexed by the same type)
from a family of morphisms between the factors.
-/
abbreviation sigma.map {f g : β → C} [has_coproduct f] [has_coproduct g]
  (p : Π b, f b ⟶ g b) : ∐ f ⟶ ∐ g :=
colim_map (discrete.nat_trans (λ X, p X.as))

instance sigma.map_epi {f g : β → C} [has_coproduct f] [has_coproduct g]
  (p : Π b, f b ⟶ g b) [Π i, epi (p i)] : epi $ sigma.map p :=
@@limits.colim_map_epi _ _ _ _ _ (by { dsimp, apply_instance })

/--
Construct an isomorphism between categorical coproducts (indexed by the same type)
from a family of isomorphisms between the factors.
-/
abbreviation sigma.map_iso {f g : β → C} [has_coproducts_of_shape β C]
  (p : Π b, f b ≅ g b) : ∐ f ≅ ∐ g :=
colim.map_iso (discrete.nat_iso (λ X, p X.as))

section comparison

variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D)
variables (f : β → C)

/-- The comparison morphism for the product of `f`. This is an iso iff `G` preserves the product
of `f`, see `preserves_product.of_iso_comparison`. -/
def pi_comparison [has_product f] [has_product (λ b, G.obj (f b))] :
  G.obj (∏ f) ⟶ ∏ (λ b, G.obj (f b)) :=
pi.lift (λ b, G.map (pi.π f b))

@[simp, reassoc]
lemma pi_comparison_comp_π [has_product f] [has_product (λ b, G.obj (f b))] (b : β) :
  pi_comparison G f ≫ pi.π _ b = G.map (pi.π f b) :=
limit.lift_π _ (discrete.mk b)

@[simp, reassoc]
lemma map_lift_pi_comparison [has_product f] [has_product (λ b, G.obj (f b))]
  (P : C) (g : Π j, P ⟶ f j) :
  G.map (pi.lift g) ≫ pi_comparison G f = pi.lift (λ j, G.map (g j)) :=
by { ext, discrete_cases, simp [← G.map_comp] }

/-- The comparison morphism for the coproduct of `f`. This is an iso iff `G` preserves the coproduct
of `f`, see `preserves_coproduct.of_iso_comparison`. -/
def sigma_comparison [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] :
  ∐ (λ b, G.obj (f b)) ⟶ G.obj (∐ f) :=
sigma.desc (λ b, G.map (sigma.ι f b))

@[simp, reassoc]
lemma ι_comp_sigma_comparison [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] (b : β) :
  sigma.ι _ b ≫ sigma_comparison G f = G.map (sigma.ι f b) :=
colimit.ι_desc _ (discrete.mk b)

@[simp, reassoc]
lemma sigma_comparison_map_desc [has_coproduct f] [has_coproduct (λ b, G.obj (f b))]
  (P : C) (g : Π j, f j ⟶ P) :
  sigma_comparison G f ≫ G.map (sigma.desc g) = sigma.desc (λ j, G.map (g j)) :=
by { ext, discrete_cases, simp [← G.map_comp] }

end comparison

variables (C)

/-- An abbreviation for `Π J, has_limits_of_shape (discrete J) C` -/
abbreviation has_products := Π (J : Type w), has_limits_of_shape (discrete J) C
/-- An abbreviation for `Π J, has_colimits_of_shape (discrete J) C` -/
abbreviation has_coproducts := Π (J : Type w), has_colimits_of_shape (discrete J) C

variable {C}

lemma has_smallest_products_of_has_products [has_products.{w} C] : has_products.{0} C :=
λ J, has_limits_of_shape_of_equivalence
  (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _)

lemma has_smallest_coproducts_of_has_coproducts [has_coproducts.{w} C] : has_coproducts.{0} C :=
λ J, has_colimits_of_shape_of_equivalence
  (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _)

lemma has_products_of_limit_fans (lf : ∀ {J : Type w} (f : J → C), fan f)
  (lf_is_limit : ∀ {J : Type w} (f : J → C), is_limit (lf f)) : has_products.{w} C :=
λ (J : Type w), { has_limit := λ F, has_limit.mk
  ⟨(cones.postcompose discrete.nat_iso_functor.inv).obj (lf (λ j, F.obj ⟨j⟩)),
    (is_limit.postcompose_inv_equiv _ _).symm (lf_is_limit _)⟩ }

/-!
(Co)products over a type with a unique term.
-/
section unique
variables {C} [unique β] (f : β → C)

/-- The limit cone for the product over an index type with exactly one term. -/
@[simps]
def limit_cone_of_unique : limit_cone (discrete.functor f) :=
{ cone :=
  { X := f default,
    π := { app := λ j, eq_to_hom (by { dsimp, congr, }), }, },
  is_limit :=
  { lift := λ s, s.π.app default,
    fac' := λ s j, begin
      have w := (s.π.naturality (eq_to_hom (unique.default_eq _))).symm,
      dsimp at w,
      simpa [eq_to_hom_map] using w,
    end,
    uniq' := λ s m w, begin
      specialize w default,
      dsimp at w,
      simpa using w,
    end, }, }

@[priority 100] instance has_product_unique : has_product f :=
has_limit.mk (limit_cone_of_unique f)

/-- A product over a index type with exactly one term is just the object over that term. -/
@[simps]
def product_unique_iso : ∏ f ≅ f default :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (limit_cone_of_unique f).is_limit

/-- The colimit cocone for the coproduct over an index type with exactly one term. -/
@[simps]
def colimit_cocone_of_unique : colimit_cocone (discrete.functor f) :=
{ cocone :=
  { X := f default,
    ι := { app := λ j, eq_to_hom (by { discrete_cases, dsimp, congr, }), }, },
  is_colimit :=
  { desc := λ s, s.ι.app default,
    fac' := λ s j, begin
      have w := (s.ι.naturality (eq_to_hom (unique.eq_default _))),
      dsimp at w,
      simpa [eq_to_hom_map] using w,
    end,
    uniq' := λ s m w, begin
      specialize w default,
      dsimp at w,
      simpa using w,
    end, }, }

@[priority 100] instance has_coproduct_unique : has_coproduct f :=
has_colimit.mk (colimit_cocone_of_unique f)

/-- A coproduct over a index type with exactly one term is just the object over that term. -/
@[simps]
def coproduct_unique_iso : ∐ f ≅ f default :=
is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
  (colimit_cocone_of_unique f).is_colimit

end unique

section reindex
variables {C} {γ : Type v} (ε : β ≃ γ) (f : γ → C)

section
variables [has_product f] [has_product (f ∘ ε)]

/-- Reindex a categorical product via an equivalence of the index types. -/
def pi.reindex : pi_obj (f ∘ ε) ≅ pi_obj f :=
has_limit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _))

@[simp, reassoc]
lemma pi.reindex_hom_π (b : β) : (pi.reindex ε f).hom ≫ pi.π f (ε b) = pi.π (f ∘ ε) b :=
begin
  dsimp [pi.reindex],
  simp only [has_limit.iso_of_equivalence_hom_π, discrete.nat_iso_inv_app,
    equivalence.equivalence_mk'_counit, discrete.equivalence_counit_iso, discrete.nat_iso_hom_app,
    eq_to_iso.hom, eq_to_hom_map],
  dsimp,
  simpa [eq_to_hom_map] using
    limit.w (discrete.functor (f ∘ ε)) (discrete.eq_to_hom' (ε.symm_apply_apply b)),
end

@[simp, reassoc]
lemma pi.reindex_inv_π (b : β) : (pi.reindex ε f).inv ≫ pi.π (f ∘ ε) b = pi.π f (ε b) :=
by simp [iso.inv_comp_eq]

end

section
variables [has_coproduct f] [has_coproduct (f ∘ ε)]

/-- Reindex a categorical coproduct via an equivalence of the index types. -/
def sigma.reindex : sigma_obj (f ∘ ε) ≅ sigma_obj f :=
has_colimit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _))

@[simp, reassoc]
lemma sigma.ι_reindex_hom (b : β) : sigma.ι (f ∘ ε) b ≫ (sigma.reindex ε f).hom = sigma.ι f (ε b) :=
begin
  dsimp [sigma.reindex],
  simp only [has_colimit.iso_of_equivalence_hom_π, equivalence.equivalence_mk'_unit,
    discrete.equivalence_unit_iso, discrete.nat_iso_hom_app, eq_to_iso.hom, eq_to_hom_map,
    discrete.nat_iso_inv_app],
  dsimp,
  simp [eq_to_hom_map,
    ←colimit.w (discrete.functor f) (discrete.eq_to_hom' (ε.apply_symm_apply (ε b)))],
end

@[simp, reassoc]
lemma sigma.ι_reindex_inv (b : β) : sigma.ι f (ε b) ≫ (sigma.reindex ε f).inv = sigma.ι (f ∘ ε) b :=
by simp [iso.comp_inv_eq]

end

end reindex

end category_theory.limits


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Dijkstra.Tactic.Basic

import Dijkstra.Control.Monad.Hom
import Dijkstra.Control.Monad.Rel
import Dijkstra.Control.Monad.Dijkstra
import Dijkstra.Control.Monad.Spec

universe u v v₁ v₂ w w₁ w₂

/-!

# Reification of Dijkstra monads

Given a Dijkstra monad `M : (α : Type u) → W α → Type v` over a monad `W : Type u → Type w`, one sometimes wants to take the value of type `M α w` into computation of a monad `m : Type u → Type v`.
For example, suppose that `M := Graph r` is the Dijkstra monad associated with the monadic relation `r : MonadRel m W` on `m` with a specification monad `W`.
In this case, a relation between a computation `x : m α` and a "specification" `w : W α` can be represented by `X : M α w`.
Sometimes, the specification `X` assures that the computation result of `x` actually lies in the subtype `{a : α // p a}` rather than `α` for some predicate `p : α → Prop`.
In other words, `X` enables to pass the result of `x` to the next computation of the form `(a : α) → p a → m β`.
In particular, if the next computation is `pure`, one obtains a value of type `m (Subtype p)`, which we would call the ***reification*** of `X`.

The goal of this module is to develop a formal framework for the above.

-/

/-!

## The transformer `SubtypeT`

We first investigate the type `m (Subtype p)` of the reifications.
Notice that it is a type construction from a monad `m : Type u → Type v`, a type `α : Type u`, and a prediate `p : α → Prop`.
Since `p` is also considered as a value of the predicate monad `Pred`,
From this viewpoint, we introduce the following:

```lean
SubtypeT m (α : Type u) (p : Pred α) ≡ m (Subtype p)
```

It turns out that `SubtypeT m` forms a Dijkstra monad over `Pred` provided `m` is a monad.
Hence, we may think of `SubtypeT` as a transformer of a monad into a Dijkstra monad.

For each monad `m`, the Dijkstra monad `SubtypeT m` comes equipped with the following two fundamental operations:

```lean
def pureMk {α: Type u} {p : Pred α} : (a : α) → (h : p a) → SubtypeT m α p :=
  λ a h => return (Subtype.mk a h)

def weaken {α :Type u} {p q : Pred α} : MonadRel.rel p q → SubtypeT m α p → SubtypeT m α q :=
  λ hpq x => x >>= λ a => return ⟨a.val, hpq a.val a.property⟩
```

-/

def SubtypeT (m : Type u → Type v) (α : Type u) (p : Pred α) : Type v := m (Subtype p)

namespace SubtypeT

variable {m : Type u → Type v} [Monad m]

instance instDijkstraMonadSubtypeT : DijkstraMonad Pred (SubtypeT m) where
  dpure a := pure ⟨a,rfl⟩
  dbind x f := x >>= λ a => f a.val >>= λ b => return ⟨b, ⟨a, a.property, b.property⟩⟩

def pureMk {α : Type u} {p : Pred α} (a : α) (h : p a) : SubtypeT m α p :=
  pure ⟨a,h⟩

def weaken {α : Type u} {p q : Pred α} (hpq : mrel p q) (x : SubtypeT m α p) : SubtypeT m α q :=
  x >>= λ a => return ⟨a.val, hpq a a.property⟩

theorem deq_of_iff [LawfulMonad m] {α : Type u} {p q : Pred α} (hpq : ∀ a, p a ↔ q a) : ∀ (x : SubtypeT m α p), DEq (SubtypeT m α) x (x.weaken λ a => (hpq a).mp) := by
  have : p = q := funext (λ a => propext (hpq a))
  cases this
  intro x; apply DEq.deq_of_eq
  conv =>
    rhs; dsimp [weaken]; congr
    . skip
    . ext a; change pure a
  rw [bind_pure]

instance instDijkstraMonadLawfulSubtypeT [LawfulMonad m] : DijkstraMonad.Lawful Pred (SubtypeT m) where
  dbind_dpure := by
    intro α p x
    dsimp [dbind, dpure]
    conv =>
      lhs; rhs; ext a; rw [pure_bind]; dsimp [pure]
    have : ∀ a, (p >>= pure) a ↔ p a := by
      rw [bind_pure (m:=Pred)]; intros; exact Iff.rfl
    apply DEq.trans (deq_of_iff (m:=m) (q:=p) this _)
    apply DEq.deq_of_eq
    conv =>
      lhs; dsimp [weaken]; rw [bind_assoc]
      rhs; ext x; rw [pure_bind]
    rw [bind_pure (m:=m)]
  dpure_dbind := by
    intro α β wf a f
    dsimp [dbind, dpure]
    conv => lhs; rw [pure_bind]; dsimp
    have : ∀ a₁, (pure a >>= wf) a₁ ↔ wf a a₁ := by
      rw [pure_bind (m:=Pred)]; intros; exact Iff.rfl
    apply DEq.trans (deq_of_iff (m:=m) this _)
    apply DEq.deq_of_eq
    conv =>
      lhs; dsimp [weaken]; rw [bind_assoc]
      rhs; ext x; rw [pure_bind]; change pure x
    rw [bind_pure]
  dbind_assoc := by
    intro α β γ wa wf wg x f g
    have : ∀ c, (wa >>= wf >>= wg) c ↔ (wa >>= λ a => wf a >>= wg) c := by
      rw [bind_assoc (m:=Pred)]; intros; exact Iff.rfl
    apply DEq.trans (deq_of_iff this _)
    apply DEq.deq_of_eq
    dsimp [weaken, dbind]
    conv =>
      lhs; rw [bind_assoc, bind_assoc]
      rhs; ext x; rw [bind_assoc]
      rhs; ext y; rw [pure_bind, bind_assoc]
      rhs; ext z; rw [pure_bind]
    apply bind_congr
    intro a
    conv =>
      rhs; rw [bind_assoc]
      rhs; ext b; rw [bind_assoc]
      rhs; ext x; rw [pure_bind]

end SubtypeT

/-!

## Dijkstra lift

As seen in the previous section, the type `m (Subtype p)` of the result of the reification form a Dijkstra monad over the specification `Pred`.
This implies that the reification is a transformation of Dijkstra monads with possibly different underlying monads.
This is why we introduce the notion of ***Dijkstra lift***, which is an analogue of `MonadLift`.

-/

/-- Dijkstra lift structure. Notice that the ingredients include `MonadRel W Z` instead of `MonadHom W Z`. -/
class DijkstraLift {W : Type u → Type v₁} [Monad W] {Z : Type u → Type v₂} [Monad Z] (r : MonadRel W Z) (M : (α : Type u) → W α → Type w₁) [DijkstraMonad W M] (N : (α : Type u) → Z α → Type w₂) [DijkstraMonad Z N] where
  dLift {α : Type u} {w : W α} {z : Z α} : r.rel w z → M α w → N α z

/-- Axioms for Dijkstra lifts -/
class DijkstraLift.Lawful {W : Type u → Type v₁} [Monad W] {Z : Type u → Type v₂} [Monad Z] (r : MonadRel W Z) (M : (α : Type u) → W α → Type w₁) [DijkstraMonad W M] (N : (α : Type u) → Z α → Type w₂) [DijkstraMonad Z N] [DijkstraLift r M N] where
  -- Compatibility with `DijkstraMonad.dpure`
  dLift_dpure {α : Type u} (a : α) : dLift (r.pure a) (dpure (M:=M) a) = dpure (M:=N) a
  -- Compatibility with `DijkstraMonad.dbind`
  dLift_dbind {α β : Type u} {wa : W α} {wf : α → W β} {za : Z α} {zf : α → Z β} {ha : r.rel wa za} {hf : ∀ a, r.rel (wf a) (zf a)} (x : M α wa) (f : (a : α) → M β (wf a)) : dLift (r.bind ha hf) (dbind (M:=M) x f) = dbind (M:=N) (dLift ha x) λ a => dLift (hf a) (f a)

export DijkstraLift.Lawful (dLift_dpure dLift_dbind)

/-- As an example, for every monad `m`, `SubtypeT m` has a canonical lift to itself along the implication relation `Pred.rel p q ≡ ∀ a, p a → q a`. -/
instance instDijkstraLiftSubtypeTweaken (m : Type u → Type v) [Monad m] : DijkstraLift Pred.rel (SubtypeT m) (SubtypeT  m) where
  dLift h x := SubtypeT.weaken h x

instance instDijkstraLiftLawfulSubtypeTweaken (m : Type u → Type v) [Monad m] [LawfulMonad m] : DijkstraLift.Lawful Pred.rel (SubtypeT m) (SubtypeT m) where
  dLift_dpure a := by
    dsimp [DijkstraLift.dLift, SubtypeT.weaken, dpure]
    rw [pure_bind]
  dLift_dbind x f := by
    dsimp [DijkstraLift.dLift, SubtypeT.weaken, dbind]
    rw [bind_assoc, bind_assoc]
    apply bind_congr; intro a
    rw [bind_assoc, pure_bind, bind_assoc]
    apply bind_congr; intro b
    rw [pure_bind, pure_bind]

/-!

## Reification

We now define the notion of reification.
Let `M : (α : Type u) → W α → Type v` be a Dijkstra monad over a (specification) monad `W` equipped with a specification monadic relation `r : SpecMonadRel W Pred`.
Then, a monad `m : Tye u → Type w` is called a ***reification of `M`*** with respect to `r` if there is a Dijkstra lift `reify : r w p → M α w → SubtypeT m p` which satisfies the follogin conditions.

```lean
reify_weaken {α : Type u} {p q : Pred α} (hpq : ∀ a, p a → q a): ∀ {wp : WPPure α} {x : M α wp} {h : wp p}, (reify p x h).weaken hpq = reify q x (wp.monotonic h)
```
-/

/-- Reification of a Dijkstra monad  -/
class Reification {W : Type u → Type w} [Monad W] [SpecMonad W] (r : SpecMonadRel W Pred) (M : (α : Type u) → W α → Type v) [DijkstraMonad W M] (m : Type u → Type v₁) [Monad m] extends DijkstraLift r.toMonadRel M (SubtypeT m)

def reify {W : Type u → Type w} [Monad W] [SpecMonad W] {r : SpecMonadRel W Pred} {M : (α : Type u) → W α → Type v} [DijkstraMonad W M] {m : Type u → Type v₁} [Monad m] [self : Reification r M m] {α : Type u} {w : W α} (p : Pred α) : r.rel w p → M α w → SubtypeT m α p :=
  self.dLift

/-- The axioms for reification -/
class Reification.Lawful {W : Type u → Type w} [Monad W] [SpecMonad W] (r : SpecMonadRel W Pred) (M : (α : Type u) → W α → Type v) [DijkstraMonad W M] (m : Type u → Type v₁) [Monad m] [Reification r M m] extends DijkstraLift.Lawful r.toMonadRel M (SubtypeT m) where
  --- `reify` and `weaken`
  reify_weaken {α : Type u} {wa : W α} {p q : Pred α} (hpq : mrel p q) : ∀ {x : M α wa} {h : r.rel wa p}, (reify (M:=M) (m:=m) p h x).weaken hpq = reify (M:=M) (m:=m) q (r.trans_right h hpq) x

export Reification.Lawful (reify_weaken)

section Reification

variable {W : Type u → Type w} [Monad W] [SpecMonad W] {r : SpecMonadRel W Pred} {M : (α :Type u) → W α → Type v} [DijkstraMonad W M] {m :Type u → Type v₁} [Monad m] [Reification r M m] [DijkstraLift.Lawful r.toMonadRel M (SubtypeT m)] [self : Reification.Lawful r M m]

@[simp]
theorem reify_dpure {α : Type u} (a : α) : reify (M:=M) (pure a) (r.pure a) (dpure a) = dpure (M:=SubtypeT m) a :=
  dLift_dpure a

@[simp]
theorem reify_dbind {α β : Type u} {wa : W α} {wf : α → W β} {pa : Pred α} {pf : α → Pred β} {ha : r.rel wa pa} {hf : ∀ a, r.rel (wf a) (pf a)} (x : M α wa) (f : (a : α) → M β (wf a)) : reify (M:=M) (pa >>= pf) (r.bind ha hf) (dbind x f) = dbind (M:=SubtypeT m) (reify (M:=M) pa ha x) (λ a => reify (M:=M) (pf a) (hf a) (f a)) :=
  dLift_dbind x f

end Reification


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.calculus.mean_value

/-!
# L'Hôpital's rule for 0/0 indeterminate forms

In this file, we prove several forms of "L'Hopital's rule" for computing 0/0
indeterminate forms. The proof of `has_deriv_at.lhopital_zero_right_on_Ioo`
is based on the one given in the corresponding
[Wikibooks](https://en.wikibooks.org/wiki/Calculus/L%27H%C3%B4pital%27s_Rule)
chapter, and all other statements are derived from this one by composing by
carefully chosen functions.

Note that the filter `f'/g'` tends to isn't required to be one of `𝓝 a`,
`at_top` or `at_bot`. In fact, we give a slightly stronger statement by
allowing it to be any filter on `ℝ`.

Each statement is available in a `has_deriv_at` form and a `deriv` form, which
is denoted by each statement being in either the `has_deriv_at` or the `deriv`
namespace.

## Tags

L'Hôpital's rule, L'Hopital's rule
-/

open filter set
open_locale filter topological_space pointwise

variables {a b : ℝ} (hab : a < b) {l : filter ℝ} {f f' g g' : ℝ → ℝ}

/-!
## Interval-based versions

We start by proving statements where all conditions (derivability, `g' ≠ 0`) have
to be satisfied on an explicitly-provided interval.
-/

namespace has_deriv_at

include hab

theorem lhopital_zero_right_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have sub : ∀ x ∈ Ioo a b, Ioo a x ⊆ Ioo a b := λ x hx, Ioo_subset_Ioo (le_refl a) (le_of_lt hx.2),
  have hg : ∀ x ∈ (Ioo a b), g x ≠ 0,
  { intros x hx h,
    have : tendsto g (𝓝[Iio x] x) (𝓝 0),
    { rw [← h, ← nhds_within_Ioo_eq_nhds_within_Iio hx.1],
      exact ((hgg' x hx).continuous_at.continuous_within_at.mono $ sub x hx).tendsto },
    obtain ⟨y, hyx, hy⟩ : ∃ c ∈ Ioo a x, g' c = 0,
      from exists_has_deriv_at_eq_zero' hx.1 hga this (λ y hy, hgg' y $ sub x hx hy),
    exact hg' y (sub x hx hyx) hy },
  have : ∀ x ∈ Ioo a b, ∃ c ∈ Ioo a x, (f x) * (g' c) = (g x) * (f' c),
  { intros x hx,
    rw [← sub_zero (f x), ← sub_zero (g x)],
    exact exists_ratio_has_deriv_at_eq_ratio_slope' g g' hx.1 f f'
      (λ y hy, hgg' y $ sub x hx hy) (λ y hy, hff' y $ sub x hx hy) hga hfa
      (tendsto_nhds_within_of_tendsto_nhds (hgg' x hx).continuous_at.tendsto)
      (tendsto_nhds_within_of_tendsto_nhds (hff' x hx).continuous_at.tendsto) },
  choose! c hc using this,
  have : ∀ x ∈ Ioo a b, ((λ x', (f' x') / (g' x')) ∘ c) x = f x / g x,
  { intros x hx,
    rcases hc x hx with ⟨h₁, h₂⟩,
    field_simp [hg x hx, hg' (c x) ((sub x hx) h₁)],
    simp only [h₂],
    rwa mul_comm },
  have cmp : ∀ x ∈ Ioo a b, a < c x ∧ c x < x,
    from λ x hx, (hc x hx).1,
  rw ← nhds_within_Ioo_eq_nhds_within_Ioi hab,
  apply tendsto_nhds_within_congr this,
  simp only,
  apply hdiv.comp,
  refine tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
    (tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds
      (tendsto_nhds_within_of_tendsto_nhds tendsto_id) _ _) _,
  all_goals
  { apply eventually_nhds_with_of_forall,
    intros x hx,
    have := cmp x hx,
    try {simp},
    linarith [this] }
end

theorem lhopital_zero_right_on_Ico
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Ioo a b, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Ioo a b, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Ioo at hdnf,
  rw preimage_neg_Ioo at hdng,
  have := lhopital_zero_right_on_Ioo (neg_lt_neg hab) hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Ioo at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfb.comp tendsto_neg_nhds_within_Ioi_neg)
    (hgb.comp tendsto_neg_nhds_within_Ioi_neg)
    (by { simp only [neg_div_neg_eq, mul_one, mul_neg_eq_neg_mul_symm],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_nhds_within_Ioi_neg) }),
  have := this.comp tendsto_neg_nhds_within_Iio,
  unfold function.comp at this,
  simpa only [neg_neg]
end

theorem lhopital_zero_left_on_Ioc
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ioc a b)) (hcg : continuous_on g (Ioc a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : f b = 0) (hgb : g b = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  refine lhopital_zero_left_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcf b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
  { rw [← hgb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcg b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hff' : ∀ x ∈ Ioi a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioi a, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  obtain ⟨ a', haa', ha'⟩ : ∃ a', a < a' ∧ 0 < a' :=
    ⟨1 + max a 0, ⟨lt_of_le_of_lt (le_max_left a 0) (lt_one_add _),
                   lt_of_le_of_lt (le_max_right a 0) (lt_one_add _)⟩⟩,
  have fact1 : ∀ (x:ℝ), x ∈ Ioo 0 a'⁻¹ → x ≠ 0 := λ _ hx, (ne_of_lt hx.1).symm,
  have fact2 : ∀ x ∈ Ioo 0 a'⁻¹, a < x⁻¹,
    from λ _ hx, lt_trans haa' ((lt_inv ha' hx.1).mpr hx.2),
  have hdnf : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (f ∘ has_inv.inv) (f' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hff' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have hdng : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (g ∘ has_inv.inv) (g' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hgg' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have := lhopital_zero_right_on_Ioo (inv_pos.mpr ha') hdnf hdng
    (by { intros x hx,
          refine mul_ne_zero _ (neg_ne_zero.mpr $ inv_ne_zero $ pow_ne_zero _ $ fact1 x hx),
          exact hg' _ (fact2 x hx) })
    (hftop.comp tendsto_inv_zero_at_top)
    (hgtop.comp tendsto_inv_zero_at_top)
    (by { refine (tendsto_congr' _).mp (hdiv.comp tendsto_inv_zero_at_top),
          rw eventually_eq_iff_exists_mem,
          use [Ioi 0, self_mem_nhds_within],
          intros x hx,
          unfold function.comp,
          erw mul_div_mul_right,
          refine neg_ne_zero.mpr (inv_ne_zero $ pow_ne_zero _ $ ne_of_gt hx) }),
  have := this.comp tendsto_inv_at_top_zero',
  unfold function.comp at this,
  simpa only [inv_inv₀],
end

theorem lhopital_zero_at_bot_on_Iio
  (hff' : ∀ x ∈ Iio a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Iio a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Iio a, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Iio a, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Iio a, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Iio at hdnf,
  rw preimage_neg_Iio at hdng,
  have := lhopital_zero_at_top_on_Ioi hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Iio at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfbot.comp tendsto_neg_at_top_at_bot)
    (hgbot.comp tendsto_neg_at_top_at_bot)
    (by { simp only [mul_one, mul_neg_eq_neg_mul_symm, neg_div_neg_eq],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_at_top_at_bot) }),
  have := this.comp tendsto_neg_at_bot_at_top,
  unfold function.comp at this,
  simpa only [neg_neg],
end

end has_deriv_at

namespace deriv

include hab

theorem lhopital_zero_right_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b)) (hg' : ∀ x ∈ Ioo a b, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_right_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfa hga hdiv
end

theorem lhopital_zero_right_on_Ico
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hdf hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_left_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfb hgb hdiv
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hdf : differentiable_on ℝ f (Ioi a))
  (hg' : ∀ x ∈ (Ioi a), (deriv g) x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdf : ∀ x ∈ Ioi a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioi_mem_nhds hx),
  have hdg : ∀ x ∈ Ioi a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_top_on_Ioi (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hftop hgtop hdiv,
end

theorem lhopital_zero_at_bot_on_Iio
  (hdf : differentiable_on ℝ f (Iio a))
  (hg' : ∀ x ∈ (Iio a), (deriv g) x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdf : ∀ x ∈ Iio a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Iio_mem_nhds hx),
  have hdg : ∀ x ∈ Iio a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_bot_on_Iio (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfbot hgbot hdiv,
end

end deriv

/-!
## Generic versions

The following statements no longer any explicit interval, as they only require
conditions holding eventually.
-/

namespace has_deriv_at

/-- L'Hôpital's rule for approaching a real from the right, `has_deriv_at` version -/
theorem lhopital_zero_nhds_right
  (hff' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[Ioi a] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[Ioi a] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨u, hau, hu⟩,
  refine lhopital_zero_right_on_Ioo hau _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hu hx).1.1 <|> exact (hu hx).1.2 <|> exact (hu hx).2
end

/-- L'Hôpital's rule for approaching a real from the left, `has_deriv_at` version -/
theorem lhopital_zero_nhds_left
  (hff' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[Iio a] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Iio a] a) (𝓝 0)) (hga : tendsto g (𝓝[Iio a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Iio a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Iio a] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[Iio a] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Iio_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨l, hal, hl⟩,
  refine lhopital_zero_left_on_Ioo hal _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hl hx).1.1 <|> exact (hl hx).1.2 <|> exact (hl hx).2
end

/-- L'Hôpital's rule for approaching a real, `has_deriv_at` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hff' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hff'.1 hgg'.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hff'.2 hgg'.2 hg'.2 hfa.2 hga.2 hdiv.2⟩
end

/-- **L'Hôpital's rule** for approaching a real, `has_deriv_at` version -/
theorem lhopital_zero_nhds
  (hff' : ∀ᶠ x in 𝓝 a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝 a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝 a, g' x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, f' x / g' x) (𝓝 a) l) :
  tendsto (λ x, f x / g x) (𝓝[univ \ {a}] a) l :=
begin
  apply @lhopital_zero_nhds' _ _ _ f' _ g';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- L'Hôpital's rule for approaching +∞, `has_deriv_at` version -/
theorem lhopital_zero_at_top
  (hff' : ∀ᶠ x in at_top, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_top, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_top, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_top := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_top_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Ioi l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_top_on_Ioi _ _ (λ x hx, hg' x $ (hl' hx).2) hftop hgtop hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

/-- L'Hôpital's rule for approaching -∞, `has_deriv_at` version -/
theorem lhopital_zero_at_bot
  (hff' : ∀ᶠ x in at_bot, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_bot, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_bot, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_bot := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_bot_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Iio l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_bot_on_Iio _ _ (λ x hx, hg' x $ (hl' hx).2) hfbot hgbot hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

end has_deriv_at

namespace deriv

/-- **L'Hôpital's rule** for approaching a real from the right, `deriv` version -/
theorem lhopital_zero_nhds_right
  (hdf : ∀ᶠ x in 𝓝[Ioi a] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[Ioi a] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[Ioi a] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_right hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real from the left, `deriv` version -/
theorem lhopital_zero_nhds_left
  (hdf : ∀ᶠ x in 𝓝[Iio a] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[Iio a] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Iio a] a) (𝓝 0)) (hga : tendsto g (𝓝[Iio a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Iio a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Iio a] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[Iio a] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_left hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hdf : ∀ᶠ x in 𝓝[univ \ {a}] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hdf.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hdf.2 hg'.2 hfa.2 hga.2 hdiv.2⟩,
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version -/
theorem lhopital_zero_nhds
  (hdf : ∀ᶠ x in 𝓝 a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝 a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝 a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  apply lhopital_zero_nhds';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- **L'Hôpital's rule** for approaching +∞, `deriv` version -/
theorem lhopital_zero_at_top
  (hdf : ∀ᶠ (x : ℝ) in at_top, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_top, deriv g x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdg : ∀ᶠ x in at_top, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_top, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_top, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_top hdf' hdg' hg' hftop hgtop hdiv
end

/-- **L'Hôpital's rule** for approaching -∞, `deriv` version -/
theorem lhopital_zero_at_bot
  (hdf : ∀ᶠ (x : ℝ) in at_bot, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_bot, deriv g x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdg : ∀ᶠ x in at_bot, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_bot, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_bot, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_bot hdf' hdg' hg' hfbot hgbot hdiv
end

end deriv


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.specific_limits
import combinatorics.simplicial_complex.basic
import set_theory.fincard

open affine set

variables {m : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E]
  {S₁ S₂ : simplicial_complex E}

/--
S₁ ≤ S₂ (S₁ is a subdivision of S₂) iff their underlying space is the same and each face of S₁ is
contained in some face of S₂
-/
instance : has_le (simplicial_complex E) := ⟨λ S₁ S₂, S₁.space = S₂.space ∧
  ∀ {X₁ : finset  E}, X₁ ∈ S₁.faces → ∃ X₂ ∈ S₂.faces,
  convex_hull (X₁ : set E) ⊆ convex_hull (X₂ : set E)⟩

lemma subdivision_iff_combi_interiors_subset_combi_interiors :
  S₁ ≤ S₂ ↔ S₂.space ⊆ S₁.space ∧
  ∀ {X₁}, X₁ ∈ S₁.faces → ∃ {X₂}, X₂ ∈ S₂.faces ∧ combi_interior X₁ ⊆ combi_interior X₂ :=
begin
  split,
  { rintro ⟨hspace, hS⟩,
    use ge_of_eq hspace,
    rintro X hX,
    obtain ⟨Y, hY, hXY⟩ := hS hX,
    obtain ⟨Z, hZY, hXZ⟩ := simplex_combi_interiors_split_interiors (S₂.indep hY) hXY,
    exact ⟨Z, S₂.down_closed hY hZY, hXZ⟩ },
  { rintro ⟨hspace, hS⟩,
    split,
    { apply subset.antisymm _ hspace,
      rintro x hx,
      obtain ⟨X₁, hX₁, hx⟩ := mem_space_iff.1 hx,
      obtain ⟨X₂, hX₂, hX₁X₂⟩ := hS hX₁,
      rw mem_space_iff,
      refine ⟨X₂, hX₂, _⟩,
      apply convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior _ _ hX₁X₂ hx,
      { apply S₁.indep hX₁ },
      { apply S₂.indep hX₂ } },
    { rintro X₁ hX₁,
      obtain ⟨X₂, hX₂, hX₁X₂⟩ := hS hX₁,
      refine ⟨_, hX₂, convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior _ _ _⟩,
      { apply S₁.indep hX₁ },
      { apply S₂.indep hX₂ },
      { apply hX₁X₂ }}}
end

lemma subdivision_iff_partition :
  S₁ ≤ S₂ ↔ (S₁.faces.nonempty → S₂.faces.nonempty) ∧ S₁.space ⊆ S₂.space ∧ ∀ {X₂}, X₂ ∈ S₂.faces →
  ∃ {F}, F ⊆ S₁.faces ∧ combi_interior X₂ = ⋃ (X₁ ∈ F), combi_interior X₁ :=
begin
  split,
  { rintro ⟨hspace, hsubdiv⟩,
    split,
    { rintro ⟨X₁, hX₁⟩,
      obtain ⟨X₂, hX₂, hX₁X₂⟩ := hsubdiv hX₁,
      exact ⟨X₂, hX₂⟩ },
    use le_of_eq hspace,
    rintro X hX,
    use [{Y | Y ∈ S₁.faces ∧ combi_interior Y ⊆ combi_interior X}, (λ Y hY, hY.1)],
    ext x,
    split,
    { rintro hxX,
      have hxspace := mem_space_iff.2 ⟨X, hX, hxX.1⟩,
      rw [←hspace, combi_interiors_cover, mem_bUnion_iff] at hxspace,
      obtain ⟨Y, hY, hxY⟩ := hxspace,
      apply mem_bUnion _ hxY,
      use hY,
      rintro y hyY,
      obtain ⟨Z, hZ, hYZ⟩ := hsubdiv hY,
      obtain ⟨W, hWZ, hYW⟩ := simplex_combi_interiors_split_interiors (S₂.indep hZ) hYZ,
      rw disjoint_interiors hX (S₂.down_closed hZ hWZ) hxX (hYW hxY),
      exact hYW hyY },
    { rw mem_bUnion_iff,
      rintro ⟨Y, ⟨hY, hYX⟩, hxY⟩,
      exact hYX hxY }},
  { rintro ⟨hempty, hspace, hpartition⟩,
    have hspace : S₁.space = S₂.space,
    { apply subset.antisymm hspace,
      rintro x hx,
      rw [combi_interiors_cover, mem_bUnion_iff] at ⊢ hx,
      obtain ⟨X, hX, hxX⟩ := hx,
      obtain ⟨F, hF, hXint⟩ := hpartition hX,
      rw [hXint, mem_bUnion_iff] at hxX,
      obtain ⟨Y, hY, hxY⟩ := hxX,
      exact ⟨Y, hF hY, hxY⟩ },
    use hspace,
    rintro X hX,
    cases finset.eq_empty_or_nonempty X with hXempty hXnonempty,
    { obtain ⟨Y, hY⟩ := hempty ⟨X, hX⟩,
      use [Y, hY],
      rw hXempty,
      simp },
    obtain ⟨x, hx⟩ := nonempty_combi_interior_of_nonempty (S₁.indep hX) hXnonempty,
    have hxspace := mem_space_iff.2 ⟨X, hX, hx.1⟩,
    rw [hspace, combi_interiors_cover, mem_bUnion_iff] at hxspace,
    obtain ⟨Y, hY, hxY⟩ := hxspace,
    use [Y, hY],
    rw ←closure_combi_interior_eq_convex_hull (S₁.indep hX),
    apply closure_minimal _ is_closed_convex_hull,
    rintro x' hx',
    have hxspace := mem_space_iff.2 ⟨X, hX, hx'.1⟩,
    rw [hspace, combi_interiors_cover, mem_bUnion_iff] at hxspace,
    obtain ⟨Y', hY', hxY'⟩ := hxspace,
    suffices hYY' : Y = Y',
    { rw hYY',
      exact hxY'.1 },
    obtain ⟨F, hF, hinterior⟩ := hpartition hY,
    obtain ⟨F', hF', hinterior'⟩ := hpartition hY',
    apply disjoint_interiors hY hY' (_ : x ∈ _) _,
    { rw [hinterior, mem_bUnion_iff] at ⊢ hxY,
      obtain ⟨Z, hZ, hxZ⟩ := hxY,
      use [Z, hZ, hxZ] },
    { rw [hinterior', mem_bUnion_iff] at ⊢ hxY',
      obtain ⟨Z, hZ, hxZ⟩ := hxY',
      use [Z, hZ],
      rw ←disjoint_interiors hX (hF' hZ) hx' hxZ,
      exact hx }}
end

instance : partial_order (simplicial_complex E) :=
{ le := λ S₁ S₂, S₁ ≤ S₂,
  le_refl := (λ S, ⟨rfl, (λ X hX, ⟨X, hX, subset.refl _⟩)⟩),
  le_trans := begin
    rintro S₁ S₂ S₃ h₁₂ h₂₃,
    use eq.trans h₁₂.1 h₂₃.1,
    rintro X₁ hX₁,
    obtain ⟨X₂, hX₂, hX₁₂⟩ := h₁₂.2 hX₁,
    obtain ⟨X₃, hX₃, hX₂₃⟩ := h₂₃.2 hX₂,
    exact ⟨X₃, hX₃, subset.trans hX₁₂ hX₂₃⟩,
  end,
  le_antisymm := begin
    suffices aux_lemma : ∀ {S₁ S₂ : simplicial_complex E}, S₁ ≤ S₂ → S₂ ≤ S₁ → ∀ {X},
      X ∈ S₁.faces → X ∈ S₂.faces,
    { rintro S₁ S₂ h₁ h₂,
      ext X,
      exact ⟨λ hX, aux_lemma h₁ h₂ hX, λ hX, aux_lemma h₂ h₁ hX⟩ },
    rintro S₁ S₂ h₁ h₂ X hX,
    rw subdivision_iff_partition at h₂ h₁,
    cases finset.eq_empty_or_nonempty X with hXempty hXnonempty,
    { rw hXempty,
      exact empty_mem_faces_of_nonempty (h₁.1 ⟨X, hX⟩) },
    obtain ⟨x, hxX⟩ := nonempty_combi_interior_of_nonempty (S₁.indep hX) hXnonempty,
    obtain ⟨F, hF, hFX⟩ := h₂.2.2 hX,
    have hxX' := hxX,
    rw [hFX, mem_bUnion_iff] at hxX',
    obtain ⟨Y, hY, hxY⟩ := hxX',
    obtain ⟨F', hF', hF'Y⟩ := h₁.2.2 (hF hY),
    rw [hF'Y, mem_bUnion_iff] at hxY,
    obtain ⟨Z, hZ, hxZ⟩ := hxY,
    have := disjoint_interiors hX (hF' hZ) hxX hxZ,
    subst this,
    suffices h : X = Y,
    { rw h,
      exact hF hY },
    apply combi_interior.inj (S₁.indep hX) (S₂.indep (hF hY)) (subset.antisymm _ _),
    { rw hF'Y,
      exact subset_bUnion_of_mem hZ },
    { rw hFX,
      exact subset_bUnion_of_mem hY }
  end }

/-def simplicial_complex.mesh_size (S : simplicial_complex E) : ℝ := sorry --max diameter of simplices

def barycentrisation : list (fin m → ℝ) → fin m → ℝ :=
  λ L,

def simplicial_complex.barycentric_subdivision (S : simplicial_complex E) : simplicial_complex E :=
{ faces := {X | ∃ {L : list (fin m → ℝ)}, list.to_finset L ∈ S.faces ∧ X = },
  indep := _,
  down_closed := _,
  disjoint := _ }-/