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

! This file was ported from Lean 3 source module analysis.calculus.taylor
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.IteratedDeriv
import Mathbin.Analysis.Calculus.MeanValue
import Mathbin.Data.Polynomial.Basic
import Mathbin.Data.Polynomial.Module

/-!
# Taylor's theorem

This file defines the Taylor polynomial of a real function `f : ℝ → E`,
where `E` is a normed vector space over `ℝ` and proves Taylor's theorem,
which states that if `f` is sufficiently smooth, then
`f` can be approximated by the Taylor polynomial up to an explicit error term.

## Main definitions

* `taylor_coeff_within`: the Taylor coefficient using `deriv_within`
* `taylor_within`: the Taylor polynomial using `deriv_within`

## Main statements

* `taylor_mean_remainder`: Taylor's theorem with the general form of the remainder term
* `taylor_mean_remainder_lagrange`: Taylor's theorem with the Lagrange remainder
* `taylor_mean_remainder_cauchy`: Taylor's theorem with the Cauchy remainder
* `exists_taylor_mean_remainder_bound`: Taylor's theorem for vector valued functions with a
polynomial bound on the remainder

## TODO

* the Peano form of the remainder
* the integral form of the remainder
* Generalization to higher dimensions

## Tags

Taylor polynomial, Taylor's theorem
-/

open BigOperators Interval Topology Nat

open Set

variable {𝕜 E F : Type _}

variable [NormedAddCommGroup E] [NormedSpace ℝ E]

/-- The `k`th coefficient of the Taylor polynomial. -/
noncomputable def taylorCoeffWithin (f : ℝ → E) (k : ℕ) (s : Set ℝ) (x₀ : ℝ) : E :=
  (k ! : ℝ)⁻¹ • iteratedDerivWithin k f s x₀
#align taylor_coeff_within taylorCoeffWithin

/-- The Taylor polynomial with derivatives inside of a set `s`.

The Taylor polynomial is given by
$$∑_{k=0}^n \frac{(x - x₀)^k}{k!} f^{(k)}(x₀),$$
where $f^{(k)}(x₀)$ denotes the iterated derivative in the set `s`. -/
noncomputable def taylorWithin (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ : ℝ) : PolynomialModule ℝ E :=
  (Finset.range (n + 1)).Sum fun k =>
    PolynomialModule.comp (Polynomial.X - Polynomial.C x₀)
      (PolynomialModule.single ℝ k (taylorCoeffWithin f k s x₀))
#align taylor_within taylorWithin

/-- The Taylor polynomial with derivatives inside of a set `s` considered as a function `ℝ → E`-/
noncomputable def taylorWithinEval (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ x : ℝ) : E :=
  PolynomialModule.eval x (taylorWithin f n s x₀)
#align taylor_within_eval taylorWithinEval

theorem taylorWithin_succ (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ : ℝ) :
    taylorWithin f (n + 1) s x₀ =
      taylorWithin f n s x₀ +
        PolynomialModule.comp (Polynomial.X - Polynomial.C x₀)
          (PolynomialModule.single ℝ (n + 1) (taylorCoeffWithin f (n + 1) s x₀)) :=
  by
  dsimp only [taylorWithin]
  rw [Finset.sum_range_succ]
#align taylor_within_succ taylorWithin_succ

@[simp]
theorem taylorWithinEval_succ (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ x : ℝ) :
    taylorWithinEval f (n + 1) s x₀ x =
      taylorWithinEval f n s x₀ x +
        (((n + 1 : ℝ) * n !)⁻¹ * (x - x₀) ^ (n + 1)) • iteratedDerivWithin (n + 1) f s x₀ :=
  by
  simp_rw [taylorWithinEval, taylorWithin_succ, LinearMap.map_add, PolynomialModule.comp_eval]
  congr
  simp only [Polynomial.eval_sub, Polynomial.eval_X, Polynomial.eval_C,
    PolynomialModule.eval_single, mul_inv_rev]
  dsimp only [taylorCoeffWithin]
  rw [← mul_smul, mul_comm, Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one,
    mul_inv_rev]
#align taylor_within_eval_succ taylorWithinEval_succ

/-- The Taylor polynomial of order zero evaluates to `f x`. -/
@[simp]
theorem taylor_within_zero_eval (f : ℝ → E) (s : Set ℝ) (x₀ x : ℝ) :
    taylorWithinEval f 0 s x₀ x = f x₀ :=
  by
  dsimp only [taylorWithinEval]
  dsimp only [taylorWithin]
  dsimp only [taylorCoeffWithin]
  simp
#align taylor_within_zero_eval taylor_within_zero_eval

/-- Evaluating the Taylor polynomial at `x = x₀` yields `f x`. -/
@[simp]
theorem taylorWithinEval_self (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ : ℝ) :
    taylorWithinEval f n s x₀ x₀ = f x₀ :=
  by
  induction' n with k hk
  · exact taylor_within_zero_eval _ _ _ _
  simp [hk]
#align taylor_within_eval_self taylorWithinEval_self

theorem taylor_within_apply (f : ℝ → E) (n : ℕ) (s : Set ℝ) (x₀ x : ℝ) :
    taylorWithinEval f n s x₀ x =
      ∑ k in Finset.range (n + 1), ((k ! : ℝ)⁻¹ * (x - x₀) ^ k) • iteratedDerivWithin k f s x₀ :=
  by
  induction' n with k hk
  · simp
  rw [taylorWithinEval_succ, Finset.sum_range_succ, hk]
  simp
#align taylor_within_apply taylor_within_apply

/-- If `f` is `n` times continuous differentiable on a set `s`, then the Taylor polynomial
  `taylor_within_eval f n s x₀ x` is continuous in `x₀`. -/
theorem continuousOn_taylorWithinEval {f : ℝ → E} {x : ℝ} {n : ℕ} {s : Set ℝ}
    (hs : UniqueDiffOn ℝ s) (hf : ContDiffOn ℝ n f s) :
    ContinuousOn (fun t => taylorWithinEval f n s t x) s :=
  by
  simp_rw [taylor_within_apply]
  refine' continuousOn_finset_sum (Finset.range (n + 1)) fun i hi => _
  refine' (continuous_on_const.mul ((continuous_on_const.sub continuousOn_id).pow _)).smul _
  rw [contDiffOn_iff_continuousOn_differentiableOn_deriv hs] at hf
  cases hf
  specialize hf_left i
  simp only [Finset.mem_range] at hi
  refine' hf_left _
  simp only [WithTop.coe_le_coe]
  exact nat.lt_succ_iff.mp hi
#align continuous_on_taylor_within_eval continuousOn_taylorWithinEval

/-- Helper lemma for calculating the derivative of the monomial that appears in Taylor expansions.-/
theorem monomial_has_deriv_aux (t x : ℝ) (n : ℕ) :
    HasDerivAt (fun y => (x - y) ^ (n + 1)) (-(n + 1) * (x - t) ^ n) t :=
  by
  simp_rw [sub_eq_neg_add]
  rw [← neg_one_mul, mul_comm (-1 : ℝ), mul_assoc, mul_comm (-1 : ℝ), ← mul_assoc]
  convert@HasDerivAt.pow _ _ _ _ _ (n + 1) ((hasDerivAt_id t).neg.AddConst x)
  simp only [Nat.cast_add, Nat.cast_one]
#align monomial_has_deriv_aux monomial_has_deriv_aux

