/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.continuous_function.bounded
import topology.uniform_space.compact_separated
import topology.compact_open
import topology.sets.compacts

/-!
# Continuous functions on a compact space

Continuous functions `C(α, β)` from a compact space `α` to a metric space `β`
are automatically bounded, and so acquire various structures inherited from `α →ᵇ β`.

This file transfers these structures, and restates some lemmas
characterising these structures.

If you need a lemma which is proved about `α →ᵇ β` but not for `C(α, β)` when `α` is compact,
you should restate it here. You can also use
`bounded_continuous_function.equiv_continuous_map_of_compact` to move functions back and forth.

-/

noncomputable theory
open_locale topological_space classical nnreal bounded_continuous_function big_operators

open set filter metric

open bounded_continuous_function

namespace continuous_map

variables {α β E : Type*} [topological_space α] [compact_space α] [metric_space β] [normed_group E]

section

variables (α β)

/--
When `α` is compact, the bounded continuous maps `α →ᵇ β` are
equivalent to `C(α, β)`.
-/
@[simps { fully_applied := ff }]
def equiv_bounded_of_compact : C(α, β) ≃ (α →ᵇ β) :=
⟨mk_of_compact, to_continuous_map, λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

lemma uniform_inducing_equiv_bounded_of_compact :
  uniform_inducing (equiv_bounded_of_compact α β) :=
uniform_inducing.mk'
begin
  simp only [has_basis_compact_convergence_uniformity.mem_iff, uniformity_basis_dist_le.mem_iff],
  exact λ s, ⟨λ ⟨⟨a, b⟩, ⟨ha, ⟨ε, hε, hb⟩⟩, hs⟩, ⟨{p | ∀ x, (p.1 x, p.2 x) ∈ b},
    ⟨ε, hε, λ _ h x, hb (by exact (dist_le hε.le).mp h x)⟩, λ f g h, hs (by exact λ x hx, h x)⟩,
    λ ⟨t, ⟨ε, hε, ht⟩, hs⟩, ⟨⟨set.univ, {p | dist p.1 p.2 ≤ ε}⟩, ⟨compact_univ, ⟨ε, hε, λ _ h, h⟩⟩,
    λ ⟨f, g⟩ h, hs _ _ (ht (by exact (dist_le hε.le).mpr (λ x, h x (mem_univ x))))⟩⟩,
end

lemma uniform_embedding_equiv_bounded_of_compact :
  uniform_embedding (equiv_bounded_of_compact α β) :=
{ inj := (equiv_bounded_of_compact α β).injective,
  .. uniform_inducing_equiv_bounded_of_compact α β }

/--
When `α` is compact, the bounded continuous maps `α →ᵇ 𝕜` are
additively equivalent to `C(α, 𝕜)`.
-/
@[simps apply symm_apply { fully_applied := ff }]
def add_equiv_bounded_of_compact [add_monoid β] [has_lipschitz_add β] :
  C(α, β) ≃+ (α →ᵇ β) :=
({ .. to_continuous_map_add_hom α β,
   .. (equiv_bounded_of_compact α β).symm, } : (α →ᵇ β) ≃+ C(α, β)).symm

instance : metric_space C(α, β) :=
(uniform_embedding_equiv_bounded_of_compact α β).comap_metric_space _

/--
When `α` is compact, and `β` is a metric space, the bounded continuous maps `α →ᵇ β` are
isometric to `C(α, β)`.
-/
@[simps to_equiv apply symm_apply { fully_applied := ff }]
def isometric_bounded_of_compact :
  C(α, β) ≃ᵢ (α →ᵇ β) :=
{ isometry_to_fun := λ x y, rfl,
  to_equiv := equiv_bounded_of_compact α β }

end

@[simp] lemma _root_.bounded_continuous_function.dist_mk_of_compact (f g : C(α, β)) :
  dist (mk_of_compact f) (mk_of_compact g) = dist f g := rfl

@[simp] lemma _root_.bounded_continuous_function.dist_to_continuous_map (f g : α →ᵇ β) :
  dist (f.to_continuous_map) (g.to_continuous_map) = dist f g := rfl

open bounded_continuous_function

section
variables {α β} {f g : C(α, β)} {C : ℝ}

/-- The pointwise distance is controlled by the distance between functions, by definition. -/
lemma dist_apply_le_dist (x : α) : dist (f x) (g x) ≤ dist f g :=
by simp only [← dist_mk_of_compact, dist_coe_le_dist, ← mk_of_compact_apply]

/-- The distance between two functions is controlled by the supremum of the pointwise distances -/
lemma dist_le (C0 : (0 : ℝ) ≤ C) : dist f g ≤ C ↔ ∀x:α, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le C0, mk_of_compact_apply]

lemma dist_le_iff_of_nonempty [nonempty α] :
  dist f g ≤ C ↔ ∀ x, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le_iff_of_nonempty, mk_of_compact_apply]

lemma dist_lt_iff_of_nonempty [nonempty α] :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_nonempty_compact, mk_of_compact_apply]

lemma dist_lt_of_nonempty [nonempty α] (w : ∀x:α, dist (f x) (g x) < C) : dist f g < C :=
(dist_lt_iff_of_nonempty).2 w

lemma dist_lt_iff (C0 : (0 : ℝ) < C) :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_compact C0, mk_of_compact_apply]

