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

import algebra.big_operators.basic
import ring_theory.polynomial.basic

/-!
# Lagrange interpolation

## Main definitions

* `lagrange.basis s x` where `s : finset F` and `x : F`: the Lagrange basis polynomial
  that evaluates to `1` at `x` and `0` at other elements of `s`.
* `lagrange.interpolate s f` where `s : finset F` and `f : F → F`: the Lagrange interpolant
  that evaluates to `f x` at `x` for `x ∈ s`.
-/

noncomputable theory
open_locale big_operators classical

universe u

namespace lagrange

variables {F : Type u} [decidable_eq F] [field F] (s : finset F)
variables {F' : Type u} [field F'] (s' : finset F')

open polynomial

/-- Lagrange basis polynomials that evaluate to 1 at `x` and 0 at other elements of `s`. -/
def basis (x : F) : polynomial F :=
∏ y in s.erase x, C (x - y)⁻¹ * (X - C y)

@[simp] theorem basis_empty (x : F) : basis ∅ x = 1 :=
rfl

@[simp] theorem basis_singleton_self (x : F) : basis {x} x = 1 :=
by rw [basis, finset.erase_singleton, finset.prod_empty]

@[simp] theorem eval_basis_self (x : F) : (basis s x).eval x = 1 :=
begin
  rw [basis, ← coe_eval_ring_hom, (eval_ring_hom x).map_prod, coe_eval_ring_hom,
    finset.prod_eq_one],
  intros y hy, simp_rw [eval_mul, eval_sub, eval_C, eval_X],
  exact inv_mul_cancel (sub_ne_zero_of_ne (finset.ne_of_mem_erase hy).symm)
end

@[simp] theorem eval_basis_ne (x y : F) (h1 : y ∈ s) (h2 : y ≠ x) : (basis s x).eval y = 0 :=
begin
  rw [basis,
  ← coe_eval_ring_hom, (eval_ring_hom y).map_prod, coe_eval_ring_hom,
    finset.prod_eq_zero (finset.mem_erase.2 ⟨h2, h1⟩)],
  simp_rw [eval_mul, eval_sub, eval_C, eval_X, sub_self, mul_zero]
end

theorem eval_basis (x y : F) (h : y ∈ s) : (basis s x).eval y = if y = x then 1 else 0 :=
by { split_ifs with H, { subst H, apply eval_basis_self }, { exact eval_basis_ne s x y h H } }

@[simp] theorem nat_degree_basis (x : F) (hx : x ∈ s) : (basis s x).nat_degree = s.card - 1 :=
begin
  unfold basis, generalize hsx : s.erase x = sx,
  have : x ∉ sx := hsx ▸ finset.not_mem_erase x s,
  rw [← finset.insert_erase hx, hsx, finset.card_insert_of_not_mem this, add_tsub_cancel_right],
  clear hx hsx s, revert this, apply sx.induction_on,
  { intros hx, rw [finset.prod_empty, nat_degree_one], refl },
  { intros y s hys ih hx, rw [finset.mem_insert, not_or_distrib] at hx,
    have h1 : C (x - y)⁻¹ ≠ C 0 := λ h, hx.1 (eq_of_sub_eq_zero $ inv_eq_zero.1 $ C_inj.1 h),
    have h2 : X ^ 1 - C y ≠ 0 := by convert X_pow_sub_C_ne_zero zero_lt_one y,
    rw C_0 at h1, rw pow_one at h2,
    rw [finset.prod_insert hys, nat_degree_mul (mul_ne_zero h1 h2), ih hx.2,
        finset.card_insert_of_not_mem hys, nat_degree_mul h1 h2,
        nat_degree_C, zero_add, nat_degree, degree_X_sub_C, add_comm], refl,
    rw [ne, finset.prod_eq_zero_iff], rintro ⟨z, hzs, hz⟩,
    rw mul_eq_zero at hz, cases hz with hz hz,
    { rw [← C_0, C_inj, inv_eq_zero, sub_eq_zero] at hz, exact hx.2 (hz.symm ▸ hzs) },
    { rw ← pow_one (X : polynomial F) at hz, exact X_pow_sub_C_ne_zero zero_lt_one _ hz } }
end

variables (f : F → F)

/-- Lagrange interpolation: given a finset `s` and a function `f : F → F`,
`interpolate s f` is the unique polynomial of degree `< s.card`
that takes value `f x` on all `x` in `s`. -/
def interpolate : polynomial F :=
∑ x in s, C (f x) * basis s x

@[simp] theorem interpolate_empty (f) : interpolate (∅ : finset F) f = 0 :=
rfl

@[simp] theorem interpolate_singleton (f) (x : F) : interpolate {x} f = C (f x) :=
by rw [interpolate, finset.sum_singleton, basis_singleton_self, mul_one]

@[simp] theorem eval_interpolate (x) (H : x ∈ s) : eval x (interpolate s f) = f x :=
begin
  rw [interpolate, ←coe_eval_ring_hom, ring_hom.map_sum, coe_eval_ring_hom, finset.sum_eq_single x],
  { simp },
  { intros y hy hxy, simp [eval_basis_ne s y x H hxy.symm] },
  { intro h, exact (h H).elim }
end

theorem degree_interpolate_lt : (interpolate s f).degree < s.card :=
if H : s = ∅ then by { subst H, rw [interpolate_empty, degree_zero], exact with_bot.bot_lt_coe _ }
else (degree_sum_le _ _).trans_lt $ (finset.sup_lt_iff $ with_bot.bot_lt_coe s.card).2 $ λ b _,
calc  (C (f b) * basis s b).degree
    ≤ (C (f b)).degree + (basis s b).degree : degree_mul_le _ _
... ≤ 0 + (basis s b).degree : add_le_add_right degree_C_le _
... = (basis s b).degree : zero_add _
... ≤ (basis s b).nat_degree : degree_le_nat_degree
... = (s.card - 1 : ℕ) : by { rwa nat_degree_basis }
... < s.card : with_bot.coe_lt_coe.2 (nat.pred_lt $ mt finset.card_eq_zero.1 H)

theorem degree_interpolate_erase {x} (hx : x ∈ s) :
  (interpolate (s.erase x) f).degree < (s.card - 1 : ℕ) :=
begin
  convert degree_interpolate_lt (s.erase x) f,
  rw [finset.card_erase_of_mem hx, nat.pred_eq_sub_one]
end

theorem interpolate_eq_of_eval_eq (f g : F → F) {s : finset F} (hs : ∀ x ∈ s, f x = g x) :
  interpolate s f = interpolate s g :=
begin
  rw [interpolate, interpolate],
  refine finset.sum_congr rfl (λ x hx, _),
  rw hs x hx,
end

/-- Linear version of `interpolate`. -/
def linterpolate : (F → F) →ₗ[F] polynomial F :=
{ to_fun := interpolate s,
  map_add' := λ f g, by { simp_rw [interpolate, ← finset.sum_add_distrib, ← add_mul, ← C_add],
    refl },
  map_smul' := λ c f, by { simp_rw [interpolate, finset.smul_sum, C_mul', smul_smul], refl } }

@[simp] lemma interpolate_add (f g) : interpolate s (f + g) = interpolate s f + interpolate s g :=
(linterpolate s).map_add f g

@[simp] lemma interpolate_zero : interpolate s 0 = 0 :=
(linterpolate s).map_zero

@[simp] lemma interpolate_neg (f) : interpolate s (-f) = -interpolate s f :=
(linterpolate s).map_neg f

@[simp] lemma interpolate_sub (f g) : interpolate s (f - g) = interpolate s f - interpolate s g :=
(linterpolate s).map_sub f g

@[simp] lemma interpolate_smul (c : F) (f) : interpolate s (c • f) = c • interpolate s f :=
(linterpolate s).map_smul c f

