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

/-!
# Theory of univariate polynomials

The definitions include
`degree`, `monic`, `leading_coeff`

Results include
- `degree_mul` : The degree of the product is the sum of degrees
- `leading_coeff_add_of_degree_eq` and `leading_coeff_add_of_degree_lt` :
    The leading_coefficient of a sum is determined by the leading coefficients and degrees
-/

noncomputable theory

open finsupp finset
open_locale big_operators classical polynomial

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b c d : R} {n m : ℕ}

section semiring
variables [semiring R] {p q r : R[X]}

/-- `degree p` is the degree of the polynomial `p`, i.e. the largest `X`-exponent in `p`.
`degree p = some n` when `p ≠ 0` and `n` is the highest power of `X` that appears in `p`, otherwise
`degree 0 = ⊥`. -/
def degree (p : R[X]) : with_bot ℕ := p.support.sup some

lemma degree_lt_wf : well_founded (λp q : R[X], degree p < degree q) :=
inv_image.wf degree (with_bot.well_founded_lt nat.lt_wf)

instance : has_well_founded R[X] := ⟨_, degree_lt_wf⟩

/-- `nat_degree p` forces `degree p` to ℕ, by defining nat_degree 0 = 0. -/
def nat_degree (p : R[X]) : ℕ := (degree p).get_or_else 0

/-- `leading_coeff p` gives the coefficient of the highest power of `X` in `p`-/
def leading_coeff (p : R[X]) : R := coeff p (nat_degree p)

/-- a polynomial is `monic` if its leading coefficient is 1 -/
def monic (p : R[X]) := leading_coeff p = (1 : R)

@[nontriviality] lemma monic_of_subsingleton [subsingleton R] (p : R[X]) : monic p :=
subsingleton.elim _ _

lemma monic.def : monic p ↔ leading_coeff p = 1 := iff.rfl

instance monic.decidable [decidable_eq R] : decidable (monic p) :=
by unfold monic; apply_instance

@[simp] lemma monic.leading_coeff {p : R[X]} (hp : p.monic) :
  leading_coeff p = 1 := hp

lemma monic.coeff_nat_degree {p : R[X]} (hp : p.monic) : p.coeff p.nat_degree = 1 := hp

@[simp] lemma degree_zero : degree (0 : R[X]) = ⊥ := rfl

@[simp] lemma nat_degree_zero : nat_degree (0 : R[X]) = 0 := rfl

@[simp] lemma coeff_nat_degree : coeff p (nat_degree p) = leading_coeff p := rfl

lemma degree_eq_bot : degree p = ⊥ ↔ p = 0 :=
⟨λ h, by rw [degree, ← max_eq_sup_with_bot] at h;
  exact support_eq_empty.1 (max_eq_none.1 h),
λ h, h.symm ▸ rfl⟩

@[nontriviality] lemma degree_of_subsingleton [subsingleton R] : degree p = ⊥ :=
by rw [subsingleton.elim p 0, degree_zero]

@[nontriviality] lemma nat_degree_of_subsingleton [subsingleton R] : nat_degree p = 0 :=
by rw [subsingleton.elim p 0, nat_degree_zero]

lemma degree_eq_nat_degree (hp : p ≠ 0) : degree p = (nat_degree p : with_bot ℕ) :=
let ⟨n, hn⟩ :=
  not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt degree_eq_bot.1 hp)) in
have hn : degree p = some n := not_not.1 hn,
by rw [nat_degree, hn]; refl

lemma degree_eq_iff_nat_degree_eq {p : R[X]} {n : ℕ} (hp : p ≠ 0) :
  p.degree = n ↔ p.nat_degree = n :=
by rw [degree_eq_nat_degree hp, with_bot.coe_eq_coe]

lemma degree_eq_iff_nat_degree_eq_of_pos {p : R[X]} {n : ℕ} (hn : 0 < n) :
  p.degree = n ↔ p.nat_degree = n :=
begin
  split,
  { intro H, rwa ← degree_eq_iff_nat_degree_eq, rintro rfl,
    rw degree_zero at H, exact option.no_confusion H },
  { intro H, rwa degree_eq_iff_nat_degree_eq, rintro rfl,
    rw nat_degree_zero at H, rw H at hn, exact lt_irrefl _ hn }
end

lemma nat_degree_eq_of_degree_eq_some {p : R[X]} {n : ℕ}
  (h : degree p = n) : nat_degree p = n :=
have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h,
option.some_inj.1 $ show (nat_degree p : with_bot ℕ) = n,
  by rwa [← degree_eq_nat_degree hp0]

@[simp] lemma degree_le_nat_degree : degree p ≤ nat_degree p :=
with_bot.gi_get_or_else_bot.gc.le_u_l _

lemma nat_degree_eq_of_degree_eq [semiring S] {q : S[X]} (h : degree p = degree q) :
  nat_degree p = nat_degree q :=
by unfold nat_degree; rw h

lemma le_degree_of_ne_zero (h : coeff p n ≠ 0) : (n : with_bot ℕ) ≤ degree p :=
show @has_le.le (with_bot ℕ) _ (some n : with_bot ℕ) (p.support.sup some : with_bot ℕ),
from finset.le_sup (mem_support_iff.2 h)

lemma le_nat_degree_of_ne_zero (h : coeff p n ≠ 0) : n ≤ nat_degree p :=
begin
  rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree],
  exact le_degree_of_ne_zero h,
  { assume h, subst h, exact h rfl }
end

lemma le_nat_degree_of_mem_supp (a : ℕ) :
  a ∈ p.support → a ≤ nat_degree p:=
le_nat_degree_of_ne_zero ∘ mem_support_iff.mp

lemma degree_mono [semiring S] {f : R[X]} {g : S[X]}
  (h : f.support ⊆ g.support) : f.degree ≤ g.degree := finset.sup_mono h

lemma supp_subset_range (h : nat_degree p < m) : p.support ⊆ finset.range m :=
λ n hn, mem_range.2 $ (le_nat_degree_of_mem_supp _ hn).trans_lt h

lemma supp_subset_range_nat_degree_succ : p.support ⊆ finset.range (nat_degree p + 1) :=
supp_subset_range (nat.lt_succ_self _)

lemma degree_le_degree (h : coeff q (nat_degree p) ≠ 0) : degree p ≤ degree q :=
begin
  by_cases hp : p = 0,
  { rw hp, exact bot_le },
  { rw degree_eq_nat_degree hp, exact le_degree_of_ne_zero h }
end

lemma degree_ne_of_nat_degree_ne {n : ℕ} :
  p.nat_degree ≠ n → degree p ≠ n :=
mt $ λ h, by rw [nat_degree, h, option.get_or_else_coe]

theorem nat_degree_le_iff_degree_le {n : ℕ} : nat_degree p ≤ n ↔ degree p ≤ n :=
with_bot.get_or_else_bot_le_iff

alias polynomial.nat_degree_le_iff_degree_le ↔ . .

lemma nat_degree_le_nat_degree [semiring S] {q : S[X]} (hpq : p.degree ≤ q.degree) :
  p.nat_degree ≤ q.nat_degree :=
with_bot.gi_get_or_else_bot.gc.monotone_l hpq

@[simp] lemma degree_C (ha : a ≠ 0) : degree (C a) = (0 : with_bot ℕ) :=
by { rw [degree, ← monomial_zero_left, support_monomial 0 _ ha, sup_singleton], refl }

lemma degree_C_le : degree (C a) ≤ 0 :=
by by_cases h : a = 0; [rw [h, C_0], rw [degree_C h]]; [exact bot_le, exact le_rfl]

lemma degree_C_lt : degree (C a) < 1 := degree_C_le.trans_lt $ with_bot.coe_lt_coe.mpr zero_lt_one

lemma degree_one_le : degree (1 : R[X]) ≤ (0 : with_bot ℕ) :=
by rw [← C_1]; exact degree_C_le

@[simp] lemma nat_degree_C (a : R) : nat_degree (C a) = 0 :=
begin
  by_cases ha : a = 0,
  { have : C a = 0, { rw [ha, C_0] },
    rw [nat_degree, degree_eq_bot.2 this],
    refl },
  { rw [nat_degree, degree_C ha], refl }
end

@[simp] lemma nat_degree_one : nat_degree (1 : R[X]) = 0 := nat_degree_C 1

@[simp] lemma nat_degree_nat_cast (n : ℕ) : nat_degree (n : R[X]) = 0 :=
by simp only [←C_eq_nat_cast, nat_degree_C]

@[simp] lemma degree_monomial (n : ℕ) (ha : a ≠ 0) : degree (monomial n a) = n :=
by rw [degree, support_monomial _ _ ha]; refl

@[simp] lemma degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) : degree (C a * X ^ n) = n :=
by rw [← monomial_eq_C_mul_X, degree_monomial n ha]

lemma degree_C_mul_X (ha : a ≠ 0) : degree (C a * X) = 1 :=
by simpa only [pow_one] using degree_C_mul_X_pow 1 ha

lemma degree_monomial_le (n : ℕ) (a : R) : degree (monomial n a) ≤ n :=
if h : a = 0 then by rw [h, (monomial n).map_zero]; exact bot_le else le_of_eq (degree_monomial n h)

lemma degree_C_mul_X_pow_le (n : ℕ) (a : R) : degree (C a * X ^ n) ≤ n :=
by { rw C_mul_X_pow_eq_monomial, apply degree_monomial_le }

lemma degree_C_mul_X_le (a : R) : degree (C a * X) ≤ 1 :=
by simpa only [pow_one] using degree_C_mul_X_pow_le 1 a

@[simp] lemma nat_degree_C_mul_X_pow (n : ℕ) (a : R) (ha : a ≠ 0) : nat_degree (C a * X ^ n) = n :=
nat_degree_eq_of_degree_eq_some (degree_C_mul_X_pow n ha)

@[simp] lemma nat_degree_C_mul_X (a : R) (ha : a ≠ 0) : nat_degree (C a * X) = 1 :=
by simpa only [pow_one] using nat_degree_C_mul_X_pow 1 a ha

@[simp] lemma nat_degree_monomial [decidable_eq R] (i : ℕ) (r : R)  :
  nat_degree (monomial i r) = if r = 0 then 0 else i :=
begin
  split_ifs with hr,
  { simp [hr] },
  { rw [← C_mul_X_pow_eq_monomial, nat_degree_C_mul_X_pow i r hr] }
end

lemma coeff_eq_zero_of_degree_lt (h : degree p < n) : coeff p n = 0 :=
not_not.1 (mt le_degree_of_ne_zero (not_le_of_gt h))

lemma coeff_eq_zero_of_nat_degree_lt {p : R[X]} {n : ℕ} (h : p.nat_degree < n) :
  p.coeff n = 0 :=
begin
  apply coeff_eq_zero_of_degree_lt,
  by_cases hp : p = 0,
  { subst hp, exact with_bot.bot_lt_coe n },
  { rwa [degree_eq_nat_degree hp, with_bot.coe_lt_coe] }
end

@[simp] lemma coeff_nat_degree_succ_eq_zero {p : R[X]} : p.coeff (p.nat_degree + 1) = 0 :=
coeff_eq_zero_of_nat_degree_lt (lt_add_one _)

-- We need the explicit `decidable` argument here because an exotic one shows up in a moment!
lemma ite_le_nat_degree_coeff (p : R[X]) (n : ℕ) (I : decidable (n < 1 + nat_degree p)) :
  @ite _ (n < 1 + nat_degree p) I (coeff p n) 0 = coeff p n :=
begin
  split_ifs,
  { refl },
  { exact (coeff_eq_zero_of_nat_degree_lt (not_le.1 (λ w, h (nat.lt_one_add_iff.2 w)))).symm, }
end

lemma as_sum_support (p : R[X]) :
  p = ∑ i in p.support, monomial i (p.coeff i) :=
(sum_monomial_eq p).symm

lemma as_sum_support_C_mul_X_pow (p : R[X]) :
  p = ∑ i in p.support, C (p.coeff i) * X^i :=
trans p.as_sum_support $ by simp only [C_mul_X_pow_eq_monomial]

/--
We can reexpress a sum over `p.support` as a sum over `range n`,
for any `n` satisfying `p.nat_degree < n`.
-/
lemma sum_over_range' [add_comm_monoid S] (p : R[X]) {f : ℕ → R → S} (h : ∀ n, f n 0 = 0)
  (n : ℕ) (w : p.nat_degree < n) :
  p.sum f = ∑ (a : ℕ) in range n, f a (coeff p a) :=
begin
  rcases p,
  have := supp_subset_range w,
  simp only [polynomial.sum, support, coeff, nat_degree, degree] at ⊢ this,
  exact finsupp.sum_of_support_subset _ this _ (λ n hn, h n)
end

/--
We can reexpress a sum over `p.support` as a sum over `range (p.nat_degree + 1)`.
-/
lemma sum_over_range [add_comm_monoid S] (p : R[X]) {f : ℕ → R → S} (h : ∀ n, f n 0 = 0) :
  p.sum f = ∑ (a : ℕ) in range (p.nat_degree + 1), f a (coeff p a) :=
sum_over_range' p h (p.nat_degree + 1) (lt_add_one _)

lemma as_sum_range' (p : R[X]) (n : ℕ) (w : p.nat_degree < n) :
  p = ∑ i in range n, monomial i (coeff p i) :=
p.sum_monomial_eq.symm.trans $ p.sum_over_range' monomial_zero_right _ w

lemma as_sum_range (p : R[X]) :
  p = ∑ i in range (p.nat_degree + 1), monomial i (coeff p i) :=
p.sum_monomial_eq.symm.trans $ p.sum_over_range $ monomial_zero_right

lemma as_sum_range_C_mul_X_pow (p : R[X]) :
  p = ∑ i in range (p.nat_degree + 1), C (coeff p i) * X ^ i :=
p.as_sum_range.trans $ by simp only [C_mul_X_pow_eq_monomial]

lemma coeff_ne_zero_of_eq_degree (hn : degree p = n) :
  coeff p n ≠ 0 :=
λ h, mem_support_iff.mp (mem_of_max hn) h

lemma eq_X_add_C_of_degree_le_one (h : degree p ≤ 1) :
  p = C (p.coeff 1) * X + C (p.coeff 0) :=
