/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Kevin Buzzard, Jujian Zhang
-/
import algebra.direct_sum.algebra
import algebra.direct_sum.internal
import algebra.direct_sum.ring
import group_theory.subgroup.basic

/-!
# Internally-graded algebras

This file defines the typeclass `graded_algebra 𝒜`, for working with an algebra `A` that is
internally graded by a collection of submodules `𝒜 : ι → submodule R A`.
See the docstring of that typeclass for more information.

## Main definitions

* `graded_algebra 𝒜`: the typeclass, which is a combination of `set_like.graded_monoid`, and
  a constructive version of `direct_sum.submodule_is_internal 𝒜`.
* `graded_algebra.decompose : A ≃ₐ[R] ⨁ i, 𝒜 i`, which breaks apart an element of the algebra into
  its constituent pieces.
* `graded_algebra.proj 𝒜 i` is the linear map from `A` to its degree `i : ι` component, such that
  `proj 𝒜 i x = decompose 𝒜 x i`.
* `graded_algebra.support 𝒜 r` is the `finset ι` containing the `i : ι` such that the degree `i`
  component of `r` is not zero.

## Implementation notes

For now, we do not have internally-graded semirings and internally-graded rings; these can be
represented with `𝒜 : ι → submodule ℕ A` and `𝒜 : ι → submodule ℤ A` respectively, since all
`semiring`s are ℕ-algebras via `algebra_nat`, and all `ring`s are `ℤ`-algebras via `algebra_int`.

## Tags

graded algebra, graded ring, graded semiring, decomposition
-/

open_locale direct_sum big_operators

section graded_algebra

variables {ι R A : Type*}
variables [decidable_eq ι] [add_comm_monoid ι] [comm_semiring R] [semiring A] [algebra R A]
variables (𝒜 : ι → submodule R A)

/-- An internally-graded `R`-algebra `A` is one that can be decomposed into a collection
of `submodule R A`s indexed by `ι` such that the canonical map `A → ⨁ i, 𝒜 i` is bijective and
respects multiplication, i.e. the product of an element of degree `i` and an element of degree `j`
is an element of degree `i + j`.

Note that the fact that `A` is internally-graded, `graded_algebra 𝒜`, implies an externally-graded
algebra structure `direct_sum.galgebra R (λ i, ↥(𝒜 i))`, which in turn makes available an
`algebra R (⨁ i, 𝒜 i)` instance.
-/

