import .exp .print

namespace prop

variable {α : Type}

class is_symb (α : Type) :=
(true : α) (false : α) (not : α)
(and : α) (or : α) (imp : α)

def true [is_symb α] := @exp.cst α (is_symb.true α)
notation  `⊤'` := true

def false [is_symb α] := @exp.cst α (is_symb.false α)
notation  `⊥'` := false

def not [is_symb α] (p : exp α) := exp.app (exp.cst (is_symb.not α)) p
notation  `¬'` p := not p

def and [is_symb α] (p q : exp α) := exp.app (exp.app (exp.cst (is_symb.and α)) p) q
notation  p `∧'` q := and p q

def or [is_symb α] (p q : exp α) := exp.app (exp.app (exp.cst (is_symb.or α)) p) q
notation  p `∨'` q := or p q

def imp [is_symb α] (p q : exp α) := exp.app (exp.app (exp.cst (is_symb.imp α)) p) q
notation  p `→'` q := imp p q

@[derive has_reflect]
inductive symb : Type
| atom : string → symb
| true : symb
| false : symb
| not : symb
| and : symb
| or  : symb
| imp : symb

instance : decidable_eq symb :=
by tactic.mk_dec_eq_instance

instance : is_symb symb :=
{ true  := symb.true,
  false := symb.false,
  not   := symb.not,
  and   := symb.and,
  or    := symb.or,
  imp   := symb.imp }

def A' (s : string) := @exp.cst symb (symb.atom s)