end

instance [complete_space β] : complete_space (C(α, β)) :=
(isometric_bounded_of_compact α β).complete_space

/-- See also `continuous_map.continuous_eval'` -/
@[continuity] lemma continuous_eval : continuous (λ p : C(α, β) × α, p.1 p.2) :=
continuous_eval.comp ((isometric_bounded_of_compact α β).continuous.prod_map continuous_id)

/-- See also `continuous_map.continuous_eval_const` -/
@[continuity] lemma continuous_eval_const (x : α) : continuous (λ f : C(α, β), f x) :=
continuous_eval.comp (continuous_id.prod_mk continuous_const)

/-- See also `continuous_map.continuous_coe'` -/
lemma continuous_coe : @continuous (C(α, β)) (α → β) _ _ coe_fn :=
continuous_pi continuous_eval_const

-- TODO at some point we will need lemmas characterising this norm!
-- At the moment the only way to reason about it is to transfer `f : C(α,E)` back to `α →ᵇ E`.
instance : has_norm C(α, E) :=
{ norm := λ x, dist x 0 }

@[simp] lemma _root_.bounded_continuous_function.norm_mk_of_compact (f : C(α, E)) :
  ∥mk_of_compact f∥ = ∥f∥ := rfl

@[simp] lemma _root_.bounded_continuous_function.norm_to_continuous_map_eq (f : α →ᵇ E) :
  ∥f.to_continuous_map∥ = ∥f∥ :=
rfl

open bounded_continuous_function

instance : normed_group C(α, E) :=
{ dist_eq := λ x y, by
    rw [← norm_mk_of_compact, ← dist_mk_of_compact, dist_eq_norm, mk_of_compact_sub] }

section
variables (f : C(α, E))
-- The corresponding lemmas for `bounded_continuous_function` are stated with `{f}`,
-- and so can not be used in dot notation.

lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ :=
(mk_of_compact f).norm_coe_le_norm x

/-- Distance between the images of any two points is at most twice the norm of the function. -/
lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ∥f∥ :=
(mk_of_compact f).dist_le_two_norm x y

/-- The norm of a function is controlled by the supremum of the pointwise norms -/
lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
@bounded_continuous_function.norm_le _ _ _ _
  (mk_of_compact f) _ C0

lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
@bounded_continuous_function.norm_le_of_nonempty _ _ _ _ _ (mk_of_compact f) _

lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_compact _ _ _ _ _ (mk_of_compact f) _ M0

lemma norm_lt_iff_of_nonempty [nonempty α] {M : ℝ} :
  ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_nonempty_compact _ _ _ _ _ _ (mk_of_compact f) _

lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ∥f∥ :=
le_trans (le_abs.mpr (or.inl (le_refl (f x)))) (f.norm_coe_le_norm x)

lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -∥f∥ ≤ f x :=
le_trans (neg_le_neg (f.norm_coe_le_norm x)) (neg_le.mp (neg_le_abs_self (f x)))

lemma norm_eq_supr_norm : ∥f∥ = ⨆ x : α, ∥f x∥ :=
(mk_of_compact f).norm_eq_supr_norm

end

section
variables {R : Type*} [normed_ring R]

instance : normed_ring C(α,R) :=
{ norm_mul := λ f g, norm_mul_le (mk_of_compact f) (mk_of_compact g),
  ..(infer_instance : normed_group C(α,R)) }

end

section
variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]

instance : normed_space 𝕜 C(α,E) :=
{ norm_smul_le := λ c f, le_of_eq (norm_smul c (mk_of_compact f)) }

section
variables (α 𝕜 E)

/--
When `α` is compact and `𝕜` is a normed field,
the `𝕜`-algebra of bounded continuous maps `α →ᵇ β` is
`𝕜`-linearly isometric to `C(α, β)`.
-/
def linear_isometry_bounded_of_compact :
  C(α, E) ≃ₗᵢ[𝕜] (α →ᵇ E) :=
{ map_smul' := λ c f, by { ext, simp, },
  norm_map' := λ f, rfl,
  .. add_equiv_bounded_of_compact α E }

end

-- this lemma and the next are the analogues of those autogenerated by `@[simps]` for
-- `equiv_bounded_of_compact`, `add_equiv_bounded_of_compact`
@[simp] lemma linear_isometry_bounded_of_compact_symm_apply (f : α →ᵇ E) :
  (linear_isometry_bounded_of_compact α E 𝕜).symm f = f.to_continuous_map :=
rfl