class graded_algebra extends set_like.graded_monoid 𝒜 :=
(decompose' : A → ⨁ i, 𝒜 i)
(left_inv : function.left_inverse decompose' (direct_sum.submodule_coe 𝒜))
(right_inv : function.right_inverse decompose' (direct_sum.submodule_coe 𝒜))

lemma graded_algebra.is_internal [graded_algebra 𝒜] :
  direct_sum.submodule_is_internal 𝒜 :=
⟨graded_algebra.left_inv.injective, graded_algebra.right_inv.surjective⟩

/-- A helper to construct a `graded_algebra` when the `set_like.graded_monoid` structure is already
available. This makes the `left_inv` condition easier to prove, and phrases the `right_inv`
condition in a way that allows custom `@[ext]` lemmas to apply.

See note [reducible non-instances]. -/
@[reducible]
def graded_algebra.of_alg_hom [set_like.graded_monoid 𝒜] (decompose : A →ₐ[R] ⨁ i, 𝒜 i)
  (right_inv : (direct_sum.submodule_coe_alg_hom 𝒜).comp decompose = alg_hom.id R A)
  (left_inv : ∀ i (x : 𝒜 i), decompose (x : A) = direct_sum.of (λ i, ↥(𝒜 i)) i x) :
  graded_algebra 𝒜 :=
{ decompose' := decompose,
  right_inv := alg_hom.congr_fun right_inv,
  left_inv := begin
    suffices : decompose.comp (direct_sum.submodule_coe_alg_hom 𝒜) = alg_hom.id _ _,
    from alg_hom.congr_fun this,
    ext i x : 2,
    exact (decompose.congr_arg $ direct_sum.submodule_coe_alg_hom_of _ _ _).trans (left_inv i x),
  end}

variable [graded_algebra 𝒜]

/-- If `A` is graded by `ι` with degree `i` component `𝒜 i`, then it is isomorphic as
an algebra to a direct sum of components. -/
def graded_algebra.decompose : A ≃ₐ[R] ⨁ i, 𝒜 i := alg_equiv.symm
{ to_fun := direct_sum.submodule_coe_alg_hom 𝒜,
  inv_fun := graded_algebra.decompose',
  left_inv := graded_algebra.left_inv,
  right_inv := graded_algebra.right_inv,
  map_mul' := alg_hom.map_mul _,
  map_add' := alg_hom.map_add _,
  commutes' := alg_hom.commutes _ }

@[simp] lemma graded_algebra.decompose'_def :
  graded_algebra.decompose' = graded_algebra.decompose 𝒜 := rfl

@[simp] lemma graded_algebra.decompose_symm_of {i : ι} (x : 𝒜 i) :
  (graded_algebra.decompose 𝒜).symm (direct_sum.of _ i x) = x :=
direct_sum.submodule_coe_alg_hom_of 𝒜 _ _

/-- The projection maps of graded algebra-/
def graded_algebra.proj (𝒜 : ι → submodule R A) [graded_algebra 𝒜] (i : ι) : A →ₗ[R] A :=
(𝒜 i).subtype.comp $
  (dfinsupp.lapply i).comp $
  (graded_algebra.decompose 𝒜).to_alg_hom.to_linear_map

@[simp] lemma graded_algebra.proj_apply (i : ι) (r : A) :
  graded_algebra.proj 𝒜 i r = (graded_algebra.decompose 𝒜 r : ⨁ i, 𝒜 i) i := rfl

/-- The support of `r` is the `finset` where `proj R A i r ≠ 0 ↔ i ∈ r.support`-/
def graded_algebra.support [Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0)]
  (r : A) : finset ι :=
(graded_algebra.decompose 𝒜 r).support

lemma graded_algebra.proj_recompose (a : ⨁ i, 𝒜 i) (i : ι) :
  graded_algebra.proj 𝒜 i ((graded_algebra.decompose 𝒜).symm a) =
  (graded_algebra.decompose 𝒜).symm (direct_sum.of _ i (a i)) :=
by rw [graded_algebra.proj_apply, graded_algebra.decompose_symm_of, alg_equiv.apply_symm_apply]

@[simp] lemma graded_algebra.decompose_coe {i : ι} (x : 𝒜 i) :
  graded_algebra.decompose 𝒜 x = direct_sum.of _ i x :=
by rw [←graded_algebra.decompose_symm_of, alg_equiv.apply_symm_apply]

lemma graded_algebra.decompose_of_mem {x : A} {i : ι} (hx : x ∈ 𝒜 i) :
  graded_algebra.decompose 𝒜 x = direct_sum.of _ i (⟨x, hx⟩ : 𝒜 i) :=
graded_algebra.decompose_coe _ ⟨x, hx⟩

lemma graded_algebra.decompose_of_mem_same {x : A} {i : ι} (hx : x ∈ 𝒜 i) :
  (graded_algebra.decompose 𝒜 x i : A) = x :=
by rw [graded_algebra.decompose_of_mem _ hx, direct_sum.of_eq_same, subtype.coe_mk]

lemma graded_algebra.decompose_of_mem_ne {x : A} {i j : ι} (hx : x ∈ 𝒜 i) (hij : i ≠ j):
  (graded_algebra.decompose 𝒜 x j : A) = 0 :=
by rw [graded_algebra.decompose_of_mem _ hx, direct_sum.of_eq_of_ne _ _ _ _ hij, submodule.coe_zero]

variable [Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0)]

lemma graded_algebra.mem_support_iff (r : A) (i : ι) :
  i ∈ graded_algebra.support 𝒜 r ↔ graded_algebra.proj 𝒜 i r ≠ 0 :=
begin
  rw [graded_algebra.support, dfinsupp.mem_support_iff, graded_algebra.proj_apply],
  simp only [ne.def, submodule.coe_eq_zero],
end

lemma graded_algebra.sum_support_decompose (r : A) :
  ∑ i in graded_algebra.support 𝒜 r, (graded_algebra.decompose 𝒜 r i : A) = r :=
begin
  conv_rhs { rw [←(graded_algebra.decompose 𝒜).symm_apply_apply r,
    ←direct_sum.sum_support_of _ (graded_algebra.decompose 𝒜 r)] },
  rw [alg_equiv.map_sum, graded_algebra.support],
  simp_rw graded_algebra.decompose_symm_of,
end

end graded_algebra


import tactic
import graph_theory.minor graph_theory.product analysis.complex.basic

namespace simple_graph

def Z : simple_graph ℤ :=
{ adj := λ x y, |x-y| = 1,
  symm := λ x y h, by { rw ←h, convert abs_neg _, ring },
  loopless := λ x, by simp only [sub_self, abs_zero, zero_ne_one, not_false_iff] }

variables {V V' : Type*} {G : simple_graph V} {G' : simple_graph V'}

def plane : simple_graph (ℤ × ℤ) := Z □ Z

namespace plane
variables {x x' y y' z z' : ℤ}
open walk

def flip : plane →g plane :=
{ to_fun := prod.swap,
  map_rel' := by { rintros ⟨x,y⟩ ⟨x',y'⟩ h, cases h,
    { right, exact and.symm h },
    { left, exact and.symm h } } }

lemma horiz_path_aux : ∀ (n : ℕ), reachable plane (x,y) (x+n,y)
| 0     := by simp
| (n+1) := by { refine reachable.trans (horiz_path_aux n) (reachable.step (or.inr _)), simp [Z] }

lemma horiz_path : reachable plane (x,y) (x',y) :=
begin
  by_cases (x'-x>=0),
  { obtain ⟨n,hn⟩ := int.eq_coe_of_zero_le h, convert horiz_path_aux n, linarith },
  { replace h : x-x' ≥ 0, by linarith, obtain ⟨n,hn⟩ := int.eq_coe_of_zero_le h,
    symmetry, convert (@horiz_path_aux x' y n), linarith }
end

lemma vert_path : reachable plane (x,y) (x,y') :=
by { obtain ⟨p⟩ := horiz_path, use p.map flip }

lemma connected_plane : connected plane :=
⟨λ ⟨x,y⟩ ⟨x',y'⟩, reachable.trans horiz_path vert_path, ⟨(0,0)⟩⟩

end plane

def K5 := complete_graph (finset.range 5)
def K33 := complete_bipartite_graph (finset.range 3) (finset.range 3)

-- theorem kuratowski [fintype V] : G ≼ plane ↔ K5 ⋠ G ∧ K33 ⋠ G
end simple_graph


import tactic.monotonicity tactic.norm_num

import algebra.ordered_ring

import data.list.basic

open list tactic tactic.interactive

example
  (h : 3 + 6 ≤ 4 + 5)
: 1 + 3 + 2 + 6 ≤ 4 + 2 + 1 + 5 :=
begin
  ac_mono,
end

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
by ac_mono

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
begin
  transitivity (1 + 3 + 2 - 5 : ℤ),
  { ac_mono },
  { ac_mono },
end

example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (k + 3 + x) - y ≤ (k + 4 + x) - z :=
begin
  mono, norm_num
end

example (x y z a b : ℤ)
  (h : a ≤ (b : ℤ))
  (h' : z ≤ y)
: (1 + a + x) - y ≤ (1 + b + x) - z :=
begin
  transitivity (1 + a + x - z),
  { mono, },
  { mono, mono, mono },
end

example (x y z : ℤ)
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  transitivity (1 + 3 + x - z),
  { mono },
  { mono, mono, norm_num },
end

example (x y z : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  ac_mono, mono*
end

@[simp]
def list.le' {α : Type*} [has_le α] : list α → list α → Prop
 | (x::xs) (y::ys) := x ≤ y ∧ list.le' xs ys
 | [] [] := true
 | _ _ := false

@[simp]
instance list_has_le {α : Type*} [has_le α] : has_le (list α) :=
⟨ list.le' ⟩

lemma list.le_refl {α : Type*} [preorder α] {xs : list α}
: xs ≤ xs :=
begin
  induction xs with x xs,
  { trivial },
  { simp [has_le.le,list.le],
    split, apply le_refl, apply xs_ih }
end

-- @[trans]
lemma list.le_trans {α : Type*} [preorder α]
  {xs zs : list α} (ys : list α)
  (h  : xs ≤ ys)
  (h' : ys ≤ zs)
: xs ≤ zs :=
begin
  revert ys zs,
  induction xs with x xs
  ; intros ys zs h h'
  ; cases ys with y ys
  ; cases zs with z zs
  ; try { cases h ; cases h' ; done },
  { apply list.le_refl },
  { simp [has_le.le,list.le],
    split,
    apply le_trans h.left h'.left,
    apply xs_ih _ h.right h'.right, }
end

@[mono]
lemma list_le_mono_left {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: xs ++ zs ≤ ys ++ zs :=
begin
  revert ys,
  induction xs with x xs ; intros ys h,
  { cases ys, apply list.le_refl, cases h },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    revert h, apply and.imp_right,
    apply xs_ih }
end

@[mono]
lemma list_le_mono_right {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: zs ++ xs ≤ zs ++ ys :=
begin
  revert ys zs,
  induction xs with x xs ; intros ys zs h,
  { cases ys, { simp, apply list.le_refl }, cases h  },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    suffices : list.le' ((zs ++ [x]) ++ xs) ((zs ++ [y]) ++ ys),
    { refine cast _ this, simp, },
    apply list.le_trans (zs ++ [y] ++ xs),
    { apply list_le_mono_left,
      induction zs with z zs,
      { simp [has_le.le,list.le], apply h.left },
      { simp [has_le.le,list.le], split, apply le_refl,
        apply zs_ih, } },
    { apply xs_ih h.right, } }
end

lemma bar_bar'
  (h : [] ++ [3] ++ [2] ≤ [1] ++ [5] ++ [4])
: [] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

lemma bar_bar''
  (h : [3] ++ [2] ++ [2] ≤ [5] ++ [4] ++ [])
: [1] ++ ([3] ++ [2]) ++ [2] ≤ [1] ++ [5] ++ ([4] ++ []) :=
begin
  ac_mono,
end

lemma bar_bar
  (h : [3] ++ [2] ≤ [5] ++ [4])
: [1] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

def P (x : ℕ) := 7 ≤ x
def Q (x : ℕ) := x ≤ 7

@[mono]
lemma P_mono {x y : ℕ}
  (h : x ≤ y)
: P x → P y :=
by { intro h', apply le_trans h' h }

@[mono]
lemma Q_mono {x y : ℕ}
  (h : y ≤ x)
: Q x → Q y :=
by apply le_trans h

example (x y z : ℕ)
  (h : x ≤ y)
: P (x + z) → P (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z : ℕ)
  (h : y ≤ x)
: Q (x + z) → Q (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℤ)
  (h₀ : z ≤ 0)
  (h₁ : y ≤ x)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  -- ⊢ (m + x + n) * z ≤ z * (y + n + m)
  ac_mono,
  -- ⊢ m + x + n ≤ y + n + m
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by {  ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : m + x + n ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by { ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : n + x + m ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono* : m + x + n ≤ y + n + m,
  transitivity ; [ skip , apply h₁ ],
  apply le_of_eq,
  ac_refl,
end

example (x y z k m n : ℤ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    success_if_fail { ac_mono },
    admit },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono*,
    change 0 ≤ z, apply nat.zero_le, },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    change (m + x + n) * z ≤ z * (y + n + m),
    admit },
  trivial,
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono^3,
  simp [h₁],
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: z * (x + i + n + m) + k = z * (y + j + n + m) + k :=
begin
  congr,
  simp [h₁],
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono*,
  simp [h₁],
end

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 1,
end

example {x y z : ℕ} : true :=
begin
  have : y + x ≤ y + z,
  { mono,
    guard_target' x ≤ z,
    admit },
  trivial
end

example {x y z : ℕ} : true :=
begin
  suffices : x + y ≤ z + y, trivial,
  mono,
  guard_target' x ≤ z,
  admit,
end

example {x y z w : ℕ} : true :=
begin
  have : x + y ≤ z + w,
  { mono,
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : ℕ} : true :=
begin
  have : x * y ≤ z * w,
  { mono with [0 ≤ z,0 ≤ y],
    { guard_target 0 ≤ z, admit },
    { guard_target 0 ≤ y, admit },
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∧ y → z ∧ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∨ y → z ∨ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : ℤ} : true :=
begin
  suffices : x + y < w + z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
end

example {x y z w : ℤ} : true :=
begin
  suffices : x * y < w * z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
  { guard_target' 0 < y, admit },
  { guard_target' 0 ≤ w, admit },
end

open tactic

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 3
end

example {α} [decidable_linear_order α]
  (a b c d e : α) :
  max a b ≤ e → b ≤ e :=
by { mono, apply le_max_right }

example (a b c d e : Prop)
  (h : d → a) (h' : c → e) :
  (a ∧ b → c) ∨ d → (d ∧ b → e) ∨ a :=
begin
  mono,
  mono,
  mono,
end


import data.real.basic

-- Some useful defs involving if-then-else
-- absolute value on ℝ (or any instance of decidable_linear_ordered_add_com_group)
notation `|`x`|`:= abs x

-- lemma definition.abs
-- {a: ℝ} : abs a = if a ≤ 0 then -a else a :=
-- begin
--     todo,
-- end

-- lemma definition.min
-- {a b: ℝ} : min a b = if a ≤ b then a else b :=
-- begin
--     todo,
-- end

-- lemma definition.max
-- {a b: ℝ} : max a b = if a ≤ b then b else a :=
-- begin
--     todo,
-- end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Multivariate functions of the form `α^n → α` are isomorphic to multivariate polynomials in
`n` variables.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.ideal.operations
import Mathlib.linear_algebra.finsupp_vector_space
import Mathlib.algebra.char_p.basic
import Mathlib.PostPort

universes u v u_1 u_2

namespace Mathlib

namespace mv_polynomial

theorem quotient_mk_comp_C_injective (σ : Type u) (α : Type v) [field α] (I : ideal (mv_polynomial σ α)) (hI : I ≠ ⊤) : function.injective ⇑(ring_hom.comp (ideal.quotient.mk I) C) := sorry

def restrict_total_degree (σ : Type u) (α : Type v) [field α] (m : ℕ) : submodule α (mv_polynomial σ α) :=
  finsupp.supported α α (set_of fun (n : σ →₀ ℕ) => (finsupp.sum n fun (n : σ) (e : ℕ) => e) ≤ m)

theorem mem_restrict_total_degree (σ : Type u) (α : Type v) [field α] (m : ℕ) (p : mv_polynomial σ α) : p ∈ restrict_total_degree σ α m ↔ total_degree p ≤ m := sorry

def restrict_degree (σ : Type u) (α : Type v) (m : ℕ) [field α] : submodule α (mv_polynomial σ α) :=
  finsupp.supported α α (set_of fun (n : σ →₀ ℕ) => ∀ (i : σ), coe_fn n i ≤ m)

theorem mem_restrict_degree {σ : Type u} {α : Type v} [field α] (p : mv_polynomial σ α) (n : ℕ) : p ∈ restrict_degree σ α n ↔ ∀ (s : σ →₀ ℕ), s ∈ finsupp.support p → ∀ (i : σ), coe_fn s i ≤ n := sorry

theorem mem_restrict_degree_iff_sup {σ : Type u} {α : Type v} [field α] (p : mv_polynomial σ α) (n : ℕ) : p ∈ restrict_degree σ α n ↔ ∀ (i : σ), multiset.count i (degrees p) ≤ n := sorry

theorem map_range_eq_map {σ : Type u} {α : Type v} {β : Type u_1} [comm_ring α] [comm_ring β] (p : mv_polynomial σ α) (f : α →+* β) : finsupp.map_range (⇑f) (ring_hom.map_zero f) p = coe_fn (map f) p := sorry

theorem is_basis_monomials (σ : Type u) (α : Type v) [field α] : is_basis α fun (s : σ →₀ ℕ) => monomial s 1 := sorry

end mv_polynomial

namespace mv_polynomial

theorem dim_mv_polynomial (σ : Type u) (α : Type u) [field α] : vector_space.dim α (mv_polynomial σ α) = cardinal.mk (σ →₀ ℕ) := sorry

end mv_polynomial

namespace mv_polynomial

protected instance char_p (σ : Type u_1) (R : Type u_2) [comm_ring R] (p : ℕ) [char_p R p] : char_p (mv_polynomial σ R) p :=
  char_p.mk
    fun (n : ℕ) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (↑n = 0 ↔ p ∣ n)) (Eq.symm (C_eq_coe_nat n))))
        (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn C ↑n = 0 ↔ p ∣ n)) (Eq.symm C_0)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn C ↑n = coe_fn C 0 ↔ p ∣ n)) (propext (C_inj R (↑n) 0))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (↑n = 0 ↔ p ∣ n)) (propext (char_p.cast_eq_zero_iff R p n))))
              (iff.refl (p ∣ n)))))


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

! This file was ported from Lean 3 source module category_theory.preadditive.of_biproducts
! leanprover-community/mathlib commit 061ea99a5610cfc72c286aa930d3c1f47f74f3d0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Biproducts
import Mathlib.GroupTheory.EckmannHilton
import Mathlib.Tactic.Reassoc
/-!
# Constructing a semiadditive structure from binary biproducts

We show that any category with zero morphisms and binary biproducts is enriched over the category
of commutative monoids.

-/

noncomputable section

universe v u

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.SemiadditiveOfBinaryBiproducts

variable {C : Type u} [Category.{v} C] [HasZeroMorphisms C] [HasBinaryBiproducts C]

section

variable (X Y : C)

/-- `f +ₗ g` is the composite `X ⟶ Y ⊞ Y ⟶ Y`, where the first map is `(f, g)` and the second map
    is `(𝟙 𝟙)`. -/
@[simp]
def leftAdd (f g : X ⟶ Y) : X ⟶ Y :=
  biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y)
#align category_theory.semiadditive_of_binary_biproducts.left_add CategoryTheory.SemiadditiveOfBinaryBiproducts.leftAdd

/-- `f +ᵣ g` is the composite `X ⟶ X ⊞ X ⟶ Y`, where the first map is `(𝟙, 𝟙)` and the second map
    is `(f g)`. -/
@[simp]
def rightAdd (f g : X ⟶ Y) : X ⟶ Y :=
  biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g
#align category_theory.semiadditive_of_binary_biproducts.right_add CategoryTheory.SemiadditiveOfBinaryBiproducts.rightAdd

-- mathport name: «expr +ₗ »
local infixr:65 " +ₗ " => leftAdd X Y

-- mathport name: «expr +ᵣ »
local infixr:65 " +ᵣ " => rightAdd X Y

theorem isUnital_leftAdd : EckmannHilton.IsUnital (· +ₗ ·) 0 := by
  have hr : ∀ f : X ⟶ Y, biprod.lift (0 : X ⟶ Y) f = f ≫ biprod.inr := by
    intro f
    ext
    aesop_cat
    simp [biprod.lift_fst, Category.assoc, biprod.inr_fst, comp_zero]
  have hl : ∀ f : X ⟶ Y, biprod.lift f (0 : X ⟶ Y) = f ≫ biprod.inl := by
    intro f
    ext
    aesop_cat
    simp [biprod.lift_snd, Category.assoc, biprod.inl_snd, comp_zero]
  exact ⟨⟨fun f => by simp [hr f, leftAdd, Category.assoc, Category.comp_id, biprod.inr_desc]⟩,
    ⟨fun f => by simp [hl f, leftAdd, Category.assoc, Category.comp_id, biprod.inl_desc]⟩⟩
#align category_theory.semiadditive_of_binary_biproducts.is_unital_left_add CategoryTheory.SemiadditiveOfBinaryBiproducts.isUnital_leftAdd

theorem isUnital_rightAdd : EckmannHilton.IsUnital (· +ᵣ ·) 0 := by
  have h₂ : ∀ f : X ⟶ Y, biprod.desc (0 : X ⟶ Y) f = biprod.snd ≫ f := by
    intro f
    ext
    aesop_cat
    simp only [biprod.inr_desc, BinaryBicone.inr_snd_assoc]
  have h₁ : ∀ f : X ⟶ Y,  biprod.desc f (0 : X ⟶ Y) = biprod.fst ≫ f := by
    intro f
    ext
    aesop_cat
    simp only [biprod.inr_desc, BinaryBicone.inr_fst_assoc, zero_comp]
  exact ⟨⟨fun f => by simp [h₂ f, rightAdd, biprod.lift_snd_assoc, Category.id_comp]⟩,
    ⟨fun f => by simp [h₁ f, rightAdd, biprod.lift_fst_assoc, Category.id_comp]⟩⟩
#align category_theory.semiadditive_of_binary_biproducts.is_unital_right_add CategoryTheory.SemiadditiveOfBinaryBiproducts.isUnital_rightAdd

theorem distrib (f g h k : X ⟶ Y) : (f +ᵣ g) +ₗ h +ᵣ k = (f +ₗ h) +ᵣ g +ₗ k := by
  let diag : X ⊞ X ⟶ Y ⊞ Y := biprod.lift (biprod.desc f g) (biprod.desc h k)
  have hd₁ : biprod.inl ≫ diag = biprod.lift f h := by ext <;> simp
  have hd₂ : biprod.inr ≫ diag = biprod.lift g k := by ext <;> simp
  have h₁ : biprod.lift (f +ᵣ g) (h +ᵣ k) = biprod.lift (𝟙 X) (𝟙 X) ≫ diag := by
      ext <;> aesop_cat
  have h₂ : diag ≫ biprod.desc (𝟙 Y) (𝟙 Y) = biprod.desc (f +ₗ h) (g +ₗ k) := by
    ext <;> simp [reassoc_of% hd₁, reassoc_of% hd₂] <;> aesop_cat
  rw [leftAdd, h₁, Category.assoc, h₂, rightAdd]
#align category_theory.semiadditive_of_binary_biproducts.distrib CategoryTheory.SemiadditiveOfBinaryBiproducts.distrib

/-- In a category with binary biproducts, the morphisms form a commutative monoid. -/
def addCommMonoidHomOfHasBinaryBiproducts : AddCommMonoid (X ⟶ Y)
    where
  add := (· +ᵣ ·)
  add_assoc :=
    (EckmannHilton.mul_assoc (isUnital_leftAdd X Y) (isUnital_rightAdd X Y) (distrib X Y)).assoc
  zero := 0
  zero_add := (isUnital_rightAdd X Y).left_id
  add_zero := (isUnital_rightAdd X Y).right_id
  add_comm :=
    (EckmannHilton.mul_comm (isUnital_leftAdd X Y) (isUnital_rightAdd X Y) (distrib X Y)).comm
#align category_theory.semiadditive_of_binary_biproducts.add_comm_monoid_hom_of_has_binary_biproducts CategoryTheory.SemiadditiveOfBinaryBiproducts.addCommMonoidHomOfHasBinaryBiproducts

end

section

variable {X Y Z : C}

attribute [local instance] addCommMonoidHomOfHasBinaryBiproducts

theorem add_eq_right_addition (f g : X ⟶ Y) : f + g = biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g :=
  rfl
#align category_theory.semiadditive_of_binary_biproducts.add_eq_right_addition CategoryTheory.SemiadditiveOfBinaryBiproducts.add_eq_right_addition

theorem add_eq_left_addition (f g : X ⟶ Y) : f + g = biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) :=
  congr_fun₂ (EckmannHilton.mul (isUnital_leftAdd X Y) (isUnital_rightAdd X Y) (distrib X Y)).symm f
    g
#align category_theory.semiadditive_of_binary_biproducts.add_eq_left_addition CategoryTheory.SemiadditiveOfBinaryBiproducts.add_eq_left_addition

theorem add_comp (f g : X ⟶ Y) (h : Y ⟶ Z) : (f + g) ≫ h = f ≫ h + g ≫ h := by
  simp only [add_eq_right_addition, Category.assoc]
  congr
  ext <;> simp
#align category_theory.semiadditive_of_binary_biproducts.add_comp CategoryTheory.SemiadditiveOfBinaryBiproducts.add_comp

theorem comp_add (f : X ⟶ Y) (g h : Y ⟶ Z) : f ≫ (g + h) = f ≫ g + f ≫ h := by
  simp only [add_eq_left_addition, ← Category.assoc]
  congr
  ext <;> simp
#align category_theory.semiadditive_of_binary_biproducts.comp_add CategoryTheory.SemiadditiveOfBinaryBiproducts.comp_add

end

end CategoryTheory.SemiadditiveOfBinaryBiproducts


/- A toy dialect with basic tensor computations. -/

import MLIR.Dialects.BuiltinModel
import MLIR.Util.List
import MLIR.Util.KDTensor

open DimList
open MLIR.AST (TensorElem)

/-
### Tensor transposition operation

This operation shuffles the elements of the underlying data without changing
its size. To keep this clean it's beneficial to separate the dimension logic
from the index manipulation of the transposition itself.
-/

def transpose_remap (n m: Nat): Nat → Nat :=
  fun i => m * (i % n) + (i / n)

theorem transpose_remap_bound (n m):
    ∀ i, i < n * m → transpose_remap n m i < n * m := by
  intro i h
  simp [transpose_remap]
  sorry /- m*(≤ n-1)+(< m) -/

theorem transpose_remap_involutive (n m):
    ∀i, transpose_remap m n (transpose_remap n m i) = i := by
  simp [transpose_remap, Function.comp]; intro i
  sorry /- = (i/n)*n + i%n -/

@[inline]
def Matrix n m τ :=
  RankedTensor [MLIR.AST.Dimension.Known n, MLIR.AST.Dimension.Known m] τ

def transpose (t: Matrix n m τ): Matrix m n τ :=
  { shape := [m, n],
    data := List.remap t.data (transpose_remap n m)
        (by intro i h
            rw [t.h_data_size, dim_known_prod_refines _ t.h_refines] at * <;>
            simp at *
            apply transpose_remap_bound; assumption),
    h_refines := by simp,
    h_data_size := by
      simp [shapeProd, List.foldr];
      rw [t.h_data_size, dim_known_prod_refines _ t.h_refines] <;>
      simp [Nat.mul_comm] }

theorem Function.comp_assoc {α β γ δ} (f: α → β) (g: β → γ) (h: γ → δ):
    (h ∘ g) ∘ f = h ∘ (g ∘ f) :=
  by funext x; simp

theorem transpose_involutive {α n m}:
    ∀ (t: Matrix α n m), transpose (transpose t) = t := by
  intro t;
  simp [transpose]
  apply RankedTensor.eq_of_fields_eq <;> simp
  . rw [←dim_known_project_eq _ t.h_refines] <;> simp
  . simp [List.remap_remap]
    apply List.extF <;> simp
    simp [transpose_remap_involutive]


import number_theory.kummer_dedekind

variables {R : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R]

variables {S : Type*} [comm_ring S] [algebra R S]

open ideal polynomial unique_factorization_monoid

lemma card_normalized_factors_eq_one_iff {R : Type*} [cancel_comm_monoid_with_zero R]
  [unique_factorization_monoid R] [normalization_monoid R] [decidable_eq R]
  (p : R) : (normalized_factors p).card = 1 ↔ irreducible p :=
begin
  by_cases hp0 : p = 0,
  { simp [hp0] },
  rw multiset.card_eq_one,
  split,
  { rintro ⟨q, hq⟩,
    have hq' : q ∈ normalized_factors p,
    { simpa only [hq] using multiset.mem_singleton_self q },
    have := unique_factorization_monoid.normalized_factors_prod hp0,
    rw [hq, multiset.prod_singleton] at this,
    exact this.irreducible (irreducible_of_normalized_factor _ hq') },
  { intros hp,
    exact ⟨normalize p, unique_factorization_monoid.normalized_factors_irreducible hp⟩ },
end

open kummer_dedekind

/-- An ideal is inert if the minimal polynomial remains irreducible. -/
theorem ideal.irreducible_map_iff_irreducible_minpoly
  [is_domain S] [is_dedekind_domain S] (pb : power_basis R S)
  {I : ideal R} (hI : is_maximal I) (hI' : I.map (algebra_map R S) ≠ ⊥)
  (hpb : map I^.quotient.mk (minpoly R pb.gen) ≠ 0) :
  irreducible (I.map (algebra_map R S)) ↔
    irreducible (map I^.quotient.mk (minpoly R pb.gen)) :=
begin
  classical,
  letI : field (R ⧸ I) := ideal.quotient.field I,
  rw [← card_normalized_factors_eq_one_iff, ← card_normalized_factors_eq_one_iff,
      normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map pb hI,
      multiset.card_map, multiset.card_attach],
  unfreezingI { rintro rfl },
  simpa using hI'
end

alias ideal.irreducible_map_iff_irreducible_minpoly ↔ _ ideal.irreducible_map_of_irreducible_minpoly


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Making ℤ from ℕ²

You can define `ℤ` as ℕ² / ≈, where (a,b) ≈ (c,d) ↔ a + d = b + c.
This sheet goes through this (definition, commutative ring structure) with very few hints.
All the techniques are things we've seen in the earlier sheets.

Hint: if the tactic state is

h : a + d = b + c
⊢ c + b = d + a

you can close the goal with `linarith`. If things get nonlinear (multiplication,
I'm looking at you), there's always `nlinarith`.

-/

/-

# Warm-up: how products work in Lean

-/

-- constructor for ℕ × ℕ

example : ℕ × ℕ := (3,4)

-- eliminators

def foo : ℕ × ℕ := (37, 53)

example : foo.1 = 37 :=
begin
  refl
end

example : foo.2 = 53 :=
begin
  refl
end

-- warning : constructor on eliminators isn't refl
example (a : ℕ × ℕ) : a = (a.1, a.2) :=
begin
  -- refl fails
  cases a with x y, -- a term of type ℕ × ℕ is a pair; `cases` takes it apart.
  -- now refl works
  refl,
end

def R (ab cd : ℕ × ℕ) : Prop :=
ab.1 + cd.2 = ab.2 + cd.1

lemma R_def (ab cd : ℕ × ℕ) :
R ab cd ↔ ab.1 + cd.2 = ab.2 + cd.1 :=
begin
  sorry
end

lemma R_def' (a b c d : ℕ) :
R (a, b) (c, d) ↔ a + d = b + c :=
begin
  sorry
end

lemma R_refl : reflexive R :=
begin
  sorry,
end

lemma R_symm : symmetric R :=
begin
  sorry,
end

lemma R_trans : transitive R :=
begin
  sorry,
end

instance s : setoid (ℕ × ℕ) :=
{ r := R,
  iseqv := ⟨R_refl, R_symm, R_trans⟩ }

@[simp] lemma equiv_def (a b c d : ℕ) :
  (a, b) ≈ (c, d) ↔ a + d = b + c :=
begin
  sorry
end

notation `myint` := quotient s

-- Amusingly, we can't now make a myint namespace unless
-- we do some weird quote thing (Lean unfolds the notation otherwise)
namespace «myint»

instance : has_zero myint :=
{ zero := ⟦(0,0)⟧ }

@[simp] lemma zero_def : (0 : myint) = ⟦(0, 0)⟧ :=
begin
  sorry
end

def neg : myint → myint :=
quotient.map (λ ab, (ab.2, ab.1)) begin
  sorry,
end

instance : has_neg myint :=
{ neg := neg }

@[simp] lemma neg_def (a b : ℕ) :
  -⟦(a, b)⟧ = ⟦(b, a)⟧ :=
begin
  sorry,
end

def add : myint → myint → myint :=
quotient.map₂ (λ ab cd, (ab.1 + cd.1, ab.2 + cd.2)) begin
  sorry,
end

instance : has_add myint :=
{ add := add }

@[simp] lemma add_def (a b c d : ℕ) :
  ⟦(a, b)⟧ + ⟦(c, d)⟧ = ⟦(a + c, b + d)⟧ :=
begin
  sorry
end

instance add_comm_group : add_comm_group myint :=
{ add := (+),
  add_assoc := begin
    sorry,
  end,
  zero := 0,
  zero_add := begin
    sorry,
  end,
  add_zero := begin
    sorry,
  end,
  neg := has_neg.neg,
  add_left_neg := begin
    sorry,
  end,
  add_comm := begin
    sorry,
  end }

-- our model is that the equivalence class ⟦(a, b)⟧
-- represents the integer a - b
instance : has_one myint :=
{ one := ⟦(1, 0)⟧}

@[simp] lemma one_def : (1 : myint) = ⟦(1, 0)⟧ :=
begin
  sorry,
end

-- (a-b)*(c-d)=(ac+bd)-(ad+bc)
def mul : myint → myint → myint :=
quotient.map₂ (λ ab cd, (ab.1 * cd.1 + ab.2 * cd.2, ab.1 * cd.2 + ab.2 * cd.1)) begin
  sorry,
end

instance : has_mul myint :=
{ mul := mul }

@[simp] lemma mul_def (a b c d : ℕ) :
  ⟦(a, b)⟧ * ⟦(c, d)⟧ = ⟦(a * c + b * d, a * d + b * c)⟧ :=
begin
  sorry,
end

instance : comm_ring myint :=
{ add := (+),
  zero := 0,
  mul := (*),
  mul_assoc := begin
    sorry,
  end,
  one := 1,
  one_mul := begin
    sorry,
  end,
  mul_one := begin
    sorry,
  end,
  left_distrib := begin
    sorry,
  end,
  right_distrib := begin
    sorry,
  end,
  mul_comm := begin
    sorry,
  end,
  ..myint.add_comm_group }

end «myint»


/-
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

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 : polynomial R}

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 : polynomial R) : 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} {φ ψ : polynomial R} :
  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 : polynomial R).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 : polynomial R).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 : polynomial R) (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 : polynomial R →+ S :=
{ to_fun := eval₂ f x,
  map_zero' := eval₂_zero _ _,
  map_add' := λ _ _, eval₂_add _ _ }

@[simp] lemma eval₂_nat_cast (n : ℕ) : (n : polynomial R).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 : polynomial T) (g : ℕ → T → polynomial R) (x : S) :
  (p.sum g).eval₂ f x = p.sum (λ n a, (g n a).eval₂ f x) :=
begin
  let T : polynomial R →+ 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 : ι → polynomial R) (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₂_to_finsupp_eq_lift_nc {f : R →+* S} {x : S} {p : add_monoid_algebra R ℕ} :
  eval₂ f x (⟨p⟩ : polynomial R) = lift_nc ↑f (powers_hom S x) p :=
by { simp only [eval₂_eq_sum, sum, sum_to_finsupp, 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 [mul_to_finsupp, eval₂_to_finsupp_eq_lift_nc],
  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 (polynomial R))
  (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) : polynomial R →+* 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 : polynomial R) (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 : polynomial R) (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) : polynomial R →+* 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 : polynomial R} {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 → polynomial R → R := eval₂ (ring_hom.id _)

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

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

lemma eval_eq_finset_sum' (P : polynomial R) :
  (λ x, eval x P) = (λ x, ∑ i in range (P.nat_degree + 1), P.coeff i * x ^ i) :=
begin
  ext,
  exact P.eval_eq_finset_sum x
end

@[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 : polynomial R).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 : polynomial R).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 : polynomial R).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 : polynomial R) (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) : polynomial R →ₗ[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 : polynomial R) * 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 : polynomial R) (f : ℕ → R → polynomial R) (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 : ι → polynomial R) (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 : polynomial R) (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 : polynomial R) :
  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 : polynomial R} (hp : p.coeff 0 = 0) :
  is_root p 0 :=