ext (λ n, nat.cases_on n (by simp)
  (λ n, nat.cases_on n (by simp [coeff_C])
    (λ m, have degree p < m.succ.succ, from lt_of_le_of_lt h dec_trivial,
      by simp [coeff_eq_zero_of_degree_lt this, coeff_C, nat.succ_ne_zero, coeff_X,
        nat.succ_inj', @eq_comm ℕ 0])))

lemma eq_X_add_C_of_degree_eq_one (h : degree p = 1) :
  p = C (p.leading_coeff) * X + C (p.coeff 0) :=
(eq_X_add_C_of_degree_le_one (show degree p ≤ 1, from h ▸ le_rfl)).trans
  (by simp [leading_coeff, nat_degree_eq_of_degree_eq_some h])

lemma eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
  p = C (p.coeff 1) * X + C (p.coeff 0) :=
eq_X_add_C_of_degree_le_one $ degree_le_of_nat_degree_le h

lemma exists_eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
  ∃ a b, p = C a * X + C b :=
⟨p.coeff 1, p.coeff 0, eq_X_add_C_of_nat_degree_le_one h⟩

theorem degree_X_pow_le (n : ℕ) : degree (X^n : R[X]) ≤ n :=
by simpa only [C_1, one_mul] using degree_C_mul_X_pow_le n (1:R)

theorem degree_X_le : degree (X : R[X]) ≤ 1 :=
degree_monomial_le _ _

lemma nat_degree_X_le : (X : R[X]).nat_degree ≤ 1 :=
nat_degree_le_of_degree_le degree_X_le

lemma support_C_mul_X_pow (c : R) (n : ℕ) : (C c * X ^ n).support ⊆ singleton n :=
begin
  rw [C_mul_X_pow_eq_monomial],
  exact support_monomial' _ _
end

lemma mem_support_C_mul_X_pow {n a : ℕ} {c : R} (h : a ∈ (C c * X ^ n).support) : a = n :=
mem_singleton.1 $ support_C_mul_X_pow _ _ h

lemma card_support_C_mul_X_pow_le_one {c : R} {n : ℕ} : (C c * X ^ n).support.card ≤ 1 :=
begin
  rw ← card_singleton n,
  apply card_le_of_subset (support_C_mul_X_pow c n),
end

lemma card_supp_le_succ_nat_degree (p : R[X]) : p.support.card ≤ p.nat_degree + 1 :=
begin
  rw ← finset.card_range (p.nat_degree + 1),
  exact finset.card_le_of_subset supp_subset_range_nat_degree_succ,
end

lemma le_degree_of_mem_supp (a : ℕ) :
  a ∈ p.support → ↑a ≤ degree p :=
le_degree_of_ne_zero ∘ mem_support_iff.mp

lemma nonempty_support_iff : p.support.nonempty ↔ p ≠ 0 :=
by rw [ne.def, nonempty_iff_ne_empty, ne.def, ← support_eq_empty]

lemma support_C_mul_X_pow_nonzero {c : R} {n : ℕ} (h : c ≠ 0) :
  (C c * X ^ n).support = singleton n :=
begin
  rw [C_mul_X_pow_eq_monomial],
  exact support_monomial _ _ h
end

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : R[X]}

@[simp] lemma degree_one : degree (1 : R[X]) = (0 : with_bot ℕ) :=
degree_C (show (1 : R) ≠ 0, from zero_ne_one.symm)

@[simp] lemma degree_X : degree (X : R[X]) = 1 :=
degree_monomial _ one_ne_zero

@[simp] lemma nat_degree_X : (X : R[X]).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some degree_X

end nonzero_semiring

section ring
variables [ring R]

lemma coeff_mul_X_sub_C {p : R[X]} {r : R} {a : ℕ} :
  coeff (p * (X - C r)) (a + 1) = coeff p a - coeff p (a + 1) * r :=
by simp [mul_sub]

@[simp] lemma degree_neg (p : R[X]) : degree (-p) = degree p :=
by unfold degree; rw support_neg

@[simp] lemma nat_degree_neg (p : R[X]) : nat_degree (-p) = nat_degree p :=
by simp [nat_degree]

@[simp] lemma nat_degree_int_cast (n : ℤ) : nat_degree (n : R[X]) = 0 :=
by simp only [←C_eq_int_cast, nat_degree_C]

end ring

section semiring
variables [semiring R]

/-- The second-highest coefficient, or 0 for constants -/
def next_coeff (p : R[X]) : R :=
if p.nat_degree = 0 then 0 else p.coeff (p.nat_degree - 1)

@[simp]
lemma next_coeff_C_eq_zero (c : R) :
  next_coeff (C c) = 0 := by { rw next_coeff, simp }

lemma next_coeff_of_pos_nat_degree (p : R[X]) (hp : 0 < p.nat_degree) :
  next_coeff p = p.coeff (p.nat_degree - 1) :=
by { rw [next_coeff, if_neg], contrapose! hp, simpa }

variables {p q : R[X]} {ι : Type*}

lemma coeff_nat_degree_eq_zero_of_degree_lt (h : degree p < degree q) :
  coeff p (nat_degree q) = 0 :=
coeff_eq_zero_of_degree_lt (lt_of_lt_of_le h degree_le_nat_degree)

lemma ne_zero_of_degree_gt {n : with_bot ℕ} (h : n < degree p) : p ≠ 0 :=
mt degree_eq_bot.2 (ne.symm (ne_of_lt (lt_of_le_of_lt bot_le h)))

lemma ne_zero_of_degree_ge_degree (hpq : p.degree ≤ q.degree) (hp : p ≠ 0) : q ≠ 0 :=
polynomial.ne_zero_of_degree_gt (lt_of_lt_of_le (bot_lt_iff_ne_bot.mpr
  (by rwa [ne.def, polynomial.degree_eq_bot])) hpq : q.degree > ⊥)

lemma ne_zero_of_nat_degree_gt {n : ℕ} (h : n < nat_degree p) : p ≠ 0 :=
λ H, by simpa [H, nat.not_lt_zero] using h

lemma degree_lt_degree (h : nat_degree p < nat_degree q) : degree p < degree q :=
begin
  by_cases hp : p = 0,
  { simp [hp],
    rw bot_lt_iff_ne_bot,
    intro hq,
    simpa [hp, degree_eq_bot.mp hq, lt_irrefl] using h },
  { rw [degree_eq_nat_degree hp, degree_eq_nat_degree $ ne_zero_of_nat_degree_gt h],
    exact_mod_cast h }
end

lemma nat_degree_lt_nat_degree_iff (hp : p ≠ 0) :
  nat_degree p < nat_degree q ↔ degree p < degree q :=
⟨degree_lt_degree, begin
  intro h,
  have hq : q ≠ 0 := ne_zero_of_degree_gt h,
  rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq] at h,
  exact_mod_cast h
end⟩

lemma eq_C_of_degree_le_zero (h : degree p ≤ 0) : p = C (coeff p 0) :=
begin
  ext (_|n), { simp },
  rw [coeff_C, if_neg (nat.succ_ne_zero _), coeff_eq_zero_of_degree_lt],
  exact h.trans_lt (with_bot.some_lt_some.2 n.succ_pos),
end

lemma eq_C_of_degree_eq_zero (h : degree p = 0) : p = C (coeff p 0) :=
eq_C_of_degree_le_zero (h ▸ le_rfl)

lemma degree_le_zero_iff : degree p ≤ 0 ↔ p = C (coeff p 0) :=
⟨eq_C_of_degree_le_zero, λ h, h.symm ▸ degree_C_le⟩

lemma degree_add_le (p q : R[X]) : degree (p + q) ≤ max (degree p) (degree q) :=
calc degree (p + q) = ((p + q).support).sup some : rfl
  ... ≤ (p.support ∪ q.support).sup some : sup_mono support_add
  ... = p.support.sup some ⊔ q.support.sup some : sup_union

lemma degree_add_le_of_degree_le {p q : R[X]} {n : ℕ} (hp : degree p ≤ n)
  (hq : degree q ≤ n) : degree (p + q) ≤ n :=
(degree_add_le p q).trans $ max_le hp hq

lemma nat_degree_add_le (p q : R[X]) :
  nat_degree (p + q) ≤ max (nat_degree p) (nat_degree q) :=
begin
  cases le_max_iff.1 (degree_add_le p q);
  simp [nat_degree_le_nat_degree h]
end

lemma nat_degree_add_le_of_degree_le {p q : R[X]} {n : ℕ} (hp : nat_degree p ≤ n)
  (hq : nat_degree q ≤ n) : nat_degree (p + q) ≤ n :=
(nat_degree_add_le p q).trans $ max_le hp hq

@[simp] lemma leading_coeff_zero : leading_coeff (0 : R[X]) = 0 := rfl

@[simp] lemma leading_coeff_eq_zero : leading_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction $ λ hp, mt mem_support_iff.1
  (not_not.2 h) (mem_of_max (degree_eq_nat_degree hp)),
λ h, h.symm ▸ leading_coeff_zero⟩

lemma leading_coeff_ne_zero : leading_coeff p ≠ 0 ↔ p ≠ 0 :=
by rw [ne.def, leading_coeff_eq_zero]

lemma leading_coeff_eq_zero_iff_deg_eq_bot : leading_coeff p = 0 ↔ degree p = ⊥ :=
by rw [leading_coeff_eq_zero, degree_eq_bot]

lemma nat_degree_mem_support_of_nonzero (H : p ≠ 0) : p.nat_degree ∈ p.support :=
by { rw mem_support_iff, exact (not_congr leading_coeff_eq_zero).mpr H }

lemma nat_degree_eq_support_max' (h : p ≠ 0) :
  p.nat_degree = p.support.max' (nonempty_support_iff.mpr h) :=
(le_max' _ _ $ nat_degree_mem_support_of_nonzero h).antisymm $
  max'_le _ _ _ le_nat_degree_of_mem_supp

lemma nat_degree_C_mul_X_pow_le (a : R) (n : ℕ) : nat_degree (C a * X ^ n) ≤ n :=
nat_degree_le_iff_degree_le.2 $ degree_C_mul_X_pow_le _ _

lemma degree_add_eq_left_of_degree_lt (h : degree q < degree p) : degree (p + q) = degree p :=
le_antisymm (max_eq_left_of_lt h ▸ degree_add_le _ _) $ degree_le_degree $
  begin
    rw [coeff_add, coeff_nat_degree_eq_zero_of_degree_lt h, add_zero],
    exact mt leading_coeff_eq_zero.1 (ne_zero_of_degree_gt h)
  end

lemma degree_add_eq_right_of_degree_lt (h : degree p < degree q) : degree (p + q) = degree q :=
by rw [add_comm, degree_add_eq_left_of_degree_lt h]

lemma nat_degree_add_eq_left_of_nat_degree_lt (h : nat_degree q < nat_degree p) :
  nat_degree (p + q) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_add_eq_left_of_degree_lt (degree_lt_degree h))

lemma nat_degree_add_eq_right_of_nat_degree_lt (h : nat_degree p < nat_degree q) :
  nat_degree (p + q) = nat_degree q :=
nat_degree_eq_of_degree_eq (degree_add_eq_right_of_degree_lt (degree_lt_degree h))

lemma degree_add_C (hp : 0 < degree p) : degree (p + C a) = degree p :=
add_comm (C a) p ▸ degree_add_eq_right_of_degree_lt $ lt_of_le_of_lt degree_C_le hp

lemma degree_add_eq_of_leading_coeff_add_ne_zero (h : leading_coeff p + leading_coeff q ≠ 0) :
  degree (p + q) = max p.degree q.degree :=
le_antisymm (degree_add_le _ _) $
  match lt_trichotomy (degree p) (degree q) with
  | or.inl hlt :=
    by rw [degree_add_eq_right_of_degree_lt hlt, max_eq_right_of_lt hlt]; exact le_rfl
  | or.inr (or.inl heq) :=
    le_of_not_gt $
      assume hlt : max (degree p) (degree q) > degree (p + q),
      h $ show leading_coeff p + leading_coeff q = 0,
      begin
        rw [heq, max_self] at hlt,
        rw [leading_coeff, leading_coeff, nat_degree_eq_of_degree_eq heq, ← coeff_add],
        exact coeff_nat_degree_eq_zero_of_degree_lt hlt
      end
  | or.inr (or.inr hlt) :=
    by rw [degree_add_eq_left_of_degree_lt hlt, max_eq_left_of_lt hlt]; exact le_rfl
  end

lemma degree_erase_le (p : R[X]) (n : ℕ) : degree (p.erase n) ≤ degree p :=
by { rcases p, simp only [erase, degree, coeff, support], convert sup_mono (erase_subset _ _) }

lemma degree_erase_lt (hp : p ≠ 0) : degree (p.erase (nat_degree p)) < degree p :=
begin
  apply lt_of_le_of_ne (degree_erase_le _ _),
  rw [degree_eq_nat_degree hp, degree, support_erase],
  exact λ h, not_mem_erase _ _ (mem_of_max h),
end

lemma degree_update_le (p : R[X]) (n : ℕ) (a : R) :
  degree (p.update n a) ≤ max (degree p) n :=
begin
  simp only [degree, coeff_update_apply, le_max_iff, finset.sup_le_iff, mem_support_iff],
  intros b hb,
  split_ifs at hb with h,
  { subst b,
    exact or.inr le_rfl },
  { exact or.inl (le_degree_of_ne_zero hb) }
end

lemma degree_sum_le (s : finset ι) (f : ι → R[X]) :
  degree (∑ i in s, f i) ≤ s.sup (λ b, degree (f b)) :=
finset.induction_on s (by simp only [sum_empty, sup_empty, degree_zero, le_refl]) $
  assume a s has ih,
  calc degree (∑ i in insert a s, f i) ≤ max (degree (f a)) (degree (∑ i in s, f i)) :
    by rw sum_insert has; exact degree_add_le _ _
  ... ≤ _ : by rw [sup_insert, sup_eq_max]; exact max_le_max le_rfl ih

lemma degree_mul_le (p q : R[X]) : degree (p * q) ≤ degree p + degree q :=
calc degree (p * q) ≤ (p.support).sup (λi, degree (sum q (λj a, C (coeff p i * a) * X ^ (i + j)))) :
    begin
      simp only [monomial_eq_C_mul_X.symm],
      convert degree_sum_le _ _,
      exact mul_eq_sum_sum
    end
  ... ≤ p.support.sup (λi, q.support.sup (λj, degree (C (coeff p i * coeff q j) * X ^ (i + j)))) :
    finset.sup_mono_fun (assume i hi,  degree_sum_le _ _)
  ... ≤ degree p + degree q :
    begin
      refine finset.sup_le (λ a ha, finset.sup_le (λ b hb, le_trans (degree_C_mul_X_pow_le _ _) _)),
      rw [with_bot.coe_add],
      rw mem_support_iff at ha hb,
      exact add_le_add (le_degree_of_ne_zero ha) (le_degree_of_ne_zero hb)
    end

lemma degree_pow_le (p : R[X]) : ∀ (n : ℕ), degree (p ^ n) ≤ n • (degree p)
| 0     := by rw [pow_zero, zero_nsmul]; exact degree_one_le
| (n+1) := calc degree (p ^ (n + 1)) ≤ degree p + degree (p ^ n) :
    by rw pow_succ; exact degree_mul_le _ _
  ... ≤ _ : by rw succ_nsmul; exact add_le_add le_rfl (degree_pow_le _)

@[simp] lemma leading_coeff_monomial (a : R) (n : ℕ) : leading_coeff (monomial n a) = a :=
begin
  by_cases ha : a = 0,
  { simp only [ha, (monomial n).map_zero, leading_coeff_zero] },
  { rw [leading_coeff, nat_degree_monomial, if_neg ha, coeff_monomial], simp }
end

lemma leading_coeff_C_mul_X_pow (a : R) (n : ℕ) : leading_coeff (C a * X ^ n) = a :=
by rw [C_mul_X_pow_eq_monomial, leading_coeff_monomial]

lemma leading_coeff_C_mul_X (a : R) : leading_coeff (C a * X) = a :=
by simpa only [pow_one] using leading_coeff_C_mul_X_pow a 1

@[simp]

@[simp] lemma leading_coeff_X_pow (n : ℕ) : leading_coeff ((X : R[X]) ^ n) = 1 :=
by simpa only [C_1, one_mul] using leading_coeff_C_mul_X_pow (1 : R) n

@[simp] lemma leading_coeff_X : leading_coeff (X : R[X]) = 1 :=
by simpa only [pow_one] using @leading_coeff_X_pow R _ 1

@[simp] lemma monic_X_pow (n : ℕ) : monic (X ^ n : R[X]) := leading_coeff_X_pow n

@[simp] lemma monic_X : monic (X : R[X]) := leading_coeff_X

@[simp] lemma leading_coeff_one : leading_coeff (1 : R[X]) = 1 :=
leading_coeff_C 1

@[simp] lemma monic_one : monic (1 : R[X]) := leading_coeff_C _

lemma monic.ne_zero {R : Type*} [semiring R] [nontrivial R] {p : R[X]} (hp : p.monic) :
  p ≠ 0 :=
by { rintro rfl, simpa [monic] using hp }

lemma monic.ne_zero_of_ne (h : (0:R) ≠ 1) {p : R[X]} (hp : p.monic) :
  p ≠ 0 :=
by { nontriviality R, exact hp.ne_zero }

lemma monic.ne_zero_of_polynomial_ne {r} (hp : monic p) (hne : q ≠ r) : p ≠ 0 :=
by { haveI := nontrivial.of_polynomial_ne hne, exact hp.ne_zero }

lemma leading_coeff_add_of_degree_lt (h : degree p < degree q) :
  leading_coeff (p + q) = leading_coeff q :=
have coeff p (nat_degree q) = 0, from coeff_nat_degree_eq_zero_of_degree_lt h,
by simp only [leading_coeff, nat_degree_eq_of_degree_eq (degree_add_eq_right_of_degree_lt h),
  this, coeff_add, zero_add]

lemma leading_coeff_add_of_degree_eq (h : degree p = degree q)
  (hlc : leading_coeff p + leading_coeff q ≠ 0) :
  leading_coeff (p + q) = leading_coeff p + leading_coeff q :=
have nat_degree (p + q) = nat_degree p,
  by apply nat_degree_eq_of_degree_eq;
    rw [degree_add_eq_of_leading_coeff_add_ne_zero hlc, h, max_self],
by simp only [leading_coeff, this, nat_degree_eq_of_degree_eq h, coeff_add]

@[simp] lemma coeff_mul_degree_add_degree (p q : R[X]) :
  coeff (p * q) (nat_degree p + nat_degree q) = leading_coeff p * leading_coeff q :=
calc coeff (p * q) (nat_degree p + nat_degree q) =
    ∑ x in nat.antidiagonal (nat_degree p + nat_degree q),
    coeff p x.1 * coeff q x.2 : coeff_mul _ _ _
... = coeff p (nat_degree p) * coeff q (nat_degree q) :
  begin
    refine finset.sum_eq_single (nat_degree p, nat_degree q) _ _,
    { rintro ⟨i,j⟩ h₁ h₂, rw nat.mem_antidiagonal at h₁,
      by_cases H : nat_degree p < i,
      { rw [coeff_eq_zero_of_degree_lt
          (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 H)), zero_mul] },
      { rw not_lt_iff_eq_or_lt at H, cases H,
        { subst H, rw add_left_cancel_iff at h₁, dsimp at h₁, subst h₁, exfalso, exact h₂ rfl },
        { suffices : nat_degree q < j,
          { rw [coeff_eq_zero_of_degree_lt
              (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 this)), mul_zero] },
          { by_contra H', rw not_lt at H',
            exact ne_of_lt (nat.lt_of_lt_of_le
              (nat.add_lt_add_right H j) (nat.add_le_add_left H' _)) h₁ } } } },
    { intro H, exfalso, apply H, rw nat.mem_antidiagonal }
  end

lemma degree_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  degree (p * q) = degree p + degree q :=
have hp : p ≠ 0 := by refine mt _ h; exact λ hp, by rw [hp, leading_coeff_zero, zero_mul],
have hq : q ≠ 0 := by refine mt _ h; exact λ hq, by rw [hq, leading_coeff_zero, mul_zero],
le_antisymm (degree_mul_le _ _)
begin
  rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq],
  refine le_degree_of_ne_zero _,
  rwa coeff_mul_degree_add_degree
end

lemma monic.degree_mul (hq : monic q) : degree (p * q) = degree p + degree q :=
if hp : p = 0 then by simp [hp]
else degree_mul' $ by rwa [hq.leading_coeff, mul_one, ne.def, leading_coeff_eq_zero]

lemma nat_degree_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  nat_degree (p * q) = nat_degree p + nat_degree q :=
have hp : p ≠ 0 := mt leading_coeff_eq_zero.2 (λ h₁, h $ by rw [h₁, zero_mul]),
have hq : q ≠ 0 := mt leading_coeff_eq_zero.2 (λ h₁, h $ by rw [h₁, mul_zero]),
nat_degree_eq_of_degree_eq_some $
  by rw [degree_mul' h, with_bot.coe_add, degree_eq_nat_degree hp, degree_eq_nat_degree hq]

lemma leading_coeff_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  leading_coeff (p * q) = leading_coeff p * leading_coeff q :=
begin
  unfold leading_coeff,
  rw [nat_degree_mul' h, coeff_mul_degree_add_degree],
  refl
end

lemma monomial_nat_degree_leading_coeff_eq_self (h : p.support.card ≤ 1) :
  monomial p.nat_degree p.leading_coeff = p :=
begin
  rcases card_support_le_one_iff_monomial.1 h with ⟨n, a, rfl⟩,
  by_cases ha : a = 0;
  simp [ha]
end

lemma C_mul_X_pow_eq_self (h : p.support.card ≤ 1) :
  C p.leading_coeff * X^p.nat_degree = p :=
by rw [C_mul_X_pow_eq_monomial, monomial_nat_degree_leading_coeff_eq_self h]

lemma leading_coeff_pow' : leading_coeff p ^ n ≠ 0 →
  leading_coeff (p ^ n) = leading_coeff p ^ n :=
nat.rec_on n (by simp) $
λ n ih h,
have h₁ : leading_coeff p ^ n ≠ 0 :=
  λ h₁, h $ by rw [pow_succ, h₁, mul_zero],
have h₂ : leading_coeff p * leading_coeff (p ^ n) ≠ 0 :=
  by rwa [pow_succ, ← ih h₁] at h,
by rw [pow_succ, pow_succ, leading_coeff_mul' h₂, ih h₁]

lemma degree_pow' : ∀ {n : ℕ}, leading_coeff p ^ n ≠ 0 →
  degree (p ^ n) = n • (degree p)
| 0     := λ h, by rw [pow_zero, ← C_1] at *;
  rw [degree_C h, zero_nsmul]
| (n+1) := λ h,
have h₁ : leading_coeff p ^ n ≠ 0 := λ h₁, h $
  by rw [pow_succ, h₁, mul_zero],
have h₂ : leading_coeff p * leading_coeff (p ^ n) ≠ 0 :=
  by rwa [pow_succ, ← leading_coeff_pow' h₁] at h,
by rw [pow_succ, degree_mul' h₂, succ_nsmul, degree_pow' h₁]

lemma nat_degree_pow' {n : ℕ} (h : leading_coeff p ^ n ≠ 0) :
  nat_degree (p ^ n) = n * nat_degree p :=
if hp0 : p = 0 then
  if hn0 : n = 0 then by simp *
  else by rw [hp0, zero_pow (nat.pos_of_ne_zero hn0)]; simp
else
have hpn : p ^ n ≠ 0, from λ hpn0,  have h1 : _ := h,
  by rw [← leading_coeff_pow' h1, hpn0, leading_coeff_zero] at h;
  exact h rfl,
option.some_inj.1 $ show (nat_degree (p ^ n) : with_bot ℕ) = (n * nat_degree p : ℕ),
  by rw [← degree_eq_nat_degree hpn, degree_pow' h, degree_eq_nat_degree hp0,
    ← with_bot.coe_nsmul]; simp

theorem leading_coeff_monic_mul {p q : R[X]} (hp : monic p) :
  leading_coeff (p * q) = leading_coeff q :=
begin
  rcases eq_or_ne q 0 with rfl|H,
  { simp },
  { rw [leading_coeff_mul', hp.leading_coeff, one_mul],
    rwa [hp.leading_coeff, one_mul, ne.def, leading_coeff_eq_zero] }
end

theorem leading_coeff_mul_monic {p q : R[X]} (hq : monic q) :
  leading_coeff (p * q) = leading_coeff p :=
decidable.by_cases
  (λ H : leading_coeff p = 0, by rw [H, leading_coeff_eq_zero.1 H, zero_mul, leading_coeff_zero])
  (λ H : leading_coeff p ≠ 0,
    by rw [leading_coeff_mul', hq.leading_coeff, mul_one];
      rwa [hq.leading_coeff, mul_one])

@[simp] theorem leading_coeff_mul_X_pow {p : R[X]} {n : ℕ} :
  leading_coeff (p * X ^ n) = leading_coeff p :=
leading_coeff_mul_monic (monic_X_pow n)

@[simp] theorem leading_coeff_mul_X {p : R[X]} :
  leading_coeff (p * X) = leading_coeff p :=
leading_coeff_mul_monic monic_X

lemma nat_degree_mul_le {p q : R[X]} : nat_degree (p * q) ≤ nat_degree p + nat_degree q :=
begin
  apply nat_degree_le_of_degree_le,
  apply le_trans (degree_mul_le p q),
  rw with_bot.coe_add,
  refine add_le_add _ _; apply degree_le_nat_degree,
end

lemma nat_degree_pow_le {p : R[X]} {n : ℕ} : (p ^ n).nat_degree ≤ n * p.nat_degree :=
begin
  induction n with i hi,
  { simp },
  { rw [pow_succ, nat.succ_mul, add_comm],
    apply le_trans nat_degree_mul_le,
    exact add_le_add_left hi _ }
end

@[simp] lemma coeff_pow_mul_nat_degree (p : R[X]) (n : ℕ) :
  (p ^ n).coeff (n * p.nat_degree) = p.leading_coeff ^ n :=
begin
  induction n with i hi,
  { simp },
  { rw [pow_succ', pow_succ', nat.succ_mul],
    by_cases hp1 : p.leading_coeff ^ i = 0,
    { rw [hp1, zero_mul],
      by_cases hp2 : p ^ i = 0,
      { rw [hp2, zero_mul, coeff_zero] },
      { apply coeff_eq_zero_of_nat_degree_lt,
        have h1 : (p ^ i).nat_degree < i * p.nat_degree,
        { apply lt_of_le_of_ne nat_degree_pow_le (λ h, hp2 _),
          rw [←h, hp1] at hi,
          exact leading_coeff_eq_zero.mp hi },
        calc (p ^ i * p).nat_degree ≤ (p ^ i).nat_degree + p.nat_degree : nat_degree_mul_le
                                ... < i * p.nat_degree + p.nat_degree : add_lt_add_right h1 _ } },
    { rw [←nat_degree_pow' hp1, ←leading_coeff_pow' hp1],
      exact coeff_mul_degree_add_degree _ _ } }
end

lemma subsingleton_of_monic_zero (h : monic (0 : R[X])) :
  (∀ p q : R[X], p = q) ∧ (∀ a b : R, a = b) :=
by rw [monic.def, leading_coeff_zero] at h;
  exact ⟨λ p q, by rw [← mul_one p, ← mul_one q, ← C_1, ← h, C_0, mul_zero, mul_zero],
    λ a b, by rw [← mul_one a, ← mul_one b, ← h, mul_zero, mul_zero]⟩

lemma zero_le_degree_iff {p : R[X]} : 0 ≤ degree p ↔ p ≠ 0 :=
by rw [ne.def, ← degree_eq_bot];
  cases degree p; exact dec_trivial

lemma degree_nonneg_iff_ne_zero : 0 ≤ degree p ↔ p ≠ 0 :=
⟨λ h0p hp0, absurd h0p (by rw [hp0, degree_zero]; exact dec_trivial),
  λ hp0, le_of_not_gt (λ h, by simp [gt, degree_eq_bot, *] at *)⟩

lemma nat_degree_eq_zero_iff_degree_le_zero : p.nat_degree = 0 ↔ p.degree ≤ 0 :=
by rw [← nonpos_iff_eq_zero, nat_degree_le_iff_degree_le, with_bot.coe_zero]

theorem degree_le_iff_coeff_zero (f : R[X]) (n : with_bot ℕ) :
  degree f ≤ n ↔ ∀ m : ℕ, n < m → coeff f m = 0 :=
⟨λ (H : finset.sup (f.support) some ≤ n) m (Hm : n < (m : with_bot ℕ)), decidable.of_not_not $ λ H4,
  have H1 : m ∉ f.support,
    from λ H2, not_lt_of_ge ((finset.sup_le_iff.1 H) m H2 : ((m : with_bot ℕ) ≤ n)) Hm,
  H1 $ mem_support_iff.2 H4,
λ H, finset.sup_le $ λ b Hb, decidable.of_not_not $ λ Hn,
  mem_support_iff.1 Hb $ H b $ lt_of_not_ge Hn⟩

theorem degree_lt_iff_coeff_zero (f : R[X]) (n : ℕ) :
  degree f < n ↔ ∀ m : ℕ, n ≤ m → coeff f m = 0 :=
begin
  refine ⟨λ hf m hm, coeff_eq_zero_of_degree_lt (lt_of_lt_of_le hf (with_bot.coe_le_coe.2 hm)), _⟩,
  simp only [degree, finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff,
    with_bot.some_eq_coe, with_bot.coe_lt_coe, ← @not_le ℕ],
  exact λ h m, mt (h m),
end

lemma degree_smul_le (a : R) (p : R[X]) : degree (a • p) ≤ degree p :=
begin
  apply (degree_le_iff_coeff_zero _ _).2 (λ m hm, _),
  rw degree_lt_iff_coeff_zero at hm,
  simp [hm m le_rfl],
end

lemma nat_degree_smul_le (a : R) (p : R[X]) : nat_degree (a • p) ≤ nat_degree p :=
nat_degree_le_nat_degree (degree_smul_le a p)

lemma degree_lt_degree_mul_X (hp : p ≠ 0) : p.degree < (p * X).degree :=
by haveI := nontrivial.of_polynomial_ne hp; exact
have leading_coeff p * leading_coeff X ≠ 0, by simpa,
by erw [degree_mul' this, degree_eq_nat_degree hp,
    degree_X, ← with_bot.coe_one, ← with_bot.coe_add, with_bot.coe_lt_coe];
  exact nat.lt_succ_self _

lemma nat_degree_pos_iff_degree_pos :
  0 < nat_degree p ↔ 0 < degree p :=
lt_iff_lt_of_le_iff_le nat_degree_le_iff_degree_le

lemma eq_C_of_nat_degree_le_zero (h : nat_degree p ≤ 0) : p = C (coeff p 0) :=
eq_C_of_degree_le_zero $ degree_le_of_nat_degree_le h

lemma eq_C_of_nat_degree_eq_zero (h : nat_degree p = 0) : p = C (coeff p 0) :=
eq_C_of_nat_degree_le_zero h.le

lemma ne_zero_of_coe_le_degree (hdeg : ↑n ≤ p.degree) : p ≠ 0 :=
by rw ← degree_nonneg_iff_ne_zero; exact trans (by exact_mod_cast n.zero_le) hdeg

lemma le_nat_degree_of_coe_le_degree (hdeg : ↑n ≤ p.degree) :
  n ≤ p.nat_degree :=
with_bot.coe_le_coe.mp ((degree_eq_nat_degree $ ne_zero_of_coe_le_degree hdeg) ▸ hdeg)

lemma degree_sum_fin_lt {n : ℕ} (f : fin n → R) :
  degree (∑ i : fin n, C (f i) * X ^ (i : ℕ)) < n :=
begin
  haveI : is_commutative (with_bot ℕ) max := ⟨max_comm⟩,
  haveI : is_associative (with_bot ℕ) max := ⟨max_assoc⟩,
  calc  (∑ i, C (f i) * X ^ (i : ℕ)).degree
      ≤ finset.univ.fold (⊔) ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) : degree_sum_le _ _
  ... = finset.univ.fold max ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) : rfl
  ... < n : (finset.fold_max_lt (n : with_bot ℕ)).mpr ⟨with_bot.bot_lt_coe _, _⟩,

  rintros ⟨i, hi⟩ -,
  calc (C (f ⟨i, hi⟩) * X ^ i).degree
      ≤ (C _).degree + (X ^ i).degree : degree_mul_le _ _
  ... ≤ 0 + i : add_le_add degree_C_le (degree_X_pow_le i)
  ... = i : zero_add _
  ... < n : with_bot.some_lt_some.mpr hi,
end

lemma degree_linear_le : degree (C a * X + C b) ≤ 1 :=
degree_add_le_of_degree_le (degree_C_mul_X_le _) $ le_trans degree_C_le nat.with_bot.coe_nonneg

lemma degree_linear_lt : degree (C a * X + C b) < 2 :=
degree_linear_le.trans_lt $ with_bot.coe_lt_coe.mpr one_lt_two

lemma degree_C_lt_degree_C_mul_X (ha : a ≠ 0) : degree (C b) < degree (C a * X) :=
by simpa only [degree_C_mul_X ha] using degree_C_lt

@[simp] lemma degree_linear (ha : a ≠ 0) : degree (C a * X + C b) = 1 :=
by rw [degree_add_eq_left_of_degree_lt $ degree_C_lt_degree_C_mul_X ha, degree_C_mul_X ha]

lemma nat_degree_linear_le : nat_degree (C a * X + C b) ≤ 1 :=
nat_degree_le_of_degree_le degree_linear_le

@[simp] lemma nat_degree_linear (ha : a ≠ 0) : nat_degree (C a * X + C b) = 1 :=
nat_degree_eq_of_degree_eq_some $ degree_linear ha

@[simp] lemma leading_coeff_linear (ha : a ≠ 0): leading_coeff (C a * X + C b) = a :=
by rw [add_comm, leading_coeff_add_of_degree_lt (degree_C_lt_degree_C_mul_X ha),
       leading_coeff_C_mul_X]

lemma degree_quadratic_le : degree (C a * X ^ 2 + C b * X + C c) ≤ 2 :=
by simpa only [add_assoc] using degree_add_le_of_degree_le (degree_C_mul_X_pow_le 2 a)
  (le_trans degree_linear_le $ with_bot.coe_le_coe.mpr one_le_two)

lemma degree_quadratic_lt : degree (C a * X ^ 2 + C b * X + C c) < 3 :=
degree_quadratic_le.trans_lt $ with_bot.coe_lt_coe.mpr $ lt_add_one 2

lemma degree_linear_lt_degree_C_mul_X_sq (ha : a ≠ 0) :
  degree (C b * X + C c) < degree (C a * X ^ 2) :=
by simpa only [degree_C_mul_X_pow 2 ha] using degree_linear_lt

@[simp] lemma degree_quadratic (ha : a ≠ 0) : degree (C a * X ^ 2 + C b * X + C c) = 2 :=
begin
  rw [add_assoc, degree_add_eq_left_of_degree_lt $ degree_linear_lt_degree_C_mul_X_sq ha,
      degree_C_mul_X_pow 2 ha],
  refl
end

lemma nat_degree_quadratic_le : nat_degree (C a * X ^ 2 + C b * X + C c) ≤ 2 :=
nat_degree_le_of_degree_le degree_quadratic_le

@[simp] lemma nat_degree_quadratic (ha : a ≠ 0) : nat_degree (C a * X ^ 2 + C b * X + C c) = 2 :=
nat_degree_eq_of_degree_eq_some $ degree_quadratic ha

@[simp] lemma leading_coeff_quadratic (ha : a ≠ 0) :
  leading_coeff (C a * X ^ 2 + C b * X + C c) = a :=
by rw [add_assoc, add_comm, leading_coeff_add_of_degree_lt $
         degree_linear_lt_degree_C_mul_X_sq ha, leading_coeff_C_mul_X_pow]

lemma degree_cubic_le : degree (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) ≤ 3 :=
by simpa only [add_assoc] using degree_add_le_of_degree_le (degree_C_mul_X_pow_le 3 a)
  (le_trans degree_quadratic_le $ with_bot.coe_le_coe.mpr $ nat.le_succ 2)

lemma degree_cubic_lt : degree (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) < 4 :=
degree_cubic_le.trans_lt $ with_bot.coe_lt_coe.mpr $ lt_add_one 3

lemma degree_quadratic_lt_degree_C_mul_X_cb (ha : a ≠ 0) :
  degree (C b * X ^ 2 + C c * X + C d) < degree (C a * X ^ 3) :=
by simpa only [degree_C_mul_X_pow 3 ha] using degree_quadratic_lt

@[simp] lemma degree_cubic (ha : a ≠ 0) : degree (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) = 3 :=
begin
  rw [add_assoc, add_assoc, ← add_assoc (C b * X ^ 2), degree_add_eq_left_of_degree_lt $
        degree_quadratic_lt_degree_C_mul_X_cb ha, degree_C_mul_X_pow 3 ha],
  refl
end

lemma nat_degree_cubic_le : nat_degree (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) ≤ 3 :=
nat_degree_le_of_degree_le degree_cubic_le

@[simp] lemma nat_degree_cubic (ha : a ≠ 0) :
  nat_degree (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) = 3 :=
nat_degree_eq_of_degree_eq_some $ degree_cubic ha

@[simp] lemma leading_coeff_cubic (ha : a ≠ 0):
  leading_coeff (C a * X ^ 3 + C b * X ^ 2 + C c * X + C d) = a :=
by rw [add_assoc, add_assoc, ← add_assoc (C b * X ^ 2), add_comm, leading_coeff_add_of_degree_lt $
         degree_quadratic_lt_degree_C_mul_X_cb ha, leading_coeff_C_mul_X_pow]

end semiring

section nontrivial_semiring
variables [semiring R] [nontrivial R] {p q : R[X]}

@[simp] lemma degree_X_pow (n : ℕ) : degree ((X : R[X]) ^ n) = n :=
by rw [X_pow_eq_monomial, degree_monomial _ (@one_ne_zero R _ _)]

@[simp] lemma nat_degree_X_pow (n : ℕ) : nat_degree ((X : R[X]) ^ n) = n :=
nat_degree_eq_of_degree_eq_some (degree_X_pow n)

theorem not_is_unit_X : ¬ is_unit (X : R[X]) :=
λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $
by { change g * monomial 1 1 = 1 at hgf, rw [← coeff_one_zero, ← hgf], simp }

@[simp] lemma degree_mul_X : degree (p * X) = degree p + 1 := by simp [monic_X.degree_mul]

@[simp] lemma degree_mul_X_pow : degree (p * X ^ n) = degree p + n :=
by simp [(monic_X_pow n).degree_mul]

end nontrivial_semiring

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

lemma degree_sub_le (p q : R[X]) : degree (p - q) ≤ max (degree p) (degree q) :=
by simpa only [sub_eq_add_neg, degree_neg q] using degree_add_le p (-q)

lemma degree_sub_lt (hd : degree p = degree q)
  (hp0 : p ≠ 0) (hlc : leading_coeff p = leading_coeff q) :
  degree (p - q) < degree p :=
have hp : monomial (nat_degree p) (leading_coeff p) + p.erase (nat_degree p) = p :=
  monomial_add_erase _ _,
have hq : monomial (nat_degree q) (leading_coeff q) + q.erase (nat_degree q) = q :=
  monomial_add_erase _ _,
have hd' : nat_degree p = nat_degree q := by unfold nat_degree; rw hd,
have hq0 : q ≠ 0 := mt degree_eq_bot.2 (hd ▸ mt degree_eq_bot.1 hp0),
calc degree (p - q) = degree (erase (nat_degree q) p + -erase (nat_degree q) q) :
  by conv { to_lhs, rw [← hp, ← hq, hlc, hd', add_sub_add_left_eq_sub, sub_eq_add_neg] }
... ≤ max (degree (erase (nat_degree q) p)) (degree (erase (nat_degree q) q))
  : degree_neg (erase (nat_degree q) q) ▸ degree_add_le _ _
... < degree p : max_lt_iff.2 ⟨hd' ▸ degree_erase_lt hp0, hd.symm ▸ degree_erase_lt hq0⟩

lemma nat_degree_X_sub_C_le {r : R} : (X - C r).nat_degree ≤ 1 :=
nat_degree_le_iff_degree_le.2 $ le_trans (degree_sub_le _ _) $ max_le degree_X_le $
le_trans degree_C_le $ with_bot.coe_le_coe.2 zero_le_one

lemma degree_sub_eq_left_of_degree_lt (h : degree q < degree p) : degree (p - q) = degree p :=
by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_left_of_degree_lt h] }

lemma degree_sub_eq_right_of_degree_lt (h : degree p < degree q) : degree (p - q) = degree q :=
by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_right_of_degree_lt h, degree_neg] }

end ring

section nonzero_ring
variables [nontrivial R]

section semiring
variable [semiring R]

@[simp] lemma degree_X_add_C (a : R) : degree (X + C a) = 1 :=
have degree (C a) < degree (X : R[X]),
from calc degree (C a) ≤ 0 : degree_C_le
                   ... < 1 : with_bot.some_lt_some.mpr zero_lt_one
                   ... = degree X : degree_X.symm,
by rw [degree_add_eq_left_of_degree_lt this, degree_X]

@[simp] lemma nat_degree_X_add_C (x : R) : (X + C x).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some $ degree_X_add_C x

@[simp]
lemma next_coeff_X_add_C [semiring S] (c : S) : next_coeff (X + C c) = c :=
begin
  nontriviality S,
  simp [next_coeff_of_pos_nat_degree]
end

lemma degree_X_pow_add_C {n : ℕ} (hn : 0 < n) (a : R) :
  degree ((X : R[X]) ^ n + C a) = n :=
have degree (C a) < degree ((X : R[X]) ^ n),
  from calc degree (C a) ≤ 0 : degree_C_le
  ... < degree ((X : R[X]) ^ n) : by rwa [degree_X_pow];
    exact with_bot.coe_lt_coe.2 hn,
by rw [degree_add_eq_left_of_degree_lt this, degree_X_pow]

lemma X_pow_add_C_ne_zero {n : ℕ} (hn : 0 < n) (a : R) :
  (X : R[X]) ^ n + C a ≠ 0 :=
mt degree_eq_bot.2 (show degree ((X : R[X]) ^ n + C a) ≠ ⊥,
  by rw degree_X_pow_add_C hn a; exact dec_trivial)

theorem X_add_C_ne_zero (r : R) : X + C r ≠ 0 :=
pow_one (X : R[X]) ▸ X_pow_add_C_ne_zero zero_lt_one r

theorem zero_nmem_multiset_map_X_add_C {α : Type*} (m : multiset α) (f : α → R) :
  (0 : R[X]) ∉ m.map (λ a, X + C (f a)) :=
λ mem, let ⟨a, _, ha⟩ := multiset.mem_map.mp mem in X_add_C_ne_zero _ ha

lemma nat_degree_X_pow_add_C {n : ℕ} {r : R} :
  (X ^ n + C r).nat_degree = n :=
begin
  by_cases hn : n = 0,
  { rw [hn, pow_zero, ←C_1, ←ring_hom.map_add, nat_degree_C] },
  { exact nat_degree_eq_of_degree_eq_some (degree_X_pow_add_C (pos_iff_ne_zero.mpr hn) r) },
end

@[simp] lemma leading_coeff_X_pow_add_C {n : ℕ} (hn : 0 < n) {r : R} :
  (X ^ n + C r).leading_coeff = 1 :=
by rw [leading_coeff, nat_degree_X_pow_add_C, coeff_add, coeff_X_pow_self,
  coeff_C, if_neg (pos_iff_ne_zero.mp hn), add_zero]

@[simp] lemma leading_coeff_X_add_C [semiring S] (r : S) :
  (X + C r).leading_coeff = 1 :=
begin
  nontriviality,
  rw [←pow_one (X : S[X]), leading_coeff_X_pow_add_C zero_lt_one],
  apply_instance
end

@[simp] lemma leading_coeff_X_pow_add_one {n : ℕ} (hn : 0 < n) :
  (X ^ n + 1 : R[X]).leading_coeff = 1 :=
leading_coeff_X_pow_add_C hn

@[simp] lemma leading_coeff_pow_X_add_C (r : R) (i : ℕ) :
  leading_coeff ((X + C r) ^ i) = 1 :=
by { nontriviality, rw leading_coeff_pow'; simp }

end semiring

variables [ring R]

@[simp] lemma degree_X_sub_C (a : R) : degree (X - C a) = 1 :=
by rw [sub_eq_add_neg, ←map_neg C a, degree_X_add_C]

@[simp] lemma nat_degree_X_sub_C (x : R) : (X - C x).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some $ degree_X_sub_C x

@[simp]
lemma next_coeff_X_sub_C [ring S] (c : S) : next_coeff (X - C c) = - c :=
by rw [sub_eq_add_neg, ←map_neg C c, next_coeff_X_add_C]

lemma degree_X_pow_sub_C {n : ℕ} (hn : 0 < n) (a : R) :
  degree ((X : R[X]) ^ n - C a) = n :=
by rw [sub_eq_add_neg, ←map_neg C a, degree_X_pow_add_C hn]; apply_instance

lemma X_pow_sub_C_ne_zero {n : ℕ} (hn : 0 < n) (a : R) :
  (X : R[X]) ^ n - C a ≠ 0 :=
by { rw [sub_eq_add_neg, ←map_neg C a], exact X_pow_add_C_ne_zero hn _ }

theorem X_sub_C_ne_zero (r : R) : X - C r ≠ 0 :=
pow_one (X : R[X]) ▸ X_pow_sub_C_ne_zero zero_lt_one r

theorem zero_nmem_multiset_map_X_sub_C {α : Type*} (m : multiset α) (f : α → R) :
  (0 : R[X]) ∉ m.map (λ a, X - C (f a)) :=
λ mem, let ⟨a, _, ha⟩ := multiset.mem_map.mp mem in X_sub_C_ne_zero _ ha

lemma nat_degree_X_pow_sub_C {n : ℕ} {r : R} :
  (X ^ n - C r).nat_degree = n :=
by rw [sub_eq_add_neg, ←map_neg C r, nat_degree_X_pow_add_C]

@[simp] lemma leading_coeff_X_pow_sub_C {n : ℕ} (hn : 0 < n) {r : R} :
  (X ^ n - C r).leading_coeff = 1 :=
by rw [sub_eq_add_neg, ←map_neg C r, leading_coeff_X_pow_add_C hn]; apply_instance

@[simp] lemma leading_coeff_X_sub_C [ring S] (r : S) :
  (X - C r).leading_coeff = 1 :=
by rw [sub_eq_add_neg, ←map_neg C r, leading_coeff_X_add_C]

@[simp] lemma leading_coeff_X_pow_sub_one {n : ℕ} (hn : 0 < n) :
  (X ^ n - 1 : R[X]).leading_coeff = 1 :=
leading_coeff_X_pow_sub_C hn

end nonzero_ring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : R[X]}

@[simp] lemma degree_mul : degree (p * q) = degree p + degree q :=
if hp0 : p = 0 then by simp only [hp0, degree_zero, zero_mul, with_bot.bot_add]
else if hq0 : q = 0 then  by simp only [hq0, degree_zero, mul_zero, with_bot.add_bot]
else degree_mul' $ mul_ne_zero (mt leading_coeff_eq_zero.1 hp0)
    (mt leading_coeff_eq_zero.1 hq0)

/-- `degree` as a monoid homomorphism between `R[X]` and `multiplicative (with_bot ℕ)`.
  This is useful to prove results about multiplication and degree. -/
def degree_monoid_hom [nontrivial R] : R[X] →* multiplicative (with_bot ℕ) :=
{ to_fun := degree,
  map_one' := degree_one,
  map_mul' := λ _ _, degree_mul }

@[simp] lemma degree_pow [nontrivial R] (p : R[X]) (n : ℕ) :
  degree (p ^ n) = n • (degree p) :=
map_pow (degree_monoid_hom : R[X] →* _) _ _

@[simp] lemma leading_coeff_mul (p q : R[X]) : leading_coeff (p * q) =
  leading_coeff p * leading_coeff q :=
begin
  by_cases hp : p = 0,
  { simp only [hp, zero_mul, leading_coeff_zero] },
  { by_cases hq : q = 0,
    { simp only [hq, mul_zero, leading_coeff_zero] },
    { rw [leading_coeff_mul'],
      exact mul_ne_zero (mt leading_coeff_eq_zero.1 hp) (mt leading_coeff_eq_zero.1 hq) } }
end

/-- `polynomial.leading_coeff` bundled as a `monoid_hom` when `R` has `no_zero_divisors`, and thus
  `leading_coeff` is multiplicative -/
def leading_coeff_hom : R[X] →* R :=
{ to_fun := leading_coeff,
  map_one' := by simp,
  map_mul' := leading_coeff_mul }

@[simp] lemma leading_coeff_hom_apply (p : R[X]) :
  leading_coeff_hom p = leading_coeff p := rfl

@[simp] lemma leading_coeff_pow (p : R[X]) (n : ℕ) :
  leading_coeff (p ^ n) = leading_coeff p ^ n :=
(leading_coeff_hom : R[X] →* R).map_pow p n

end no_zero_divisors

end polynomial


open Nat

def even (n : Nat) : Prop := ∃ d, n=2*d

example (n : Nat) : (even n) → (even (n+2)) := by
intro h1
apply Exists.elim h1
intro a h2
rw [h2,← Nat.mul_one 2,← Nat.left_distrib, Nat.mul_one]
apply Exists.intro (a+1)
rfl

theorem leq_eq_exist_nat_add {n m : Nat} : n ≤ m → ∃ k, m = n + k := by
intro h
induction h with
| refl => exact (Exists.intro 0 (Nat.add_zero n))
| step _ ih => apply Exists.elim ih
               intro x hx
               rw [hx,← Nat.add_comm, ← Nat.succ_add, Nat.add_comm]
               exact Exists.intro (succ x) rfl

def subtract (n m : Nat) : Nat :=
match m with
| zero => n
| succ k => pred (subtract n k)

theorem zero_sub : subtract zero k = zero := by
induction k with
| zero => rfl
| succ l ih => rw [subtract,ih,Nat.pred_zero]

theorem pred_sub_eq_sub_pred : pred (subtract n k) = subtract (pred n) k := by
induction k with
| zero => rw [subtract,subtract]
| succ k ih => rw [subtract,ih,subtract]

theorem left_sub_cancel : subtract (n+k) n = k := by
induction n with
| zero => rw [Nat.zero_add,subtract]
| succ n ih => rw [Nat.succ_add,subtract,pred_sub_eq_sub_pred,Nat.pred_succ,ih]

theorem sub_add_eq_sub_diff (h1 : n ≤ m) (h2 : k ≤ n) : subtract m n + subtract n k = subtract m k := by
cases n with
| zero => rw [subtract,zero_sub,Nat.add_zero,Nat.eq_zero_of_le_zero h2,subtract]
| succ l => have : ∃ r, m = succ l + r := leq_eq_exist_nat_add h1
            apply Exists.elim this
            intro x hx
            rw [hx]
            have : ∃ r, succ l = k + r := leq_eq_exist_nat_add h2
            apply Exists.elim this
            intro y hy
            rw [hy]
            rw [left_sub_cancel,left_sub_cancel]
            rw [Nat.add_assoc,left_sub_cancel,Nat.add_comm]

theorem sub_add_eq_sub_sub : subtract n (k+l) = subtract (subtract n k) l := by
induction l with
| zero => rw [Nat.add_zero,subtract]
| succ s ih => rw [Nat.add_succ,subtract,ih,← subtract]

theorem sub_mul_eq_mul_sub : subtract (k*n) (k*m) = k*(subtract n m) := by
induction m with
| zero => rw [Nat.mul_zero,subtract,subtract]
| succ s ih => rw [Nat.mul_succ,sub_add_eq_sub_sub,ih,subtract]
               cases (subtract n s) with
               | zero => rw [Nat.mul_zero,Nat.pred_zero,Nat.mul_zero,zero_sub]
               | succ r => rw [Nat.mul_succ,Nat.add_comm,left_sub_cancel,Nat.pred_succ]

-- simple lemma for even numbers
example {n m k : Nat} : (even n) → (even m) → subtract n m = k → even k := by
intro h1 h2 h3
apply Exists.elim h1
intro s hs
apply Exists.elim h2
intro r hr
rw [hs,hr] at h3
have : subtract (2*s) (2*r) = 2*(subtract s r) := sub_mul_eq_mul_sub
rw [this] at h3
exact Exists.intro (subtract s r) (Eq.symm h3)


import tactic

#check setoid
#check @quotient
#check prod

def int_relation : ℕ × ℕ → ℕ × ℕ → Prop
| (a, b) (c, d) := a + d = c + b

lemma int_relation_reflexive : reflexive int_relation :=
begin
  rintro ⟨a, b⟩,
  unfold int_relation
end

lemma int_relation_symmetric : symmetric int_relation :=
begin
  rintros ⟨a, b⟩ ⟨c, d⟩ h,
  unfold int_relation at h ⊢,
  symmetry,
  assumption
end

lemma int_relation_transitive : transitive int_relation :=
begin
  rintros ⟨a, b⟩ ⟨c, d⟩ ⟨m, n⟩ h₁ h₂,
  unfold int_relation at h₁ h₂ ⊢,
  linarith
end

lemma int_relation_equivalence : equivalence int_relation :=
begin
  refine ⟨_, _, _⟩,
  { exact int_relation_reflexive },
  { exact int_relation_symmetric },
  { exact int_relation_transitive }
end

#check int

instance int_setoid : setoid (ℕ × ℕ) := ⟨int_relation, int_relation_equivalence⟩

def int' : Type := quotient int_setoid

def int'_of_nat (n : ℕ) : int' := quotient.mk (n, 0)

#check has_add

def int_add : ℕ × ℕ → ℕ × ℕ → int'
| (a, b) (c, d) := quotient.mk (a + c, b + d)

instance : has_add int' :=
begin
  constructor,
  apply quotient.lift₂ int_add,
  rintros ⟨a₁₁, a₁₂⟩ ⟨a₂₁, a₂₂⟩ ⟨b₁₁, b₁₂⟩ ⟨b₂₁, b₂₂⟩ h₁ h₂,
  apply quotient.sound,
  change _ = _,
  change _ = _ at h₁,
  change _ = _ at h₂,
  linarith
end

def int_le : ℕ × ℕ → ℕ × ℕ → Prop
| (a, b) (c, d) := a + d ≤ b + c

instance : has_le int' :=
begin
  constructor,
  apply quotient.lift₂ int_le,
  rintros ⟨a₁₁, a₁₂⟩ ⟨a₂₁, a₂₂⟩ ⟨b₁₁, b₁₂⟩ ⟨b₂₁, b₂₂⟩ h₁ h₂,
  change _ = _ at h₁,
  change _ = _ at h₂,
  unfold int_le,
  ext,
  split; intro h; linarith
end

-- Problem 6.1. Show that (m + n)_ℤ = m_ℤ + n_ℤ and m ≤ n ↔ m_ℤ ≤ n_ℤ, for any
-- m, n ∈ ℕ.
lemma problem_6_1_a (m n : ℕ) : int'_of_nat (m + n) = int'_of_nat m + int'_of_nat n :=
begin
  unfold int'_of_nat,
  apply quotient.sound,
  refl
end

lemma problem_6_1_b (m n : ℕ) : m ≤ n ↔ int'_of_nat m ≤ int'_of_nat n :=
begin
  unfold int'_of_nat,
  change _ ↔ int_le _ _,
  unfold int_le,
  rw [add_zero, zero_add]
end

-- Problem 6.2. Show that ∽ is an equivalence relation.
--
-- Note: ∽ is the equivalence relation that is used to define ℚ, definition on
-- page 75.
example : sorry := sorry


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
Ported by: Joël Riou

! This file was ported from Lean 3 source module algebra.divisibility.units
! leanprover-community/mathlib commit e574b1a4e891376b0ef974b926da39e05da12a06
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Divisibility.Basic
import Mathlib.Algebra.Group.Units

/-!
# Lemmas about divisibility and units
-/

variable {α : Type _}

namespace Units

section Monoid

variable [Monoid α] {a b : α} {u : αˣ}

/-- Elements of the unit group of a monoid represented as elements of the monoid
    divide any element of the monoid. -/
theorem coe_dvd : ↑u ∣ a :=
  ⟨↑u⁻¹ * a, by simp⟩
#align units.coe_dvd Units.coe_dvd

/-- In a monoid, an element `a` divides an element `b` iff `a` divides all
    associates of `b`. -/
theorem dvd_mul_right : a ∣ b * u ↔ a ∣ b :=
  Iff.intro (fun ⟨c, Eq⟩ ↦ ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← Eq, Units.mul_inv_cancel_right]⟩)
    fun ⟨c, Eq⟩ ↦ Eq.symm ▸ (_root_.dvd_mul_right _ _).mul_right _
#align units.dvd_mul_right Units.dvd_mul_right

/-- In a monoid, an element `a` divides an element `b` iff all associates of `a` divide `b`. -/
theorem mul_right_dvd : a * u ∣ b ↔ a ∣ b :=
  Iff.intro (fun ⟨c, Eq⟩ => ⟨↑u * c, Eq.trans (mul_assoc _ _ _)⟩) fun h =>
    dvd_trans (Dvd.intro (↑u⁻¹) (by rw [mul_assoc, u.mul_inv, mul_one])) h
#align units.mul_right_dvd Units.mul_right_dvd

end Monoid

section CommMonoid

variable [CommMonoid α] {a b : α} {u : αˣ}

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
theorem dvd_mul_left : a ∣ u * b ↔ a ∣ b := by
  rw [mul_comm]
  apply dvd_mul_right
#align units.dvd_mul_left Units.dvd_mul_left

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
theorem mul_left_dvd : ↑u * a ∣ b ↔ a ∣ b := by
  rw [mul_comm]
  apply mul_right_dvd
#align units.mul_left_dvd Units.mul_left_dvd

end CommMonoid

end Units

namespace IsUnit

section Monoid

variable [Monoid α] {a b u : α} (hu : IsUnit u)

/-- Units of a monoid divide any element of the monoid. -/
@[simp]
theorem dvd : u ∣ a := by
  rcases hu with ⟨u, rfl⟩
  apply Units.coe_dvd
#align is_unit.dvd IsUnit.dvd

@[simp]
theorem dvd_mul_right : a ∣ b * u ↔ a ∣ b := by
  rcases hu with ⟨u, rfl⟩
  apply Units.dvd_mul_right
#align is_unit.dvd_mul_right IsUnit.dvd_mul_right

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
@[simp]
theorem mul_right_dvd : a * u ∣ b ↔ a ∣ b := by
  rcases hu with ⟨u, rfl⟩
  apply Units.mul_right_dvd
#align is_unit.mul_right_dvd IsUnit.mul_right_dvd

end Monoid

section CommMonoid

variable [CommMonoid α] (a b u : α) (hu : IsUnit u)

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
@[simp]
theorem dvd_mul_left : a ∣ u * b ↔ a ∣ b := by
  rcases hu with ⟨u, rfl⟩
  apply Units.dvd_mul_left
#align is_unit.dvd_mul_left IsUnit.dvd_mul_left

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
@[simp]
theorem mul_left_dvd : u * a ∣ b ↔ a ∣ b := by
  rcases hu with ⟨u, rfl⟩
  apply Units.mul_left_dvd
#align is_unit.mul_left_dvd IsUnit.mul_left_dvd

end CommMonoid

end IsUnit

section CommMonoid

variable [CommMonoid α]

theorem isUnit_iff_dvd_one {x : α} : IsUnit x ↔ x ∣ 1 :=
  ⟨IsUnit.dvd, fun ⟨y, h⟩ => ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩
#align is_unit_iff_dvd_one isUnit_iff_dvd_one

theorem isUnit_iff_forall_dvd {x : α} : IsUnit x ↔ ∀ y, x ∣ y :=
  isUnit_iff_dvd_one.trans ⟨fun h _ => h.trans (one_dvd _), fun h => h _⟩
#align is_unit_iff_forall_dvd isUnit_iff_forall_dvd

theorem isUnit_of_dvd_unit {x y : α} (xy : x ∣ y) (hu : IsUnit y) : IsUnit x :=
  isUnit_iff_dvd_one.2 <| xy.trans <| isUnit_iff_dvd_one.1 hu
#align is_unit_of_dvd_unit isUnit_of_dvd_unit

theorem isUnit_of_dvd_one {a : α} (h : a ∣ 1) : IsUnit (a : α) :=
  isUnit_iff_dvd_one.mpr h
#align is_unit_of_dvd_one isUnit_of_dvd_one

theorem not_isUnit_of_not_isUnit_dvd {a b : α} (ha : ¬IsUnit a) (hb : a ∣ b) : ¬IsUnit b :=
  mt (isUnit_of_dvd_unit hb) ha
#align not_is_unit_of_not_is_unit_dvd not_isUnit_of_not_isUnit_dvd

end CommMonoid


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

import algebra.ring.basic
import algebra.algebra.basic
import algebra.group_power.basic
import algebra.field_power
import algebra.opposites

/-!  # Squares, even and odd elements

This file proves some general facts about squares, even and odd elements of semirings.

In the implementation, we define `is_square` and we let `even` be the notion transported by
`to_additive`.  The definition are therefore as follows:
```lean
is_square a ↔ ∃ r, a = r * r
even a ↔ ∃ r, a = r + r
```

Odd elements are not unified with a multiplicative notion.

## Future work

* TODO: Try to generalize further the typeclass assumptions on `is_square/even`.
  For instance, in some cases, there are `semiring` assumptions that I (DT) am not convinced are
  necessary.
* TODO: Consider moving the definition and lemmas about `odd` to a separate file.
* TODO: The "old" definition of `even a` asked for the existence of an element `c` such that
  `a = 2 * c`.  For this reason, several fixes introduce an extra `two_mul` or `← two_mul`.
  It might be the case that by making a careful choice of `simp` lemma, this can be avoided.
 -/

open mul_opposite
variables {F α β R : Type*}

section has_mul
variables [has_mul α]

/--  An element `a` of a type `α` with multiplication satisfies `square a` if `a = r * r`,
for some `r : α`. -/
@[to_additive
"An element `a` of a type `α` with addition satisfies `even a` if `a = r + r`,
for some `r : α`."]
def is_square (a : α) : Prop := ∃ r, a = r * r

@[simp, to_additive] lemma is_square_mul_self (m : α) : is_square (m * m) := ⟨m, rfl⟩

@[to_additive] lemma is_square_op_iff (a : α) : is_square (op a) ↔ is_square a :=
⟨λ ⟨c, hc⟩, ⟨unop c, by rw [← unop_mul, ← hc, unop_op]⟩, λ ⟨c, hc⟩, by simp [hc]⟩

/-- Create a decidability instance for `is_square` on `fintype`s. -/
instance is_square_decidable [fintype α] [decidable_eq α] : decidable_pred (is_square : α → Prop) :=
λ a, fintype.decidable_exists_fintype

end has_mul

@[simp, to_additive]
lemma is_square_one [mul_one_class α] : is_square (1 : α) := ⟨1, (mul_one _).symm⟩

@[to_additive]
lemma is_square.map [mul_one_class α] [mul_one_class β] [monoid_hom_class F α β] {m : α} (f : F) :
  is_square m → is_square (f m) :=
by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp⟩ }

section monoid
variables [monoid α]

@[to_additive even_iff_exists_two_nsmul]
lemma is_square_iff_exists_sq (m : α) : is_square m ↔ ∃ c, m = c ^ 2 :=
by simp [is_square, pow_two]

alias is_square_iff_exists_sq ↔ is_square.exists_sq is_square_of_exists_sq

attribute [to_additive even.exists_two_nsmul "Alias of the forwards direction of
`even_iff_exists_two_nsmul`."] is_square.exists_sq

attribute [to_additive even_of_exists_two_nsmul "Alias of the backwards direction of
`even_iff_exists_two_nsmul`."] is_square_of_exists_sq

@[simp, to_additive even_two_nsmul]
lemma is_square_sq (a : α) : is_square (a ^ 2) := ⟨a, pow_two _⟩

variables [has_distrib_neg α] {n : ℕ}

lemma even.neg_pow : even n → ∀ a : α, (-a) ^ n = a ^ n :=
by { rintro ⟨c, rfl⟩ a, simp_rw [←two_mul, pow_mul, neg_sq] }

lemma even.neg_one_pow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_pow, one_pow]

end monoid

/-- `0` is always a square (in a monoid with zero). -/
lemma is_square_zero (M : Type*) [monoid_with_zero M] : is_square (0 : M) :=
by { use 0, simp only [mul_zero] }

@[to_additive] lemma is_square.mul [comm_semigroup α] {a b : α} :
  is_square a → is_square b → is_square (a * b) :=
by { rintro ⟨a, rfl⟩ ⟨b, rfl⟩, exact ⟨a * b, mul_mul_mul_comm _ _ _ _⟩ }

section division_monoid
variables [division_monoid α] {a : α}

@[simp, to_additive] lemma is_square_inv : is_square a⁻¹ ↔ is_square a :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw [← is_square_op_iff, ← inv_inv a],
    exact h.map (mul_equiv.inv' α) },
  { exact ((is_square_op_iff a).mpr h).map (mul_equiv.inv' α).symm }
end

alias is_square_inv ↔ _ is_square.inv

attribute [to_additive] is_square.inv

variables [has_distrib_neg α] {n : ℤ}

lemma even.neg_zpow : even n → ∀ a : α, (-a) ^ n = a ^ n :=
by { rintro ⟨c, rfl⟩ a, exact zpow_bit0_neg _ _ }

lemma even.neg_one_zpow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_zpow, one_zpow]

end division_monoid

lemma even_abs [subtraction_monoid α] [linear_order α] {a : α} : even (|a|) ↔ even a :=
by cases abs_choice a; simp only [h, even_neg]

@[to_additive]
lemma is_square.div [division_comm_monoid α] {a b : α} (ha : is_square a) (hb : is_square b) :
  is_square (a / b) :=
by { rw div_eq_mul_inv, exact ha.mul hb.inv }

-- `odd.tsub` requires `canonically_linear_ordered_semiring`, which we don't have
lemma even.tsub [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α]
  [contravariant_class α α (+) (≤)] {m n : α} (hm : even m) (hn : even n) : even (m - n) :=
begin
  obtain ⟨a, rfl⟩ := hm,
  obtain ⟨b, rfl⟩ := hn,
  refine ⟨a - b, _⟩,
  obtain h | h := le_total a b,
  { rw [tsub_eq_zero_of_le h, tsub_eq_zero_of_le (add_le_add h h), add_zero] },
  { exact (tsub_add_tsub_comm h h).symm }
end

lemma even_iff_exists_bit0 [has_add α] {a : α} : even a ↔ ∃ b, a = bit0 b := iff.rfl

alias even_iff_exists_bit0 ↔ even.exists_bit0 _

section semiring
variables [semiring α] [semiring β] {m n : α}

lemma even_iff_exists_two_mul (m : α) : even m ↔ ∃ c, m = 2 * c :=
by simp [even_iff_exists_two_nsmul]

lemma even_iff_two_dvd {a : α} : even a ↔ 2 ∣ a := by simp [even, has_dvd.dvd, two_mul]

@[simp] lemma range_two_mul (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x) = {a | even a} :=
by { ext x, simp [eq_comm, two_mul, even] }

@[simp] lemma even_bit0 (a : α) : even (bit0 a) :=
⟨a, rfl⟩

@[simp] lemma even_two : even (2 : α) := ⟨1, rfl⟩

@[simp] lemma even.mul_left (hm : even m) (n) : even (n * m) :=
hm.map (add_monoid_hom.mul_left n)

@[simp] lemma even.mul_right (hm : even m) (n) : even (m * n) :=
hm.map (add_monoid_hom.mul_right n)

lemma even_two_mul (m : α) : even (2 * m) := ⟨m, two_mul _⟩

lemma even.pow_of_ne_zero (hm : even m) : ∀ {a : ℕ}, a ≠ 0 → even (m ^ a)
| 0       a0 := (a0 rfl).elim
| (a + 1) _  := by { rw pow_succ, exact hm.mul_right _ }

section with_odd

/-- An element `a` of a semiring is odd if there exists `k` such `a = 2*k + 1`. -/
def odd (a : α) : Prop := ∃ k, a = 2*k + 1

lemma odd_iff_exists_bit1 {a : α} : odd a ↔ ∃ b, a = bit1 b :=
exists_congr $ λ b, by { rw two_mul, refl }

alias odd_iff_exists_bit1 ↔ odd.exists_bit1 _

@[simp] lemma odd_bit1 (a : α) : odd (bit1 a) := odd_iff_exists_bit1.2 ⟨a, rfl⟩

@[simp] lemma range_two_mul_add_one (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x + 1) = {a | odd a} :=
by { ext x, simp [odd, eq_comm] }

lemma even.add_odd : even m → odd n → odd (m + n) :=
by { rintro ⟨m, rfl⟩ ⟨n, rfl⟩, exact ⟨m + n, by rw [mul_add, ← two_mul, add_assoc]⟩ }

lemma odd.add_even (hm : odd m) (hn : even n) : odd (m + n) :=
by { rw add_comm, exact hn.add_odd hm }

lemma odd.add_odd : odd m → odd n → even (m + n) :=
begin
  rintro ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨n + m + 1, _⟩,
  rw [← two_mul, ←add_assoc, add_comm _ (2 * n), ←add_assoc, ←mul_add, add_assoc, mul_add _ (n + m),
    mul_one],
  refl
end

@[simp] lemma odd_one : odd (1 : α) :=
⟨0, (zero_add _).symm.trans (congr_arg (+ (1 : α)) (mul_zero _).symm)⟩

@[simp] lemma odd_two_mul_add_one (m : α) : odd (2 * m + 1) := ⟨m, rfl⟩

lemma odd.map [ring_hom_class F α β] (f : F) : odd m → odd (f m) :=
by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp [two_mul]⟩ }

@[simp] lemma odd.mul : odd m → odd n → odd (m * n) :=
begin
  rintro ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨2 * m * n + n + m, _⟩,
  rw [mul_add, add_mul, mul_one, ← add_assoc, one_mul, mul_assoc, ← mul_add, ← mul_add, ← mul_assoc,
    ← nat.cast_two, ← nat.cast_comm],
end

lemma odd.pow (hm : odd m) : ∀ {a : ℕ}, odd (m ^ a)
| 0       := by { rw pow_zero, exact odd_one }
| (a + 1) := by { rw pow_succ, exact hm.mul odd.pow }

end with_odd
end semiring

section monoid
variables [monoid α] [has_distrib_neg α] {a : α} {n : ℕ}

lemma odd.neg_pow : odd n → ∀ a : α, (-a) ^ n = - a ^ n :=
by { rintro ⟨c, rfl⟩ a, simp_rw [pow_add, pow_mul, neg_sq, pow_one, mul_neg] }
lemma odd.neg_one_pow (h : odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_pow, one_pow]

end monoid

section ring
variables [ring α] {a b : α} {n : ℕ}

@[simp] lemma even_neg_two : even (- 2 : α) := by simp only [even_neg, even_two]

lemma odd.neg (hp : odd a) : odd (-a) :=
begin
  obtain ⟨k, hk⟩ := hp,
  use -(k + 1),
  rw [mul_neg, mul_add, neg_add, add_assoc, two_mul (1 : α), neg_add,
    neg_add_cancel_right, ←neg_add, hk],
end

@[simp] lemma odd_neg : odd (-a) ↔ odd a := ⟨λ h, neg_neg a ▸ h.neg, odd.neg⟩

@[simp] lemma odd_neg_one : odd (- 1 : α) := by simp

lemma odd.sub_even (ha : odd a) (hb : even b) : odd (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_even hb.neg }

lemma even.sub_odd (ha : even a) (hb : odd b) : odd (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_odd hb.neg }

lemma odd.sub_odd (ha : odd a) (hb : odd b) : even (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_odd hb.neg }

lemma odd_abs [linear_order α] : odd (abs a) ↔ odd a :=
by cases abs_choice a with h h; simp only [h, odd_neg]

end ring

section powers
variables [linear_ordered_ring R] {a : R} {n : ℕ}

lemma even.pow_nonneg (hn : even n) (a : R) : 0 ≤ a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_nonneg a k

lemma even.pow_pos (hn : even n) (ha : a ≠ 0) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_pos ha k

lemma odd.pow_nonpos (hn : odd n) (ha : a ≤ 0) : a ^ n ≤ 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_nonpos_iff.mpr ha

lemma odd.pow_neg (hn : odd n) (ha : a < 0) : a ^ n < 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_neg_iff.mpr ha

lemma odd.pow_nonneg_iff (hn : odd n) : 0 ≤ a ^ n ↔ 0 ≤ a :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ hn.pow_neg ha), λ ha, pow_nonneg ha n⟩

lemma odd.pow_nonpos_iff (hn : odd n) : a ^ n ≤ 0 ↔ a ≤ 0 :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ pow_pos ha _), hn.pow_nonpos⟩

lemma odd.pow_pos_iff (hn : odd n) : 0 < a ^ n ↔ 0 < a :=
⟨λ h, lt_of_not_le (λ ha, h.not_le $ hn.pow_nonpos ha), λ ha, pow_pos ha n⟩

lemma odd.pow_neg_iff (hn : odd n) : a ^ n < 0 ↔ a < 0 :=
⟨λ h, lt_of_not_le (λ ha, h.not_le $ pow_nonneg ha _), hn.pow_neg⟩

lemma even.pow_pos_iff (hn : even n) (h₀ : 0 < n) : 0 < a ^ n ↔ a ≠ 0 :=
⟨λ h ha, by { rw [ha, zero_pow h₀] at h, exact lt_irrefl 0 h }, hn.pow_pos⟩

lemma even.pow_abs {p : ℕ} (hp : even p) (a : R) : |a| ^ p = a ^ p :=
begin
  rw [←abs_pow, abs_eq_self],
  exact hp.pow_nonneg _
end

@[simp] lemma pow_bit0_abs (a : R) (p : ℕ) : |a| ^ bit0 p = a ^ bit0 p := (even_bit0 _).pow_abs _

lemma odd.strict_mono_pow (hn : odd n) : strict_mono (λ a : R, a ^ n) :=
by cases hn with k hk; simpa only [hk, two_mul] using strict_mono_pow_bit1 _

end powers

/-- The cardinality of `fin (bit0 k)` is even, `fact` version.
This `fact` is needed as an instance by `matrix.special_linear_group.has_neg`. -/
lemma fintype.card_fin_even {k : ℕ} : fact (even (fintype.card (fin (bit0 k)))) :=
⟨by { rw [fintype.card_fin], exact even_bit0 k }⟩

section field_power
variable {K : Type*}

section division_ring
variables [division_ring K] {n : ℤ}

lemma odd.neg_zpow (h : odd n) (a : K) : (-a) ^ n = - a ^ n :=
by { obtain ⟨k, rfl⟩ := h.exists_bit1, exact zpow_bit1_neg _ _ }

lemma odd.neg_one_zpow (h : odd n) : (-1 : K) ^ n = -1 := by rw [h.neg_zpow, one_zpow]

end division_ring

variables [linear_ordered_field K] {n : ℤ} {a : K}

protected lemma even.zpow_nonneg (hn : even n) (a : K) : 0 ≤ a ^ n :=
begin
  cases le_or_lt 0 a with h h,
  { exact zpow_nonneg h _ },
  { exact (hn.neg_zpow a).subst (zpow_nonneg (neg_nonneg_of_nonpos h.le) _) }
end

theorem even.zpow_pos (hn : even n) (ha : a ≠ 0) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit0_pos ha k

protected lemma odd.zpow_nonneg (hn : odd n) (ha : 0 ≤ a) : 0 ≤ a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonneg_iff.mpr ha

theorem odd.zpow_pos (hn : odd n) (ha : 0 < a) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_pos_iff.mpr ha

theorem odd.zpow_nonpos (hn : odd n) (ha : a ≤ 0) : a ^ n ≤ 0:=
by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonpos_iff.mpr ha

theorem odd.zpow_neg (hn : odd n) (ha : a < 0) : a ^ n < 0:=
by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_neg_iff.mpr ha

lemma even.zpow_abs {p : ℤ} (hp : even p) (a : K) : |a| ^ p = a ^ p :=
begin
  cases abs_choice a with h h;
  simp only [h, hp.neg_zpow _],
end

@[simp] lemma zpow_bit0_abs (a : K) (p : ℤ) : |a| ^ bit0 p = a ^ bit0 p :=
(even_bit0 _).zpow_abs _

lemma even.abs_zpow {p : ℤ} (hp : even p) (a : K) : |a ^ p| = a ^ p :=
begin
  rw [abs_eq_self],
  exact hp.zpow_nonneg _
end

@[simp] lemma abs_zpow_bit0 (a : K) (p : ℤ) :
  |a ^ bit0 p| = a ^ bit0 p :=
(even_bit0 _).abs_zpow _

end field_power


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.order.monoid_lemmas
import algebra.group_with_zero.basic
import logic.embedding

/-!
# Regular elements

We introduce left-regular, right-regular and regular elements, along with their `to_additive`
analogues add-left-regular, add-right-regular and add-regular elements.

By definition, a regular element in a commutative ring is a non-zero divisor.
Lemma `is_regular_of_ne_zero` implies that every non-zero element of an integral domain is regular.
Since it assumes that the ring is a `cancel_monoid_with_zero` it applies also, for instance, to `ℕ`.

The lemmas in Section `mul_zero_class` show that the `0` element is (left/right-)regular if and
only if the `mul_zero_class` is trivial.  This is useful when figuring out stopping conditions for
regular sequences: if `0` is ever an element of a regular sequence, then we can extend the sequence
by adding one further `0`.

The final goal is to develop part of the API to prove, eventually, results about non-zero-divisors.
-/
variables {R : Type*} {a b : R}

section has_mul

variable [has_mul R]

/-- A left-regular element is an element `c` such that multiplication on the left by `c`
is injective. -/
@[to_additive "An add-left-regular element is an element `c` such that addition on the left by `c`
is injective. -/
"]
def is_left_regular (c : R) := function.injective ((*) c)

/-- A right-regular element is an element `c` such that multiplication on the right by `c`
is injective. -/
@[to_additive "An add-right-regular element is an element `c` such that addition on the right by `c`
is injective."]
def is_right_regular (c : R) := function.injective (* c)

/-- An add-regular element is an element `c` such that addition by `c` both on the left and
on the right is injective. -/
structure is_add_regular {R : Type*} [has_add R] (c : R) : Prop :=
(left : is_add_left_regular c)
(right : is_add_right_regular c)

/-- A regular element is an element `c` such that multiplication by `c` both on the left and
on the right is injective. -/
structure is_regular (c : R) : Prop :=
(left : is_left_regular c)
(right : is_right_regular c)

attribute [to_additive] is_regular

@[to_additive]
protected lemma mul_le_cancellable.is_left_regular [partial_order R] {a : R}
  (ha : mul_le_cancellable a) : is_left_regular a :=
ha.injective

lemma is_left_regular.right_of_commute {a : R} (ca : ∀ b, commute a b)
  (h : is_left_regular a) : is_right_regular a :=
λ x y xy, h $ (ca x).trans $ xy.trans $ (ca y).symm

lemma commute.is_regular_iff {a : R} (ca : ∀ b, commute a b) :
  is_regular a ↔ is_left_regular a :=
⟨λ h, h.left, λ h, ⟨h, h.right_of_commute ca⟩⟩

end has_mul

section semigroup

variable [semigroup R]

/-- In a semigroup, the product of left-regular elements is left-regular. -/
@[to_additive "In an additive semigroup, the sum of add-left-regular elements is add-left.regular."]
lemma is_left_regular.mul (lra : is_left_regular a) (lrb : is_left_regular b) :
  is_left_regular (a * b) :=
show function.injective ((*) (a * b)), from (comp_mul_left a b) ▸ lra.comp lrb

/-- In a semigroup, the product of right-regular elements is right-regular. -/
@[to_additive
"In an additive semigroup, the sum of add-right-regular elements is add-right-regular."]
lemma is_right_regular.mul (rra : is_right_regular a) (rrb : is_right_regular b) :
  is_right_regular (a * b) :=
show function.injective (* (a * b)), from (comp_mul_right b a) ▸ rrb.comp rra

/--  If an element `b` becomes left-regular after multiplying it on the left by a left-regular
element, then `b` is left-regular. -/
@[to_additive "If an element `b` becomes add-left-regular after adding to it on the left a
add-left-regular element, then `b` is add-left-regular."]
lemma is_left_regular.of_mul (ab : is_left_regular (a * b)) :
  is_left_regular b :=
function.injective.of_comp (by rwa comp_mul_left a b)

/--  An element is left-regular if and only if multiplying it on the left by a left-regular element
is left-regular. -/
@[simp, to_additive "An element is add-left-regular if and only if adding to it on the left a
add-left-regular element is add-left-regular."]
lemma mul_is_left_regular_iff (b : R) (ha : is_left_regular a) :
  is_left_regular (a * b) ↔ is_left_regular b :=
⟨λ ab, is_left_regular.of_mul ab, λ ab, is_left_regular.mul ha ab⟩

/--  If an element `b` becomes right-regular after multiplying it on the right by a right-regular
element, then `b` is right-regular. -/
@[to_additive "If an element `b` becomes add-right-regular after adding to it on the right a
add-right-regular element, then `b` is add-right-regular."]
lemma is_right_regular.of_mul (ab : is_right_regular (b * a)) :
  is_right_regular b :=
begin
  refine λ x y xy, ab (_ : x * (b * a) = y * (b * a)),
  rw [← mul_assoc, ← mul_assoc],
  exact congr_fun (congr_arg has_mul.mul xy) a,
end

/--  An element is right-regular if and only if multiplying it on the right with a right-regular
element is right-regular. -/
@[simp, to_additive "An element is add-right-regular if and only if adding it on the right to a
add-right-regular element is add-right-regular."]
lemma mul_is_right_regular_iff (b : R) (ha : is_right_regular a) :
  is_right_regular (b * a) ↔ is_right_regular b :=
⟨λ ab, is_right_regular.of_mul ab, λ ab, is_right_regular.mul ab ha⟩

/--  Two elements `a` and `b` are regular if and only if both products `a * b` and `b * a`
are regular. -/
@[to_additive "Two elements `a` and `b` are add-regular if and only if both sums `a + b` and `b + a`
are add-regular."]
lemma is_regular_mul_and_mul_iff :
  is_regular (a * b) ∧ is_regular (b * a) ↔ is_regular a ∧ is_regular b :=
begin
  refine ⟨_, _⟩,
  { rintros ⟨ab, ba⟩,
    exact ⟨⟨is_left_regular.of_mul ba.left, is_right_regular.of_mul ab.right⟩,
      ⟨is_left_regular.of_mul ab.left, is_right_regular.of_mul ba.right⟩⟩ },
  { rintros ⟨ha, hb⟩,
    exact ⟨⟨(mul_is_left_regular_iff _ ha.left).mpr hb.left,
        (mul_is_right_regular_iff _ hb.right).mpr ha.right⟩,
      ⟨(mul_is_left_regular_iff _ hb.left).mpr ha.left,
        (mul_is_right_regular_iff _ ha.right).mpr hb.right⟩⟩ }
end

/--  The "most used" implication of `mul_and_mul_iff`, with split hypotheses, instead of `∧`. -/
@[to_additive "The \"most used\" implication of `add_and_add_iff`, with split hypotheses,
instead of `∧`."]
lemma is_regular.and_of_mul_of_mul (ab : is_regular (a * b)) (ba : is_regular (b * a)) :
  is_regular a ∧ is_regular b :=
is_regular_mul_and_mul_iff.mp ⟨ab, ba⟩

end semigroup

section mul_zero_class

variables [mul_zero_class R]

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular.subsingleton (h : is_left_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (zero_mul a) (zero_mul b).symm⟩

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular.subsingleton (h : is_right_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (mul_zero a) (mul_zero b).symm⟩

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular.subsingleton (h : is_regular (0 : R)) : subsingleton R :=
h.left.subsingleton

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular_zero_iff_subsingleton : is_left_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not left-regular. -/
lemma not_is_left_regular_zero_iff : ¬ is_left_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_left_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular_zero_iff_subsingleton : is_right_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not right-regular. -/
lemma not_is_right_regular_zero_iff : ¬ is_right_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_right_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular_iff_subsingleton : is_regular (0 : R) ↔ subsingleton R :=
⟨λ h, h.left.subsingleton,
 λ h, ⟨is_left_regular_zero_iff_subsingleton.mpr h, is_right_regular_zero_iff_subsingleton.mpr h⟩⟩

/-- A left-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_left_regular.ne_zero [nontrivial R] (la : is_left_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (la _),
  rw [zero_mul, zero_mul]
end

/-- A right-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_right_regular.ne_zero [nontrivial R] (ra : is_right_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (ra (_ : x * 0 = y * 0)),
  rw [mul_zero, mul_zero]
end

/-- A regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_regular.ne_zero [nontrivial R] (la : is_regular a) : a ≠ 0 :=
la.left.ne_zero

/--  In a non-trivial ring, the element `0` is not left-regular -- with typeclasses. -/
lemma not_is_left_regular_zero [nR : nontrivial R] : ¬ is_left_regular (0 : R) :=
not_is_left_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not right-regular -- with typeclasses. -/
lemma not_is_right_regular_zero [nR : nontrivial R] : ¬ is_right_regular (0 : R) :=
not_is_right_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not regular -- with typeclasses. -/
lemma not_is_regular_zero [nontrivial R] : ¬ is_regular (0 : R) :=
λ h, is_regular.ne_zero h rfl

end mul_zero_class

section comm_semigroup

variable [comm_semigroup R]

/--  A product is regular if and only if the factors are. -/
@[to_additive "A sum is add-regular if and only if the summands are."]
lemma is_regular_mul_iff : is_regular (a * b) ↔ is_regular a ∧ is_regular b :=
begin
  refine iff.trans _ is_regular_mul_and_mul_iff,
  refine ⟨λ ab, ⟨ab, by rwa mul_comm⟩, λ rab, rab.1⟩
end

end comm_semigroup

section monoid

variables [monoid R]

/--  In a monoid, `1` is regular. -/
@[to_additive "In an additive monoid, `0` is regular."]
lemma is_regular_one : is_regular (1 : R) :=
⟨λ a b ab, (one_mul a).symm.trans (eq.trans ab (one_mul b)),
  λ a b ab, (mul_one a).symm.trans (eq.trans ab (mul_one b))⟩

/-- An element admitting a left inverse is left-regular. -/
@[to_additive "An element admitting a left additive opposite is add-left-regular."]
lemma is_left_regular_of_mul_eq_one (h : b * a = 1) : is_left_regular a :=
@is_left_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.left })

/-- An element admitting a right inverse is right-regular. -/
@[to_additive "An element admitting a right additive opposite is add-right-regular."]
lemma is_right_regular_of_mul_eq_one (h : a * b = 1) : is_right_regular a :=
@is_right_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.right })

/-- If `R` is a monoid, an element in `Rˣ` is regular. -/
@[to_additive "If `R` is an additive monoid, an element in `add_units R` is add-regular."]
lemma units.is_regular (a : Rˣ) : is_regular (a : R) :=
⟨is_left_regular_of_mul_eq_one a.inv_mul, is_right_regular_of_mul_eq_one a.mul_inv⟩

/-- A unit in a monoid is regular. -/
@[to_additive "An additive unit in an additive monoid is add-regular."]
lemma is_unit.is_regular (ua : is_unit a) : is_regular a :=
begin
  rcases ua with ⟨a, rfl⟩,
  exact units.is_regular a,
end

end monoid

section left_or_right_cancel_semigroup

/--
The embedding of a left cancellative semigroup into itself
by left multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a left cancellative additive semigroup into itself
   by left translation by a fixed element.", simps]
def mul_left_embedding {G : Type*} [left_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, g * h, inj' := mul_right_injective g }

/--
The embedding of a right cancellative semigroup into itself
by right multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a right cancellative additive semigroup into itself
   by right translation by a fixed element.", simps]
def mul_right_embedding {G : Type*} [right_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, h * g, inj' := mul_left_injective g }

@[to_additive]
lemma mul_left_embedding_eq_mul_right_embedding {G : Type*} [cancel_comm_monoid G] (g : G) :
  mul_left_embedding g = mul_right_embedding g :=
by { ext, exact mul_comm _ _ }

/--  Elements of a left cancel semigroup are left regular. -/
@[to_additive "Elements of an add left cancel semigroup are add-left-regular."]
lemma is_left_regular_of_left_cancel_semigroup [left_cancel_semigroup R] (g : R) :
  is_left_regular g :=
mul_right_injective g

/--  Elements of a right cancel semigroup are right regular. -/
@[to_additive "Elements of an add right cancel semigroup are add-right-regular"]
lemma is_right_regular_of_right_cancel_semigroup [right_cancel_semigroup R] (g : R) :
  is_right_regular g :=
mul_left_injective g

end left_or_right_cancel_semigroup

section cancel_monoid

variables [cancel_monoid R]

/--  Elements of a cancel monoid are regular.  Cancel semigroups do not appear to exist. -/
@[to_additive
"Elements of an add cancel monoid are regular.  Add cancel semigroups do not appear to exist."]
lemma is_regular_of_cancel_monoid (g : R) : is_regular g :=
⟨mul_right_injective g, mul_left_injective g⟩

end cancel_monoid

section cancel_monoid_with_zero

variables  [cancel_monoid_with_zero R]

/--  Non-zero elements of an integral domain are regular. -/
lemma is_regular_of_ne_zero (a0 : a ≠ 0) : is_regular a :=
⟨λ b c, (mul_right_inj' a0).mp, λ b c, (mul_left_inj' a0).mp⟩

/-- In a non-trivial integral domain, an element is regular iff it is non-zero. -/
lemma is_regular_iff_ne_zero [nontrivial R] : is_regular a ↔ a ≠ 0 :=
⟨is_regular.ne_zero, is_regular_of_ne_zero⟩

end cancel_monoid_with_zero


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree.definitions

/-!
# Trailing degree of univariate polynomials

## Main definitions

* `trailing_degree p`: the multiplicity of `X` in the polynomial `p`
* `nat_trailing_degree`: a variant of `trailing_degree` that takes values in the natural numbers
* `trailing_coeff`: the coefficient at index `nat_trailing_degree p`

Converts most results about `degree`, `nat_degree` and `leading_coeff` to results about the bottom
end of a polynomial
-/

noncomputable theory

open function polynomial finsupp finset
open_locale big_operators classical polynomial

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

section semiring
variables [semiring R] {p q r : R[X]}

/-- `trailing_degree p` is the multiplicity of `x` in the polynomial `p`, i.e. the smallest
`X`-exponent in `p`.
`trailing_degree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears
in `p`, otherwise
`trailing_degree 0 = ⊤`. -/
def trailing_degree (p : R[X]) : with_top ℕ := p.support.inf some

lemma trailing_degree_lt_wf : well_founded
(λp q : R[X], trailing_degree p < trailing_degree q) :=
inv_image.wf trailing_degree (with_top.well_founded_lt nat.lt_wf)

/-- `nat_trailing_degree p` forces `trailing_degree p` to `ℕ`, by defining
`nat_trailing_degree ⊤ = 0`. -/
def nat_trailing_degree (p : R[X]) : ℕ := (trailing_degree p).get_or_else 0

/-- `trailing_coeff p` gives the coefficient of the smallest power of `X` in `p`-/
def trailing_coeff (p : R[X]) : R := coeff p (nat_trailing_degree p)

/-- a polynomial is `monic_at` if its trailing coefficient is 1 -/
def trailing_monic (p : R[X]) := trailing_coeff p = (1 : R)

lemma trailing_monic.def : trailing_monic p ↔ trailing_coeff p = 1 := iff.rfl

instance trailing_monic.decidable [decidable_eq R] : decidable (trailing_monic p) :=
by unfold trailing_monic; apply_instance

@[simp] lemma trailing_monic.trailing_coeff {p : R[X]} (hp : p.trailing_monic) :
  trailing_coeff p = 1 := hp

@[simp] lemma trailing_degree_zero : trailing_degree (0 : R[X]) = ⊤ := rfl

@[simp] lemma trailing_coeff_zero : trailing_coeff (0 : R[X]) = 0 := rfl

@[simp] lemma nat_trailing_degree_zero : nat_trailing_degree (0 : R[X]) = 0 := rfl

lemma trailing_degree_eq_top : trailing_degree p = ⊤ ↔ p = 0 :=
⟨λ h, by rw [trailing_degree, ← min_eq_inf_with_top] at h;
  exact support_eq_empty.1 (min_eq_none.1 h),
λ h, by simp [h]⟩

lemma trailing_degree_eq_nat_trailing_degree (hp : p ≠ 0) :
  trailing_degree p = (nat_trailing_degree p : with_top ℕ) :=
let ⟨n, hn⟩ :=
  not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt trailing_degree_eq_top.1 hp)) in
have hn : trailing_degree p = some n := not_not.1 hn,
by rw [nat_trailing_degree, hn]; refl

lemma trailing_degree_eq_iff_nat_trailing_degree_eq {p : R[X]} {n : ℕ} (hp : p ≠ 0) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
by rw [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_eq_coe]

lemma trailing_degree_eq_iff_nat_trailing_degree_eq_of_pos {p : R[X]} {n : ℕ} (hn : 0 < n) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
begin
  split,
  { intro H, rwa ← trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw trailing_degree_zero at H, exact option.no_confusion H },
  { intro H, rwa trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw nat_trailing_degree_zero at H, rw H at hn, exact lt_irrefl _ hn }
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq_some {p : R[X]} {n : ℕ}
  (h : trailing_degree p = n) : nat_trailing_degree p = n :=
have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h,
option.some_inj.1 $ show (nat_trailing_degree p : with_top ℕ) = n,
  by rwa [← trailing_degree_eq_nat_trailing_degree hp0]

@[simp] lemma nat_trailing_degree_le_trailing_degree :
  ↑(nat_trailing_degree p) ≤ trailing_degree p :=
begin
  by_cases hp : p = 0, { rw [hp, trailing_degree_zero], exact le_top },
  rw [trailing_degree_eq_nat_trailing_degree hp],
  exact le_rfl
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq [semiring S] {q : S[X]}
  (h : trailing_degree p = trailing_degree q) :
nat_trailing_degree p = nat_trailing_degree q :=
by unfold nat_trailing_degree; rw h

lemma le_trailing_degree_of_ne_zero (h : coeff p n ≠ 0) : trailing_degree p ≤ n :=
show @has_le.le (with_top ℕ) _ (p.support.inf some : with_top ℕ) (some n : with_top ℕ),
from finset.inf_le (mem_support_iff.2 h)

lemma nat_trailing_degree_le_of_ne_zero (h : coeff p n ≠ 0) : nat_trailing_degree p ≤ n :=
begin
  rw [← with_top.coe_le_coe, ← trailing_degree_eq_nat_trailing_degree],
  { exact le_trailing_degree_of_ne_zero h, },
  { assume h, subst h, exact h rfl }
end

lemma trailing_degree_le_trailing_degree (h : coeff q (nat_trailing_degree p) ≠ 0) :
  trailing_degree q ≤ trailing_degree p :=
begin
  by_cases hp : p = 0,
  { rw hp, exact le_top },
  { rw trailing_degree_eq_nat_trailing_degree hp, exact le_trailing_degree_of_ne_zero h }
end

lemma trailing_degree_ne_of_nat_trailing_degree_ne {n : ℕ} :
  p.nat_trailing_degree ≠ n → trailing_degree p ≠ n :=
mt $ λ h, by rw [nat_trailing_degree, h, option.get_or_else_coe]

theorem nat_trailing_degree_le_of_trailing_degree_le {n : ℕ} {hp : p ≠ 0}
  (H : (n : with_top ℕ) ≤ trailing_degree p) : n ≤ nat_trailing_degree p :=
begin
  rw trailing_degree_eq_nat_trailing_degree hp at H,
  exact with_top.coe_le_coe.mp H,
end

@[simp] lemma trailing_degree_monomial (ha : a ≠ 0) : trailing_degree (monomial n a) = n :=
by rw [trailing_degree, support_monomial _ _ ha, inf_singleton, with_top.some_eq_coe]

lemma nat_trailing_degree_monomial (ha : a ≠ 0) : nat_trailing_degree (monomial n a) = n :=
by rw [nat_trailing_degree, trailing_degree_monomial ha]; refl

lemma nat_trailing_degree_monomial_le : nat_trailing_degree (monomial n a) ≤ n :=
if ha : a = 0 then by simp [ha] else (nat_trailing_degree_monomial ha).le

lemma le_trailing_degree_monomial : ↑n ≤ trailing_degree (monomial n a) :=
if ha : a = 0 then by simp [ha] else (trailing_degree_monomial ha).ge

@[simp] lemma trailing_degree_C (ha : a ≠ 0) : trailing_degree (C a) = (0 : with_top ℕ) :=
trailing_degree_monomial ha

lemma le_trailing_degree_C : (0 : with_top ℕ) ≤ trailing_degree (C a) :=
le_trailing_degree_monomial

lemma trailing_degree_one_le : (0 : with_top ℕ) ≤ trailing_degree (1 : R[X]) :=
by rw [← C_1]; exact le_trailing_degree_C

@[simp] lemma nat_trailing_degree_C (a : R) : nat_trailing_degree (C a) = 0 :=
nonpos_iff_eq_zero.1 nat_trailing_degree_monomial_le

@[simp] lemma nat_trailing_degree_one : nat_trailing_degree (1 : R[X]) = 0 :=
nat_trailing_degree_C 1

@[simp] lemma nat_trailing_degree_nat_cast (n : ℕ) : nat_trailing_degree (n : R[X]) = 0 :=
by simp only [←C_eq_nat_cast, nat_trailing_degree_C]

@[simp] lemma trailing_degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) :
  trailing_degree (C a * X ^ n) = n :=
by rw [C_mul_X_pow_eq_monomial, trailing_degree_monomial ha]

lemma le_trailing_degree_C_mul_X_pow (n : ℕ) (a : R) :
  (n : with_top ℕ) ≤ trailing_degree (C a * X ^ n) :=
by { rw C_mul_X_pow_eq_monomial, exact le_trailing_degree_monomial }

lemma coeff_eq_zero_of_trailing_degree_lt (h : (n : with_top ℕ) < trailing_degree p) :
  coeff p n = 0 :=
not_not.1 (mt le_trailing_degree_of_ne_zero (not_le_of_gt h))

lemma coeff_eq_zero_of_lt_nat_trailing_degree {p : R[X]} {n : ℕ}
  (h : n < p.nat_trailing_degree) :
  p.coeff n = 0 :=
begin
  apply coeff_eq_zero_of_trailing_degree_lt,
  by_cases hp : p = 0,
  { rw [hp, trailing_degree_zero], exact with_top.coe_lt_top n, },
  { rwa [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_lt_coe] },
end

@[simp] lemma coeff_nat_trailing_degree_pred_eq_zero {p : R[X]}
  {hp : (0 : with_top ℕ) < nat_trailing_degree p} : p.coeff (p.nat_trailing_degree - 1) = 0 :=
coeff_eq_zero_of_lt_nat_trailing_degree $ nat.sub_lt
  ((with_top.zero_lt_coe (nat_trailing_degree p)).mp hp) nat.one_pos

theorem le_trailing_degree_X_pow (n : ℕ) :
  (n : with_top ℕ) ≤ trailing_degree (X^n : R[X]) :=
by simpa only [C_1, one_mul] using le_trailing_degree_C_mul_X_pow n (1:R)

theorem le_trailing_degree_X : (1 : with_top ℕ) ≤ trailing_degree (X : R[X]) :=
le_trailing_degree_monomial

lemma nat_trailing_degree_X_le : (X : R[X]).nat_trailing_degree ≤ 1 :=
nat_trailing_degree_monomial_le

@[simp] lemma trailing_coeff_eq_zero : trailing_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction $ λ hp, mt mem_support_iff.1
  (not_not.2 h) (mem_of_min (trailing_degree_eq_nat_trailing_degree hp)),
λ h, h.symm ▸ leading_coeff_zero⟩

lemma trailing_coeff_nonzero_iff_nonzero : trailing_coeff p ≠ 0 ↔ p ≠ 0 :=
not_congr trailing_coeff_eq_zero

lemma nat_trailing_degree_mem_support_of_nonzero : p ≠ 0 → nat_trailing_degree p ∈ p.support :=
(mem_support_iff.mpr ∘ trailing_coeff_nonzero_iff_nonzero.mpr)

lemma nat_trailing_degree_le_of_mem_supp (a : ℕ) :
  a ∈ p.support → nat_trailing_degree p ≤ a:=
nat_trailing_degree_le_of_ne_zero ∘ mem_support_iff.mp

lemma nat_trailing_degree_eq_support_min' (h : p ≠ 0) :
  nat_trailing_degree p = p.support.min' (nonempty_support_iff.mpr h) :=
begin
  apply le_antisymm,
  { apply le_min',
    intros y hy,
    exact nat_trailing_degree_le_of_mem_supp y hy },
  { apply finset.min'_le,
    exact mem_support_iff.mpr (trailing_coeff_nonzero_iff_nonzero.mpr h), },
end

lemma nat_trailing_degree_le_nat_degree (p : R[X]) :
  p.nat_trailing_degree ≤ p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, nat_degree_zero, nat_trailing_degree_zero] },
  { exact le_nat_degree_of_ne_zero (mt trailing_coeff_eq_zero.mp hp) },
end

lemma nat_trailing_degree_mul_X_pow {p : R[X]} (hp : p ≠ 0) (n : ℕ) :
  (p * X ^ n).nat_trailing_degree = p.nat_trailing_degree + n :=
begin
  apply le_antisymm,
  { refine nat_trailing_degree_le_of_ne_zero (λ h, mt trailing_coeff_eq_zero.mp hp _),
    rwa [trailing_coeff, ←coeff_mul_X_pow] },
  { rw [nat_trailing_degree_eq_support_min' (λ h, hp (mul_X_pow_eq_zero h)), finset.le_min'_iff],
    intros y hy,
    have key : n ≤ y,
    { rw [mem_support_iff, coeff_mul_X_pow'] at hy,
      exact by_contra (λ h, hy (if_neg h)) },
    rw [mem_support_iff, coeff_mul_X_pow', if_pos key] at hy,
    exact (le_tsub_iff_right key).mp (nat_trailing_degree_le_of_ne_zero hy) },
end

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : R[X]}

@[simp] lemma trailing_degree_one : trailing_degree (1 : R[X]) = (0 : with_top ℕ) :=
trailing_degree_C one_ne_zero

@[simp] lemma trailing_degree_X : trailing_degree (X : R[X]) = 1 :=
trailing_degree_monomial one_ne_zero

@[simp] lemma nat_trailing_degree_X : (X : R[X]).nat_trailing_degree = 1 :=
nat_trailing_degree_monomial one_ne_zero

end nonzero_semiring

section ring
variables [ring R]

@[simp] lemma trailing_degree_neg (p : R[X]) : trailing_degree (-p) = trailing_degree p :=
by unfold trailing_degree; rw support_neg

@[simp] lemma nat_trailing_degree_neg (p : R[X]) :
  nat_trailing_degree (-p) = nat_trailing_degree p :=
by simp [nat_trailing_degree]

@[simp] lemma nat_trailing_degree_int_cast (n : ℤ) : nat_trailing_degree (n : R[X]) = 0 :=
by simp only [←C_eq_int_cast, nat_trailing_degree_C]

end ring

section semiring
variables [semiring R]

/-- The second-lowest coefficient, or 0 for constants -/
def next_coeff_up (p : R[X]) : R :=
if p.nat_trailing_degree = 0 then 0 else p.coeff (p.nat_trailing_degree + 1)

@[simp]
lemma next_coeff_up_C_eq_zero (c : R) :
  next_coeff_up (C c) = 0 := by { rw next_coeff_up, simp }

lemma next_coeff_up_of_pos_nat_trailing_degree (p : R[X]) (hp : 0 < p.nat_trailing_degree) :
  next_coeff_up p = p.coeff (p.nat_trailing_degree + 1) :=
by { rw [next_coeff_up, if_neg], contrapose! hp, simpa }

end semiring

section semiring
variables [semiring R] {p q : R[X]} {ι : Type*}

lemma coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt
  (h : trailing_degree p < trailing_degree q) :
  coeff q (nat_trailing_degree p) = 0 :=
coeff_eq_zero_of_trailing_degree_lt $ nat_trailing_degree_le_trailing_degree.trans_lt h

lemma ne_zero_of_trailing_degree_lt {n : with_top ℕ} (h : trailing_degree p < n) : p ≠ 0 :=
λ h₀, h.not_le (by simp [h₀])

end semiring
end polynomial