theorem eq_zero_of_eval_eq_zero {f : polynomial F'} (hf1 : f.degree < s'.card)
  (hf2 : ∀ x ∈ s', f.eval x = 0) : f = 0 :=
by_contradiction $ λ hf3, not_le_of_lt hf1 $
calc  (s'.card : with_bot ℕ)
    ≤ f.roots.to_finset.card : with_bot.coe_le_coe.2 $ finset.card_le_of_subset $ λ x hx,
        (multiset.mem_to_finset).mpr $ (mem_roots hf3).2 $ hf2 x hx
... ≤ f.roots.card : with_bot.coe_le_coe.2 $ f.roots.to_finset_card_le
... ≤ f.degree : card_roots hf3

theorem eq_of_eval_eq {f g : polynomial F'} (hf : f.degree < s'.card) (hg : g.degree < s'.card)
  (hfg : ∀ x ∈ s', f.eval x = g.eval x) : f = g :=
eq_of_sub_eq_zero $ eq_zero_of_eval_eq_zero s'
  (lt_of_le_of_lt (degree_sub_le f g) $ max_lt hf hg)
  (λ x hx, by rw [eval_sub, hfg x hx, sub_self])

theorem eq_interpolate_of_eval_eq {g : polynomial F} (hg : g.degree < s.card)
  (hgf : ∀ x ∈ s, g.eval x = f x) : interpolate s f = g :=
eq_of_eval_eq s (degree_interpolate_lt _ _) hg $ λ x hx, begin
  rw hgf x hx,
  exact eval_interpolate _ _ _ hx,
end

theorem eq_interpolate (f : polynomial F) (hf : f.degree < s.card) :
  interpolate s (λ x, f.eval x) = f :=
eq_of_eval_eq s (degree_interpolate_lt s _) hf $ λ x hx, eval_interpolate s _ x hx

/-- Lagrange interpolation induces isomorphism between functions from `s` and polynomials
of degree less than `s.card`. -/
def fun_equiv_degree_lt : degree_lt F s.card ≃ₗ[F] (s → F) :=
{ to_fun := λ f x, f.1.eval x,
  map_add' := λ f g, funext $ λ x, eval_add,
  map_smul' := λ c f, funext $ by simp,
  inv_fun := λ f, ⟨interpolate s (λ x, if hx : x ∈ s then f ⟨x, hx⟩ else 0),
    mem_degree_lt.2 $ degree_interpolate_lt _ _⟩,
  left_inv := λ f, begin apply subtype.eq,
    simp only [subtype.coe_mk, subtype.val_eq_coe, dite_eq_ite],
    convert eq_interpolate s f (mem_degree_lt.1 f.2) using 1,
    rw interpolate_eq_of_eval_eq,
    intros x hx,
    rw if_pos hx end,
  right_inv := λ f, funext $ λ ⟨x, hx⟩, begin
    convert eval_interpolate s _ x hx,
    simp_rw dif_pos hx end }

theorem interpolate_eq_interpolate_erase_add {x y : F} (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) :
  interpolate s f =
  C (y - x)⁻¹ * ((X - C x) * interpolate (s.erase x) f + (C y - X) * interpolate (s.erase y) f) :=
begin
  refine eq_interpolate_of_eval_eq _ _ _ (λ z hz, _),
  { rw [degree_mul, degree_C (inv_ne_zero (sub_ne_zero.2 hxy.symm)), zero_add],
    refine lt_of_le_of_lt (degree_add_le _ _) (max_lt _ _),
    { rw [degree_mul, degree_X_sub_C],
      convert (with_bot.add_lt_add_iff_left (with_bot.coe_ne_bot _)).2
        (degree_interpolate_erase s f hx),
      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨x, hx⟩)] },
    { rw [degree_mul, ←neg_sub, degree_neg, degree_X_sub_C],
      convert (with_bot.add_lt_add_iff_left (with_bot.coe_ne_bot _)).2
        (degree_interpolate_erase s f hy),
      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨y, hy⟩)] } },
  { by_cases hzx : z = x,
    { simp [hzx, eval_interpolate (s.erase y) f x (finset.mem_erase_of_ne_of_mem hxy hx),
            inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
    { by_cases hzy : z = y,
      { simp [hzy, eval_interpolate (s.erase x) f y (finset.mem_erase_of_ne_of_mem hxy.symm hy),
              inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
      { simp only [eval_interpolate (s.erase x) f z (finset.mem_erase_of_ne_of_mem hzx hz),
                   eval_interpolate (s.erase y) f z (finset.mem_erase_of_ne_of_mem hzy hz),
                   inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm), eval_mul, eval_C, eval_add,
                   eval_sub, eval_X],
        ring } } }
end

end lagrange


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import tactic.noncomm_ring
import field_theory.is_alg_closed.basic
/-!
# Spectrum of an element in an algebra
This file develops the basic theory of the spectrum of an element of an algebra.
This theory will serve as the foundation for spectral theory in Banach algebras.

## Main definitions

* `resolvent_set a : set R`: the resolvent set of an element `a : A` where
  `A` is an  `R`-algebra.
* `spectrum a : set R`: the spectrum of an element `a : A` where
  `A` is an  `R`-algebra.
* `resolvent : R → A`: the resolvent function is `λ r, ring.inverse (↑ₐr - a)`, and hence
  when `r ∈ resolvent R A`, it is actually the inverse of the unit `(↑ₐr - a)`.

## Main statements

* `spectrum.unit_smul_eq_smul` and `spectrum.smul_eq_smul`: units in the scalar ring commute
  (multiplication) with the spectrum, and over a field even `0` commutes with the spectrum.
* `spectrum.left_add_coset_eq`: elements of the scalar ring commute (addition) with the spectrum.
* `spectrum.unit_mem_mul_iff_mem_swap_mul` and `spectrum.preimage_units_mul_eq_swap_mul`: the
  units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`.
* `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is
  a singleton.
* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem.

## Notations

* `σ a` : `spectrum R a` of `a : A`
-/

universes u v

section defs

variables (R : Type u) {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

-- definition and basic properties

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *resolvent set* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is a unit of the
algebra `A`.  -/
def resolvent_set (a : A) : set R :=
{ r : R | is_unit (algebra_map R A r - a) }

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *spectrum* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is not a unit of the
algebra `A`.

The spectrum is simply the complement of the resolvent set.  -/
def spectrum (a : A) : set R :=
(resolvent_set R a)ᶜ

variable {R}
/-- Given an `a : A` where `A` is an `R`-algebra, the *resolvent* is
    a map `R → A` which sends `r : R` to `(algebra_map R A r - a)⁻¹` when
    `r ∈ resolvent R A` and `0` when `r ∈ spectrum R A`. -/
noncomputable def resolvent (a : A) (r : R) : A :=
ring.inverse (algebra_map R A r - a)

end defs

-- products of scalar units and algebra units

lemma is_unit.smul_sub_iff_sub_inv_smul {R : Type u} {A : Type v}
  [comm_ring R] [ring A] [algebra R A] {r : Rˣ} {a : A} :
  is_unit (r • 1 - a) ↔ is_unit (1 - r⁻¹ • a) :=
begin
  have a_eq : a = r•r⁻¹•a, by simp,
  nth_rewrite 0 a_eq,
  rw [←smul_sub,is_unit_smul_iff],
end

namespace spectrum

section scalar_ring

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

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_iff {r : R} {a : A} :
  r ∈ σ a ↔ ¬ is_unit (↑ₐr - a) :=
iff.rfl

lemma not_mem_iff {r : R} {a : A} :
  r ∉ σ a ↔ is_unit (↑ₐr - a) :=
by { apply not_iff_not.mp, simp [set.not_not_mem, mem_iff] }

lemma mem_resolvent_set_of_left_right_inverse {r : R} {a b c : A}
  (h₁ : (↑ₐr - a) * b = 1) (h₂ : c * (↑ₐr - a) = 1) :
  r ∈ resolvent_set R a :=
units.is_unit ⟨↑ₐr - a, b, h₁, by rwa ←left_inv_eq_right_inv h₂ h₁⟩

lemma mem_resolvent_set_iff {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (↑ₐr - a) :=
iff.rfl

lemma resolvent_eq {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  resolvent a r = ↑h.unit⁻¹ :=
ring.inverse_unit h.unit

lemma add_mem_iff {a : A} {r s : R} :
  r ∈ σ a ↔ r + s ∈ σ (↑ₐs + a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff],
  have h_eq : ↑ₐ(r + s) - (↑ₐs + a) = ↑ₐr - a,
    { simp, noncomm_ring },
  rw h_eq,
end

lemma smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} :
  r • s ∈ σ (r • a) ↔ s ∈ σ a :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have h_eq : (r • s) • (1 : A) = r • s • 1, by simp,
  rw [h_eq, ←smul_sub, is_unit_smul_iff],
end

open_locale pointwise

theorem unit_smul_eq_smul (a : A) (r : Rˣ) :
  σ (r • a) = r • σ a :=
begin
  ext,
  have x_eq : x = r • r⁻¹ • x, by simp,
  nth_rewrite 0 x_eq,
  rw smul_mem_smul_iff,
  split,
    { exact λ h, ⟨r⁻¹ • x, ⟨h, by simp⟩⟩},
    { rintros ⟨_, _, x'_eq⟩, simpa [←x'_eq],}
end

theorem left_add_coset_eq (a : A) (r : R) :
  left_add_coset r (σ a) = σ (↑ₐr + a) :=
by { ext, rw [mem_left_add_coset_iff, neg_add_eq_sub, add_mem_iff],
     nth_rewrite 1 ←sub_add_cancel x r, }

-- `r ∈ σ(a*b) ↔ r ∈ σ(b*a)` for any `r : Rˣ`
theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} :
  ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have coe_smul_eq : ↑r • 1 = r • (1 : A), from rfl,
  rw coe_smul_eq,
  simp only [is_unit.smul_sub_iff_sub_inv_smul],
  have right_inv_of_swap : ∀ {x y z : A} (h : (1 - x * y) * z = 1),
    (1 - y * x) * (1 + y * z * x) = 1, from λ x y z h,
      calc (1 - y * x) * (1 + y * z * x) = 1 - y * x + y * ((1 - x * y) * z) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have left_inv_of_swap : ∀ {x y z : A} (h : z * (1 - x * y) = 1),
    (1 + y * z * x) * (1 - y * x) = 1, from λ x y z h,
      calc (1 + y * z * x) * (1 - y * x) = 1 - y * x + y * (z * (1 - x * y)) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have is_unit_one_sub_mul_of_swap : ∀ {x y : A} (h : is_unit (1 - x * y)),
    is_unit (1 - y * x), from λ x y h, by
      { let h₁ := right_inv_of_swap h.unit.val_inv,
        let h₂ := left_inv_of_swap h.unit.inv_val,
        exact ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, h₁, h₂⟩, rfl⟩, },
  have is_unit_one_sub_mul_iff_swap : ∀ {x y : A},
    is_unit (1 - x * y) ↔ is_unit (1 - y * x), by
      { intros, split, repeat {apply is_unit_one_sub_mul_of_swap}, },
  rw [←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a, is_unit_one_sub_mul_iff_swap],
end

theorem preimage_units_mul_eq_swap_mul {a b : A} :
  (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹'  σ (b * a) :=
by { ext, exact unit_mem_mul_iff_mem_swap_mul, }

end scalar_ring

section scalar_field

variables {𝕜 : Type u} {A : Type v}
variables [field 𝕜] [ring A] [algebra 𝕜 A]

local notation `σ` := spectrum 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

/-- Without the assumption `nontrivial A`, then `0 : A` would be invertible. -/
@[simp] lemma zero_eq [nontrivial A] : σ (0 : A) = {0} :=
begin
  refine set.subset.antisymm _ (by simp [algebra.algebra_map_eq_smul_one, mem_iff]),
  rw [spectrum, set.compl_subset_comm],
  intros k hk,
  rw set.mem_compl_singleton_iff at hk,
  have : is_unit (units.mk0 k hk • (1 : A)) := is_unit.smul (units.mk0 k hk) is_unit_one,
  simpa [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one]
end

@[simp] theorem scalar_eq [nontrivial A] (k : 𝕜) : σ (↑ₐk) = {k} :=
begin
  have coset_eq : left_add_coset k {0} = {k}, by
    { ext, split,
      { intro hx, simp [left_add_coset] at hx, exact hx, },
      { intro hx, simp at hx, exact ⟨0, ⟨set.mem_singleton 0, by simp [hx]⟩⟩, }, },
  calc σ (↑ₐk) = σ (↑ₐk + 0)                  : by simp
    ...        = left_add_coset k (σ (0 : A)) : by rw ←left_add_coset_eq
    ...        = left_add_coset k {0}         : by rw zero_eq
    ...        = {k}                          : coset_eq,
end

@[simp] lemma one_eq [nontrivial A] : σ (1 : A) = {1} :=
calc σ (1 : A) = σ (↑ₐ1) : by simp [algebra.algebra_map_eq_smul_one]
  ...          = {1}     : scalar_eq 1

open_locale pointwise

/-- the assumption `(σ a).nonempty` is necessary and cannot be removed without
    further conditions on the algebra `A` and scalar field `𝕜`. -/
theorem smul_eq_smul [nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).nonempty) :
  σ (k • a) = k • (σ a) :=
begin
  rcases eq_or_ne k 0 with rfl | h,
  { simpa [ha, zero_smul_set] },
  { exact unit_smul_eq_smul a (units.mk0 k h) },
end

theorem nonzero_mul_eq_swap_mul (a b : A) : σ (a * b) \ {0} = σ (b * a) \ {0} :=
begin
  suffices h : ∀ (x y : A), σ (x * y) \ {0} ⊆ σ (y * x) \ {0},
  { exact set.eq_of_subset_of_subset (h a b) (h b a) },
  { rintros _ _ k ⟨k_mem, k_neq⟩,
    change k with ↑(units.mk0 k k_neq) at k_mem,
    exact ⟨unit_mem_mul_iff_mem_swap_mul.mp k_mem, k_neq⟩ },
end

open polynomial
/-- Half of the spectral mapping theorem for polynomials. We prove it separately
because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/

lemma exists_mem_of_not_is_unit_aeval_prod {p : polynomial 𝕜} {a : A} (hp : p ≠ 0)
  (h : ¬is_unit (aeval a (multiset.map (λ (x : 𝕜), X - C x) p.roots).prod)) :
  ∃ k : 𝕜, k ∈ σ a ∧ eval k p = 0 :=
begin
  rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h,
  replace h := mt list.prod_is_unit h,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h,
  rcases h with ⟨r, r_mem, r_nu⟩,
  exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩
end

/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : polynomial 𝕜)
  (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/
  refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p),
  /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/
  have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)),
  have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt
    (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]),
  have lead_ne := leading_coeff_ne_zero.mpr h_ne,
  have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit,
  /- leading coefficient is a unit so product of linear factors is not a unit;
  apply `exists_mem_of_not_is_unit_aeval_prod`. -/
  have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p,
    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
  rw [mem_iff, ←p_a_eq, hprod, aeval_mul,
    ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk,
  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit),
  rcases hk with ⟨r, r_mem, r_ev⟩,
  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩,
