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

import measure_theory.measure.haar_lebesgue
import measure_theory.covering.besicovitch

/-!
# Satellite configurations for Besicovitch covering lemma in vector spaces

The Besicovitch covering theorem ensures that, in a nice metric space, there exists a number `N`
such that, from any family of balls with bounded radii, one can extract `N` families, each made of
disjoint balls, covering together all the centers of the initial family.

A key tool in the proof of this theorem is the notion of a satellite configuration, i.e., a family
of `N + 1` balls, where the first `N` balls all intersect the last one, but none of them contains
the center of another one and their radii are controlled. This is a technical notion, but it shows
up naturally in the proof of the Besicovitch theorem (which goes through a greedy algorithm): to
ensure that in the end one needs at most `N` families of balls, the crucial property of the
underlying metric space is that there should be no satellite configuration of `N + 1` points.

This file is devoted to the study of this property in vector spaces: we prove the main result
of [Füredi and Loeb, On the best constant for the Besicovitch covering theorem][furedi-loeb1994],
which shows that the optimal such `N` in a vector space coincides with the maximal number
of points one can put inside the unit ball of radius `2` under the condition that their distances
are bounded below by `1`.
In particular, this number is bounded by `5 ^ dim` by a straightforward measure argument.

## Main definitions and results

* `multiplicity E` is the maximal number of points one can put inside the unit ball
  of radius `2` in the vector space `E`, under the condition that their distances
  are bounded below by `1`.
* `multiplicity_le E` shows that `multiplicity E ≤ 5 ^ (dim E)`.
* `good_τ E` is a constant `> 1`, but close enough to `1` that satellite configurations
  with this parameter `τ` are not worst than for `τ = 1`.
* `is_empty_satellite_config_multiplicity` is the main theorem, saying that there are
  no satellite configurations of `(multiplicity E) + 1` points, for the parameter `good_τ E`.
-/

universe u
open metric set finite_dimensional measure_theory filter fin

open_locale ennreal topology

noncomputable theory

namespace besicovitch

variables {E : Type*} [normed_add_comm_group E]

namespace satellite_config
variables [normed_space ℝ E] {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)

/-- Rescaling a satellite configuration in a vector space, to put the basepoint at `0` and the base
radius at `1`. -/
def center_and_rescale :
  satellite_config E N τ :=
{ c := λ i, (a.r (last N))⁻¹ • (a.c i - a.c (last N)),
  r := λ i, (a.r (last N))⁻¹ * a.r i,
  rpos := λ i, mul_pos (inv_pos.2 (a.rpos _)) (a.rpos _),
  h := λ i j hij, begin
    rcases a.h i j hij with H|H,
    { left,
      split,
      { rw [dist_eq_norm, ← smul_sub, norm_smul, real.norm_eq_abs,
          abs_of_nonneg (inv_nonneg.2 ((a.rpos _)).le)],
        refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
        rw [dist_eq_norm] at H,
        convert H.1 using 2,
        abel },
      { rw [← mul_assoc, mul_comm τ, mul_assoc],
        refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
        exact H.2 } },
    { right,
      split,
      { rw [dist_eq_norm, ← smul_sub, norm_smul, real.norm_eq_abs,
          abs_of_nonneg (inv_nonneg.2 ((a.rpos _)).le)],
        refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
        rw [dist_eq_norm] at H,
        convert H.1 using 2,
        abel },
      { rw [← mul_assoc, mul_comm τ, mul_assoc],
        refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
        exact H.2 } },
  end,
  hlast := λ i hi, begin
    have H := a.hlast i hi,
    split,
    { rw [dist_eq_norm, ← smul_sub, norm_smul, real.norm_eq_abs,
        abs_of_nonneg (inv_nonneg.2 ((a.rpos _)).le)],
      refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
      rw [dist_eq_norm] at H,
      convert H.1 using 2,
      abel },
    { rw [← mul_assoc, mul_comm τ, mul_assoc],
      refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
      exact H.2 }
  end,
  inter := λ i hi, begin
    have H := a.inter i hi,
    rw [dist_eq_norm, ← smul_sub, norm_smul, real.norm_eq_abs,
        abs_of_nonneg (inv_nonneg.2 ((a.rpos _)).le), ← mul_add],
    refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 ((a.rpos _)).le),
    rw dist_eq_norm at H,
    convert H using 2,
    abel
  end }

lemma center_and_rescale_center :
  a.center_and_rescale.c (last N) = 0 :=
by simp [satellite_config.center_and_rescale]

lemma center_and_rescale_radius {N : ℕ} {τ : ℝ} (a : satellite_config E N τ) :
  a.center_and_rescale.r (last N) = 1 :=
