/-
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.algebra.spectrum
import analysis.special_functions.pow
import analysis.complex.liouville
import analysis.complex.polynomial
import analysis.analytic.radius_liminf
import topology.algebra.module.character_space
import analysis.normed_space.exponential
/-!
# The spectrum of elements in a complete normed algebra

This file contains the basic theory for the resolvent and spectrum of a Banach algebra.

## Main definitions

* `spectral_radius : ℝ≥0∞`: supremum of `‖k‖₊` for all `k ∈ spectrum 𝕜 a`
* `normed_ring.alg_equiv_complex_of_complete`: **Gelfand-Mazur theorem** For a complex
  Banach division algebra, the natural `algebra_map ℂ A` is an algebra isomorphism whose inverse
  is given by selecting the (unique) element of `spectrum ℂ a`

## Main statements

* `spectrum.is_open_resolvent_set`: the resolvent set is open.
* `spectrum.is_closed`: the spectrum is closed.
* `spectrum.subset_closed_ball_norm`: the spectrum is a subset of closed disk of radius
  equal to the norm.
* `spectrum.is_compact`: the spectrum is compact.
* `spectrum.spectral_radius_le_nnnorm`: the spectral radius is bounded above by the norm.
* `spectrum.has_deriv_at_resolvent`: the resolvent function is differentiable on the resolvent set.
* `spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius`: Gelfand's formula for the
  spectral radius in Banach algebras over `ℂ`.
* `spectrum.nonempty`: the spectrum of any element in a complex Banach algebra is nonempty.

## TODO

* compute all derivatives of `resolvent a`.

-/

open_locale ennreal nnreal

/-- The *spectral radius* is the supremum of the `nnnorm` (`‖⬝‖₊`) of elements in the spectrum,
    coerced into an element of `ℝ≥0∞`. Note that it is possible for `spectrum 𝕜 a = ∅`. In this
    case, `spectral_radius a = 0`.  It is also possible that `spectrum 𝕜 a` be unbounded (though
    not for Banach algebras, see `spectrum.is_bounded`, below).  In this case,
    `spectral_radius a = ∞`. -/
noncomputable def spectral_radius (𝕜 : Type*) {A : Type*} [normed_field 𝕜] [ring A]
  [algebra 𝕜 A] (a : A) : ℝ≥0∞ :=
⨆ k ∈ spectrum 𝕜 a, ‖k‖₊

variables {𝕜 : Type*} {A : Type*}

namespace spectrum

section spectrum_compact

open filter

variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A]

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

@[simp] lemma spectral_radius.of_subsingleton [subsingleton A] (a : A) :
  spectral_radius 𝕜 a = 0 :=
by simp [spectral_radius]

@[simp] lemma spectral_radius_zero : spectral_radius 𝕜 (0 : A) = 0 :=
by { nontriviality A, simp [spectral_radius] }

lemma mem_resolvent_set_of_spectral_radius_lt {a : A} {k : 𝕜} (h : spectral_radius 𝕜 a < ‖k‖₊) :
  k ∈ ρ a :=
not_not.mp $ λ hn, h.not_le $ le_supr₂ k hn

variable [complete_space A]

lemma is_open_resolvent_set (a : A) : is_open (ρ a) :=
units.is_open.preimage ((continuous_algebra_map 𝕜 A).sub continuous_const)

protected lemma is_closed (a : A) : is_closed (σ a) :=
(is_open_resolvent_set a).is_closed_compl

lemma mem_resolvent_set_of_norm_lt_mul {a : A} {k : 𝕜} (h : ‖a‖ * ‖(1 : A)‖ < ‖k‖) :
  k ∈ ρ a :=
begin
  rw [resolvent_set, set.mem_set_of_eq, algebra.algebra_map_eq_smul_one],
  nontriviality A,
  have hk : k ≠ 0,
    from ne_zero_of_norm_ne_zero ((mul_nonneg (norm_nonneg _) (norm_nonneg _)).trans_lt h).ne',
  let ku := units.map (↑ₐ).to_monoid_hom (units.mk0 k hk),
  rw [←inv_inv (‖(1 : A)‖), mul_inv_lt_iff (inv_pos.2 $ norm_pos_iff.2 (one_ne_zero : (1 : A) ≠ 0))]
    at h,
  have hku : ‖-a‖ < ‖(↑ku⁻¹:A)‖⁻¹ := by simpa [ku, norm_algebra_map] using h,
  simpa [ku, sub_eq_add_neg, algebra.algebra_map_eq_smul_one] using (ku.add (-a) hku).is_unit,
end

lemma mem_resolvent_set_of_norm_lt [norm_one_class A] {a : A} {k : 𝕜} (h : ‖a‖ < ‖k‖) :
  k ∈ ρ a :=
mem_resolvent_set_of_norm_lt_mul (by rwa [norm_one, mul_one])

lemma norm_le_norm_mul_of_mem {a : A} {k : 𝕜} (hk : k ∈ σ a) :
  ‖k‖ ≤ ‖a‖ * ‖(1 : A)‖ :=
le_of_not_lt $ mt mem_resolvent_set_of_norm_lt_mul hk

lemma norm_le_norm_of_mem [norm_one_class A] {a : A} {k : 𝕜} (hk : k ∈ σ a) :
  ‖k‖ ≤ ‖a‖ :=
le_of_not_lt $ mt mem_resolvent_set_of_norm_lt hk

lemma subset_closed_ball_norm_mul (a : A) :
  σ a ⊆ metric.closed_ball (0 : 𝕜) (‖a‖ * ‖(1 : A)‖) :=
λ k hk, by simp [norm_le_norm_mul_of_mem hk]

lemma subset_closed_ball_norm [norm_one_class A] (a : A) :
  σ a ⊆ metric.closed_ball (0 : 𝕜) (‖a‖) :=
λ k hk, by simp [norm_le_norm_of_mem hk]

lemma is_bounded (a : A) : metric.bounded (σ a) :=
(metric.bounded_iff_subset_ball 0).mpr ⟨‖a‖ * ‖(1 : A)‖, subset_closed_ball_norm_mul a⟩

protected theorem is_compact [proper_space 𝕜] (a : A) : is_compact (σ a) :=
metric.is_compact_of_is_closed_bounded (spectrum.is_closed a) (is_bounded a)

theorem spectral_radius_le_nnnorm [norm_one_class A] (a : A) :
  spectral_radius 𝕜 a ≤ ‖a‖₊ :=
by { refine supr₂_le (λ k hk, _), exact_mod_cast norm_le_norm_of_mem hk }

lemma exists_nnnorm_eq_spectral_radius_of_nonempty [proper_space 𝕜] {a : A} (ha : (σ a).nonempty) :
  ∃ k ∈ σ a, (‖k‖₊ : ℝ≥0∞) = spectral_radius 𝕜 a :=
begin
  obtain ⟨k, hk, h⟩ := (spectrum.is_compact a).exists_forall_ge ha continuous_nnnorm.continuous_on,
  exact ⟨k, hk, le_antisymm (le_supr₂ k hk) (supr₂_le $ by exact_mod_cast h)⟩,
end

lemma spectral_radius_lt_of_forall_lt_of_nonempty [proper_space 𝕜] {a : A}
  (ha : (σ a).nonempty) {r : ℝ≥0} (hr : ∀ k ∈ σ a, ‖k‖₊ < r) :
  spectral_radius 𝕜 a < r :=
Sup_image.symm.trans_lt $ ((spectrum.is_compact a).Sup_lt_iff_of_continuous ha
  (ennreal.continuous_coe.comp continuous_nnnorm).continuous_on (r : ℝ≥0∞)).mpr
  (by exact_mod_cast hr)

open ennreal polynomial

variable (𝕜)
theorem spectral_radius_le_pow_nnnorm_pow_one_div (a : A) (n : ℕ) :
  spectral_radius 𝕜 a ≤ (‖a ^ (n + 1)‖₊) ^ (1 / (n + 1) : ℝ) * (‖(1 : A)‖₊) ^ (1 / (n + 1) : ℝ) :=
begin
  refine supr₂_le (λ k hk, _),
  /- apply easy direction of the spectral mapping theorem for polynomials -/
  have pow_mem : k ^ (n + 1) ∈ σ (a ^ (n + 1)),
    by simpa only [one_mul, algebra.algebra_map_eq_smul_one, one_smul, aeval_monomial, one_mul,
      eval_monomial] using subset_polynomial_aeval a (monomial (n + 1) (1 : 𝕜)) ⟨k, hk, rfl⟩,
  /- power of the norm is bounded by norm of the power -/
  have nnnorm_pow_le : (↑(‖k‖₊ ^ (n + 1)) : ℝ≥0∞) ≤ ‖a ^ (n + 1)‖₊ * ‖(1 : A)‖₊,
    { simpa only [real.to_nnreal_mul (norm_nonneg _), norm_to_nnreal, nnnorm_pow k (n + 1),
        ennreal.coe_mul] using coe_mono (real.to_nnreal_mono (norm_le_norm_mul_of_mem pow_mem)) },
  /- take (n + 1)ᵗʰ roots and clean up the left-hand side -/
  have hn : 0 < ((n + 1 : ℕ) : ℝ), by exact_mod_cast nat.succ_pos',
  convert monotone_rpow_of_nonneg (one_div_pos.mpr hn).le nnnorm_pow_le,
  erw [coe_pow, ←rpow_nat_cast, ←rpow_mul, mul_one_div_cancel hn.ne', rpow_one],
  rw [nat.cast_succ, ennreal.coe_mul_rpow],
end

theorem spectral_radius_le_liminf_pow_nnnorm_pow_one_div (a : A) :
  spectral_radius 𝕜 a ≤ at_top.liminf (λ n : ℕ, (‖a ^ n‖₊ : ℝ≥0∞) ^ (1 / n : ℝ)) :=
begin
  refine ennreal.le_of_forall_lt_one_mul_le (λ ε hε, _),
  by_cases ε = 0,
  { simp only [h, zero_mul, zero_le'] },
  have hε' : ε⁻¹ ≠ ∞,
    from λ h', h (by simpa only [inv_inv, inv_top] using congr_arg (λ (x : ℝ≥0∞), x⁻¹) h'),
  simp only [ennreal.mul_le_iff_le_inv h (hε.trans_le le_top).ne, mul_comm ε⁻¹,
    liminf_eq_supr_infi_of_nat', ennreal.supr_mul, ennreal.infi_mul hε'],
  rw [←ennreal.inv_lt_inv, inv_one] at hε,
  obtain ⟨N, hN⟩ := eventually_at_top.mp
    (ennreal.eventually_pow_one_div_le (ennreal.coe_ne_top : ↑‖(1 : A)‖₊ ≠ ∞) hε),
  refine (le_trans _ (le_supr _ (N + 1))),
  refine le_infi (λ n, _),
  simp only [←add_assoc],
  refine (spectral_radius_le_pow_nnnorm_pow_one_div 𝕜 a (n + N)).trans _,
  norm_cast,
  exact mul_le_mul_left' (hN (n + N + 1) (by linarith)) _,
end

end spectrum_compact

section resolvent

open filter asymptotics

variables [nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]

local notation `ρ` := resolvent_set 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

theorem has_deriv_at_resolvent {a : A} {k : 𝕜} (hk : k ∈ ρ a) :
  has_deriv_at (resolvent a) (-(resolvent a k) ^ 2) k :=
begin
  have H₁ : has_fderiv_at ring.inverse _ (↑ₐk - a) := has_fderiv_at_ring_inverse hk.unit,
  have H₂ : has_deriv_at (λ k, ↑ₐk - a) 1 k,
  { simpa using (algebra.linear_map 𝕜 A).has_deriv_at.sub_const a },
  simpa [resolvent, sq, hk.unit_spec, ← ring.inverse_unit hk.unit] using H₁.comp_has_deriv_at k H₂,
end

/- TODO: Once there is sufficient API for bornology, we should get a nice filter / asymptotics
version of this, for example: `tendsto (resolvent a) (cobounded 𝕜) (𝓝 0)` or more specifically
`(resolvent a) =O[cobounded 𝕜] (λ z, z⁻¹)`. -/
lemma norm_resolvent_le_forall (a : A) :
  ∀ ε > 0, ∃ R > 0, ∀ z : 𝕜, R ≤ ‖z‖ → ‖resolvent a z‖ ≤ ε :=
begin
  obtain ⟨c, c_pos, hc⟩ := (@normed_ring.inverse_one_sub_norm A _ _).exists_pos,
  rw [is_O_with_iff, eventually_iff, metric.mem_nhds_iff] at hc,
  rcases hc with ⟨δ, δ_pos, hδ⟩,
  simp only [cstar_ring.norm_one, mul_one] at hδ,
  intros ε hε,
  have ha₁ : 0 < ‖a‖ + 1 := lt_of_le_of_lt (norm_nonneg a) (lt_add_one _),
  have min_pos : 0 < min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹),
    from lt_min (mul_pos δ_pos (inv_pos.mpr ha₁)) (mul_pos hε (inv_pos.mpr c_pos)),
  refine ⟨(min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹))⁻¹, inv_pos.mpr min_pos, (λ z hz, _)⟩,
  have hnz : z ≠ 0 := norm_pos_iff.mp (lt_of_lt_of_le (inv_pos.mpr min_pos) hz),
  replace hz := inv_le_of_inv_le min_pos hz,
  rcases (⟨units.mk0 z hnz, units.coe_mk0 hnz⟩ : is_unit z) with ⟨z, rfl⟩,
  have lt_δ : ‖z⁻¹ • a‖ < δ,
  { rw [units.smul_def, norm_smul, units.coe_inv, norm_inv],
    calc ‖(z : 𝕜)‖⁻¹ * ‖a‖ ≤ δ * (‖a‖ + 1)⁻¹ * ‖a‖
        : mul_le_mul_of_nonneg_right (hz.trans (min_le_left _ _)) (norm_nonneg _)
    ...                   < δ
        : by { conv { rw mul_assoc, to_rhs, rw (mul_one δ).symm },
               exact mul_lt_mul_of_pos_left
                 ((inv_mul_lt_iff ha₁).mpr ((mul_one (‖a‖ + 1)).symm ▸ (lt_add_one _))) δ_pos } },
  rw [←inv_smul_smul z (resolvent a (z : 𝕜)), units_smul_resolvent_self, resolvent,
    algebra.algebra_map_eq_smul_one, one_smul, units.smul_def, norm_smul, units.coe_inv, norm_inv],
  calc _ ≤ ε * c⁻¹ * c : mul_le_mul (hz.trans (min_le_right _ _)) (hδ (mem_ball_zero_iff.mpr lt_δ))
                           (norm_nonneg _) (mul_pos hε (inv_pos.mpr c_pos)).le
  ...    = _           : inv_mul_cancel_right₀ c_pos.ne.symm ε,
