/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import topology.uniform_space.uniform_convergence
import topology.uniform_space.pi
import topology.uniform_space.equiv

/-!
# Topology and uniform structure of uniform convergence

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

This files endows `α → β` with the topologies / uniform structures of
- uniform convergence on `α`
- uniform convergence on a specified family `𝔖` of sets of `α`, also called `𝔖`-convergence

Since `α → β` is already endowed with the topologies and uniform structures of pointwise
convergence, we introduce type aliases `uniform_fun α β` (denoted `α →ᵤ β`) and
`uniform_on_fun α β 𝔖` (denoted `α →ᵤ[𝔖] β`) and we actually endow *these* with the structures
of uniform and `𝔖`-convergence respectively.

Usual examples of the second construction include :
- the topology of compact convergence, when `𝔖` is the set of compacts of `α`
- the strong topology on the dual of a topological vector space (TVS) `E`, when `𝔖` is the set of
  Von Neuman bounded subsets of `E`
- the weak-* topology on the dual of a TVS `E`, when `𝔖` is the set of singletons of `E`.

This file contains a lot of technical facts, so it is heavily commented, proofs included!

## Main definitions

* `uniform_fun.gen`: basis sets for the uniformity of uniform convergence. These are sets
  of the form `S(V) := {(f, g) | ∀ x : α, (f x, g x) ∈ V}` for some `V : set (β × β)`
* `uniform_fun.uniform_space`: uniform structure of uniform convergence. This is the
  `uniform_space` on `α →ᵤ β` whose uniformity is generated by the sets `S(V)` for `V ∈ 𝓤 β`.
  We will denote this uniform space as `𝒰(α, β, uβ)`, both in the comments and as a local notation
  in the Lean code, where `uβ` is the uniform space structure on `β`.
  This is declared as an instance on `α →ᵤ β`.
* `uniform_on_fun.uniform_space`: uniform structure of `𝔖`-convergence, where
  `𝔖 : set (set α)`. This is the infimum, for `S ∈ 𝔖`, of the pullback of `𝒰 S β` by the map of
  restriction to `S`. We will denote it `𝒱(α, β, 𝔖, uβ)`, where `uβ` is the uniform space structure
  on `β`.
  This is declared as an instance on `α →ᵤ[𝔖] β`.

## Main statements

### Basic properties

* `uniform_fun.uniform_continuous_eval`: evaluation is uniformly continuous on `α →ᵤ β`.
* `uniform_fun.t2_space`: the topology of uniform convergence on `α →ᵤ β` is T₂ if
  `β` is T₂.
* `uniform_fun.tendsto_iff_tendsto_uniformly`: `𝒰(α, β, uβ)` is
  indeed the uniform structure of uniform convergence
* `uniform_on_fun.uniform_continuous_eval_of_mem`: evaluation at a point contained in a
  set of `𝔖` is uniformly continuous on `α →ᵤ[𝔖] β`
* `uniform_on_fun.t2_space_of_covering`: the topology of `𝔖`-convergence on `α →ᵤ[𝔖] β` is T₂ if
  `β` is T₂ and `𝔖` covers `α`
* `uniform_on_fun.tendsto_iff_tendsto_uniformly_on`:
  `𝒱(α, β, 𝔖 uβ)` is indeed the uniform structure of `𝔖`-convergence

### Functoriality and compatibility with product of uniform spaces

In order to avoid the need for filter bases as much as possible when using these definitions,
we develop an extensive API for manipulating these structures abstractly. As usual in the topology
section of mathlib, we first state results about the complete lattices of `uniform_space`s on
fixed types, and then we use these to deduce categorical-like results about maps between two
uniform spaces.

We only describe these in the harder case of `𝔖`-convergence, as the names of the corresponding
results for uniform convergence can easily be guessed.

#### Order statements

* `uniform_on_fun.mono`: let `u₁`, `u₂` be two uniform structures on `γ` and
  `𝔖₁ 𝔖₂ : set (set α)`. If `u₁ ≤ u₂` and `𝔖₂ ⊆ 𝔖₁` then `𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂)`.
* `uniform_on_fun.infi_eq`: if `u` is a family of uniform structures on `γ`, then
  `𝒱(α, γ, 𝔖, (⨅ i, u i)) = ⨅ i, 𝒱(α, γ, 𝔖, u i)`.
* `uniform_on_fun.comap_eq`: if `u` is a uniform structures on `β` and `f : γ → β`, then
  `𝒱(α, γ, 𝔖, comap f u) = comap (λ g, f ∘ g) 𝒱(α, γ, 𝔖, u₁)`.

An interesting note about these statements is that they are proved without ever unfolding the basis
definition of the uniform structure of uniform convergence! Instead, we build a
(not very interesting) Galois connection `uniform_convergence.gc` and then rely on the Galois
connection API to do most of the work.

#### Morphism statements (unbundled)

* `uniform_on_fun.postcomp_uniform_continuous`: if `f : γ → β` is uniformly
  continuous, then `(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is uniformly continuous.
* `uniform_on_fun.postcomp_uniform_inducing`: if `f : γ → β` is a uniform
  inducing, then `(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is a uniform inducing.
* `uniform_on_fun.precomp_uniform_continuous`: let `f : γ → α`, `𝔖 : set (set α)`,
  `𝔗 : set (set γ)`, and assume that `∀ T ∈ 𝔗, f '' T ∈ 𝔖`. Then, the function
  `(λ g, g ∘ f) : (α →ᵤ[𝔖] β) → (γ →ᵤ[𝔗] β)` is uniformly continuous.

#### Isomorphism statements (bundled)

* `uniform_on_fun.congr_right`: turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism
  `(α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β)` by post-composing.
* `uniform_on_fun.congr_left`: turn a bijection `e : γ ≃ α` such that we have both
  `∀ T ∈ 𝔗, e '' T ∈ 𝔖` and `∀ S ∈ 𝔖, e ⁻¹' S ∈ 𝔗` into a uniform isomorphism
  `(γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β)` by pre-composing.
* `uniform_on_fun.uniform_equiv_Pi_comm`: the natural bijection between `α → Π i, δ i`
  and `Π i, α → δ i`, upgraded to a uniform isomorphism between `α →ᵤ[𝔖] (Π i, δ i)` and
  `Π i, α →ᵤ[𝔖] δ i`.

#### Important use cases

* If `G` is a uniform group, then `α →ᵤ[𝔖] G` is a uniform group: since `(/) : G × G → G` is
  uniformly continuous, `uniform_convergence_on.postcomp_uniform_continuous` tells us that
  `((/) ∘ —) : (α →ᵤ[𝔖] G × G) → (α →ᵤ[𝔖] G)` is uniformly continuous. By precomposing with
  `uniform_convergence_on.uniform_equiv_prod_arrow`, this gives that
  `(/) : (α →ᵤ[𝔖] G) × (α →ᵤ[𝔖] G) → (α →ᵤ[𝔖] G)` is also uniformly continuous
* The transpose of a continuous linear map is continuous for the strong topologies: since
  continuous linear maps are uniformly continuous and map bounded sets to bounded sets,
  this is just a special case of `uniform_convergence_on.precomp_uniform_continuous`.

## TODO

* Show that the uniform structure of `𝔖`-convergence is exactly the structure of `𝔖'`-convergence,
  where `𝔖'` is the ***noncovering*** bornology (i.e ***not*** what `bornology` currently refers
  to in mathlib) generated by `𝔖`.

## References

* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]

## Tags

uniform convergence
-/

noncomputable theory
open_locale topology classical uniformity filter

open set filter

section type_alias

/-- The type of functions from `α` to `β` equipped with the uniform structure and topology of
uniform convergence. We denote it `α →ᵤ β`. -/
def uniform_fun (α β : Type*) := α → β

/-- The type of functions from `α` to `β` equipped with the uniform structure and topology of
uniform convergence on some family `𝔖` of subsets of `α`. We denote it `α →ᵤ[𝔖] β`. -/
@[nolint unused_arguments]
def uniform_on_fun (α β : Type*) (𝔖 : set (set α)) := α → β

localized "notation α ` →ᵤ `:25 β:0 := uniform_fun α β" in uniform_convergence
localized "notation α ` →ᵤ[`:25 𝔖 `] `:0 β:0 := uniform_on_fun α β 𝔖" in uniform_convergence
localized "notation `λᵘ` binders `, ` r:(scoped p, uniform_fun.of_fun p) := r"
  in uniform_convergence
localized "notation `λᵘ[` 𝔖 `] ` binders `, ` r:(scoped p, uniform_fun.of_fun p) := r"
  in uniform_convergence

instance {α β} [nonempty β] : nonempty (α →ᵤ β) := pi.nonempty
instance {α β 𝔖} [nonempty β] : nonempty (α →ᵤ[𝔖] β) := pi.nonempty

/-- Reinterpret `f : α → β` as an element of `α →ᵤ β`. -/
def uniform_fun.of_fun {α β} : (α → β) ≃ (α →ᵤ β) := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩

/-- Reinterpret `f : α → β` as an element of `α →ᵤ[𝔖] β`. -/
def uniform_on_fun.of_fun {α β} (𝔖) : (α → β) ≃ (α →ᵤ[𝔖] β) := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩

/-- Reinterpret `f : α →ᵤ β` as an element of `α → β`. -/
def uniform_fun.to_fun {α β} : (α →ᵤ β) ≃ (α → β) := uniform_fun.of_fun.symm

/-- Reinterpret `f : α →ᵤ[𝔖] β` as an element of `α → β`. -/
def uniform_on_fun.to_fun {α β} (𝔖) : (α →ᵤ[𝔖] β) ≃ (α → β) := (uniform_on_fun.of_fun 𝔖).symm

-- Note: we don't declare a `has_coe_to_fun` instance because Lean wouldn't insert it when writing
-- `f x` (because of definitional equality with `α → β`).

end type_alias

open_locale uniform_convergence

namespace uniform_fun