@[simp] lemma linear_isometry_bounded_of_compact_apply_apply (f : C(α, E)) (a : α) :
  (linear_isometry_bounded_of_compact α E 𝕜 f) a = f a :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_isometric :
  (linear_isometry_bounded_of_compact α E 𝕜).to_isometric = (isometric_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_add_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_add_equiv =
    (add_equiv_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_of_compact_to_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_equiv =
    (equiv_bounded_of_compact α E) :=
rfl

end

section
variables {𝕜 : Type*} {γ : Type*} [normed_field 𝕜] [normed_ring γ] [normed_algebra 𝕜 γ]

instance [nonempty α] : normed_algebra 𝕜 C(α, γ) :=
{ norm_algebra_map_eq := λ c, (norm_algebra_map_eq (α →ᵇ γ) c : _), }

end

end continuous_map

namespace continuous_map

section uniform_continuity
variables {α β : Type*}
variables [metric_space α] [compact_space α] [metric_space β]

/-!
We now set up some declarations making it convenient to use uniform continuity.
-/

lemma uniform_continuity
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) :
  ∃ δ > 0, ∀ {x y}, dist x y < δ → dist (f x) (f y) < ε :=
metric.uniform_continuous_iff.mp
  (compact_space.uniform_continuous_of_continuous f.continuous) ε h

/--
An arbitrarily chosen modulus of uniform continuity for a given function `f` and `ε > 0`.
-/
-- This definition allows us to separate the choice of some `δ`,
-- and the corresponding use of `dist a b < δ → dist (f a) (f b) < ε`,
-- even across different declarations.
def modulus (f : C(α, β)) (ε : ℝ) (h : 0 < ε) : ℝ :=
classical.some (uniform_continuity f ε h)

lemma modulus_pos (f : C(α, β)) {ε : ℝ} {h : 0 < ε} : 0 < f.modulus ε h :=
(classical.some_spec (uniform_continuity f ε h)).fst

lemma dist_lt_of_dist_lt_modulus
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) {a b : α} (w : dist a b < f.modulus ε h) :
  dist (f a) (f b) < ε :=
(classical.some_spec (uniform_continuity f ε h)).snd w

end uniform_continuity

end continuous_map

section comp_left
variables (X : Type*) {𝕜 β γ : Type*} [topological_space X] [compact_space X]
  [nondiscrete_normed_field 𝕜]
variables [normed_group β] [normed_space 𝕜 β] [normed_group γ] [normed_space 𝕜 γ]

open continuous_map

/--
Postcomposition of continuous functions into a normed module by a continuous linear map is a
continuous linear map.
Transferred version of `continuous_linear_map.comp_left_continuous_bounded`,
upgraded version of `continuous_linear_map.comp_left_continuous`,
similar to `linear_map.comp_left`. -/
protected def continuous_linear_map.comp_left_continuous_compact (g : β →L[𝕜] γ) :
  C(X, β) →L[𝕜] C(X, γ) :=
(linear_isometry_bounded_of_compact X γ 𝕜).symm.to_linear_isometry.to_continuous_linear_map.comp $
(g.comp_left_continuous_bounded X).comp $
(linear_isometry_bounded_of_compact X β 𝕜).to_linear_isometry.to_continuous_linear_map

@[simp] lemma continuous_linear_map.to_linear_comp_left_continuous_compact (g : β →L[𝕜] γ) :
  (g.comp_left_continuous_compact X : C(X, β) →ₗ[𝕜] C(X, γ)) = g.comp_left_continuous 𝕜 X :=
by { ext f, refl }

@[simp] lemma continuous_linear_map.comp_left_continuous_compact_apply (g : β →L[𝕜] γ)
  (f : C(X, β)) (x : X) :
  g.comp_left_continuous_compact X f x = g (f x) :=
rfl

end comp_left

namespace continuous_map
/-!
We now setup variations on `comp_right_* f`, where `f : C(X, Y)`
(that is, precomposition by a continuous map),
as a morphism `C(Y, T) → C(X, T)`, respecting various types of structure.

In particular:
* `comp_right_continuous_map`, the bundled continuous map (for this we need `X Y` compact).
* `comp_right_homeomorph`, when we precompose by a homeomorphism.
* `comp_right_alg_hom`, when `T = R` is a topological ring.
-/
section comp_right

/--
Precomposition by a continuous map is itself a continuous map between spaces of continuous maps.
-/
def comp_right_continuous_map {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) : C(C(Y, T), C(X, T)) :=
{ to_fun := λ g, g.comp f,
  continuous_to_fun :=
  begin
    refine metric.continuous_iff.mpr _,
    intros g ε ε_pos,
    refine ⟨ε, ε_pos, λ g' h, _⟩,
    rw continuous_map.dist_lt_iff ε_pos at h ⊢,
    { exact λ x, h (f x), },
  end }

@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) (g : C(Y, T)) :
  (comp_right_continuous_map T f) g = g.comp f :=
rfl

