/-
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.operator_norm
import analysis.normed_space.star.basic
import topology.continuous_function.algebra
import data.real.sqrt
import analysis.normed_space.lattice_ordered_group

/-!
# 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 function

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⟩

@[simp] lemma coe_to_continuous_fun (f : α →ᵇ β) : (f.to_continuous_map : α → β) = f := rfl

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α →ᵇ β) : α → β := h

initialize_simps_projections bounded_continuous_function (to_continuous_map_to_fun → apply)

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 coe_injective : @injective (α →ᵇ β) (α → β) coe_fn := λ f g h, ext $ congr_fun h

lemma bounded_range (f : α →ᵇ β) : bounded (range f) :=
bounded_range_iff.2 f.bounded

lemma bounded_image (f : α →ᵇ β) (s : set α) : bounded (f '' s) :=
f.bounded_range.mono $ image_subset_range _ _

lemma eq_of_empty [is_empty α] (f g : α →ᵇ β) : f = g :=
ext $ is_empty.elim ‹_›

/-- 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 (is_compact_range f.continuous).bounded⟩

@[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 -/
@[simps] def mk_of_discrete [discrete_topology α] (f : α → β)
  (C : ℝ) (h : ∀ x y : α, dist (f x) (f y) ≤ C) : α →ᵇ β :=
⟨⟨f, continuous_of_discrete_topology⟩, ⟨C, h⟩⟩

/-- 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
  rcases f.bounded_range.union g.bounded_range with ⟨C, hC⟩,
  refine ⟨max 0 C, le_max_left _ _, λ x, (hC _ _ _ _).trans (le_max_right _ _)⟩;
    [left, right]; apply mem_range_self
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_rfl, λ 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⟩

/-- 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_rfl).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 _)) }

/-- On an empty space, bounded continuous functions are at distance 0 -/
lemma dist_zero_of_empty [is_empty α] : dist f g = 0 :=
dist_eq_zero.2 (eq_of_empty f g)