variables (α β : Type*) {γ ι : Type*}
variables {s s' : set α} {x : α} {p : filter ι} {g : ι → α}

/-- Basis sets for the uniformity of uniform convergence: `gen α β V` is the set of pairs `(f, g)`
of functions `α →ᵤ β` such that `∀ x, (f x, g x) ∈ V`. -/
protected def gen (V : set (β × β)) : set ((α →ᵤ β) × (α →ᵤ β)) :=
  {uv : (α →ᵤ β) × (α →ᵤ β) | ∀ x, (uv.1 x, uv.2 x) ∈ V}

/-- If `𝓕` is a filter on `β × β`, then the set of all `uniform_convergence.gen α β V` for
`V ∈ 𝓕` is a filter basis on `(α →ᵤ β) × (α →ᵤ β)`. This will only be applied to `𝓕 = 𝓤 β` when
`β` is equipped with a `uniform_space` structure, but it is useful to define it for any filter in
order to be able to state that it has a lower adjoint (see `uniform_convergence.gc`). -/
protected lemma is_basis_gen (𝓑 : filter $ β × β) :
  is_basis (λ V : set (β × β), V ∈ 𝓑) (uniform_fun.gen α β) :=
⟨⟨univ, univ_mem⟩, λ U V hU hV, ⟨U ∩ V, inter_mem hU hV, λ uv huv,
  ⟨λ x, (huv x).left, λ x, (huv x).right⟩⟩⟩

/-- For `𝓕 : filter (β × β)`, this is the set of all `uniform_convergence.gen α β V` for
`V ∈ 𝓕` as a bundled `filter_basis` over `(α →ᵤ β) × (α →ᵤ β)`. This will only be applied to
`𝓕 = 𝓤 β` when `β` is equipped with a `uniform_space` structure, but it is useful to define it for
any filter in order to be able to state that it has a lower adjoint
(see `uniform_convergence.gc`). -/
protected def basis (𝓕 : filter $ β × β) : filter_basis ((α →ᵤ β) × (α →ᵤ β)) :=
(uniform_fun.is_basis_gen α β 𝓕).filter_basis

/-- For `𝓕 : filter (β × β)`, this is the filter generated by the filter basis
`uniform_convergence.basis α β 𝓕`. For `𝓕 = 𝓤 β`, this will be the uniformity of uniform
convergence on `α`. -/
protected def filter (𝓕 : filter $ β × β) : filter ((α →ᵤ β) × (α →ᵤ β)) :=
(uniform_fun.basis α β 𝓕).filter

local notation `Φ` :=
λ (α β : Type*) (uvx : ((α →ᵤ β) × (α →ᵤ β)) × α), (uvx.1.1 uvx.2, uvx.1.2 uvx.2)

/- This is a lower adjoint to `uniform_convergence.filter` (see `uniform_convergence.gc`).
The exact definition of the lower adjoint `l` is not interesting; we will only use that it exists
(in `uniform_convergence.mono` and `uniform_convergence.infi_eq`) and that
`l (filter.map (prod.map f f) 𝓕) = filter.map (prod.map ((∘) f) ((∘) f)) (l 𝓕)` for each
`𝓕 : filter (γ × γ)` and `f : γ → α` (in `uniform_convergence.comap_eq`). -/
local notation `lower_adjoint` :=
λ 𝓐, map (Φ α β) (𝓐 ×ᶠ ⊤)

/-- The function `uniform_convergence.filter α β : filter (β × β) → filter ((α →ᵤ β) × (α →ᵤ β))`
has a lower adjoint `l` (in the sense of `galois_connection`). The exact definition of `l` is not
interesting; we will only use that it exists (in `uniform_convergence.mono` and
`uniform_convergence.infi_eq`) and that
`l (filter.map (prod.map f f) 𝓕) = filter.map (prod.map ((∘) f) ((∘) f)) (l 𝓕)` for each
`𝓕 : filter (γ × γ)` and `f : γ → α` (in `uniform_convergence.comap_eq`). -/
protected lemma gc : galois_connection lower_adjoint
  (λ 𝓕, uniform_fun.filter α β 𝓕) :=
begin
  intros 𝓐 𝓕,
  symmetry,
  calc 𝓐 ≤ uniform_fun.filter α β 𝓕
      ↔ (uniform_fun.basis α β 𝓕).sets ⊆ 𝓐.sets :
        by rw [uniform_fun.filter, ← filter_basis.generate, sets_iff_generate]
  ... ↔ ∀ U ∈ 𝓕, uniform_fun.gen α β U ∈ 𝓐 : image_subset_iff
  ... ↔ ∀ U ∈ 𝓕, {uv | ∀ x, (uv, x) ∈
          {t : ((α →ᵤ β) × (α →ᵤ β)) × α | (t.1.1 t.2, t.1.2 t.2) ∈ U}} ∈ 𝓐 : iff.rfl
  ... ↔ ∀ U ∈ 𝓕, {uvx : ((α →ᵤ β) × (α →ᵤ β)) × α | (uvx.1.1 uvx.2, uvx.1.2 uvx.2) ∈ U} ∈
          𝓐 ×ᶠ (⊤ : filter α) : forall₂_congr (λ U hU, mem_prod_top.symm)
  ... ↔ lower_adjoint 𝓐 ≤ 𝓕 : iff.rfl,
end

variables [uniform_space β]

/-- Core of the uniform structure of uniform convergence. -/
protected def uniform_core : uniform_space.core (α →ᵤ β) :=
uniform_space.core.mk_of_basis (uniform_fun.basis α β (𝓤 β))
  (λ U ⟨V, hV, hVU⟩ f, hVU ▸ λ x, refl_mem_uniformity hV)
  (λ U ⟨V, hV, hVU⟩, hVU ▸ ⟨uniform_fun.gen α β (prod.swap ⁻¹' V),
    ⟨prod.swap ⁻¹' V, tendsto_swap_uniformity hV, rfl⟩, λ uv huv x, huv x⟩)
  (λ U ⟨V, hV, hVU⟩, hVU ▸ let ⟨W, hW, hWV⟩ := comp_mem_uniformity_sets hV in
    ⟨uniform_fun.gen α β W, ⟨W, hW, rfl⟩, λ uv ⟨w, huw, hwv⟩ x, hWV
      ⟨w x, by exact ⟨huw x, hwv x⟩⟩⟩)

/-- Uniform structure of uniform convergence, declared as an instance on `α →ᵤ β`.
We will denote it `𝒰(α, β, uβ)` in the rest of this file. -/
instance : uniform_space (α →ᵤ β) :=
uniform_space.of_core (uniform_fun.uniform_core α β)

/-- Topology of uniform convergence, declared as an instance on `α →ᵤ β`. -/
instance : topological_space (α →ᵤ β) := infer_instance

local notation `𝒰(`α`, `β`, `u`)` := @uniform_fun.uniform_space α β u

/-- By definition, the uniformity of `α →ᵤ β` admits the family `{(f, g) | ∀ x, (f x, g x) ∈ V}`
for `V ∈ 𝓤 β` as a filter basis. -/
protected lemma has_basis_uniformity :
  (𝓤 (α →ᵤ β)).has_basis (λ V, V ∈ 𝓤 β)
  (uniform_fun.gen α β) :=
(uniform_fun.is_basis_gen α β (𝓤 β)).has_basis

/-- The uniformity of `α →ᵤ β` admits the family `{(f, g) | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓑` as
a filter basis, for any basis `𝓑` of `𝓤 β` (in the case `𝓑 = (𝓤 β).as_basis` this is true by
definition). -/
protected lemma has_basis_uniformity_of_basis {ι : Sort*} {p : ι → Prop} {s : ι → set (β × β)}
  (h : (𝓤 β).has_basis p s) :
  (𝓤 (α →ᵤ β)).has_basis p (uniform_fun.gen α β ∘ s) :=
(uniform_fun.has_basis_uniformity α β).to_has_basis
  (λ U hU, let ⟨i, hi, hiU⟩ := h.mem_iff.mp hU in ⟨i, hi, λ uv huv x, hiU (huv x)⟩)
  (λ i hi, ⟨s i, h.mem_of_mem hi, subset_refl _⟩)

/-- For `f : α →ᵤ β`, `𝓝 f` admits the family `{g | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓑` as a filter
basis, for any basis `𝓑` of `𝓤 β`. -/
protected lemma has_basis_nhds_of_basis (f) {p : ι → Prop} {s : ι → set (β × β)}
  (h : has_basis (𝓤 β) p s) :
  (𝓝 f).has_basis p (λ i, {g | (f, g) ∈ uniform_fun.gen α β (s i)}) :=
nhds_basis_uniformity' (uniform_fun.has_basis_uniformity_of_basis α β h)

/-- For `f : α →ᵤ β`, `𝓝 f` admits the family `{g | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓤 β` as a
filter basis. -/
protected lemma has_basis_nhds (f) :
  (𝓝 f).has_basis (λ V, V ∈ 𝓤 β) (λ V, {g | (f, g) ∈ uniform_fun.gen α β V}) :=
uniform_fun.has_basis_nhds_of_basis α β f (filter.basis_sets _)

variables {α}

/-- Evaluation at a fixed point is uniformly continuous on `α →ᵤ β`. -/
lemma uniform_continuous_eval (x : α) :
  uniform_continuous (function.eval x ∘ to_fun : (α →ᵤ β) → β) :=
begin
  change _ ≤ _,
  rw [map_le_iff_le_comap,
      (uniform_fun.has_basis_uniformity α β).le_basis_iff ((𝓤 _).basis_sets.comap _)],
  exact λ U hU, ⟨U, hU, λ uv huv, huv x⟩
end

variables {β}

/-- If `u₁` and `u₂` are two uniform structures on `γ` and `u₁ ≤ u₂`, then
`𝒰(α, γ, u₁) ≤ 𝒰(α, γ, u₂)`. -/
protected lemma mono : monotone (@uniform_fun.uniform_space α γ) :=
λ u₁ u₂ hu, (uniform_fun.gc α γ).monotone_u hu

/-- If `u` is a family of uniform structures on `γ`, then
`𝒰(α, γ, (⨅ i, u i)) = ⨅ i, 𝒰(α, γ, u i)`. -/
protected lemma infi_eq {u : ι → uniform_space γ} :
  (𝒰(α, γ, ⨅ i, u i)) = ⨅ i, 𝒰(α, γ, u i) :=
begin
  -- This follows directly from the fact that the upper adjoint in a Galois connection maps
  -- infimas to infimas.
  ext : 1,
  change uniform_fun.filter α γ (𝓤[⨅ i, u i]) = 𝓤[⨅ i, 𝒰(α, γ, u i)],
  rw [infi_uniformity, infi_uniformity],
  exact (uniform_fun.gc α γ).u_infi
end

/-- If `u₁` and `u₂` are two uniform structures on `γ`, then
`𝒰(α, γ, u₁ ⊓ u₂) = 𝒰(α, γ, u₁) ⊓ 𝒰(α, γ, u₂)`. -/
protected lemma inf_eq {u₁ u₂ : uniform_space γ} :
  (𝒰(α, γ, u₁ ⊓ u₂)) = (𝒰(α, γ, u₁)) ⊓ (𝒰(α, γ, u₂)) :=
begin
  -- This follows directly from the fact that the upper adjoint in a Galois connection maps
  -- infimas to infimas.
  rw [inf_eq_infi, inf_eq_infi, uniform_fun.infi_eq],
  refine infi_congr (λ i, _),
  cases i; refl
end

/-- If `u` is a uniform structures on `β` and `f : γ → β`, then
`𝒰(α, γ, comap f u) = comap (λ g, f ∘ g) 𝒰(α, γ, u₁)`. -/
protected lemma comap_eq {f : γ → β} :
  (𝒰(α, γ, ‹uniform_space β›.comap f)) = (𝒰(α, β, _)).comap ((∘) f) :=
begin
  letI : uniform_space γ := ‹uniform_space β›.comap f,
  ext : 1,
  change (uniform_fun.filter α γ ((𝓤 β).comap _)) =
    (uniform_fun.filter α β ((𝓤 β))).comap _,
  -- We have the following four Galois connection which form a square diagram, and we want
  -- to show that the square of upper adjoints is commutative. The trick then is to use
  -- `galois_connection.u_comm_of_l_comm` to reduce it to commutativity of the lower adjoints,
  -- which is way easier to prove.
  have h₁ := filter.gc_map_comap (prod.map ((∘) f) ((∘) f)),
  have h₂ := filter.gc_map_comap (prod.map f f),
  have h₃ := uniform_fun.gc α β,
  have h₄ := uniform_fun.gc α γ,
  refine galois_connection.u_comm_of_l_comm h₁ h₂ h₃ h₄ (λ 𝓐, _),
  have : prod.map f f ∘ (Φ α γ) =
    (Φ α β) ∘ prod.map (prod.map ((∘) f) ((∘) f)) id,
  { ext; refl },
  rw [map_comm this, ← prod_map_map_eq'],
  refl
end

/-- Post-composition by a uniformly continuous function is uniformly continuous on `α →ᵤ β`.

More precisely, if `f : γ → β` is uniformly continuous, then `(λ g, f ∘ g) : (α →ᵤ γ) → (α →ᵤ β)`
is uniformly continuous. -/
protected lemma postcomp_uniform_continuous [uniform_space γ] {f : γ → β}
  (hf : uniform_continuous f):
  uniform_continuous (of_fun ∘ ((∘) f) ∘ to_fun : (α →ᵤ γ) → (α →ᵤ β)) :=
-- This is a direct consequence of `uniform_convergence.comap_eq`
uniform_continuous_iff.mpr $
calc 𝒰(α, γ, _)
    ≤ 𝒰(α, γ, ‹uniform_space β›.comap f) :
      uniform_fun.mono (uniform_continuous_iff.mp hf)
... = (𝒰(α, β, _)).comap ((∘) f) :
      uniform_fun.comap_eq

/-- Post-composition by a uniform inducing is a uniform inducing for the
uniform structures of uniform convergence.

More precisely, if `f : γ → β` is a uniform inducing, then `(λ g, f ∘ g) : (α →ᵤ γ) → (α →ᵤ β)` is
a uniform inducing. -/
protected lemma postcomp_uniform_inducing [uniform_space γ] {f : γ → β}
  (hf : uniform_inducing f):
  uniform_inducing (of_fun ∘ ((∘) f) ∘ to_fun : (α →ᵤ γ) → (α →ᵤ β)) :=
-- This is a direct consequence of `uniform_convergence.comap_eq`
begin
  split,
  replace hf : (𝓤 β).comap (prod.map f f) = _ := hf.comap_uniformity,
  change comap (prod.map (of_fun ∘ (∘) f ∘ to_fun) (of_fun ∘ (∘) f ∘ to_fun)) _ = _,
  rw [← uniformity_comap] at ⊢ hf,
  congr,
  rw [← uniform_space_eq hf, uniform_fun.comap_eq],
  refl
end

/-- Turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism `(α →ᵤ γ) ≃ᵤ (α →ᵤ β)` by
post-composing. -/
protected def congr_right [uniform_space γ] (e : γ ≃ᵤ β) :
  (α →ᵤ γ) ≃ᵤ (α →ᵤ β) :=
{ uniform_continuous_to_fun :=
    uniform_fun.postcomp_uniform_continuous e.uniform_continuous,
  uniform_continuous_inv_fun :=
    uniform_fun.postcomp_uniform_continuous e.symm.uniform_continuous,
  .. equiv.Pi_congr_right (λ a, e.to_equiv) }

/-- Pre-composition by a any function is uniformly continuous for the uniform structures of
uniform convergence.

More precisely, for any `f : γ → α`, the function `(λ g, g ∘ f) : (α →ᵤ β) → (γ →ᵤ β)` is uniformly
continuous. -/
protected lemma precomp_uniform_continuous {f : γ → α} :
  uniform_continuous (λ g : α →ᵤ β, of_fun (g ∘ f)) :=
begin
  -- Here we simply go back to filter bases.
  rw uniform_continuous_iff,
  change 𝓤 (α →ᵤ β) ≤ (𝓤 (γ →ᵤ β)).comap (prod.map (λ g : α →ᵤ β, g ∘ f) (λ g : α →ᵤ β, g ∘ f)),
  rw (uniform_fun.has_basis_uniformity α β).le_basis_iff
    ((uniform_fun.has_basis_uniformity γ β).comap _),
  exact λ U hU, ⟨U, hU, λ uv huv x, huv (f x)⟩
end

/-- Turn a bijection `γ ≃ α` into a uniform isomorphism
`(γ →ᵤ β) ≃ᵤ (α →ᵤ β)` by pre-composing. -/
protected def congr_left (e : γ ≃ α) :
  (γ →ᵤ β) ≃ᵤ (α →ᵤ β) :=
{ uniform_continuous_to_fun :=
    uniform_fun.precomp_uniform_continuous,
  uniform_continuous_inv_fun :=
    uniform_fun.precomp_uniform_continuous,
  .. equiv.arrow_congr e (equiv.refl _) }

/-- The topology of uniform convergence is T₂. -/
instance [t2_space β] : t2_space (α →ᵤ β) :=
{ t2 :=
  begin
    intros f g h,
    obtain ⟨x, hx⟩ := not_forall.mp (mt funext h),
    exact separated_by_continuous (uniform_continuous_eval β x).continuous hx
  end }

/-- The natural map `uniform_fun.to_fun` from `α →ᵤ β` to `α → β` is uniformly continuous.

In other words, the uniform structure of uniform convergence is finer than that of pointwise
convergence, aka the product uniform structure. -/
protected lemma uniform_continuous_to_fun : uniform_continuous (to_fun : (α →ᵤ β) → α → β) :=
begin
  -- By definition of the product uniform structure, this is just `uniform_continuous_eval`.
  rw uniform_continuous_pi,
  intros x,
  exact uniform_continuous_eval β x
end

/-- The topology of uniform convergence indeed gives the same notion of convergence as
`tendsto_uniformly`. -/
protected lemma tendsto_iff_tendsto_uniformly {F : ι → α →ᵤ β} {f : α →ᵤ β} :
  tendsto F p (𝓝 f) ↔ tendsto_uniformly F f p :=
begin
  rw [(uniform_fun.has_basis_nhds α β f).tendsto_right_iff, tendsto_uniformly],
  exact iff.rfl,
end

/-- The natural bijection between `α → β × γ` and `(α → β) × (α → γ)`, upgraded to a uniform
isomorphism between `α →ᵤ β × γ` and `(α →ᵤ β) × (α →ᵤ γ)`. -/
protected def uniform_equiv_prod_arrow [uniform_space γ] :
  (α →ᵤ β × γ) ≃ᵤ ((α →ᵤ β) × (α →ᵤ γ)) :=
-- Denote `φ` this bijection. We want to show that
-- `comap φ (𝒰(α, β, uβ) × 𝒰(α, γ, uγ)) = 𝒰(α, β × γ, uβ × uγ)`.
-- But `uβ × uγ` is defined as `comap fst uβ ⊓ comap snd uγ`, so we just have to apply
-- `uniform_convergence.inf_eq` and `uniform_convergence.comap_eq`, which leaves us to check
-- that some square commutes.
(equiv.arrow_prod_equiv_prod_arrow _ _ _).to_uniform_equiv_of_uniform_inducing
begin
  split,
  change comap (prod.map (equiv.arrow_prod_equiv_prod_arrow _ _ _)
    (equiv.arrow_prod_equiv_prod_arrow _ _ _)) _ = _,
  rw ← uniformity_comap,
  congr,
  rw [prod.uniform_space, prod.uniform_space, uniform_space.comap_inf, uniform_fun.inf_eq],
  congr;
  rw [← uniform_space.comap_comap, uniform_fun.comap_eq];
  refl -- the relevant diagram commutes by definition
end

variables (α) (δ : ι → Type*) [Π i, uniform_space (δ i)]

/-- The natural bijection between `α → Π i, δ i` and `Π i, α → δ i`, upgraded to a uniform
isomorphism between `α →ᵤ (Π i, δ i)` and `Π i, α →ᵤ δ i`. -/
protected def uniform_equiv_Pi_comm : uniform_equiv (α →ᵤ Π i, δ i) (Π i, α →ᵤ δ i) :=
-- Denote `φ` this bijection. We want to show that
-- `comap φ (Π i, 𝒰(α, δ i, uδ i)) = 𝒰(α, (Π i, δ i), (Π i, uδ i))`.
-- But `Π i, uδ i` is defined as `⨅ i, comap (eval i) (uδ i)`, so we just have to apply
-- `uniform_convergence.infi_eq` and `uniform_convergence.comap_eq`, which leaves us to check
-- that some square commutes.
@equiv.to_uniform_equiv_of_uniform_inducing _ _
  (𝒰(α, Π i, δ i, Pi.uniform_space δ))
  (@Pi.uniform_space ι (λ i, α → δ i) (λ i, 𝒰(α, δ i, _)))
  (equiv.Pi_comm _)
begin
  split,
  change comap (prod.map function.swap function.swap) _ = _,
  rw ← uniformity_comap,
  congr,
  rw [Pi.uniform_space, uniform_space.of_core_eq_to_core, Pi.uniform_space,
      uniform_space.of_core_eq_to_core, uniform_space.comap_infi, uniform_fun.infi_eq],
  refine infi_congr (λ i, _),
  rw [← uniform_space.comap_comap, uniform_fun.comap_eq]
  -- Like in the previous lemma, the diagram actually commutes by definition
end

end uniform_fun

namespace uniform_on_fun

variables {α β : Type*} {γ ι : Type*}
variables {s s' : set α} {x : α} {p : filter ι} {g : ι → α}

local notation `𝒰(`α`, `β`, `u`)` := @uniform_fun.uniform_space α β u

/-- Basis sets for the uniformity of `𝔖`-convergence: for `S : set α` and `V : set (β × β)`,
`gen 𝔖 S V` is the set of pairs `(f, g)` of functions `α →ᵤ[𝔖] β` such that
`∀ x ∈ S, (f x, g x) ∈ V`. Note that the family `𝔖 : set (set α)` is only used to specify which
type alias of `α → β` to use here. -/
protected def gen (𝔖) (S : set α) (V : set (β × β)) : set ((α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β)) :=
  {uv : (α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β) | ∀ x ∈ S, (uv.1 x, uv.2 x) ∈ V}

/-- For `S : set α` and `V : set (β × β)`, we have
`uniform_on_fun.gen 𝔖 S V = (S.restrict × S.restrict) ⁻¹' (uniform_fun.gen S β V)`.
This is the crucial fact for proving that the family `uniform_on_fun.gen S V` for `S ∈ 𝔖` and
`V ∈ 𝓤 β` is indeed a basis for the uniformity `α →ᵤ[𝔖] β` endowed with `𝒱(α, β, 𝔖, uβ)`
the uniform structure of `𝔖`-convergence, as defined in `uniform_on_fun.uniform_space`. -/
protected lemma gen_eq_preimage_restrict {𝔖} (S : set α) (V : set (β × β)) :
  uniform_on_fun.gen 𝔖 S V =
  (prod.map S.restrict S.restrict) ⁻¹' (uniform_fun.gen S β V) :=
begin
  ext uv,
  exact ⟨λ h ⟨x, hx⟩, h x hx, λ h x hx, h ⟨x, hx⟩⟩
end

/-- `uniform_on_fun.gen` is antitone in the first argument and monotone in the second. -/
protected lemma gen_mono {𝔖} {S S' : set α} {V V' : set (β × β)} (hS : S' ⊆ S) (hV : V ⊆ V') :
  uniform_on_fun.gen 𝔖 S V ⊆ uniform_on_fun.gen 𝔖 S' V' :=
λ uv h x hx, hV (h x $ hS hx)

/-- If `𝔖 : set (set α)` is nonempty and directed and `𝓑` is a filter basis on `β × β`, then the
family `uniform_on_fun.gen 𝔖 S V` for `S ∈ 𝔖` and `V ∈ 𝓑` is a filter basis on
`(α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β)`.
We will show in `has_basis_uniformity_of_basis` that, if `𝓑` is a basis for `𝓤 β`, then the
corresponding filter is the uniformity of `α →ᵤ[𝔖] β`. -/
protected lemma is_basis_gen (𝔖 : set (set α)) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
  (𝓑 : filter_basis $ β × β) :
  is_basis (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓑)
    (λ SV, uniform_on_fun.gen 𝔖 SV.1 SV.2) :=
⟨h.prod 𝓑.nonempty, λ U₁V₁ U₂V₂ h₁ h₂,
  let ⟨U₃, hU₃, hU₁₃, hU₂₃⟩ := h' U₁V₁.1 h₁.1 U₂V₂.1 h₂.1 in
  let ⟨V₃, hV₃, hV₁₂₃⟩ := 𝓑.inter_sets h₁.2 h₂.2 in ⟨⟨U₃, V₃⟩, ⟨⟨hU₃, hV₃⟩, λ uv huv,
    ⟨(λ x hx, (hV₁₂₃ $ huv x $ hU₁₃ hx).1), (λ x hx, (hV₁₂₃ $ huv x $ hU₂₃ hx).2)⟩⟩⟩⟩

variables (α β) [uniform_space β] (𝔖 : set (set α))

/-- Uniform structure of `𝔖`-convergence, i.e uniform convergence on the elements of `𝔖`,
declared as an instance on `α →ᵤ[𝔖] β`. It is defined as the infimum, for `S ∈ 𝔖`, of the pullback
by `S.restrict`, the map of restriction to `S`, of the uniform structure `𝒰(s, β, uβ)` on
`↥S →ᵤ β`. We will denote it `𝒱(α, β, 𝔖, uβ)`, where `uβ` is the uniform structure on `β`. -/
instance : uniform_space (α →ᵤ[𝔖] β) :=
⨅ (s : set α) (hs : s ∈ 𝔖), uniform_space.comap s.restrict
  (𝒰(s, β, _))

local notation `𝒱(`α`, `β`, `𝔖`, `u`)` := @uniform_on_fun.uniform_space α β u 𝔖

/-- Topology of `𝔖`-convergence, i.e uniform convergence on the elements of `𝔖`, declared as an
instance on `α →ᵤ[𝔖] β`. -/
instance : topological_space (α →ᵤ[𝔖] β) :=
(𝒱(α, β, 𝔖, _)).to_topological_space

/-- The topology of `𝔖`-convergence is the infimum, for `S ∈ 𝔖`, of topology induced by the map
of `S.restrict : (α →ᵤ[𝔖] β) → (↥S →ᵤ β)` of restriction to `S`, where `↥S →ᵤ β` is endowed with
the topology of uniform convergence. -/
protected lemma topological_space_eq :
  uniform_on_fun.topological_space α β 𝔖 = ⨅ (s : set α) (hs : s ∈ 𝔖),
  topological_space.induced s.restrict (uniform_fun.topological_space s β) :=
begin
  simp only [uniform_on_fun.topological_space, to_topological_space_infi,
    to_topological_space_infi, to_topological_space_comap],
  refl
end

protected lemma has_basis_uniformity_of_basis_aux₁ {p : ι → Prop} {s : ι → set (β × β)}
  (hb : has_basis (𝓤 β) p s) (S : set α) :
  (@uniformity (α →ᵤ[𝔖] β) ((uniform_fun.uniform_space S β).comap S.restrict)).has_basis
  p (λ i, uniform_on_fun.gen 𝔖 S (s i)) :=
begin
  simp_rw [uniform_on_fun.gen_eq_preimage_restrict, uniformity_comap],
  exact (uniform_fun.has_basis_uniformity_of_basis S β hb).comap _
end

protected lemma has_basis_uniformity_of_basis_aux₂ (h : directed_on (⊆) 𝔖) {p : ι → Prop}
  {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
  directed_on ((λ s : set α, (uniform_fun.uniform_space s β).comap
    (s.restrict : (α →ᵤ β) → s →ᵤ β)) ⁻¹'o ge) 𝔖 :=
h.mono $ λ s t hst,
  ((uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb _).le_basis_iff
    (uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb _)).mpr
  (λ V hV, ⟨V, hV, uniform_on_fun.gen_mono hst subset_rfl⟩)

/-- If `𝔖 : set (set α)` is nonempty and directed and `𝓑` is a filter basis of `𝓤 β`, then the
uniformity of `α →ᵤ[𝔖] β` admits the family `{(f, g) | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and
`V ∈ 𝓑` as a filter basis. -/
protected lemma has_basis_uniformity_of_basis (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
  {p : ι → Prop} {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
  (𝓤 (α →ᵤ[𝔖] β)).has_basis
    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
    (λ Si, uniform_on_fun.gen 𝔖 Si.1 (s Si.2)) :=
begin
  simp only [infi_uniformity],
  exact has_basis_binfi_of_directed h (λ S, (uniform_on_fun.gen 𝔖 S) ∘ s) _
    (λ S hS, uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb S)
    (uniform_on_fun.has_basis_uniformity_of_basis_aux₂ α β 𝔖 h' hb)
end

/-- If `𝔖 : set (set α)` is nonempty and directed, then the uniformity of `α →ᵤ[𝔖] β` admits the
family `{(f, g) | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓤 β` as a filter basis. -/
protected lemma has_basis_uniformity (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖) :
  (𝓤 (α →ᵤ[𝔖] β)).has_basis
    (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓤 β)
    (λ SV, uniform_on_fun.gen 𝔖 SV.1 SV.2) :=
uniform_on_fun.has_basis_uniformity_of_basis α β 𝔖 h h' (𝓤 β).basis_sets

/-- For `f : α →ᵤ[𝔖] β`, where `𝔖 : set (set α)` is nonempty and directed, `𝓝 f` admits the
family `{g | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓑` as a filter basis, for any basis
`𝓑` of `𝓤 β`. -/
protected lemma has_basis_nhds_of_basis (f : α →ᵤ[𝔖] β) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
  {p : ι → Prop} {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
  (𝓝 f).has_basis
    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
    (λ Si, {g | (g, f) ∈ uniform_on_fun.gen 𝔖 Si.1 (s Si.2)}) :=
begin
  letI : uniform_space (α → β) := uniform_on_fun.uniform_space α β 𝔖,
  exact nhds_basis_uniformity (uniform_on_fun.has_basis_uniformity_of_basis α β 𝔖 h h' hb)
end

/-- For `f : α →ᵤ[𝔖] β`, where `𝔖 : set (set α)` is nonempty and directed, `𝓝 f` admits the
family `{g | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓤 β` as a filter basis. -/
protected lemma has_basis_nhds (f : α →ᵤ[𝔖] β) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖) :
  (𝓝 f).has_basis
    (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓤 β)
    (λ SV, {g | (g, f) ∈ uniform_on_fun.gen 𝔖 SV.1 SV.2}) :=
uniform_on_fun.has_basis_nhds_of_basis α β 𝔖 f h h' (filter.basis_sets _)

/-- If `S ∈ 𝔖`, then the restriction to `S` is a uniformly continuous map from `α →ᵤ[𝔖] β` to
`↥S →ᵤ β`. -/
protected lemma uniform_continuous_restrict (h : s ∈ 𝔖) :
  uniform_continuous (uniform_fun.of_fun ∘ (s.restrict : (α → β) → (s → β)) ∘ (to_fun 𝔖)) :=
begin
  change _ ≤ _,
  simp only [uniform_on_fun.uniform_space, map_le_iff_le_comap, infi_uniformity],
  exact infi₂_le s h
end

variables {α}

/-- Let `u₁`, `u₂` be two uniform structures on `γ` and `𝔖₁ 𝔖₂ : set (set α)`. If `u₁ ≤ u₂` and
`𝔖₂ ⊆ 𝔖₁` then `𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂)`. -/
protected lemma mono ⦃u₁ u₂ : uniform_space γ⦄ (hu : u₁ ≤ u₂) ⦃𝔖₁ 𝔖₂ : set (set α)⦄
  (h𝔖 : 𝔖₂ ⊆ 𝔖₁) :
  𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂) :=
calc 𝒱(α, γ, 𝔖₁, u₁)
    ≤ 𝒱(α, γ, 𝔖₂, u₁) : infi_le_infi_of_subset h𝔖
... ≤ 𝒱(α, γ, 𝔖₂, u₂) : infi₂_mono
        (λ i hi, uniform_space.comap_mono $ uniform_fun.mono hu)

/-- If `x : α` is in some `S ∈ 𝔖`, then evaluation at `x` is uniformly continuous on
`α →ᵤ[𝔖] β`. -/
lemma uniform_continuous_eval_of_mem {x : α} (hxs : x ∈ s) (hs : s ∈ 𝔖) :
  uniform_continuous ((function.eval x : (α → β) → β) ∘ to_fun 𝔖) :=
(uniform_fun.uniform_continuous_eval β (⟨x, hxs⟩ : s)).comp
  (uniform_on_fun.uniform_continuous_restrict α β 𝔖 hs)

variables {β} {𝔖}

/-- If `u` is a family of uniform structures on `γ`, then
`𝒱(α, γ, 𝔖, (⨅ i, u i)) = ⨅ i, 𝒱(α, γ, 𝔖, u i)`. -/
protected lemma infi_eq {u : ι → uniform_space γ} :
  𝒱(α, γ, 𝔖, ⨅ i, u i) =
  ⨅ i, 𝒱(α, γ, 𝔖, u i) :=
begin
  simp_rw [uniform_on_fun.uniform_space, uniform_fun.infi_eq, uniform_space.comap_infi],
  rw infi_comm,
  exact infi_congr (λ s, infi_comm)
end

/-- If `u₁` and `u₂` are two uniform structures on `γ`, then
`𝒱(α, γ, 𝔖, u₁ ⊓ u₂) = 𝒱(α, γ, 𝔖, u₁) ⊓ 𝒱(α, γ, 𝔖, u₂)`. -/
protected lemma inf_eq {u₁ u₂ : uniform_space γ} :
  𝒱(α, γ, 𝔖, u₁ ⊓ u₂) =
  𝒱(α, γ, 𝔖, u₁) ⊓
  𝒱(α, γ, 𝔖, u₂) :=
begin
  rw [inf_eq_infi, inf_eq_infi, uniform_on_fun.infi_eq],
  refine infi_congr (λ i, _),
  cases i; refl
end

/-- If `u` is a uniform structures on `β` and `f : γ → β`, then
`𝒱(α, γ, 𝔖, comap f u) = comap (λ g, f ∘ g) 𝒱(α, γ, 𝔖, u₁)`. -/
protected lemma comap_eq {f : γ → β} :
  𝒱(α, γ, 𝔖, ‹uniform_space β›.comap f) =
  𝒱(α, β, 𝔖, _).comap ((∘) f) :=
begin
  -- We reduce this to `uniform_convergence.comap_eq` using the fact that `comap` distributes
  -- on `infi`.
  simp_rw [uniform_on_fun.uniform_space, uniform_space.comap_infi,
            uniform_fun.comap_eq, ← uniform_space.comap_comap],
  refl -- by definition, `∀ S ∈ 𝔖, (f ∘ —) ∘ S.restrict = S.restrict ∘ (f ∘ —)`.
end

/-- Post-composition by a uniformly continuous function is uniformly continuous for the
uniform structures of `𝔖`-convergence.

More precisely, if `f : γ → β` is uniformly continuous, then
`(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is uniformly continuous. -/
protected lemma postcomp_uniform_continuous [uniform_space γ] {f : γ → β}
  (hf : uniform_continuous f):
  uniform_continuous (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) :=
begin
  -- This is a direct consequence of `uniform_convergence.comap_eq`
  rw uniform_continuous_iff,
  calc 𝒱(α, γ, 𝔖, _)
      ≤ 𝒱(α, γ, 𝔖, ‹uniform_space β›.comap f) :
        uniform_on_fun.mono (uniform_continuous_iff.mp hf) (subset_rfl)
  ... = 𝒱(α, β, 𝔖, _).comap ((∘) f) :
        uniform_on_fun.comap_eq
end

/-- Post-composition by a uniform inducing is a uniform inducing for the
uniform structures of `𝔖`-convergence.

More precisely, if `f : γ → β` is a uniform inducing, then
`(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is a uniform inducing. -/
protected lemma postcomp_uniform_inducing [uniform_space γ] {f : γ → β}
  (hf : uniform_inducing f):
  uniform_inducing (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) :=
-- This is a direct consequence of `uniform_convergence.comap_eq`
begin
  split,
  replace hf : (𝓤 β).comap (prod.map f f) = _ := hf.comap_uniformity,
  change comap (prod.map (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖)) _ = _,
  rw [← uniformity_comap] at ⊢ hf,
  congr,
  rw [← uniform_space_eq hf, uniform_on_fun.comap_eq],
  refl
end

/-- Turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism `(α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β)`
by post-composing. -/
protected def congr_right [uniform_space γ] (e : γ ≃ᵤ β) :
  (α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β) :=
{ uniform_continuous_to_fun :=
    uniform_on_fun.postcomp_uniform_continuous e.uniform_continuous,
  uniform_continuous_inv_fun :=
    uniform_on_fun.postcomp_uniform_continuous e.symm.uniform_continuous,
  .. equiv.Pi_congr_right (λ a, e.to_equiv) }

/-- Let `f : γ → α`, `𝔖 : set (set α)`, `𝔗 : set (set γ)`, and assume that `∀ T ∈ 𝔗, f '' T ∈ 𝔖`.
Then, the function `(λ g, g ∘ f) : (α →ᵤ[𝔖] β) → (γ →ᵤ[𝔗] β)` is uniformly continuous.

Note that one can easily see that assuming `∀ T ∈ 𝔗, ∃ S ∈ 𝔖, f '' T ⊆ S` would work too, but
we will get this for free when we prove that `𝒱(α, β, 𝔖, uβ) = 𝒱(α, β, 𝔖', uβ)` where `𝔖'` is the
***noncovering*** bornology generated by `𝔖`. -/
protected lemma precomp_uniform_continuous {𝔗 : set (set γ)} {f : γ → α}
  (hf : 𝔗 ⊆ (image f) ⁻¹' 𝔖) :
  uniform_continuous (λ g : α →ᵤ[𝔖] β, of_fun 𝔗 (g ∘ f)) :=
begin
  -- Since `comap` distributes on `infi`, it suffices to prove that
  -- `⨅ s ∈ 𝔖, comap s.restrict 𝒰(↥s, β, uβ) ≤ ⨅ t ∈ 𝔗, comap (t.restrict ∘ (— ∘ f)) 𝒰(↥t, β, uβ)`.
  simp_rw [uniform_continuous_iff, uniform_on_fun.uniform_space, uniform_space.comap_infi,
            ← uniform_space.comap_comap],
  -- For any `t ∈ 𝔗`, note `s := f '' t ∈ 𝔖`.
  -- We will show that `comap s.restrict 𝒰(↥s, β, uβ) ≤ comap (t.restrict ∘ (— ∘ f)) 𝒰(↥t, β, uβ)`.
  refine le_infi₂ (λ t ht, infi_le_of_le (f '' t) $ infi_le_of_le (hf ht) _),
  -- Let `f'` be the map from `t` to `f '' t` induced by `f`.
  let f' : t → f '' t := (maps_to_image f t).restrict f t (f '' t),
  -- By definition `t.restrict ∘ (— ∘ f) = (— ∘ f') ∘ (f '' t).restrict`.
  have : t.restrict ∘ (λ g : α →ᵤ[𝔖] β, of_fun 𝔗 (g ∘ f)) =
    (λ g : (f '' t) → β, g ∘ f') ∘ (f '' t).restrict := rfl,
  -- Thus, we have to show `comap (f '' t).restrict 𝒰(↥(f '' t), β, uβ) ≤`
  -- `comap (f '' t).restrict (comap (— ∘ f') 𝒰(↥t, β, uβ))`.
  rw [this, @uniform_space.comap_comap (α →ᵤ[𝔖] β) ((f '' t) →ᵤ β)],
  -- But this is exactly monotonicity of `comap` applied to
  -- `uniform_convergence.precomp_continuous`.
  refine uniform_space.comap_mono _,
  rw ← uniform_continuous_iff,
  exact uniform_fun.precomp_uniform_continuous
end

/-- Turn a bijection `e : γ ≃ α` such that we have both `∀ T ∈ 𝔗, e '' T ∈ 𝔖` and
`∀ S ∈ 𝔖, e ⁻¹' S ∈ 𝔗` into a uniform isomorphism `(γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β)` by pre-composing. -/
protected def congr_left {𝔗 : set (set γ)} (e : γ ≃ α)
  (he : 𝔗 ⊆ (image e) ⁻¹' 𝔖) (he' : 𝔖 ⊆ (preimage e) ⁻¹' 𝔗) :
  (γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β) :=
{ uniform_continuous_to_fun :=
    uniform_on_fun.precomp_uniform_continuous
    begin
      intros s hs,
      change e.symm '' s ∈ 𝔗,
      rw ← preimage_equiv_eq_image_symm,
      exact he' hs
    end,
  uniform_continuous_inv_fun :=
    uniform_on_fun.precomp_uniform_continuous he,
  .. equiv.arrow_congr e (equiv.refl _) }

/-- If `𝔖` covers `α`, then the topology of `𝔖`-convergence is T₂. -/
lemma t2_space_of_covering [t2_space β] (h : ⋃₀ 𝔖 = univ) :
  t2_space (α →ᵤ[𝔖] β) :=
{ t2 :=
  begin
    intros f g hfg,
    obtain ⟨x, hx⟩ := not_forall.mp (mt funext hfg),
    obtain ⟨s, hs, hxs⟩ : ∃ s ∈ 𝔖, x ∈ s := mem_sUnion.mp (h.symm ▸ true.intro),
    exact separated_by_continuous (uniform_continuous_eval_of_mem β 𝔖 hxs hs).continuous hx
  end }

/-- If `𝔖` covers `α`, the natural map `uniform_on_fun.to_fun` from `α →ᵤ[𝔖] β` to `α → β` is
uniformly continuous.

In other words, if `𝔖` covers `α`, then the uniform structure of `𝔖`-convergence is finer than
that of pointwise convergence. -/
protected lemma uniform_continuous_to_fun (h : ⋃₀ 𝔖 = univ) :
  uniform_continuous (to_fun 𝔖 : (α →ᵤ[𝔖] β) → α → β) :=
begin
  rw uniform_continuous_pi,
  intros x,
  obtain ⟨s : set α, hs : s ∈ 𝔖, hxs :  x ∈ s⟩ := sUnion_eq_univ_iff.mp h x,
  exact uniform_continuous_eval_of_mem β 𝔖 hxs hs
end

/-- Convergence in the topology of `𝔖`-convergence means uniform convergence on `S` (in the sense
of `tendsto_uniformly_on`) for all `S ∈ 𝔖`. -/
protected lemma tendsto_iff_tendsto_uniformly_on {F : ι → α →ᵤ[𝔖] β} {f : α →ᵤ[𝔖] β} :
  tendsto F p (𝓝 f) ↔
  ∀ s ∈ 𝔖, tendsto_uniformly_on F f p s :=
begin
  rw [uniform_on_fun.topological_space_eq, nhds_infi, tendsto_infi],
  refine forall_congr (λ s, _),
  rw [nhds_infi, tendsto_infi],
  refine forall_congr (λ hs, _),
  rw [nhds_induced, tendsto_comap_iff, tendsto_uniformly_on_iff_tendsto_uniformly_comp_coe,
      uniform_fun.tendsto_iff_tendsto_uniformly],
  refl
end

/-- The natural bijection between `α → β × γ` and `(α → β) × (α → γ)`, upgraded to a uniform
isomorphism between `α →ᵤ[𝔖] β × γ` and `(α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] γ)`. -/
protected def uniform_equiv_prod_arrow [uniform_space γ] :
  (α →ᵤ[𝔖] β × γ) ≃ᵤ ((α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] γ)) :=
-- Denote `φ` this bijection. We want to show that
-- `comap φ (𝒱(α, β, 𝔖, uβ) × 𝒱(α, γ, 𝔖, uγ)) = 𝒱(α, β × γ, 𝔖, uβ × uγ)`.
-- But `uβ × uγ` is defined as `comap fst uβ ⊓ comap snd uγ`, so we just have to apply
-- `uniform_convergence_on.inf_eq` and `uniform_convergence_on.comap_eq`, which leaves us to check
-- that some square commutes.
-- We could also deduce this from `uniform_convergence.uniform_equiv_prod_arrow`, but it turns out
-- to be more annoying.
((uniform_on_fun.of_fun 𝔖).symm.trans $ (equiv.arrow_prod_equiv_prod_arrow _ _ _).trans $
  (uniform_on_fun.of_fun 𝔖).prod_congr (uniform_on_fun.of_fun 𝔖))
  .to_uniform_equiv_of_uniform_inducing
begin
  split,
  rw [uniformity_prod, comap_inf, comap_comap, comap_comap, uniform_on_fun.inf_eq, inf_uniformity,
    uniform_on_fun.comap_eq, uniform_on_fun.comap_eq, uniformity_comap, uniformity_comap],
  refl -- the relevant diagram commutes by definition
end

variables (𝔖) (δ : ι → Type*) [Π i, uniform_space (δ i)]

/-- The natural bijection between `α → Π i, δ i` and `Π i, α → δ i`, upgraded to a uniform
isomorphism between `α →ᵤ[𝔖] (Π i, δ i)` and `Π i, α →ᵤ[𝔖] δ i`. -/
protected def uniform_equiv_Pi_comm :
  (α →ᵤ[𝔖] Π i, δ i) ≃ᵤ (Π i, α →ᵤ[𝔖] δ i)  :=
-- Denote `φ` this bijection. We want to show that
-- `comap φ (Π i, 𝒱(α, δ i, 𝔖, uδ i)) = 𝒱(α, (Π i, δ i), 𝔖, (Π i, uδ i))`.
-- But `Π i, uδ i` is defined as `⨅ i, comap (eval i) (uδ i)`, so we just have to apply
-- `uniform_convergence_on.infi_eq` and `uniform_convergence_on.comap_eq`, which leaves us to check
-- that some square commutes.
-- We could also deduce this from `uniform_convergence.uniform_equiv_Pi_comm`, but it turns out
-- to be more annoying.
(equiv.Pi_comm _).to_uniform_equiv_of_uniform_inducing
begin
  split,
  change comap (prod.map function.swap function.swap) _ = _,
  rw ← uniformity_comap,
  congr,
  rw [Pi.uniform_space, uniform_space.of_core_eq_to_core, Pi.uniform_space,
      uniform_space.of_core_eq_to_core, uniform_space.comap_infi, uniform_on_fun.infi_eq],
  refine infi_congr (λ i, _),
  rw [← uniform_space.comap_comap, uniform_on_fun.comap_eq]
  -- Like in the previous lemma, the diagram actually commutes by definition
end

end uniform_on_fun


import Playground.Category.Instances.Set
import Playground.Category.Functor.Bi

namespace Category.Functor
section

  def hom.{u,v} (C) [Category.{u,v} C] : Bi Cᵒᵖ C (Type _) where
      obj_map := λ ⟨op X, Y⟩ => X ⟶ Y
      hom_map := @λ ⟨op X₁, Y₁⟩ ⟨op X₂, Y₂⟩ ⟨op f, g⟩ =>
        show (_ ⟶ _) → (_ ⟶ _) from
        λ z => (f ≫ z) ≫ g
      hom_map_comp := @λ ⟨op X₁, Y₁⟩ ⟨op X₂, Y₂⟩ ⟨op X₃, Y₃⟩ ⟨op f₁, g₁⟩ ⟨op f₂, g₂⟩ => by
        funext (z : _ ⟶ _)
        show ((_ ≫ _) ≫ _) ≫ (_ ≫ _) = (_ ≫ ((_ ≫ _) ≫ _)) ≫ _
        simp [assoc]
      hom_map_id := λ ⟨op X₁, Y₁⟩ => by simp; rfl

  example {C} [Category C] (U : Cᵒᵖ) : C ⥤ Type _ := (hom C).fixLeft U
  example {C} [Category C] (U : C) : Cᵒᵖ ⥤ Type _ := (hom C).fixRight U

  def ulift.{u,v} : Type u ⥤ Type (max u v) := {
      obj_map := ULift.{v}
      hom_map := @λ X Y f => λ x : ULift.{v} X => ULift.up (f x.down)
      hom_map_comp := λ _ _ => rfl
      hom_map_id := λ _ => rfl
    }

end
end Category.Functor


import M4R.Algebra.Ring.ChainProperties

namespace M4R
  open Semiring localisation Ideal QuotientRing

  class LocalRing (α : Type _) extends Ring α where
    loc : ∃ m : Ideal α, Ring.MaxSpec α = Set.singleton m

  namespace LocalRing
    open Classical

    variable {α : Type _} [LocalRing α]

    noncomputable def m : Ideal α := choose LocalRing.loc
    theorem m_maxspec : Ring.MaxSpec α = Set.singleton m := choose_spec LocalRing.loc
    theorem m_max : (m : Ideal α).is_maximal := (m_maxspec ▸ rfl : m ∈ Ring.MaxSpec α)
    theorem m_proper : (m : Ideal α).proper_ideal := m_max.left

    theorem maximal_is_m {I : Ideal α} (hI : I.is_maximal) : I = m :=
      (m_maxspec ▸ hI : I ∈ Set.singleton m)

    theorem units {a : α} : isUnit a ↔ a ∉ m :=
      ⟨fun h₁ h₂ => absurd (is_unit_ideal'.mpr ⟨a, h₁, h₂⟩) m_proper,
       not_imp_symm fun ha =>
        let ⟨I, haI, hI⟩ := exists_maximal_containing (unit_not_principal ha)
        maximal_is_m hI ▸ haI (generator_in_principal a)⟩

    theorem not_unit {a : α} : ¬isUnit a ↔ a ∈ m := (iff_not_comm.mp units).symm

    theorem subset_m {I : Ideal α} (hI : I.proper_ideal) : I ⊆ m :=
      fun x hx => byContradiction fun h =>
        absurd (Ideal.is_unit_ideal'.mpr ⟨x, units.mpr h, hx⟩) hI

    theorem nontrivial (α : Type _) [LocalRing α] : Ring.is_NonTrivial α :=
      fun h => units.mp (isUnit_1 : isUnit (1 : α)) (h ▸ m.has_zero)

    def residue_field (α : Type _) [LocalRing α] := QClass (m : Ideal α)

    instance localisation_at [Ring α] {P : Ideal α} (hP : P.is_prime) : LocalRing (localisationₚ hP) where
      loc := ⟨localiseₚ hP P, Set.singleton.ext.mpr (localisationₚ.is_max hP)⟩

    theorem localisation_at.m_def [Ring α] {P : Ideal α} (hP : P.is_prime) : localiseₚ hP P = m :=
      maximal_is_m ((localisationₚ.is_max hP _).mpr rfl)

    theorem jacobson_radical_eq_m (α : Type _) [LocalRing α] : Ring.jacobson_radical α = m :=
      Ideal.antisymm (Ring.maximal_subset_jacobson m_max)
        fun x hx => Ideal.sIntersection.mem.mpr fun I hI => maximal_is_m hI ▸ hx

    theorem proper_subset_jacobson_radical [LocalRing α] {I : Ideal α} (hI : I.proper_ideal) : I ⊆ Ring.jacobson_radical α :=
      jacobson_radical_eq_m α ▸ subset_m hI

    instance quotient_LocalRing [LocalRing α] {I : Ideal α} (hI : I.proper_ideal) : LocalRing (QClass I) where
      loc := ⟨extension (QuotientRing.natural_hom I).hom m, Set.ext.mp fun x => ⟨fun hx =>
        quotient_contraction_injective ((quotient_extension_contraction (subset_m hI)).symm ▸
          maximal_is_m (quotient_contraction_maximal hx)),
      fun hx => hx ▸ Ideal.quotient_extension_maximal m_max (subset_m hI)⟩⟩

    theorem quotient_LocalRing.m_def [LocalRing α] {I : Ideal α} (hI : I.proper_ideal) :
      extension (QuotientRing.natural_hom I).hom m = @m _ (quotient_LocalRing hI) :=
        @maximal_is_m _ (quotient_LocalRing hI) _ (quotient_extension_maximal m_max (subset_m hI))

  end LocalRing

  open LocalRing localisation_at Monoid Group NCSemiring CommMonoid

  class NoetherianLocalRing (α : Type _) extends LocalRing α, NoetherianRing α

  namespace NoetherianLocalRing

    instance localisation_NoetherianLocalRing [NoetherianRing α] {P : Ideal α} (hP : P.is_prime) :
      NoetherianLocalRing (localisationₚ hP) where
        noetherian := NoetherianRing.localisation_noetherian (PrimeComp hP)

    instance quotient_NotherianLocalRing [NoetherianLocalRing α] {I : Ideal α} (hI : I.proper_ideal) :
      NoetherianLocalRing (QClass I) where
        toLocalRing := quotient_LocalRing hI
        noetherian  := NoetherianRing.quotient_noetherian I

    protected theorem m_finitely_generated (α : Type _) [NoetherianLocalRing α] : (m : Ideal α).finitely_generated :=
      NoetherianRing.ideal_finitely_generated m

    theorem local_krull_principal_ideal_theorem [NoetherianLocalRing α] {a : α}
      (hP : m.minimal_prime_ideal_of (principal a)) : (m : Ideal α).height_le 1 :=
        let RaR := QClass (principal a)
        have : Ring.Spec RaR ⊆ Ring.MaxSpec RaR := fun Q hQ => by
          let Q' := contractionᵣ₁ (QuotientRing.natural_hom (principal a)) Q
          have h₁ : principal a ⊆ Q' := fun x hx => (natural_hom.kernel.mpr hx ▸ Q.has_zero :
            QuotientRing.natural_hom (principal a) x ∈ Q)
          have h₂ : Q'.is_prime := Ideal.contraction_prime _ hQ
          have := quotient_extension_maximal m_max (subset_m hP.right_proper)
          rw [←hP.right.right h₂ h₁ (subset_m h₂.left)] at this
          exact contraction_extension_eq_of_surjective (QuotientRing.natural_hom (principal a)).preserve_mul_right
            (natural_hom.surjective (principal a)) Q ▸ this
        have : ∀ Q Q' : Ideal α, Q.is_prime → Q'.is_prime → Q' ⊊ Q → Q ⊊ m → False := fun Q Q' hQ hQ' hQ'Q hQm => by
          have haQ : a ∉ Q := fun h => absurd (hP.right.right hQ (principal_in h) hQm.left) (Ideal.subsetneq.mp hQm).right
          let c : chain RaR := fun n => extension (QuotientRing.natural_hom (principal a)) (symbolic_power hQ n.succ)
          have hc : c.descending := fun n => extension.subset _ (symbolic_power.descending hQ n.succ)
          let ⟨N, hN⟩ := ArtinianRing.artinian_of_primes_maximal this c hc
          have he := quotient_extension_injective (hN N.succ (Nat.le_succ N))
          have : symbolic_power hQ N.succ = symbolic_power hQ N.succ.succ + principal a * symbolic_power hQ N.succ :=
            Ideal.antisymm (fun x hx =>
              let ⟨i, hi, j, ⟨c, hc⟩, hij⟩ : x ∈ symbolic_power hQ N.succ.succ + principal a := he ▸ add.subset (symbolic_power hQ N.succ) (principal a) hx
              ⟨i, hi, j,
                have : x - i = c * a := mul_comm a c ▸ hc ▸ Group.sub_eq.mpr (add_comm i j ▸ hij.symm)
                have : c * a ∈ symbolic_power hQ N.succ := this ▸ (symbolic_power hQ N.succ).sub_closed hx (symbolic_power.descending hQ N.succ hi)
                have := ((symbolic_power.primary hQ N.succ_ne_zero).right c a this).resolve_right
                  fun ha => absurd (symbolic_power.rad_eq hQ N.succ_ne_zero ▸ ha) haQ
                from_set.contains_mem ⟨a, generator_in_principal a, c, this, hc.symm⟩, hij⟩)
              (add.subset_add (symbolic_power.descending hQ N.succ) (product.subset_right))
          have h₁ : extension (QuotientRing.natural_hom (symbolic_power hQ N.succ.succ)).hom m ⊆ Ring.jacobson_radical _ :=
            @proper_subset_jacobson_radical _ (LocalRing.quotient_LocalRing (symbolic_power.primary hQ (N.succ.succ_ne_zero)).left) _
              (quotient_extension_proper (Subset.trans (symbolic_power.subset_base hQ N.succ.succ_ne_zero) hQm.left) m_proper)
          have h₂ : extension (QuotientRing.natural_hom (symbolic_power hQ N.succ.succ)).hom (symbolic_power hQ N.succ) =
            extension (QuotientRing.natural_hom (symbolic_power hQ N.succ.succ)).hom (m * symbolic_power hQ N.succ) :=
              Ideal.antisymm (by
                conv => lhs rw [this, QuotientRing.natural_hom.extension_add_I]
                exact extension.subset _ (Ideal.product.mul_subset_mul hP.right.left (Subset.refl _)))
                (extension_mul _ _ _ ▸ product.subset_right)
          rw [extension_mul] at h₂
          have := Ideal.antisymm (quotient_extension_zero.mp (Ring.nakayama (NoetherianRing.ideal_finitely_generated _) h₁ h₂)) (symbolic_power.descending hQ N.succ)
          have h₁ : localiseₚ hQ Q ⊆ Ring.jacobson_radical _ := by
            rw [jacobson_radical_eq_m, localisation_at.m_def]; exact Subset.refl m
          have h₂ : localiseₚ hQ Q ^ N.succ = localiseₚ hQ Q ^ N.succ.succ :=
            ((extension_pow (natural_homₚ hQ).toRMulMap Q N.succ_ne_zero).symm.trans ((extension_contraction_extension
              (natural_homₚ hQ).preserve_mul_right (Q ^ N.succ)).trans ((congrArg (localiseₚ hQ) this).trans (extension_contraction_extension
              (natural_homₚ hQ).preserve_mul_right (Q ^ N.succ.succ)).symm))).trans (extension_pow (natural_homₚ hQ).toRMulMap Q N.succ.succ_ne_zero)
          conv at h₂ => rhs rw [pow_nat_succ, mul_comm]
          have := congrArg Ideal.radical (Ring.nakayama (NoetherianRing.ideal_finitely_generated _) h₁ h₂)
          rw [radical_pow_of_prime (localisationₚ.prime hQ) N.succ N.succ_ne_zero, Ring.nil_radical.def] at this
          have : delocaliseₚ hQ (localiseₚ hQ Q) ⊆ delocaliseₚ hQ (localiseₚ hQ Q') := contraction.subset
            (natural_homₚ hQ).preserve_mul_right (this ▸ Ring.nil_radical.eq_prime_intersection (localisationₚ hQ)
            ▸ Ideal.sIntersection.contains (localise_ideal.prime hQ' (PrimeComp.disjoint_subset hQ hQ'Q.left)))
          exact absurd (Ideal.antisymm hQ'Q.left (localise_ideal.prime_loc_deloc hQ (PrimeComp.disjoint_subset hQ (Subset.refl Q))
            ▸ localise_ideal.prime_loc_deloc hQ' (PrimeComp.disjoint_subset hQ hQ'Q.left) ▸ this)) (Ideal.subsetneq.mp hQ'Q).right
        height_le_of_strict_lt (maximal_is_prime m_max) fun c hc h => Classical.byContradiction fun he =>
          this (c 1) (c 2) (hc.right.right 1) (hc.right.right 2) (Ideal.subsetneq.mpr ⟨hc.right.left 1, Ne.symm he⟩)
            (Ideal.subsetneq.mpr (hc.left ▸ ⟨hc.right.left 0, (h 0 Nat.zero_lt_one).symm⟩))

    theorem local_krull_height_theorem {α : Type u} [NoetherianLocalRing α] (f : Finset α) (hP : m.minimal_prime_ideal_of (from_set f.toSet))
      (ih : ∀ m, m < f.length → ∀ (α : Type u) [NoetherianRing α] (f : Finset α) (hfm : f.length = m) (P : Ideal α),
        P.minimal_prime_ideal_of (from_set f.toSet) → P.height_le f.length) : (m : Ideal α).height_le f.length :=
          (f.length.le_or_lt 0).elim
            (fun hf0 => by
              have hf0 := Nat.le_zero.mp hf0
              rw [Finset.eq_empty_of_length_eq_zero hf0] at hP
              exact hf0 ▸ Ideal.height_le_of_eq (Ideal.height_eq_zero.mpr (from_set.empty ▸ hP)))
            fun hf0 =>
              /-
                • sufficient to show height Q ≤ f.length - 1 for any prime ideal Q such that Q ⊊ m with no prime Q' in between (NOT Q ⊊ Q' ⊊ m)
                • from_set f ⊈ Q as m is minimal prime, so f must contain at least one generator g ∉ Q
                • use artinian_of_primes_maximal on R/(Q + principal g) (primes in R/(Q + gR) correspond to primes P in R s.t.
                  Q + gR ⊊ P (i.e. only m, which is also maximal in the quotient))
                • artinian → nilradical nilpotent, and nilradical = m / (Q + gR) (⋂₀ of primes = {m})
                • (m/(Q + gR)) ^ n = 0 → m ^ n ⊆ Q + gR → all generators in x ∈ f (apart from g) satisfy x ^ n ∈ Q + principal g,
                  i.e. xᵢ ^ n = dᵢ + rᵢg, xᵢ ∈ f ∖ { g }, dᵢ ∈ Q, rᵢ ∈ R
                • any prime ideal containing all the dᵢ's and g must contain all of f, and so must equal m. Thus, letting d = {d₁, ..., dᵢ} (of length f.length-1),
                  we have : M / (from_set d) is a minimal prime ideal of principal (natural_hom (from_set d) g) (or principal g / (from_set d)?).
                • Using krull_principal_ideal_theorem (maybe even local version?) we have height (m / (from_set d)) ≤ 1, and so Q must be a minimal prime of from_set d,
                  otherwise if there exists a prime Q' s.t. from_set d ⊆ Q' ⊊ Q, we would have Q' / (from_set d) ⊊ Q / (from_set d) ⊊ m / (from_set d),
                  violating the height condition.
                • As Q is a minimal prime of from_set d (with d.length + 1 = f.length), ih gives height Q ≤ n - 1
              -/
              have : ∀ Q : Ideal α, Q.is_prime → Q ⊊ m → (∀ Q' : Ideal α, Q'.is_prime → Q ⊆ Q' → Q' ⊊ m → Q' ⊆ Q) → Q.height_le f.length.pred := fun Q hQ hQm hQmax => by
                let ⟨g, hgf, hgQ⟩ : ∃ g : α, g ∈ f ∧ g ∉ Q := Classical.byContradiction fun h =>
                  absurd ((hP.right.right hQ (from_set.ideal_contained fun x hx => of_not_not (not_and.mp
                    (not_exists.mp h x) hx)) hQm.left) ▸ Subset.refl _) (ProperSubset.toNotSubset hQm)
                have hprimes_maximal : Ring.Spec (QClass (Q + principal g)) ⊆ Ring.MaxSpec (QClass (Q + principal g)) := fun Q' hQ' =>
                  have := contraction_prime (QuotientRing.natural_hom (Q + principal g)) hQ'
                  Classical.byContradiction fun h' => absurd (Subset.trans (quotient_contraction_contains Q')
                    (hQmax _ this (Subset.trans (add.subset Q (principal g)) (quotient_contraction_contains Q'))
                    (Ideal.subsetneq.mpr ⟨subset_m this.left, fun h => absurd (quotient_of_contraction_maximal
                    (h ▸ m_max)) h'⟩)) (add.subset' _ _ (generator_in_principal g))) hgQ
                have : Ring.MaxSpec (QClass (Q + principal g)) = Set.singleton (extension (QuotientRing.natural_hom (Q + principal g)).hom m) :=
                  Set.ext.mp fun I => ⟨fun hI => contraction_extension_eq_of_surjective (QuotientRing.natural_hom (Q + principal g)).preserve_mul_right
                    (natural_hom.surjective (Q + principal g)) I ▸ congrArg (extension (QuotientRing.natural_hom (Q + principal g)).hom ·)
                    (maximal_is_m (quotient_contraction_maximal hI)), fun hI => hI ▸ quotient_extension_maximal m_max (add.subset_add hQm.left
                    (principal_in (hP.right.left (from_set.contains_mem hgf))))⟩
                let ⟨n, hn, hnm⟩ := ArtinianRing.nilradical_nilpotent (ArtinianRing.artinian_of_primes_maximal hprimes_maximal)
                rw [Ring.nil_radical.eq_prime_intersection, Set.subset.antisymm hprimes_maximal (fun _ => maximal_is_prime),
                  this, sIntersection.single, ←extension_pow _ _ hn, quotient_extension_zero] at hnm
                have hxQg : ∀ x ∈ f, x ^ n ∈ Q + principal g := fun x hx =>
                  hnm (product.pow_contains n (hP.right.left (from_set.contains_mem hx)))
                let d : Finset α := ((f.erase g).elems.pmap (fun x hx => Classical.choose (hxQg x hx))
                  (fun x hx => (Finset.mem_erase.mp hx).right)).to_finset
                have hdQ : from_set d.toSet ⊆ Q := from_set.ideal_contained fun x hx =>
                  let ⟨a, ha, hx⟩ := UnorderedList.mem_pmap.mp (UnorderedList.mem_to_finset.mp hx)
                  hx ▸ (Classical.choose_spec (hxQg a (Finset.mem_erase.mp ha).right)).left
                have hdproper := proper_ideal_subset hdQ hQ.left
                have : (extension (QuotientRing.natural_hom (from_set d.toSet)).hom m).minimal_prime_ideal_of
                  (principal (QuotientRing.natural_hom (from_set d.toSet) g)) :=
                    ⟨quotient_extension_prime (maximal_is_prime m_max) (Subset.trans hdQ hQm.left),
                    from_set.contains_principal ⟨g, hP.right.left (from_set.contains_mem hgf), rfl⟩,
                    by
                      intro J hJ hgJ hJm
                      have : f.toSet ⊆ (contractionᵣ₁ (QuotientRing.natural_hom (from_set d.toSet)) J).subset := fun x hxf => by
                        byCases hxg : x = g
                        { rw [←extension_principal] at hgJ
                          apply contraction.subset (QuotientRing.natural_hom (from_set d.toSet)).preserve_mul_right hgJ;
                          rw [←natural_hom.extension_add_I, hxg]
                          exact extension_contraction _ _ (add.subset' (from_set d.toSet) (principal g) (generator_in_principal g)) }
                        { have := Classical.choose_spec (Classical.choose_spec (hxQg x hxf)).right;
                          exact prime_radical (contraction_prime (QuotientRing.natural_hom (from_set d.toSet)) hJ) x n hn
                            (this.right ▸ (contractionᵣ₁ (QuotientRing.natural_hom (from_set d.toSet)) J).add_closed
                              (quotient_contraction_contains J (from_set.contains_mem (UnorderedList.mem_to_finset.mpr
                              (UnorderedList.mem_pmap.mpr ⟨x, Finset.mem_erase.mpr ⟨hxg, hxf⟩, rfl⟩))))
                            (Subset.trans (extension_principal _ g ▸ extension_contraction _ _) (contraction.subset (QuotientRing.natural_hom
                              (from_set d.toSet)).preserve_mul_right hgJ) this.left)) }
                      have := hP.right.right (contraction_prime _ hJ) (from_set.ideal_contained this) (quotient_extension_contraction
                        (Subset.trans hdQ hQm.left) ▸ contraction.subset (QuotientRing.natural_hom (from_set d.toSet)).preserve_mul_right hJm)
                      exact contraction_extension_eq_of_surjective _ (natural_hom.surjective _) J ▸
                        congrArg (extension (QuotientRing.natural_hom (from_set d.toSet)).hom ·) this⟩
                rw [quotient_LocalRing.m_def hdproper] at this
                have := @local_krull_principal_ideal_theorem _ (quotient_NotherianLocalRing hdproper) _ this
                have : Q.minimal_prime_ideal_of (from_set d.toSet) := ⟨hQ, hdQ, by
                  intro J hJ hdJ hJQ
                  exact Classical.byContradiction fun hneJQ => absurd this (Ideal.height_gt_one (quotient_extension_prime hJ hdJ)
                    (quotient_extension_prime hQ hdQ) (maximal_is_prime (@m_max _ (quotient_LocalRing hdproper)))
                    (quotient_extension_subsetneq hdJ (Ideal.subsetneq.mpr ⟨hJQ, hneJQ⟩))
                    (quotient_LocalRing.m_def hdproper ▸ quotient_extension_subsetneq hdQ hQm))⟩
                have hdf : d.length < f.length := by
                  apply Nat.lt_of_le_of_lt (UnorderedList.to_finset_length_le _)
                  rw [UnorderedList.pmap_length]
                  conv => rhs rw [f.erase_cons hgf, Finset.length_cons]
                  exact Nat.lt.base _
                exact Q.height_le_trans (Nat.le_of_succ_le_succ (Nat.succ_pred_eq_of_pos hf0 ▸ hdf))
                  (ih d.length hdf α d rfl Q this)
              Nat.succ_pred_eq_of_pos hf0 ▸ height_le_succ (maximal_is_prime m_max) fun Q hQ hQm =>
                let ⟨P, ⟨hP, hPm, hQP⟩, hPmax⟩ := @NoetherianRing.exists_maximal _ _ {P : Ideal α | P.is_prime ∧ P ⊊ m ∧ Q ⊆ P} ⟨Q, hQ, hQm, Subset.refl Q⟩
                have := this P hP hPm (fun Q' hQ' hPQ' hQm' => hPmax Q' ⟨hQ', hQm', Subset.trans hQP hPQ'⟩ hPQ' ▸ Subset.refl _)
                height_le_subset hQ hQP this

  end NoetherianLocalRing

  namespace NoetherianRing

    theorem krull_principal_ideal_theorem [NoetherianRing α] {a : α}
      {P : Ideal α} (hP : P.minimal_prime_ideal_of (principal a)) : P.height_le 1 :=
        have : m.minimal_prime_ideal_of (principal (natural_homₚ hP.left a)) :=
          localise_ideal.principal _ a ▸ m_def hP.left ▸ minimal_prime_localisation
            hP (PrimeComp.disjoint hP.left)
        local_height_le hP.left (PrimeComp.disjoint hP.left) 1 (m_def hP.left ▸
          NoetherianLocalRing.local_krull_principal_ideal_theorem this : height_le (localiseₚ hP.left P) 1)

    theorem krull_height_theorem [NoetherianRing α] {f : Finset α} {P : Ideal α}
      (hP : P.minimal_prime_ideal_of (from_set f.toSet)) : P.height_le f.length :=
        Nat.strong_induction (fun n => ∀ (α : Type _) [NoetherianRing α] (f : Finset α) (hfn : f.length = n) (P : Ideal α),
          P.minimal_prime_ideal_of (from_set f.toSet) → P.height_le f.length)
          (fun n ih α hα f hfn P hP =>
            let f' : Finset (localisationₚ hP.left) := (f.map (natural_homₚ hP.left)).to_finset
            have hf' : f'.length ≤ f.length := f.length_map (natural_homₚ hP.left).hom ▸
              (f.map (natural_homₚ hP.left).hom).to_finset_length_le
            have : m.minimal_prime_ideal_of (from_set f'.toSet) := by
              exact extension_from_finset (natural_homₚ hP.left).preserve_mul_right f ▸ m_def hP.left
                ▸ minimal_prime_localisation hP (PrimeComp.disjoint hP.left)
            have := NoetherianLocalRing.local_krull_height_theorem f' this (fun m hm => ih m (hfn ▸ Nat.lt_of_lt_of_le hm hf'))
            P.height_le_trans hf' (local_height_le hP.left (PrimeComp.disjoint hP.left) f'.length (m_def hP.left ▸ this :
                height_le (localiseₚ hP.left P) f'.length))) f.length α f rfl P hP

  end NoetherianRing

  namespace NoetherianLocalRing

    protected theorem has_krull_dim (α : Type _) [NoetherianLocalRing α] : Ring.krull_dim.has_krull_dim α :=
      let ⟨f, hf⟩ := NoetherianLocalRing.m_finitely_generated α
      Ring.krull_dim.has_krull_dim_of_maximal_height_le ⟨m, m_max⟩ f.length fun M hM =>
        NoetherianRing.krull_height_theorem (maximal_is_m hM ▸ hf ▸ minimal_prime_of_prime (maximal_is_prime m_max))

  end NoetherianLocalRing

  class RegularLocalRing (α : Type _) extends NoetherianLocalRing α where
    regular : (NoetherianLocalRing.m_finitely_generated α).minimal_generator_count =
                Ring.krull_dim.dim (NoetherianLocalRing.has_krull_dim α)

end M4R


import data.nat.prime
import data.pnat.basic

import for_mathlib.exactly_divides

open nat

namespace order

section raw_order

variables (p : ℕ) (hp : p > 1)

protected def order_core : Π (n : ℕ), n > 0 → {r // p^r ∣∣ n}
| 0       := λ n_pos, absurd n_pos dec_trivial
| n@(k+1) := λ n_pos,
  have n / p < n, from div_lt_self n_pos hp,
  if h : p ∣ n
  then
    have p * (n / p) = n, from nat.mul_div_cancel' h,
    let ⟨s, hs⟩ :=
      order_core (n / p)
        (pos_of_mul_pos_left (this.symm ▸ n_pos : 0 < p * (n / p)) dec_trivial)
    in ⟨succ s, this ▸ (exactly_divides_succ (hp.trans dec_trivial)).mp hs⟩
  else ⟨0, (exactly_divides_zero (hp.trans dec_trivial)).mp h⟩

def order (n : ℕ) (n_pos : n > 0) : ℕ := (order.order_core p hp n n_pos).val

lemma exactly_divides_order (n : ℕ) (n_pos : n > 0) :
  p^(order p hp n n_pos) ∣∣ n :=
(order.order_core p hp n n_pos).property

end raw_order

/- XXX comments -/

instance : has_dvd ℕ+ := ⟨λ a b, a.val ∣ b.val⟩

def 𝓟 := {p : ℕ // prime p}
notation `PP` := 𝓟

def 𝓟.gt_one (p : 𝓟) : p.val > 1 := p.property.one_lt
def 𝓟.pos (p : 𝓟) : p.val > 0 := p.property.pos

instance : has_coe 𝓟 ℕ+ := ⟨λ p, ⟨p.val, p.pos⟩⟩

def ord (p : 𝓟) (n : ℕ+) : ℕ := order p p.gt_one n n.property
def exactly_divides_ord {p : 𝓟} {n : ℕ+} : p^(ord p n) ∣∣ n :=
exactly_divides_order p p.gt_one n n.property
def exactly_divides_iff_ord {p : 𝓟} {r : ℕ} {n : ℕ+} : ord p n = r ↔ p^r ∣∣ n :=
iff.intro
  (λ e, e ▸ exactly_divides_ord)
  (exactly_divides_unique exactly_divides_ord)

variable {p : 𝓟}

-- Recursion (though we prove them in a round-about fashion)

lemma ord_not_div {n : ℕ+} : ¬(↑p ∣ n) ↔ ord p n = 0 :=
(exactly_divides_zero p.pos).trans exactly_divides_iff_ord.symm

lemma ord_div {n : ℕ+} : ord p (p * n) = succ (ord p n) :=
exactly_divides_iff_ord.mpr
((exactly_divides_succ p.pos).mp exactly_divides_ord)

-- Multiplicative

lemma ord_one : ord p 1 = 0 :=
exactly_divides_iff_ord.mpr (exactly_divides_one p.property)

lemma ord_mul (a b : ℕ+) : ord p (a * b) = ord p a + ord p b :=
exactly_divides_iff_ord.mpr
(exactly_divides_mul p.property
  exactly_divides_ord exactly_divides_ord)

lemma ord_ppow {k : ℕ} {a : ℕ+} : ord p (a ^ k) = k * ord p a :=
begin
  apply exactly_divides_iff_ord.mpr,
  convert (exactly_divides_pow p.property exactly_divides_ord),
  simp,
end

lemma ord_pow {k : ℕ} {a : ℕ+} : ord p (a^k) = k * ord p a := ord_ppow

-- Gcd

/-

def pgcd (a b : ℕ+) : ℕ+ := ⟨gcd a b, gcd_pos_of_pos_left b a.pos⟩

--set_option pp.notation false
@[simp] lemma pgcd_coe_something (a b : ℕ) : pgcd a b = gcd a b := begin
unfold pgcd,
--rw pnat.coe_nat_coe a, -- I am so rubbish at coe
sorry
end

--#print notation ℕ∞
lemma ord_pgcd {a b : ℕ+} : ord p (pgcd a b) = min (ord p a) (ord p b) :=
exactly_divides_iff_ord.mpr
(exactly_divides_gcd
  exactly_divides_ord exactly_divides_ord)

lemma ord_gcd {a b : ℕ+} : ord p (gcd a b) = min (ord p a) (ord p b) :=
have pgcd a b = gcd a b, from (pnat.coe_nat_coe _).symm, this ▸ ord_pgcd

instance pnat.has_le : has_le (ℕ+) := ⟨λ a b, a.1 ≤ b.1⟩

-- Addition

-- ord_mul : ∀ {p : PP} (a b : ℕ+), ord p (a * b) = ord p a + ord p b
lemma ord_le_mul_right (a b : ℕ+) : ord p a ≤ ord p (a * b) :=
begin
have H : ∀ a b c : ℕ+, a = b + c → b ≤ a := sorry,
--refine H _ _ _ (ord_mul a b) -- error
sorry
end

--set_option pp.all true
--set_option pp.notation false

lemma ord_add {a b : ℕ+} : ord p (a + b) ≥ min (ord p a) (ord p b) :=
begin
  --have H (a b : ℕ+) : gcd a b ∣ (a + b) := sorry,
  have H : ∀ (a b : ℕ+), gcd a b ∣ (a + b) :=
  λ a b, (nat.dvd_add_iff_left (gcd_dvd_right _ _)).1 (gcd_dvd_left _ _),
  rw ←ord_gcd,
  have H3 : ord p (a + b) ≥ ord p (pgcd a b) := sorry,
  have H2 := H a b,
  suffices : H3 = (ord p (a + b) ≥ ord p ↑(gcd ↑a ↑b)),
  -- now need to uncast to use H2?

  cases H2 with d Hd,
  /-
  Hd :
  @eq.{1} nat
    (@has_add.add.{0} nat nat.has_add
       (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) a)
       (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) b))
    (@has_mul.mul.{0} nat
       (@mul_zero_class.to_has_mul.{0} nat
          (@semiring.to_mul_zero_class.{0} nat (@comm_semiring.to_semiring.{0} nat nat.comm_semiring)))
       (nat.gcd (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) a)
          (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) b))
       d)
⊢ @ge.{0} nat nat.has_le (order.ord p (@has_add.add.{0} pnat pnat.has_add a b))
    (order.ord p
       (@coe.{1 1} nat pnat (@coe_to_lift.{1 1} nat pnat (@coe_base.{1 1} nat pnat coe_nat_pnat))
          (nat.gcd (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) a)
             (@coe.{1 1} pnat nat (@coe_to_lift.{1 1} pnat nat (@coe_base.{1 1} pnat nat coe_pnat_nat)) b))))
             -/
  change a + b = _ at Hd,

  --have H2 : ord p (gcd a b) ≥ min (ord p a) (ord p b),
  -- it's ord_gcd

  sorry,
end

  #exit
  begin
    intros a b,
    refine (nat.dvd_add_iff_left _).1 _,
      exact gcd_dvd_right _ _,
    exact gcd_dvd_left _ _ --
  end,
sorry
end
#check @nat.dvd_add_iff_left

-/
end order