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

/-!
# Theory of univariate polynomials

The main defs here are `eval₂`, `eval`, and `map`.
We give several lemmas about their interaction with each other and with module operations.
-/

noncomputable theory

open finset add_monoid_algebra
open_locale big_operators polynomial

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

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

section
variables [semiring S]
variables (f : R →+* S) (x : S)

/-- Evaluate a polynomial `p` given a ring hom `f` from the scalar ring
  to the target and a value `x` for the variable in the target -/
def eval₂ (p : R[X]) : S :=
p.sum (λ e a, f a * x ^ e)

lemma eval₂_eq_sum {f : R →+* S} {x : S} : p.eval₂ f x = p.sum (λ e a, f a * x ^ e) := rfl

lemma eval₂_congr {R S : Type*} [semiring R] [semiring S]
  {f g : R →+* S} {s t : S} {φ ψ : R[X]} :
  f = g → s = t → φ = ψ → eval₂ f s φ = eval₂ g t ψ :=
by rintro rfl rfl rfl; refl

@[simp] lemma eval₂_at_zero : p.eval₂ f 0 = f (coeff p 0) :=
by simp only [eval₂_eq_sum, zero_pow_eq, mul_ite, mul_zero, mul_one, sum, not_not, mem_support_iff,
  sum_ite_eq', ite_eq_left_iff, ring_hom.map_zero, implies_true_iff, eq_self_iff_true]
  {contextual := tt}

@[simp] lemma eval₂_zero : (0 : R[X]).eval₂ f x = 0 :=
by simp [eval₂_eq_sum]

@[simp] lemma eval₂_C : (C a).eval₂ f x = f a :=
by simp [eval₂_eq_sum]

@[simp] lemma eval₂_X : X.eval₂ f x = x :=
by simp [eval₂_eq_sum]

@[simp] lemma eval₂_monomial {n : ℕ} {r : R} : (monomial n r).eval₂ f x = (f r) * x^n :=
by simp [eval₂_eq_sum]

@[simp] lemma eval₂_X_pow {n : ℕ} : (X^n).eval₂ f x = x^n :=
begin
  rw X_pow_eq_monomial,
  convert eval₂_monomial f x,
  simp,
end

@[simp] lemma eval₂_add : (p + q).eval₂ f x = p.eval₂ f x + q.eval₂ f x :=
by { apply sum_add_index; simp [add_mul] }

@[simp] lemma eval₂_one : (1 : R[X]).eval₂ f x = 1 :=
by rw [← C_1, eval₂_C, f.map_one]

@[simp] lemma eval₂_bit0 : (bit0 p).eval₂ f x = bit0 (p.eval₂ f x) :=
by rw [bit0, eval₂_add, bit0]

@[simp] lemma eval₂_bit1 : (bit1 p).eval₂ f x = bit1 (p.eval₂ f x) :=
by rw [bit1, eval₂_add, eval₂_bit0, eval₂_one, bit1]

@[simp] lemma eval₂_smul (g : R →+* S) (p : R[X]) (x : S) {s : R} :
  eval₂ g x (s • p) = g s * eval₂ g x p :=
begin
  have A : p.nat_degree < p.nat_degree.succ := nat.lt_succ_self _,
  have B : (s • p).nat_degree < p.nat_degree.succ := (nat_degree_smul_le _ _).trans_lt A,
  rw [eval₂_eq_sum, eval₂_eq_sum, sum_over_range' _ _ _ A, sum_over_range' _ _ _ B];
  simp [mul_sum, mul_assoc],
end

@[simp] lemma eval₂_C_X : eval₂ C X p = p :=
polynomial.induction_on' p (λ p q hp hq, by simp [hp, hq])
  (λ n x, by rw [eval₂_monomial, monomial_eq_smul_X, C_mul'])

/-- `eval₂_add_monoid_hom (f : R →+* S) (x : S)` is the `add_monoid_hom` from
`polynomial R` to `S` obtained by evaluating the pushforward of `p` along `f` at `x`. -/
@[simps] def eval₂_add_monoid_hom : R[X] →+ S :=
{ to_fun := eval₂ f x,
  map_zero' := eval₂_zero _ _,
  map_add' := λ _ _, eval₂_add _ _ }

@[simp] lemma eval₂_nat_cast (n : ℕ) : (n : R[X]).eval₂ f x = n :=
begin
  induction n with n ih,
  { simp only [eval₂_zero, nat.cast_zero] },
  { rw [n.cast_succ, eval₂_add, ih, eval₂_one, n.cast_succ] }
end

variables [semiring T]
lemma eval₂_sum (p : T[X]) (g : ℕ → T → R[X]) (x : S) :
  (p.sum g).eval₂ f x = p.sum (λ n a, (g n a).eval₂ f x) :=
begin
  let T : R[X] →+ S :=
    { to_fun := eval₂ f x, map_zero' := eval₂_zero _ _, map_add' := λ p q, eval₂_add _ _ },
  have A : ∀ y, eval₂ f x y = T y := λ y, rfl,
  simp only [A],
  rw [sum, T.map_sum, sum]
end

lemma eval₂_finset_sum (s : finset ι) (g : ι → R[X]) (x : S) :
  (∑ i in s, g i).eval₂ f x = ∑ i in s, (g i).eval₂ f x :=
begin
  classical,
  induction s using finset.induction with p hp s hs, simp,
  rw [sum_insert, eval₂_add, hs, sum_insert]; assumption,
end

lemma eval₂_of_finsupp {f : R →+* S} {x : S} {p : add_monoid_algebra R ℕ} :
  eval₂ f x (⟨p⟩ : R[X]) = lift_nc ↑f (powers_hom S x) p :=
by { simp only [eval₂_eq_sum, sum, to_finsupp_sum, support, coeff], refl }

lemma eval₂_mul_noncomm (hf : ∀ k, commute (f $ q.coeff k) x) :
  eval₂ f x (p * q) = eval₂ f x p * eval₂ f x q :=
begin
  rcases p, rcases q,
  simp only [coeff] at hf,
  simp only [←of_finsupp_mul, eval₂_of_finsupp],
  exact lift_nc_mul _ _ p q (λ k n hn, (hf k).pow_right n)
end

@[simp] lemma eval₂_mul_X : eval₂ f x (p * X) = eval₂ f x p * x :=
begin
  refine trans (eval₂_mul_noncomm _ _ $ λ k, _) (by rw eval₂_X),
  rcases em (k = 1) with (rfl|hk),
  { simp },
  { simp [coeff_X_of_ne_one hk] }
end

@[simp] lemma eval₂_X_mul : eval₂ f x (X * p) = eval₂ f x p * x :=
by rw [X_mul, eval₂_mul_X]

lemma eval₂_mul_C' (h : commute (f a) x) : eval₂ f x (p * C a) = eval₂ f x p * f a :=
begin
  rw [eval₂_mul_noncomm, eval₂_C],
  intro k,
  by_cases hk : k = 0,
  { simp only [hk, h, coeff_C_zero, coeff_C_ne_zero] },
  { simp only [coeff_C_ne_zero hk, ring_hom.map_zero, commute.zero_left] }
end

lemma eval₂_list_prod_noncomm (ps : list R[X])
  (hf : ∀ (p ∈ ps) k, commute (f $ coeff p k) x) :
  eval₂ f x ps.prod = (ps.map (polynomial.eval₂ f x)).prod :=
begin
  induction ps using list.reverse_rec_on with ps p ihp,
  { simp },
  { simp only [list.forall_mem_append, list.forall_mem_singleton] at hf,
    simp [eval₂_mul_noncomm _ _ hf.2, ihp hf.1] }
end

/-- `eval₂` as a `ring_hom` for noncommutative rings -/
def eval₂_ring_hom' (f : R →+* S) (x : S) (hf : ∀ a, commute (f a) x) : R[X] →+* S :=
{ to_fun := eval₂ f x,
  map_add' := λ _ _, eval₂_add _ _,
  map_zero' := eval₂_zero _ _,
  map_mul' := λ p q, eval₂_mul_noncomm f x (λ k, hf $ coeff q k),
  map_one' := eval₂_one _ _ }

end

/-!
We next prove that eval₂ is multiplicative
as long as target ring is commutative
(even if the source ring is not).
-/
section eval₂
variables [comm_semiring S]
variables (f : R →+* S) (x : S)

@[simp] lemma eval₂_mul : (p * q).eval₂ f x = p.eval₂ f x * q.eval₂ f x :=
eval₂_mul_noncomm _ _ $ λ k, commute.all _ _

lemma eval₂_mul_eq_zero_of_left (q : R[X]) (hp : p.eval₂ f x = 0) :
  (p * q).eval₂ f x = 0 :=
begin
  rw eval₂_mul f x,
  exact mul_eq_zero_of_left hp (q.eval₂ f x)
end

lemma eval₂_mul_eq_zero_of_right (p : R[X]) (hq : q.eval₂ f x = 0) :
  (p * q).eval₂ f x = 0 :=
begin
  rw eval₂_mul f x,
  exact mul_eq_zero_of_right (p.eval₂ f x) hq
end

/-- `eval₂` as a `ring_hom` -/
def eval₂_ring_hom (f : R →+* S) (x : S) : R[X] →+* S :=
{ map_one' := eval₂_one _ _,
  map_mul' := λ _ _, eval₂_mul _ _,
  ..eval₂_add_monoid_hom f x }

@[simp] lemma coe_eval₂_ring_hom (f : R →+* S) (x) : ⇑(eval₂_ring_hom f x) = eval₂ f x := rfl

lemma eval₂_pow (n : ℕ) : (p ^ n).eval₂ f x = p.eval₂ f x ^ n := (eval₂_ring_hom _ _).map_pow _ _

lemma eval₂_eq_sum_range :
  p.eval₂ f x = ∑ i in finset.range (p.nat_degree + 1), f (p.coeff i) * x^i :=
trans (congr_arg _ p.as_sum_range) (trans (eval₂_finset_sum f _ _ x) (congr_arg _ (by simp)))

lemma eval₂_eq_sum_range' (f : R →+* S) {p : R[X]} {n : ℕ} (hn : p.nat_degree < n) (x : S) :
  eval₂ f x p = ∑ i in finset.range n, f (p.coeff i) * x ^ i :=
begin
  rw [eval₂_eq_sum, p.sum_over_range' _ _ hn],
  intro i,
  rw [f.map_zero, zero_mul]
end

lemma eval₂_dvd : p ∣ q → eval₂ f x p ∣ eval₂ f x q :=
(eval₂_ring_hom f x).map_dvd

lemma eval₂_eq_zero_of_dvd_of_eval₂_eq_zero (h : p ∣ q) (h0 : eval₂ f x p = 0) :
  eval₂ f x q = 0 :=
zero_dvd_iff.mp (h0 ▸ eval₂_dvd f x h)

end eval₂

section eval
variables {x : R}

/-- `eval x p` is the evaluation of the polynomial `p` at `x` -/
def eval : R → R[X] → R := eval₂ (ring_hom.id _)

lemma eval_eq_sum : p.eval x = p.sum (λ e a, a * x ^ e) :=
rfl

lemma eval_eq_sum_range {p : R[X]} (x : R) :
  p.eval x = ∑ i in finset.range (p.nat_degree + 1), p.coeff i * x ^ i :=
by rw [eval_eq_sum, sum_over_range]; simp

lemma eval_eq_sum_range' {p : R[X]} {n : ℕ} (hn : p.nat_degree < n) (x : R) :
  p.eval x = ∑ i in finset.range n, p.coeff i * x ^ i :=
by rw [eval_eq_sum, p.sum_over_range' _ _ hn]; simp

@[simp] lemma eval₂_at_apply {S : Type*} [semiring S] (f : R →+* S) (r : R) :
  p.eval₂ f (f r) = f (p.eval r) :=
begin
  rw [eval₂_eq_sum, eval_eq_sum, sum, sum, f.map_sum],
  simp only [f.map_mul, f.map_pow],
end

@[simp] lemma eval₂_at_one {S : Type*} [semiring S] (f : R →+* S) : p.eval₂ f 1 = f (p.eval 1) :=
begin
  convert eval₂_at_apply f 1,
  simp,
end

@[simp] lemma eval₂_at_nat_cast {S : Type*} [semiring S] (f : R →+* S) (n : ℕ) :
  p.eval₂ f n = f (p.eval n) :=
begin
  convert eval₂_at_apply f n,
  simp,
end

@[simp] lemma eval_C : (C a).eval x = a := eval₂_C _ _

@[simp] lemma eval_nat_cast {n : ℕ} : (n : R[X]).eval x = n :=
by simp only [←C_eq_nat_cast, eval_C]

@[simp] lemma eval_X : X.eval x = x := eval₂_X _ _

@[simp] lemma eval_monomial {n a} : (monomial n a).eval x = a * x^n :=
eval₂_monomial _ _

@[simp] lemma eval_zero : (0 : R[X]).eval x = 0 :=  eval₂_zero _ _

@[simp] lemma eval_add : (p + q).eval x = p.eval x + q.eval x := eval₂_add _ _

@[simp] lemma eval_one : (1 : R[X]).eval x = 1 := eval₂_one _ _

@[simp] lemma eval_bit0 : (bit0 p).eval x = bit0 (p.eval x) := eval₂_bit0 _ _

@[simp] lemma eval_bit1 : (bit1 p).eval x = bit1 (p.eval x) := eval₂_bit1 _ _

@[simp] lemma eval_smul (p : R[X]) (x : R) {s : R} :
  (s • p).eval x = s * p.eval x :=
eval₂_smul (ring_hom.id _) _ _

@[simp] lemma eval_C_mul : (C a * p).eval x = a * p.eval x :=
begin
  apply polynomial.induction_on' p,
  { intros p q ph qh,
    simp only [mul_add, eval_add, ph, qh], },
  { intros n b,
    simp only [mul_assoc, C_mul_monomial, eval_monomial], }
end

/-- `polynomial.eval` as linear map -/
@[simps] def leval {R : Type*} [semiring R] (r : R) : R[X] →ₗ[R] R :=
{ to_fun := λ f, f.eval r,
  map_add' := λ f g, eval_add,
  map_smul' := λ c f, eval_smul f r }

@[simp] lemma eval_nat_cast_mul {n : ℕ} : ((n : R[X]) * p).eval x = n * p.eval x :=
by rw [←C_eq_nat_cast, eval_C_mul]

@[simp] lemma eval_mul_X : (p * X).eval x = p.eval x * x :=
begin
  apply polynomial.induction_on' p,
  { intros p q ph qh,
    simp only [add_mul, eval_add, ph, qh], },
  { intros n a,
    simp only [←monomial_one_one_eq_X, monomial_mul_monomial, eval_monomial,
      mul_one, pow_succ', mul_assoc], }
end

@[simp] lemma eval_mul_X_pow {k : ℕ} : (p * X^k).eval x = p.eval x * x^k :=
begin
  induction k with k ih,
  { simp, },
  { simp [pow_succ', ←mul_assoc, ih], }
end

lemma eval_sum (p : R[X]) (f : ℕ → R → R[X]) (x : R) :
  (p.sum f).eval x = p.sum (λ n a, (f n a).eval x) :=
eval₂_sum _ _ _ _

lemma eval_finset_sum (s : finset ι) (g : ι → R[X]) (x : R) :
  (∑ i in s, g i).eval x = ∑ i in s, (g i).eval x := eval₂_finset_sum _ _ _ _

/-- `is_root p x` implies `x` is a root of `p`. The evaluation of `p` at `x` is zero -/
def is_root (p : R[X]) (a : R) : Prop := p.eval a = 0

instance [decidable_eq R] : decidable (is_root p a) := by unfold is_root; apply_instance

@[simp] lemma is_root.def : is_root p a ↔ p.eval a = 0 := iff.rfl

lemma is_root.eq_zero (h : is_root p x) : eval x p = 0 := h

lemma coeff_zero_eq_eval_zero (p : R[X]) :
  coeff p 0 = p.eval 0 :=
calc coeff p 0 = coeff p 0 * 0 ^ 0 : by simp
... = p.eval 0 : eq.symm $
  finset.sum_eq_single _ (λ b _ hb, by simp [zero_pow (nat.pos_of_ne_zero hb)]) (by simp)

lemma zero_is_root_of_coeff_zero_eq_zero {p : R[X]} (hp : p.coeff 0 = 0) :
  is_root p 0 :=
by rwa coeff_zero_eq_eval_zero at hp

lemma is_root.dvd {R : Type*} [comm_semiring R] {p q : R[X]} {x : R}
  (h : p.is_root x) (hpq : p ∣ q) : q.is_root x :=
by rwa [is_root, eval, eval₂_eq_zero_of_dvd_of_eval₂_eq_zero _ _ hpq]

lemma not_is_root_C (r a : R) (hr : r ≠ 0) : ¬ is_root (C r) a :=
by simpa using hr

end eval

section comp

/-- The composition of polynomials as a polynomial. -/
def comp (p q : R[X]) : R[X] := p.eval₂ C q

lemma comp_eq_sum_left : p.comp q = p.sum (λ e a, C a * q ^ e) :=
rfl

@[simp] lemma comp_X : p.comp X = p :=
begin
  simp only [comp, eval₂, ← monomial_eq_C_mul_X],
  exact sum_monomial_eq _,
end

@[simp] lemma X_comp : X.comp p = p := eval₂_X _ _

@[simp] lemma comp_C : p.comp (C a) = C (p.eval a) :=
by simp [comp, (C : R →+* _).map_sum]

@[simp] lemma C_comp : (C a).comp p = C a := eval₂_C _ _

@[simp] lemma nat_cast_comp {n : ℕ} : (n : R[X]).comp p = n :=
by rw [←C_eq_nat_cast, C_comp]

@[simp] lemma comp_zero : p.comp (0 : R[X]) = C (p.eval 0) :=
by rw [← C_0, comp_C]

@[simp] lemma zero_comp : comp (0 : R[X]) p = 0 :=
by rw [← C_0, C_comp]

@[simp] lemma comp_one : p.comp 1 = C (p.eval 1) :=
by rw [← C_1, comp_C]

@[simp] lemma one_comp : comp (1 : R[X]) p = 1 :=
by rw [← C_1, C_comp]

@[simp] lemma add_comp : (p + q).comp r = p.comp r + q.comp r := eval₂_add _ _

@[simp] lemma monomial_comp (n : ℕ) : (monomial n a).comp p = C a * p^n :=
eval₂_monomial _ _

@[simp] lemma mul_X_comp : (p * X).comp r = p.comp r * r :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp only [hp, hq, add_mul, add_comp] },
  { intros n b, simp only [pow_succ', mul_assoc, monomial_mul_X, monomial_comp] }
end

@[simp] lemma X_pow_comp {k : ℕ} : (X^k).comp p = p^k :=
begin
  induction k with k ih,
  { simp, },
  { simp [pow_succ', mul_X_comp, ih], },
end

@[simp] lemma mul_X_pow_comp {k : ℕ} : (p * X^k).comp r = p.comp r * r^k :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih, pow_succ', ←mul_assoc, mul_X_comp], },
end

@[simp] lemma C_mul_comp : (C a * p).comp r = C a * p.comp r :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp [hp, hq, mul_add], },
  { intros n b, simp [mul_assoc], }
end

@[simp] lemma nat_cast_mul_comp {n : ℕ} : ((n : R[X]) * p).comp r = n * p.comp r :=
by rw [←C_eq_nat_cast, C_mul_comp, C_eq_nat_cast]

@[simp] lemma mul_comp {R : Type*} [comm_semiring R] (p q r : R[X]) :
  (p * q).comp r = p.comp r * q.comp r := eval₂_mul _ _

lemma prod_comp {R : Type*} [comm_semiring R] (s : multiset R[X]) (p : R[X]) :
  s.prod.comp p = (s.map (λ q : R[X], q.comp p)).prod :=
(s.prod_hom (monoid_hom.mk (λ q : R[X], q.comp p) one_comp (λ q r, mul_comp q r p))).symm

@[simp] lemma pow_comp {R : Type*} [comm_semiring R] (p q : R[X]) (n : ℕ) :
  (p^n).comp q = (p.comp q)^n :=
((monoid_hom.mk (λ r : R[X], r.comp q)) one_comp (λ r s, mul_comp r s q)).map_pow p n

@[simp] lemma bit0_comp : comp (bit0 p : R[X]) q = bit0 (p.comp q) :=
by simp only [bit0, add_comp]

@[simp] lemma bit1_comp : comp (bit1 p : R[X]) q = bit1 (p.comp q) :=
by simp only [bit1, add_comp, bit0_comp, one_comp]

lemma comp_assoc {R : Type*} [comm_semiring R] (φ ψ χ : R[X]) :
  (φ.comp ψ).comp χ = φ.comp (ψ.comp χ) :=
begin
  apply polynomial.induction_on φ;
  { intros, simp only [add_comp, mul_comp, C_comp, X_comp, pow_succ', ← mul_assoc, *] at * }
end

lemma coeff_comp_degree_mul_degree (hqd0 : nat_degree q ≠ 0) :
  coeff (p.comp q) (nat_degree p * nat_degree q) =
  leading_coeff p * leading_coeff q ^ nat_degree p :=
begin
  rw [comp, eval₂, coeff_sum],
  convert finset.sum_eq_single p.nat_degree _ _,
  { simp only [coeff_nat_degree, coeff_C_mul, coeff_pow_mul_nat_degree] },
  { assume b hbs hbp,
    refine coeff_eq_zero_of_nat_degree_lt ((nat_degree_mul_le).trans_lt _),
    rw [nat_degree_C, zero_add],
    refine (nat_degree_pow_le).trans_lt ((mul_lt_mul_right (pos_iff_ne_zero.mpr hqd0)).mpr _),
    exact lt_of_le_of_ne (le_nat_degree_of_mem_supp _ hbs) hbp },
  { simp {contextual := tt} }
end

end comp

section map
variables [semiring S]
variables (f : R →+* S)

/-- `map f p` maps a polynomial `p` across a ring hom `f` -/
def map : R[X] → S[X] := eval₂ (C.comp f) X

@[simp] lemma map_C : (C a).map f = C (f a) := eval₂_C _ _

@[simp] lemma map_X : X.map f = X := eval₂_X _ _

@[simp] lemma map_monomial {n a} : (monomial n a).map f = monomial n (f a) :=
begin
  dsimp only [map],
  rw [eval₂_monomial, monomial_eq_C_mul_X], refl,
end

@[simp] lemma map_zero : (0 : R[X]).map f = 0 :=  eval₂_zero _ _

@[simp] lemma map_add : (p + q).map f = p.map f + q.map f := eval₂_add _ _

@[simp] lemma map_one : (1 : R[X]).map f = 1 := eval₂_one _ _

@[simp] lemma map_mul : (p * q).map f = p.map f * q.map f :=
by { rw [map, eval₂_mul_noncomm], exact λ k, (commute_X _).symm }

@[simp] lemma map_smul (r : R) : (r • p).map f = f r • p.map f :=
by rw [map, eval₂_smul, ring_hom.comp_apply, C_mul']

/-- `polynomial.map` as a `ring_hom`. -/
-- `map` is a ring-hom unconditionally, and theoretically the definition could be replaced,
-- but this turns out not to be easy because `p.map f` does not resolve to `polynomial.map`
-- if `map` is a `ring_hom` instead of a plain function; the elaborator does not try to coerce
-- to a function before trying field (dot) notation (this may be technically infeasible);
-- the relevant code is (both lines): https://github.com/leanprover-community/
-- lean/blob/487ac5d7e9b34800502e1ddf3c7c806c01cf9d51/src/frontends/lean/elaborator.cpp#L1876-L1913
def map_ring_hom (f : R →+* S) : R[X] →+* S[X] :=
{ to_fun := polynomial.map f,
  map_add' := λ _ _, map_add f,
  map_zero' := map_zero f,
  map_mul' := λ _ _, map_mul f,
  map_one' := map_one f }

@[simp] lemma coe_map_ring_hom (f : R →+* S) : ⇑(map_ring_hom f) = map f := rfl

-- This is protected to not clash with the global `map_nat_cast`.
@[simp] protected theorem map_nat_cast (n : ℕ) : (n : R[X]).map f = n :=
map_nat_cast (map_ring_hom f) n

@[simp]
lemma coeff_map (n : ℕ) : coeff (p.map f) n = f (coeff p n) :=
begin
  rw [map, eval₂, coeff_sum, sum],
  conv_rhs { rw [← sum_C_mul_X_eq p, coeff_sum, sum, ring_hom.map_sum], },
  refine finset.sum_congr rfl (λ x hx, _),
  simp [function.comp, coeff_C_mul_X_pow, f.map_mul],
  split_ifs; simp [f.map_zero],
end

/-- If `R` and `S` are isomorphic, then so are their polynomial rings. -/
@[simps] def map_equiv (e : R ≃+* S) : R[X] ≃+* S[X] :=
ring_equiv.of_hom_inv
  (map_ring_hom e)
  (map_ring_hom e.symm)
  (by ext; simp)
  (by ext; simp)

lemma map_map [semiring T] (g : S →+* T)
  (p : R[X]) : (p.map f).map g = p.map (g.comp f) :=
ext (by simp [coeff_map])

@[simp] lemma map_id : p.map (ring_hom.id _) = p := by simp [polynomial.ext_iff, coeff_map]

lemma eval₂_eq_eval_map {x : S} : p.eval₂ f x = (p.map f).eval x :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp [hp, hq], },
  { intros n r, simp, }
end

lemma map_injective (hf : function.injective f) : function.injective (map f) :=
λ p q h, ext $ λ m, hf $ by rw [← coeff_map f, ← coeff_map f, h]

lemma map_surjective (hf : function.surjective f) : function.surjective (map f) :=
λ p, polynomial.induction_on' p
 (λ p q hp hq, let ⟨p', hp'⟩ := hp, ⟨q', hq'⟩ := hq in ⟨p' + q', by rw [map_add f, hp', hq']⟩)
 (λ n s, let ⟨r, hr⟩ := hf s in ⟨monomial n r, by rw [map_monomial f, hr]⟩)

lemma degree_map_le (p : R[X]) : degree (p.map f) ≤ 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_map_le (p : R[X]) : nat_degree (p.map f) ≤ nat_degree p :=
nat_degree_le_nat_degree (degree_map_le f p)

variables {f}

lemma map_monic_eq_zero_iff (hp : p.monic) : p.map f = 0 ↔ ∀ x, f x = 0 :=
⟨ λ hfp x, calc f x = f x * f p.leading_coeff : by simp only [mul_one, hp.leading_coeff, f.map_one]
                ... = f x * (p.map f).coeff p.nat_degree : congr_arg _ (coeff_map _ _).symm
                ... = 0 : by simp only [hfp, mul_zero, coeff_zero],
  λ h, ext (λ n, by simp only [h, coeff_map, coeff_zero]) ⟩

lemma map_monic_ne_zero (hp : p.monic) [nontrivial S] : p.map f ≠ 0 :=
λ h, f.map_one_ne_zero ((map_monic_eq_zero_iff hp).mp h _)

lemma degree_map_eq_of_leading_coeff_ne_zero (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : degree (p.map f) = degree p :=
le_antisymm (degree_map_le f _) $
  have hp0 : p ≠ 0, from leading_coeff_ne_zero.mp (λ hp0, hf (trans (congr_arg _ hp0) f.map_zero)),
  begin
    rw [degree_eq_nat_degree hp0],
    refine le_degree_of_ne_zero _,
    rw [coeff_map], exact hf
  end

lemma nat_degree_map_of_leading_coeff_ne_zero (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero f hf)

lemma leading_coeff_map_of_leading_coeff_ne_zero (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  unfold leading_coeff,
  rw [coeff_map, nat_degree_map_of_leading_coeff_ne_zero f hf],
end

variables (f)

@[simp] lemma map_ring_hom_id : map_ring_hom (ring_hom.id R) = ring_hom.id R[X] :=
ring_hom.ext $ λ x, map_id

@[simp] lemma map_ring_hom_comp [semiring T] (f : S →+* T) (g : R →+* S) :
  (map_ring_hom f).comp (map_ring_hom g) = map_ring_hom (f.comp g) :=
ring_hom.ext $ polynomial.map_map g f

lemma map_list_prod (L : list R[X]) : L.prod.map f = (L.map $ map f).prod :=
eq.symm $ list.prod_hom _ (map_ring_hom f).to_monoid_hom

@[simp] protected lemma map_pow (n : ℕ) : (p ^ n).map f = p.map f ^ n :=
(map_ring_hom f).map_pow _ _

lemma mem_map_srange {p : S[X]} :
  p ∈ (map_ring_hom f).srange ↔ ∀ n, p.coeff n ∈ f.srange :=
begin
  split,
  { rintro ⟨p, rfl⟩ n, rw [coe_map_ring_hom, coeff_map], exact set.mem_range_self _ },
  { intro h, rw p.as_sum_range_C_mul_X_pow,
    refine (map_ring_hom f).srange.sum_mem _,
    intros i hi,
    rcases h i with ⟨c, hc⟩,
    use [C c * X^i],
    rw [coe_map_ring_hom, map_mul, map_C, hc, polynomial.map_pow, map_X] }
end

lemma mem_map_range {R S : Type*} [ring R] [ring S] (f : R →+* S)
  {p : S[X]} : p ∈ (map_ring_hom f).range ↔ ∀ n, p.coeff n ∈ f.range :=
mem_map_srange f

lemma eval₂_map [semiring T] (g : S →+* T) (x : T) :
  (p.map f).eval₂ g x = p.eval₂ (g.comp f) x :=
by rw [eval₂_eq_eval_map, eval₂_eq_eval_map, map_map]

lemma eval_map (x : S) : (p.map f).eval x = p.eval₂ f x :=
(eval₂_eq_eval_map f).symm

protected lemma map_sum {ι : Type*} (g : ι → R[X]) (s : finset ι) :
  (∑ i in s, g i).map f = ∑ i in s, (g i).map f :=
(map_ring_hom f).map_sum _ _

lemma map_comp (p q : R[X]) : map f (p.comp q) = (map f p).comp (map f q) :=
polynomial.induction_on p
  (by simp only [map_C, forall_const, C_comp, eq_self_iff_true])
  (by simp only [map_add, add_comp, forall_const, implies_true_iff, eq_self_iff_true]
        {contextual := tt})
  (by simp only [pow_succ', ←mul_assoc, comp, forall_const, eval₂_mul_X, implies_true_iff,
        eq_self_iff_true, map_X, map_mul] {contextual := tt})

@[simp]
lemma eval_zero_map (f : R →+* S) (p : R[X]) :
  (p.map f).eval 0 = f (p.eval 0) :=
by simp [←coeff_zero_eq_eval_zero]

@[simp]
lemma eval_one_map (f : R →+* S) (p : R[X]) :
  (p.map f).eval 1 = f (p.eval 1) :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp only [hp, hq, map_add, ring_hom.map_add, eval_add] },
  { intros n r, simp only [one_pow, mul_one, eval_monomial, map_monomial] }
end

@[simp]
lemma eval_nat_cast_map (f : R →+* S) (p : R[X]) (n : ℕ) :
  (p.map f).eval n = f (p.eval n) :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp only [hp, hq, map_add, ring_hom.map_add, eval_add] },
  { intros n r, simp only [map_nat_cast f, eval_monomial, map_monomial, f.map_pow, f.map_mul] }
end

@[simp]
lemma eval_int_cast_map {R S : Type*} [ring R] [ring S]
  (f : R →+* S) (p : R[X]) (i : ℤ) :
  (p.map f).eval i = f (p.eval i) :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, simp only [hp, hq, map_add, ring_hom.map_add, eval_add] },
  { intros n r, simp only [f.map_int_cast, eval_monomial, map_monomial, f.map_pow, f.map_mul] }
end

end map

/-!
After having set up the basic theory of `eval₂`, `eval`, `comp`, and `map`,
we make `eval₂` irreducible.

Perhaps we can make the others irreducible too?
-/
attribute [irreducible] polynomial.eval₂

section hom_eval₂

variables [semiring S] [semiring T]  (f : R →+* S) (g : S →+* T) (p)

lemma hom_eval₂ (x : S) : g (p.eval₂ f x) = p.eval₂ (g.comp f) (g x) :=
by rw [←eval₂_map, eval₂_at_apply, eval_map]

end hom_eval₂

end semiring

section comm_semiring

section eval

variables [comm_semiring R] {p q : R[X]} {x : R}

lemma eval₂_comp [comm_semiring S] (f : R →+* S) {x : S} :
  eval₂ f x (p.comp q) = eval₂ f (eval₂ f x q) p :=
by rw [comp, p.as_sum_range]; simp [eval₂_finset_sum, eval₂_pow]

@[simp] lemma eval_mul : (p * q).eval x = p.eval x * q.eval x := eval₂_mul _ _

/-- `eval r`, regarded as a ring homomorphism from `polynomial R` to `R`. -/
def eval_ring_hom : R → R[X] →+* R := eval₂_ring_hom (ring_hom.id _)

@[simp] lemma coe_eval_ring_hom (r : R) : ((eval_ring_hom r) : R[X] → R) = eval r := rfl

@[simp] lemma eval_pow (n : ℕ) : (p ^ n).eval x = p.eval x ^ n := eval₂_pow _ _ _

@[simp]
lemma eval_comp : (p.comp q).eval x = p.eval (q.eval x) :=
begin
  apply polynomial.induction_on' p,
  { intros r s hr hs, simp [add_comp, hr, hs], },
  { intros n a, simp, }
end

/-- `comp p`, regarded as a ring homomorphism from `polynomial R` to itself. -/
def comp_ring_hom : R[X] → R[X] →+* R[X] :=
eval₂_ring_hom C

lemma eval₂_hom [comm_semiring S] (f : R →+* S) (x : R) :
  p.eval₂ f (f x) = f (p.eval x) :=
(ring_hom.comp_id f) ▸ (hom_eval₂ p (ring_hom.id R) f x).symm

lemma root_mul_left_of_is_root (p : R[X]) {q : R[X]} :
  is_root q a → is_root (p * q) a :=
λ H, by rw [is_root, eval_mul, is_root.def.1 H, mul_zero]

lemma root_mul_right_of_is_root {p : R[X]} (q : R[X]) :
  is_root p a → is_root (p * q) a :=
λ H, by rw [is_root, eval_mul, is_root.def.1 H, zero_mul]

/--
Polynomial evaluation commutes with `list.prod`
-/
lemma eval_list_prod (l : list R[X]) (x : R) :
  eval x l.prod = (l.map (eval x)).prod :=
(eval_ring_hom x).map_list_prod l

/--
Polynomial evaluation commutes with `multiset.prod`
-/

/--
Polynomial evaluation commutes with `finset.prod`
-/
lemma eval_prod {ι : Type*} (s : finset ι) (p : ι → R[X]) (x : R) :
  eval x (∏ j in s, p j) = ∏ j in s, eval x (p j) :=
(eval_ring_hom x).map_prod _ _

lemma is_root_prod {R} [comm_ring R] [is_domain R] {ι : Type*}
  (s : finset ι) (p : ι → R[X]) (x : R) :
  is_root (∏ j in s, p j) x ↔ ∃ i ∈ s, is_root (p i) x :=
by simp only [is_root, eval_prod, finset.prod_eq_zero_iff]

lemma eval_dvd : p ∣ q → eval x p ∣ eval x q :=
eval₂_dvd _ _

lemma eval_eq_zero_of_dvd_of_eval_eq_zero : p ∣ q → eval x p = 0 → eval x q = 0 :=
eval₂_eq_zero_of_dvd_of_eval₂_eq_zero _ _

@[simp]
lemma eval_geom_sum {R} [comm_semiring R] {n : ℕ} {x : R} : eval x (geom_sum X n) = geom_sum x n :=
by simp [geom_sum_def, eval_finset_sum]

end eval

section map

--TODO rename to `map_dvd_map`
lemma map_dvd {R S} [semiring R] [comm_semiring S] (f : R →+* S) {x y : R[X]} :
  x ∣ y → x.map f ∣ y.map f := eval₂_dvd _ _

variables [comm_semiring R] [comm_semiring S] (f : R →+* S)

protected lemma map_multiset_prod (m : multiset R[X]) : m.prod.map f = (m.map $ map f).prod :=
eq.symm $ multiset.prod_hom _ (map_ring_hom f).to_monoid_hom

protected lemma map_prod {ι : Type*} (g : ι → R[X]) (s : finset ι) :
  (∏ i in s, g i).map f = ∏ i in s, (g i).map f :=
(map_ring_hom f).map_prod _ _

lemma support_map_subset (p : R[X]) : (map f p).support ⊆ p.support :=
begin
  intros x,
  contrapose!,
  simp { contextual := tt },
end

lemma is_root.map {f : R →+* S} {x : R} {p : R[X]} (h : is_root p x) :
  is_root (p.map f) (f x) :=
by rw [is_root, eval_map, eval₂_hom, h.eq_zero, f.map_zero]

lemma is_root.of_map {R} [comm_ring R] {f : R →+* S} {x : R} {p : R[X]}
  (h : is_root (p.map f) (f x)) (hf : function.injective f) : is_root p x :=
by rwa [is_root, ←f.injective_iff'.mp hf, ←eval₂_hom, ←eval_map]

lemma is_root_map_iff {R : Type*} [comm_ring R] {f : R →+* S} {x : R} {p : R[X]}
  (hf : function.injective f) : is_root (p.map f) (f x) ↔ is_root p x :=
⟨λ h, h.of_map hf, λ h, h.map⟩

end map

end comm_semiring

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

lemma C_neg : C (-a) = -C a := ring_hom.map_neg C a

lemma C_sub : C (a - b) = C a - C b := ring_hom.map_sub C a b

@[simp] lemma map_sub {S} [ring S] (f : R →+* S) :
  (p - q).map f = p.map f - q.map f :=
(map_ring_hom f).map_sub p q

@[simp] lemma map_neg {S} [ring S] (f : R →+* S) :
  (-p).map f = -(p.map f) :=
(map_ring_hom f).map_neg p

@[simp] lemma map_int_cast {S} [ring S] (f : R →+* S) (n : ℤ) :
  map f ↑n = ↑n :=
(map_ring_hom f).map_int_cast n

@[simp] lemma eval_int_cast {n : ℤ} {x : R} : (n : R[X]).eval x = n :=
by simp only [←C_eq_int_cast, eval_C]

@[simp] lemma eval₂_neg {S} [ring S] (f : R →+* S) {x : S} :
  (-p).eval₂ f x = -p.eval₂ f x :=
by rw [eq_neg_iff_add_eq_zero, ←eval₂_add, add_left_neg, eval₂_zero]

@[simp] lemma eval₂_sub {S} [ring S] (f : R →+* S) {x : S} :
  (p - q).eval₂ f x = p.eval₂ f x - q.eval₂ f x :=
by rw [sub_eq_add_neg, eval₂_add, eval₂_neg, sub_eq_add_neg]

@[simp] lemma eval_neg (p : R[X]) (x : R) : (-p).eval x = -p.eval x :=
eval₂_neg _

@[simp] lemma eval_sub (p q : R[X]) (x : R) : (p - q).eval x = p.eval x - q.eval x :=
eval₂_sub _

lemma root_X_sub_C : is_root (X - C a) b ↔ a = b :=
by rw [is_root.def, eval_sub, eval_X, eval_C, sub_eq_zero, eq_comm]

@[simp] lemma neg_comp : (-p).comp q = -p.comp q := eval₂_neg _

@[simp] lemma sub_comp : (p - q).comp r = p.comp r - q.comp r := eval₂_sub _

@[simp] lemma cast_int_comp (i : ℤ) : comp (i : R[X]) p = i :=
by cases i; simp

end ring

end polynomial


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

! This file was ported from Lean 3 source module tactic.omega.misc
! leanprover-community/mathlib commit a0735864ba72769da4b378673d3dbe2453924fde
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Localized

/-
Miscellaneous.
-/
variable {α β γ : Type}

namespace Omega

theorem fun_mono_2 {p : α → β → γ} {a1 a2 : α} {b1 b2 : β} :
    a1 = a2 → b1 = b2 → p a1 b1 = p a2 b2 := fun h1 h2 => by rw [h1, h2]
#align omega.fun_mono_2 Omega.fun_mono_2

theorem pred_mono_2 {p : α → β → Prop} {a1 a2 : α} {b1 b2 : β} :
    a1 = a2 → b1 = b2 → (p a1 b1 ↔ p a2 b2) := fun h1 h2 => by rw [h1, h2]
#align omega.pred_mono_2 Omega.pred_mono_2

theorem pred_mono_2' {c : Prop → Prop → Prop} {a1 a2 b1 b2 : Prop} :
    (a1 ↔ a2) → (b1 ↔ b2) → (c a1 b1 ↔ c a2 b2) := fun h1 h2 => by rw [h1, h2]
#align omega.pred_mono_2' Omega.pred_mono_2'

/-- Update variable assignment for a specific variable
    and leave everything else unchanged -/
def update (m : Nat) (a : α) (v : Nat → α) : Nat → α
  | n => if n = m then a else v n
#align omega.update Omega.update

-- mathport name: omega.update
scoped notation v " ⟨" m " ↦ " a "⟩" => Omega.update m a v

theorem update_eq (m : Nat) (a : α) (v : Nat → α) : (v ⟨m ↦ a⟩) m = a := by
  simp only [update, if_pos rfl]
#align omega.update_eq Omega.update_eq

theorem update_eq_of_ne {m : Nat} {a : α} {v : Nat → α} (k : Nat) : k ≠ m → update m a v k = v k :=
  by
  intro h1
  unfold update
  rw [if_neg h1]
#align omega.update_eq_of_ne Omega.update_eq_of_ne

/-- Assign a new value to the zeroth variable, and push all
    other assignments up by 1 -/
def updateZero (a : α) (v : Nat → α) : Nat → α
  | 0 => a
  | k + 1 => v k
#align omega.update_zero Omega.updateZero

open Tactic

/-- Intro with a fresh name -/
unsafe def intro_fresh : tactic Unit := do
  let n ← mk_fresh_name
  intro n
  skip
#align omega.intro_fresh omega.intro_fresh

/-- Revert an expr if it passes the given test -/
unsafe def revert_cond (t : expr → tactic Unit) (x : expr) : tactic Unit :=
  (t x >> revert x) >> skip <|> skip
#align omega.revert_cond omega.revert_cond

/-- Revert all exprs in the context that pass the given test -/
unsafe def revert_cond_all (t : expr → tactic Unit) : tactic Unit := do
  let hs ← local_context
  mmap (revert_cond t) hs
  skip
#align omega.revert_cond_all omega.revert_cond_all

/-- Try applying a tactic to each of the element in a list
    until success, and return the first successful result -/
unsafe def app_first {α β : Type} (t : α → tactic β) : List α → tactic β
  | [] => failed
  | a :: as => t a <|> app_first as
#align omega.app_first omega.app_first

end Omega


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes, Floris van Doorn, Yaël Dillies

! This file was ported from Lean 3 source module data.nat.factorial.basic
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Basic
import Mathbin.Data.Nat.Pow

/-!
# Factorial and variants

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

This file defines the factorial, along with the ascending and descending variants.

## Main declarations

* `nat.factorial`: The factorial.
* `nat.asc_factorial`: The ascending factorial. Note that it runs from `n + 1` to `n + k`
  and *not* from `n` to `n + k - 1`. We might want to change that in the future.
* `nat.desc_factorial`: The descending factorial. It runs from `n - k` to `n`.
-/

namespace Nat

#print Nat.factorial /-
/-- `nat.factorial n` is the factorial of `n`. -/
@[simp]
def factorial : ℕ → ℕ
  | 0 => 1
  | succ n => succ n * factorial n
#align nat.factorial Nat.factorial
-/

-- mathport name: nat.factorial
scoped notation:10000 n "!" => Nat.factorial n

section Factorial

variable {m n : ℕ}

#print Nat.factorial_zero /-
@[simp]
theorem factorial_zero : 0! = 1 :=
  rfl
#align nat.factorial_zero Nat.factorial_zero
-/

#print Nat.factorial_succ /-
@[simp]
theorem factorial_succ (n : ℕ) : n.succ ! = (n + 1) * n ! :=
  rfl
#align nat.factorial_succ Nat.factorial_succ
-/

#print Nat.factorial_one /-
@[simp]
theorem factorial_one : 1! = 1 :=
  rfl
#align nat.factorial_one Nat.factorial_one
-/

#print Nat.factorial_two /-
@[simp]
theorem factorial_two : 2! = 2 :=
  rfl
#align nat.factorial_two Nat.factorial_two
-/

#print Nat.mul_factorial_pred /-
theorem mul_factorial_pred (hn : 0 < n) : n * (n - 1)! = n ! :=
  tsub_add_cancel_of_le (Nat.succ_le_of_lt hn) ▸ rfl
#align nat.mul_factorial_pred Nat.mul_factorial_pred
-/

#print Nat.factorial_pos /-
theorem factorial_pos : ∀ n, 0 < n !
  | 0 => zero_lt_one
  | succ n => mul_pos (succ_pos _) (factorial_pos n)
#align nat.factorial_pos Nat.factorial_pos
-/

#print Nat.factorial_ne_zero /-
theorem factorial_ne_zero (n : ℕ) : n ! ≠ 0 :=
  ne_of_gt (factorial_pos _)
#align nat.factorial_ne_zero Nat.factorial_ne_zero
-/

#print Nat.factorial_dvd_factorial /-
theorem factorial_dvd_factorial {m n} (h : m ≤ n) : m ! ∣ n ! :=
  by
  induction' n with n IH
  · simp [Nat.eq_zero_of_le_zero h]
  obtain rfl | hl := h.eq_or_lt
  · simp
  exact (IH (le_of_lt_succ hl)).mul_left _
#align nat.factorial_dvd_factorial Nat.factorial_dvd_factorial
-/

#print Nat.dvd_factorial /-
theorem dvd_factorial : ∀ {m n}, 0 < m → m ≤ n → m ∣ n !
  | succ m, n, _, h => dvd_of_mul_right_dvd (factorial_dvd_factorial h)
#align nat.dvd_factorial Nat.dvd_factorial
-/

#print Nat.factorial_le /-
@[mono]
theorem factorial_le {m n} (h : m ≤ n) : m ! ≤ n ! :=
  le_of_dvd (factorial_pos _) (factorial_dvd_factorial h)
#align nat.factorial_le Nat.factorial_le
-/

#print Nat.factorial_mul_pow_le_factorial /-
theorem factorial_mul_pow_le_factorial : ∀ {m n : ℕ}, m ! * m.succ ^ n ≤ (m + n)!
  | m, 0 => by simp
  | m, n + 1 => by
    rw [← add_assoc, Nat.factorial_succ, mul_comm (Nat.succ _), pow_succ', ← mul_assoc] <;>
      exact
        mul_le_mul factorial_mul_pow_le_factorial (Nat.succ_le_succ (Nat.le_add_right _ _))
          (Nat.zero_le _) (Nat.zero_le _)
#align nat.factorial_mul_pow_le_factorial Nat.factorial_mul_pow_le_factorial
-/

#print Nat.monotone_factorial /-
theorem monotone_factorial : Monotone factorial := fun n m => factorial_le
#align nat.monotone_factorial Nat.monotone_factorial
-/

#print Nat.factorial_lt /-
theorem factorial_lt (hn : 0 < n) : n ! < m ! ↔ n < m :=
  by
  refine' ⟨fun h => not_le.mp fun hmn => not_le_of_lt h (factorial_le hmn), fun h => _⟩
  have : ∀ {n}, 0 < n → n ! < n.succ ! := by
    intro k hk
    rw [factorial_succ, succ_mul, lt_add_iff_pos_left]
    exact mul_pos hk k.factorial_pos
  induction' h with k hnk ih generalizing hn
  · exact this hn
  · exact (ih hn).trans (this <| hn.trans <| lt_of_succ_le hnk)
#align nat.factorial_lt Nat.factorial_lt
-/

#print Nat.one_lt_factorial /-
theorem one_lt_factorial : 1 < n ! ↔ 1 < n :=
  factorial_lt one_pos
#align nat.one_lt_factorial Nat.one_lt_factorial
-/

#print Nat.factorial_eq_one /-
theorem factorial_eq_one : n ! = 1 ↔ n ≤ 1 :=
  by
  refine' ⟨fun h => _, by rintro (_ | _ | _) <;> rfl⟩
  rw [← not_lt, ← one_lt_factorial, h]
  apply lt_irrefl
#align nat.factorial_eq_one Nat.factorial_eq_one
-/

#print Nat.factorial_inj /-
theorem factorial_inj (hn : 1 < n !) : n ! = m ! ↔ n = m :=
  by
  refine' ⟨fun h => _, congr_arg _⟩
  obtain hnm | rfl | hnm := lt_trichotomy n m
  · rw [← factorial_lt <| pos_of_gt <| one_lt_factorial.mp hn, h] at hnm
    cases lt_irrefl _ hnm
  · rfl
  rw [h, one_lt_factorial] at hn
  rw [← factorial_lt (lt_trans one_pos hn), h] at hnm
  cases lt_irrefl _ hnm
#align nat.factorial_inj Nat.factorial_inj
-/

#print Nat.self_le_factorial /-
theorem self_le_factorial : ∀ n : ℕ, n ≤ n !
  | 0 => zero_le_one
  | k + 1 => le_mul_of_one_le_right k.zero_lt_succ.le (Nat.one_le_of_lt <| Nat.factorial_pos _)
#align nat.self_le_factorial Nat.self_le_factorial
-/

#print Nat.lt_factorial_self /-
theorem lt_factorial_self {n : ℕ} (hi : 3 ≤ n) : n < n ! :=
  by
  rw [← succ_pred_eq_of_pos ((zero_lt_two.trans (lt.base 2)).trans_le hi), factorial_succ]
  exact
    lt_mul_of_one_lt_right (pred n).succ_pos
      ((one_lt_two.trans_le (le_pred_of_lt (succ_le_iff.mp hi))).trans_le (self_le_factorial _))
#align nat.lt_factorial_self Nat.lt_factorial_self
-/

#print Nat.add_factorial_succ_lt_factorial_add_succ /-
theorem add_factorial_succ_lt_factorial_add_succ {i : ℕ} (n : ℕ) (hi : 2 ≤ i) :
    i + (n + 1)! < (i + n + 1)! :=
  by
  rw [factorial_succ (i + _), add_mul, one_mul]
  have : i ≤ i + n := le.intro rfl
  exact
    add_lt_add_of_lt_of_le
      (this.trans_lt
        ((lt_mul_iff_one_lt_right (zero_lt_two.trans_le (hi.trans this))).mpr
          (lt_iff_le_and_ne.mpr
            ⟨(i + n).factorial_pos, fun g =>
              Nat.not_succ_le_self 1 ((hi.trans this).trans (factorial_eq_one.mp g.symm))⟩)))
      (factorial_le
        ((le_of_eq (add_comm n 1)).trans ((add_le_add_iff_right n).mpr (one_le_two.trans hi))))
#align nat.add_factorial_succ_lt_factorial_add_succ Nat.add_factorial_succ_lt_factorial_add_succ
-/

#print Nat.add_factorial_lt_factorial_add /-
theorem add_factorial_lt_factorial_add {i n : ℕ} (hi : 2 ≤ i) (hn : 1 ≤ n) : i + n ! < (i + n)! :=
  by
  cases hn
  · rw [factorial_one]
    exact lt_factorial_self (succ_le_succ hi)
  exact add_factorial_succ_lt_factorial_add_succ _ hi
#align nat.add_factorial_lt_factorial_add Nat.add_factorial_lt_factorial_add
-/

#print Nat.add_factorial_succ_le_factorial_add_succ /-
theorem add_factorial_succ_le_factorial_add_succ (i : ℕ) (n : ℕ) : i + (n + 1)! ≤ (i + (n + 1))! :=
  by
  obtain i2 | _ | i0 := le_or_lt 2 i
  · exact (n.add_factorial_succ_lt_factorial_add_succ i2).le
  · rw [← add_assoc, factorial_succ (1 + n), add_mul, one_mul, add_comm 1 n]
    exact (add_le_add_iff_right _).mpr (one_le_mul (Nat.le_add_left 1 n) (n + 1).factorial_pos)
  rw [le_zero_iff.mp (nat.succ_le_succ_iff.mp i0), zero_add, zero_add]
#align nat.add_factorial_succ_le_factorial_add_succ Nat.add_factorial_succ_le_factorial_add_succ
-/

#print Nat.add_factorial_le_factorial_add /-
theorem add_factorial_le_factorial_add (i : ℕ) {n : ℕ} (n1 : 1 ≤ n) : i + n ! ≤ (i + n)! :=
  by
  cases' n1 with h
  · exact self_le_factorial _
  exact add_factorial_succ_le_factorial_add_succ i h
#align nat.add_factorial_le_factorial_add Nat.add_factorial_le_factorial_add
-/

#print Nat.factorial_mul_pow_sub_le_factorial /-
theorem factorial_mul_pow_sub_le_factorial {n m : ℕ} (hnm : n ≤ m) : n ! * n ^ (m - n) ≤ m ! :=
  by
  suffices n ! * (n + 1) ^ (m - n) ≤ m ! by
    apply trans _ this
    rw [mul_le_mul_left]
    apply pow_le_pow_of_le_left (zero_le n) (le_succ n)
    exact factorial_pos n
  convert Nat.factorial_mul_pow_le_factorial
  exact (add_tsub_cancel_of_le hnm).symm
#align nat.factorial_mul_pow_sub_le_factorial Nat.factorial_mul_pow_sub_le_factorial
-/

end Factorial

/-! ### Ascending and descending factorials -/

section AscFactorial

#print Nat.ascFactorial /-
/-- `n.asc_factorial k = (n + k)! / n!` (as seen in `nat.asc_factorial_eq_div`), but implemented
recursively to allow for "quick" computation when using `norm_num`. This is closely related to
`pochhammer`, but much less general. -/
def ascFactorial (n : ℕ) : ℕ → ℕ
  | 0 => 1
  | k + 1 => (n + k + 1) * asc_factorial k
#align nat.asc_factorial Nat.ascFactorial
-/

#print Nat.ascFactorial_zero /-
@[simp]
theorem ascFactorial_zero (n : ℕ) : n.ascFactorial 0 = 1 :=
  rfl
#align nat.asc_factorial_zero Nat.ascFactorial_zero
-/

#print Nat.zero_ascFactorial /-
@[simp]
theorem zero_ascFactorial (k : ℕ) : (0 : ℕ).ascFactorial k = k ! :=
  by
  induction' k with t ht
  · rfl
  rw [asc_factorial, ht, zero_add, Nat.factorial_succ]
#align nat.zero_asc_factorial Nat.zero_ascFactorial
-/

#print Nat.ascFactorial_succ /-
theorem ascFactorial_succ {n k : ℕ} : n.ascFactorial k.succ = (n + k + 1) * n.ascFactorial k :=
  rfl
#align nat.asc_factorial_succ Nat.ascFactorial_succ
-/

#print Nat.succ_ascFactorial /-
theorem succ_ascFactorial (n : ℕ) :
    ∀ k, (n + 1) * n.succ.ascFactorial k = (n + k + 1) * n.ascFactorial k
  | 0 => by rw [add_zero, asc_factorial_zero, asc_factorial_zero]
  | k + 1 => by
    rw [asc_factorial, mul_left_comm, succ_asc_factorial, asc_factorial, succ_add, ← add_assoc]
#align nat.succ_asc_factorial Nat.succ_ascFactorial
-/

#print Nat.factorial_mul_ascFactorial /-
/-- `n.asc_factorial k = (n + k)! / n!` but without ℕ-division. See `nat.asc_factorial_eq_div` for
the version with ℕ-division. -/
theorem factorial_mul_ascFactorial (n : ℕ) : ∀ k, n ! * n.ascFactorial k = (n + k)!
  | 0 => by rw [asc_factorial, add_zero, mul_one]
  | k + 1 => by
    rw [asc_factorial_succ, mul_left_comm, factorial_mul_asc_factorial, ← add_assoc, factorial]
#align nat.factorial_mul_asc_factorial Nat.factorial_mul_ascFactorial
-/

#print Nat.ascFactorial_eq_div /-
/-- Avoid in favor of `nat.factorial_mul_asc_factorial` if you can. ℕ-division isn't worth it. -/
theorem ascFactorial_eq_div (n k : ℕ) : n.ascFactorial k = (n + k)! / n ! :=
  by
  apply mul_left_cancel₀ n.factorial_ne_zero
  rw [factorial_mul_asc_factorial]
  exact (Nat.mul_div_cancel' <| factorial_dvd_factorial <| le.intro rfl).symm
#align nat.asc_factorial_eq_div Nat.ascFactorial_eq_div
-/

#print Nat.ascFactorial_of_sub /-
theorem ascFactorial_of_sub {n k : ℕ} (h : k < n) :
    (n - k) * (n - k).ascFactorial k = (n - (k + 1)).ascFactorial (k + 1) :=
  by
  set t := n - k.succ with ht
  suffices h' : n - k = t.succ; · rw [← ht, h', succ_asc_factorial, asc_factorial_succ]
  rw [ht, succ_eq_add_one, ← tsub_tsub_assoc (succ_le_of_lt h) (succ_pos _), succ_sub_one]
#align nat.asc_factorial_of_sub Nat.ascFactorial_of_sub
-/

#print Nat.pow_succ_le_ascFactorial /-
theorem pow_succ_le_ascFactorial (n : ℕ) : ∀ k : ℕ, (n + 1) ^ k ≤ n.ascFactorial k
  | 0 => by rw [asc_factorial_zero, pow_zero]
  | k + 1 => by
    rw [pow_succ]
    exact Nat.mul_le_mul (Nat.add_le_add_right le_self_add _) (pow_succ_le_asc_factorial k)
#align nat.pow_succ_le_asc_factorial Nat.pow_succ_le_ascFactorial
-/

#print Nat.pow_lt_ascFactorial' /-
theorem pow_lt_ascFactorial' (n k : ℕ) : (n + 1) ^ (k + 2) < n.ascFactorial (k + 2) :=
  by
  rw [pow_succ]
  exact
    Nat.mul_lt_mul (Nat.add_lt_add_right (Nat.lt_add_of_pos_right succ_pos') 1)
      (pow_succ_le_asc_factorial n _) (pow_pos succ_pos' _)
#align nat.pow_lt_asc_factorial' Nat.pow_lt_ascFactorial'
-/

#print Nat.pow_lt_ascFactorial /-
theorem pow_lt_ascFactorial (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → (n + 1) ^ k < n.ascFactorial k
  | 0 => by rintro ⟨⟩
  | 1 => by rintro (_ | ⟨⟨⟩⟩)
  | k + 2 => fun _ => pow_lt_ascFactorial' n k
#align nat.pow_lt_asc_factorial Nat.pow_lt_ascFactorial
-/

#print Nat.ascFactorial_le_pow_add /-
theorem ascFactorial_le_pow_add (n : ℕ) : ∀ k : ℕ, n.ascFactorial k ≤ (n + k) ^ k
  | 0 => by rw [asc_factorial_zero, pow_zero]
  | k + 1 => by
    rw [asc_factorial_succ, pow_succ]
    exact
      Nat.mul_le_mul_of_nonneg_left
        ((asc_factorial_le_pow_add k).trans (Nat.pow_le_pow_of_le_left (le_succ _) _))
#align nat.asc_factorial_le_pow_add Nat.ascFactorial_le_pow_add
-/

#print Nat.ascFactorial_lt_pow_add /-
theorem ascFactorial_lt_pow_add (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → n.ascFactorial k < (n + k) ^ k
  | 0 => by rintro ⟨⟩
  | 1 => by rintro (_ | ⟨⟨⟩⟩)
  | k + 2 => fun _ => by
    rw [asc_factorial_succ, pow_succ]
    refine'
      Nat.mul_lt_mul' le_rfl
        ((asc_factorial_le_pow_add n _).trans_lt
          (pow_lt_pow_of_lt_left (lt_add_one _) (succ_pos _)))
        (succ_pos _)
#align nat.asc_factorial_lt_pow_add Nat.ascFactorial_lt_pow_add
-/

#print Nat.ascFactorial_pos /-
theorem ascFactorial_pos (n k : ℕ) : 0 < n.ascFactorial k :=
  (pow_pos (succ_pos n) k).trans_le (pow_succ_le_ascFactorial n k)
#align nat.asc_factorial_pos Nat.ascFactorial_pos
-/

end AscFactorial

section DescFactorial

#print Nat.descFactorial /-
/-- `n.desc_factorial k = n! / (n - k)!` (as seen in `nat.desc_factorial_eq_div`), but
implemented recursively to allow for "quick" computation when using `norm_num`. This is closely
related to `pochhammer`, but much less general. -/
def descFactorial (n : ℕ) : ℕ → ℕ
  | 0 => 1
  | k + 1 => (n - k) * desc_factorial k
#align nat.desc_factorial Nat.descFactorial
-/

#print Nat.descFactorial_zero /-
@[simp]
theorem descFactorial_zero (n : ℕ) : n.descFactorial 0 = 1 :=
  rfl
#align nat.desc_factorial_zero Nat.descFactorial_zero
-/

#print Nat.descFactorial_succ /-
@[simp]
theorem descFactorial_succ (n k : ℕ) : n.descFactorial k.succ = (n - k) * n.descFactorial k :=
  rfl
#align nat.desc_factorial_succ Nat.descFactorial_succ
-/

#print Nat.zero_descFactorial_succ /-
theorem zero_descFactorial_succ (k : ℕ) : (0 : ℕ).descFactorial k.succ = 0 := by
  rw [desc_factorial_succ, zero_tsub, MulZeroClass.zero_mul]
#align nat.zero_desc_factorial_succ Nat.zero_descFactorial_succ
-/

#print Nat.descFactorial_one /-
@[simp]
theorem descFactorial_one (n : ℕ) : n.descFactorial 1 = n := by
  rw [desc_factorial_succ, desc_factorial_zero, mul_one, tsub_zero]
#align nat.desc_factorial_one Nat.descFactorial_one
-/

#print Nat.succ_descFactorial_succ /-
@[simp]
theorem succ_descFactorial_succ (n : ℕ) :
    ∀ k : ℕ, (n + 1).descFactorial (k + 1) = (n + 1) * n.descFactorial k
  | 0 => by rw [desc_factorial_zero, desc_factorial_one, mul_one]
  | succ k => by
    rw [desc_factorial_succ, succ_desc_factorial_succ, desc_factorial_succ, succ_sub_succ,
      mul_left_comm]
#align nat.succ_desc_factorial_succ Nat.succ_descFactorial_succ
-/

#print Nat.succ_descFactorial /-
theorem succ_descFactorial (n : ℕ) :
    ∀ k, (n + 1 - k) * (n + 1).descFactorial k = (n + 1) * n.descFactorial k
  | 0 => by rw [tsub_zero, desc_factorial_zero, desc_factorial_zero]
  | k + 1 => by
    rw [desc_factorial, succ_desc_factorial, desc_factorial_succ, succ_sub_succ, mul_left_comm]
#align nat.succ_desc_factorial Nat.succ_descFactorial
-/

#print Nat.descFactorial_self /-
theorem descFactorial_self : ∀ n : ℕ, n.descFactorial n = n !
  | 0 => by rw [desc_factorial_zero, factorial_zero]
  | succ n => by rw [succ_desc_factorial_succ, desc_factorial_self, factorial_succ]
#align nat.desc_factorial_self Nat.descFactorial_self
-/

#print Nat.descFactorial_eq_zero_iff_lt /-
@[simp]
theorem descFactorial_eq_zero_iff_lt {n : ℕ} : ∀ {k : ℕ}, n.descFactorial k = 0 ↔ n < k
  | 0 => by simp only [desc_factorial_zero, Nat.one_ne_zero, Nat.not_lt_zero]
  | succ k =>
    by
    rw [desc_factorial_succ, mul_eq_zero, desc_factorial_eq_zero_iff_lt, lt_succ_iff,
      tsub_eq_zero_iff_le, lt_iff_le_and_ne, or_iff_left_iff_imp, and_imp]
    exact fun h _ => h
#align nat.desc_factorial_eq_zero_iff_lt Nat.descFactorial_eq_zero_iff_lt
-/

alias desc_factorial_eq_zero_iff_lt ↔ _ desc_factorial_of_lt
#align nat.desc_factorial_of_lt Nat.descFactorial_of_lt

#print Nat.add_descFactorial_eq_ascFactorial /-
theorem add_descFactorial_eq_ascFactorial (n : ℕ) :
    ∀ k : ℕ, (n + k).descFactorial k = n.ascFactorial k
  | 0 => by rw [asc_factorial_zero, desc_factorial_zero]
  | succ k => by
    rw [Nat.add_succ, succ_desc_factorial_succ, asc_factorial_succ,
      add_desc_factorial_eq_asc_factorial]
#align nat.add_desc_factorial_eq_asc_factorial Nat.add_descFactorial_eq_ascFactorial
-/

#print Nat.factorial_mul_descFactorial /-
/-- `n.desc_factorial k = n! / (n - k)!` but without ℕ-division. See `nat.desc_factorial_eq_div`
for the version using ℕ-division. -/
theorem factorial_mul_descFactorial : ∀ {n k : ℕ}, k ≤ n → (n - k)! * n.descFactorial k = n !
  | n, 0 => fun _ => by rw [desc_factorial_zero, mul_one, tsub_zero]
  | 0, succ k => fun h => by
    exfalso
    exact not_succ_le_zero k h
  | succ n, succ k => fun h => by
    rw [succ_desc_factorial_succ, succ_sub_succ, ← mul_assoc, mul_comm (n - k)!, mul_assoc,
      factorial_mul_desc_factorial (Nat.succ_le_succ_iff.1 h), factorial_succ]
#align nat.factorial_mul_desc_factorial Nat.factorial_mul_descFactorial
-/

#print Nat.descFactorial_eq_div /-
/-- Avoid in favor of `nat.factorial_mul_desc_factorial` if you can. ℕ-division isn't worth it. -/
theorem descFactorial_eq_div {n k : ℕ} (h : k ≤ n) : n.descFactorial k = n ! / (n - k)! :=
  by
  apply mul_left_cancel₀ (factorial_ne_zero (n - k))
  rw [factorial_mul_desc_factorial h]
  exact (Nat.mul_div_cancel' <| factorial_dvd_factorial <| Nat.sub_le n k).symm
#align nat.desc_factorial_eq_div Nat.descFactorial_eq_div
-/

#print Nat.pow_sub_le_descFactorial /-
theorem pow_sub_le_descFactorial (n : ℕ) : ∀ k : ℕ, (n + 1 - k) ^ k ≤ n.descFactorial k
  | 0 => by rw [desc_factorial_zero, pow_zero]
  | k + 1 => by
    rw [desc_factorial_succ, pow_succ, succ_sub_succ]
    exact
      Nat.mul_le_mul_of_nonneg_left
        (le_trans (Nat.pow_le_pow_of_le_left (tsub_le_tsub_right (le_succ _) _) k)
          (pow_sub_le_desc_factorial k))
#align nat.pow_sub_le_desc_factorial Nat.pow_sub_le_descFactorial
-/

#print Nat.pow_sub_lt_descFactorial' /-
theorem pow_sub_lt_descFactorial' {n : ℕ} :
    ∀ {k : ℕ}, k + 2 ≤ n → (n - (k + 1)) ^ (k + 2) < n.descFactorial (k + 2)
  | 0 => fun h => by
    rw [desc_factorial_succ, pow_succ, pow_one, desc_factorial_one]
    exact
      Nat.mul_lt_mul_of_pos_left (tsub_lt_self (lt_of_lt_of_le zero_lt_two h) zero_lt_one)
        (tsub_pos_of_lt h)
  | k + 1 => fun h => by
    rw [desc_factorial_succ, pow_succ]
    refine'
      Nat.mul_lt_mul_of_pos_left
        ((Nat.pow_le_pow_of_le_left (tsub_le_tsub_right (le_succ n) _) _).trans_lt _)
        (tsub_pos_of_lt h)
    rw [succ_sub_succ]
    exact pow_sub_lt_desc_factorial' ((le_succ _).trans h)
#align nat.pow_sub_lt_desc_factorial' Nat.pow_sub_lt_descFactorial'
-/

#print Nat.pow_sub_lt_descFactorial /-
theorem pow_sub_lt_descFactorial {n : ℕ} :
    ∀ {k : ℕ}, 2 ≤ k → k ≤ n → (n + 1 - k) ^ k < n.descFactorial k
  | 0 => by rintro ⟨⟩
  | 1 => by rintro (_ | ⟨⟨⟩⟩)
  | k + 2 => fun _ h => by
    rw [succ_sub_succ]
    exact pow_sub_lt_desc_factorial' h
#align nat.pow_sub_lt_desc_factorial Nat.pow_sub_lt_descFactorial
-/

#print Nat.descFactorial_le_pow /-
theorem descFactorial_le_pow (n : ℕ) : ∀ k : ℕ, n.descFactorial k ≤ n ^ k
  | 0 => by rw [desc_factorial_zero, pow_zero]
  | k + 1 => by
    rw [desc_factorial_succ, pow_succ]
    exact Nat.mul_le_mul (Nat.sub_le _ _) (desc_factorial_le_pow k)
#align nat.desc_factorial_le_pow Nat.descFactorial_le_pow
-/

#print Nat.descFactorial_lt_pow /-
theorem descFactorial_lt_pow {n : ℕ} (hn : 1 ≤ n) : ∀ {k : ℕ}, 2 ≤ k → n.descFactorial k < n ^ k
  | 0 => by rintro ⟨⟩
  | 1 => by rintro (_ | ⟨⟨⟩⟩)
  | k + 2 => fun _ => by
    rw [desc_factorial_succ, pow_succ', mul_comm]
    exact
      Nat.mul_lt_mul' (desc_factorial_le_pow _ _) (tsub_lt_self hn k.zero_lt_succ) (pow_pos hn _)
#align nat.desc_factorial_lt_pow Nat.descFactorial_lt_pow
-/

end DescFactorial

end Nat


import ring_theory.ideal.local_ring

lemma subring.is_unit_iff {K : Type*} [division_ring K] {A : subring K} (x : A) (hx : x ≠ 0) :
  is_unit x ↔ (x : K)⁻¹ ∈ A :=
begin
  split,
  { rintro ⟨⟨x, y, hxy, hyx⟩, rfl⟩,
    convert y.2,
    rw inv_eq_of_mul_eq_one_left,
    exact subtype.ext_iff.mp hyx },
  { intro h,
    have : (x : K) ≠ 0 := by { contrapose! hx, ext1, exact hx },
    refine ⟨⟨x, ⟨_, h⟩, _, _⟩, rfl⟩; ext; simp [inv_mul_cancel this, mul_inv_cancel this] }
end

lemma is_local_ring_hom_of_surjective {R S : Type*} [comm_ring R] [local_ring R] [comm_ring S]
  [nontrivial S]
  (f : R →+* S) (hf : function.surjective f) : is_local_ring_hom f :=
begin
  haveI := local_ring.of_surjective' _ hf,
  have := ideal.comap_map_of_surjective f hf (local_ring.maximal_ideal R),
  rw [sup_eq_left.mpr _] at this,
  rw [(local_ring.local_hom_tfae f).out 0 3, ← this],
  { refine ideal.comap_mono (local_ring.le_maximal_ideal _),
    intro e, rw e at this, exact (local_ring.maximal_ideal.is_maximal R).ne_top this.symm },
  { apply local_ring.le_maximal_ideal, intro e, apply @one_ne_zero S, rw ← f.map_one,
    change (1 : R) ∈ ideal.comap f ⊥, rw e, trivial }
end

instance is_local_ring_hom_ring_equiv {R S : Type*} [comm_ring R] [local_ring R] [comm_ring S]
  [nontrivial S] (f : R ≃+* S) : is_local_ring_hom (f : R →+* S) :=
begin
  casesI subsingleton_or_nontrivial S,
  { haveI := f.to_equiv.subsingleton, exact ⟨λ _ _, is_unit_of_subsingleton _⟩ },
  { exact is_local_ring_hom_of_surjective _ f.surjective }
end

lemma local_ring.map_maximal_ideal_of_surjective {R S : Type*} [comm_ring R] [comm_ring S]
  [local_ring R] [local_ring S] (f : R →+* S) (hf : function.surjective f) :
  (local_ring.maximal_ideal R).map f = local_ring.maximal_ideal S :=
begin
  nontriviality S,
  haveI := is_local_ring_hom_of_surjective f hf,
  refine le_antisymm (((local_ring.local_hom_tfae f).out 0 2).mp infer_instance) _,
  rw ← ideal.map_comap_of_surjective f hf (local_ring.maximal_ideal S),
  apply ideal.map_mono,
  rw ((local_ring.local_hom_tfae f).out 0 4).mp infer_instance,
  exact le_refl _
end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module ring_theory.ideal.over
! leanprover-community/mathlib commit 198cb64d5c961e1a8d0d3e219feb7058d5353861
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Algebraic
import Mathbin.RingTheory.Localization.AtPrime
import Mathbin.RingTheory.Localization.Integral

/-!
# Ideals over/under ideals

This file concerns ideals lying over other ideals.
Let `f : R →+* S` be a ring homomorphism (typically a ring extension), `I` an ideal of `R` and
`J` an ideal of `S`. We say `J` lies over `I` (and `I` under `J`) if `I` is the `f`-preimage of `J`.
This is expressed here by writing `I = J.comap f`.

## Implementation notes

The proofs of the `comap_ne_bot` and `comap_lt_comap` families use an approach
specific for their situation: we construct an element in `I.comap f` from the
coefficients of a minimal polynomial.
Once mathlib has more material on the localization at a prime ideal, the results
can be proven using more general going-up/going-down theory.
-/

variable {R : Type _} [CommRing R]

namespace Ideal

open Polynomial

open Polynomial

open Submodule

section CommRing

variable {S : Type _} [CommRing S] {f : R →+* S} {I J : Ideal S}

theorem coeff_zero_mem_comap_of_root_mem_of_eval_mem {r : S} (hr : r ∈ I) {p : R[X]}
    (hp : p.eval₂ f r ∈ I) : p.coeff 0 ∈ I.comap f :=
  by
  rw [← p.div_X_mul_X_add, eval₂_add, eval₂_C, eval₂_mul, eval₂_X] at hp
  refine' mem_comap.mpr ((I.add_mem_iff_right _).mp hp)
  exact I.mul_mem_left _ hr
#align ideal.coeff_zero_mem_comap_of_root_mem_of_eval_mem Ideal.coeff_zero_mem_comap_of_root_mem_of_eval_mem

theorem coeff_zero_mem_comap_of_root_mem {r : S} (hr : r ∈ I) {p : R[X]} (hp : p.eval₂ f r = 0) :
    p.coeff 0 ∈ I.comap f :=
  coeff_zero_mem_comap_of_root_mem_of_eval_mem hr (hp.symm ▸ I.zero_mem)
#align ideal.coeff_zero_mem_comap_of_root_mem Ideal.coeff_zero_mem_comap_of_root_mem

theorem exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem {r : S}
    (r_non_zero_divisor : ∀ {x}, x * r = 0 → x = 0) (hr : r ∈ I) {p : R[X]} :
    ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0), ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
  by
  refine' p.rec_on_horner _ _ _
  · intro h
    contradiction
  · intro p a coeff_eq_zero a_ne_zero ih p_ne_zero hp
    refine' ⟨0, _, coeff_zero_mem_comap_of_root_mem hr hp⟩
    simp [coeff_eq_zero, a_ne_zero]
  · intro p p_nonzero ih mul_nonzero hp
    rw [eval₂_mul, eval₂_X] at hp
    obtain ⟨i, hi, mem⟩ := ih p_nonzero (r_non_zero_divisor hp)
    refine' ⟨i + 1, _, _⟩ <;> simp [hi, mem]
#align ideal.exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem Ideal.exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem

/-- Let `P` be an ideal in `R[x]`.  The map
`R[x]/P → (R / (P ∩ R))[x] / (P / (P ∩ R))`
is injective.
-/
theorem injective_quotient_le_comap_map (P : Ideal R[X]) :
    Function.Injective
      ((map (mapRingHom (Quotient.mk (P.comap (C : R →+* R[X])))) P).quotientMap
        (mapRingHom (Quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map) :=
  by
  refine' quotient_map_injective' (le_of_eq _)
  rw [comap_map_of_surjective (map_ring_hom (Quotient.mk' (P.comap (C : R →+* R[X]))))
      (map_surjective (Quotient.mk' (P.comap (C : R →+* R[X]))) quotient.mk_surjective)]
  refine' le_antisymm (sup_le le_rfl _) (le_sup_of_le_left le_rfl)
  refine' fun p hp =>
    polynomial_mem_ideal_of_coeff_mem_ideal P p fun n => quotient.eq_zero_iff_mem.mp _
  simpa only [coeff_map, coe_map_ring_hom] using ext_iff.mp (ideal.mem_bot.mp (mem_comap.mp hp)) n
#align ideal.injective_quotient_le_comap_map Ideal.injective_quotient_le_comap_map

/-- The identity in this lemma asserts that the "obvious" square
```
    R    → (R / (P ∩ R))
    ↓          ↓
R[x] / P → (R / (P ∩ R))[x] / (P / (P ∩ R))
```
commutes.  It is used, for instance, in the proof of `quotient_mk_comp_C_is_integral_of_jacobson`,
in the file `ring_theory/jacobson`.
-/
theorem quotient_mk_maps_eq (P : Ideal R[X]) :
    ((Quotient.mk (map (mapRingHom (Quotient.mk (P.comap (C : R →+* R[X])))) P)).comp C).comp
        (Quotient.mk (P.comap (C : R →+* R[X]))) =
      ((map (mapRingHom (Quotient.mk (P.comap (C : R →+* R[X])))) P).quotientMap
            (mapRingHom (Quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map).comp
        ((Quotient.mk P).comp C) :=
  by
  refine' RingHom.ext fun x => _
  repeat' rw [RingHom.coe_comp, Function.comp_apply]
  rw [quotient_map_mk, coe_map_ring_hom, map_C]
#align ideal.quotient_mk_maps_eq Ideal.quotient_mk_maps_eq

/-- This technical lemma asserts the existence of a polynomial `p` in an ideal `P ⊂ R[x]`
that is non-zero in the quotient `R / (P ∩ R) [x]`.  The assumptions are equivalent to
`P ≠ 0` and `P ∩ R = (0)`.
-/
theorem exists_nonzero_mem_of_ne_bot {P : Ideal R[X]} (Pb : P ≠ ⊥) (hP : ∀ x : R, C x ∈ P → x = 0) :
    ∃ p : R[X], p ∈ P ∧ Polynomial.map (Quotient.mk (P.comap (C : R →+* R[X]))) p ≠ 0 :=
  by
  obtain ⟨m, hm⟩ := Submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr Pb)
  refine' ⟨m, Submodule.coe_mem m, fun pp0 => hm (submodule.coe_eq_zero.mp _)⟩
  refine'
    (injective_iff_map_eq_zero (Polynomial.mapRingHom (Quotient.mk' (P.comap (C : R →+* R[X]))))).mp
      _ _ pp0
  refine' map_injective _ ((Quotient.mk' (P.comap C)).injective_iff_ker_eq_bot.mpr _)
  rw [mk_ker]
  exact (Submodule.eq_bot_iff _).mpr fun x hx => hP x (mem_comap.mp hx)
#align ideal.exists_nonzero_mem_of_ne_bot Ideal.exists_nonzero_mem_of_ne_bot

variable {p : Ideal R} {P : Ideal S}

/-- If there is an injective map `R/p → S/P` such that following diagram commutes:
```
R   → S
↓     ↓
R/p → S/P
```
then `P` lies over `p`.
-/
theorem comap_eq_of_scalar_tower_quotient [Algebra R S] [Algebra (R ⧸ p) (S ⧸ P)]
    [IsScalarTower R (R ⧸ p) (S ⧸ P)] (h : Function.Injective (algebraMap (R ⧸ p) (S ⧸ P))) :
    comap (algebraMap R S) P = p := by
  ext x;
  constructor <;>
    rw [mem_comap, ← quotient.eq_zero_iff_mem, ← quotient.eq_zero_iff_mem, quotient.mk_algebra_map,
      IsScalarTower.algebraMap_apply _ (R ⧸ p), quotient.algebra_map_eq]
  · intro hx
    exact (injective_iff_map_eq_zero (algebraMap (R ⧸ p) (S ⧸ P))).mp h _ hx
  · intro hx
    rw [hx, RingHom.map_zero]
#align ideal.comap_eq_of_scalar_tower_quotient Ideal.comap_eq_of_scalar_tower_quotient

/-- If `P` lies over `p`, then `R / p` has a canonical map to `S / P`. -/
def Quotient.algebraQuotientOfLeComap (h : p ≤ comap f P) : Algebra (R ⧸ p) (S ⧸ P) :=
  RingHom.toAlgebra <| quotientMap _ f h
#align ideal.quotient.algebra_quotient_of_le_comap Ideal.Quotient.algebraQuotientOfLeComap

/-- `R / p` has a canonical map to `S / pS`. -/
instance Quotient.algebraQuotientMapQuotient : Algebra (R ⧸ p) (S ⧸ map f p) :=
  quotient.algebra_quotient_of_le_comap le_comap_map
#align ideal.quotient.algebra_quotient_map_quotient Ideal.Quotient.algebraQuotientMapQuotient

@[simp]
theorem Quotient.algebraMap_quotient_map_quotient (x : R) :
    algebraMap (R ⧸ p) (S ⧸ map f p) (Quotient.mk p x) = Quotient.mk _ (f x) :=
  rfl
#align ideal.quotient.algebra_map_quotient_map_quotient Ideal.Quotient.algebraMap_quotient_map_quotient

@[simp]
theorem Quotient.mk_smul_mk_quotient_map_quotient (x : R) (y : S) :
    Quotient.mk p x • Quotient.mk (map f p) y = Quotient.mk _ (f x * y) :=
  rfl
#align ideal.quotient.mk_smul_mk_quotient_map_quotient Ideal.Quotient.mk_smul_mk_quotient_map_quotient

instance Quotient.tower_quotient_map_quotient [Algebra R S] :
    IsScalarTower R (R ⧸ p) (S ⧸ map (algebraMap R S) p) :=
  IsScalarTower.of_algebraMap_eq fun x => by
    rw [quotient.algebra_map_eq, quotient.algebra_map_quotient_map_quotient,
      quotient.mk_algebra_map]
#align ideal.quotient.tower_quotient_map_quotient Ideal.Quotient.tower_quotient_map_quotient

instance QuotientMapQuotient.isNoetherian [Algebra R S] [IsNoetherian R S] (I : Ideal R) :
    IsNoetherian (R ⧸ I) (S ⧸ Ideal.map (algebraMap R S) I) :=
  isNoetherian_of_tower R <|
    isNoetherian_of_surjective S (Ideal.Quotient.mkₐ R _).toLinearMap <|
      LinearMap.range_eq_top.mpr Ideal.Quotient.mk_surjective
#align ideal.quotient_map_quotient.is_noetherian Ideal.QuotientMapQuotient.isNoetherian

end CommRing

section IsDomain

variable {S : Type _} [CommRing S] {f : R →+* S} {I J : Ideal S}

theorem exists_coeff_ne_zero_mem_comap_of_root_mem [IsDomain S] {r : S} (r_ne_zero : r ≠ 0)
    (hr : r ∈ I) {p : R[X]} :
    ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0), ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
  exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem
    (fun _ h => Or.resolve_right (mul_eq_zero.mp h) r_ne_zero) hr
#align ideal.exists_coeff_ne_zero_mem_comap_of_root_mem Ideal.exists_coeff_ne_zero_mem_comap_of_root_mem

theorem exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff [IsPrime I] (hIJ : I ≤ J) {r : S}
    (hr : r ∈ (J : Set S) \ I) {p : R[X]} (p_ne_zero : p.map (Quotient.mk (I.comap f)) ≠ 0)
    (hpI : p.eval₂ f r ∈ I) : ∃ i, p.coeff i ∈ (J.comap f : Set R) \ I.comap f :=
  by
  obtain ⟨hrJ, hrI⟩ := hr
  have rbar_ne_zero : Quotient.mk' I r ≠ 0 := mt (quotient.mk_eq_zero I).mp hrI
  have rbar_mem_J : Quotient.mk' I r ∈ J.map (Quotient.mk' I) := mem_map_of_mem _ hrJ
  have quotient_f : ∀ x ∈ I.comap f, (Quotient.mk' I).comp f x = 0 := by
    simp [quotient.eq_zero_iff_mem]
  have rbar_root :
    (p.map (Quotient.mk' (I.comap f))).eval₂ (Quotient.lift (I.comap f) _ quotient_f)
        (Quotient.mk' I r) =
      0 :=
    by
    convert quotient.eq_zero_iff_mem.mpr hpI
    exact trans (eval₂_map _ _ _) (hom_eval₂ p f (Quotient.mk' I) r).symm
  obtain ⟨i, ne_zero, mem⟩ :=
    exists_coeff_ne_zero_mem_comap_of_root_mem rbar_ne_zero rbar_mem_J p_ne_zero rbar_root
  rw [coeff_map] at ne_zero mem
  refine' ⟨i, (mem_quotient_iff_mem hIJ).mp _, mt _ NeZero⟩
  · simpa using mem
  simp [quotient.eq_zero_iff_mem]
#align ideal.exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff Ideal.exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff

theorem comap_lt_comap_of_root_mem_sdiff [I.IsPrime] (hIJ : I ≤ J) {r : S}
    (hr : r ∈ (J : Set S) \ I) {p : R[X]} (p_ne_zero : p.map (Quotient.mk (I.comap f)) ≠ 0)
    (hp : p.eval₂ f r ∈ I) : I.comap f < J.comap f :=
  let ⟨i, hJ, hI⟩ := exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff hIJ hr p_ne_zero hp
  SetLike.lt_iff_le_and_exists.mpr ⟨comap_mono hIJ, p.coeff i, hJ, hI⟩
#align ideal.comap_lt_comap_of_root_mem_sdiff Ideal.comap_lt_comap_of_root_mem_sdiff

theorem mem_of_one_mem (h : (1 : S) ∈ I) (x) : x ∈ I :=
  (I.eq_top_iff_one.mpr h).symm ▸ mem_top
#align ideal.mem_of_one_mem Ideal.mem_of_one_mem

theorem comap_lt_comap_of_integral_mem_sdiff [Algebra R S] [hI : I.IsPrime] (hIJ : I ≤ J) {x : S}
    (mem : x ∈ (J : Set S) \ I) (integral : IsIntegral R x) :
    I.comap (algebraMap R S) < J.comap (algebraMap R S) :=
  by
  obtain ⟨p, p_monic, hpx⟩ := integral
  refine' comap_lt_comap_of_root_mem_sdiff hIJ mem _ _
  swap
  · apply map_monic_ne_zero p_monic
    apply quotient.nontrivial
    apply mt comap_eq_top_iff.mp
    apply hI.1
  convert I.zero_mem
#align ideal.comap_lt_comap_of_integral_mem_sdiff Ideal.comap_lt_comap_of_integral_mem_sdiff

theorem comap_ne_bot_of_root_mem [IsDomain S] {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I) {p : R[X]}
    (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0) : I.comap f ≠ ⊥ := fun h =>
  let ⟨i, hi, mem⟩ := exists_coeff_ne_zero_mem_comap_of_root_mem r_ne_zero hr p_ne_zero hp
  absurd (mem_bot.mp (eq_bot_iff.mp h mem)) hi
#align ideal.comap_ne_bot_of_root_mem Ideal.comap_ne_bot_of_root_mem

theorem isMaximal_of_isIntegral_of_isMaximal_comap [Algebra R S] (hRS : Algebra.IsIntegral R S)
    (I : Ideal S) [I.IsPrime] (hI : IsMaximal (I.comap (algebraMap R S))) : IsMaximal I :=
  ⟨⟨mt comap_eq_top_iff.mpr hI.1.1, fun J I_lt_J =>
      let ⟨I_le_J, x, hxJ, hxI⟩ := SetLike.lt_iff_le_and_exists.mp I_lt_J
      comap_eq_top_iff.1 <|
        hI.1.2 _ (comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (hRS x))⟩⟩
#align ideal.is_maximal_of_is_integral_of_is_maximal_comap Ideal.isMaximal_of_isIntegral_of_isMaximal_comap

theorem isMaximal_of_isIntegral_of_isMaximal_comap' (f : R →+* S) (hf : f.IsIntegral) (I : Ideal S)
    [hI' : I.IsPrime] (hI : IsMaximal (I.comap f)) : IsMaximal I :=
  @isMaximal_of_isIntegral_of_isMaximal_comap R _ S _ f.toAlgebra hf I hI' hI
#align ideal.is_maximal_of_is_integral_of_is_maximal_comap' Ideal.isMaximal_of_isIntegral_of_isMaximal_comap'

variable [Algebra R S]

theorem comap_ne_bot_of_algebraic_mem [IsDomain S] {x : S} (x_ne_zero : x ≠ 0) (x_mem : x ∈ I)
    (hx : IsAlgebraic R x) : I.comap (algebraMap R S) ≠ ⊥ :=
  let ⟨p, p_ne_zero, hp⟩ := hx
  comap_ne_bot_of_root_mem x_ne_zero x_mem p_ne_zero hp
#align ideal.comap_ne_bot_of_algebraic_mem Ideal.comap_ne_bot_of_algebraic_mem

theorem comap_ne_bot_of_integral_mem [Nontrivial R] [IsDomain S] {x : S} (x_ne_zero : x ≠ 0)
    (x_mem : x ∈ I) (hx : IsIntegral R x) : I.comap (algebraMap R S) ≠ ⊥ :=
  comap_ne_bot_of_algebraic_mem x_ne_zero x_mem (hx.IsAlgebraic R)
#align ideal.comap_ne_bot_of_integral_mem Ideal.comap_ne_bot_of_integral_mem

theorem eq_bot_of_comap_eq_bot [Nontrivial R] [IsDomain S] (hRS : Algebra.IsIntegral R S)
    (hI : I.comap (algebraMap R S) = ⊥) : I = ⊥ :=
  by
  refine' eq_bot_iff.2 fun x hx => _
  by_cases hx0 : x = 0
  · exact hx0.symm ▸ Ideal.zero_mem ⊥
  · exact absurd hI (comap_ne_bot_of_integral_mem hx0 hx (hRS x))
#align ideal.eq_bot_of_comap_eq_bot Ideal.eq_bot_of_comap_eq_bot

theorem isMaximal_comap_of_isIntegral_of_isMaximal (hRS : Algebra.IsIntegral R S) (I : Ideal S)
    [hI : I.IsMaximal] : IsMaximal (I.comap (algebraMap R S)) :=
  by
  refine' quotient.maximal_of_is_field _ _
  haveI : is_prime (I.comap (algebraMap R S)) := comap_is_prime _ _
  exact
    isField_of_isIntegral_of_isField (isIntegral_quotient_of_isIntegral hRS)
      algebra_map_quotient_injective (by rwa [← quotient.maximal_ideal_iff_is_field_quotient])
#align ideal.is_maximal_comap_of_is_integral_of_is_maximal Ideal.isMaximal_comap_of_isIntegral_of_isMaximal

theorem isMaximal_comap_of_isIntegral_of_is_maximal' {R S : Type _} [CommRing R] [CommRing S]
    (f : R →+* S) (hf : f.IsIntegral) (I : Ideal S) (hI : I.IsMaximal) : IsMaximal (I.comap f) :=
  @isMaximal_comap_of_isIntegral_of_isMaximal R _ S _ f.toAlgebra hf I hI
#align ideal.is_maximal_comap_of_is_integral_of_is_maximal' Ideal.isMaximal_comap_of_isIntegral_of_is_maximal'

section IsIntegralClosure

variable (S) {A : Type _} [CommRing A]

variable [Algebra R A] [Algebra A S] [IsScalarTower R A S] [IsIntegralClosure A R S]

theorem IsIntegralClosure.comap_lt_comap {I J : Ideal A} [I.IsPrime] (I_lt_J : I < J) :
    I.comap (algebraMap R A) < J.comap (algebraMap R A) :=
  let ⟨I_le_J, x, hxJ, hxI⟩ := SetLike.lt_iff_le_and_exists.mp I_lt_J
  comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (IsIntegralClosure.isIntegral R S x)
#align ideal.is_integral_closure.comap_lt_comap Ideal.IsIntegralClosure.comap_lt_comap

theorem IsIntegralClosure.isMaximal_of_isMaximal_comap (I : Ideal A) [I.IsPrime]
    (hI : IsMaximal (I.comap (algebraMap R A))) : IsMaximal I :=
  isMaximal_of_isIntegral_of_isMaximal_comap (fun x => IsIntegralClosure.isIntegral R S x) I hI
#align ideal.is_integral_closure.is_maximal_of_is_maximal_comap Ideal.IsIntegralClosure.isMaximal_of_isMaximal_comap

variable [IsDomain A]

theorem IsIntegralClosure.comap_ne_bot [Nontrivial R] {I : Ideal A} (I_ne_bot : I ≠ ⊥) :
    I.comap (algebraMap R A) ≠ ⊥ :=
  let ⟨x, x_mem, x_ne_zero⟩ := I.ne_bot_iff.mp I_ne_bot
  comap_ne_bot_of_integral_mem x_ne_zero x_mem (IsIntegralClosure.isIntegral R S x)
#align ideal.is_integral_closure.comap_ne_bot Ideal.IsIntegralClosure.comap_ne_bot

theorem IsIntegralClosure.eq_bot_of_comap_eq_bot [Nontrivial R] {I : Ideal A} :
    I.comap (algebraMap R A) = ⊥ → I = ⊥ :=
  imp_of_not_imp_not _ _ (IsIntegralClosure.comap_ne_bot S)
#align ideal.is_integral_closure.eq_bot_of_comap_eq_bot Ideal.IsIntegralClosure.eq_bot_of_comap_eq_bot

end IsIntegralClosure

theorem IntegralClosure.comap_lt_comap {I J : Ideal (integralClosure R S)} [I.IsPrime]
    (I_lt_J : I < J) :
    I.comap (algebraMap R (integralClosure R S)) < J.comap (algebraMap R (integralClosure R S)) :=
  IsIntegralClosure.comap_lt_comap S I_lt_J
#align ideal.integral_closure.comap_lt_comap Ideal.IntegralClosure.comap_lt_comap

theorem IntegralClosure.isMaximal_of_isMaximal_comap (I : Ideal (integralClosure R S)) [I.IsPrime]
    (hI : IsMaximal (I.comap (algebraMap R (integralClosure R S)))) : IsMaximal I :=
  IsIntegralClosure.isMaximal_of_isMaximal_comap S I hI
#align ideal.integral_closure.is_maximal_of_is_maximal_comap Ideal.IntegralClosure.isMaximal_of_isMaximal_comap

section

variable [IsDomain S]

theorem IntegralClosure.comap_ne_bot [Nontrivial R] {I : Ideal (integralClosure R S)}
    (I_ne_bot : I ≠ ⊥) : I.comap (algebraMap R (integralClosure R S)) ≠ ⊥ :=
  IsIntegralClosure.comap_ne_bot S I_ne_bot
#align ideal.integral_closure.comap_ne_bot Ideal.IntegralClosure.comap_ne_bot

theorem IntegralClosure.eq_bot_of_comap_eq_bot [Nontrivial R] {I : Ideal (integralClosure R S)} :
    I.comap (algebraMap R (integralClosure R S)) = ⊥ → I = ⊥ :=
  IsIntegralClosure.eq_bot_of_comap_eq_bot S
#align ideal.integral_closure.eq_bot_of_comap_eq_bot Ideal.IntegralClosure.eq_bot_of_comap_eq_bot

/-- `comap (algebra_map R S)` is a surjection from the prime spec of `R` to prime spec of `S`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
theorem exists_ideal_over_prime_of_is_integral' (H : Algebra.IsIntegral R S) (P : Ideal R)
    [IsPrime P] (hP : (algebraMap R S).ker ≤ P) :
    ∃ Q : Ideal S, IsPrime Q ∧ Q.comap (algebraMap R S) = P :=
  by
  have hP0 : (0 : S) ∉ Algebra.algebraMapSubmonoid S P.prime_compl :=
    by
    rintro ⟨x, ⟨hx, x0⟩⟩
    exact absurd (hP x0) hx
  let Rₚ := Localization P.prime_compl
  let Sₚ := Localization (Algebra.algebraMapSubmonoid S P.prime_compl)
  letI : IsDomain (Localization (Algebra.algebraMapSubmonoid S P.prime_compl)) :=
    IsLocalization.isDomain_localization (le_nonZeroDivisors_of_noZeroDivisors hP0)
  obtain ⟨Qₚ : Ideal Sₚ, Qₚ_maximal⟩ := exists_maximal Sₚ
  haveI Qₚ_max : is_maximal (comap _ Qₚ) :=
    @is_maximal_comap_of_is_integral_of_is_maximal Rₚ _ Sₚ _ (localizationAlgebra P.prime_compl S)
      (isIntegral_localization H) _ Qₚ_maximal
  refine' ⟨comap (algebraMap S Sₚ) Qₚ, ⟨comap_is_prime _ Qₚ, _⟩⟩
  convert Localization.AtPrime.comap_maximalIdeal
  rw [comap_comap, ← LocalRing.eq_maximalIdeal Qₚ_max, ← IsLocalization.map_comp _]
  rfl
#align ideal.exists_ideal_over_prime_of_is_integral' Ideal.exists_ideal_over_prime_of_is_integral'

end

/-- More general going-up theorem than `exists_ideal_over_prime_of_is_integral'`.
TODO: Version of going-up theorem with arbitrary length chains (by induction on this)?
  Not sure how best to write an ascending chain in Lean -/
theorem exists_ideal_over_prime_of_isIntegral (H : Algebra.IsIntegral R S) (P : Ideal R) [IsPrime P]
    (I : Ideal S) [IsPrime I] (hIP : I.comap (algebraMap R S) ≤ P) :
    ∃ Q ≥ I, IsPrime Q ∧ Q.comap (algebraMap R S) = P :=
  by
  let quot := R ⧸ I.comap (algebraMap R S)
  obtain ⟨Q' : Ideal (S ⧸ I), ⟨Q'_prime, hQ'⟩⟩ :=
    @exists_ideal_over_prime_of_is_integral' Quot _ (S ⧸ I) _ Ideal.quotientAlgebra _
      (isIntegral_quotient_of_isIntegral H) (map (Quotient.mk' (I.comap (algebraMap R S))) P)
      (map_is_prime_of_surjective quotient.mk_surjective (by simp [hIP]))
      (le_trans (le_of_eq ((RingHom.injective_iff_ker_eq_bot _).1 algebra_map_quotient_injective))
        bot_le)
  haveI := Q'_prime
  refine' ⟨Q'.comap _, le_trans (le_of_eq mk_ker.symm) (ker_le_comap _), ⟨comap_is_prime _ Q', _⟩⟩
  rw [comap_comap]
  refine' trans _ (trans (congr_arg (comap (Quotient.mk' (comap (algebraMap R S) I))) hQ') _)
  · simpa [comap_comap]
  · refine' trans (comap_map_of_surjective _ quotient.mk_surjective _) (sup_eq_left.2 _)
    simpa [← RingHom.ker_eq_comap_bot] using hIP
#align ideal.exists_ideal_over_prime_of_is_integral Ideal.exists_ideal_over_prime_of_isIntegral

/-- `comap (algebra_map R S)` is a surjection from the max spec of `S` to max spec of `R`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
theorem exists_ideal_over_maximal_of_isIntegral [IsDomain S] (H : Algebra.IsIntegral R S)
    (P : Ideal R) [P_max : IsMaximal P] (hP : (algebraMap R S).ker ≤ P) :
    ∃ Q : Ideal S, IsMaximal Q ∧ Q.comap (algebraMap R S) = P :=
  by
  obtain ⟨Q, ⟨Q_prime, hQ⟩⟩ := exists_ideal_over_prime_of_is_integral' H P hP
  haveI : Q.is_prime := Q_prime
  exact ⟨Q, is_maximal_of_is_integral_of_is_maximal_comap H _ (hQ.symm ▸ P_max), hQ⟩
#align ideal.exists_ideal_over_maximal_of_is_integral Ideal.exists_ideal_over_maximal_of_isIntegral

end IsDomain

end Ideal


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module topology.omega_complete_partial_order
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Basic
import Mathbin.Order.OmegaCompletePartialOrder

/-!
# Scott Topological Spaces

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

A type of topological spaces whose notion
of continuity is equivalent to continuity in ωCPOs.

## Reference

 * https://ncatlab.org/nlab/show/Scott+topology

-/

open Set OmegaCompletePartialOrder

open Classical

universe u

namespace Scott

#print Scott.IsωSup /-
/-- `x` is an `ω`-Sup of a chain `c` if it is the least upper bound of the range of `c`. -/
def IsωSup {α : Type u} [Preorder α] (c : Chain α) (x : α) : Prop :=
  (∀ i, c i ≤ x) ∧ ∀ y, (∀ i, c i ≤ y) → x ≤ y
#align Scott.is_ωSup Scott.IsωSup
-/

#print Scott.isωSup_iff_isLUB /-
theorem isωSup_iff_isLUB {α : Type u} [Preorder α] {c : Chain α} {x : α} :
    IsωSup c x ↔ IsLUB (range c) x := by simp [is_ωSup, IsLUB, IsLeast, upperBounds, lowerBounds]
#align Scott.is_ωSup_iff_is_lub Scott.isωSup_iff_isLUB
-/

variable (α : Type u) [OmegaCompletePartialOrder α]

#print Scott.IsOpen /-
/-- The characteristic function of open sets is monotone and preserves
the limits of chains. -/
def IsOpen (s : Set α) : Prop :=
  Continuous' fun x => x ∈ s
#align Scott.is_open Scott.IsOpen
-/

#print Scott.isOpen_univ /-
theorem isOpen_univ : IsOpen α univ :=
  ⟨fun x y h hx => mem_univ _, @CompleteLattice.top_continuous α Prop _ _⟩
#align Scott.is_open_univ Scott.isOpen_univ
-/

/- warning: Scott.is_open.inter -> Scott.IsOpen.inter is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : OmegaCompletePartialOrder.{u1} α] (s : Set.{u1} α) (t : Set.{u1} α), (Scott.IsOpen.{u1} α _inst_1 s) -> (Scott.IsOpen.{u1} α _inst_1 t) -> (Scott.IsOpen.{u1} α _inst_1 (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : OmegaCompletePartialOrder.{u1} α] (s : Set.{u1} α) (t : Set.{u1} α), (Scott.IsOpen.{u1} α _inst_1 s) -> (Scott.IsOpen.{u1} α _inst_1 t) -> (Scott.IsOpen.{u1} α _inst_1 (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align Scott.is_open.inter Scott.IsOpen.interₓ'. -/
theorem IsOpen.inter (s t : Set α) : IsOpen α s → IsOpen α t → IsOpen α (s ∩ t) :=
  CompleteLattice.inf_continuous'
#align Scott.is_open.inter Scott.IsOpen.inter

#print Scott.isOpen_unionₛ /-
theorem isOpen_unionₛ (s : Set (Set α)) (hs : ∀ t ∈ s, IsOpen α t) : IsOpen α (⋃₀ s) :=
  by
  simp only [IsOpen] at hs⊢
  convert CompleteLattice.supₛ_continuous' (setOf ⁻¹' s) _
  · ext1 x
    simp only [supₛ_apply, set_of_bijective.surjective.exists, exists_prop, mem_preimage,
      SetCoe.exists, supᵢ_Prop_eq, mem_set_of_eq, Subtype.coe_mk, mem_sUnion]
  · intro p hp
    exact hs (setOf p) (mem_preimage.1 hp)
#align Scott.is_open_sUnion Scott.isOpen_unionₛ
-/

end Scott

#print Scott /-
/-- A Scott topological space is defined on preorders
such that their open sets, seen as a function `α → Prop`,
preserves the joins of ω-chains  -/
@[reducible]
def Scott (α : Type u) :=
  α
#align Scott Scott
-/

#print Scott.topologicalSpace /-
instance Scott.topologicalSpace (α : Type u) [OmegaCompletePartialOrder α] :
    TopologicalSpace (Scott α) where
  IsOpen := Scott.IsOpen α
  isOpen_univ := Scott.isOpen_univ α
  isOpen_inter := Scott.IsOpen.inter α
  isOpen_unionₛ := Scott.isOpen_unionₛ α
#align Scott.topological_space Scott.topologicalSpace
-/

section notBelow

variable {α : Type _} [OmegaCompletePartialOrder α] (y : Scott α)

#print notBelow /-
/-- `not_below` is an open set in `Scott α` used
to prove the monotonicity of continuous functions -/
def notBelow :=
  { x | ¬x ≤ y }
#align not_below notBelow
-/

#print notBelow_isOpen /-
theorem notBelow_isOpen : IsOpen (notBelow y) :=
  by
  have h : Monotone (notBelow y) := by
    intro x y' h
    simp only [notBelow, setOf, le_Prop_eq]
    intro h₀ h₁
    apply h₀ (le_trans h h₁)
  exists h
  rintro c
  apply eq_of_forall_ge_iff
  intro z
  rw [ωSup_le_iff]
  simp only [ωSup_le_iff, notBelow, mem_set_of_eq, le_Prop_eq, OrderHom.coe_fun_mk, chain.map_coe,
    Function.comp_apply, exists_imp, not_forall]
#align not_below_is_open notBelow_isOpen
-/

end notBelow

open Scott hiding IsOpen

open OmegaCompletePartialOrder

#print isωSup_ωSup /-
theorem isωSup_ωSup {α} [OmegaCompletePartialOrder α] (c : Chain α) : IsωSup c (ωSup c) :=
  by
  constructor
  · apply le_ωSup
  · apply ωSup_le
#align is_ωSup_ωSup isωSup_ωSup
-/

/- warning: Scott_continuous_of_continuous -> scottContinuous_of_continuous is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : OmegaCompletePartialOrder.{u1} α] [_inst_2 : OmegaCompletePartialOrder.{u2} β] (f : (Scott.{u1} α) -> (Scott.{u2} β)), (Continuous.{u1, u2} (Scott.{u1} α) (Scott.{u2} β) (Scott.topologicalSpace.{u1} α _inst_1) (Scott.topologicalSpace.{u2} β _inst_2) f) -> (OmegaCompletePartialOrder.Continuous'.{u1, u2} (Scott.{u1} α) (Scott.{u2} β) _inst_1 _inst_2 f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : OmegaCompletePartialOrder.{u2} α] [_inst_2 : OmegaCompletePartialOrder.{u1} β] (f : (Scott.{u2} α) -> (Scott.{u1} β)), (Continuous.{u2, u1} (Scott.{u2} α) (Scott.{u1} β) (Scott.topologicalSpace.{u2} α _inst_1) (Scott.topologicalSpace.{u1} β _inst_2) f) -> (OmegaCompletePartialOrder.Continuous'.{u2, u1} (Scott.{u2} α) (Scott.{u1} β) _inst_1 _inst_2 f)
Case conversion may be inaccurate. Consider using '#align Scott_continuous_of_continuous scottContinuous_of_continuousₓ'. -/
/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:565:11: unsupported: specialize non-hyp -/
theorem scottContinuous_of_continuous {α β} [OmegaCompletePartialOrder α]
    [OmegaCompletePartialOrder β] (f : Scott α → Scott β) (hf : Continuous f) :
    OmegaCompletePartialOrder.Continuous' f :=
  by
  simp only [continuous_def, (· ⁻¹' ·)] at hf
  have h : Monotone f := by
    intro x y h
    cases' hf { x | ¬x ≤ f y } (notBelow_isOpen _) with hf hf'
    clear hf'
    specialize hf h
    simp only [preimage, mem_set_of_eq, le_Prop_eq] at hf
    by_contra H
    apply hf H le_rfl
  exists h
  intro c
  apply eq_of_forall_ge_iff
  intro z
  specialize
    «./././Mathport/Syntax/Translate/Tactic/Lean3.lean:565:11: unsupported: specialize non-hyp»
  cases hf
  specialize hf_h c
  simp only [notBelow, OrderHom.coe_fun_mk, eq_iff_iff, mem_set_of_eq] at hf_h
  rw [← not_iff_not]
  simp only [ωSup_le_iff, hf_h, ωSup, supᵢ, Sup, CompleteLattice.sup, CompleteSemilatticeSup.sup,
    exists_prop, mem_range, OrderHom.coe_fun_mk, chain.map_coe, Function.comp_apply, eq_iff_iff,
    not_forall]
  tauto
#align Scott_continuous_of_continuous scottContinuous_of_continuous

/- warning: continuous_of_Scott_continuous -> continuous_of_scottContinuous is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : OmegaCompletePartialOrder.{u1} α] [_inst_2 : OmegaCompletePartialOrder.{u2} β] (f : (Scott.{u1} α) -> (Scott.{u2} β)), (OmegaCompletePartialOrder.Continuous'.{u1, u2} (Scott.{u1} α) (Scott.{u2} β) _inst_1 _inst_2 f) -> (Continuous.{u1, u2} (Scott.{u1} α) (Scott.{u2} β) (Scott.topologicalSpace.{u1} α _inst_1) (Scott.topologicalSpace.{u2} β _inst_2) f)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : OmegaCompletePartialOrder.{u2} α] [_inst_2 : OmegaCompletePartialOrder.{u1} β] (f : (Scott.{u2} α) -> (Scott.{u1} β)), (OmegaCompletePartialOrder.Continuous'.{u2, u1} (Scott.{u2} α) (Scott.{u1} β) _inst_1 _inst_2 f) -> (Continuous.{u2, u1} (Scott.{u2} α) (Scott.{u1} β) (Scott.topologicalSpace.{u2} α _inst_1) (Scott.topologicalSpace.{u1} β _inst_2) f)
Case conversion may be inaccurate. Consider using '#align continuous_of_Scott_continuous continuous_of_scottContinuousₓ'. -/
theorem continuous_of_scottContinuous {α β} [OmegaCompletePartialOrder α]
    [OmegaCompletePartialOrder β] (f : Scott α → Scott β)
    (hf : OmegaCompletePartialOrder.Continuous' f) : Continuous f :=
  by
  rw [continuous_def]
  intro s hs
  change continuous' (s ∘ f)
  cases' hs with hs hs'
  cases' hf with hf hf'
  apply continuous.of_bundled
  apply continuous_comp _ _ hf' hs'
#align continuous_of_Scott_continuous continuous_of_scottContinuous


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

/-!
# Lie algebras of associative algebras

This file defines the Lie algebra structure that arises on an associative algebra via the ring
commutator.

Since the linear endomorphisms of a Lie algebra form an associative algebra, one can define the
adjoint action as a morphism of Lie algebras from a Lie algebra to its linear endomorphisms. We
make such a definition in this file.

## Main definitions

 * `lie_algebra.of_associative_algebra`
 * `lie_algebra.of_associative_algebra_hom`
 * `lie_module.to_endomorphism`
 * `lie_algebra.ad`
 * `linear_equiv.lie_conj`
 * `alg_equiv.to_lie_equiv`

## Tags

lie algebra, ring commutator, adjoint action
-/

universes u v w w₁ w₂

section of_associative

variables {A : Type v} [ring A]

namespace ring

/-- The bracket operation for rings is the ring commutator, which captures the extent to which a
ring is commutative. It is identically zero exactly when the ring is commutative. -/
@[priority 100]
instance : has_bracket A A := ⟨λ x y, x*y - y*x⟩

lemma lie_def (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

end ring

namespace lie_ring

/-- An associative ring gives rise to a Lie ring by taking the bracket to be the ring commutator. -/
@[priority 100]
instance of_associative_ring : lie_ring A :=
{ add_lie      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_add      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_self     := by simp only [ring.lie_def, forall_const, sub_self],
  leibniz_lie  := λ x y z, by { repeat { rw ring.lie_def, }, noncomm_ring, } }

lemma of_associative_ring_bracket (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

@[simp] lemma lie_apply {α : Type*} (f g : α → A) (a : α) : ⁅f, g⁆ a = ⁅f a, g a⁆ := rfl

end lie_ring

section associative_module

variables {M : Type w} [add_comm_group M] [module A M]

/-- We can regard a module over an associative ring `A` as a Lie ring module over `A` with Lie
bracket equal to its ring commutator.

Note that this cannot be a global instance because it would create a diamond when `M = A`,
specifically we can build two mathematically-different `has_bracket A A`s:
 1. `@ring.has_bracket A _` which says `⁅a, b⁆ = a * b - b * a`
 2. `(@lie_ring_module.of_associative_module A _ A _ _).to_has_bracket` which says `⁅a, b⁆ = a • b`
    (and thus `⁅a, b⁆ = a * b`)

See note [reducible non-instances] -/
@[reducible]
def lie_ring_module.of_associative_module : lie_ring_module A M :=
{ bracket     := (•),
  add_lie     := add_smul,
  lie_add     := smul_add,
  leibniz_lie :=
    by simp [lie_ring.of_associative_ring_bracket, sub_smul, mul_smul, sub_add_cancel], }

local attribute [instance] lie_ring_module.of_associative_module

lemma lie_eq_smul (a : A) (m : M) : ⁅a, m⁆ = a • m := rfl

end associative_module

section lie_algebra

variables {R : Type u} [comm_ring R] [algebra R A]

/-- An associative algebra gives rise to a Lie algebra by taking the bracket to be the ring
commutator. -/
@[priority 100]
instance lie_algebra.of_associative_algebra : lie_algebra R A :=
{ lie_smul := λ t x y,
    by rw [lie_ring.of_associative_ring_bracket, lie_ring.of_associative_ring_bracket,
           algebra.mul_smul_comm, algebra.smul_mul_assoc, smul_sub], }

local attribute [instance] lie_ring_module.of_associative_module

section associative_representation

variables {M : Type w} [add_comm_group M] [module R M] [module A M] [is_scalar_tower R A M]

/-- A representation of an associative algebra `A` is also a representation of `A`, regarded as a
Lie algebra via the ring commutator.

See the comment at `lie_ring_module.of_associative_module` for why the possibility `M = A` means
this cannot be a global instance. -/
def lie_module.of_associative_module : lie_module R A M :=
{ smul_lie := smul_assoc,
  lie_smul := smul_algebra_smul_comm }

instance module.End.lie_ring_module : lie_ring_module (module.End R M) M :=
lie_ring_module.of_associative_module

instance module.End.lie_module : lie_module R (module.End R M) M :=
lie_module.of_associative_module

end associative_representation

namespace alg_hom

variables {B : Type w} {C : Type w₁} [ring B] [ring C] [algebra R B] [algebra R C]
variables (f : A →ₐ[R] B) (g : B →ₐ[R] C)

/-- The map `of_associative_algebra` associating a Lie algebra to an associative algebra is
functorial. -/
def to_lie_hom : A →ₗ⁅R⁆ B :=
 { map_lie' := λ x y, show f ⁅x,y⁆ = ⁅f x,f y⁆,
     by simp only [lie_ring.of_associative_ring_bracket, alg_hom.map_sub, alg_hom.map_mul],
  ..f.to_linear_map, }

instance : has_coe (A →ₐ[R] B) (A →ₗ⁅R⁆ B) := ⟨to_lie_hom⟩

@[simp] lemma to_lie_hom_coe : f.to_lie_hom = ↑f := rfl

@[simp]

lemma to_lie_hom_apply (x : A) : f.to_lie_hom x = f x := rfl

@[simp] lemma to_lie_hom_id : (alg_hom.id R A : A →ₗ⁅R⁆ A) = lie_hom.id := rfl

@[simp] lemma to_lie_hom_comp : (g.comp f : A →ₗ⁅R⁆ C) = (g : B →ₗ⁅R⁆ C).comp (f : A →ₗ⁅R⁆ B) := rfl

lemma to_lie_hom_injective {f g : A →ₐ[R] B}
  (h : (f : A →ₗ⁅R⁆ B) = (g : A →ₗ⁅R⁆ B)) : f = g :=
by { ext a, exact lie_hom.congr_fun h a, }

end alg_hom

end lie_algebra

end of_associative

section adjoint_action

variables (R : Type u) (L : Type v) (M : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]

/-- A Lie module yields a Lie algebra morphism into the linear endomorphisms of the module.

See also `lie_module.to_module_hom`. -/
@[simps] def lie_module.to_endomorphism : L →ₗ⁅R⁆ module.End R M :=
{ to_fun    := λ x,
  { to_fun    := λ m, ⁅x, m⁆,
    map_add'  := lie_add x,
    map_smul' := λ t, lie_smul t x, },
  map_add'  := λ x y, by { ext m, apply add_lie, },
  map_smul' := λ t x, by { ext m, apply smul_lie, },
  map_lie'  := λ x y, by { ext m, apply lie_lie, }, }

/-- The adjoint action of a Lie algebra on itself. -/
def lie_algebra.ad : L →ₗ⁅R⁆ module.End R L := lie_module.to_endomorphism R L L

@[simp] lemma lie_algebra.ad_apply (x y : L) : lie_algebra.ad R L x y = ⁅x, y⁆ := rfl

@[simp] lemma lie_module.to_endomorphism_module_End :
  lie_module.to_endomorphism R (module.End R M) M = lie_hom.id :=
by { ext g m, simp [lie_eq_smul], }

lemma lie_subalgebra.to_endomorphism_eq (K : lie_subalgebra R L) {x : K} :
  lie_module.to_endomorphism R K M x = lie_module.to_endomorphism R L M x :=
rfl

@[simp] lemma lie_subalgebra.to_endomorphism_mk (K : lie_subalgebra R L) {x : L} (hx : x ∈ K) :
  lie_module.to_endomorphism R K M ⟨x, hx⟩ = lie_module.to_endomorphism R L M x :=
rfl

variables {R L M}

lemma lie_submodule.coe_map_to_endomorphism_le {N : lie_submodule R L M} {x : L} :
  (N : submodule R M).map (lie_module.to_endomorphism R L M x) ≤ N :=
begin
  rintros n ⟨m, hm, rfl⟩,
  exact N.lie_mem hm,
end

open lie_algebra

lemma lie_algebra.ad_eq_lmul_left_sub_lmul_right (A : Type v) [ring A] [algebra R A] :
  (ad R A : A → module.End R A) = algebra.lmul_left R - algebra.lmul_right R :=
by { ext a b, simp [lie_ring.of_associative_ring_bracket], }

lemma lie_subalgebra.ad_comp_incl_eq (K : lie_subalgebra R L) (x : K) :
  (ad R L ↑x).comp (K.incl : K →ₗ[R] L) = (K.incl : K →ₗ[R] L).comp (ad R K x) :=
begin
  ext y,
  simp only [ad_apply, lie_hom.coe_to_linear_map, lie_subalgebra.coe_incl, linear_map.coe_comp,
    lie_subalgebra.coe_bracket, function.comp_app],
end

end adjoint_action

/-- A subalgebra of an associative algebra is a Lie subalgebra of the associated Lie algebra. -/
def lie_subalgebra_of_subalgebra (R : Type u) [comm_ring R] (A : Type v) [ring A] [algebra R A]
  (A' : subalgebra R A) : lie_subalgebra R A :=
{ lie_mem' := λ x y hx hy, by
  { change ⁅x, y⁆ ∈ A', change x ∈ A' at hx, change y ∈ A' at hy,
    rw lie_ring.of_associative_ring_bracket,
    have hxy := A'.mul_mem hx hy,
    have hyx := A'.mul_mem hy hx,
    exact submodule.sub_mem A'.to_submodule hxy hyx, },
  ..A'.to_submodule }

namespace linear_equiv

variables {R : Type u} {M₁ : Type v} {M₂ : Type w}
variables [comm_ring R] [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]
variables (e : M₁ ≃ₗ[R] M₂)

/-- A linear equivalence of two modules induces a Lie algebra equivalence of their endomorphisms. -/
def lie_conj : module.End R M₁ ≃ₗ⁅R⁆ module.End R M₂ :=
{ map_lie' := λ f g, show e.conj ⁅f, g⁆ = ⁅e.conj f, e.conj g⁆,
    by simp only [lie_ring.of_associative_ring_bracket, linear_map.mul_eq_comp, e.conj_comp,
                  linear_equiv.map_sub],
  ..e.conj }

@[simp] lemma lie_conj_apply (f : module.End R M₁) : e.lie_conj f = e.conj f := rfl

@[simp] lemma lie_conj_symm : e.lie_conj.symm = e.symm.lie_conj := rfl

end linear_equiv

namespace alg_equiv

variables {R : Type u} {A₁ : Type v} {A₂ : Type w}
variables [comm_ring R] [ring A₁] [ring A₂] [algebra R A₁] [algebra R A₂]
variables (e : A₁ ≃ₐ[R] A₂)

/-- An equivalence of associative algebras is an equivalence of associated Lie algebras. -/
def to_lie_equiv : A₁ ≃ₗ⁅R⁆ A₂ :=
{ to_fun   := e.to_fun,
  map_lie' := λ x y, by simp [lie_ring.of_associative_ring_bracket],
  ..e.to_linear_equiv }

@[simp] lemma to_lie_equiv_apply (x : A₁) : e.to_lie_equiv x = e x := rfl

@[simp] lemma to_lie_equiv_symm_apply (x : A₂) : e.to_lie_equiv.symm x = e.symm x := rfl

end alg_equiv


import data.equiv.basic

namespace wf

-- general well-founded trees
inductive W (L : Type) (A : L → Type) : Type
| Node : ∀ (lbl : L), (A lbl → W) → W

-- model of nat as well-founded tree with nodes labelled by bool
def nat := W bool (λ b, bool.rec empty unit b)

def list (L : Type) :=
W (option L) (λ l, option.rec_on l empty (λ _, unit))

end wf

example : equiv nat wf.nat :=
{ to_fun := λ n, nat.rec_on n (wf.W.Node ff empty.elim) (λ d w, wf.W.Node tt $ λ _, w),
  inv_fun := λ w, wf.W.rec_on w $ λ b, bool.rec_on b (λ _ _, 0) (λ H1 H2, nat.succ (H2 ())),
  left_inv := begin
    intro n,
    induction n with d hd, refl,
    dsimp,
    congr',
  end,
  right_inv := begin
    intro w,
    induction w with b H1 H2,
    cases b,
    { dsimp,
      -- congr', -- fails
      convert rfl, -- works
      ext x,
      cases x,
    },
    { dsimp,
      congr',
      ext a,
      convert (H2 a)
    }
  end
}

example (L : Type) : equiv (list L) (wf.list L) :=
{ to_fun := λ l, list.rec_on l (wf.W.Node none empty.elim) $ λ t m IH, wf.W.Node (some t) $ λ s, IH,
  inv_fun := λ w, wf.W.rec_on w $ λ ol, option.cases_on ol
    (λ _ _, list.nil) (λ l h1 h2, list.cons l $ h2 ()),
  left_inv := begin
    intro l,
    induction l with e l h, refl,
    dsimp, congr',
  end,
  right_inv := begin
    intro w,
    induction w with ol H1 H2,
    cases ol,
      dsimp, congr', ext x, cases x,
    dsimp, congr', ext a, convert (H2 a)
  end }


import logic.nontrivial
import algebra.ordered_ring
import data.nat.basic

/-! ### Test `nontriviality` with inequality hypotheses -/

example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
begin
  nontriviality,
  guard_hyp _inst : nontrivial R,
  assumption,
end

/-! ### Test `nontriviality` with equality or non-strict inequality goals -/

example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
begin
  nontriviality,
  guard_hyp _inst : nontrivial R,
  apply mul_comm,
end

/-! ### Test deducing `nontriviality` by instance search -/

example {R : Type} [ordered_ring R] : 0 ≤ (1 : R) :=
begin
  nontriviality R,
  guard_hyp _inst : nontrivial R,
  exact zero_le_one,
end

example {R : Type} [ordered_ring R] : 0 ≤ (1 : R) :=
begin
  nontriviality ℕ,
  guard_hyp _inst : nontrivial ℕ,
  exact zero_le_one,
end

example {R : Type} [ordered_ring R] : 0 ≤ (1 : R) :=
begin
  success_if_fail { nontriviality punit },
  exact zero_le_one,
end

example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 2 ∣ 4 :=
begin
  nontriviality R,
  guard_hyp _inst : nontrivial R,
  dec_trivial
end

/-! Test using `@[nontriviality]` lemmas in `nontriviality and custom `simp` lemmas -/

def empty_or_univ {α : Type*} (s : set α) : Prop := s = ∅ ∨ s = set.univ

lemma subsingleton.set_empty_or_univ {α} [subsingleton α] (s : set α) :
  s = ∅ ∨ s = set.univ :=
subsingleton.set_cases (or.inl rfl) (or.inr rfl) s

lemma subsingleton.set_empty_or_univ' {α} [subsingleton α] (s : set α) :
  empty_or_univ s :=
subsingleton.set_empty_or_univ s

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  success_if_fail { nontriviality α },
  rw [set.empty_union] at hs,
  exact or.inr hs
end

section

local attribute [nontriviality] subsingleton.set_empty_or_univ

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  success_if_fail { nontriviality α },
  nontriviality α using [subsingleton.set_empty_or_univ'],
  rw [set.empty_union] at hs,
  exact or.inr hs
end

end

local attribute [nontriviality] subsingleton.set_empty_or_univ'

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  nontriviality α,
  rw [set.empty_union] at hs,
  exact or.inr hs
end

/-! Test with nonatomic type argument -/

example (α : ℕ → Type) (a b : α 0) (h : a = b) : a = b :=
begin
  nontriviality α 0 using [nat.zero_lt_one],
  guard_hyp _inst : nontrivial (α 0),
  exact h
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

The Schröder-Bernstein theorem, and well ordering of cardinals.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.fixed_points
import Mathlib.order.zorn
import Mathlib.PostPort

universes u v

namespace Mathlib

namespace function

namespace embedding

theorem schroeder_bernstein {α : Type u} {β : Type v} {f : α → β} {g : β → α} (hf : injective f) (hg : injective g) : ∃ (h : α → β), bijective h := sorry

theorem antisymm {α : Type u} {β : Type v} : (α ↪ β) → (β ↪ α) → Nonempty (α ≃ β) := sorry

theorem min_injective {ι : Type u} {β : ι → Type v} (I : Nonempty ι) : ∃ (i : ι), Nonempty ((j : ι) → β i ↪ β j) := sorry

theorem total {α : Type u} {β : Type v} : Nonempty (α ↪ β) ∨ Nonempty (β ↪ α) := sorry