end

end resolvent

section one_sub_smul

open continuous_multilinear_map ennreal formal_multilinear_series
open_locale nnreal ennreal

variables
[nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A]

variable (𝕜)
/-- In a Banach algebra `A` over a nontrivially normed field `𝕜`, for any `a : A` the
power series with coefficients `a ^ n` represents the function `(1 - z • a)⁻¹` in a disk of
radius `‖a‖₊⁻¹`. -/
lemma has_fpower_series_on_ball_inverse_one_sub_smul [complete_space A] (a : A) :
  has_fpower_series_on_ball (λ z : 𝕜, ring.inverse (1 - z • a))
    (λ n, continuous_multilinear_map.mk_pi_field 𝕜 (fin n) (a ^ n)) 0 (‖a‖₊)⁻¹ :=
{ r_le :=
  begin
    refine le_of_forall_nnreal_lt (λ r hr, le_radius_of_bound_nnreal _ (max 1 ‖(1 : A)‖₊) (λ n, _)),
    rw [←norm_to_nnreal, norm_mk_pi_field, norm_to_nnreal],
    cases n,
    { simp only [le_refl, mul_one, or_true, le_max_iff, pow_zero] },
    { refine le_trans (le_trans (mul_le_mul_right' (nnnorm_pow_le' a n.succ_pos) (r ^ n.succ)) _)
        (le_max_left _ _),
      { by_cases ‖a‖₊ = 0,
        { simp only [h, zero_mul, zero_le', pow_succ], },
        { rw [←coe_inv h, coe_lt_coe, nnreal.lt_inv_iff_mul_lt h] at hr,
          simpa only [←mul_pow, mul_comm] using pow_le_one' hr.le n.succ } } }
  end,
  r_pos := ennreal.inv_pos.mpr coe_ne_top,
  has_sum := λ y hy,
  begin
    have norm_lt : ‖y • a‖ < 1,
    { by_cases h : ‖a‖₊ = 0,
      { simp only [nnnorm_eq_zero.mp h, norm_zero, zero_lt_one, smul_zero] },
      { have nnnorm_lt : ‖y‖₊ < ‖a‖₊⁻¹,
          by simpa only [←coe_inv h, mem_ball_zero_iff, metric.emetric_ball_nnreal] using hy,
        rwa [←coe_nnnorm, ←real.lt_to_nnreal_iff_coe_lt, real.to_nnreal_one, nnnorm_smul,
          ←nnreal.lt_inv_iff_mul_lt h] } },
    simpa [←smul_pow, (normed_ring.summable_geometric_of_norm_lt_1 _ norm_lt).has_sum_iff]
      using (normed_ring.inverse_one_sub _ norm_lt).symm,
  end }

variable {𝕜}
lemma is_unit_one_sub_smul_of_lt_inv_radius {a : A} {z : 𝕜} (h : ↑‖z‖₊ < (spectral_radius 𝕜 a)⁻¹) :
  is_unit (1 - z • a) :=
begin
  by_cases hz : z = 0,
  { simp only [hz, is_unit_one, sub_zero, zero_smul] },
  { let u := units.mk0 z hz,
    suffices hu : is_unit (u⁻¹ • 1 - a),
    { rwa [is_unit.smul_sub_iff_sub_inv_smul, inv_inv u] at hu },
    { rw [units.smul_def, ←algebra.algebra_map_eq_smul_one, ←mem_resolvent_set_iff],
      refine mem_resolvent_set_of_spectral_radius_lt _,
      rwa [units.coe_inv, nnnorm_inv, coe_inv (nnnorm_ne_zero_iff.mpr
        (units.coe_mk0 hz ▸ hz : (u : 𝕜) ≠ 0)), lt_inv_iff_lt_inv] } }
end

/-- In a Banach algebra `A` over `𝕜`, for `a : A` the function `λ z, (1 - z • a)⁻¹` is
differentiable on any closed ball centered at zero of radius `r < (spectral_radius 𝕜 a)⁻¹`. -/
theorem differentiable_on_inverse_one_sub_smul [complete_space A] {a : A} {r : ℝ≥0}
  (hr : (r : ℝ≥0∞) < (spectral_radius 𝕜 a)⁻¹) :
  differentiable_on 𝕜 (λ z : 𝕜, ring.inverse (1 - z • a)) (metric.closed_ball 0 r) :=
begin
  intros z z_mem,
  apply differentiable_at.differentiable_within_at,
  have hu : is_unit (1 - z • a),
  { refine is_unit_one_sub_smul_of_lt_inv_radius (lt_of_le_of_lt (coe_mono _) hr),
    simpa only [norm_to_nnreal, real.to_nnreal_coe]
      using real.to_nnreal_mono (mem_closed_ball_zero_iff.mp z_mem) },
  have H₁ : differentiable 𝕜 (λ w : 𝕜, 1 - w • a) := (differentiable_id.smul_const a).const_sub 1,
  exact differentiable_at.comp z (differentiable_at_inverse hu.unit) (H₁.differentiable_at),
end

end one_sub_smul

section gelfand_formula

open filter ennreal continuous_multilinear_map
open_locale topology

variables
[normed_ring A] [normed_algebra ℂ A] [complete_space A]

/-- The `limsup` relationship for the spectral radius used to prove `spectrum.gelfand_formula`. -/
lemma limsup_pow_nnnorm_pow_one_div_le_spectral_radius (a : A) :
  limsup (λ n : ℕ, ↑‖a ^ n‖₊ ^ (1 / n : ℝ)) at_top ≤ spectral_radius ℂ a :=
begin
  refine ennreal.inv_le_inv.mp (le_of_forall_pos_nnreal_lt (λ r r_pos r_lt, _)),
  simp_rw [inv_limsup, ←one_div],
  let p : formal_multilinear_series ℂ ℂ A :=
    λ n, continuous_multilinear_map.mk_pi_field ℂ (fin n) (a ^ n),
  suffices h : (r : ℝ≥0∞) ≤ p.radius,
  { convert h,
    simp only [p.radius_eq_liminf, ←norm_to_nnreal, norm_mk_pi_field],
    congr,
    ext n,
    rw [norm_to_nnreal, ennreal.coe_rpow_def (‖a ^ n‖₊) (1 / n : ℝ), if_neg],
    exact λ ha, by linarith [ha.2, (one_div_nonneg.mpr n.cast_nonneg : 0 ≤ (1 / n : ℝ))], },
  { have H₁ := (differentiable_on_inverse_one_sub_smul r_lt).has_fpower_series_on_ball r_pos,
    exact ((has_fpower_series_on_ball_inverse_one_sub_smul ℂ a).exchange_radius H₁).r_le, }
end

/-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the
`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/
theorem pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius (a : A) :
  tendsto (λ n : ℕ, ((‖a ^ n‖₊ ^ (1 / n : ℝ)) : ℝ≥0∞)) at_top (𝓝 (spectral_radius ℂ a)) :=
tendsto_of_le_liminf_of_limsup_le (spectral_radius_le_liminf_pow_nnnorm_pow_one_div ℂ a)
  (limsup_pow_nnnorm_pow_one_div_le_spectral_radius a)

/- This is the same as `pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius` but for `norm`
instead of `nnnorm`. -/
/-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the
`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/

end gelfand_formula

section nonempty_spectrum

variables [normed_ring A] [normed_algebra ℂ A] [complete_space A] [nontrivial A] (a : A)

/-- In a (nontrivial) complex Banach algebra, every element has nonempty spectrum. -/
protected theorem nonempty : (spectrum ℂ a).nonempty :=
begin
  /- Suppose `σ a = ∅`, then resolvent set is `ℂ`, any `(z • 1 - a)` is a unit, and `resolvent`
  is differentiable on `ℂ`. -/
  rw set.nonempty_iff_ne_empty,
  by_contra h,
  have H₀ : resolvent_set ℂ a = set.univ, by rwa [spectrum, set.compl_empty_iff] at h,
  have H₁ : differentiable ℂ (λ z : ℂ, resolvent a z), from λ z,
    (has_deriv_at_resolvent (H₀.symm ▸ set.mem_univ z : z ∈ resolvent_set ℂ a)).differentiable_at,
  /- The norm of the resolvent is small for all sufficently large `z`, and by compactness and
  continuity it is bounded on the complement of a large ball, thus uniformly bounded on `ℂ`.
  By Liouville's theorem `λ z, resolvent a z` is constant -/
  have H₂ := norm_resolvent_le_forall a,
  have H₃ : ∀ z : ℂ, resolvent a z = resolvent a (0 : ℂ),
  { refine λ z, H₁.apply_eq_apply_of_bounded (bounded_iff_forall_norm_le.mpr _) z 0,
    rcases H₂ 1 zero_lt_one with ⟨R, R_pos, hR⟩,
    rcases (proper_space.is_compact_closed_ball (0 : ℂ) R).exists_bound_of_continuous_on
      H₁.continuous.continuous_on with ⟨C, hC⟩,
    use max C 1,
    rintros _ ⟨w, rfl⟩,
    refine or.elim (em (‖w‖ ≤ R)) (λ hw, _) (λ hw, _),
      { exact (hC w (mem_closed_ball_zero_iff.mpr hw)).trans (le_max_left _ _) },
      { exact (hR w (not_le.mp hw).le).trans (le_max_right _ _), }, },
  /- `resolvent a 0 = 0`, which is a contradition because it isn't a unit. -/
  have H₅ : resolvent a (0 : ℂ) = 0,
  { refine norm_eq_zero.mp (le_antisymm (le_of_forall_pos_le_add (λ ε hε, _)) (norm_nonneg _)),
    rcases H₂ ε hε with ⟨R, R_pos, hR⟩,
    simpa only [H₃ R] using (zero_add ε).symm.subst
      (hR R (by exact_mod_cast (real.norm_of_nonneg R_pos.lt.le).symm.le)), },
  /- `not_is_unit_zero` is where we need `nontrivial A`, it is unavoidable. -/
  exact not_is_unit_zero (H₅.subst (is_unit_resolvent.mp
    (mem_resolvent_set_iff.mp (H₀.symm ▸ set.mem_univ 0)))),
end

/-- In a complex Banach algebra, the spectral radius is always attained by some element of the
spectrum. -/
lemma exists_nnnorm_eq_spectral_radius : ∃ z ∈ spectrum ℂ a, (‖z‖₊ : ℝ≥0∞) = spectral_radius ℂ a :=
exists_nnnorm_eq_spectral_radius_of_nonempty (spectrum.nonempty a)

/-- In a complex Banach algebra, if every element of the spectrum has norm strictly less than
`r : ℝ≥0`, then the spectral radius is also strictly less than `r`. -/
lemma spectral_radius_lt_of_forall_lt {r : ℝ≥0} (hr : ∀ z ∈ spectrum ℂ a, ‖z‖₊ < r) :
  spectral_radius ℂ a < r :=
spectral_radius_lt_of_forall_lt_of_nonempty (spectrum.nonempty a) hr

open_locale polynomial
open polynomial

/-- The **spectral mapping theorem** for polynomials in a Banach algebra over `ℂ`. -/
lemma map_polynomial_aeval (p : ℂ[X]) :
  spectrum ℂ (aeval a p) = (λ k, eval k p) '' (spectrum ℂ a) :=
map_polynomial_aeval_of_nonempty a p (spectrum.nonempty a)

/-- A specialization of the spectral mapping theorem for polynomials in a Banach algebra over `ℂ`
to monic monomials. -/
protected lemma map_pow (n : ℕ) : spectrum ℂ (a ^ n) = (λ x, x ^ n) '' (spectrum ℂ a) :=
by simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval a (X ^ n)

end nonempty_spectrum

section gelfand_mazur_isomorphism

variables [normed_ring A] [normed_algebra ℂ A] (hA : ∀ {a : A}, is_unit a ↔ a ≠ 0)
include hA

local notation `σ` := spectrum ℂ

lemma algebra_map_eq_of_mem {a : A} {z : ℂ} (h : z ∈ σ a) : algebra_map ℂ A z = a :=
by rwa [mem_iff, hA, not_not, sub_eq_zero] at h

/-- **Gelfand-Mazur theorem**: For a complex Banach division algebra, the natural `algebra_map ℂ A`
is an algebra isomorphism whose inverse is given by selecting the (unique) element of
`spectrum ℂ a`. In addition, `algebra_map_isometry` guarantees this map is an isometry.

Note: because `normed_division_ring` requires the field `norm_mul' : ∀ a b, ‖a * b‖ = ‖a‖ * ‖b‖`, we
don't use this type class and instead opt for a `normed_ring` in which the nonzero elements are
precisely the units. This allows for the application of this isomorphism in broader contexts, e.g.,
to the quotient of a complex Banach algebra by a maximal ideal. In the case when `A` is actually a
`normed_division_ring`, one may fill in the argument `hA` with the lemma `is_unit_iff_ne_zero`. -/
@[simps]
noncomputable def _root_.normed_ring.alg_equiv_complex_of_complete
  [complete_space A] : ℂ ≃ₐ[ℂ] A :=
let nt : nontrivial A := ⟨⟨1, 0, hA.mp ⟨⟨1, 1, mul_one _, mul_one _⟩, rfl⟩⟩⟩ in
{ to_fun := algebra_map ℂ A,
  inv_fun := λ a, (@spectrum.nonempty _ _ _ _ nt a).some,
  left_inv := λ z, by simpa only [@scalar_eq _ _ _ _ _ nt _] using
    (@spectrum.nonempty _ _ _ _ nt $ algebra_map ℂ A z).some_mem,
  right_inv := λ a, algebra_map_eq_of_mem @hA (@spectrum.nonempty _ _ _ _ nt a).some_mem,
  ..algebra.of_id ℂ A }

end gelfand_mazur_isomorphism

section exp_mapping

local notation `↑ₐ` := algebra_map 𝕜 A

/-- For `𝕜 = ℝ` or `𝕜 = ℂ`, `exp 𝕜` maps the spectrum of `a` into the spectrum of `exp 𝕜 a`. -/
theorem exp_mem_exp [is_R_or_C 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]
  (a : A) {z : 𝕜} (hz : z ∈ spectrum 𝕜 a) : exp 𝕜 z ∈ spectrum 𝕜 (exp 𝕜 a) :=
begin
  have hexpmul : exp 𝕜 a = exp 𝕜 (a - ↑ₐ z) * ↑ₐ (exp 𝕜 z),
  { rw [algebra_map_exp_comm z, ←exp_add_of_commute (algebra.commutes z (a - ↑ₐz)).symm,
      sub_add_cancel] },
  let b := ∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ n,
  have hb : summable (λ n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ n),
  { refine summable_of_norm_bounded_eventually _ (real.summable_pow_div_factorial ‖a - ↑ₐz‖) _,
    filter_upwards [filter.eventually_cofinite_ne 0] with n hn,
    rw [norm_smul, mul_comm, norm_inv, is_R_or_C.norm_eq_abs, is_R_or_C.abs_cast_nat,
      ←div_eq_mul_inv],
    exact div_le_div (pow_nonneg (norm_nonneg _) n) (norm_pow_le' (a - ↑ₐz) (zero_lt_iff.mpr hn))
      (by exact_mod_cast nat.factorial_pos n)
      (by exact_mod_cast nat.factorial_le (lt_add_one n).le) },
  have h₀ : ∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ (n + 1) = (a - ↑ₐz) * b,
    { simpa only [mul_smul_comm, pow_succ] using hb.tsum_mul_left (a - ↑ₐz) },
  have h₁ : ∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ (n + 1) = b * (a - ↑ₐz),
    { simpa only [pow_succ', algebra.smul_mul_assoc] using hb.tsum_mul_right (a - ↑ₐz) },
  have h₃ : exp 𝕜 (a - ↑ₐz) = 1 + (a - ↑ₐz) * b,
  { rw exp_eq_tsum,
    convert tsum_eq_zero_add (exp_series_summable' (a - ↑ₐz)),
    simp only [nat.factorial_zero, nat.cast_one, inv_one, pow_zero, one_smul],
    exact h₀.symm },
  rw [spectrum.mem_iff, is_unit.sub_iff, ←one_mul (↑ₐ(exp 𝕜 z)), hexpmul, ←_root_.sub_mul,
    commute.is_unit_mul_iff (algebra.commutes (exp 𝕜 z) (exp 𝕜 (a - ↑ₐz) - 1)).symm,
    sub_eq_iff_eq_add'.mpr h₃, commute.is_unit_mul_iff (h₀ ▸ h₁ : (a - ↑ₐz) * b = b * (a - ↑ₐz))],
  exact not_and_of_not_left _ (not_and_of_not_left _ ((not_iff_not.mpr is_unit.sub_iff).mp hz)),
end

end exp_mapping

end spectrum

namespace alg_hom

section normed_field
variables {F : Type*} [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]
local notation `↑ₐ` := algebra_map 𝕜 A

/-- An algebra homomorphism into the base field, as a continuous linear map (since it is
automatically bounded). See note [lower instance priority] -/
@[priority 100]
instance [alg_hom_class F 𝕜 A 𝕜] : continuous_linear_map_class F 𝕜 A 𝕜 :=
{ map_continuous := λ φ, add_monoid_hom_class.continuous_of_bound φ ‖(1 : A)‖ $
    λ a, (mul_comm ‖a‖ ‖(1 : A)‖) ▸ spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum φ _),
  .. alg_hom_class.linear_map_class }

/-- An algebra homomorphism into the base field, as a continuous linear map (since it is
automatically bounded). -/
def to_continuous_linear_map (φ : A →ₐ[𝕜] 𝕜) : A →L[𝕜] 𝕜 :=
{ cont := map_continuous φ, .. φ.to_linear_map }

@[simp] lemma coe_to_continuous_linear_map (φ : A →ₐ[𝕜] 𝕜) :
  ⇑φ.to_continuous_linear_map = φ := rfl

lemma norm_apply_le_self_mul_norm_one [alg_hom_class F 𝕜 A 𝕜] (f : F) (a : A) :
  ‖f a‖ ≤ ‖a‖ * ‖(1 : A)‖ :=
spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum f _)

lemma norm_apply_le_self [norm_one_class A] [alg_hom_class F 𝕜 A 𝕜] (f : F) (a : A) : ‖f a‖ ≤ ‖a‖ :=
spectrum.norm_le_norm_of_mem (apply_mem_spectrum f _)

end normed_field

section nontrivially_normed_field
variables [nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]
local notation `↑ₐ` := algebra_map 𝕜 A

@[simp] lemma to_continuous_linear_map_norm [norm_one_class A] (φ : A →ₐ[𝕜] 𝕜) :
  ‖φ.to_continuous_linear_map‖ = 1 :=
continuous_linear_map.op_norm_eq_of_bounds zero_le_one
  (λ a, (one_mul ‖a‖).symm ▸ spectrum.norm_le_norm_of_mem (apply_mem_spectrum φ _))
  (λ _ _ h, by simpa only [coe_to_continuous_linear_map, map_one, norm_one, mul_one] using h 1)

end nontrivially_normed_field

end alg_hom

namespace weak_dual

namespace character_space

variables [nontrivially_normed_field 𝕜] [normed_ring A] [complete_space A]
variables [normed_algebra 𝕜 A]

/-- The equivalence between characters and algebra homomorphisms into the base field. -/
def equiv_alg_hom : (character_space 𝕜 A) ≃ (A →ₐ[𝕜] 𝕜)  :=
{ to_fun := to_alg_hom,
  inv_fun := λ f,
  { val := f.to_continuous_linear_map,
    property := by { rw eq_set_map_one_map_mul, exact ⟨map_one f, map_mul f⟩ } },
  left_inv := λ f, subtype.ext $ continuous_linear_map.ext $ λ x, rfl,
  right_inv := λ f, alg_hom.ext $ λ x, rfl }

@[simp] lemma equiv_alg_hom_coe (f : character_space 𝕜 A) : ⇑(equiv_alg_hom f) = f := rfl

@[simp] lemma equiv_alg_hom_symm_coe  (f : A →ₐ[𝕜] 𝕜) : ⇑(equiv_alg_hom.symm f) = f := rfl

end character_space

end weak_dual


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying

! This file was ported from Lean 3 source module measure_theory.decomposition.radon_nikodym
! leanprover-community/mathlib commit fc75855907eaa8ff39791039710f567f37d4556f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Decomposition.Lebesgue

/-!
# Radon-Nikodym theorem

This file proves the Radon-Nikodym theorem. The Radon-Nikodym theorem states that, given measures
`μ, ν`, if `have_lebesgue_decomposition μ ν`, then `μ` is absolutely continuous with respect to
`ν` if and only if there exists a measurable function `f : α → ℝ≥0∞` such that `μ = fν`.
In particular, we have `f = rn_deriv μ ν`.

The Radon-Nikodym theorem will allow us to define many important concepts in probability theory,
most notably probability cumulative functions. It could also be used to define the conditional
expectation of a real function, but we take a different approach (see the file
`measure_theory/function/conditional_expectation`).

## Main results

* `measure_theory.measure.absolutely_continuous_iff_with_density_rn_deriv_eq` :
  the Radon-Nikodym theorem
* `measure_theory.signed_measure.absolutely_continuous_iff_with_density_rn_deriv_eq` :
  the Radon-Nikodym theorem for signed measures

## Tags

Radon-Nikodym theorem
-/

noncomputable section

open Classical MeasureTheory NNReal ENNReal

variable {α β : Type _} {m : MeasurableSpace α}

namespace MeasureTheory

namespace Measure

include m

theorem withDensity_rnDeriv_eq (μ ν : Measure α) [HaveLebesgueDecomposition μ ν] (h : μ ≪ ν) :
    ν.withDensity (rnDeriv μ ν) = μ :=
  by
  obtain ⟨hf₁, ⟨E, hE₁, hE₂, hE₃⟩, hadd⟩ := have_lebesgue_decomposition_spec μ ν
  have : singular_part μ ν = 0 :=
    by
    refine' le_antisymm (fun A hA => _) (measure.zero_le _)
    suffices singular_part μ ν Set.univ = 0
      by
      rw [measure.coe_zero, Pi.zero_apply, ← this]
      exact measure_mono (Set.subset_univ _)
    rw [← measure_add_measure_compl hE₁, hE₂, zero_add]
    have : (singular_part μ ν + ν.with_density (rn_deriv μ ν)) (Eᶜ) = μ (Eᶜ) := by rw [← hadd]
    rw [measure.coe_add, Pi.add_apply, h hE₃] at this
    exact (add_eq_zero_iff.1 this).1
  rw [this, zero_add] at hadd
  exact hadd.symm
#align measure_theory.measure.with_density_rn_deriv_eq MeasureTheory.Measure.withDensity_rnDeriv_eq

/-- **The Radon-Nikodym theorem**: Given two measures `μ` and `ν`, if
`have_lebesgue_decomposition μ ν`, then `μ` is absolutely continuous to `ν` if and only if
`ν.with_density (rn_deriv μ ν) = μ`. -/
theorem absolutelyContinuous_iff_withDensity_rnDeriv_eq {μ ν : Measure α}
    [HaveLebesgueDecomposition μ ν] : μ ≪ ν ↔ ν.withDensity (rnDeriv μ ν) = μ :=
  ⟨withDensity_rnDeriv_eq μ ν, fun h => h ▸ withDensityAbsolutelyContinuous _ _⟩
#align measure_theory.measure.absolutely_continuous_iff_with_density_rn_deriv_eq MeasureTheory.Measure.absolutelyContinuous_iff_withDensity_rnDeriv_eq

theorem with_density_rnDeriv_toReal_eq {μ ν : Measure α} [IsFiniteMeasure μ]
    [HaveLebesgueDecomposition μ ν] (h : μ ≪ ν) {i : Set α} (hi : MeasurableSet i) :
    (∫ x in i, (μ.rnDeriv ν x).toReal ∂ν) = (μ i).toReal :=
  by
  rw [integral_to_real, ← with_density_apply _ hi, with_density_rn_deriv_eq μ ν h]
  · measurability
  · refine'
      ae_lt_top (μ.measurable_rn_deriv ν) (lt_of_le_of_lt (lintegral_mono_set i.subset_univ) _).Ne
    rw [← with_density_apply _ MeasurableSet.univ, with_density_rn_deriv_eq μ ν h]
    exact measure_lt_top _ _
#align measure_theory.measure.with_density_rn_deriv_to_real_eq MeasureTheory.Measure.with_density_rnDeriv_toReal_eq

end Measure

namespace SignedMeasure

include m

open Measure VectorMeasure

theorem withDensityᵥ_rnDeriv_eq (s : SignedMeasure α) (μ : Measure α) [SigmaFinite μ]
    (h : s ≪ᵥ μ.toEnnrealVectorMeasure) : μ.withDensityᵥ (s.rnDeriv μ) = s :=
  by
  rw [absolutely_continuous_ennreal_iff, (_ : μ.to_ennreal_vector_measure.ennreal_to_measure = μ),
    total_variation_absolutely_continuous_iff] at h
  · ext1 i hi
    rw [with_densityᵥ_apply (integrable_rn_deriv _ _) hi, rn_deriv, integral_sub,
      with_density_rn_deriv_to_real_eq h.1 hi, with_density_rn_deriv_to_real_eq h.2 hi]
    · conv_rhs => rw [← s.to_signed_measure_to_jordan_decomposition]
      erw [vector_measure.sub_apply]
      rw [to_signed_measure_apply_measurable hi, to_signed_measure_apply_measurable hi]
    all_goals
      rw [← integrable_on_univ]
      refine' integrable_on.restrict _ MeasurableSet.univ
      refine' ⟨_, has_finite_integral_to_real_of_lintegral_ne_top _⟩
      · apply Measurable.aeStronglyMeasurable
        measurability
      · rw [set_lintegral_univ]
        exact (lintegral_rn_deriv_lt_top _ _).Ne
  · exact equiv_measure.right_inv μ
#align measure_theory.signed_measure.with_densityᵥ_rn_deriv_eq MeasureTheory.SignedMeasure.withDensityᵥ_rnDeriv_eq

/-- The Radon-Nikodym theorem for signed measures. -/
theorem absolutelyContinuous_iff_withDensityᵥ_rnDeriv_eq (s : SignedMeasure α) (μ : Measure α)
    [SigmaFinite μ] : s ≪ᵥ μ.toEnnrealVectorMeasure ↔ μ.withDensityᵥ (s.rnDeriv μ) = s :=
  ⟨withDensityᵥ_rnDeriv_eq s μ, fun h => h ▸ withDensityᵥAbsolutelyContinuous _ _⟩
#align measure_theory.signed_measure.absolutely_continuous_iff_with_densityᵥ_rn_deriv_eq MeasureTheory.SignedMeasure.absolutelyContinuous_iff_withDensityᵥ_rnDeriv_eq

end SignedMeasure

end MeasureTheory


import tactic --hide

/-
The goal for this level is to show that implications are transitive.
That is, if `P → Q` and `Q → R` are true, then so is `P → R`.
-/

/- Hint: Hint
It might be useful to start by using `intros hPQ hQR hP`.
-/

/-Lemma
If $P,Q,R$ are logical statements and $P \implies Q$ and $Q \implies R$ then $P \implies R$.
-/
lemma implicationss_are_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R) :=
begin
  intros hPQ hQR hP,
  apply hQR,
  apply hPQ,
  exact hP,

end


/-
Copyright (c) 2016 Jacob Gross. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jacob Gross, Jeremy Avigad

Sigma algebras.
-/
import data.set data.nat theories.topology.continuous ..move
open eq.ops set nat

structure sigma_algebra [class] (X : Type) :=
  (sets : set (set X))
  (univ_mem_sets : univ ∈ sets)
  (comp_mem_sets : ∀ {s : set X}, s ∈ sets → (-s ∈ sets))
  (cUnion_mem_sets : ∀ {s : ℕ → set X}, (∀ i, s i ∈ sets) → (⋃ i, s i) ∈ sets)

/- Closure properties -/

namespace measure_theory
open sigma_algebra

variables {X : Type} [sigma_algebra X]

definition measurable (t : set X) : Prop := t ∈ sets X

theorem measurable_univ : measurable (@univ X) :=
univ_mem_sets X

theorem measurable_compl {s : set X} (H : measurable s) : measurable (-s) :=
comp_mem_sets H

theorem measurable_of_measurable_compl {s : set X} (H : measurable (-s)) : measurable s :=
!compl_compl ▸ measurable_compl H

theorem measurable_empty : measurable (∅ : set X) :=
compl_univ ▸ measurable_compl measurable_univ

theorem measurable_cUnion {s : ℕ → set X} (H : ∀ i, measurable (s i)) :
  measurable (⋃ i, s i) :=
cUnion_mem_sets H

theorem measurable_cInter {s : ℕ → set X} (H : ∀ i, measurable (s i)) :
  measurable (⋂ i, s i) :=
have ∀ i, measurable (-(s i)), from take i, measurable_compl (H i),
have measurable (-(⋃ i, -(s i))), from measurable_compl (measurable_cUnion this),
show measurable (⋂ i, s i), by rewrite Inter_eq_comp_Union_comp; apply this

theorem measurable_union {s t : set X} (Hs : measurable s) (Ht : measurable t) :
  measurable (s ∪ t) :=
have ∀ i, measurable (bin_ext s t i), by intro i; cases i; exact Hs; exact Ht,
show measurable (s ∪ t), by rewrite -Union_bin_ext; exact measurable_cUnion this

theorem measurable_inter {s t : set X} (Hs : measurable s) (Ht : measurable t) :
  measurable (s ∩ t) :=
have ∀ i, measurable (bin_ext s t i), by intro i; cases i; exact Hs; exact Ht,
show measurable (s ∩ t), by rewrite -Inter_bin_ext; exact measurable_cInter this

theorem measurable_diff {s t : set X} (Hs : measurable s) (Ht : measurable t) :
  measurable (s \ t) :=
measurable_inter Hs (measurable_compl Ht)

theorem measurable_insert {x : X} {s : set X} (Hx : measurable '{x}) (Hs : measurable s) :
  measurable (insert x s) :=
!insert_eq⁻¹ ▸ measurable_union Hx Hs

end measure_theory

/- Measurable functions -/

namespace measure_theory
  open sigma_algebra function
  variables {X Y Z : Type} {M : sigma_algebra X} {N : sigma_algebra Y} {L : sigma_algebra Z}

  definition measurable_fun (f : X → Y) (M : sigma_algebra X) (N : sigma_algebra Y) :=
  ∀ ⦃s⦄, s ∈ sets Y → f '- s ∈ sets X

  theorem measurable_fun_id : measurable_fun (@id X) M M :=
  take s, suppose s ∈ sets X, this

  theorem measurable_fun_comp {f : X → Y} {g : Y → Z} (Hf : measurable_fun f M N)
      (Hg : measurable_fun g N L) :
    measurable_fun (g ∘ f) M L :=
  take s, assume Hs, Hf (Hg Hs)

  section
    open classical

    theorem measurable_fun_const (c : Y) :
      measurable_fun (λ x : X, c) M N :=
    take s, assume Hs,
    if cs : c ∈ s then
      have (λx, c) '- s = @univ X, from eq_univ_of_forall (take x, mem_preimage cs),
      by rewrite this; apply measurable_univ
    else
      have (λx, c) '- s = (∅ : set X),
        from eq_empty_of_forall_not_mem (take x, assume H, cs (mem_of_mem_preimage H)),
      by rewrite this; apply measurable_empty
end

end measure_theory

/-
-- Properties of sigma algebras
-/

namespace sigma_algebra
open measure_theory
variables {X : Type}

protected theorem eq {M N : sigma_algebra X} (H : @sets X M = @sets X N) :
  M = N :=
by cases M; cases N; cases H; apply rfl

/- sigma algebra generated by a set -/

inductive sets_generated_by (G : set (set X)) : set X → Prop :=
| generators_mem : ∀ ⦃s : set X⦄, s ∈ G → sets_generated_by G s
| univ_mem       : sets_generated_by G univ
| comp_mem       : ∀ ⦃s : set X⦄, sets_generated_by G s → sets_generated_by G (-s)
| cUnion_mem     : ∀ ⦃s : ℕ → set X⦄, (∀ i, sets_generated_by G (s i)) →
                                        sets_generated_by G (⋃ i, s i)

protected definition generated_by {X : Type} (G : set (set X)) : sigma_algebra X :=
⦃sigma_algebra,
  sets            := sets_generated_by G,
  univ_mem_sets   := sets_generated_by.univ_mem G,
  comp_mem_sets   := sets_generated_by.comp_mem ,
  cUnion_mem_sets := sets_generated_by.cUnion_mem ⦄

theorem sets_generated_by_initial {G : set (set X)} {M : sigma_algebra X} (H : G ⊆ @sets _ M) :
  sets_generated_by G ⊆ @sets _ M :=
begin
  intro s Hs,
  induction Hs with s sG s Hs ssX s Hs sisX,
    {exact H sG},
    {exact measurable_univ},
    {exact measurable_compl ssX},
  exact measurable_cUnion sisX
end

theorem measurable_generated_by {G : set (set X)} :
   ∀₀ s ∈ G, @measurable _ (sigma_algebra.generated_by G) s :=
λ s H, sets_generated_by.generators_mem H

section
  variables {Y : Type} {M : sigma_algebra X}

  theorem measurable_fun_generated_by (f : X → Y) (G : set (set Y))
    (Hg : ∀₀ g ∈ G, f '- g ∈ sets X) : measurable_fun f M (sigma_algebra.generated_by G) :=
  begin
    intro A HA,
    induction HA with Hg A s setsG pre s' HsetsG HsetsG',
      exact Hg A,
      exact measurable_univ,
      rewrite [preimage_compl]; exact measurable_compl pre,
      rewrite [preimage_Union]; exact measurable_cUnion HsetsG'
  end
end

/- The collection of sigma algebras forms a complete lattice. -/

protected definition le (M N : sigma_algebra X) : Prop := @sets _ M ⊆ @sets _ N

definition sigma_algebra_has_le [instance] :
  has_le (sigma_algebra X) :=
has_le.mk sigma_algebra.le

protected theorem le_refl (M : sigma_algebra X) : M ≤ M := subset.refl (@sets _ M)

protected theorem le_trans (M N L : sigma_algebra X) : M ≤ N → N ≤ L → M ≤ L :=
assume H1, assume H2,
subset.trans H1 H2

protected theorem le_antisymm (M N : sigma_algebra X) : M ≤ N → N ≤ M → M = N :=
assume H1, assume H2,
sigma_algebra.eq (subset.antisymm H1 H2)

protected theorem generated_by_initial {G : set (set X)} {M : sigma_algebra X} (H : G ⊆ @sets X M) :
  sigma_algebra.generated_by G ≤ M :=
sets_generated_by_initial H

protected definition inf (M N : sigma_algebra X) : sigma_algebra X :=
⦃sigma_algebra,
  sets            := @sets X M ∩ @sets X N,
  univ_mem_sets   := abstract and.intro (@measurable_univ X M) (@measurable_univ X N) end,
  comp_mem_sets   := abstract take s, assume Hs, and.intro
                       (@measurable_compl X M s (and.elim_left Hs))
                       (@measurable_compl X N s (and.elim_right Hs)) end,
  cUnion_mem_sets := abstract take s, assume Hs, and.intro
                       (@measurable_cUnion X M s (λ i, and.elim_left (Hs i)))
                       (@measurable_cUnion X N s (λ i, and.elim_right (Hs i))) end⦄

protected theorem inf_le_left (M N : sigma_algebra X) : sigma_algebra.inf M N ≤ M :=
λ s, !inter_subset_left

protected theorem inf_le_right (M N : sigma_algebra X) : sigma_algebra.inf M N ≤ N :=
λ s, !inter_subset_right

protected theorem le_inf (M N L : sigma_algebra X) (H1 : L ≤ M) (H2 : L ≤ N) :
  L ≤ sigma_algebra.inf M N :=
λ s H, and.intro (H1 s H) (H2 s H)

protected definition Inf (MS : set (sigma_algebra X)) : sigma_algebra X :=
⦃sigma_algebra,
  sets            := ⋂ M ∈ MS, @sets _ M,
  univ_mem_sets   := abstract take M, assume HM, @measurable_univ X M end,
  comp_mem_sets   := abstract take s, assume Hs, take M, assume HM,
                       measurable_compl (Hs M HM) end,
  cUnion_mem_sets := abstract take s, assume Hs, take M, assume HM,
                       measurable_cUnion (λ i, Hs i M HM) end
⦄

protected theorem Inf_le {M : sigma_algebra X} {MS : set (sigma_algebra X)} (MMS : M ∈ MS) :
  sigma_algebra.Inf MS ≤ M :=
bInter_subset_of_mem MMS

protected theorem le_Inf {M : sigma_algebra X} {MS : set (sigma_algebra X)} (H : ∀₀ N ∈ MS, M ≤ N) :
  M ≤ sigma_algebra.Inf MS :=
take s, assume Hs : s ∈ @sets _ M,
take N, assume NMS : N ∈ MS,
show s ∈ @sets _ N, from H NMS s Hs

protected definition sup (M N : sigma_algebra X) : sigma_algebra X :=
sigma_algebra.generated_by (@sets _ M ∪ @sets _ N)

protected theorem le_sup_left (M N : sigma_algebra X) : M ≤ sigma_algebra.sup M N :=
take s, assume Hs : s ∈ @sets _ M,
measurable_generated_by (or.inl Hs)

protected theorem le_sup_right (M N : sigma_algebra X) : N ≤ sigma_algebra.sup M N :=
take s, assume Hs : s ∈ @sets _ N,
measurable_generated_by (or.inr Hs)

protected theorem sup_le {M N L : sigma_algebra X} (H1 : M ≤ L) (H2 : N ≤ L) :
  sigma_algebra.sup M N ≤ L :=
have @sets _ M ∪ @sets _ N ⊆ @sets _ L, from union_subset H1 H2,
sets_generated_by_initial this

protected definition Sup (MS : set (sigma_algebra X)) : sigma_algebra X :=
sigma_algebra.generated_by (⋃ M ∈ MS, @sets _ M)

protected theorem le_Sup {M : sigma_algebra X} {MS : set (sigma_algebra X)} (MMS : M ∈ MS) :
  M ≤ sigma_algebra.Sup MS :=
take s, assume Hs : s ∈ @sets _ M,
measurable_generated_by (mem_bUnion MMS Hs)

protected theorem Sup_le {N : sigma_algebra X} {MS : set (sigma_algebra X)} (H : ∀₀ M ∈ MS, M ≤ N) :
  sigma_algebra.Sup MS ≤ N :=
have (⋃ M ∈ MS, @sets _ M) ⊆ @sets _ N, from bUnion_subset H,
sets_generated_by_initial this

protected definition complete_lattice [trans_instance] :
  complete_lattice (sigma_algebra X) :=
⦃complete_lattice,
  le           := sigma_algebra.le,
  le_refl      := sigma_algebra.le_refl,
  le_trans     := sigma_algebra.le_trans,
  le_antisymm  := sigma_algebra.le_antisymm,
  inf          := sigma_algebra.inf,
  sup          := sigma_algebra.sup,
  inf_le_left  := sigma_algebra.inf_le_left,
  inf_le_right := sigma_algebra.inf_le_right,
  le_inf       := sigma_algebra.le_inf,
  le_sup_left  := sigma_algebra.le_sup_left,
  le_sup_right := sigma_algebra.le_sup_right,
  sup_le       := @sigma_algebra.sup_le X,
  Inf          := sigma_algebra.Inf,
  Sup          := sigma_algebra.Sup,
  Inf_le       := @sigma_algebra.Inf_le X,
  le_Inf       := @sigma_algebra.le_Inf X,
  le_Sup       := @sigma_algebra.le_Sup X,
  Sup_le       := @sigma_algebra.Sup_le X⦄
end sigma_algebra

/- Borel sets -/

namespace measure_theory

section
  open topology
  variables (X : Type) [topology X]

  definition borel_algebra : sigma_algebra X :=
  sigma_algebra.generated_by (opens X)

  variable {X}
  definition borel (s : set X) : Prop := @measurable _ (borel_algebra X) s

  theorem borel_of_Open {s : set X} (H : Open s) : borel s :=
  sigma_algebra.measurable_generated_by H

  theorem borel_of_closed {s : set X} (H : closed s) : borel s :=
  have borel (-s), from borel_of_Open H,
  @measurable_of_measurable_compl _ (borel_algebra X) _ this
end

/- borel functions -/

section
  open topology function
  variables {X Y Z : Type} [topology X] [topology Y] [topology Z]

  definition borel_fun (f : X → Y) := ∀ ⦃s⦄, Open s → borel (f '- s)

  theorem borel_fun_id : borel_fun (@id X) := λ s Os, borel_of_Open Os

  theorem borel_fun_of_continuous {f : X → Y} (H : continuous f) : borel_fun f :=
  λ s Os, borel_of_Open (H Os)

  theorem borel_fun_const (c : Y) : borel_fun (λ x : X, c) :=
  borel_fun_of_continuous (continuous_const c)

  theorem measurable_fun_of_borel_fun {f : X → Y} (H : borel_fun f) :
    measurable_fun f (borel_algebra X) (borel_algebra Y) :=
  sigma_algebra.measurable_fun_generated_by f (opens Y) H

  theorem borel_fun_of_measurable_fun {f : X → Y}
      (H : measurable_fun f (borel_algebra X) (borel_algebra Y)) :
    borel_fun f :=
  λ s Os, H (borel_of_Open Os)

  theorem borel_fun_iff (f : X → Y) :
    borel_fun f ↔ measurable_fun f (borel_algebra X) (borel_algebra Y) :=
  iff.intro measurable_fun_of_borel_fun borel_fun_of_measurable_fun

  theorem borel_fun_comp {f : X → Y} {g : Y → Z} (Hf : borel_fun f) (Hg : borel_fun g) :
    borel_fun (g ∘ f) :=
  λ s Os, measurable_fun_of_borel_fun Hf (Hg Os)
end

end measure_theory


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

! This file was ported from Lean 3 source module ring_theory.algebraic
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.RingTheory.IntegralClosure
import Mathbin.Data.Polynomial.IntegralNormalization

/-!
# Algebraic elements and algebraic extensions

An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial.
An R-algebra is algebraic over R if and only if all its elements are algebraic over R.
The main result in this file proves transitivity of algebraicity:
a tower of algebraic field extensions is algebraic.
-/

universe u v w

open Classical Polynomial

open Polynomial

section

variable (R : Type u) {A : Type v} [CommRing R] [Ring A] [Algebra R A]

/-- An element of an R-algebra is algebraic over R if it is a root of a nonzero polynomial
with coefficients in R. -/
def IsAlgebraic (x : A) : Prop :=
  ∃ p : R[X], p ≠ 0 ∧ aeval x p = 0
#align is_algebraic IsAlgebraic

/-- An element of an R-algebra is transcendental over R if it is not algebraic over R. -/
def Transcendental (x : A) : Prop :=
  ¬IsAlgebraic R x
#align transcendental Transcendental

theorem is_transcendental_of_subsingleton [Subsingleton R] (x : A) : Transcendental R x :=
  fun ⟨p, h, _⟩ => h <| Subsingleton.elim p 0
#align is_transcendental_of_subsingleton is_transcendental_of_subsingleton

variable {R}

/-- A subalgebra is algebraic if all its elements are algebraic. -/
def Subalgebra.IsAlgebraic (S : Subalgebra R A) : Prop :=
  ∀ x ∈ S, IsAlgebraic R x
#align subalgebra.is_algebraic Subalgebra.IsAlgebraic

variable (R A)

/-- An algebra is algebraic if all its elements are algebraic. -/
def Algebra.IsAlgebraic : Prop :=
  ∀ x : A, IsAlgebraic R x
#align algebra.is_algebraic Algebra.IsAlgebraic

variable {R A}

/-- A subalgebra is algebraic if and only if it is algebraic as an algebra. -/
theorem Subalgebra.isAlgebraic_iff (S : Subalgebra R A) :
    S.IsAlgebraic ↔ @Algebra.IsAlgebraic R S _ _ S.Algebra :=
  by
  delta Algebra.IsAlgebraic Subalgebra.IsAlgebraic
  rw [Subtype.forall']
  refine' forall_congr' fun x => exists_congr fun p => and_congr Iff.rfl _
  have h : Function.Injective S.val := Subtype.val_injective
  conv_rhs => rw [← h.eq_iff, AlgHom.map_zero]
  rw [← aeval_alg_hom_apply, S.val_apply]
#align subalgebra.is_algebraic_iff Subalgebra.isAlgebraic_iff

/-- An algebra is algebraic if and only if it is algebraic as a subalgebra. -/
theorem Algebra.isAlgebraic_iff : Algebra.IsAlgebraic R A ↔ (⊤ : Subalgebra R A).IsAlgebraic :=
  by
  delta Algebra.IsAlgebraic Subalgebra.IsAlgebraic
  simp only [Algebra.mem_top, forall_prop_of_true, iff_self_iff]
#align algebra.is_algebraic_iff Algebra.isAlgebraic_iff

theorem isAlgebraic_iff_not_injective {x : A} :
    IsAlgebraic R x ↔ ¬Function.Injective (Polynomial.aeval x : R[X] →ₐ[R] A) := by
  simp only [IsAlgebraic, injective_iff_map_eq_zero, not_forall, and_comm, exists_prop]
#align is_algebraic_iff_not_injective isAlgebraic_iff_not_injective

end

section zero_ne_one

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

variable [CommRing S] [Ring A] [Algebra R A] [Algebra R S] [Algebra S A]

variable [IsScalarTower R S A]

/-- An integral element of an algebra is algebraic.-/
theorem IsIntegral.isAlgebraic [Nontrivial R] {x : A} : IsIntegral R x → IsAlgebraic R x :=
  fun ⟨p, hp, hpx⟩ => ⟨p, hp.NeZero, hpx⟩
#align is_integral.is_algebraic IsIntegral.isAlgebraic

variable {R}

theorem isAlgebraic_zero [Nontrivial R] : IsAlgebraic R (0 : A) :=
  ⟨_, X_ne_zero, aeval_X 0⟩
#align is_algebraic_zero isAlgebraic_zero

/-- An element of `R` is algebraic, when viewed as an element of the `R`-algebra `A`. -/
theorem isAlgebraic_algebraMap [Nontrivial R] (x : R) : IsAlgebraic R (algebraMap R A x) :=
  ⟨_, X_sub_C_ne_zero x, by rw [_root_.map_sub, aeval_X, aeval_C, sub_self]⟩
#align is_algebraic_algebra_map isAlgebraic_algebraMap

theorem isAlgebraic_one [Nontrivial R] : IsAlgebraic R (1 : A) :=
  by
  rw [← _root_.map_one _]
  exact isAlgebraic_algebraMap 1
#align is_algebraic_one isAlgebraic_one

theorem isAlgebraic_nat [Nontrivial R] (n : ℕ) : IsAlgebraic R (n : A) :=
  by
  rw [← map_natCast _]
  exact isAlgebraic_algebraMap n
#align is_algebraic_nat isAlgebraic_nat

theorem isAlgebraic_int [Nontrivial R] (n : ℤ) : IsAlgebraic R (n : A) :=
  by
  rw [← _root_.map_int_cast (algebraMap R A)]
  exact isAlgebraic_algebraMap n
#align is_algebraic_int isAlgebraic_int

theorem isAlgebraic_rat (R : Type u) {A : Type v} [DivisionRing A] [Field R] [Algebra R A] (n : ℚ) :
    IsAlgebraic R (n : A) := by
  rw [← map_ratCast (algebraMap R A)]
  exact isAlgebraic_algebraMap n
#align is_algebraic_rat isAlgebraic_rat

theorem isAlgebraic_of_mem_rootSet {R : Type u} {A : Type v} [Field R] [Field A] [Algebra R A]
    {p : R[X]} {x : A} (hx : x ∈ p.rootSet A) : IsAlgebraic R x :=
  ⟨p, ne_zero_of_mem_rootSet hx, aeval_eq_zero_of_mem_rootSet hx⟩
#align is_algebraic_of_mem_root_set isAlgebraic_of_mem_rootSet

open IsScalarTower

theorem isAlgebraic_algebraMap_of_isAlgebraic {a : S} :
    IsAlgebraic R a → IsAlgebraic R (algebraMap S A a) := fun ⟨f, hf₁, hf₂⟩ =>
  ⟨f, hf₁, by rw [aeval_algebra_map_apply, hf₂, map_zero]⟩
#align is_algebraic_algebra_map_of_is_algebraic isAlgebraic_algebraMap_of_isAlgebraic

/-- This is slightly more general than `is_algebraic_algebra_map_of_is_algebraic` in that it
  allows noncommutative intermediate rings `A`. -/
theorem isAlgebraic_algHom_of_isAlgebraic {B} [Ring B] [Algebra R B] (f : A →ₐ[R] B) {a : A}
    (h : IsAlgebraic R a) : IsAlgebraic R (f a) :=
  let ⟨p, hp, ha⟩ := h
  ⟨p, hp, by rw [aeval_alg_hom, f.comp_apply, ha, map_zero]⟩
#align is_algebraic_alg_hom_of_is_algebraic isAlgebraic_algHom_of_isAlgebraic

/-- Transfer `algebra.is_algebraic` across an `alg_equiv`. -/
theorem AlgEquiv.isAlgebraic {B} [Ring B] [Algebra R B] (e : A ≃ₐ[R] B)
    (h : Algebra.IsAlgebraic R A) : Algebra.IsAlgebraic R B := fun b => by
  convert← isAlgebraic_algHom_of_isAlgebraic e.to_alg_hom (h _) <;> apply e.apply_symm_apply
#align alg_equiv.is_algebraic AlgEquiv.isAlgebraic

theorem AlgEquiv.isAlgebraic_iff {B} [Ring B] [Algebra R B] (e : A ≃ₐ[R] B) :
    Algebra.IsAlgebraic R A ↔ Algebra.IsAlgebraic R B :=
  ⟨e.IsAlgebraic, e.symm.IsAlgebraic⟩
#align alg_equiv.is_algebraic_iff AlgEquiv.isAlgebraic_iff

theorem isAlgebraic_algebraMap_iff {a : S} (h : Function.Injective (algebraMap S A)) :
    IsAlgebraic R (algebraMap S A a) ↔ IsAlgebraic R a :=
  ⟨fun ⟨p, hp0, hp⟩ => ⟨p, hp0, h (by rwa [map_zero, ← aeval_algebra_map_apply])⟩,
    isAlgebraic_algebraMap_of_isAlgebraic⟩
#align is_algebraic_algebra_map_iff isAlgebraic_algebraMap_iff

theorem isAlgebraic_of_pow {r : A} {n : ℕ} (hn : 0 < n) (ht : IsAlgebraic R (r ^ n)) :
    IsAlgebraic R r := by
  obtain ⟨p, p_nonzero, hp⟩ := ht
  refine' ⟨Polynomial.expand _ n p, _, _⟩
  · rwa [Polynomial.expand_ne_zero hn]
  · rwa [Polynomial.expand_aeval n p r]
#align is_algebraic_of_pow isAlgebraic_of_pow

theorem Transcendental.pow {r : A} (ht : Transcendental R r) {n : ℕ} (hn : 0 < n) :
    Transcendental R (r ^ n) := fun ht' => ht <| isAlgebraic_of_pow hn ht'
#align transcendental.pow Transcendental.pow

end zero_ne_one

section Field

variable {K : Type u} {A : Type v} [Field K] [Ring A] [Algebra K A]

/-- An element of an algebra over a field is algebraic if and only if it is integral.-/
theorem isAlgebraic_iff_isIntegral {x : A} : IsAlgebraic K x ↔ IsIntegral K x :=
  by
  refine' ⟨_, IsIntegral.isAlgebraic K⟩
  rintro ⟨p, hp, hpx⟩
  refine' ⟨_, monic_mul_leading_coeff_inv hp, _⟩
  rw [← aeval_def, AlgHom.map_mul, hpx, MulZeroClass.zero_mul]
#align is_algebraic_iff_is_integral isAlgebraic_iff_isIntegral

protected theorem Algebra.isAlgebraic_iff_isIntegral :
    Algebra.IsAlgebraic K A ↔ Algebra.IsIntegral K A :=
  ⟨fun h x => isAlgebraic_iff_isIntegral.mp (h x), fun h x => isAlgebraic_iff_isIntegral.mpr (h x)⟩
#align algebra.is_algebraic_iff_is_integral Algebra.isAlgebraic_iff_isIntegral

end Field

namespace Algebra

variable {K : Type _} {L : Type _} {R : Type _} {S : Type _} {A : Type _}

variable [Field K] [Field L] [CommRing R] [CommRing S] [CommRing A]

variable [Algebra K L] [Algebra L A] [Algebra K A] [IsScalarTower K L A]

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

/-- If L is an algebraic field extension of K and A is an algebraic algebra over L,
then A is algebraic over K. -/
theorem isAlgebraic_trans (L_alg : IsAlgebraic K L) (A_alg : IsAlgebraic L A) : IsAlgebraic K A :=
  by
  simp only [IsAlgebraic, isAlgebraic_iff_isIntegral] at L_alg A_alg⊢
  exact isIntegral_trans L_alg A_alg
#align algebra.is_algebraic_trans Algebra.isAlgebraic_trans

variable (K L)

/-- If x is algebraic over R, then x is algebraic over S when S is an extension of R,
  and the map from `R` to `S` is injective. -/
theorem isAlgebraic_of_larger_base_of_injective (hinj : Function.Injective (algebraMap R S)) {x : A}
    (A_alg : IsAlgebraic R x) : IsAlgebraic S x :=
  let ⟨p, hp₁, hp₂⟩ := A_alg
  ⟨p.map (algebraMap _ _), by
    rwa [Ne.def, ← degree_eq_bot, degree_map_eq_of_injective hinj, degree_eq_bot], by simpa⟩
#align is_algebraic_of_larger_base_of_injective isAlgebraic_of_larger_base_of_injective

/-- If A is an algebraic algebra over R, then A is algebraic over S when S is an extension of R,
  and the map from `R` to `S` is injective. -/
theorem isAlgebraic_of_larger_base_of_injective (hinj : Function.Injective (algebraMap R S))
    (A_alg : IsAlgebraic R A) : IsAlgebraic S A := fun x =>
  isAlgebraic_of_larger_base_of_injective hinj (A_alg x)
#align algebra.is_algebraic_of_larger_base_of_injective Algebra.isAlgebraic_of_larger_base_of_injective

/-- If x is a algebraic over K, then x is algebraic over L when L is an extension of K -/
theorem isAlgebraic_of_larger_base {x : A} (A_alg : IsAlgebraic K x) : IsAlgebraic L x :=
  isAlgebraic_of_larger_base_of_injective (algebraMap K L).Injective A_alg
#align is_algebraic_of_larger_base isAlgebraic_of_larger_base

/-- If A is an algebraic algebra over K, then A is algebraic over L when L is an extension of K -/
theorem isAlgebraic_of_larger_base (A_alg : IsAlgebraic K A) : IsAlgebraic L A :=
  isAlgebraic_of_larger_base_of_injective (algebraMap K L).Injective A_alg
#align algebra.is_algebraic_of_larger_base Algebra.isAlgebraic_of_larger_base

variable (K L)

/-- A field extension is integral if it is finite. -/
theorem isIntegral_of_finite [FiniteDimensional K L] : Algebra.IsIntegral K L := fun x =>
  isIntegral_of_submodule_noetherian ⊤ (IsNoetherian.iff_fg.2 inferInstance) x Algebra.mem_top
#align algebra.is_integral_of_finite Algebra.isIntegral_of_finite

/-- A field extension is algebraic if it is finite. -/
theorem isAlgebraic_of_finite [finite : FiniteDimensional K L] : IsAlgebraic K L :=
  Algebra.isAlgebraic_iff_isIntegral.mpr (isIntegral_of_finite K L)
#align algebra.is_algebraic_of_finite Algebra.isAlgebraic_of_finite

variable {K L}

theorem IsAlgebraic.algHom_bijective (ha : Algebra.IsAlgebraic K L) (f : L →ₐ[K] L) :
    Function.Bijective f :=
  by
  refine' ⟨f.to_ring_hom.injective, fun b => _⟩
  obtain ⟨p, hp, he⟩ := ha b
  let f' : p.root_set L → p.root_set L := (root_set_maps_to' id f).restrict f _ _
  have : Function.Surjective f' :=
    Finite.injective_iff_surjective.1 fun _ _ h =>
      Subtype.eq <| f.to_ring_hom.injective <| Subtype.ext_iff.1 h
  obtain ⟨a, ha⟩ := this ⟨b, mem_root_set.2 ⟨hp, he⟩⟩
  exact ⟨a, Subtype.ext_iff.1 ha⟩
#align algebra.is_algebraic.alg_hom_bijective Algebra.IsAlgebraic.algHom_bijective

theorem AlgHom.bijective [FiniteDimensional K L] (ϕ : L →ₐ[K] L) : Function.Bijective ϕ :=
  (Algebra.isAlgebraic_of_finite K L).algHom_bijective ϕ
#align alg_hom.bijective AlgHom.bijective

variable (K L)

/-- Bijection between algebra equivalences and algebra homomorphisms -/
@[simps]
noncomputable def IsAlgebraic.algEquivEquivAlgHom (ha : Algebra.IsAlgebraic K L) :
    (L ≃ₐ[K] L) ≃* (L →ₐ[K] L) where
  toFun ϕ := ϕ.toAlgHom
  invFun ϕ := AlgEquiv.ofBijective ϕ (ha.algHom_bijective ϕ)
  left_inv _ := by
    ext
    rfl
  right_inv _ := by
    ext
    rfl
  map_mul' _ _ := rfl
#align algebra.is_algebraic.alg_equiv_equiv_alg_hom Algebra.IsAlgebraic.algEquivEquivAlgHom

/-- Bijection between algebra equivalences and algebra homomorphisms -/
@[reducible]
noncomputable def algEquivEquivAlgHom [FiniteDimensional K L] : (L ≃ₐ[K] L) ≃* (L →ₐ[K] L) :=
  (Algebra.isAlgebraic_of_finite K L).algEquivEquivAlgHom K L
#align alg_equiv_equiv_alg_hom algEquivEquivAlgHom

end Algebra

variable {R S : Type _} [CommRing R] [IsDomain R] [CommRing S]

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y «expr ≠ » (0 : R)) -/
theorem exists_integral_multiple [Algebra R S] {z : S} (hz : IsAlgebraic R z)
    (inj : ∀ x, algebraMap R S x = 0 → x = 0) :
    ∃ (x : integralClosure R S)(y : _)(_ : y ≠ (0 : R)), z * algebraMap R S y = x :=
  by
  rcases hz with ⟨p, p_ne_zero, px⟩
  set a := p.leading_coeff with a_def
  have a_ne_zero : a ≠ 0 := mt polynomial.leading_coeff_eq_zero.mp p_ne_zero
  have y_integral : IsIntegral R (algebraMap R S a) := isIntegral_algebraMap
  have x_integral : IsIntegral R (z * algebraMap R S a) :=
    ⟨p.integral_normalization, monic_integral_normalization p_ne_zero,
      integral_normalization_aeval_eq_zero px inj⟩
  exact ⟨⟨_, x_integral⟩, a, a_ne_zero, rfl⟩
#align exists_integral_multiple exists_integral_multiple

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (d «expr ≠ » (0 : R)) -/
/-- A fraction `(a : S) / (b : S)` can be reduced to `(c : S) / (d : R)`,
if `S` is the integral closure of `R` in an algebraic extension `L` of `R`. -/
theorem IsIntegralClosure.exists_smul_eq_mul {L : Type _} [Field L] [Algebra R S] [Algebra S L]
    [Algebra R L] [IsScalarTower R S L] [IsIntegralClosure S R L] (h : Algebra.IsAlgebraic R L)
    (inj : Function.Injective (algebraMap R L)) (a : S) {b : S} (hb : b ≠ 0) :
    ∃ (c : S)(d : _)(_ : d ≠ (0 : R)), d • a = b * c :=
  by
  obtain ⟨c, d, d_ne, hx⟩ :=
    exists_integral_multiple (h (algebraMap _ L a / algebraMap _ L b))
      ((injective_iff_map_eq_zero _).mp inj)
  refine'
    ⟨IsIntegralClosure.mk' S (c : L) c.2, d, d_ne, IsIntegralClosure.algebraMap_injective S R L _⟩
  simp only [Algebra.smul_def, RingHom.map_mul, IsIntegralClosure.algebraMap_mk', ← hx, ←
    IsScalarTower.algebraMap_apply]
  rw [← mul_assoc _ (_ / _), mul_div_cancel' (algebraMap S L a), mul_comm]
  exact mt ((injective_iff_map_eq_zero _).mp (IsIntegralClosure.algebraMap_injective S R L) _) hb
#align is_integral_closure.exists_smul_eq_mul IsIntegralClosure.exists_smul_eq_mul

section Field

variable {K L : Type _} [Field K] [Field L] [Algebra K L] (A : Subalgebra K L)

theorem inv_eq_of_aeval_divX_ne_zero {x : L} {p : K[X]} (aeval_ne : aeval x (divX p) ≠ 0) :
    x⁻¹ = aeval x (divX p) / (aeval x p - algebraMap _ _ (p.coeff 0)) :=
  by
  rw [inv_eq_iff_eq_inv, inv_div, eq_comm, div_eq_iff, sub_eq_iff_eq_add, mul_comm]
  conv_lhs => rw [← div_X_mul_X_add p]
  rw [AlgHom.map_add, AlgHom.map_mul, aeval_X, aeval_C]
  exact aeval_ne
#align inv_eq_of_aeval_div_X_ne_zero inv_eq_of_aeval_divX_ne_zero

theorem inv_eq_of_root_of_coeff_zero_ne_zero {x : L} {p : K[X]} (aeval_eq : aeval x p = 0)
    (coeff_zero_ne : p.coeff 0 ≠ 0) : x⁻¹ = -(aeval x (divX p) / algebraMap _ _ (p.coeff 0)) :=
  by
  convert inv_eq_of_aeval_divX_ne_zero (mt (fun h => (algebraMap K L).Injective _) coeff_zero_ne)
  · rw [aeval_eq, zero_sub, div_neg]
  rw [RingHom.map_zero]
  convert aeval_eq
  conv_rhs => rw [← div_X_mul_X_add p]
  rw [AlgHom.map_add, AlgHom.map_mul, h, MulZeroClass.zero_mul, zero_add, aeval_C]
#align inv_eq_of_root_of_coeff_zero_ne_zero inv_eq_of_root_of_coeff_zero_ne_zero

theorem Subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero {x : A} {p : K[X]}
    (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) : (x⁻¹ : L) ∈ A :=
  by
  suffices (x⁻¹ : L) = (-p.coeff 0)⁻¹ • aeval x (div_X p)
    by
    rw [this]
    exact A.smul_mem (aeval x _).2 _
  have : aeval (x : L) p = 0 := by rw [Subalgebra.aeval_coe, aeval_eq, Subalgebra.coe_zero]
  rw [inv_eq_of_root_of_coeff_zero_ne_zero this coeff_zero_ne, div_eq_inv_mul, Algebra.smul_def,
    map_inv₀, map_neg, inv_neg, neg_mul, Subalgebra.aeval_coe]
#align subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero Subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero

theorem Subalgebra.inv_mem_of_algebraic {x : A} (hx : IsAlgebraic K (x : L)) : (x⁻¹ : L) ∈ A :=
  by
  obtain ⟨p, ne_zero, aeval_eq⟩ := hx
  rw [Subalgebra.aeval_coe, Subalgebra.coe_eq_zero] at aeval_eq
  revert ne_zero aeval_eq
  refine' p.rec_on_horner _ _ _
  · intro h
    contradiction
  · intro p a hp ha ih ne_zero aeval_eq
    refine' A.inv_mem_of_root_of_coeff_zero_ne_zero aeval_eq _
    rwa [coeff_add, hp, zero_add, coeff_C, if_pos rfl]
  · intro p hp ih ne_zero aeval_eq
    rw [AlgHom.map_mul, aeval_X, mul_eq_zero] at aeval_eq
    cases' aeval_eq with aeval_eq x_eq
    · exact ih hp aeval_eq
    · rw [x_eq, Subalgebra.coe_zero, inv_zero]
      exact A.zero_mem
#align subalgebra.inv_mem_of_algebraic Subalgebra.inv_mem_of_algebraic

/-- In an algebraic extension L/K, an intermediate subalgebra is a field. -/
theorem Subalgebra.isField_of_algebraic (hKL : Algebra.IsAlgebraic K L) : IsField A :=
  { show Nontrivial A by infer_instance, Subalgebra.toCommRing A with
    mul_inv_cancel := fun a ha =>
      ⟨⟨a⁻¹, A.inv_mem_of_algebraic (hKL a)⟩,
        Subtype.ext (mul_inv_cancel (mt (Subalgebra.coe_eq_zero _).mp ha))⟩ }
#align subalgebra.is_field_of_algebraic Subalgebra.isField_of_algebraic

end Field

section Pi

variable (R' : Type u) (S' : Type v) (T' : Type w)

/-- This is not an instance as it forms a diamond with `pi.has_smul`.

See the `instance_diamonds` test for details. -/
def Polynomial.hasSmulPi [Semiring R'] [SMul R' S'] : SMul R'[X] (R' → S') :=
  ⟨fun p f x => eval x p • f x⟩
#align polynomial.has_smul_pi Polynomial.hasSmulPi

/-- This is not an instance as it forms a diamond with `pi.has_smul`.

See the `instance_diamonds` test for details. -/
noncomputable def Polynomial.hasSmulPi' [CommSemiring R'] [Semiring S'] [Algebra R' S']
    [SMul S' T'] : SMul R'[X] (S' → T') :=
  ⟨fun p f x => aeval x p • f x⟩
#align polynomial.has_smul_pi' Polynomial.hasSmulPi'

variable {R} {S}

attribute [local instance] Polynomial.hasSmulPi Polynomial.hasSmulPi'

@[simp]
theorem polynomial_smul_apply [Semiring R'] [SMul R' S'] (p : R'[X]) (f : R' → S') (x : R') :
    (p • f) x = eval x p • f x :=
  rfl
#align polynomial_smul_apply polynomial_smul_apply

@[simp]
theorem polynomial_smul_apply' [CommSemiring R'] [Semiring S'] [Algebra R' S'] [SMul S' T']
    (p : R'[X]) (f : S' → T') (x : S') : (p • f) x = aeval x p • f x :=
  rfl
#align polynomial_smul_apply' polynomial_smul_apply'

variable [CommSemiring R'] [CommSemiring S'] [CommSemiring T'] [Algebra R' S'] [Algebra S' T']

/-- This is not an instance for the same reasons as `polynomial.has_smul_pi'`. -/
noncomputable def Polynomial.algebraPi : Algebra R'[X] (S' → T') :=
  {
    Polynomial.hasSmulPi' R' S'
      T' with
    toFun := fun p z => algebraMap S' T' (aeval z p)
    map_one' := funext fun z => by simp only [Polynomial.aeval_one, Pi.one_apply, map_one]
    map_mul' := fun f g => funext fun z => by simp only [Pi.mul_apply, map_mul]
    map_zero' := funext fun z => by simp only [Polynomial.aeval_zero, Pi.zero_apply, map_zero]
    map_add' := fun f g =>
      funext fun z => by simp only [Polynomial.aeval_add, Pi.add_apply, map_add]
    commutes' := fun p f => funext fun z => mul_comm _ _
    smul_def' := fun p f =>
      funext fun z => by
        simp only [Algebra.algebraMap_eq_smul_one, polynomial_smul_apply', one_mul, Pi.mul_apply,
          Algebra.smul_mul_assoc] }
#align polynomial.algebra_pi Polynomial.algebraPi

attribute [local instance] Polynomial.algebraPi

@[simp]
theorem Polynomial.algebraMap_pi_eq_aeval :
    (algebraMap R'[X] (S' → T') : R'[X] → S' → T') = fun p z => algebraMap _ _ (aeval z p) :=
  rfl
#align polynomial.algebra_map_pi_eq_aeval Polynomial.algebraMap_pi_eq_aeval

@[simp]
theorem Polynomial.algebraMap_pi_self_eq_eval :
    (algebraMap R'[X] (R' → R') : R'[X] → R' → R') = fun p z => eval z p :=
  rfl
#align polynomial.algebra_map_pi_self_eq_eval Polynomial.algebraMap_pi_self_eq_eval

end Pi


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

! This file was ported from Lean 3 source module topology.algebra.infinite_sum.order
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Archimedean
import Mathlib.Topology.Algebra.InfiniteSum.Basic
import Mathlib.Topology.Algebra.Order.Field
import Mathlib.Topology.Algebra.Order.MonotoneConvergence

/-!
# Infinite sum in an order

This file provides lemmas about the interaction of infinite sums and order operations.
-/

open Finset Filter Function BigOperators
open scoped Classical

variable {ι κ α : Type _}

section Preorder

variable [Preorder α] [AddCommMonoid α] [TopologicalSpace α] [OrderClosedTopology α] [T2Space α]
  {f : ℕ → α} {c : α}

theorem tsum_le_of_sum_range_le (hf : Summable f) (h : ∀ n, (∑ i in range n, f i) ≤ c) :
    (∑' n, f n) ≤ c :=
  let ⟨_l, hl⟩ := hf
  hl.tsum_eq.symm ▸ le_of_tendsto' hl.tendsto_sum_nat h
#align tsum_le_of_sum_range_le tsum_le_of_sum_range_le

end Preorder

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid α] [TopologicalSpace α] [OrderClosedTopology α] {f g : ι → α}
  {a a₁ a₂ : α}

theorem hasSum_le (h : ∀ i, f i ≤ g i) (hf : HasSum f a₁) (hg : HasSum g a₂) : a₁ ≤ a₂ :=
  le_of_tendsto_of_tendsto' hf hg fun _ => sum_le_sum fun i _ => h i
#align has_sum_le hasSum_le

@[mono]
theorem hasSum_mono (hf : HasSum f a₁) (hg : HasSum g a₂) (h : f ≤ g) : a₁ ≤ a₂ :=
  hasSum_le h hf hg
#align has_sum_mono hasSum_mono

theorem hasSum_le_of_sum_le (hf : HasSum f a) (h : ∀ s, (∑ i in s, f i) ≤ a₂) : a ≤ a₂ :=
  le_of_tendsto' hf h
#align has_sum_le_of_sum_le hasSum_le_of_sum_le

theorem le_hasSum_of_le_sum (hf : HasSum f a) (h : ∀ s, a₂ ≤ ∑ i in s, f i) : a₂ ≤ a :=
  ge_of_tendsto' hf h
#align le_has_sum_of_le_sum le_hasSum_of_le_sum

theorem hasSum_le_inj {g : κ → α} (e : ι → κ) (he : Injective e)
    (hs : ∀ c, c ∉ Set.range e → 0 ≤ g c) (h : ∀ i, f i ≤ g (e i)) (hf : HasSum f a₁)
    (hg : HasSum g a₂) : a₁ ≤ a₂ := by
  rw [← hasSum_extend_zero he] at hf
  refine hasSum_le (fun c => ?_) hf hg
  obtain ⟨i, rfl⟩ | h := em (c ∈ Set.range e)
  · rw [he.extend_apply]
    exact h _
  · rw [extend_apply' _ _ _ h]
    exact hs _ h
#align has_sum_le_inj hasSum_le_inj

theorem tsum_le_tsum_of_inj {g : κ → α} (e : ι → κ) (he : Injective e)
    (hs : ∀ c, c ∉ Set.range e → 0 ≤ g c) (h : ∀ i, f i ≤ g (e i)) (hf : Summable f)
    (hg : Summable g) : tsum f ≤ tsum g :=
  hasSum_le_inj _ he hs h hf.hasSum hg.hasSum
#align tsum_le_tsum_of_inj tsum_le_tsum_of_inj

theorem sum_le_hasSum (s : Finset ι) (hs : ∀ i, i ∉ s → 0 ≤ f i) (hf : HasSum f a) :
    (∑ i in s, f i) ≤ a :=
  ge_of_tendsto hf (eventually_atTop.2
    ⟨s, fun _t hst => sum_le_sum_of_subset_of_nonneg hst fun i _ hbs => hs i hbs⟩)
#align sum_le_has_sum sum_le_hasSum

theorem isLUB_hasSum (h : ∀ i, 0 ≤ f i) (hf : HasSum f a) :
    IsLUB (Set.range fun s => ∑ i in s, f i) a :=
  isLUB_of_tendsto_atTop (Finset.sum_mono_set_of_nonneg h) hf
#align is_lub_has_sum isLUB_hasSum

theorem le_hasSum (hf : HasSum f a) (i : ι) (hb : ∀ j, j ≠ i → 0 ≤ f j) : f i ≤ a :=
  calc
    f i = ∑ i in {i}, f i := Finset.sum_singleton.symm
    _ ≤ a := sum_le_hasSum _ (by simpa) hf
#align le_has_sum le_hasSum

theorem sum_le_tsum {f : ι → α} (s : Finset ι) (hs : ∀ i, i ∉ s → 0 ≤ f i) (hf : Summable f) :
    (∑ i in s, f i) ≤ ∑' i, f i :=
  sum_le_hasSum s hs hf.hasSum
#align sum_le_tsum sum_le_tsum

theorem le_tsum (hf : Summable f) (i : ι) (hb : ∀ j, j ≠ i → 0 ≤ f j) : f i ≤ ∑' i, f i :=
  le_hasSum hf.hasSum i hb
#align le_tsum le_tsum

theorem tsum_le_tsum (h : ∀ i, f i ≤ g i) (hf : Summable f) (hg : Summable g) :
    (∑' i, f i) ≤ ∑' i, g i :=
  hasSum_le h hf.hasSum hg.hasSum
#align tsum_le_tsum tsum_le_tsum

@[mono]
theorem tsum_mono (hf : Summable f) (hg : Summable g) (h : f ≤ g) : (∑' n, f n) ≤ ∑' n, g n :=
  tsum_le_tsum h hf hg
#align tsum_mono tsum_mono

theorem tsum_le_of_sum_le (hf : Summable f) (h : ∀ s, (∑ i in s, f i) ≤ a₂) : (∑' i, f i) ≤ a₂ :=
  hasSum_le_of_sum_le hf.hasSum h
#align tsum_le_of_sum_le tsum_le_of_sum_le

theorem tsum_le_of_sum_le' (ha₂ : 0 ≤ a₂) (h : ∀ s, (∑ i in s, f i) ≤ a₂) : (∑' i, f i) ≤ a₂ := by
  by_cases hf : Summable f
  · exact tsum_le_of_sum_le hf h
  · rw [tsum_eq_zero_of_not_summable hf]
    exact ha₂
#align tsum_le_of_sum_le' tsum_le_of_sum_le'

theorem HasSum.nonneg (h : ∀ i, 0 ≤ g i) (ha : HasSum g a) : 0 ≤ a :=
  hasSum_le h hasSum_zero ha
#align has_sum.nonneg HasSum.nonneg

theorem HasSum.nonpos (h : ∀ i, g i ≤ 0) (ha : HasSum g a) : a ≤ 0 :=
  hasSum_le h ha hasSum_zero
#align has_sum.nonpos HasSum.nonpos

theorem tsum_nonneg (h : ∀ i, 0 ≤ g i) : 0 ≤ ∑' i, g i := by
  by_cases hg : Summable g
  · exact hg.hasSum.nonneg h
  · rw [tsum_eq_zero_of_not_summable hg]
#align tsum_nonneg tsum_nonneg

theorem tsum_nonpos (h : ∀ i, f i ≤ 0) : (∑' i, f i) ≤ 0 := by
  by_cases hf : Summable f
  · exact hf.hasSum.nonpos h
  · rw [tsum_eq_zero_of_not_summable hf]
#align tsum_nonpos tsum_nonpos

-- porting note: generalized from `OrderedAddCommGroup` to `OrderedAddCommMonoid`
theorem hasSum_zero_iff_of_nonneg (hf : ∀ i, 0 ≤ f i) : HasSum f 0 ↔ f = 0 := by
  refine' ⟨fun hf' => _, _⟩
  · ext i
    exact (hf i).antisymm' (le_hasSum hf' _ fun j _ => hf j)
  · rintro rfl
    exact hasSum_zero
#align has_sum_zero_iff_of_nonneg hasSum_zero_iff_of_nonneg

end OrderedAddCommMonoid

section OrderedAddCommGroup

variable [OrderedAddCommGroup α] [TopologicalSpace α] [TopologicalAddGroup α]
  [OrderClosedTopology α] {f g : ι → α} {a₁ a₂ : α} {i : ι}

theorem hasSum_lt (h : f ≤ g) (hi : f i < g i) (hf : HasSum f a₁) (hg : HasSum g a₂) : a₁ < a₂ := by
  have : update f i 0 ≤ update g i 0 := update_le_update_iff.mpr ⟨rfl.le, fun i _ => h i⟩
  have : 0 - f i + a₁ ≤ 0 - g i + a₂ := hasSum_le this (hf.update i 0) (hg.update i 0)
  simpa only [zero_sub, add_neg_cancel_left] using add_lt_add_of_lt_of_le hi this
#align has_sum_lt hasSum_lt

@[mono]
theorem hasSum_strict_mono (hf : HasSum f a₁) (hg : HasSum g a₂) (h : f < g) : a₁ < a₂ :=
  let ⟨hle, _i, hi⟩ := Pi.lt_def.mp h
  hasSum_lt hle hi hf hg
#align has_sum_strict_mono hasSum_strict_mono

theorem tsum_lt_tsum (h : f ≤ g) (hi : f i < g i) (hf : Summable f) (hg : Summable g) :
    (∑' n, f n) < ∑' n, g n :=
  hasSum_lt h hi hf.hasSum hg.hasSum
#align tsum_lt_tsum tsum_lt_tsum

@[mono]
theorem tsum_strict_mono (hf : Summable f) (hg : Summable g) (h : f < g) :
    (∑' n, f n) < ∑' n, g n :=
  let ⟨hle, _i, hi⟩ := Pi.lt_def.mp h
  tsum_lt_tsum hle hi hf hg
#align tsum_strict_mono tsum_strict_mono

theorem tsum_pos (hsum : Summable g) (hg : ∀ i, 0 ≤ g i) (i : ι) (hi : 0 < g i) :
    0 < ∑' i, g i := by
  rw [← tsum_zero]
  exact tsum_lt_tsum hg hi summable_zero hsum
#align tsum_pos tsum_pos

end OrderedAddCommGroup

section CanonicallyOrderedAddMonoid

variable [CanonicallyOrderedAddMonoid α] [TopologicalSpace α] [OrderClosedTopology α] {f : ι → α}
  {a : α}

theorem le_hasSum' (hf : HasSum f a) (i : ι) : f i ≤ a :=
  le_hasSum hf i fun _ _ => zero_le _
#align le_has_sum' le_hasSum'

theorem le_tsum' (hf : Summable f) (i : ι) : f i ≤ ∑' i, f i :=
  le_tsum hf i fun _ _ => zero_le _
#align le_tsum' le_tsum'

theorem hasSum_zero_iff : HasSum f 0 ↔ ∀ x, f x = 0 :=
  (hasSum_zero_iff_of_nonneg fun _ => zero_le _).trans funext_iff
#align has_sum_zero_iff hasSum_zero_iff

theorem tsum_eq_zero_iff (hf : Summable f) : (∑' i, f i) = 0 ↔ ∀ x, f x = 0 := by
  rw [← hasSum_zero_iff, hf.hasSum_iff]
#align tsum_eq_zero_iff tsum_eq_zero_iff

theorem tsum_ne_zero_iff (hf : Summable f) : (∑' i, f i) ≠ 0 ↔ ∃ x, f x ≠ 0 := by
  rw [Ne.def, tsum_eq_zero_iff hf, not_forall]
#align tsum_ne_zero_iff tsum_ne_zero_iff

theorem isLUB_hasSum' (hf : HasSum f a) : IsLUB (Set.range fun s => ∑ i in s, f i) a :=
  isLUB_of_tendsto_atTop (Finset.sum_mono_set f) hf
#align is_lub_has_sum' isLUB_hasSum'

end CanonicallyOrderedAddMonoid

section LinearOrder

/-!
For infinite sums taking values in a linearly ordered monoid, the existence of a least upper
bound for the finite sums is a criterion for summability.

This criterion is useful when applied in a linearly ordered monoid which is also a complete or
conditionally complete linear order, such as `ℝ`, `ℝ≥0`, `ℝ≥0∞`, because it is then easy to check
the existence of a least upper bound.
-/

theorem hasSum_of_isLUB_of_nonneg [LinearOrderedAddCommMonoid α] [TopologicalSpace α]
    [OrderTopology α] {f : ι → α} (i : α) (h : ∀ i, 0 ≤ f i)
    (hf : IsLUB (Set.range fun s => ∑ i in s, f i) i) : HasSum f i :=
  tendsto_atTop_isLUB (Finset.sum_mono_set_of_nonneg h) hf
#align has_sum_of_is_lub_of_nonneg hasSum_of_isLUB_of_nonneg

theorem hasSum_of_isLUB [CanonicallyLinearOrderedAddMonoid α] [TopologicalSpace α] [OrderTopology α]
    {f : ι → α} (b : α) (hf : IsLUB (Set.range fun s => ∑ i in s, f i) b) : HasSum f b :=
  tendsto_atTop_isLUB (Finset.sum_mono_set f) hf
#align has_sum_of_is_lub hasSum_of_isLUB

theorem summable_abs_iff [LinearOrderedAddCommGroup α] [UniformSpace α] [UniformAddGroup α]
    [CompleteSpace α] {f : ι → α} : (Summable fun x => |f x|) ↔ Summable f :=
  let s := { x | 0 ≤ f x }
  have h1 : ∀ x : s, |f x| = f x := fun x => abs_of_nonneg x.2
  have h2 : ∀ x : ↑(sᶜ), |f x| = -f x := fun x => abs_of_neg (not_le.1 x.2)
  calc (Summable fun x => |f x|) ↔
      (Summable fun x : s => |f x|) ∧ Summable fun x : ↑(sᶜ) => |f x| :=
        summable_subtype_and_compl.symm
  _ ↔ (Summable fun x : s => f x) ∧ Summable fun x : ↑(sᶜ) => -f x := by simp only [h1, h2]
  _ ↔ Summable f := by simp only [summable_neg_iff, summable_subtype_and_compl]
#align summable_abs_iff summable_abs_iff

alias summable_abs_iff ↔ Summable.of_abs Summable.abs
#align summable.of_abs Summable.of_abs
#align summable.abs Summable.abs

theorem Finite.of_summable_const [LinearOrderedAddCommGroup α] [TopologicalSpace α] [Archimedean α]
    [OrderClosedTopology α] {b : α} (hb : 0 < b) (hf : Summable fun _ : ι => b) :
    Finite ι := by
  have H : ∀ s : Finset ι, s.card • b ≤ ∑' _i : ι, b := fun s => by
    simpa using sum_le_hasSum s (fun a _ => hb.le) hf.hasSum
  obtain ⟨n, hn⟩ := Archimedean.arch (∑' _i : ι, b) hb
  have : ∀ s : Finset ι, s.card ≤ n := fun s => by
    simpa [nsmul_le_nsmul_iff hb] using (H s).trans hn
  have : Fintype ι := fintypeOfFinsetCardLe n this
  infer_instance

theorem Set.Finite.of_summable_const [LinearOrderedAddCommGroup α] [TopologicalSpace α]
    [Archimedean α] [OrderClosedTopology α] {b : α} (hb : 0 < b) (hf : Summable fun _ : ι => b) :
    (Set.univ : Set ι).Finite :=
  finite_univ_iff.2 <| .of_summable_const hb hf
#align finite_of_summable_const Set.Finite.of_summable_const

end LinearOrder

theorem Summable.tendsto_atTop_of_pos [LinearOrderedField α] [TopologicalSpace α] [OrderTopology α]
    {f : ℕ → α} (hf : Summable f⁻¹) (hf' : ∀ n, 0 < f n) : Tendsto f atTop atTop :=
  inv_inv f ▸ Filter.Tendsto.inv_tendsto_zero <|
    tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within _ hf.tendsto_atTop_zero <|
      eventually_of_forall fun _ => inv_pos.2 (hf' _)
#align summable.tendsto_top_of_pos Summable.tendsto_atTop_of_pos


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module data.matrix.rank
! leanprover-community/mathlib commit bf2a9e0156cc11bf44893ea1b4b2da8ae655c901
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FreeModule.Finite.Rank
import Mathbin.LinearAlgebra.Matrix.ToLin

/-!
# Rank of matrices

The rank of a matrix `A` is defined to be the rank of range of the linear map corresponding to `A`.
This definition does not depend on the choice of basis, see `matrix.rank_eq_finrank_range_to_lin`.

## Main declarations

* `matrix.rank`: the rank of a matrix

## TODO

* Show that `matrix.rank` is equal to the row-rank and column-rank
* Generalize away from fields

-/

open Matrix

namespace Matrix

open FiniteDimensional

variable {m n o K : Type _} [m_fin : Fintype m] [Fintype n] [Fintype o]

variable [DecidableEq n] [DecidableEq o] [Field K]

variable (A : Matrix m n K)

/-- The rank of a matrix is the rank of its image. -/
noncomputable def rank : ℕ :=
  finrank K A.toLin'.range
#align matrix.rank Matrix.rank

@[simp]
theorem rank_one : rank (1 : Matrix n n K) = Fintype.card n := by
  rw [rank, to_lin'_one, LinearMap.range_id, finrank_top, Module.Free.finrank_pi]
#align matrix.rank_one Matrix.rank_one

@[simp]
theorem rank_zero : rank (0 : Matrix n n K) = 0 := by
  rw [rank, LinearEquiv.map_zero, LinearMap.range_zero, finrank_bot]
#align matrix.rank_zero Matrix.rank_zero

theorem rank_le_card_width : A.rank ≤ Fintype.card n :=
  by
  convert le_of_add_le_left A.to_lin'.finrank_range_add_finrank_ker.le
  exact (Module.Free.finrank_pi K).symm
#align matrix.rank_le_card_width Matrix.rank_le_card_width

theorem rank_le_width {m n : ℕ} (A : Matrix (Fin m) (Fin n) K) : A.rank ≤ n :=
  A.rank_le_card_width.trans <| (Fintype.card_fin n).le
#align matrix.rank_le_width Matrix.rank_le_width

theorem rank_mul_le (B : Matrix n o K) : (A ⬝ B).rank ≤ A.rank :=
  by
  refine' LinearMap.finrank_le_finrank_of_injective (Submodule.ofLe_injective _)
  rw [to_lin'_mul]
  exact LinearMap.range_comp_le_range _ _
#align matrix.rank_mul_le Matrix.rank_mul_le

theorem rank_unit (A : (Matrix n n K)ˣ) : (A : Matrix n n K).rank = Fintype.card n :=
  by
  refine' le_antisymm (rank_le_card_width A) _
  have := rank_mul_le (A : Matrix n n K) (↑A⁻¹ : Matrix n n K)
  rwa [← mul_eq_mul, ← Units.val_mul, mul_inv_self, Units.val_one, rank_one] at this
#align matrix.rank_unit Matrix.rank_unit

theorem rank_of_isUnit (A : Matrix n n K) (h : IsUnit A) : A.rank = Fintype.card n :=
  by
  obtain ⟨A, rfl⟩ := h
  exact rank_unit A
#align matrix.rank_of_is_unit Matrix.rank_of_isUnit

include m_fin

theorem rank_eq_finrank_range_toLin {M₁ M₂ : Type _} [AddCommGroup M₁] [AddCommGroup M₂]
    [Module K M₁] [Module K M₂] (v₁ : Basis m K M₁) (v₂ : Basis n K M₂) :
    A.rank = finrank K (toLin v₂ v₁ A).range :=
  by
  let e₁ := (Pi.basisFun K m).Equiv v₁ (Equiv.refl _)
  let e₂ := (Pi.basisFun K n).Equiv v₂ (Equiv.refl _)
  have range_e₂ : (e₂ : (n → K) →ₗ[K] M₂).range = ⊤ :=
    by
    rw [LinearMap.range_eq_top]
    exact e₂.surjective
  refine' LinearEquiv.finrank_eq (e₁.of_submodules _ _ _)
  rw [← LinearMap.range_comp, ← LinearMap.range_comp_of_range_eq_top (to_lin v₂ v₁ A) range_e₂]
  congr 1
  apply LinearMap.pi_ext'
  rintro i
  apply LinearMap.ext_ring
  have aux₁ := to_lin_self (Pi.basisFun K n) (Pi.basisFun K m) A i
  have aux₂ := Basis.equiv_apply (Pi.basisFun K n) i v₂
  rw [to_lin_eq_to_lin'] at aux₁
  rw [Pi.basisFun_apply, LinearMap.coe_stdBasis] at aux₁ aux₂
  simp only [LinearMap.comp_apply, e₁, e₂, LinearEquiv.coe_coe, Equiv.refl_apply, aux₁, aux₂,
    LinearMap.coe_single, to_lin_self, LinearEquiv.map_sum, LinearEquiv.map_smul, Basis.equiv_apply]
#align matrix.rank_eq_finrank_range_to_lin Matrix.rank_eq_finrank_range_toLin

theorem rank_le_card_height : A.rank ≤ Fintype.card m :=
  (Submodule.finrank_le _).trans (Module.Free.finrank_pi K).le
#align matrix.rank_le_card_height Matrix.rank_le_card_height

omit m_fin

theorem rank_le_height {m n : ℕ} (A : Matrix (Fin m) (Fin n) K) : A.rank ≤ m :=
  A.rank_le_card_height.trans <| (Fintype.card_fin m).le
#align matrix.rank_le_height Matrix.rank_le_height

end Matrix


import .atom data.hash_map

namespace locally_nameless

inductive type : Type
| base : type
| arrow : type → type → type

inductive exp : Type
| var_b : ℕ → exp
| var_f : atom → exp
| const : ℕ → exp
| abs   : exp → exp
| app   : exp → exp → exp

open exp

def subst_exp (v:atom) (s:exp) : exp → exp
| (var_b n)   := var_b n
| (var_f x)   := if x = v then s else var_f x
| (const n)  := const n
| (abs e)     := abs (subst_exp e)
| (app e₁ e₂) := app (subst_exp e₁) (subst_exp e₂)

def fv_exp : exp → list atom
| (var_b nat) := []
| (var_f x)   := [x]
| (const n)   := []
| (abs e)     := fv_exp e
| (app e₁ e₂) := fv_exp e₁ ∪ fv_exp e₂

def open_exp_wrt_exp_core : ℕ → exp → exp → exp
| k s (var_b n) := match has_ordering.cmp n k with
               | ordering.lt  := var_b n
               | ordering.eq  := s
               | ordering.gt  := var_b (n-1)
               end

| k s (var_f x)   := var_f x
| k s (const n)   := const n
| k s (abs e)     := abs (open_exp_wrt_exp_core (k+1) s e)
| k s (app e₁ e₂) := app (open_exp_wrt_exp_core k s e₁) (open_exp_wrt_exp_core k s e₂)

def open_exp_wrt_exp (s e : exp) : exp := open_exp_wrt_exp_core 0 s e.

def context : Type := hash_map atom (λ a, exp)

def reduce : exp → option exp
| (app (abs f) a) := have exp.sizeof (open_exp_wrt_exp a f) < exp.sizeof f + (exp.sizeof a + 2), from sorry, reduce (open_exp_wrt_exp a f)
| (abs e)         := some (abs e)
| (const n)       := some (const n)
| (app _ _)       := none
| (var_b n)       := none
| (var_f v)       := none

#check @reduce.equations._eqn_1
#check @reduce.equations._eqn_2
#check @reduce.equations._eqn_3
#check @reduce.equations._eqn_4
#check @reduce.equations._eqn_5
#check @reduce.equations._eqn_6
#check @reduce.equations._eqn_7
#check @reduce.equations._eqn_8

lemma not_lt_refl : ∀ (n : ℕ), ¬ (n < n) := sorry

example : reduce (app (abs (var_b 0)) (const 5)) = some (const 5) :=
begin
simp [reduce, open_exp_wrt_exp, open_exp_wrt_exp_core, open_exp_wrt_exp_core._match_1, has_ordering.cmp, nat.cmp, not_lt_refl],
end

end locally_nameless


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

/-!
# Isomorphism theorems for modules.

* The Noether's first, second, and third isomorphism theorems for modules are proved as
  `linear_map.quot_ker_equiv_range`, `linear_map.quotient_inf_equiv_sup_quotient` and
  `submodule.quotient_quotient_equiv_quotient`.

-/

universes u v

variables {R M M₂ M₃ : Type*}
variables [ring R] [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M] [module R M₂] [module R M₃]
variables (f : M →ₗ[R] M₂)

/-! The first and second isomorphism theorems for modules. -/
namespace linear_map

open submodule

section isomorphism_laws

/-- The first isomorphism law for modules. The quotient of `M` by the kernel of `f` is linearly
equivalent to the range of `f`. -/
noncomputable def quot_ker_equiv_range : (M ⧸ f.ker) ≃ₗ[R] f.range :=
(linear_equiv.of_injective (f.ker.liftq f $ le_rfl) $
  ker_eq_bot.mp $ submodule.ker_liftq_eq_bot _ _ _ (le_refl f.ker)).trans
  (linear_equiv.of_eq _ _ $ submodule.range_liftq _ _ _)

/-- The first isomorphism theorem for surjective linear maps. -/
noncomputable def quot_ker_equiv_of_surjective
  (f : M →ₗ[R] M₂) (hf : function.surjective f) : (M ⧸ f.ker) ≃ₗ[R] M₂ :=
f.quot_ker_equiv_range.trans
  (linear_equiv.of_top f.range (linear_map.range_eq_top.2 hf))

@[simp] lemma quot_ker_equiv_range_apply_mk (x : M) :
  (f.quot_ker_equiv_range (submodule.quotient.mk x) : M₂) = f x :=
rfl

@[simp] lemma quot_ker_equiv_range_symm_apply_image (x : M) (h : f x ∈ f.range) :
  f.quot_ker_equiv_range.symm ⟨f x, h⟩ = f.ker.mkq x :=
f.quot_ker_equiv_range.symm_apply_apply (f.ker.mkq x)

/--
Canonical linear map from the quotient `p/(p ∩ p')` to `(p+p')/p'`, mapping `x + (p ∩ p')`
to `x + p'`, where `p` and `p'` are submodules of an ambient module.
-/
def quotient_inf_to_sup_quotient (p p' : submodule R M) :
  p ⧸ (comap p.subtype (p ⊓ p')) →ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') := by exact
(comap p.subtype (p ⊓ p')).liftq
  ((comap (p ⊔ p').subtype p').mkq.comp (of_le le_sup_left)) begin
rw [ker_comp, of_le, comap_cod_restrict, ker_mkq, map_comap_subtype],
exact comap_mono (inf_le_inf_right _ le_sup_left) end

/--
Second Isomorphism Law : the canonical map from `p/(p ∩ p')` to `(p+p')/p'` as a linear isomorphism.
-/
noncomputable def quotient_inf_equiv_sup_quotient (p p' : submodule R M) :
  (p ⧸ (comap p.subtype (p ⊓ p'))) ≃ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') := by exact
linear_equiv.of_bijective (quotient_inf_to_sup_quotient p p')
  ⟨begin
    rw [← ker_eq_bot, quotient_inf_to_sup_quotient, ker_liftq_eq_bot],
    rw [ker_comp, ker_mkq],
    exact λ ⟨x, hx1⟩ hx2, ⟨hx1, hx2⟩
  end,
  begin
    rw [← range_eq_top, quotient_inf_to_sup_quotient, range_liftq, eq_top_iff'],
    rintros ⟨x, hx⟩, rcases mem_sup.1 hx with ⟨y, hy, z, hz, rfl⟩,
    use [⟨y, hy⟩], apply (submodule.quotient.eq _).2,
    change y - (y + z) ∈ p',
    rwa [sub_add_eq_sub_sub, sub_self, zero_sub, neg_mem_iff]
  end⟩

@[simp] lemma coe_quotient_inf_to_sup_quotient (p p' : submodule R M) :
  ⇑(quotient_inf_to_sup_quotient p p') = quotient_inf_equiv_sup_quotient p p' := rfl

@[simp] lemma quotient_inf_equiv_sup_quotient_apply_mk (p p' : submodule R M) (x : p) :
  quotient_inf_equiv_sup_quotient p p' (submodule.quotient.mk x) =
    submodule.quotient.mk (of_le (le_sup_left : p ≤ p ⊔ p') x) :=
rfl

lemma quotient_inf_equiv_sup_quotient_symm_apply_left (p p' : submodule R M)
  (x : p ⊔ p') (hx : (x:M) ∈ p) :
  (quotient_inf_equiv_sup_quotient p p').symm (submodule.quotient.mk x) =
    submodule.quotient.mk ⟨x, hx⟩ :=
(linear_equiv.symm_apply_eq _).2 $ by simp [of_le_apply]

@[simp] lemma quotient_inf_equiv_sup_quotient_symm_apply_eq_zero_iff {p p' : submodule R M}
  {x : p ⊔ p'} :
  (quotient_inf_equiv_sup_quotient p p').symm (submodule.quotient.mk x) = 0 ↔ (x:M) ∈ p' :=
(linear_equiv.symm_apply_eq _).trans $ by simp [of_le_apply]

lemma quotient_inf_equiv_sup_quotient_symm_apply_right (p p' : submodule R M) {x : p ⊔ p'}
  (hx : (x:M) ∈ p') :
  (quotient_inf_equiv_sup_quotient p p').symm (submodule.quotient.mk x) = 0 :=
quotient_inf_equiv_sup_quotient_symm_apply_eq_zero_iff.2 hx

end isomorphism_laws

end linear_map

/-! The third isomorphism theorem for modules. -/
namespace submodule

variables (S T : submodule R M) (h : S ≤ T)

/-- The map from the third isomorphism theorem for modules: `(M / S) / (T / S) → M / T`. -/
def quotient_quotient_equiv_quotient_aux (h : S ≤ T) :
  (M ⧸ S) ⧸ (T.map S.mkq) →ₗ[R] M ⧸ T := by exact
liftq _ (mapq S T linear_map.id h)
  (by { rintro _ ⟨x, hx, rfl⟩, rw [linear_map.mem_ker, mkq_apply, mapq_apply],
        exact (quotient.mk_eq_zero _).mpr hx })

@[simp] lemma quotient_quotient_equiv_quotient_aux_mk (x : M ⧸ S) :
  quotient_quotient_equiv_quotient_aux S T h (quotient.mk x) = mapq S T linear_map.id h x :=
liftq_apply _ _ _

@[simp] lemma quotient_quotient_equiv_quotient_aux_mk_mk (x : M) :
  quotient_quotient_equiv_quotient_aux S T h (quotient.mk (quotient.mk x)) = quotient.mk x :=
by rw [quotient_quotient_equiv_quotient_aux_mk, mapq_apply, linear_map.id_apply]

/-- **Noether's third isomorphism theorem** for modules: `(M / S) / (T / S) ≃ M / T`. -/
def quotient_quotient_equiv_quotient :
  ((M ⧸ S) ⧸ (T.map S.mkq)) ≃ₗ[R] M ⧸ T :=
{ to_fun := quotient_quotient_equiv_quotient_aux S T h,
  inv_fun := mapq _ _ (mkq S) (le_comap_map _ _),
  left_inv := λ x, quotient.induction_on' x $ λ x, quotient.induction_on' x $ λ x, by simp,
  right_inv := λ x, quotient.induction_on' x $ λ x, by simp,
  .. quotient_quotient_equiv_quotient_aux S T h }

/-- Corollary of the third isomorphism theorem: `[S : T] [M : S] = [M : T]` -/
lemma card_quotient_mul_card_quotient (S T : submodule R M) (hST : T ≤ S)
  [decidable_pred (λ x, x ∈ S.map T.mkq)] [fintype (M ⧸ S)] [fintype (M ⧸ T)] :
  fintype.card (S.map T.mkq) * fintype.card (M ⧸ S) = fintype.card (M ⧸ T) :=
by rw [submodule.card_eq_card_quotient_mul_card (map T.mkq S),
       fintype.card_eq.mpr ⟨(quotient_quotient_equiv_quotient T S hST).to_equiv⟩]

end submodule