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

! This file was ported from Lean 3 source module order.jordan_holder
! leanprover-community/mathlib commit 91288e351d51b3f0748f0a38faa7613fb0ae2ada
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Lattice
import Mathlib.Data.List.Sort
import Mathlib.Logic.Equiv.Fin
import Mathlib.Logic.Equiv.Functor
import Mathlib.Data.Fintype.Card

/-!
# Jordan-Hölder Theorem

This file proves the Jordan Hölder theorem for a `JordanHolderLattice`, a class also defined in
this file. Examples of `JordanHolderLattice` include `Subgroup G` if `G` is a group, and
`Submodule R M` if `M` is an `R`-module. Using this approach the theorem need not be proved
seperately for both groups and modules, the proof in this file can be applied to both.

## Main definitions
The main definitions in this file are `JordanHolderLattice` and `CompositionSeries`,
and the relation `Equivalent` on `CompositionSeries`

A `JordanHolderLattice` is the class for which the Jordan Hölder theorem is proved. A
Jordan Hölder lattice is a lattice equipped with a notion of maximality, `IsMaximal`, and a notion
of isomorphism of pairs `Iso`. In the example of subgroups of a group, `IsMaximal H K` means that
`H` is a maximal normal subgroup of `K`, and `Iso (H₁, K₁) (H₂, K₂)` means that the quotient
`H₁ / K₁` is isomorphic to the quotient `H₂ / K₂`. `Iso` must be symmetric and transitive and must
satisfy the second isomorphism theorem `Iso (H, H ⊔ K) (H ⊓ K, K)`.

A `CompositionSeries X` is a finite nonempty series of elements of the lattice `X` such that
each element is maximal inside the next. The length of a `CompositionSeries X` is
one less than the number of elements in the series. Note that there is no stipulation
that a series start from the bottom of the lattice and finish at the top.
For a composition series `s`, `s.top` is the largest element of the series,
and `s.bot` is the least element.

Two `CompositionSeries X`, `s₁` and `s₂` are equivalent if there is a bijection
`e : Fin s₁.length ≃ Fin s₂.length` such that for any `i`,
`Iso (s₁ i, s₁ i.succ) (s₂ (e i), s₂ (e i.succ))`

## Main theorems

The main theorem is `CompositionSeries.jordan_holder`, which says that if two composition
series have the same least element and the same largest element,
then they are `Equivalent`.

## TODO

Provide instances of `JordanHolderLattice` for both submodules and subgroups, and potentially
for modular lattices.

It is not entirely clear how this should be done. Possibly there should be no global instances
of `JordanHolderLattice`, and the instances should only be defined locally in order to prove
the Jordan-Hölder theorem for modules/groups and the API should be transferred because many of the
theorems in this file will have stronger versions for modules. There will also need to be an API for
mapping composition series across homomorphisms. It is also probably possible to
provide an instance of `JordanHolderLattice` for any `ModularLattice`, and in this case the
Jordan-Hölder theorem will say that there is a well defined notion of length of a modular lattice.
However an instance of `JordanHolderLattice` for a modular lattice will not be able to contain
the correct notion of isomorphism for modules, so a separate instance for modules will still be
required and this will clash with the instance for modular lattices, and so at least one of these
instances should not be a global instance.
-/

universe u

open Set

/-- A `JordanHolderLattice` is the class for which the Jordan Hölder theorem is proved. A
Jordan Hölder lattice is a lattice equipped with a notion of maximality, `IsMaximal`, and a notion
of isomorphism of pairs `Iso`. In the example of subgroups of a group, `IsMaximal H K` means that
`H` is a maximal normal subgroup of `K`, and `Iso (H₁, K₁) (H₂, K₂)` means that the quotient
`H₁ / K₁` is isomorphic to the quotient `H₂ / K₂`. `Iso` must be symmetric and transitive and must
satisfy the second isomorphism theorem `Iso (H, H ⊔ K) (H ⊓ K, K)`.
Examples include `Subgroup G` if `G` is a group, and `Submodule R M` if `M` is an `R`-module.
-/
class JordanHolderLattice (X : Type u) [Lattice X] where
  IsMaximal : X → X → Prop
  lt_of_isMaximal : ∀ {x y}, IsMaximal x y → x < y
  sup_eq_of_isMaximal : ∀ {x y z}, IsMaximal x z → IsMaximal y z → x ≠ y → x ⊔ y = z
  isMaximal_inf_left_of_isMaximal_sup :
    ∀ {x y}, IsMaximal x (x ⊔ y) → IsMaximal y (x ⊔ y) → IsMaximal (x ⊓ y) x
  Iso : X × X → X × X → Prop
  iso_symm : ∀ {x y}, Iso x y → Iso y x
  iso_trans : ∀ {x y z}, Iso x y → Iso y z → Iso x z
  second_iso : ∀ {x y}, IsMaximal x (x ⊔ y) → Iso (x, x ⊔ y) (x ⊓ y, y)
#align jordan_holder_lattice JordanHolderLattice

namespace JordanHolderLattice

variable {X : Type u} [Lattice X] [JordanHolderLattice X]

theorem isMaximal_inf_right_of_isMaximal_sup {x y : X} (hxz : IsMaximal x (x ⊔ y))
    (hyz : IsMaximal y (x ⊔ y)) : IsMaximal (x ⊓ y) y := by
  rw [inf_comm]
  rw [sup_comm] at hxz hyz
  exact isMaximal_inf_left_of_isMaximal_sup hyz hxz
#align jordan_holder_lattice.is_maximal_inf_right_of_is_maximal_sup JordanHolderLattice.isMaximal_inf_right_of_isMaximal_sup

theorem isMaximal_of_eq_inf (x b : X) {a y : X} (ha : x ⊓ y = a) (hxy : x ≠ y) (hxb : IsMaximal x b)
    (hyb : IsMaximal y b) : IsMaximal a y := by
  have hb : x ⊔ y = b := sup_eq_of_isMaximal hxb hyb hxy
  substs a b
  exact isMaximal_inf_right_of_isMaximal_sup hxb hyb
#align jordan_holder_lattice.is_maximal_of_eq_inf JordanHolderLattice.isMaximal_of_eq_inf

theorem second_iso_of_eq {x y a b : X} (hm : IsMaximal x a) (ha : x ⊔ y = a) (hb : x ⊓ y = b) :
    Iso (x, a) (b, y) := by substs a b; exact second_iso hm
#align jordan_holder_lattice.second_iso_of_eq JordanHolderLattice.second_iso_of_eq

theorem IsMaximal.iso_refl {x y : X} (h : IsMaximal x y) : Iso (x, y) (x, y) :=
  second_iso_of_eq h (sup_eq_right.2 (le_of_lt (lt_of_isMaximal h)))
    (inf_eq_left.2 (le_of_lt (lt_of_isMaximal h)))
#align jordan_holder_lattice.is_maximal.iso_refl JordanHolderLattice.IsMaximal.iso_refl

end JordanHolderLattice

open JordanHolderLattice

attribute [symm] iso_symm

attribute [trans] iso_trans

/-- A `CompositionSeries X` is a finite nonempty series of elements of a
`JordanHolderLattice` such that each element is maximal inside the next. The length of a
`CompositionSeries X` is one less than the number of elements in the series.
Note that there is no stipulation that a series start from the bottom of the lattice and finish at
the top. For a composition series `s`, `s.top` is the largest element of the series,
and `s.bot` is the least element.
-/
structure CompositionSeries (X : Type u) [Lattice X] [JordanHolderLattice X] : Type u where
  length : ℕ
  series : Fin (length + 1) → X
  step' : ∀ i : Fin length, IsMaximal (series (Fin.castSucc i)) (series (Fin.succ i))
#align composition_series CompositionSeries

namespace CompositionSeries

variable {X : Type u} [Lattice X] [JordanHolderLattice X]

instance coeFun : CoeFun (CompositionSeries X) fun x => Fin (x.length + 1) → X where
  coe := CompositionSeries.series
#align composition_series.has_coe_to_fun CompositionSeries.coeFun