end

/-- In this version of the spectral mapping theorem, we assume the spectrum
is nonempty instead of assuming the degree of the polynomial is positive. Note: the
assumption `[nontrivial A]` is necessary for the same reason as in `spectrum.zero_eq`. -/
theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] [nontrivial A] (a : A) (p : polynomial 𝕜)
  (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p),
  { rw eq_C_of_degree_le_zero h,
    simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] },
end

variable (𝕜)
/--
Every element `a` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `𝕜` has non-empty spectrum. -/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜]
  [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) :
  ∃ k : 𝕜, k ∈ σ a :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a,
  have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu,
  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu,
  exact ⟨k, hk⟩
end

end scalar_field

end spectrum

namespace alg_hom

variables {R : Type*} {A : Type*} [comm_ring R] [ring A] [algebra R A]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma apply_mem_spectrum [nontrivial R] (φ : A →ₐ[R] R) (a : A) : φ a ∈ σ a :=
begin
  have h : ↑ₐ(φ a) - a ∈ φ.to_ring_hom.ker,
  { simp only [ring_hom.mem_ker, coe_to_ring_hom, commutes, algebra.id.map_eq_id,
               to_ring_hom_eq_coe, ring_hom.id_apply, sub_self, map_sub] },
  simp only [spectrum.mem_iff, ←mem_nonunits_iff,
             coe_subset_nonunits (φ.to_ring_hom.ker_ne_top) h],
end

end alg_hom


import data.real.basic
import tactic

namespace logic_example

variable U : Type
variables A B : U → Prop

/-
If you have a proof, h1, which says:
   for all x, if the property A(x) is true, then the property B(x) is true.
and you have another proof, h2, which says:
   for all x, the property A(X) is true,

Then the following is a proof which says:
   for all x, B(X) is true.
-/
example
 (h1 : ∀ x, A x → B x)
 (h2 : ∀ x, A x) :
∀ x, B x :=
assume y,
have h3 : A y, from h2 y,
have h4 : A y → B y, from h1 y,
show B y, from h4 h3

end logic_example

set_option pp.implicit true
-- Make simp display the steps used.
set_option trace.simplify.rewrite true
-- # 1
namespace problem1
-- let X, Y, Z be sets.
variables {X Y Z : Type}
-- a function f : X → Y is *injective* if f(a) = f(b) → a = b for all a,b in X.
def injective (f : X → Y)  : Prop :=
∀ a b : X, f(a) = f(b) → a = b
-- challenge: the composite of two injective functions is injective
theorem challenge1
(f : X → Y) (hf : injective f)
(g : Y → Z) (hg : injective g) :
injective (g ∘ f) :=
begin
  intros a b,
  intro h₁, --: g ∘ f a  = g ∘ f b, How to specify the type of h₁?
  have h₂ : f a = f b, from hg (f a) (f b) h₁,
  have h₃ : a = b, from hf a b h₂,
  exact h₃
end
theorem challenge1_solution
(f : X → Y) (hf : injective f)
(g : Y → Z) (hg : injective g) :
injective (g ∘ f) :=
begin
-- the *definition* of "injective" is "for all a and b...", so let
-- a and b be arbitrary elements of X.
intros a b,
-- Assume (g ∘ f) a = (g ∘ f) b
intro hab,
-- The goal is now ⊢ a = b .
-- By injectivity of f, it suffices to prove f(a)=f(b)
apply hf,
-- By injectivity of g, it suffices to prove g(f(a))=g(f(b))
apply hg,
-- but this is precisely our assumption.
exact hab,
-- "no goals" means we're done.
end
end problem1

namespace problem2
-- basic definitions
def upper_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, s ≤ b }
def lower_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, b ≤ s }
def is_least (S : set ℝ) (l : ℝ) : Prop := l ∈ S ∧ l ∈ lower_bounds S
def is_lub (S : set ℝ) (l : ℝ) : Prop := is_least (upper_bounds S) l