by rwa coeff_zero_eq_eval_zero at hp

end eval

section comp

/-- The composition of polynomials as a polynomial. -/
def comp (p q : polynomial R) : polynomial R := 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 : polynomial R).comp p = n :=
by rw [←C_eq_nat_cast, C_comp]

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

@[simp] lemma zero_comp : comp (0 : polynomial R) 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 : polynomial R) 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 : polynomial R) * 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 : polynomial R) :
  (p * q).comp r = p.comp r * q.comp r := eval₂_mul _ _

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

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

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

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

lemma comp_assoc {R : Type*} [comm_semiring R] (φ ψ χ : polynomial R) :
  (φ.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

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 : polynomial R → polynomial S := 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 : polynomial R).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 : polynomial R).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` -/
-- TODO: can't we make this the main definition of `polynomial.map`?
def map_ring_hom (f : R →+* S) : polynomial R →+* polynomial S :=
{ 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

@[simp] theorem map_nat_cast (n : ℕ) : (n : polynomial R).map f = n :=
(map_ring_hom f).map_nat_cast 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, 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) : polynomial R ≃+* polynomial S :=
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 : polynomial R) : (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 : polynomial R) : 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_refl _)],
end

lemma nat_degree_map_le (p : polynomial R) : 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 (polynomial R) :=
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 $ map_map g f

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

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

lemma mem_map_srange {p : polynomial S} :
  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, map_pow, map_X] }
end

lemma mem_map_range {R S : Type*} [ring R] [ring S] (f : R →+* S)
  {p : polynomial S} : 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 :=
begin
  have A : nat_degree (p.map f) < p.nat_degree.succ :=
    (nat_degree_map_le _ _).trans_lt (nat.lt_succ_self _),
  conv_lhs { rw [eval₂_eq_sum], },
  rw [sum_over_range' _ _ _ A],
  { simp only [coeff_map, eval₂_eq_sum, sum_over_range, forall_const, zero_mul, ring_hom.map_zero,
      function.comp_app, ring_hom.coe_comp] },
  { simp only [forall_const, zero_mul, ring_hom.map_zero] }
end

lemma eval_map (x : S) : (p.map f).eval x = p.eval₂ f x :=
eval₂_map f (ring_hom.id _) x

lemma map_sum {ι : Type*} (g : ι → polynomial R) (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 : polynomial R) : 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 : polynomial R) :
  (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 : polynomial R) :
  (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 : polynomial R) (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 [f.map_nat_cast, 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 : polynomial R) (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₂
-- TODO: Here we need commutativity in both `S` and `T`?
variables [comm_semiring S] [comm_semiring T]
variables (f : R →+* S) (g : S →+* T) (p)

lemma hom_eval₂ (x : S) : g (p.eval₂ f x) = p.eval₂ (g.comp f) (g x) :=
begin
  apply polynomial.induction_on p; clear p,
  { simp only [forall_const, eq_self_iff_true, eval₂_C, ring_hom.coe_comp] },
  { intros p q hp hq, simp only [hp, hq, eval₂_add, g.map_add] },
  { intros n a ih, simpa only [eval₂_mul, eval₂_C, eval₂_X_pow, g.map_mul, g.map_pow] }
end

end hom_eval₂

end semiring

section comm_semiring

section eval

variables [comm_semiring R] {p q : polynomial R} {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 → polynomial R →+* R := eval₂_ring_hom (ring_hom.id _)

@[simp] lemma coe_eval_ring_hom (r : R) : ((eval_ring_hom r) : polynomial R → 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 : polynomial R → polynomial R →+* polynomial R :=
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 : polynomial R) {q : polynomial R} :
  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 : polynomial R} (q : polynomial R) :
  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 finset.prod
-/
lemma eval_prod {ι : Type*} (s : finset ι) (p : ι → polynomial R) (x : R) :
  eval x (∏ j in s, p j) = ∏ j in s, eval x (p j) :=
begin
  classical,
  apply finset.induction_on s,
  { simp only [finset.prod_empty, eval_one] },
  { intros j s hj hpj,
    have h0 : ∏ i in insert j s, eval x (p i) = (eval x (p j)) * ∏ i in s, eval x (p i),
    { apply finset.prod_insert hj },
    rw [h0, ← hpj, finset.prod_insert hj, eval_mul] },
end

lemma is_root_prod {R} [comm_ring R] [is_domain R] {ι : Type*}
  (s : finset ι) (p : ι → polynomial R) (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

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

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

lemma map_prod {ι : Type*} (g : ι → polynomial R) (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 : polynomial R) : (map f p).support ⊆ p.support :=
begin
  intros x,
  simp only [mem_support_iff],
  contrapose!,
  rw coeff_map,
  intro hx,
  rw hx,
  exact ring_hom.map_zero f,
end

lemma is_root.map {f : R →+* S} {x : R} {p : polynomial R} (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 : polynomial R}
  (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 : polynomial R}
  (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 : polynomial R}

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 : polynomial R).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 : polynomial R) (x : R) : (-p).eval x = -p.eval x :=
eval₂_neg _

@[simp] lemma eval_sub (p q : polynomial R) (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 : polynomial R) p = i :=
by cases i; simp

end ring

end polynomial


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Yury Kudryashov
-/
import data.real.sqrt
import data.rat.sqrt
import ring_theory.int.basic
import data.polynomial.eval
import data.polynomial.degree
import tactic.interval_cases
import ring_theory.algebraic
/-!
# Irrational real numbers

In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
`rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.