by simp [satellite_config.center_and_rescale, inv_mul_cancel (a.rpos _).ne']

end satellite_config

/-! ### Disjoint balls of radius close to `1` in the radius `2` ball. -/

/-- The maximum cardinality of a `1`-separated set in the ball of radius `2`. This is also the
optimal number of families in the Besicovitch covering theorem. -/
def multiplicity (E : Type*) [normed_add_comm_group E] :=
Sup {N | ∃ s : finset E, s.card = N ∧ (∀ c ∈ s, ‖c‖ ≤ 2) ∧ (∀ c ∈ s, ∀ d ∈ s, c ≠ d → 1 ≤ ‖c - d‖)}

section
variables [normed_space ℝ E]  [finite_dimensional ℝ E]

/-- Any `1`-separated set in the ball of radius `2` has cardinality at most `5 ^ dim`. This is
useful to show that the supremum in the definition of `besicovitch.multiplicity E` is
well behaved. -/
lemma card_le_of_separated
  (s : finset E) (hs : ∀ c ∈ s, ‖c‖ ≤ 2) (h : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖) :
  s.card ≤ 5 ^ (finrank ℝ E) :=
begin
  /- We consider balls of radius `1/2` around the points in `s`. They are disjoint, and all
  contained in the ball of radius `5/2`. A volume argument gives `s.card * (1/2)^dim ≤ (5/2)^dim`,
  i.e., `s.card ≤ 5^dim`. -/
  borelize E,
  let μ : measure E := measure.add_haar,
  let δ : ℝ := (1 : ℝ)/2,
  let ρ : ℝ := (5 : ℝ)/2,
  have ρpos : 0 < ρ := by norm_num [ρ],
  set A := ⋃ (c ∈ s), ball (c : E) δ with hA,
  have D : set.pairwise (s : set E) (disjoint on (λ c, ball (c : E) δ)),
  { rintros c hc d hd hcd,
    apply ball_disjoint_ball,
    rw dist_eq_norm,
    convert h c hc d hd hcd,
    norm_num },
  have A_subset : A ⊆ ball (0 : E) ρ,
  { refine Union₂_subset (λ x hx, _),
    apply ball_subset_ball',
    calc δ + dist x 0 ≤ δ + 2 : by { rw dist_zero_right, exact add_le_add le_rfl (hs x hx) }
    ... = 5 / 2 : by norm_num [δ] },
  have I : (s.card : ℝ≥0∞) * ennreal.of_real (δ ^ (finrank ℝ E)) * μ (ball 0 1) ≤
    ennreal.of_real (ρ ^ (finrank ℝ E)) * μ (ball 0 1) := calc
  (s.card : ℝ≥0∞) * ennreal.of_real (δ ^ (finrank ℝ E)) * μ (ball 0 1) = μ A :
    begin
      rw [hA, measure_bUnion_finset D (λ c hc, measurable_set_ball)],
      have I : 0 < δ, by norm_num [δ],
      simp only [μ.add_haar_ball_of_pos _ I, one_div, one_pow, finset.sum_const,
        nsmul_eq_mul, div_pow, mul_assoc]
    end
  ... ≤ μ (ball (0 : E) ρ) : measure_mono A_subset
  ... = ennreal.of_real (ρ ^ (finrank ℝ E)) * μ (ball 0 1) :
    by simp only [μ.add_haar_ball_of_pos _ ρpos],
  have J : (s.card : ℝ≥0∞) * ennreal.of_real (δ ^ (finrank ℝ E))
    ≤ ennreal.of_real (ρ ^ (finrank ℝ E)) :=
      (ennreal.mul_le_mul_right (measure_ball_pos _ _ zero_lt_one).ne'
        measure_ball_lt_top.ne).1 I,
  have K : (s.card : ℝ) ≤ (5 : ℝ) ^ finrank ℝ E,
    by simpa [ennreal.to_real_mul, div_eq_mul_inv] using
      ennreal.to_real_le_of_le_of_real (pow_nonneg ρpos.le _) J,
  exact_mod_cast K,
end

lemma multiplicity_le : multiplicity E ≤ 5 ^ (finrank ℝ E) :=
begin
  apply cSup_le,
  { refine ⟨0, ⟨∅, by simp⟩⟩ },
  { rintros _ ⟨s, ⟨rfl, h⟩⟩,
    exact besicovitch.card_le_of_separated s h.1 h.2 }
end

lemma card_le_multiplicity
  {s : finset E} (hs : ∀ c ∈ s, ‖c‖ ≤ 2) (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖) :
  s.card ≤ multiplicity E :=
begin
  apply le_cSup,
  { refine ⟨5 ^ (finrank ℝ E), _⟩,
    rintros _ ⟨s, ⟨rfl, h⟩⟩,
    exact besicovitch.card_le_of_separated s h.1 h.2 },
  { simp only [mem_set_of_eq, ne.def],
    exact ⟨s, rfl, hs, h's⟩ }
end

variable (E)

/-- If `δ` is small enough, a `(1-δ)`-separated set in the ball of radius `2` also has cardinality
at most `multiplicity E`. -/
lemma exists_good_δ : ∃ (δ : ℝ), 0 < δ ∧ δ < 1 ∧ ∀ (s : finset E), (∀ c ∈ s, ‖c‖ ≤ 2) →
  (∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - δ ≤ ‖c - d‖) → s.card ≤ multiplicity E :=
begin
  /- This follows from a compactness argument: otherwise, one could extract a converging
  subsequence, to obtain a `1`-separated set in the ball of radius `2` with cardinality
  `N = multiplicity E + 1`. To formalize this, we work with functions `fin N → E`.
   -/
  classical,
  by_contra' h,
  set N := multiplicity E + 1 with hN,
  have : ∀ (δ : ℝ), 0 < δ → ∃ f : fin N → E, (∀ (i : fin N), ‖f i‖ ≤ 2)
    ∧ (∀ i j, i ≠ j → 1 - δ ≤ ‖f i - f j‖),
  { assume δ hδ,
    rcases lt_or_le δ 1 with hδ'|hδ',
    { rcases h δ hδ hδ' with ⟨s, hs, h's, s_card⟩,
      obtain ⟨f, f_inj, hfs⟩ : ∃ (f : fin N → E), function.injective f ∧ range f ⊆ ↑s,
      { have : fintype.card (fin N) ≤ s.card, { simp only [fintype.card_fin], exact s_card },
        rcases function.embedding.exists_of_card_le_finset this with ⟨f, hf⟩,
        exact ⟨f, f.injective, hf⟩ },
      simp only [range_subset_iff, finset.mem_coe] at hfs,
      refine ⟨f, λ i, hs _ (hfs i), λ i j hij, h's _ (hfs i) _ (hfs j) (f_inj.ne hij)⟩ },
    { exact ⟨λ i, 0, λ i, by simp, λ i j hij, by simpa only [norm_zero, sub_nonpos, sub_self]⟩ } },
  -- For `δ > 0`, `F δ` is a function from `fin N` to the ball of radius `2` for which two points
  -- in the image are separated by `1 - δ`.
  choose! F hF using this,
  -- Choose a converging subsequence when `δ → 0`.
  have : ∃ f : fin N → E, (∀ (i : fin N), ‖f i‖ ≤ 2) ∧ (∀ i j, i ≠ j → 1 ≤ ‖f i - f j‖),
  { obtain ⟨u, u_mono, zero_lt_u, hu⟩ : ∃ (u : ℕ → ℝ), (∀ (m n : ℕ), m < n → u n < u m)
      ∧ (∀ (n : ℕ), 0 < u n) ∧ filter.tendsto u filter.at_top (𝓝 0) :=
        exists_seq_strict_anti_tendsto (0 : ℝ),
    have A : ∀ n, F (u n) ∈ closed_ball (0 : fin N → E) 2,
    { assume n,
      simp only [pi_norm_le_iff_of_nonneg zero_le_two, mem_closed_ball, dist_zero_right,
                 (hF (u n) (zero_lt_u n)).left, forall_const], },
    obtain ⟨f, fmem, φ, φ_mono, hf⟩ : ∃ (f ∈ closed_ball (0 : fin N → E) 2) (φ : ℕ → ℕ),
      strict_mono φ ∧ tendsto ((F ∘ u) ∘ φ) at_top (𝓝 f) :=
        is_compact.tendsto_subseq (is_compact_closed_ball _ _) A,
    refine ⟨f, λ i, _, λ i j hij, _⟩,
    { simp only [pi_norm_le_iff_of_nonneg zero_le_two, mem_closed_ball, dist_zero_right] at fmem,
      exact fmem i },
    { have A : tendsto (λ n, ‖F (u (φ n)) i - F (u (φ n)) j‖) at_top (𝓝 (‖f i - f j‖)) :=
        ((hf.apply i).sub (hf.apply j)).norm,
      have B : tendsto (λ n, 1 - u (φ n)) at_top (𝓝 (1 - 0)) :=
        tendsto_const_nhds.sub (hu.comp φ_mono.tendsto_at_top),
      rw sub_zero at B,
      exact le_of_tendsto_of_tendsto' B A (λ n, (hF (u (φ n)) (zero_lt_u _)).2 i j hij) } },
  rcases this with ⟨f, hf, h'f⟩,
  -- the range of `f` contradicts the definition of `multiplicity E`.
  have finj : function.injective f,
  { assume i j hij,
    by_contra,
    have : 1 ≤ ‖f i - f j‖ := h'f i j h,
    simp only [hij, norm_zero, sub_self] at this,
    exact lt_irrefl _ (this.trans_lt zero_lt_one) },
  let s := finset.image f finset.univ,
  have s_card : s.card = N,
    by { rw finset.card_image_of_injective _ finj, exact finset.card_fin N },
  have hs : ∀ c ∈ s, ‖c‖ ≤ 2,
    by simp only [hf, forall_apply_eq_imp_iff', forall_const, forall_exists_index, finset.mem_univ,
                  finset.mem_image],
  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖,
  { simp only [s, forall_apply_eq_imp_iff', forall_exists_index, finset.mem_univ, finset.mem_image,
      ne.def, exists_true_left, forall_apply_eq_imp_iff', forall_true_left],
    assume i j hij,
    have : i ≠ j := λ h, by { rw h at hij, exact hij rfl },
    exact h'f i j this },
  have : s.card ≤ multiplicity E := card_le_multiplicity hs h's,
  rw [s_card, hN] at this,
  exact lt_irrefl _ ((nat.lt_succ_self (multiplicity E)).trans_le this),
end

/-- A small positive number such that any `1 - δ`-separated set in the ball of radius `2` has
cardinality at most `besicovitch.multiplicity E`. -/
def good_δ : ℝ := (exists_good_δ E).some

lemma good_δ_lt_one : good_δ E < 1 := (exists_good_δ E).some_spec.2.1

/-- A number `τ > 1`, but chosen close enough to `1` so that the construction in the Besicovitch
covering theorem using this parameter `τ` will give the smallest possible number of covering
families. -/
def good_τ : ℝ := 1 + (good_δ E) / 4

lemma one_lt_good_τ : 1 < good_τ E :=
by { dsimp [good_τ, good_δ], linarith [(exists_good_δ E).some_spec.1] }

variable {E}

lemma card_le_multiplicity_of_δ {s : finset E} (hs : ∀ c ∈ s, ‖c‖ ≤ 2)
  (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ‖c - d‖) :
  s.card ≤ multiplicity E :=
(classical.some_spec (exists_good_δ E)).2.2 s hs h's

lemma le_multiplicity_of_δ_of_fin {n : ℕ} (f : fin n → E) (h : ∀ i, ‖f i‖ ≤ 2)
  (h' : ∀ i j, i ≠ j → 1 - good_δ E ≤ ‖f i - f j‖) :
  n ≤ multiplicity E :=
begin
  classical,
  have finj : function.injective f,
  { assume i j hij,
    by_contra,
    have : 1 - good_δ E ≤ ‖f i - f j‖ := h' i j h,
    simp only [hij, norm_zero, sub_self] at this,
    linarith [good_δ_lt_one E] },
  let s := finset.image f finset.univ,
  have s_card : s.card = n,
    by { rw finset.card_image_of_injective _ finj, exact finset.card_fin n },
  have hs : ∀ c ∈ s, ‖c‖ ≤ 2,
    by simp only [h, forall_apply_eq_imp_iff', forall_const, forall_exists_index, finset.mem_univ,
                  finset.mem_image, implies_true_iff],
  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ‖c - d‖,
  { simp only [s, forall_apply_eq_imp_iff', forall_exists_index, finset.mem_univ, finset.mem_image,
      ne.def, exists_true_left, forall_apply_eq_imp_iff', forall_true_left],
    assume i j hij,
    have : i ≠ j := λ h, by { rw h at hij, exact hij rfl },
    exact h' i j this },
  have : s.card ≤ multiplicity E := card_le_multiplicity_of_δ hs h's,
  rwa [s_card] at this,
end

end

namespace satellite_config

/-!
### Relating satellite configurations to separated points in the ball of radius `2`.

We prove that the number of points in a satellite configuration is bounded by the maximal number
of `1`-separated points in the ball of radius `2`. For this, start from a satellite congifuration
`c`. Without loss of generality, one can assume that the last ball is centered at `0` and of
radius `1`. Define `c' i = c i` if `‖c i‖ ≤ 2`, and `c' i = (2/‖c i‖) • c i` if `‖c i‖ > 2`.
It turns out that these points are `1 - δ`-separated, where `δ` is arbitrarily small if `τ` is
close enough to `1`. The number of such configurations is bounded by `multiplicity E` if `δ` is
suitably small.

To check that the points `c' i` are `1 - δ`-separated, one treats separately the cases where
both `‖c i‖` and `‖c j‖` are `≤ 2`, where one of them is `≤ 2` and the other one is `> 2`, and
where both of them are `> 2`.
-/

lemma exists_normalized_aux1 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
  (lastr : a.r (last N) = 1) (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1)
  (i j : fin N.succ) (inej : i ≠ j) :
  1 - δ ≤ ‖a.c i - a.c j‖ :=
begin
  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
    by simpa only [dist_eq_norm] using a.h,
  have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
  have D : 0 ≤ 1 - δ / 4, by linarith only [hδ2],
  have τpos : 0 < τ := _root_.zero_lt_one.trans_le hτ,
  have I : (1 - δ / 4) * τ ≤ 1 := calc
    (1 - δ / 4) * τ ≤ (1 - δ / 4) * (1 + δ / 4) : mul_le_mul_of_nonneg_left hδ1 D
    ... = 1 - δ^2 / 16 : by ring
    ... ≤ 1 : (by linarith only [sq_nonneg δ]),
  have J : 1 - δ ≤ 1 - δ / 4, by linarith only [δnonneg],
  have K : 1 - δ / 4 ≤ τ⁻¹, by { rw [inv_eq_one_div, le_div_iff τpos], exact I },
  suffices L : τ⁻¹ ≤ ‖a.c i - a.c j‖, by linarith only [J, K, L],
  have hτ' : ∀ k, τ⁻¹ ≤ a.r k,
  { assume k,
    rw [inv_eq_one_div, div_le_iff τpos, ← lastr, mul_comm],
    exact a.hlast' k hτ },
  rcases ah i j inej with H|H,
  { apply le_trans _ H.1,
    exact hτ' i },
  { rw norm_sub_rev,
    apply le_trans _ H.1,
    exact hτ' j }
end

variable [normed_space ℝ E]

lemma exists_normalized_aux2 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
  (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
  (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1)
  (i j : fin N.succ) (inej : i ≠ j) (hi : ‖a.c i‖ ≤ 2) (hj : 2 < ‖a.c j‖) :
  1 - δ ≤ ‖a.c i - (2 / ‖a.c j‖) • a.c j‖ :=
begin
  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
    by simpa only [dist_eq_norm] using a.h,
  have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
  have D : 0 ≤ 1 - δ / 4, by linarith only [hδ2],
  have τpos : 0 < τ := _root_.zero_lt_one.trans_le hτ,
  have hcrj : ‖a.c j‖ ≤ a.r j + 1,
    by simpa only [lastc, lastr, dist_zero_right] using a.inter' j,
  have I : a.r i ≤ 2,
  { rcases lt_or_le i (last N) with H|H,
    { apply (a.hlast i H).1.trans,
      simpa only [dist_eq_norm, lastc, sub_zero] using hi },
    { have : i = last N := top_le_iff.1 H,
      rw [this, lastr],
      exact one_le_two } },
  have J : (1 - δ / 4) * τ ≤ 1 := calc
    (1 - δ / 4) * τ ≤ (1 - δ / 4) * (1 + δ / 4) : mul_le_mul_of_nonneg_left hδ1 D
    ... = 1 - δ^2 / 16 : by ring
    ... ≤ 1 : (by linarith only [sq_nonneg δ]),
  have A : a.r j - δ ≤ ‖a.c i - a.c j‖,
  { rcases ah j i inej.symm with H|H, { rw norm_sub_rev, linarith [H.1] },
    have C : a.r j ≤ 4 := calc
      a.r j ≤ τ * a.r i : H.2
      ... ≤ τ * 2 : mul_le_mul_of_nonneg_left I τpos.le
      ... ≤ (5/4) * 2 : mul_le_mul_of_nonneg_right (by linarith only [hδ1, hδ2]) zero_le_two
      ... ≤ 4 : by norm_num,
    calc a.r j - δ ≤ a.r j - (a.r j / 4) * δ : begin
        refine sub_le_sub le_rfl _,
        refine mul_le_of_le_one_left δnonneg _,
        linarith only [C],
      end
    ... = (1 - δ / 4) * a.r j : by ring
    ... ≤ (1 - δ / 4) * (τ * a.r i) :
      mul_le_mul_of_nonneg_left (H.2) D
    ... ≤ 1 * a.r i : by { rw [← mul_assoc], apply mul_le_mul_of_nonneg_right J (a.rpos _).le }
    ... ≤ ‖a.c i - a.c j‖ : by { rw [one_mul], exact H.1 } },
  set d := (2 / ‖a.c j‖) • a.c j with hd,
  have : a.r j - δ ≤ ‖a.c i - d‖ + (a.r j - 1) := calc
    a.r j - δ ≤ ‖a.c i - a.c j‖ : A
    ... ≤ ‖a.c i - d‖ + ‖d - a.c j‖ : by simp only [← dist_eq_norm, dist_triangle]
    ... ≤ ‖a.c i - d‖ + (a.r j - 1) : begin
      apply add_le_add_left,
      have A : 0 ≤ 1 - 2 / ‖a.c j‖, by simpa [div_le_iff (zero_le_two.trans_lt hj)] using hj.le,
      rw [← one_smul ℝ (a.c j), hd, ← sub_smul, norm_smul, norm_sub_rev, real.norm_eq_abs,
          abs_of_nonneg A, sub_mul],
      field_simp [(zero_le_two.trans_lt hj).ne'],
      linarith only [hcrj]
    end,
  linarith only [this]
end

lemma exists_normalized_aux3 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
  (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
  (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4)
  (i j : fin N.succ) (inej : i ≠ j) (hi : 2 < ‖a.c i‖) (hij : ‖a.c i‖ ≤ ‖a.c j‖) :
  1 - δ ≤ ‖(2 / ‖a.c i‖) • a.c i - (2 / ‖a.c j‖) • a.c j‖ :=
begin
  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
    by simpa only [dist_eq_norm] using a.h,
  have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
  have τpos : 0 < τ := _root_.zero_lt_one.trans_le hτ,
  have hcrj : ‖a.c j‖ ≤ a.r j + 1,
    by simpa only [lastc, lastr, dist_zero_right] using a.inter' j,
  have A : a.r i ≤ ‖a.c i‖,
  { have : i < last N,
    { apply lt_top_iff_ne_top.2,
      assume iN,
      change i = last N at iN,
      rw [iN, lastc, norm_zero] at hi,
      exact lt_irrefl _ (zero_le_two.trans_lt hi) },
    convert (a.hlast i this).1,
    rw [dist_eq_norm, lastc, sub_zero] },
  have hj : 2 < ‖a.c j‖ := hi.trans_le hij,
  set s := ‖a.c i‖ with hs,
  have spos : 0 < s := zero_lt_two.trans hi,
  set d := (s/‖a.c j‖) • a.c j with hd,
  have I : ‖a.c j - a.c i‖ ≤ ‖a.c j‖ - s + ‖d - a.c i‖ := calc
    ‖a.c j - a.c i‖ ≤ ‖a.c j - d‖ + ‖d - a.c i‖ : by simp [← dist_eq_norm, dist_triangle]
    ... = ‖a.c j‖ - ‖a.c i‖ + ‖d - a.c i‖ : begin
      nth_rewrite 0 ← one_smul ℝ (a.c j),
      rw [add_left_inj, hd, ← sub_smul, norm_smul, real.norm_eq_abs, abs_of_nonneg, sub_mul,
          one_mul, div_mul_cancel _ (zero_le_two.trans_lt hj).ne'],
      rwa [sub_nonneg, div_le_iff (zero_lt_two.trans hj), one_mul],
    end,
  have J : a.r j - ‖a.c j - a.c i‖ ≤ s / 2 * δ := calc
    a.r j - ‖a.c j - a.c i‖ ≤ s * (τ - 1) : begin
      rcases ah j i inej.symm with H|H,
      { calc a.r j - ‖a.c j - a.c i‖ ≤ 0 : sub_nonpos.2 H.1
        ... ≤ s * (τ - 1) : mul_nonneg spos.le (sub_nonneg.2 hτ) },
      { rw norm_sub_rev at H,
        calc a.r j - ‖a.c j - a.c i‖ ≤ τ * a.r i - a.r i : sub_le_sub H.2 H.1
        ... = a.r i * (τ - 1) : by ring
        ... ≤ s * (τ - 1) : mul_le_mul_of_nonneg_right A (sub_nonneg.2 hτ) }
    end
    ... ≤ s * (δ / 2) : mul_le_mul_of_nonneg_left (by linarith only [δnonneg, hδ1]) spos.le
    ... = s / 2 * δ : by ring,
  have invs_nonneg : 0 ≤ 2 / s := (div_nonneg zero_le_two (zero_le_two.trans hi.le)),
  calc 1 - δ = (2 / s) * (s / 2 - (s / 2) * δ) : by { field_simp [spos.ne'], ring }
  ... ≤ (2 / s) * ‖d - a.c i‖ :
    mul_le_mul_of_nonneg_left (by linarith only [hcrj, I, J, hi]) invs_nonneg
  ... = ‖(2 / s) • a.c i - (2 / ‖a.c j‖) • a.c j‖ : begin
    conv_lhs { rw [norm_sub_rev, ← abs_of_nonneg invs_nonneg] },
    rw [← real.norm_eq_abs, ← norm_smul, smul_sub, hd, smul_smul],
    congr' 3,
    field_simp [spos.ne'],
  end
end

lemma exists_normalized {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
  (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
  (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1) :
  ∃ (c' : fin N.succ → E), (∀ n, ‖c' n‖ ≤ 2) ∧ (∀ i j, i ≠ j → 1 - δ ≤ ‖c' i - c' j‖) :=
begin
  let c' : fin N.succ → E := λ i, if ‖a.c i‖ ≤ 2 then a.c i else (2 / ‖a.c i‖) • a.c i,
  have norm_c'_le : ∀ i, ‖c' i‖ ≤ 2,
  { assume i,
    simp only [c'],
    split_ifs, { exact h },
    by_cases hi : ‖a.c i‖ = 0;
    field_simp [norm_smul, hi] },
  refine ⟨c', λ n, norm_c'_le n, λ i j inej, _⟩,
  -- up to exchanging `i` and `j`, one can assume `∥c i∥ ≤ ∥c j∥`.
  wlog hij : ‖a.c i‖ ≤ ‖a.c j‖ generalizing i j,
  { rw norm_sub_rev, exact this j i inej.symm (le_of_not_le hij) },
  rcases le_or_lt (‖a.c j‖) 2 with Hj|Hj,
  -- case `∥c j∥ ≤ 2` (and therefore also `∥c i∥ ≤ 2`)
  { simp_rw [c', Hj, hij.trans Hj, if_true],
    exact exists_normalized_aux1 a lastr hτ δ hδ1 hδ2 i j inej },
  -- case `2 < ‖c j‖`
  { have H'j : (‖a.c j‖ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hj,
    rcases le_or_lt (‖a.c i‖) 2 with Hi|Hi,
    { -- case `‖c i‖ ≤ 2`
      simp_rw [c', Hi, if_true, H'j, if_false],
      exact exists_normalized_aux2 a lastc lastr hτ δ hδ1 hδ2 i j inej Hi Hj },
    { -- case `2 < ‖c i‖`
      have H'i : (‖a.c i‖ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hi,
      simp_rw [c', H'i, if_false, H'j, if_false],
      exact exists_normalized_aux3 a lastc lastr hτ δ hδ1 i j inej Hi hij } }
end

end satellite_config

variables (E) [normed_space ℝ E] [finite_dimensional ℝ E]

/-- In a normed vector space `E`, there can be no satellite configuration with `multiplicity E + 1`
points and the parameter `good_τ E`. This will ensure that in the inductive construction to get
the Besicovitch covering families, there will never be more than `multiplicity E` nonempty
families. -/
theorem is_empty_satellite_config_multiplicity :
  is_empty (satellite_config E (multiplicity E) (good_τ E)) :=
⟨begin
  assume a,
  let b := a.center_and_rescale,
  rcases b.exists_normalized (a.center_and_rescale_center) (a.center_and_rescale_radius)
    (one_lt_good_τ E).le (good_δ E) le_rfl (good_δ_lt_one E).le with ⟨c', c'_le_two, hc'⟩,
  exact lt_irrefl _ ((nat.lt_succ_self _).trans_le (le_multiplicity_of_δ_of_fin c' c'_le_two hc'))
end⟩

@[priority 100]
instance : has_besicovitch_covering E :=
⟨⟨multiplicity E, good_τ E, one_lt_good_τ E, is_empty_satellite_config_multiplicity E⟩⟩

end besicovitch


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Bryan Gin-ge Chen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.prime
import Mathlib.data.int.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Lemmas about nat.prime using `int`s
-/

namespace int

theorem not_prime_of_int_mul {a : ℤ} {b : ℤ} {c : ℕ} (ha : 1 < nat_abs a) (hb : 1 < nat_abs b) (hc : a * b = ↑c) : ¬nat.prime c :=
  nat.not_prime_mul' (nat_abs_mul_nat_abs_eq hc) ha hb


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.eval
import Mathlib.PostPort

universes u u_1 y v

namespace Mathlib

/-!
# The derivative map on polynomials

## Main definitions
 * `polynomial.derivative`: The formal derivative of polynomials, expressed as a linear map.

-/

namespace polynomial

/-- `derivative p` is the formal derivative of the polynomial `p` -/
def derivative {R : Type u} [semiring R] : linear_map R (polynomial R) (polynomial R) :=
  finsupp.total ℕ (polynomial R) R fun (n : ℕ) => coe_fn C ↑n * X ^ (n - 1)

theorem derivative_apply {R : Type u} [semiring R] (p : polynomial R) :
    coe_fn derivative p = finsupp.sum p fun (n : ℕ) (a : R) => coe_fn C (a * ↑n) * X ^ (n - 1) :=
  sorry

theorem coeff_derivative {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) :
    coeff (coe_fn derivative p) n = coeff p (n + 1) * (↑n + 1) :=
  sorry

theorem derivative_zero {R : Type u} [semiring R] : coe_fn derivative 0 = 0 :=
  linear_map.map_zero derivative

theorem derivative_monomial {R : Type u} [semiring R] (a : R) (n : ℕ) :
    coe_fn derivative (coe_fn (monomial n) a) = coe_fn (monomial (n - 1)) (a * ↑n) :=
  sorry

theorem derivative_C_mul_X_pow {R : Type u} [semiring R] (a : R) (n : ℕ) :
    coe_fn derivative (coe_fn C a * X ^ n) = coe_fn C (a * ↑n) * X ^ (n - 1) :=
  sorry

@[simp] theorem derivative_X_pow {R : Type u} [semiring R] (n : ℕ) :
    coe_fn derivative (X ^ n) = ↑n * X ^ (n - 1) :=
  sorry

@[simp] theorem derivative_C {R : Type u} [semiring R] {a : R} :
    coe_fn derivative (coe_fn C a) = 0 :=
  sorry

@[simp] theorem derivative_X {R : Type u} [semiring R] : coe_fn derivative X = 1 := sorry

@[simp] theorem derivative_one {R : Type u} [semiring R] : coe_fn derivative 1 = 0 := derivative_C

@[simp] theorem derivative_bit0 {R : Type u} [semiring R] {a : polynomial R} :
    coe_fn derivative (bit0 a) = bit0 (coe_fn derivative a) :=
  sorry

@[simp] theorem derivative_bit1 {R : Type u} [semiring R] {a : polynomial R} :
    coe_fn derivative (bit1 a) = bit0 (coe_fn derivative a) :=
  sorry

@[simp] theorem derivative_add {R : Type u} [semiring R] {f : polynomial R} {g : polynomial R} :
    coe_fn derivative (f + g) = coe_fn derivative f + coe_fn derivative g :=
  linear_map.map_add derivative f g

@[simp] theorem derivative_neg {R : Type u_1} [ring R] (f : polynomial R) :
    coe_fn derivative (-f) = -coe_fn derivative f :=
  linear_map.map_neg derivative f

@[simp] theorem derivative_sub {R : Type u_1} [ring R] (f : polynomial R) (g : polynomial R) :
    coe_fn derivative (f - g) = coe_fn derivative f - coe_fn derivative g :=
  linear_map.map_sub derivative f g

@[simp] theorem derivative_sum {R : Type u} {ι : Type y} [semiring R] {s : finset ι}
    {f : ι → polynomial R} :
    coe_fn derivative (finset.sum s fun (b : ι) => f b) =
        finset.sum s fun (b : ι) => coe_fn derivative (f b) :=
  linear_map.map_sum derivative

@[simp] theorem derivative_smul {R : Type u} [semiring R] (r : R) (p : polynomial R) :
    coe_fn derivative (r • p) = r • coe_fn derivative p :=
  linear_map.map_smul derivative r p

theorem derivative_eval {R : Type u} [comm_semiring R] (p : polynomial R) (x : R) :
    eval x (coe_fn derivative p) = finsupp.sum p fun (n : ℕ) (a : R) => a * ↑n * x ^ (n - 1) :=
  sorry

@[simp] theorem derivative_mul {R : Type u} [comm_semiring R] {f : polynomial R}
    {g : polynomial R} :
    coe_fn derivative (f * g) = coe_fn derivative f * g + f * coe_fn derivative g :=
  sorry

theorem derivative_pow_succ {R : Type u} [comm_semiring R] (p : polynomial R) (n : ℕ) :
    coe_fn derivative (p ^ (n + 1)) = (↑n + 1) * p ^ n * coe_fn derivative p :=
  sorry

theorem derivative_pow {R : Type u} [comm_semiring R] (p : polynomial R) (n : ℕ) :
    coe_fn derivative (p ^ n) = ↑n * p ^ (n - 1) * coe_fn derivative p :=
  sorry

theorem derivative_map {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S]
    (p : polynomial R) (f : R →+* S) : coe_fn derivative (map f p) = map f (coe_fn derivative p) :=
  sorry

/-- Chain rule for formal derivative of polynomials. -/
theorem derivative_eval₂_C {R : Type u} [comm_semiring R] (p : polynomial R) (q : polynomial R) :
    coe_fn derivative (eval₂ C q p) = eval₂ C q (coe_fn derivative p) * coe_fn derivative q :=
  sorry

theorem of_mem_support_derivative {R : Type u} [comm_semiring R] {p : polynomial R} {n : ℕ}
    (h : n ∈ finsupp.support (coe_fn derivative p)) : n + 1 ∈ finsupp.support p :=
  sorry

theorem degree_derivative_lt {R : Type u} [comm_semiring R] {p : polynomial R} (hp : p ≠ 0) :
    degree (coe_fn derivative p) < degree p :=
  iff.mpr (finset.sup_lt_iff (iff.mpr bot_lt_iff_ne_bot (mt (iff.mp degree_eq_bot) hp)))
    fun (n : ℕ) (hp : n ∈ finsupp.support (coe_fn derivative p)) =>
      lt_of_lt_of_le (iff.mpr with_bot.some_lt_some (nat.lt_succ_self n))
        (finset.le_sup (of_mem_support_derivative hp))

theorem nat_degree_derivative_lt {R : Type u} [comm_semiring R] {p : polynomial R}
    (hp : coe_fn derivative p ≠ 0) : nat_degree (coe_fn derivative p) < nat_degree p :=
  sorry

theorem degree_derivative_le {R : Type u} [comm_semiring R] {p : polynomial R} :
    degree (coe_fn derivative p) ≤ degree p :=
  sorry

theorem mem_support_derivative {R : Type u} [integral_domain R] [char_zero R] (p : polynomial R)
    (n : ℕ) : n ∈ finsupp.support (coe_fn derivative p) ↔ n + 1 ∈ finsupp.support p :=
  sorry

@[simp] theorem degree_derivative_eq {R : Type u} [integral_domain R] [char_zero R]
    (p : polynomial R) (hp : 0 < nat_degree p) :
    degree (coe_fn derivative p) = ↑(nat_degree p - 1) :=
  sorry

theorem nat_degree_eq_zero_of_derivative_eq_zero {R : Type u} [integral_domain R] [char_zero R]
    {f : polynomial R} (h : coe_fn derivative f = 0) : nat_degree f = 0 :=
  sorry

end Mathlib


namespace integer_numbers

set_option trace.simplify.rewrite true

inductive myint
| zero : myint
| succ : myint → myint
| pred : myint → myint

local notation `P` := myint.pred
local notation `S` := myint.succ

axiom succ_pred {n : myint} : S (P n) = n
axiom pred_succ {n : myint} : P (S n) = n

attribute [simp] succ_pred pred_succ

lemma sspp (n : myint) : S (S (P (P n))) = n :=
begin
  -- S (S (P (P n))) = n
  -- use congr
  -- P (S (S (P (P n)))) = P n
  -- use pred_succ
  -- S (P (P n)) = P n
  -- use pred_succ
  -- P (P n) = P (P n)

  -- try to substitute S (P n) → n
  -- apply eq.subst (succ_pred.symm),
  rw succ_pred,
  exact succ_pred,
end

#print sspp

-- λ (n : myint), (id ((eq.refl (S (S (P (P n))) = n)).rec succ_pred)).mpr succ_pred

lemma sspp₂ (n : myint) : S (S (P (P n))) = n :=
begin
  apply (eq.mpr _ succ_pred),
  exact n,
  have h := (eq.rec succ_pred),
  type_check (h succ_pred), -- S (P (S (P ?m_1))) = ?m_1
  all_goals { sorry },
end

lemma ppss (n : myint) : P (P (S (S n))) = n :=
  by rw [pred_succ, pred_succ]

lemma comm_succ_pred (n : myint) : S (P n) = P (S n) :=
  by rw [succ_pred, pred_succ]

#print comm_succ_pred

example : S (P myint.zero) = myint.zero := succ_pred

constant pos : nat → myint
-- | 0            := myint.zero
-- | (nat.succ n) := myint.succ (pos n)

axiom pos.zero : pos 0 = myint.zero
axiom pos.step {n : ℕ} : pos (nat.succ n) = myint.succ (pos n)

constant neg : nat → myint
-- | 0            := myint.zero
-- | (nat.succ n) := myint.pred (neg n)
axiom neg.zero : neg 0 = myint.zero
axiom neg.step {n : ℕ} : neg (nat.succ n) = myint.pred (neg n)

attribute [simp] pos.zero pos.step neg.zero neg.step

example : pos 0 = myint.zero := pos.zero
lemma pos_one : pos 1 = S myint.zero := by rw [pos.step, pos.zero]
lemma neg_one : neg 1 = P myint.zero := by rw [neg.step, neg.zero]

example : (neg 1).succ.succ = pos 1 :=
  by { rw [neg_one, pos_one], congr, exact succ_pred }
-- apply myint.pred.inj, add .pred into both sides of equation

example : S (S (neg 1)) = pos 1 :=
  by rw [neg_one, succ_pred, pos_one]
-- "exact pos_one" works when def keyword used

constant add : myint → myint → myint
-- | myint.zero n     := n
-- | (myint.succ m) n := myint.succ (add m n)
-- | (myint.pred m) n := myint.pred (add m n)

axiom add.zero_id : add myint.zero = id
axiom add.succ {m n : myint} : add (S m) n = S (add m n)
axiom add.pred {m n : myint} : add (P m) n = P (add m n)

instance : has_zero myint := ⟨myint.zero⟩
instance : has_one myint := ⟨myint.succ myint.zero⟩
noncomputable instance : has_add myint := ⟨add⟩

-- def myint.one := myint.succ 0
-- def myint.neg_one := myint.succ 0
-- attribute [pattern] myint.one
-- @[refl]
lemma add.zero {n : myint} : add myint.zero n = n := by {
  rw add.zero_id,
  exact id.def n, -- refl,
}

@[simp]
lemma myint.zero_def : 0 = myint.zero := rfl

@[simp]
lemma myint.one_def : 1 = S 0 := rfl

-- test reflexivity attribute
-- lemma x1_proof : add 0 10 = 10 := add.zero
-- example : x1_proof = add.zero := rfl -- demonstrate that proof is add_zero?

-- test reflexivity attribute
lemma x1_proof : S 10 = S 10 := by refl
example : x1_proof = eq.refl (S _) := rfl

example : (0 : myint) + 0 = 0 := @add.zero 0
example : (0 : myint) + 1 = 1 := @add.zero 1

example : add (S 0) 0 = (1 : myint) := by {
  rw add.succ,
  rw myint.zero_def,
  rw add.zero,
  refl,
  -- exact myint.one_def,
}

example : (1 : myint) + 0 = 1 := by { simp [(+)], rw [add.succ, add.zero] }
example : (1 : myint) + 1 = pos 2 := by {
  rw pos.step,
  rw pos.step,
  rw pos.zero,
  simp [(+)],
  rw add.succ,
  rw add.zero,
}

-- lemma myint.one_def : 1 = myint.one := rfl
-- attribute [simp] myint.one_def

example : add myint.zero 1 = S 0 :=
begin
  rw add.zero,
  refl,
  -- rw myint.one_def,
end

example : neg 1 + 1 = 0 :=
begin
  simp only [(+)],
  rw neg_one,
  rw add.pred,
  rw add.zero,
  rw myint.one_def,
  exact pred_succ,
end

lemma zero_add (n : myint) : add 0 n = n := add.zero
lemma add_zero (n : myint) : add n 0 = n :=
begin
  induction n with n ih n ih,
  { exact add.zero },
  {
    -- rw [add.succ, ih]
    apply eq.trans (@add.succ n 0),
    congr,
    exact ih,
  },
  {
    -- rw [add.pred, ih],
    type_check @add.pred n 0,
    apply eq.trans (@add.pred n 0),
    congr,
    exact ih,
  },
end

#print add_zero

lemma add_zero_one : add 0 1 = 1 ∧ add 1 0 = 1 := by simp [add.succ, add.zero]
lemma some (a b : Prop) {ha : a} {hb : b} : a ∧ b := by split; assumption
example : and.intro add_zero_one.left add_zero_one.right = add_zero_one := rfl
example : add_zero_one.left = add_zero_one.1 ∧ add_zero_one.right = add_zero_one.2 :=
  ⟨rfl, rfl⟩

end integer_numbers

namespace halfnumbers

inductive nat
| zero : nat
| succ : nat → nat
| halfpred : nat → nat

notation 0 := nat.zero
def S := nat.succ
def P := nat.halfpred
notation 1 := S 0
axiom succ_pred_2 : ∀ n : nat, S (P (P n)) = n
axiom pred_2_succ : ∀ n : nat, P (P (S n)) = n
-- We dont need this type of numbers because:
--   If substitute [P (P n) → P² n] in all theorems than halfnumbers becomes
-- integer numbers with successor S and predecessor P².

-- But if P has additional properties rather than P²?

end halfnumbers


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

! This file was ported from Lean 3 source module group_theory.finiteness
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pointwise.Finite
import Mathlib.GroupTheory.QuotientGroup
import Mathlib.GroupTheory.Submonoid.Operations
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.SetTheory.Cardinal.Finite
import Mathlib.Data.Finset.Preimage

/-!
# Finitely generated monoids and groups

We define finitely generated monoids and groups. See also `Submodule.Fg` and `Module.Finite` for
finitely-generated modules.

## Main definition

* `Submonoid.Fg S`, `AddSubmonoid.Fg S` : A submonoid `S` is finitely generated.
* `Monoid.Fg M`, `AddMonoid.Fg M` : A typeclass indicating a type `M` is finitely generated as a
monoid.
* `Subgroup.Fg S`, `AddSubgroup.Fg S` : A subgroup `S` is finitely generated.
* `Group.Fg M`, `AddGroup.Fg M` : A typeclass indicating a type `M` is finitely generated as a
group.

-/

/-! ### Monoids and submonoids -/

open Pointwise

variable {M N : Type _} [Monoid M] [AddMonoid N]

section Submonoid

/-- A submonoid of `M` is finitely generated if it is the closure of a finite subset of `M`. -/
@[to_additive]
def Submonoid.Fg (P : Submonoid M) : Prop :=
  ∃ S : Finset M, Submonoid.closure ↑S = P
#align submonoid.fg Submonoid.Fg
#align add_submonoid.fg AddSubmonoid.Fg

/-- An additive submonoid of `N` is finitely generated if it is the closure of a finite subset of
`M`. -/
add_decl_doc AddSubmonoid.Fg

/-- An equivalent expression of `Submonoid.Fg` in terms of `Set.Finite` instead of `Finset`. -/
@[to_additive "An equivalent expression of `AddSubmonoid.Fg` in terms of `Set.Finite` instead of
`Finset`."]
theorem Submonoid.fg_iff (P : Submonoid M) :
    Submonoid.Fg P ↔ ∃ S : Set M, Submonoid.closure S = P ∧ S.Finite :=
  ⟨fun ⟨S, hS⟩ => ⟨S, hS, Finset.finite_toSet S⟩, fun ⟨S, hS, hf⟩ =>
    ⟨Set.Finite.toFinset hf, by simp [hS]⟩⟩
#align submonoid.fg_iff Submonoid.fg_iff
#align add_submonoid.fg_iff AddSubmonoid.fg_iff

theorem Submonoid.fg_iff_add_fg (P : Submonoid M) : P.Fg ↔ P.toAddSubmonoid.Fg :=
  ⟨fun h =>
    let ⟨S, hS, hf⟩ := (Submonoid.fg_iff _).1 h
    (AddSubmonoid.fg_iff _).mpr
      ⟨Additive.toMul ⁻¹' S, by simp [← Submonoid.toAddSubmonoid_closure, hS], hf⟩,
    fun h =>
    let ⟨T, hT, hf⟩ := (AddSubmonoid.fg_iff _).1 h
    (Submonoid.fg_iff _).mpr
      ⟨Multiplicative.ofAdd ⁻¹' T, by simp [← AddSubmonoid.toSubmonoid'_closure, hT], hf⟩⟩
#align submonoid.fg_iff_add_fg Submonoid.fg_iff_add_fg

theorem AddSubmonoid.fg_iff_mul_fg (P : AddSubmonoid N) : P.Fg ↔ P.toSubmonoid.Fg := by
  convert (Submonoid.fg_iff_add_fg (toSubmonoid P)).symm
#align add_submonoid.fg_iff_mul_fg AddSubmonoid.fg_iff_mul_fg

end Submonoid

section Monoid

variable (M N)

/-- A monoid is finitely generated if it is finitely generated as a submonoid of itself. -/
class Monoid.Fg : Prop where
  out : (⊤ : Submonoid M).Fg
#align monoid.fg Monoid.Fg

/-- An additive monoid is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class AddMonoid.Fg : Prop where
  out : (⊤ : AddSubmonoid N).Fg
#align add_monoid.fg AddMonoid.Fg

attribute [to_additive] Monoid.Fg

variable {M N}

theorem Monoid.fg_def : Monoid.Fg M ↔ (⊤ : Submonoid M).Fg :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align monoid.fg_def Monoid.fg_def

theorem AddMonoid.fg_def : AddMonoid.Fg N ↔ (⊤ : AddSubmonoid N).Fg :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align add_monoid.fg_def AddMonoid.fg_def

/-- An equivalent expression of `Monoid.Fg` in terms of `Set.Finite` instead of `Finset`. -/
@[to_additive
      "An equivalent expression of `AddMonoid.Fg` in terms of `Set.Finite` instead of `Finset`."]
theorem Monoid.fg_iff :
    Monoid.Fg M ↔ ∃ S : Set M, Submonoid.closure S = (⊤ : Submonoid M) ∧ S.Finite :=
  ⟨fun h => (Submonoid.fg_iff ⊤).1 h.out, fun h => ⟨(Submonoid.fg_iff ⊤).2 h⟩⟩
#align monoid.fg_iff Monoid.fg_iff
#align add_monoid.fg_iff AddMonoid.fg_iff

theorem Monoid.fg_iff_add_fg : Monoid.Fg M ↔ AddMonoid.Fg (Additive M) :=
  ⟨fun h => ⟨(Submonoid.fg_iff_add_fg ⊤).1 h.out⟩, fun h => ⟨(Submonoid.fg_iff_add_fg ⊤).2 h.out⟩⟩
#align monoid.fg_iff_add_fg Monoid.fg_iff_add_fg

theorem AddMonoid.fg_iff_mul_fg : AddMonoid.Fg N ↔ Monoid.Fg (Multiplicative N) :=
  ⟨fun h => ⟨(AddSubmonoid.fg_iff_mul_fg ⊤).1 h.out⟩, fun h =>
    ⟨(AddSubmonoid.fg_iff_mul_fg ⊤).2 h.out⟩⟩
#align add_monoid.fg_iff_mul_fg AddMonoid.fg_iff_mul_fg

instance AddMonoid.fg_of_monoid_fg [Monoid.Fg M] : AddMonoid.Fg (Additive M) :=
  Monoid.fg_iff_add_fg.1 ‹_›
#align add_monoid.fg_of_monoid_fg AddMonoid.fg_of_monoid_fg

instance Monoid.fg_of_addMonoid_fg [AddMonoid.Fg N] : Monoid.Fg (Multiplicative N) :=
  AddMonoid.fg_iff_mul_fg.1 ‹_›
#align monoid.fg_of_add_monoid_fg Monoid.fg_of_addMonoid_fg

@[to_additive]
instance (priority := 100) Monoid.fg_of_finite [Finite M] : Monoid.Fg M := by
  cases nonempty_fintype M
  exact ⟨⟨Finset.univ, by rw [Finset.coe_univ] ; exact Submonoid.closure_univ⟩⟩
#align monoid.fg_of_finite Monoid.fg_of_finite
#align add_monoid.fg_of_finite AddMonoid.fg_of_finite

end Monoid

@[to_additive]
theorem Submonoid.Fg.map {M' : Type _} [Monoid M'] {P : Submonoid M} (h : P.Fg) (e : M →* M') :
    (P.map e).Fg := by
  classical
    obtain ⟨s, rfl⟩ := h
    exact ⟨s.image e, by rw [Finset.coe_image, MonoidHom.map_mclosure]⟩
#align submonoid.fg.map Submonoid.Fg.map
#align add_submonoid.fg.map AddSubmonoid.Fg.map

@[to_additive]
theorem Submonoid.Fg.map_injective {M' : Type _} [Monoid M'] {P : Submonoid M} (e : M →* M')
    (he : Function.Injective e) (h : (P.map e).Fg) : P.Fg := by
  obtain ⟨s, hs⟩ := h
  use s.preimage e (he.injOn _)
  apply Submonoid.map_injective_of_injective he
  rw [← hs, MonoidHom.map_mclosure e, Finset.coe_preimage]
  congr
  rw [Set.image_preimage_eq_iff, ← MonoidHom.coe_mrange e, ← Submonoid.closure_le, hs,
      MonoidHom.mrange_eq_map e]
  exact Submonoid.monotone_map le_top
#align submonoid.fg.map_injective Submonoid.Fg.map_injective
#align add_submonoid.fg.map_injective AddSubmonoid.Fg.map_injective

@[to_additive (attr := simp)]
theorem Monoid.fg_iff_submonoid_fg (N : Submonoid M) : Monoid.Fg N ↔ N.Fg := by
  conv_rhs => rw [← N.range_subtype, MonoidHom.mrange_eq_map]
  exact ⟨fun h => h.out.map N.subtype, fun h => ⟨h.map_injective N.subtype Subtype.coe_injective⟩⟩
#align monoid.fg_iff_submonoid_fg Monoid.fg_iff_submonoid_fg
#align add_monoid.fg_iff_add_submonoid_fg AddMonoid.fg_iff_addSubmonoid_fg

@[to_additive]
theorem Monoid.fg_of_surjective {M' : Type _} [Monoid M'] [Monoid.Fg M] (f : M →* M')
    (hf : Function.Surjective f) : Monoid.Fg M' := by
  classical
    obtain ⟨s, hs⟩ := Monoid.fg_def.mp ‹_›
    use s.image f
    rwa [Finset.coe_image, ← MonoidHom.map_mclosure, hs, ← MonoidHom.mrange_eq_map,
      MonoidHom.mrange_top_iff_surjective]
#align monoid.fg_of_surjective Monoid.fg_of_surjective
#align add_monoid.fg_of_surjective AddMonoid.fg_of_surjective

@[to_additive]
instance Monoid.fg_range {M' : Type _} [Monoid M'] [Monoid.Fg M] (f : M →* M') :
    Monoid.Fg (MonoidHom.mrange f) :=
  Monoid.fg_of_surjective f.mrangeRestrict f.mrangeRestrict_surjective
#align monoid.fg_range Monoid.fg_range
#align add_monoid.fg_range AddMonoid.fg_range

@[to_additive AddSubmonoid.multiples_fg]
theorem Submonoid.powers_fg (r : M) : (Submonoid.powers r).Fg :=
  ⟨{r}, (Finset.coe_singleton r).symm ▸ (Submonoid.powers_eq_closure r).symm⟩
#align submonoid.powers_fg Submonoid.powers_fg
#align add_submonoid.multiples_fg AddSubmonoid.multiples_fg

@[to_additive AddMonoid.multiples_fg]
instance Monoid.powers_fg (r : M) : Monoid.Fg (Submonoid.powers r) :=
  (Monoid.fg_iff_submonoid_fg _).mpr (Submonoid.powers_fg r)
#align monoid.powers_fg Monoid.powers_fg
#align add_monoid.multiples_fg AddMonoid.multiples_fg

@[to_additive]
instance Monoid.closure_finset_fg (s : Finset M) : Monoid.Fg (Submonoid.closure (s : Set M)) := by
  refine' ⟨⟨s.preimage Subtype.val (Subtype.coe_injective.injOn _), _⟩⟩
  rw [Finset.coe_preimage, Submonoid.closure_closure_coe_preimage]
#align monoid.closure_finset_fg Monoid.closure_finset_fg
#align add_monoid.closure_finset_fg AddMonoid.closure_finset_fg

@[to_additive]
instance Monoid.closure_finite_fg (s : Set M) [Finite s] : Monoid.Fg (Submonoid.closure s) :=
  haveI := Fintype.ofFinite s
  s.coe_toFinset ▸ Monoid.closure_finset_fg s.toFinset
#align monoid.closure_finite_fg Monoid.closure_finite_fg
#align add_monoid.closure_finite_fg AddMonoid.closure_finite_fg

/-! ### Groups and subgroups -/

variable {G H : Type _} [Group G] [AddGroup H]

section Subgroup

/-- A subgroup of `G` is finitely generated if it is the closure of a finite subset of `G`. -/
@[to_additive]
def Subgroup.Fg (P : Subgroup G) : Prop :=
  ∃ S : Finset G, Subgroup.closure ↑S = P
#align subgroup.fg Subgroup.Fg
#align add_subgroup.fg AddSubgroup.Fg

/-- An additive subgroup of `H` is finitely generated if it is the closure of a finite subset of
`H`. -/
add_decl_doc AddSubgroup.Fg

/-- An equivalent expression of `Subgroup.Fg` in terms of `Set.Finite` instead of `Finset`. -/
@[to_additive "An equivalent expression of `AddSubgroup.fg` in terms of `Set.Finite` instead of
`Finset`."]
theorem Subgroup.fg_iff (P : Subgroup G) :
    Subgroup.Fg P ↔ ∃ S : Set G, Subgroup.closure S = P ∧ S.Finite :=
  ⟨fun ⟨S, hS⟩ => ⟨S, hS, Finset.finite_toSet S⟩, fun ⟨S, hS, hf⟩ =>
    ⟨Set.Finite.toFinset hf, by simp [hS]⟩⟩
#align subgroup.fg_iff Subgroup.fg_iff
#align add_subgroup.fg_iff AddSubgroup.fg_iff

/-- A subgroup is finitely generated if and only if it is finitely generated as a submonoid. -/
@[to_additive "An additive subgroup is finitely generated if
and only if it is finitely generated as an additive submonoid."]
theorem Subgroup.fg_iff_submonoid_fg (P : Subgroup G) : P.Fg ↔ P.toSubmonoid.Fg := by
  constructor
  · rintro ⟨S, rfl⟩
    rw [Submonoid.fg_iff]
    refine' ⟨S ∪ S⁻¹, _, S.finite_toSet.union S.finite_toSet.inv⟩
    exact (Subgroup.closure_toSubmonoid _).symm
  · rintro ⟨S, hS⟩
    refine' ⟨S, le_antisymm _ _⟩
    · rw [Subgroup.closure_le, ← Subgroup.coe_toSubmonoid, ← hS]
      exact Submonoid.subset_closure
    · rw [← Subgroup.toSubmonoid_le, ← hS, Submonoid.closure_le]
      exact Subgroup.subset_closure
#align subgroup.fg_iff_submonoid_fg Subgroup.fg_iff_submonoid_fg
#align add_subgroup.fg_iff_add_submonoid.fg AddSubgroup.fg_iff_addSubmonoid_fg

theorem Subgroup.fg_iff_add_fg (P : Subgroup G) : P.Fg ↔ P.toAddSubgroup.Fg := by
  rw [Subgroup.fg_iff_submonoid_fg, AddSubgroup.fg_iff_addSubmonoid_fg]
  exact (Subgroup.toSubmonoid P).fg_iff_add_fg
#align subgroup.fg_iff_add_fg Subgroup.fg_iff_add_fg

theorem AddSubgroup.fg_iff_mul_fg (P : AddSubgroup H) : P.Fg ↔ P.toSubgroup.Fg := by
  rw [AddSubgroup.fg_iff_addSubmonoid_fg, Subgroup.fg_iff_submonoid_fg]
  exact AddSubmonoid.fg_iff_mul_fg (AddSubgroup.toAddSubmonoid P)
#align add_subgroup.fg_iff_mul_fg AddSubgroup.fg_iff_mul_fg

end Subgroup

section Group

variable (G H)

/-- A group is finitely generated if it is finitely generated as a submonoid of itself. -/
class Group.Fg : Prop where
  out : (⊤ : Subgroup G).Fg
#align group.fg Group.Fg

/-- An additive group is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class AddGroup.Fg : Prop where
  out : (⊤ : AddSubgroup H).Fg
#align add_group.fg AddGroup.Fg

attribute [to_additive] Group.Fg

variable {G H}

theorem Group.fg_def : Group.Fg G ↔ (⊤ : Subgroup G).Fg :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align group.fg_def Group.fg_def

theorem AddGroup.fg_def : AddGroup.Fg H ↔ (⊤ : AddSubgroup H).Fg :=
  ⟨fun h => h.1, fun h => ⟨h⟩⟩
#align add_group.fg_def AddGroup.fg_def

/-- An equivalent expression of `Group.Fg` in terms of `Set.Finite` instead of `Finset`. -/
@[to_additive
      "An equivalent expression of `AddGroup.fg` in terms of `Set.Finite` instead of `Finset`."]
theorem Group.fg_iff : Group.Fg G ↔ ∃ S : Set G, Subgroup.closure S = (⊤ : Subgroup G) ∧ S.Finite :=
  ⟨fun h => (Subgroup.fg_iff ⊤).1 h.out, fun h => ⟨(Subgroup.fg_iff ⊤).2 h⟩⟩
#align group.fg_iff Group.fg_iff
#align add_group.fg_iff AddGroup.fg_iff

@[to_additive]
theorem Group.fg_iff' :
    Group.Fg G ↔ ∃ (n : _)(S : Finset G), S.card = n ∧ Subgroup.closure (S : Set G) = ⊤ :=
  Group.fg_def.trans ⟨fun ⟨S, hS⟩ => ⟨S.card, S, rfl, hS⟩, fun ⟨_n, S, _hn, hS⟩ => ⟨S, hS⟩⟩
#align group.fg_iff' Group.fg_iff'
#align add_group.fg_iff' AddGroup.fg_iff'

/-- A group is finitely generated if and only if it is finitely generated as a monoid. -/
@[to_additive "An additive group is finitely generated if and only
if it is finitely generated as an additive monoid."]
theorem Group.fg_iff_monoid_fg : Group.Fg G ↔ Monoid.Fg G :=
  ⟨fun h => Monoid.fg_def.2 <| (Subgroup.fg_iff_submonoid_fg ⊤).1 (Group.fg_def.1 h), fun h =>
    Group.fg_def.2 <| (Subgroup.fg_iff_submonoid_fg ⊤).2 (Monoid.fg_def.1 h)⟩
#align group.fg_iff_monoid.fg Group.fg_iff_monoid_fg
#align add_group.fg_iff_add_monoid.fg AddGroup.fg_iff_addMonoid_fg

theorem GroupFg.iff_add_fg : Group.Fg G ↔ AddGroup.Fg (Additive G) :=
  ⟨fun h => ⟨(Subgroup.fg_iff_add_fg ⊤).1 h.out⟩, fun h => ⟨(Subgroup.fg_iff_add_fg ⊤).2 h.out⟩⟩
#align group_fg.iff_add_fg GroupFg.iff_add_fg

theorem AddGroup.fg_iff_mul_fg : AddGroup.Fg H ↔ Group.Fg (Multiplicative H) :=
  ⟨fun h => ⟨(AddSubgroup.fg_iff_mul_fg ⊤).1 h.out⟩, fun h =>
    ⟨(AddSubgroup.fg_iff_mul_fg ⊤).2 h.out⟩⟩
#align add_group.fg_iff_mul_fg AddGroup.fg_iff_mul_fg

instance AddGroup.fg_of_group_fg [Group.Fg G] : AddGroup.Fg (Additive G) :=
  GroupFg.iff_add_fg.1 ‹_›
#align add_group.fg_of_group_fg AddGroup.fg_of_group_fg

instance Group.fg_of_mul_group_fg [AddGroup.Fg H] : Group.Fg (Multiplicative H) :=
  AddGroup.fg_iff_mul_fg.1 ‹_›
#align group.fg_of_mul_group_fg Group.fg_of_mul_group_fg

@[to_additive]
instance (priority := 100) Group.fg_of_finite [Finite G] : Group.Fg G := by
  cases nonempty_fintype G
  exact ⟨⟨Finset.univ, by rw [Finset.coe_univ] ; exact Subgroup.closure_univ⟩⟩
#align group.fg_of_finite Group.fg_of_finite
#align add_group.fg_of_finite AddGroup.fg_of_finite

@[to_additive]
theorem Group.fg_of_surjective {G' : Type _} [Group G'] [hG : Group.Fg G] {f : G →* G'}
    (hf : Function.Surjective f) : Group.Fg G' :=
  Group.fg_iff_monoid_fg.mpr <|
    @Monoid.fg_of_surjective G _ G' _ (Group.fg_iff_monoid_fg.mp hG) f hf
#align group.fg_of_surjective Group.fg_of_surjective
#align add_group.fg_of_surjective AddGroup.fg_of_surjective

@[to_additive]
instance Group.fg_range {G' : Type _} [Group G'] [Group.Fg G] (f : G →* G') : Group.Fg f.range :=
  Group.fg_of_surjective f.rangeRestrict_surjective
#align group.fg_range Group.fg_range
#align add_group.fg_range AddGroup.fg_range

@[to_additive]
instance Group.closure_finset_fg (s : Finset G) : Group.Fg (Subgroup.closure (s : Set G)) := by
  refine' ⟨⟨s.preimage Subtype.val (Subtype.coe_injective.injOn _), _⟩⟩
  rw [Finset.coe_preimage, ← Subgroup.coeSubtype, Subgroup.closure_preimage_eq_top]
#align group.closure_finset_fg Group.closure_finset_fg
#align add_group.closure_finset_fg AddGroup.closure_finset_fg

@[to_additive]
instance Group.closure_finite_fg (s : Set G) [Finite s] : Group.Fg (Subgroup.closure s) :=
  haveI := Fintype.ofFinite s
  s.coe_toFinset ▸ Group.closure_finset_fg s.toFinset
#align group.closure_finite_fg Group.closure_finite_fg
#align add_group.closure_finite_fg AddGroup.closure_finite_fg

variable (G)

/-- The minimum number of generators of a group. -/
@[to_additive "The minimum number of generators of an additive group"]
noncomputable def Group.rank [h : Group.Fg G] :=
  @Nat.find _ (Classical.decPred _) (Group.fg_iff'.mp h)
#align group.rank Group.rank
#align add_group.rank AddGroup.rank

@[to_additive]
theorem Group.rank_spec [h : Group.Fg G] :
    ∃ S : Finset G, S.card = Group.rank G ∧ Subgroup.closure (S : Set G) = ⊤ :=
  @Nat.find_spec _ (Classical.decPred _) (Group.fg_iff'.mp h)
#align group.rank_spec Group.rank_spec
#align add_group.rank_spec AddGroup.rank_spec

@[to_additive]
theorem Group.rank_le [h : Group.Fg G] {S : Finset G} (hS : Subgroup.closure (S : Set G) = ⊤) :
    Group.rank G ≤ S.card :=
  @Nat.find_le _ _ (Classical.decPred _) (Group.fg_iff'.mp h) ⟨S, rfl, hS⟩
#align group.rank_le Group.rank_le
#align add_group.rank_le AddGroup.rank_le

variable {G} {G' : Type _} [Group G']

@[to_additive]
theorem Group.rank_le_of_surjective [Group.Fg G] [Group.Fg G'] (f : G →* G')
    (hf : Function.Surjective f) : Group.rank G' ≤ Group.rank G := by
  classical
    obtain ⟨S, hS1, hS2⟩ := Group.rank_spec G
    trans (S.image f).card
    · apply Group.rank_le
      rw [Finset.coe_image, ← MonoidHom.map_closure, hS2, Subgroup.map_top_of_surjective f hf]
    · exact Finset.card_image_le.trans_eq hS1
#align group.rank_le_of_surjective Group.rank_le_of_surjective
#align add_group.rank_le_of_surjective AddGroup.rank_le_of_surjective

@[to_additive]
theorem Group.rank_range_le [Group.Fg G] {f : G →* G'} : Group.rank f.range ≤ Group.rank G :=
  Group.rank_le_of_surjective f.rangeRestrict f.rangeRestrict_surjective
#align group.rank_range_le Group.rank_range_le
#align add_group.rank_range_le AddGroup.rank_range_le

@[to_additive]
theorem Group.rank_congr [Group.Fg G] [Group.Fg G'] (f : G ≃* G') : Group.rank G = Group.rank G' :=
  le_antisymm (Group.rank_le_of_surjective f.symm f.symm.surjective)
    (Group.rank_le_of_surjective f f.surjective)
#align group.rank_congr Group.rank_congr
#align add_group.rank_congr AddGroup.rank_congr

end Group

namespace Subgroup

@[to_additive]
theorem rank_congr {H K : Subgroup G} [Group.Fg H] [Group.Fg K] (h : H = K) :
    Group.rank H = Group.rank K := by subst h; rfl
#align subgroup.rank_congr Subgroup.rank_congr
#align add_subgroup.rank_congr AddSubgroup.rank_congr

@[to_additive]
theorem rank_closure_finset_le_card (s : Finset G) : Group.rank (closure (s : Set G)) ≤ s.card := by
  classical
    let t : Finset (closure (s : Set G)) := s.preimage Subtype.val (Subtype.coe_injective.injOn _)
    have ht : closure (t : Set (closure (s : Set G))) = ⊤ := by
      rw [Finset.coe_preimage]
      exact closure_preimage_eq_top (s : Set G)
    apply (Group.rank_le (closure (s : Set G)) ht).trans
    suffices H : Set.InjOn Subtype.val (t : Set (closure (s : Set G)))
    rw [← Finset.card_image_of_injOn H, Finset.image_preimage]
    · apply Finset.card_filter_le
    · apply Subtype.coe_injective.injOn
#align subgroup.rank_closure_finset_le_card Subgroup.rank_closure_finset_le_card
#align add_subgroup.rank_closure_finset_le_card AddSubgroup.rank_closure_finset_le_card

@[to_additive]
theorem rank_closure_finite_le_nat_card (s : Set G) [Finite s] :
    Group.rank (closure s) ≤ Nat.card s := by
  haveI := Fintype.ofFinite s
  rw [Nat.card_eq_fintype_card, ← s.toFinset_card, ← rank_congr (congr_arg _ s.coe_toFinset)]
  exact rank_closure_finset_le_card s.toFinset
#align subgroup.rank_closure_finite_le_nat_card Subgroup.rank_closure_finite_le_nat_card
#align add_subgroup.rank_closure_finite_le_nat_card AddSubgroup.rank_closure_finite_le_nat_card

end Subgroup

section QuotientGroup

@[to_additive]
instance QuotientGroup.fg [Group.Fg G] (N : Subgroup G) [Subgroup.Normal N] : Group.Fg <| G ⧸ N :=
  Group.fg_of_surjective <| QuotientGroup.mk'_surjective N
#align quotient_group.fg QuotientGroup.fg
#align quotient_add_group.fg QuotientAddGroup.fg

end QuotientGroup


-- Las funciones de extracción no están acotadas
-- =============================================

import data.real.basic
open nat

variable {φ : ℕ → ℕ}

-- ----------------------------------------------------
-- Nota. Se usará la siguiente definición y lema
-- estudiado anteriormente.
-- ----------------------------------------------------

def extraccion : (ℕ → ℕ) → Prop
| φ := ∀ n m, n < m → φ n < φ m

lemma id_mne_extraccion
  (h : extraccion φ)
  : ∀ n, n ≤ φ n :=
begin
  intros n,
  induction n with m HI,
  { linarith },
  { exact nat.succ_le_of_lt (by linarith [h m (m+1) (by linarith)]) },
end

-- ----------------------------------------------------
-- Ejercicio. Demostrar que las funciones de extracción
-- no está acotadas; es decir, que si φ es una función
-- de extracción, entonces
--     ∀ N N', ∃ n ≥ N', φ n ≥ N
-- ----------------------------------------------------

-- 1ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros N N',
  let n := max N N',
  use n,
  split,
  { exact le_max_right N N', },
  { calc N ≤ n   : le_max_left N N'
       ... ≤ φ n : id_mne_extraccion h n, },
end

-- 2ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros N N',
  let n := max N N',
  use n,
  split,
  { exact le_max_right N N', },
  { exact le_trans (le_max_left N N')
                   (id_mne_extraccion h n), },
end

-- 3ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros N N',
  use max N N',
  split,
  { exact le_max_right N N', },
  { exact le_trans (le_max_left N N')
                   (id_mne_extraccion h (max N N')), },
end

-- 4ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros N N',
  use max N N',
  exact ⟨le_max_right N N',
         le_trans (le_max_left N N')
                  (id_mne_extraccion h (max N N'))⟩,
end

-- 5ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
λ N N',
  ⟨max N N', ⟨le_max_right N N',
              le_trans (le_max_left N N')
                       (id_mne_extraccion h (max N N'))⟩⟩

-- 6ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
assume N N',
let n := max N N' in
have h1 : n ≥ N',
  from le_max_right N N',
show ∃ n ≥ N', φ n ≥ N, from
exists.intro n
  (exists.intro h1
    (show φ n ≥ N, from
       calc N ≤ n   : le_max_left N N'
          ... ≤ φ n : id_mne_extraccion h n))

-- 7ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
assume N N',
let n := max N N' in
have h1 : n ≥ N',
  from le_max_right N N',
show ∃ n ≥ N', φ n ≥ N, from
⟨n, h1, calc N ≤ n   : le_max_left N N'
          ...  ≤ φ n : id_mne_extraccion h n⟩

-- 8ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
assume N N',
let n := max N N' in
have h1 : n ≥ N',
  from le_max_right N N',
show ∃ n ≥ N', φ n ≥ N, from
⟨n, h1, le_trans (le_max_left N N')
                 (id_mne_extraccion h (max N N'))⟩

-- 9ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
assume N N',
let n := max N N' in
have h1 : n ≥ N',
  from le_max_right N N',
⟨n, h1, le_trans (le_max_left N N')
                 (id_mne_extraccion h n)⟩

-- 10ª demostración
example
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
assume N N',
⟨max N N', le_max_right N N',
           le_trans (le_max_left N N')
                    (id_mne_extraccion h (max N N'))⟩

-- 11ª demostración
lemma extraccion_mye
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
λ N N',
  ⟨max N N', le_max_right N N',
             le_trans (le_max_left N N')
             (id_mne_extraccion h (max N N'))⟩


/-
Copyright (c) 2015, 2017 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Extended metric spaces.

Authors: Jeremy Avigad, Robert Y. Lewis, Johannes Hölzl, Mario Carneiro, Sébastien Gouëzel

This file is devoted to the definition and study of `emetric_spaces`, i.e., metric
spaces in which the distance is allowed to take the value ∞. This extended distance is
called `edist`, and takes values in `ennreal`.

Many definitions and theorems expected on emetric spaces are already introduced on uniform spaces and
topological spaces. For example:
  open and closed sets, compactness, completeness, continuity and uniform continuity

The class `emetric_space` therefore extends `uniform_space` (and `topological_space`).
-/

import data.real.nnreal data.real.ennreal
import topology.uniform_space.separation topology.uniform_space.uniform_embedding
open lattice set filter classical
noncomputable theory

local notation `𝓤` := uniformity

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

/-- Characterizing uniformities associated to a (generalized) distance function `D`
in terms of the elements of the uniformity. -/
theorem uniformity_dist_of_mem_uniformity [linear_order β] {U : filter (α × α)} (z : β) (D : α → α → β)
  (H : ∀ s, s ∈ U ↔ ∃ε>z, ∀{a b:α}, D a b < ε → (a, b) ∈ s) :
  U = ⨅ ε>z, principal {p:α×α | D p.1 p.2 < ε} :=
le_antisymm
  (le_infi $ λ ε, le_infi $ λ ε0, le_principal_iff.2 $ (H _).2 ⟨ε, ε0, λ a b, id⟩)
  (λ r ur, let ⟨ε, ε0, h⟩ := (H _).1 ur in
    mem_infi_sets ε $ mem_infi_sets ε0 $ mem_principal_sets.2 $ λ ⟨a, b⟩, h)

class has_edist (α : Type*) := (edist : α → α → ennreal)
export has_edist (edist)

/- Design note: one could define an `emetric_space` just by giving `edist`, and then
derive an instance of `uniform_space` by taking the natural uniform structure
associated to the distance. This creates diamonds problem for products, as the
uniform structure on the product of two emetric spaces could be obtained first
by obtaining two uniform spaces and then taking their products, or by taking
the product of the emetric spaces and then the associated uniform structure.
The two uniform structure we have just described are equal, but not defeq, which
creates a lot of problem.

The idea is to add, in the very definition of an `emetric_space`, a uniform structure
with a uniformity which equal to the one given by the distance, but maybe not defeq.
And the instance from `emetric_space` to `uniform_space` uses this uniformity.
In this way, when we create the product of emetric spaces, we put in the product
the uniformity corresponding to the product of the uniformities. There is one more
proof obligation, that this product uniformity is equal to the uniformity corresponding
to the product metric. But the diamond problem disappears.

The same trick is used in the definition of a metric space, where one stores as well
a uniform structure and an edistance. -/

/-- Creating a uniform space from an extended distance. -/
def uniform_space_of_edist
  (edist : α → α → ennreal)
  (edist_self : ∀ x : α, edist x x = 0)
  (edist_comm : ∀ x y : α, edist x y = edist y x)
  (edist_triangle : ∀ x y z : α, edist x z ≤ edist x y + edist y z) : uniform_space α :=
uniform_space.of_core {
  uniformity := (⨅ ε>0, principal {p:α×α | edist p.1 p.2 < ε}),
  refl       := le_infi $ assume ε, le_infi $
    by simp [set.subset_def, id_rel, edist_self, (>)] {contextual := tt},
  comp       :=
    le_infi $ assume ε, le_infi $ assume h,
    have (2 : ennreal) = (2 : ℕ) := by simp,
    have A : 0 < ε / 2 := ennreal.div_pos_iff.2 ⟨ne_of_gt h, this ▸ ennreal.nat_ne_top 2⟩,
    lift'_le
    (mem_infi_sets (ε / 2) $ mem_infi_sets A (subset.refl _)) $
    have ∀ (a b c : α), edist a c < ε / 2 → edist c b < ε / 2 → edist a b < ε,
      from assume a b c hac hcb,
      calc edist a b ≤ edist a c + edist c b : edist_triangle _ _ _
        ... < ε / 2 + ε / 2 : ennreal.add_lt_add hac hcb
        ... = ε : by rw [ennreal.add_halves],
    by simpa [comp_rel],
  symm       := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ by simp [edist_comm] }

/-- Extended metric spaces, with an extended distance `edist` possibly taking the
value ∞

Each emetric space induces a canonical `uniform_space` and hence a canonical `topological_space`.
This is enforced in the type class definition, by extending the `uniform_space` structure. When
instantiating an `emetric_space` structure, the uniformity fields are not necessary, they will be
filled in by default. There is a default value for the uniformity, that can be substituted
in cases of interest, for instance when instantiating an `emetric_space` structure
on a product.

Continuity of `edist` is finally proving in `topology.instances.ennreal`
-/
class emetric_space (α : Type u) extends has_edist α : Type u :=
(edist_self : ∀ x : α, edist x x = 0)
(eq_of_edist_eq_zero : ∀ {x y : α}, edist x y = 0 → x = y)
(edist_comm : ∀ x y : α, edist x y = edist y x)
(edist_triangle : ∀ x y z : α, edist x z ≤ edist x y + edist y z)
(to_uniform_space : uniform_space α := uniform_space_of_edist edist edist_self edist_comm edist_triangle)
(uniformity_edist : 𝓤 α = ⨅ ε>0, principal {p:α×α | edist p.1 p.2 < ε} . control_laws_tac)

/- emetric spaces are less common than metric spaces. Therefore, we work in a dedicated
namespace, while notions associated to metric spaces are mostly in the root namespace. -/
variables [emetric_space α]

instance emetric_space.to_uniform_space' : uniform_space α :=
emetric_space.to_uniform_space α

export emetric_space (edist_self eq_of_edist_eq_zero edist_comm edist_triangle)

attribute [simp] edist_self

/-- Characterize the equality of points by the vanishing of their extended distance -/
@[simp] theorem edist_eq_zero {x y : α} : edist x y = 0 ↔ x = y :=
iff.intro eq_of_edist_eq_zero (assume : x = y, this ▸ edist_self _)

@[simp] theorem zero_eq_edist {x y : α} : 0 = edist x y ↔ x = y :=
iff.intro (assume h, eq_of_edist_eq_zero (h.symm))
          (assume : x = y, this ▸ (edist_self _).symm)

/-- Triangle inequality for the extended distance -/
theorem edist_triangle_left (x y z : α) : edist x y ≤ edist z x + edist z y :=
by rw edist_comm z; apply edist_triangle

theorem edist_triangle_right (x y z : α) : edist x y ≤ edist x z + edist y z :=
by rw edist_comm y; apply edist_triangle

lemma edist_triangle4 (x y z t : α) :
  edist x t ≤ edist x y + edist y z + edist z t :=
calc
  edist x t ≤ edist x z + edist z t : edist_triangle x z t
... ≤ (edist x y + edist y z) + edist z t : add_le_add_right' (edist_triangle x y z)

/-- Two points coincide if their distance is `< ε` for all positive ε -/
theorem eq_of_forall_edist_le {x y : α} (h : ∀ε, ε > 0 → edist x y ≤ ε) : x = y :=
eq_of_edist_eq_zero (eq_of_le_of_forall_le_of_dense (by simp) h)

/-- Reformulation of the uniform structure in terms of the extended distance -/
theorem uniformity_edist' : 𝓤 α = (⨅ ε>0, principal {p:α×α | edist p.1 p.2 < ε}) :=
emetric_space.uniformity_edist _

/-- Reformulation of the uniform structure in terms of the extended distance on a subtype -/
theorem uniformity_edist'' : 𝓤 α = (⨅ε:{ε:ennreal // ε>0}, principal {p:α×α | edist p.1 p.2 < ε.val}) :=
by simp [infi_subtype]; exact uniformity_edist'

theorem uniformity_edist_nnreal :
  𝓤 α = (⨅(ε:nnreal) (h : ε > 0), principal {p:α×α | edist p.1 p.2 < ε}) :=
begin
  rw [uniformity_edist', ennreal.infi_ennreal, inf_of_le_left],
  { congr, funext ε, refine infi_congr_Prop ennreal.coe_pos _, assume h, refl },
  refine le_infi (assume h, infi_le_of_le 1 $ infi_le_of_le ennreal.zero_lt_one $ _),
  exact principal_mono.2 (assume p h, lt_of_lt_of_le h le_top)
end

/-- Characterization of the elements of the uniformity in terms of the extended distance -/
theorem mem_uniformity_edist {s : set (α×α)} :
  s ∈ 𝓤 α ↔ (∃ε>0, ∀{a b:α}, edist a b < ε → (a, b) ∈ s) :=
begin
  rw [uniformity_edist'', mem_infi],
  simp [subset_def],
  exact assume ⟨r, hr⟩ ⟨p, hp⟩, ⟨⟨min r p, lt_min hr hp⟩, by simp [lt_min_iff, (≥)] {contextual := tt}⟩,
  exact ⟨⟨1, ennreal.zero_lt_one⟩⟩
end

/-- Fixed size neighborhoods of the diagonal belong to the uniform structure -/
theorem edist_mem_uniformity {ε:ennreal} (ε0 : 0 < ε) :
  {p:α×α | edist p.1 p.2 < ε} ∈ 𝓤 α :=
mem_uniformity_edist.2 ⟨ε, ε0, λ a b, id⟩

namespace emetric

/-- ε-δ characterization of uniform continuity on emetric spaces -/
theorem uniform_continuous_iff [emetric_space β] {f : α → β} :
  uniform_continuous f ↔ ∀ ε > 0, ∃ δ > 0,
    ∀{a b:α}, edist a b < δ → edist (f a) (f b) < ε :=
uniform_continuous_def.trans
⟨λ H ε ε0, mem_uniformity_edist.1 $ H _ $ edist_mem_uniformity ε0,
 λ H r ru,
  let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru, ⟨δ, δ0, hδ⟩ := H _ ε0 in
  mem_uniformity_edist.2 ⟨δ, δ0, λ a b h, hε (hδ h)⟩⟩

/-- ε-δ characterization of uniform embeddings on emetric spaces -/
theorem uniform_embedding_iff [emetric_space β] {f : α → β} :
  uniform_embedding f ↔ function.injective f ∧ uniform_continuous f ∧
    ∀ δ > 0, ∃ ε > 0, ∀ {a b : α}, edist (f a) (f b) < ε → edist a b < δ :=
uniform_embedding_def'.trans $ and_congr iff.rfl $ and_congr iff.rfl
⟨λ H δ δ0, let ⟨t, tu, ht⟩ := H _ (edist_mem_uniformity δ0),
               ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 tu in
  ⟨ε, ε0, λ a b h, ht _ _ (hε h)⟩,
 λ H s su, let ⟨δ, δ0, hδ⟩ := mem_uniformity_edist.1 su, ⟨ε, ε0, hε⟩ := H _ δ0 in
  ⟨_, edist_mem_uniformity ε0, λ a b h, hδ (hε h)⟩⟩

/-- ε-δ characterization of Cauchy sequences on emetric spaces -/
protected lemma cauchy_iff {f : filter α} :
  cauchy f ↔ f ≠ ⊥ ∧ ∀ ε > 0, ∃ t ∈ f, ∀ x y ∈ t, edist x y < ε :=
cauchy_iff.trans $ and_congr iff.rfl
⟨λ H ε ε0, let ⟨t, tf, ts⟩ := H _ (edist_mem_uniformity ε0) in
   ⟨t, tf, λ x y xt yt, @ts (x, y) ⟨xt, yt⟩⟩,
 λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru,
               ⟨t, tf, h⟩ := H ε ε0 in
   ⟨t, tf, λ ⟨x, y⟩ ⟨hx, hy⟩, hε (h x y hx hy)⟩⟩

end emetric

open emetric

/-- An emetric space is separated -/
instance to_separated : separated α :=
separated_def.2 $ λ x y h, eq_of_forall_edist_le $
λ ε ε0, le_of_lt (h _ (edist_mem_uniformity ε0))

/-- Auxiliary function to replace the uniformity on an emetric space with
a uniformity which is equal to the original one, but maybe not defeq.
This is useful if one wants to construct an emetric space with a
specified uniformity. -/
def emetric_space.replace_uniformity {α} [U : uniform_space α] (m : emetric_space α)
  (H : @uniformity _ U = @uniformity _ (emetric_space.to_uniform_space α)) :
  emetric_space α :=
{ edist               := @edist _ m.to_has_edist,
  edist_self          := edist_self,
  eq_of_edist_eq_zero := @eq_of_edist_eq_zero _ _,
  edist_comm          := edist_comm,
  edist_triangle      := edist_triangle,
  to_uniform_space    := U,
  uniformity_edist    := H.trans (@emetric_space.uniformity_edist α _) }

/-- The extended metric induced by an injective function taking values in an emetric space. -/
def emetric_space.induced {α β} (f : α → β) (hf : function.injective f)
  (m : emetric_space β) : emetric_space α :=
{ edist               := λ x y, edist (f x) (f y),
  edist_self          := λ x, edist_self _,
  eq_of_edist_eq_zero := λ x y h, hf (edist_eq_zero.1 h),
  edist_comm          := λ x y, edist_comm _ _,
  edist_triangle      := λ x y z, edist_triangle _ _ _,
  to_uniform_space    := uniform_space.comap f m.to_uniform_space,
  uniformity_edist    := begin
    apply @uniformity_dist_of_mem_uniformity _ _ _ _ _ (λ x y, edist (f x) (f y)),
    refine λ s, mem_comap_sets.trans _,
    split; intro H,
    { rcases H with ⟨r, ru, rs⟩,
      rcases mem_uniformity_edist.1 ru with ⟨ε, ε0, hε⟩,
      refine ⟨ε, ε0, λ a b h, rs (hε _)⟩, exact h },
    { rcases H with ⟨ε, ε0, hε⟩,
      exact ⟨_, edist_mem_uniformity ε0, λ ⟨a, b⟩, hε⟩ }
  end }

/-- Emetric space instance on subsets of emetric spaces -/
instance {p : α → Prop} [t : emetric_space α] : emetric_space (subtype p) :=
t.induced subtype.val (λ x y, subtype.eq)

/-- The extended distance on a subset of an emetric space is the restriction of
the original distance, by definition -/
theorem subtype.edist_eq {p : α → Prop} [t : emetric_space α] (x y : subtype p) :
  edist x y = edist x.1 y.1 := rfl

/-- The product of two emetric spaces, with the max distance, is an extended
metric spaces. We make sure that the uniform structure thus constructed is the one
corresponding to the product of uniform spaces, to avoid diamond problems. -/
instance prod.emetric_space_max [emetric_space β] : emetric_space (α × β) :=
{ edist := λ x y, max (edist x.1 y.1) (edist x.2 y.2),
  edist_self := λ x, by simp,
  eq_of_edist_eq_zero := λ x y h, begin
    cases max_le_iff.1 (le_of_eq h) with h₁ h₂,
    have A : x.fst = y.fst := eq_of_edist_eq_zero (by simpa using h₁),
    have B : x.snd = y.snd := eq_of_edist_eq_zero (by simpa using h₂),
    exact prod.ext_iff.2 ⟨A, B⟩
  end,
  edist_comm := λ x y, by simp [edist_comm],
  edist_triangle := λ x y z, max_le
    (le_trans (edist_triangle _ _ _) (add_le_add' (le_max_left _ _) (le_max_left _ _)))
    (le_trans (edist_triangle _ _ _) (add_le_add' (le_max_right _ _) (le_max_right _ _))),
  uniformity_edist := begin
    refine uniformity_prod.trans _,
    simp [emetric_space.uniformity_edist, comap_infi],
    rw ← infi_inf_eq, congr, funext,
    rw ← infi_inf_eq, congr, funext,
    simp [inf_principal, ext_iff, max_lt_iff]
  end,
  to_uniform_space := prod.uniform_space }

section pi
open finset
variables {π : β → Type*} [fintype β]

/-- The product of a finite number of emetric spaces, with the max distance, is still
an emetric space.
This construction would also work for infinite products, but it would not give rise
to the product topology. Hence, we only formalize it in the good situation of finitely many
spaces. -/
instance emetric_space_pi [∀b, emetric_space (π b)] : emetric_space (Πb, π b) :=
{ edist := λ f g, finset.sup univ (λb, edist (f b) (g b)),
  edist_self := assume f, bot_unique $ finset.sup_le $ by simp,
  edist_comm := assume f g, by unfold edist; congr; funext a; exact edist_comm _ _,
  edist_triangle := assume f g h,
    begin
      simp only [finset.sup_le_iff],
      assume b hb,
      exact le_trans (edist_triangle _ (g b) _) (add_le_add' (le_sup hb) (le_sup hb))
    end,
  eq_of_edist_eq_zero := assume f g eq0,
    begin
      have eq1 : sup univ (λ (b : β), edist (f b) (g b)) ≤ 0 := le_of_eq eq0,
      simp only [finset.sup_le_iff] at eq1,
      exact (funext $ assume b, eq_of_edist_eq_zero $ bot_unique $ eq1 b $ mem_univ b),
    end }

end pi

namespace emetric
variables {x y z : α} {ε ε₁ ε₂ : ennreal} {s : set α}

/-- `emetric.ball x ε` is the set of all points `y` with `edist y x < ε` -/
def ball (x : α) (ε : ennreal) : set α := {y | edist y x < ε}

@[simp] theorem mem_ball : y ∈ ball x ε ↔ edist y x < ε := iff.rfl

theorem mem_ball' : y ∈ ball x ε ↔ edist x y < ε := by rw edist_comm; refl

/-- `emetric.closed_ball x ε` is the set of all points `y` with `edist y x ≤ ε` -/
def closed_ball (x : α) (ε : ennreal) := {y | edist y x ≤ ε}

@[simp] theorem mem_closed_ball : y ∈ closed_ball x ε ↔ edist y x ≤ ε := iff.rfl

theorem ball_subset_closed_ball : ball x ε ⊆ closed_ball x ε :=
assume y, by simp; intros h; apply le_of_lt h

theorem pos_of_mem_ball (hy : y ∈ ball x ε) : 0 < ε :=
lt_of_le_of_lt (zero_le _) hy

theorem mem_ball_self (h : 0 < ε) : x ∈ ball x ε :=
show edist x x < ε, by rw edist_self; assumption

theorem mem_closed_ball_self : x ∈ closed_ball x ε :=
show edist x x ≤ ε, by rw edist_self; exact bot_le

theorem mem_ball_comm : x ∈ ball y ε ↔ y ∈ ball x ε :=
by simp [edist_comm]

theorem ball_subset_ball (h : ε₁ ≤ ε₂) : ball x ε₁ ⊆ ball x ε₂ :=
λ y (yx : _ < ε₁), lt_of_lt_of_le yx h

theorem closed_ball_subset_closed_ball (h : ε₁ ≤ ε₂) :
  closed_ball x ε₁ ⊆ closed_ball x ε₂ :=
λ y (yx : _ ≤ ε₁), le_trans yx h

theorem ball_disjoint (h : ε₁ + ε₂ ≤ edist x y) : ball x ε₁ ∩ ball y ε₂ = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ z ⟨h₁, h₂⟩,
not_lt_of_le (edist_triangle_left x y z)
  (lt_of_lt_of_le (ennreal.add_lt_add h₁ h₂) h)

theorem ball_subset (h : edist x y + ε₁ ≤ ε₂) (h' : edist x y < ⊤): ball x ε₁ ⊆ ball y ε₂ :=
λ z zx, calc
  edist z y ≤ edist z x + edist x y : edist_triangle _ _ _
  ... = edist x y + edist z x : add_comm _ _
  ... < edist x y + ε₁ : (ennreal.add_lt_add_iff_left h').2 zx
  ... ≤ ε₂ : h

theorem exists_ball_subset_ball (h : y ∈ ball x ε) : ∃ ε' > 0, ball y ε' ⊆ ball x ε :=
begin
  have : 0 < ε - edist y x := by simpa using h,
  refine ⟨ε - edist y x, this, ball_subset _ _⟩,
  { rw ennreal.add_sub_cancel_of_le (le_of_lt h), apply le_refl _},
  { have : edist y x ≠ ⊤ := lattice.ne_top_of_lt h, apply lt_top_iff_ne_top.2 this }
end

theorem ball_eq_empty_iff : ball x ε = ∅ ↔ ε = 0 :=
eq_empty_iff_forall_not_mem.trans
⟨λh, le_bot_iff.1 (le_of_not_gt (λ ε0, h _ (mem_ball_self ε0))),
λε0 y h, not_lt_of_le (le_of_eq ε0) (pos_of_mem_ball h)⟩

theorem nhds_eq : nhds x = (⨅ε:{ε:ennreal // ε>0}, principal (ball x ε.val)) :=
begin
  rw [nhds_eq_uniformity, uniformity_edist'', lift'_infi],
  { apply congr_arg, funext ε,
    rw [lift'_principal],
    { simp [ball, edist_comm] },
    { exact monotone_preimage } },
  { exact ⟨⟨1, ennreal.zero_lt_one⟩⟩ },
  { intros, refl }
end

theorem mem_nhds_iff : s ∈ nhds x ↔ ∃ε>0, ball x ε ⊆ s :=
begin
  rw [nhds_eq, mem_infi],
  { simp },
  { intros y z, cases y with y hy, cases z with z hz,
    refine ⟨⟨min y z, lt_min hy hz⟩, _⟩,
    simp [ball_subset_ball, min_le_left, min_le_right, (≥)] },
  { exact ⟨⟨1, ennreal.zero_lt_one⟩⟩ }
end

theorem is_open_iff : is_open s ↔ ∀x∈s, ∃ε>0, ball x ε ⊆ s :=
by simp [is_open_iff_nhds, mem_nhds_iff]

theorem is_open_ball : is_open (ball x ε) :=
is_open_iff.2 $ λ y, exists_ball_subset_ball

theorem ball_mem_nhds (x : α) {ε : ennreal} (ε0 : 0 < ε) : ball x ε ∈ nhds x :=
mem_nhds_sets is_open_ball (mem_ball_self ε0)

/-- ε-characterization of the closure in emetric spaces -/
theorem mem_closure_iff' :
  x ∈ closure s ↔ ∀ε>0, ∃y ∈ s, edist x y < ε :=
⟨begin
  intros hx ε hε,
  have A : ball x ε ∩ s ≠ ∅ := mem_closure_iff.1 hx _ is_open_ball (mem_ball_self hε),
  cases ne_empty_iff_exists_mem.1 A with y hy,
  simp,
  exact ⟨y, ⟨hy.2, by have B := hy.1; simpa [mem_ball'] using B⟩⟩
end,
begin
  intros H,
  apply mem_closure_iff.2,
  intros o ho xo,
  rcases is_open_iff.1 ho x xo with ⟨ε, ⟨εpos, hε⟩⟩,
  rcases H ε εpos with ⟨y, ⟨ys, ydist⟩⟩,
  have B : y ∈ o ∩ s := ⟨hε (by simpa [edist_comm]), ys⟩,
  apply ne_empty_of_mem B
end⟩

theorem tendsto_nhds {f : filter β} {u : β → α} {a : α} :
  tendsto u f (nhds a) ↔ ∀ ε > 0, ∃ n ∈ f, ∀x ∈ n, edist (u x) a < ε :=
⟨λ H ε ε0, ⟨u⁻¹' (ball a ε), H (ball_mem_nhds _ ε0), by simp⟩,
 λ H s hs,
  let ⟨ε, ε0, hε⟩ := mem_nhds_iff.1 hs, ⟨δ, δ0, hδ⟩ := H _ ε0 in
  f.sets_of_superset δ0 (λx xδ, hε (hδ x xδ))⟩

theorem tendsto_at_top [inhabited β] [semilattice_sup β] (u : β → α) {a : α} :
  tendsto u at_top (nhds a) ↔ ∀ε>0, ∃N, ∀n≥N, edist (u n) a < ε :=
begin
  rw tendsto_nhds,
  apply forall_congr,
  intro ε,
  apply forall_congr,
  intro hε,
  simp,
  exact ⟨λ ⟨s, ⟨N, hN⟩, hs⟩, ⟨N, λn hn, hs _ (hN _ hn)⟩, λ ⟨N, hN⟩, ⟨{n | n ≥ N}, ⟨⟨N, by simp⟩, hN⟩⟩⟩,
end

/-- In an emetric space, Cauchy sequences are characterized by the fact that, eventually,
the edistance between its elements is arbitrarily small -/

/-- A variation around the emetric characterization of Cauchy sequences -/
theorem cauchy_seq_iff' [inhabited β] [semilattice_sup β] {u : β → α} :
  cauchy_seq u ↔ ∀ε>(0 : ennreal), ∃N, ∀n≥N, edist (u n) (u N) < ε :=
begin
  rw cauchy_seq_iff,
  split,
  { intros H ε εpos,
    rcases H ε εpos with ⟨N, hN⟩,
    exact ⟨N, λn hn, hN _ _ (le_refl N) hn⟩ },
  { intros H ε εpos,
    rcases H (ε/2) (ennreal.half_pos εpos) with ⟨N, hN⟩,
    exact ⟨N, λ m n hm hn, calc
       edist (u n) (u m) ≤ edist (u n) (u N) + edist (u m) (u N) : edist_triangle_right _ _ _
                    ... < ε/2 + ε/2 : ennreal.add_lt_add (hN _ hn) (hN _ hm)
                    ... = ε : ennreal.add_halves _⟩ }
end

theorem totally_bounded_iff {s : set α} :
  totally_bounded s ↔ ∀ ε > 0, ∃t : set α, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
⟨λ H ε ε0, H _ (edist_mem_uniformity ε0),
 λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru,
               ⟨t, ft, h⟩ := H ε ε0 in
  ⟨t, ft, subset.trans h $ Union_subset_Union $ λ y, Union_subset_Union $ λ yt z, hε⟩⟩

theorem totally_bounded_iff' {s : set α} :
  totally_bounded s ↔ ∀ ε > 0, ∃t⊆s, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
⟨λ H ε ε0, (totally_bounded_iff_subset.1 H) _ (edist_mem_uniformity ε0),
 λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru,
               ⟨t, _, ft, h⟩ := H ε ε0 in
  ⟨t, ft, subset.trans h $ Union_subset_Union $ λ y, Union_subset_Union $ λ yt z, hε⟩⟩

section compact

/-- A compact set in an emetric space is separable, i.e., it is the closure of a countable set -/
lemma countable_closure_of_compact {α : Type u} [emetric_space α] {s : set α} (hs : compact s) :
  ∃ t ⊆ s, (countable t ∧ s = closure t) :=
begin
  have A : ∀ (e:ennreal), e > 0 → ∃ t ⊆ s, (finite t ∧ s ⊆ (⋃x∈t, ball x e)) :=
    totally_bounded_iff'.1 (compact_iff_totally_bounded_complete.1 hs).1,
--    assume e, finite_cover_balls_of_compact hs,
  have B : ∀ (e:ennreal), ∃ t ⊆ s, finite t ∧ (e > 0 → s ⊆ (⋃x∈t, ball x e)),
  { intro e,
    cases le_or_gt e 0 with h,
    { exact ⟨∅, by finish⟩ },
    { rcases A e h with ⟨s, ⟨finite_s, closure_s⟩⟩, existsi s, finish }},
  /-The desired countable set is obtained by taking for each `n` the centers of a finite cover
  by balls of radius `1/n`, and then the union over `n`. -/
  choose T T_in_s finite_T using B,
  let t := ⋃n:ℕ, T n⁻¹,
  have T₁ : t ⊆ s := begin apply Union_subset, assume n, apply T_in_s end,
  have T₂ : countable t := by finish [countable_Union, countable_finite],
  have T₃ : s ⊆ closure t,
  { intros x x_in_s,
    apply mem_closure_iff'.2,
    intros ε εpos,
    rcases ennreal.exists_inv_nat_lt (bot_lt_iff_ne_bot.1 εpos) with ⟨n, hn⟩,
    have inv_n_pos : (0 : ennreal) < (n : ℕ)⁻¹ := by simp [ennreal.bot_lt_iff_ne_bot],
    have C : x ∈ (⋃y∈ T (n : ℕ)⁻¹, ball y (n : ℕ)⁻¹) :=
      mem_of_mem_of_subset x_in_s ((finite_T (n : ℕ)⁻¹).2 inv_n_pos),
    rcases mem_Union.1 C with ⟨y, _, ⟨y_in_T, rfl⟩, Dxy⟩,
    simp at Dxy,  -- Dxy : edist x y < 1 / ↑n
    have : y ∈ t := mem_of_mem_of_subset y_in_T (by apply subset_Union (λ (n:ℕ), T (n : ℕ)⁻¹)),
    have : edist x y < ε := lt_trans Dxy hn,
    exact ⟨y, ‹y ∈ t›, ‹edist x y < ε›⟩ },
  have T₄ : closure t ⊆ s := calc
    closure t ⊆ closure s : closure_mono T₁
    ... = s : closure_eq_of_is_closed (closed_of_compact _ hs),
  exact ⟨t, ⟨T₁, T₂, subset.antisymm T₃ T₄⟩⟩
end

end compact

section first_countable

instance (α : Type u) [emetric_space α] :
  topological_space.first_countable_topology α :=
⟨assume a, ⟨⋃ i:ℕ, {ball a i⁻¹},
  countable_Union $ assume n, countable_singleton _,
  suffices (⨅ i:{ i : ennreal // i > 0}, principal (ball a i)) = ⨅ (n : ℕ), principal (ball a n⁻¹),
    by simpa [nhds_eq, @infi_comm _ _ ℕ],
  begin
    apply le_antisymm,
    { refine le_infi (assume n, infi_le_of_le _ _),
      exact ⟨n⁻¹, by apply bot_lt_iff_ne_bot.2; simp⟩,
      exact le_refl _ },
    refine le_infi (assume ε, _),
    rcases ennreal.exists_inv_nat_lt (bot_lt_iff_ne_bot.1 ε.2) with ⟨n, εn⟩,
    exact infi_le_of_le n (principal_mono.2 $ ball_subset_ball $ le_of_lt εn)
  end⟩⟩

end first_countable

section second_countable
open topological_space

/-- A separable emetric space is second countable: one obtains a countable basis by taking
the balls centered at points in a dense subset, and with rational radii. We do not register
this as an instance, as there is already an instance going in the other direction
from second countable spaces to separable spaces, and we want to avoid loops. -/
lemma second_countable_of_separable (α : Type u) [emetric_space α] [separable_space α] :
  second_countable_topology α :=
let ⟨S, ⟨S_countable, S_dense⟩⟩ := separable_space.exists_countable_closure_eq_univ α in
⟨⟨⋃x ∈ S, ⋃ (n : nat), {ball x (n⁻¹)},
⟨show countable ⋃x ∈ S, ⋃ (n : nat), {ball x (n⁻¹)},
{ apply countable_bUnion S_countable,
  intros a aS,
  apply countable_Union,
  simp },
show uniform_space.to_topological_space α = generate_from (⋃x ∈ S, ⋃ (n : nat), {ball x (n⁻¹)}),
{ have A : ∀ (u : set α), (u ∈ ⋃x ∈ S, ⋃ (n : nat), ({ball x ((n : ennreal)⁻¹)} : set (set α))) → is_open u,
  { simp only [and_imp, exists_prop, set.mem_Union, set.mem_singleton_iff, exists_imp_distrib],
    intros u x hx i u_ball,
    rw [u_ball],
    exact is_open_ball },
  have B : is_topological_basis (⋃x ∈ S, ⋃ (n : nat), ({ball x (n⁻¹)} : set (set α))),
  { refine is_topological_basis_of_open_of_nhds A (λa u au open_u, _),
    rcases is_open_iff.1 open_u a au with ⟨ε, εpos, εball⟩,
    have : ε / 2 > 0 := ennreal.half_pos εpos,
    /- The ball `ball a ε` is included in `u`. We need to find one of our balls `ball x (n⁻¹)`
    containing `a` and contained in `ball a ε`. For this, we take `n` larger than `2/ε`, and
    then `x` in `S` at distance at most `n⁻¹` of `a` -/
    rcases ennreal.exists_inv_nat_lt (bot_lt_iff_ne_bot.1 (ennreal.half_pos εpos)) with ⟨n, εn⟩,
    have : (0 : ennreal) < n⁻¹ := by simp [ennreal.bot_lt_iff_ne_bot],
    have : (a : α) ∈ closure (S : set α) := by rw [S_dense]; simp,
    rcases mem_closure_iff'.1 this _ ‹(0 : ennreal) <  n⁻¹› with ⟨x, xS, xdist⟩,
    existsi ball x (↑n)⁻¹,
    have I : ball x (n⁻¹) ⊆ ball a ε := λy ydist, calc
      edist y a = edist a y : edist_comm _ _
      ... ≤ edist a x + edist y x : edist_triangle_right _ _ _
      ... < n⁻¹ + n⁻¹ : ennreal.add_lt_add xdist ydist
      ... < ε/2 + ε/2 : ennreal.add_lt_add εn εn
      ... = ε : ennreal.add_halves _,
    simp only [emetric.mem_ball, exists_prop, set.mem_Union, set.mem_singleton_iff],
    exact ⟨⟨x, ⟨xS, ⟨n, rfl⟩⟩⟩, ⟨by simpa, subset.trans I εball⟩⟩ },
  exact B.2.2 }⟩⟩⟩

end second_countable

section diam

/-- The diameter of a set in an emetric space, named `emetric.diam` -/
def diam (s : set α) := Sup ((λp : α × α, edist p.1 p.2) '' (set.prod s s))

/-- If two points belong to some set, their edistance is bounded by the diameter of the set -/
lemma edist_le_diam_of_mem (hx : x ∈ s) (hy : y ∈ s) : edist x y ≤ diam s :=
le_Sup ((mem_image _ _ _).2 ⟨(⟨x, y⟩ : α × α), by simp [hx, hy]⟩)

/-- If the distance between any two points in a set is bounded by some constant, this constant
bounds the diameter. -/
lemma diam_le_of_forall_edist_le {d : ennreal} (h : ∀x y ∈ s, edist x y ≤ d) : diam s ≤ d :=
begin
  apply Sup_le _,
  simp only [and_imp, set.mem_image, set.mem_prod, exists_imp_distrib, prod.exists],
  assume b x y xs ys dxy,
  rw ← dxy,
  exact h x y xs ys
end

/-- The diameter of the empty set vanishes -/
@[simp] lemma diam_empty : diam (∅ : set α) = 0 :=
by simp [diam]

/-- The diameter of a singleton vanishes -/
@[simp] lemma diam_singleton : diam ({x} : set α) = 0 :=
by simp [diam]

/-- The diameter is monotonous with respect to inclusion -/
lemma diam_mono {s t : set α} (h : s ⊆ t) : diam s ≤ diam t :=
begin
  refine Sup_le_Sup (λp hp, _),
  simp only [set.mem_image, set.mem_prod, prod.exists] at hp,
  rcases hp with ⟨x, y, ⟨⟨xs, ys⟩, dxy⟩⟩,
  exact (mem_image _ _ _).2 ⟨⟨x, y⟩, ⟨⟨h xs, h ys⟩, dxy⟩⟩
end

/-- The diameter of a union is controlled by the diameter of the sets, and the edistance
between two points in the sets. -/
lemma diam_union {t : set α} (xs : x ∈ s) (yt : y ∈ t) : diam (s ∪ t) ≤ diam s + edist x y + diam t :=
begin
  have A : ∀a ∈ s, ∀b ∈ t, edist a b ≤ diam s + edist x y + diam t := λa ha b hb, calc
    edist a b ≤ edist a x + edist x y + edist y b : edist_triangle4 _ _ _ _
    ... ≤ diam s + edist x y + diam t :
      add_le_add' (add_le_add' (edist_le_diam_of_mem ha xs) (le_refl _)) (edist_le_diam_of_mem yt hb),
  refine diam_le_of_forall_edist_le (λa b ha hb, _),
  cases (mem_union _ _ _).1 ha with h'a h'a; cases (mem_union _ _ _).1 hb with h'b h'b,
  { calc edist a b ≤ diam s : edist_le_diam_of_mem h'a h'b
        ... ≤ diam s + (edist x y + diam t) : le_add_right (le_refl _)
        ... = diam s + edist x y + diam t : by simp only [add_comm, eq_self_iff_true, add_left_comm] },
  { exact A a h'a b h'b },
  { have Z := A b h'b a h'a, rwa [edist_comm] at Z },
  { calc edist a b ≤ diam t : edist_le_diam_of_mem h'a h'b
        ... ≤ (diam s + edist x y) + diam t : le_add_left (le_refl _) }
end

lemma diam_union' {t : set α} (h : s ∩ t ≠ ∅) : diam (s ∪ t) ≤ diam s + diam t :=
let ⟨x, ⟨xs, xt⟩⟩ := ne_empty_iff_exists_mem.1 h in by simpa using diam_union xs xt

lemma diam_closed_ball {r : ennreal} : diam (closed_ball x r) ≤ 2 * r :=
diam_le_of_forall_edist_le $ λa b ha hb, calc
  edist a b ≤ edist a x + edist b x : edist_triangle_right _ _ _
  ... ≤ r + r : add_le_add' ha hb
  ... = 2 * r : by simp [mul_two, mul_comm]

lemma diam_ball {r : ennreal} : diam (ball x r) ≤ 2 * r :=
le_trans (diam_mono ball_subset_closed_ball) diam_closed_ball

end diam

end emetric --namespace