/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison
-/

import algebra.quotient
import data.fintype.prod
import group_theory.group_action.basic
import group_theory.subgroup.mul_opposite
import tactic.group

/-!
# Cosets

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

This file develops the basic theory of left and right cosets.

## Main definitions

* `left_coset a s`: the left coset `a * s` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `left_add_coset a s`.
* `right_coset s a`: the right coset `s * a` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `right_add_coset s a`.
* `quotient_group.quotient s`: the quotient type representing the left cosets with respect to a
  subgroup `s`, for an `add_group` this is `quotient_add_group.quotient s`.
* `quotient_group.mk`: the canonical map from `α` to `α/s` for a subgroup `s` of `α`, for an
  `add_group` this is `quotient_add_group.mk`.
* `subgroup.left_coset_equiv_subgroup`: the natural bijection between a left coset and the subgroup,
  for an `add_group` this is `add_subgroup.left_coset_equiv_add_subgroup`.

## Notation

* `a *l s`: for `left_coset a s`.
* `a +l s`: for `left_add_coset a s`.
* `s *r a`: for `right_coset s a`.
* `s +r a`: for `right_add_coset s a`.

* `G ⧸ H` is the quotient of the (additive) group `G` by the (additive) subgroup `H`
-/

open set function

variable {α : Type*}