/--
Precomposition by a homeomorphism is itself a homeomorphism between spaces of continuous maps.
-/
def comp_right_homeomorph {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : X ≃ₜ Y) : C(Y, T) ≃ₜ C(X, T) :=
{ to_fun := comp_right_continuous_map T f.to_continuous_map,
  inv_fun := comp_right_continuous_map T f.symm.to_continuous_map,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
Precomposition of functions into a normed ring by continuous map is an algebra homomorphism.
-/
def comp_right_alg_hom {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) :
  C(Y, R) →ₐ[R] C(X, R) :=
{ to_fun := λ g, g.comp f,
  map_zero' := by { ext, simp, },
  map_add' := λ g₁ g₂, by { ext, simp, },
  map_one' := by { ext, simp, },
  map_mul' := λ g₁ g₂, by { ext, simp, },
  commutes' := λ r, by { ext, simp, }, }

@[simp] lemma comp_right_alg_hom_apply {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) (g : C(Y, R)) :
  (comp_right_alg_hom R f) g = g.comp f :=
rfl

lemma comp_right_alg_hom_continuous {X Y : Type*} (R : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y]
  [normed_comm_ring R] (f : C(X, Y)) :
  continuous (comp_right_alg_hom R f) :=
begin
  change continuous (comp_right_continuous_map R f),
  continuity,
end

end comp_right

section weierstrass

open topological_space

variables {X : Type*} [topological_space X] [t2_space X] [locally_compact_space X]
variables {E : Type*} [normed_group E] [complete_space E]

lemma summable_of_locally_summable_norm {ι : Type*} {F : ι → C(X, E)}
  (hF : ∀ K : compacts X, summable (λ i, ∥(F i).restrict K∥)) :
  summable F :=
begin
  refine (continuous_map.exists_tendsto_compact_open_iff_forall _).2 (λ K hK, _),
  lift K to compacts X using hK,
  have A : ∀ s : finset ι, restrict ↑K (∑ i in s, F i) = ∑ i in s, restrict K (F i),
  { intro s, ext1 x, simp },
  simpa only [has_sum, A] using summable_of_summable_norm (hF K)
end

end weierstrass

end continuous_map


def ack: nat -> nat -> nat
| 0 n := n + 1
| (m + 1) 0 := ack m 1
| (m + 1) (n + 1) := ack m (ack (m + 1) n)

lemma ack_2nd_lt_val: forall m n, n < ack m n :=
begin
  intro m,
  induction m with m' ih,
  show forall n, n < ack 0 n,
  {
    intro n,
    calc
      n   < n + 1 : nat.le_refl _
      ... = ack 0 n : by simp only [ack]
  },
  show forall n, n < ack (m' + 1) n,
  {
    intro n,
    induction n with n' ih2,
    show 0 < ack (m' + 1) 0,
    {
      calc
        0   < 1 : nat.le_refl 1
        ... < ack m' 1 : ih 1
        ... = ack (m' + 1) 0 : by simp [ack]
    },
    show n' + 1 < ack (m' + 1) (n' + 1),
    {
      calc
        n' + 1 <= ack (m' + 1) n' : ih2
           ... <  ack m' (ack (m' + 1) n') : by apply ih
           ... =  ack (m' + 1) (n' + 1) : by simp [ack]
    },
  }
end

lemma ack_argsum_lt_val: forall m n, m + n < ack m n :=
begin
  intro m,
  induction m with m' ih,
  show forall n, 0 + n < ack 0 n,
  {
    intro n,
    rw nat.add_comm,
    apply ack_2nd_lt_val,
  },
  show forall n, m' + 1 + n < ack (m' + 1) n,
  {
    intro n,
    induction n with n' ih2,
    show m' + 1 < ack (m'+ 1) 0,
    {
      calc
        m' + 1 < ack m' 1 : by apply ih
           ... = ack (m' + 1) 0 : by simp [ack]
    },
    show m' + 1 + n' + 1 < ack (m' + 1) (n' + 1),
    {
      calc
        m' + 1 + n' + 1 <= m' + (m' + 1 + n' + 1) : by apply nat.le_add_left
                    ... <= m' + ack (m' + 1) n' :
                           by apply nat.add_le_add_left ih2
                    ... < ack m' (ack (m' + 1) n') : by apply ih
                    ... = ack (m' + 1) (n' + 1) : by simp [ack]
    },
  }
end