We also provide dot-style constructors like `irrational.add_rat`, `irrational.rat_sub` etc.
-/

open rat real multiplicity

/-- A real number is irrational if it is not equal to any rational number. -/
def irrational (x : ℝ) := x ∉ set.range (coe : ℚ → ℝ)

lemma irrational_iff_ne_rational (x : ℝ) : irrational x ↔ ∀ a b : ℤ, x ≠ a / b :=
by simp only [irrational, rat.forall, cast_mk, not_exists, set.mem_range, cast_coe_int, cast_div,
  eq_comm]

/-- A transcendental real number is irrational. -/
lemma transcendental.irrational {r : ℝ} (tr : transcendental ℚ r) :
  irrational r :=
by { rintro ⟨a, rfl⟩, exact tr (is_algebraic_algebra_map a) }

/-!
### Irrationality of roots of integer and rational numbers
-/

/-- If `x^n`, `n > 0`, is integer and is not the `n`-th power of an integer, then
`x` is irrational. -/
theorem irrational_nrt_of_notint_nrt {x : ℝ} (n : ℕ) (m : ℤ)
  (hxr : x ^ n = m) (hv : ¬ ∃ y : ℤ, x = y) (hnpos : 0 < n) :
  irrational x :=
begin
  rintros ⟨⟨N, D, P, C⟩, rfl⟩,
  rw [← cast_pow] at hxr,
  have c1 : ((D : ℤ) : ℝ) ≠ 0,
  { rw [int.cast_ne_zero, int.coe_nat_ne_zero], exact ne_of_gt P },
  have c2 : ((D : ℤ) : ℝ) ^ n ≠ 0 := pow_ne_zero _ c1,
  rw [num_denom', cast_pow, cast_mk, div_pow, div_eq_iff_mul_eq c2,
      ← int.cast_pow, ← int.cast_pow, ← int.cast_mul, int.cast_inj] at hxr,
  have hdivn : ↑D ^ n ∣ N ^ n := dvd.intro_left m hxr,
  rw [← int.dvd_nat_abs, ← int.coe_nat_pow, int.coe_nat_dvd, int.nat_abs_pow,
    nat.pow_dvd_pow_iff hnpos] at hdivn,
  have hD : D = 1 := by rw [← nat.gcd_eq_right hdivn, C.gcd_eq_one],
  subst D,
  refine hv ⟨N, _⟩,
  rw [num_denom', int.coe_nat_one, mk_eq_div, int.cast_one, div_one, cast_coe_int]
end

/-- If `x^n = m` is an integer and `n` does not divide the `multiplicity p m`, then `x`
is irrational. -/
theorem irrational_nrt_of_n_not_dvd_multiplicity {x : ℝ} (n : ℕ) {m : ℤ} (hm : m ≠ 0) (p : ℕ)
  [hp : fact p.prime] (hxr : x ^ n = m)
  (hv : (multiplicity (p : ℤ) m).get (finite_int_iff.2 ⟨hp.1.ne_one, hm⟩) % n ≠ 0) :
  irrational x :=
begin
  rcases nat.eq_zero_or_pos n with rfl | hnpos,
  { rw [eq_comm, pow_zero, ← int.cast_one, int.cast_inj] at hxr,
    simpa [hxr, multiplicity.one_right (mt is_unit_iff_dvd_one.1
      (mt int.coe_nat_dvd.1 hp.1.not_dvd_one)), nat.zero_mod] using hv },
  refine irrational_nrt_of_notint_nrt _ _ hxr _ hnpos,
  rintro ⟨y, rfl⟩,
  rw [← int.cast_pow, int.cast_inj] at hxr, subst m,
  have : y ≠ 0, { rintro rfl, rw zero_pow hnpos at hm, exact hm rfl },
  erw [multiplicity.pow' (nat.prime_iff_prime_int.1 hp.1)
    (finite_int_iff.2 ⟨hp.1.ne_one, this⟩), nat.mul_mod_right] at hv,
  exact hv rfl
end

theorem irrational_sqrt_of_multiplicity_odd (m : ℤ) (hm : 0 < m)
  (p : ℕ) [hp : fact p.prime]
  (Hpv : (multiplicity (p : ℤ) m).get
    (finite_int_iff.2 ⟨hp.1.ne_one, (ne_of_lt hm).symm⟩) % 2 = 1) :
  irrational (sqrt m) :=
@irrational_nrt_of_n_not_dvd_multiplicity _ 2 _ (ne.symm (ne_of_lt hm)) p hp
  (sq_sqrt (int.cast_nonneg.2 $ le_of_lt hm))
  (by rw Hpv; exact one_ne_zero)

theorem nat.prime.irrational_sqrt {p : ℕ} (hp : nat.prime p) : irrational (sqrt p) :=
@irrational_sqrt_of_multiplicity_odd p (int.coe_nat_pos.2 hp.pos) p ⟨hp⟩ $
by simp [multiplicity_self (mt is_unit_iff_dvd_one.1 (mt int.coe_nat_dvd.1 hp.not_dvd_one) : _)];
  refl

theorem irrational_sqrt_two : irrational (sqrt 2) :=
by simpa using nat.prime_two.irrational_sqrt

theorem irrational_sqrt_rat_iff (q : ℚ) : irrational (sqrt q) ↔
  rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q :=
if H1 : rat.sqrt q * rat.sqrt q = q
then iff_of_false (not_not_intro ⟨rat.sqrt q,
  by rw [← H1, cast_mul, sqrt_mul_self (cast_nonneg.2 $ rat.sqrt_nonneg q),
         sqrt_eq, abs_of_nonneg (rat.sqrt_nonneg q)]⟩) (λ h, h.1 H1)
else if H2 : 0 ≤ q
then iff_of_true (λ ⟨r, hr⟩, H1 $ (exists_mul_self _).1 ⟨r,
  by rwa [eq_comm, sqrt_eq_iff_mul_self_eq (cast_nonneg.2 H2), ← cast_mul, rat.cast_inj] at hr;
  rw [← hr]; exact real.sqrt_nonneg _⟩) ⟨H1, H2⟩
else iff_of_false (not_not_intro ⟨0,
  by rw cast_zero; exact (sqrt_eq_zero_of_nonpos (rat.cast_nonpos.2 $ le_of_not_le H2)).symm⟩)
  (λ h, H2 h.2)

instance (q : ℚ) : decidable (irrational (sqrt q)) :=
decidable_of_iff' _ (irrational_sqrt_rat_iff q)

/-!
### Adding/subtracting/multiplying by rational numbers
-/

lemma rat.not_irrational (q : ℚ) : ¬irrational q := λ h, h ⟨q, rfl⟩

namespace irrational

variables (q : ℚ) {x y : ℝ}

open_locale classical

theorem add_cases : irrational (x + y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx + ry, cast_add rx ry⟩
end

theorem of_rat_add (h : irrational (q + x)) : irrational x :=
h.add_cases.elim (λ h, absurd h q.not_irrational) id

theorem rat_add (h : irrational x) : irrational (q + x) :=
of_rat_add (-q) $ by rwa [cast_neg, neg_add_cancel_left]

theorem of_add_rat : irrational (x + q) → irrational x :=
add_comm ↑q x ▸ of_rat_add q

theorem add_rat (h : irrational x) : irrational (x + q) :=
add_comm ↑q x ▸ h.rat_add q

theorem of_neg (h : irrational (-x)) : irrational x :=
λ ⟨q, hx⟩, h ⟨-q, by rw [cast_neg, hx]⟩

protected theorem neg (h : irrational x) : irrational (-x) :=
of_neg $ by rwa neg_neg

theorem sub_rat (h : irrational x) : irrational (x - q) :=
by simpa only [sub_eq_add_neg, cast_neg] using h.add_rat (-q)

theorem rat_sub (h : irrational x) : irrational (q - x) :=
by simpa only [sub_eq_add_neg] using h.neg.rat_add q

theorem of_sub_rat (h : irrational (x - q)) : irrational x :=
(of_add_rat (-q) $ by simpa only [cast_neg, sub_eq_add_neg] using h)

theorem of_rat_sub (h : irrational (q - x)) : irrational x :=
of_neg (of_rat_add q (by simpa only [sub_eq_add_neg] using h))

theorem mul_cases : irrational (x * y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx * ry, cast_mul rx ry⟩
end

theorem of_mul_rat (h : irrational (x * q)) : irrational x :=
h.mul_cases.elim id (λ h, absurd h q.not_irrational)

theorem mul_rat (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x * q) :=
of_mul_rat q⁻¹ $ by rwa [mul_assoc, ← cast_mul, mul_inv_cancel hq, cast_one, mul_one]

theorem of_rat_mul : irrational (q * x) → irrational x :=
mul_comm x q ▸ of_mul_rat q

theorem rat_mul (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (q * x) :=
mul_comm x q ▸ h.mul_rat hq

theorem of_mul_self (h : irrational (x * x)) : irrational x :=
h.mul_cases.elim id id

theorem of_inv (h : irrational x⁻¹) : irrational x :=
λ ⟨q, hq⟩, h $ hq ▸ ⟨q⁻¹, q.cast_inv⟩

protected theorem inv (h : irrational x) : irrational x⁻¹ :=
of_inv $ by rwa inv_inv'

theorem div_cases (h : irrational (x / y)) : irrational x ∨ irrational y :=
h.mul_cases.imp id of_inv

theorem of_rat_div (h : irrational (q / x)) : irrational x :=
(h.of_rat_mul q).of_inv

theorem of_one_div (h : irrational (1 / x)) : irrational x :=
of_rat_div 1 $ by rwa [cast_one]

theorem of_pow : ∀ n : ℕ, irrational (x^n) → irrational x
| 0 := λ h, by { rw pow_zero at h, exact (h ⟨1, cast_one⟩).elim }
| (n+1) := λ h, by { rw pow_succ at h, exact h.mul_cases.elim id (of_pow n) }

theorem of_fpow : ∀ m : ℤ, irrational (x^m) → irrational x
| (n:ℕ) := of_pow n
| -[1+n] := λ h, by { rw gpow_neg_succ_of_nat at h, exact h.of_inv.of_pow _ }

end irrational

section polynomial

open polynomial
variables (x : ℝ) (p : polynomial ℤ)

lemma one_lt_nat_degree_of_irrational_root (hx : irrational x) (p_nonzero : p ≠ 0)
  (x_is_root : aeval x p = 0) : 1 < p.nat_degree :=
begin
  by_contra rid,
  rcases exists_eq_X_add_C_of_nat_degree_le_one (not_lt.1 rid) with ⟨a, b, rfl⟩, clear rid,
  have : (a : ℝ) * x = -b, by simpa [eq_neg_iff_add_eq_zero] using x_is_root,
  rcases em (a = 0) with (rfl|ha),
  { obtain rfl : b = 0, by simpa,
    simpa using p_nonzero },
  { rw [mul_comm, ← eq_div_iff_mul_eq, eq_comm] at this,
    refine hx ⟨-b / a, _⟩,
    assumption_mod_cast, assumption_mod_cast }
end

end polynomial

section
variables {q : ℚ} {x : ℝ}

open irrational

@[simp] theorem irrational_rat_add_iff : irrational (q + x) ↔ irrational x :=
⟨of_rat_add q, rat_add q⟩

@[simp] theorem irrational_add_rat_iff : irrational (x + q) ↔ irrational x :=
⟨of_add_rat q, add_rat q⟩

@[simp] theorem irrational_rat_sub_iff : irrational (q - x) ↔ irrational x :=
⟨of_rat_sub q, rat_sub q⟩

@[simp] theorem irrational_sub_rat_iff : irrational (x - q) ↔ irrational x :=
⟨of_sub_rat q, sub_rat q⟩

@[simp] theorem irrational_neg_iff : irrational (-x) ↔ irrational x :=
⟨of_neg, irrational.neg⟩

@[simp] theorem irrational_inv_iff : irrational x⁻¹ ↔ irrational x :=
⟨of_inv, irrational.inv⟩

end