/-- A set has at most one least upper bound -/
theorem challenge2
(S : set ℝ)
(a b : ℝ)
(ha : is_lub S a)
(hb : is_lub S b) :
a = b :=
begin
have h₁ : a ∈ upper_bounds S, from ha.left,
have h₂ : b ∈ upper_bounds S, from hb.left,
have h₃ : a ≤ b, from ha.right b h₂,
have h₄ : b ≤ a, from hb.right a h₁,
linarith,
-- or
--exact @le_antisymm ℝ real.partial_order a b h₃ h₄
end

/-- A set has at most one least upper bound -/
theorem challenge2_tactic_version
(S : set ℝ)
(a b : ℝ)
(ha : is_lub S a)
(hb : is_lub S b) :
a = b :=
begin
-- if you unfold some definitions
 unfold is_lub at ha,
 unfold is_least at ha,
-- then you discover that by definition ha is a proof of
-- a ∈ upper_bounds S ∧ a ∈ lower_bounds (upper_bounds S)
-- so it's a proof of P ∧ Q, so you can use `cases` to recover the proofs of P and Q.
cases ha with ha₁ ha₂,
-- you don't have to do the unfolding though.
cases hb with hb₁ hb₂,
-- we prove a = b by showing a ≤ b and b ≤ a
apply le_antisymm,
{ -- to prove a ≤ b we want to argue that b is an upper bound and a is the least upper bound.
  -- First let's use the fact that a is at most all upper bounds
  --apply ha₂,
  -- and now we just need that b is an upper bound
  exact hb₁},
{ -- The other way is similar.
  apply hb₂,
  exact ha₁}
end
end problem2

namespace ploblem3
theorem challenge3 :
(2 : ℝ) + 2 ≠ 5 :=
begin
linarith,
end
theorem challenge3_solution :
(2 : ℝ) + 2 ≠ 5 :=
begin
norm_num
end
/-
Notes:
After checking the docs, norm_num is more lightweight, covering arithmetic
evaluations of *,+,-,^,≤, whereas linarith has norm_num as a subset. It
handles 'linear' arithmetic (not exactly sure what is included here), but it
it is far more comprehensive.
-/
end ploblem3
namespace problem4
open function
theorem challenge4
(X Y Z : Type)
(f : X → Y)
(g : Y → Z) :
surjective (g ∘ f) → surjective g :=
assume h₁,
assume z,
have h₂ : ∃y : Y, g y = z, from exists.elim (h₁ z)
(assume (x : X) (hh₁ : (g ∘ f) x = z),
  have hh₂ : g (f x) = z, from hh₁,
  let y := f x in exists.intro y hh₂),
h₂
theorem challenge4_solution
(X Y Z : Type)
(f : X → Y)
(g : Y → Z) :
surjective (g ∘ f) → surjective g :=
begin
intro h,
intro z,
cases h z with a ha,
use f a,
assumption,
end
end problem4


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import algebra.star.pointwise
import algebra.star.subalgebra
import field_theory.is_alg_closed.basic
import tactic.noncomm_ring
/-!
# Spectrum of an element in an algebra
This file develops the basic theory of the spectrum of an element of an algebra.
This theory will serve as the foundation for spectral theory in Banach algebras.

## Main definitions

* `resolvent_set a : set R`: the resolvent set of an element `a : A` where
  `A` is an  `R`-algebra.
* `spectrum a : set R`: the spectrum of an element `a : A` where
  `A` is an  `R`-algebra.
* `resolvent : R → A`: the resolvent function is `λ r, ring.inverse (↑ₐr - a)`, and hence
  when `r ∈ resolvent R A`, it is actually the inverse of the unit `(↑ₐr - a)`.

## Main statements

* `spectrum.unit_smul_eq_smul` and `spectrum.smul_eq_smul`: units in the scalar ring commute
  (multiplication) with the spectrum, and over a field even `0` commutes with the spectrum.
* `spectrum.left_add_coset_eq`: elements of the scalar ring commute (addition) with the spectrum.
* `spectrum.unit_mem_mul_iff_mem_swap_mul` and `spectrum.preimage_units_mul_eq_swap_mul`: the
  units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`.
* `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is
  a singleton.
* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem.

## Notations

* `σ a` : `spectrum R a` of `a : A`
-/

open set
open_locale pointwise

universes u v

section defs