inductive inf [is_symb α] : list (seq α) → seq α → Prop
| id : ∀ Γ Δ p, inf [] (p::Γ ==> p::Δ)
| truer : ∀ Γ Δ, inf [] (Γ ==> ⊤'::Δ)
| falsel : ∀ Γ Δ, inf [] (⊥'::Γ ==> Δ)
| andl : ∀ Γ Δ p q, inf [p::q::Γ ==> Δ] ((p ∧' q)::Γ ==> Δ)
| andr : ∀ Γ Δ p q, inf [Γ ==> p::Δ, Γ ==> q::Δ] (Γ ==> (p ∧' q)::Δ)
| orl : ∀ Γ Δ p q, inf [p::Γ ==> Δ, q::Γ ==> Δ] ((p ∨' q)::Γ ==> Δ)
| orr : ∀ Γ Δ p q, inf [Γ ==> p::q::Δ] (Γ ==> (p ∨' q)::Δ)
| impl : ∀ Γ Δ p q, inf [Γ ==> p::Δ, q::Γ ==> Δ] ((p →' q)::Γ ==> Δ)
| impr : ∀ Γ Δ p q, inf [p::Γ ==> q::Δ] (Γ ==> (p →' q)::Δ)
| wl : ∀ Γ Δ p, inf [Γ ==> Δ] (p::Γ ==> Δ)
| wr : ∀ Γ Δ p, inf [Γ ==> Δ] (Γ ==> p::Δ)
| cl : ∀ Γ Δ p, inf [p::p::Γ ==> Δ] (p::Γ ==> Δ)
| cr : ∀ Γ Δ p, inf [Γ ==> p::p::Δ] (Γ ==> p::Δ)
| pl : ∀ Γ Γ' Δ, Γ ~ Γ' → inf [Γ ==> Δ] (Γ' ==> Δ)
| pr : ∀ Γ Δ Δ', Δ ~ Δ' → inf [Γ ==> Δ] (Γ ==> Δ')

inductive thm [is_symb α] : (seq α) → Prop
| inf : ∀ {s S}, inf S s → (∀ s' ∈ S, thm s') → thm s

/- Derived rules -/

open list

lemma thm.id [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p, thm (p::Γ ==> p::Δ) :=
begin
  intros Γ Δ p, apply thm.inf,
  apply inf.id, apply forall_mem_nil
end

lemma thm.truer [is_symb α] :
  ∀ (Γ Δ : list (exp α)), thm (Γ ==> ⊤'::Δ) :=
begin
  intros Γ Δ, apply thm.inf,
  apply inf.truer, apply forall_mem_nil
end

lemma thm.falsel [is_symb α] :
  ∀ (Γ Δ : list (exp α)), thm (⊥'::Γ ==> Δ) :=
begin
  intros Γ Δ, apply thm.inf,
  apply inf.falsel, apply forall_mem_nil
end

lemma thm.andl [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (p::q::Γ ==> Δ) → thm ((p ∧' q)::Γ ==> Δ) :=
begin
  intros Γ Δ p q h, apply thm.inf, apply inf.andl,
  rewrite forall_mem_singleton, apply h
end

lemma thm.andr [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (Γ ==> p::Δ) → thm (Γ ==> q::Δ)
  → thm (Γ ==> (p ∧' q)::Δ) :=
begin
  intros Γ Δ p q h1 h2,
  apply thm.inf, apply inf.andr, intros s hs,
  rewrite mem_cons_iff at hs, cases hs with hs hs,
  rewrite hs, apply h1, rewrite mem_singleton at hs,
  rewrite hs, apply h2
end

lemma thm.orl [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (p::Γ ==> Δ) → thm (q::Γ ==> Δ)
  → thm ((p ∨' q)::Γ ==> Δ) :=
begin
  intros Γ Δ p q h1 h2,
  apply thm.inf, apply inf.orl, intros s hs,
  rewrite mem_cons_iff at hs, cases hs with hs hs,
  rewrite hs, apply h1, rewrite mem_singleton at hs,
  rewrite hs, apply h2
end

lemma thm.orr [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (Γ ==> p::q::Δ) → thm (Γ ==> (p ∨' q)::Δ) :=
begin
  intros Γ Δ p q h, apply thm.inf, apply inf.orr,
  rewrite forall_mem_singleton, apply h
end

lemma thm.impl [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (Γ ==> p::Δ) → thm (q::Γ ==> Δ)
  → thm ((p →' q)::Γ ==> Δ) :=
begin
  intros Γ Δ p q h1 h2, apply thm.inf, apply inf.impl,
  intros s hs, rewrite mem_cons_iff at hs,
  cases hs with hs hs, rewrite hs, apply h1,
  rewrite mem_singleton at hs, rewrite hs, apply h2
end

lemma thm.impr [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p q,
  thm (p::Γ ==> q::Δ) → thm (Γ ==> (p →' q)::Δ) :=
begin
  intros Γ Δ p q h, apply thm.inf, apply inf.impr,
  rewrite forall_mem_singleton, apply h
end

lemma thm.wl [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p,
  thm (Γ ==> Δ) → thm (p::Γ ==> Δ) :=
begin
  intros Γ Δ p h, apply thm.inf, apply inf.wl,
  rewrite forall_mem_singleton, apply h
end

lemma thm.wr [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p,
  thm (Γ ==> Δ) → thm (Γ ==> p::Δ) :=
begin
  intros Γ Δ p h, apply thm.inf, apply inf.wr,
  rewrite forall_mem_singleton, apply h
end

lemma thm.cl [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p,
  thm (p::p::Γ ==> Δ) → thm (p::Γ ==> Δ) :=
begin
  intros Γ Δ p h, apply thm.inf, apply inf.cl,
  rewrite forall_mem_singleton, apply h
end

lemma thm.cr [is_symb α] :
  ∀ (Γ Δ : list (exp α)) p,
  thm (Γ ==> p::p::Δ) → thm (Γ ==> p::Δ) :=
begin
  intros Γ Δ p h, apply thm.inf, apply inf.cr,
  rewrite forall_mem_singleton, apply h
end

lemma thm.rl [is_symb α] :
  ∀ n (Γ Δ : list (exp α)), thm (rotate n Γ ==> Δ) → thm (Γ ==> Δ) :=
begin
  intros n Γ Δ h, apply thm.inf,
  apply inf.pl (rotate n Γ),
  apply perm_rotate, intros s' hs',
  rewrite list.mem_singleton at hs',
  rewrite hs', apply h
end

lemma thm.rr [is_symb α] :
  ∀ n (Γ Δ : list (exp α)), thm (Γ ==> rotate n Δ) → thm (Γ ==> Δ) :=
begin
  intros n Γ Δ h, apply thm.inf,
  apply inf.pr _ (rotate n Δ),
  apply perm_rotate, intros s' hs',
  rewrite list.mem_singleton at hs',
  rewrite hs', apply h
end

/- Printing -/

open expr tactic

meta def getsqt : tactic (list (exp symb) × list (exp symb)) :=
do `(thm (%%Γe ==> %%Δe)) ← tactic.target,
    Γ ← eval_expr (list (exp symb)) Γe,
    Δ ← eval_expr (list (exp symb)) Δe,
    return (Γ,Δ)

def fml2str : exp symb → string
| (exp.app (exp.cst s) p) :=
  if s = (is_symb.not symb)
  then "¬" ++ fml2str p
  else "ERROR"
| (exp.app (exp.app (exp.cst s) p) q) :=
  if s = (is_symb.and symb)
  then "(" ++ fml2str p ++ " ∧ " ++ fml2str q ++ ")" else
  if s = (is_symb.or symb)
  then "(" ++ fml2str p ++ " ∨ " ++ fml2str q ++ ")" else
  if s = (is_symb.imp symb)
  then "(" ++ fml2str p ++ " → " ++ fml2str q ++ ")" else "ERROR"
| (exp.cst s) :=
  if s = is_symb.true symb
  then "⊤" else
  if s = is_symb.false symb
  then "⊥" else
  match s with
  | (symb.atom str) := str
  | _ := "ERROR"
  end
| _ := "ERROR"

meta def showgoal : tactic unit :=
(do (Γ,Δ) ← getsqt, trace (sqt2str fml2str Γ Δ)) <|> trace "No Goals"

/- Examples (Hilbert System Axioms) -/

example : thm ([] ==> [A' "φ" →' A' "φ"]) :=
begin
  showgoal,
  apply thm.impr,
  apply thm.id,
  showgoal
end

example : thm ([] ==> [A' "φ" →' (A' "ψ" →' A' "φ")]) :=
begin
  showgoal,
  apply thm.impr,
  apply thm.impr,
  apply thm.rl 1,
  apply thm.id,
  showgoal
end

example : thm ([] ==> [(A' "φ" →' (A' "ψ" →' A' "χ")) →' ((A' "φ" →' A' "ψ") →' (A' "φ" →' A' "χ"))]) :=
begin
  showgoal,
  apply thm.impr,
  apply thm.impr,
  apply thm.impr,
  apply thm.rl 2,
  apply thm.impl,
  apply thm.rl 1,
  apply thm.id,
  apply thm.impl,
  apply thm.impl,
  apply thm.id,
  apply thm.id,
  apply thm.id,
  showgoal
end

end prop


/-
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 ring_theory.adjoin.basic
import data.polynomial.eval

/-!
# Theory of univariate polynomials

We show that `polynomial A` is an R-algebra when `A` is an R-algebra.
We promote `eval₂` to an algebra hom in `aeval`.
-/

noncomputable theory
open finset
open_locale big_operators

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {A' B' : Type*} {a b : R} {n : ℕ}
variables [comm_semiring A'] [comm_semiring B']

section comm_semiring
variables [comm_semiring R] {p q r : polynomial R}

variables [semiring A] [algebra R A]

/-- Note that this instance also provides `algebra R (polynomial R)`. -/
instance algebra_of_algebra : algebra R (polynomial A) :=
{ smul_def' := λ r p, begin
    rcases p,
    simp only [C, monomial, monomial_fun, ring_hom.coe_mk, ring_hom.to_fun_eq_coe,
      function.comp_app, ring_hom.coe_comp, smul_to_finsupp, mul_to_finsupp],
    exact algebra.smul_def' _ _,
  end,
  commutes' := λ r p, begin
    rcases p,
    simp only [C, monomial, monomial_fun, ring_hom.coe_mk, ring_hom.to_fun_eq_coe,
      function.comp_app, ring_hom.coe_comp, mul_to_finsupp],
    convert algebra.commutes' r p,
  end,
  .. C.comp (algebra_map R A) }

lemma algebra_map_apply (r : R) :
  algebra_map R (polynomial A) r = C (algebra_map R A r) :=
rfl

/--
When we have `[comm_ring R]`, the function `C` is the same as `algebra_map R (polynomial R)`.

(But note that `C` is defined when `R` is not necessarily commutative, in which case
`algebra_map` is not available.)
-/
lemma C_eq_algebra_map (r : R) :
  C r = algebra_map R (polynomial R) r :=
rfl

variables {R}

/--
  Extensionality lemma for algebra maps out of `polynomial A'` over a smaller base ring than `A'`
-/
@[ext] lemma alg_hom_ext' [algebra R A'] [algebra R B']
  {f g : polynomial A' →ₐ[R] B'}
  (h₁ : f.comp (is_scalar_tower.to_alg_hom R A' (polynomial A')) =
        g.comp (is_scalar_tower.to_alg_hom R A' (polynomial A')))
  (h₂ : f X = g X) : f = g :=
alg_hom.coe_ring_hom_injective (polynomial.ring_hom_ext'
  (congr_arg alg_hom.to_ring_hom h₁) h₂)

variable (R)

/-- Algebra isomorphism between `polynomial R` and `add_monoid_algebra R ℕ`. This is just an
implementation detail, but it can be useful to transfer results from `finsupp` to polynomials. -/
@[simps]
def to_finsupp_iso_alg : polynomial R ≃ₐ[R] add_monoid_algebra R ℕ :=
{ commutes' := λ r,
  begin
    simp only [add_monoid_algebra.coe_algebra_map, algebra.id.map_eq_self, function.comp_app],
    rw [←C_eq_algebra_map, ←monomial_zero_left, ring_equiv.to_fun_eq_coe, to_finsupp_iso_monomial],
  end,
  ..to_finsupp_iso R }

variable {R}

instance [nontrivial A] : nontrivial (subalgebra R (polynomial A)) :=
⟨⟨⊥, ⊤, begin
  rw [ne.def, set_like.ext_iff, not_forall],
  refine ⟨X, _⟩,
  simp only [algebra.mem_bot, not_exists, set.mem_range, iff_true, algebra.mem_top,
    algebra_map_apply, not_forall],
  intro x,
  rw [ext_iff, not_forall],
  refine ⟨1, _⟩,
  simp [coeff_C],
end⟩⟩

@[simp]
lemma alg_hom_eval₂_algebra_map
  {R A B : Type*} [comm_ring R] [ring A] [ring B] [algebra R A] [algebra R B]
  (p : polynomial R) (f : A →ₐ[R] B) (a : A) :
  f (eval₂ (algebra_map R A) a p) = eval₂ (algebra_map R B) (f a) p :=
begin
  dsimp [eval₂, sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast,
    alg_hom.commutes],
end

@[simp]
lemma eval₂_algebra_map_X {R A : Type*} [comm_ring R] [ring A] [algebra R A]
  (p : polynomial R) (f : polynomial R →ₐ[R] A) :
  eval₂ (algebra_map R A) (f X) p = f p :=
begin
  conv_rhs { rw [←polynomial.sum_C_mul_X_eq p], },
  dsimp [eval₂, sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast],
  simp [polynomial.C_eq_algebra_map],
end

-- these used to be about `algebra_map ℤ R`, but now the simp-normal form is `int.cast_ring_hom R`.
@[simp]
lemma ring_hom_eval₂_cast_int_ring_hom {R S : Type*} [ring R] [ring S]
  (p : polynomial ℤ) (f : R →+* S) (r : R) :
  f (eval₂ (int.cast_ring_hom R) r p) = eval₂ (int.cast_ring_hom S) (f r) p :=
alg_hom_eval₂_algebra_map p f.to_int_alg_hom r

@[simp]
lemma eval₂_int_cast_ring_hom_X {R : Type*} [ring R] (p : polynomial ℤ) (f : polynomial ℤ →+* R) :
  eval₂ (int.cast_ring_hom R) (f X) p = f p :=
eval₂_algebra_map_X p f.to_int_alg_hom

end comm_semiring

section aeval
variables [comm_semiring R] {p q : polynomial R}

variables [semiring A] [algebra R A]
variables {B : Type*} [semiring B] [algebra R B]
variables (x : A)

/-- Given a valuation `x` of the variable in an `R`-algebra `A`, `aeval R A x` is
the unique `R`-algebra homomorphism from `R[X]` to `A` sending `X` to `x`.

This is a stronger variant of the linear map `polynomial.leval`. -/
def aeval : polynomial R →ₐ[R] A :=
{ commutes' := λ r, eval₂_C _ _,
  ..eval₂_ring_hom' (algebra_map R A) x (λ a, algebra.commutes _ _) }

variables {R A}

@[simp] lemma adjoin_X : algebra.adjoin R ({X} : set (polynomial R)) = ⊤ :=
begin
  refine top_unique (λ p hp, _),
  set S := algebra.adjoin R ({X} : set (polynomial R)),
  rw [← sum_monomial_eq p], simp only [monomial_eq_smul_X, sum],
  exact S.sum_mem (λ n hn, S.smul_mem (S.pow_mem (algebra.subset_adjoin rfl) _) _)
end

@[ext] lemma alg_hom_ext {f g : polynomial R →ₐ[R] A} (h : f X = g X) : f = g :=
alg_hom.ext_of_adjoin_eq_top adjoin_X $ λ p hp, (set.mem_singleton_iff.1 hp).symm ▸ h

theorem aeval_def (p : polynomial R) : aeval x p = eval₂ (algebra_map R A) x p := rfl

@[simp] lemma aeval_zero : aeval x (0 : polynomial R) = 0 :=
alg_hom.map_zero (aeval x)

@[simp] lemma aeval_X : aeval x (X : polynomial R) = x := eval₂_X _ x

@[simp] lemma aeval_C (r : R) : aeval x (C r) = algebra_map R A r := eval₂_C _ x

@[simp] lemma aeval_monomial {n : ℕ} {r : R} : aeval x (monomial n r) = (algebra_map _ _ r) * x^n :=
eval₂_monomial _ _

@[simp] lemma aeval_X_pow {n : ℕ} : aeval x ((X : polynomial R)^n) = x^n :=
eval₂_X_pow _ _

@[simp] lemma aeval_add : aeval x (p + q) = aeval x p + aeval x q :=
alg_hom.map_add _ _ _

@[simp] lemma aeval_one : aeval x (1 : polynomial R) = 1 :=
alg_hom.map_one _

@[simp] lemma aeval_bit0 : aeval x (bit0 p) = bit0 (aeval x p) :=
alg_hom.map_bit0 _ _

@[simp] lemma aeval_bit1 : aeval x (bit1 p) = bit1 (aeval x p) :=
alg_hom.map_bit1 _ _

@[simp] lemma aeval_nat_cast (n : ℕ) : aeval x (n : polynomial R) = n :=
map_nat_cast _ _

lemma aeval_mul : aeval x (p * q) = aeval x p * aeval x q :=
alg_hom.map_mul _ _ _

lemma aeval_comp {A : Type*} [comm_semiring A] [algebra R A] (x : A) :
  aeval x (p.comp q) = (aeval (aeval x q) p) :=
eval₂_comp (algebra_map R A)

@[simp] lemma aeval_map {A : Type*} [comm_semiring A] [algebra R A] [algebra A B]
  [is_scalar_tower R A B] (b : B) (p : polynomial R) :
  aeval b (p.map (algebra_map R A)) = aeval b p :=
by rw [aeval_def, eval₂_map, ←is_scalar_tower.algebra_map_eq, ←aeval_def]

theorem aeval_alg_hom (f : A →ₐ[R] B) (x : A) : aeval (f x) = f.comp (aeval x) :=
alg_hom_ext $ by simp only [aeval_X, alg_hom.comp_apply]

@[simp] theorem aeval_X_left : aeval (X : polynomial R) = alg_hom.id R (polynomial R) :=
alg_hom_ext $ aeval_X X

theorem eval_unique (φ : polynomial R →ₐ[R] A) (p) :
  φ p = eval₂ (algebra_map R A) (φ X) p :=
by rw [← aeval_def, aeval_alg_hom, aeval_X_left, alg_hom.comp_id]

theorem aeval_alg_equiv (f : A ≃ₐ[R] B) (x : A) : aeval (f x) = (f : A →ₐ[R] B).comp (aeval x) :=
aeval_alg_hom (f : A →ₐ[R] B) x

theorem aeval_alg_equiv_apply (f : A ≃ₐ[R] B) (x : A) (p : polynomial R) :
  aeval (f x) p = f (aeval x p) :=
aeval_alg_hom_apply (f : A →ₐ[R] B) x p

lemma aeval_algebra_map_apply (x : R) (p : polynomial R) :
  aeval (algebra_map R A x) p = algebra_map R A (p.eval x) :=
aeval_alg_hom_apply (algebra.of_id R A) x p

@[simp] lemma coe_aeval_eq_eval (r : R) :
  (aeval r : polynomial R → R) = eval r := rfl

@[simp] lemma aeval_fn_apply {X : Type*} (g : polynomial R) (f : X → R) (x : X) :
  ((aeval f) g) x = aeval (f x) g :=
(aeval_alg_hom_apply (pi.eval_alg_hom _ _ x) f g).symm

@[norm_cast] lemma aeval_subalgebra_coe
  (g : polynomial R) {A : Type*} [semiring A] [algebra R A] (s : subalgebra R A) (f : s) :
  (aeval f g : A) = aeval (f : A) g :=
(aeval_alg_hom_apply s.val f g).symm

lemma coeff_zero_eq_aeval_zero (p : polynomial R) : p.coeff 0 = aeval 0 p :=
by simp [coeff_zero_eq_eval_zero]

lemma coeff_zero_eq_aeval_zero' (p : polynomial R) :
  algebra_map R A (p.coeff 0) = aeval (0 : A) p :=
by simp [aeval_def]

variable (R)

theorem _root_.algebra.adjoin_singleton_eq_range_aeval (x : A) :
  algebra.adjoin R {x} = (polynomial.aeval x).range :=
by rw [← algebra.map_top, ← adjoin_X, alg_hom.map_adjoin, set.image_singleton, aeval_X]

variable {R}

section comm_semiring

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

lemma aeval_eq_sum_range [algebra R S] {p : polynomial R} (x : S) :
  aeval x p = ∑ i in finset.range (p.nat_degree + 1), p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range (algebra_map R S) x }

lemma aeval_eq_sum_range' [algebra R S] {p : polynomial R} {n : ℕ} (hn : p.nat_degree < n) (x : S) :
aeval x p = ∑ i in finset.range n, p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range' (algebra_map R S) hn x }

lemma aeval_sum {ι : Type*} [algebra R S] (s : finset ι) (f : ι → polynomial R)
  (g : S) : aeval g (∑ i in s, f i) = ∑ i in s, aeval g (f i) :=
(polynomial.aeval g : polynomial R →ₐ[_] _).map_sum f s

@[to_additive]
lemma aeval_prod {ι : Type*} [algebra R S] (s : finset ι)
  (f : ι → polynomial R) (g : S) : aeval g (∏ i in s, f i) = ∏ i in s, aeval g (f i) :=
(polynomial.aeval g : polynomial R →ₐ[_] _).map_prod f s

lemma is_root_of_eval₂_map_eq_zero
  (hf : function.injective f) {r : R} : eval₂ f (f r) p = 0 → p.is_root r :=
begin
  intro h,
  apply hf,
  rw [←eval₂_hom, h, f.map_zero],
end

lemma is_root_of_aeval_algebra_map_eq_zero [algebra R S] {p : polynomial R}
  (inj : function.injective (algebra_map R S))
  {r : R} (hr : aeval (algebra_map R S r) p = 0) : p.is_root r :=
is_root_of_eval₂_map_eq_zero inj hr

section aeval_tower

variables [algebra S R] [algebra S A'] [algebra S B']

/-- Version of `aeval` for defining algebra homs out of `polynomial R` over a smaller base ring
  than `R`. -/
def aeval_tower (f : R →ₐ[S] A') (x : A') : polynomial R →ₐ[S] A' :=
{ commutes' := λ r, by simp [algebra_map_apply],
  ..eval₂_ring_hom ↑f x }

variables (g : R →ₐ[S] A') (y : A')

@[simp] lemma aeval_tower_X : aeval_tower g y X = y := eval₂_X _ _

@[simp] lemma aeval_tower_C (x : R) : aeval_tower g y (C x) = g x := eval₂_C _ _

@[simp] lemma aeval_tower_comp_C : ((aeval_tower g y : polynomial R →+* A').comp C) = g :=
ring_hom.ext $ aeval_tower_C _ _

@[simp] lemma aeval_tower_algebra_map (x : R) :
  aeval_tower g y (algebra_map R (polynomial R) x) = g x := eval₂_C _ _

@[simp] lemma aeval_tower_comp_algebra_map :
  (aeval_tower g y : polynomial R →+* A').comp (algebra_map R (polynomial R)) = g :=
aeval_tower_comp_C _ _

lemma aeval_tower_to_alg_hom (x : R) :
  aeval_tower g y (is_scalar_tower.to_alg_hom S R (polynomial R) x) = g x :=
aeval_tower_algebra_map _ _ _

@[simp] lemma aeval_tower_comp_to_alg_hom :
  (aeval_tower g y).comp (is_scalar_tower.to_alg_hom S R (polynomial R)) = g :=
alg_hom.coe_ring_hom_injective $ aeval_tower_comp_algebra_map _ _

@[simp] lemma aeval_tower_id : aeval_tower (alg_hom.id S S) = aeval :=
by { ext, simp only [eval_X, aeval_tower_X, coe_aeval_eq_eval], }

@[simp] lemma aeval_tower_of_id : aeval_tower (algebra.of_id S A') = aeval :=
by { ext, simp only [aeval_X, aeval_tower_X], }

end aeval_tower

end comm_semiring

section comm_ring

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

lemma dvd_term_of_dvd_eval_of_dvd_terms {z p : S} {f : polynomial S} (i : ℕ)
  (dvd_eval : p ∣ f.eval z) (dvd_terms : ∀ (j ≠ i), p ∣ f.coeff j * z ^ j) :
  p ∣ f.coeff i * z ^ i :=
begin
  by_cases hi : i ∈ f.support,
  { rw [eval, eval₂, sum] at dvd_eval,
    rw [←finset.insert_erase hi, finset.sum_insert (finset.not_mem_erase _ _)] at dvd_eval,
    refine (dvd_add_left _).mp dvd_eval,
    apply finset.dvd_sum,
    intros j hj,
    exact dvd_terms j (finset.ne_of_mem_erase hj) },
  { convert dvd_zero p,
    rw not_mem_support_iff at hi,
    simp [hi] }
end

lemma dvd_term_of_is_root_of_dvd_terms {r p : S} {f : polynomial S} (i : ℕ)
  (hr : f.is_root r) (h : ∀ (j ≠ i), p ∣ f.coeff j * r ^ j) : p ∣ f.coeff i * r ^ i :=
dvd_term_of_dvd_eval_of_dvd_terms i (eq.symm hr ▸ dvd_zero p) h

end comm_ring

end aeval

section ring
variables [ring R]

/--
The evaluation map is not generally multiplicative when the coefficient ring is noncommutative,
but nevertheless any polynomial of the form `p * (X - monomial 0 r)` is sent to zero
when evaluated at `r`.

This is the key step in our proof of the Cayley-Hamilton theorem.
-/
lemma eval_mul_X_sub_C {p : polynomial R} (r : R) :
  (p * (X - C r)).eval r = 0 :=
begin
  simp only [eval, eval₂, ring_hom.id_apply],
  have bound := calc
    (p * (X - C r)).nat_degree
         ≤ p.nat_degree + (X - C r).nat_degree : nat_degree_mul_le
     ... ≤ p.nat_degree + 1 : add_le_add_left nat_degree_X_sub_C_le _
     ... < p.nat_degree + 2 : lt_add_one _,
  rw sum_over_range' _ _ (p.nat_degree + 2) bound,
  swap,
  { simp, },
  rw sum_range_succ',
  conv_lhs
  { congr, apply_congr, skip,
    rw [coeff_mul_X_sub_C, sub_mul, mul_assoc, ←pow_succ], },
  simp [sum_range_sub', coeff_monomial],
end

theorem not_is_unit_X_sub_C [nontrivial R] (r : R) : ¬ is_unit (X - C r) :=
λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ by erw [← eval_mul_X_sub_C, hgf, eval_one]

end ring

lemma aeval_endomorphism {M : Type*}
  [comm_ring R] [add_comm_group M] [module R M]
  (f : M →ₗ[R] M) (v : M) (p : polynomial R) :
  aeval f p v = p.sum (λ n b, b • (f ^ n) v) :=
begin
  rw [aeval_def, eval₂],
  exact (linear_map.applyₗ v).map_sum ,
end

end polynomial