import convex relint

open_locale pointwise

variables {V: Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

lemma inner_eq_of_mem_normal_face {A : set V} {u x y : V}
(hx : x ∈ normal_face A u) (hy : y ∈ normal_face A u) :
⟪x, u⟫_ℝ = ⟪y, u⟫_ℝ :=
begin
  rw [mem_normal_face] at hx hy,
  apply le_antisymm,
  all_goals {tauto},
end

lemma summands_eq_of_summands_le_of_sum_ge
{a a' b b' : ℝ} : a ≤ a' → b ≤ b' → a + b ≥ a' + b' → a = a' ∧ b = b' :=
begin
  intros ha hb hab,
  split,
  {
    apply le_antisymm ha,
    rw [ge_iff_le, ←le_sub_iff_add_le] at hab,
    refine le_trans hab _,
    simp only [tsub_le_iff_right, add_le_add_iff_left],
    exact hb,
  },
  {
    apply le_antisymm hb,
    rw [ge_iff_le, ←le_sub_iff_add_le'] at hab,
    refine le_trans hab _,
    rw [add_sub_right_comm],
    simp only [add_le_iff_nonpos_left, sub_nonpos],
    exact ha,
  },
end

lemma eq_of_le_of_combo_ge
{ca a a' cb b b' : ℝ} :
ca > 0 → cb > 0 → a ≤ a' → b ≤ b' → ca • a + cb • b ≥ ca • a' + cb • b' → a = a' ∧ b = b' :=
begin
  intros hca hcb ha hb hab,
  suffices hs : ca • a = ca • a' ∧ cb • b = cb • b',
  {
    exact ⟨
      eq_of_smul_eq_smul_of_pos_of_le hs.1 hca ha,
      eq_of_smul_eq_smul_of_pos_of_le hs.2 hcb hb⟩,
  },
  apply summands_eq_of_summands_le_of_sum_ge,
  {
    exact smul_le_smul_of_nonneg ha (le_of_lt hca),
  },
  {
    exact smul_le_smul_of_nonneg hb (le_of_lt hcb),
  },
  {
    exact hab,
  },
end

lemma eq_of_le_of_combo_ge'
{ca a cb b c : ℝ} :
ca > 0 → cb > 0 → ca + cb = 1 → a ≤ c → b ≤ c → ca • a + cb • b ≥ c → a = c ∧ b = c :=
begin
  intros hca hcb hcab ha hb hab,
  have := eq_of_le_of_combo_ge hca hcb ha hb,
  simp only [←add_smul, hcab, one_smul] at this,
  exact this hab,
end

lemma ge_of_le_of_combo_ge'
{ca a cb b c : ℝ} :
ca > 0 → cb > 0 → ca + cb = 1 → a ≤ c → b ≤ c → ca • a + cb • b ≥ c → a ≥ c ∧ b ≥ c :=
begin
  intros hca hcb hcab ha hb hab,
  have := eq_of_le_of_combo_ge' hca hcb hcab ha hb hab,
  rw [this.1, this.2],
  exact ⟨le_refl c, le_refl c⟩,
end

lemma normal_face_convex {A : set V} (h : convex ℝ A) :
∀ u : V, convex ℝ (normal_face A u) :=
begin
  intros u x y hx hy a b ann bnn hab,
  refine ⟨h (normal_face_subset hx) (normal_face_subset hy)
    ann bnn hab, _⟩,
  intros z zA,
  simp only [inner_add_left, inner_smul_left,
    is_R_or_C.conj_to_real],
  rw [mem_normal_face] at hx hy,
  refine le_trans _ (add_le_add
    (mul_le_mul_of_nonneg_left (hx.2 z zA) ann)
    (mul_le_mul_of_nonneg_left (hy.2 z zA) bnn)),
  rw [←add_mul, hab, one_mul],
end

lemma normal_face_is_face {A : set V} (h : convex ℝ A) :
∀ u : V, is_face A (normal_face A u) :=
begin
  intro u,
  simp only [is_face],
  refine ⟨normal_face_subset, normal_face_convex h u, _⟩,
  {
    intros x hx y hy hh,
    rcases hh with ⟨z, hz₁, hz₂⟩,
    rcases hz₁ with ⟨a, b, apos, bpos, hab, rfl⟩,
    suffices hs : x ∈ normal_face A u ∧ y ∈ normal_face A u,
    {
      rw [←convex_hull_pair],
      rw [convex.convex_hull_subset_iff (normal_face_convex h u)],
      simp only [set.insert_subset, set.singleton_subset_iff],
      exact hs,
    },
    {
      simp only [mem_normal_face] at hz₂ ⊢,
      rw [and_and_and_comm],
      refine ⟨⟨hx, hy⟩, _⟩,
      simp only [←forall_and_distrib, ←imp_and_distrib],
      intros z zA,
      suffices hs : ⟪x, u⟫_ℝ = ⟪a • x + b • y, u⟫_ℝ ∧ ⟪y, u⟫_ℝ = ⟪a • x + b • y, u⟫_ℝ,
      {
        rw [hs.1, hs.2, and_self],
        exact hz₂.2 z zA,
      },
      apply eq_of_le_of_combo_ge' apos bpos hab,
      {
        exact hz₂.2 x hx,
      },
      {
        exact hz₂.2 y hy,
      },
      {
        simp only [inner_add_left, inner_smul_left, is_R_or_C.conj_to_real] at hz₂,
        exact hz₂.2 _ hz₂.1,
      },
    },
  },
end

lemma set_own_face {A : set V} (Acv : convex ℝ A) : is_face A A :=
begin
  simp only [is_face],
  refine ⟨_, _, _⟩,
  {tauto},
  {assumption},
  {
    rintro x hx y hy ⟨z, ⟨hzs, hz⟩⟩ p hp,
    refine convex.segment_subset Acv hx hy hp,
  }
end

lemma mem_normal_face_iff_subset_halfspace (A : set V) (u : V) {x : V}
(xA : x ∈ A) :
x ∈ normal_face A u ↔ A ⊆ { w : V | ⟪w, u⟫_ℝ ≤ ⟪x, u⟫_ℝ } :=
begin
  rw [mem_normal_face],
  tauto,
end

lemma mem_normal_face_iff_subset_halfspace' (A : set V) (u : V) {x : V} :
x ∈ normal_face A u ↔ x ∈ A ∧ A ⊆ { w : V | ⟪w, u⟫_ℝ ≤ ⟪x, u⟫_ℝ } :=
begin
  rw [mem_normal_face],
  tauto,
end

lemma convex_halfspace_le' (u : V) (r : ℝ) :
convex ℝ { w : V | ⟪w, u⟫_ℝ ≤ r} :=
begin
  conv {
    congr,
    congr,
    funext,
    rw [real_inner_comm],
    simp only [←inner_product_space.to_dual_apply],
  },
  apply convex_halfspace_le,
  apply linear_map.is_linear,
end

lemma convex_hyperplane' (u : V) (r : ℝ) :
convex ℝ { w : V | ⟪w, u⟫_ℝ = r} :=
begin
  conv {
    congr,
    congr,
    funext,
    rw [real_inner_comm],
    simp only [←inner_product_space.to_dual_apply],
  },
  apply convex_hyperplane,
  apply linear_map.is_linear,
end

lemma normal_face_subset_normal_face_hull {A : set V} {u : V} :
normal_face A u ⊆ normal_face (convex_hull ℝ A) u :=
begin
  intros w,
  rw [mem_normal_face_iff_subset_halfspace',
  mem_normal_face_iff_subset_halfspace'],
  intro h,
  refine ⟨subset_convex_hull _ _ h.1, _⟩,
  rw [convex.convex_hull_subset_iff (convex_halfspace_le' u _)],
  exact h.2,
end

lemma normal_face_subset_hyperplane_of_mem {A : set V} {u : V} {x : V}
(hx : x ∈ normal_face A u) :
normal_face A u ⊆ { w : V | ⟪w, u⟫_ℝ = ⟪x, u⟫_ℝ } :=
begin
  intros y hy,
  exact inner_eq_of_mem_normal_face hy hx,
end

lemma inner_eq_of_mem_hull_normal_face {A : set V} {u : V} {x y : V}
(hx : x ∈ convex_hull ℝ (normal_face A u)) (hy : y ∈ convex_hull ℝ (normal_face A u)) :
⟪x, u⟫_ℝ = ⟪y, u⟫_ℝ :=
begin
  have : (convex_hull ℝ (normal_face A u)).nonempty := ⟨x, hx⟩,
  rw [convex_hull_nonempty_iff] at this,
  rcases this with ⟨z, hz⟩,
  have : convex_hull ℝ (normal_face A u) ⊆ { w : V | ⟪w, u⟫_ℝ = ⟪z, u⟫_ℝ },
  {
    rw [convex.convex_hull_subset_iff (convex_hyperplane' u _)],
    exact normal_face_subset_hyperplane_of_mem hz,
  },
  rw [mem_normal_face_iff_subset_halfspace'] at hz,
  replace hx := this hx,
  replace hy := this hy,
  simp only [set.mem_set_of] at hx hy,
  rw [hx, hy],
end

lemma mem_normal_face_iff_mem_hull_normal_face {A : set V} {u : V} {x : V}
(xA : x ∈ A) :
x ∈ normal_face A u ↔ x ∈ convex_hull ℝ (normal_face A u) :=
begin
  split,
  {
    intro h,
    exact subset_convex_hull _ _ h,
  },
  {
    rw [mem_normal_face_iff_subset_halfspace _ _ xA],
    intro hx,
    have : (convex_hull ℝ (normal_face A u)).nonempty := ⟨x, hx⟩,
    rw [convex_hull_nonempty_iff] at this,
    rcases this with ⟨z, hz⟩,
    have := inner_eq_of_mem_hull_normal_face hx (subset_convex_hull _ _ hz),
    intros a ha,
    rw [set.mem_set_of, this],
    rw [mem_normal_face] at hz,
    exact hz.2 _ ha,
  },
end

lemma normal_face_spanned_by_verts {S : set V} (u : V) :
normal_face (convex_hull ℝ S) u = convex_hull ℝ (normal_face S u) :=
begin
  let 𝓜 := { x ∈ convex_hull ℝ S | x ∈ normal_face (convex_hull ℝ S) u ↔ x ∈ convex_hull ℝ (normal_face S u) },
  suffices hs : 𝓜 = convex_hull ℝ S,
  {
    ext, split,
    {
      intro h,
      have : x ∈ convex_hull ℝ S := normal_face_subset h,
      rw [←hs, set.mem_sep_iff] at this,
      exact this.2.mp h,
    },
    {
      intro h,
      have : x ∈ convex_hull ℝ S := convex_hull_mono normal_face_subset h,
      rw [←hs, set.mem_sep_iff] at this,
      exact this.2.mpr h,
    },
  },
  apply subset_antisymm,
  {
    rintro x ⟨hx₁, hx₂⟩,
    exact hx₁,
  },
  {
    rw [convex.convex_hull_subset_iff],
    {
      intros x hx,
      refine ⟨subset_convex_hull _ _ hx, _⟩,
      simp only,
      rw [mem_normal_face_iff_subset_halfspace _ _ (subset_convex_hull _ _ hx)],
      rw [convex.convex_hull_subset_iff (convex_halfspace_le' u _)],
      rw [←mem_normal_face_iff_subset_halfspace _ _ hx],
      rw [←mem_normal_face_iff_mem_hull_normal_face hx],
    },
    {
      rw [convex_iff_open_segment_subset],
      intros x y hx hy z hz,
      simp only [set.mem_sep_eq] at hx hy,
      refine ⟨_, _⟩,
      {
        have := convex_convex_hull ℝ S,
        rw [convex_iff_open_segment_subset] at this,
        exact this hx.1 hy.1 hz,
      },
      {
        simp only, split,
        {
          intro hh,
          have := normal_face_is_face (convex_convex_hull ℝ S) u,
          rcases this with ⟨-, -, this⟩,
          replace := this x hx.1 y hy.1 ⟨z, hz, hh⟩,
          have xmem := this (left_mem_segment ℝ _ _),
          have ymem := this (right_mem_segment ℝ _ _),
          rw [hx.2] at xmem,
          rw [hy.2] at ymem,
          exact convex_iff_open_segment_subset.mp (convex_convex_hull _ _) xmem ymem hz,
        },
        {
          rw [mem_normal_face_iff_mem_hull_normal_face],
          {
            suffices hs : normal_face S u ⊆ normal_face (convex_hull ℝ S) u,
            {
              apply convex_hull_mono hs,
            },
            {
              exact normal_face_subset_normal_face_hull,
            },
          },
          {
            have : convex ℝ (convex_hull ℝ S) := convex_convex_hull ℝ S,
            rw [convex_iff_open_segment_subset] at this,
            exact this hx.1 hy.1 hz,
          },
        },
      },
    },
  },
end

--lemma face_body {A : set V} (u : V) (h : is_convex_body A) : is_convex_body (face A u) := sorry
--lemma face_polytope {A F : set V} (h : is_polytope A) (hf : is_face A F) : is_polytope F := sorry

lemma face_closed {A F : set V} (h : is_closed A) (hf : is_face A F) :
is_closed F :=
begin
  simp only [is_face] at hf,
  rw [closed_iff_segments_closable (face_convex hf)],
  intros x y hs,
  rcases open_segment_nonempty x y with ⟨z, hz⟩,
  replace h := segments_closable_of_closed h,
  have : segment ℝ x y ⊆ A,
  {
    refine h _ _ _,
    refine subset_trans hs _,
    exact hf.1,
  },
  have := hf.2.2 x (this (left_mem_segment ℝ _ _)) y (this (right_mem_segment ℝ _ _)),
  refine this ⟨z, hz, hs hz⟩,
end

-- lemma relopen_iff_open {A : set V} (hA : vector_span ℝ A = ⊤) :
-- is_relopen A ↔ is_open A := sorry

/- theorem cl_relint {A : set V} (h : convex ℝ A) :
is_closed A → closure (relint A) = A := sorry

theorem relint_cl {A : set V} (h : convex ℝ A) :
is_relopen A → relint (closure A) = A := sorry

theorem relint_affine_span {A : set V} (h : convex ℝ A) :
affine_span ℝ (relint A) = affine_span ℝ A := sorry

lemma relopen_of_inter_relopen {A B : set V} :
is_relopen A → is_relopen B → is_relopen (A ∩ B) := sorry

lemma relint_eq_relint_inter_relint {A B : set V}
(Acv : convex ℝ A) (BCv: convex ℝ B):
(relint A ∩ relint B).nonempty →
relint (A ∩ B) = relint A ∩ relint B := sorry -/

/- lemma relopen_subspace (E : submodule ℝ V) :
is_relopen (E : set V) := sorry

lemma relint_coe_invariant {E : submodule ℝ V}
(A : set E) : E.subtype '' (relint A) = relint (E.subtype '' A) := sorry
 -/

lemma face_inter {A F G : set V} (h : convex ℝ A)
(hF : is_face A F) (hG : is_face A G) :
is_face A (F ∩ G) :=
begin
  simp only [is_face],
  refine ⟨_, _, _⟩,
  {
    rintro x ⟨xF, -⟩,
    exact (face_subset hF) xF,
  },
  {
    exact convex.inter (face_convex hF) (face_convex hG),
  },
  {
    have aF := face_absorbs_segments hF,
    have aG := face_absorbs_segments hG,
    rintro x hx y hy ⟨z, ⟨hzs, hz⟩⟩ p hp,
    exact ⟨
      aF x hx y hy ⟨z, ⟨hzs, hz.1⟩⟩ hp, -- why omit p?
      aG x hx y hy ⟨z, ⟨hzs, hz.2⟩⟩ hp,
    ⟩,
  },
end

lemma face_sInter {A : set V} {M : set (set V)}
(Acv : convex ℝ A) (h : ∀ F ∈ M, is_face A F)
(ne : M.nonempty) :
is_face A (set.sInter M) :=
begin
  rcases ne with ⟨F, hF⟩,
  simp only [is_face],
  refine ⟨_, _, _⟩,
  {
    rintro x hx,
    exact (face_subset (h F hF)) (hx F hF),
  },
  {
    exact convex_sInter (λ G hG, face_convex (h G hG)),
  },
  {
    rintro x hx y hy ⟨z, ⟨hzs, hz⟩⟩ p hp,
    rintro G hG,
    exact face_absorbs_segments (h G hG) x hx y hy ⟨z, ⟨hzs, hz G hG⟩⟩ hp,
  },
end

def faces (A : set V) := { F : set V | is_face A F }

def faces_containing {A B : set V} (h : B ⊆ A) :=
{ F : set V | is_face A F ∧ B ⊆ F }

lemma face_subset' {A : set V} (F : faces A) :
↑F ⊆ A :=
begin
  apply face_subset,
  exact F.property,
end

def smallest_face_containing {A B : set V}
(Acv : convex ℝ A) (BA : B ⊆ A) : faces A :=
⟨
  set.sInter (faces_containing BA),
  face_sInter Acv (λ G hG, hG.1) ⟨A, ⟨set_own_face Acv, BA⟩⟩
⟩

lemma smallest_face_containing_contains {A B : set V}
(Acv : convex ℝ A) (BA : B ⊆ A) :
B ⊆ smallest_face_containing Acv BA :=
begin
  simp only [smallest_face_containing, faces_containing, subtype.coe_mk, set.subset_sInter_iff, set.mem_set_of_eq, and_imp,
  imp_self, implies_true_iff],
end

lemma smallest_face_containing_subset {A B F : set V}
(Acv : convex ℝ A) (hAF : is_face A F) (hBF : B ⊆ F) :
(smallest_face_containing Acv (subset_trans hBF hAF.1)).val ⊆ F :=
begin
  simp only [smallest_face_containing, faces_containing],
  apply set.sInter_subset_of_mem,
  exact ⟨hAF, hBF⟩,
end

def smallest_face_containing_point {A : set V}
(Acv : convex ℝ A) {x : V} (xA : x ∈ A) : faces A :=
smallest_face_containing Acv (set.singleton_subset_iff.mpr xA)

lemma smallest_face_containing_point_contains {A : set V} {x : V}
(Acv : convex ℝ A) (xA : x ∈ A) :
x ∈ (smallest_face_containing_point Acv xA).val :=
begin
  simp only [smallest_face_containing_point],
  apply smallest_face_containing_contains Acv,
  exact set.mem_singleton _,
end

lemma smallest_face_containing_point_subset {A F : set V} {x : V}
(Acv : convex ℝ A) (hAF : is_face A F) (xF : x ∈ F) :
(smallest_face_containing_point Acv (hAF.1 xF)).val ⊆ F :=
begin
  simp only [smallest_face_containing_point],
  refine smallest_face_containing_subset Acv hAF _,
  simpa only [set.singleton_subset_iff] using xF,
end

/- lemma point_in_proper_face_of_relbd {A : set V}
(Acv : convex ℝ A) {x : V} (hx : x ∈ relbd A ∩ A) :
(smallest_face_containing_point Acv hx.2 : set V) ⊂ A :=
begin
  admit,
end -/

lemma is_closed_halfspace (u : V) (c : ℝ) :
is_closed { v : V | ⟪v, u⟫_ℝ ≤ c } :=
begin
  have := inner_left_continuous u,
  rw [continuous_iff_is_closed] at this,
  exact this _ is_closed_Iic,
end

/- lemma exists_supporting_halfspace' {A : set V}
(Acv : convex ℝ A) (Atop : vector_span ℝ A = ⊤) {x : V}
(h : x ∈ frontier A ∩ A) :
∃ u : V, u ≠ 0 ∧ A ⊆ { v : V | ⟪v, u⟫_ℝ ≤ ⟪x, u⟫_ℝ } :=
begin
  have xniA : x ∉ interior A := h.1.2,
  obtain ⟨f, hf⟩ := geometric_hahn_banach_open_point
    (interior_convex Acv) is_open_interior xniA,
  simp only [←inner_product_space.to_dual_symm_apply'] at hf,
  refine ⟨(inner_product_space.to_dual ℝ V).symm f, _, _⟩,
  {
    obtain ⟨y, hy⟩ : (interior A).nonempty,
    {
      rw [←relint_eq_int Atop],
      exact relint_nonempty Acv ⟨x, h.2⟩,
    },
    intro hc,
    simp only [hc, inner_zero_right] at hf,
    have := hf y hy,
    linarith,
  },
  {
    refine subset_trans subset_closure _,
    rw [←cl_relint_eq_cl Acv, relint_eq_int Atop,
      ←closure_eq_iff_is_closed.mpr (is_closed_halfspace _ _)],
    apply closure_mono,
    intros a ha,
    exact le_of_lt (hf a ha),
    apply_instance,
  },
end -/

/- lemma exists_supporting_halfspace'' {A : set V}
(Acv : convex ℝ A) (Aro : is_relopen A) {x : V}
(xA : x ∈ relbd A) :
∃ u : V, (∀ y : V, y ∈ A → ⟪x, u⟫_ℝ ≥ ⟪y, u⟫_ℝ) ∧ normal_face A u ⊂ A
:=
begin
  rw [relopen_iff_exists_open_inter_aspan] at Aro,
  obtain ⟨U, hU₁, hU₂⟩ := Aro,
  admit,
end -/

lemma exists_supporting_halfspace {A : set V}
(Acv : convex ℝ A) {x : V}
(h : x ∈ relbd A ∩ A) :
∃ u : V, x ∈ normal_face A u ∧ normal_face A u ⊂ A
:= sorry
/- begin
  let E := vector_span ℝ A,
  let A' : set E := coe ⁻¹' (A - {x}),
  have A'cv : convex ℝ A',
  {
    intros y z hy hz a b hnn bnn hab,
    simp only [set.sub_singleton, set.mem_preimage, set.mem_image] at hy hz ⊢,
    rcases hz with ⟨z, zA, hz⟩,
    rcases hy with ⟨y, yA, hy⟩,
    refine ⟨a • y + b • z, _, _⟩,
    {
      apply Acv,
      all_goals {assumption},
    },
    {
      simp only [←hy, ←hz, submodule.coe_add,
      submodule.coe_smul_of_tower, smul_sub,
      sub_add_sub_comm, ←add_smul, hab, one_smul],
    },
  },
  have A'top : vector_span ℝ A' = ⊤,
  {
    have Ane : (A - {x}).nonempty := ⟨0, ⟨x, x, h.2, set.mem_singleton x, sub_self x⟩⟩,
    have : A - {x} ⊆ (vector_span ℝ A).subtype.range,
    {
      rw [submodule.range_subtype],
      simp only [vector_span],
      refine subset_trans _ submodule.subset_span,
      simp only [set.sub_singleton, set.image_subset_iff],
      intros a ha,
      refine ⟨a, x, ha, h.2, rfl⟩,
    },
    have hh : submodule.span ℝ (A - {x}) = vector_span ℝ A,
    {
      simp only [vector_span],
      apply le_antisymm,
      {
        apply submodule.span_mono,
        rintro - ⟨a, y, ha, hy, rfl⟩,
        obtain rfl := set.eq_of_mem_singleton hy,
        exact ⟨a, y, ha, h.2, rfl⟩,
      },
      {
        rw [submodule.span_le],
        rintro - ⟨a, b, ha, hb, rfl⟩,
        rw [set_like.mem_coe],
        have : (a - x) - (b - x) ∈ submodule.span ℝ (A - {x}),
        {
          refine submodule.sub_mem _ _ _,
          {exact submodule.subset_span ⟨a, x, ha, set.mem_singleton x, rfl⟩},
          {exact submodule.subset_span ⟨b, x, hb, set.mem_singleton x, rfl⟩},
        },
        simp only [sub_sub_sub_cancel_right] at this,
        exact this,
      },
    },
    have := submodule.span_preimage_eq Ane this,
    rw [hh] at this,
    convert this using 1,
    admit,
    admit,
  },
  have A'f : (0 : E) ∈ frontier A',
  {
    simp only [relbd, relint] at h,
    refine ⟨_, _⟩,
    admit, admit,
  },
  admit,
end -/

abbreviation halfspace (u : V) (c : ℝ) := {v : V | ⟪v, u⟫_ℝ ≤ c}
abbreviation hyperplane (u : V) (c : ℝ) := {v : V | ⟪v, u⟫_ℝ = c}

/- lemma relopen_subset_hyperplane_of_subset_halfspace
{A : set V} {x u : V} {c : ℝ} (hx : x ∈ A ∩ hyperplane u c)
(hA₁ : is_relopen A) (hA₂ : A ⊆ halfspace u c) :
A ⊆ hyperplane u c := sorry -/

lemma face_trans {A F G: set V}
(hGF : is_face F G) (hFA : is_face A F) : is_face A G :=
begin
  refine ⟨subset_trans hGF.1 hFA.1, hGF.2.1, _⟩,
  intros x hx y hy h,
  rcases h with ⟨z, hz, zG⟩,
  have ssubs:= hFA.2.2 x hx y hy ⟨z, hz, hGF.1 zG⟩,
  refine hGF.2.2 x (ssubs (left_mem_segment _ _ _))
                 y (ssubs (right_mem_segment _ _ _))
                 ⟨z, hz, zG⟩,
end

lemma relopen_subset_face_of_relopen_of_mem {A B F : set V} {x : V}
(hFA : is_face A F) (hBA : B ⊆ A) (hB : is_relopen B) (xBF : x ∈ B ∩ F) :
B ⊆ F :=
begin
  intros y yB,
  have xrB : x ∈ relint B,
  {
    rw [relint_relopen hB],
    exact xBF.1,
  },
  obtain ⟨z, zB, hs⟩ := exists_mem_open_segment_of_mem_relint
    xrB (subset_affine_span _ _ yB),
  exact hFA.2.2 y (hBA yB) z (hBA zB) ⟨x, hs, xBF.2⟩
    (left_mem_segment _ _ _),
end

lemma relopen_set_in_relint_face {A B : set V}
(Acv : convex ℝ A) (BA : B ⊆ A)
(Bro : is_relopen B) (Bcv : convex ℝ B) (Bne : B.nonempty):
B ⊆ relint (smallest_face_containing Acv BA) :=
begin
  let F := smallest_face_containing Acv BA,
  by_contradiction,
  rw [set.subset_def] at h,
  push_neg at h,
  rcases h with ⟨x, xB, xr⟩,
  have xfr : x ∈ relbd (smallest_face_containing Acv BA).val ∩ (smallest_face_containing Acv BA).val,
  {
    have : x ∈ (smallest_face_containing Acv BA).val :=
      smallest_face_containing_contains Acv BA xB,
    exact ⟨⟨subset_closure this, xr⟩, this⟩,
  },
  obtain ⟨u, xG, hGF⟩ := exists_supporting_halfspace
    (face_convex (smallest_face_containing Acv BA).property) xfr,
  let G := normal_face F.val u,
  change G ⊂ F.val at hGF,
  have hGA : is_face A G := face_trans
    (normal_face_is_face (face_convex F.property) u) F.property,
  have hBG := relopen_subset_face_of_relopen_of_mem hGA BA Bro ⟨xB, xG⟩,
  have hFG : F.val ⊆ G := smallest_face_containing_subset Acv hGA hBG,
  exact hGF.2 hFG,
end

lemma relint_faces_disjoint {A F G : set V}
(Acv : convex ℝ A) (hF : is_face A F) (hG : is_face A G) :
F = G ∨ relint F ∩ relint G = ∅ :=
begin
  by_cases h : (relint F ∩ relint G).nonempty,
  {
    left,
    by_contradiction hc,
    rcases h with ⟨x, hx⟩,
    rw [subset_antisymm_iff] at hc,
    push_neg at hc,
    simp only [imp_iff_or_not, set.not_subset] at hc,
    cases hc,
    {
      rcases hc with ⟨y, yG, ynF⟩,
      obtain ⟨z, zG, hs⟩ := exists_mem_open_segment_of_mem_relint
        hx.2 (subset_affine_span _ _ yG),
      apply ynF,
      refine hF.2.2 _ (hG.1 yG) _ (hG.1 zG) _ (left_mem_segment _ _ _),
      exact ⟨x, hs, relint_subset_self _ hx.1⟩,
    },
    {
      rcases hc with ⟨y, yF, ynG⟩,
      obtain ⟨z, zF, hs⟩ := exists_mem_open_segment_of_mem_relint
        hx.1 (subset_affine_span _ _ yF),
      apply ynG,
      refine hG.2.2 _ (hF.1 yF) _ (hF.1 zF) _ (left_mem_segment _ _ _),
      exact ⟨x, hs, relint_subset_self _ hx.2⟩,
    },
  },
  {
    right,
    rw [set.nonempty_def] at h,
    push_neg at h,
    ext,
    tauto,
  },
end

/- lemma surrounding_relint_face_unique {A B F : set V}
(Acv : convex ℝ A) (BA : B ⊆ A) (Bne : B.nonempty) (h : is_face A F) :
B ⊆ relint F → F = smallest_face_containing Acv BA :=
begin
  intro hBF,
  cases relint_faces_disjoint Acv h (smallest_face_containing Acv BA).property with hc hc,
  {
    exact hc,
  },
  {
    rcases Bne with ⟨x, xB⟩,
    have : x ∈ relint F ∩ relint (smallest_face_containing Acv BA).val,
    {
      refine ⟨hBF xB, _⟩,
      admit,
    },
    admit,
  },
end -/

lemma relopen_singleton (x : V) : is_relopen ({x} : set V) :=
begin
  simp only [is_relopen],
  have := affine_subspace.coe_affine_span_singleton ℝ V x,
  convert is_open_univ,
  ext y,
  simp only [set.mem_preimage, set.mem_singleton_iff, set.mem_univ, iff_true],
  have hy := y.property,
  change y.val ∈ (affine_span ℝ ({x} : set V) : set V) at hy,
  rw [this] at hy,
  exact set.eq_of_mem_singleton hy,
end

lemma point_in_relint_face {A : set V}
(Acv : convex ℝ A) {x : V} (xA : x ∈ A) :
x ∈ relint (smallest_face_containing_point Acv xA : set V) :=
begin
  have := relopen_set_in_relint_face Acv
    (set.singleton_subset_iff.mpr xA)
    (relopen_singleton x)
    (convex_singleton x)
    ⟨x, rfl⟩,
  exact set.singleton_subset_iff.mp this,
end

lemma surrounding_relint_face_unique {A F : set V} {x : V}
(Acv : convex ℝ A) (xA : x ∈ A) (h : is_face A F) :
x ∈ relint F → F = smallest_face_containing_point Acv xA :=
begin
  intro hBF,
  cases relint_faces_disjoint Acv h (smallest_face_containing_point Acv xA).property with hc hc,
  {
    exact hc,
  },
  {
    have : x ∈ relint F ∩ relint (smallest_face_containing_point Acv xA).val,
    {
      refine ⟨hBF, _⟩,
      exact point_in_relint_face Acv xA,
    },
    rw [hc, set.mem_empty_eq] at this,
    contradiction,
  },
end

/- lemma point_in_relint_face {A : set V}
(Acv : convex ℝ A) {x : V} (xA : x ∈ A) :
x ∈ relint (smallest_face_containing_point Acv xA : set V) :=
begin
  let F := smallest_face_containing_point Acv xA,
  by_contradiction xr,
  have xfr : x ∈ relbd F.val ∩ F.val,
  {
    have : x ∈ F.val :=
      smallest_face_containing_point_contains Acv xA,
    exact ⟨⟨subset_closure this, xr⟩, this⟩,
  },
  obtain ⟨u, xG, hGF⟩ := exists_supporting_halfspace
    (face_convex F.property) xfr,
  let G := normal_face F.val u,
  change G ⊂ F.val at hGF,
  have hGA : is_face A G := face_trans
    (normal_face_is_face (face_convex F.property) u) F.property,
  have hFG : F.val ⊆ G := smallest_face_containing_point_subset Acv hGA xG,
  exact hGF.2 hFG,
end -/

lemma convex_hull_subset_vector_space (A : set V) (E : submodule ℝ V) :
A ⊆ E → convex_hull ℝ A ⊆ E :=
begin
  rw [convex.convex_hull_subset_iff E.convex],
  exact id,
end

/- theorem relint_aff_int (A : set V) : is_relopen (relint A) :=
begin
  have hh: relint A = coerce_affine_subspace_set (affine_span ℝ A) (interior (set_into_affine_subspace A (affine_span ℝ A))) := sorry,
  have : set_into_affine_subspace (relint A) (affine_span ℝ A) = (interior (set_into_affine_subspace A (affine_span ℝ A))) := sorry,
  rw is_relopen,
  -- rw relint,
  simp,
  rw this,

end -/

lemma mem_vspan_normal_face (A : set V) (u : V) :
u ∈ (vector_span ℝ (normal_face A u))ᗮ :=
begin
  simp only [vector_span, mem_orthogonal_span],
  rintro - ⟨a, b, ha, hb, rfl⟩,
  simp only [mem_normal_face] at ha hb,
  simp only [vsub_eq_sub, inner_sub_left, sub_eq_zero],
  apply le_antisymm,
  all_goals {tauto},
end

/- lemma add_mem_normal_face (A : set V) (u : V) {x y : V}
(hx : x ∈ normal_face A u) (hy : y ∈ (vector_span ℝ (normal_face A u))ᗮ)
(hxy : x + y ∈ A) : x + y ∈ normal_face A u := sorry

lemma add_mem_normal_face' (A : set V) (u : V) :
A ∩ (normal_face A u + (vector_span ℝ (normal_face A u))ᗮ) = normal_face A u := sorry -/

lemma is_face_refl {A : set V} (hA : convex ℝ A) :
is_face A A :=
begin
  suffices h : A = normal_face A 0,
  {
    nth_rewrite 1 [h],
    apply normal_face_is_face hA,
  },
  simp only [normal_face],
  ext, split,
  {
    intro xA,
    refine ⟨xA, _⟩,
    simp only [inner_zero_right],
    rintro - -,
    exact le_refl 0,
  },
  {
    rintro ⟨xA, -⟩,
    exact xA,
  },
end

lemma face_smul {A : set V} {u : V} {c : ℝ} (cpos : c > 0) :
normal_face (c • A) u = c • normal_face A u :=
begin
  ext,
  simp only [mem_normal_face, set.mem_smul_set],
  simp only [ge_iff_le, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂],
  split,
  {
    rintro ⟨⟨y, yA, rfl⟩, h⟩,
    refine ⟨y, ⟨yA, _⟩, _⟩,
    {
      intros z zA,
      replace h := h z zA,
      simp only [inner_smul_left, is_R_or_C.conj_to_real] at h,
      exact le_of_mul_le_mul_left h cpos,
    },
    {
      refl,
    }
  },
  {
    rintro ⟨y, ⟨yA, hy⟩, rfl⟩,
    refine ⟨⟨y, yA, rfl⟩, _⟩,
    intros a aA,
    simp only [inner_smul_left, is_R_or_C.conj_to_real],
    rw [mul_le_mul_left cpos],
    tauto,
  },
end

lemma face_translate {A : set V} {u x : V} :
normal_face (A + {x}) u = normal_face A u + {x} :=
begin
  ext y,
  simp only [mem_normal_face, set.mem_add, set.mem_singleton_iff],
  split,
  {
    rintro ⟨⟨z, w, zA, rfl, rfl⟩, h₂⟩,
    refine ⟨z, w, ⟨zA, _⟩, rfl, rfl⟩,
    intros v vA,
    have := h₂ (v + w) ⟨v, w, vA, rfl, rfl⟩,
    simpa only [inner_add_left, ge_iff_le, add_le_add_iff_right] using this,
  },
  {
    rintro ⟨z, w, ⟨zA, h⟩, rfl, rfl⟩,
    refine ⟨⟨z, w, zA, rfl, rfl⟩, _⟩,
    rintro v ⟨s, t, sA, rfl, rfl⟩,
    simp only [inner_add_left, ge_iff_le, add_le_add_iff_right],
    exact h s sA,
  },
end

lemma h_normal_face_homothety (A : set V) (u : V) (c : ℝ) (v : V)
(h : c > 0) : normal_face (c • (A + {v})) u ⊆ c • (normal_face A u + {v}) :=
begin
  simp only [normal_face],
  intro x,
  {
    intros hx,
    replace hx := set.mem_set_of.mp hx,
    rcases set.mem_smul_set.mp hx.1 with ⟨y, hy, rfl⟩,
    refine set.mem_smul_set.mpr (set.smul_mem_smul_set _),
    apply set.mem_set_of.mpr,
    refine ⟨y - v, v, _, _⟩,
    {
      apply set.mem_set_of.mpr,
      rcases hy with ⟨a, vv, ha, hvv, rfl⟩,
      rcases set.eq_of_mem_singleton hvv,
      split,
      {
        simp only [ha, add_sub_cancel],
      },
      {
        intros y hy,
        replace hx := hx.2,
        have := hx (c • (y + v)) _,
        {
          simp only [inner_smul_left, inner_add_left,
            is_R_or_C.conj_to_real, (smul_eq_mul ℝ).symm] at this,
          replace := (smul_le_smul_iff_of_pos h).mp this,
          simpa only [add_sub_cancel, add_le_add_iff_right] using this,
        },
        {
          refine set.smul_mem_smul_set ⟨y, v, hy, _, rfl⟩,
          exact set.mem_singleton _,
        },
      },
    },
    {
      refine ⟨set.mem_singleton _, by simp only [sub_add_cancel]⟩,
    },
  },
end

lemma normal_face_homothety {A : set V} {u : V} {c : ℝ} (v : V)
(h : c > 0) : normal_face (c • (A + {v})) u = c • (normal_face A u + {v}) :=
begin
  apply subset_antisymm,
  {
    apply h_normal_face_homothety A u c v h,
  },
  {
    let B := c • (A + {v}),
    refine (set.set_smul_subset_iff₀ (ne_of_gt h)).mpr _,
    suffices hh : normal_face A u ⊆ c⁻¹ • (normal_face (c • (A + {v})) u + {-c • v}),
    {
      rintro x ⟨n, vv, hn, hvv, rfl⟩,
      cases set.eq_of_mem_singleton hvv,
      rcases set.mem_smul_set.mp (hh hn) with ⟨a, ha, rfl⟩,
      refine set.mem_smul_set.mpr ⟨a - (-c) • v, _, _⟩,
      {
        rcases ha with ⟨b, d, hb, hd, rfl⟩,
        cases set.eq_of_mem_singleton hd,
        convert hb,
        simp only [add_sub_cancel],
      },
      {
        simp only [neg_smul, sub_neg_eq_add, smul_add, add_right_inj,
          inv_smul_smul₀ (ne_of_gt h)],
      },
    },
    convert h_normal_face_homothety B u c⁻¹ (-c • v) (inv_pos_of_pos h),
    ext, split,
    {
      intro hx,
      refine (set.mem_smul_set_iff_inv_smul_mem₀ (ne_of_gt (inv_pos_of_pos h)) _ _).mpr _,
      simp only [B, inv_inv, set.add_singleton, neg_smul, set.image_add_right,
        set.mem_preimage, neg_neg],
      refine set.mem_smul_set.mpr _,
      refine ⟨x + v, _, _⟩,
      {
        refine (set.mem_preimage).mpr _,
        convert hx,
        simp only [add_neg_cancel_right],
      },
      {
        rw [smul_add],
      },
    },
    {
      intro hx,
      rcases set.mem_smul_set.mp hx with ⟨y, ⟨b, w, hb, hw, rfl⟩, rfl⟩,
      rcases set.eq_of_mem_singleton hw,
      simp only [B] at hb,
      rcases set.mem_smul_set.mp hb with ⟨d, ⟨e, q, he, hq, rfl⟩, rfl⟩,
      rcases set.eq_of_mem_singleton hq,
      simp only [neg_smul, sub_neg_eq_add, smul_add,
        sub_neg_eq_add],
      simp only [smul_neg, (smul_assoc _ _ _).symm,
        (inv_mul_eq_one₀ (ne_of_gt h)).mpr rfl, smul_eq_mul, one_smul,
        add_neg_cancel_right],
      assumption,
    },
  },
end

@[simp]
lemma normal_face_singleton (x : V) (u : V) :
normal_face {x} u = {x} :=
begin
  ext,
  simp only [mem_normal_face, set.mem_singleton_iff, ge_iff_le, forall_eq, and_iff_left_iff_imp],
  rintro rfl,
  apply le_refl,
end

@[simp]
lemma normal_face_zero (u : V) :
normal_face 0 u = 0 :=
begin
  have : (0 : set V) = {0} := rfl,
  rw [this],
  apply normal_face_singleton,
end


/-
Copyright (c) 2015, 2017 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis, Johannes Hölzl, Mario Carneiro, Sébastien Gouëzel
-/
import data.real.ennreal
import data.finset.intervals
import topology.uniform_space.uniform_embedding
import topology.uniform_space.pi
import topology.uniform_space.uniform_convergence
import topology.paracompact
import set_theory.ordinal

/-!
# Extended metric spaces

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 `ℝ≥0∞`.

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`).

Since a lot of elementary properties don't require `eq_of_edist_eq_zero` we start setting up the
theory of `pseudo_emetric_space`, where we don't require `edist x y = 0 → x = y` and we specialize
to `emetric_space` at the end.
-/

open set filter classical
noncomputable theory

open_locale uniformity topological_space big_operators filter nnreal ennreal

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

/-- 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, 𝓟 {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)

/-- `has_edist α` means that `α` is equipped with an extended distance. -/
class has_edist (α : Type*) := (edist : α → α → ℝ≥0∞)
export has_edist (edist)

/-- Creating a uniform space from an extended distance. -/
def uniform_space_of_edist
  (edist : α → α → ℝ≥0∞)
  (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, 𝓟 {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 : ℝ≥0∞) = (2 : ℕ) := by simp,
    have A : 0 < ε / 2 := ennreal.div_pos_iff.2
      ⟨ne_of_gt h, by { convert 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] }

-- the uniform structure is embedded in the emetric space structure
-- to avoid instance diamond issues. See Note [forgetful inheritance].

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

Each pseudo_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 a `pseudo_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 a `pseudo_emetric_space` structure
on a product.

Continuity of `edist` is proved in `topology.instances.ennreal`
-/
class pseudo_emetric_space (α : Type u) extends has_edist α : Type u :=
(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)
(to_uniform_space : uniform_space α :=
  uniform_space_of_edist edist edist_self edist_comm edist_triangle)
(uniformity_edist : 𝓤 α = ⨅ ε>0, 𝓟 {p:α×α | edist p.1 p.2 < ε} . control_laws_tac)

/- Pseudoemetric 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 [pseudo_emetric_space α]

@[priority 100] -- see Note [lower instance priority]
instance pseudo_emetric_space.to_uniform_space' : uniform_space α :=
pseudo_emetric_space.to_uniform_space

export pseudo_emetric_space (edist_self edist_comm edist_triangle)

attribute [simp] edist_self

/-- 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) _

/-- The triangle (polygon) inequality for sequences of points; `finset.Ico` version. -/
lemma edist_le_Ico_sum_edist (f : ℕ → α) {m n} (h : m ≤ n) :
  edist (f m) (f n) ≤ ∑ i in finset.Ico m n, edist (f i) (f (i + 1)) :=
begin
  revert n,
  refine nat.le_induction _ _,
  { simp only [finset.sum_empty, finset.Ico.self_eq_empty, edist_self],
    -- TODO: Why doesn't Lean close this goal automatically? `apply le_refl` fails too.
    exact le_refl (0:ℝ≥0∞) },
  { assume n hn hrec,
    calc edist (f m) (f (n+1)) ≤ edist (f m) (f n) + edist (f n) (f (n+1)) : edist_triangle _ _ _
      ... ≤ ∑ i in finset.Ico m n, _ + _ : add_le_add hrec (le_refl _)
      ... = ∑ i in finset.Ico m (n+1), _ :
        by rw [finset.Ico.succ_top hn, finset.sum_insert, add_comm]; simp }
end

/-- The triangle (polygon) inequality for sequences of points; `finset.range` version. -/
lemma edist_le_range_sum_edist (f : ℕ → α) (n : ℕ) :
  edist (f 0) (f n) ≤ ∑ i in finset.range n, edist (f i) (f (i + 1)) :=
finset.Ico.zero_bot n ▸ edist_le_Ico_sum_edist f (nat.zero_le n)

/-- A version of `edist_le_Ico_sum_edist` with each intermediate distance replaced
with an upper estimate. -/
lemma edist_le_Ico_sum_of_edist_le {f : ℕ → α} {m n} (hmn : m ≤ n)
  {d : ℕ → ℝ≥0∞} (hd : ∀ {k}, m ≤ k → k < n → edist (f k) (f (k + 1)) ≤ d k) :
  edist (f m) (f n) ≤ ∑ i in finset.Ico m n, d i :=
le_trans (edist_le_Ico_sum_edist f hmn) $
finset.sum_le_sum $ λ k hk, hd (finset.Ico.mem.1 hk).1 (finset.Ico.mem.1 hk).2

/-- A version of `edist_le_range_sum_edist` with each intermediate distance replaced
with an upper estimate. -/
lemma edist_le_range_sum_of_edist_le {f : ℕ → α} (n : ℕ)
  {d : ℕ → ℝ≥0∞} (hd : ∀ {k}, k < n → edist (f k) (f (k + 1)) ≤ d k) :
  edist (f 0) (f n) ≤ ∑ i in finset.range n, d i :=
finset.Ico.zero_bot n ▸ edist_le_Ico_sum_of_edist_le (zero_le n) (λ _ _, hd)

/-- Reformulation of the uniform structure in terms of the extended distance -/
theorem uniformity_pseudoedist :
  𝓤 α = ⨅ ε>0, 𝓟 {p:α×α | edist p.1 p.2 < ε} :=
pseudo_emetric_space.uniformity_edist

theorem uniformity_basis_edist :
  (𝓤 α).has_basis (λ ε : ℝ≥0∞, 0 < ε) (λ ε, {p:α×α | edist p.1 p.2 < ε}) :=
(@uniformity_pseudoedist α _).symm ▸ has_basis_binfi_principal
  (λ r hr p hp, ⟨min r p, lt_min hr hp,
    λ x hx, lt_of_lt_of_le hx (min_le_left _ _),
    λ x hx, lt_of_lt_of_le hx (min_le_right _ _)⟩)
  ⟨1, ennreal.zero_lt_one⟩

/-- 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) :=
uniformity_basis_edist.mem_uniformity_iff

/-- Given `f : β → ℝ≥0∞`, if `f` sends `{i | p i}` to a set of positive numbers
accumulating to zero, then `f i`-neighborhoods of the diagonal form a basis of `𝓤 α`.

For specific bases see `uniformity_basis_edist`, `uniformity_basis_edist'`,
`uniformity_basis_edist_nnreal`, and `uniformity_basis_edist_inv_nat`. -/
protected theorem emetric.mk_uniformity_basis {β : Type*} {p : β → Prop} {f : β → ℝ≥0∞}
  (hf₀ : ∀ x, p x → 0 < f x) (hf : ∀ ε, 0 < ε → ∃ x (hx : p x), f x ≤ ε) :
  (𝓤 α).has_basis p (λ x, {p:α×α | edist p.1 p.2 < f x}) :=
begin
  refine ⟨λ s, uniformity_basis_edist.mem_iff.trans _⟩,
  split,
  { rintros ⟨ε, ε₀, hε⟩,
    rcases hf ε ε₀ with ⟨i, hi, H⟩,
    exact ⟨i, hi, λ x hx, hε $ lt_of_lt_of_le hx H⟩ },
  { exact λ ⟨i, hi, H⟩, ⟨f i, hf₀ i hi, H⟩ }
end

/-- Given `f : β → ℝ≥0∞`, if `f` sends `{i | p i}` to a set of positive numbers
accumulating to zero, then closed `f i`-neighborhoods of the diagonal form a basis of `𝓤 α`.

For specific bases see `uniformity_basis_edist_le` and `uniformity_basis_edist_le'`. -/
protected theorem emetric.mk_uniformity_basis_le {β : Type*} {p : β → Prop} {f : β → ℝ≥0∞}
  (hf₀ : ∀ x, p x → 0 < f x) (hf : ∀ ε, 0 < ε → ∃ x (hx : p x), f x ≤ ε) :
  (𝓤 α).has_basis p (λ x, {p:α×α | edist p.1 p.2 ≤ f x}) :=
begin
  refine ⟨λ s, uniformity_basis_edist.mem_iff.trans _⟩,
  split,
  { rintros ⟨ε, ε₀, hε⟩,
    rcases exists_between ε₀ with ⟨ε', hε'⟩,
    rcases hf ε' hε'.1 with ⟨i, hi, H⟩,
    exact ⟨i, hi, λ x hx, hε $ lt_of_le_of_lt (le_trans hx H) hε'.2⟩ },
  { exact λ ⟨i, hi, H⟩, ⟨f i, hf₀ i hi, λ x hx, H (le_of_lt hx)⟩ }
end

theorem uniformity_basis_edist_le :
  (𝓤 α).has_basis (λ ε : ℝ≥0∞, 0 < ε) (λ ε, {p:α×α | edist p.1 p.2 ≤ ε}) :=
emetric.mk_uniformity_basis_le (λ _, id) (λ ε ε₀, ⟨ε, ε₀, le_refl ε⟩)

theorem uniformity_basis_edist' (ε' : ℝ≥0∞) (hε' : 0 < ε') :
  (𝓤 α).has_basis (λ ε : ℝ≥0∞, ε ∈ Ioo 0 ε') (λ ε, {p:α×α | edist p.1 p.2 < ε}) :=
emetric.mk_uniformity_basis (λ _, and.left)
  (λ ε ε₀, let ⟨δ, hδ⟩ := exists_between hε' in
    ⟨min ε δ, ⟨lt_min ε₀ hδ.1, lt_of_le_of_lt (min_le_right _ _) hδ.2⟩, min_le_left _ _⟩)

theorem uniformity_basis_edist_le' (ε' : ℝ≥0∞) (hε' : 0 < ε') :
  (𝓤 α).has_basis (λ ε : ℝ≥0∞, ε ∈ Ioo 0 ε') (λ ε, {p:α×α | edist p.1 p.2 ≤ ε}) :=
emetric.mk_uniformity_basis_le (λ _, and.left)
  (λ ε ε₀, let ⟨δ, hδ⟩ := exists_between hε' in
    ⟨min ε δ, ⟨lt_min ε₀ hδ.1, lt_of_le_of_lt (min_le_right _ _) hδ.2⟩, min_le_left _ _⟩)

theorem uniformity_basis_edist_nnreal :
  (𝓤 α).has_basis (λ ε : ℝ≥0, 0 < ε) (λ ε, {p:α×α | edist p.1 p.2 < ε}) :=
emetric.mk_uniformity_basis (λ _, ennreal.coe_pos.2)
  (λ ε ε₀, let ⟨δ, hδ⟩ := ennreal.lt_iff_exists_nnreal_btwn.1 ε₀ in
  ⟨δ, ennreal.coe_pos.1 hδ.1, le_of_lt hδ.2⟩)

theorem uniformity_basis_edist_inv_nat :
  (𝓤 α).has_basis (λ _, true) (λ n:ℕ, {p:α×α | edist p.1 p.2 < (↑n)⁻¹}) :=
emetric.mk_uniformity_basis
  (λ n _, ennreal.inv_pos.2 $ ennreal.nat_ne_top n)
  (λ ε ε₀, let ⟨n, hn⟩ := ennreal.exists_inv_nat_lt (ne_of_gt ε₀) in ⟨n, trivial, le_of_lt hn⟩)

theorem uniformity_basis_edist_inv_two_pow :
  (𝓤 α).has_basis (λ _, true) (λ n:ℕ, {p:α×α | edist p.1 p.2 < 2⁻¹ ^ n}) :=
emetric.mk_uniformity_basis
  (λ n _, ennreal.pow_pos (ennreal.inv_pos.2 ennreal.two_ne_top) _)
  (λ ε ε₀, let ⟨n, hn⟩ := ennreal.exists_inv_two_pow_lt (ne_of_gt ε₀) in ⟨n, trivial, le_of_lt hn⟩)

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

namespace emetric

theorem uniformity_has_countable_basis : is_countably_generated (𝓤 α) :=
is_countably_generated_of_seq ⟨_, uniformity_basis_edist_inv_nat.eq_infi⟩

/-- ε-δ characterization of uniform continuity on a set for pseudoemetric spaces -/
theorem uniform_continuous_on_iff [pseudo_emetric_space β] {f : α → β} {s : set α} :
  uniform_continuous_on f s ↔ ∀ ε > 0, ∃ δ > 0,
    ∀{a b}, a ∈ s → b ∈ s → edist a b < δ → edist (f a) (f b) < ε :=
uniformity_basis_edist.uniform_continuous_on_iff uniformity_basis_edist

/-- ε-δ characterization of uniform continuity on pseudoemetric spaces -/
theorem uniform_continuous_iff [pseudo_emetric_space β] {f : α → β} :
  uniform_continuous f ↔ ∀ ε > 0, ∃ δ > 0,
    ∀{a b:α}, edist a b < δ → edist (f a) (f b) < ε :=
uniformity_basis_edist.uniform_continuous_iff uniformity_basis_edist

/-- ε-δ characterization of uniform embeddings on pseudoemetric spaces -/
theorem uniform_embedding_iff [pseudo_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)⟩⟩

/-- If a map between pseudoemetric spaces is a uniform embedding then the edistance between `f x`
and `f y` is controlled in terms of the distance between `x` and `y`. -/
theorem controlled_of_uniform_embedding [pseudo_emetric_space β] {f : α → β} :
  uniform_embedding f →
  (∀ ε > 0, ∃ δ > 0, ∀ {a b : α}, edist a b < δ → edist (f a) (f b) < ε) ∧
  (∀ δ > 0, ∃ ε > 0, ∀ {a b : α}, edist (f a) (f b) < ε → edist a b < δ) :=
begin
  assume h,
    exact ⟨uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1,
          (uniform_embedding_iff.1 h).2.2⟩,
end

/-- ε-δ characterization of Cauchy sequences on pseudoemetric spaces -/
protected lemma cauchy_iff {f : filter α} :
  cauchy f ↔ f ≠ ⊥ ∧ ∀ ε > 0, ∃ t ∈ f, ∀ x y ∈ t, edist x y < ε :=
by rw ← ne_bot_iff; exact uniformity_basis_edist.cauchy_iff

/-- A very useful criterion to show that a space is complete is to show that all sequences
which satisfy a bound of the form `edist (u n) (u m) < B N` for all `n m ≥ N` are
converging. This is often applied for `B N = 2^{-N}`, i.e., with a very fast convergence to
`0`, which makes it possible to use arguments of converging series, while this is impossible
to do in general for arbitrary Cauchy sequences. -/
theorem complete_of_convergent_controlled_sequences (B : ℕ → ℝ≥0∞) (hB : ∀n, 0 < B n)
  (H : ∀u : ℕ → α, (∀N n m : ℕ, N ≤ n → N ≤ m → edist (u n) (u m) < B N) →
    ∃x, tendsto u at_top (𝓝 x)) :
  complete_space α :=
uniform_space.complete_of_convergent_controlled_sequences
  uniformity_has_countable_basis
  (λ n, {p:α×α | edist p.1 p.2 < B n}) (λ n, edist_mem_uniformity $ hB n) H

/-- A sequentially complete pseudoemetric space is complete. -/
theorem complete_of_cauchy_seq_tendsto :
  (∀ u : ℕ → α, cauchy_seq u → ∃a, tendsto u at_top (𝓝 a)) → complete_space α :=
uniform_space.complete_of_cauchy_seq_tendsto uniformity_has_countable_basis

/-- Expressing locally uniform convergence on a set using `edist`. -/
lemma tendsto_locally_uniformly_on_iff {ι : Type*} [topological_space β]
  {F : ι → β → α} {f : β → α} {p : filter ι} {s : set β} :
  tendsto_locally_uniformly_on F f p s ↔
  ∀ ε > 0, ∀ x ∈ s, ∃ t ∈ 𝓝[s] x, ∀ᶠ n in p, ∀ y ∈ t, edist (f y) (F n y) < ε :=
begin
  refine ⟨λ H ε hε, H _ (edist_mem_uniformity hε), λ H u hu x hx, _⟩,
  rcases mem_uniformity_edist.1 hu with ⟨ε, εpos, hε⟩,
  rcases H ε εpos x hx with ⟨t, ht, Ht⟩,
  exact ⟨t, ht, Ht.mono (λ n hs x hx, hε (hs x hx))⟩
end

/-- Expressing uniform convergence on a set using `edist`. -/
lemma tendsto_uniformly_on_iff {ι : Type*}
  {F : ι → β → α} {f : β → α} {p : filter ι} {s : set β} :
  tendsto_uniformly_on F f p s ↔ ∀ ε > 0, ∀ᶠ n in p, ∀ x ∈ s, edist (f x) (F n x) < ε :=
begin
  refine ⟨λ H ε hε, H _ (edist_mem_uniformity hε), λ H u hu, _⟩,
  rcases mem_uniformity_edist.1 hu with ⟨ε, εpos, hε⟩,
  exact (H ε εpos).mono (λ n hs x hx, hε (hs x hx))
end

/-- Expressing locally uniform convergence using `edist`. -/
lemma tendsto_locally_uniformly_iff {ι : Type*} [topological_space β]
  {F : ι → β → α} {f : β → α} {p : filter ι} :
  tendsto_locally_uniformly F f p ↔
  ∀ ε > 0, ∀ (x : β), ∃ t ∈ 𝓝 x, ∀ᶠ n in p, ∀ y ∈ t, edist (f y) (F n y) < ε :=
by simp only [← tendsto_locally_uniformly_on_univ, tendsto_locally_uniformly_on_iff,
  mem_univ, forall_const, exists_prop, nhds_within_univ]

/-- Expressing uniform convergence using `edist`. -/
lemma tendsto_uniformly_iff {ι : Type*}
  {F : ι → β → α} {f : β → α} {p : filter ι} :
  tendsto_uniformly F f p ↔ ∀ ε > 0, ∀ᶠ n in p, ∀ x, edist (f x) (F n x) < ε :=
by simp only [← tendsto_uniformly_on_univ, tendsto_uniformly_on_iff, mem_univ, forall_const]

end emetric

open emetric

/-- Auxiliary function to replace the uniformity on a pseudoemetric space with
a uniformity which is equal to the original one, but maybe not defeq.
This is useful if one wants to construct a pseudoemetric space with a
specified uniformity. See Note [forgetful inheritance] explaining why having definitionally
the right uniformity is often important.
-/
def pseudo_emetric_space.replace_uniformity {α} [U : uniform_space α] (m : pseudo_emetric_space α)
  (H : @uniformity _ U = @uniformity _ pseudo_emetric_space.to_uniform_space) :
  pseudo_emetric_space α :=
{ edist               := @edist _ m.to_has_edist,
  edist_self          := edist_self,
  edist_comm          := edist_comm,
  edist_triangle      := edist_triangle,
  to_uniform_space    := U,
  uniformity_edist    := H.trans (@pseudo_emetric_space.uniformity_edist α _) }

/-- The extended pseudometric induced by a function taking values in a pseudoemetric space. -/
def pseudo_emetric_space.induced {α β} (f : α → β)
  (m : pseudo_emetric_space β) : pseudo_emetric_space α :=
{ edist               := λ x y, edist (f x) (f y),
  edist_self          := λ x, edist_self _,
  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 }

/-- Pseudoemetric space instance on subsets of pseudoemetric spaces -/
instance {α : Type*} {p : α → Prop} [t : pseudo_emetric_space α] :
  pseudo_emetric_space (subtype p) := t.induced coe

/-- The extended psuedodistance on a subset of a pseudoemetric space is the restriction of
the original pseudodistance, by definition -/
theorem subtype.edist_eq {p : α → Prop} (x y : subtype p) : edist x y = edist (x : α) y := rfl

/-- The product of two pseudoemetric spaces, with the max distance, is an extended
pseudometric 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.pseudo_emetric_space_max [pseudo_emetric_space β] : pseudo_emetric_space (α × β) :=
{ edist := λ x y, max (edist x.1 y.1) (edist x.2 y.2),
  edist_self := λ x, by simp,
  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 [pseudo_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 }

lemma prod.edist_eq [pseudo_emetric_space β] (x y : α × β) :
  edist x y = max (edist x.1 y.1) (edist x.2 y.2) :=
rfl

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

/-- The product of a finite number of pseudoemetric spaces, with the max distance, is still
a pseudoemetric 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 pseudo_emetric_space_pi [∀b, pseudo_emetric_space (π b)] :
  pseudo_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,
  to_uniform_space := Pi.uniform_space _,
  uniformity_edist := begin
    simp only [Pi.uniformity, pseudo_emetric_space.uniformity_edist, comap_infi, gt_iff_lt,
      preimage_set_of_eq, comap_principal],
    rw infi_comm, congr, funext ε,
    rw infi_comm, congr, funext εpos,
    change 0 < ε at εpos,
    simp [set.ext_iff, εpos]
  end }

lemma edist_pi_def [Π b, pseudo_emetric_space (π b)] (f g : Π b, π b) :
  edist f g = finset.sup univ (λb, edist (f b) (g b)) := rfl

@[simp]
lemma edist_pi_const [nonempty β] (a b : α) :
  edist (λ x : β, a) (λ _, b) = edist a b := finset.sup_const univ_nonempty (edist a b)

end pi

namespace emetric
variables {x y z : α} {ε ε₁ ε₂ : ℝ≥0∞} {s : set α}

/-- `emetric.ball x ε` is the set of all points `y` with `edist y x < ε` -/
def ball (x : α) (ε : ℝ≥0∞) : 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 : α) (ε : ℝ≥0∞) := {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 ≠ ⊤ := 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)⟩

/-- Relation “two points are at a finite edistance” is an equivalence relation. -/
def edist_lt_top_setoid : setoid α :=
{ r := λ x y, edist x y < ⊤,
  iseqv := ⟨λ x, by { rw edist_self, exact ennreal.coe_lt_top },
    λ x y h, by rwa edist_comm,
    λ x y z hxy hyz, lt_of_le_of_lt (edist_triangle x y z) (ennreal.add_lt_top.2 ⟨hxy, hyz⟩)⟩ }

@[simp] lemma ball_zero : ball x 0 = ∅ :=
by rw [emetric.ball_eq_empty_iff]

theorem nhds_basis_eball : (𝓝 x).has_basis (λ ε:ℝ≥0∞, 0 < ε) (ball x) :=
nhds_basis_uniformity uniformity_basis_edist

theorem nhds_basis_closed_eball : (𝓝 x).has_basis (λ ε:ℝ≥0∞, 0 < ε) (closed_ball x) :=
nhds_basis_uniformity uniformity_basis_edist_le

theorem nhds_eq : 𝓝 x = (⨅ε>0, 𝓟 (ball x ε)) :=
nhds_basis_eball.eq_binfi

theorem mem_nhds_iff : s ∈ 𝓝 x ↔ ∃ε>0, ball x ε ⊆ s := nhds_basis_eball.mem_iff

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 is_closed_ball_top : is_closed (ball x ⊤) :=
is_open_compl_iff.1 $ is_open_iff.2 $ λ y hy, ⟨⊤, ennreal.coe_lt_top, subset_compl_iff_disjoint.2 $
  ball_disjoint $ by { rw ennreal.top_add, exact le_of_not_lt hy }⟩

theorem ball_mem_nhds (x : α) {ε : ℝ≥0∞} (ε0 : 0 < ε) : ball x ε ∈ 𝓝 x :=
mem_nhds_sets is_open_ball (mem_ball_self ε0)

theorem ball_prod_same [pseudo_emetric_space β] (x : α) (y : β) (r : ℝ≥0∞) :
  (ball x r).prod (ball y r) = ball (x, y) r :=
ext $ λ z, max_lt_iff.symm

theorem closed_ball_prod_same [pseudo_emetric_space β] (x : α) (y : β) (r : ℝ≥0∞) :
  (closed_ball x r).prod (closed_ball y r) = closed_ball (x, y) r :=
ext $ λ z, max_le_iff.symm

/-- ε-characterization of the closure in pseudoemetric spaces -/
theorem mem_closure_iff :
  x ∈ closure s ↔ ∀ε>0, ∃y ∈ s, edist x y < ε :=
(mem_closure_iff_nhds_basis nhds_basis_eball).trans $
  by simp only [mem_ball, edist_comm x]

theorem tendsto_nhds {f : filter β} {u : β → α} {a : α} :
  tendsto u f (𝓝 a) ↔ ∀ ε > 0, ∀ᶠ x in f, edist (u x) a < ε :=
nhds_basis_eball.tendsto_right_iff

theorem tendsto_at_top [nonempty β] [semilattice_sup β] {u : β → α} {a : α} :
  tendsto u at_top (𝓝 a) ↔ ∀ε>0, ∃N, ∀n≥N, edist (u n) a < ε :=
(at_top_basis.tendsto_iff nhds_basis_eball).trans $
  by simp only [exists_prop, true_and, mem_Ici, mem_ball]

/-- In a pseudoemetric space, Cauchy sequences are characterized by the fact that, eventually,
the pseudoedistance between its elements is arbitrarily small -/
@[nolint ge_or_gt] -- see Note [nolint_ge]

/-- A variation around the emetric characterization of Cauchy sequences -/
theorem cauchy_seq_iff' [nonempty β] [semilattice_sup β] {u : β → α} :
  cauchy_seq u ↔ ∀ε>(0 : ℝ≥0∞), ∃N, ∀n≥N, edist (u n) (u N) < ε :=
uniformity_basis_edist.cauchy_seq_iff'

/-- A variation of the emetric characterization of Cauchy sequences that deals with
`ℝ≥0` upper bounds. -/
theorem cauchy_seq_iff_nnreal [nonempty β] [semilattice_sup β] {u : β → α} :
  cauchy_seq u ↔ ∀ ε : ℝ≥0, 0 < ε → ∃ N, ∀ n, N ≤ n → edist (u n) (u N) < ε :=
uniformity_basis_edist_nnreal.cauchy_seq_iff'

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

/-- An `emetric_space` is always a paracompact space. Formalization is based on [MR0236876]. -/
@[priority 100] -- See note [lower instance priority]
instance : paracompact_space α :=
begin
  classical,
  /- We start with trivial observations about `1 / 2 ^ k`. Here and below we use `1 / 2 ^ k` in
  the comments and `2⁻¹ ^ k` in the code. -/
  have pow_pos : ∀ k : ℕ, (0 : ℝ≥0∞) < 2⁻¹ ^ k,
    from λ k, ennreal.pow_pos (ennreal.inv_pos.2 ennreal.two_ne_top) _,
  have hpow_le : ∀ {m n : ℕ}, m ≤ n → (2⁻¹ : ℝ≥0∞) ^ n ≤ 2⁻¹ ^ m,
    from λ m n h, ennreal.pow_le_pow_of_le_one (ennreal.inv_le_one.2 ennreal.one_lt_two.le) h,
  have h2pow : ∀ n : ℕ, 2 * (2⁻¹ : ℝ≥0∞) ^ (n + 1) = 2⁻¹ ^ n,
    by { intro n, simp [pow_succ, ← mul_assoc, ennreal.mul_inv_cancel] },
  -- Consider an open covering `S : set (set α)`
  refine ⟨λ ι s ho hcov, _⟩,
  simp only [Union_eq_univ_iff] at hcov,
  -- choose a well founded order on `S`
  letI : linear_order ι := linear_order_of_STO' well_ordering_rel,
  have wf : well_founded ((<) : ι → ι → Prop) := @is_well_order.wf ι well_ordering_rel _,
  -- Let `ind x` be the minimal index `s : S` such that `x ∈ s`.
  set ind : α → ι := λ x, wf.min {i : ι | x ∈ s i} (hcov x),
  have mem_ind : ∀ x, x ∈ s (ind x), from λ x, wf.min_mem _ (hcov x),
  have nmem_of_lt_ind : ∀ {x i}, i < (ind x) → x ∉ s i,
    from λ x i hlt hxi, wf.not_lt_min _ (hcov x) hxi hlt,
  /- The refinement `D : ℕ → ι → set α` is defined recursively. For each `n` and `i`, `D n i`
  is the union of balls `ball x (1 / 2 ^ n)` over all points `x` such that

  * `ind x = i`;
  * `x` does not belong to any `D m j`, `m < n`;
  * `ball x (3 / 2 ^ n) ⊆ s i`;

  We define this sequence using `nat.strong_rec_on'`, then restate it as `Dn` and `memD`.
  -/
  set D : ℕ → ι → set α :=
    λ n, nat.strong_rec_on' n (λ n D' i,
      ⋃ (x : α) (hxs : ind x = i) (hb : ball x (3 * 2⁻¹ ^ n) ⊆ s i)
        (hlt : ∀ (m < n) (j : ι), x ∉ D' m ‹_› j), ball x (2⁻¹ ^ n)),
  have Dn : ∀ n i, D n i = ⋃ (x : α) (hxs : ind x = i) (hb : ball x (3 * 2⁻¹ ^ n) ⊆ s i)
    (hlt : ∀ (m < n) (j : ι), x ∉ D m j), ball x (2⁻¹ ^ n),
    from λ n s, by { simp only [D], rw nat.strong_rec_on_beta' },
  have memD : ∀ {n i y}, y ∈ D n i ↔ ∃ x (hi : ind x = i) (hb : ball x (3 * 2⁻¹ ^ n) ⊆ s i)
    (hlt : ∀ (m < n) (j : ι), x ∉ D m j), edist y x < 2⁻¹ ^ n,
  { intros n i y, rw [Dn n i], simp only [mem_Union, mem_ball] },
  -- The sets `D n i` cover the whole space. Indeed, for each `x` we can choose `n` such that
  -- `ball x (3 / 2 ^ n) ⊆ s (ind x)`, then either `x ∈ D n i`, or `x ∈ D m i` for some `m < n`.
  have Dcov : ∀ x, ∃ n i, x ∈ D n i,
  { intro x,
    obtain ⟨n, hn⟩ : ∃ n : ℕ, ball x (3 * 2⁻¹ ^ n) ⊆ s (ind x),
    { -- This proof takes 5 lines because we can't import `specific_limits` here
      rcases is_open_iff.1 (ho $ ind x) x (mem_ind x) with ⟨ε, ε0, hε⟩,
      have : 0 < ε / 3 := ennreal.div_pos_iff.2 ⟨ε0.lt.ne', ennreal.coe_ne_top⟩,
      rcases ennreal.exists_inv_two_pow_lt this.ne' with ⟨n, hn⟩,
      refine ⟨n, subset.trans (ball_subset_ball _) hε⟩,
      simpa only [div_eq_mul_inv, mul_comm] using (ennreal.mul_lt_of_lt_div hn).le },
    by_contra h, push_neg at h,
    apply h n (ind x),
    exact memD.2 ⟨x, rfl, hn, λ _ _ _, h _ _, mem_ball_self (pow_pos _)⟩ },
  -- Each `D n i` is a union of open balls, hence it is an open set
  have Dopen : ∀ n i, is_open (D n i),
  { intros n i,
    rw Dn,
    iterate 4 { refine is_open_Union (λ _, _) },
    exact is_open_ball },
  -- the covering `D n i` is a refinement of the original covering: `D n i ⊆ s i`
  have HDS : ∀ n i, D n i ⊆ s i,
  { intros n s x,
    rw memD,
    rintro ⟨y, rfl, hsub, -, hyx⟩,
    refine hsub (lt_of_lt_of_le hyx _),
    calc 2⁻¹ ^ n = 1 * 2⁻¹ ^ n : (one_mul _).symm
    ... ≤ 3 * 2⁻¹ ^ n : ennreal.mul_le_mul _ le_rfl,
    -- TODO: use `norm_num`
    have : ((1 : ℕ) : ℝ≥0∞) ≤ (3 : ℕ), from ennreal.coe_nat_le_coe_nat.2 (by norm_num1),
    exact_mod_cast this },
  -- Let us show the rest of the properties. Since the definition expects a family indexed
  -- by a single parameter, we use `ℕ × ι` as the domain.
  refine ⟨ℕ × ι, λ ni, D ni.1 ni.2, λ _, Dopen _ _, _, _, λ ni, ⟨ni.2, HDS _ _⟩⟩,
  -- The sets `D n i` cover the whole space as we proved earlier
  { refine Union_eq_univ_iff.2 (λ x, _),
    rcases Dcov x with ⟨n, i, h⟩,
    exact ⟨⟨n, i⟩, h⟩ },
  { /- Let us prove that the covering `D n i` is locally finite. Take a point `x` and choose
    `n`, `i` so that `x ∈ D n i`. Since `D n i` is an open set, we can choose `k` so that
    `B = ball x (1 / 2 ^ (n + k + 1)) ⊆ D n i`. -/
    intro x,
    rcases Dcov x with ⟨n, i, hn⟩,
    have : D n i ∈ 𝓝 x, from mem_nhds_sets (Dopen _ _) hn,
    rcases (nhds_basis_uniformity uniformity_basis_edist_inv_two_pow).mem_iff.1 this
      with ⟨k, -, hsub : ball x (2⁻¹ ^ k) ⊆ D n i⟩,
    set B := ball x (2⁻¹ ^ (n + k + 1)),
    refine ⟨B, ball_mem_nhds _ (pow_pos _), _⟩,
    -- The sets `D m i`, `m > n + k`, are disjoint with `B`
    have Hgt : ∀ (m ≥ n + k + 1) (i : ι), disjoint (D m i) B,
    { rintros m hm i y ⟨hym, hyx⟩,
      rcases memD.1 hym with ⟨z, rfl, hzi, H, hz⟩,
      have : z ∉ ball x (2⁻¹ ^ k), from λ hz, H n (by linarith) i (hsub hz), apply this,
      calc edist z x ≤ edist y z + edist y x : edist_triangle_left _ _ _
      ... < (2⁻¹ ^ m) + (2⁻¹ ^ (n + k + 1)) : ennreal.add_lt_add hz hyx
      ... ≤ (2⁻¹ ^ (k + 1)) + (2⁻¹ ^ (k + 1)) :
        add_le_add (hpow_le $ by linarith) (hpow_le $ by linarith)
      ... = (2⁻¹ ^ k) : by rw [← two_mul, h2pow] },
    -- For each `m ≤ n + k` there is at most one `j` such that `D m j ∩ B` is nonempty.
    have Hle : ∀ m ≤ n + k, set.subsingleton {j | (D m j ∩ B).nonempty},
    { rintros m hm j₁ ⟨y, hyD, hyB⟩ j₂ ⟨z, hzD, hzB⟩,
      by_contra h,
      wlog h : j₁ < j₂ := ne.lt_or_lt h using [j₁ j₂ y z, j₂ j₁ z y],
      rcases memD.1 hyD with ⟨y', rfl, hsuby, -, hdisty⟩,
      rcases memD.1 hzD with ⟨z', rfl, -, -, hdistz⟩,
      suffices : edist z' y' < 3 * 2⁻¹ ^ m, from nmem_of_lt_ind h (hsuby this),
      calc edist z' y' ≤ edist z' x + edist x y' : edist_triangle _ _ _
      ... ≤ (edist z z' + edist z x) + (edist y x + edist y y') :
        add_le_add (edist_triangle_left _ _ _) (edist_triangle_left _ _ _)
      ... < (2⁻¹ ^ m + 2⁻¹ ^ (n + k + 1)) + (2⁻¹ ^ (n + k + 1) + 2⁻¹ ^ m) :
        by apply_rules [ennreal.add_lt_add]
      ... = 2 * (2⁻¹ ^ m + 2⁻¹ ^ (n + k + 1)) : by simp only [two_mul, add_comm]
      ... ≤ 2 * (2⁻¹ ^ m + 2⁻¹ ^ (m + 1)) :
        ennreal.mul_le_mul le_rfl $ add_le_add le_rfl $ hpow_le (add_le_add hm le_rfl)
      ... = 3 * 2⁻¹ ^ m : by rw [mul_add, h2pow, bit1, add_mul, one_mul] },
    -- Finally, we glue `Hgt` and `Hle`
    have : (⋃ (m ≤ n + k) (i ∈ {i : ι | (D m i ∩ B).nonempty}), {(m, i)}).finite,
      from (finite_le_nat _).bUnion (λ i hi, (Hle i hi).finite.bUnion (λ _ _, finite_singleton _)),
    refine this.subset (λ I hI, _), simp only [mem_Union],
    refine ⟨I.1, _, I.2, hI, prod.mk.eta.symm⟩,
    exact not_lt.1 (λ hlt, Hgt I.1 hlt I.2 hI.some_spec) }
end

/-- For a set `s` in a pseudo emetric space, if for every `ε > 0` there exists a countable
set that is `ε`-dense in `s`, then there exists a countable subset `t ⊆ s` that is dense in `s`. -/
lemma subset_countable_closure_of_almost_dense_set (s : set α)
  (hs : ∀ ε > 0, ∃ t : set α, countable t ∧ s ⊆ ⋃ x ∈ t, closed_ball x ε) :
  ∃ t ⊆ s, (countable t ∧ s ⊆ closure t) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|⟨x₀, hx₀⟩,
  { exact ⟨∅, empty_subset _, countable_empty, empty_subset _⟩ },
  choose! T hTc hsT using (λ n : ℕ, hs n⁻¹ (by simp)),
  have : ∀ r x, ∃ y ∈ s, closed_ball x r ∩ s ⊆ closed_ball y (r * 2),
  { intros r x,
    rcases (closed_ball x r ∩ s).eq_empty_or_nonempty with he|⟨y, hxy, hys⟩,
    { refine ⟨x₀, hx₀, _⟩, rw he, exact empty_subset _ },
    { refine ⟨y, hys, λ z hz, _⟩,
      calc edist z y ≤ edist z x + edist y x : edist_triangle_right _ _ _
      ... ≤ r + r : add_le_add hz.1 hxy
      ... = r * 2 : (mul_two r).symm } },
  choose f hfs hf,
  refine ⟨⋃ n : ℕ, (f n⁻¹) '' (T n), Union_subset $ λ n, image_subset_iff.2 (λ z hz, hfs _ _),
    countable_Union $ λ n, (hTc n).image _, _⟩,
  refine λ x hx, mem_closure_iff.2 (λ ε ε0, _),
  rcases ennreal.exists_inv_nat_lt (ennreal.half_pos ε0).ne' with ⟨n, hn⟩,
  rcases mem_bUnion_iff.1 (hsT n hx) with ⟨y, hyn, hyx⟩,
  refine ⟨f n⁻¹ y, mem_Union.2 ⟨n, mem_image_of_mem _ hyn⟩, _⟩,
  calc edist x (f n⁻¹ y) ≤ n⁻¹ * 2 : hf _ _ ⟨hyx, hx⟩
                     ... < ε      : ennreal.mul_lt_of_lt_div hn
end

/-- A compact set in a pseudo emetric space is separable, i.e., it is a subset of the closure of a
countable set.  -/
lemma subset_countable_closure_of_compact {s : set α} (hs : is_compact s) :
  ∃ t ⊆ s, (countable t ∧ s ⊆ closure t) :=
begin
  refine subset_countable_closure_of_almost_dense_set s (λ ε hε, _),
  rcases totally_bounded_iff'.1 hs.totally_bounded ε hε with ⟨t, hts, htf, hst⟩,
  exact ⟨t, htf.countable,
    subset.trans hst (bUnion_subset_bUnion_right $ λ _ _, ball_subset_closed_ball)⟩
end

end compact

section first_countable

@[priority 100] -- see Note [lower instance priority]
instance (α : Type u) [pseudo_emetric_space α] :
  topological_space.first_countable_topology α :=
uniform_space.first_countable_topology uniformity_has_countable_basis

end first_countable

section second_countable
open topological_space

variables (α)

/-- A separable pseudoemetric 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 [separable_space α] :
  second_countable_topology α :=
uniform_space.second_countable_of_separable uniformity_has_countable_basis

/-- A sigma compact pseudo emetric space has second countable topology. This is not an instance
to avoid a loop with `sigma_compact_space_of_locally_compact_second_countable`.  -/
lemma second_countable_of_sigma_compact [sigma_compact_space α] :
  second_countable_topology α :=
begin
  suffices : separable_space α, by exactI second_countable_of_separable α,
  choose T hTsub hTc hsubT
    using λ n, subset_countable_closure_of_compact (is_compact_compact_covering α n),
  refine ⟨⟨⋃ n, T n, countable_Union hTc, λ x, _⟩⟩,
  rcases Union_eq_univ_iff.1 (Union_compact_covering α) x with ⟨n, hn⟩,
  exact closure_mono (subset_Union _ n) (hsubT _ hn)
end

variable {α}

lemma second_countable_of_almost_dense_set
  (hs : ∀ ε > 0, ∃ t : set α, countable t ∧ (⋃ x ∈ t, closed_ball x ε) = univ) :
  second_countable_topology α :=
begin
  suffices : separable_space α, by exactI second_countable_of_separable α,
  rcases subset_countable_closure_of_almost_dense_set (univ : set α) (λ ε ε0, _)
    with ⟨t, -, htc, ht⟩,
  { exact ⟨⟨t, htc, λ x, ht (mem_univ x)⟩⟩ },
  { rcases hs ε ε0 with ⟨t, htc, ht⟩,
    exact ⟨t, htc, univ_subset_iff.2 ht⟩ }
end

end second_countable

section diam

/-- The diameter of a set in a pseudoemetric space, named `emetric.diam` -/
def diam (s : set α) := ⨆ (x ∈ s) (y ∈ s), edist x y

lemma diam_le_iff {d : ℝ≥0∞} :
  diam s ≤ d ↔ ∀ (x ∈ s) (y ∈ s), edist x y ≤ d :=
by simp only [diam, supr_le_iff]

lemma diam_image_le_iff {d : ℝ≥0∞} {f : β → α} {s : set β} :
  diam (f '' s) ≤ d ↔ ∀ (x ∈ s) (y ∈ s), edist (f x) (f y) ≤ d :=
by simp only [diam_le_iff, ball_image_iff]

lemma edist_le_of_diam_le {d} (hx : x ∈ s) (hy : y ∈ s) (hd : diam s ≤ d) : edist x y ≤ d :=
diam_le_iff.1 hd x hx y hy

/-- 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 :=
edist_le_of_diam_le hx hy le_rfl

/-- If the distance between any two points in a set is bounded by some constant, this constant
bounds the diameter. -/
lemma diam_le {d : ℝ≥0∞} (h : ∀ (x ∈ s) (y ∈ s), edist x y ≤ d) : diam s ≤ d := diam_le_iff.2 h

/-- The diameter of a subsingleton vanishes. -/
lemma diam_subsingleton (hs : s.subsingleton) : diam s = 0 :=
nonpos_iff_eq_zero.1 $ diam_le $
λ x hx y hy, (hs hx hy).symm ▸ edist_self y ▸ le_rfl

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

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

lemma diam_insert : diam (insert x s) = max (⨆ y ∈ s, edist x y) (diam s) :=
eq_of_forall_ge_iff $ λ d, by simp only [diam_le_iff, ball_insert_iff,
  edist_self, edist_comm x, max_le_iff, supr_le_iff, zero_le, true_and,
  forall_and_distrib, and_self, ← and_assoc]

lemma diam_pair : diam ({x, y} : set α) = edist x y :=
by simp only [supr_singleton, diam_insert, diam_singleton, ennreal.max_zero_right]

lemma diam_triple :
  diam ({x, y, z} : set α) = max (max (edist x y) (edist x z)) (edist y z) :=
by simp only [diam_insert, supr_insert, supr_singleton, diam_singleton,
  ennreal.max_zero_right, ennreal.sup_eq_max]

/-- The diameter is monotonous with respect to inclusion -/
lemma diam_mono {s t : set α} (h : s ⊆ t) : diam s ≤ diam t :=
diam_le $ λ x hx y hy, edist_le_diam_of_mem (h hx) (h hy)

/-- 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 (λa ha b 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 : (add_assoc _ _ _).symm },
  { 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).nonempty) : diam (s ∪ t) ≤ diam s + diam t :=
let ⟨x, ⟨xs, xt⟩⟩ := h in by simpa using diam_union xs xt

lemma diam_closed_ball {r : ℝ≥0∞} : diam (closed_ball x r) ≤ 2 * r :=
diam_le $ λa ha b hb, calc
  edist a b ≤ edist a x + edist b x : edist_triangle_right _ _ _
  ... ≤ r + r : add_le_add ha hb
  ... = 2 * r : (two_mul r).symm

lemma diam_ball {r : ℝ≥0∞} : diam (ball x r) ≤ 2 * r :=
le_trans (diam_mono ball_subset_closed_ball) diam_closed_ball

end diam

end emetric --namespace

/-- We now define `emetric_space`, extending `pseudo_emetric_space`. -/

class emetric_space (α : Type u) extends pseudo_emetric_space α : Type u :=
(eq_of_edist_eq_zero : ∀ {x y : α}, edist x y = 0 → x = y)

variables {γ : Type w} [emetric_space γ]

@[priority 100] -- see Note [lower instance priority]
instance emetric_space.to_uniform_space' : uniform_space γ :=
pseudo_emetric_space.to_uniform_space

export emetric_space (eq_of_edist_eq_zero)

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

theorem edist_le_zero {x y : γ} : (edist x y ≤ 0) ↔ x = y :=
nonpos_iff_eq_zero.trans edist_eq_zero

@[simp] theorem edist_pos {x y : γ} : 0 < edist x y ↔ x ≠ y := by simp [← not_le]

/-- 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 bot_le h)

/-- A map between emetric spaces is a uniform embedding if and only if the edistance between `f x`
and `f y` is controlled in terms of the distance between `x` and `y` and conversely. -/
theorem uniform_embedding_iff' [emetric_space β] {f : γ → β} :
  uniform_embedding f ↔
  (∀ ε > 0, ∃ δ > 0, ∀ {a b : γ}, edist a b < δ → edist (f a) (f b) < ε) ∧
  (∀ δ > 0, ∃ ε > 0, ∀ {a b : γ}, edist (f a) (f b) < ε → edist a b < δ) :=
begin
  split,
  { assume h,
    exact ⟨emetric.uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1,
          (uniform_embedding_iff.1 h).2.2⟩ },
  { rintros ⟨h₁, h₂⟩,
    refine uniform_embedding_iff.2 ⟨_, emetric.uniform_continuous_iff.2 h₁, h₂⟩,
    assume x y hxy,
    have : edist x y ≤ 0,
    { refine le_of_forall_lt' (λδ δpos, _),
      rcases h₂ δ δpos with ⟨ε, εpos, hε⟩,
      have : edist (f x) (f y) < ε, by simpa [hxy],
      exact hε this },
    simpa using this }
end

/-- An emetric space is separated -/
@[priority 100] -- see Note [lower instance priority]
instance to_separated : separated_space γ :=
separated_def.2 $ λ x y h, eq_of_forall_edist_le $
λ ε ε0, le_of_lt (h _ (edist_mem_uniformity ε0))

/-- If a  `pseudo_emetric_space` is separated, then it is an `emetric_space`. -/
def emetric_of_t2_pseudo_emetric_space {α : Type*} [pseudo_emetric_space α]
  (h : separated_space α) : emetric_space α :=
{ eq_of_edist_eq_zero := λ x y hdist,
  begin
    refine separated_def.1 h x y (λ s hs, _),
    obtain ⟨ε, hε, H⟩ := mem_uniformity_edist.1 hs,
    exact H (show edist x y < ε, by rwa [hdist])
  end
  ..‹pseudo_emetric_space α› }

/-- 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. See Note [forgetful inheritance] explaining why having definitionally
the right uniformity is often important.
-/
def emetric_space.replace_uniformity {γ} [U : uniform_space γ] (m : emetric_space γ)
  (H : @uniformity _ U = @uniformity _ pseudo_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 (@pseudo_emetric_space.uniformity_edist γ _) }

  /-- The extended metric induced by an injective function taking values in a 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 {α : Type*} {p : α → Prop} [t : emetric_space α] : emetric_space (subtype p) :=
t.induced coe (λ x y, subtype.ext_iff_val.2)

/-- 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 (γ × β) :=
{ 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 := edist_le_zero.1 h₁,
    have B : x.snd = y.snd := edist_le_zero.1 h₂,
    exact prod.ext_iff.2 ⟨A, B⟩
  end,
  ..prod.pseudo_emetric_space_max }

/-- Reformulation of the uniform structure in terms of the extended distance -/
theorem uniformity_edist :
  𝓤 γ = ⨅ ε>0, 𝓟 {p:γ×γ | edist p.1 p.2 < ε} :=
pseudo_emetric_space.uniformity_edist

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) :=
{ 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, edist_le_zero.1 $ eq1 b $ mem_univ b),
  end,
  ..pseudo_emetric_space_pi }

end pi

namespace emetric

@[priority 100] -- see Note [lower instance priority]
instance normal_of_emetric : normal_space γ := normal_of_paracompact_t2

/-- A compact set in an emetric space is separable, i.e., it is the closure of a countable set. -/
lemma countable_closure_of_compact {s : set γ} (hs : is_compact s) :
  ∃ t ⊆ s, (countable t ∧ s = closure t) :=
begin
  rcases subset_countable_closure_of_compact hs with ⟨t, hts, htc, hsub⟩,
  exact ⟨t, hts, htc, subset.antisymm hsub (closure_minimal hts hs.is_closed)⟩
end

section diam

variables {s : set γ}

lemma diam_eq_zero_iff : diam s = 0 ↔ s.subsingleton :=
⟨λ h x hx y hy, edist_le_zero.1 $ h ▸ edist_le_diam_of_mem hx hy, diam_subsingleton⟩

lemma diam_pos_iff : 0 < diam s ↔ ∃ (x ∈ s) (y ∈ s), x ≠ y :=
begin
  have := not_congr (@diam_eq_zero_iff _ _ s),
  dunfold set.subsingleton at this,
  push_neg at this,
  simpa only [pos_iff_ne_zero, exists_prop] using this
end

end diam

end emetric


/- Implies Truth Table
    t   t   t
    t   f   f
    f   t   t
    f   f   t
-/

-- Reverse a list using recursion
def my_reverse {α : Type} : list α → list α
| list.nil := list.nil
| (list.cons h t) := list.append (my_reverse t) (list.cons h list.nil)

/- *** I. FORMAL LANGUAGES *** -/
inductive var : Type
| mkVar : ℕ → var

inductive unOp : Type
| square

inductive binOp : Type
| powOp

inductive pExp : Type
| litExp : ℕ → pExp
| varExp : var → pExp
| unOpExp : unOp → pExp → pExp
| binOpExp : binOp → pExp → pExp → pExp

open var
open pExp
open unOp
open binOp

def pZero := litExp nat.zero
def pSquare := unOpExp square
def pPow := binOpExp powOp

def count : pExp → nat
| (litExp b) := 0
| (varExp v) := 1
| (unOpExp op e) := count e
| (binOpExp op e1 e2) := (count e1 + count e2)

notation e1 ^ e2 :=  pPow e1 e2

def bSquare : ℕ → ℕ
| 0 := 1
| (n + 1) := 2 * bSquare n

def bPow : ℕ → ℕ → ℕ
| m 0        := 1
| m (n + 1)  := pow m n * m

def interpUnOp : unOp → (ℕ → ℕ)
| squareOp := bSquare

def interpBinOp : binOp → (ℕ → ℕ → ℕ)
| powOp := bPow

def pEval : pExp → (var → ℕ) → ℕ
| (litExp b) i := b
| (varExp v) i := i v
| (unOpExp op e) i :=
    (interpUnOp op) (pEval e i)
| (binOpExp op e1 e2) i :=
     (interpBinOp op)
        (pEval e1 i)
        (pEval e2 i)

def var1 := mkVar 1
def var2 := mkVar 2
def var5 := mkVar 5

def X : pExp:= varExp var1

/- *** II. PREDICATE LOGIC *** -/
-- ∀ and ∃ are called quantifiers
-- ∀ (p : Person), ∃ (q : Person), likes p q
-- forall people, there exists some person such that forall people they like that person
-- eventually: everyone likes someone
-- ∃ (q : Person), ∀ (p : Person), likes p q
-- there exists someone who all people like
-- someone is liked by everybody

/-
∃ (p : Person), ∀ (q : Person), ¬ likes q p
there exists someone that nobody likes
∃ (p : Person), ∀ (q : Person), ¬ likes p q
someone likes nobody
∀ (q : Person), ∃ (p : Person), ¬ likes q p
nobody likes everyone
everyone has someone they don't like
∀ (q : Person), ∃ (p : Person), ¬ likes p q
nobody is liked by everyone
everyone has someone that doesn't like them
¬ (∀ (q : Person), ∃ (p : Person), likes p q)
this is equivalent to:
∃ (q : Person), ∀ (p : Person), ¬ likes p q
in english, there exists someone that nobody likes.

∀ (q : Person), ¬ (∃ (p : Person), likes p q)
this is equivalent to:
∀ (q : Person), ∀ (p : Person), ¬ likes p q
in english, nobody likes anyone

Simpler negation example:
¬ (∀ p: Person, p has purple hair)
Wordy English: "It is not the case that everyone has purple hair"
i.e. We can disprove "everyone has purple hair" by finding someone
     that does not have purple hair
The above is equivalent to:
∃ p: Person, ¬ (p has purple hair)

∀ (p : Person), ∃ (q : Person), likes q p
everyone is liked by somebody

∀ (p : Person), ∃ (q : Person), ¬ likes p q →
∃ (p : Person), ∀ (q : Person), ¬ likes q p
if _, then _
if everyone has someone they don't like, then noone likes someone

¬ (∃ (x : ℕ ), ∀ (y : ℕ ), x>y)
there is not a largest natural number
-/

/- *** II. PROOFS *** -/
/-
    Tactic scripts use begin and end blocks and have several keyworks including
    1) assume - Whenever you have an implication in your goal,
    you can assume the premise and then all that's left is to
    prove the rest of the implication. Note that something like
    ¬P is considered an implication of type P -> false

    2) exact is the same thing as apply - only difference is
    that you can only use it to solve a goal (e.g. if you don't
    solve the goal with your exact statement, you should be
    using apply instead)

    3) intros is a shortcut for assume - it assumes everything
    in implications for you.

    4) apply applies a function to your goal. For example,
    if you are trying to prove A and B, you can apply and.intro
    and then you have to prove A and B next.
-/

--TOOLS: and.intro, and.elim_left, and.elim_right, eq.refl,
-- eq.trans, eq.symm, assume, exact, apply

example (a b : ℕ ):a = b →  b = a :=
begin
    assume aeqb,
    apply eq.symm aeqb,
end

def syllogism (P Q R : Prop): (P -> Q) -> (Q -> R) -> (P -> R) :=
begin
    intros pq qr pfP,
    apply qr,
    apply pq,
    exact pfP,
end

def and_elim_left (P Q : Prop): (P ∧ Q) -> P :=
begin
    assume pnq,
    apply and.elim_left pnq,
end

example : ∀ P Q R : Prop, (P → Q) → (P ∧ R) → (Q ∧ (1 = 1)) :=
begin
    assume (P Q R : Prop),
	intros pq,
    intros pr,
    apply and.intro _ _,
        exact pq (and.elim_left pr),
        exact eq.refl 1,
end
/- EXTRA CREDIT -/
def neg_intro (P : Prop): (P -> false) -> ¬ P :=
begin
    intro a,
    exact a,
end

variables p q : Prop

example (hpq : p → q) (hnq : ¬q) : ¬p :=
begin
    assume hp : p,
    show false, from hnq(hpq hp),
end

/-
  Negation, ¬p, is actually defined to be p → false,
  so we obtain ¬p by deriving a contradiction from p.
  Similarly, the expression hnp hp produces a proof of
  false from hp : p and hnp : ¬p. The next example uses
  both these rules to produce a proof of (p → q) → ¬q → ¬p.
  (The symbol ¬ is produced by typing \not or \neg.)
-/

theorem and_swap : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from and.intro (and.right h) (and.left h))
  (assume h : q ∧ p,
    show p ∧ q, from and.intro (and.right h) (and.left h))

def false_elim (P : Prop): false -> P :=
begin
    assume p,
    exact false.elim p,
end

def and_intro (P Q : Prop) : P -> Q -> (P ∧ Q) :=
begin
    intros p q,
    exact and.intro p q,
end

def and_elim_left' (P Q : Prop): (P ∧ Q) -> P :=
begin
    intros pq,
    exact and.elim_left pq,
end

def and_elim_right' (P Q : Prop) : (P ∧ Q) -> Q :=
begin
    intros qp,
    exact and.elim_right qp,
end

def or_intro_left (P Q : Prop): P -> (P ∨ Q) :=
begin
    intros p,
    exact or.intro_left Q p,
    -- shorthand is exact or.inl p
end

def or_intro_right (P Q : Prop): Q -> (P ∨ Q) :=
begin
    intros q,
    exact or.inr q,
end

def or_elim (P Q R : Prop) : (P ∨ Q) -> (P -> R) -> (Q -> R) -> R :=
begin
    assume porq pimpr qimpr,
    cases porq with pfP pfQ,
    exact pimpr pfP,
    exact qimpr pfQ,

end

def arrow_elim (P Q : Prop): (P -> Q) -> P -> Q :=
begin
    intros pinpq p,
    exact pinpq p,
end

def neg_intro' (P : Prop): (P -> false) -> ¬ P :=
begin
    intros,
    exact a,
end

example : 2+3 = 5 ∧ 3+7 = 10 → 2+5 = 7 :=
begin
intros premise,
apply eq.refl 7,
end

example : 0 = 1 → 3 = 1000 :=
begin
assume zeroeqone,
have zeroneqone : 0 ≠ 1 := dec_trivial,
contradiction,
end


structure Foo.A where
  x : Nat

structure Boo.A extends Foo.A where
  y : Nat

structure B extends Boo.A where
  z : Nat

def f1 (x y z : Nat) : B :=
  { x, y, z }

theorem ex1 (x y z : Nat) : f1 x y z = ⟨⟨⟨x⟩, y⟩, z⟩ :=
  rfl

theorem ex2 (x y z : Nat) : f1 x y z = B.mk (Boo.A.mk (Foo.A.mk x) y) z :=
  rfl

#check { x := 0, y := 1, z := 2 : B }

structure Foo.C where
  x : Nat
  y : Nat

structure Boo.C where
  x : Nat
  z : Nat

structure D extends Foo.C, Boo.C

def f2 (x y z : Nat) : D :=
  { x, y, z }

theorem ex3 (x y z : Nat) : f2 x y z = D.mk ⟨x, y⟩ z :=
  rfl

#check { x := 0, y := 1, z := 2 : D }

#print D.toC_1


import algebra.group.basic
import tactic
import group_theory.subgroup.basic
import data.set.basic
import data.set_like.basic
import chapter2.sheet1_subgroup_defs_and_exs

-- These next few sheets are going to be based off of Zipperer ms thesis. I want a clean definition for the centralizer and normalizer that is general

--start with defining what is needed for the type A to only be a set with the multiplication operation.

variables (A:Type) (B:Type) [has_mul A] [has_mul B]

definition lcoset [has_mul A] (a:A) (S: set A) : set A := (λ (x : A), a*x) '' S --the '' is very neat notation that I found in the mathlib documentation!

definition rcoset [has_mul A] (S: set A) (a:A) : set A := (λ (x:A), x*a) '' S --can I think of '' as a map function?

--notation a ` ** ` N := lcoset (A:Type) (a:A) (N:set A)  --can't seem to get this to work

lemma mul_mem_lcoset {S : set A} {x : A} (a : A) (xS : x ∈ S) : (a*x ∈ (lcoset (A) (a) (S))) :=
begin
exact set.mem_image_of_mem (λ (x:A), a*x) xS, --ooh that is cool! I understand what is happening here.
end

lemma mul_mem_rcoset {S: set A} {x:A} (a:A) (xS : x ∈ S) : (x*a ∈ (rcoset (A) (S) (a))) :=
begin
exact set.mem_image_of_mem (λ (x:A), x*a) xS,
end

-- the following proofs allow for the idea of two left cosets being equivalent to be expressed

definition lcoset_equiv (S: set A) (a b : A) : Prop := ((lcoset (A) (a) (S)) = (lcoset (A) (b) (S)))

lemma equivalence_lcoset_reflexive (S : set A) : reflexive (lcoset_equiv (A) (S) ) :=
begin
unfold reflexive, intro x, unfold lcoset_equiv,
end

lemma equivalence_lcoset_symmetric (S : set A): symmetric (lcoset_equiv (A) (S) ) :=
begin
unfold symmetric, intros x y hxy, unfold lcoset_equiv at hxy, unfold lcoset_equiv,
rw hxy,
end

lemma equivalence_lcoset_transitive (S: set A) : transitive (lcoset_equiv (A) (S)) :=
begin
unfold transitive, intros x y z hxy hyz, unfold lcoset_equiv at hxy hyz ⊢, rw hxy, rw hyz,
end

lemma equivalence_lcoset_equiv (S : set A) : equivalence (lcoset_equiv (A) (S)) := --currying lcoset_equiv here so it has the type needed for an equivalence relation
mk_equivalence (lcoset_equiv (A) (S)) (equivalence_lcoset_reflexive (A) (S : set A)) (equivalence_lcoset_symmetric (A) (S : set A)) (equivalence_lcoset_transitive (A) (S: set A))

--end of lcoset_equivalence proof.

lemma lcoset_subset_lcoset {S T : set A} (a : A) (h : T ⊆ S) : (lcoset (A) (a) (T) ⊆ lcoset (A) (a) (S)) :=
set.image_subset (λ(x:A), a*x) h

lemma rcoset_subset_rcoset {S T : set A} (a: A) (h: T⊆S) : (rcoset (A) (T) (a) ⊆ rcoset (A) (S) (a)) :=
set.image_subset (λ(x:A), x*a) h

--I'm a bit confused with the defnition of a homormorphism in lean. It seems to only accept monoids and groups? Although it appears to work on magamas in the context of category theory?? So following Buzzard I define a homomorphism over sets here.
@[ext] structure magma_hom (A B: Type) [has_mul A] [has_mul B] :=
(to_fun : A → B)
(map_mul' (a b : A) : to_fun (a * b) =  to_fun a * to_fun b)

notation A ` →** ` B := magma_hom A B

instance : has_coe_to_fun (A →** B) (λ _, A → B) :=
{coe := magma_hom.to_fun}
--end of "magma" homomorphism definition

lemma image_of_lcoset_is_hom {B:Type} [has_mul B] {f : A →** B} {S:set A} {a:A} : (f '' (lcoset (A) (a) (S)) = lcoset (B) (f a) ( f '' S)) :=
begin
unfold lcoset,
ext y,
dsimp, split,
{intro hy,
simp at hy,
simp,
cases hy with b hb_1,
cases hb_1 with hb_1 hb_2,
use b,
split,
exact hb_1,
rw ← hb_2,
exact (f.map_mul' a b).symm,},
intro hz,
simp at hz,
simp,
cases hz with b hb_1,
cases hb_1 with hb_1 hb_2,
use b,
split,
exact hb_1,
rw ← hb_2,
exact f.map_mul' a b,
end --Actually a really satisfying proof. I was able to simplify zipper's proof here! Very cool.

lemma image_of_rcoset_is_hom {B:Type} [has_mul B] {f : A →** B} {S:set A} {a:A} : (f '' (rcoset (A) (S) (a)) = rcoset (B) ( f '' S) (f a)) :=
begin
unfold rcoset,
ext y,
split,
intro hy,
simp at hy,
simp,
cases hy with b hb_1,
cases hb_1 with hb_1 hb_2,
use b,
split,
exact hb_1,
rw ← hb_2,
exact (f.map_mul' b a).symm,
intro hy2,
simp at hy2,
simp,
cases hy2 with b hb_1,
cases hb_1 with hb_1 hb_2,
use b,
split,
exact hb_1,
rw ← hb_2,
exact f.map_mul' b a,
end


theorem succ_eq_add_one (n : mynat) : succ n = n + 1 :=
begin
rw one_eq_succ_zero, rw add_succ, rw add_zero, refl,
end


import topology.metric_space.basic
open set metric metric_space

/- 7-7: continuous maps on compact metric spaces are uniformly continuous -/
theorem uniformly_continuous_of_continuous_of_compact
  {M N : Type} {S : set M} [metric_space M] [metric_space N]
  (f : M → N) (hS : is_compact S) (hf : continuous f) :
  uniform_continuous_on f S :=
begin
  rw uniform_continuous_on_iff,
  intros ε εpos,

  -- Construct a cover U of S consisting of preimages of all (ε/2)-balls in N
  let U : N → set M := λ q, f ⁻¹' (ball q (ε/2)),
  have Uopen : ∀ q, is_open (U q),
  { intro q,
    rw continuous_def at hf,
    exact hf (ball q (ε/2)) is_open_ball },
  have Ucover : S ⊆ ⋃ i, U i,
  { intros s hs,
    rw mem_Union,
    use f s,
    rw mem_preimage,
    exact mem_ball_self (by linarith)},

  -- U has a Lebesgue number δ by compactness of S
  have lebesgue_num := lebesgue_number_lemma_of_metric hS Uopen Ucover,
  rcases lebesgue_num with ⟨δ, δpos, hδ⟩,
  -- This δ is our desired one to prove uniform continuity
  use [δ, δpos],
  intros a b ha hb hab,
  -- Show that `a` and `b` lie in some `U i`
  have h_aball_U := hδ a ha,
  cases h_aball_U with i h_Ui,
  dsimp at h_Ui,
  have h_a_Ui : a ∈ U i := h_Ui (mem_ball_self δpos),
  have h_b_Ui : b ∈ U i,
    rw [←mem_ball, mem_ball_comm] at hab,
    exact h_Ui hab,
  -- Thus `f a` and `f b` lie in the same `ε/2`-ball,
  rw [mem_preimage, mem_ball] at h_a_Ui h_b_Ui,
  -- meaning `dist (f a) (f b) < ε` as desired.
  calc dist (f a) (f b) ≤ dist (f a) i + dist i (f b) : dist_triangle _ _ _
  ... = dist (f a) i + dist (f b) i : by rw dist_comm i (f b)
  ... < ε/2 + ε/2 : by linarith
  ... = ε : by ring,
end

/- 7-8: retracts of Hausdorff spaces are closed -/
variables {X : Type} [topological_space X] [t2_space X]

def is_retract' (S : set X) (f : X → X) : Prop :=
  continuous f ∧ range f ⊆ S ∧ ∀ (x : X), x ∈ S → f x = x

def is_retract (S : set X) : Prop := ∃ (f : X → X), is_retract' S f

theorem is_closed_of_hausdorff_retract {S : set X} (h : is_retract S) :
  is_closed S :=
begin
  obtain ⟨f, hf⟩ := h,
  unfold is_retract' at hf,
  rcases hf with ⟨hf1, hf2, hf3⟩,

  rw is_closed_iff_nhds,
  -- Massaging it into a nice form
  by_contra h', rw not_forall at h', obtain ⟨x, hx⟩ := h', rw not_imp at hx,
  rcases hx with ⟨hx1, hx2⟩,

  have h1 : x ≠ f x,
  { by_contra h,
    have contra : f x ∈ S := hf2 (exists.intro x rfl),
    rw ←h at contra,
    exact hx2 contra },

  obtain ⟨u, v, ⟨hu, hv, ⟨hxu, hfxv, huv⟩⟩⟩ := t2_space.t2 x (f x) h1,
  have := mem_nhds_iff.mpr (exists.intro u
    (exists.intro (subset.refl _) ⟨hu, hxu⟩)),
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.associated
import Mathlib.data.fintype.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Some facts about finite rings
-/

theorem card_units_lt (R : Type u_1) [semiring R] [nontrivial R] [fintype R] : fintype.card (units R) < fintype.card R :=
  card_lt_card_of_injective_of_not_mem coe units.ext not_is_unit_zero


-- https://leanprover.github.io/functional_programming_in_lean/getting-to-know/polymorphism.html

-- 1. Write a function to find the last entry in a list. It should return an Option.

---- Version 1 (method)

def List.llast? {α : Type} (xs : List α) : Option α :=
  match xs with
  | [] => Option.none
  | y :: aa => if length aa == 0 then Option.some y else aa.llast?

#eval ['a', 'b', 'c'].llast?

---- Version 2 (function)

def llast? {α : Type} (xs : List α) : Option α :=
  match xs with
  | [] => Option.none
  | y :: aa => if aa.length == 0 then Option.some y else llast? aa

#eval llast? ['a', 'b', 'c']

-- 2. Write a function that finds the first entry in a list that satisfies a given predicate. Start the definition with def List.findFirst? {α : Type} (xs : List α) (predicate : α → Bool) : Option α :=

---- Version 1 (method)

def List.findFirst? {α : Type} (xs : List α) (predicate : α → Bool) : Option α :=
  match xs with
  | [] => Option.none
  | y :: _ => if predicate y then Option.some y else Option.none

#eval ['a', 'b', 'c'].findFirst? λ x => x == 'a' -- some 'a'
#eval ['a', 'b', 'c'].findFirst? λ x => x == 'w' -- none

---- Version 2 (function)

def findFirst? {α : Type} (xs : List α) (predicate : α → Bool) : Option α :=
  match xs with
  | [] => Option.none
  | y :: _ => if predicate y then Option.some y else Option.none

#eval findFirst? ['a', 'b', 'c'] λ x => x == 'a' -- some 'a'
#eval findFirst? ['a', 'b', 'c'] λ x => x == 'w' -- none

-- 3. Write a function Prod.swap that swaps the two fields in a pair. Start the definition with def Prod.swap {α β : Type} (pair : α × β) : β × α :=

def Prod.swap {α β : Type} (pair : α × β) : β × α :=
  (pair.snd, pair.fst)

#eval (3, 'a').swap //=> ('a', 3)

-- 4. Rewrite the PetName example to use a custom datatype and compare it to the version that uses Sum.

-- Sum example from the book
def PetName : Type := String ⊕ String
def animals : List PetName :=
  [Sum.inl "Spot", Sum.inr "Tiger", Sum.inl "Fifi", Sum.inl "Rex", Sum.inr "Floof"]

-- Same example, but with a custom data type
inductive OurPetName : Type where
  | cat : String → OurPetName
  | dog : String → OurPetName

def ourAnimnals : List OurPetName :=
  [OurPetName.dog "Spot", OurPetName.cat "Toger", OurPetName.dog "Fifi", OurPetName.dog "Rex", OurPetName.cat "Floof"]

-- 5. Write a function zip that combines two lists into a list of pairs. The resulting list should be as long as the shortest input list.

-- Full solution
def zip {α β : Type} (xs : List α) (ys : List β) : List (α × β) :=
  match xs, ys with
  | List.nil, List.nil => List.nil
  | List.nil, List.cons n ns => List.nil
  | List.cons m ms, List.nil => List.nil
  | List.cons m ms, List.cons n ns => List.cons (m, n) (zip ms ns)

-- Full solution, with "Automatic Implicit Arguments" syntax sugar (see https://leanprover.github.io/functional_programming_in_lean/getting-to-know/conveniences.html)
def zip (xs : List α) (ys : List β) : List (α × β) :=
  match xs, ys with
  | List.nil, List.nil => List.nil
  | List.nil, List.cons n ns => List.nil
  | List.cons m ms, List.nil => List.nil
  | List.cons m ms, List.cons n ns => List.cons (m, n) (zip ms ns)

-- Full solution, with "Pattern-Matching Definitions" syntax sugar (see https://leanprover.github.io/functional_programming_in_lean/getting-to-know/conveniences.html)
def zip : List α → List β → List (α × β)
  | List.nil, List.nil => List.nil
  | List.nil, List.cons n ns => List.nil
  | List.cons m ms, List.nil => List.nil
  | List.cons m ms, List.cons n ns => List.cons (m, n) (zip ms ns)

#eval zip [1, 2, 3] ['a', 'b', 'c'] --=> [(1, 'a'), (2, 'b'), (3, 'c')]
#eval zip [1, 2, 3] ['a', 'b'] --=> [(1, 'a'), (2, 'b')]

-- 6. Write a polymorphic function take that returns the first n entries in a list, where n is a Nat. If the list contains fewer than n entries, then the resulting list should be the input list. #eval take 3 ["bolete", "oyster"] should yield ["bolete", "oyster"], and #eval take 1 ["bolete", "oyster"] should yield ["bolete"].

def take {α : Type} (n : Nat) (xs : List α) : List α :=
  match n, xs with
  | Nat.zero, List.nil => List.nil
  | Nat.succ a, List.nil => List.nil
  | Nat.zero, List.cons m ms => List.nil
  | Nat.succ a, List.cons m ms => List.cons m (take a ms)

#eval take 3 ["bolete", "oyster"]
#eval take 1 ["bolete", "oyster"]