variables (R : Type u) {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

local notation `↑ₐ` := algebra_map R A

-- definition and basic properties

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *resolvent set* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is a unit of the
algebra `A`.  -/
def resolvent_set (a : A) : set R :=
{ r : R | is_unit (↑ₐr - a) }

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *spectrum* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is not a unit of the
algebra `A`.

The spectrum is simply the complement of the resolvent set.  -/
def spectrum (a : A) : set R :=
(resolvent_set R a)ᶜ

variable {R}
/-- Given an `a : A` where `A` is an `R`-algebra, the *resolvent* is
    a map `R → A` which sends `r : R` to `(algebra_map R A r - a)⁻¹` when
    `r ∈ resolvent R A` and `0` when `r ∈ spectrum R A`. -/
noncomputable def resolvent (a : A) (r : R) : A :=
ring.inverse (↑ₐr - a)

/-- The unit `1 - r⁻¹ • a` constructed from `r • 1 - a` when the latter is a unit. -/
@[simps]
noncomputable def is_unit.sub_inv_smul {r : Rˣ} {s : R} {a : A}
  (h : is_unit $ r • ↑ₐs  - a) : Aˣ :=
{ val := ↑ₐs - r⁻¹ • a,
  inv := r • ↑h.unit⁻¹,
  val_inv := by rw [mul_smul_comm, ←smul_mul_assoc, smul_sub, smul_inv_smul, h.mul_coe_inv],
  inv_val := by rw [smul_mul_assoc, ←mul_smul_comm, smul_sub, smul_inv_smul, h.coe_inv_mul], }

end defs

namespace spectrum
open_locale polynomial

section scalar_semiring

variables {R : Type u} {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_iff {r : R} {a : A} :
  r ∈ σ a ↔ ¬ is_unit (↑ₐr - a) :=
iff.rfl

lemma not_mem_iff {r : R} {a : A} :
  r ∉ σ a ↔ is_unit (↑ₐr - a) :=
by { apply not_iff_not.mp, simp [set.not_not_mem, mem_iff] }

variables (R)

lemma zero_mem_iff {a : A} : (0 : R) ∈ σ a ↔ ¬is_unit a :=
by rw [mem_iff, map_zero, zero_sub, is_unit.neg_iff]

lemma zero_not_mem_iff {a : A} : (0 : R) ∉ σ a ↔ is_unit a :=
by rw [zero_mem_iff, not_not]

variables {R}

lemma mem_resolvent_set_of_left_right_inverse {r : R} {a b c : A}
  (h₁ : (↑ₐr - a) * b = 1) (h₂ : c * (↑ₐr - a) = 1) :
  r ∈ resolvent_set R a :=
units.is_unit ⟨↑ₐr - a, b, h₁, by rwa ←left_inv_eq_right_inv h₂ h₁⟩

lemma mem_resolvent_set_iff {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (↑ₐr - a) :=
iff.rfl

@[simp] lemma resolvent_set_of_subsingleton [subsingleton A] (a : A) :
  resolvent_set R a = set.univ :=
by simp_rw [resolvent_set, subsingleton.elim (algebra_map R A _ - a) 1, is_unit_one,
  set.set_of_true]

@[simp] lemma of_subsingleton [subsingleton A] (a : A) :
  spectrum R a = ∅ :=
by rw [spectrum, resolvent_set_of_subsingleton, set.compl_univ]

lemma resolvent_eq {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  resolvent a r = ↑h.unit⁻¹ :=
ring.inverse_unit h.unit

lemma units_smul_resolvent {r : Rˣ} {s : R} {a : A} :
  r • resolvent a (s : R) = resolvent (r⁻¹ • a) (r⁻¹ • s : R) :=
begin
  by_cases h : s ∈ spectrum R a,
  { rw [mem_iff] at h,
    simp only [resolvent, algebra.algebra_map_eq_smul_one] at *,
    rw [smul_assoc, ←smul_sub],
    have h' : ¬ is_unit (r⁻¹ • (s • 1 - a)),
      from λ hu, h (by simpa only [smul_inv_smul] using is_unit.smul r hu),
    simp only [ring.inverse_non_unit _ h, ring.inverse_non_unit _ h', smul_zero] },
  { simp only [resolvent],
    have h' : is_unit (r • (algebra_map R A (r⁻¹ • s)) - a),
      { simpa [algebra.algebra_map_eq_smul_one, smul_assoc] using not_mem_iff.mp h },
    rw [←h'.coe_sub_inv_smul, ←(not_mem_iff.mp h).unit_spec, ring.inverse_unit, ring.inverse_unit,
      h'.coe_inv_sub_inv_smul],
    simp only [algebra.algebra_map_eq_smul_one, smul_assoc, smul_inv_smul], },
end

lemma units_smul_resolvent_self {r : Rˣ} {a : A} :
  r • resolvent a (r : R) = resolvent (r⁻¹ • a) (1 : R) :=
by simpa only [units.smul_def, algebra.id.smul_eq_mul, units.inv_mul]
  using @units_smul_resolvent _ _ _ _ _ r r a

/-- The resolvent is a unit when the argument is in the resolvent set. -/
lemma is_unit_resolvent {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (resolvent a r) :=
is_unit_ring_inverse.symm

lemma inv_mem_resolvent_set {r : Rˣ} {a : Aˣ} (h : (r : R) ∈ resolvent_set R (a : A)) :
  (↑r⁻¹ : R) ∈ resolvent_set R (↑a⁻¹ : A) :=
begin
  rw [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, ←units.smul_def] at h ⊢,
  rw [is_unit.smul_sub_iff_sub_inv_smul, inv_inv, is_unit.sub_iff],
  have h₁ : (a : A) * (r • (↑a⁻¹ : A) - 1) = r • 1 - a,
  { rw [mul_sub, mul_smul_comm, a.mul_inv, mul_one], },
  have h₂ : (r • (↑a⁻¹ : A) - 1) * a = r • 1 - a,
  { rw [sub_mul, smul_mul_assoc, a.inv_mul, one_mul], },
  have hcomm : commute (a : A) (r • (↑a⁻¹ : A) - 1), { rwa ←h₂ at h₁ },
  exact (hcomm.is_unit_mul_iff.mp (h₁.symm ▸ h)).2,
end

lemma inv_mem_iff {r : Rˣ} {a : Aˣ} :
  (r : R) ∈ σ (a : A) ↔ (↑r⁻¹ : R) ∈ σ (↑a⁻¹ : A) :=
not_iff_not.2 $ ⟨inv_mem_resolvent_set, inv_mem_resolvent_set⟩

lemma zero_mem_resolvent_set_of_unit (a : Aˣ) : 0 ∈ resolvent_set R (a : A) :=
by simpa only [mem_resolvent_set_iff, ←not_mem_iff, zero_not_mem_iff] using a.is_unit

lemma ne_zero_of_mem_of_unit {a : Aˣ} {r : R} (hr : r ∈ σ (a : A)) : r ≠ 0 :=
λ hn, (hn ▸ hr) (zero_mem_resolvent_set_of_unit a)

lemma add_mem_iff {a : A} {r s : R} :
  r + s ∈ σ a ↔ r ∈ σ (-↑ₐs + a) :=
by simp only [mem_iff, sub_neg_eq_add, ←sub_sub, map_add]

lemma add_mem_add_iff {a : A} {r s : R} :
  r + s ∈ σ (↑ₐs + a) ↔ r ∈ σ a  :=
by rw [add_mem_iff, neg_add_cancel_left]

lemma smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} :
  r • s ∈ σ (r • a) ↔ s ∈ σ a :=
by simp only [mem_iff, not_iff_not, algebra.algebra_map_eq_smul_one, smul_assoc, ←smul_sub,
  is_unit_smul_iff]

open_locale polynomial

theorem unit_smul_eq_smul (a : A) (r : Rˣ) :
  σ (r • a) = r • σ a :=
begin
  ext,
  have x_eq : x = r • r⁻¹ • x, by simp,
  nth_rewrite 0 x_eq,
  rw smul_mem_smul_iff,
  split,
    { exact λ h, ⟨r⁻¹ • x, ⟨h, by simp⟩⟩},
    { rintros ⟨_, _, x'_eq⟩, simpa [←x'_eq],}
end

-- `r ∈ σ(a*b) ↔ r ∈ σ(b*a)` for any `r : Rˣ`
theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} :
  ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) :=
begin
  have h₁ : ∀ x y : A, is_unit (1 - x * y) → is_unit (1 - y * x),
  { refine λ x y h, ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, _, _⟩, rfl⟩,
    calc (1 - y * x) * (1 + y * (is_unit.unit h).inv * x)
        = (1 - y * x) + y * ((1 - x * y) * h.unit.inv) * x : by noncomm_ring
    ... = 1 : by simp only [units.inv_eq_coe_inv, is_unit.mul_coe_inv, mul_one, sub_add_cancel],
    calc (1 + y * (is_unit.unit h).inv * x) * (1 - y * x)
        = (1 - y * x) + y * (h.unit.inv * (1 - x * y)) * x : by noncomm_ring
    ... = 1 : by simp only [units.inv_eq_coe_inv, is_unit.coe_inv_mul, mul_one, sub_add_cancel]},
  simpa only [mem_iff, not_iff_not, algebra.algebra_map_eq_smul_one, ←units.smul_def,
    is_unit.smul_sub_iff_sub_inv_smul, ←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a]
    using iff.intro (h₁ (r⁻¹ • a) b) (h₁ b (r⁻¹ • a)),
end

theorem preimage_units_mul_eq_swap_mul {a b : A} :
  (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹'  σ (b * a) :=
set.ext $ λ _, unit_mem_mul_iff_mem_swap_mul

section star

variables [has_involutive_star R] [star_ring A] [star_module R A]

lemma star_mem_resolvent_set_iff {r : R} {a : A} :
  star r ∈ resolvent_set R a ↔ r ∈ resolvent_set R (star a) :=
by refine ⟨λ h, _, λ h, _⟩;
  simpa only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, star_sub, star_smul,
    star_star, star_one] using is_unit.star h

protected lemma map_star (a : A) : σ (star a) = star (σ a) :=
by { ext, simpa only [set.mem_star, mem_iff, not_iff_not] using star_mem_resolvent_set_iff.symm }

end star

end scalar_semiring

section scalar_ring

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

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

-- it would be nice to state this for `subalgebra_class`, but we don't have such a thing yet
lemma subset_subalgebra {S : subalgebra R A} (a : S) : spectrum R (a : A) ⊆ spectrum R a :=
compl_subset_compl.2 (λ _, is_unit.map S.val)

-- this is why it would be nice if `subset_subalgebra` was registered for `subalgebra_class`.
lemma subset_star_subalgebra [star_ring R] [star_ring A] [star_module R A] {S : star_subalgebra R A}
  (a : S) : spectrum R (a : A) ⊆ spectrum R a :=
compl_subset_compl.2 (λ _, is_unit.map S.subtype)

lemma singleton_add_eq (a : A) (r : R) : {r} + (σ a) = σ (↑ₐr + a) :=
ext $ λ x,
  by rw [singleton_add, image_add_left, mem_preimage, add_comm, add_mem_iff, map_neg, neg_neg]

lemma add_singleton_eq (a : A) (r : R) : (σ a) + {r} = σ (a + ↑ₐr) :=
add_comm {r} (σ a) ▸ add_comm (algebra_map R A r) a ▸ singleton_add_eq a r

lemma vadd_eq (a : A) (r : R) : r +ᵥ (σ a) = σ (↑ₐr + a) :=
(singleton_add).symm.trans $ singleton_add_eq a r

lemma neg_eq (a : A) : -(σ a) = σ (-a) :=
set.ext $ λ x, by simp only [mem_neg, mem_iff, map_neg, ←neg_add', is_unit.neg_iff, sub_neg_eq_add]

lemma singleton_sub_eq (a : A) (r : R) :
  {r} - (σ a) = σ (↑ₐr - a) :=
by rw [sub_eq_add_neg, neg_eq, singleton_add_eq, sub_eq_add_neg]

lemma sub_singleton_eq (a : A) (r : R) :
  (σ a) - {r} = σ (a - ↑ₐr) :=
by simpa only [neg_sub, neg_eq] using congr_arg has_neg.neg (singleton_sub_eq a r)

open polynomial

lemma exists_mem_of_not_is_unit_aeval_prod [is_domain R] {p : R[X]} {a : A} (hp : p ≠ 0)
  (h : ¬is_unit (aeval a (multiset.map (λ (x : R), X - C x) p.roots).prod)) :
  ∃ k : R, k ∈ σ a ∧ eval k p = 0 :=
begin
  rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h,
  replace h := mt list.prod_is_unit h,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h,
  rcases h with ⟨r, r_mem, r_nu⟩,
  exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩
end

end scalar_ring

section scalar_field

variables {𝕜 : Type u} {A : Type v}
variables [field 𝕜] [ring A] [algebra 𝕜 A]

local notation `σ` := spectrum 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

/-- Without the assumption `nontrivial A`, then `0 : A` would be invertible. -/
@[simp] lemma zero_eq [nontrivial A] : σ (0 : A) = {0} :=
begin
  refine set.subset.antisymm _ (by simp [algebra.algebra_map_eq_smul_one, mem_iff]),
  rw [spectrum, set.compl_subset_comm],
  intros k hk,
  rw set.mem_compl_singleton_iff at hk,
  have : is_unit (units.mk0 k hk • (1 : A)) := is_unit.smul (units.mk0 k hk) is_unit_one,
  simpa [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one]
end

@[simp] theorem scalar_eq [nontrivial A] (k : 𝕜) : σ (↑ₐk) = {k} :=
by rw [←add_zero (↑ₐk), ←singleton_add_eq, zero_eq, set.singleton_add_singleton, add_zero]

@[simp] lemma one_eq [nontrivial A] : σ (1 : A) = {1} :=
calc σ (1 : A) = σ (↑ₐ1) : by rw [algebra.algebra_map_eq_smul_one, one_smul]
  ...          = {1}     : scalar_eq 1

/-- the assumption `(σ a).nonempty` is necessary and cannot be removed without
    further conditions on the algebra `A` and scalar field `𝕜`. -/
theorem smul_eq_smul [nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).nonempty) :
  σ (k • a) = k • (σ a) :=
begin
  rcases eq_or_ne k 0 with rfl | h,
  { simpa [ha, zero_smul_set] },
  { exact unit_smul_eq_smul a (units.mk0 k h) },
end

theorem nonzero_mul_eq_swap_mul (a b : A) : σ (a * b) \ {0} = σ (b * a) \ {0} :=
begin
  suffices h : ∀ (x y : A), σ (x * y) \ {0} ⊆ σ (y * x) \ {0},
  { exact set.eq_of_subset_of_subset (h a b) (h b a) },
  { rintros _ _ k ⟨k_mem, k_neq⟩,
    change k with ↑(units.mk0 k k_neq) at k_mem,
    exact ⟨unit_mem_mul_iff_mem_swap_mul.mp k_mem, k_neq⟩ },
end

protected lemma map_inv (a : Aˣ) : (σ (a : A))⁻¹ = σ (↑a⁻¹ : A) :=
begin
  refine set.eq_of_subset_of_subset (λ k hk, _) (λ k hk, _),
  { rw set.mem_inv at hk,
    have : k ≠ 0,
    { simpa only [inv_inv] using inv_ne_zero (ne_zero_of_mem_of_unit hk), },
    lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr this,
    rw ←units.coe_inv k at hk,
    exact inv_mem_iff.mp hk },
  { lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr (ne_zero_of_mem_of_unit hk),
    simpa only [units.coe_inv] using inv_mem_iff.mp hk, }
end

open polynomial
/-- Half of the spectral mapping theorem for polynomials. We prove it separately
because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/

/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
  (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/
  refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p),
  /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/
  have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)),
  have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt
    (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]),
  have lead_ne := leading_coeff_ne_zero.mpr h_ne,
  have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit,
  /- leading coefficient is a unit so product of linear factors is not a unit;
  apply `exists_mem_of_not_is_unit_aeval_prod`. -/
  have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p,
    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
  rw [mem_iff, ←p_a_eq, hprod, aeval_mul,
    ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk,
  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit),
  rcases hk with ⟨r, r_mem, r_ev⟩,
  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩,
end

/-- In this version of the spectral mapping theorem, we assume the spectrum
is nonempty instead of assuming the degree of the polynomial is positive. -/
theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
  (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  nontriviality A,
  refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p),
  { rw eq_C_of_degree_le_zero h,
    simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] },