lemma dist_eq_supr : dist f g = ⨆ x : α, dist (f x) (g x) :=
begin
  casesI is_empty_or_nonempty α, { rw [supr_of_empty', real.Sup_empty, dist_zero_of_empty] },
  refine (dist_le_iff_of_nonempty.mpr $ le_csupr _).antisymm (csupr_le dist_coe_le_dist),
  exact dist_set_exists.imp (λ C hC, forall_range_iff.2 hC.2)
end

variables (α) {β}

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

variable {α}

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⟩

lemma lipschitz_evalx (x : α) : lipschitz_with 1 (λ f : α →ᵇ β, f x) :=
lipschitz_with.mk_one $ λ f g, dist_coe_le_dist x

theorem uniform_continuous_coe : @uniform_continuous (α →ᵇ β) (α → β) _ _ coe_fn :=
uniform_continuous_pi.2 $ λ x, (lipschitz_evalx x).uniform_continuous

lemma continuous_coe : continuous (λ (f : α →ᵇ β) x, f x) :=
uniform_continuous.continuous uniform_continuous_coe

/-- When `x` is fixed, `(f : α →ᵇ β) ↦ f x` is continuous -/
@[continuity] theorem continuous_evalx {x : α} : continuous (λ f : α →ᵇ β, f x) :=
(continuous_apply x).comp continuous_coe

/-- The evaluation map is continuous, as a joint function of `u` and `x` -/
@[continuity] theorem continuous_eval : continuous (λ p : (α →ᵇ β) × α, p.1 p.2) :=
continuous_prod_of_continuous_lipschitz _ 1 (λ f, f.continuous) $ lipschitz_evalx

/-- 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 (eventually_of_forall $ λ 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 of a bounded continuous function and a continuous function. -/
@[simps { fully_applied := ff }]
def comp_continuous {δ : Type*} [topological_space δ] (f : α →ᵇ β) (g : C(δ, α)) : δ →ᵇ β :=
{ to_continuous_map := f.1.comp g,
  bounded' := f.bounded'.imp (λ C hC x y, hC _ _) }

lemma lipschitz_comp_continuous {δ : Type*} [topological_space δ] (g : C(δ, α)) :
  lipschitz_with 1 (λ f : α →ᵇ β, f.comp_continuous g) :=
lipschitz_with.mk_one $ λ f₁ f₂, (dist_le dist_nonneg).2 $ λ x, dist_coe_le_dist (g x)

lemma continuous_comp_continuous {δ : Type*} [topological_space δ] (g : C(δ, α)) :
  continuous (λ f : α →ᵇ β, f.comp_continuous g) :=
(lipschitz_comp_continuous g).continuous

/-- Restrict a bounded continuous function to a set. -/
@[simps apply { fully_applied := ff }]
def restrict (f : α →ᵇ β) (s : set α) : s →ᵇ β := f.comp_continuous (continuous_map.id.restrict s)

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

section extend

variables {δ : Type*} [topological_space δ] [discrete_topology δ]

/-- A version of `function.extend` for bounded continuous maps. We assume that the domain has
discrete topology, so we only need to verify boundedness. -/
def extend (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) : δ →ᵇ β :=
{ to_fun := extend f g h,
  continuous_to_fun := continuous_of_discrete_topology,
  bounded' :=
    begin
      rw [← bounded_range_iff, range_extend f.injective, metric.bounded_union],
      exact ⟨g.bounded_range, h.bounded_image _⟩
    end }

@[simp] lemma extend_apply (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) (x : α) :
  extend f g h (f x) = g x :=
extend_apply f.injective _ _ _

@[simp] lemma extend_comp (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) : extend f g h ∘ f = g :=
extend_comp f.injective _ _

lemma extend_apply' {f : α ↪ δ} {x : δ} (hx : x ∉ range f) (g : α →ᵇ β) (h : δ →ᵇ β) :
  extend f g h x = h x :=
extend_apply' _ _ _ hx

lemma extend_of_empty [is_empty α] (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) :
  extend f g h = h :=
coe_injective $ function.extend_of_empty f g h

@[simp] lemma dist_extend_extend (f : α ↪ δ) (g₁ g₂ : α →ᵇ β) (h₁ h₂ : δ →ᵇ β) :
  dist (g₁.extend f h₁) (g₂.extend f h₂) =
    max (dist g₁ g₂) (dist (h₁.restrict (range f)ᶜ) (h₂.restrict (range f)ᶜ)) :=
begin
  refine le_antisymm ((dist_le $ le_max_iff.2 $ or.inl dist_nonneg).2 $ λ x, _) (max_le _ _),
  { rcases em (∃ y, f y = x) with (⟨x, rfl⟩|hx),
    { simp only [extend_apply],
      exact (dist_coe_le_dist x).trans (le_max_left _ _) },
    { simp only [extend_apply' hx],
      lift x to ((range f)ᶜ : set δ) using hx,
      calc dist (h₁ x) (h₂ x) = dist (h₁.restrict (range f)ᶜ x) (h₂.restrict (range f)ᶜ x) : rfl
      ... ≤ dist (h₁.restrict (range f)ᶜ) (h₂.restrict (range f)ᶜ) : dist_coe_le_dist x
      ... ≤ _ : le_max_right _ _ } },
  { refine (dist_le dist_nonneg).2 (λ x, _),
    rw [← extend_apply f g₁ h₁, ← extend_apply f g₂ h₂],
    exact dist_coe_le_dist _ },
  { refine (dist_le dist_nonneg).2 (λ x, _),
    calc dist (h₁ x) (h₂ x) = dist (extend f g₁ h₁ x) (extend f g₂ h₂ x) :
      by rw [extend_apply' x.coe_prop, extend_apply' x.coe_prop]
    ... ≤ _ : dist_coe_le_dist _ }
end

lemma isometry_extend (f : α ↪ δ) (h : δ →ᵇ β) :
  isometry (λ g : α →ᵇ β, extend f g h) :=
isometry_emetric_iff_metric.2 $ λ g₁ g₂, by simp [dist_nonneg]

end extend

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⟩ := _root_.mem_nhds_iff.1 nhdsU in
      ⟨V, xV, openV, λy hy z hz f hf, hU y (VU hy) z (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_Union₂.1 (htα (mem_univ x)),
  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 := is_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 hy z hz f hf, _) (H x ε ε0)),
    calc dist (f y) (f z) = dist (F f y) (F f z) : rfl
                        ... < ε : hU y hy z 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 hy z 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 hy z 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 hy z 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
    ... ≤ |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 has_lipschitz_add
/- In this section, if `β` is an `add_monoid` whose addition operation is Lipschitz, then we show
that the space of bounded continuous functions from `α` to `β` inherits a topological `add_monoid`
structure, by using pointwise operations and checking that they are compatible with the uniform
distance.

Implementation note: The material in this section could have been written for `has_lipschitz_mul`
and transported by `@[to_additive]`.  We choose not to do this because this causes a few lemma
names (for example, `coe_mul`) to conflict with later lemma names for normed rings; this is only a
trivial inconvenience, but in any case there are no obvious applications of the multiplicative
version. -/

variables [topological_space α] [metric_space β] [add_monoid β]

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

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

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

@[simp] lemma zero_comp_continuous [topological_space γ] (f : C(γ, α)) :
  (0 : α →ᵇ β).comp_continuous f = 0 := rfl

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

/-- The pointwise sum of two bounded continuous functions is again bounded continuous. -/
instance : has_add (α →ᵇ β) :=
{ add := λ f g,
    bounded_continuous_function.mk_of_bound (f.to_continuous_map + g.to_continuous_map)
    (↑(has_lipschitz_add.C β) * max (classical.some f.bounded) (classical.some g.bounded))
    begin
      intros x y,
      refine le_trans (lipschitz_with_lipschitz_const_add ⟨f x, g x⟩ ⟨f y, g y⟩) _,
      rw prod.dist_eq,
      refine mul_le_mul_of_nonneg_left _ (has_lipschitz_add.C β).coe_nonneg,
      apply max_le_max,
      exact classical.some_spec f.bounded x y,
      exact classical.some_spec g.bounded x y,
    end }

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

lemma add_comp_continuous [topological_space γ] (h : C(γ, α)) :
  (g + f).comp_continuous h = g.comp_continuous h + f.comp_continuous h := rfl

instance : add_monoid (α →ᵇ β) :=
{ 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,
  .. bounded_continuous_function.has_add,
  .. bounded_continuous_function.has_zero }

instance : has_lipschitz_add (α →ᵇ β) :=
{ lipschitz_add := ⟨has_lipschitz_add.C β, begin
    have C_nonneg := (has_lipschitz_add.C β).coe_nonneg,
    rw lipschitz_with_iff_dist_le_mul,
    rintros ⟨f₁, g₁⟩ ⟨f₂, g₂⟩,
    rw dist_le (mul_nonneg C_nonneg dist_nonneg),
    intros x,
    refine le_trans (lipschitz_with_lipschitz_const_add ⟨f₁ x, g₁ x⟩ ⟨f₂ x, g₂ x⟩) _,
    refine mul_le_mul_of_nonneg_left _ C_nonneg,
    apply max_le_max; exact dist_coe_le_dist x,
  end⟩ }

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

variables (α β)

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

end has_lipschitz_add

section comm_has_lipschitz_add

variables [topological_space α] [metric_space β] [add_comm_monoid β] [has_lipschitz_add β]

@[to_additive] instance : add_comm_monoid (α →ᵇ β) :=
{ add_comm      := assume f g, by ext; simp [add_comm],
  .. bounded_continuous_function.add_monoid }

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

end comm_has_lipschitz_add

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_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]

/-- When the domain is non-empty, we do not need the `0 ≤ C` condition in the formula for ∥f∥ as an
`Inf`. -/
lemma norm_eq_of_nonempty [h : nonempty α] : ∥f∥ = Inf {C : ℝ | ∀ (x : α), ∥f x∥ ≤ C} :=
begin
  unfreezingI { obtain ⟨a⟩ := h, },
  rw norm_eq,
  congr,
  ext,
  simp only [and_iff_right_iff_imp],
  exact λ h', le_trans (norm_nonneg (f a)) (h' a),
end

@[simp] lemma norm_eq_zero_of_empty [h : is_empty α] : ∥f∥ = 0 :=
dist_zero_of_empty

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_rfl

@[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⟩⟩

@[simp] lemma coe_of_normed_group
  {α : Type u} {β : Type v} [topological_space α] [normed_group β]
  (f : α → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) :
  (of_normed_group f Hf C H : α → β) = f := rfl

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

@[simp] lemma coe_of_normed_group_discrete
  {α : Type u} {β : Type v} [topological_space α] [discrete_topology α] [normed_group β]
  (f : α → β) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) :
  (of_normed_group_discrete f C H : α → β) = f := rfl

/-- Taking the pointwise norm of a bounded continuous function with values in a `normed_group`,
yields a bounded continuous function with values in ℝ. -/
def norm_comp : α →ᵇ ℝ :=
f.comp norm lipschitz_with_one_norm

@[simp] lemma coe_norm_comp : (f.norm_comp : α → ℝ) = norm ∘ f := rfl

@[simp] lemma norm_norm_comp : ∥f.norm_comp∥ = ∥f∥ :=
by simp only [norm_eq, coe_norm_comp, norm_norm]

lemma bdd_above_range_norm_comp : bdd_above $ set.range $ norm ∘ f :=
(real.bounded_iff_bdd_below_bdd_above.mp $ @bounded_range _ _ _ _ f.norm_comp).2

lemma norm_eq_supr_norm : ∥f∥ = ⨆ x : α, ∥f x∥ :=
begin
  casesI is_empty_or_nonempty α with hα _,
  { suffices : range (norm ∘ f) = ∅, { rw [f.norm_eq_zero_of_empty, supr, this, real.Sup_empty], },
    simp only [hα, range_eq_empty, not_nonempty_iff], },
  { rw [norm_eq_of_nonempty, supr,
      ← cInf_upper_bounds_eq_cSup f.bdd_above_range_norm_comp (range_nonempty _)],
    congr,
    ext,
    simp only [forall_apply_eq_imp_iff', mem_range, exists_imp_distrib], },
end

/-- 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_neg : ⇑(-f) = -f := rfl
lemma neg_apply : (-f) x = -f x := rfl

instance : add_comm_group (α →ᵇ β) :=
{ 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.add_monoid,
  ..bounded_continuous_function.has_neg,
  ..bounded_continuous_function.has_sub }

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

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

lemma norm_comp_continuous_le [topological_space γ] (f : α →ᵇ β) (g : C(γ, α)) :
  ∥f.comp_continuous g∥ ≤ ∥f∥ :=
((lipschitz_comp_continuous g).dist_le_mul f 0).trans $
  by rw [nnreal.coe_one, one_mul, dist_zero_right]

end normed_group

section has_bounded_smul
/-!
### `has_bounded_smul` (in particular, topological module) structure

In this section, if `β` is a metric space and a `𝕜`-module whose addition and scalar multiplication
are compatible with the metric structure, then we show that the space of bounded continuous
functions from `α` to `β` inherits a so-called `has_bounded_smul` structure (in particular, a
`has_continuous_mul` structure, which is the mathlib formulation of being a topological module), by
using pointwise operations and checking that they are compatible with the uniform distance. -/

variables {𝕜 : Type*} [metric_space 𝕜] [semiring 𝕜]
variables [topological_space α] [metric_space β] [add_comm_monoid β]
  [module 𝕜 β] [has_bounded_smul 𝕜 β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance : has_scalar 𝕜 (α →ᵇ β) :=
⟨λ c f,
  bounded_continuous_function.mk_of_bound
    (c • f.to_continuous_map)
    (dist c 0 * (classical.some f.bounded))
    begin
      intros x y,
      refine (dist_smul_pair c (f x) (f y)).trans _,
      refine mul_le_mul_of_nonneg_left _ dist_nonneg,
      exact classical.some_spec f.bounded x y
    end ⟩

@[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 : has_bounded_smul 𝕜 (α →ᵇ β) :=
{ dist_smul_pair' := λ c f₁ f₂, begin
    rw dist_le (mul_nonneg dist_nonneg dist_nonneg),
    intros x,
    refine (dist_smul_pair c (f₁ x) (f₂ x)).trans _,
    exact mul_le_mul_of_nonneg_left (dist_coe_le_dist x) dist_nonneg
  end,
  dist_pair_smul' := λ c₁ c₂ f, begin
    rw dist_le (mul_nonneg dist_nonneg dist_nonneg),
    intros x,
    refine (dist_pair_smul c₁ c₂ (f x)).trans _,
    convert mul_le_mul_of_nonneg_left (dist_coe_le_dist x) dist_nonneg,
    simp
  end }

variables [has_lipschitz_add β]

instance : module 𝕜 (α →ᵇ β) :=
{ 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),
  smul_zero := λ c, ext $ λ x, smul_zero c,
  zero_smul := λ f, ext $ λ x, zero_smul 𝕜 (f x),
  .. bounded_continuous_function.add_comm_monoid }

variables (𝕜)
/-- The evaluation at a point, as a continuous linear map from `α →ᵇ β` to `β`. -/
def eval_clm (x : α) : (α →ᵇ β) →L[𝕜] β :=
{ to_fun := λ f, f x,
  map_add' := λ f g, by simp only [pi.add_apply, coe_add],
  map_smul' := λ c f, by simp only [coe_smul, ring_hom.id_apply] }

@[simp] lemma eval_clm_apply (x : α) (f : α →ᵇ β) :
  eval_clm 𝕜 x f = f x := rfl

variables (α β)

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

end has_bounded_smul

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*}
variables [topological_space α] [normed_group β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance [normed_field 𝕜] [normed_space 𝕜 β] : normed_space 𝕜 (α →ᵇ β) := ⟨λ c f, begin
  refine norm_of_normed_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _,
  exact (λ x, trans_rel_right _ (norm_smul _ _)
    (mul_le_mul_of_nonneg_left (f.norm_coe_le_norm _) (norm_nonneg _))) end⟩

variables [nondiscrete_normed_field 𝕜] [normed_space 𝕜 β]
variables [normed_group γ] [normed_space 𝕜 γ]

variables (α)
-- TODO does this work in the `has_bounded_smul` setting, too?
/--
Postcomposition of bounded continuous functions into a normed module by a continuous linear map is
a continuous linear map.
Upgraded version of `continuous_linear_map.comp_left_continuous`, similar to
`linear_map.comp_left`. -/
protected def _root_.continuous_linear_map.comp_left_continuous_bounded (g : β →L[𝕜] γ) :
  (α →ᵇ β) →L[𝕜] (α →ᵇ γ) :=
linear_map.mk_continuous
  { to_fun := λ f, of_normed_group
      (g ∘ f)
      (g.continuous.comp f.continuous)
      (∥g∥ * ∥f∥)
      (λ x, (g.le_op_norm_of_le (f.norm_coe_le_norm x))),
    map_add' := λ f g, by ext; simp,
    map_smul' := λ c f, by ext; simp }
  ∥g∥
  (λ f, norm_of_normed_group_le _ (mul_nonneg (norm_nonneg g) (norm_nonneg f)) _)

@[simp] lemma _root_.continuous_linear_map.comp_left_continuous_bounded_apply (g : β →L[𝕜] γ)
  (f : α →ᵇ β) (x : α) :
  (g.comp_left_continuous_bounded α f) x = g (f x) :=
rfl

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

lemma nnreal.upper_bound {α : Type*} [topological_space α]
  (f : α →ᵇ ℝ≥0) (x : α) : f x ≤ nndist f 0 :=
begin
  have key : nndist (f x) ((0 : α →ᵇ ℝ≥0) x) ≤ nndist f 0,
  { exact @dist_coe_le_dist α ℝ≥0 _ _ f 0 x, },
  simp only [coe_zero, pi.zero_apply] at key,
  rwa nnreal.nndist_zero_eq_val' (f x) at key,
end

/-!
### Star structures

In this section, if `β` is a normed ⋆-group, then so is the space of bounded
continuous functions from `α` to `β`, by using the star operation pointwise.

If `𝕜` is normed field and a ⋆-ring over which `β` is a normed algebra and a
star module, then the space of bounded continuous functions from `α` to `β`
is a star module.

If `β` is a ⋆-ring in addition to being a normed ⋆-group, then `α →ᵇ β`
inherits a ⋆-ring structure.

In summary, if `β` is a C⋆-algebra over `𝕜`, then so is  `α →ᵇ β`; note that
completeness is guaranteed when `β` is complete (see
`bounded_continuous_function.complete`). -/

section normed_group

variables {𝕜 : Type*} [normed_field 𝕜] [star_ring 𝕜]
variables [topological_space α] [normed_group β] [star_add_monoid β] [normed_star_monoid β]
variables [normed_space 𝕜 β] [star_module 𝕜 β]

instance : star_add_monoid (α →ᵇ β) :=
{ star            := λ f, f.comp star star_normed_group_hom.lipschitz,
  star_involutive := λ f, ext $ λ x, star_star (f x),
  star_add        := λ f g, ext $ λ x, star_add (f x) (g x) }

/-- The right-hand side of this equality can be parsed `star ∘ ⇑f` because of the
instance `pi.has_star`. Upon inspecting the goal, one sees `⊢ ⇑(star f) = star ⇑f`.-/
@[simp] lemma coe_star (f : α →ᵇ β) : ⇑(star f) = star f := rfl

@[simp] lemma star_apply (f : α →ᵇ β) (x : α) : star f x = star (f x) := rfl

instance : normed_star_monoid (α →ᵇ β) :=
{ norm_star := λ f, by
  { simp only [norm_eq], congr, ext, conv_lhs { find (∥_∥) { erw (@norm_star β _ _ _ (f x)) } } } }

instance : star_module 𝕜 (α →ᵇ β) :=
{ star_smul := λ k f, ext $ λ x, star_smul k (f x) }

end normed_group

section cstar_ring

variables [topological_space α]
variables [normed_ring β] [star_ring β]

instance [normed_star_monoid β] : star_ring (α →ᵇ β) :=
{ star_mul := λ f g, ext $ λ x, star_mul (f x) (g x),
  ..bounded_continuous_function.star_add_monoid }

variable [cstar_ring β]

instance : cstar_ring (α →ᵇ β) :=
{ norm_star_mul_self :=
  begin
    intro f,
    refine le_antisymm _ _,
    { rw [←sq, norm_le (sq_nonneg _)],
      dsimp [star_apply],
      intro x,
      rw [cstar_ring.norm_star_mul_self, ←sq],
      refine sq_le_sq' _ _,
      { linarith [norm_nonneg (f x), norm_nonneg f] },
      { exact norm_coe_le_norm f x }, },
    { rw [←sq, ←real.le_sqrt (norm_nonneg _) (norm_nonneg _), norm_le (real.sqrt_nonneg _)],
      intro x,
      rw [real.le_sqrt (norm_nonneg _) (norm_nonneg _), sq, ←cstar_ring.norm_star_mul_self],
      exact norm_coe_le_norm (star f * f) x }
  end }

end cstar_ring

section normed_lattice_ordered_group

variables [topological_space α] [normed_lattice_add_comm_group β]

instance : partial_order (α →ᵇ β) := partial_order.lift (λ f, f.to_fun) (by tidy)

/--
Continuous normed lattice group valued functions form a meet-semilattice
-/
instance : semilattice_inf (α →ᵇ β) :=
{ inf := λ f g,
  { to_fun := λ t, f t ⊓ g t,
    continuous_to_fun := f.continuous.inf g.continuous,
    bounded' := begin
      cases f.bounded' with C₁ hf,
      cases g.bounded' with C₂ hg,
      refine ⟨C₁ + C₂, λ x y, _⟩,
      simp_rw normed_group.dist_eq at hf hg ⊢,
      exact (norm_inf_sub_inf_le_add_norm _ _ _ _).trans (add_le_add (hf _ _) (hg _ _)),
    end },
  inf_le_left := λ f g, continuous_map.le_def.mpr (λ _, inf_le_left),
  inf_le_right := λ f g, continuous_map.le_def.mpr (λ _, inf_le_right),
  le_inf := λ f g₁ g₂ w₁ w₂, continuous_map.le_def.mpr (λ _, le_inf (continuous_map.le_def.mp w₁ _)
    (continuous_map.le_def.mp w₂ _)),
  ..bounded_continuous_function.partial_order }

instance : semilattice_sup (α →ᵇ β) :=
{ sup := λ f g,
  { to_fun := λ t, f t ⊔ g t,
    continuous_to_fun := f.continuous.sup g.continuous,
    bounded' := begin
      cases f.bounded' with C₁ hf,
      cases g.bounded' with C₂ hg,
      refine ⟨C₁ + C₂, λ x y, _⟩,
      simp_rw normed_group.dist_eq at hf hg ⊢,
      exact (norm_sup_sub_sup_le_add_norm _ _ _ _).trans (add_le_add (hf _ _) (hg _ _)),
    end },
  le_sup_left := λ f g, continuous_map.le_def.mpr (λ _, le_sup_left),
  le_sup_right := λ f g, continuous_map.le_def.mpr (λ _, le_sup_right),
  sup_le := λ f g₁ g₂ w₁ w₂, continuous_map.le_def.mpr (λ _, sup_le (continuous_map.le_def.mp w₁ _)
    (continuous_map.le_def.mp w₂ _)),
  ..bounded_continuous_function.partial_order }

instance  : lattice (α →ᵇ β) :=
{ .. bounded_continuous_function.semilattice_sup, .. bounded_continuous_function.semilattice_inf }

@[simp] lemma coe_fn_sup (f g : α →ᵇ β) : ⇑(f ⊔ g) = f ⊔ g := rfl

@[simp] lemma coe_fn_abs (f : α →ᵇ β) : ⇑|f| = |f| := rfl

instance : normed_lattice_add_comm_group (α →ᵇ β) :=
{ add_le_add_left := begin
    intros f g h₁ h t,
    simp only [coe_to_continuous_fun, pi.add_apply, add_le_add_iff_left, coe_add,
      continuous_map.to_fun_eq_coe],
    exact h₁ _,
  end,
  solid :=
  begin
    intros f g h,
    have i1: ∀ t, ∥f t∥ ≤ ∥g t∥ := λ t, solid (h t),
    rw norm_le (norm_nonneg _),
    exact λ t, (i1 t).trans (norm_coe_le_norm g t),
  end,
  ..bounded_continuous_function.lattice, }

end normed_lattice_ordered_group

end bounded_continuous_function


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

! This file was ported from Lean 3 source module ring_theory.quotient_nilpotent
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Nilpotent
import Mathbin.RingTheory.Ideal.QuotientOperations

/-!
# Nilpotent elements in quotient rings
-/

theorem Ideal.isRadical_iff_quotient_reduced {R : Type _} [CommRing R] (I : Ideal R) :
    I.IsRadical ↔ IsReduced (R ⧸ I) :=
  by
  conv_lhs => rw [← @Ideal.mk_ker R _ I]
  exact RingHom.ker_isRadical_iff_reduced_of_surjective (@Ideal.Quotient.mk_surjective R _ I)
#align ideal.is_radical_iff_quotient_reduced Ideal.isRadical_iff_quotient_reduced

variable {R S : Type _} [CommSemiring R] [CommRing S] [Algebra R S] (I : Ideal S)

/-- Let `P` be a property on ideals. If `P` holds for square-zero ideals, and if
  `P I → P (J ⧸ I) → P J`, then `P` holds for all nilpotent ideals. -/
theorem Ideal.IsNilpotent.induction_on (hI : IsNilpotent I)
    {P : ∀ ⦃S : Type _⦄ [CommRing S], ∀ I : Ideal S, Prop}
    (h₁ : ∀ ⦃S : Type _⦄ [CommRing S], ∀ I : Ideal S, I ^ 2 = ⊥ → P I)
    (h₂ :
      ∀ ⦃S : Type _⦄ [CommRing S],
        ∀ I J : Ideal S, I ≤ J → P I → P (J.map (Ideal.Quotient.mk I)) → P J) :
    P I := by
  obtain ⟨n, hI : I ^ n = ⊥⟩ := hI
  revert S
  apply Nat.strong_induction_on n
  clear n
  intro n H S _ I hI
  by_cases hI' : I = ⊥
  · subst hI'
    apply h₁
    rw [← Ideal.zero_eq_bot, zero_pow]
    exact zero_lt_two
  cases n
  · rw [pow_zero, Ideal.one_eq_top] at hI
    haveI := subsingleton_of_bot_eq_top hI.symm
    exact (hI' (Subsingleton.elim _ _)).elim
  cases n
  · rw [pow_one] at hI
    exact (hI' hI).elim
  apply h₂ (I ^ 2) _ (Ideal.pow_le_self two_ne_zero)
  · apply H n.succ _ (I ^ 2)
    · rw [← pow_mul, eq_bot_iff, ← hI, Nat.succ_eq_add_one, Nat.succ_eq_add_one]
      exact Ideal.pow_le_pow (by linarith)
    · exact le_refl n.succ.succ
  · apply h₁
    rw [← Ideal.map_pow, Ideal.map_quotient_self]
#align ideal.is_nilpotent.induction_on Ideal.IsNilpotent.induction_on

theorem IsNilpotent.isUnit_quotient_mk_iff {R : Type _} [CommRing R] {I : Ideal R}
    (hI : IsNilpotent I) {x : R} : IsUnit (Ideal.Quotient.mk I x) ↔ IsUnit x :=
  by
  refine' ⟨_, fun h => h.map I.Quotient.mk⟩
  revert x
  apply Ideal.IsNilpotent.induction_on I hI <;> clear hI I
  swap
  · introv e h₁ h₂ h₃
    apply h₁
    apply h₂
    exact
      h₃.map
        ((DoubleQuot.quotQuotEquivQuotSup I J).trans
              (Ideal.quotEquivOfEq (sup_eq_right.mpr e))).symm.toRingHom
  · introv e H
    skip
    obtain ⟨y, hy⟩ := Ideal.Quotient.mk_surjective (↑H.unit⁻¹ : S ⧸ I)
    have : Ideal.Quotient.mk I (x * y) = Ideal.Quotient.mk I 1 := by
      rw [map_one, _root_.map_mul, hy, IsUnit.mul_val_inv]
    rw [Ideal.Quotient.eq] at this
    have : (x * y - 1) ^ 2 = 0 := by
      rw [← Ideal.mem_bot, ← e]
      exact Ideal.pow_mem_pow this _
    have : x * (y * (2 - x * y)) = 1 :=
      by
      rw [eq_comm, ← sub_eq_zero, ← this]
      ring
    exact isUnit_of_mul_eq_one _ _ this
#align is_nilpotent.is_unit_quotient_mk_iff IsNilpotent.isUnit_quotient_mk_iff


-- Regla de introducción de la unión
-- =================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    A ⊆ A ∪ B
-- ----------------------------------------------------

import data.set

variable  U : Type
variables A B : set U
variable  x : U

open set

-- #reduce x ∈ A ∪ B

-- 1ª demostración
example : A ⊆ A ∪ B :=
begin
  intros x h,
  simp,
  left,
  exact h,
end

-- 2ª demostración
example : A ⊆ A ∪ B :=
begin
  intros x h,
  left,
  exact h,
end

-- 3ª demostración
example : A ⊆ A ∪ B :=
assume x,
assume h : x ∈ A,
show x ∈ A ∪ B, from or.inl h

-- 4ª demostración
example : A ⊆ A ∪ B :=
assume x,
assume h : x ∈ A,
or.inl h

-- 5ª demostración
example : A ⊆ A ∪ B :=
assume x,
λ h : x ∈ A, or.inl h

-- 6ª demostración
example : A ⊆ A ∪ B :=
assume x, or.inl

-- 7ª demostración
example : A ⊆ A ∪ B :=
λ x, or.inl

-- 8ª demostración
example : A ⊆ A ∪ B :=
-- by library_search
subset_union_left A B

-- 9ª demostración
example : A ⊆ A ∪ B :=
λ x, mem_union_left B

-- 10ª demostración
example : A ⊆ A ∪ B :=
-- by hint
by finish

-- 11ª demostración
example : A ⊆ A ∪ B :=
by simp


/-
M1F 2017-18 Sheet 1 Question 2 to 4 solutions.
Author : Kevin Buzzard
This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/
-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q4.

-- Let me first make a tool which is capable of proving all three hypotheses
-- when we have the right assumptions.

meta def prove_hyps : tactic unit :=
`[
  { -- This tactic will try to prove
    -- (P → Q ∨ R) ∧ (¬ Q → R ∨ ¬ P) ∧ (Q ∧ R → ¬ P)
    apply and.intro, -- next goal is P → Q ∨ R
      intro, -- now P is a hypothesis and Q ∨ R is the goal.
      -- next line works if any of ¬ P or Q or R are true.
      contradiction <|> {left,assumption} <|> {right,assumption},
    apply and.intro, -- same story,
      intro,contradiction <|> {left,assumption} <|> {right,assumption},
    -- next line attempts to prove Q and R -> not P.
    intro HQR, --
    have Q, from HQR.left,
    have R, from HQR.right,
    -- now Q and R are assumptions and not P is the goal.
    assumption <|> contradiction
  }
]

-- I used that tool to figure out what the answer is.

-- The answer to Q4 is that all three hypotheses are true if and only if either
-- (i) P is false, or
-- (ii) P is true, and exactly one of Q and R are true.

-- It's possible to write a very long proof of this.
-- But in this case I just did a brute force case by case check,
-- using basic tactics joined together with glue I learnt about
-- in section 5.5 of Theorem Proving In Lean.

theorem m1f_sheet01_q04 : (P → (Q ∨ R)) ∧ (¬ Q → (R ∨ ¬ P)) ∧ ((Q ∧ R) → ¬ P) ↔
  (¬ P) ∨ (P ∧ Q ∧ ¬ R) ∨ (P ∧ ¬ Q ∧ R) :=
begin
cases em P with HP HnP;cases em Q with HQ HnQ;cases em R with HR HnR;apply iff.intro,
repeat {-- we'll do all eight cases automatically.
  intro hyps,
  cc, -- this does the case where hyps implies my solution
  -- now check my solution implies hyps (possibly by contradiction)
  intro hmypqr,
  { prove_hyps } <|> {
    cases hmypqr with h1 h2,
    contradiction,
    cases h2 with ha hb,
    cases ha with h3 h4,
    cases h4,
    contradiction,
    cases hb with h5 h6,
    cases h6,
    contradiction
  }
},
end


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

/-!
# Quotients by submodules

* If `p` is a submodule of `M`, `M ⧸ p` is the quotient of `M` with respect to `p`:
  that is, elements of `M` are identified if their difference is in `p`. This is itself a module.

-/

-- For most of this file we work over a noncommutative ring
section ring

namespace submodule

variables {R M : Type*} {r : R} {x y : M} [ring R] [add_comm_group M] [module R M]
variables (p p' : submodule R M)

open linear_map

-- TODO(Mario): Factor through add_subgroup
/-- The equivalence relation associated to a submodule `p`, defined by `x ≈ y` iff `y - x ∈ p`. -/
def quotient_rel : setoid M :=
⟨λ x y, x - y ∈ p, λ x, by simp,
 λ x y h, by simpa using neg_mem _ h,
 λ x y z h₁ h₂, by simpa [sub_eq_add_neg, add_left_comm, add_assoc] using add_mem _ h₁ h₂⟩

/-- The quotient of a module `M` by a submodule `p ⊆ M`. -/
instance has_quotient : has_quotient M (submodule R M) := ⟨λ p, quotient (quotient_rel p)⟩

namespace quotient

/-- Map associating to an element of `M` the corresponding element of `M/p`,
when `p` is a submodule of `M`. -/
def mk {p : submodule R M} : M → M ⧸ p := quotient.mk'

@[simp] theorem mk_eq_mk {p : submodule R M} (x : M) :
  (@_root_.quotient.mk _ (quotient_rel p) x) = mk x := rfl
@[simp] theorem mk'_eq_mk {p : submodule R M} (x : M) : (quotient.mk' x : M ⧸ p) = mk x := rfl
@[simp] theorem quot_mk_eq_mk {p : submodule R M} (x : M) : (quot.mk _ x : M ⧸ p) = mk x := rfl

protected theorem eq {x y : M} : (mk x : M ⧸ p) = mk y ↔ x - y ∈ p := quotient.eq'

instance : has_zero (M ⧸ p) := ⟨mk 0⟩
instance : inhabited (M ⧸ p) := ⟨0⟩

@[simp] theorem mk_zero : mk 0 = (0 : M ⧸ p) := rfl

@[simp] theorem mk_eq_zero : (mk x : M ⧸ p) = 0 ↔ x ∈ p :=
by simpa using (quotient.eq p : mk x = 0 ↔ _)

instance : has_add (M ⧸ p) :=
⟨λ a b, quotient.lift_on₂' a b (λ a b, mk (a + b)) $
  λ a₁ a₂ b₁ b₂ h₁ h₂, (quotient.eq p).2 $
    by simpa [sub_eq_add_neg, add_left_comm, add_comm] using add_mem p h₁ h₂⟩

@[simp] theorem mk_add : (mk (x + y) : M ⧸ p) = mk x + mk y := rfl

instance : has_neg (M ⧸ p) :=
⟨λ a, quotient.lift_on' a (λ a, mk (-a)) $
 λ a b h, (quotient.eq p).2 $ by simpa using neg_mem p h⟩

@[simp] theorem mk_neg : (mk (-x) : M ⧸ p) = -mk x := rfl

instance : has_sub (M ⧸ p) :=
⟨λ a b, quotient.lift_on₂' a b (λ a b, mk (a - b)) $
  λ a₁ a₂ b₁ b₂ h₁ h₂, (quotient.eq p).2 $
  by simpa [sub_eq_add_neg, add_left_comm, add_comm] using add_mem p h₁ (neg_mem p h₂)⟩

@[simp] theorem mk_sub : (mk (x - y) : M ⧸ p) = mk x - mk y := rfl

instance add_comm_group : add_comm_group (M ⧸ p) :=
{ zero := (0 : M ⧸ p),
  add := (+),
  neg := has_neg.neg,
  sub := has_sub.sub,
  add_assoc := by { rintros ⟨x⟩ ⟨y⟩ ⟨z⟩, simp only [←mk_add p, quot_mk_eq_mk, add_assoc] },
  zero_add := by { rintro ⟨x⟩, simp only [←mk_zero p, ←mk_add p, quot_mk_eq_mk, zero_add] },
  add_zero := by { rintro ⟨x⟩, simp only [←mk_zero p, ←mk_add p, add_zero, quot_mk_eq_mk] },
  add_comm := by { rintros ⟨x⟩ ⟨y⟩, simp only [←mk_add p, quot_mk_eq_mk, add_comm] },
  add_left_neg := by { rintro ⟨x⟩,
    simp only [←mk_zero p, ←mk_add p, ←mk_neg p, quot_mk_eq_mk, add_left_neg] },
  sub_eq_add_neg := by { rintros ⟨x⟩ ⟨y⟩,
    simp only [←mk_add p, ←mk_neg p, ←mk_sub p, sub_eq_add_neg, quot_mk_eq_mk] },
  nsmul := λ n x, quotient.lift_on' x (λ x, mk (n • x)) $
     λ x y h, (quotient.eq p).2 $ by simpa [smul_sub] using smul_of_tower_mem p n h,
  nsmul_zero' := by { rintros ⟨⟩, simp only [mk_zero, quot_mk_eq_mk, zero_smul], refl },
  nsmul_succ' := by { rintros n ⟨⟩,
    simp only [nat.succ_eq_one_add, add_nsmul, mk_add, quot_mk_eq_mk, one_nsmul], refl },
  zsmul := λ n x, quotient.lift_on' x (λ x, mk (n • x)) $
     λ x y h, (quotient.eq p).2 $ by simpa [smul_sub] using smul_of_tower_mem p n h,
  zsmul_zero' := by { rintros ⟨⟩, simp only [mk_zero, quot_mk_eq_mk, zero_smul], refl },
  zsmul_succ' := by { rintros n ⟨⟩,
    simp [nat.succ_eq_add_one, add_nsmul, mk_add, quot_mk_eq_mk, one_nsmul, add_smul, add_comm],
    refl },
  zsmul_neg' := by { rintros n ⟨x⟩, simp_rw [zsmul_neg_succ_of_nat, coe_nat_zsmul], refl }, }

section has_scalar

variables {S : Type*} [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] (P : submodule R M)

instance has_scalar' : has_scalar S (M ⧸ P) :=
⟨λ a, quotient.map' ((•) a) $ λ x y h, by simpa [smul_sub] using P.smul_mem (a • 1 : R) h⟩

/-- Shortcut to help the elaborator in the common case. -/
instance has_scalar : has_scalar R (M ⧸ P) :=
quotient.has_scalar' P

@[simp] theorem mk_smul (r : S) (x : M) : (mk (r • x) : M ⧸ p) = r • mk x := rfl

instance (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M]
  [smul_comm_class S T M] : smul_comm_class S T (M ⧸ P) :=
{ smul_comm := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_comm _ _ _) }

instance (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M] [has_scalar S T]
  [is_scalar_tower S T M] : is_scalar_tower S T (M ⧸ P) :=
{ smul_assoc := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_assoc _ _ _) }

end has_scalar

section module

variables {S : Type*}

instance mul_action' [monoid S] [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
  (P : submodule R M) : mul_action S (M ⧸ P) :=
function.surjective.mul_action mk (surjective_quot_mk _) P^.quotient.mk_smul

instance mul_action (P : submodule R M) : mul_action R (M ⧸ P) :=
quotient.mul_action' P

instance distrib_mul_action' [monoid S] [has_scalar S R] [distrib_mul_action S M]
  [is_scalar_tower S R M]
  (P : submodule R M) : distrib_mul_action S (M ⧸ P) :=
function.surjective.distrib_mul_action
  ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul

instance distrib_mul_action (P : submodule R M) : distrib_mul_action R (M ⧸ P) :=
quotient.distrib_mul_action' P

instance module' [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
  (P : submodule R M) : module S (M ⧸ P) :=
function.surjective.module _
  ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul

instance module (P : submodule R M) : module R (M ⧸ P) :=
quotient.module' P

variables (S)

/-- The quotient of `P` as an `S`-submodule is the same as the quotient of `P` as an `R`-submodule,
where `P : submodule R M`.
-/
def restrict_scalars_equiv [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
  (P : submodule R M) :
  (M ⧸ P.restrict_scalars S) ≃ₗ[S] M ⧸ P :=
{ map_add' := λ x y, quotient.induction_on₂' x y (λ x' y', rfl),
  map_smul' := λ c x, quotient.induction_on' x (λ x', rfl),
  ..quotient.congr_right $ λ _ _, iff.rfl }

@[simp] lemma restrict_scalars_equiv_mk
  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
  (x : M) : restrict_scalars_equiv S P (mk x) = mk x :=
rfl

@[simp] lemma restrict_scalars_equiv_symm_mk
  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
  (x : M) : (restrict_scalars_equiv S P).symm (mk x) = mk x :=
rfl

end module

lemma mk_surjective : function.surjective (@mk _ _ _ _ _ p) :=
by { rintros ⟨x⟩, exact ⟨x, rfl⟩ }

lemma nontrivial_of_lt_top (h : p < ⊤) : nontrivial (M ⧸ p) :=
begin
  obtain ⟨x, _, not_mem_s⟩ := set_like.exists_of_lt h,
  refine ⟨⟨mk x, 0, _⟩⟩,
  simpa using not_mem_s
end

end quotient

section

variables {M₂ : Type*} [add_comm_group M₂] [module R M₂]

lemma quot_hom_ext ⦃f g : M ⧸ p →ₗ[R] M₂⦄ (h : ∀ x, f (quotient.mk x) = g (quotient.mk x)) :
  f = g :=
linear_map.ext $ λ x, quotient.induction_on' x h

/-- The map from a module `M` to the quotient of `M` by a submodule `p` as a linear map. -/
def mkq : M →ₗ[R] M ⧸ p :=
{ to_fun := quotient.mk, map_add' := by simp, map_smul' := by simp }

@[simp] theorem mkq_apply (x : M) : p.mkq x = quotient.mk x := rfl

end

variables {R₂ M₂ : Type*} [ring R₂] [add_comm_group M₂] [module R₂ M₂] {τ₁₂ : R →+* R₂}

/-- Two `linear_map`s from a quotient module are equal if their compositions with
`submodule.mkq` are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma linear_map_qext ⦃f g : M ⧸ p →ₛₗ[τ₁₂] M₂⦄ (h : f.comp p.mkq = g.comp p.mkq) : f = g :=
linear_map.ext $ λ x, quotient.induction_on' x $ (linear_map.congr_fun h : _)

/-- The map from the quotient of `M` by a submodule `p` to `M₂` induced by a linear map `f : M → M₂`
vanishing on `p`, as a linear map. -/
def liftq (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ f.ker) : M ⧸ p →ₛₗ[τ₁₂] M₂ :=
{ to_fun := λ x, _root_.quotient.lift_on' x f $
    λ a b (ab : a - b ∈ p), eq_of_sub_eq_zero $ by simpa using h ab,
  map_add' := by rintro ⟨x⟩ ⟨y⟩; exact f.map_add x y,
  map_smul' := by rintro a ⟨x⟩; exact f.map_smulₛₗ a x }

@[simp] theorem liftq_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) :
  p.liftq f h (quotient.mk x) = f x := rfl

@[simp] theorem liftq_mkq (f : M →ₛₗ[τ₁₂] M₂) (h) : (p.liftq f h).comp p.mkq = f :=
by ext; refl

@[simp] theorem range_mkq : p.mkq.range = ⊤ :=
eq_top_iff'.2 $ by rintro ⟨x⟩; exact ⟨x, rfl⟩

@[simp] theorem ker_mkq : p.mkq.ker = p :=
by ext; simp

lemma le_comap_mkq (p' : submodule R (M ⧸ p)) : p ≤ comap p.mkq p' :=
by simpa using (comap_mono bot_le : p.mkq.ker ≤ comap p.mkq p')

@[simp] theorem mkq_map_self : map p.mkq p = ⊥ :=
by rw [eq_bot_iff, map_le_iff_le_comap, comap_bot, ker_mkq]; exact le_refl _

@[simp] theorem comap_map_mkq : comap p.mkq (map p.mkq p') = p ⊔ p' :=
by simp [comap_map_eq, sup_comm]

@[simp] theorem map_mkq_eq_top : map p.mkq p' = ⊤ ↔ p ⊔ p' = ⊤ :=
by simp only [map_eq_top_iff p.range_mkq, sup_comm, ker_mkq]

variables (q : submodule R₂ M₂)

/-- The map from the quotient of `M` by submodule `p` to the quotient of `M₂` by submodule `q` along
`f : M → M₂` is linear. -/
def mapq (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ comap f q) :
  (M ⧸ p) →ₛₗ[τ₁₂] (M₂ ⧸ q) :=
p.liftq (q.mkq.comp f) $ by simpa [ker_comp] using h

@[simp] theorem mapq_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) :
  mapq p q f h (quotient.mk x) = quotient.mk (f x) := rfl

theorem mapq_mkq (f : M →ₛₗ[τ₁₂] M₂) {h} : (mapq p q f h).comp p.mkq = q.mkq.comp f :=
by ext x; refl

theorem comap_liftq (f : M →ₛₗ[τ₁₂] M₂) (h) :
  q.comap (p.liftq f h) = (q.comap f).map (mkq p) :=
le_antisymm
  (by rintro ⟨x⟩ hx; exact ⟨_, hx, rfl⟩)
  (by rw [map_le_iff_le_comap, ← comap_comp, liftq_mkq]; exact le_refl _)

theorem map_liftq [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) (q : submodule R (M ⧸ p)) :
  q.map (p.liftq f h) = (q.comap p.mkq).map f :=
le_antisymm
  (by rintro _ ⟨⟨x⟩, hxq, rfl⟩; exact ⟨x, hxq, rfl⟩)
  (by rintro _ ⟨x, hxq, rfl⟩; exact ⟨quotient.mk x, hxq, rfl⟩)

theorem ker_liftq (f : M →ₛₗ[τ₁₂] M₂) (h) :
  ker (p.liftq f h) = (ker f).map (mkq p) := comap_liftq _ _ _ _

theorem range_liftq [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) :
  range (p.liftq f h) = range f :=
by simpa only [range_eq_map] using map_liftq _ _ _ _

theorem ker_liftq_eq_bot (f : M →ₛₗ[τ₁₂] M₂) (h) (h' : ker f ≤ p) : ker (p.liftq f h) = ⊥ :=
by rw [ker_liftq, le_antisymm h h', mkq_map_self]

/-- The correspondence theorem for modules: there is an order isomorphism between submodules of the
quotient of `M` by `p`, and submodules of `M` larger than `p`. -/
def comap_mkq.rel_iso :
  submodule R (M ⧸ p) ≃o {p' : submodule R M // p ≤ p'} :=
{ to_fun    := λ p', ⟨comap p.mkq p', le_comap_mkq p _⟩,
  inv_fun   := λ q, map p.mkq q,
  left_inv  := λ p', map_comap_eq_self $ by simp,
  right_inv := λ ⟨q, hq⟩, subtype.ext_val $ by simpa [comap_map_mkq p],
  map_rel_iff'      := λ p₁ p₂, comap_le_comap_iff $ range_mkq _ }

/-- The ordering on submodules of the quotient of `M` by `p` embeds into the ordering on submodules
of `M`. -/
def comap_mkq.order_embedding :
  submodule R (M ⧸ p) ↪o submodule R M :=
(rel_iso.to_rel_embedding $ comap_mkq.rel_iso p).trans (subtype.rel_embedding _ _)

@[simp] lemma comap_mkq_embedding_eq (p' : submodule R (M ⧸ p)) :
  comap_mkq.order_embedding p p' = comap p.mkq p' := rfl

lemma span_preimage_eq [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {s : set M₂} (h₀ : s.nonempty)
  (h₁ : s ⊆ range f) :
  span R (f ⁻¹' s) = (span R₂ s).comap f :=
begin
  suffices : (span R₂ s).comap f ≤ span R (f ⁻¹' s),
  { exact le_antisymm (span_preimage_le f s) this, },
  have hk : ker f ≤ span R (f ⁻¹' s),
  { let y := classical.some h₀, have hy : y ∈ s, { exact classical.some_spec h₀, },
    rw ker_le_iff, use [y, h₁ hy], rw ← set.singleton_subset_iff at hy,
    exact set.subset.trans subset_span (span_mono (set.preimage_mono hy)), },
  rw ← left_eq_sup at hk, rw f.range_coe at h₁,
  rw [hk, ← map_le_map_iff, map_span, map_comap_eq, set.image_preimage_eq_of_subset h₁],
  exact inf_le_right,
end

end submodule

open submodule

namespace linear_map

section ring

variables {R M R₂ M₂ R₃ M₃ : Type*}
variables [ring R] [ring R₂] [ring R₃]
variables [add_comm_monoid M] [add_comm_group M₂] [add_comm_monoid M₃]
variables [module R M] [module R₂ M₂] [module R₃ M₃]
variables {τ₁₂ : R →+* R₂} {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃}
variables [ring_hom_comp_triple τ₁₂ τ₂₃ τ₁₃] [ring_hom_surjective τ₁₂]

lemma range_mkq_comp (f : M →ₛₗ[τ₁₂] M₂) : f.range.mkq.comp f = 0 :=
linear_map.ext $ λ x, by simp

lemma ker_le_range_iff {f : M →ₛₗ[τ₁₂] M₂} {g : M₂ →ₛₗ[τ₂₃] M₃} :
  g.ker ≤ f.range ↔ f.range.mkq.comp g.ker.subtype = 0 :=
by rw [←range_le_ker_iff, submodule.ker_mkq, submodule.range_subtype]

/-- An epimorphism is surjective. -/
lemma range_eq_top_of_cancel {f : M →ₛₗ[τ₁₂] M₂}
  (h : ∀ (u v : M₂ →ₗ[R₂] M₂ ⧸ f.range), u.comp f = v.comp f → u = v) : f.range = ⊤ :=
begin
  have h₁ : (0 : M₂ →ₗ[R₂] M₂ ⧸ f.range).comp f = 0 := zero_comp _,
  rw [←submodule.ker_mkq f.range, ←h 0 f.range.mkq (eq.trans h₁ (range_mkq_comp _).symm)],
  exact ker_zero
end

end ring

end linear_map

open linear_map

namespace submodule

variables {R M : Type*} {r : R} {x y : M} [ring R] [add_comm_group M] [module R M]
variables (p p' : submodule R M)

/-- If `p = ⊥`, then `M / p ≃ₗ[R] M`. -/
def quot_equiv_of_eq_bot (hp : p = ⊥) : (M ⧸ p) ≃ₗ[R] M :=
linear_equiv.of_linear (p.liftq id $ hp.symm ▸ bot_le) p.mkq (liftq_mkq _ _ _) $
  p.quot_hom_ext $ λ x, rfl

@[simp] lemma quot_equiv_of_eq_bot_apply_mk (hp : p = ⊥) (x : M) :
  p.quot_equiv_of_eq_bot hp (quotient.mk x) = x := rfl

@[simp] lemma quot_equiv_of_eq_bot_symm_apply (hp : p = ⊥) (x : M) :
  (p.quot_equiv_of_eq_bot hp).symm x = quotient.mk x := rfl

@[simp] lemma coe_quot_equiv_of_eq_bot_symm (hp : p = ⊥) :
  ((p.quot_equiv_of_eq_bot hp).symm : M →ₗ[R] M ⧸ p) = p.mkq := rfl

/-- Quotienting by equal submodules gives linearly equivalent quotients. -/
def quot_equiv_of_eq (h : p = p') : (M ⧸ p) ≃ₗ[R] M ⧸ p' :=
{ map_add' := by { rintros ⟨x⟩ ⟨y⟩, refl }, map_smul' := by { rintros x ⟨y⟩, refl },
  ..@quotient.congr _ _ (quotient_rel p) (quotient_rel p') (equiv.refl _) $
    λ a b, by { subst h, refl } }

@[simp]
lemma quot_equiv_of_eq_mk (h : p = p') (x : M) :
  submodule.quot_equiv_of_eq p p' h (submodule.quotient.mk x) = submodule.quotient.mk x :=
rfl

end submodule

end ring

section comm_ring

variables {R M M₂ : Type*} {r : R} {x y : M} [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group M₂] [module R M₂]
  (p : submodule R M) (q : submodule R M₂)

namespace submodule

/-- Given modules `M`, `M₂` over a commutative ring, together with submodules `p ⊆ M`, `q ⊆ M₂`,
the natural map $\{f ∈ Hom(M, M₂) | f(p) ⊆ q \} \to Hom(M/p, M₂/q)$ is linear. -/
def mapq_linear : compatible_maps p q →ₗ[R] (M ⧸ p) →ₗ[R] (M₂ ⧸ q) :=
{ to_fun    := λ f, mapq _ _ f.val f.property,
  map_add'  := λ x y, by { ext, refl, },
  map_smul' := λ c f, by { ext, refl, } }

end submodule

end comm_ring


/-
Copyright (c) 2021 Bhavik Mehta, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies
-/
import algebra.big_operators.basic
import data.nat.interval
import order.antichain

/-!
# `r`-sets and slice

This file defines the `r`-th slice of a set family and provides a way to say that a set family is
made of `r`-sets.

An `r`-set is a finset of cardinality `r` (aka of *size* `r`). The `r`-th slice of a set family is
the set family made of its `r`-sets.

## Main declarations

* `set.sized`: `A.sized r` means that `A` only contains `r`-sets.
* `finset.slice`: `A.slice r` is the set of `r`-sets in `A`.

## Notation

`A # r` is notation for `A.slice r` in locale `finset_family`.
-/

open finset nat
open_locale big_operators

variables {α : Type*} {ι : Sort*} {κ : ι → Sort*}

namespace set
variables {A B : set (finset α)} {r : ℕ}

/-! ### Families of `r`-sets -/

/-- `sized r A` means that every finset in `A` has size `r`. -/
def sized (r : ℕ) (A : set (finset α)) : Prop := ∀ ⦃x⦄, x ∈ A → card x = r

lemma sized.mono (h : A ⊆ B) (hB : B.sized r) : A.sized r := λ x hx, hB $ h hx

lemma sized_union : (A ∪ B).sized r ↔ A.sized r ∧ B.sized r :=
⟨λ hA, ⟨hA.mono $ subset_union_left _ _, hA.mono $ subset_union_right _ _⟩,
  λ hA x hx, hx.elim (λ h, hA.1 h) $ λ h, hA.2 h⟩

alias sized_union ↔ _ sized.union

--TODO: A `forall_Union` lemma would be handy here.
@[simp] lemma sized_Union {f : ι → set (finset α)} : (⋃ i, f i).sized r ↔ ∀ i, (f i).sized r :=
by { simp_rw [set.sized, set.mem_Union, forall_exists_index], exact forall_swap }

@[simp] lemma sized_Union₂ {f : Π i, κ i → set (finset α)} :
  (⋃ i j, f i j).sized r ↔ ∀ i j, (f i j).sized r :=
by simp_rw sized_Union

protected lemma sized.is_antichain (hA : A.sized r) : is_antichain (⊆) A :=
λ s hs t ht h hst, h $ finset.eq_of_subset_of_card_le hst ((hA ht).trans (hA hs).symm).le

protected lemma sized.subsingleton (hA : A.sized 0) : A.subsingleton :=
subsingleton_of_forall_eq ∅ $ λ s hs, card_eq_zero.1 $ hA hs

lemma sized.subsingleton' [fintype α] (hA : A.sized (fintype.card α)) : A.subsingleton :=
subsingleton_of_forall_eq finset.univ $ λ s hs, s.card_eq_iff_eq_univ.1 $ hA hs

lemma sized.empty_mem_iff (hA : A.sized r) : ∅ ∈ A ↔ A = {∅} := hA.is_antichain.bot_mem_iff

lemma sized.univ_mem_iff [fintype α] (hA : A.sized r) : finset.univ ∈ A ↔ A = {finset.univ} :=
hA.is_antichain.top_mem_iff

lemma sized_powerset_len (s : finset α) (r : ℕ) : (powerset_len r s : set (finset α)).sized r :=
λ t ht, (mem_powerset_len.1 ht).2

end set

namespace finset
section sized
variables [fintype α] {𝒜 : finset (finset α)} {s : finset α} {r : ℕ}

lemma subset_powerset_len_univ_iff : 𝒜 ⊆ powerset_len r univ ↔ (𝒜 : set (finset α)).sized r :=
forall_congr $ λ A, by rw [mem_powerset_len_univ_iff, mem_coe]

alias subset_powerset_len_univ_iff  ↔ _ _root_.set.sized.subset_powerset_len_univ

lemma _root_.set.sized.card_le (h𝒜 : (𝒜 : set (finset α)).sized r) :
  card 𝒜 ≤ (fintype.card α).choose r :=
begin
  rw [fintype.card, ←card_powerset_len],
  exact card_le_of_subset h𝒜.subset_powerset_len_univ,
end

end sized

/-! ### Slices -/

section slice
variables {𝒜 : finset (finset α)} {A A₁ A₂ : finset α} {r r₁ r₂ : ℕ}

/-- The `r`-th slice of a set family is the subset of its elements which have cardinality `r`. -/
def slice (𝒜 : finset (finset α)) (r : ℕ) : finset (finset α) := 𝒜.filter (λ i, i.card = r)

localized "infix ` # `:90 := finset.slice" in finset_family

/-- `A` is in the `r`-th slice of `𝒜` iff it's in `𝒜` and has cardinality `r`. -/
lemma mem_slice : A ∈ 𝒜 # r ↔ A ∈ 𝒜 ∧ A.card = r := mem_filter

/-- The `r`-th slice of `𝒜` is a subset of `𝒜`. -/
lemma slice_subset : 𝒜 # r ⊆ 𝒜 := filter_subset _ _

/-- Everything in the `r`-th slice of `𝒜` has size `r`. -/
lemma sized_slice : (𝒜 # r : set (finset α)).sized r := λ _, and.right ∘ mem_slice.mp

lemma eq_of_mem_slice (h₁ : A ∈ 𝒜 # r₁) (h₂ : A ∈ 𝒜 # r₂) : r₁ = r₂ :=
(sized_slice h₁).symm.trans $ sized_slice h₂

/-- Elements in distinct slices must be distinct. -/
lemma ne_of_mem_slice (h₁ : A₁ ∈ 𝒜 # r₁) (h₂ : A₂ ∈ 𝒜 # r₂) : r₁ ≠ r₂ → A₁ ≠ A₂ :=
mt $ λ h, (sized_slice h₁).symm.trans ((congr_arg card h).trans (sized_slice h₂))

lemma pairwise_disjoint_slice [decidable_eq α] : (set.univ : set ℕ).pairwise_disjoint (slice 𝒜) :=
λ m _ n _ hmn, disjoint_filter.2 $ λ s hs hm hn, hmn $ hm.symm.trans hn

variables [fintype α] (𝒜)

@[simp] lemma bUnion_slice [decidable_eq α] : (Iic $ fintype.card α).bUnion 𝒜.slice = 𝒜 :=
subset.antisymm (bUnion_subset.2 $ λ r _, slice_subset) $ λ s hs,
  mem_bUnion.2 ⟨s.card, mem_Iic.2 $ s.card_le_univ, mem_slice.2 $ ⟨hs, rfl⟩⟩

@[simp] lemma sum_card_slice : ∑ r in Iic (fintype.card α), (𝒜 # r).card = 𝒜.card :=
by { rw [←card_bUnion (finset.pairwise_disjoint_slice.subset (set.subset_univ _)), bUnion_slice],
  exact classical.dec_eq _ }

end slice
end finset


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

! This file was ported from Lean 3 source module algebra.char_p.exp_char
! leanprover-community/mathlib commit 932872382355f00112641d305ba0619305dc8642
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Basic
import Mathbin.Data.Nat.Prime

/-!
# Exponential characteristic

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

This file defines the exponential characteristic and establishes a few basic results relating
it to the (ordinary characteristic).
The definition is stated for a semiring, but the actual results are for nontrivial rings
(as far as exponential characteristic one is concerned), respectively a ring without zero-divisors
(for prime characteristic).

## Main results
- `exp_char`: the definition of exponential characteristic
- `exp_char_is_prime_or_one`: the exponential characteristic is a prime or one
- `char_eq_exp_char_iff`: the characteristic equals the exponential characteristic iff the
  characteristic is prime

## Tags
exponential characteristic, characteristic
-/

universe u

variable (R : Type u)

section Semiring

variable [Semiring R]

#print ExpChar /-
/-- The definition of the exponential characteristic of a semiring. -/
class inductive ExpChar (R : Type u) [Semiring R] : ℕ → Prop
  | zero [CharZero R] : ExpChar 1
  | Prime {q : ℕ} (hprime : q.Prime) [hchar : CharP R q] : ExpChar q
#align exp_char ExpChar
-/

#print expChar_one_of_char_zero /-
/-- The exponential characteristic is one if the characteristic is zero. -/
theorem expChar_one_of_char_zero (q : ℕ) [hp : CharP R 0] [hq : ExpChar R q] : q = 1 :=
  by
  cases' hq with q hq_one hq_prime
  · rfl
  · exact False.elim (lt_irrefl _ ((hp.eq R hq_hchar).symm ▸ hq_prime : (0 : ℕ).Prime).Pos)
#align exp_char_one_of_char_zero expChar_one_of_char_zero
-/

#print char_eq_expChar_iff /-
/-- The characteristic equals the exponential characteristic iff the former is prime. -/
theorem char_eq_expChar_iff (p q : ℕ) [hp : CharP R p] [hq : ExpChar R q] : p = q ↔ p.Prime :=
  by
  cases' hq with q hq_one hq_prime
  · apply iff_of_false
    · rintro rfl
      exact one_ne_zero (hp.eq R (CharP.ofCharZero R))
    · intro pprime
      rw [(CharP.eq R hp inferInstance : p = 0)] at pprime
      exact Nat.not_prime_zero pprime
  · exact ⟨fun hpq => hpq.symm ▸ hq_prime, fun _ => CharP.eq R hp hq_hchar⟩
#align char_eq_exp_char_iff char_eq_expChar_iff
-/

section Nontrivial

variable [Nontrivial R]

#print char_zero_of_expChar_one /-
/-- The exponential characteristic is one if the characteristic is zero. -/
theorem char_zero_of_expChar_one (p : ℕ) [hp : CharP R p] [hq : ExpChar R 1] : p = 0 :=
  by
  cases hq
  · exact CharP.eq R hp inferInstance
  · exact False.elim (CharP.char_ne_one R 1 rfl)
#align char_zero_of_exp_char_one char_zero_of_expChar_one
-/

#print charZero_of_expChar_one' /-
-- see Note [lower instance priority]
/-- The characteristic is zero if the exponential characteristic is one. -/
instance (priority := 100) charZero_of_expChar_one' [hq : ExpChar R 1] : CharZero R :=
  by
  cases hq
  · assumption
  · exact False.elim (CharP.char_ne_one R 1 rfl)
#align char_zero_of_exp_char_one' charZero_of_expChar_one'
-/

#print expChar_one_iff_char_zero /-
/-- The exponential characteristic is one iff the characteristic is zero. -/
theorem expChar_one_iff_char_zero (p q : ℕ) [CharP R p] [ExpChar R q] : q = 1 ↔ p = 0 :=
  by
  constructor
  · rintro rfl
    exact char_zero_of_expChar_one R p
  · rintro rfl
    exact expChar_one_of_char_zero R q
#align exp_char_one_iff_char_zero expChar_one_iff_char_zero
-/

section NoZeroDivisors

variable [NoZeroDivisors R]

/- warning: char_prime_of_ne_zero -> char_prime_of_ne_zero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : Semiring.{u1} R] [_inst_2 : Nontrivial.{u1} R] [_inst_3 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))] {p : Nat} [hp : CharP.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) p], (Ne.{1} Nat p (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Nat.Prime p)
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : Semiring.{u1} R] [_inst_2 : Nontrivial.{u1} R] [_inst_3 : NoZeroDivisors.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))] {p : Nat} [hp : CharP.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) p], (Ne.{1} Nat p (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Nat.Prime p)
Case conversion may be inaccurate. Consider using '#align char_prime_of_ne_zero char_prime_of_ne_zeroₓ'. -/
/-- A helper lemma: the characteristic is prime if it is non-zero. -/
theorem char_prime_of_ne_zero {p : ℕ} [hp : CharP R p] (p_ne_zero : p ≠ 0) : Nat.Prime p :=
  by
  cases' CharP.char_is_prime_or_zero R p with h h
  · exact h
  · contradiction
#align char_prime_of_ne_zero char_prime_of_ne_zero

/- warning: exp_char_is_prime_or_one -> expChar_is_prime_or_one is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : Semiring.{u1} R] [_inst_2 : Nontrivial.{u1} R] [_inst_3 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))] (q : Nat) [hq : ExpChar.{u1} R _inst_1 q], Or (Nat.Prime q) (Eq.{1} Nat q (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : Semiring.{u1} R] (_inst_2 : Nat) [_inst_3 : ExpChar.{u1} R _inst_1 _inst_2], Or (Nat.Prime _inst_2) (Eq.{1} Nat _inst_2 (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))
Case conversion may be inaccurate. Consider using '#align exp_char_is_prime_or_one expChar_is_prime_or_oneₓ'. -/
/-- The exponential characteristic is a prime number or one. -/
theorem expChar_is_prime_or_one (q : ℕ) [hq : ExpChar R q] : Nat.Prime q ∨ q = 1 :=
  or_iff_not_imp_right.mpr fun h =>
    by
    cases' CharP.exists R with p hp
    have p_ne_zero : p ≠ 0 := by
      intro p_zero
      have : CharP R 0 := by rwa [← p_zero]
      have : q = 1 := expChar_one_of_char_zero R q
      contradiction
    have p_eq_q : p = q := (char_eq_expChar_iff R p q).mpr (char_prime_of_ne_zero R p_ne_zero)
    cases' CharP.char_is_prime_or_zero R p with pprime
    · rwa [p_eq_q] at pprime
    · contradiction
#align exp_char_is_prime_or_one expChar_is_prime_or_one

end NoZeroDivisors

end Nontrivial

end Semiring


/-
Copyright (c) 2023 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli
-/
import measure_theory.measure.lebesgue
import analysis.calculus.monotone
import data.set.function
import analysis.bounded_variation
import tactic.swap_var
/-!
# Constant speed

This file defines the notion of constant (and unit) speed for a function `f : ℝ → E` with
pseudo-emetric structure on `E` with respect to a set `s : set ℝ` and "speed" `l : ℝ≥0`, and shows
that if `f` has locally bounded variation on `s`, it can be obtained (up to distance zero, on `s`),
as a composite `φ ∘ (variation_on_from_to f s a)`, where `φ` has unit speed and `a ∈ s`.

## Main definitions

* `has_constant_speed_on_with f s l`, stating that the speed of `f` on `s` is `l`.
* `has_unit_speed_on f s`, stating that the speed of `f` on `s` is `1`.
* `natural_parameterization f s a : ℝ → E`, the unit speed reparameterization of `f` on `s` relative
  to `a`.

## Main statements

* `unique_unit_speed_on_Icc_zero` proves that if `f` and `f ∘ φ` are both naturally
  parameterized on closed intervals starting at `0`, then `φ` must be the identity on
  those intervals.
* `edist_natural_parameterization_eq_zero` proves that if `f` has locally bounded variation, then
  precomposing `natural_parameterization f s a` with `variation_on_from_to f s a` yields a function
  at distance zero from `f` on `s`.
* `has_unit_speed_natural_parameterization` proves that if `f` has locally bounded
  variation, then `natural_parameterization f s a` has unit speed on `s`.

## Tags

arc-length, parameterization
-/

open_locale big_operators nnreal ennreal
open set measure_theory classical

variables {α : Type*} [linear_order α] {E : Type*} [pseudo_emetric_space E]
variables (f : ℝ → E) (s : set ℝ) (l : ℝ≥0)

/--
`f` has constant speed `l` on `s` if the variation of `f` on `s ∩ Icc x y` is equal to
`l * (y - x)` for any `x y` in `s`.
-/
def has_constant_speed_on_with :=
∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), evariation_on f (s ∩ Icc x y) = ennreal.of_real (l * (y - x))

variables {f} {s} {l}

lemma has_constant_speed_on_with.has_locally_bounded_variation_on
  (h : has_constant_speed_on_with f s l) : has_locally_bounded_variation_on f s := λ x y hx hy,
by simp only [has_bounded_variation_on, h hx hy, ne.def, ennreal.of_real_ne_top, not_false_iff]

lemma has_constant_speed_on_with_of_subsingleton
  (f : ℝ → E) {s : set ℝ} (hs : s.subsingleton) (l : ℝ≥0) : has_constant_speed_on_with f s l :=
begin
  rintro x hx y hy, cases hs hx hy,
  rw evariation_on.subsingleton f (λ y hy z hz, hs hy.1 hz.1 : (s ∩ Icc x x).subsingleton),
  simp only [sub_self, mul_zero, ennreal.of_real_zero],
end

lemma has_constant_speed_on_with_iff_ordered :
  has_constant_speed_on_with f s l ↔
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), (x ≤ y) →
    evariation_on f (s ∩ Icc x y) = ennreal.of_real (l * (y - x)) :=
begin
  refine ⟨λ h x xs y ys xy, h xs ys, λ h x xs y ys, _⟩,
  rcases le_total x y with xy|yx,
  { exact h xs ys xy, },
  { rw [evariation_on.subsingleton, ennreal.of_real_of_nonpos],
    { exact mul_nonpos_of_nonneg_of_nonpos l.prop (sub_nonpos_of_le yx), },
    { rintro z ⟨zs, xz, zy⟩ w ⟨ws, xw, wy⟩,
      cases le_antisymm (zy.trans yx) xz,
      cases le_antisymm (wy.trans yx) xw,
      refl, }, },
end

lemma has_constant_speed_on_with_iff_variation_on_from_to_eq :
  has_constant_speed_on_with f s l ↔ (has_locally_bounded_variation_on f s ∧
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), variation_on_from_to f s x y = l * (y - x)) :=
begin
  split,
  { rintro h, refine ⟨h.has_locally_bounded_variation_on, λ x xs y ys, _⟩,
    rw has_constant_speed_on_with_iff_ordered at h,
    rcases le_total x y with xy|yx,
    { rw [variation_on_from_to.eq_of_le f s xy, h xs ys xy,
          ennreal.to_real_of_real (mul_nonneg l.prop (sub_nonneg.mpr xy))], },
    { rw [variation_on_from_to.eq_of_ge f s yx, h ys xs yx,
          ennreal.to_real_of_real  (mul_nonneg l.prop (sub_nonneg.mpr yx)),
          mul_comm ↑l, mul_comm ↑l, ←neg_mul, neg_sub], }, },
  { rw has_constant_speed_on_with_iff_ordered,
    rintro h x xs y ys xy,
    rw [←h.2 xs ys, variation_on_from_to.eq_of_le f s xy,
        ennreal.of_real_to_real (h.1 x y xs ys)], },
end

lemma has_constant_speed_on_with.union {t : set ℝ}
  (hfs : has_constant_speed_on_with f s l) (hft : has_constant_speed_on_with f t l)
  {x : ℝ} (hs : is_greatest s x) (ht : is_least t x) : has_constant_speed_on_with f (s ∪ t) l :=
begin
  rw has_constant_speed_on_with_iff_ordered at hfs hft ⊢,
  rintro z (zs|zt) y (ys|yt) zy,
  { have : (s ∪ t) ∩ Icc z y = (s ∩ Icc z y), by
    { ext w, split,
      { rintro ⟨(ws|wt), zw, wy⟩,
        { exact ⟨ws, zw, wy⟩, },
        { exact ⟨(le_antisymm (wy.trans (hs.2 ys)) (ht.2 wt)).symm ▸ hs.1, zw, wy⟩, }, },
      { rintro ⟨ws, zwy⟩, exact ⟨or.inl ws, zwy⟩, }, },
    rw [this, hfs zs ys zy], },
  { have : (s ∪ t) ∩ Icc z y = (s ∩ Icc z x) ∪ (t ∩ Icc x y), by
    { ext w, split,
      { rintro ⟨(ws|wt), zw, wy⟩,
        exacts [or.inl ⟨ws, zw, hs.2 ws⟩, or.inr ⟨wt, ht.2 wt, wy⟩], },
      { rintro (⟨ws, zw, wx⟩|⟨wt, xw, wy⟩),
        exacts [⟨or.inl ws, zw, wx.trans (ht.2 yt)⟩, ⟨or.inr wt, (hs.2 zs).trans xw, wy⟩], }, },
    rw [this,
        @evariation_on.union _ _ _ _ f _ _ x,
        hfs zs hs.1 (hs.2 zs), hft ht.1 yt (ht.2 yt),
        ←ennreal.of_real_add (mul_nonneg l.prop (sub_nonneg.mpr (hs.2 zs)))
                             (mul_nonneg l.prop (sub_nonneg.mpr (ht.2 yt))) ],
    ring_nf,
    exacts [⟨⟨hs.1, hs.2 zs, le_rfl⟩, λ w ⟨ws, zw, wx⟩, wx⟩,
            ⟨⟨ht.1, le_rfl, ht.2 yt⟩, λ w ⟨wt, xw, wy⟩, xw⟩], },
  { cases le_antisymm zy ((hs.2 ys).trans (ht.2 zt)),
    simp only [Icc_self, sub_self, mul_zero, ennreal.of_real_zero],
    exact evariation_on.subsingleton _ (λ _ ⟨_, uz⟩ _ ⟨_, vz⟩, uz.trans vz.symm), },
  { have : (s ∪ t) ∩ Icc z y = (t ∩ Icc z y), by
    { ext w, split,
      { rintro ⟨(ws|wt), zw, wy⟩,
        { exact ⟨(le_antisymm ((ht.2 zt).trans zw) (hs.2 ws)) ▸ ht.1, zw, wy⟩, },
        { exact ⟨wt, zw, wy⟩, }, },
      { rintro ⟨wt, zwy⟩, exact ⟨or.inr wt, zwy⟩, }, },
    rw [this, hft zt yt zy], }
end

lemma has_constant_speed_on_with.Icc_Icc {x y z : ℝ}
  (hfs : has_constant_speed_on_with f (Icc x y) l)
  (hft : has_constant_speed_on_with f (Icc y z) l) : has_constant_speed_on_with f (Icc x z) l :=
begin
  rcases le_total x y with xy|yx,
  rcases le_total y z with yz|zy,
  { rw ←set.Icc_union_Icc_eq_Icc xy yz,
    exact hfs.union hft (is_greatest_Icc xy) (is_least_Icc yz), },
  { rintro u ⟨xu, uz⟩ v ⟨xv, vz⟩,
    rw [Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right vz,
        ←hfs ⟨xu, uz.trans zy⟩ ⟨xv, vz.trans zy⟩,
        Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right (vz.trans zy)], },
  { rintro u ⟨xu, uz⟩ v ⟨xv, vz⟩,
    rw [Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right vz,
        ←hft ⟨yx.trans xu, uz⟩ ⟨yx.trans xv, vz⟩,
        Icc_inter_Icc, sup_of_le_right (yx.trans xu), inf_of_le_right (vz)], },
end

lemma has_constant_speed_on_with_zero_iff :
  has_constant_speed_on_with f s 0 ↔ ∀ x y ∈ s, edist (f x) (f y) = 0 :=
begin
  dsimp [has_constant_speed_on_with],
  simp only [zero_mul, ennreal.of_real_zero, ←evariation_on.eq_zero_iff],
  split,
  { by_contra',
    obtain ⟨h, hfs⟩ := this,
    simp_rw evariation_on.eq_zero_iff at hfs h,
    push_neg at hfs,
    obtain ⟨x, xs, y, ys, hxy⟩ := hfs,
    rcases le_total x y with xy|yx,
    { exact hxy (h xs ys x ⟨xs, le_rfl, xy⟩ y ⟨ys, xy, le_rfl⟩), },
    { rw edist_comm at hxy,
      exact hxy (h ys xs y ⟨ys, le_rfl, yx⟩ x ⟨xs, yx, le_rfl⟩), }, },
  { rintro h x xs y ys,
    refine le_antisymm _ (zero_le'),
    rw ←h,
    exact evariation_on.mono f (inter_subset_left s (Icc x y)), },
end

lemma has_constant_speed_on_with.ratio {l' : ℝ≥0} (hl' : l' ≠ 0) {φ : ℝ → ℝ}
  (φm : monotone_on φ s)
  (hfφ : has_constant_speed_on_with (f ∘ φ) s l)
  (hf : has_constant_speed_on_with f (φ '' s) l')
  ⦃x : ℝ⦄ (xs : x ∈ s) : eq_on φ (λ y, (l / l') * (y - x) + (φ x)) s :=
begin
  rintro y ys,
  rw [←sub_eq_iff_eq_add, mul_comm, ←mul_div_assoc,
      eq_div_iff (nnreal.coe_ne_zero.mpr hl')],
  rw has_constant_speed_on_with_iff_variation_on_from_to_eq at hf,
  rw has_constant_speed_on_with_iff_variation_on_from_to_eq at hfφ,
  symmetry,
  calc  (y - x) * l
      = l * (y - x) : by rw mul_comm
  ... = variation_on_from_to (f ∘ φ) s x y : (hfφ.2 xs ys).symm
  ... = variation_on_from_to f (φ '' s) (φ x) (φ y) :
    variation_on_from_to.comp_eq_of_monotone_on f φ φm xs ys
  ... = l' * (φ y - φ x) : hf.2 ⟨x,xs,rfl⟩ ⟨y,ys,rfl⟩
  ... = (φ y - φ x) * l' : by rw mul_comm,
end

/-- `f` has unit speed on `s` if it is linearly parameterized by `l = 1` on `s`. -/
def has_unit_speed_on (f : ℝ → E) (s : set ℝ) := has_constant_speed_on_with f s 1

lemma has_unit_speed_on.union {t : set ℝ} {x : ℝ}
  (hfs : has_unit_speed_on f s) (hft : has_unit_speed_on f t)
  (hs : is_greatest s x) (ht : is_least t x) : has_unit_speed_on f (s ∪ t) :=
has_constant_speed_on_with.union hfs hft hs ht

lemma has_unit_speed_on.Icc_Icc {x y z : ℝ}
  (hfs : has_unit_speed_on f (Icc x y)) (hft : has_unit_speed_on f (Icc y z)) :
  has_unit_speed_on f (Icc x z) :=
has_constant_speed_on_with.Icc_Icc hfs hft

/--
If both `f` and `f ∘ φ` have unit speed (on `t` and `s` respectively) and `φ`
monotonically maps `s` onto `t`, then `φ` is just a translation (on `s`).
-/
lemma unique_unit_speed {φ : ℝ → ℝ} (φm : monotone_on φ s)
  (hfφ : has_unit_speed_on (f ∘ φ) s) (hf : has_unit_speed_on f (φ '' s))
  ⦃x : ℝ⦄ (xs : x ∈ s) : eq_on φ (λ y, (y - x) + (φ x)) s :=
begin
  dsimp only [has_unit_speed_on] at hf hfφ,
  convert has_constant_speed_on_with.ratio one_ne_zero φm hfφ hf xs,
  simp only [nonneg.coe_one, div_self, ne.def, one_ne_zero, not_false_iff, one_mul],
end

/--
If both `f` and `f ∘ φ` have unit speed (on `Icc 0 t` and `Icc 0 s` respectively)
and `φ` monotonically maps `Icc 0 s` onto `Icc 0 t`, then `φ` is the identity on `Icc 0 s`
-/
lemma unique_unit_speed_on_Icc_zero {s t : ℝ} (hs : 0 ≤ s) (ht : 0 ≤ t)
  {φ : ℝ → ℝ}  (φm : monotone_on φ $ Icc 0 s) (φst : φ '' (Icc 0 s) = (Icc 0 t))
  (hfφ : has_unit_speed_on (f ∘ φ) (Icc 0 s))
  (hf : has_unit_speed_on f (Icc 0 t)) : eq_on φ id (Icc 0 s) :=
begin
  rw ←φst at hf,
  convert unique_unit_speed φm hfφ hf ⟨le_rfl, hs⟩,
  have : φ 0 = 0, by
  { obtain ⟨x,xs,hx⟩ :=  φst.rec_on (surj_on_image φ (Icc 0 s)) ⟨le_rfl, ht⟩,
    exact le_antisymm (hx.rec_on (φm ⟨le_rfl,hs⟩ xs xs.1))
                      (φst.rec_on (maps_to_image φ (Icc 0 s)) (⟨le_rfl, hs⟩)).1, },
  simp only [tsub_zero, this, add_zero],
  refl,
end

/--
The natural parameterization of `f` on `s`, which, if `f` has locally bounded variation on `s`,
* has unit speed on `s`
  (by `natural_parameterization_has_unit_speed`).
* composed with `variation_on_from_to f s a`, is at distance zero from `f`
  (by `natural_parameterization_edist_zero`).
-/
noncomputable def natural_parameterization (f : α → E) (s : set α) (a : α) : ℝ → E :=
f ∘ (@function.inv_fun_on _ _ ⟨a⟩ (variation_on_from_to f s a) s)

lemma edist_natural_parameterization_eq_zero {f : α → E} {s : set α}
  (hf : has_locally_bounded_variation_on f s) {a : α} (as : a ∈ s) {b : α} (bs : b ∈ s) :
  edist (natural_parameterization f s a (variation_on_from_to f s a b)) (f b) = 0 :=
begin
  dsimp only [natural_parameterization],
  haveI : nonempty α := ⟨a⟩,
  let c := function.inv_fun_on (variation_on_from_to f s a) s (variation_on_from_to f s a b),
  obtain ⟨cs, hc⟩ := @function.inv_fun_on_pos _ _ _ s
                      (variation_on_from_to f s a) (variation_on_from_to f s a b) ⟨b, bs, rfl⟩,
  rw [variation_on_from_to.eq_left_iff hf as cs bs] at hc,
  apply variation_on_from_to.edist_zero_of_eq_zero hf cs bs hc,
end

lemma has_unit_speed_natural_parameterization (f : α → E) {s : set α}
  (hf : has_locally_bounded_variation_on f s) {a : α} (as : a ∈ s) :
  has_unit_speed_on (natural_parameterization f s a) (variation_on_from_to f s a '' s) :=
begin
  dsimp only [has_unit_speed_on],
  rw has_constant_speed_on_with_iff_ordered,
  rintro _ ⟨b, bs, rfl⟩ _ ⟨c, cs, rfl⟩ h,
  rcases le_total c b with cb|bc,
  { rw [nnreal.coe_one, one_mul, le_antisymm h (variation_on_from_to.monotone_on hf as cs bs cb),
        sub_self, ennreal.of_real_zero, Icc_self, evariation_on.subsingleton],
    exact λ x hx y hy, hx.2.trans hy.2.symm, },
  { rw [nnreal.coe_one, one_mul, sub_eq_add_neg, variation_on_from_to.eq_neg_swap, neg_neg,
        add_comm, variation_on_from_to.add hf bs as cs, ←variation_on_from_to.eq_neg_swap f],
    rw [←evariation_on.comp_inter_Icc_eq_of_monotone_on (natural_parameterization f s a) _
        (variation_on_from_to.monotone_on hf as) bs cs],
    rw [@evariation_on.eq_of_edist_zero_on _ _ _ _ _ f],
    { rw [variation_on_from_to.eq_of_le _ _ bc, ennreal.of_real_to_real (hf b c bs cs)], },
    { rintro x ⟨xs, bx, xc⟩,
      exact edist_natural_parameterization_eq_zero hf as xs, }, },
end