theorem hasDerivWithinAt_taylor_coeff_within {f : ℝ → E} {x y : ℝ} {k : ℕ} {s s' : Set ℝ}
    (hs'_unique : UniqueDiffWithinAt ℝ s' y) (hs' : s' ∈ 𝓝[s] y) (hy : y ∈ s') (h : s' ⊆ s)
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin (k + 1) f s) s') :
    HasDerivWithinAt
      (fun t => (((k + 1 : ℝ) * k !)⁻¹ * (x - t) ^ (k + 1)) • iteratedDerivWithin (k + 1) f s t)
      ((((k + 1 : ℝ) * k !)⁻¹ * (x - y) ^ (k + 1)) • iteratedDerivWithin (k + 2) f s y -
        ((k ! : ℝ)⁻¹ * (x - y) ^ k) • iteratedDerivWithin (k + 1) f s y)
      s' y :=
  by
  have hf'' :
    HasDerivWithinAt (fun t => iteratedDerivWithin (k + 1) f s t)
      (iteratedDerivWithin (k + 2) f s y) s' y :=
    by
    convert(hf' y hy).HasDerivWithinAt
    rw [iteratedDerivWithin_succ (hs'_unique.mono h)]
    refine' (derivWithin_subset h hs'_unique _).symm
    exact (hf' y hy).antimono h hs'
  have :
    HasDerivWithinAt (fun t => ((k + 1 : ℝ) * k !)⁻¹ * (x - t) ^ (k + 1))
      (-((k ! : ℝ)⁻¹ * (x - y) ^ k)) s' y :=
    by
    -- Commuting the factors:
    have : -((k ! : ℝ)⁻¹ * (x - y) ^ k) = ((k + 1 : ℝ) * k !)⁻¹ * (-(k + 1) * (x - y) ^ k) :=
      by
      field_simp [Nat.cast_add_one_ne_zero k, Nat.factorial_ne_zero k]
      ring_nf
    rw [this]
    exact (monomial_has_deriv_aux y x _).HasDerivWithinAt.const_mul _
  convert this.smul hf''
  field_simp [Nat.cast_add_one_ne_zero k, Nat.factorial_ne_zero k]
  rw [neg_div, neg_smul, sub_eq_add_neg]
#align has_deriv_within_at_taylor_coeff_within hasDerivWithinAt_taylor_coeff_within

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for arbitrary sets -/
theorem hasDerivWithinAt_taylorWithinEval {f : ℝ → E} {x y : ℝ} {n : ℕ} {s s' : Set ℝ}
    (hs'_unique : UniqueDiffWithinAt ℝ s' y) (hs_unique : UniqueDiffOn ℝ s) (hs' : s' ∈ 𝓝[s] y)
    (hy : y ∈ s') (h : s' ⊆ s) (hf : ContDiffOn ℝ n f s)
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f s) s') :
    HasDerivWithinAt (fun t => taylorWithinEval f n s t x)
      (((n ! : ℝ)⁻¹ * (x - y) ^ n) • iteratedDerivWithin (n + 1) f s y) s' y :=
  by
  induction' n with k hk
  · simp only [taylor_within_zero_eval, Nat.factorial_zero, Nat.cast_one, inv_one, pow_zero,
      mul_one, zero_add, one_smul]
    simp only [iteratedDerivWithin_zero] at hf'
    rw [iteratedDerivWithin_one hs_unique (h hy)]
    refine' HasDerivWithinAt.mono _ h
    refine' DifferentiableWithinAt.hasDerivWithinAt _
    exact (hf' y hy).antimono h hs'
  simp_rw [Nat.add_succ, taylorWithinEval_succ]
  simp only [add_zero, Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one]
  have hdiff : DifferentiableOn ℝ (iteratedDerivWithin k f s) s' :=
    by
    have coe_lt_succ : (k : WithTop ℕ) < k.succ :=
      by
      rw [WithTop.coe_lt_coe]
      exact lt_add_one k
    refine' DifferentiableOn.mono _ h
    exact hf.differentiable_on_iterated_deriv_within coe_lt_succ hs_unique
  specialize hk (ContDiffOn.of_succ hf) hdiff
  convert hk.add (hasDerivWithinAt_taylor_coeff_within hs'_unique hs' hy h hf')
  exact (add_sub_cancel'_right _ _).symm
#align has_deriv_within_at_taylor_within_eval hasDerivWithinAt_taylorWithinEval

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for open intervals -/
theorem taylorWithinEval_hasDerivAt_Ioo {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ} (hx : a < b)
    (ht : t ∈ Ioo a b) (hf : ContDiffOn ℝ n f (Icc a b))
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc a b)) (Ioo a b)) :
    HasDerivAt (fun y => taylorWithinEval f n (Icc a b) y x)
      (((n ! : ℝ)⁻¹ * (x - t) ^ n) • iteratedDerivWithin (n + 1) f (Icc a b) t) t :=
  haveI h_nhds := IsOpen.mem_nhds isOpen_Ioo ht
  (hasDerivWithinAt_taylorWithinEval (uniqueDiffWithinAt_Ioo ht) (uniqueDiffOn_Icc hx)
        (nhdsWithin_le_nhds h_nhds) ht Ioo_subset_Icc_self hf hf').HasDerivAt
    h_nhds
#align taylor_within_eval_has_deriv_at_Ioo taylorWithinEval_hasDerivAt_Ioo

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for closed intervals -/
theorem has_deriv_within_taylorWithinEval_at_Icc {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ}
    (hx : a < b) (ht : t ∈ Icc a b) (hf : ContDiffOn ℝ n f (Icc a b))
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc a b)) (Icc a b)) :
    HasDerivWithinAt (fun y => taylorWithinEval f n (Icc a b) y x)
      (((n ! : ℝ)⁻¹ * (x - t) ^ n) • iteratedDerivWithin (n + 1) f (Icc a b) t) (Icc a b) t :=
  hasDerivWithinAt_taylorWithinEval (uniqueDiffOn_Icc hx t ht) (uniqueDiffOn_Icc hx)
    self_mem_nhdsWithin ht rfl.Subset hf hf'
#align has_deriv_within_taylor_within_eval_at_Icc has_deriv_within_taylorWithinEval_at_Icc

/-! ### Taylor's theorem with mean value type remainder estimate -/

/-- **Taylor's theorem** with the general mean value form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`, and `g` is a differentiable function on
`Ioo x₀ x` and continuous on `Icc x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{(x - x')^n}{n!} \frac{g(x) - g(x₀)}{g' x'},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$. -/
theorem taylor_mean_remainder {f : ℝ → ℝ} {g g' : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
    (hf : ContDiffOn ℝ n f (Icc x₀ x))
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc x₀ x)) (Ioo x₀ x))
    (gcont : ContinuousOn g (Icc x₀ x))
    (gdiff : ∀ x_1 : ℝ, x_1 ∈ Ioo x₀ x → HasDerivAt g (g' x_1) x_1)
    (g'_ne : ∀ x_1 : ℝ, x_1 ∈ Ioo x₀ x → g' x_1 ≠ 0) :
    ∃ (x' : ℝ)(hx' : x' ∈ Ioo x₀ x),
      f x - taylorWithinEval f n (Icc x₀ x) x₀ x =
        ((x - x') ^ n / n ! * (g x - g x₀) / g' x') • iteratedDerivWithin (n + 1) f (Icc x₀ x) x' :=
  by
  -- We apply the mean value theorem
  rcases exists_ratio_hasDerivAt_eq_ratio_slope (fun t => taylorWithinEval f n (Icc x₀ x) t x)
      (fun t => ((n ! : ℝ)⁻¹ * (x - t) ^ n) • iteratedDerivWithin (n + 1) f (Icc x₀ x) t) hx
      (continuousOn_taylorWithinEval (uniqueDiffOn_Icc hx) hf)
      (fun _ hy => taylorWithinEval_hasDerivAt_Ioo x hx hy hf hf') g g' gcont gdiff with
    ⟨y, hy, h⟩
  use y, hy
  -- The rest is simplifications and trivial calculations
  simp only [taylorWithinEval_self] at h
  rw [mul_comm, ← div_left_inj' (g'_ne y hy), mul_div_cancel _ (g'_ne y hy)] at h
  rw [← h]
  field_simp [g'_ne y hy, n.factorial_ne_zero]
  ring
#align taylor_mean_remainder taylor_mean_remainder

/-- **Taylor's theorem** with the Lagrange form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x₀)^{n+1}}{(n+1)!},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated
derivative. -/
theorem taylor_mean_remainder_lagrange {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
    (hf : ContDiffOn ℝ n f (Icc x₀ x))
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc x₀ x)) (Ioo x₀ x)) :
    ∃ (x' : ℝ)(hx' : x' ∈ Ioo x₀ x),
      f x - taylorWithinEval f n (Icc x₀ x) x₀ x =
        iteratedDerivWithin (n + 1) f (Icc x₀ x) x' * (x - x₀) ^ (n + 1) / (n + 1)! :=
  by
  have gcont : ContinuousOn (fun t : ℝ => (x - t) ^ (n + 1)) (Icc x₀ x) :=
    by
    refine' Continuous.continuousOn _
    continuity
  have xy_ne : ∀ y : ℝ, y ∈ Ioo x₀ x → (x - y) ^ n ≠ 0 :=
    by
    intro y hy
    refine' pow_ne_zero _ _
    rw [mem_Ioo] at hy
    rw [sub_ne_zero]
    exact hy.2.Ne.symm
  have hg' : ∀ y : ℝ, y ∈ Ioo x₀ x → -(↑n + 1) * (x - y) ^ n ≠ 0 := fun y hy =>
    mul_ne_zero (neg_ne_zero.mpr (Nat.cast_add_one_ne_zero n)) (xy_ne y hy)
  -- We apply the general theorem with g(t) = (x - t)^(n+1)
  rcases taylor_mean_remainder hx hf hf' gcont (fun y _ => monomial_has_deriv_aux y x _) hg' with
    ⟨y, hy, h⟩
  use y, hy
  simp only [sub_self, zero_pow', Ne.def, Nat.succ_ne_zero, not_false_iff, zero_sub, mul_neg] at h
  rw [h, neg_div, ← div_neg, neg_mul, neg_neg]
  field_simp [n.cast_add_one_ne_zero, n.factorial_ne_zero, xy_ne y hy]
  ring
#align taylor_mean_remainder_lagrange taylor_mean_remainder_lagrange

/-- **Taylor's theorem** with the Cauchy form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x')^n (x-x₀)}{n!},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated
derivative. -/
theorem taylor_mean_remainder_cauchy {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
    (hf : ContDiffOn ℝ n f (Icc x₀ x))
    (hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc x₀ x)) (Ioo x₀ x)) :
    ∃ (x' : ℝ)(hx' : x' ∈ Ioo x₀ x),
      f x - taylorWithinEval f n (Icc x₀ x) x₀ x =
        iteratedDerivWithin (n + 1) f (Icc x₀ x) x' * (x - x') ^ n / n ! * (x - x₀) :=
  by
  have gcont : ContinuousOn id (Icc x₀ x) := Continuous.continuousOn (by continuity)
  have gdiff : ∀ x_1 : ℝ, x_1 ∈ Ioo x₀ x → HasDerivAt id ((fun t : ℝ => (1 : ℝ)) x_1) x_1 :=
    fun _ _ => hasDerivAt_id _
  -- We apply the general theorem with g = id
  rcases taylor_mean_remainder hx hf hf' gcont gdiff fun _ _ => by simp with ⟨y, hy, h⟩
  use y, hy
  rw [h]
  field_simp [n.factorial_ne_zero]
  ring
#align taylor_mean_remainder_cauchy taylor_mean_remainder_cauchy

/-- **Taylor's theorem** with a polynomial bound on the remainder

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`.
The difference of `f` and its `n`-th Taylor polynomial can be estimated by
`C * (x - a)^(n+1) / n!` where `C` is a bound for the `n+1`-th iterated derivative of `f`. -/
theorem taylor_mean_remainder_bound {f : ℝ → E} {a b C x : ℝ} {n : ℕ} (hab : a ≤ b)
    (hf : ContDiffOn ℝ (n + 1) f (Icc a b)) (hx : x ∈ Icc a b)
    (hC : ∀ y ∈ Icc a b, ‖iteratedDerivWithin (n + 1) f (Icc a b) y‖ ≤ C) :
    ‖f x - taylorWithinEval f n (Icc a b) a x‖ ≤ C * (x - a) ^ (n + 1) / n ! :=
  by
  rcases eq_or_lt_of_le hab with (rfl | h)
  · rw [Icc_self, mem_singleton_iff] at hx
    simp [hx]
  -- The nth iterated derivative is differentiable
  have hf' : DifferentiableOn ℝ (iteratedDerivWithin n f (Icc a b)) (Icc a b) :=
    hf.differentiable_on_iterated_deriv_within (with_top.coe_lt_coe.mpr n.lt_succ_self)
      (uniqueDiffOn_Icc h)
  -- We can uniformly bound the derivative of the Taylor polynomial
  have h' :
    ∀ (y : ℝ) (hy : y ∈ Ico a x),
      ‖((n ! : ℝ)⁻¹ * (x - y) ^ n) • iteratedDerivWithin (n + 1) f (Icc a b) y‖ ≤
        (n ! : ℝ)⁻¹ * |x - a| ^ n * C :=
    by
    rintro y ⟨hay, hyx⟩
    rw [norm_smul, Real.norm_eq_abs]
    -- Estimate the iterated derivative by `C`
    refine' mul_le_mul _ (hC y ⟨hay, hyx.le.trans hx.2⟩) (by positivity) (by positivity)
    -- The rest is a trivial calculation
    rw [abs_mul, abs_pow, abs_inv, Nat.abs_cast]
    mono* with 0 ≤ (n ! : ℝ)⁻¹
    any_goals positivity
    linarith [hx.1, hyx]
  -- Apply the mean value theorem for vector valued functions:
  have A :
    ∀ t ∈ Icc a x,
      HasDerivWithinAt (fun y => taylorWithinEval f n (Icc a b) y x)
        (((↑n !)⁻¹ * (x - t) ^ n) • iteratedDerivWithin (n + 1) f (Icc a b) t) (Icc a x) t :=
    by
    intro t ht
    have I : Icc a x ⊆ Icc a b := Icc_subset_Icc_right hx.2
    exact (has_deriv_within_taylorWithinEval_at_Icc x h (I ht) hf.of_succ hf').mono I
  have := norm_image_sub_le_of_norm_deriv_le_segment' A h' x (right_mem_Icc.2 hx.1)
  simp only [taylorWithinEval_self] at this
  refine' this.trans_eq _
  -- The rest is a trivial calculation
  rw [abs_of_nonneg (sub_nonneg.mpr hx.1)]
  ring
#align taylor_mean_remainder_bound taylor_mean_remainder_bound

/-- **Taylor's theorem** with a polynomial bound on the remainder

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`.
There exists a constant `C` such that for all `x ∈ Icc a b` the difference of `f` and its `n`-th
Taylor polynomial can be estimated by `C * (x - a)^(n+1)`. -/
theorem exists_taylor_mean_remainder_bound {f : ℝ → E} {a b : ℝ} {n : ℕ} (hab : a ≤ b)
    (hf : ContDiffOn ℝ (n + 1) f (Icc a b)) :
    ∃ C, ∀ x ∈ Icc a b, ‖f x - taylorWithinEval f n (Icc a b) a x‖ ≤ C * (x - a) ^ (n + 1) :=
  by
  rcases eq_or_lt_of_le hab with (rfl | h)
  · refine' ⟨0, fun x hx => _⟩
    have : a = x := by simpa [← le_antisymm_iff] using hx
    simp [← this]
  -- We estimate by the supremum of the norm of the iterated derivative
  let g : ℝ → ℝ := fun y => ‖iteratedDerivWithin (n + 1) f (Icc a b) y‖
  use SupSet.supₛ (g '' Icc a b) / n !
  intro x hx
  rw [div_mul_eq_mul_div₀]
  refine' taylor_mean_remainder_bound hab hf hx fun y => _
  exact (hf.continuous_on_iterated_deriv_within rfl.le <| uniqueDiffOn_Icc h).norm.le_supₛ_image_Icc
#align exists_taylor_mean_remainder_bound exists_taylor_mean_remainder_bound


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.metric_space.closeds
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecificLimits.Basic
import Mathbin.Topology.MetricSpace.HausdorffDistance
import Mathbin.Topology.Sets.Compacts

/-!
# Closed subsets

This file defines the metric and emetric space structure on the types of closed subsets and nonempty
compact subsets of a metric or emetric space.

The Hausdorff distance induces an emetric space structure on the type of closed subsets
of an emetric space, called `closeds`. Its completeness, resp. compactness, resp.
second-countability, follow from the corresponding properties of the original space.

In a metric space, the type of nonempty compact subsets (called `nonempty_compacts`) also
inherits a metric space structure from the Hausdorff distance, as the Hausdorff edistance is
always finite in this context.
-/

noncomputable section

open Classical Topology ENNReal

universe u

open Classical Set Function TopologicalSpace Filter

namespace Emetric

section

variable {α : Type u} [EMetricSpace α] {s : Set α}

/-- In emetric spaces, the Hausdorff edistance defines an emetric space structure
on the type of closed subsets -/
instance Closeds.emetricSpace : EMetricSpace (Closeds α)
    where
  edist s t := hausdorffEdist (s : Set α) t
  edist_self s := hausdorffEdist_self
  edist_comm s t := hausdorffEdist_comm
  edist_triangle s t u := hausdorffEdist_triangle
  eq_of_edist_eq_zero s t h :=
    Closeds.ext <| (hausdorffEdist_zero_iff_eq_of_closed s.closed t.closed).1 h
#align emetric.closeds.emetric_space Emetric.Closeds.emetricSpace

/-- The edistance to a closed set depends continuously on the point and the set -/
theorem continuous_infEdist_Hausdorff_edist :
    Continuous fun p : α × Closeds α => infEdist p.1 p.2 :=
  by
  refine' continuous_of_le_add_edist 2 (by simp) _
  rintro ⟨x, s⟩ ⟨y, t⟩
  calc
    inf_edist x s ≤ inf_edist x t + Hausdorff_edist (t : Set α) s :=
      inf_edist_le_inf_edist_add_Hausdorff_edist
    _ ≤ inf_edist y t + edist x y + Hausdorff_edist (t : Set α) s :=
      (add_le_add_right inf_edist_le_inf_edist_add_edist _)
    _ = inf_edist y t + (edist x y + Hausdorff_edist (s : Set α) t) := by
      rw [add_assoc, Hausdorff_edist_comm]
    _ ≤ inf_edist y t + (edist (x, s) (y, t) + edist (x, s) (y, t)) :=
      (add_le_add_left (add_le_add (le_max_left _ _) (le_max_right _ _)) _)
    _ = inf_edist y t + 2 * edist (x, s) (y, t) := by rw [← mul_two, mul_comm]

#align emetric.continuous_inf_edist_Hausdorff_edist Emetric.continuous_infEdist_Hausdorff_edist

/-- Subsets of a given closed subset form a closed set -/
theorem isClosed_subsets_of_isClosed (hs : IsClosed s) :
    IsClosed { t : Closeds α | (t : Set α) ⊆ s } :=
  by
  refine' isClosed_of_closure_subset fun t ht x hx => _
  -- t : closeds α,  ht : t ∈ closure {t : closeds α | t ⊆ s},
  -- x : α,  hx : x ∈ t
  -- goal : x ∈ s
  have : x ∈ closure s := by
    refine' mem_closure_iff.2 fun ε εpos => _
    rcases mem_closure_iff.1 ht ε εpos with ⟨u, hu, Dtu⟩
    -- u : closeds α,  hu : u ∈ {t : closeds α | t ⊆ s},  hu' : edist t u < ε
    rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dtu with ⟨y, hy, Dxy⟩
    -- y : α,  hy : y ∈ u, Dxy : edist x y < ε
    exact ⟨y, hu hy, Dxy⟩
  rwa [hs.closure_eq] at this
#align emetric.is_closed_subsets_of_is_closed Emetric.isClosed_subsets_of_isClosed

/-- By definition, the edistance on `closeds α` is given by the Hausdorff edistance -/
theorem Closeds.edist_eq {s t : Closeds α} : edist s t = hausdorffEdist (s : Set α) t :=
  rfl
#align emetric.closeds.edist_eq Emetric.Closeds.edist_eq

/-- In a complete space, the type of closed subsets is complete for the
Hausdorff edistance. -/
instance Closeds.completeSpace [CompleteSpace α] : CompleteSpace (Closeds α) :=
  by
  /- We will show that, if a sequence of sets `s n` satisfies
    `edist (s n) (s (n+1)) < 2^{-n}`, then it converges. This is enough to guarantee
    completeness, by a standard completeness criterion.
    We use the shorthand `B n = 2^{-n}` in ennreal. -/
  let B : ℕ → ℝ≥0∞ := fun n => 2⁻¹ ^ n
  have B_pos : ∀ n, (0 : ℝ≥0∞) < B n := by simp [B, ENNReal.pow_pos]
  have B_ne_top : ∀ n, B n ≠ ⊤ := by simp [B, ENNReal.pow_ne_top]
  /- Consider a sequence of closed sets `s n` with `edist (s n) (s (n+1)) < B n`.
    We will show that it converges. The limit set is t0 = ⋂n, closure (⋃m≥n, s m).
    We will have to show that a point in `s n` is close to a point in `t0`, and a point
    in `t0` is close to a point in `s n`. The completeness then follows from a
    standard criterion. -/
  refine' complete_of_convergent_controlled_sequences B B_pos fun s hs => _
  let t0 := ⋂ n, closure (⋃ m ≥ n, s m : Set α)
  let t : closeds α := ⟨t0, isClosed_interᵢ fun _ => isClosed_closure⟩
  use t
  -- The inequality is written this way to agree with `edist_le_of_edist_le_geometric_of_tendsto₀`
  have I1 : ∀ n, ∀ x ∈ s n, ∃ y ∈ t0, edist x y ≤ 2 * B n :=
    by
    /- This is the main difficulty of the proof. Starting from `x ∈ s n`, we want
           to find a point in `t0` which is close to `x`. Define inductively a sequence of
           points `z m` with `z n = x` and `z m ∈ s m` and `edist (z m) (z (m+1)) ≤ B m`. This is
           possible since the Hausdorff distance between `s m` and `s (m+1)` is at most `B m`.
           This sequence is a Cauchy sequence, therefore converging as the space is complete, to
           a limit which satisfies the required properties. -/
    intro n x hx
    obtain ⟨z, hz₀, hz⟩ :
      ∃ z : ∀ l, s (n + l), (z 0 : α) = x ∧ ∀ k, edist (z k : α) (z (k + 1) : α) ≤ B n / 2 ^ k :=
      by
      -- We prove existence of the sequence by induction.
      have : ∀ (l) (z : s (n + l)), ∃ z' : s (n + l + 1), edist (z : α) z' ≤ B n / 2 ^ l :=
        by
        intro l z
        obtain ⟨z', z'_mem, hz'⟩ : ∃ z' ∈ s (n + l + 1), edist (z : α) z' < B n / 2 ^ l :=
          by
          refine' exists_edist_lt_of_Hausdorff_edist_lt _ _
          · exact s (n + l)
          · exact z.2
          simp only [B, ENNReal.inv_pow, div_eq_mul_inv]
          rw [← pow_add]
          apply hs <;> simp
        exact ⟨⟨z', z'_mem⟩, le_of_lt hz'⟩
      use fun k => Nat.recOn k ⟨x, hx⟩ fun l z => some (this l z), rfl
      exact fun k => some_spec (this k _)
    -- it follows from the previous bound that `z` is a Cauchy sequence
    have : CauchySeq fun k => (z k : α) := cauchySeq_of_edist_le_geometric_two (B n) (B_ne_top n) hz
    -- therefore, it converges
    rcases cauchySeq_tendsto_of_complete this with ⟨y, y_lim⟩
    use y
    -- the limit point `y` will be the desired point, in `t0` and close to our initial point `x`.
    -- First, we check it belongs to `t0`.
    have : y ∈ t0 :=
      mem_Inter.2 fun k =>
        mem_closure_of_tendsto y_lim
          (by
            simp only [exists_prop, Set.mem_unionᵢ, Filter.eventually_atTop, Set.mem_preimage,
              Set.preimage_unionᵢ]
            exact ⟨k, fun m hm => ⟨n + m, zero_add k ▸ add_le_add (zero_le n) hm, (z m).2⟩⟩)
    use this
    -- Then, we check that `y` is close to `x = z n`. This follows from the fact that `y`
    -- is the limit of `z k`, and the distance between `z n` and `z k` has already been estimated.
    rw [← hz₀]
    exact edist_le_of_edist_le_geometric_two_of_tendsto₀ (B n) hz y_lim
  have I2 : ∀ n, ∀ x ∈ t0, ∃ y ∈ s n, edist x y ≤ 2 * B n :=
    by
    /- For the (much easier) reverse inequality, we start from a point `x ∈ t0` and we want
            to find a point `y ∈ s n` which is close to `x`.
            `x` belongs to `t0`, the intersection of the closures. In particular, it is well
            approximated by a point `z` in `⋃m≥n, s m`, say in `s m`. Since `s m` and
            `s n` are close, this point is itself well approximated by a point `y` in `s n`,
            as required. -/
    intro n x xt0
    have : x ∈ closure (⋃ m ≥ n, s m : Set α) := by apply mem_Inter.1 xt0 n
    rcases mem_closure_iff.1 this (B n) (B_pos n) with ⟨z, hz, Dxz⟩
    -- z : α,  Dxz : edist x z < B n,
    simp only [exists_prop, Set.mem_unionᵢ] at hz
    rcases hz with ⟨m, ⟨m_ge_n, hm⟩⟩
    -- m : ℕ, m_ge_n : m ≥ n, hm : z ∈ s m
    have : Hausdorff_edist (s m : Set α) (s n) < B n := hs n m n m_ge_n (le_refl n)
    rcases exists_edist_lt_of_Hausdorff_edist_lt hm this with ⟨y, hy, Dzy⟩
    -- y : α,  hy : y ∈ s n,  Dzy : edist z y < B n
    exact
      ⟨y, hy,
        calc
          edist x y ≤ edist x z + edist z y := edist_triangle _ _ _
          _ ≤ B n + B n := (add_le_add (le_of_lt Dxz) (le_of_lt Dzy))
          _ = 2 * B n := (two_mul _).symm
          ⟩
  -- Deduce from the above inequalities that the distance between `s n` and `t0` is at most `2 B n`.
  have main : ∀ n : ℕ, edist (s n) t ≤ 2 * B n := fun n =>
    Hausdorff_edist_le_of_mem_edist (I1 n) (I2 n)
  -- from this, the convergence of `s n` to `t0` follows.
  refine' tendsto_at_top.2 fun ε εpos => _
  have : tendsto (fun n => 2 * B n) at_top (𝓝 (2 * 0)) :=
    ENNReal.Tendsto.const_mul
      (ENNReal.tendsto_pow_atTop_nhds_0_of_lt_1 <| by simp [ENNReal.one_lt_two]) (Or.inr <| by simp)
  rw [MulZeroClass.mul_zero] at this
  obtain ⟨N, hN⟩ : ∃ N, ∀ b ≥ N, ε > 2 * B b
  exact ((tendsto_order.1 this).2 ε εpos).exists_forall_of_atTop
  exact ⟨N, fun n hn => lt_of_le_of_lt (main n) (hN n hn)⟩
#align emetric.closeds.complete_space Emetric.Closeds.completeSpace

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ⊆ » s) -/
/-- In a compact space, the type of closed subsets is compact. -/
instance Closeds.compactSpace [CompactSpace α] : CompactSpace (Closeds α) :=
  ⟨by
    /- by completeness, it suffices to show that it is totally bounded,
        i.e., for all ε>0, there is a finite set which is ε-dense.
        start from a set `s` which is ε-dense in α. Then the subsets of `s`
        are finitely many, and ε-dense for the Hausdorff distance. -/
    refine'
      isCompact_of_totallyBounded_isClosed (EMetric.totallyBounded_iff.2 fun ε εpos => _)
        isClosed_univ
    rcases exists_between εpos with ⟨δ, δpos, δlt⟩
    rcases EMetric.totallyBounded_iff.1
        (isCompact_iff_totallyBounded_isComplete.1 (@isCompact_univ α _ _)).1 δ δpos with
      ⟨s, fs, hs⟩
    -- s : set α,  fs : s.finite,  hs : univ ⊆ ⋃ (y : α) (H : y ∈ s), eball y δ
    -- we first show that any set is well approximated by a subset of `s`.
    have main : ∀ u : Set α, ∃ (v : _)(_ : v ⊆ s), Hausdorff_edist u v ≤ δ :=
      by
      intro u
      let v := { x : α | x ∈ s ∧ ∃ y ∈ u, edist x y < δ }
      exists v, (fun x hx => hx.1 : v ⊆ s)
      refine' Hausdorff_edist_le_of_mem_edist _ _
      · intro x hx
        have : x ∈ ⋃ y ∈ s, ball y δ := hs (by simp)
        rcases mem_Union₂.1 this with ⟨y, ys, dy⟩
        have : edist y x < δ := by simp at dy <;> rwa [edist_comm] at dy
        exact ⟨y, ⟨ys, ⟨x, hx, this⟩⟩, le_of_lt dy⟩
      · rintro x ⟨hx1, ⟨y, yu, hy⟩⟩
        exact ⟨y, yu, le_of_lt hy⟩
    -- introduce the set F of all subsets of `s` (seen as members of `closeds α`).
    let F := { f : closeds α | (f : Set α) ⊆ s }
    refine' ⟨F, _, fun u _ => _⟩
    -- `F` is finite
    · apply @finite.of_finite_image _ _ F coe
      · apply fs.finite_subsets.subset fun b => _
        simp only [and_imp, Set.mem_image, Set.mem_setOf_eq, exists_imp]
        intro x hx hx'
        rwa [hx'] at hx
      · exact set_like.coe_injective.inj_on F
    -- `F` is ε-dense
    · obtain ⟨t0, t0s, Dut0⟩ := main u
      have : IsClosed t0 := (fs.subset t0s).IsCompact.IsClosed
      let t : closeds α := ⟨t0, this⟩
      have : t ∈ F := t0s
      have : edist u t < ε := lt_of_le_of_lt Dut0 δlt
      apply mem_Union₂.2
      exact ⟨t, ‹t ∈ F›, this⟩⟩
#align emetric.closeds.compact_space Emetric.Closeds.compactSpace

/-- In an emetric space, the type of non-empty compact subsets is an emetric space,
where the edistance is the Hausdorff edistance -/
instance NonemptyCompacts.emetricSpace : EMetricSpace (NonemptyCompacts α)
    where
  edist s t := hausdorffEdist (s : Set α) t
  edist_self s := hausdorffEdist_self
  edist_comm s t := hausdorffEdist_comm
  edist_triangle s t u := hausdorffEdist_triangle
  eq_of_edist_eq_zero s t h :=
    NonemptyCompacts.ext <|
      by
      have : closure (s : Set α) = closure t := Hausdorff_edist_zero_iff_closure_eq_closure.1 h
      rwa [s.is_compact.is_closed.closure_eq, t.is_compact.is_closed.closure_eq] at this
#align emetric.nonempty_compacts.emetric_space Emetric.NonemptyCompacts.emetricSpace

/-- `nonempty_compacts.to_closeds` is a uniform embedding (as it is an isometry) -/
theorem NonemptyCompacts.ToCloseds.uniformEmbedding :
    UniformEmbedding (@NonemptyCompacts.toCloseds α _ _) :=
  Isometry.uniformEmbedding fun x y => rfl
#align emetric.nonempty_compacts.to_closeds.uniform_embedding Emetric.NonemptyCompacts.ToCloseds.uniformEmbedding

/-- The range of `nonempty_compacts.to_closeds` is closed in a complete space -/
theorem NonemptyCompacts.isClosed_in_closeds [CompleteSpace α] :
    IsClosed (range <| @NonemptyCompacts.toCloseds α _ _) :=
  by
  have :
    range nonempty_compacts.to_closeds =
      { s : closeds α | (s : Set α).Nonempty ∧ IsCompact (s : Set α) } :=
    by
    ext s
    refine' ⟨_, fun h => ⟨⟨⟨s, h.2⟩, h.1⟩, closeds.ext rfl⟩⟩
    rintro ⟨s, hs, rfl⟩
    exact ⟨s.nonempty, s.is_compact⟩
  rw [this]
  refine' isClosed_of_closure_subset fun s hs => ⟨_, _⟩
  · -- take a set set t which is nonempty and at a finite distance of s
    rcases mem_closure_iff.1 hs ⊤ ENNReal.coe_lt_top with ⟨t, ht, Dst⟩
    rw [edist_comm] at Dst
    -- since `t` is nonempty, so is `s`
    exact nonempty_of_Hausdorff_edist_ne_top ht.1 (ne_of_lt Dst)
  · refine' isCompact_iff_totallyBounded_isComplete.2 ⟨_, s.closed.is_complete⟩
    refine' totally_bounded_iff.2 fun ε (εpos : 0 < ε) => _
    -- we have to show that s is covered by finitely many eballs of radius ε
    -- pick a nonempty compact set t at distance at most ε/2 of s
    rcases mem_closure_iff.1 hs (ε / 2) (ENNReal.half_pos εpos.ne') with ⟨t, ht, Dst⟩
    -- cover this space with finitely many balls of radius ε/2
    rcases totally_bounded_iff.1 (isCompact_iff_totallyBounded_isComplete.1 ht.2).1 (ε / 2)
        (ENNReal.half_pos εpos.ne') with
      ⟨u, fu, ut⟩
    refine' ⟨u, ⟨fu, fun x hx => _⟩⟩
    -- u : set α,  fu : u.finite,  ut : t ⊆ ⋃ (y : α) (H : y ∈ u), eball y (ε / 2)
    -- then s is covered by the union of the balls centered at u of radius ε
    rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dst with ⟨z, hz, Dxz⟩
    rcases mem_Union₂.1 (ut hz) with ⟨y, hy, Dzy⟩
    have : edist x y < ε :=
      calc
        edist x y ≤ edist x z + edist z y := edist_triangle _ _ _
        _ < ε / 2 + ε / 2 := (ENNReal.add_lt_add Dxz Dzy)
        _ = ε := ENNReal.add_halves _

    exact mem_bUnion hy this
#align emetric.nonempty_compacts.is_closed_in_closeds Emetric.NonemptyCompacts.isClosed_in_closeds

/-- In a complete space, the type of nonempty compact subsets is complete. This follows
from the same statement for closed subsets -/
instance NonemptyCompacts.completeSpace [CompleteSpace α] : CompleteSpace (NonemptyCompacts α) :=
  (completeSpace_iff_isComplete_range
        NonemptyCompacts.ToCloseds.uniformEmbedding.to_uniformInducing).2 <|
    NonemptyCompacts.isClosed_in_closeds.IsComplete
#align emetric.nonempty_compacts.complete_space Emetric.NonemptyCompacts.completeSpace

/-- In a compact space, the type of nonempty compact subsets is compact. This follows from
the same statement for closed subsets -/
instance NonemptyCompacts.compactSpace [CompactSpace α] : CompactSpace (NonemptyCompacts α) :=
  ⟨by
    rw [nonempty_compacts.to_closeds.uniform_embedding.embedding.is_compact_iff_is_compact_image]
    rw [image_univ]
    exact nonempty_compacts.is_closed_in_closeds.is_compact⟩
#align emetric.nonempty_compacts.compact_space Emetric.NonemptyCompacts.compactSpace

/-- In a second countable space, the type of nonempty compact subsets is second countable -/
instance NonemptyCompacts.secondCountableTopology [SecondCountableTopology α] :
    SecondCountableTopology (NonemptyCompacts α) :=
  haveI : separable_space (nonempty_compacts α) :=
    by
    /- To obtain a countable dense subset of `nonempty_compacts α`, start from
        a countable dense subset `s` of α, and then consider all its finite nonempty subsets.
        This set is countable and made of nonempty compact sets. It turns out to be dense:
        by total boundedness, any compact set `t` can be covered by finitely many small balls, and
        approximations in `s` of the centers of these balls give the required finite approximation
        of `t`. -/
    rcases exists_countable_dense α with ⟨s, cs, s_dense⟩
    let v0 := { t : Set α | t.Finite ∧ t ⊆ s }
    let v : Set (nonempty_compacts α) := { t : nonempty_compacts α | (t : Set α) ∈ v0 }
    refine' ⟨⟨v, _, _⟩⟩
    · have : v0.countable := countable_set_of_finite_subset cs
      exact this.preimage SetLike.coe_injective
    · refine' fun t => mem_closure_iff.2 fun ε εpos => _
      -- t is a compact nonempty set, that we have to approximate uniformly by a a set in `v`.
      rcases exists_between εpos with ⟨δ, δpos, δlt⟩
      have δpos' : 0 < δ / 2 := ENNReal.half_pos δpos.ne'
      -- construct a map F associating to a point in α an approximating point in s, up to δ/2.
      have Exy : ∀ x, ∃ y, y ∈ s ∧ edist x y < δ / 2 :=
        by
        intro x
        rcases mem_closure_iff.1 (s_dense x) (δ / 2) δpos' with ⟨y, ys, hy⟩
        exact ⟨y, ⟨ys, hy⟩⟩
      let F x := some (Exy x)
      have Fspec : ∀ x, F x ∈ s ∧ edist x (F x) < δ / 2 := fun x => some_spec (Exy x)
      -- cover `t` with finitely many balls. Their centers form a set `a`
      have : TotallyBounded (t : Set α) := t.is_compact.totally_bounded
      rcases totally_bounded_iff.1 this (δ / 2) δpos' with ⟨a, af, ta⟩
      -- a : set α,  af : a.finite,  ta : t ⊆ ⋃ (y : α) (H : y ∈ a), eball y (δ / 2)
      -- replace each center by a nearby approximation in `s`, giving a new set `b`
      let b := F '' a
      have : b.finite := af.image _
      have tb : ∀ x ∈ t, ∃ y ∈ b, edist x y < δ :=
        by
        intro x hx
        rcases mem_Union₂.1 (ta hx) with ⟨z, za, Dxz⟩
        exists F z, mem_image_of_mem _ za
        calc
          edist x (F z) ≤ edist x z + edist z (F z) := edist_triangle _ _ _
          _ < δ / 2 + δ / 2 := (ENNReal.add_lt_add Dxz (Fspec z).2)
          _ = δ := ENNReal.add_halves _

      -- keep only the points in `b` that are close to point in `t`, yielding a new set `c`
      let c := { y ∈ b | ∃ x ∈ t, edist x y < δ }
      have : c.finite := ‹b.finite›.Subset fun x hx => hx.1
      -- points in `t` are well approximated by points in `c`
      have tc : ∀ x ∈ t, ∃ y ∈ c, edist x y ≤ δ :=
        by
        intro x hx
        rcases tb x hx with ⟨y, yv, Dxy⟩
        have : y ∈ c := by simp [c, -mem_image] <;> exact ⟨yv, ⟨x, hx, Dxy⟩⟩
        exact ⟨y, this, le_of_lt Dxy⟩
      -- points in `c` are well approximated by points in `t`
      have ct : ∀ y ∈ c, ∃ x ∈ t, edist y x ≤ δ :=
        by
        rintro y ⟨hy1, x, xt, Dyx⟩
        have : edist y x ≤ δ :=
          calc
            edist y x = edist x y := edist_comm _ _
            _ ≤ δ := le_of_lt Dyx

        exact ⟨x, xt, this⟩
      -- it follows that their Hausdorff distance is small
      have : Hausdorff_edist (t : Set α) c ≤ δ := Hausdorff_edist_le_of_mem_edist tc ct
      have Dtc : Hausdorff_edist (t : Set α) c < ε := this.trans_lt δlt
      -- the set `c` is not empty, as it is well approximated by a nonempty set
      have hc : c.nonempty := nonempty_of_Hausdorff_edist_ne_top t.nonempty (ne_top_of_lt Dtc)
      -- let `d` be the version of `c` in the type `nonempty_compacts α`
      let d : nonempty_compacts α := ⟨⟨c, ‹c.finite›.IsCompact⟩, hc⟩
      have : c ⊆ s := by
        intro x hx
        rcases(mem_image _ _ _).1 hx.1 with ⟨y, ⟨ya, yx⟩⟩
        rw [← yx]
        exact (Fspec y).1
      have : d ∈ v := ⟨‹c.finite›, this⟩
      -- we have proved that `d` is a good approximation of `t` as requested
      exact ⟨d, ‹d ∈ v›, Dtc⟩
  UniformSpace.secondCountable_of_separable (nonempty_compacts α)
#align emetric.nonempty_compacts.second_countable_topology Emetric.NonemptyCompacts.secondCountableTopology

end

--section
end Emetric

--namespace
namespace Metric

section

variable {α : Type u} [MetricSpace α]

/-- `nonempty_compacts α` inherits a metric space structure, as the Hausdorff
edistance between two such sets is finite. -/
instance NonemptyCompacts.metricSpace : MetricSpace (NonemptyCompacts α) :=
  EMetricSpace.toMetricSpace fun x y =>
    hausdorffEdist_ne_top_of_nonempty_of_bounded x.Nonempty y.Nonempty x.IsCompact.Bounded
      y.IsCompact.Bounded
#align metric.nonempty_compacts.metric_space Metric.NonemptyCompacts.metricSpace

/-- The distance on `nonempty_compacts α` is the Hausdorff distance, by construction -/
theorem NonemptyCompacts.dist_eq {x y : NonemptyCompacts α} :
    dist x y = hausdorffDist (x : Set α) y :=
  rfl
#align metric.nonempty_compacts.dist_eq Metric.NonemptyCompacts.dist_eq

theorem lipschitz_infDist_set (x : α) : LipschitzWith 1 fun s : NonemptyCompacts α => infDist x s :=
  LipschitzWith.of_le_add fun s t => by
    rw [dist_comm]
    exact inf_dist_le_inf_dist_add_Hausdorff_dist (edist_ne_top t s)
#align metric.lipschitz_inf_dist_set Metric.lipschitz_infDist_set

theorem lipschitz_infDist : LipschitzWith 2 fun p : α × NonemptyCompacts α => infDist p.1 p.2 :=
  @LipschitzWith.uncurry _ _ _ _ _ _ (fun (x : α) (s : NonemptyCompacts α) => infDist x s) 1 1
    (fun s => lipschitz_infDist_pt s) lipschitz_infDist_set
#align metric.lipschitz_inf_dist Metric.lipschitz_infDist

theorem uniformContinuous_infDist_Hausdorff_dist :
    UniformContinuous fun p : α × NonemptyCompacts α => infDist p.1 p.2 :=
  lipschitz_infDist.UniformContinuous
#align metric.uniform_continuous_inf_dist_Hausdorff_dist Metric.uniformContinuous_infDist_Hausdorff_dist

end

--section
end Metric

--namespace


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel
The metric and emetric space structure on the types of closed subsets and nonempty compact
subsets of a metric or emetric space

The Hausdorff distance induces an emetric space structure on the type of closed subsets
of an emetric space, called `closeds`. Its completeness, resp. compactness, resp.
second-countability, follow from the corresponding properties of the original space.

In a metric space, the type of nonempty compact subsets (called `nonempty_compacts`) also
inherits a metric space structure from the Hausdorff distance, as the Hausdorff edistance is
always finite in this context.
-/

import topology.metric_space.hausdorff_distance topology.opens
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable

universe u
open classical lattice set function topological_space filter

namespace emetric
section
variables {α : Type u} [emetric_space α] {s : set α}

/-- In emetric spaces, the Hausdorff edistance defines an emetric space structure
on the type of closed subsets -/
instance closeds.emetric_space : emetric_space (closeds α) :=
{ edist               := λs t, Hausdorff_edist s.val t.val,
  edist_self          := λs, Hausdorff_edist_self,
  edist_comm          := λs t, Hausdorff_edist_comm,
  edist_triangle      := λs t u, Hausdorff_edist_triangle,
  eq_of_edist_eq_zero :=
    λs t h, subtype.eq ((Hausdorff_edist_zero_iff_eq_of_closed s.property t.property).1 h) }

/-- The edistance to a closed set depends continuously on the point and the set -/
lemma continuous_inf_edist_Hausdorff_edist :
  continuous (λp : α × (closeds α), inf_edist p.1 (p.2).val) :=
begin
  refine continuous_of_le_add_edist 2 (by simp) _,
  rintros ⟨x, s⟩ ⟨y, t⟩,
  calc inf_edist x (s.val) ≤ inf_edist x (t.val) + Hausdorff_edist (t.val) (s.val) :
    inf_edist_le_inf_edist_add_Hausdorff_edist
  ... ≤ (inf_edist y (t.val) + edist x y) + Hausdorff_edist (t.val) (s.val) :
    add_le_add_right' inf_edist_le_inf_edist_add_edist
  ... = inf_edist y (t.val) + (edist x y + Hausdorff_edist (s.val) (t.val)) :
    by simp [add_comm, Hausdorff_edist_comm]
  ... ≤ inf_edist y (t.val) + (edist (x, s) (y, t) + edist (x, s) (y, t)) :
    add_le_add_left' (add_le_add' (by simp [edist, le_refl]) (by simp [edist, le_refl]))
  ... = inf_edist y (t.val) + 2 * edist (x, s) (y, t) :
    by rw [← mul_two, mul_comm]
end

/-- Subsets of a given closed subset form a closed set -/
lemma is_closed_subsets_of_is_closed (hs : is_closed s) :
  is_closed {t : closeds α | t.val ⊆ s} :=
begin
  refine is_closed_of_closure_subset (λt ht x hx, _),
  -- t : closeds α,  ht : t ∈ closure {t : closeds α | t.val ⊆ s},
  -- x : α,  hx : x ∈ t.val
  -- goal : x ∈ s
  have : x ∈ closure s,
  { refine mem_closure_iff'.2 (λε εpos, _),
    rcases mem_closure_iff'.1 ht ε εpos with ⟨u, hu, Dtu⟩,
    -- u : closeds α,  hu : u ∈ {t : closeds α | t.val ⊆ s},  hu' : edist t u < ε
    rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dtu with ⟨y, hy, Dxy⟩,
    -- y : α,  hy : y ∈ u.val, Dxy : edist x y < ε
    exact ⟨y, hu hy, Dxy⟩ },
  rwa closure_eq_of_is_closed hs at this,
end

/-- By definition, the edistance on `closeds α` is given by the Hausdorff edistance -/
lemma closeds.edist_eq {s t : closeds α} : edist s t = Hausdorff_edist s.val t.val := rfl

/-- In a complete space, the type of closed subsets is complete for the
Hausdorff edistance. -/
instance closeds.complete_space [complete_space α] : complete_space (closeds α) :=
begin
  /- We will show that, if a sequence of sets `s n` satisfies
  `edist (s n) (s (n+1)) < 2^{-n}`, then it converges. This is enough to guarantee
  completeness, by a standard completeness criterion.
  We use the shorthand `B n = 2^{-n}` in ennreal. -/
  let B : ℕ → ennreal := ennreal.half_pow,
  /- Consider a sequence of closed sets `s n` with `edist (s n) (s (n+1)) < B n`.
  We will show that it converges. The limit set is t0 = ⋂n, closure (⋃m≥n, s m).
  We will have to show that a point in `s n` is close to a point in `t0`, and a point
  in `t0` is close to a point in `s n`. The completeness then follows from a
  standard criterion. -/
  refine complete_of_convergent_controlled_sequences _ ennreal.half_pow_pos (λs hs, _),
  let t0 := ⋂n, closure (⋃m≥n, (s m).val),
  have : is_closed t0 := is_closed_Inter (λ_, is_closed_closure),
  let t : closeds α := ⟨t0, this⟩,
  use t,
  have I1 : ∀n:ℕ, ∀x ∈ (s n).val, ∃y ∈ t0, edist x y ≤ 2 * B n,
  { /- This is the main difficulty of the proof. Starting from `x ∈ s n`, we want
       to find a point in `t0` which is close to `x`. Define inductively a sequence of
       points `z m` with `z n = x` and `z m ∈ s m` and `edist (z m) (z (m+1)) ≤ B m`. This is
       possible since the Hausdorff distance between `s m` and `s (m+1)` is at most `B m`.
       This sequence is a Cauchy sequence, therefore converging as the space is complete, to
       a limit which satisfies the required properties. -/
    assume n x hx,
    haveI : nonempty α := ⟨x⟩,
    let z : ℕ → α := λk, nat.rec_on k x (λl z, if l < n then x else
                      epsilon (λy, y ∈ (s (l+1)).val ∧ edist z y < B l)),
    have z_le_n : ∀l≤n, z l = x,
    { assume l hl,
      cases l with m,
      { show z 0 = x, from rfl },
      { have : z (nat.succ m) = ite (m < n) x (epsilon (λ (y : α), y ∈ (s (m + 1)).val ∧ edist (z m) y < B m))
          := rfl,
        rw this,
        simp [nat.lt_of_succ_le hl] }},
    have : z n = x := z_le_n n (le_refl n),
    -- check by induction that the sequence `z m` satisfies the required properties
    have I : ∀m≥n, z m ∈ (s m).val → (z (m+1) ∈ (s (m+1)).val ∧ edist (z m) (z (m+1)) < B m),
    { assume m hm hz,
      have E : ∃y, y ∈ (s (m+1)).val ∧ edist (z m) y < B m,
      { have : Hausdorff_edist (s m).val (s (m+1)).val < B m := hs m m (m+1) (le_refl _) (by simp),
        rcases exists_edist_lt_of_Hausdorff_edist_lt hz this with ⟨y, hy, Dy⟩,
        exact ⟨y, ⟨hy, Dy⟩⟩ },
      have : z (m+1) = ite (m < n) x (epsilon (λ (y : α), y ∈ (s (m + 1)).val ∧ edist (z m) y < B m)) := rfl,
      rw this,
      simp only [not_lt_of_le hm, if_false],
      exact epsilon_spec E },
    have z_in_s : ∀m≥n, z m ∈ (s m).val :=
      nat.le_induction (by rwa ‹z n = x›) (λm hm zm, (I m hm zm).1),
    -- for all `m`, the distance between `z m` and `z (m+1)` is controlled by `B m`:
    -- for `m ≥ n`, this follows from the construction, while for `m < n` all points are `x`.
    have Im_succm : ∀m, edist (z m) (z (m+1)) ≤ B m,
    { assume m,
      by_cases hm : n≤m,
      { exact le_of_lt (I m hm (z_in_s m hm)).2 },
      { rw not_le at hm,
        have Im : z m = x := z_le_n m (le_of_lt hm),
        have Im' : z (m+1) = x := z_le_n (m+1) (nat.succ_le_of_lt hm),
        simp [Im, Im', ennreal.half_pow_pos] }},
    /- From the distance control between `z m` and `z (m+1)`, we deduce a distance control
    between `z k` and `z l` by summing the geometric series. -/
    have Iz : ∀k l N, N ≤ k → N ≤ l → edist (z k) (z l) ≤ 2 * B N :=
      λk l N hk hl, ennreal.edist_le_two_mul_half_pow hk hl Im_succm,
    -- it follows from the previous bound that `z` is a Cauchy sequence
    have : cauchy_seq z := ennreal.cauchy_seq_of_edist_le_half_pow Im_succm,
    -- therefore, it converges
    rcases cauchy_seq_tendsto_of_complete this with ⟨y, y_lim⟩,
    -- the limit point `y` will be the desired point, in `t0` and close to our initial point `x`.
    -- First, we check it belongs to `t0`.
    have : y ∈ t0 := mem_Inter.2 (λk, mem_closure_of_tendsto (by simp) y_lim
    begin
      simp only [exists_prop, set.mem_Union, filter.mem_at_top_sets, set.mem_preimage_eq, set.preimage_Union],
      exact ⟨max n k, λm hm, ⟨m, ⟨le_trans (le_max_right _ _) hm, z_in_s m (le_trans (le_max_left _ _) hm)⟩⟩⟩,
    end),
    -- Then, we check that `y` is close to `x = z n`. This follows from the fact that `y`
    -- is the limit of `z k`, and the distance between `z n` and `z k` has already been estimated.
    have : edist x y ≤ 2 * B n,
    { refine le_of_tendsto (by simp) (tendsto_edist tendsto_const_nhds y_lim) _,
      simp [‹z n = x›.symm],
      exact ⟨n, λm hm, Iz n m n (le_refl n) hm⟩ },
    -- Conclusion of this argument: the point `y` satisfies the required properties.
    exact ⟨y, ‹y ∈ t0›, ‹edist x y ≤ 2 * B n›⟩ },
  have I2 : ∀n:ℕ, ∀x ∈ t0, ∃y ∈ (s n).val, edist x y ≤ 2 * B n,
  { /- For the (much easier) reverse inequality, we start from a point `x ∈ t0` and we want
        to find a point `y ∈ s n` which is close to `x`.
        `x` belongs to `t0`, the intersection of the closures. In particular, it is well
        approximated by a point `z` in `⋃m≥n, s m`, say in `s m`. Since `s m` and
        `s n` are close, this point is itself well approximated by a point `y` in `s n`,
        as required. -/
    assume n x xt0,
    have : x ∈ closure (⋃m≥n, (s m).val), by apply mem_Inter.1 xt0 n,
    rcases mem_closure_iff'.1 this (B n) (ennreal.half_pow_pos n) with ⟨z, hz, Dxz⟩,
    -- z : α,  Dxz : edist x z < B n,
    simp only [exists_prop, set.mem_Union] at hz,
    rcases hz with ⟨m, ⟨m_ge_n, hm⟩⟩,
    -- m : ℕ, m_ge_n : m ≥ n, hm : z ∈ (s m).val
    have : Hausdorff_edist (s m).val (s n).val < B n := hs n m n m_ge_n (le_refl n),
    rcases exists_edist_lt_of_Hausdorff_edist_lt hm this with ⟨y, hy, Dzy⟩,
    -- y : α,  hy : y ∈ (s n).val,  Dzy : edist z y < B n
    exact ⟨y, hy, calc
      edist x y ≤ edist x z + edist z y : edist_triangle _ _ _
            ... ≤ B n + B n : add_le_add' (le_of_lt Dxz) (le_of_lt Dzy)
            ... = 2 * B n : (two_mul _).symm ⟩ },
  -- Deduce from the above inequalities that the distance between `s n` and `t0` is at most `2 B n`.
  have main : ∀n:ℕ, edist (s n) t ≤ 2 * B n := λn, Hausdorff_edist_le_of_mem_edist (I1 n) (I2 n),
  -- from this, the convergence of `s n` to `t0` follows.
  refine (tendsto_at_top _).2 (λε εpos, _),
  have : tendsto (λn, 2 * ennreal.half_pow n) at_top (nhds (2 * 0)) :=
    ennreal.tendsto_mul_right ennreal.half_pow_tendsto_zero (by simp),
  rw mul_zero at this,
  have Z := (tendsto_orderable.1 this).2 ε εpos,
  simp only [filter.mem_at_top_sets, set.mem_set_of_eq] at Z,
  rcases Z with ⟨N, hN⟩,  --  ∀ (b : ℕ), b ≥ N → ε > 2 * B b
  exact ⟨N, λn hn, lt_of_le_of_lt (main n) (hN n hn)⟩
end

/-- In a compact space, the type of closed subsets is compact. -/
instance closeds.compact_space [compact_space α] : compact_space (closeds α) :=
⟨begin
  /- by completeness, it suffices to show that it is totally bounded,
    i.e., for all ε>0, there is a finite set which is ε-dense.
    start from a set `s` which is ε-dense in α. Then the subsets of `s`
    are finitely many, and ε-dense for the Hausdorff distance. -/
  refine compact_of_totally_bounded_is_closed (emetric.totally_bounded_iff.2 (λε εpos, _)) is_closed_univ,
  rcases dense εpos with ⟨δ, δpos, δlt⟩,
  rcases emetric.totally_bounded_iff.1 (compact_iff_totally_bounded_complete.1 (@compact_univ α _ _ _)).1 δ δpos
    with ⟨s, fs, hs⟩,
  -- s : set α,  fs : finite s,  hs : univ ⊆ ⋃ (y : α) (H : y ∈ s), eball y δ
  -- we first show that any set is well approximated by a subset of `s`.
  have main : ∀ u : set α, ∃v ⊆ s, Hausdorff_edist u v ≤ δ,
  { assume u,
    let v := {x : α | x ∈ s ∧ ∃y∈u, edist x y < δ},
    existsi [v, ((λx hx, hx.1) : v ⊆ s)],
    refine Hausdorff_edist_le_of_mem_edist _ _,
    { assume x hx,
      have : x ∈ ⋃y ∈ s, ball y δ := hs (by simp),
      rcases mem_bUnion_iff.1 this with ⟨y, ⟨ys, dy⟩⟩,
      have : edist y x < δ := by simp at dy; rwa [edist_comm] at dy,
      exact ⟨y, ⟨ys, ⟨x, hx, this⟩⟩, le_of_lt dy⟩ },
    { rintros x ⟨hx1, ⟨y, yu, hy⟩⟩,
      exact ⟨y, yu, le_of_lt hy⟩ }},
  -- introduce the set F of all subsets of `s` (seen as members of `closeds α`).
  let F := {f : closeds α | f.val ⊆ s},
  use F,
  split,
  -- `F` is finite
  { apply @finite_of_finite_image _ _ F (λf, f.val),
    { simp [subtype.val_injective] },
    { refine finite_subset (finite_subsets_of_finite fs) (λb, _),
      simp only [and_imp, set.mem_image, set.mem_set_of_eq, exists_imp_distrib],
      assume x hx hx',
      rwa hx' at hx }},
  -- `F` is ε-dense
  { assume u _,
    rcases main u.val with ⟨t0, t0s, Dut0⟩,
    have : finite t0 := finite_subset fs t0s,
    have : is_closed t0 := closed_of_compact _ (compact_of_finite this),
    let t : closeds α := ⟨t0, this⟩,
    have : t ∈ F := t0s,
    have : edist u t < ε := lt_of_le_of_lt Dut0 δlt,
    apply mem_bUnion_iff.2,
    exact ⟨t, ‹t ∈ F›, this⟩ }
end⟩

/-- In an emetric space, the type of non-empty compact subsets is an emetric space,
where the edistance is the Hausdorff edistance -/
instance nonempty_compacts.emetric_space : emetric_space (nonempty_compacts α) :=
{ edist               := λs t, Hausdorff_edist s.val t.val,
  edist_self          := λs, Hausdorff_edist_self,
  edist_comm          := λs t, Hausdorff_edist_comm,
  edist_triangle      := λs t u, Hausdorff_edist_triangle,
  eq_of_edist_eq_zero := λs t h, subtype.eq $ begin
    have : closure (s.val) = closure (t.val) := Hausdorff_edist_zero_iff_closure_eq_closure.1 h,
    rwa [closure_eq_iff_is_closed.2 (closed_of_compact _ s.property.2),
              closure_eq_iff_is_closed.2 (closed_of_compact _ t.property.2)] at this,
  end }

/-- `nonempty_compacts.to_closeds` is a uniform embedding (as it is an isometry) -/
lemma nonempty_compacts.to_closeds.uniform_embedding :
  uniform_embedding (@nonempty_compacts.to_closeds α _ _) :=
isometry.uniform_embedding $ λx y, rfl

/-- The range of `nonempty_compacts.to_closeds` is closed in a complete space -/
lemma nonempty_compacts.is_closed_in_closeds [complete_space α] :
  is_closed (nonempty_compacts.to_closeds '' (univ : set (nonempty_compacts α))) :=
begin
  have : nonempty_compacts.to_closeds '' univ = {s : closeds α | s.val ≠ ∅ ∧ compact s.val},
  { ext,
    simp only [set.image_univ, set.mem_range, ne.def, set.mem_set_of_eq],
    split,
    { rintros ⟨y, hy⟩,
      have : x.val = y.val := by rcases hy; simp,
      rw this,
      exact y.property },
    { rintros ⟨hx1, hx2⟩,
      existsi (⟨x.val, ⟨hx1, hx2⟩⟩ : nonempty_compacts α),
      apply subtype.eq,
      refl }},
  rw this,
  refine is_closed_of_closure_subset (λs hs, _),
  split,
  { -- take a set set t which is nonempty and at distance at most 1 of s
    rcases mem_closure_iff'.1 hs 1 ennreal.zero_lt_one with ⟨t, ht, Dst⟩,
    rw edist_comm at Dst,
    -- this set t contains a point x
    rcases ne_empty_iff_exists_mem.1 ht.1 with ⟨x, hx⟩,
    -- by the Hausdorff distance control, this point x is at distance at most 1
    -- of a point y in s
    rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dst with ⟨y, hy, _⟩,
    -- this shows that s is not empty
    exact ne_empty_of_mem hy },
  { refine compact_iff_totally_bounded_complete.2 ⟨_, is_complete_of_is_closed s.property⟩,
    refine totally_bounded_iff.2 (λε εpos, _),
    -- we have to show that s is covered by finitely many eballs of radius ε
    -- pick a nonempty compact set t at distance at most ε/2 of s
    rcases mem_closure_iff'.1 hs (ε/2) (ennreal.half_pos εpos) with ⟨t, ht, Dst⟩,
    -- cover this space with finitely many balls of radius ε/2
    rcases totally_bounded_iff.1 (compact_iff_totally_bounded_complete.1 ht.2).1 (ε/2) (ennreal.half_pos εpos)
      with ⟨u, fu, ut⟩,
    refine ⟨u, ⟨fu, λx hx, _⟩⟩,
    -- u : set α,  fu : finite u,  ut : t.val ⊆ ⋃ (y : α) (H : y ∈ u), eball y (ε / 2)
    -- then s is covered by the union of the balls centered at u of radius ε
    rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dst with ⟨z, hz, Dxz⟩,
    rcases mem_bUnion_iff.1 (ut hz) with ⟨y, hy, Dzy⟩,
    have : edist x y < ε := calc
      edist x y ≤ edist x z + edist z y : edist_triangle _ _ _
      ... < ε/2 + ε/2 : ennreal.add_lt_add Dxz Dzy
      ... = ε : ennreal.add_halves _,
    exact mem_bUnion hy this },
end

/-- In a complete space, the type of nonempty compact subsets is complete. This follows
from the same statement for closed subsets -/
instance nonempty_compacts.complete_space [complete_space α] : complete_space (nonempty_compacts α) :=
begin
  apply complete_space_of_is_complete_univ,
  apply (is_complete_image_iff nonempty_compacts.to_closeds.uniform_embedding).1,
  apply is_complete_of_is_closed,
  exact nonempty_compacts.is_closed_in_closeds
end

/-- In a compact space, the type of nonempty compact subsets is compact. This follows from
the same statement for closed subsets -/
instance nonempty_compacts.compact_space [compact_space α] : compact_space (nonempty_compacts α) :=
⟨begin
  rw compact_iff_compact_image_of_embedding nonempty_compacts.to_closeds.uniform_embedding.embedding,
  exact compact_of_closed nonempty_compacts.is_closed_in_closeds
end⟩

/-- In a second countable space, the type of nonempty compact subsets is second countable -/
instance nonempty_compacts.second_countable_topology [second_countable_topology α] :
  second_countable_topology (nonempty_compacts α) :=
begin
  haveI : separable_space (nonempty_compacts α) :=
  begin
    /- To obtain a countable dense subset of `nonempty_compacts α`, start from
    a countable dense subset `s` of α, and then consider all its finite nonempty subsets.
    This set is countable and made of nonempty compact sets. It turns out to be dense:
    by total boundedness, any compact set `t` can be covered by finitely many small balls, and
    approximations in `s` of the centers of these balls give the required finite approximation
    of `t`. -/
    have : separable_space α := by apply_instance,
    rcases this.exists_countable_closure_eq_univ with ⟨s, cs, s_dense⟩,
    let v0 := {t : set α | finite t ∧ t ⊆ s},
    let v : set (nonempty_compacts α) := {t : nonempty_compacts α | t.val ∈ v0},
    refine  ⟨⟨v, ⟨_, _⟩⟩⟩,
    { have : countable (subtype.val '' v),
      { refine countable_subset (λx hx, _) (countable_set_of_finite_subset cs),
        rcases (mem_image _ _ _).1 hx with ⟨y, ⟨hy, yx⟩⟩,
        rw ← yx,
        exact hy },
      apply countable_of_injective_of_countable_image _ this,
      apply inj_on_of_inj_on_of_subset (injective_iff_inj_on_univ.1 subtype.val_injective)
        (subset_univ _) },
    { refine subset.antisymm (subset_univ _) (λt ht, mem_closure_iff'.2 (λε εpos, _)),
      -- t is a compact nonempty set, that we have to approximate uniformly by a a set in `v`.
      rcases dense εpos with ⟨δ, δpos, δlt⟩,
      -- construct a map F associating to a point in α an approximating point in s, up to δ/2.
      have Exy : ∀x, ∃y, y ∈ s ∧ edist x y < δ/2,
      { assume x,
        have : x ∈ closure s := by rw s_dense; exact mem_univ _,
        rcases mem_closure_iff'.1 this (δ/2) (ennreal.half_pos δpos) with ⟨y, ys, hy⟩,
        exact ⟨y, ⟨ys, hy⟩⟩ },
      let F := λx, some (Exy x),
      have Fspec : ∀x, F x ∈ s ∧ edist x (F x) < δ/2 := λx, some_spec (Exy x),

      -- cover `t` with finitely many balls. Their centers form a set `a`
      have : totally_bounded t.val := (compact_iff_totally_bounded_complete.1 t.property.2).1,
      rcases totally_bounded_iff.1 this (δ/2) (ennreal.half_pos δpos) with ⟨a, af, ta⟩,
      -- a : set α,  af : finite a,  ta : t.val ⊆ ⋃ (y : α) (H : y ∈ a), eball y (δ / 2)
      -- replace each center by a nearby approximation in `s`, giving a new set `b`
      let b := F '' a,
      have : finite b := finite_image _ af,
      have tb : ∀x ∈ t.val, ∃y ∈ b, edist x y < δ,
      { assume x hx,
        rcases mem_bUnion_iff.1 (ta hx) with ⟨z, za, Dxz⟩,
        existsi [F z, mem_image_of_mem _ za],
        calc edist x (F z) ≤ edist x z + edist z (F z) : edist_triangle _ _ _
             ... < δ/2 + δ/2 : ennreal.add_lt_add Dxz (Fspec z).2
             ... = δ : ennreal.add_halves _ },
      -- keep only the points in `b` that are close to point in `t`, yielding a new set `c`
      let c := {y ∈ b | ∃x∈t.val, edist x y < δ},
      have : finite c := finite_subset ‹finite b› (λx hx, hx.1),
      -- points in `t` are well approximated by points in `c`
      have tc : ∀x ∈ t.val, ∃y ∈ c, edist x y ≤ δ,
      { assume x hx,
        rcases tb x hx with ⟨y, yv, Dxy⟩,
        have : y ∈ c := by simp [c, -mem_image]; exact ⟨yv, ⟨x, hx, Dxy⟩⟩,
        exact ⟨y, this, le_of_lt Dxy⟩ },
      -- points in `c` are well approximated by points in `t`
      have ct : ∀y ∈ c, ∃x ∈ t.val, edist y x ≤ δ,
      { rintros y ⟨hy1, ⟨x, xt, Dyx⟩⟩,
        have : edist y x ≤ δ := calc
          edist y x = edist x y : edist_comm _ _
          ... ≤ δ : le_of_lt Dyx,
        exact ⟨x, xt, this⟩ },
      -- it follows that their Hausdorff distance is small
      have : Hausdorff_edist t.val c ≤ δ :=
        Hausdorff_edist_le_of_mem_edist tc ct,
      have Dtc : Hausdorff_edist t.val c < ε := lt_of_le_of_lt this δlt,
      -- the set `c` is not empty, as it is well approximated by a nonempty set
      have : c ≠ ∅,
      { by_contradiction h,
        simp only [not_not, ne.def] at h,
        rw [h, Hausdorff_edist_empty t.property.1] at Dtc,
        exact not_top_lt Dtc },
      -- let `d` be the version of `c` in the type `nonempty_compacts α`
      let d : nonempty_compacts α := ⟨c, ⟨‹c ≠ ∅›, compact_of_finite ‹finite c›⟩⟩,
      have : c ⊆ s,
      { assume x hx,
        rcases (mem_image _ _ _).1 hx.1 with ⟨y, ⟨ya, yx⟩⟩,
        rw ← yx,
        exact (Fspec y).1 },
      have : d ∈ v := ⟨‹finite c›, this⟩,
      -- we have proved that `d` is a good approximation of `t` as requested
      exact ⟨d, ‹d ∈ v›, Dtc⟩ },
  end,
  apply second_countable_of_separable,
end

end --section
end emetric --namespace

namespace metric
section

variables {α : Type u} [metric_space α]

/-- `nonempty_compacts α` inherits a metric space structure, as the Hausdorff
edistance between two such sets is finite. -/
instance nonempty_compacts.metric_space : metric_space (nonempty_compacts α) :=
emetric_space.to_metric_space $ λx y, Hausdorff_edist_ne_top_of_ne_empty_of_bounded x.2.1 y.2.1
  (bounded_of_compact x.2.2) (bounded_of_compact y.2.2)

/-- The distance on `nonempty_compacts α` is the Hausdorff distance, by construction -/
lemma nonempty_compacts.dist_eq {x y : nonempty_compacts α} :
  dist x y = Hausdorff_dist x.val y.val := rfl

lemma uniform_continuous_inf_dist_Hausdorff_dist :
  uniform_continuous (λp : α × (nonempty_compacts α), inf_dist p.1 (p.2).val) :=
begin
  refine uniform_continuous_of_le_add 2 _,
  rintros ⟨x, s⟩ ⟨y, t⟩,
  calc inf_dist x (s.val) ≤ inf_dist x (t.val) + Hausdorff_dist (t.val) (s.val) :
    inf_dist_le_inf_dist_add_Hausdorff_dist (edist_ne_top t s)
  ... ≤ (inf_dist y (t.val) + dist x y) + Hausdorff_dist (t.val) (s.val) :
    add_le_add_right inf_dist_le_inf_dist_add_dist _
  ... = inf_dist y (t.val) + (dist x y + Hausdorff_dist (s.val) (t.val)) :
    by simp [add_comm, Hausdorff_dist_comm]
  ... ≤ inf_dist y (t.val) + (dist (x, s) (y, t) + dist (x, s) (y, t)) :
    add_le_add_left (add_le_add (by simp [dist, le_refl]) (by simp [dist, nonempty_compacts.dist_eq, le_refl])) _
  ... = inf_dist y (t.val) + 2 * dist (x, s) (y, t) :
    by rw [← mul_two, mul_comm]
end

end --section
end metric --namespace


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

! This file was ported from Lean 3 source module data.int.sqrt
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Sqrt

/-!
# Square root of integers

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

This file defines the square root function on integers. `int.sqrt z` is the greatest integer `r`
such that `r * r ≤ z`. If `z ≤ 0`, then `int.sqrt z = 0`.
-/

namespace Int

#print Int.sqrt /-
/-- `sqrt z` is the square root of an integer `z`. If `z` is positive, it returns the largest
integer `r` such that `r * r ≤ n`. If it is negative, it returns `0`. For example, `sqrt (-1) = 0`,
`sqrt 1 = 1`, `sqrt 2 = 1` -/
@[pp_nodot]
def sqrt (z : ℤ) : ℤ :=
  Nat.sqrt <| Int.toNat z
#align int.sqrt Int.sqrt
-/

#print Int.sqrt_eq /-
theorem sqrt_eq (n : ℤ) : sqrt (n * n) = n.natAbs := by
  rw [sqrt, ← nat_abs_mul_self, to_nat_coe_nat, Nat.sqrt_eq]
#align int.sqrt_eq Int.sqrt_eq
-/

#print Int.exists_mul_self /-
theorem exists_mul_self (x : ℤ) : (∃ n, n * n = x) ↔ sqrt x * sqrt x = x :=
  ⟨fun ⟨n, hn⟩ => by rw [← hn, sqrt_eq, ← Int.ofNat_mul, nat_abs_mul_self], fun h => ⟨sqrt x, h⟩⟩
#align int.exists_mul_self Int.exists_mul_self
-/

#print Int.sqrt_nonneg /-
theorem sqrt_nonneg (n : ℤ) : 0 ≤ sqrt n :=
  coe_nat_nonneg _
#align int.sqrt_nonneg Int.sqrt_nonneg
-/

end Int


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import analysis.normed_space.operator_norm
import topology.metric_space.baire
import topology.algebra.module.basic
/-!
# The Banach-Steinhaus theorem: Uniform Boundedness Principle

Herein we prove the Banach-Steinhaus theorem: any collection of bounded linear maps
from a Banach space into a normed space which is pointwise bounded is uniformly bounded.

## TODO

For now, we only prove the standard version by appeal to the Baire category theorem.
Much more general versions exist (in particular, for maps from barrelled spaces to locally
convex spaces), but these are not yet in `mathlib`.
-/

open set

variables
{E F 𝕜 𝕜₂ : Type*}
[semi_normed_group E] [semi_normed_group F]
[nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂]
[normed_space 𝕜 E] [normed_space 𝕜₂ F]
{σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂]

/-- This is the standard Banach-Steinhaus theorem, or Uniform Boundedness Principle.
If a family of continuous linear maps from a Banach space into a normed space is pointwise
bounded, then the norms of these linear maps are uniformly bounded. -/
theorem banach_steinhaus {ι : Type*} [complete_space E] {g : ι → E →SL[σ₁₂] F}
  (h : ∀ x, ∃ C, ∀ i, ∥g i x∥ ≤ C) :
  ∃ C', ∀ i, ∥g i∥ ≤ C' :=
begin
  /- sequence of subsets consisting of those `x : E` with norms `∥g i x∥` bounded by `n` -/
  let e : ℕ → set E := λ n, (⋂ i : ι, { x : E | ∥g i x∥ ≤ n }),
  /- each of these sets is closed -/
  have hc : ∀ n : ℕ, is_closed (e n), from λ i, is_closed_Inter (λ i,
    is_closed_le (continuous.norm (g i).cont) continuous_const),
  /- the union is the entire space; this is where we use `h` -/
  have hU : (⋃ n : ℕ, e n) = univ,
  { refine eq_univ_of_forall (λ x, _),
    cases h x with C hC,
    obtain ⟨m, hm⟩ := exists_nat_ge C,
    exact ⟨e m, mem_range_self m, mem_Inter.mpr (λ i, le_trans (hC i) hm)⟩ },
  /- apply the Baire category theorem to conclude that for some `m : ℕ`, `e m` contains some `x` -/
  rcases nonempty_interior_of_Union_of_closed hc hU with ⟨m, x, hx⟩,
  rcases metric.is_open_iff.mp is_open_interior x hx with ⟨ε, ε_pos, hε⟩,
  obtain ⟨k, hk⟩ := normed_field.exists_one_lt_norm 𝕜,
  /- show all elements in the ball have norm bounded by `m` after applying any `g i` -/
  have real_norm_le : ∀ z : E, z ∈ metric.ball x ε → ∀ i : ι, ∥g i z∥ ≤ m,
  { intros z hz i,
    replace hz := mem_Inter.mp (interior_Inter_subset _ (hε hz)) i,
    apply interior_subset hz },
  have εk_pos : 0 < ε / ∥k∥ := div_pos ε_pos (zero_lt_one.trans hk),
  refine ⟨(m + m : ℕ) / (ε / ∥k∥), λ i, continuous_linear_map.op_norm_le_of_shell ε_pos _ hk _⟩,
  { exact div_nonneg (nat.cast_nonneg _) εk_pos.le },
  intros y le_y y_lt,
  calc ∥g i y∥
      = ∥g i (y + x) - g i x∥   : by rw [continuous_linear_map.map_add, add_sub_cancel]
  ... ≤ ∥g i (y + x)∥ + ∥g i x∥ : norm_sub_le _ _
  ... ≤ m + m : add_le_add (real_norm_le (y + x) (by rwa [add_comm, add_mem_ball_iff_norm]) i)
          (real_norm_le x (metric.mem_ball_self ε_pos) i)
  ... = (m + m : ℕ) : (m.cast_add m).symm
  ... ≤ (m + m : ℕ) * (∥y∥ / (ε / ∥k∥))
      : le_mul_of_one_le_right (nat.cast_nonneg _)
          ((one_le_div $ div_pos ε_pos (zero_lt_one.trans hk)).2 le_y)
  ... = (m + m : ℕ) / (ε / ∥k∥) * ∥y∥ : (mul_comm_div' _ _ _).symm,
end

open_locale ennreal
open ennreal

/-- This version of Banach-Steinhaus is stated in terms of suprema of `↑∥⬝∥₊ : ℝ≥0∞`
for convenience. -/
theorem banach_steinhaus_supr_nnnorm {ι : Type*} [complete_space E] {g : ι → E →SL[σ₁₂] F}
  (h : ∀ x, (⨆ i, ↑∥g i x∥₊) < ∞) :
  (⨆ i, ↑∥g i∥₊) < ∞ :=
begin
  have h' : ∀ x : E, ∃ C : ℝ, ∀ i : ι, ∥g i x∥ ≤ C,
  { intro x,
    rcases lt_iff_exists_coe.mp (h x) with ⟨p, hp₁, _⟩,
    refine ⟨p, (λ i, _)⟩,
    exact_mod_cast
    calc (∥g i x∥₊ : ℝ≥0∞) ≤ ⨆ j,  ∥g j x∥₊ : le_supr _ i
      ...                  = p              : hp₁ },
  cases banach_steinhaus h' with C' hC',
  refine (supr_le $ λ i, _).trans_lt (@coe_lt_top C'.to_nnreal),
  rw ←norm_to_nnreal,
  exact coe_mono (real.to_nnreal_le_to_nnreal $ hC' i),
end

open_locale topological_space
open filter

/-- Given a *sequence* of continuous linear maps which converges pointwise and for which the
domain is complete, the Banach-Steinhaus theorem is used to guarantee that the limit map
is a *continuous* linear map as well. -/
def continuous_linear_map_of_tendsto [complete_space E] [t2_space F]
  (g : ℕ → E →SL[σ₁₂] F) {f : E → F} (h : tendsto (λ n x, g n x) at_top (𝓝 f)) :
  E →SL[σ₁₂] F :=
{ to_fun := f,
  map_add' := (linear_map_of_tendsto _ _ h).map_add',
  map_smul' := (linear_map_of_tendsto _ _ h).map_smul',
  cont :=
    begin
      /- show that the maps are pointwise bounded and apply `banach_steinhaus`-/
      have h_point_bdd : ∀ x : E, ∃ C : ℝ, ∀ n : ℕ, ∥g n x∥ ≤ C,
      { intro x,
        rcases cauchy_seq_bdd (tendsto_pi_nhds.mp h x).cauchy_seq with ⟨C, C_pos, hC⟩,
        refine ⟨C + ∥g 0 x∥, (λ n, _)⟩,
        simp_rw dist_eq_norm at hC,
        calc ∥g n x∥ ≤ ∥g 0 x∥ + ∥g n x - g 0 x∥ : norm_le_insert' _ _
          ...        ≤ C + ∥g 0 x∥               : by linarith [hC n 0] },
      cases banach_steinhaus h_point_bdd with C' hC',
      /- show the uniform bound from `banach_steinhaus` is a norm bound of the limit map
         by allowing "an `ε` of room." -/
      refine linear_map.continuous_of_bound (linear_map_of_tendsto _ _ h) C'
        (λ x, le_of_forall_pos_lt_add (λ ε ε_pos, _)),
      cases metric.tendsto_at_top.mp (tendsto_pi_nhds.mp h x) ε ε_pos with n hn,
      have lt_ε : ∥g n x - f x∥ < ε, by {rw ←dist_eq_norm, exact hn n (le_refl n)},
      calc ∥f x∥ ≤ ∥g n x∥ + ∥g n x - f x∥ : norm_le_insert _ _
        ...      < ∥g n∥ * ∥x∥ + ε        : by linarith [lt_ε, (g n).le_op_norm x]
        ...      ≤ C' * ∥x∥ + ε           : by nlinarith [hC' n, norm_nonneg x],
    end }


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

! This file was ported from Lean 3 source module algebra.category.Group.images
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Group.Abelian
import Mathbin.CategoryTheory.Limits.Shapes.Images

/-!
# The category of commutative additive groups has images.

Note that we don't need to register any of the constructions here as instances, because we get them
from the fact that `AddCommGroup` is an abelian category.
-/

open CategoryTheory

open CategoryTheory.Limits

universe u

namespace AddCommGroupCat

-- Note that because `injective_of_mono` is currently only proved in `Type 0`,
-- we restrict to the lowest universe here for now.
variable {G H : AddCommGroupCat.{0}} (f : G ⟶ H)

attribute [local ext] Subtype.ext_val

section

-- implementation details of `has_image` for AddCommGroup; use the API, not these
/-- the image of a morphism in AddCommGroup is just the bundling of `add_monoid_hom.range f` -/
def image : AddCommGroupCat :=
  AddCommGroupCat.of (AddMonoidHom.range f)
#align AddCommGroup.image AddCommGroupCat.image

/-- the inclusion of `image f` into the target -/
def image.ι : image f ⟶ H :=
  f.range.Subtype
#align AddCommGroup.image.ι AddCommGroupCat.image.ι

instance : Mono (image.ι f) :=
  ConcreteCategory.mono_of_injective (image.ι f) Subtype.val_injective

/-- the corestriction map to the image -/
def factorThruImage : G ⟶ image f :=
  f.range_restrict
#align AddCommGroup.factor_thru_image AddCommGroupCat.factorThruImage

theorem image.fac : factorThruImage f ≫ image.ι f = f :=
  by
  ext
  rfl
#align AddCommGroup.image.fac AddCommGroupCat.image.fac

attribute [local simp] image.fac

variable {f}

/-- the universal property for the image factorisation -/
noncomputable def image.lift (F' : MonoFactorisation f) : image f ⟶ F'.i
    where
  toFun := (fun x => F'.e (Classical.indefiniteDescription _ x.2).1 : image f → F'.i)
  map_zero' := by
    haveI := F'.m_mono
    apply injective_of_mono F'.m
    change (F'.e ≫ F'.m) _ = _
    rw [F'.fac, AddMonoidHom.map_zero]
    exact (Classical.indefiniteDescription (fun y => f y = 0) _).2
  map_add' := by
    intro x y
    haveI := F'.m_mono
    apply injective_of_mono F'.m
    rw [AddMonoidHom.map_add]
    change (F'.e ≫ F'.m) _ = (F'.e ≫ F'.m) _ + (F'.e ≫ F'.m) _
    rw [F'.fac]
    rw [(Classical.indefiniteDescription (fun z => f z = _) _).2]
    rw [(Classical.indefiniteDescription (fun z => f z = _) _).2]
    rw [(Classical.indefiniteDescription (fun z => f z = _) _).2]
    rfl
#align AddCommGroup.image.lift AddCommGroupCat.image.lift

theorem image.lift_fac (F' : MonoFactorisation f) : image.lift F' ≫ F'.m = image.ι f :=
  by
  ext x
  change (F'.e ≫ F'.m) _ = _
  rw [F'.fac, (Classical.indefiniteDescription _ x.2).2]
  rfl
#align AddCommGroup.image.lift_fac AddCommGroupCat.image.lift_fac

end

/-- the factorisation of any morphism in AddCommGroup through a mono. -/
def monoFactorisation : MonoFactorisation f
    where
  i := image f
  m := image.ι f
  e := factorThruImage f
#align AddCommGroup.mono_factorisation AddCommGroupCat.monoFactorisation

/-- the factorisation of any morphism in AddCommGroup through a mono has the universal property of
the image. -/
noncomputable def isImage : IsImage (monoFactorisation f)
    where
  lift := image.lift
  lift_fac := image.lift_fac
#align AddCommGroup.is_image AddCommGroupCat.isImage

/-- The categorical image of a morphism in `AddCommGroup`
agrees with the usual group-theoretical range.
-/
noncomputable def imageIsoRange {G H : AddCommGroupCat.{0}} (f : G ⟶ H) :
    Limits.image f ≅ AddCommGroupCat.of f.range :=
  IsImage.isoExt (Image.isImage f) (isImage f)
#align AddCommGroup.image_iso_range AddCommGroupCat.imageIsoRange

end AddCommGroupCat


/-
Copyright (c) 2022 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis

! This file was ported from Lean 3 source module topology.algebra.module.character_space
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Module.WeakDual
import Mathbin.Algebra.Algebra.Spectrum
import Mathbin.Topology.ContinuousFunction.Algebra

/-!
# Character space of a topological algebra

The character space of a topological algebra is the subset of elements of the weak dual that
are also algebra homomorphisms. This space is used in the Gelfand transform, which gives an
isomorphism between a commutative C⋆-algebra and continuous functions on the character space
of the algebra. This, in turn, is used to construct the continuous functional calculus on
C⋆-algebras.

## Implementation notes

We define `character_space 𝕜 A` as a subset of the weak dual, which automatically puts the
correct topology on the space. We then define `to_alg_hom` which provides the algebra homomorphism
corresponding to any element. We also provide `to_clm` which provides the element as a
continuous linear map. (Even though `weak_dual 𝕜 A` is a type copy of `A →L[𝕜] 𝕜`, this is
often more convenient.)

## Tags

character space, Gelfand transform, functional calculus

-/

namespace WeakDual

/-- The character space of a topological algebra is the subset of elements of the weak dual that
are also algebra homomorphisms. -/
def characterSpace (𝕜 : Type _) (A : Type _) [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜]
    [ContinuousConstSMul 𝕜 𝕜] [NonUnitalNonAssocSemiring A] [TopologicalSpace A] [Module 𝕜 A] :=
  { φ : WeakDual 𝕜 A | φ ≠ 0 ∧ ∀ x y : A, φ (x * y) = φ x * φ y }
#align weak_dual.character_space WeakDual.characterSpace

variable {𝕜 : Type _} {A : Type _}

namespace CharacterSpace

section NonUnitalNonAssocSemiring

variable [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜] [ContinuousConstSMul 𝕜 𝕜]
  [NonUnitalNonAssocSemiring A] [TopologicalSpace A] [Module 𝕜 A]

@[simp, norm_cast, protected]
theorem coe_coe (φ : characterSpace 𝕜 A) : ⇑(φ : WeakDual 𝕜 A) = φ :=
  rfl
#align weak_dual.character_space.coe_coe WeakDual.characterSpace.coe_coe

/-- Elements of the character space are continuous linear maps. -/
instance : ContinuousLinearMapClass (characterSpace 𝕜 A) 𝕜 A 𝕜
    where
  coe φ := (φ : A → 𝕜)
  coe_injective' φ ψ h := by
    ext
    exact congr_fun h x
  map_smulₛₗ φ := (φ : WeakDual 𝕜 A).map_smul
  map_add φ := (φ : WeakDual 𝕜 A).map_add
  map_continuous φ := (φ : WeakDual 𝕜 A).cont

@[ext]
theorem ext {φ ψ : characterSpace 𝕜 A} (h : ∀ x, φ x = ψ x) : φ = ψ :=
  FunLike.ext _ _ h
#align weak_dual.character_space.ext WeakDual.characterSpace.ext

/-- An element of the character space, as a continuous linear map. -/
def toClm (φ : characterSpace 𝕜 A) : A →L[𝕜] 𝕜 :=
  (φ : WeakDual 𝕜 A)
#align weak_dual.character_space.to_clm WeakDual.characterSpace.toClm

@[simp]
theorem coe_toClm (φ : characterSpace 𝕜 A) : ⇑(toClm φ) = φ :=
  rfl
#align weak_dual.character_space.coe_to_clm WeakDual.characterSpace.coe_toClm

/-- Elements of the character space are non-unital algebra homomorphisms. -/
instance : NonUnitalAlgHomClass (characterSpace 𝕜 A) 𝕜 A 𝕜 :=
  {
    characterSpace.continuousLinearMapClass with
    map_smul := fun φ => map_smul φ
    map_zero := fun φ => map_zero φ
    map_mul := fun φ => φ.Prop.2 }

/-- An element of the character space, as an non-unital algebra homomorphism. -/
def toNonUnitalAlgHom (φ : characterSpace 𝕜 A) : A →ₙₐ[𝕜] 𝕜
    where
  toFun := (φ : A → 𝕜)
  map_mul' := map_mul φ
  map_smul' := map_smul φ
  map_zero' := map_zero φ
  map_add' := map_add φ
#align weak_dual.character_space.to_non_unital_alg_hom WeakDual.characterSpace.toNonUnitalAlgHom

@[simp]
theorem coe_toNonUnitalAlgHom (φ : characterSpace 𝕜 A) : ⇑(toNonUnitalAlgHom φ) = φ :=
  rfl
#align weak_dual.character_space.coe_to_non_unital_alg_hom WeakDual.characterSpace.coe_toNonUnitalAlgHom

instance [Subsingleton A] : IsEmpty (characterSpace 𝕜 A) :=
  ⟨fun φ =>
    φ.Prop.1 <| ContinuousLinearMap.ext fun x => by simp only [Subsingleton.elim x 0, map_zero]⟩

variable (𝕜 A)

theorem union_zero :
    characterSpace 𝕜 A ∪ {0} = { φ : WeakDual 𝕜 A | ∀ x y : A, φ (x * y) = φ x * φ y } :=
  le_antisymm
    (by
      rintro φ (hφ | h₀)
      · exact hφ.2
      · exact fun x y => by simp [Set.eq_of_mem_singleton h₀])
    fun φ hφ => Or.elim (em <| φ = 0) (fun h₀ => Or.inr h₀) fun h₀ => Or.inl ⟨h₀, hφ⟩
#align weak_dual.character_space.union_zero WeakDual.characterSpace.union_zero

/-- The `character_space 𝕜 A` along with `0` is always a closed set in `weak_dual 𝕜 A`. -/
theorem union_zero_isClosed [T2Space 𝕜] [ContinuousMul 𝕜] : IsClosed (characterSpace 𝕜 A ∪ {0}) :=
  by
  simp only [union_zero, Set.setOf_forall]
  exact
    isClosed_interᵢ fun x =>
      isClosed_interᵢ fun y =>
        isClosed_eq (eval_continuous _) <| (eval_continuous _).mul (eval_continuous _)
#align weak_dual.character_space.union_zero_is_closed WeakDual.characterSpace.union_zero_isClosed

end NonUnitalNonAssocSemiring

section Unital

variable [CommRing 𝕜] [NoZeroDivisors 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜]
  [ContinuousConstSMul 𝕜 𝕜] [TopologicalSpace A] [Semiring A] [Algebra 𝕜 A]

/-- In a unital algebra, elements of the character space are algebra homomorphisms. -/
instance : AlgHomClass (characterSpace 𝕜 A) 𝕜 A 𝕜 :=
  have map_one' : ∀ φ : characterSpace 𝕜 A, φ 1 = 1 := fun φ =>
    by
    have h₁ : φ 1 * (1 - φ 1) = 0 := by rw [mul_sub, sub_eq_zero, mul_one, ← map_mul φ, one_mul]
    rcases mul_eq_zero.mp h₁ with (h₂ | h₂)
    · have : ∀ a, φ (a * 1) = 0 := fun a => by simp only [map_mul φ, h₂, MulZeroClass.mul_zero]
      exact False.elim (φ.prop.1 <| ContinuousLinearMap.ext <| by simpa only [mul_one] using this)
    · exact (sub_eq_zero.mp h₂).symm
  {
    characterSpace.nonUnitalAlgHomClass with
    map_one := map_one'
    commutes := fun φ r =>
      by
      rw [Algebra.algebraMap_eq_smul_one, Algebra.id.map_eq_id, RingHom.id_apply]
      change ((φ : WeakDual 𝕜 A) : A →L[𝕜] 𝕜) (r • 1) = r
      rw [map_smul, Algebra.id.smul_eq_mul, character_space.coe_coe, map_one' φ, mul_one] }

/-- An element of the character space of a unital algebra, as an algebra homomorphism. -/
@[simps]
def toAlgHom (φ : characterSpace 𝕜 A) : A →ₐ[𝕜] 𝕜 :=
  { toNonUnitalAlgHom φ with
    map_one' := map_one φ
    commutes' := AlgHomClass.commutes φ }
#align weak_dual.character_space.to_alg_hom WeakDual.characterSpace.toAlgHom

theorem eq_set_map_one_map_mul [Nontrivial 𝕜] :
    characterSpace 𝕜 A = { φ : WeakDual 𝕜 A | φ 1 = 1 ∧ ∀ x y : A, φ (x * y) = φ x * φ y } :=
  by
  ext x
  refine' ⟨fun h => ⟨map_one (⟨x, h⟩ : character_space 𝕜 A), h.2⟩, fun h => ⟨_, h.2⟩⟩
  rintro rfl
  simpa using h.1
#align weak_dual.character_space.eq_set_map_one_map_mul WeakDual.characterSpace.eq_set_map_one_map_mul

/-- under suitable mild assumptions on `𝕜`, the character space is a closed set in
`weak_dual 𝕜 A`. -/
protected theorem isClosed [Nontrivial 𝕜] [T2Space 𝕜] [ContinuousMul 𝕜] :
    IsClosed (characterSpace 𝕜 A) :=
  by
  rw [eq_set_map_one_map_mul, Set.setOf_and]
  refine' IsClosed.inter (isClosed_eq (eval_continuous _) continuous_const) _
  simpa only [(union_zero 𝕜 A).symm] using union_zero_is_closed _ _
#align weak_dual.character_space.is_closed WeakDual.characterSpace.isClosed

end Unital

section Ring

variable [CommRing 𝕜] [NoZeroDivisors 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜]
  [ContinuousConstSMul 𝕜 𝕜] [TopologicalSpace A] [Ring A] [Algebra 𝕜 A]

theorem apply_mem_spectrum [Nontrivial 𝕜] (φ : characterSpace 𝕜 A) (a : A) : φ a ∈ spectrum 𝕜 a :=
  AlgHom.apply_mem_spectrum φ a
#align weak_dual.character_space.apply_mem_spectrum WeakDual.characterSpace.apply_mem_spectrum

theorem ext_ker {φ ψ : characterSpace 𝕜 A} (h : RingHom.ker φ = RingHom.ker ψ) : φ = ψ :=
  by
  ext
  have : x - algebraMap 𝕜 A (ψ x) ∈ RingHom.ker φ := by
    simpa only [h, RingHom.mem_ker, map_sub, AlgHomClass.commutes] using sub_self (ψ x)
  · rwa [RingHom.mem_ker, map_sub, AlgHomClass.commutes, sub_eq_zero] at this
#align weak_dual.character_space.ext_ker WeakDual.characterSpace.ext_ker

end Ring

end CharacterSpace

section Kernel

variable [Field 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜] [ContinuousConstSMul 𝕜 𝕜]

variable [Ring A] [TopologicalSpace A] [Algebra 𝕜 A]

/-- The `ring_hom.ker` of `φ : character_space 𝕜 A` is maximal. -/
instance ker_isMaximal (φ : characterSpace 𝕜 A) : (RingHom.ker φ).IsMaximal :=
  RingHom.ker_isMaximal_of_surjective φ fun z =>
    ⟨algebraMap 𝕜 A z, by simp only [AlgHomClass.commutes, Algebra.id.map_eq_id, RingHom.id_apply]⟩
#align weak_dual.ker_is_maximal WeakDual.ker_isMaximal

end Kernel

section GelfandTransform

open ContinuousMap

variable (𝕜 A) [CommRing 𝕜] [NoZeroDivisors 𝕜] [TopologicalSpace 𝕜] [TopologicalRing 𝕜]
  [TopologicalSpace A] [Semiring A] [Algebra 𝕜 A]

/-- The **Gelfand transform** is an algebra homomorphism (over `𝕜`) from a topological `𝕜`-algebra
`A` into the `𝕜`-algebra of continuous `𝕜`-valued functions on the `character_space 𝕜 A`.
The character space itself consists of all algebra homomorphisms from `A` to `𝕜`.  -/
@[simps]
def gelfandTransform : A →ₐ[𝕜] C(characterSpace 𝕜 A, 𝕜)
    where
  toFun a :=
    { toFun := fun φ => φ a
      continuous_toFun := (eval_continuous a).comp continuous_induced_dom }
  map_one' := by
    ext
    simp only [coe_mk, coe_one, Pi.one_apply, map_one a]
  map_mul' a b := by
    ext
    simp only [map_mul, coe_mk, coe_mul, Pi.mul_apply]
  map_zero' := by
    ext
    simp only [map_zero, coe_mk, coe_mul, coe_zero, Pi.zero_apply]
  map_add' a b := by
    ext
    simp only [map_add, coe_mk, coe_add, Pi.add_apply]
  commutes' k := by
    ext
    simp only [AlgHomClass.commutes, Algebra.id.map_eq_id, RingHom.id_apply, coe_mk,
      algebraMap_apply, Algebra.id.smul_eq_mul, mul_one]
#align weak_dual.gelfand_transform WeakDual.gelfandTransform

end GelfandTransform

end WeakDual