end

/-- A specialization of `spectrum.subset_polynomial_aeval` to monic monomials for convenience. -/
lemma pow_image_subset (a : A) (n : ℕ) : (λ x, x ^ n) '' (σ a) ⊆ σ (a ^ n) :=
by simpa only [eval_pow, eval_X, aeval_X_pow] using subset_polynomial_aeval a (X ^ n : 𝕜[X])

/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
convenience. -/
lemma map_pow_of_pos [is_alg_closed 𝕜] (a : A) {n : ℕ} (hn : 0 < n) :
  σ (a ^ n) = (λ x, x ^ n) '' (σ a) :=
by simpa only [aeval_X_pow, eval_pow, eval_X] using
  map_polynomial_aeval_of_degree_pos a (X ^ n : 𝕜[X]) (by { rw_mod_cast degree_X_pow, exact hn })

/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
convenience. -/
lemma map_pow_of_nonempty [is_alg_closed 𝕜] {a : A} (ha : (σ a).nonempty) (n : ℕ) :
  σ (a ^ n) = (λ x, x ^ n) '' (σ a) :=
by simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval_of_nonempty a (X ^ n) ha

variable (𝕜)
/--
Every element `a` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `𝕜` has non-empty spectrum. -/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜]
  [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) :
  ∃ k : 𝕜, k ∈ σ a :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a,
  have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu,
  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu,
  exact ⟨k, hk⟩
end

end scalar_field

end spectrum

namespace alg_hom

section comm_semiring