instance inhabited [Inhabited X] : Inhabited (CompositionSeries X) :=
  ⟨{  length := 0
      series := default
      step' := fun x => x.elim0 }⟩
#align composition_series.has_inhabited CompositionSeries.inhabited

theorem step (s : CompositionSeries X) :
    ∀ i : Fin s.length, IsMaximal (s (Fin.castSucc i)) (s (Fin.succ i)) :=
  s.step'
#align composition_series.step CompositionSeries.step

-- @[simp] -- Porting note: dsimp can prove this
theorem coeFn_mk (length : ℕ) (series step) :
    (@CompositionSeries.mk X _ _ length series step : Fin length.succ → X) = series :=
  rfl
#align composition_series.coe_fn_mk CompositionSeries.coeFn_mk

theorem lt_succ (s : CompositionSeries X) (i : Fin s.length) :
    s (Fin.castSucc i) < s (Fin.succ i) :=
  lt_of_isMaximal (s.step _)
#align composition_series.lt_succ CompositionSeries.lt_succ

protected theorem strictMono (s : CompositionSeries X) : StrictMono s :=
  Fin.strictMono_iff_lt_succ.2 s.lt_succ
#align composition_series.strict_mono CompositionSeries.strictMono

protected theorem injective (s : CompositionSeries X) : Function.Injective s :=
  s.strictMono.injective
#align composition_series.injective CompositionSeries.injective

@[simp]
protected theorem inj (s : CompositionSeries X) {i j : Fin s.length.succ} : s i = s j ↔ i = j :=
  s.injective.eq_iff
#align composition_series.inj CompositionSeries.inj

instance membership : Membership X (CompositionSeries X) :=
  ⟨fun x s => x ∈ Set.range s⟩
#align composition_series.has_mem CompositionSeries.membership

theorem mem_def {x : X} {s : CompositionSeries X} : x ∈ s ↔ x ∈ Set.range s :=
  Iff.rfl
#align composition_series.mem_def CompositionSeries.mem_def

theorem total {s : CompositionSeries X} {x y : X} (hx : x ∈ s) (hy : y ∈ s) : x ≤ y ∨ y ≤ x := by
  rcases Set.mem_range.1 hx with ⟨i, rfl⟩
  rcases Set.mem_range.1 hy with ⟨j, rfl⟩
  rw [s.strictMono.le_iff_le, s.strictMono.le_iff_le]
  exact le_total i j
#align composition_series.total CompositionSeries.total

/-- The ordered `List X` of elements of a `CompositionSeries X`. -/
def toList (s : CompositionSeries X) : List X :=
  List.ofFn s
#align composition_series.to_list CompositionSeries.toList

/-- Two `CompositionSeries` are equal if they are the same length and
have the same `i`th element for every `i` -/
theorem ext_fun {s₁ s₂ : CompositionSeries X} (hl : s₁.length = s₂.length)
    (h : ∀ i, s₁ i = s₂ (Fin.cast (congr_arg Nat.succ hl) i)) : s₁ = s₂ := by
  cases s₁; cases s₂
  -- Porting note: `dsimp at *` doesn't work. Why?
  dsimp at hl h
  subst hl
  simpa [Function.funext_iff] using h
#align composition_series.ext_fun CompositionSeries.ext_fun

@[simp]
theorem length_toList (s : CompositionSeries X) : s.toList.length = s.length + 1 := by
  rw [toList, List.length_ofFn]
#align composition_series.length_to_list CompositionSeries.length_toList

theorem toList_ne_nil (s : CompositionSeries X) : s.toList ≠ [] := by
  rw [← List.length_pos_iff_ne_nil, length_toList]; exact Nat.succ_pos _
#align composition_series.to_list_ne_nil CompositionSeries.toList_ne_nil

theorem toList_injective : Function.Injective (@CompositionSeries.toList X _ _) :=
  fun s₁ s₂ (h : List.ofFn s₁ = List.ofFn s₂) => by
  have h₁ : s₁.length = s₂.length :=
    Nat.succ_injective
      ((List.length_ofFn s₁).symm.trans <| (congr_arg List.length h).trans <| List.length_ofFn s₂)
  have h₂ : ∀ i : Fin s₁.length.succ, s₁ i = s₂ (Fin.cast (congr_arg Nat.succ h₁) i) :=
    -- Porting note: `List.nthLe_ofFn` has been deprecated but `List.get_ofFn` has a
    --               different type, so we do golf here.
    congr_fun <| List.ofFn_injective <| h.trans <| List.ofFn_congr (congr_arg Nat.succ h₁).symm _
  cases s₁
  cases s₂
  -- Porting note: `dsimp at *` doesn't work. Why?
  dsimp at h h₁ h₂
  subst h₁
  -- Porting note: `[heq_iff_eq, eq_self_iff_true, true_and_iff]`
  --             → `[mk.injEq, heq_eq_eq, true_and]`
  simp only [mk.injEq, heq_eq_eq, true_and]
  simp only [Fin.cast_refl] at h₂
  exact funext h₂
#align composition_series.to_list_injective CompositionSeries.toList_injective

theorem chain'_toList (s : CompositionSeries X) : List.Chain' IsMaximal s.toList :=
  List.chain'_iff_get.2
    (by
      intro i hi
      simp only [toList, List.get_ofFn]
      rw [length_toList] at hi
      exact s.step ⟨i, hi⟩)
#align composition_series.chain'_to_list CompositionSeries.chain'_toList

theorem toList_sorted (s : CompositionSeries X) : s.toList.Sorted (· < ·) :=
  List.pairwise_iff_get.2 fun i j h => by
    dsimp [toList]
    rw [List.get_ofFn, List.get_ofFn]
    exact s.strictMono h
#align composition_series.to_list_sorted CompositionSeries.toList_sorted

theorem toList_nodup (s : CompositionSeries X) : s.toList.Nodup :=
  s.toList_sorted.nodup
#align composition_series.to_list_nodup CompositionSeries.toList_nodup

@[simp]
theorem mem_toList {s : CompositionSeries X} {x : X} : x ∈ s.toList ↔ x ∈ s := by
  rw [toList, List.mem_ofFn, mem_def]
#align composition_series.mem_to_list CompositionSeries.mem_toList

/-- Make a `CompositionSeries X` from the ordered list of its elements. -/
def ofList (l : List X) (hl : l ≠ []) (hc : List.Chain' IsMaximal l) : CompositionSeries X
    where
  length := l.length - 1
  series i :=
    l.nthLe i
      (by
        conv_rhs => rw [← tsub_add_cancel_of_le (Nat.succ_le_of_lt (List.length_pos_of_ne_nil hl))]
        exact i.2)
  step' := fun ⟨i, hi⟩ => List.chain'_iff_get.1 hc i hi
#align composition_series.of_list CompositionSeries.ofList

theorem length_ofList (l : List X) (hl : l ≠ []) (hc : List.Chain' IsMaximal l) :
    (ofList l hl hc).length = l.length - 1 :=
  rfl
#align composition_series.length_of_list CompositionSeries.length_ofList

theorem ofList_toList (s : CompositionSeries X) :
    ofList s.toList s.toList_ne_nil s.chain'_toList = s := by
  refine' ext_fun _ _
  · rw [length_ofList, length_toList, Nat.succ_sub_one]
  · rintro ⟨i, hi⟩
    -- Porting note: Was `dsimp [ofList, toList]; rw [List.nthLe_ofFn']`.
    simp [ofList, toList, -List.ofFn_succ]
#align composition_series.of_list_to_list CompositionSeries.ofList_toList

@[simp]
theorem ofList_toList' (s : CompositionSeries X) :
    ofList s.toList s.toList_ne_nil s.chain'_toList = s :=
  ofList_toList s
#align composition_series.of_list_to_list' CompositionSeries.ofList_toList'

@[simp]
theorem toList_ofList (l : List X) (hl : l ≠ []) (hc : List.Chain' IsMaximal l) :
    toList (ofList l hl hc) = l := by
  refine' List.ext_get _ _
  · rw [length_toList, length_ofList,
      tsub_add_cancel_of_le (Nat.succ_le_of_lt <| List.length_pos_of_ne_nil hl)]
  · intro i hi hi'
    dsimp [ofList, toList]
    rw [List.get_ofFn]
    rfl
#align composition_series.to_list_of_list CompositionSeries.toList_ofList

/-- Two `CompositionSeries` are equal if they have the same elements. See also `ext_fun`. -/
@[ext]
theorem ext {s₁ s₂ : CompositionSeries X} (h : ∀ x, x ∈ s₁ ↔ x ∈ s₂) : s₁ = s₂ :=
  toList_injective <|
    List.eq_of_perm_of_sorted
      (by
        classical
        exact List.perm_of_nodup_nodup_toFinset_eq s₁.toList_nodup s₂.toList_nodup
          (Finset.ext <| by simp [*]))
      s₁.toList_sorted s₂.toList_sorted
#align composition_series.ext CompositionSeries.ext

/-- The largest element of a `CompositionSeries` -/
def top (s : CompositionSeries X) : X :=
  s (Fin.last _)
#align composition_series.top CompositionSeries.top

theorem top_mem (s : CompositionSeries X) : s.top ∈ s :=
  mem_def.2 (Set.mem_range.2 ⟨Fin.last _, rfl⟩)
#align composition_series.top_mem CompositionSeries.top_mem

@[simp]
theorem le_top {s : CompositionSeries X} (i : Fin (s.length + 1)) : s i ≤ s.top :=
  s.strictMono.monotone (Fin.le_last _)
#align composition_series.le_top CompositionSeries.le_top

theorem le_top_of_mem {s : CompositionSeries X} {x : X} (hx : x ∈ s) : x ≤ s.top :=
  let ⟨_i, hi⟩ := Set.mem_range.2 hx
  hi ▸ le_top _
#align composition_series.le_top_of_mem CompositionSeries.le_top_of_mem

/-- The smallest element of a `CompositionSeries` -/
def bot (s : CompositionSeries X) : X :=
  s 0
#align composition_series.bot CompositionSeries.bot

theorem bot_mem (s : CompositionSeries X) : s.bot ∈ s :=
  mem_def.2 (Set.mem_range.2 ⟨0, rfl⟩)
#align composition_series.bot_mem CompositionSeries.bot_mem

@[simp]
theorem bot_le {s : CompositionSeries X} (i : Fin (s.length + 1)) : s.bot ≤ s i :=
  s.strictMono.monotone (Fin.zero_le _)
#align composition_series.bot_le CompositionSeries.bot_le

theorem bot_le_of_mem {s : CompositionSeries X} {x : X} (hx : x ∈ s) : s.bot ≤ x :=
  let ⟨_i, hi⟩ := Set.mem_range.2 hx
  hi ▸ bot_le _
#align composition_series.bot_le_of_mem CompositionSeries.bot_le_of_mem

theorem length_pos_of_mem_ne {s : CompositionSeries X} {x y : X} (hx : x ∈ s) (hy : y ∈ s)
    (hxy : x ≠ y) : 0 < s.length :=
  let ⟨i, hi⟩ := hx
  let ⟨j, hj⟩ := hy
  have hij : i ≠ j := mt s.inj.2 fun h => hxy (hi ▸ hj ▸ h)
  hij.lt_or_lt.elim
    (fun hij => lt_of_le_of_lt (zero_le (i : ℕ)) (lt_of_lt_of_le hij (Nat.le_of_lt_succ j.2)))
      fun hji => lt_of_le_of_lt (zero_le (j : ℕ)) (lt_of_lt_of_le hji (Nat.le_of_lt_succ i.2))
#align composition_series.length_pos_of_mem_ne CompositionSeries.length_pos_of_mem_ne

theorem forall_mem_eq_of_length_eq_zero {s : CompositionSeries X} (hs : s.length = 0) {x y}
    (hx : x ∈ s) (hy : y ∈ s) : x = y :=
  by_contradiction fun hxy => pos_iff_ne_zero.1 (length_pos_of_mem_ne hx hy hxy) hs
#align composition_series.forall_mem_eq_of_length_eq_zero CompositionSeries.forall_mem_eq_of_length_eq_zero

/-- Remove the largest element from a `CompositionSeries`. If the series `s`
has length zero, then `s.eraseTop = s` -/
@[simps]
def eraseTop (s : CompositionSeries X) : CompositionSeries X
    where
  length := s.length - 1
  series i := s ⟨i, lt_of_lt_of_le i.2 (Nat.succ_le_succ tsub_le_self)⟩
  step' i := by
    have := s.step ⟨i, lt_of_lt_of_le i.2 tsub_le_self⟩
    cases i
    exact this
#align composition_series.erase_top CompositionSeries.eraseTop

theorem top_eraseTop (s : CompositionSeries X) :
    s.eraseTop.top = s ⟨s.length - 1, lt_of_le_of_lt tsub_le_self (Nat.lt_succ_self _)⟩ :=
  show s _ = s _ from
    congr_arg s
      (by
        ext
        simp only [eraseTop_length, Fin.val_last, Fin.coe_castSucc, Fin.coe_ofNat_eq_mod,
          Fin.val_mk])
#align composition_series.top_erase_top CompositionSeries.top_eraseTop

@[simp]
theorem bot_eraseTop (s : CompositionSeries X) : s.eraseTop.bot = s.bot :=
  rfl
#align composition_series.bot_erase_top CompositionSeries.bot_eraseTop

theorem mem_eraseTop_of_ne_of_mem {s : CompositionSeries X} {x : X} (hx : x ≠ s.top) (hxs : x ∈ s) :
    x ∈ s.eraseTop := by
  rcases hxs with ⟨i, rfl⟩
  have hi : (i : ℕ) < (s.length - 1).succ :=
    by
    conv_rhs => rw [← Nat.succ_sub (length_pos_of_mem_ne ⟨i, rfl⟩ s.top_mem hx), Nat.succ_sub_one]
    exact lt_of_le_of_ne (Nat.le_of_lt_succ i.2) (by simpa [top, s.inj, Fin.ext_iff] using hx)
  refine' ⟨Fin.castSucc i, _⟩
  simp [Fin.ext_iff, Nat.mod_eq_of_lt hi]
#align composition_series.mem_erase_top_of_ne_of_mem CompositionSeries.mem_eraseTop_of_ne_of_mem

theorem mem_eraseTop {s : CompositionSeries X} {x : X} (h : 0 < s.length) :
    x ∈ s.eraseTop ↔ x ≠ s.top ∧ x ∈ s := by
  simp only [mem_def]
  dsimp only [eraseTop]
  constructor
  · rintro ⟨i, rfl⟩
    have hi : (i : ℕ) < s.length := by
      conv_rhs => rw [← Nat.succ_sub_one s.length, Nat.succ_sub h]
      exact i.2
    -- Porting note: Was `simp [top, Fin.ext_iff, ne_of_lt hi]`.
    simp [top, Fin.ext_iff, ne_of_lt hi, -Set.mem_range, Set.mem_range_self]
  · intro h
    exact mem_eraseTop_of_ne_of_mem h.1 h.2
#align composition_series.mem_erase_top CompositionSeries.mem_eraseTop

theorem lt_top_of_mem_eraseTop {s : CompositionSeries X} {x : X} (h : 0 < s.length)
    (hx : x ∈ s.eraseTop) : x < s.top :=
  lt_of_le_of_ne (le_top_of_mem ((mem_eraseTop h).1 hx).2) ((mem_eraseTop h).1 hx).1
#align composition_series.lt_top_of_mem_erase_top CompositionSeries.lt_top_of_mem_eraseTop

theorem isMaximal_eraseTop_top {s : CompositionSeries X} (h : 0 < s.length) :
    IsMaximal s.eraseTop.top s.top := by
  have : s.length - 1 + 1 = s.length := by
    conv_rhs => rw [← Nat.succ_sub_one s.length]; rw [Nat.succ_sub h]
  rw [top_eraseTop, top]
  convert s.step ⟨s.length - 1, Nat.sub_lt h zero_lt_one⟩; ext; simp [this]
#align composition_series.is_maximal_erase_top_top CompositionSeries.isMaximal_eraseTop_top

section FinLemmas

-- TODO: move these to `VecNotation` and rename them to better describe their statement
variable {α : Type _} {m n : ℕ} (a : Fin m.succ → α) (b : Fin n.succ → α)

theorem append_castAdd_aux (i : Fin m) :
    Matrix.vecAppend (Nat.add_succ _ _).symm (a ∘ Fin.castSucc) b
      (Fin.castSucc <| Fin.castAdd n i) =
      a (Fin.castSucc i) := by
  cases i
  simp [Matrix.vecAppend_eq_ite, *]
#align composition_series.append_cast_add_aux CompositionSeries.append_castAdd_aux

theorem append_succ_castAdd_aux (i : Fin m) (h : a (Fin.last _) = b 0) :
    Matrix.vecAppend (Nat.add_succ _ _).symm (a ∘ Fin.castSucc) b (Fin.castAdd n i).succ =
      a i.succ := by
  cases' i with i hi
  simp only [Matrix.vecAppend_eq_ite, hi, Fin.succ_mk, Function.comp_apply, Fin.castSucc_mk,
    Fin.val_mk, Fin.castAdd_mk]
  split_ifs with h_1
  · rfl
  · have : i + 1 = m := le_antisymm hi (le_of_not_gt h_1)
    calc
      b ⟨i + 1 - m, by simp [this]⟩ = b 0 := congr_arg b (by simp [Fin.ext_iff, this])
      _ = a (Fin.last _) := h.symm
      _ = _ := congr_arg a (by simp [Fin.ext_iff, this])

#align composition_series.append_succ_cast_add_aux CompositionSeries.append_succ_castAdd_aux

theorem append_natAdd_aux (i : Fin n) :
    Matrix.vecAppend (Nat.add_succ _ _).symm (a ∘ Fin.castSucc) b
      (Fin.castSucc <| Fin.natAdd m i) =
      b (Fin.castSucc i) := by
  cases i
  simp only [Matrix.vecAppend_eq_ite, Nat.not_lt_zero, Fin.natAdd_mk, add_lt_iff_neg_left,
    add_tsub_cancel_left, dif_neg, Fin.castSucc_mk, not_false_iff, Fin.val_mk]
#align composition_series.append_nat_add_aux CompositionSeries.append_natAdd_aux

theorem append_succ_natAdd_aux (i : Fin n) :
    Matrix.vecAppend (Nat.add_succ _ _).symm (a ∘ Fin.castSucc) b (Fin.natAdd m i).succ =
      b i.succ := by
  cases' i with i hi
  simp only [Matrix.vecAppend_eq_ite, add_assoc, Nat.not_lt_zero, Fin.natAdd_mk,
    add_lt_iff_neg_left, add_tsub_cancel_left, Fin.succ_mk, dif_neg, not_false_iff, Fin.val_mk]
#align composition_series.append_succ_nat_add_aux CompositionSeries.append_succ_natAdd_aux

end FinLemmas

/-- Append two composition series `s₁` and `s₂` such that
the least element of `s₁` is the maximum element of `s₂`. -/
@[simps length]
def append (s₁ s₂ : CompositionSeries X) (h : s₁.top = s₂.bot) : CompositionSeries X where
  length := s₁.length + s₂.length
  series := Matrix.vecAppend (Nat.add_succ s₁.length s₂.length).symm (s₁ ∘ Fin.castSucc) s₂
  step' i := by
    refine' Fin.addCases _ _ i
    · intro i
      rw [append_succ_castAdd_aux _ _ _ h, append_castAdd_aux]
      exact s₁.step i
    · intro i
      rw [append_natAdd_aux, append_succ_natAdd_aux]
      exact s₂.step i
#align composition_series.append CompositionSeries.append

theorem coe_append (s₁ s₂ : CompositionSeries X) (h) :
    ⇑(s₁.append s₂ h) = Matrix.vecAppend (Nat.add_succ _ _).symm (s₁ ∘ Fin.castSucc) s₂ :=
  rfl
#align composition_series.coe_append CompositionSeries.coe_append

@[simp]
theorem append_castAdd {s₁ s₂ : CompositionSeries X} (h : s₁.top = s₂.bot) (i : Fin s₁.length) :
    append s₁ s₂ h (Fin.castSucc <| Fin.castAdd s₂.length i) = s₁ (Fin.castSucc i) := by
  rw [coe_append, append_castAdd_aux _ _ i]
#align composition_series.append_cast_add CompositionSeries.append_castAdd

@[simp]
theorem append_succ_castAdd {s₁ s₂ : CompositionSeries X} (h : s₁.top = s₂.bot)
    (i : Fin s₁.length) : append s₁ s₂ h (Fin.castAdd s₂.length i).succ = s₁ i.succ := by
  rw [coe_append, append_succ_castAdd_aux _ _ _ h]
#align composition_series.append_succ_cast_add CompositionSeries.append_succ_castAdd

@[simp]
theorem append_natAdd {s₁ s₂ : CompositionSeries X} (h : s₁.top = s₂.bot) (i : Fin s₂.length) :
    append s₁ s₂ h (Fin.castSucc <| Fin.natAdd s₁.length i) = s₂ (Fin.castSucc i) := by
  rw [coe_append, append_natAdd_aux _ _ i]
#align composition_series.append_nat_add CompositionSeries.append_natAdd

@[simp]
theorem append_succ_natAdd {s₁ s₂ : CompositionSeries X} (h : s₁.top = s₂.bot) (i : Fin s₂.length) :
    append s₁ s₂ h (Fin.natAdd s₁.length i).succ = s₂ i.succ := by
  rw [coe_append, append_succ_natAdd_aux _ _ i]
#align composition_series.append_succ_nat_add CompositionSeries.append_succ_natAdd

/-- Add an element to the top of a `CompositionSeries` -/
@[simps length]
def snoc (s : CompositionSeries X) (x : X) (hsat : IsMaximal s.top x) : CompositionSeries X where
  length := s.length + 1
  series := Fin.snoc s x
  step' i := by
    refine' Fin.lastCases _ _ i
    · rwa [Fin.snoc_cast_succ, Fin.succ_last, Fin.snoc_last, ← top]
    · intro i
      rw [Fin.snoc_cast_succ, ← Fin.castSucc_fin_succ, Fin.snoc_cast_succ]
      exact s.step _
#align composition_series.snoc CompositionSeries.snoc

@[simp]
theorem top_snoc (s : CompositionSeries X) (x : X) (hsat : IsMaximal s.top x) :
    (snoc s x hsat).top = x :=
  Fin.snoc_last (α := fun _ => X) _ _
#align composition_series.top_snoc CompositionSeries.top_snoc

@[simp]
theorem snoc_last (s : CompositionSeries X) (x : X) (hsat : IsMaximal s.top x) :
    snoc s x hsat (Fin.last (s.length + 1)) = x :=
  Fin.snoc_last (α := fun _ => X) _ _
#align composition_series.snoc_last CompositionSeries.snoc_last

@[simp]
theorem snoc_castSucc (s : CompositionSeries X) (x : X) (hsat : IsMaximal s.top x)
    (i : Fin (s.length + 1)) : snoc s x hsat (Fin.castSucc i) = s i :=
  Fin.snoc_cast_succ (α := fun _ => X) _ _ _
#align composition_series.snoc_cast_succ CompositionSeries.snoc_castSucc

@[simp]
theorem bot_snoc (s : CompositionSeries X) (x : X) (hsat : IsMaximal s.top x) :
    (snoc s x hsat).bot = s.bot := by rw [bot, bot, ← snoc_castSucc s _ _ 0, Fin.castSucc_zero]
#align composition_series.bot_snoc CompositionSeries.bot_snoc

theorem mem_snoc {s : CompositionSeries X} {x y : X} {hsat : IsMaximal s.top x} :
    y ∈ snoc s x hsat ↔ y ∈ s ∨ y = x := by
  simp only [snoc, mem_def]
  constructor
  · rintro ⟨i, rfl⟩
    refine' Fin.lastCases _ (fun i => _) i
    · right
      simp
    · left
      simp
  · intro h
    rcases h with (⟨i, rfl⟩ | rfl)
    · use Fin.castSucc i
      simp
    · use Fin.last _
      simp
#align composition_series.mem_snoc CompositionSeries.mem_snoc

theorem eq_snoc_eraseTop {s : CompositionSeries X} (h : 0 < s.length) :
    s = snoc (eraseTop s) s.top (isMaximal_eraseTop_top h) := by
  ext x
  simp [mem_snoc, mem_eraseTop h]
  by_cases h : x = s.top <;> simp [*, s.top_mem]
#align composition_series.eq_snoc_erase_top CompositionSeries.eq_snoc_eraseTop

@[simp]
theorem snoc_eraseTop_top {s : CompositionSeries X} (h : IsMaximal s.eraseTop.top s.top) :
    s.eraseTop.snoc s.top h = s :=
  have h : 0 < s.length :=
    Nat.pos_of_ne_zero
      (by
        intro hs
        refine' ne_of_gt (lt_of_isMaximal h) _
        simp [top, Fin.ext_iff, hs])
  (eq_snoc_eraseTop h).symm
#align composition_series.snoc_erase_top_top CompositionSeries.snoc_eraseTop_top

/-- Two `CompositionSeries X`, `s₁` and `s₂` are equivalent if there is a bijection
`e : Fin s₁.length ≃ Fin s₂.length` such that for any `i`,
`Iso (s₁ i) (s₁ i.succ) (s₂ (e i), s₂ (e i.succ))` -/
def Equivalent (s₁ s₂ : CompositionSeries X) : Prop :=
  ∃ f : Fin s₁.length ≃ Fin s₂.length,
    ∀ i : Fin s₁.length, Iso (s₁ (Fin.castSucc i), s₁ i.succ)
      (s₂ (Fin.castSucc (f i)), s₂ (Fin.succ (f i)))
#align composition_series.equivalent CompositionSeries.Equivalent

namespace Equivalent

@[refl]
theorem refl (s : CompositionSeries X) : Equivalent s s :=
  ⟨Equiv.refl _, fun _ => (s.step _).iso_refl⟩
#align composition_series.equivalent.refl CompositionSeries.Equivalent.refl

@[symm]
theorem symm {s₁ s₂ : CompositionSeries X} (h : Equivalent s₁ s₂) : Equivalent s₂ s₁ :=
  ⟨h.choose.symm, fun i => iso_symm (by simpa using h.choose_spec (h.choose.symm i))⟩
#align composition_series.equivalent.symm CompositionSeries.Equivalent.symm

@[trans]
theorem trans {s₁ s₂ s₃ : CompositionSeries X} (h₁ : Equivalent s₁ s₂) (h₂ : Equivalent s₂ s₃) :
    Equivalent s₁ s₃ :=
  ⟨h₁.choose.trans h₂.choose,
    fun i => iso_trans (h₁.choose_spec i) (h₂.choose_spec (h₁.choose i))⟩
#align composition_series.equivalent.trans CompositionSeries.Equivalent.trans

theorem append {s₁ s₂ t₁ t₂ : CompositionSeries X} (hs : s₁.top = s₂.bot) (ht : t₁.top = t₂.bot)
    (h₁ : Equivalent s₁ t₁) (h₂ : Equivalent s₂ t₂) :
    Equivalent (append s₁ s₂ hs) (append t₁ t₂ ht) :=
  let e : Fin (s₁.length + s₂.length) ≃ Fin (t₁.length + t₂.length) :=
    calc
      Fin (s₁.length + s₂.length) ≃ Sum (Fin s₁.length) (Fin s₂.length) := finSumFinEquiv.symm
      _ ≃ Sum (Fin t₁.length) (Fin t₂.length) := (Equiv.sumCongr h₁.choose h₂.choose)
      _ ≃ Fin (t₁.length + t₂.length) := finSumFinEquiv

  ⟨e, by
    intro i
    refine' Fin.addCases _ _ i
    · intro i
      simpa [top, bot] using h₁.choose_spec i
    · intro i
      simpa [top, bot] using h₂.choose_spec i⟩
#align composition_series.equivalent.append CompositionSeries.Equivalent.append

protected theorem snoc {s₁ s₂ : CompositionSeries X} {x₁ x₂ : X} {hsat₁ : IsMaximal s₁.top x₁}
    {hsat₂ : IsMaximal s₂.top x₂} (hequiv : Equivalent s₁ s₂)
    (htop : Iso (s₁.top, x₁) (s₂.top, x₂)) : Equivalent (s₁.snoc x₁ hsat₁) (s₂.snoc x₂ hsat₂) :=
  let e : Fin s₁.length.succ ≃ Fin s₂.length.succ :=
    calc
      Fin (s₁.length + 1) ≃ Option (Fin s₁.length) := finSuccEquivLast
      _ ≃ Option (Fin s₂.length) := (Functor.mapEquiv Option hequiv.choose)
      _ ≃ Fin (s₂.length + 1) := finSuccEquivLast.symm

  ⟨e, fun i => by
    refine' Fin.lastCases _ _ i
    · simpa [top] using htop
    · intro i
      simpa [Fin.succ_castSucc] using hequiv.choose_spec i⟩
#align composition_series.equivalent.snoc CompositionSeries.Equivalent.snoc

theorem length_eq {s₁ s₂ : CompositionSeries X} (h : Equivalent s₁ s₂) : s₁.length = s₂.length := by
  simpa using Fintype.card_congr h.choose
#align composition_series.equivalent.length_eq CompositionSeries.Equivalent.length_eq

theorem snoc_snoc_swap {s : CompositionSeries X} {x₁ x₂ y₁ y₂ : X} {hsat₁ : IsMaximal s.top x₁}
    {hsat₂ : IsMaximal s.top x₂} {hsaty₁ : IsMaximal (snoc s x₁ hsat₁).top y₁}
    {hsaty₂ : IsMaximal (snoc s x₂ hsat₂).top y₂} (hr₁ : Iso (s.top, x₁) (x₂, y₂))
    (hr₂ : Iso (x₁, y₁) (s.top, x₂)) :
    Equivalent (snoc (snoc s x₁ hsat₁) y₁ hsaty₁) (snoc (snoc s x₂ hsat₂) y₂ hsaty₂) :=
  let e : Fin (s.length + 1 + 1) ≃ Fin (s.length + 1 + 1) :=
    Equiv.swap (Fin.last _) (Fin.castSucc (Fin.last _))
  have h1 : ∀ {i : Fin s.length},
      (Fin.castSucc (Fin.castSucc i)) ≠ (Fin.castSucc (Fin.last _)) := fun {_} =>
    ne_of_lt (by simp [Fin.castSucc_lt_last])
  have h2 : ∀ {i : Fin s.length},
      (Fin.castSucc (Fin.castSucc i)) ≠ Fin.last _ := fun {_} =>
    ne_of_lt (by simp [Fin.castSucc_lt_last])
  ⟨e, by
    intro i
    dsimp only []
    refine' Fin.lastCases _ (fun i => _) i
    · erw [Equiv.swap_apply_left, snoc_castSucc, snoc_last, Fin.succ_last, snoc_last,
        snoc_castSucc, snoc_castSucc, Fin.succ_castSucc, snoc_castSucc, Fin.succ_last, snoc_last]
      exact hr₂
    · refine' Fin.lastCases _ (fun i => _) i
      · erw [Equiv.swap_apply_right, snoc_castSucc, snoc_castSucc, snoc_castSucc,
          Fin.succ_castSucc, snoc_castSucc, Fin.succ_last, snoc_last, snoc_last, Fin.succ_last,
          snoc_last]
        exact hr₁
      · erw [Equiv.swap_apply_of_ne_of_ne h2 h1, snoc_castSucc, snoc_castSucc, snoc_castSucc,
          snoc_castSucc, Fin.succ_castSucc, snoc_castSucc, Fin.succ_castSucc, snoc_castSucc,
          snoc_castSucc, snoc_castSucc]
        exact (s.step i).iso_refl⟩
#align composition_series.equivalent.snoc_snoc_swap CompositionSeries.Equivalent.snoc_snoc_swap

end Equivalent

theorem length_eq_zero_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero {s₁ s₂ : CompositionSeries X}
    (hb : s₁.bot = s₂.bot) (ht : s₁.top = s₂.top) (hs₁ : s₁.length = 0) : s₂.length = 0 := by
  have : s₁.bot = s₁.top := congr_arg s₁ (Fin.ext (by simp [hs₁]))
  have : Fin.last s₂.length = (0 : Fin s₂.length.succ) :=
    s₂.injective (hb.symm.trans (this.trans ht)).symm
  -- Porting note: Was `simpa [Fin.ext_iff]`.
  rw [Fin.ext_iff] at this
  simpa
#align composition_series.length_eq_zero_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero CompositionSeries.length_eq_zero_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero

theorem length_pos_of_bot_eq_bot_of_top_eq_top_of_length_pos {s₁ s₂ : CompositionSeries X}
    (hb : s₁.bot = s₂.bot) (ht : s₁.top = s₂.top) : 0 < s₁.length → 0 < s₂.length :=
  not_imp_not.1
    (by
      simp only [pos_iff_ne_zero, Ne.def, not_iff_not, Classical.not_not]
      exact length_eq_zero_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero hb.symm ht.symm)
#align composition_series.length_pos_of_bot_eq_bot_of_top_eq_top_of_length_pos CompositionSeries.length_pos_of_bot_eq_bot_of_top_eq_top_of_length_pos

theorem eq_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero {s₁ s₂ : CompositionSeries X}
    (hb : s₁.bot = s₂.bot) (ht : s₁.top = s₂.top) (hs₁0 : s₁.length = 0) : s₁ = s₂ := by
  have : ∀ x, x ∈ s₁ ↔ x = s₁.top := fun x =>
    ⟨fun hx => forall_mem_eq_of_length_eq_zero hs₁0 hx s₁.top_mem, fun hx => hx.symm ▸ s₁.top_mem⟩
  have : ∀ x, x ∈ s₂ ↔ x = s₂.top := fun x =>
    ⟨fun hx =>
      forall_mem_eq_of_length_eq_zero
        (length_eq_zero_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero hb ht hs₁0) hx s₂.top_mem,
      fun hx => hx.symm ▸ s₂.top_mem⟩
  ext
  simp [*]
#align composition_series.eq_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero CompositionSeries.eq_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero

/-- Given a `CompositionSeries`, `s`, and an element `x`
such that `x` is maximal inside `s.top` there is a series, `t`,
such that `t.top = x`, `t.bot = s.bot`
and `snoc t s.top _` is equivalent to `s`. -/
theorem exists_top_eq_snoc_equivalant (s : CompositionSeries X) (x : X) (hm : IsMaximal x s.top)
    (hb : s.bot ≤ x) :
    ∃ t : CompositionSeries X,
      t.bot = s.bot ∧ t.length + 1 = s.length ∧
      ∃ htx : t.top = x, Equivalent s (snoc t s.top (htx.symm ▸ hm)) := by
  induction' hn : s.length with n ih generalizing s x
  · exact
      (ne_of_gt (lt_of_le_of_lt hb (lt_of_isMaximal hm))
          (forall_mem_eq_of_length_eq_zero hn s.top_mem s.bot_mem)).elim
  · have h0s : 0 < s.length := hn.symm ▸ Nat.succ_pos _
    by_cases hetx : s.eraseTop.top = x
    · use s.eraseTop
      simp [← hetx, hn]
      -- Porting note: `rfl` is required.
      rfl
    · have imxs : IsMaximal (x ⊓ s.eraseTop.top) s.eraseTop.top :=
        isMaximal_of_eq_inf x s.top rfl (Ne.symm hetx) hm (isMaximal_eraseTop_top h0s)
      have := ih _ _ imxs (le_inf (by simpa) (le_top_of_mem s.eraseTop.bot_mem)) (by simp [hn])
      rcases this with ⟨t, htb, htl, htt, hteqv⟩
      have hmtx : IsMaximal t.top x :=
        isMaximal_of_eq_inf s.eraseTop.top s.top (by rw [inf_comm, htt]) hetx
          (isMaximal_eraseTop_top h0s) hm
      use snoc t x hmtx
      refine' ⟨by simp [htb], by simp [htl], by simp, _⟩
      have :
        s.Equivalent
          ((snoc t s.eraseTop.top (htt.symm ▸ imxs)).snoc s.top
            (by simpa using isMaximal_eraseTop_top h0s)) :=
        by
        conv_lhs => rw [eq_snoc_eraseTop h0s]
        exact Equivalent.snoc hteqv (by simpa using (isMaximal_eraseTop_top h0s).iso_refl)
      refine' this.trans _
      refine' Equivalent.snoc_snoc_swap _ _
      · exact
          iso_symm
            (second_iso_of_eq hm
              (sup_eq_of_isMaximal hm (isMaximal_eraseTop_top h0s) (Ne.symm hetx)) htt.symm)
      · exact
          second_iso_of_eq (isMaximal_eraseTop_top h0s)
            (sup_eq_of_isMaximal (isMaximal_eraseTop_top h0s) hm hetx) (by rw [inf_comm, htt])
#align composition_series.exists_top_eq_snoc_equivalant CompositionSeries.exists_top_eq_snoc_equivalant

/-- The **Jordan-Hölder** theorem, stated for any `JordanHolderLattice`.
If two composition series start and finish at the same place, they are equivalent. -/
theorem jordan_holder (s₁ s₂ : CompositionSeries X) (hb : s₁.bot = s₂.bot) (ht : s₁.top = s₂.top) :
    Equivalent s₁ s₂ := by
  induction' hle : s₁.length with n ih generalizing s₁ s₂
  · rw [eq_of_bot_eq_bot_of_top_eq_top_of_length_eq_zero hb ht hle]
  · have h0s₂ : 0 < s₂.length :=
      length_pos_of_bot_eq_bot_of_top_eq_top_of_length_pos hb ht (hle.symm ▸ Nat.succ_pos _)
    rcases exists_top_eq_snoc_equivalant s₁ s₂.eraseTop.top
        (ht.symm ▸ isMaximal_eraseTop_top h0s₂)
        (hb.symm ▸ s₂.bot_eraseTop ▸ bot_le_of_mem (top_mem _)) with
      ⟨t, htb, htl, htt, hteq⟩
    have := ih t s₂.eraseTop (by simp [htb, ← hb]) htt (Nat.succ_inj'.1 (htl.trans hle))
    refine' hteq.trans _
    conv_rhs => rw [eq_snoc_eraseTop h0s₂]
    simp only [ht]
    exact Equivalent.snoc this (by simp [htt, (isMaximal_eraseTop_top h0s₂).iso_refl])
#align composition_series.jordan_holder CompositionSeries.jordan_holder

end CompositionSeries


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Mario Carneiro, Yury Kudryashov, Heather Macbeth
-/
import analysis.normed_space.basic
import topology.continuous_function.algebra

/-!
# Bounded continuous functions

The type of bounded continuous functions taking values in a metric space, with
the uniform distance.

-/

noncomputable theory
open_locale topological_space classical nnreal

open set filter metric

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

/-- The type of bounded continuous functions from a topological space to a metric space -/
structure bounded_continuous_function
  (α : Type u) (β : Type v) [topological_space α] [metric_space β] extends continuous_map α β :
  Type (max u v) :=
(bounded' : ∃C, ∀x y:α, dist (to_fun x) (to_fun y) ≤ C)

localized "infixr ` →ᵇ `:25 := bounded_continuous_function" in bounded_continuous_function

namespace bounded_continuous_function
section basics
variables [topological_space α] [metric_space β] [metric_space γ]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance : has_coe_to_fun (α →ᵇ β) :=  ⟨_, λ f, f.to_fun⟩

protected lemma bounded (f : α →ᵇ β) : ∃C, ∀ x y : α, dist (f x) (f y) ≤ C := f.bounded'
@[continuity]
protected lemma continuous (f : α →ᵇ β) : continuous f := f.to_continuous_map.continuous

@[ext] lemma ext (H : ∀x, f x = g x) : f = g :=
by { cases f, cases g, congr, ext, exact H x, }

lemma ext_iff : f = g ↔ ∀ x, f x = g x :=
⟨λ h, λ x, h ▸ rfl, ext⟩

lemma bounded_range : bounded (range f) :=
bounded_range_iff.2 f.bounded

/-- A continuous function with an explicit bound is a bounded continuous function. -/
def mk_of_bound (f : C(α, β)) (C : ℝ) (h : ∀ x y : α, dist (f x) (f y) ≤ C) : α →ᵇ β :=
⟨f, ⟨C, h⟩⟩

@[simp] lemma mk_of_bound_coe {f} {C} {h} : (mk_of_bound f C h : α → β) = (f : α → β) :=
rfl

/-- A continuous function on a compact space is automatically a bounded continuous function. -/
def mk_of_compact [compact_space α] (f : C(α, β)) : α →ᵇ β :=
⟨f, bounded_range_iff.1 $ bounded_of_compact $ compact_range f.continuous⟩

@[simp] lemma mk_of_compact_apply [compact_space α] (f : C(α, β)) (a : α) :
  mk_of_compact f a = f a :=
rfl

/-- If a function is bounded on a discrete space, it is automatically continuous,
and therefore gives rise to an element of the type of bounded continuous functions -/
def mk_of_discrete [discrete_topology α] (f : α → β)
  (C : ℝ) (h :  ∀ x y : α, dist (f x) (f y) ≤ C) : α →ᵇ β :=
⟨⟨f, continuous_of_discrete_topology⟩, ⟨C, h⟩⟩

@[simp] lemma mk_of_discrete_apply
  [discrete_topology α] (f : α → β) (C) (h) (a : α) :
  mk_of_discrete f C h a = f a :=
rfl

section
variables (α β)
/--
The map forgetting that a bounded continuous function is bounded.
-/
def forget_boundedness : (α →ᵇ β) → C(α, β) :=
λ f, f.1

@[simp] lemma forget_boundedness_coe (f : α →ᵇ β) : (forget_boundedness α β f : α → β) = f :=
rfl

end

/-- The uniform distance between two bounded continuous functions -/
instance : has_dist (α →ᵇ β) :=
⟨λf g, Inf {C | 0 ≤ C ∧ ∀ x : α, dist (f x) (g x) ≤ C}⟩

lemma dist_eq : dist f g = Inf {C | 0 ≤ C ∧ ∀ x : α, dist (f x) (g x) ≤ C} := rfl

lemma dist_set_exists : ∃ C, 0 ≤ C ∧ ∀ x : α, dist (f x) (g x) ≤ C :=
begin
  refine if h : nonempty α then _ else ⟨0, le_refl _, λ x, h.elim ⟨x⟩⟩,
  cases h with x,
  rcases f.bounded with ⟨Cf, hCf : ∀ x y, dist (f x) (f y) ≤ Cf⟩,
  rcases g.bounded with ⟨Cg, hCg : ∀ x y, dist (g x) (g y) ≤ Cg⟩,
  let C := max 0 (dist (f x) (g x) + (Cf + Cg)),
  refine ⟨C, le_max_left _ _, λ y, _⟩,
  calc dist (f y) (g y) ≤ dist (f x) (g x) + (dist (f x) (f y) + dist (g x) (g y)) :
    dist_triangle4_left _ _ _ _
                    ... ≤ dist (f x) (g x) + (Cf + Cg) : by mono*
                    ... ≤ C : le_max_right _ _
end

/-- The pointwise distance is controlled by the distance between functions, by definition. -/
lemma dist_coe_le_dist (x : α) : dist (f x) (g x) ≤ dist f g :=
le_cInf dist_set_exists $ λb hb, hb.2 x

/- This lemma will be needed in the proof of the metric space instance, but it will become
useless afterwards as it will be superseded by the general result that the distance is nonnegative
in metric spaces. -/
private lemma dist_nonneg' : 0 ≤ dist f g :=
le_cInf dist_set_exists (λ C, and.left)

/-- 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 :=
⟨λ h x, le_trans (dist_coe_le_dist x) h, λ H, cInf_le ⟨0, λ C, and.left⟩ ⟨C0, H⟩⟩

lemma dist_le_iff_of_nonempty [nonempty α] :
  dist f g ≤ C ↔ ∀ x, dist (f x) (g x) ≤ C :=
⟨λ h x, le_trans (dist_coe_le_dist x) h,
 λ w, (dist_le (le_trans dist_nonneg (w (nonempty.some ‹_›)))).mpr w⟩

lemma dist_lt_of_nonempty_compact [nonempty α] [compact_space α]
  (w : ∀x:α, dist (f x) (g x) < C) : dist f g < C :=
begin
  have c : continuous (λ x, dist (f x) (g x)), { continuity, },
  obtain ⟨x, -, le⟩ :=
    is_compact.exists_forall_ge compact_univ set.univ_nonempty (continuous.continuous_on c),
  exact lt_of_le_of_lt (dist_le_iff_of_nonempty.mpr (λ y, le y trivial)) (w x),
end

lemma dist_lt_iff_of_compact [compact_space α] (C0 : (0 : ℝ) < C) :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
begin
  fsplit,
  { intros w x,
    exact lt_of_le_of_lt (dist_coe_le_dist x) w, },
  { by_cases h : nonempty α,
    { resetI,
      exact dist_lt_of_nonempty_compact, },
    { rintro -,
      convert C0,
      apply le_antisymm _ dist_nonneg',
      rw [dist_eq],
      exact cInf_le ⟨0, λ C, and.left⟩ ⟨le_refl _, λ x, false.elim (h (nonempty.intro x))⟩, }, },
end

lemma dist_lt_iff_of_nonempty_compact [nonempty α] [compact_space α] :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
⟨λ w x, lt_of_le_of_lt (dist_coe_le_dist x) w, dist_lt_of_nonempty_compact⟩

/-- On an empty space, bounded continuous functions are at distance 0 -/
lemma dist_zero_of_empty (e : ¬ nonempty α) : dist f g = 0 :=
le_antisymm ((dist_le (le_refl _)).2 $ λ x, e.elim ⟨x⟩) dist_nonneg'

/-- The type of bounded continuous functions, with the uniform distance, is a metric space. -/
instance : metric_space (α →ᵇ β) :=
{ dist_self := λ f, le_antisymm ((dist_le (le_refl _)).2 $ λ x, by simp) dist_nonneg',
  eq_of_dist_eq_zero := λ f g hfg, by ext x; exact
    eq_of_dist_eq_zero (le_antisymm (hfg ▸ dist_coe_le_dist _) dist_nonneg),
  dist_comm := λ f g, by simp [dist_eq, dist_comm],
  dist_triangle := λ f g h,
    (dist_le (add_nonneg dist_nonneg' dist_nonneg')).2 $ λ x,
      le_trans (dist_triangle _ _ _) (add_le_add (dist_coe_le_dist _) (dist_coe_le_dist _)) }

variables (α) {β}

/-- Constant as a continuous bounded function. -/
def const (b : β) : α →ᵇ β := ⟨continuous_map.const b, 0, by simp [le_refl]⟩

variable {α}

@[simp] lemma coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
lemma const_apply (a : α) (b : β) : (const α b : α → β) a = b := rfl

/-- If the target space is inhabited, so is the space of bounded continuous functions -/
instance [inhabited β] : inhabited (α →ᵇ β) := ⟨const α (default β)⟩

/-- The evaluation map is continuous, as a joint function of `u` and `x` -/
theorem continuous_eval : continuous (λ p : (α →ᵇ β) × α, p.1 p.2) :=
continuous_iff'.2 $ λ ⟨f, x⟩ ε ε0,
/- use the continuity of `f` to find a neighborhood of `x` where it varies at most by ε/2 -/
have Hs : _ := continuous_iff'.1 f.continuous x (ε/2) (half_pos ε0),
mem_sets_of_superset (prod_mem_nhds_sets (ball_mem_nhds _ (half_pos ε0)) Hs) $
λ ⟨g, y⟩ ⟨hg, hy⟩, calc dist (g y) (f x)
      ≤ dist (g y) (f y) + dist (f y) (f x) : dist_triangle _ _ _
  ... < ε/2 + ε/2 : add_lt_add (lt_of_le_of_lt (dist_coe_le_dist _) hg) hy
  ... = ε : add_halves _

/-- In particular, when `x` is fixed, `f → f x` is continuous -/
theorem continuous_evalx {x : α} : continuous (λ f : α →ᵇ β, f x) :=
continuous_eval.comp (continuous_id.prod_mk continuous_const)

/-- Bounded continuous functions taking values in a complete space form a complete space. -/
instance [complete_space β] : complete_space (α →ᵇ β) :=
complete_of_cauchy_seq_tendsto $ λ (f : ℕ → α →ᵇ β) (hf : cauchy_seq f),
begin
  /- We have to show that `f n` converges to a bounded continuous function.
  For this, we prove pointwise convergence to define the limit, then check
  it is a continuous bounded function, and then check the norm convergence. -/
  rcases cauchy_seq_iff_le_tendsto_0.1 hf with ⟨b, b0, b_bound, b_lim⟩,
  have f_bdd := λx n m N hn hm, le_trans (dist_coe_le_dist x) (b_bound n m N hn hm),
  have fx_cau : ∀x, cauchy_seq (λn, f n x) :=
    λx, cauchy_seq_iff_le_tendsto_0.2 ⟨b, b0, f_bdd x, b_lim⟩,
  choose F hF using λx, cauchy_seq_tendsto_of_complete (fx_cau x),
  /- F : α → β,  hF : ∀ (x : α), tendsto (λ (n : ℕ), f n x) at_top (𝓝 (F x))
  `F` is the desired limit function. Check that it is uniformly approximated by `f N` -/
  have fF_bdd : ∀x N, dist (f N x) (F x) ≤ b N :=
    λ x N, le_of_tendsto (tendsto_const_nhds.dist (hF x))
      (filter.eventually_at_top.2 ⟨N, λn hn, f_bdd x N n N (le_refl N) hn⟩),
  refine ⟨⟨⟨F, _⟩, _⟩, _⟩,
  { /- Check that `F` is continuous, as a uniform limit of continuous functions -/
    have : tendsto_uniformly (λn x, f n x) F at_top,
    { refine metric.tendsto_uniformly_iff.2 (λ ε ε0, _),
      refine ((tendsto_order.1 b_lim).2 ε ε0).mono (λ n hn x, _),
      rw dist_comm,
      exact lt_of_le_of_lt (fF_bdd x n) hn },
    exact this.continuous (λN, (f N).continuous) },
  { /- Check that `F` is bounded -/
    rcases (f 0).bounded with ⟨C, hC⟩,
    refine ⟨C + (b 0 + b 0), λ x y, _⟩,
    calc dist (F x) (F y) ≤ dist (f 0 x) (f 0 y) + (dist (f 0 x) (F x) + dist (f 0 y) (F y)) :
      dist_triangle4_left _ _ _ _
                      ... ≤ C + (b 0 + b 0) : by mono* },
  { /- Check that `F` is close to `f N` in distance terms -/
    refine tendsto_iff_dist_tendsto_zero.2 (squeeze_zero (λ _, dist_nonneg) _ b_lim),
    exact λ N, (dist_le (b0 _)).2 (λx, fF_bdd x N) }
end

/-- Composition (in the target) of a bounded continuous function with a Lipschitz map again
gives a bounded continuous function -/
def comp (G : β → γ) {C : ℝ≥0} (H : lipschitz_with C G)
  (f : α →ᵇ β) : α →ᵇ γ :=
⟨⟨λx, G (f x), H.continuous.comp f.continuous⟩,
  let ⟨D, hD⟩ := f.bounded in
  ⟨max C 0 * D, λ x y, calc
    dist (G (f x)) (G (f y)) ≤ C * dist (f x) (f y) : H.dist_le_mul _ _
    ... ≤ max C 0 * dist (f x) (f y) : mul_le_mul_of_nonneg_right (le_max_left C 0) dist_nonneg
    ... ≤ max C 0 * D : mul_le_mul_of_nonneg_left (hD _ _) (le_max_right C 0)⟩⟩

/-- The composition operator (in the target) with a Lipschitz map is Lipschitz -/
lemma lipschitz_comp {G : β → γ} {C : ℝ≥0} (H : lipschitz_with C G) :
  lipschitz_with C (comp G H : (α →ᵇ β) → α →ᵇ γ) :=
lipschitz_with.of_dist_le_mul $ λ f g,
(dist_le (mul_nonneg C.2 dist_nonneg)).2 $ λ x,
calc dist (G (f x)) (G (g x)) ≤ C * dist (f x) (g x) : H.dist_le_mul _ _
  ... ≤ C * dist f g : mul_le_mul_of_nonneg_left (dist_coe_le_dist _) C.2

/-- The composition operator (in the target) with a Lipschitz map is uniformly continuous -/
lemma uniform_continuous_comp {G : β → γ} {C : ℝ≥0} (H : lipschitz_with C G) :
  uniform_continuous (comp G H : (α →ᵇ β) → α →ᵇ γ) :=
(lipschitz_comp H).uniform_continuous

/-- The composition operator (in the target) with a Lipschitz map is continuous -/
lemma continuous_comp {G : β → γ} {C : ℝ≥0} (H : lipschitz_with C G) :
  continuous (comp G H : (α →ᵇ β) → α →ᵇ γ) :=
(lipschitz_comp H).continuous

/-- Restriction (in the target) of a bounded continuous function taking values in a subset -/
def cod_restrict (s : set β) (f : α →ᵇ β) (H : ∀x, f x ∈ s) : α →ᵇ s :=
⟨⟨s.cod_restrict f H, continuous_subtype_mk _ f.continuous⟩, f.bounded⟩

end basics

section arzela_ascoli
variables [topological_space α] [compact_space α] [metric_space β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

/- Arzela-Ascoli theorem asserts that, on a compact space, a set of functions sharing
a common modulus of continuity and taking values in a compact set forms a compact
subset for the topology of uniform convergence. In this section, we prove this theorem
and several useful variations around it. -/

/-- First version, with pointwise equicontinuity and range in a compact space -/
theorem arzela_ascoli₁ [compact_space β]
  (A : set (α →ᵇ β))
  (closed : is_closed A)
  (H : ∀ (x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  is_compact A :=
begin
  refine compact_of_totally_bounded_is_closed _ closed,
  refine totally_bounded_of_finite_discretization (λ ε ε0, _),
  rcases exists_between ε0 with ⟨ε₁, ε₁0, εε₁⟩,
  let ε₂ := ε₁/2/2,
  /- We have to find a finite discretization of `u`, i.e., finite information
  that is sufficient to reconstruct `u` up to ε. This information will be
  provided by the values of `u` on a sufficiently dense set tα,
  slightly translated to fit in a finite ε₂-dense set tβ in the image. Such
  sets exist by compactness of the source and range. Then, to check that these
  data determine the function up to ε, one uses the control on the modulus of
  continuity to extend the closeness on tα to closeness everywhere. -/
  have ε₂0 : ε₂ > 0 := half_pos (half_pos ε₁0),
  have : ∀x:α, ∃U, x ∈ U ∧ is_open U ∧ ∀ (y z ∈ U) {f : α →ᵇ β},
    f ∈ A → dist (f y) (f z) < ε₂ := λ x,
      let ⟨U, nhdsU, hU⟩ := H x _ ε₂0,
          ⟨V, VU, openV, xV⟩ := mem_nhds_sets_iff.1 nhdsU in
      ⟨V, xV, openV, λy z hy hz f hf, hU y z (VU hy) (VU hz) f hf⟩,
  choose U hU using this,
  /- For all x, the set hU x is an open set containing x on which the elements of A
  fluctuate by at most ε₂.
  We extract finitely many of these sets that cover the whole space, by compactness -/
  rcases compact_univ.elim_finite_subcover_image
    (λx _, (hU x).2.1) (λx hx, mem_bUnion (mem_univ _) (hU x).1)
    with ⟨tα, _, ⟨_⟩, htα⟩,
  /- tα : set α, htα : univ ⊆ ⋃x ∈ tα, U x -/
  rcases @finite_cover_balls_of_compact β _ _ compact_univ _ ε₂0
    with ⟨tβ, _, ⟨_⟩, htβ⟩, resetI,
  /- tβ : set β, htβ : univ ⊆ ⋃y ∈ tβ, ball y ε₂ -/
  /- Associate to every point `y` in the space a nearby point `F y` in tβ -/
  choose F hF using λy, show ∃z∈tβ, dist y z < ε₂, by simpa using htβ (mem_univ y),
  /- F : β → β, hF : ∀ (y : β), F y ∈ tβ ∧ dist y (F y) < ε₂ -/

  /- Associate to every function a discrete approximation, mapping each point in `tα`
  to a point in `tβ` close to its true image by the function. -/
  refine ⟨tα → tβ, by apply_instance, λ f a, ⟨F (f a), (hF (f a)).1⟩, _⟩,
  rintro ⟨f, hf⟩ ⟨g, hg⟩ f_eq_g,
  /- If two functions have the same approximation, then they are within distance ε -/
  refine lt_of_le_of_lt ((dist_le $ le_of_lt ε₁0).2 (λ x, _)) εε₁,
  obtain ⟨x', x'tα, hx'⟩ : ∃x' ∈ tα, x ∈ U x' := mem_bUnion_iff.1 (htα (mem_univ x)),
  refine calc dist (f x) (g x)
      ≤ dist (f x) (f x') + dist (g x) (g x') + dist (f x') (g x') : dist_triangle4_right _ _ _ _
  ... ≤ ε₂ + ε₂ + ε₁/2 : le_of_lt (add_lt_add (add_lt_add _ _) _)
  ... = ε₁ : by rw [add_halves, add_halves],
  { exact (hU x').2.2 _ _ hx' ((hU x').1) hf },
  { exact (hU x').2.2 _ _ hx' ((hU x').1) hg },
  { have F_f_g : F (f x') = F (g x') :=
      (congr_arg (λ f:tα → tβ, (f ⟨x', x'tα⟩ : β)) f_eq_g : _),
    calc dist (f x') (g x')
          ≤ dist (f x') (F (f x')) + dist (g x') (F (f x')) : dist_triangle_right _ _ _
      ... = dist (f x') (F (f x')) + dist (g x') (F (g x')) : by rw F_f_g
      ... < ε₂ + ε₂ : add_lt_add (hF (f x')).2 (hF (g x')).2
      ... = ε₁/2 : add_halves _ }
end

/-- Second version, with pointwise equicontinuity and range in a compact subset -/
theorem arzela_ascoli₂
  (s : set β) (hs : is_compact s)
  (A : set (α →ᵇ β))
  (closed : is_closed A)
  (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  is_compact A :=
/- This version is deduced from the previous one by restricting to the compact type in the target,
using compactness there and then lifting everything to the original space. -/
begin
  have M : lipschitz_with 1 coe := lipschitz_with.subtype_coe s,
  let F : (α →ᵇ s) → α →ᵇ β := comp coe M,
  refine compact_of_is_closed_subset
    ((_ : is_compact (F ⁻¹' A)).image (continuous_comp M)) closed (λ f hf, _),
  { haveI : compact_space s := compact_iff_compact_space.1 hs,
    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed)
      (λ x ε ε0, bex.imp_right (λ U U_nhds hU y z hy hz f hf, _) (H x ε ε0)),
    calc dist (f y) (f z) = dist (F f y) (F f z) : rfl
                        ... < ε : hU y z hy hz (F f) hf },
  { let g := cod_restrict s f (λx, in_s f x hf),
    rw [show f = F g, by ext; refl] at hf ⊢,
    exact ⟨g, hf, rfl⟩ }
end

/-- Third (main) version, with pointwise equicontinuity and range in a compact subset, but
without closedness. The closure is then compact -/
theorem arzela_ascoli
  (s : set β) (hs : is_compact s)
  (A : set (α →ᵇ β))
  (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  is_compact (closure A) :=
/- This version is deduced from the previous one by checking that the closure of A, in
addition to being closed, still satisfies the properties of compact range and equicontinuity -/
arzela_ascoli₂ s hs (closure A) is_closed_closure
  (λ f x hf, (mem_of_closed' hs.is_closed).2 $ λ ε ε0,
    let ⟨g, gA, dist_fg⟩ := metric.mem_closure_iff.1 hf ε ε0 in
    ⟨g x, in_s g x gA, lt_of_le_of_lt (dist_coe_le_dist _) dist_fg⟩)
  (λ x ε ε0, show ∃ U ∈ 𝓝 x,
      ∀ y z ∈ U, ∀ (f : α →ᵇ β), f ∈ closure A → dist (f y) (f z) < ε,
    begin
      refine bex.imp_right (λ U U_set hU y z hy hz f hf, _) (H x (ε/2) (half_pos ε0)),
      rcases metric.mem_closure_iff.1 hf (ε/2/2) (half_pos (half_pos ε0)) with ⟨g, gA, dist_fg⟩,
      replace dist_fg := λ x, lt_of_le_of_lt (dist_coe_le_dist x) dist_fg,
      calc dist (f y) (f z) ≤ dist (f y) (g y) + dist (f z) (g z) + dist (g y) (g z) :
        dist_triangle4_right _ _ _ _
          ... < ε/2/2 + ε/2/2 + ε/2 :
            add_lt_add (add_lt_add (dist_fg y) (dist_fg z)) (hU y z hy hz g gA)
          ... = ε : by rw [add_halves, add_halves]
    end)

/- To apply the previous theorems, one needs to check the equicontinuity. An important
instance is when the source space is a metric space, and there is a fixed modulus of continuity
for all the functions in the set A -/

lemma equicontinuous_of_continuity_modulus {α : Type u} [metric_space α]
  (b : ℝ → ℝ) (b_lim : tendsto b (𝓝 0) (𝓝 0))
  (A : set (α →ᵇ β))
  (H : ∀(x y:α) (f : α →ᵇ β), f ∈ A → dist (f x) (f y) ≤ b (dist x y))
  (x:α) (ε : ℝ) (ε0 : 0 < ε) : ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε :=
begin
  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
  refine ⟨ball x (δ/2), ball_mem_nhds x (half_pos δ0), λ y z hy hz f hf, _⟩,
  have : dist y z < δ := calc
    dist y z ≤ dist y x + dist z x : dist_triangle_right _ _ _
    ... < δ/2 + δ/2 : add_lt_add hy hz
    ... = δ : add_halves _,
  calc
    dist (f y) (f z) ≤ b (dist y z) : H y z f hf
    ... ≤ abs (b (dist y z)) : le_abs_self _
    ... = dist (b (dist y z)) 0 : by simp [real.dist_eq]
    ... < ε : hδ (by simpa [real.dist_eq] using this),
end

end arzela_ascoli

section normed_group
/- In this section, if β is a normed group, then we show that the space of bounded
continuous functions from α to β inherits a normed group structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables [topological_space α] [normed_group β]
variables (f g : α →ᵇ β) {x : α} {C : ℝ}

instance : has_zero (α →ᵇ β) := ⟨const α 0⟩

@[simp] lemma coe_zero : ((0 : α →ᵇ β) : α → β) = 0 := rfl

instance : has_norm (α →ᵇ β) := ⟨λu, dist u 0⟩

lemma norm_def : ∥f∥ = dist f 0 := rfl

/-- The norm of a bounded continuous function is the supremum of `∥f x∥`.
We use `Inf` to ensure that the definition works if `α` has no elements. -/
lemma norm_eq (f : α →ᵇ β) :
  ∥f∥ = Inf {C : ℝ | 0 ≤ C ∧ ∀ (x : α), ∥f x∥ ≤ C} :=
by simp [norm_def, bounded_continuous_function.dist_eq]

lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ := calc
  ∥f x∥ = dist (f x) ((0 : α →ᵇ β) x) : by simp [dist_zero_right]
  ... ≤ ∥f∥ : dist_coe_le_dist _

lemma dist_le_two_norm' {f : γ → β} {C : ℝ} (hC : ∀ x, ∥f x∥ ≤ C) (x y : γ) :
  dist (f x) (f y) ≤ 2 * C :=
calc dist (f x) (f y) ≤ ∥f x∥ + ∥f y∥ : dist_le_norm_add_norm _ _
                  ... ≤ C + C         : add_le_add (hC x) (hC y)
                  ... = 2 * C         : (two_mul _).symm

/-- 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∥ :=
dist_le_two_norm' f.norm_coe_le_norm x y

variable {f}

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

lemma norm_le_of_nonempty [nonempty α]
  {f : α →ᵇ β} {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
begin
  simp_rw [norm_def, ←dist_zero_right],
  exact dist_le_iff_of_nonempty,
end

lemma norm_lt_iff_of_compact [compact_space α]
  {f : α →ᵇ β} {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
begin
  simp_rw [norm_def, ←dist_zero_right],
  exact dist_lt_iff_of_compact M0,
end

lemma norm_lt_iff_of_nonempty_compact [nonempty α] [compact_space α]
  {f : α →ᵇ β} {M : ℝ} : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
begin
  simp_rw [norm_def, ←dist_zero_right],
  exact dist_lt_iff_of_nonempty_compact,
end

variable (f)

/-- Norm of `const α b` is less than or equal to `∥b∥`. If `α` is nonempty,
then it is equal to `∥b∥`. -/
lemma norm_const_le (b : β) : ∥const α b∥ ≤ ∥b∥ :=
(norm_le (norm_nonneg b)).2 $ λ x, le_refl _

@[simp] lemma norm_const_eq [h : nonempty α] (b : β) : ∥const α b∥ = ∥b∥ :=
le_antisymm (norm_const_le b) $ h.elim $ λ x, (const α b).norm_coe_le_norm x

/-- Constructing a bounded continuous function from a uniformly bounded continuous
function taking values in a normed group. -/
def of_normed_group {α : Type u} {β : Type v} [topological_space α] [normed_group β]
  (f : α  → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) : α →ᵇ β :=
⟨⟨λn, f n, Hf⟩, ⟨_, dist_le_two_norm' H⟩⟩

lemma norm_of_normed_group_le {f : α → β} (hfc : continuous f) {C : ℝ} (hC : 0 ≤ C)
  (hfC : ∀ x, ∥f x∥ ≤ C) : ∥of_normed_group f hfc C hfC∥ ≤ C :=
(norm_le hC).2 hfC

/-- Constructing a bounded continuous function from a uniformly bounded
function on a discrete space, taking values in a normed group -/
def of_normed_group_discrete {α : Type u} {β : Type v}
  [topological_space α] [discrete_topology α] [normed_group β]
  (f : α  → β) (C : ℝ) (H : ∀x, norm (f x) ≤ C) : α →ᵇ β :=
of_normed_group f continuous_of_discrete_topology C H

/-- The pointwise sum of two bounded continuous functions is again bounded continuous. -/
instance : has_add (α →ᵇ β) :=
⟨λf g, of_normed_group (f + g) (f.continuous.add g.continuous) (∥f∥ + ∥g∥) $ λ x,
  le_trans (norm_add_le _ _) (add_le_add (f.norm_coe_le_norm x) (g.norm_coe_le_norm x))⟩

/-- The pointwise opposite of a bounded continuous function is again bounded continuous. -/
instance : has_neg (α →ᵇ β) :=
⟨λf, of_normed_group (-f) f.continuous.neg ∥f∥ $ λ x,
  trans_rel_right _ (norm_neg _) (f.norm_coe_le_norm x)⟩

/-- The pointwise difference of two bounded continuous functions is again bounded continuous. -/
instance : has_sub (α →ᵇ β) :=
⟨λf g, of_normed_group (f - g) (f.continuous.sub g.continuous) (∥f∥ + ∥g∥) $ λ x,
  by { simp only [sub_eq_add_neg],
       exact le_trans (norm_add_le _ _) (add_le_add (f.norm_coe_le_norm x) $
         trans_rel_right _ (norm_neg _) (g.norm_coe_le_norm x)) }⟩

@[simp] lemma coe_add : ⇑(f + g) = f + g := rfl
lemma add_apply : (f + g) x = f x + g x := rfl
@[simp] lemma coe_neg : ⇑(-f) = -f := rfl
lemma neg_apply : (-f) x = -f x := rfl

lemma forall_coe_zero_iff_zero : (∀x, f x = 0) ↔ f = 0 :=
(@ext_iff _ _ _ _ f 0).symm

instance : add_comm_group (α →ᵇ β) :=
{ add_assoc      := assume f g h, by ext; simp [add_assoc],
  zero_add       := assume f, by ext; simp,
  add_zero       := assume f, by ext; simp,
  add_left_neg   := assume f, by ext; simp,
  add_comm       := assume f g, by ext; simp [add_comm],
  sub_eq_add_neg := assume f g, by { ext, apply sub_eq_add_neg },
  ..bounded_continuous_function.has_add,
  ..bounded_continuous_function.has_neg,
  ..bounded_continuous_function.has_sub,
  ..bounded_continuous_function.has_zero }

@[simp] lemma coe_sub : ⇑(f - g) = f - g := rfl
lemma sub_apply : (f - g) x = f x - g x := rfl

/-- Coercion of a `normed_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn` -/
@[simps]
def coe_fn_add_hom : (α →ᵇ β) →+ (α → β) :=
{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add}

open_locale big_operators
@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → (α →ᵇ β)) :
  ⇑(∑ i in s, f i) = (∑ i in s, (f i : α → β)) :=
(@coe_fn_add_hom α β _ _).map_sum f s

lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → (α →ᵇ β)) (a : α) :
  (∑ i in s, f i) a = (∑ i in s, f i a) :=
by simp

instance : normed_group (α →ᵇ β) :=
{ dist_eq := λ f g, by simp only [norm_eq, dist_eq, dist_eq_norm, sub_apply] }

lemma abs_diff_coe_le_dist : ∥f x - g x∥ ≤ dist f g :=
by { rw dist_eq_norm, exact (f - g).norm_coe_le_norm x }

lemma coe_le_coe_add_dist {f g : α →ᵇ ℝ} : f x ≤ g x + dist f g :=
sub_le_iff_le_add'.1 $ (abs_le.1 $ @dist_coe_le_dist _ _ _ _ f g x).2

variables (α β)

/--
The additive map forgetting that a bounded continuous function is bounded.
-/
@[simps]
def forget_boundedness_add_hom : (α →ᵇ β) →+ C(α, β) :=
{ to_fun := forget_boundedness α β,
  map_zero' := by { ext, simp, },
  map_add' := by { intros, ext, simp, }, }

end normed_group

section normed_space
/-!
### Normed space structure

In this section, if `β` is a normed space, then we show that the space of bounded
continuous functions from `α` to `β` inherits a normed space structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables {𝕜 : Type*} [normed_field 𝕜]
variables [topological_space α] [normed_group β] [normed_space 𝕜 β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance : has_scalar 𝕜 (α →ᵇ β) :=
⟨λ c f, of_normed_group (c • f) (f.continuous.const_smul c) (∥c∥ * ∥f∥) $ λ x,
  trans_rel_right _ (norm_smul _ _)
    (mul_le_mul_of_nonneg_left (f.norm_coe_le_norm _) (norm_nonneg _))⟩

@[simp] lemma coe_smul (c : 𝕜) (f : α →ᵇ β) : ⇑(c • f) = λ x, c • (f x) := rfl
lemma smul_apply (c : 𝕜) (f : α →ᵇ β) (x : α) : (c • f) x = c • f x := rfl

instance : module 𝕜 (α →ᵇ β) :=
module.of_core $
{ smul     := (•),
  smul_add := λ c f g, ext $ λ x, smul_add c (f x) (g x),
  add_smul := λ c₁ c₂ f, ext $ λ x, add_smul c₁ c₂ (f x),
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul c₁ c₂ (f x),
  one_smul := λ f, ext $ λ x, one_smul 𝕜 (f x) }

instance : normed_space 𝕜 (α →ᵇ β) := ⟨λ c f, norm_of_normed_group_le _
  (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _⟩

variables (α β)

/-- The linear map forgetting that a bounded continuous function is bounded. -/
@[simps]
def forget_boundedness_linear_map : (α →ᵇ β) →ₗ[𝕜] C(α, β) :=
{ to_fun := forget_boundedness α β,
  map_smul' := by { intros, ext, simp, },
  map_add' := by { intros, ext, simp, }, }

end normed_space

section normed_ring
/-!
### Normed ring structure

In this section, if `R` is a normed ring, then we show that the space of bounded
continuous functions from `α` to `R` inherits a normed ring structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables [topological_space α] {R : Type*} [normed_ring R]

instance : ring (α →ᵇ R) :=
{ one := const α 1,
  mul := λ f g, of_normed_group (f * g) (f.continuous.mul g.continuous) (∥f∥ * ∥g∥) $ λ x,
    le_trans (normed_ring.norm_mul (f x) (g x)) $
      mul_le_mul (f.norm_coe_le_norm x) (g.norm_coe_le_norm x) (norm_nonneg _) (norm_nonneg _),
  one_mul := λ f, ext $ λ x, one_mul (f x),
  mul_one := λ f, ext $ λ x, mul_one (f x),
  mul_assoc := λ f₁ f₂ f₃, ext $ λ x, mul_assoc _ _ _,
  left_distrib := λ f₁ f₂ f₃, ext $ λ x, left_distrib _ _ _,
  right_distrib := λ f₁ f₂ f₃, ext $ λ x, right_distrib _ _ _,
  .. bounded_continuous_function.add_comm_group }

@[simp] lemma coe_mul (f g : α →ᵇ R) : ⇑(f * g) = f * g := rfl
lemma mul_apply (f g : α →ᵇ R) (x : α) : (f * g) x = f x * g x := rfl

instance : normed_ring (α →ᵇ R) :=
{ norm_mul := λ f g, norm_of_normed_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _,
  .. bounded_continuous_function.normed_group }

end normed_ring

section normed_comm_ring
/-!
### Normed commutative ring structure

In this section, if `R` is a normed commutative ring, then we show that the space of bounded
continuous functions from `α` to `R` inherits a normed commutative ring structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables [topological_space α] {R : Type*} [normed_comm_ring R]

instance : comm_ring (α →ᵇ R) :=
{ mul_comm := λ f₁ f₂, ext $ λ x, mul_comm _ _,
  .. bounded_continuous_function.ring }

instance : normed_comm_ring (α →ᵇ R) :=
{ .. bounded_continuous_function.comm_ring, .. bounded_continuous_function.normed_group }

end normed_comm_ring

section normed_algebra
/-!
### Normed algebra structure

In this section, if `γ` is a normed algebra, then we show that the space of bounded
continuous functions from `α` to `γ` inherits a normed algebra structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables {𝕜 : Type*} [normed_field 𝕜]
variables [topological_space α] [normed_group β] [normed_space 𝕜 β]
variables [normed_ring γ] [normed_algebra 𝕜 γ]
variables {f g : α →ᵇ γ} {x : α} {c : 𝕜}

/-- `bounded_continuous_function.const` as a `ring_hom`. -/
def C : 𝕜 →+* (α →ᵇ γ) :=
{ to_fun    := λ (c : 𝕜), const α ((algebra_map 𝕜 γ) c),
  map_one'  := ext $ λ x, (algebra_map 𝕜 γ).map_one,
  map_mul'  := λ c₁ c₂, ext $ λ x, (algebra_map 𝕜 γ).map_mul _ _,
  map_zero' := ext $ λ x, (algebra_map 𝕜 γ).map_zero,
  map_add'  := λ c₁ c₂, ext $ λ x, (algebra_map 𝕜 γ).map_add _ _ }

instance : algebra 𝕜 (α →ᵇ γ) :=
{ to_ring_hom := C,
  commutes' := λ c f, ext $ λ x, algebra.commutes' _ _,
  smul_def' := λ c f, ext $ λ x, algebra.smul_def' _ _,
  ..bounded_continuous_function.module,
  ..bounded_continuous_function.ring }

@[simp] lemma algebra_map_apply (k : 𝕜) (a : α) :
  algebra_map 𝕜 (α →ᵇ γ) k a = k • 1 :=
by { rw algebra.algebra_map_eq_smul_one, refl, }

instance [nonempty α] : normed_algebra 𝕜 (α →ᵇ γ) :=
{ norm_algebra_map_eq := λ c, begin
    calc ∥ (algebra_map 𝕜 (α →ᵇ γ)).to_fun c∥ = ∥(algebra_map 𝕜 γ) c∥ : _
    ... = ∥c∥ : norm_algebra_map_eq _ _,
    apply norm_const_eq ((algebra_map 𝕜 γ) c), assumption,
  end,
  ..bounded_continuous_function.algebra }

/-!
### Structure as normed module over scalar functions

If `β` is a normed `𝕜`-space, then we show that the space of bounded continuous
functions from `α` to `β` is naturally a module over the algebra of bounded continuous
functions from `α` to `𝕜`. -/

instance has_scalar' : has_scalar (α →ᵇ 𝕜) (α →ᵇ β) :=
⟨λ (f : α →ᵇ 𝕜) (g : α →ᵇ β), of_normed_group (λ x, (f x) • (g x))
(f.continuous.smul g.continuous) (∥f∥ * ∥g∥) (λ x, calc
  ∥f x • g x∥ ≤ ∥f x∥ * ∥g x∥ : normed_space.norm_smul_le _ _
  ... ≤ ∥f∥ * ∥g∥ : mul_le_mul (f.norm_coe_le_norm _) (g.norm_coe_le_norm _) (norm_nonneg _)
    (norm_nonneg _)) ⟩

instance module' : module (α →ᵇ 𝕜) (α →ᵇ β) :=
module.of_core $
{ smul     := (•),
  smul_add := λ c f₁ f₂, ext $ λ x, smul_add _ _ _,
  add_smul := λ c₁ c₂ f, ext $ λ x, add_smul _ _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
  one_smul := λ f, ext $ λ x, one_smul 𝕜 (f x) }

/- TODO: When `normed_module` has been added to `normed_space.basic`, the above facts
show that the space of bounded continuous functions from `α` to `β` is naturally a normed
module over the algebra of bounded continuous functions from `α` to `𝕜`. -/

end normed_algebra

end bounded_continuous_function


/-
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_topology

/-!
# Equicontinuity of a family of functions

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

Let `X` be a topological space and `α` a `uniform_space`. A family of functions `F : ι → X → α`
is said to be *equicontinuous at a point `x₀ : X`* when, for any entourage `U` in `α`, there is a
neighborhood `V` of `x₀` such that, for all `x ∈ V`, and *for all `i`*, `F i x` is `U`-close to
`F i x₀`. In other words, one has `∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U`.
For maps between metric spaces, this corresponds to
`∀ ε > 0, ∃ δ > 0, ∀ x, ∀ i, dist x₀ x < δ → dist (F i x₀) (F i x) < ε`.

`F` is said to be *equicontinuous* if it is equicontinuous at each point.

A closely related concept is that of ***uniform*** *equicontinuity* of a family of functions
`F : ι → β → α` between uniform spaces, which means that, for any entourage `U` in `α`, there is an
entourage `V` in `β` such that, if `x` and `y` are `V`-close, then *for all `i`*, `F i x` and
`F i y` are `U`-close. In other words, one has
`∀ U ∈ 𝓤 α, ∀ᶠ xy in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U`.
For maps between metric spaces, this corresponds to
`∀ ε > 0, ∃ δ > 0, ∀ x y, ∀ i, dist x y < δ → dist (F i x₀) (F i x) < ε`.

## Main definitions

* `equicontinuous_at`: equicontinuity of a family of functions at a point
* `equicontinuous`: equicontinuity of a family of functions on the whole domain
* `uniform_equicontinuous`: uniform equicontinuity of a family of functions on the whole domain

## Main statements

* `equicontinuous_iff_continuous`: equicontinuity can be expressed as a simple continuity
  condition between well-chosen function spaces. This is really useful for building up the theory.
* `equicontinuous.closure`: if a set of functions is equicontinuous, its closure
  *for the topology of uniform convergence* is also equicontinuous.

## Notations

Throughout this file, we use :
- `ι`, `κ` for indexing types
- `X`, `Y`, `Z` for topological spaces
- `α`, `β`, `γ` for uniform spaces

## Implementation details

We choose to express equicontinuity as a properties of indexed families of functions rather
than sets of functions for the following reasons:
- it is really easy to express equicontinuity of `H : set (X → α)` using our setup: it is just
  equicontinuity of the family `coe : ↥H → (X → α)`. On the other hand, going the other way around
  would require working with the range of the family, which is always annoying because it
  introduces useless existentials.
- in most applications, one doesn't work with bare functions but with a more specific hom type
  `hom`. Equicontinuity of a set `H : set hom` would then have to be expressed as equicontinuity
  of `coe_fn '' H`, which is super annoying to work with. This is much simpler with families,
  because equicontinuity of a family `𝓕 : ι → hom` would simply be expressed as equicontinuity
  of `coe_fn ∘ 𝓕`, which doesn't introduce any nasty existentials.

To simplify statements, we do provide abbreviations `set.equicontinuous_at`, `set.equicontinuous`
and `set.uniform_equicontinuous` asserting the corresponding fact about the family
`coe : ↥H → (X → α)` where `H : set (X → α)`. Note however that these won't work for sets of hom
types, and in that case one should go back to the family definition rather than using `set.image`.

Since we have no use case for it yet, we don't introduce any relative version
(i.e no `equicontinuous_within_at` or `equicontinuous_on`), but this is more of a conservative
position than a design decision, so anyone needing relative versions should feel free to add them,
and that should hopefully be a straightforward task.

## References

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

## Tags

equicontinuity, uniform convergence, ascoli
-/

section

open uniform_space filter set
open_locale uniformity topology uniform_convergence

variables {ι κ X Y Z α β γ 𝓕 : Type*} [topological_space X] [topological_space Y]
  [topological_space Z] [uniform_space α] [uniform_space β] [uniform_space γ]

/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
*equicontinuous at `x₀ : X`* if, for all entourage `U ∈ 𝓤 α`, there is a neighborhood `V` of `x₀`
such that, for all `x ∈ V` and for all `i : ι`, `F i x` is `U`-close to `F i x₀`. -/
def equicontinuous_at (F : ι → X → α) (x₀ : X) : Prop :=
∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U

/-- We say that a set `H : set (X → α)` of functions is equicontinuous at a point if the family
`coe : ↥H → (X → α)` is equicontinuous at that point. -/
protected abbreviation set.equicontinuous_at (H : set $ X → α) (x₀ : X) : Prop :=
equicontinuous_at (coe : H → X → α) x₀

/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
*equicontinuous* on all of `X` if it is equicontinuous at each point of `X`. -/
def equicontinuous (F : ι → X → α) : Prop :=
∀ x₀, equicontinuous_at F x₀

/-- We say that a set `H : set (X → α)` of functions is equicontinuous if the family
`coe : ↥H → (X → α)` is equicontinuous. -/
protected abbreviation set.equicontinuous (H : set $ X → α) : Prop :=
equicontinuous (coe : H → X → α)

/-- A family `F : ι → β → α` of functions between uniform spaces is *uniformly equicontinuous* if,
for all entourage `U ∈ 𝓤 α`, there is an entourage `V ∈ 𝓤 β` such that, whenever `x` and `y` are
`V`-close, we have that, *for all `i : ι`*, `F i x` is `U`-close to `F i x₀`. -/
def uniform_equicontinuous (F : ι → β → α) : Prop :=
∀ U ∈ 𝓤 α, ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U

/-- We say that a set `H : set (X → α)` of functions is uniformly equicontinuous if the family
`coe : ↥H → (X → α)` is uniformly equicontinuous. -/
protected abbreviation set.uniform_equicontinuous (H : set $ β → α) : Prop :=
uniform_equicontinuous (coe : H → β → α)

/-- Reformulation of equicontinuity at `x₀` comparing two variables near `x₀` instead of comparing
only one with `x₀`. -/
lemma equicontinuous_at_iff_pair {F : ι → X → α} {x₀ : X} : equicontinuous_at F x₀ ↔
  ∀ U ∈ 𝓤 α, ∃ V ∈ 𝓝 x₀, ∀ (x y ∈ V) i, (F i x, F i y) ∈ U :=
begin
  split; intros H U hU,
  { rcases comp_symm_mem_uniformity_sets hU with ⟨V, hV, hVsymm, hVU⟩,
    refine ⟨_, H V hV, λ x hx y hy i, hVU (prod_mk_mem_comp_rel _ (hy i))⟩,
    exact hVsymm.mk_mem_comm.mp (hx i) },
  { rcases H U hU with ⟨V, hV, hVU⟩,
    filter_upwards [hV] using λ x hx i, (hVU x₀ (mem_of_mem_nhds hV) x hx i) }
end

/-- Uniform equicontinuity implies equicontinuity. -/
lemma uniform_equicontinuous.equicontinuous {F : ι → β → α} (h : uniform_equicontinuous F) :
  equicontinuous F :=
λ x₀ U hU, mem_of_superset (ball_mem_nhds x₀ (h U hU)) (λ x hx i, hx i)

/-- Each function of a family equicontinuous at `x₀` is continuous at `x₀`. -/
lemma equicontinuous_at.continuous_at {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀)
  (i : ι) : continuous_at (F i) x₀ :=
begin
  intros U hU,
  rw uniform_space.mem_nhds_iff at hU,
  rcases hU with ⟨V, hV₁, hV₂⟩,
  exact mem_map.mpr (mem_of_superset (h V hV₁) (λ x hx, hV₂ (hx i)))
end

protected lemma set.equicontinuous_at.continuous_at_of_mem {H : set $ X → α} {x₀ : X}
  (h : H.equicontinuous_at x₀) {f : X → α} (hf : f ∈ H) : continuous_at f x₀ :=
h.continuous_at ⟨f, hf⟩

/-- Each function of an equicontinuous family is continuous. -/
lemma equicontinuous.continuous {F : ι → X → α} (h : equicontinuous F) (i : ι) :
  continuous (F i) :=
continuous_iff_continuous_at.mpr (λ x, (h x).continuous_at i)

protected lemma set.equicontinuous.continuous_of_mem {H : set $ X → α} (h : H.equicontinuous)
  {f : X → α} (hf : f ∈ H) : continuous f :=
h.continuous ⟨f, hf⟩

/-- Each function of a uniformly equicontinuous family is uniformly continuous. -/
lemma uniform_equicontinuous.uniform_continuous {F : ι → β → α} (h : uniform_equicontinuous F)
  (i : ι) : uniform_continuous (F i) :=
λ U hU, mem_map.mpr (mem_of_superset (h U hU) $ λ xy hxy, (hxy i))

protected lemma set.uniform_equicontinuous.uniform_continuous_of_mem {H : set $ β → α}
  (h : H.uniform_equicontinuous) {f : β → α} (hf : f ∈ H) : uniform_continuous f :=
h.uniform_continuous ⟨f, hf⟩

/-- Taking sub-families preserves equicontinuity at a point. -/
lemma equicontinuous_at.comp {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀) (u : κ → ι) :
  equicontinuous_at (F ∘ u) x₀ :=
λ U hU, (h U hU).mono (λ x H k, H (u k))

protected lemma set.equicontinuous_at.mono {H H' : set $ X → α} {x₀ : X}
  (h : H.equicontinuous_at x₀) (hH : H' ⊆ H) : H'.equicontinuous_at x₀ :=
h.comp (inclusion hH)

/-- Taking sub-families preserves equicontinuity. -/
lemma equicontinuous.comp {F : ι → X → α} (h : equicontinuous F) (u : κ → ι) :
  equicontinuous (F ∘ u) :=
λ x, (h x).comp u

protected lemma set.equicontinuous.mono {H H' : set $ X → α}
  (h : H.equicontinuous) (hH : H' ⊆ H) : H'.equicontinuous :=
h.comp (inclusion hH)

/-- Taking sub-families preserves uniform equicontinuity. -/
lemma uniform_equicontinuous.comp {F : ι → β → α} (h : uniform_equicontinuous F) (u : κ → ι) :
  uniform_equicontinuous (F ∘ u) :=
λ U hU, (h U hU).mono (λ x H k, H (u k))

protected lemma set.uniform_equicontinuous.mono {H H' : set $ β → α}
  (h : H.uniform_equicontinuous) (hH : H' ⊆ H) : H'.uniform_equicontinuous :=
h.comp (inclusion hH)

/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff `range 𝓕` is equicontinuous at `x₀`,
i.e the family `coe : range F → X → α` is equicontinuous at `x₀`. -/
lemma equicontinuous_at_iff_range {F : ι → X → α} {x₀ : X} :
  equicontinuous_at F x₀ ↔ equicontinuous_at (coe : range F → X → α) x₀ :=
⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩

/-- A family `𝓕 : ι → X → α` is equicontinuous iff `range 𝓕` is equicontinuous,
i.e the family `coe : range F → X → α` is equicontinuous. -/
lemma equicontinuous_iff_range {F : ι → X → α} :
  equicontinuous F ↔ equicontinuous (coe : range F → X → α) :=
forall_congr (λ x₀, equicontinuous_at_iff_range)

/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff `range 𝓕` is uniformly equicontinuous,
i.e the family `coe : range F → β → α` is uniformly equicontinuous. -/
lemma uniform_equicontinuous_at_iff_range {F : ι → β → α} :
  uniform_equicontinuous F ↔ uniform_equicontinuous (coe : range F → β → α) :=
⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩

section

open uniform_fun

/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff the function `swap 𝓕 : X → ι → α` is
continuous at `x₀` *when `ι → α` is equipped with the topology of uniform convergence*. This is
very useful for developping the equicontinuity API, but it should not be used directly for other
purposes. -/
lemma equicontinuous_at_iff_continuous_at {F : ι → X → α} {x₀ : X} :
  equicontinuous_at F x₀ ↔ continuous_at (of_fun ∘ function.swap F : X → ι →ᵤ α) x₀ :=
by rw [continuous_at, (uniform_fun.has_basis_nhds ι α _).tendsto_right_iff]; refl

/-- A family `𝓕 : ι → X → α` is equicontinuous iff the function `swap 𝓕 : X → ι → α` is
continuous *when `ι → α` is equipped with the topology of uniform convergence*. This is
very useful for developping the equicontinuity API, but it should not be used directly for other
purposes. -/
lemma equicontinuous_iff_continuous {F : ι → X → α} :
  equicontinuous F ↔ continuous (of_fun ∘ function.swap F : X → ι →ᵤ α) :=
by simp_rw [equicontinuous, continuous_iff_continuous_at, equicontinuous_at_iff_continuous_at]

/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff the function `swap 𝓕 : β → ι → α` is
uniformly continuous *when `ι → α` is equipped with the uniform structure of uniform convergence*.
This is very useful for developping the equicontinuity API, but it should not be used directly
for other purposes. -/
lemma uniform_equicontinuous_iff_uniform_continuous {F : ι → β → α} :
  uniform_equicontinuous F ↔ uniform_continuous (of_fun ∘ function.swap F : β → ι →ᵤ α) :=
by rw [uniform_continuous, (uniform_fun.has_basis_uniformity ι α).tendsto_right_iff]; refl

lemma filter.has_basis.equicontinuous_at_iff_left {κ : Type*} {p : κ → Prop} {s : κ → set X}
  {F : ι → X → α} {x₀ : X} (hX : (𝓝 x₀).has_basis p s) : equicontinuous_at F x₀ ↔
  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x ∈ s k, ∀ i, (F i x₀, F i x) ∈ U :=
begin
  rw [equicontinuous_at_iff_continuous_at, continuous_at,
      hX.tendsto_iff (uniform_fun.has_basis_nhds ι α _)],
  refl
end

lemma filter.has_basis.equicontinuous_at_iff_right {κ : Type*} {p : κ → Prop} {s : κ → set (α × α)}
  {F : ι → X → α} {x₀ : X} (hα : (𝓤 α).has_basis p s) : equicontinuous_at F x₀ ↔
  ∀ k, p k → ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ s k :=
begin
  rw [equicontinuous_at_iff_continuous_at, continuous_at,
      (uniform_fun.has_basis_nhds_of_basis ι α _ hα).tendsto_right_iff],
  refl
end

lemma filter.has_basis.equicontinuous_at_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop} {s₁ : κ₁ → set X}
  {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → X → α} {x₀ : X}
  (hX : (𝓝 x₀).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : equicontinuous_at F x₀ ↔
  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x ∈ s₁ k₁, ∀ i, (F i x₀, F i x) ∈ s₂ k₂ :=
begin
  rw [equicontinuous_at_iff_continuous_at, continuous_at,
      hX.tendsto_iff (uniform_fun.has_basis_nhds_of_basis ι α _ hα)],
  refl
end

lemma filter.has_basis.uniform_equicontinuous_iff_left {κ : Type*} {p : κ → Prop}
  {s : κ → set (β × β)} {F : ι → β → α} (hβ : (𝓤 β).has_basis p s) : uniform_equicontinuous F ↔
  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x y, (x, y) ∈ s k → ∀ i, (F i x, F i y) ∈ U :=
begin
  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
      hβ.tendsto_iff (uniform_fun.has_basis_uniformity ι α)],
  simp_rw [prod.forall],
  refl
end

lemma filter.has_basis.uniform_equicontinuous_iff_right {κ : Type*} {p : κ → Prop}
  {s : κ → set (α × α)} {F : ι → β → α} (hα : (𝓤 α).has_basis p s) : uniform_equicontinuous F ↔
  ∀ k, p k → ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ s k :=
begin
  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
      (uniform_fun.has_basis_uniformity_of_basis ι α hα).tendsto_right_iff],
  refl
end

lemma filter.has_basis.uniform_equicontinuous_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop}
  {s₁ : κ₁ → set (β × β)} {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → β → α}
  (hβ : (𝓤 β).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : uniform_equicontinuous F ↔
  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x y, (x, y) ∈ s₁ k₁ → ∀ i, (F i x, F i y) ∈ s₂ k₂ :=
begin
  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
      hβ.tendsto_iff (uniform_fun.has_basis_uniformity_of_basis ι α hα)],
  simp_rw [prod.forall],
  refl
end

/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous at a point
`x₀ : X` iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is
equicontinuous at `x₀`. -/
lemma uniform_inducing.equicontinuous_at_iff {F : ι → X → α} {x₀ : X} {u : α → β}
  (hu : uniform_inducing u) :
  equicontinuous_at F x₀ ↔ equicontinuous_at (((∘) u) ∘ F) x₀ :=
begin
  have := (uniform_fun.postcomp_uniform_inducing hu).inducing,
  rw [equicontinuous_at_iff_continuous_at, equicontinuous_at_iff_continuous_at,
      this.continuous_at_iff],
  refl
end

/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous iff the
family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is equicontinuous. -/
lemma uniform_inducing.equicontinuous_iff {F : ι → X → α} {u : α → β}
  (hu : uniform_inducing u) :
  equicontinuous F ↔ equicontinuous (((∘) u) ∘ F) :=
begin
  congrm (∀ x, (_ : Prop)),
  rw hu.equicontinuous_at_iff
end

/-- Given `u : α → γ` a uniform inducing map, a family `𝓕 : ι → β → α` is uniformly equicontinuous
iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is uniformly
equicontinuous. -/
lemma uniform_inducing.uniform_equicontinuous_iff {F : ι → β → α} {u : α → γ}
  (hu : uniform_inducing u) :
  uniform_equicontinuous F ↔ uniform_equicontinuous (((∘) u) ∘ F) :=
begin
  have := uniform_fun.postcomp_uniform_inducing hu,
  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_equicontinuous_iff_uniform_continuous,
      this.uniform_continuous_iff],
  refl
end

/-- A version of `equicontinuous_at.closure` applicable to subsets of types which embed continuously
into `X → α` with the product topology. It turns out we don't need any other condition on the
embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
the coercion is injective. -/
lemma equicontinuous_at.closure' {A : set Y} {u : Y → X → α} {x₀ : X}
  (hA : equicontinuous_at (u ∘ coe : A → X → α) x₀) (hu : continuous u) :
  equicontinuous_at (u ∘ coe : closure A → X → α) x₀ :=
begin
  intros U hU,
  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
  filter_upwards [hA V hV] with x hx,
  rw set_coe.forall at *,
  change A ⊆ (λ f, (u f x₀, u f x)) ⁻¹' V at hx,
  refine (closure_minimal hx $ hVclosed.preimage $ _).trans (preimage_mono hVU),
  exact continuous.prod_mk ((continuous_apply x₀).comp hu) ((continuous_apply x).comp hu)
end

/-- If a set of functions is equicontinuous at some `x₀`, its closure for the product topology is
also equicontinuous at `x₀`. -/
lemma equicontinuous_at.closure {A : set $ X → α} {x₀ : X} (hA : A.equicontinuous_at x₀) :
  (closure A).equicontinuous_at x₀ :=
@equicontinuous_at.closure' _ _ _ _ _ _ _ id _ hA continuous_id

/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is equicontinuous at some `x₀ : X`, then the limit is continuous at `x₀`. -/
lemma filter.tendsto.continuous_at_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
  {f : X → α} {x₀ : X} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous_at F x₀) :
  continuous_at f x₀ :=
(equicontinuous_at_iff_range.mp h₂).closure.continuous_at
  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩

/-- A version of `equicontinuous.closure` applicable to subsets of types which embed continuously
into `X → α` with the product topology. It turns out we don't need any other condition on the
embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
the coercion is injective. -/
lemma equicontinuous.closure' {A : set Y} {u : Y → X → α}
  (hA : equicontinuous (u ∘ coe : A → X → α)) (hu : continuous u) :
  equicontinuous (u ∘ coe : closure A → X → α) :=
λ x, (hA x).closure' hu

/-- If a set of functions is equicontinuous, its closure for the product topology is also
equicontinuous. -/
lemma equicontinuous.closure {A : set $ X → α} (hA : A.equicontinuous) :
  (closure A).equicontinuous :=
λ x, (hA x).closure

/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is equicontinuous, then the limit is continuous. -/
lemma filter.tendsto.continuous_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
  {f : X → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous F) :
  continuous f :=
continuous_iff_continuous_at.mpr (λ x, h₁.continuous_at_of_equicontinuous_at (h₂ x))

/-- A version of `uniform_equicontinuous.closure` applicable to subsets of types which embed
continuously into `β → α` with the product topology. It turns out we don't need any other condition
on the embedding than continuity, but in practice this will mostly be applied to `fun_like` types
where the coercion is injective. -/
lemma uniform_equicontinuous.closure' {A : set Y} {u : Y → β → α}
  (hA : uniform_equicontinuous (u ∘ coe : A → β → α)) (hu : continuous u) :
  uniform_equicontinuous (u ∘ coe : closure A → β → α) :=
begin
  intros U hU,
  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
  filter_upwards [hA V hV],
  rintros ⟨x, y⟩ hxy,
  rw set_coe.forall at *,
  change A ⊆ (λ f, (u f x, u f y)) ⁻¹' V at hxy,
  refine (closure_minimal hxy $ hVclosed.preimage $ _).trans (preimage_mono hVU),
  exact continuous.prod_mk ((continuous_apply x).comp hu) ((continuous_apply y).comp hu)
end

/-- If a set of functions is uniformly equicontinuous, its closure for the product topology is also
uniformly equicontinuous. -/
lemma uniform_equicontinuous.closure {A : set $ β → α} (hA : A.uniform_equicontinuous) :
  (closure A).uniform_equicontinuous :=
@uniform_equicontinuous.closure' _ _ _ _ _ _ _ id hA continuous_id

/-- If `𝓕 : ι → β → α` tends to `f : β → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is uniformly equicontinuous, then the limit is uniformly continuous. -/
lemma filter.tendsto.uniform_continuous_of_uniform_equicontinuous {l : filter ι} [l.ne_bot]
  {F : ι → β → α} {f : β → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : uniform_equicontinuous F) :
  uniform_continuous f :=
(uniform_equicontinuous_at_iff_range.mp h₂).closure.uniform_continuous
  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩

end

end


import data.real.basic
import order.interval
import order.lattice
import topology.algebra.order.compact
import topology.instances.real
import data.nat.factorial.basic
import data.int.interval
import tactic.slim_check
-- import number_theory.geometry_of_numbers
import measure_theory.measure.haar
import linear_algebra.finite_dimensional
import analysis.normed_space.pointwise
import measure_theory.group.pointwise

.
open set
open_locale nat

lemma mediant_btwn {K : Type*} [linear_ordered_field K] {a b c d : K} (hc : 0 < c) (hd : 0 < d)
  (h : a / c < b / d) :
  a / c < (a + b) / (c + d) ∧
  (a + b) / (c + d) < b / d :=
begin
  rw div_lt_div_iff hc hd at h,
  rw [div_lt_div_iff (add_pos hc hd) hd, div_lt_div_iff hc (add_pos hc hd)],
  split;
  linarith,
end

/--
if b / d < a / c with ad - bc = 1
we have (a + b) / (c + d) in between
so (a + b) / (c + d) < a / c has same property ie
a * (c + d) - (a + b) * c = 1
and
b / d < (a + b) / (c + d) has same property ie
(a + b) * d - b * (c + d) = 1
-/
lemma mediant_unimod {a b c d : ℤ} (ha : a * d - b * c = 1) : a * (c + d) - (a + b) * c = 1 ∧
  (a + b) * d - b * (c + d) = 1 :=
begin
  ring_nf,
  rw mul_comm,
  simp [ha],
end

lemma mediant_reduced {a b c d : ℤ} (ha : a * d - b * c = 1) :
  (a + b).nat_abs.coprime (c + d).nat_abs :=
begin
  -- have := calc b + d = (b + d) * 1 : by simp
  --   ... = (b + d) * (a * d - b * c) : by rw ← ha
  --   ... = b * ((a + b) * d - b * (c + d)) + d * (a * (c + d) - (a + b) * c) : by ring,
  change (a + b).gcd (c + d) = 1,
  have := dvd_sub ((int.gcd_dvd_right (a + b) (c+d)).mul_left a)
                  ((int.gcd_dvd_left (a + b) (c+d)).mul_right c),
  rw (mediant_unimod ha).1 at this,
  rw ← int.nat_abs_dvd_iff_dvd at this,
  simpa using this,
end

-- See Apostol Modular forms and Dirichlet seties in number theory p. 98

lemma mediant_denom {a c : ℤ} {b d : ℕ} (hb : 0 < b) (ha : c * b - d * a = 1) : ((a + c : ℚ) / (b + d)).denom = b + d :=
begin
  -- TODO this is a horrible proof, serious cleanup needed
  rw mul_comm _ a at ha,
  rw add_comm b d,
  have := rat.denom_div_eq_of_coprime _ (mediant_reduced ha),
  rw add_comm c a at this,
  norm_cast at this,
  rw ← this,
  congr,
  simp only [add_comm, nat.cast_add],
  rw rat.mk_eq_div,
  norm_cast,
  norm_cast,
  linarith,
end

lemma farey_set_finite (n : ℕ) (x y : ℝ) :
  {r : ℝ | ∃ q : ℚ, (q.denom ≤ n ∧ x ≤ q ∧ ↑q ≤ y) ∧ ↑q = r}.finite :=
begin
  have nfact_pos : 0 < (n! : ℝ),
  { norm_cast,
    rw pos_iff_ne_zero,
    exact (nat.factorial_ne_zero n), },
  have : (((*) n! : ℝ → ℝ) '' _).finite,
  swap,
  apply this.of_finite_image,
  apply function.injective.inj_on,
  exact mul_right_injective₀ nfact_pos.ne.symm,
  { have : {t : ℝ | ∃ q : ℤ, (x * n! ≤ q ∧ ↑q ≤ y * n!) ∧ (↑q : ℝ) = t}.finite,
    { apply set.finite.image,
      change {r : ℤ | _}.finite,
      apply (finite_Icc ⌊x * ↑n!⌋ ⌈y * n!⌉).subset,
      rintros y ⟨hyl, hyr⟩,
      rw [mem_Icc],
      split,
      have := (int.floor_le _).trans hyl, -- TODO can this be a le_floor type iff lemma?
      exact_mod_cast this,
      have := hyr.trans (int.le_ceil _), -- TODO can this be a le_floor type iff lemma?
      exact_mod_cast this, },
    apply this.subset,
    intros x hx,
    rcases hx with ⟨hx_w, ⟨r, ⟨ha, hb, hc⟩, hd⟩, rfl⟩,
    simp only [←hd, mem_set_of_eq, eq_self_iff_true] at *,
    have key : (r * n!).denom = 1,
    { rw rat.mul_denom,
      simp only [rat.coe_nat_denom, mul_one, rat.coe_nat_num],
      suffices : (r.num * ↑n!).nat_abs.gcd r.denom = r.denom,
      simp only [this, nat.div_self r.pos],
      apply nat.gcd_eq_right,
      simp only [int.nat_abs_mul, int.nat_abs_of_nat],
      apply dvd_mul_of_dvd_right,
      apply nat.dvd_factorial r.pos ha, },
    use (r * n!).num,
    have := rat.coe_int_num_of_denom_eq_one key, -- TODO a general version of this for any coe
    apply_fun (coe : ℚ → ℝ) at this,
    push_cast at this,
    simp only [this],
    repeat { split },
    rwa mul_le_mul_right nfact_pos,
    rwa mul_le_mul_right nfact_pos,
    rw mul_comm, },
end