/-- The left coset `a * s` for an element `a : α` and a subset `s : set α` -/
@[to_additive left_add_coset "The left coset `a+s` for an element `a : α`
and a subset `s : set α`"]
def left_coset [has_mul α] (a : α) (s : set α) : set α := (λ x, a * x) '' s

/-- The right coset `s * a` for an element `a : α` and a subset `s : set α` -/
@[to_additive right_add_coset "The right coset `s+a` for an element `a : α`
and a subset `s : set α`"]
def right_coset [has_mul α] (s : set α) (a : α) : set α := (λ x, x * a) '' s

localized "infix (name := left_coset) ` *l `:70 := left_coset" in coset
localized "infix (name := left_add_coset) ` +l `:70 := left_add_coset" in coset
localized "infix (name := right_coset) ` *r `:70 := right_coset" in coset
localized "infix (name := right_add_coset) ` +r `:70 := right_add_coset" in coset

section coset_mul
variable [has_mul α]

@[to_additive mem_left_add_coset]
lemma mem_left_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ a *l s :=
mem_image_of_mem (λ b : α, a * b) hxS

@[to_additive mem_right_add_coset]
lemma mem_right_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ s *r a :=
mem_image_of_mem (λ b : α, b * a) hxS

/-- Equality of two left cosets `a * s` and `b * s`. -/
@[to_additive left_add_coset_equivalence "Equality of two left cosets `a + s` and `b + s`."]
def left_coset_equivalence (s : set α) (a b : α) := a *l s = b *l s

@[to_additive left_add_coset_equivalence_rel]
lemma left_coset_equivalence_rel (s : set α) : equivalence (left_coset_equivalence s) :=
mk_equivalence (left_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

/-- Equality of two right cosets `s * a` and `s * b`. -/
@[to_additive right_add_coset_equivalence "Equality of two right cosets `s + a` and `s + b`."]
def right_coset_equivalence (s : set α) (a b : α) := s *r a = s *r b

@[to_additive right_add_coset_equivalence_rel]
lemma right_coset_equivalence_rel (s : set α) : equivalence (right_coset_equivalence s) :=
mk_equivalence (right_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

end coset_mul

section coset_semigroup
variable [semigroup α]

@[simp, to_additive left_add_coset_assoc] lemma left_coset_assoc (s : set α) (a b : α) :
  a *l (b *l s) = (a * b) *l s :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[simp, to_additive right_add_coset_assoc] lemma right_coset_assoc (s : set α) (a b : α) :
  s *r a *r b = s *r (a * b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[to_additive left_add_coset_right_add_coset]
lemma left_coset_right_coset (s : set α) (a b : α) : a *l s *r b = a *l (s *r b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

end coset_semigroup

section coset_monoid
variables [monoid α] (s : set α)

@[simp, to_additive zero_left_add_coset] lemma one_left_coset : 1 *l s = s :=
set.ext $ by simp [left_coset]

@[simp, to_additive right_add_coset_zero] lemma right_coset_one : s *r 1 = s :=
set.ext $ by simp [right_coset]

end coset_monoid

section coset_submonoid
open submonoid
variables [monoid α] (s : submonoid α)

@[to_additive mem_own_left_add_coset]
lemma mem_own_left_coset (a : α) : a ∈ a *l s :=
suffices a * 1 ∈ a *l s, by simpa,
mem_left_coset a (one_mem s : 1 ∈ s)

@[to_additive mem_own_right_add_coset]
lemma mem_own_right_coset (a : α) : a ∈ (s : set α) *r a :=
suffices 1 * a ∈ (s : set α) *r a, by simpa,
mem_right_coset a (one_mem s : 1 ∈ s)

@[to_additive mem_left_add_coset_left_add_coset]
lemma mem_left_coset_left_coset {a : α} (ha : a *l s = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_left_coset s a

@[to_additive mem_right_add_coset_right_add_coset]
lemma mem_right_coset_right_coset {a : α} (ha : (s : set α) *r a = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_right_coset s a

end coset_submonoid

section coset_group
variables [group α] {s : set α} {x : α}

@[to_additive mem_left_add_coset_iff]
lemma mem_left_coset_iff (a : α) : x ∈ a *l s ↔ a⁻¹ * x ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨a⁻¹ * x, h, by simp⟩)

@[to_additive mem_right_add_coset_iff]
lemma mem_right_coset_iff (a : α) : x ∈ s *r a ↔ x * a⁻¹ ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨x * a⁻¹, h, by simp⟩)

end coset_group

section coset_subgroup
open subgroup

variables [group α] (s : subgroup α)

@[to_additive left_add_coset_mem_left_add_coset]
lemma left_coset_mem_left_coset {a : α} (ha : a ∈ s) : a *l s = s :=
set.ext $ by simp [mem_left_coset_iff, mul_mem_cancel_left (s.inv_mem ha)]

@[to_additive right_add_coset_mem_right_add_coset]
lemma right_coset_mem_right_coset {a : α} (ha : a ∈ s) : (s : set α) *r a = s :=
set.ext $ assume b, by simp [mem_right_coset_iff, mul_mem_cancel_right (s.inv_mem ha)]

@[to_additive] lemma orbit_subgroup_eq_right_coset (a : α) : mul_action.orbit s a = s *r a :=
set.ext (λ b, ⟨λ ⟨c, d⟩, ⟨c, c.2, d⟩, λ ⟨c, d, e⟩, ⟨⟨c, d⟩, e⟩⟩)

@[to_additive] lemma orbit_subgroup_eq_self_of_mem {a : α} (ha : a ∈ s) :
  mul_action.orbit s a = s :=
(orbit_subgroup_eq_right_coset s a).trans (right_coset_mem_right_coset s ha)

@[to_additive] lemma orbit_subgroup_one_eq_self : mul_action.orbit s (1 : α) = s :=
orbit_subgroup_eq_self_of_mem s s.one_mem

@[to_additive eq_add_cosets_of_normal]
theorem eq_cosets_of_normal (N : s.normal) (g : α) : g *l s = s *r g :=
set.ext $ assume a, by simp [mem_left_coset_iff, mem_right_coset_iff]; rw [N.mem_comm_iff]

@[to_additive normal_of_eq_add_cosets]
theorem normal_of_eq_cosets (h : ∀ g : α, g *l s = s *r g) : s.normal :=
⟨assume a ha g, show g * a * g⁻¹ ∈ (s : set α),
  by rw [← mem_right_coset_iff, ← h]; exact mem_left_coset g ha⟩

@[to_additive normal_iff_eq_add_cosets]
theorem normal_iff_eq_cosets : s.normal ↔ ∀ g : α, g *l s = s *r g :=
⟨@eq_cosets_of_normal _ _ s, normal_of_eq_cosets s⟩

@[to_additive left_add_coset_eq_iff]
lemma left_coset_eq_iff {x y : α} : left_coset x s = left_coset y s ↔ x⁻¹ * y ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_left_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_left_inv, exact s.one_mem },
  { intros h z, rw ←mul_inv_cancel_right x⁻¹ y, rw mul_assoc, exact s.mul_mem_cancel_left h },
end

@[to_additive right_add_coset_eq_iff]
lemma right_coset_eq_iff {x y : α} : right_coset ↑s x = right_coset s y ↔ y * x⁻¹ ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_right_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_right_inv, exact s.one_mem },
  { intros h z, rw ←inv_mul_cancel_left y x⁻¹, rw ←mul_assoc, exact s.mul_mem_cancel_right h },
end

end coset_subgroup

run_cmd to_additive.map_namespace `quotient_group `quotient_add_group

namespace quotient_group

variables [group α] (s : subgroup α)

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
@[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup."]
def left_rel : setoid α := mul_action.orbit_rel s.opposite α

variables {s}

@[to_additive]
lemma left_rel_apply {x y : α} : @setoid.r _ (left_rel s) x y ↔ (x⁻¹ * y ∈ s) :=
calc (∃ a : s.opposite, y * mul_opposite.unop a = x)
    ↔ ∃ a : s, y * a = x : s.opposite_equiv.symm.exists_congr_left
... ↔ ∃ a : s, x⁻¹ * y = a⁻¹ : by simp only [inv_mul_eq_iff_eq_mul, eq_mul_inv_iff_mul_eq]
... ↔ x⁻¹ * y ∈ s : by simp [set_like.exists]

variables (s)

@[to_additive]
lemma left_rel_eq : @setoid.r _ (left_rel s) = λ x y, x⁻¹ * y ∈ s :=
funext₂ $ by { simp only [eq_iff_iff], apply left_rel_apply }

lemma left_rel_r_eq_left_coset_equivalence :
  @setoid.r _ (quotient_group.left_rel s) = left_coset_equivalence s :=
by { ext, rw left_rel_eq, exact (left_coset_eq_iff s).symm }

@[to_additive]
instance left_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (left_rel s).r :=
λ x y, by { rw left_rel_eq, exact ‹decidable_pred (∈ s)› _ }

/-- `α ⧸ s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `α ⧸ s` is a group -/
@[to_additive "`α ⧸ s` is the quotient type representing the left cosets of `s`.  If `s` is a
normal subgroup, `α ⧸ s` is a group"]
instance : has_quotient α (subgroup α) := ⟨λ s, quotient (left_rel s)⟩

/-- The equivalence relation corresponding to the partition of a group by right cosets of a
subgroup. -/
@[to_additive "The equivalence relation corresponding to the partition of a group by right cosets of
a subgroup."]
def right_rel : setoid α := mul_action.orbit_rel s α

variables {s}

@[to_additive]
lemma right_rel_apply {x y : α} : @setoid.r _ (right_rel s) x y ↔ (y * x⁻¹ ∈ s) :=
calc (∃ a : s, (a:α) * y = x)
    ↔ ∃ a : s, y * x⁻¹ = a⁻¹ : by simp only [mul_inv_eq_iff_eq_mul, eq_inv_mul_iff_mul_eq]
... ↔ y * x⁻¹ ∈ s : by simp [set_like.exists]

variables (s)

@[to_additive]
lemma right_rel_eq : @setoid.r _ (right_rel s) = λ x y, y * x⁻¹ ∈ s :=
funext₂ $ by { simp only [eq_iff_iff], apply right_rel_apply }

lemma right_rel_r_eq_right_coset_equivalence :
  @setoid.r _ (quotient_group.right_rel s) = right_coset_equivalence s :=
by { ext, rw right_rel_eq, exact (right_coset_eq_iff s).symm }

@[to_additive]
instance right_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (right_rel s).r :=
λ x y, by { rw right_rel_eq, exact ‹decidable_pred (∈ s)› _ }

/-- Right cosets are in bijection with left cosets. -/
@[to_additive "Right cosets are in bijection with left cosets."]
def quotient_right_rel_equiv_quotient_left_rel : quotient (quotient_group.right_rel s) ≃ α ⧸ s :=
{ to_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
  inv_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
  left_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })),
  right_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })) }

@[to_additive] instance fintype_quotient_right_rel [fintype (α ⧸ s)] :
  fintype (quotient (quotient_group.right_rel s)) :=
fintype.of_equiv (α ⧸ s) (quotient_group.quotient_right_rel_equiv_quotient_left_rel s).symm

@[to_additive] lemma card_quotient_right_rel [fintype (α ⧸ s)] :
  fintype.card (quotient (quotient_group.right_rel s)) = fintype.card (α ⧸ s) :=
fintype.of_equiv_card (quotient_group.quotient_right_rel_equiv_quotient_left_rel s).symm

end quotient_group

namespace quotient_group

variables [group α] {s : subgroup α}

@[to_additive]
instance fintype [fintype α] (s : subgroup α) [decidable_rel (left_rel s).r] :
  fintype (α ⧸ s) :=
quotient.fintype (left_rel s)

/-- The canonical map from a group `α` to the quotient `α ⧸ s`. -/
@[to_additive "The canonical map from an `add_group` `α` to the quotient `α ⧸ s`."]
abbreviation mk (a : α) : α ⧸ s :=
quotient.mk' a

@[to_additive]
lemma mk_surjective : function.surjective $ @mk _ _ s := quotient.surjective_quotient_mk'

@[elab_as_eliminator, to_additive]
lemma induction_on {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z, C (quotient_group.mk z)) : C x :=
quotient.induction_on' x H

@[to_additive]
instance : has_coe_t α (α ⧸ s) := ⟨mk⟩ -- note [use has_coe_t]

@[elab_as_eliminator, to_additive]
lemma induction_on' {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z : α, C z) : C x :=
quotient.induction_on' x H

@[simp, to_additive]
lemma quotient_lift_on_coe {β} (f : α → β) (h) (x : α) :
  quotient.lift_on' (x : α ⧸ s) f h = f x := rfl

@[to_additive] lemma forall_coe {C : α ⧸ s → Prop} : (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
mk_surjective.forall

@[to_additive] lemma exists_coe {C : α ⧸ s → Prop} : (∃ x : α ⧸ s, C x) ↔ ∃ x : α, C x :=
mk_surjective.exists

@[to_additive]
instance (s : subgroup α) : inhabited (α ⧸ s) :=
⟨((1 : α) : α ⧸ s)⟩

@[to_additive quotient_add_group.eq]
protected lemma eq {a b : α} : (a : α ⧸ s) = b ↔ a⁻¹ * b ∈ s :=
calc _ ↔ @setoid.r _ (left_rel s) a b : quotient.eq'
... ↔ _ : by rw left_rel_apply

@[to_additive quotient_add_group.eq']
lemma eq' {a b : α} : (mk a : α ⧸ s) = mk b ↔ a⁻¹ * b ∈ s :=
quotient_group.eq

@[simp, to_additive quotient_add_group.out_eq']
lemma out_eq' (a : α ⧸ s) : mk a.out' = a :=
quotient.out_eq' a

variables (s)

/- It can be useful to write `obtain ⟨h, H⟩ := mk_out'_eq_mul ...`, and then `rw [H]` or
  `simp_rw [H]` or `simp only [H]`. In order for `simp_rw` and `simp only` to work, this lemma is
  stated in terms of an arbitrary `h : s`, rathern that the specific `h = g⁻¹ * (mk g).out'`. -/
@[to_additive quotient_add_group.mk_out'_eq_mul]
lemma mk_out'_eq_mul (g : α) : ∃ h : s, (mk g : α ⧸ s).out' = g * h :=
⟨⟨g⁻¹ * (mk g).out', eq'.mp (mk g).out_eq'.symm⟩, by rw [set_like.coe_mk, mul_inv_cancel_left]⟩

variables {s} {a b : α}

@[simp, to_additive quotient_add_group.mk_add_of_mem]
lemma mk_mul_of_mem (a : α) (hb : b ∈ s) : (mk (a * b) : α ⧸ s) = mk a :=
by rwa [eq', mul_inv_rev, inv_mul_cancel_right, s.inv_mem_iff]

@[to_additive]
lemma eq_class_eq_left_coset (s : subgroup α) (g : α) :
  {x : α | (x : α ⧸ s) = g} = left_coset g s :=
set.ext $ λ z,
  by rw [mem_left_coset_iff, set.mem_set_of_eq, eq_comm, quotient_group.eq, set_like.mem_coe]

@[to_additive]
lemma preimage_image_coe (N : subgroup α) (s : set α) :
  coe ⁻¹' ((coe : α → α ⧸ N) '' s) = ⋃ x : N, (λ y : α, y * x) ⁻¹' s :=
begin
  ext x,
  simp only [quotient_group.eq, set_like.exists, exists_prop, set.mem_preimage, set.mem_Union,
    set.mem_image, set_like.coe_mk, ← eq_inv_mul_iff_mul_eq],
  exact ⟨λ ⟨y, hs, hN⟩, ⟨_, N.inv_mem hN, by simpa using hs⟩,
         λ ⟨z, hz, hxz⟩, ⟨x*z, hxz, by simpa using hz⟩⟩,
end

end quotient_group

namespace subgroup
open quotient_group
variables [group α] {s : subgroup α}

/-- The natural bijection between a left coset `g * s` and `s`. -/
@[to_additive "The natural bijection between the cosets `g + s` and `s`."]
def left_coset_equiv_subgroup (g : α) : left_coset g s ≃ s :=
⟨λ x, ⟨g⁻¹ * x.1, (mem_left_coset_iff _).1 x.2⟩,
 λ x, ⟨g * x.1, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- The natural bijection between a right coset `s * g` and `s`. -/
@[to_additive "The natural bijection between the cosets `s + g` and `s`."]
def right_coset_equiv_subgroup (g : α) : right_coset ↑s g ≃ s :=
⟨λ x, ⟨x.1 * g⁻¹, (mem_right_coset_iff _).1 x.2⟩,
 λ x, ⟨x.1 * g, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
@[to_additive "A (non-canonical) bijection between an add_group `α` and the product `(α/s) × s`"]
noncomputable def group_equiv_quotient_times_subgroup :
  α ≃ (α ⧸ s) × s :=
calc α ≃ Σ L : α ⧸ s, {x : α // (x : α ⧸ s) = L} :
  (equiv.sigma_fiber_equiv quotient_group.mk).symm
    ... ≃ Σ L : α ⧸ s, left_coset (quotient.out' L) s :
  equiv.sigma_congr_right (λ L,
    begin
      rw ← eq_class_eq_left_coset,
      show _root_.subtype (λ x : α, quotient.mk' x = L) ≃
        _root_.subtype (λ x : α, quotient.mk' x = quotient.mk' _),
      simp [-quotient.eq'],
    end)
    ... ≃ Σ L : α ⧸ s, s :
  equiv.sigma_congr_right (λ L, left_coset_equiv_subgroup _)
    ... ≃ (α ⧸ s) × s :
  equiv.sigma_equiv_prod _ _

variables {t : subgroup α}

/-- If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection. -/
@[to_additive "If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection."]
def quotient_equiv_of_eq (h : s = t) : α ⧸ s ≃ α ⧸ t :=
{ to_fun := quotient.map' id (λ a b h', h ▸ h'),
  inv_fun := quotient.map' id (λ a b h', h.symm ▸ h'),
  left_inv := λ q, induction_on' q (λ g, rfl),
  right_inv := λ q, induction_on' q (λ g, rfl) }

lemma quotient_equiv_of_eq_mk (h : s = t) (a : α) :
  quotient_equiv_of_eq h (quotient_group.mk a) = (quotient_group.mk a) :=
rfl

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`.", simps]
def quotient_equiv_prod_of_le' (h_le : s ≤ t)
  (f : α ⧸ t → α) (hf : function.right_inverse f quotient_group.mk) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
{ to_fun := λ a, ⟨a.map' id (λ b c h, left_rel_apply.mpr (h_le (left_rel_apply.mp h))),
    a.map' (λ g : α, ⟨(f (quotient.mk' g))⁻¹ * g, left_rel_apply.mp (quotient.exact' (hf g))⟩)
    (λ b c h, by
    { rw left_rel_apply,
      change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s,
      have key : f b = f c :=
        congr_arg f (quotient.sound' (left_rel_apply.mpr (h_le (left_rel_apply.mp h)))),
      rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left, ← left_rel_apply] })⟩,
  inv_fun := λ a, a.2.map' (λ b, f a.1 * b) (λ b c h, by
  { rw left_rel_apply at ⊢ h,
    change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s,
    rwa [mul_inv_rev, mul_assoc, inv_mul_cancel_left] }),
  left_inv := by
  { refine quotient.ind' (λ a, _),
    simp_rw [quotient.map'_mk', id.def, set_like.coe_mk, mul_inv_cancel_left] },
  right_inv := by
  { refine prod.rec _,
    refine quotient.ind' (λ a, _),
    refine quotient.ind' (λ b, _),
    have key : quotient.mk' (f (quotient.mk' a) * b) = quotient.mk' a :=
      (quotient_group.mk_mul_of_mem (f a) b.2).trans (hf a),
    simp_rw [quotient.map'_mk', id.def, key, inv_mul_cancel_left, subtype.coe_eta] } }

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`.", simps]
noncomputable def quotient_equiv_prod_of_le (h_le : s ≤ t) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
quotient_equiv_prod_of_le' h_le quotient.out' quotient.out_eq'

/-- If `s ≤ t`, then there is an embedding `s ⧸ H.subgroup_of s ↪ t ⧸ H.subgroup_of t`. -/
@[to_additive "If `s ≤ t`, then there is an embedding
  `s ⧸ H.add_subgroup_of s ↪ t ⧸ H.add_subgroup_of t`."]
def quotient_subgroup_of_embedding_of_le (H : subgroup α) (h : s ≤ t) :
  s ⧸ H.subgroup_of s ↪ t ⧸ H.subgroup_of t :=
{ to_fun := quotient.map' (inclusion h) (λ a b, by { simp_rw left_rel_eq, exact id }),
  inj' := quotient.ind₂' $ by { intros a b h, simpa only [quotient.map'_mk', eq'] using h } }

@[simp, to_additive]
lemma quotient_subgroup_of_embedding_of_le_apply_mk (H : subgroup α) (h : s ≤ t) (g : s) :
  quotient_subgroup_of_embedding_of_le H h (quotient_group.mk g) =
    quotient_group.mk (inclusion h g) :=
rfl

/-- If `s ≤ t`, then there is a map `H ⧸ s.subgroup_of H → H ⧸ t.subgroup_of H`. -/
@[to_additive "If `s ≤ t`, then there is an map
  `H ⧸ s.add_subgroup_of H → H ⧸ t.add_subgroup_of H`."]
def quotient_subgroup_of_map_of_le (H : subgroup α) (h : s ≤ t) :
  H ⧸ s.subgroup_of H → H ⧸ t.subgroup_of H :=
quotient.map' id $ λ a b, by { simp_rw [left_rel_eq], apply h }

@[simp, to_additive]
lemma quotient_subgroup_of_map_of_le_apply_mk (H : subgroup α) (h : s ≤ t) (g : H) :
  quotient_subgroup_of_map_of_le H h (quotient_group.mk g) = quotient_group.mk g :=
rfl

/-- If `s ≤ t`, then there is a map `α ⧸ s → α ⧸ t`. -/
@[to_additive "If `s ≤ t`, then there is an map `α ⧸ s → α ⧸ t`."]
def quotient_map_of_le (h : s ≤ t) : α ⧸ s → α ⧸ t :=
quotient.map' id $ λ a b, by { simp_rw [left_rel_eq], apply h }

@[simp, to_additive]
lemma quotient_map_of_le_apply_mk (h : s ≤ t) (g : α) :
  quotient_map_of_le h (quotient_group.mk g) = quotient_group.mk g :=
rfl

/-- The natural embedding `H ⧸ (⨅ i, f i).subgroup_of H ↪ Π i, H ⧸ (f i).subgroup_of H`. -/
@[to_additive "The natural embedding
  `H ⧸ (⨅ i, f i).add_subgroup_of H) ↪ Π i, H ⧸ (f i).add_subgroup_of H`.", simps]
def quotient_infi_subgroup_of_embedding {ι : Type*} (f : ι → subgroup α) (H : subgroup α) :
  H ⧸ (⨅ i, f i).subgroup_of H ↪ Π i, H ⧸ (f i).subgroup_of H :=
{ to_fun := λ q i, quotient_subgroup_of_map_of_le H (infi_le f i) q,
  inj' := quotient.ind₂' $ by simp_rw [funext_iff, quotient_subgroup_of_map_of_le_apply_mk,
    eq', mem_subgroup_of, mem_infi, imp_self, forall_const] }

@[simp, to_additive] lemma quotient_infi_subgroup_of_embedding_apply_mk
  {ι : Type*} (f : ι → subgroup α) (H : subgroup α) (g : H) (i : ι) :
  quotient_infi_subgroup_of_embedding f H (quotient_group.mk g) i = quotient_group.mk g :=
rfl

/-- The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`. -/
@[to_additive "The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`.", simps]
def quotient_infi_embedding {ι : Type*} (f : ι → subgroup α) : α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i :=
{ to_fun := λ q i, quotient_map_of_le (infi_le f i) q,
  inj' := quotient.ind₂' $ by simp_rw [funext_iff, quotient_map_of_le_apply_mk,
    eq', mem_infi, imp_self, forall_const] }

@[simp, to_additive] lemma quotient_infi_embedding_apply_mk
  {ι : Type*} (f : ι → subgroup α) (g : α) (i : ι) :
  quotient_infi_embedding f (quotient_group.mk g) i = quotient_group.mk g :=
rfl

@[to_additive] lemma card_eq_card_quotient_mul_card_subgroup
  [fintype α] (s : subgroup α) [fintype s] [decidable_pred (λ a, a ∈ s)] :
  fintype.card α = fintype.card (α ⧸ s) * fintype.card s :=
by rw ← fintype.card_prod;
  exact fintype.card_congr (subgroup.group_equiv_quotient_times_subgroup)

/-- **Lagrange's Theorem**: The order of a subgroup divides the order of its ambient group. -/
@[to_additive "**Lagrange's Theorem**: The order of an additive subgroup divides the order of its
ambient group."]
lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
  fintype.card s ∣ fintype.card α :=
by classical; simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_left ℕ]

@[to_additive] lemma card_quotient_dvd_card [fintype α] (s : subgroup α) [decidable_pred (∈ s)] :
  fintype.card (α ⧸ s) ∣ fintype.card α :=
by simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_right ℕ]

open fintype

variables {H : Type*} [group H]

@[to_additive] lemma card_dvd_of_injective [fintype α] [fintype H] (f : α →* H)
  (hf : function.injective f) : card α ∣ card H :=
by classical;
calc card α = card (f.range : subgroup H) : card_congr (equiv.of_injective f hf)
...∣ card H : card_subgroup_dvd_card _

@[to_additive] lemma card_dvd_of_le {H K : subgroup α} [fintype H] [fintype K] (hHK : H ≤ K) :
  card H ∣ card K :=
card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)

@[to_additive] lemma card_comap_dvd_of_injective (K : subgroup H) [fintype K]
  (f : α →* H) [fintype (K.comap f)] (hf : function.injective f) :
  fintype.card (K.comap f) ∣ fintype.card K :=
by haveI : fintype ((K.comap f).map f) :=
  fintype.of_equiv _ (equiv_map_of_injective _ _ hf).to_equiv;
calc fintype.card (K.comap f) = fintype.card ((K.comap f).map f) :
       fintype.card_congr (equiv_map_of_injective _ _ hf).to_equiv
... ∣ fintype.card K : card_dvd_of_le (map_comap_le _ _)

end subgroup

namespace quotient_group

variables [group α]

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α ⧸ s`, then there is a
(typically non-canonical) bijection between the preimage of `t` in `α` and the product `s × t`. -/
@[to_additive "If `s` is a subgroup of the additive group `α`, and `t` is a subset of `α ⧸ s`, then
there is a (typically non-canonical) bijection between the preimage of `t` in `α` and the product
`s × t`."]
noncomputable def preimage_mk_equiv_subgroup_times_set (s : subgroup α) (t : set (α ⧸ s)) :
  quotient_group.mk ⁻¹' t ≃ s × t :=
{ to_fun := λ a, ⟨⟨(quotient.out' (quotient_group.mk a))⁻¹ * a,
    left_rel_apply.mp (@quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _))⟩,
      ⟨quotient_group.mk a, a.2⟩⟩,
  inv_fun := λ a, ⟨quotient.out' a.2.1 * a.1.1, show quotient_group.mk _ ∈ t,
    by { rw [mk_mul_of_mem _ a.1.2, out_eq'], exact a.2.2 }⟩,
  left_inv := λ ⟨a, ha⟩, subtype.eq $ show _ * _ = a, by simp,
  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, by ext; simp [ha] }

end quotient_group

/--
We use the class `has_coe_t` instead of `has_coe` if the first argument is a variable,
or if the second argument is a variable not occurring in the first.
Using `has_coe` would cause looping of type-class inference. See
<https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/remove.20all.20instances.20with.20variable.20domain>
-/
library_note "use has_coe_t"


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

import algebra.direct_sum.module
import tactic.fin_cases

/-!
# Not all complementary decompositions of a module over a semiring make up a direct sum

This shows that while `ℤ≤0` and `ℤ≥0` are complementary `ℕ`-submodules of `ℤ`, which in turn
implies as a collection they are `complete_lattice.independent` and that they span all of `ℤ`, they
do not form a decomposition into a direct sum.

This file demonstrates why `direct_sum.submodule_is_internal_of_independent_of_supr_eq_top` must
take `ring R` and not `semiring R`.
-/

lemma units_int.one_ne_neg_one : (1 : ℤˣ) ≠ -1 := dec_trivial

/-- Submodules of positive and negative integers, keyed by sign. -/
def with_sign (i : ℤˣ) : submodule ℕ ℤ :=
add_submonoid.to_nat_submodule $ show add_submonoid ℤ, from
  { carrier := {z | 0 ≤ i • z},
    zero_mem' := show 0 ≤ i • (0 : ℤ), from (smul_zero _).ge,
    add_mem' := λ x y (hx : 0 ≤ i • x) (hy : 0 ≤ i • y), show _ ≤ _, begin
      rw smul_add,
      exact add_nonneg hx hy
    end }

local notation `ℤ≥0` := with_sign 1
local notation `ℤ≤0` := with_sign (-1)

lemma mem_with_sign_one {x : ℤ} : x ∈ ℤ≥0 ↔ 0 ≤ x :=
show _ ≤ _ ↔ _, by rw one_smul

lemma mem_with_sign_neg_one {x : ℤ} : x ∈ ℤ≤0 ↔ x ≤ 0 :=
show _ ≤ _ ↔ _, by rw [units.neg_smul, le_neg, one_smul, neg_zero]

/-- The two submodules are complements. -/
lemma with_sign.is_compl : is_compl (ℤ≥0) (ℤ≤0) :=
begin
  split,
  { apply submodule.disjoint_def.2,
    intros x hx hx',
    exact le_antisymm (mem_with_sign_neg_one.mp hx') (mem_with_sign_one.mp hx), },
  { intros x hx,
    obtain hp | hn := (le_refl (0 : ℤ)).le_or_le x,
    exact submodule.mem_sup_left (mem_with_sign_one.mpr hp),
    exact submodule.mem_sup_right (mem_with_sign_neg_one.mpr hn), }
end

def with_sign.independent : complete_lattice.independent with_sign :=
begin
  refine (complete_lattice.independent_pair units_int.one_ne_neg_one _).mpr
    with_sign.is_compl.disjoint,
  intros i,
  fin_cases i; simp,
end

lemma with_sign.supr : supr with_sign = ⊤ :=
begin
  rw [←finset.sup_univ_eq_supr, units_int.univ, finset.sup_insert, finset.sup_singleton],
  exact with_sign.is_compl.sup_eq_top,
end

/-- But there is no embedding into `ℤ` from the direct sum. -/
lemma with_sign.not_injective :
  ¬function.injective (direct_sum.to_module ℕ ℤˣ ℤ (λ i, (with_sign i).subtype)) :=
begin
  intro hinj,
  let p1 : ℤ≥0 := ⟨1, mem_with_sign_one.2 zero_le_one⟩,
  let n1 : ℤ≤0 := ⟨-1, mem_with_sign_neg_one.2 $ neg_nonpos.2 zero_le_one⟩,
  let z := direct_sum.lof ℕ _ (λ i, with_sign i) 1 p1 +
           direct_sum.lof ℕ _ (λ i, with_sign i) (-1) n1,
  have : z ≠ 0,
  { intro h,
    dsimp [z, direct_sum.lof_eq_of, direct_sum.of] at h,
    replace h := dfinsupp.ext_iff.mp h 1,
    rw [dfinsupp.zero_apply, dfinsupp.add_apply, dfinsupp.single_eq_same,
      dfinsupp.single_eq_of_ne (units_int.one_ne_neg_one.symm), add_zero, subtype.ext_iff,
      submodule.coe_zero] at h,
    apply zero_ne_one h.symm, },
  apply hinj.ne this,
  rw [linear_map.map_zero, linear_map.map_add, direct_sum.to_module_lof, direct_sum.to_module_lof],
  simp,
end

/-- And so they do not represent an internal direct sum. -/
lemma with_sign.not_internal : ¬direct_sum.submodule_is_internal with_sign :=
with_sign.not_injective ∘ and.elim_left


/-
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 algebra.monoid_algebra.basic
import data.finset.sort

/-!
# Theory of univariate polynomials

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

This file defines `polynomial R`, the type of univariate polynomials over the semiring `R`, builds
a semiring structure on it, and gives basic definitions that are expanded in other files in this
directory.

## Main definitions

* `monomial n a` is the polynomial `a X^n`. Note that `monomial n` is defined as an `R`-linear map.
* `C a` is the constant polynomial `a`. Note that `C` is defined as a ring homomorphism.
* `X` is the polynomial `X`, i.e., `monomial 1 1`.
* `p.sum f` is `∑ n in p.support, f n (p.coeff n)`, i.e., one sums the values of functions applied
  to coefficients of the polynomial `p`.
* `p.erase n` is the polynomial `p` in which one removes the `c X^n` term.

There are often two natural variants of lemmas involving sums, depending on whether one acts on the
polynomials, or on the function. The naming convention is that one adds `index` when acting on
the polynomials. For instance,
* `sum_add_index` states that `(p + q).sum f = p.sum f + q.sum f`;
* `sum_add` states that `p.sum (λ n x, f n x + g n x) = p.sum f + p.sum g`.
* Notation to refer to `polynomial R`, as `R[X]` or `R[t]`.

## Implementation

Polynomials are defined using `add_monoid_algebra R ℕ`, where `R` is a semiring.
The variable `X` commutes with every polynomial `p`: lemma `X_mul` proves the identity
`X * p = p * X`.  The relationship to `add_monoid_algebra R ℕ` is through a structure
to make polynomials irreducible from the point of view of the kernel. Most operations
are irreducible since Lean can not compute anyway with `add_monoid_algebra`. There are two
exceptions that we make semireducible:
* The zero polynomial, so that its coefficients are definitionally equal to `0`.
* The scalar action, to permit typeclass search to unfold it to resolve potential instance
  diamonds.

The raw implementation of the equivalence between `R[X]` and `add_monoid_algebra R ℕ` is
done through `of_finsupp` and `to_finsupp` (or, equivalently, `rcases p` when `p` is a polynomial
gives an element `q` of `add_monoid_algebra R ℕ`, and conversely `⟨q⟩` gives back `p`). The
equivalence is also registered as a ring equiv in `polynomial.to_finsupp_iso`. These should
in general not be used once the basic API for polynomials is constructed.
-/

noncomputable theory

/-- `polynomial R` is the type of univariate polynomials over `R`.

Polynomials should be seen as (semi-)rings with the additional constructor `X`.
The embedding from `R` is called `C`. -/
structure polynomial (R : Type*) [semiring R] := of_finsupp ::
(to_finsupp : add_monoid_algebra R ℕ)

localized "notation (name := polynomial) R`[X]`:9000 := polynomial R" in polynomial

open add_monoid_algebra finsupp function
open_locale big_operators polynomial

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

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

lemma forall_iff_forall_finsupp (P : R[X] → Prop) :
  (∀ p, P p) ↔ ∀ (q : add_monoid_algebra R ℕ), P ⟨q⟩ :=
⟨λ h q, h ⟨q⟩, λ h ⟨p⟩, h p⟩

lemma exists_iff_exists_finsupp (P : R[X] → Prop) :
  (∃ p, P p) ↔ ∃ (q : add_monoid_algebra R ℕ), P ⟨q⟩ :=
⟨λ ⟨⟨p⟩, hp⟩, ⟨p, hp⟩, λ ⟨q, hq⟩, ⟨⟨q⟩, hq⟩ ⟩

@[simp] lemma eta (f : R[X]) : polynomial.of_finsupp f.to_finsupp = f := by cases f; refl

/-! ### Conversions to and from `add_monoid_algebra`

Since `R[X]` is not defeq to `add_monoid_algebra R ℕ`, but instead is a structure wrapping
it, we have to copy across all the arithmetic operators manually, along with the lemmas about how
they unfold around `polynomial.of_finsupp` and `polynomial.to_finsupp`.
-/
section add_monoid_algebra

@[irreducible] private def add : R[X] → R[X] → R[X]
| ⟨a⟩ ⟨b⟩ := ⟨a + b⟩
@[irreducible] private def neg {R : Type u} [ring R] : R[X] → R[X]
| ⟨a⟩ := ⟨-a⟩
@[irreducible] private def mul : R[X] → R[X] → R[X]
| ⟨a⟩ ⟨b⟩ := ⟨a * b⟩

instance : has_zero R[X] := ⟨⟨0⟩⟩
instance : has_one R[X] := ⟨⟨1⟩⟩
instance : has_add R[X] := ⟨add⟩
instance {R : Type u} [ring R] : has_neg R[X] := ⟨neg⟩
instance {R : Type u} [ring R] : has_sub R[X] := ⟨λ a b, a + -b⟩
instance : has_mul R[X] := ⟨mul⟩
instance {S : Type*} [smul_zero_class S R] : smul_zero_class S R[X] :=
{ smul := λ r p, ⟨r • p.to_finsupp⟩,
  smul_zero := λ a, congr_arg of_finsupp (smul_zero a) }
@[priority 1]  -- to avoid a bug in the `ring` tactic
instance has_pow : has_pow R[X] ℕ := { pow := λ p n, npow_rec n p }

@[simp] lemma of_finsupp_zero : (⟨0⟩ : R[X]) = 0 := rfl
@[simp] lemma of_finsupp_one : (⟨1⟩ : R[X]) = 1 := rfl

@[simp] lemma of_finsupp_add {a b} : (⟨a + b⟩ : R[X]) = ⟨a⟩ + ⟨b⟩ := show _ = add _ _, by rw add
@[simp] lemma of_finsupp_neg {R : Type u} [ring R] {a} : (⟨-a⟩ : R[X]) = -⟨a⟩ :=
show _ = neg _, by rw neg
@[simp] lemma of_finsupp_sub {R : Type u} [ring R] {a b} : (⟨a - b⟩ : R[X]) = ⟨a⟩ - ⟨b⟩ :=
by { rw [sub_eq_add_neg, of_finsupp_add, of_finsupp_neg], refl }
@[simp] lemma of_finsupp_mul (a b) : (⟨a * b⟩ : R[X]) = ⟨a⟩ * ⟨b⟩ := show _ = mul _ _, by rw mul
@[simp] lemma of_finsupp_smul {S : Type*} [smul_zero_class S R] (a : S) (b) :
  (⟨a • b⟩ : R[X]) = (a • ⟨b⟩ : R[X]) := rfl
@[simp] lemma of_finsupp_pow (a) (n : ℕ) : (⟨a ^ n⟩ : R[X]) = ⟨a⟩ ^ n :=
begin
  change _ = npow_rec n _,
  induction n,
  { simp [npow_rec], } ,
  { simp [npow_rec, n_ih, pow_succ] }
end

@[simp] lemma to_finsupp_zero : (0 : R[X]).to_finsupp = 0 :=
rfl

@[simp] lemma to_finsupp_one : (1 : R[X]).to_finsupp = 1 := rfl

@[simp] lemma to_finsupp_add (a b : R[X]) : (a + b).to_finsupp = a.to_finsupp + b.to_finsupp :=
by { cases a, cases b, rw ←of_finsupp_add }
@[simp] lemma to_finsupp_neg {R : Type u} [ring R] (a : R[X]) : (-a).to_finsupp = -a.to_finsupp :=
by { cases a, rw ←of_finsupp_neg }
@[simp] lemma to_finsupp_sub {R : Type u} [ring R] (a b : R[X]) :
  (a - b).to_finsupp = a.to_finsupp - b.to_finsupp :=
by { rw [sub_eq_add_neg, ←to_finsupp_neg, ←to_finsupp_add], refl }
@[simp] lemma to_finsupp_mul (a b : R[X]) : (a * b).to_finsupp = a.to_finsupp * b.to_finsupp :=
by { cases a, cases b, rw ←of_finsupp_mul }
@[simp] lemma to_finsupp_smul {S : Type*} [smul_zero_class S R] (a : S) (b : R[X]) :
  (a • b).to_finsupp = a • b.to_finsupp := rfl
@[simp] lemma to_finsupp_pow (a : R[X]) (n : ℕ) : (a ^ n).to_finsupp = a.to_finsupp ^ n :=
by { cases a, rw ←of_finsupp_pow }

lemma _root_.is_smul_regular.polynomial {S : Type*} [monoid S] [distrib_mul_action S R] {a : S}
  (ha : is_smul_regular R a) : is_smul_regular R[X] a
| ⟨x⟩ ⟨y⟩ h := congr_arg _ $ ha.finsupp (polynomial.of_finsupp.inj h)

lemma to_finsupp_injective : function.injective (to_finsupp : R[X] → add_monoid_algebra _ _) :=
λ ⟨x⟩ ⟨y⟩, congr_arg _

@[simp] lemma to_finsupp_inj {a b : R[X]} : a.to_finsupp = b.to_finsupp ↔ a = b :=
to_finsupp_injective.eq_iff

@[simp] lemma to_finsupp_eq_zero {a : R[X]} : a.to_finsupp = 0 ↔ a = 0 :=
by rw [←to_finsupp_zero, to_finsupp_inj]

@[simp] lemma to_finsupp_eq_one {a : R[X]} : a.to_finsupp = 1 ↔ a = 1 :=
by rw [←to_finsupp_one, to_finsupp_inj]

/-- A more convenient spelling of `polynomial.of_finsupp.inj_eq` in terms of `iff`. -/
lemma of_finsupp_inj {a b} : (⟨a⟩ : R[X]) = ⟨b⟩ ↔ a = b :=
iff_of_eq of_finsupp.inj_eq

@[simp] lemma of_finsupp_eq_zero {a} : (⟨a⟩ : R[X]) = 0 ↔ a = 0 :=
by rw [←of_finsupp_zero, of_finsupp_inj]

@[simp] lemma of_finsupp_eq_one {a} : (⟨a⟩ : R[X]) = 1 ↔ a = 1 :=
by rw [←of_finsupp_one, of_finsupp_inj]

instance : inhabited R[X] := ⟨0⟩

instance : has_nat_cast R[X] := ⟨λ n, polynomial.of_finsupp n⟩

instance : semiring R[X] :=
function.injective.semiring to_finsupp to_finsupp_injective
  to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul
  (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl)

instance {S} [monoid S] [distrib_mul_action S R] : distrib_mul_action S R[X] :=
function.injective.distrib_mul_action
  ⟨to_finsupp, to_finsupp_zero, to_finsupp_add⟩ to_finsupp_injective to_finsupp_smul

instance {S} [monoid S] [distrib_mul_action S R] [has_faithful_smul S R] :
  has_faithful_smul S R[X] :=
{ eq_of_smul_eq_smul := λ s₁ s₂ h, eq_of_smul_eq_smul $ λ a : ℕ →₀ R, congr_arg to_finsupp (h ⟨a⟩) }

instance {S} [semiring S] [module S R] : module S R[X] :=
function.injective.module _
  ⟨to_finsupp, to_finsupp_zero, to_finsupp_add⟩ to_finsupp_injective to_finsupp_smul

instance {S₁ S₂} [monoid S₁] [monoid S₂] [distrib_mul_action S₁ R] [distrib_mul_action S₂ R]
  [smul_comm_class S₁ S₂ R] : smul_comm_class S₁ S₂ R[X] :=
⟨by { rintros _ _ ⟨⟩, simp_rw [←of_finsupp_smul, smul_comm] }⟩

instance {S₁ S₂} [has_smul S₁ S₂] [monoid S₁] [monoid S₂] [distrib_mul_action S₁ R]
  [distrib_mul_action S₂ R] [is_scalar_tower S₁ S₂ R] : is_scalar_tower S₁ S₂ R[X] :=
⟨by { rintros _ _ ⟨⟩, simp_rw [←of_finsupp_smul, smul_assoc] }⟩

instance is_scalar_tower_right {α K : Type*} [semiring K] [distrib_smul α K]
  [is_scalar_tower α K K] : is_scalar_tower α K[X] K[X] :=
⟨by rintros _ ⟨⟩ ⟨⟩;
  simp_rw [smul_eq_mul, ← of_finsupp_smul, ← of_finsupp_mul, ← of_finsupp_smul, smul_mul_assoc]⟩

instance {S} [monoid S] [distrib_mul_action S R] [distrib_mul_action Sᵐᵒᵖ R]
  [is_central_scalar S R] : is_central_scalar S R[X] :=
⟨by { rintros _ ⟨⟩, simp_rw [←of_finsupp_smul, op_smul_eq_smul] }⟩

instance [subsingleton R] : unique R[X] :=
{ uniq := by { rintros ⟨x⟩, refine congr_arg of_finsupp _, simp },
.. polynomial.inhabited }

variable (R)

/-- Ring isomorphism between `R[X]` and `add_monoid_algebra R ℕ`. This is just an
implementation detail, but it can be useful to transfer results from `finsupp` to polynomials. -/
@[simps apply symm_apply]
def to_finsupp_iso : R[X] ≃+* add_monoid_algebra R ℕ :=
{ to_fun := to_finsupp,
  inv_fun := of_finsupp,
  left_inv := λ ⟨p⟩, rfl,
  right_inv := λ p, rfl,
  map_mul' := to_finsupp_mul,
  map_add' := to_finsupp_add }

end add_monoid_algebra

variable {R}

lemma of_finsupp_sum {ι : Type*} (s : finset ι) (f : ι → add_monoid_algebra R ℕ) :
  (⟨∑ i in s, f i⟩ : R[X]) = ∑ i in s, ⟨f i⟩ :=
map_sum (to_finsupp_iso R).symm f s

lemma to_finsupp_sum {ι : Type*} (s : finset ι) (f : ι → R[X]) :
  (∑ i in s, f i : R[X]).to_finsupp = ∑ i in s, (f i).to_finsupp :=
map_sum (to_finsupp_iso R) f s

/--
The set of all `n` such that `X^n` has a non-zero coefficient.
-/
@[simp]
def support : R[X] → finset ℕ
| ⟨p⟩ := p.support

@[simp] lemma support_of_finsupp (p) : support (⟨p⟩ : R[X]) = p.support :=
by rw support

@[simp] lemma support_zero : (0 : R[X]).support = ∅ :=
rfl

@[simp] lemma support_eq_empty : p.support = ∅ ↔ p = 0 :=
by { rcases p, simp [support] }

lemma card_support_eq_zero : p.support.card = 0 ↔ p = 0 :=
by simp

/-- `monomial s a` is the monomial `a * X^s` -/
def monomial (n : ℕ) : R →ₗ[R] R[X] :=
{ to_fun := λ t, ⟨finsupp.single n t⟩,
  map_add' := by simp,
  map_smul' := by simp [←of_finsupp_smul] }

@[simp] lemma to_finsupp_monomial (n : ℕ) (r : R) :
  (monomial n r).to_finsupp = finsupp.single n r :=
by simp [monomial]

@[simp] lemma of_finsupp_single (n : ℕ) (r : R) :
  (⟨finsupp.single n r⟩ : R[X]) = monomial n r :=
by simp [monomial]

@[simp]
lemma monomial_zero_right (n : ℕ) :
  monomial n (0 : R) = 0 :=
(monomial n).map_zero

-- This is not a `simp` lemma as `monomial_zero_left` is more general.
lemma monomial_zero_one : monomial 0 (1 : R) = 1 := rfl

-- TODO: can't we just delete this one?
lemma monomial_add (n : ℕ) (r s : R) :
  monomial n (r + s) = monomial n r + monomial n s :=
(monomial n).map_add _ _

lemma monomial_mul_monomial (n m : ℕ) (r s : R) :
  monomial n r * monomial m s = monomial (n + m) (r * s) :=
to_finsupp_injective $
  by simp only [to_finsupp_monomial, to_finsupp_mul, add_monoid_algebra.single_mul_single]

@[simp]
lemma monomial_pow (n : ℕ) (r : R) (k : ℕ) :
  (monomial n r)^k = monomial (n*k) (r^k) :=
begin
  induction k with k ih,
  { simp [pow_zero, monomial_zero_one], },
  { simp [pow_succ, ih, monomial_mul_monomial, nat.succ_eq_add_one, mul_add, add_comm] },
end

lemma smul_monomial {S} [monoid S] [distrib_mul_action S R] (a : S) (n : ℕ) (b : R) :
  a • monomial n b = monomial n (a • b) :=
to_finsupp_injective $ by simp

lemma monomial_injective (n : ℕ) :
  function.injective (monomial n : R → R[X]) :=
(to_finsupp_iso R).symm.injective.comp (single_injective n)

@[simp] lemma monomial_eq_zero_iff (t : R) (n : ℕ) :
  monomial n t = 0 ↔ t = 0 :=
linear_map.map_eq_zero_iff _ (polynomial.monomial_injective n)

lemma support_add : (p + q).support ⊆ p.support ∪ q.support :=
begin
  rcases p, rcases q,
  simp only [←of_finsupp_add, support],
  exact support_add
end

/--
`C a` is the constant polynomial `a`.
`C` is provided as a ring homomorphism.
-/
def C : R →+* R[X] :=
{ map_one' := by simp [monomial_zero_one],
  map_mul' := by simp [monomial_mul_monomial],
  map_zero' := by simp,
  .. monomial 0 }

@[simp] lemma monomial_zero_left (a : R) : monomial 0 a = C a := rfl

@[simp] lemma to_finsupp_C (a : R) : (C a).to_finsupp = single 0 a := rfl

lemma C_0 : C (0 : R) = 0 := by simp

lemma C_1 : C (1 : R) = 1 := rfl

lemma C_mul : C (a * b) = C a * C b := C.map_mul a b

lemma C_add : C (a + b) = C a + C b := C.map_add a b

@[simp] lemma smul_C {S} [monoid S] [distrib_mul_action S R] (s : S) (r : R) :
  s • C r = C (s • r) :=
smul_monomial _ _ r

@[simp] lemma C_bit0 : C (bit0 a) = bit0 (C a) := C_add

@[simp] lemma C_bit1 : C (bit1 a) = bit1 (C a) := by simp [bit1, C_bit0]

lemma C_pow : C (a ^ n) = C a ^ n := C.map_pow a n

@[simp]
lemma C_eq_nat_cast (n : ℕ) : C (n : R) = (n : R[X]) :=
map_nat_cast C n

@[simp] lemma C_mul_monomial : C a * monomial n b = monomial n (a * b) :=
by simp only [←monomial_zero_left, monomial_mul_monomial, zero_add]

@[simp] lemma monomial_mul_C : monomial n a * C b = monomial n (a * b) :=
by simp only [←monomial_zero_left, monomial_mul_monomial, add_zero]

/-- `X` is the polynomial variable (aka indeterminate). -/
def X : R[X] := monomial 1 1

lemma monomial_one_one_eq_X : monomial 1 (1 : R) = X := rfl

lemma monomial_one_right_eq_X_pow (n : ℕ) : monomial n (1 : R) = X^n :=
begin
  induction n with n ih,
  { simp [monomial_zero_one], },
  { rw [pow_succ, ←ih, ←monomial_one_one_eq_X, monomial_mul_monomial, add_comm, one_mul], }
end

@[simp] lemma to_finsupp_X : X.to_finsupp = finsupp.single 1 (1 : R) := rfl

/-- `X` commutes with everything, even when the coefficients are noncommutative. -/
lemma X_mul : X * p = p * X :=
begin
  rcases p,
  simp only [X, ←of_finsupp_single, ←of_finsupp_mul, linear_map.coe_mk],
  ext,
  simp [add_monoid_algebra.mul_apply, sum_single_index, add_comm],
end

lemma X_pow_mul {n : ℕ} : X^n * p = p * X^n :=
begin
  induction n with n ih,
  { simp, },
  { conv_lhs { rw pow_succ', },
    rw [mul_assoc, X_mul, ←mul_assoc, ih, mul_assoc, ←pow_succ'], }
end

/-- Prefer putting constants to the left of `X`.

This lemma is the loop-avoiding `simp` version of `polynomial.X_mul`. -/
@[simp] lemma X_mul_C (r : R) : X * C r = C r * X :=
X_mul

/-- Prefer putting constants to the left of `X ^ n`.

This lemma is the loop-avoiding `simp` version of `X_pow_mul`. -/
@[simp] lemma X_pow_mul_C (r : R) (n : ℕ) : X^n * C r = C r * X^n :=
X_pow_mul

lemma X_pow_mul_assoc {n : ℕ} : (p * X^n) * q = (p * q) * X^n :=
by rw [mul_assoc, X_pow_mul, ←mul_assoc]

/-- Prefer putting constants to the left of `X ^ n`.

This lemma is the loop-avoiding `simp` version of `X_pow_mul_assoc`. -/
@[simp] lemma X_pow_mul_assoc_C {n : ℕ} (r : R) : (p * X^n) * C r = p * C r * X^n :=
X_pow_mul_assoc

lemma commute_X (p : R[X]) : commute X p := X_mul

lemma commute_X_pow (p : R[X]) (n : ℕ) : commute (X ^ n) p := X_pow_mul

@[simp]
lemma monomial_mul_X (n : ℕ) (r : R) : monomial n r * X = monomial (n+1) r :=
by erw [monomial_mul_monomial, mul_one]

@[simp]
lemma monomial_mul_X_pow (n : ℕ) (r : R) (k : ℕ) : monomial n r * X^k = monomial (n+k) r :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih, pow_succ', ←mul_assoc, add_assoc], },
end

@[simp]
lemma X_mul_monomial (n : ℕ) (r : R) : X * monomial n r = monomial (n+1) r :=
by rw [X_mul, monomial_mul_X]

@[simp]
lemma X_pow_mul_monomial (k n : ℕ) (r : R) : X^k * monomial n r = monomial (n+k) r :=
by rw [X_pow_mul, monomial_mul_X_pow]

/-- `coeff p n` (often denoted `p.coeff n`) is the coefficient of `X^n` in `p`. -/
@[simp] def coeff : R[X] → ℕ → R
| ⟨p⟩ := p

lemma coeff_injective : injective (coeff : R[X] → ℕ → R) :=
by { rintro ⟨p⟩ ⟨q⟩, simp only [coeff, fun_like.coe_fn_eq, imp_self] }

@[simp] lemma coeff_inj : p.coeff = q.coeff ↔ p = q := coeff_injective.eq_iff

lemma to_finsupp_apply (f : R[X]) (i) : f.to_finsupp i = f.coeff i := by cases f; refl

lemma coeff_monomial : coeff (monomial n a) m = if n = m then a else 0 :=
by { simp only [←of_finsupp_single, coeff, linear_map.coe_mk], rw finsupp.single_apply }

@[simp] lemma coeff_zero (n : ℕ) : coeff (0 : R[X]) n = 0 := rfl

@[simp] lemma coeff_one_zero : coeff (1 : R[X]) 0 = 1 :=
by { rw [← monomial_zero_one, coeff_monomial], simp }

@[simp] lemma coeff_X_one : coeff (X : R[X]) 1 = 1 := coeff_monomial

@[simp] lemma coeff_X_zero : coeff (X : R[X]) 0 = 0 := coeff_monomial

@[simp] lemma coeff_monomial_succ : coeff (monomial (n+1) a) 0 = 0 :=
by simp [coeff_monomial]

lemma coeff_X : coeff (X : R[X]) n = if 1 = n then 1 else 0 := coeff_monomial

lemma coeff_X_of_ne_one {n : ℕ} (hn : n ≠ 1) : coeff (X : R[X]) n = 0 :=
by rw [coeff_X, if_neg hn.symm]

@[simp] lemma mem_support_iff : n ∈ p.support ↔ p.coeff n ≠ 0 :=
by { rcases p, simp }

lemma not_mem_support_iff : n ∉ p.support ↔ p.coeff n = 0 :=
by simp

lemma coeff_C : coeff (C a) n = ite (n = 0) a 0 :=
by { convert coeff_monomial using 2, simp [eq_comm], }

@[simp] lemma coeff_C_zero : coeff (C a) 0 = a := coeff_monomial

lemma coeff_C_ne_zero (h : n ≠ 0) : (C a).coeff n = 0 :=
by rw [coeff_C, if_neg h]

lemma C_mul_X_pow_eq_monomial : ∀ {n : ℕ}, C a * X ^ n = monomial n a
| 0     := mul_one _
| (n+1) := by rw [pow_succ', ←mul_assoc, C_mul_X_pow_eq_monomial, X, monomial_mul_monomial, mul_one]

@[simp] lemma to_finsupp_C_mul_X_pow (a : R) (n : ℕ) :
  (C a * X ^ n).to_finsupp = finsupp.single n a :=
by rw [C_mul_X_pow_eq_monomial, to_finsupp_monomial]

lemma C_mul_X_eq_monomial : C a * X = monomial 1 a := by rw [← C_mul_X_pow_eq_monomial, pow_one]

@[simp] lemma to_finsupp_C_mul_X (a : R) : (C a * X).to_finsupp = finsupp.single 1 a :=
by rw [C_mul_X_eq_monomial, to_finsupp_monomial]

lemma C_injective : injective (C : R → R[X]) := monomial_injective 0

@[simp] lemma C_inj : C a = C b ↔ a = b := C_injective.eq_iff
@[simp] lemma C_eq_zero : C a = 0 ↔ a = 0 := C_injective.eq_iff' (map_zero C)

lemma C_ne_zero : C a ≠ 0 ↔ a ≠ 0 := C_eq_zero.not

lemma subsingleton_iff_subsingleton :
  subsingleton R[X] ↔ subsingleton R :=
⟨@injective.subsingleton _ _ _ C_injective, by { introI, apply_instance } ⟩

theorem nontrivial.of_polynomial_ne (h : p ≠ q) : nontrivial R :=
(subsingleton_or_nontrivial R).resolve_left $ λ hI, h $ by exactI subsingleton.elim _ _

lemma forall_eq_iff_forall_eq :
  (∀ f g : R[X], f = g) ↔ (∀ a b : R, a = b) :=
by simpa only [← subsingleton_iff] using subsingleton_iff_subsingleton

theorem ext_iff {p q : R[X]} : p = q ↔ ∀ n, coeff p n = coeff q n :=
by { rcases p, rcases q, simp [coeff, finsupp.ext_iff] }

@[ext] lemma ext {p q : R[X]} : (∀ n, coeff p n = coeff q n) → p = q :=
ext_iff.2

/-- Monomials generate the additive monoid of polynomials. -/
lemma add_submonoid_closure_set_of_eq_monomial :
  add_submonoid.closure {p : R[X] | ∃ n a, p = monomial n a} = ⊤ :=
begin
  apply top_unique,
  rw [← add_submonoid.map_equiv_top (to_finsupp_iso R).symm.to_add_equiv,
    ← finsupp.add_closure_set_of_eq_single, add_monoid_hom.map_mclosure],
  refine add_submonoid.closure_mono (set.image_subset_iff.2 _),
  rintro _ ⟨n, a, rfl⟩,
  exact ⟨n, a, polynomial.of_finsupp_single _ _⟩,
end

lemma add_hom_ext {M : Type*} [add_monoid M] {f g : R[X] →+ M}
  (h : ∀ n a, f (monomial n a) = g (monomial n a)) :
  f = g :=
add_monoid_hom.eq_of_eq_on_mdense add_submonoid_closure_set_of_eq_monomial $
  by { rintro p ⟨n, a, rfl⟩, exact h n a }

@[ext] lemma add_hom_ext' {M : Type*} [add_monoid M] {f g : R[X] →+ M}
  (h : ∀ n, f.comp (monomial n).to_add_monoid_hom = g.comp (monomial n).to_add_monoid_hom) :
  f = g :=
add_hom_ext (λ n, add_monoid_hom.congr_fun (h n))

@[ext] lemma lhom_ext' {M : Type*} [add_comm_monoid M] [module R M] {f g : R[X] →ₗ[R] M}
  (h : ∀ n, f.comp (monomial n) = g.comp (monomial n)) :
  f = g :=
linear_map.to_add_monoid_hom_injective $ add_hom_ext $ λ n, linear_map.congr_fun (h n)

-- this has the same content as the subsingleton
lemma eq_zero_of_eq_zero (h : (0 : R) = (1 : R)) (p : R[X]) : p = 0 :=
by rw [←one_smul R p, ←h, zero_smul]

section fewnomials

lemma support_monomial (n) {a : R} (H : a ≠ 0) : (monomial n a).support = singleton n :=
by rw [←of_finsupp_single, support, finsupp.support_single_ne_zero _ H]

lemma support_monomial' (n) (a : R) : (monomial n a).support ⊆ singleton n :=
by { rw [←of_finsupp_single, support], exact finsupp.support_single_subset }

lemma support_C_mul_X {c : R} (h : c ≠ 0) : (C c * X).support = singleton 1 :=
by rw [C_mul_X_eq_monomial, support_monomial 1 h]

lemma support_C_mul_X' (c : R) : (C c * X).support ⊆ singleton 1 :=
by simpa only [C_mul_X_eq_monomial] using support_monomial' 1 c

lemma support_C_mul_X_pow (n : ℕ) {c : R} (h : c ≠ 0) : (C c * X ^ n).support = singleton n :=
by rw [C_mul_X_pow_eq_monomial, support_monomial n h]

lemma support_C_mul_X_pow' (n : ℕ) (c : R) : (C c * X ^ n).support ⊆ singleton n :=
by simpa only [C_mul_X_pow_eq_monomial] using support_monomial' n c

open finset

lemma support_binomial' (k m : ℕ) (x y : R) : (C x * X ^ k + C y * X ^ m).support ⊆ {k, m} :=
support_add.trans (union_subset ((support_C_mul_X_pow' k x).trans
  (singleton_subset_iff.mpr (mem_insert_self k {m}))) ((support_C_mul_X_pow' m y).trans
  (singleton_subset_iff.mpr (mem_insert_of_mem (mem_singleton_self m)))))

lemma support_trinomial' (k m n : ℕ) (x y z : R) :
  (C x * X ^ k + C y * X ^ m + C z * X ^ n).support ⊆ {k, m, n} :=
support_add.trans (union_subset (support_add.trans (union_subset ((support_C_mul_X_pow' k x).trans
  (singleton_subset_iff.mpr (mem_insert_self k {m, n}))) ((support_C_mul_X_pow' m y).trans
  (singleton_subset_iff.mpr (mem_insert_of_mem (mem_insert_self m {n}))))))
  ((support_C_mul_X_pow' n z).trans (singleton_subset_iff.mpr
  (mem_insert_of_mem (mem_insert_of_mem (mem_singleton_self n))))))

end fewnomials

lemma X_pow_eq_monomial (n) : X ^ n = monomial n (1 : R) :=
begin
  induction n with n hn,
  { rw [pow_zero, monomial_zero_one] },
  { rw [pow_succ', hn, X, monomial_mul_monomial, one_mul] },
end

@[simp] lemma to_finsupp_X_pow (n : ℕ) : (X ^ n).to_finsupp = finsupp.single n (1 : R) :=
by rw [X_pow_eq_monomial, to_finsupp_monomial]

lemma smul_X_eq_monomial {n} : a • X ^ n = monomial n (a : R) :=
by rw [X_pow_eq_monomial, smul_monomial, smul_eq_mul, mul_one]

lemma support_X_pow (H : ¬(1 : R) = 0) (n : ℕ) : (X ^ n : R[X]).support = singleton n :=
begin
  convert support_monomial n H,
  exact X_pow_eq_monomial n,
end

lemma support_X_empty (H : (1 : R) = 0) : (X : R[X]).support = ∅ :=
by rw [X, H, monomial_zero_right, support_zero]

lemma support_X (H : ¬(1 : R) = 0) : (X : R[X]).support = singleton 1 :=
by rw [← pow_one X, support_X_pow H 1]

lemma monomial_left_inj {a : R} (ha : a ≠ 0) {i j : ℕ} : (monomial i a) = (monomial j a) ↔ i = j :=
by simp_rw [←of_finsupp_single, finsupp.single_left_inj ha]

lemma binomial_eq_binomial {k l m n : ℕ} {u v : R} (hu : u ≠ 0) (hv : v ≠ 0) :
  C u * X ^ k + C v * X ^ l = C u * X ^ m + C v * X ^ n ↔
  (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u + v = 0 ∧ k = l ∧ m = n) :=
begin
  simp_rw [C_mul_X_pow_eq_monomial, ←to_finsupp_inj, to_finsupp_add, to_finsupp_monomial],
  exact finsupp.single_add_single_eq_single_add_single hu hv,
end

lemma nat_cast_mul (n : ℕ) (p : R[X]) : (n : R[X]) * p = n • p :=
(nsmul_eq_mul _ _).symm

/-- Summing the values of a function applied to the coefficients of a polynomial -/
def sum {S : Type*} [add_comm_monoid S] (p : R[X]) (f : ℕ → R → S) : S :=
∑ n in p.support, f n (p.coeff n)

lemma sum_def {S : Type*} [add_comm_monoid S] (p : R[X]) (f : ℕ → R → S) :
  p.sum f = ∑ n in p.support, f n (p.coeff n) := rfl

lemma sum_eq_of_subset {S : Type*} [add_comm_monoid S] (p : R[X])
  (f : ℕ → R → S) (hf : ∀ i, f i 0 = 0) (s : finset ℕ) (hs : p.support ⊆ s) :
  p.sum f = ∑ n in s, f n (p.coeff n) :=
begin
  apply finset.sum_subset hs (λ n hn h'n, _),
  rw not_mem_support_iff at h'n,
  simp [h'n, hf]
end

/-- Expressing the product of two polynomials as a double sum. -/
lemma mul_eq_sum_sum :
  p * q = ∑ i in p.support, q.sum (λ j a, (monomial (i + j)) (p.coeff i * a)) :=
begin
  apply to_finsupp_injective,
  rcases p, rcases q,
  simp [support, sum, coeff, to_finsupp_sum],
  refl
end

@[simp] lemma sum_zero_index {S : Type*} [add_comm_monoid S] (f : ℕ → R → S) :
  (0 : R[X]).sum f = 0 :=
by simp [sum]

@[simp] lemma sum_monomial_index {S : Type*} [add_comm_monoid S]
  (n : ℕ) (a : R) (f : ℕ → R → S) (hf : f n 0 = 0) :
  (monomial n a : R[X]).sum f = f n a :=
begin
  by_cases h : a = 0,
  { simp [h, hf] },
  { simp [sum, support_monomial, h, coeff_monomial] }
end

@[simp] lemma sum_C_index {a} {β} [add_comm_monoid β] {f : ℕ → R → β} (h : f 0 0 = 0) :
  (C a).sum f = f 0 a :=
sum_monomial_index 0 a f h

-- the assumption `hf` is only necessary when the ring is trivial
@[simp] lemma sum_X_index {S : Type*} [add_comm_monoid S] {f : ℕ → R → S} (hf : f 1 0 = 0) :
  (X : R[X]).sum f = f 1 1 :=
sum_monomial_index 1 1 f hf

lemma sum_add_index {S : Type*} [add_comm_monoid S] (p q : R[X])
  (f : ℕ → R → S) (hf : ∀ i, f i 0 = 0) (h_add : ∀a b₁ b₂, f a (b₁ + b₂) = f a b₁ + f a b₂) :
  (p + q).sum f = p.sum f + q.sum f :=
begin
  rcases p, rcases q,
  simp only [←of_finsupp_add, sum, support, coeff, pi.add_apply, coe_add],
  exact finsupp.sum_add_index' hf h_add,
end

lemma sum_add' {S : Type*} [add_comm_monoid S] (p : R[X]) (f g : ℕ → R → S) :
  p.sum (f + g) = p.sum f + p.sum g :=
by simp [sum_def, finset.sum_add_distrib]

lemma sum_add {S : Type*} [add_comm_monoid S] (p : R[X]) (f g : ℕ → R → S) :
  p.sum (λ n x, f n x + g n x) = p.sum f + p.sum g :=
sum_add' _ _ _

lemma sum_smul_index {S : Type*} [add_comm_monoid S] (p : R[X]) (b : R)
  (f : ℕ → R → S) (hf : ∀ i, f i 0 = 0) : (b • p).sum f = p.sum (λ n a, f n (b * a)) :=
begin
  rcases p,
  simpa [sum, support, coeff] using finsupp.sum_smul_index hf,
end

lemma sum_monomial_eq : ∀ p : R[X], p.sum (λ n a, monomial n a) = p
| ⟨p⟩ := (of_finsupp_sum _ _).symm.trans (congr_arg _ $ finsupp.sum_single _)

lemma sum_C_mul_X_pow_eq (p : R[X]) : p.sum (λ n a, C a * X ^ n) = p :=
by simp_rw [C_mul_X_pow_eq_monomial, sum_monomial_eq]

/-- `erase p n` is the polynomial `p` in which the `X^n` term has been erased. -/
@[irreducible] definition erase (n : ℕ) : R[X] → R[X]
| ⟨p⟩ := ⟨p.erase n⟩

@[simp] lemma to_finsupp_erase (p : R[X]) (n : ℕ) :
  to_finsupp (p.erase n) = (p.to_finsupp).erase n :=
by { rcases p, simp only [erase] }

@[simp] lemma of_finsupp_erase (p : add_monoid_algebra R ℕ) (n : ℕ) :
  (⟨p.erase n⟩ : R[X]) = (⟨p⟩ : R[X]).erase n :=
by { rcases p, simp only [erase] }

@[simp] lemma support_erase (p : R[X]) (n : ℕ) :
  support (p.erase n) = (support p).erase n :=
by { rcases p, simp only [support, erase, support_erase] }

lemma monomial_add_erase (p : R[X]) (n : ℕ) : monomial n (coeff p n) + p.erase n = p :=
to_finsupp_injective $ begin
  rcases p,
  rw [to_finsupp_add, to_finsupp_monomial, to_finsupp_erase, coeff],
  exact finsupp.single_add_erase _ _,
end

lemma coeff_erase (p : R[X]) (n i : ℕ) :
  (p.erase n).coeff i = if i = n then 0 else p.coeff i :=
begin
  rcases p,
  simp only [erase, coeff],
  convert rfl
end

@[simp] lemma erase_zero (n : ℕ) : (0 : R[X]).erase n = 0 :=
to_finsupp_injective $ by simp

@[simp]

@[simp] lemma erase_same (p : R[X]) (n : ℕ) : coeff (p.erase n) n = 0 :=
by simp [coeff_erase]

@[simp] lemma erase_ne (p : R[X]) (n i : ℕ) (h : i ≠ n) :
  coeff (p.erase n) i = coeff p i :=
by simp [coeff_erase, h]

section update

/-- Replace the coefficient of a `p : R[X]` at a given degree `n : ℕ`
by a given value `a : R`. If `a = 0`, this is equal to `p.erase n`
If `p.nat_degree < n` and `a ≠ 0`, this increases the degree to `n`.  -/
def update (p : R[X]) (n : ℕ) (a : R) :
  R[X] :=
polynomial.of_finsupp (p.to_finsupp.update n a)

lemma coeff_update (p : R[X]) (n : ℕ) (a : R) :
  (p.update n a).coeff = function.update p.coeff n a :=
begin
  ext,
  cases p,
  simp only [coeff, update, function.update_apply, coe_update],
end

lemma coeff_update_apply (p : R[X]) (n : ℕ) (a : R) (i : ℕ) :
  (p.update n a).coeff i = if (i = n) then a else p.coeff i :=
by rw [coeff_update, function.update_apply]

@[simp] lemma coeff_update_same (p : R[X]) (n : ℕ) (a : R) :
  (p.update n a).coeff n = a :=
by rw [p.coeff_update_apply, if_pos rfl]

lemma coeff_update_ne (p : R[X]) {n : ℕ} (a : R) {i : ℕ} (h : i ≠ n) :
  (p.update n a).coeff i = p.coeff i :=
by rw [p.coeff_update_apply, if_neg h]

@[simp] lemma update_zero_eq_erase (p : R[X]) (n : ℕ) :
  p.update n 0 = p.erase n :=
by { ext, rw [coeff_update_apply, coeff_erase] }

lemma support_update (p : R[X]) (n : ℕ) (a : R) [decidable (a = 0)] :
  support (p.update n a) = if a = 0 then p.support.erase n else insert n p.support :=
by { classical, cases p, simp only [support, update, support_update], congr }

lemma support_update_zero (p : R[X]) (n : ℕ) :
  support (p.update n 0) = p.support.erase n :=
by rw [update_zero_eq_erase, support_erase]

lemma support_update_ne_zero (p : R[X]) (n : ℕ) {a : R} (ha : a ≠ 0) :
  support (p.update n a) = insert n p.support :=
by classical; rw [support_update, if_neg ha]

end update

end semiring

section comm_semiring
variables [comm_semiring R]

instance : comm_semiring R[X] :=
function.injective.comm_semiring to_finsupp to_finsupp_injective
  to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul
  (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl)

end comm_semiring

section ring
variables [ring R]

instance : has_int_cast R[X] := ⟨λ n, of_finsupp n⟩

instance : ring R[X] :=
function.injective.ring to_finsupp to_finsupp_injective
  to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul to_finsupp_neg to_finsupp_sub
  (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) (λ _, rfl)

@[simp] lemma coeff_neg (p : R[X]) (n : ℕ) : coeff (-p) n = -coeff p n :=
by { rcases p, rw [←of_finsupp_neg, coeff, coeff, finsupp.neg_apply] }

@[simp]
lemma coeff_sub (p q : R[X]) (n : ℕ) : coeff (p - q) n = coeff p n - coeff q n :=
by { rcases p, rcases q, rw [←of_finsupp_sub, coeff, coeff, coeff, finsupp.sub_apply] }

@[simp] lemma monomial_neg (n : ℕ) (a : R) : monomial n (-a) = -(monomial n a) :=
by rw [eq_neg_iff_add_eq_zero, ←monomial_add, neg_add_self, monomial_zero_right]

@[simp] lemma support_neg {p : R[X]} : (-p).support = p.support :=
by { rcases p, rw [←of_finsupp_neg, support, support, finsupp.support_neg] }

@[simp] lemma C_eq_int_cast (n : ℤ) : C (n : R) = n := map_int_cast C n

end ring

instance [comm_ring R] : comm_ring R[X] :=
function.injective.comm_ring to_finsupp to_finsupp_injective
  to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul to_finsupp_neg to_finsupp_sub
  (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) (λ _, rfl)

section nonzero_semiring

variables [semiring R] [nontrivial R]
instance : nontrivial R[X] :=
begin
  have h : nontrivial (add_monoid_algebra R ℕ) := by apply_instance,
  rcases h.exists_pair_ne with ⟨x, y, hxy⟩,
  refine ⟨⟨⟨x⟩, ⟨y⟩, _⟩⟩,
  simp [hxy],
end

lemma X_ne_zero : (X : R[X]) ≠ 0 :=
mt (congr_arg (λ p, coeff p 1)) (by simp)

end nonzero_semiring

@[simp] lemma nontrivial_iff [semiring R] : nontrivial R[X] ↔ nontrivial R :=
⟨λ h, let ⟨r, s, hrs⟩ := @exists_pair_ne _ h in nontrivial.of_polynomial_ne hrs,
  λ h, @polynomial.nontrivial _ _ h⟩

section repr
variables [semiring R]
open_locale classical

instance [has_repr R] : has_repr R[X] :=
⟨λ p, if p = 0 then "0"
  else (p.support.sort (≤)).foldr
    (λ n a, a ++ (if a = "" then "" else " + ") ++
      if n = 0
        then "C (" ++ repr (coeff p n) ++ ")"
        else if n = 1
          then if (coeff p n) = 1 then "X" else "C (" ++ repr (coeff p n) ++ ") * X"
          else if (coeff p n) = 1 then "X ^ " ++ repr n
            else "C (" ++ repr (coeff p n) ++ ") * X ^ " ++ repr n) ""⟩

end repr

end polynomial


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.inner_product_space.rayleigh
import analysis.inner_product_space.pi_L2

/-! # Spectral theory of self-adjoint operators

This file covers the spectral theory of self-adjoint operators on an inner product space.

The first part of the file covers general properties, true without any condition on boundedness or
compactness of the operator or finite-dimensionality of the underlying space, notably:
* `is_self_adjoint.conj_eigenvalue_eq_self`: the eigenvalues are real
* `is_self_adjoint.orthogonal_family_eigenspaces`: the eigenspaces are orthogonal
* `is_self_adjoint.orthogonal_supr_eigenspaces`: the restriction of the operator to the mutual
  orthogonal complement of the eigenspaces has, itself, no eigenvectors

The second part of the file covers properties of self-adjoint operators in finite dimension.
Letting `T` be a self-adjoint operator on a finite-dimensional inner product space `T`,
* The definition `is_self_adjoint.diagonalization` provides a linear isometry equivalence `E` to
  the direct sum of the eigenspaces of `T`.  The theorem
  `is_self_adjoint.diagonalization_apply_self_apply` states that, when `T` is transferred via this
  equivalence to an operator on the direct sum, it acts diagonally.
* The definition `is_self_adjoint.eigenvector_basis` provides an orthonormal basis for `E`
  consisting of eigenvectors of `T`, with `is_self_adjoint.eigenvalues` giving the corresponding
  list of eigenvalues, as real numbers.  The definition `is_self_adjoint.diagonalization_basis`
  gives the associated linear isometry equivalence from `E` to Euclidean space, and the theorem
  `is_self_adjoint.diagonalization_basis_apply_self_apply` states that, when `T` is transferred via
  this equivalence to an operator on Euclidean space, it acts diagonally.

These are forms of the *diagonalization theorem* for self-adjoint operators on finite-dimensional
inner product spaces.

## TODO

Spectral theory for compact self-adjoint operators, bounded self-adjoint operators.

## Tags

self-adjoint operator, spectral theorem, diagonalization theorem

-/

variables {𝕜 : Type*} [is_R_or_C 𝕜] [dec_𝕜 : decidable_eq 𝕜]
variables {E : Type*} [normed_add_comm_group E] [inner_product_space 𝕜 E]

local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y

open_locale big_operators complex_conjugate
open module.End

namespace linear_map
namespace is_symmetric

variables {T : E →ₗ[𝕜] E} (hT : T.is_symmetric)
include hT

/-- A self-adjoint operator preserves orthogonal complements of its eigenspaces. -/
lemma invariant_orthogonal_eigenspace (μ : 𝕜) (v : E) (hv : v ∈ (eigenspace T μ)ᗮ) :
  T v ∈ (eigenspace T μ)ᗮ :=
begin
  intros w hw,
  have : T w = (μ:𝕜) • w := by rwa mem_eigenspace_iff at hw,
  simp [← hT w, this, inner_smul_left, hv w hw]
end

/-- The eigenvalues of a self-adjoint operator are real. -/
lemma conj_eigenvalue_eq_self {μ : 𝕜} (hμ : has_eigenvalue T μ) : conj μ = μ :=
begin
  obtain ⟨v, hv₁, hv₂⟩ := hμ.exists_has_eigenvector,
  rw mem_eigenspace_iff at hv₁,
  simpa [hv₂, inner_smul_left, inner_smul_right, hv₁] using hT v v
end

/-- The eigenspaces of a self-adjoint operator are mutually orthogonal. -/
lemma orthogonal_family_eigenspaces :
  orthogonal_family 𝕜 (λ μ, eigenspace T μ) (λ μ, (eigenspace T μ).subtypeₗᵢ) :=
begin
  rintros μ ν hμν ⟨v, hv⟩ ⟨w, hw⟩,
  by_cases hv' : v = 0,
  { simp [hv'] },
  have H := hT.conj_eigenvalue_eq_self (has_eigenvalue_of_has_eigenvector ⟨hv, hv'⟩),
  rw mem_eigenspace_iff at hv hw,
  refine or.resolve_left _ hμν.symm,
  simpa [inner_smul_left, inner_smul_right, hv, hw, H] using (hT v w).symm
end

lemma orthogonal_family_eigenspaces' :
  orthogonal_family 𝕜 (λ μ : eigenvalues T, eigenspace T μ) (λ μ, (eigenspace T μ).subtypeₗᵢ) :=
hT.orthogonal_family_eigenspaces.comp subtype.coe_injective

/-- The mutual orthogonal complement of the eigenspaces of a self-adjoint operator on an inner
product space is an invariant subspace of the operator. -/
lemma orthogonal_supr_eigenspaces_invariant ⦃v : E⦄ (hv : v ∈ (⨆ μ, eigenspace T μ)ᗮ) :
  T v ∈ (⨆ μ, eigenspace T μ)ᗮ :=
begin
  rw ← submodule.infi_orthogonal at ⊢ hv,
  exact T.infi_invariant hT.invariant_orthogonal_eigenspace v hv
end

/-- The mutual orthogonal complement of the eigenspaces of a self-adjoint operator on an inner
product space has no eigenvalues. -/
lemma orthogonal_supr_eigenspaces (μ : 𝕜) :
  eigenspace (T.restrict hT.orthogonal_supr_eigenspaces_invariant) μ = ⊥ :=
begin
  set p : submodule 𝕜 E := (⨆ μ, eigenspace T μ)ᗮ,
  refine eigenspace_restrict_eq_bot hT.orthogonal_supr_eigenspaces_invariant _,
  have H₂ : p ≤ (eigenspace T μ)ᗮ := submodule.orthogonal_le (le_supr _ _),
  exact (eigenspace T μ).orthogonal_disjoint.mono_right H₂
end

/-! ### Finite-dimensional theory -/

variables [finite_dimensional 𝕜 E]

/-- The mutual orthogonal complement of the eigenspaces of a self-adjoint operator on a
finite-dimensional inner product space is trivial. -/
lemma orthogonal_supr_eigenspaces_eq_bot : (⨆ μ, eigenspace T μ)ᗮ = ⊥ :=
begin
  have hT' : is_symmetric _ := hT.restrict_invariant hT.orthogonal_supr_eigenspaces_invariant,
  -- a self-adjoint operator on a nontrivial inner product space has an eigenvalue
  haveI := hT'.subsingleton_of_no_eigenvalue_finite_dimensional hT.orthogonal_supr_eigenspaces,
  exact submodule.eq_bot_of_subsingleton _,
end

lemma orthogonal_supr_eigenspaces_eq_bot' : (⨆ μ : eigenvalues T, eigenspace T μ)ᗮ = ⊥ :=
show (⨆ μ : {μ // (eigenspace T μ) ≠ ⊥}, eigenspace T μ)ᗮ = ⊥,
by rw [supr_ne_bot_subtype, hT.orthogonal_supr_eigenspaces_eq_bot]

include dec_𝕜

/-- The eigenspaces of a self-adjoint operator on a finite-dimensional inner product space `E` give
an internal direct sum decomposition of `E`. -/

section version1

/-- Isometry from an inner product space `E` to the direct sum of the eigenspaces of some
self-adjoint operator `T` on `E`. -/
noncomputable def diagonalization : E ≃ₗᵢ[𝕜] pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ) :=
hT.direct_sum_is_internal.isometry_L2_of_orthogonal_family
  hT.orthogonal_family_eigenspaces'

@[simp] lemma diagonalization_symm_apply (w : pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ)) :
  hT.diagonalization.symm w = ∑ μ, w μ :=
hT.direct_sum_is_internal.isometry_L2_of_orthogonal_family_symm_apply
  hT.orthogonal_family_eigenspaces' w

/-- *Diagonalization theorem*, *spectral theorem*; version 1: A self-adjoint operator `T` on a
finite-dimensional inner product space `E` acts diagonally on the decomposition of `E` into the
direct sum of the eigenspaces of `T`. -/
lemma diagonalization_apply_self_apply (v : E) (μ : eigenvalues T) :
  hT.diagonalization (T v) μ = (μ : 𝕜) • hT.diagonalization v μ :=
begin
  suffices : ∀ w : pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ),
    (T (hT.diagonalization.symm w)) = hT.diagonalization.symm (λ μ, (μ : 𝕜) • w μ),
  { simpa only [linear_isometry_equiv.symm_apply_apply, linear_isometry_equiv.apply_symm_apply]
      using congr_arg (λ w, hT.diagonalization w μ) (this (hT.diagonalization v)) },
  intros w,
  have hwT : ∀ μ, T (w μ) = (μ : 𝕜) • w μ := λ μ, mem_eigenspace_iff.1 (w μ).2,
  simp only [hwT, diagonalization_symm_apply, map_sum, submodule.coe_smul_of_tower],
end

end version1

section version2
variables {n : ℕ} (hn : finite_dimensional.finrank 𝕜 E = n)

/-- A choice of orthonormal basis of eigenvectors for self-adjoint operator `T` on a
finite-dimensional inner product space `E`.

TODO Postcompose with a permutation so that these eigenvectors are listed in increasing order of
eigenvalue. -/
@[irreducible] noncomputable def eigenvector_basis : orthonormal_basis (fin n) 𝕜 E :=
hT.direct_sum_is_internal.subordinate_orthonormal_basis hn
  hT.orthogonal_family_eigenspaces'

/-- The sequence of real eigenvalues associated to the standard orthonormal basis of eigenvectors
for a self-adjoint operator `T` on `E`.

TODO Postcompose with a permutation so that these eigenvalues are listed in increasing order. -/
@[irreducible] noncomputable def eigenvalues (i : fin n) : ℝ :=
@is_R_or_C.re 𝕜 _ $
  hT.direct_sum_is_internal.subordinate_orthonormal_basis_index hn i
    hT.orthogonal_family_eigenspaces'

lemma has_eigenvector_eigenvector_basis (i : fin n) :
  has_eigenvector T (hT.eigenvalues hn i) (hT.eigenvector_basis hn i) :=
begin
  let v : E := hT.eigenvector_basis hn i,
  let μ : 𝕜 := hT.direct_sum_is_internal.subordinate_orthonormal_basis_index
    hn i hT.orthogonal_family_eigenspaces',
  simp_rw [eigenvalues],
  change has_eigenvector T (is_R_or_C.re μ) v,
  have key : has_eigenvector T μ v,
  { have H₁ : v ∈ eigenspace T μ,
    { simp_rw [v, eigenvector_basis],
      exact hT.direct_sum_is_internal.subordinate_orthonormal_basis_subordinate
        hn i hT.orthogonal_family_eigenspaces' },
    have H₂ : v ≠ 0 := by simpa using (hT.eigenvector_basis hn).to_basis.ne_zero i,
    exact ⟨H₁, H₂⟩ },
  have re_μ : ↑(is_R_or_C.re μ) = μ,
  { rw ← is_R_or_C.eq_conj_iff_re,
    exact hT.conj_eigenvalue_eq_self (has_eigenvalue_of_has_eigenvector key) },
  simpa [re_μ] using key,
end

lemma has_eigenvalue_eigenvalues (i : fin n) : has_eigenvalue T (hT.eigenvalues hn i) :=
module.End.has_eigenvalue_of_has_eigenvector (hT.has_eigenvector_eigenvector_basis hn i)

@[simp] lemma apply_eigenvector_basis (i : fin n) :
  T (hT.eigenvector_basis hn i) = (hT.eigenvalues hn i : 𝕜) • hT.eigenvector_basis hn i :=
mem_eigenspace_iff.mp (hT.has_eigenvector_eigenvector_basis hn i).1

/-- *Diagonalization theorem*, *spectral theorem*; version 2: A self-adjoint operator `T` on a
finite-dimensional inner product space `E` acts diagonally on the identification of `E` with
Euclidean space induced by an orthonormal basis of eigenvectors of `T`. -/
lemma diagonalization_basis_apply_self_apply (v : E) (i : fin n) :
  (hT.eigenvector_basis hn).repr (T v) i =
    hT.eigenvalues hn i * (hT.eigenvector_basis hn).repr v i :=
begin
  suffices : ∀ w : euclidean_space 𝕜 (fin n),
    T ((hT.eigenvector_basis hn).repr.symm w)
    = (hT.eigenvector_basis hn).repr.symm (λ i, hT.eigenvalues hn i * w i),
  { simpa [orthonormal_basis.sum_repr_symm] using
      congr_arg (λ v, (hT.eigenvector_basis hn).repr v i)
        (this ((hT.eigenvector_basis hn).repr v)) },
  intros w,
  simp_rw [← orthonormal_basis.sum_repr_symm, linear_map.map_sum,
    linear_map.map_smul, apply_eigenvector_basis],
  apply fintype.sum_congr,
  intros a,
  rw [smul_smul, mul_comm],
end

end version2

end is_symmetric
end linear_map

section nonneg

@[simp]
lemma inner_product_apply_eigenvector {μ : 𝕜} {v : E} {T : E →ₗ[𝕜] E}
  (h : v ∈ module.End.eigenspace T μ) : ⟪v, T v⟫ = μ * ‖v‖ ^ 2 :=
by simp only [mem_eigenspace_iff.mp h, inner_smul_right, inner_self_eq_norm_sq_to_K]

lemma eigenvalue_nonneg_of_nonneg {μ : ℝ} {T : E →ₗ[𝕜] E} (hμ : has_eigenvalue T μ)
  (hnn : ∀ (x : E), 0 ≤ is_R_or_C.re ⟪x, T x⟫) : 0 ≤ μ :=
begin
  obtain ⟨v, hv⟩ := hμ.exists_has_eigenvector,
  have hpos : 0 < ‖v‖ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2,
  have : is_R_or_C.re ⟪v, T v⟫ = μ * ‖v‖ ^ 2,
  { exact_mod_cast congr_arg is_R_or_C.re (inner_product_apply_eigenvector hv.1) },
  exact (zero_le_mul_right hpos).mp (this ▸ hnn v),
end

lemma eigenvalue_pos_of_pos {μ : ℝ} {T : E →ₗ[𝕜] E} (hμ : has_eigenvalue T μ)
  (hnn : ∀ (x : E), 0 < is_R_or_C.re ⟪x, T x⟫) : 0 < μ :=
begin
  obtain ⟨v, hv⟩ := hμ.exists_has_eigenvector,
  have hpos : 0 < ‖v‖ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2,
  have : is_R_or_C.re ⟪v, T v⟫ = μ * ‖v‖ ^ 2,
  { exact_mod_cast congr_arg is_R_or_C.re (inner_product_apply_eigenvector hv.1) },
  exact (zero_lt_mul_right hpos).mp (this ▸ hnn v),
end

end nonneg


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Julian Kuelshammer, Heather Macbeth

! This file was ported from Lean 3 source module ring_theory.polynomial.chebyshev
! leanprover-community/mathlib commit d774451114d6045faeb6751c396bea1eb9058946
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Derivative
import Mathlib.Tactic.LinearCombination

/-!
# Chebyshev polynomials

The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
with integral coefficients.

## Main definitions

* `Polynomial.Chebyshev.T`: the Chebyshev polynomials of the first kind.
* `Polynomial.Chebyshev.U`: the Chebyshev polynomials of the second kind.

## Main statements

* The formal derivative of the Chebyshev polynomials of the first kind is a scalar multiple of the
  Chebyshev polynomials of the second kind.
* `Polynomial.Chebyshev.mul_T`, the product of the `m`-th and `(m + k)`-th Chebyshev polynomials of
  the first kind is the sum of the `(2 * m + k)`-th and `k`-th Chebyshev polynomials of the first
  kind.
* `Polynomial.Chebyshev.T_mul`, the `(m * n)`-th Chebyshev polynomial of the first kind is the
  composition of the `m`-th and `n`-th Chebyshev polynomials of the first kind.

## Implementation details

Since Chebyshev polynomials have interesting behaviour over the complex numbers and modulo `p`,
we define them to have coefficients in an arbitrary commutative ring, even though
technically `ℤ` would suffice.
The benefit of allowing arbitrary coefficient rings, is that the statements afterwards are clean,
and do not have `map (Int.castRingHom R)` interfering all the time.

## References

[Lionel Ponton, _Roots of the Chebyshev polynomials: A purely algebraic approach_]
[ponton2020chebyshev]

## TODO

* Redefine and/or relate the definition of Chebyshev polynomials to `LinearRecurrence`.
* Add explicit formula involving square roots for Chebyshev polynomials
* Compute zeroes and extrema of Chebyshev polynomials.
* Prove that the roots of the Chebyshev polynomials (except 0) are irrational.
* Prove minimax properties of Chebyshev polynomials.
-/

noncomputable section

namespace Polynomial.Chebyshev
set_option linter.uppercaseLean3 false -- `T` `U` `X`

open Polynomial

open Polynomial

variable (R S : Type _) [CommRing R] [CommRing S]

/-- `T n` is the `n`-th Chebyshev polynomial of the first kind -/
noncomputable def T : ℕ → R[X]
  | 0 => 1
  | 1 => X
  | n + 2 => 2 * X * T (n + 1) - T n
#align polynomial.chebyshev.T Polynomial.Chebyshev.T

@[simp]
theorem T_zero : T R 0 = 1 := rfl
#align polynomial.chebyshev.T_zero Polynomial.Chebyshev.T_zero

@[simp]
theorem T_one : T R 1 = X := rfl
#align polynomial.chebyshev.T_one Polynomial.Chebyshev.T_one

@[simp]
theorem T_add_two (n : ℕ) : T R (n + 2) = 2 * X * T R (n + 1) - T R n := by rw [T]
#align polynomial.chebyshev.T_add_two Polynomial.Chebyshev.T_add_two

theorem T_of_two_le (n : ℕ) (h : 2 ≤ n) : T R n = 2 * X * T R (n - 1) - T R (n - 2) := by
  obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le h
  rw [add_comm]
  exact T_add_two R n
#align polynomial.chebyshev.T_of_two_le Polynomial.Chebyshev.T_of_two_le

/-- `U n` is the `n`-th Chebyshev polynomial of the second kind -/
noncomputable def U : ℕ → R[X]
  | 0 => 1
  | 1 => 2 * X
  | n + 2 => 2 * X * U (n + 1) - U n
#align polynomial.chebyshev.U Polynomial.Chebyshev.U

@[simp]
theorem U_zero : U R 0 = 1 := rfl
#align polynomial.chebyshev.U_zero Polynomial.Chebyshev.U_zero

@[simp]
theorem U_one : U R 1 = 2 * X := rfl
#align polynomial.chebyshev.U_one Polynomial.Chebyshev.U_one

@[simp]
theorem U_add_two (n : ℕ) : U R (n + 2) = 2 * X * U R (n + 1) - U R n := by rw [U]
#align polynomial.chebyshev.U_add_two Polynomial.Chebyshev.U_add_two

theorem U_two : U R 2 = 4 * X ^ 2 - 1 := by
  simp only [U]
  ring
#align polynomial.chebyshev.U_two Polynomial.Chebyshev.U_two

theorem U_of_two_le (n : ℕ) (h : 2 ≤ n) : U R n = 2 * X * U R (n - 1) - U R (n - 2) := by
  obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le h
  rw [add_comm]
  exact U_add_two R n
#align polynomial.chebyshev.U_of_two_le Polynomial.Chebyshev.U_of_two_le

theorem U_eq_X_mul_U_add_T : ∀ n : ℕ, U R (n + 1) = X * U R n + T R (n + 1)
  | 0 => by simp only [T, U, two_mul, mul_one]
  | 1 => by simp only [T, U]; ring
  | n + 2 =>
    calc
      U R (n + 2 + 1) = 2 * X * (X * U R (n + 1) + T R (n + 2)) - (X * U R n + T R (n + 1)) := by
        rw [U_add_two, U_eq_X_mul_U_add_T n, U_eq_X_mul_U_add_T (n + 1), U_eq_X_mul_U_add_T n]
      _ = X * (2 * X * U R (n + 1) - U R n) + (2 * X * T R (n + 2) - T R (n + 1)) := by ring
      _ = X * U R (n + 2) + T R (n + 2 + 1) := by simp only [U_add_two, T_add_two]
#align polynomial.chebyshev.U_eq_X_mul_U_add_T Polynomial.Chebyshev.U_eq_X_mul_U_add_T

theorem T_eq_U_sub_X_mul_U (n : ℕ) : T R (n + 1) = U R (n + 1) - X * U R n := by
  rw [U_eq_X_mul_U_add_T, add_comm (X * U R n), add_sub_cancel]
#align polynomial.chebyshev.T_eq_U_sub_X_mul_U Polynomial.Chebyshev.T_eq_U_sub_X_mul_U

theorem T_eq_X_mul_T_sub_pol_U : ∀ n : ℕ, T R (n + 2) = X * T R (n + 1) - (1 - X ^ 2) * U R n
  | 0 => by simp only [T, U]; ring
  | 1 => by simp only [T, U]; ring
  | n + 2 =>
    calc
      T R (n + 2 + 2) = 2 * X * T R (n + 2 + 1) - T R (n + 2) := T_add_two _ _
      _ = 2 * X * (X * T R (n + 2) - (1 - X ^ 2) * U R (n + 1)) -
            (X * T R (n + 1) - (1 - X ^ 2) * U R n) :=
        by simp only [T_eq_X_mul_T_sub_pol_U]
      _ = X * (2 * X * T R (n + 2) - T R (n + 1)) - (1 - X ^ 2) * (2 * X * U R (n + 1) - U R n) :=
        by ring
      _ = X * T R (n + 2 + 1) - (1 - X ^ 2) * U R (n + 2) := by rw [T_add_two _ (n + 1), U_add_two]
#align polynomial.chebyshev.T_eq_X_mul_T_sub_pol_U Polynomial.Chebyshev.T_eq_X_mul_T_sub_pol_U

theorem one_sub_X_sq_mul_U_eq_pol_in_T (n : ℕ) :
    (1 - X ^ 2) * U R n = X * T R (n + 1) - T R (n + 2) := by
  rw [T_eq_X_mul_T_sub_pol_U, ← sub_add, sub_self, zero_add]
#align polynomial.chebyshev.one_sub_X_sq_mul_U_eq_pol_in_T Polynomial.Chebyshev.one_sub_X_sq_mul_U_eq_pol_in_T

variable {R S}

@[simp]
theorem map_T (f : R →+* S) : ∀ n : ℕ, map f (T R n) = T S n
  | 0 => by simp only [T_zero, Polynomial.map_one]
  | 1 => by simp only [T_one, map_X]
  | n + 2 => by
    simp only [T_add_two, Polynomial.map_mul, Polynomial.map_sub, map_X, Polynomial.map_add,
      Polynomial.map_one, Polynomial.map_ofNat, map_T f (n + 1), map_T f n]
#align polynomial.chebyshev.map_T Polynomial.Chebyshev.map_T

@[simp]
theorem map_U (f : R →+* S) : ∀ n : ℕ, map f (U R n) = U S n
  | 0 => by simp only [U_zero, Polynomial.map_one]
  | 1 => by
    simp [U_one, map_X, Polynomial.map_mul, Polynomial.map_add, Polynomial.map_one]
  | n + 2 => by
    simp only [U_add_two, Polynomial.map_mul, Polynomial.map_sub, map_X, Polynomial.map_add,
      Polynomial.map_one, map_U f (n + 1), map_U f n]
    norm_num
#align polynomial.chebyshev.map_U Polynomial.Chebyshev.map_U

theorem T_derivative_eq_U : ∀ n : ℕ, derivative (T R (n + 1)) = (n + 1) * U R n
  | 0 => by simp only [T_one, U_zero, derivative_X, Nat.cast_zero, zero_add, mul_one]
  | 1 => by
    simp [T_two, U_one, derivative_sub, derivative_one, derivative_mul, derivative_X_pow, add_mul]
  | n + 2 =>
    calc
      derivative (T R (n + 2 + 1)) =
          2 * T R (n + 2) + 2 * X * derivative (T R (n + 1 + 1)) - derivative (T R (n + 1)) :=
        by
          rw [T_add_two _ (n + 1), derivative_sub, derivative_mul, derivative_mul, derivative_X,
            derivative_ofNat]
          ring_nf
      _ = 2 * (U R (n + 1 + 1) - X * U R (n + 1)) + 2 * X * (((n + 1 + 1) : R[X]) * U R (n + 1))
          - ((n + 1) : R[X]) * U R n := by
        rw_mod_cast [T_derivative_eq_U (n + 1), T_derivative_eq_U n, T_eq_U_sub_X_mul_U _ (n + 1)]
      _ = (n + 1 : R[X]) * (2 * X * U R (n + 1) - U R n) + 2 * U R (n + 2) := by ring
      _ = (n + 1) * U R (n + 2) + 2 * U R (n + 2) := by rw [U_add_two]
      _ = (n + 2 + 1) * U R (n + 2) := by ring
      _ = (↑(n + 2) + 1) * U R (n + 2) := by norm_cast
#align polynomial.chebyshev.T_derivative_eq_U Polynomial.Chebyshev.T_derivative_eq_U

theorem one_sub_X_sq_mul_derivative_T_eq_poly_in_T (n : ℕ) :
    (1 - X ^ 2) * derivative (T R (n + 1)) = (n + 1 : R[X]) * (T R n - X * T R (n + 1)) :=
  calc
    (1 - X ^ 2) * derivative (T R (n + 1)) = (1 - X ^ 2) * ((n + 1 : R[X]) * U R n) := by
      rw [T_derivative_eq_U]
    _ = (n + 1 : R[X]) * ((1 - X ^ 2) * U R n) := by ring
    _ = (n + 1 : R[X]) * (X * T R (n + 1) - (2 * X * T R (n + 1) - T R n)) := by
      rw [one_sub_X_sq_mul_U_eq_pol_in_T, T_add_two]
    _ = (n + 1 : R[X]) * (T R n - X * T R (n + 1)) := by ring
#align polynomial.chebyshev.one_sub_X_sq_mul_derivative_T_eq_poly_in_T Polynomial.Chebyshev.one_sub_X_sq_mul_derivative_T_eq_poly_in_T

theorem add_one_mul_T_eq_poly_in_U (n : ℕ) :
    ((n : R[X]) + 1) * T R (n + 1) = X * U R n - (1 - X ^ 2) * derivative (U R n) := by
  have h :
    derivative (T R (n + 2)) =
      U R (n + 1) - X * U R n + X * derivative (T R (n + 1)) + 2 * X * U R n -
        (1 - X ^ 2) * derivative (U R n) :=
    by
    conv_lhs => rw [T_eq_X_mul_T_sub_pol_U]
    simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
      one_mul, T_derivative_eq_U]
    rw [T_eq_U_sub_X_mul_U, C_eq_nat_cast]
    ring
  calc
    ((n : R[X]) + 1) * T R (n + 1) =
        ((n : R[X]) + 1 + 1) * (X * U R n + T R (n + 1)) - X * ((n + 1 : R[X]) * U R n) -
          (X * U R n + T R (n + 1)) :=
      by ring
    _ = derivative (T R (n + 2)) - X * derivative (T R (n + 1)) - U R (n + 1) := by
      rw [← U_eq_X_mul_U_add_T, ← T_derivative_eq_U, ← Nat.cast_one, ← Nat.cast_add, Nat.cast_one, ←
        T_derivative_eq_U (n + 1)]
    _ = U R (n + 1) - X * U R n + X * derivative (T R (n + 1)) + 2 * X * U R n -
              (1 - X ^ 2) * derivative (U R n) -
            X * derivative (T R (n + 1)) -
          U R (n + 1) :=
      by rw [h]
    _ = X * U R n - (1 - X ^ 2) * derivative (U R n) := by ring
#align polynomial.chebyshev.add_one_mul_T_eq_poly_in_U Polynomial.Chebyshev.add_one_mul_T_eq_poly_in_U

variable (R)

/-- The product of two Chebyshev polynomials is the sum of two other Chebyshev polynomials. -/
theorem mul_T : ∀ m k, 2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
  | 0 => by simp [two_mul, add_mul]
  | 1 => by simp [add_comm]
  | m + 2 => by
    intro k
    -- clean up the `T` nat indices in the goal
    suffices 2 * T R (m + 2) * T R (m + k + 2) = T R (2 * m + k + 4) + T R k by
      have h_nat₁ : 2 * (m + 2) + k = 2 * m + k + 4 := by ring
      have h_nat₂ : m + 2 + k = m + k + 2 := by ring
      simpa [h_nat₁, h_nat₂] using this
    -- clean up the `T` nat indices in the inductive hypothesis applied to `m + 1` and `k + 1`
    have H₁ : 2 * T R (m + 1) * T R (m + k + 2) = T R (2 * m + k + 3) + T R (k + 1) := by
      have h_nat₁ : m + 1 + (k + 1) = m + k + 2 := by ring
      have h_nat₂ : 2 * (m + 1) + (k + 1) = 2 * m + k + 3 := by ring
      simpa [h_nat₁, h_nat₂] using mul_T (m + 1) (k + 1)
    -- clean up the `T` nat indices in the inductive hypothesis applied to `m` and `k + 2`
    have H₂ : 2 * T R m * T R (m + k + 2) = T R (2 * m + k + 2) + T R (k + 2) := by
      have h_nat₁ : 2 * m + (k + 2) = 2 * m + k + 2 := by simp [add_assoc]
      have h_nat₂ : m + (k + 2) = m + k + 2 := by simp [add_assoc]
      simpa [h_nat₁, h_nat₂] using mul_T m (k + 2)
    -- state the `T` recurrence relation for a few useful indices
    have h₁ := T_add_two R m
    have h₂ : T R (2 * m + k + 4) = 2 * X * T R (2 * m + k + 3) - T R (2 * m + k + 2) :=
      T_add_two R (2 * m + k + 2)
    have h₃ := T_add_two R k
    -- the desired identity is an appropriate linear combination of H₁, H₂, h₁, h₂, h₃
    linear_combination 2 * T R (m + k + 2) * h₁ + 2 * (X : R[X]) * H₁ - H₂ - h₂ - h₃
#align polynomial.chebyshev.mul_T Polynomial.Chebyshev.mul_T

/-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
theorem T_mul : ∀ m n, T R (m * n) = (T R m).comp (T R n)
  | 0 => by simp
  | 1 => by simp
  | m + 2 => by
    intro n
    have : 2 * T R n * T R ((m + 1) * n) = T R ((m + 2) * n) + T R (m * n) := by
      convert mul_T R n (m * n) using 1 <;> ring_nf
    simp [this, T_mul m, ← T_mul (m + 1)]
#align polynomial.chebyshev.T_mul Polynomial.Chebyshev.T_mul

end Polynomial.Chebyshev