lemma ack_2nd_succ: forall m n, ack m n < ack m (n + 1) :=
begin
  intros m,
  induction m with m' ih,
  show forall n, ack 0 n < ack 0 (n + 1),
  {
    intro n,
    calc
      ack 0 n = n + 1 : by simp [ack]
          ... < n + 2 : by apply nat.le_refl
          ... = ack 0 (n + 1) : by simp [ack]
  },
  show forall n, ack (m' + 1) n < ack (m' + 1) (n + 1),
  {
    intro n,
    calc
      ack (m' + 1) n < ack m' (ack (m' + 1) n) : by apply ack_2nd_lt_val
                 ... = ack (m' + 1) (n + 1) : by simp [ack]
  }
end

lemma incr_of_succ : forall f: nat -> nat,
  (forall x, f x < f (x + 1)) -> forall m n, m < n -> f m < f n :=
begin
  intros f succ m n hlt,
  induction hlt with n' mlen' ih,
  show f m < f (m + 1), { apply succ },
  show f m < f (n' + 1),
  calc
    f m < f n' : ih
    ... < f (n' + 1) : succ n'
end

lemma incr_eq_of_succ : forall f: nat -> nat,
  (forall x, f x < f (x + 1)) -> forall m n, m <= n -> f m <= f n :=
begin
  intros f succ m n hle,
  induction hle with n' _ ih,
  show f m <= f m, { reflexivity },
  show f m <= f (n' + 1),
  calc
    f m <= f n' : ih
    ... <=  f (n' + 1) : le_of_lt (succ n')
end

lemma ack_2nd_incr: forall m n p, n < p -> ack m n < ack m p :=
  fun m n p,
  assume nltp: n < p,
  incr_of_succ (ack m) (ack_2nd_succ m) n p nltp

lemma ack_2nd_incr_eq: forall m n p, n <= p -> ack m n <= ack m p :=
  fun m n p,
  assume nlep: n <= p,
  incr_eq_of_succ (ack m) (ack_2nd_succ m) n p nlep

lemma ack_1st_succ: forall m n, ack m n < ack (m + 1) n :=
begin
  intros m n,
  induction n with n' ih; simp [ack],
  show ack m 0 < ack m 1, { apply ack_2nd_succ },
  show ack m (n' + 1) < ack m (ack (m + 1) n'),
  {
    calc
      ack m (n' + 1) <= ack m (m + 1 + n') :
            by apply ack_2nd_incr_eq; rw nat.succ_add; apply nat.le_add_left
                 ... <  ack m (ack (m + 1) n') :
            by apply ack_2nd_incr; apply ack_argsum_lt_val
  },
end

lemma ack_1st_incr: forall l m n, l < m -> ack l n < ack m n :=
  fun l m n,
  assume lltm: l < m,
  incr_of_succ (fun i, ack i n) (fun i, ack_1st_succ i n) l m lltm

lemma ack_1st_incr_eq: forall l m n, l <= m -> ack l n <= ack m n :=
  fun l m n,
  assume llem: l <= m,
  incr_eq_of_succ (fun i, ack i n) (fun i, ack_1st_succ i n) l m llem

lemma ack_arg_1st_prior: forall m n, ack m (n + 1) <= ack (m + 1) n :=
begin
  intros m n,
  cases n with n',
  show ack m 1 <= ack (m + 1) 0, { simp [ack] },
  show ack m (n' + 2) <= ack (m + 1) (n' + 1),
  {
    calc
      ack m (n' + 2) <= ack m (ack (m + 1) n') :
        begin
          apply ack_2nd_incr_eq,
          calc
            n' + 2 <= m + 1 + n' + 1 : by rw nat.succ_add; apply nat.le_add_left
               ... <= ack (m + 1) n' : by apply ack_argsum_lt_val
        end
                 ... =  ack (m + 1) (n' + 1) : by simp [ack]
  }
end

lemma ack_arg_1st_prior_any: forall m n p, ack m (n + p) <= ack (m + p) n :=
fun m n p,
begin
  revert m n,
  induction p with p' ih,
  intros m n,
  reflexivity,
  intros m n,
  calc
    ack m (n + p' + 1) <= ack (m + 1) (n + p') : by apply ack_arg_1st_prior
                   ... <= ack (m + 1 + p') n : by apply ih
                   ... =  ack (m + p' + 1) n : by rw nat.succ_add
end

lemma ack_dual_app:
  forall a b y, ack a (ack b y) <= ack (max a b + 1) (y + 1) :=
begin
  intros a b y,
  calc
    ack a (ack b y) <= ack a (ack (max a b + 1) y) :
                       begin
                         apply ack_2nd_incr_eq,
                         apply ack_1st_incr_eq,
                         calc
                           b   <= max a b : by apply le_max_right
                           ... <= max a b + 1 : by apply nat.le_succ
                       end
                ... <= ack (max a b) (ack (max a b + 1) y) : by
                       apply ack_1st_incr_eq; apply le_max_left
                ... =  ack (max a b + 1) (y + 1) : by simp only [ack]
end

@[simp] lemma ack_1_n: forall n, ack 1 n = n + 2 :=
begin
  intro n,
  induction n with n' ih,
  show ack 1 0 = 2, { simp [ack], },
  show ack 1 (n' + 1) = n' + 3,
  calc
    ack 1 (n' + 1) = (ack 1 n') + 1 : by simp [ack]
               ... = n' + 3 : by rw ih
end

@[simp] lemma ack_2_n: forall n, ack 2 n = 2 * n + 3 :=
begin
  intro n,
  induction n with n' ih,
  show ack 2 0 = 3, { simp [ack], },
  show ack 2 (n' + 1) = 2 * n' + 5,
  calc
    ack 2 (n' + 1) = ack 1 (ack 2 n') : by simp [ack]
               ... = ack 2 n' + 2 : by rw ack_1_n
               ... = 2 * n' + 5 : by rw ih
end

lemma ack_lemma_7: forall n x y,
  x >= 3 -> (n + 1) * ack x y <= ack x (y + n) :=
begin
  intros n x y hlt,
  induction n with n' ih2,
  show 1 * ack x y <= ack x y, { rw nat.one_mul },
  show (n' + 2) * ack x y <= ack x (y + n' + 1),
  have h: {x': nat // x' + 1 = x},
  {
    cases x with x',
    have hnotle: not (3 <= 0) := nat.not_succ_le_zero 2,
    contradiction,
    existsi x',
    reflexivity,
  },
  cases h with x' xsucc,
  have x'ge2: x' >= 2,
  {
    apply nat.le_of_add_le_add_right,
    rw xsucc,
    exact hlt,
  },
  calc
    (n' + 2) * ack x y <= 2 * (n' + 1) * ack x y :
                          begin
                            apply nat.mul_le_mul_right,
                            calc
                              n' + 2 <= 1 * n' + n' + 2 :
                                        by apply nat.le_add_left
                                 ... =  2 * n' + 2 : by rw nat.succ_mul 1
                                 ... =  2 * (n' + 1) : by reflexivity,
                          end
                   ... =  2 * ((n' + 1) * ack x y) : by rw nat.mul_assoc
                   ... <= 2 * ack x (y + n') : by
                          apply nat.mul_le_mul_left;
                          exact ih2
                   ... =  2 * ack (x' + 1) (y + n') : by rw xsucc
                   ... <= ack 2 (ack (x' + 1) (y + n')) : by
                          rw ack_2_n; apply nat.le_add_right
                   ... <= ack x' (ack (x' + 1) (y + n')) :
                          by apply ack_1st_incr_eq; exact x'ge2
                   ... =  ack (x' + 1) (y + n' + 1) : by simp only [ack]
                   ... =  ack x (y + n' + 1) : by rw xsucc
end

lemma ack_lemma_8: forall m n, m >= 1 -> ack (m + 1) n > ack m (2 * n) :=
begin
  intros m n mge1,
  revert n,
  cases nat.eq_or_lt_of_le mge1 with heq hlt,
  cases heq,
  show forall n, ack 2 n > ack 1 (2 * n),
  {
    intro n,
    calc
      ack 2 n = 2 * n + 3 : by rw ack_2_n
          ... > 2 * n + 2 : by apply nat.le_refl
          ... = ack 1 (2 * n) : by rw ack_1_n
  },
  show forall n, ack (m + 1) n > ack m (2 * n),
  intro n,
  induction n with n' ih2,
  show ack (m + 1) 0 > ack m 0, { apply ack_1st_succ },
  show ack (m + 1) (n' + 1) > ack m (2 * n' + 2),
  calc
    ack (m + 1) (n' + 1) =  ack m (ack (m + 1) n') : by simp [ack]
                    ...  >  ack m (ack m (2 * n')) : by
                            apply ack_2nd_incr; apply ih2
                    ...  >= ack m (2 * n' + 2) :
                           begin
                             apply ack_2nd_incr_eq,
                             calc
                               ack m (2 * n') >= ack 1 (2 * n') :
                                                 begin
                                                   apply ack_1st_incr_eq,
                                                   exact mge1
                                                 end
                                          ... =  2 * n' + 2 : by rw ack_1_n
                           end
end


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

/-!
# The group of units of a complete normed ring

This file contains the basic theory for the group of units (invertible elements) of a complete
normed ring (Banach algebras being a notable special case).

## Main results

The constructions `one_sub`, `add` and `unit_of_nearby` state, in varying forms, that perturbations
of a unit are units.  The latter two are not stated in their optimal form; more precise versions
would use the spectral radius.

The first main result is `is_open`:  the group of units of a complete normed ring is an open subset
of the ring.

The function `inverse` (defined in `algebra.ring`), for a ring `R`, sends `a : R` to `a⁻¹` if `a` is
a unit and 0 if not.  The other major results of this file (notably `inverse_add`,
`inverse_add_norm` and `inverse_add_norm_diff_nth_order`) cover the asymptotic properties of
`inverse (x + t)` as `t → 0`.

-/

noncomputable theory
open_locale topological_space
variables {R : Type*} [normed_ring R] [complete_space R]

namespace units

/-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1`
from `1` is a unit.  Here we construct its `units` structure.  -/
@[simps coe]
def one_sub (t : R) (h : ∥t∥ < 1) : units R :=
{ val := 1 - t,
  inv := ∑' n : ℕ, t ^ n,
  val_inv := mul_neg_geom_series t h,
  inv_val := geom_series_mul_neg t h }

/-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than
`∥x⁻¹∥⁻¹` from `x` is a unit.  Here we construct its `units` structure. -/
@[simps coe]
def add (x : units R) (t : R) (h : ∥t∥ < ∥(↑x⁻¹ : R)∥⁻¹) : units R :=
units.copy  -- to make `coe_add` true definitionally, for convenience
  (x * (units.one_sub (-(↑x⁻¹ * t)) begin
      nontriviality R using [zero_lt_one],
      have hpos : 0 < ∥(↑x⁻¹ : R)∥ := units.norm_pos x⁻¹,
      calc ∥-(↑x⁻¹ * t)∥
          = ∥↑x⁻¹ * t∥                    : by { rw norm_neg }
      ... ≤ ∥(↑x⁻¹ : R)∥ * ∥t∥            : norm_mul_le ↑x⁻¹ _
      ... < ∥(↑x⁻¹ : R)∥ * ∥(↑x⁻¹ : R)∥⁻¹ : by nlinarith only [h, hpos]
      ... = 1                             : mul_inv_cancel (ne_of_gt hpos)
    end))
  (x + t) (by simp [mul_add]) _ rfl

/-- In a complete normed ring, an element `y` of distance less than `∥x⁻¹∥⁻¹` from `x` is a unit.
Here we construct its `units` structure. -/
@[simps coe]
def unit_of_nearby (x : units R) (y : R) (h : ∥y - x∥ < ∥(↑x⁻¹ : R)∥⁻¹) : units R :=
units.copy (x.add (y - x : R) h) y (by simp) _ rfl

/-- The group of units of a complete normed ring is an open subset of the ring. -/
protected lemma is_open : is_open {x : R | is_unit x} :=
begin
  nontriviality R,
  apply metric.is_open_iff.mpr,
  rintros x' ⟨x, rfl⟩,
  refine ⟨∥(↑x⁻¹ : R)∥⁻¹, inv_pos.mpr (units.norm_pos x⁻¹), _⟩,
  intros y hy,
  rw [metric.mem_ball, dist_eq_norm] at hy,
  exact (x.unit_of_nearby y hy).is_unit
end

protected lemma nhds (x : units R) : {x : R | is_unit x} ∈ 𝓝 (x : R) :=
is_open.mem_nhds units.is_open x.is_unit

end units

namespace normed_ring
open_locale classical big_operators
open asymptotics filter metric finset ring

lemma inverse_one_sub (t : R) (h : ∥t∥ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ :=
by rw [← inverse_unit (units.one_sub t h), units.coe_one_sub]

/-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/
lemma inverse_add (x : units R) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t) = inverse (1 + ↑x⁻¹ * t) * ↑x⁻¹ :=
begin
  nontriviality R,
  rw [eventually_iff, metric.mem_nhds_iff],
  have hinv : 0 < ∥(↑x⁻¹ : R)∥⁻¹, by cancel_denoms,
  use [∥(↑x⁻¹ : R)∥⁻¹, hinv],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  have ht' : ∥-↑x⁻¹ * t∥ < 1,
  { refine lt_of_le_of_lt (norm_mul_le _ _) _,
    rw norm_neg,
    refine lt_of_lt_of_le (mul_lt_mul_of_pos_left ht x⁻¹.norm_pos) _,
    cancel_denoms },
  have hright := inverse_one_sub (-↑x⁻¹ * t) ht',
  have hleft := inverse_unit (x.add t ht),
  simp only [← neg_mul_eq_neg_mul, sub_neg_eq_add] at hright,
  simp only [units.coe_add] at hleft,
  simp [hleft, hright, units.add]
end

lemma inverse_one_sub_nth_order (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((1:R) - t) = (∑ i in range n, t ^ i) + (t ^ n) * inverse (1 - t) :=
begin
  simp only [eventually_iff, metric.mem_nhds_iff],
  use [1, by norm_num],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  simp only [inverse_one_sub t ht, set.mem_set_of_eq],
  have h : 1 = ((range n).sum (λ i, t ^ i)) * (units.one_sub t ht) + t ^ n,
  { simp only [units.coe_one_sub],
    rw [← geom_sum, geom_sum_mul_neg],
    simp },
  rw [← one_mul ↑(units.one_sub t ht)⁻¹, h, add_mul],
  congr,
  { rw [mul_assoc, (units.one_sub t ht).mul_inv],
    simp },
  { simp only [units.coe_one_sub],
    rw [← add_mul, ← geom_sum, geom_sum_mul_neg],
    simp }
end

/-- The formula
`inverse (x + t) = (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹ + (- x⁻¹ * t) ^ n * inverse (x + t)`
holds for `t` sufficiently small. -/
lemma inverse_add_nth_order (x : units R) (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t)
  = (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹ + (- ↑x⁻¹ * t) ^ n * inverse (x + t) :=
begin
  refine (inverse_add x).mp _,
  have hzero : tendsto (λ (t : R), - ↑x⁻¹ * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (- (↑x⁻¹ : R))).tendsto 0).comp tendsto_id,
    simp },
  refine (hzero.eventually (inverse_one_sub_nth_order n)).mp (eventually_of_forall _),
  simp only [neg_mul_eq_neg_mul_symm, sub_neg_eq_add],
  intros t h1 h2,
  have h := congr_arg (λ (a : R), a * ↑x⁻¹) h1,
  dsimp at h,
  convert h,
  rw [add_mul, mul_assoc],
  simp [h2.symm]
end

lemma inverse_one_sub_norm : is_O (λ t, inverse ((1:R) - t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  simp only [is_O, is_O_with, eventually_iff, metric.mem_nhds_iff],
  refine ⟨∥(1:R)∥ + 1, (2:ℝ)⁻¹, by norm_num, _⟩,
  intros t ht,
  simp only [ball, dist_zero_right, set.mem_set_of_eq] at ht,
  have ht' : ∥t∥ < 1,
  { have : (2:ℝ)⁻¹ < 1 := by cancel_denoms,
    linarith },
  simp only [inverse_one_sub t ht', norm_one, mul_one, set.mem_set_of_eq],
  change ∥∑' n : ℕ, t ^ n∥ ≤ _,
  have := normed_ring.tsum_geometric_of_norm_lt_1 t ht',
  have : (1 - ∥t∥)⁻¹ ≤ 2,
  { rw ← inv_inv₀ (2:ℝ),
    refine inv_le_inv_of_le (by norm_num) _,
    have : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by ring,
    linarith },
  linarith
end

/-- The function `λ t, inverse (x + t)` is O(1) as `t → 0`. -/
lemma inverse_add_norm (x : units R) : is_O (λ t, inverse (↑x + t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  simp only [is_O_iff, norm_one, mul_one],
  cases is_O_iff.mp (@inverse_one_sub_norm R _ _) with C hC,
  use C * ∥((x⁻¹:units R):R)∥,
  have hzero : tendsto (λ t, - (↑x⁻¹ : R) * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (-↑x⁻¹ : R)).tendsto 0).comp tendsto_id,
    simp },
  refine (inverse_add x).mp ((hzero.eventually hC).mp (eventually_of_forall _)),
  intros t bound iden,
  rw iden,
  simp at bound,
  have hmul := norm_mul_le (inverse (1 + ↑x⁻¹ * t)) ↑x⁻¹,
  nlinarith [norm_nonneg (↑x⁻¹ : R)]
end

/-- The function
`λ t, inverse (x + t) - (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹`
is `O(t ^ n)` as `t → 0`. -/
lemma inverse_add_norm_diff_nth_order (x : units R) (n : ℕ) :
  is_O (λ (t : R), inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
  (λ t, ∥t∥ ^ n) (𝓝 (0:R)) :=
begin
  by_cases h : n = 0,
  { simpa [h] using inverse_add_norm x },
  have hn : 0 < n := nat.pos_of_ne_zero h,
  simp [is_O_iff],
  cases (is_O_iff.mp (inverse_add_norm x)) with C hC,
  use C * ∥(1:ℝ)∥ * ∥(↑x⁻¹ : R)∥ ^ n,
  have h : eventually_eq (𝓝 (0:R))
    (λ t, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
    (λ t, ((- ↑x⁻¹ * t) ^ n) * inverse (x + t)),
  { refine (inverse_add_nth_order x n).mp (eventually_of_forall _),
    intros t ht,
    convert congr_arg (λ a, a - (range n).sum (pow (-↑x⁻¹ * t)) * ↑x⁻¹) ht,
    simp },
  refine h.mp (hC.mp (eventually_of_forall _)),
  intros t _ hLHS,
  simp only [neg_mul_eq_neg_mul_symm] at hLHS,
  rw hLHS,
  refine le_trans (norm_mul_le _ _ ) _,
  have h' : ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { calc ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(-(↑x⁻¹ * t))∥ ^ n : norm_pow_le' _ hn
    ... = ∥↑x⁻¹ * t∥ ^ n : by rw norm_neg
    ... ≤ (∥(↑x⁻¹ : R)∥ * ∥t∥) ^ n : _
    ... =  ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n : mul_pow _ _ n,
    exact pow_le_pow_of_le_left (norm_nonneg _) (norm_mul_le ↑x⁻¹ t) n },
  have h'' : 0 ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { refine mul_nonneg _ _;
    exact pow_nonneg (norm_nonneg _) n },
  nlinarith [norm_nonneg (inverse (↑x + t))],
end

/-- The function `λ t, inverse (x + t) - x⁻¹` is `O(t)` as `t → 0`. -/
lemma inverse_add_norm_diff_first_order (x : units R) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹) (λ t, ∥t∥) (𝓝 (0:R)) :=
by { convert inverse_add_norm_diff_nth_order x 1; simp }

/-- The function
`λ t, inverse (x + t) - x⁻¹ + x⁻¹ * t * x⁻¹`
is `O(t ^ 2)` as `t → 0`. -/
lemma inverse_add_norm_diff_second_order (x : units R) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) (λ t, ∥t∥ ^ 2) (𝓝 (0:R)) :=
begin
  convert inverse_add_norm_diff_nth_order x 2,
  ext t,
  simp only [range_succ, range_one, sum_insert, mem_singleton, sum_singleton, not_false_iff,
    one_ne_zero, pow_zero, add_mul, pow_one, one_mul, neg_mul_eq_neg_mul_symm,
    sub_add_eq_sub_sub_swap, sub_neg_eq_add],
end

/-- The function `inverse` is continuous at each unit of `R`. -/
lemma inverse_continuous_at (x : units R) : continuous_at inverse (x : R) :=
begin
  have h_is_o : is_o (λ (t : R), ∥inverse (↑x + t) - ↑x⁻¹∥) (λ (t : R), (1:ℝ)) (𝓝 0),
  { refine is_o_norm_left.mpr ((inverse_add_norm_diff_first_order x).trans_is_o _),
    exact is_o_norm_left.mpr (is_o_id_const one_ne_zero) },
  have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0),
  { refine tendsto_zero_iff_norm_tendsto_zero.mpr _,
    exact tendsto_iff_norm_tendsto_zero.mp tendsto_id },
  simp only [continuous_at],
  rw [tendsto_iff_norm_tendsto_zero, inverse_unit],
  convert h_is_o.tendsto_0.comp h_lim,
  ext, simp
end

end normed_ring

namespace units
open mul_opposite filter normed_ring

/-- In a normed ring, the coercion from `units R` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open map. -/
lemma is_open_map_coe : is_open_map (coe : units R → R) :=
begin
  rw is_open_map_iff_nhds_le,
  intros x s,
  rw [mem_map, mem_nhds_induced],
  rintros ⟨t, ht, hts⟩,
  obtain ⟨u, hu, v, hv, huvt⟩ :
    ∃ (u : set R), u ∈ 𝓝 ↑x ∧ ∃ (v : set Rᵐᵒᵖ), v ∈ 𝓝 (op ↑x⁻¹) ∧ u.prod v ⊆ t,
  { simpa [embed_product, mem_nhds_prod_iff] using ht },
  have : u ∩ (op ∘ ring.inverse) ⁻¹' v ∩ (set.range (coe : units R → R)) ∈ 𝓝 ↑x,
  { refine inter_mem (inter_mem hu _) (units.nhds x),
    refine (continuous_op.continuous_at.comp (inverse_continuous_at x)).preimage_mem_nhds _,
    simpa using hv },
  refine mem_of_superset this _,
  rintros _ ⟨⟨huy, hvy⟩, ⟨y, rfl⟩⟩,
  have : embed_product R y ∈ u.prod v := ⟨huy, by simpa using hvy⟩,
  simpa using hts (huvt this)
end

/-- In a normed ring, the coercion from `units R` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open embedding. -/
lemma open_embedding_coe : open_embedding (coe : units R → R) :=
open_embedding_of_continuous_injective_open continuous_coe ext is_open_map_coe

end units