variables {F R A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B]
variables [alg_hom_class F R A B]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_resolvent_set_apply (φ : F) {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  r ∈ resolvent_set R ((φ : A → B) a) :=
by simpa only [map_sub, alg_hom_class.commutes] using h.map φ

lemma spectrum_apply_subset (φ : F) (a : A) : σ ((φ : A → B) a) ⊆ σ a :=
λ _, mt (mem_resolvent_set_apply φ)

end comm_semiring

section comm_ring

variables {F R A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B]
variables [alg_hom_class F R A R]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma apply_mem_spectrum [nontrivial R] (φ : F) (a : A) : φ a ∈ σ a :=
begin
  have h : ↑ₐ(φ a) - a ∈ (φ : A →+* R).ker,
  { simp only [ring_hom.mem_ker, map_sub, ring_hom.coe_coe, alg_hom_class.commutes,
      algebra.id.map_eq_id, ring_hom.id_apply, sub_self], },
  simp only [spectrum.mem_iff, ←mem_nonunits_iff, coe_subset_nonunits ((φ : A →+* R).ker_ne_top) h],
end

end comm_ring

end alg_hom


import data.real.basic
import data.nat.basic
variables (x y : ℝ)

example (A B : Prop) : (¬ A) ∨ (B) ↔ (A ∧ B) ∨ (¬ A) :=
begin
split,
intro h,
cases h with ha hab,
right,
exact ha,
by_cases h:A,
left,
split,
exact h,
exact hab,
right,
exact h,
intro h,
by_cases ha:A,
right,
cases h with h₁ h₂,
cases h₁ with h₃ h₄,
exact h₄,
exfalso,
apply h₂,
exact ha,
left,
exact ha,
end

theorem de_morgan1 (A B : Prop) : ¬ (A∨B) ↔ (¬A) ∧ (¬B) :=
begin
split, --We consider each implication separately
intro h₁, --We introduce ¬(A ∨ B) as the hypothesis h₁
split, --Instead of showing ¬A ∧ ¬B, we will show ¬A and ¬B separately
intro h₂, --The goal ¬A changes to false, and we the hypothesis h₂:A
apply h₁,
left,
exact h₂,
intro h₂,
apply h₁,
right,
exact h₂,
intros h₁ h₂,
cases h₁ with h₃ h₄,
cases h₂ with h₅ h₆,
apply h₃,
exact h₅,
apply h₄,
exact h₆,
end

theorem de_morgan2 (A B : Prop) : ¬(A∧B) ↔ (¬A)∨(¬B):=
begin
split,
intro h₁,
by_cases h:A,
right,
intro h₂,
apply h₁,
split,
exact h,
exact h₂,
left,
exact h,
intros h₁ h₂,
cases h₂ with h₃ h₄,
cases h₁ with h₅ h₆,
apply h₅,
exact h₃,
apply h₆,
apply h₄,
end

theorem lawofcomm (A B : Prop) : A∧B ↔ B∧A:=
begin
split, --We consider the separate implications ⊢ A ∧ B → B ∧ A and ⊢B ∧ A → A ∧ B
intro h₁, --This lets us consider the hypothesis A ∧ B
cases h₁ with h₂ h₃, -- h₁:A ∧ B changes to h₂:A and h₃:B
split,--Instead of showing B ∧ A we show B and A separately
exact h₃,
exact h₂,
intro h₁,
cases h₁ with h₂ h₃,
split,
exact h₃,
exact h₂,
end

theorem lawofcomm (A B : Prop) : A∧B ↔ B∧A:=
begin
split, --We consider the separate implications ⊢ A ∧ B → B ∧ A and ⊢B ∧ A → A ∧ B
iterate 2
{intro h₁, --This lets us consider the hypothesis A ∧ B
cases h₁ with h₂ h₃, -- h₁:A ∧ B changes to h₂:A and h₃:B
split,--Instead of showing B ∧ A we show B and A separately
exact h₃,
exact h₂,},
end

theorem lawofassoc (A B C : Prop) : A∧(B∧C) ↔ (A∧B)∧C:=
begin
split,
intro h₁,
split,
cases h₁ with h₂ h₃,
cases h₃ with h₄ h₅,
split,
exact h₂,
exact h₄,
cases h₁ with h₂ h₃,
cases h₃ with h₄ h₅,
exact h₅,
intro h₁,
split,
cases h₁ with h₂ h₃,
cases h₂ with h₄ h₅,
exact h₄,
cases h₁ with h₂ h₃,
cases h₂ with h₄ h₅,
split,
exact h₅,
exact h₃,
end

theorem lawofdist (A B C : Prop) : A∧(B∨C) ↔ (A∧B)∨(A∧C):=
begin
split,
intro h₁,
cases h₁ with h₂ h₃,
cases h₃ with h₄ h₅,
left,
split,
exact h₂,
exact h₄,
right,
split,
exact h₂,
exact h₅,
intro h₁,
cases h₁ with h₂ h₃,
cases h₂ with h₄ h₅,
split,
exact h₄,
left,
exact h₅,
split,
cases h₃ with h₄ h₅,
exact h₄,
cases h₃ with h₄ h₅,
right,
exact h₅,
end

example (n: nat)  (h:x>0) : (1+x)^n ≥ 1 + x*n :=
begin
  induction n with d hd,
  norm_num,
  have h₁:d.succ = ↑d+1,
  norm_num,
  rw h₁,
  norm_num,
  rw mul_add,
  rw pow_succ,
  rw add_mul,
  rw ← add_assoc,
  rw one_mul,
  rw mul_one,
  norm_num at hd,
  apply add_le_add hd,
  nth_rewrite 0 ← mul_one x,
  apply mul_le_mul,
  clear hd,
  refl,
  clear hd,
  induction d with d hd,
  simp[pow_zero,pow_succ],
  nth_rewrite 0 ← mul_one (1:ℝ),
  apply mul_le_mul,
  linarith,
  finish,
  repeat{linarith},

end

example {x : ℝ} {n : ℕ} (h : 0 < x) : 1 + x * n ≤ (1 + x) ^ n :=
begin
  induction n with n hn,
  { norm_num },
  { change n.succ with n + 1, norm_num,
    simp [pow_succ, mul_add, ←add_assoc, add_mul],
    apply add_le_add hn, clear hn, nth_rewrite 0 ←mul_one x,
    apply mul_le_mul; try {linarith},
    induction n with n hn; simp [pow_zero, pow_succ],
    nth_rewrite 0 ←mul_one (1 : ℝ), apply mul_le_mul; linarith },
end


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lu-Ming Zhang
-/
import linear_algebra.matrix.symmetric

/-!
# Circulant matrices

This file contains the definition and basic results about circulant matrices.
Given a vector `v : n → α` indexed by a type that is endowed with subtraction,
`matrix.circulant v` is the matrix whose `(i, j)`th entry is `v (i - j)`.

## Main results

- `matrix.circulant`: the circulant matrix generated by a given vector `v : n → α`.
- `matrix.circulant_mul`: the product of two circulant matrices `circulant v` and `circulant w` is
                          the circulant matrix generated by `mul_vec (circulant v) w`.
- `matrix.circulant_mul_comm`: multiplication of circulant matrices commutes when the elements do.

## Implementation notes

`matrix.fin.foo` is the `fin n` version of `matrix.foo`.
Namely, the index type of the circulant matrices in discussion is `fin n`.

## Tags

circulant, matrix
-/

variables {α β m n R : Type*}

namespace matrix

open function
open_locale matrix big_operators

/-- Given the condition `[has_sub n]` and a vector `v : n → α`,
    we define `circulant v` to be the circulant matrix generated by `v` of type `matrix n n α`.
    The `(i,j)`th entry is defined to be `v (i - j)`. -/
@[simp]
def circulant [has_sub n] (v : n → α) : matrix n n α
| i j := v (i - j)

lemma circulant_col_zero_eq [add_group n] (v : n → α) (i : n) : circulant v i 0 = v i :=
congr_arg v (sub_zero _)

lemma circulant_injective [add_group n] : injective (circulant : (n → α) → matrix n n α) :=
begin
  intros v w h,
  ext k,
  rw [← circulant_col_zero_eq v, ← circulant_col_zero_eq w, h]
end

lemma fin.circulant_injective : ∀ n, injective (λ v : fin n → α, circulant v)
| 0     := dec_trivial
| (n+1) := circulant_injective

@[simp] lemma circulant_inj [add_group n] {v w : n → α} :
  circulant v = circulant w ↔ v = w :=
circulant_injective.eq_iff

@[simp] lemma fin.circulant_inj {n} {v w : fin n → α} :
  circulant v = circulant w ↔ v = w :=
(fin.circulant_injective n).eq_iff

lemma transpose_circulant [add_group n] (v : n → α) :
  (circulant v)ᵀ = circulant (λ i, v (-i)) :=
by ext; simp

lemma conj_transpose_circulant [has_star α] [add_group n] (v : n → α) :
  (circulant v)ᴴ = circulant (star (λ i, v (-i))) :=
by ext; simp

lemma fin.transpose_circulant : ∀ {n} (v : fin n → α), (circulant v)ᵀ =  circulant (λ i, v (-i))
| 0     := dec_trivial
| (n+1) := transpose_circulant

lemma fin.conj_transpose_circulant [has_star α] :
  ∀ {n} (v : fin n → α), (circulant v)ᴴ = circulant (star (λ i, v (-i)))
| 0     := dec_trivial
| (n+1) := conj_transpose_circulant

lemma map_circulant [has_sub n] (v : n → α) (f : α → β) :
  (circulant v).map f = circulant (λ i, f (v i)) :=
ext $ λ _ _, rfl

lemma circulant_neg [has_neg α] [has_sub n] (v : n → α) :
  circulant (- v) = - circulant v :=
ext $ λ _ _, rfl

@[simp] lemma circulant_zero (α n) [has_zero α] [has_sub n] :
  circulant 0 = (0 : matrix n n α) :=
ext $ λ _ _, rfl

lemma circulant_add [has_add α] [has_sub n] (v w : n → α) :
  circulant (v + w) = circulant v + circulant w :=
ext $ λ _ _, rfl

lemma circulant_sub [has_sub α] [has_sub n] (v w : n → α) :
  circulant (v - w) = circulant v - circulant w :=
ext $ λ _ _, rfl

/-- The product of two circulant matrices `circulant v` and `circulant w` is
    the circulant matrix generated by `mul_vec (circulant v) w`. -/
lemma circulant_mul [semiring α] [fintype n] [add_group n] (v w : n → α) :
  circulant v ⬝ circulant w = circulant (mul_vec (circulant v) w) :=
begin
  ext i j,
  simp only [mul_apply, mul_vec, circulant, dot_product],
  refine fintype.sum_equiv (equiv.sub_right j) _ _ _,
  intro x,
  simp only [equiv.sub_right_apply, sub_sub_sub_cancel_right],
end

lemma fin.circulant_mul [semiring α] :
  ∀ {n} (v w : fin n → α), circulant v ⬝ circulant w = circulant (mul_vec (circulant v) w)
| 0     := dec_trivial
| (n+1) := circulant_mul

/-- Multiplication of circulant matrices commutes when the elements do. -/
lemma circulant_mul_comm
  [comm_semigroup α] [add_comm_monoid α] [fintype n] [add_comm_group n] (v w : n → α) :
  circulant v ⬝ circulant w = circulant w ⬝ circulant v :=
begin
  ext i j,
  simp only [mul_apply, circulant, mul_comm],
  refine fintype.sum_equiv ((equiv.sub_left i).trans (equiv.add_right j)) _ _ _,
  intro x,
  congr' 2,
  { simp },
  { simp only [equiv.coe_add_right, function.comp_app,
               equiv.coe_trans, equiv.sub_left_apply],
    abel }
end

lemma fin.circulant_mul_comm [comm_semigroup α] [add_comm_monoid α] :
  ∀ {n} (v w : fin n → α), circulant v ⬝ circulant w = circulant w ⬝ circulant v
| 0     := dec_trivial
| (n+1) := circulant_mul_comm

/-- `k • circulant v` is another circulant matrix `circulant (k • v)`. -/
lemma circulant_smul [has_sub n] [has_scalar R α] (k : R) (v : n → α) :
  circulant (k • v) = k • circulant v :=
by ext; simp

@[simp] lemma circulant_single_one
  (α n) [has_zero α] [has_one α] [decidable_eq n] [add_group n] :
  circulant (pi.single 0 1 : n → α) = (1 : matrix n n α) :=
by { ext i j, simp [one_apply, pi.single_apply, sub_eq_zero] }

@[simp] lemma circulant_single
  (n) [semiring α] [decidable_eq n] [add_group n] [fintype n] (a : α) :
  circulant (pi.single 0 a : n → α) = scalar n a :=
begin
  ext i j,
  simp [pi.single_apply, one_apply, sub_eq_zero],
end

/-- Note we use `↑i = 0` instead of `i = 0` as `fin 0` has no `0`.
This means that we cannot state this with `pi.single` as we did with `matrix.circulant_single`. -/
lemma fin.circulant_ite (α) [has_zero α] [has_one α] :
  ∀ n, circulant (λ i, ite (↑i = 0) 1 0 : fin n → α) = 1
| 0     := dec_trivial
| (n+1) :=
begin
  rw [←circulant_single_one],
  congr' with j,
  simp only [pi.single_apply, fin.ext_iff],
  congr
end

/-- A circulant of `v` is symmetric iff `v` equals its reverse. -/
lemma circulant_is_symm_iff [add_group n] {v : n → α} :
  (circulant v).is_symm ↔ ∀ i, v (- i) = v i :=
by rw [is_symm, transpose_circulant, circulant_inj, funext_iff]

lemma fin.circulant_is_symm_iff :
  ∀ {n} {v : fin n → α}, (circulant v).is_symm ↔ ∀ i, v (- i) = v i
| 0     := λ v, by simp [is_symm.ext_iff, is_empty.forall_iff]
| (n+1) := λ v, circulant_is_symm_iff

/-- If `circulant v` is symmetric, `∀ i j : I, v (- i) = v i`. -/
lemma circulant_is_symm_apply [add_group n] {v : n → α} (h : (circulant v).is_symm) (i : n) :
  v (-i) = v i :=
circulant_is_symm_iff.1 h i

lemma fin.circulant_is_symm_apply {n} {v : fin n → α} (h : (circulant v).is_symm) (i : fin n) :
  v (-i) = v i :=
fin.circulant_is_symm_iff.1 h i

end matrix


import data.nat.choose.vandermonde
--import multinomial

section combinatorics

/-- Number of possibilities of choosing m groups of n-element subsets out of mn elements -/
def mchoose (m n : ℕ) : ℕ :=
finset.prod (finset.range m) (λ p, nat.choose (p * n + n - 1) (n - 1))

lemma mchoose_zero (n : ℕ) : mchoose 0 n = 1 :=
by rw [mchoose, finset.range_zero, finset.prod_empty]

lemma mchoose_zero' (m : ℕ) : mchoose m 0 = 1 :=
by simp only [mchoose, mul_zero, nat.choose_self, finset.prod_const_one]

lemma mchoose_succ (m n : ℕ) :
  mchoose (m + 1) n = (nat.choose (m * n + n - 1) (n - 1)) * (mchoose m n) :=
by simp only [mchoose, finset.prod_range_succ, mul_comm]

lemma mchoose_lemma (m : ℕ) {n : ℕ} (hn : n ≠ 0) :
  (m.factorial) * (n.factorial)^m * (mchoose m n) = (m * n).factorial :=
begin
  rw ← zero_lt_iff at hn,
  induction m with m ih,
  { rw [mchoose_zero, mul_one, zero_mul, nat.factorial_zero, pow_zero, mul_one] },
  { have hmn : (m + 1) * (m * n + n - 1).choose (n - 1) = (m * n + n).choose n,
    { rw [← mul_left_inj' (nat.mul_ne_zero (nat.factorial_ne_zero (m * n)) (nat.factorial_ne_zero n)),
        ← mul_assoc, ← mul_assoc, nat.add_choose_mul_factorial_mul_factorial,
        ← nat.mul_factorial_pred hn, mul_comm n _, ← mul_assoc, nat.add_sub_assoc hn (m * n),
        mul_comm,mul_assoc ((m + 1) * (m * n + (n - 1)).choose (n - 1)), mul_assoc (m + 1),
        ← mul_assoc ((m * n + (n - 1)).choose (n - 1)), nat.add_choose_mul_factorial_mul_factorial,
        ← nat.mul_factorial_pred  (nat.add_pos_right _ hn), ← nat.add_sub_assoc hn (m * n)],
      ring, },
    rw [mchoose_succ, nat.factorial_succ, pow_succ, ← mul_assoc],
    conv_rhs { rw nat.succ_mul},
    rw [← nat.add_choose_mul_factorial_mul_factorial, ← ih, ← hmn],
    ring_nf, }
end

end combinatorics


/-
Copyright (c) 2021 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang
-/
import analysis.special_functions.integrals

/-! # The Wallis formula for Pi

This file establishes the Wallis product for `π` (`real.tendsto_prod_pi_div_two`). Our proof is
largely about analyzing the behaviour of the sequence `∫ x in 0..π, sin x ^ n` as `n → ∞`.
See: https://en.wikipedia.org/wiki/Wallis_product

The proof can be broken down into two pieces. The first step (carried out in
`analysis.special_functions.integrals`) is to use repeated integration by parts to obtain an
explicit formula for this integral, which is rational if `n` is odd and a rational multiple of `π`
if `n` is even.

The second step, carried out here, is to estimate the ratio
`∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k)` and prove that
it converges to one using the squeeze theorem. The final product for `π` is obtained after some
algebraic manipulation.

## Main statements

* `real.wallis.W`: the product of the first `k` terms in Wallis' formula for `π`.
* `real.wallis.W_eq_integral_sin_pow_div_integral_sin_pow`: express `W n` as a ratio of integrals.
* `real.wallis.W_le` and `real.wallis.le_W`: upper and lower bounds for `W n`.
* `real.tendsto_prod_pi_div_two`: the Wallis product formula.
 -/

open_locale real topology big_operators nat
open filter finset interval_integral

namespace real

namespace wallis

/-- The product of the first `k` terms in Wallis' formula for `π`. -/
noncomputable def W (k : ℕ) : ℝ :=
∏ i in range k, (2 * i + 2) / (2 * i + 1) * ((2 * i + 2) / (2 * i + 3))

lemma W_succ (k : ℕ) :
  W (k + 1) = W k * ((2 * k + 2) / (2 * k + 1) * ((2 * k + 2) / (2 * k + 3))) :=
prod_range_succ _ _

lemma W_pos (k : ℕ) : 0 < W k :=
begin
  induction k with k hk,
  { unfold W, simp },
  { rw W_succ,
    refine mul_pos hk (mul_pos (div_pos _ _) (div_pos _ _));
    positivity }
end

lemma W_eq_factorial_ratio (n : ℕ) :
  W n = (2 ^ (4 * n) * n! ^ 4) / ((2 * n)!^ 2 * (2 * n + 1)) :=
begin
  induction n with n IH,
  { simp only [W, prod_range_zero, nat.factorial_zero, mul_zero, pow_zero, algebra_map.coe_one,
      one_pow, mul_one, algebra_map.coe_zero, zero_add, div_self, ne.def, one_ne_zero,
      not_false_iff] },
  { unfold W at ⊢ IH,
    rw [prod_range_succ, IH, _root_.div_mul_div_comm, _root_.div_mul_div_comm],
    refine (div_eq_div_iff _ _).mpr _,
    any_goals { exact ne_of_gt (by positivity) },
    simp_rw [nat.mul_succ, nat.factorial_succ, pow_succ],
    push_cast,
    ring_nf }
end

lemma W_eq_integral_sin_pow_div_integral_sin_pow (k : ℕ) :
  (π/2)⁻¹ * W k = (∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1)) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k) :=
begin
  rw [integral_sin_pow_even, integral_sin_pow_odd, mul_div_mul_comm, ←prod_div_distrib, inv_div],
  simp_rw [div_div_div_comm, div_div_eq_mul_div, mul_div_assoc],
  refl,
end

lemma W_le (k : ℕ) : W k ≤ π / 2 :=
begin
  rw [←div_le_one pi_div_two_pos, div_eq_inv_mul],
  rw [W_eq_integral_sin_pow_div_integral_sin_pow, div_le_one (integral_sin_pow_pos _)],
  apply integral_sin_pow_succ_le,
end

lemma le_W (k : ℕ) : ((2:ℝ) * k + 1) / (2 * k + 2) * (π / 2) ≤ W k :=
begin
  rw [←le_div_iff pi_div_two_pos, div_eq_inv_mul (W k) _],
  rw [W_eq_integral_sin_pow_div_integral_sin_pow, le_div_iff (integral_sin_pow_pos _)],
  convert integral_sin_pow_succ_le (2 * k + 1),
  rw integral_sin_pow (2 * k),
  simp only [sin_zero, zero_pow', ne.def, nat.succ_ne_zero, not_false_iff, zero_mul, sin_pi,
    tsub_zero, nat.cast_mul, nat.cast_bit0, algebra_map.coe_one, zero_div, zero_add],
end

lemma tendsto_W_nhds_pi_div_two : tendsto W at_top (𝓝 $ π / 2) :=
begin
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le _ tendsto_const_nhds le_W W_le,
  have : 𝓝 (π / 2) = 𝓝 ((1 - 0) * (π / 2)), by rw [sub_zero, one_mul], rw this,
  refine tendsto.mul _ tendsto_const_nhds,
  have h : ∀ (n:ℕ), ((2:ℝ) * n + 1) / (2 * n + 2) = 1 - 1 / (2 * n + 2),
  { intro n,
    rw [sub_div' _ _ _ (ne_of_gt (add_pos_of_nonneg_of_pos
      (mul_nonneg ((two_pos : 0 < (2:ℝ)).le) (nat.cast_nonneg _)) two_pos)), one_mul],
    congr' 1, ring },
  simp_rw h,
  refine (tendsto_const_nhds.div_at_top _).const_sub _,
  refine tendsto.at_top_add _ tendsto_const_nhds,
  exact tendsto_coe_nat_at_top_at_top.const_mul_at_top two_pos
end

end wallis

end real

/-- Wallis' product formula for `π / 2`. -/
theorem real.tendsto_prod_pi_div_two :
  tendsto
  (λ k, ∏ i in range k, (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3)))
  at_top (𝓝 (π/2)) :=
real.wallis.tendsto_W_nhds_pi_div_two