import .circuit

noncomputable theory
open_locale classical
open_locale big_operators

/-
  Flats and closure.

  TODO : Flats are a `modular_lattice`
-/

variables {E : Type*} [finite E] {M M₁ M₂ : matroid E}
  {I I₁ I₂ B₁ B₂ J B C X Y Z F F₀ F₁ F₂ H H₁ H₂ : set E} {e f x y z : E}

open set

namespace matroid

lemma flat_def :
  M.flat F ↔ ∀ I X, M.basis I F → M.basis I X → X ⊆ F  :=
iff.rfl

lemma flat.r_insert_of_not_mem (hF : M.flat F) (he : e ∉ F) :
  M.r (insert e F) = M.r F + 1 :=
begin
  suffices h' : M.r F < M.r (insert e F),
  { rw (nat.lt_iff_add_one_le.mp h').antisymm (M.r_insert_le_add_one F e)},
  obtain ⟨I,hI⟩ := M.exists_basis F,
  have hnb : ¬ M.basis I (insert e F),
    from λ hI', he (hF I (insert e F) hI hI' (mem_insert e F)),
  by_contra' h_le,
  exact hnb (hI.indep.basis_of_subset_of_r_le (hI.subset.trans (subset_insert _ _))
    (h_le.trans_eq hI.r.symm)),
end

lemma flat_iff_r_lt_r_insert :
  M.flat F ↔ ∀ e ∉ F, M.r F < M.r (insert e F) :=
begin
  refine ⟨λ hF e heF, nat.lt_iff_add_one_le.mpr (hF.r_insert_of_not_mem heF).symm.le,
    λ h, flat_def.mpr (λ I X hIF hIX, _)⟩,
  by_contra' hXF,
  obtain ⟨e,heX,heF⟩ := not_subset.mp hXF,
  apply (h e heF).ne,
  rw [←hIF.r_eq_r_insert, hIX.r_eq_r_insert, insert_eq_of_mem heX, ←hIF.r, ←hIX.r],
end

lemma flat.not_mem_iff_r_insert (hF : M.flat F) :
  e ∉ F ↔ M.r (insert e F) = M.r F + 1 :=
begin
  refine ⟨hF.r_insert_of_not_mem, λ h he, _⟩,
  rw [insert_eq_of_mem he, self_eq_add_right] at h,
  simpa only using h,
end

lemma flat.Inter {ι : Type*} (F : ι → set E) (hF : ∀ i, M.flat (F i)) :
  M.flat (⋂ i, F i) :=
begin
  simp_rw [flat_iff_r_lt_r_insert],
  by_contra' h,
  obtain ⟨e, he, hre⟩ := h,
  rw [mem_Inter, not_forall] at he,
  obtain ⟨j, hj⟩ := he,
  have hj' := (hF j).r_insert_of_not_mem hj,
  rw r_insert_eq_of_r_insert_subset_le (Inter_subset F j) hre at hj',
  simpa using hj',
end

lemma flat.inter (hF₁ : M.flat F₁) (hF₂ : M.flat F₂) :
  M.flat (F₁ ∩ F₂) :=
begin
  rw inter_eq_Inter,
  refine flat.Inter _ (λ i, _),
  cases i; assumption,
end

lemma univ_flat (M : matroid E) :
  M.flat univ :=
flat_iff_r_lt_r_insert.mpr (λ e he, (he (mem_univ e)).elim)

lemma exists_flat_not_mem_of_r_insert_ne (M : matroid E) (h : M.r (insert e X) ≠ M.r X):
  ∃ F, M.flat F ∧ X ⊆ F ∧ e ∉ F :=
begin
  have hr := r_insert_eq_add_one_of_r_ne h,
  have heX : e ∉ X,
  { intro heX, rw [insert_eq_of_mem heX] at h, exact h rfl},
  obtain ⟨F, ⟨hXF, hF⟩, hF'⟩ :=
    finite.exists_maximal (λ F, X ⊆ F ∧ M.r F ≤ M.r X) ⟨X, rfl.subset, rfl.le⟩,
  dsimp only at hF',
  have heF : e ∉ F,
  { intro heF,
    simpa only [add_le_iff_nonpos_right, le_zero_iff, hr, ←(hF.antisymm (M.r_mono hXF))] using
      M.r_mono (insert_subset.mpr ⟨heF, hXF⟩)},
  refine ⟨F, flat_iff_r_lt_r_insert.mpr (λ f hfF, _), hXF, heF⟩,
  by_contra' hle,
  rw hF' (insert f F) ⟨hXF.trans (subset_insert _ _), hle.trans hF⟩ (subset_insert _ _) at hfF,
  simpa only [mem_insert_iff, eq_self_iff_true, true_or, not_true] using hfF,
end

lemma cl_def (M : matroid E) : M.cl X = ⋂₀ {F | M.flat F ∧ X ⊆ F} := rfl

lemma mem_cl_iff_forall_mem_flat :
  e ∈ M.cl X ↔ ∀ F, M.flat F → X ⊆ F → e ∈ F :=
by simp_rw [cl_def, mem_sInter, mem_set_of_eq, and_imp]

lemma flat_of_cl (M : matroid E) (X : set E) :
  M.flat (M.cl X) :=
begin
  rw [cl_def, sInter_eq_Inter],
  refine flat.Inter _ _,
  rintro ⟨F,hF⟩,
  exact hF.1,
end

lemma subset_cl (M : matroid E) (X : set E) :
  X ⊆ M.cl X :=
by simp only [cl_def, subset_sInter_iff, mem_set_of_eq, and_imp, imp_self, implies_true_iff]

lemma mem_cl :
  e ∈ M.cl X ↔ M.r (insert e X) = M.r X :=
begin
  have hF := M.flat_of_cl X,
  rw flat_iff_r_lt_r_insert at hF,
  refine ⟨λ hecl, by_contra (λ hne, _),λ h, by_contra (λ heX, (hF e heX).ne _)⟩,
  { have hlem : ∃ F, M.flat F ∧ X ⊆ F ∧ e ∉ F,
    { have hr := r_insert_eq_add_one_of_r_ne hne,
      have heX : e ∉ X,
      { intro heX, rw [insert_eq_of_mem heX] at hne, exact hne rfl},
      obtain ⟨F, ⟨hXF, hF⟩, hF'⟩ :=
        finite.exists_maximal (λ F, X ⊆ F ∧ M.r F ≤ M.r X) ⟨X, rfl.subset, rfl.le⟩,
      dsimp only at hF',
      have heF : e ∉ F,
      { intro heF,
        simpa only [add_le_iff_nonpos_right, le_zero_iff, hr, ←(hF.antisymm (M.r_mono hXF))] using
          M.r_mono (insert_subset.mpr ⟨heF, hXF⟩)},
      refine ⟨F, flat_iff_r_lt_r_insert.mpr (λ f hfF, _), hXF, heF⟩,
      by_contra' hle,
      rw hF' (insert f F) ⟨hXF.trans (subset_insert _ _), hle.trans hF⟩ (subset_insert _ _) at hfF,
      simpa only [mem_insert_iff, eq_self_iff_true, true_or, not_true] using hfF},
    obtain ⟨F, hF, hXf, heF⟩ := hlem,
    rw mem_cl_iff_forall_mem_flat at hecl,
    exact heF (hecl _ hF hXf)},
  rw r_insert_eq_of_r_insert_subset_le (M.subset_cl X) h.le,
end

lemma not_mem_cl :
  e ∉ M.cl X ↔ M.r (insert e X) = M.r X + 1 :=
begin
  rw [mem_cl, ←ne.def],
  refine ⟨r_insert_eq_add_one_of_r_ne, λ h,
    by simp only [h, ne.def, nat.succ_ne_self, not_false_iff]⟩,
end

@[simp] lemma r_cl (M : matroid E) (X : set E) :
  M.r (M.cl X) = M.r X :=
(r_eq_of_r_all_insert_eq (M.subset_cl X) (λ e h, (mem_cl.mp h).symm)).symm

@[simp] lemma cl_cl (M : matroid E) (X : set E) :
  M.cl (M.cl X) = M.cl X :=
begin
  ext x,
  simp_rw [mem_cl, r_cl],
  refine ⟨λ h, (M.r_mono (subset_insert _ _)).antisymm' _, λ h, _⟩,
  { rw ←h,
    exact M.r_mono (insert_subset_insert (M.subset_cl _))},
  convert (@r_union_eq_of_subset_of_r_eq _ _ M _ _ (M.cl X) (subset_insert x X) h.symm).symm
    using 1,
  { rw [insert_union, union_eq_right_iff_subset.mpr (M.subset_cl X)]},
  rw [union_eq_right_iff_subset.mpr (M.subset_cl X), r_cl],
end

lemma cl_subset_cl_of_subset (M : matroid E) (h : X ⊆ Y) :
  M.cl X ⊆ M.cl Y :=
sInter_subset_sInter (λ F hF, ⟨hF.1, h.trans hF.2⟩)

lemma cl_mono (M : matroid E) : monotone M.cl :=
  λ _ _, M.cl_subset_cl_of_subset

lemma cl_subset_cl_of_subset_cl (hXY : X ⊆ M.cl Y) :
  M.cl X ⊆ M.cl Y :=
by simpa only [cl_cl] using M.cl_subset_cl_of_subset hXY

lemma cl_subset_cl_iff_subset_cl :
  M.cl X ⊆ M.cl Y ↔ X ⊆ M.cl Y :=
⟨λ h, (M.subset_cl _).trans h, cl_subset_cl_of_subset_cl⟩

lemma subset_cl_of_subset (M : matroid E) (hXY : X ⊆ Y) :
  X ⊆ M.cl Y :=
hXY.trans (M.subset_cl Y)

lemma mem_cl_of_mem (M : matroid E) (h : e ∈ X) :
  e ∈ M.cl X :=
(M.subset_cl X) h

lemma r_insert_eq_add_one_of_not_mem_cl (h : e ∉ M.cl X) :
  M.r (insert e X) = M.r X + 1 :=
r_insert_eq_add_one_of_r_ne (h ∘ mem_cl.mpr)

lemma not_mem_cl_of_r_insert_gt (h : M.r X < M.r (insert e X)) :
  e ∉ M.cl X :=
h.ne.symm ∘ mem_cl.mp

lemma mem_cl_of_r_insert_le (h : M.r (insert e X) ≤ M.r X) :
  e ∈ M.cl X :=
mem_cl.mpr (h.antisymm (M.r_le_r_insert X e))

lemma not_mem_cl_iff_r_insert_eq_add_one  :
  e ∉ M.cl X ↔ M.r (insert e X) = M.r X + 1 :=
⟨r_insert_eq_add_one_of_not_mem_cl, λ h, not_mem_cl_of_r_insert_gt (by {rw h, apply lt_add_one})⟩

lemma cl_insert_eq_of_mem_cl (he : e ∈ M.cl X) :
  M.cl (insert e X) = M.cl X :=
begin
  refine (M.cl_mono (subset_insert _ _)).antisymm' _,
  rw [←M.cl_cl X],
  exact M.cl_subset_cl_of_subset (insert_subset.mpr ⟨he, M.subset_cl _⟩),
end

lemma mem_cl_insert (he : e ∉ M.cl X) (hef : e ∈ M.cl (insert f X)) :
  f ∈ M.cl (insert e X) :=
begin
  by_contra hf,
  rw not_mem_cl_iff_r_insert_eq_add_one at he hf,
  rw [mem_cl, insert_comm, hf, he] at hef,
  have h := M.r_insert_le_add_one X f,
  rw ←hef at h,
  exact (lt_add_one _).not_le h,
end

@[simp] lemma cl_union_cl_right_eq_cl_union (M : matroid E) (X Y : set E) :
  M.cl (X ∪ M.cl Y) = M.cl (X ∪ Y) :=
begin
  refine ((M.cl_mono (union_subset_union_right X (M.subset_cl _)))).antisymm' _,
  rw [←M.cl_cl (X ∪ Y)],
  exact M.cl_mono (union_subset ((subset_union_left _ _).trans (M.subset_cl _))
    (M.cl_mono (subset_union_right _ _))),
end

@[simp] lemma cl_union_cl_left_eq_cl_union (M : matroid E) (X Y : set E) :
  M.cl (M.cl X ∪ Y) = M.cl (X ∪ Y) :=
by rw [union_comm, cl_union_cl_right_eq_cl_union, union_comm]

@[simp] lemma cl_cl_union_cl_eq_cl_union (M : matroid E) (X Y : set E) :
  M.cl (M.cl X ∪ M.cl Y) = M.cl (X ∪ Y) :=
by rw [cl_union_cl_left_eq_cl_union, cl_union_cl_right_eq_cl_union]

@[simp] lemma cl_insert_cl_eq_cl_insert (M : matroid E) (e : E) (X : set E) :
  M.cl (insert e (M.cl X)) = M.cl (insert e X) :=
by simp_rw [←singleton_union, cl_union_cl_right_eq_cl_union]

lemma cl_exchange (he : e ∈ M.cl (insert f X) \ M.cl X ) :
  f ∈ M.cl (insert e X) \ M.cl X :=
begin
  refine ⟨mem_cl_insert he.2 he.1, λ hf, _ ⟩,
  rw [cl_insert_eq_of_mem_cl hf, diff_self] at he,
  exact not_mem_empty _ he,
end

lemma cl_diff_singleton_eq_cl (h : e ∈ M.cl (X \ {e})) :
  M.cl (X \ {e}) = M.cl X :=
begin
  refine (M.cl_mono (diff_subset _ _)).antisymm _,
  have h' := M.cl_mono (insert_subset.mpr ⟨h, (M.subset_cl _ )⟩),
  rw [insert_diff_singleton, cl_cl] at h',
  exact (M.cl_mono (subset_insert _ _)).trans h',
end

lemma mem_cl_diff_singleton_iff_cl (he : e ∈ X) :
  e ∈ M.cl (X \ {e}) ↔ M.cl (X \ {e}) = M.cl X :=
⟨cl_diff_singleton_eq_cl, λ h, by {rw h, exact subset_cl _ _ he}⟩

lemma circuit.subset_cl_diff_singleton (hC : M.circuit C) (e : E) :
  C ⊆ M.cl (C \ {e}) :=
begin
  nth_rewrite 0 [←inter_union_diff C {e}],
  refine union_subset  _ (M.subset_cl _),
  obtain he | he := em (e ∈ C),
  { refine (inter_subset_right _ _).trans (singleton_subset_iff.mpr _),
    rw [mem_cl, insert_diff_singleton, insert_eq_of_mem he, hC.r,
      (hC.diff_singleton_indep he).r, ncard_diff_singleton_of_mem he]},
  convert empty_subset _,
  rwa inter_singleton_eq_empty,
end

lemma indep_iff_cl_diff_ne_forall :
  M.indep I ↔ ∀ x ∈ I, M.cl (I \ {x}) ≠ M.cl I :=
begin
  refine ⟨λ h x hxI h_eq, _, λ h, _⟩,
  { have h' : x ∈ M.cl (I \ {x}),
    { rw [h_eq], exact M.subset_cl _ hxI},
    rw [mem_cl, insert_diff_singleton, insert_eq_of_mem hxI, h.r, (h.diff _).r,
      ←ncard_diff_singleton_add_one hxI] at h',
    simpa using h'},
  rw [indep_iff_forall_subset_not_circuit],
  by_contra' hC,
  obtain ⟨C, hCI, hC⟩ := hC,
  obtain ⟨x,hxC⟩ := hC.nonempty,
  exact h x (hCI hxC) (cl_diff_singleton_eq_cl
    (M.cl_mono (diff_subset_diff_left hCI) (hC.subset_cl_diff_singleton _ hxC))),
end

 lemma indep_iff_not_mem_cl_diff_forall :
  M.indep I ↔ ∀ x ∈ I, x ∉ M.cl (I \ {x}) :=
begin
  rw indep_iff_cl_diff_ne_forall,
  exact ⟨λ h, λ x hxI, by {rw mem_cl_diff_singleton_iff_cl hxI, exact h x hxI},
    λ h x hxI, by {rw [ne.def, ←mem_cl_diff_singleton_iff_cl hxI], exact h x hxI}⟩,
end

lemma indep_iff_cl_ssubset_ssubset_forall :
  M.indep I ↔ ∀ J ⊂ I, M.cl J ⊂ M.cl I :=
begin
  refine ⟨λ hI J hJI, _,
    λ h, indep_iff_cl_diff_ne_forall.mpr (λ x hx, (h _ (diff_singleton_ssubset hx)).ne)⟩,
  obtain ⟨e,heI,heJ⟩ := exists_of_ssubset hJI,
  exact (M.cl_subset_cl_of_subset (subset_diff_singleton hJI.subset heJ)).trans_ssubset
    ((M.cl_subset_cl_of_subset (diff_subset I {e})).ssubset_of_ne
    (indep_iff_cl_diff_ne_forall.mp hI e heI)),
end

lemma indep.not_mem_cl_iff (hI : M.indep I) :
  x ∉ M.cl I ↔ x ∉ I ∧ M.indep (insert x I) :=
begin
  rw [←not_iff_not, not_not_mem, not_and, mem_cl],
  refine ⟨λ h hxI hI', indep_iff_cl_diff_ne_forall.mp hI' x (mem_insert _ _) _,
    λ h, (M.r_mono (subset_insert _ _)).antisymm' _⟩,
  { rw [hI.r, hI'.r, ncard_insert_of_not_mem hxI] at h, simpa using h},
  obtain (hxI | hxI) := em (x ∈ I),
  { rw [insert_eq_of_mem hxI]},
  have hIi := h hxI,
  rwa [←r_lt_card_iff_dep, ←nat.add_one_le_iff, ncard_insert_of_not_mem hxI, add_le_add_iff_right,
    ←hI.r] at hIi,
end

lemma indep.cl_diff_singleton_ssubset (hI : M.indep I) (he : e ∈ I) :
  M.cl (I \ {e}) ⊂  M.cl I :=
ssubset_of_subset_of_ne (M.cl_mono (diff_subset _ _)) (indep_iff_cl_diff_ne_forall.mp hI _ he)

lemma indep.cl_ssubset_ssubset (hI : M.indep I) (hJI : J ⊂ I) :
  M.cl J ⊂ M.cl I :=
indep_iff_cl_ssubset_ssubset_forall.mp hI J hJI

lemma subset_cl_iff_r_union_eq_r :
  X ⊆ M.cl Y ↔ M.r (Y ∪ X) = M.r Y :=
begin
  refine ⟨λ h, r_union_eq_of_r_all_insert_le (λ e he, by rw mem_cl.mp (h he)),
    λ hu e heX, mem_cl.mpr ((M.r_mono (subset_insert _ _)).antisymm' _)⟩,
  rw ←hu,
  apply r_mono,
  rw insert_subset,
  simp only [mem_union, subset_union_left, and_true],
  exact or.inr heX,
end

lemma basis.subset_cl (hI : M.basis I X) :
  X ⊆ M.cl I :=
begin
  rw subset_cl_iff_r_union_eq_r,
  refine le_antisymm _ (M.r_le_r_union_left _ _),
  rw [hI.r, union_eq_right_iff_subset.mpr hI.subset],
end

lemma cl_flat (M : matroid E) (X : set E) :
  M.flat (M.cl X) :=
λ I Y hIcl hIY, hIY.subset_cl.trans (cl_subset_cl_of_subset_cl hIcl.subset)

lemma flat_iff_cl_self :
  M.flat F ↔ M.cl F = F :=
begin
  refine ⟨λ hF, (sInter_subset_of_mem _).antisymm (subset_sInter _), λ hF, _⟩,
  { exact ⟨hF, rfl.subset⟩,   },
  { rintro F' ⟨hF', hFF'⟩, exact hFF'},
  rw ←hF,
  apply cl_flat,
end

lemma flat.cl (hF : M.flat F) :
  M.cl F = F :=
flat_iff_cl_self.mp hF

lemma flat_iff_ssubset_cl_insert_forall :
  M.flat F ↔ ∀ e ∉ F, M.cl F ⊂ M.cl (insert e F) :=
begin
  refine ⟨λ h e he, (M.cl_subset_cl_of_subset (subset_insert _ _)).ssubset_of_ne _, λ h, _⟩,
  { rw [h.cl], exact λ h', mt ((set.ext_iff.mp h') e).mpr he ((M.subset_cl _) (mem_insert _ _))},
  rw flat_iff_cl_self,
  by_contra h',
  obtain ⟨e,he',heF⟩ := exists_of_ssubset (ssubset_of_ne_of_subset (ne.symm h') (M.subset_cl F)),
  have h'' := (h e heF),
  rw [←cl_insert_cl_eq_cl_insert, insert_eq_of_mem he', cl_cl] at h'',
  exact h''.ne rfl,
end

lemma flat.cl_exchange (hF : M.flat F) (he : e ∈ M.cl (insert f F) \ F) :
  f ∈ M.cl (insert e F) \ F :=
by {nth_rewrite 1 ←hF.cl, apply cl_exchange, rwa hF.cl}

lemma flat.cl_subset_of_subset (hF : M.flat F) (h : X ⊆ F) :
  M.cl X ⊆ F :=
by {have h' := M.cl_mono h, rwa hF.cl at h'}

lemma base.cl (hB : M.base B) :
  M.cl B = univ :=
eq_univ_of_forall (λ x, by_contra (λ hx,
    (hB.dep_of_insert (not_mem_subset (M.subset_cl B) hx) (hB.indep.not_mem_cl_iff.mp hx).2)))

lemma indep.basis_cl (hI : M.indep I) :
  M.basis I (M.cl I) :=
begin
  refine ⟨hI, M.subset_cl _, λ J hJ hIJ hJI, hIJ.antisymm (λ e he, by_contra (λ heI, _))⟩,
  apply indep_iff_cl_diff_ne_forall.mp (hJ.subset (insert_subset.mpr ⟨he, hIJ⟩)) e (mem_insert _ _),
  rw [insert_diff_of_mem _ (mem_singleton e), diff_singleton_eq_self heI],
  refine (M.cl_mono (subset_insert _ _)).antisymm (subset_trans _ (cl_subset_cl_of_subset_cl hJI)),
  exact M.cl_subset_cl_of_subset (insert_subset.mpr ⟨he, hIJ⟩),
end

lemma basis.cl (hI : M.basis I X) :
  M.cl I = M.cl X :=
(M.cl_mono hI.subset).antisymm ((M.cl_flat I).cl_subset_of_subset hI.subset_cl)

lemma basis.basis_cl (hI : M.basis I X) :
  M.basis I (M.cl X) :=
by {rw [←hI.cl], exact hI.indep.basis_cl}

lemma basis_iff_basis_cl_of_subset (hIX : I ⊆ X) :
  M.basis I X ↔ M.basis I (M.cl X) :=
⟨λ h, h.basis_cl,λ h, h.basis_subset hIX (subset_cl _ _)⟩

lemma basis.basis_of_cl_eq_cl (hI : M.basis I X) (hIY : I ⊆ Y) (h : M.cl X = M.cl Y) :
  M.basis I Y :=
begin
  rw [basis_iff_basis_cl_of_subset hIY, ←h],
  exact hI.basis_cl,
end

lemma base_subset_iff_cl_eq_univ :
  (∃ B ⊆ X, M.base B) ↔ M.cl X = univ :=
begin
  split,
  { rintro ⟨B, hBX, hB⟩,
    have h' := M.cl_subset_cl_of_subset hBX,
    rw [hB.cl] at h',
    exact h'.antisymm' (subset_univ _)},
  intro h,
  obtain ⟨I, hIX⟩ := M.exists_basis X,
  have h' := hIX.basis_cl,
  rw [h, ←base_iff_basis_univ] at h',
  exact ⟨I, hIX.subset, h'⟩,
end

lemma basis.insert_basis_insert_of_not_mem_cl (hI : M.basis I X) (he : e ∉ M.cl X) :
  M.basis (insert e I) (insert e X) :=
begin
  rw [←hI.cl, hI.indep.not_mem_cl_iff] at he,
  refine ⟨he.2, insert_subset_insert hI.subset, λ J hJ heIJ hJeX, heIJ.antisymm _⟩,
  rw [←union_singleton, ←inter_union_diff J X, union_subset_iff, (@diff_subset_iff _ J _ _),
    ←union_assoc, union_eq_left_iff_subset.mpr hI.subset, union_singleton, union_singleton,
    ←hI.eq_of_subset_indep (hJ.inter_right X)
      (subset_inter ((subset_insert _ _).trans heIJ) hI.subset) (inter_subset_right _ _)],
  exact ⟨subset_insert _ _, hJeX⟩,
end

lemma not_mem_cl_iff_forall_insert_basis_insert :
  e ∉ M.cl X ↔ (e ∉ X ∧ (∀ I, M.basis I X → M.basis (insert e I) (insert e X))) :=
begin
  refine ⟨λ he, ⟨λ heX, he (M.subset_cl X heX), λ I hI, hI.insert_basis_insert_of_not_mem_cl he⟩,
    λ h he, _⟩,
  obtain ⟨I, hI⟩ := M.exists_basis X,
  exact (h.2 I hI).not_basis_of_ssubset (ssubset_insert (λ heI, h.1 (hI.subset heI)))
    (hI.basis_cl.basis_subset (hI.subset.trans (subset_insert _ _))
      (insert_subset.mpr ⟨he,M.subset_cl _⟩)),
end

lemma basis_iff_cl :
  M.basis I X ↔ I ⊆ X ∧ X ⊆ M.cl I ∧ ∀ J ⊆ I, X ⊆ M.cl J → J = I :=
begin
  revert I,
  by_contra' hcon,
  obtain ⟨I, hI, hImin⟩ := finite.exists_minimal _ hcon,
  apply hI,
  refine ⟨λ hI, ⟨hI.subset, hI.subset_cl, _ ⟩, _⟩,
  { by_contra' h',
    obtain ⟨J, ⟨hJI, hXJ, hJne⟩, hJmin⟩ := finite.exists_minimal _ h',
    refine hJne (hImin J (λ hJgood,_) hJI).symm,
    have hJ : M.basis J X,
    { rw hJgood,
      refine ⟨hJI.trans hI.subset, hXJ, λ J' hJ' hXJ', _⟩,
      rw hJmin J' ⟨hJ'.trans hJI,hXJ',_⟩ hJ',
      rintro rfl,
      exact hJne (hJI.antisymm hJ')},
    exact hJne (hJ.eq_of_subset_indep hI.indep hJI hI.subset)},
  rintros ⟨hIX, hXI, hI⟩,
  refine ⟨_,hIX,λ J hJ hIJ hJX, by_contra (λ hne, _)⟩,
  { rw indep_iff_cl_ssubset_ssubset_forall,
    intros J hJI,
    refine (M.cl_subset_cl_of_subset (hJI.subset)).ssubset_of_ne (λ he, hJI.ne _),
    exact hI J hJI.subset (hXI.trans_eq he.symm)},
  rw indep_iff_cl_ssubset_ssubset_forall at hJ,
  refine ((hJ I (hIJ.ssubset_of_ne hne)).trans_subset (M.cl_mono hJX)).not_subset _,
  exact cl_subset_cl_of_subset_cl hXI,
end

lemma basis_union_iff_indep_cl :
  M.basis I (I ∪ X) ↔ M.indep I ∧ X ⊆ M.cl I :=
begin
  refine ⟨λ h, ⟨h.indep, (subset_union_right _ _).trans h.subset_cl⟩, _⟩,
  rw basis_iff_cl,
  rintros ⟨hI, hXI⟩,
  refine ⟨subset_union_left _ _, union_subset (M.subset_cl _) hXI, λ J hJI hJ, by_contra (λ h', _)⟩,
  obtain ⟨e,heI,heJ⟩ := exists_of_ssubset (hJI.ssubset_of_ne h'),
  have heJ' : e ∈ M.cl J,
    from hJ (or.inl heI),
  refine indep_iff_not_mem_cl_diff_forall.mp hI e heI (mem_of_mem_of_subset heJ' _),
  exact M.cl_subset_cl_of_subset (subset_diff_singleton hJI heJ),
end

lemma basis_iff_indep_cl :
  M.basis I X ↔ M.indep I ∧ X ⊆ M.cl I ∧ I ⊆ X :=
⟨λ h, ⟨h.indep, h.subset_cl, h.subset⟩,
  λ h, (basis_union_iff_indep_cl.mpr ⟨h.1,h.2.1⟩).basis_subset h.2.2 (subset_union_right _ _)⟩

lemma basis.eq_of_cl_subset (hI : M.basis I X) (hJI : J ⊆ I) (hJ : X ⊆ M.cl J) :
  J = I :=
(basis_iff_cl.mp hI).2.2 J hJI hJ

lemma empty_basis_iff :
  M.basis ∅ X ↔ X ⊆ M.cl ∅ :=
begin
  simp only [basis_iff_cl, empty_subset, true_and, and_iff_left_iff_imp],
  exact λ h J hJ hXJ, subset_empty_iff.mp hJ,
end

lemma mem_cl_iff_exists_circuit :
  e ∈ M.cl X ↔ e ∈ X ∨ ∃ C, M.circuit C ∧ e ∈ C ∧ C \ {e} ⊆ X :=
begin
  refine ⟨λ h, _,_⟩,
  { by_contra' h',
    obtain ⟨I, hI⟩ := M.exists_basis X,
    have hIe : ¬ M.indep (insert e I),
    { intro hI',
      refine indep_iff_not_mem_cl_diff_forall.mp hI' e (mem_insert _ _) _,
      rwa [insert_diff_of_mem _ (mem_singleton _),
        diff_singleton_eq_self (not_mem_subset hI.subset h'.1), hI.cl]},
    obtain ⟨C,⟨hCeI, hC, heC⟩,-⟩ :=  hI.indep.unique_circuit_of_insert _ hIe,
    refine h'.2 C hC heC (diff_subset_iff.mpr (hCeI.trans _)),
    rw singleton_union,
    apply insert_subset_insert hI.subset},
  rintro (heX | ⟨C,hC, heC, hCX⟩),
  { exact (M.subset_cl X) heX},
  exact (M.cl_mono hCX) (hC.subset_cl_diff_singleton e heC),
end

lemma flat_iff_forall_circuit :
  M.flat F ↔ ∀ C e, M.circuit C → e ∈ C → C \ {e} ⊆ F → e ∈ F :=
begin
  rw [flat_iff_cl_self],
  refine ⟨λ h C e hC heC hCF , _, λ h, (M.subset_cl _).antisymm' (λ e heF, _) ⟩,
  { rw ←h, exact (hC.subset_cl_diff_singleton e).trans (M.cl_mono hCF) heC},
  exact (mem_cl_iff_exists_circuit.mp heF).elim id (λ ⟨C, hC, heC, hCF⟩, h _ _ hC heC hCF),
end

/- ### Basis exchange -/
/- These lemmas doesn't actually use closure in their statements, but we prove them using closure.
  TODO : Avoid cardinality in the proofs. -/

/- Given two bases `I₁,I₂` of `X` and an element `e` of `I₁ \ I₂`, we can find an `f ∈ I₂ \ I₁`
  so that swapping `e` for `f` in yields bases in both `I₁` and `I₂`.  -/
theorem basis.strong_exchange (hI₁ : M.basis I₁ X) (hI₂ : M.basis I₂ X) (he : e ∈ I₁ \ I₂) :
  ∃ f ∈ I₂ \ I₁, M.basis (insert e (I₂ \ {f})) X ∧ M.basis (insert f (I₁ \ {e})) X :=
begin
  by_contra,
  simp_rw [not_exists, not_and] at h,

  have heX : e ∈ X := hI₁.subset he.1,
  obtain ⟨C, ⟨hCB₂,hC⟩, hCunique⟩ :=
    hI₂.indep.unique_circuit_of_insert e (hI₂.insert_dep ⟨heX, he.2⟩),

  have hCss := diff_singleton_subset_iff.mpr hCB₂,

  simp only [exists_unique_iff_exists, exists_prop, and_imp] at hCunique,
  have hC_exchange : ∀ f ∈ C \ {e}, M.basis (insert e (I₂ \ {f})) X,
  { rintros y ⟨hyC, hyx⟩,

    rw [basis_iff_indep_card, ncard_exchange he.2 (hCss ⟨hyC,hyx⟩), hI₂.card, eq_self_iff_true,
      and_true],
    refine ⟨by_contra (λ hdep, _), insert_subset.mpr ⟨heX, ((diff_subset _ _).trans hI₂.subset)⟩⟩,

    rw [dep_iff_supset_circuit] at hdep,
    obtain ⟨C', hC'ss, hC'⟩ := hdep,
    have  hC'e : e ∈ C',
    { by_contra he',
      exact hC'.dep (hI₂.indep.subset (((subset_insert_iff_of_not_mem he').mp hC'ss).trans
          (diff_subset _ _)))},
    have := hCunique C' (hC'ss.trans (insert_subset_insert (diff_subset _ _))) hC' hC'e,
    subst this,
    simpa using hC'ss hyC},

  have hcl : ∀ f ∈ I₂ \ M.cl (I₁ \ {e}), M.basis (insert f (I₁ \ {e})) X,
  { rintro f ⟨hf₂, hf₁⟩,
    obtain rfl | hfe := em (f = e),
    { rwa [insert_diff_singleton, insert_eq_self.mpr he.1]},
    have hfI₁ : f ∉ I₁, from
      λ hfI₁, hf₁ (M.subset_cl (I₁ \ {e}) (mem_diff_singleton.mpr ⟨hfI₁, hfe⟩)),
    simp_rw [basis_iff_indep_card, indep_iff_r_eq_card, ncard_exchange hfI₁ he.1,
      hI₁.card, eq_self_iff_true, and_true, ←hI₁.card, not_mem_cl.mp hf₁, insert_subset,
      (hI₁.indep.diff {e}).r, ncard_diff_singleton_add_one he.1, eq_self_iff_true, true_and],
    exact ⟨hI₂.subset hf₂, (diff_subset _ _).trans hI₁.subset⟩},

  have hss : C \ {e} ⊆ M.cl (I₁ \ {e}),
  from λ f hf, by_contra (λ hf', h _ ⟨hCss hf, λ hf₁, hf' (M.subset_cl _ ⟨hf₁,hf.2⟩)⟩
      (hC_exchange f hf) (hcl _ ⟨hCss hf,hf'⟩)),

  have he' := (hC.1.subset_cl_diff_singleton _).trans (cl_subset_cl_of_subset_cl hss) hC.2,
  rw [mem_cl, insert_diff_singleton, insert_eq_of_mem he.1, hI₁.indep.r, (hI₁.indep.diff _).r,
    ←ncard_diff_singleton_add_one he.1] at he',
  simpa only [nat.succ_ne_self] using he',
end

/- This lemma is tantamount to saying that matroid restriction is well-defined. -/
lemma basis.exchange (hI₁ : M.basis I₁ X) (hI₂ : M.basis I₂ X) (he : e ∈ I₁ \ I₂) :
  ∃ f ∈ I₂ \ I₁, M.basis (insert f (I₁ \ {e})) X :=
(hI₁.strong_exchange hI₂ he).imp (λ h, Exists.imp (λ h', and.right))

lemma basis.rev_exchange (hI₁ : M.basis I₁ X) (hI₂ : M.basis I₂ X) (he : e ∈ I₁ \ I₂) :
  ∃ f ∈ I₂ \ I₁, M.basis (insert e (I₂ \ {f})) X :=
(hI₁.strong_exchange hI₂ he).imp (λ h, Exists.imp (λ h', and.left))

theorem base.strong_exchange (hB₁ : M.base B₁) (hB₂ : M.base B₂) (hx : x ∈ B₁ \ B₂) :
  ∃ y ∈ B₂ \ B₁, M.base (insert x (B₂ \ {y})) ∧ M.base (insert y (B₁ \ {x})) :=
by {simp_rw base_iff_basis_univ at *, exact hB₁.strong_exchange hB₂ hx}

lemma base.rev_exchange (hB₁ : M.base B₁) (hB₂ : M.base B₂) (hx : x ∈ B₁ \ B₂) :
  ∃ y ∈ B₂ \ B₁, M.base (insert x (B₂ \ {y})) :=
(hB₁.strong_exchange hB₂ hx).imp (by {rintro y ⟨hy,h,-⟩, use [hy,h]})

/- ### Flats and rank -/

lemma flat.r_strict_mono (hF₁ : M.flat F₁) (hF₂ : M.flat F₂) (h : F₁ ⊂ F₂) :
  M.r F₁ < M.r F₂ :=
begin
  refine lt_of_le_of_ne (M.r_mono h.subset) (λ he, _),
  obtain ⟨x,hx, hxF₁⟩ := exists_of_ssubset h,
  have hle := M.r_mono (insert_subset.mpr ⟨hx, h.subset⟩),
  rw [hF₁.r_insert_of_not_mem hxF₁, ←he] at hle,
  simpa only [add_le_iff_nonpos_right, le_zero_iff] using hle,
end

lemma flat.eq_of_le_r_subset (hF₁ : M.flat F₁) (hF₂ : M.flat F₂) (h : F₁ ⊆ F₂)
(hr : M.r F₂ ≤ M.r F₁):
  F₁ = F₂ :=
by_contra (λ h', (hF₁.r_strict_mono hF₂ (ssubset_of_ne_of_subset h' h)).not_le hr)

lemma flat.eq_univ_of_rk_le_r (hF : M.flat F) (hr : M.rk ≤ M.r F) :
  F = univ :=
hF.eq_of_le_r_subset (M.univ_flat) (subset_univ _) hr

lemma r_le_iff_cl {n : ℕ} :
  M.r X ≤ n ↔ ∃ I, X ⊆ M.cl I ∧ I.ncard ≤ n :=
begin
  refine ⟨λ h, _, _⟩,
  { obtain ⟨I,hI⟩ := M.exists_basis X,
    exact ⟨I, hI.subset_cl, by rwa hI.card⟩},
  rintro ⟨I, hXI, hIn⟩,
  refine (M.r_mono hXI).trans (le_trans _ hIn),
  rw [r_cl],
  exact M.r_le_card I,
end

lemma le_r_iff_cl {n : ℕ} :
 n ≤ M.r X ↔ ∀ I, X ⊆ M.cl I → n ≤ I.ncard :=
begin
  cases n, simp,
  rw [←not_lt, ←not_iff_not, not_not, not_forall],
  simp_rw [not_imp, not_le, nat.lt_succ_iff],
  exact r_le_iff_cl,
end

lemma eq_of_cl_eq_cl_forall {M₁ M₂ : matroid E} (h : ∀ X, M₁.cl X = M₂.cl X) :
  M₁ = M₂ :=
eq_of_indep_iff_indep_forall (λ I, by simp_rw [indep_iff_cl_diff_ne_forall, h])

/- ### Covering  -/

/-- A set is covered by another in a matroid if they are strictly nested flats, with no flat
  between them . -/
def covby (M : matroid E) (F₀ F₁ : set E) : Prop :=
  M.flat F₀ ∧ M.flat F₁ ∧ F₀ ⊂ F₁ ∧ ∀ F, M.flat F → F₀ ⊆ F → F ⊆ F₁ → F = F₀ ∨ F = F₁

lemma covby_iff :
  M.covby F₀ F₁ ↔ M.flat F₀ ∧ M.flat F₁ ∧ F₀ ⊂ F₁ ∧
    ∀ F, M.flat F → F₀ ⊆ F → F ⊆ F₁ → F = F₀ ∨ F = F₁ :=
iff.rfl

lemma covby.flat_left (h : M.covby F₀ F₁) :
  M.flat F₀ :=
h.1

lemma covby.flat_right (h : M.covby F₀ F₁) :
  M.flat F₁ :=
h.2.1

lemma covby.ssubset (h : M.covby F₀ F₁) :
  F₀ ⊂ F₁ :=
h.2.2.1

lemma covby.subset (h : M.covby F₀ F₁) :
  F₀ ⊆ F₁ :=
h.2.2.1.subset

lemma covby.eq_or_eq (h : M.covby F₀ F₁) (hF : M.flat F) (h₀ : F₀ ⊆ F) (h₁ : F ⊆ F₁) :
  F = F₀ ∨ F = F₁ :=
h.2.2.2 F hF h₀ h₁

lemma covby.eq_of_subset_of_ssubset (h : M.covby F₀ F₁) (hF : M.flat F) (hF₀ : F₀ ⊆ F)
(hF₁ : F ⊂ F₁) :
  F = F₀ :=
(h.2.2.2 F hF hF₀ hF₁.subset).elim id (λ h', (hF₁.ne h').elim)

lemma covby.eq_of_ssubset_of_subset (h : M.covby F₀ F₁) (hF : M.flat F) (hF₀ : F₀ ⊂ F)
(hF₁ : F ⊆ F₁) :
  F = F₁ :=
(h.2.2.2 F hF hF₀.subset hF₁).elim (λ h', (hF₀.ne.symm h').elim) id

lemma covby.cl_insert_eq (h : M.covby F₀ F₁) (he : e ∈ F₁ \ F₀) :
  M.cl (insert e F₀) = F₁ :=
h.eq_of_ssubset_of_subset (M.cl_flat _)
  ((ssubset_insert he.2).trans_subset (M.subset_cl _))
  (h.flat_right.cl_subset_of_subset (insert_subset.mpr ⟨he.1, h.ssubset.subset⟩))

lemma flat.exists_unique_flat_of_not_mem (hF₀ : M.flat F₀) (he : e ∉ F₀) :
  ∃! F₁, e ∈ F₁ ∧ M.covby F₀ F₁ :=
begin
  refine ⟨M.cl (insert e F₀), ⟨(M.subset_cl _) (mem_insert _ _),_⟩, _⟩,
  { refine ⟨hF₀,M.cl_flat _, (ssubset_insert he).trans_subset (M.subset_cl _), λ F hF hF₀F hFeF₀,_⟩,
    by_contra' h,
    refine h.2 (hFeF₀.antisymm (hF.cl_subset_of_subset (insert_subset.mpr ⟨_,hF₀F⟩))),
    obtain ⟨x,hxF,hxF₀⟩ := exists_of_ssubset (hF₀F.ssubset_of_ne (ne.symm h.1)),
    exact mem_of_mem_of_subset (hF₀.cl_exchange ⟨hFeF₀ hxF, hxF₀⟩).1
      (hF.cl_subset_of_subset (insert_subset.mpr ⟨hxF, hF₀F⟩))},
  rintro F ⟨heF, ⟨-,hF,hF₀F,hmin⟩⟩,
  obtain (h' | rfl) := hmin (M.cl (insert e F₀)) (M.cl_flat _)
    ((subset_insert _ _).trans (M.subset_cl _))
    (hF.cl_subset_of_subset (insert_subset.mpr ⟨heF,hF₀F.subset⟩)),
  { exact (((ssubset_insert he).trans_subset (M.subset_cl _)).ne.symm h').elim},
  refl,
end

/- ### Hyperplanes -/

lemma hyperplane_def :
  M.hyperplane H ↔ (M.flat H ∧ H ⊂ univ ∧ ∀ F, H ⊂ F → M.flat F → F = univ) :=
iff.rfl

lemma hyperplane.flat (hH : M.hyperplane H) :
  M.flat H :=
hH.1

lemma hyperplane.ssubset_univ (hH : M.hyperplane H) :
  H ⊂ univ :=
hH.2.1

lemma univ_not_hyperplane (M : matroid E) :
  ¬ M.hyperplane univ :=
λ h, h.2.1.ne rfl

lemma hyperplane.eq_of_subset (h₁ : M.hyperplane H₁) (h₂ : M.hyperplane H₂) (h : H₁ ⊆ H₂) :
  H₁ = H₂ :=
by_contra (λ he, h₂.ssubset_univ.ne (h₁.2.2 H₂ (h.ssubset_of_ne he) h₂.flat))

lemma hyperplane.not_ssubset (h₁ : M.hyperplane H₁) (h₂ : M.hyperplane H₂) :
  ¬ H₁ ⊂ H₂ :=
λ hss, hss.ne (h₁.eq_of_subset h₂ hss.subset)

lemma hyperplane.exists_not_mem (hH : M.hyperplane H) :
  ∃ e, e ∉ H :=
by {by_contra' h, apply M.univ_not_hyperplane, convert hH, rwa [eq_comm, eq_univ_iff_forall] }

lemma hyperplane_iff_maximal_cl_ne_univ :
  M.hyperplane H ↔ M.cl H ≠ univ ∧ ∀ X, H ⊂ X → M.cl X = univ :=
begin
  rw [hyperplane_def, cl_def],
  simp only [ne.def, sInter_eq_univ, mem_set_of_eq, and_imp, not_forall, exists_prop],
  refine ⟨λ h, ⟨⟨H, h.1, rfl.subset, h.2.1.ne⟩, λ X hHX, h.2.2 _
    (hHX.trans_subset (M.subset_cl _)) (M.cl_flat _)⟩, λ h, _⟩,
  obtain ⟨⟨F,hF,hHF,hFne⟩,hmax⟩ := h,
  suffices h_eq : H = F,
  { subst h_eq,
    refine ⟨hF, ssubset_univ_iff.mpr hFne, λ F hHF hF, _⟩,
    rw ←hF.cl,
    exact hmax _ hHF, },
  refine by_contra (λ hne, hFne _),
  rw [←hmax F (ssubset_of_ne_of_subset hne hHF), hF.cl],
end

lemma hyperplane_iff_maximal_not_supset_base :
  M.hyperplane H ↔ (¬∃ B ⊆ H, M.base B) ∧ ∀ X, H ⊂ X → ∃ B ⊆ X, M.base B :=
by simp_rw [hyperplane_iff_maximal_cl_ne_univ, ne.def, ←base_subset_iff_cl_eq_univ]

lemma hyperplane_iff_maximal_r :
  M.hyperplane H ↔ M.r H < M.rk ∧ ∀ X, H ⊂ X → M.r X = M.rk :=
begin
  rw hyperplane_def,
  refine ⟨_,λ hH, ⟨flat_iff_r_lt_r_insert.mpr (λ e heH, _),
    ssubset_of_ne_of_subset (λ hH', _) (subset_univ _), λ F hHF hF, _⟩⟩,
  { rintro ⟨hH, hHss, hHmax⟩,
    have hlt := hH.r_strict_mono (M.univ_flat) hHss,
    refine ⟨hlt,λ X hHX, _⟩,
    convert congr_arg M.r (hHmax _ (hHX.trans_subset (M.subset_cl X)) (M.cl_flat _)) using 1,
    rw [r_cl]},
  { rw hH.2 (insert e H) (ssubset_insert heH), exact hH.1 },
  { subst hH', exact hH.1.ne rfl},
  apply hF.eq_of_le_r_subset (M.univ_flat) (subset_univ _),
  rw hH.2 _ hHF,
end

lemma hyperplane.r_add_one (hH : M.hyperplane H) :
  M.r H + 1 = M.rk :=
begin
  rw [hyperplane_iff_maximal_r] at hH,
  cases hH with h₁ h₂,
  refine (nat.add_one_le_iff.mpr h₁).antisymm _,
  by_cases ∃ x, x ∉ H,
  { obtain ⟨x,hxH⟩ := h,
    rw [←h₂ _ (ssubset_insert hxH)],
    exact (M.r_insert_le_add_one H x)},
  simp_rw [not_exists, not_not_mem, ←eq_univ_iff_forall] at h,
  rw h,
  apply nat.le_succ,
end

lemma hyperplane.coe_r (hH : M.hyperplane H) :
  (M.r H : ℤ) = M.rk - 1 :=
by simp [←hH.r_add_one]

lemma hyperplane_iff_flat_r_eq :
  M.hyperplane H ↔ M.flat H ∧ M.r H + 1 = M.rk :=
begin
  refine ⟨λ h, ⟨h.1,h.r_add_one⟩,λ h,
    ⟨h.1,ssubset_univ_iff.mpr (λ hH, by {subst hH, simpa using h.2}), λ F hHF hF,
      hF.eq_univ_of_rk_le_r _⟩⟩,
  rw [←h.2, nat.add_one_le_iff],
  exact h.1.r_strict_mono hF hHF,
end

lemma base.hyperplane_of_cl_diff_singleton (hB : M.base B) (heB : e ∈ B) :
  M.hyperplane (M.cl (B \ {e})) :=
begin
  rw [hyperplane_iff_maximal_cl_ne_univ, cl_cl, ne_univ_iff_exists_not_mem],
  refine ⟨⟨e, λ he, indep_iff_cl_diff_ne_forall.mp hB.indep _ heB (cl_diff_singleton_eq_cl he)⟩,
    λ X hX, univ_subset_iff.mp _⟩,
  obtain ⟨f,hfX, hfB⟩ := exists_of_ssubset hX,
  obtain (rfl | hef) := eq_or_ne f e,
  { have hu := union_subset (singleton_subset_iff.mpr hfX) ((subset_cl _ _).trans hX.subset),
    rw [singleton_union, insert_diff_singleton, insert_eq_of_mem heB] at hu,
    exact (hB.cl.symm.trans_subset (M.cl_subset_cl_of_subset hu))},
  rw (hB.indep.diff {e}).not_mem_cl_iff at hfB,
  have  hf : f ∉ B,
  { refine λ hf, hef _,
    simp only [mem_diff, mem_singleton_iff, not_and, not_not] at hfB,
    exact hfB.1 hf},
  rw ←(hB.exchange_base_of_indep heB hf hfB.2).cl,
  exact M.cl_subset_cl_of_subset (insert_subset.mpr ⟨hfX,subset_trans (M.subset_cl _) hX.subset⟩),
end

lemma hyperplane.ssupset_eq_univ_of_flat (hH : M.hyperplane H) (hF : M.flat F) (h : H ⊂ F) :
  F = univ :=
begin
  apply hF.eq_univ_of_rk_le_r,
  have hlt := hH.flat.r_strict_mono hF h,
  rwa [nat.lt_iff_add_one_le, hH.r_add_one] at hlt,
end

lemma hyperplane.cl_insert_eq_univ (hH : M.hyperplane H) (he : e ∉ H) :
  M.cl (insert e H) = univ :=
hH.ssupset_eq_univ_of_flat (M.cl_flat _) ((ssubset_insert he).trans_subset (M.subset_cl _))

lemma exists_hyperplane_sep_of_not_mem_cl (h : e ∉ M.cl X) :
  ∃ H, M.hyperplane H ∧ X ⊆ H ∧ e ∉ H :=
begin
  rw not_mem_cl_iff_forall_insert_basis_insert at h,
  obtain ⟨I,hI⟩ := M.exists_basis X,
  have hIe := h.2 I hI,
  obtain ⟨B,hB,heIB⟩ := hIe.indep.exists_base_supset,
  rw insert_subset at heIB,
  refine ⟨M.cl (B \ {e}), hB.hyperplane_of_cl_diff_singleton heIB.1,_,λ hecl, _ ⟩,
  { have hIBe : I ⊆ B \ {e} := subset_diff_singleton heIB.2 (not_mem_subset hI.subset h.1),
    exact hI.subset_cl.trans (M.cl_mono hIBe)},
  exact indep_iff_cl_diff_ne_forall.mp hB.indep e heIB.1 (cl_diff_singleton_eq_cl hecl),
end

lemma cl_eq_sInter_hyperplanes (M : matroid E) (X : set E) :
  M.cl X = ⋂₀ {H | M.hyperplane H ∧ X ⊆ H} :=
begin
  apply subset_antisymm,
  { simp only [subset_sInter_iff, mem_set_of_eq, and_imp],
    exact λ H hH hXH, hH.flat.cl_subset_of_subset hXH},
  by_contra' h',
  obtain ⟨x, h, hx⟩ := not_subset.mp h',
  obtain ⟨H, hH, hXH, hxH⟩ := exists_hyperplane_sep_of_not_mem_cl hx,
  exact hxH (h H ⟨hH, hXH⟩),
end

lemma flat.subset_hyperplane_of_ne_univ (hF : M.flat F) (h : F ≠ univ) :
  ∃ H, M.hyperplane H ∧ F ⊆ H :=
begin
  obtain ⟨H,⟨hFH,hH,hne⟩,hHmax⟩ := finite.exists_maximal (λ X, F ⊆ X ∧ M.flat X ∧ X ≠ univ)
    ⟨F,subset.rfl,hF, h⟩,
  refine ⟨H, _, hFH⟩,
  rw [hyperplane_iff_maximal_cl_ne_univ, hH.cl],
  refine ⟨hne, λ X hHX, by_contra (λ hne', hHX.not_subset _)⟩,

  rw hHmax (M.cl X) ⟨hFH.trans (hHX.subset.trans (M.subset_cl _)), M.cl_flat _, hne'⟩
     (hHX.subset.trans (M.subset_cl _)),
  exact M.subset_cl _,
end

lemma subset_hyperplane_iff_cl_ne_univ :
  M.cl Y ≠ univ ↔ ∃ H, M.hyperplane H ∧ Y ⊆ H :=
begin
  refine ⟨λ h, _,_⟩,
  { obtain ⟨H, hH, hYH⟩ := (M.cl_flat Y).subset_hyperplane_of_ne_univ h,
    exact ⟨H, hH, (M.subset_cl Y).trans hYH⟩},
  rintro ⟨H, hH, hYH⟩ hY,
  refine hH.ssubset_univ.not_subset _,
  rw ←hH.flat.cl,
  exact (hY.symm.trans_subset (M.cl_mono hYH)),
end

/- This follows more easily from a rank argument, but I'm trying to avoid rank. -/
lemma hyperplane.inter_right_covby_of_inter_left_covby
(hH₁ : M.hyperplane H₁) (hH₂ : M.hyperplane H₂) (h : M.covby (H₁ ∩ H₂) H₁) :
  M.covby (H₁ ∩ H₂) H₂ :=
begin
  obtain (rfl | hne) := eq_or_ne H₁ H₂, assumption,
  have hssu : H₁ ∩ H₂ ⊂ H₂,
  { refine (inter_subset_right _ _).ssubset_of_ne (λh'', hne _ ),
    rw [inter_eq_right_iff_subset, ←le_iff_subset] at h'',
    rw eq_of_le_of_not_lt h'' (hH₂.not_ssubset hH₁)},

  refine ⟨hH₁.flat.inter hH₂.flat, hH₂.flat, hssu, λ F hF hssF hFH₂, _⟩,
  by_contra' h',

  obtain ⟨x,hxF,hx⟩ := exists_of_ssubset (hssF.ssubset_of_ne (ne.symm h'.1)),
  obtain ⟨y,hyH₂,hy⟩ := exists_of_ssubset (hFH₂.ssubset_of_ne h'.2),
  obtain ⟨z,hzH₁,hz⟩ := exists_of_ssubset h.ssubset,
  have hzcl : M.cl (insert z (H₁ ∩ H₂)) = H₁ := h.cl_insert_eq ⟨hzH₁,hz⟩,
  have hxH₁ : x ∉ H₁ := λ hxH₁, hx ⟨hxH₁, hFH₂ hxF⟩,

  have h₁ : z ∉ M.cl (insert x (H₁ ∩ H₂)),
  { intro hz', apply hxH₁,
    have h' := cl_exchange ⟨hz', by rwa (hH₁.flat.inter hH₂.flat).cl⟩,
    rw [h.cl_insert_eq ⟨hzH₁,hz⟩] at h',
    exact h'.1},

  have hycl : y ∈ M.cl (insert z (insert x (H₁ ∩ H₂))) \ M.cl (insert x (H₁ ∩ H₂)),
  { refine ⟨_,λ hy',hy _⟩,
    { rw [insert_comm, ←cl_insert_cl_eq_cl_insert, hzcl, hH₁.cl_insert_eq_univ hxH₁],
      exact mem_univ _ },
    exact hF.cl_subset_of_subset (insert_subset.mpr ⟨hxF,hssF⟩) hy' },

  refine hz ⟨hzH₁, mem_of_mem_of_subset (cl_exchange hycl) ((diff_subset _ _).trans
    (hH₂.flat.cl_subset_of_subset _))⟩,
  rw [insert_subset, insert_subset],
  exact ⟨hyH₂, hFH₂ hxF, inter_subset_right _ _⟩,
end

lemma hyperplane.inter_covby_comm (hH₁ : M.hyperplane H₁) (hH₂ : M.hyperplane H₂) :
  M.covby (H₁ ∩ H₂) H₁ ↔  M.covby (H₁ ∩ H₂) H₂ :=
⟨hH₁.inter_right_covby_of_inter_left_covby hH₂,
  by {rw inter_comm, intro h, exact hH₂.inter_right_covby_of_inter_left_covby hH₁ h}⟩

end matroid

section from_axioms

lemma cl_diff_singleton_eq_cl (cl : set E → set E) (subset_cl : ∀ X, X ⊆ cl X)
(cl_mono : ∀ X Y, X ⊆ Y → cl X ⊆ cl Y) (cl_idem : ∀ X, cl (cl X) = cl X )
{x : E} {I : set E} (h : x ∈ cl (I \ {x})) :
  cl (I \ {x}) = cl I :=
begin
  refine (cl_mono _ _ (diff_subset _ _)).antisymm _,
  have h' := cl_mono _ _ (insert_subset.mpr ⟨h, (subset_cl _ )⟩),
  rw [insert_diff_singleton, cl_idem] at h',
  exact (cl_mono _ _ (subset_insert _ _)).trans h',
end

/- ### closure and flat axioms -/
/-- A function satisfying the closure axioms determines a matroid -/
def matroid_of_cl (cl : set E → set E)
  (subset_cl : ∀ X, X ⊆ cl X )
  (cl_mono : ∀ X Y, X ⊆ Y → cl X ⊆ cl Y )
  (cl_idem : ∀ X, cl (cl X) = cl X )
  (cl_exchange : ∀ X e f, f ∈ cl (insert e X) \ cl X → e ∈ cl (insert f X) \ cl X ) :
matroid E :=
{ base := λ B, cl B = univ ∧ ∀ X ⊂ B, cl X ≠ univ,
  exists_base' :=
  let ⟨B,hB,hBmin⟩ := finite.exists_minimal (λ B, cl B = univ)
      ⟨univ, eq_univ_of_univ_subset (subset_cl _)⟩ in
    ⟨B, hB, λ X hXB hX, hXB.ne.symm (hBmin _ hX hXB.subset)⟩,
  base_exchange' :=
  begin
    intros B₁ B₂ hB₁ hB₂ x hx,
    by_contra' h,
    have h₁ : ∀ y ∈ B₂, y ∉ cl (B₁ \ {x}) → cl (insert y (B₁ \ {x})) = univ,
    { refine λ y hyB₂ hynotin, _,
      have hex := cl_exchange (B₁ \ {x}) x y,
      rw [insert_diff_singleton, insert_eq_of_mem hx.1, hB₁.1, ←compl_eq_univ_diff,
        mem_compl_iff] at hex,
      have h' := insert_subset.mpr ⟨(hex hynotin).1, (subset_insert _ _).trans (subset_cl _)⟩,
      rw [insert_diff_singleton, insert_eq_of_mem hx.1] at h',
      have h'' := cl_mono _ _ h',
      rwa [cl_idem, hB₁.1, univ_subset_iff] at h''},

    have hss : B₂ \ B₁ ⊆ cl (B₁ \ {x}),
    { refine λ y hy, by_contra (λ h', _),
      have hxy : x ≠ y,
      { rintro rfl, exact hx.2 hy.1},
      obtain ⟨A,⟨hAs,hA⟩,hAmin⟩ := finite.exists_minimal _ (h y hy (h₁ y hy.1 h')),
      have hxA : x ∉ A,
      { refine λ hxA, hxy _,  have := hAs.subset, simpa using this hxA},
      have hyA : y ∈ A,
      { by_contra hyA,
        exact hB₁.2 _ (((subset_insert_iff_of_not_mem hyA).mp hAs.subset).trans_ssubset
          (diff_singleton_ssubset hx.1)) hA},
      have hy' : B₁ ⊆ cl (A \ {y}),
      { refine λ z hz, by_contra (λ hz', _ ),
        have hzA : z ∈ cl (insert y (A \ {y})),
        { rw [insert_diff_singleton, insert_eq_of_mem hyA, hA], exact mem_univ _,},
        have h' := (cl_exchange _ _ _ ⟨hzA,hz'⟩).1,
        have h'' := insert_subset.mpr ⟨h', (subset_insert _ _).trans (subset_cl _)⟩,
        rw [insert_diff_singleton, insert_eq_of_mem hyA] at h'',
        have h''' := cl_mono _ _ h'',
        rw [hA, univ_subset_iff, cl_idem] at h''',
        refine hB₁.2 _ _ h''',
        refine ssubset_of_ne_of_subset _ (insert_subset.mpr ⟨hz,_⟩),
        { obtain (rfl | hxz) := eq_or_ne x z,
          { intro h_eq,
            rw [←h_eq, insert_diff_singleton_comm hxy.symm] at hAs,
            refine hAs.not_subset _,
            rw [diff_subset_iff, insert_comm, singleton_union, insert_diff_singleton,
              insert_eq_of_mem hyA], },
          simp_rw [ne.def, ext_iff, not_forall, mem_insert_iff, mem_diff, mem_singleton_iff],
          use x,
          have := hx.1, tauto},
        rw [diff_subset_iff, singleton_union],
        exact hAs.subset.trans (insert_subset_insert (diff_subset _ _))},
      have hA' := cl_mono _ _ hy',
      rw [hB₁.1, univ_subset_iff, cl_idem] at hA',
      refine (diff_singleton_ssubset hyA).ne.symm (hAmin _ ⟨_,hA'⟩ (diff_subset _ _)),
      exact (diff_subset _ _).trans_ssubset hAs},

  have ht : B₂ ⊆ _ := subset_trans _ (union_subset hss (subset_cl (B₁ \ {x}))),
  { have ht' := cl_mono _ _ ht,
    rw [hB₂.1, cl_idem, univ_subset_iff] at ht',
    exact hB₁.2 _ (diff_singleton_ssubset hx.1) ht'},
  nth_rewrite 0 [←diff_union_inter B₂ B₁],
  apply union_subset_union rfl.subset,
  rintros y ⟨hy2,hy1⟩,
  rw mem_diff_singleton,
  use hy1,
  rintro rfl,
  exact hx.2 hy2,
  end }

lemma matroid_of_cl_aux (cl : set E → set E)
  (subset_cl : ∀ X, X ⊆ cl X )
  (cl_mono : ∀ X Y, X ⊆ Y → cl X ⊆ cl Y )
  (cl_idem : ∀ X, cl (cl X) = cl X )
  (cl_exchange : ∀ X e f, f ∈ cl (insert e X) \ cl X → e ∈ cl (insert f X) \ cl X )
  {I : set E} :
(∀ x ∈ I, cl (I \ {x}) ≠ cl I) ↔ ∃ B, cl B = univ ∧ (∀ X ⊂ B, cl X ≠ univ) ∧ I ⊆ B :=
begin
  refine ⟨λ h, _, λ h x hI hcl, _⟩,
  { obtain ⟨B, ⟨hB, hIB⟩, hBmax⟩ :=
      finite.exists_maximal (λ X, (∀ e ∈ X, cl (X \ {e}) ≠ cl X) ∧ I ⊆ X)
         ⟨I, h, rfl.subset⟩,
    refine ⟨B, by_contra (λ hBu, _), λ X hXB hX, _, hIB⟩,
    { rw [←ne.def, ne_univ_iff_exists_not_mem] at hBu,
      obtain ⟨a,haB⟩ := hBu,
      have haB' : a ∉ B := λ haB', haB (subset_cl B haB'),
      rw hBmax (insert a B) _ (subset_insert _ _) at haB',
      { exact haB' (mem_insert _ _)},
      refine ⟨λ e heaB hcl, _,  hIB.trans (subset_insert _ _)⟩,
      have hea : e ≠ a,
      { rintro rfl,
        rw [insert_diff_self_of_not_mem haB'] at hcl,
        rw hcl at haB,
        exact haB ((subset_cl (insert e B)) (mem_insert e B))},
      have heB : e ∈ B := mem_of_mem_insert_of_ne heaB hea,
      have hecl : e ∉ cl ((insert a B) \ {e}),
      { refine λ h_in, hB e heB (cl_diff_singleton_eq_cl cl subset_cl cl_mono cl_idem _),
        by_contra hecl, apply haB,
        rw ←insert_diff_singleton_comm hea.symm  at h_in,
        have := (cl_exchange _ _ _ ⟨h_in,hecl⟩).1,
        rwa [insert_diff_singleton, insert_eq_of_mem heB] at this},
      rw hcl at hecl,
      exact hecl ((subset_cl _) heaB)},
    obtain ⟨e,heB, heX⟩ := exists_of_ssubset hXB,
    have hcon := hX.symm.trans_subset (cl_mono _ _ (subset_diff_singleton hXB.subset heX)),
    rw [univ_subset_iff] at hcon,
    refine hB e heB ((cl_mono _ _ (diff_subset _ _)).antisymm _),
    rw [hcon],
    apply subset_univ},
  obtain ⟨B, hBu, hBmax, hIB⟩ := h,
  refine hBmax _ (diff_singleton_ssubset (hIB hI)) _,
  rwa cl_diff_singleton_eq_cl cl subset_cl cl_mono cl_idem,
  have hdiff := cl_mono _ _  (@diff_subset_diff_left _ _ _ {x} hIB),
  rw [hcl] at hdiff,
  apply hdiff,
  apply subset_cl,
  exact hI,
end

@[simp] lemma matroid_of_cl_apply (cl : set E → set E)
  (subset_cl : ∀ X, X ⊆ cl X )
  (cl_mono : ∀ X Y, X ⊆ Y → cl X ⊆ cl Y )
  (cl_idem : ∀ X, cl (cl X) = cl X )
  (cl_exchange : ∀ X e f, f ∈ cl (insert e X) \ cl X → e ∈ cl (insert f X) \ cl X ) :
(matroid_of_cl cl subset_cl cl_mono cl_idem cl_exchange).cl = cl :=
begin
  set M := matroid_of_cl cl subset_cl cl_mono cl_idem cl_exchange with hM,
  apply funext,
  by_contra' h,
  obtain ⟨I,hI,hImin⟩ := finite.exists_minimal _ h,

  have hImin' : ∀ x ∈ I, M.cl (I \ {x}) = cl (I \ {x}),
  { by_contra' h,
    obtain ⟨x,hxI,hne⟩ := h,
    exact (diff_singleton_ssubset hxI).ne.symm (hImin _ hne (diff_subset _ _))},

  set indep : set E → Prop := λ I, ∀ x ∈ I, cl (I \ {x}) ≠ cl I with h_indep,

  have hIi : (M.indep I) ∧ (indep I),
  { rw [matroid.indep_iff_cl_diff_ne_forall],
    by_contra h', apply hI,
    simp_rw [not_and_distrib, h_indep, not_forall, not_ne_iff] at h',
    obtain (⟨x,hxI,hne⟩ | ⟨x,hxI,hne⟩) := h',
    { rw [←hne, hImin' _ hxI, cl_diff_singleton_eq_cl cl subset_cl cl_mono cl_idem],
      rw [←hImin' x hxI, hne],
      exact (M.subset_cl I) hxI},
    rw [←hne, ←hImin' _ hxI, cl_diff_singleton_eq_cl M.cl M.subset_cl M.cl_mono M.cl_cl],
    rw [hImin' _ hxI, hne],
    exact (subset_cl I) hxI},

  simp_rw [set.ext_iff, not_forall, not_iff, hIi.1.not_mem_cl_iff,
    matroid.indep_iff_subset_base, hM, matroid_of_cl] at hI,

  obtain ⟨x,hx⟩:= hI,
  obtain (hxI | hxI) := em (x ∈ cl I),
  { obtain ⟨hxI', B, ⟨hB, hBmin⟩, hxIB⟩ := hx.mpr hxI,
    refine hBmin (B \ {x}) (diff_singleton_ssubset (hxIB (mem_insert _ _))) _,
    rwa [cl_diff_singleton_eq_cl cl subset_cl cl_mono cl_idem],
    have hIBx : I ⊆ B \ {x}, from ((subset_diff_singleton ((subset_insert _ _).trans hxIB)) hxI'),
    exact cl_mono I (B \ {x}) hIBx hxI},

  have hxI' : x ∉ I, from λ hxI', hxI ((subset_cl _) hxI'),
  simp_rw [iff_false_right hxI, not_and, not_exists, not_and] at hx,

  have hxI : indep (insert x I),
   { rintro y (rfl | hy) h_eq,

    { simp only [insert_diff_of_mem, mem_singleton] at h_eq,
      refine hxI (cl_mono _ _ (diff_subset _ {y}) _),
      rw h_eq,
      refine subset_cl _ (mem_insert _ _)},

    have hxy : x ≠ y, {rintro rfl, exact hxI' hy},
    have hycl : y ∈ cl (insert x (I \ {y})),
    { rw [insert_diff_singleton_comm hxy, h_eq], apply subset_cl, exact subset_insert _ _ hy},
    have hy' : y ∉ cl (I \ {y}), from
      λ hy', hIi.2 y hy (cl_diff_singleton_eq_cl cl subset_cl cl_mono cl_idem  hy'),
    have h' := (cl_exchange _ _ _ ⟨hycl,hy'⟩).1,
    rw [insert_diff_singleton, insert_eq_of_mem hy] at h',
    exact hxI h' },
  rw [h_indep, matroid_of_cl_aux cl subset_cl cl_mono cl_idem cl_exchange] at hxI,
  obtain ⟨B, hB, hIB⟩ := hxI,
  exact hx hxI' B ⟨hB, hIB.1⟩ hIB.2,
end

lemma matroid_of_flat_aux (flat : set E → Prop) (univ_flat : flat univ)
(flat_inter : ∀ F₁ F₂, flat F₁ → flat F₂ → flat (F₁ ∩ F₂)) (X : set E) :
  flat (⋂₀ {F | flat F ∧ X ⊆ F}) ∧ ∀ F₀, flat F₀ → ((⋂₀ {F | flat F ∧ X ⊆ F}) ⊆ F₀ ↔ X ⊆ F₀) :=
begin
  set F₁ := ⋂₀ {F | flat F ∧ X ⊆ F} with hF₁,
  refine ⟨_, λ F₀ hF₀, ⟨λ hF₁F₀, _, λ hXF, _⟩⟩ ,
  { obtain ⟨F',⟨hF',hYF'⟩,hmin⟩ := finite.exists_minimal (λ F, flat F ∧ X ⊆ F)
      ⟨univ, univ_flat, subset_univ _⟩,
    convert hF',
    refine subset_antisymm (sInter_subset_of_mem ⟨hF',hYF'⟩) (subset_sInter _),
    rintro F ⟨hF,hYF⟩,
    rw hmin _ ⟨flat_inter _ _ hF hF', subset_inter hYF hYF'⟩ _,
    { apply inter_subset_left},
    apply inter_subset_right},
  { refine subset_trans (subset_sInter (λ F h, _)) hF₁F₀, exact h.2},
  apply sInter_subset_of_mem,
  exact ⟨hF₀, hXF⟩,
end

/-- A collection of sets satisfying the flat axioms determines a matroid -/
def matroid_of_flat (flat : set E → Prop) (univ_flat : flat univ)
(flat_inter : ∀ F₁ F₂, flat F₁ → flat F₂ → flat (F₁ ∩ F₂))
(flat_partition : ∀ F₀ e, flat F₀ → e ∉ F₀ →
  ∃! F₁, flat F₁ ∧ insert e F₀ ⊆ F₁ ∧ ∀ F, flat F → F₀ ⊆ F → F ⊂ F₁ → F₀ = F) :=
matroid_of_cl (λ X, ⋂₀ {F | flat F ∧ X ⊆ F})
(λ X, subset_sInter (λ F, and.right))
(λ X Y hXY, subset_sInter (λ F hF, by {apply sInter_subset_of_mem, exact ⟨hF.1, hXY.trans hF.2⟩}))
(begin
  refine λ X, (subset_sInter (λ F, and.right)).antisymm' _,
  simp only [subset_sInter_iff, mem_set_of_eq, and_imp],
  rintro F hF hXF,
  apply sInter_subset_of_mem,
  split, assumption,
  apply sInter_subset_of_mem,
  exact ⟨hF, hXF⟩,
end )
(begin
  simp only [mem_diff, mem_sInter, mem_set_of_eq, and_imp, not_forall, exists_prop,
    forall_exists_index],
  refine λ X e f h F₀ hF₀ hXF₀ hfF₀, ⟨λ Ff hFf hfXf, _,
    ⟨F₀, hF₀, hXF₀, λ heF₀, hfF₀ (h _ hF₀ (insert_subset.mpr ⟨heF₀,hXF₀⟩))⟩⟩,

  obtain ⟨hFX, hX'⟩    := matroid_of_flat_aux flat univ_flat flat_inter X,
  obtain ⟨hFXe, hXe'⟩  := matroid_of_flat_aux flat univ_flat flat_inter (insert e X),
  obtain ⟨hFXf, hXf'⟩  := matroid_of_flat_aux flat univ_flat flat_inter (insert f X),

  set FX := sInter {F | flat F ∧ X ⊆ F} with hFX_def,
  set FXe := sInter {F | flat F ∧ insert e X ⊆ F} with hFXe_def,
  set FXf := sInter {F | flat F ∧ insert f X ⊆ F} with hFXe_def,

  apply (hXf' Ff hFf).mpr hfXf,
  have heFXe : e ∈ FXe := mem_sInter.mpr (λ _ hF, hF.2 (mem_insert _ _)),
  have hfFXf : f ∈ FXf := mem_sInter.mpr (λ _ hF, hF.2 (mem_insert _ _)),

  have hXFX : X ⊆ FX := subset_sInter (λ _, and.right),
  have hfFX : f ∉ FX := λ hfFX, hfF₀ ((hX' F₀ hF₀).mpr hXF₀ hfFX),
  have heFX : e ∉ FX := λ heFX, hfFX (h _ hFX (insert_subset.mpr ⟨heFX, hXFX⟩)),
  have hFXFXe : FX ⊆ FXe,
  { rw [hX' FXe hFXe], exact subset_sInter (λ F hF, (subset_insert _ _).trans hF.2)},
  have hFXFXf : FX ⊆ FXf,
  { rw [hX' FXf hFXf], exact subset_sInter (λ F hF, (subset_insert _ _).trans hF.2)},

  have hfFXe := h FXe hFXe (insert_subset.mpr ⟨heFXe,hXFX.trans hFXFXe⟩),

  have hss := (hXf' _ hFXe).mpr (insert_subset.mpr ⟨hfFXe, hXFX.trans hFXFXe⟩),

  suffices h_eq : FXf = FXe, by rwa h_eq,
  by_contra h_ne, apply hfFX,
  have hssu := ssubset_of_subset_of_ne hss h_ne,

  obtain ⟨FXe',⟨hFXe',heFX',hmin⟩, hunique⟩ := flat_partition FX e hFX heFX,

  have hFXemin : ∀ (F : set E), flat F → FX ⊆ F → F ⊂ FXe → FX = F, from
  λ F hF hFXF hFFXe, hmin _ hF hFXF
    (hFFXe.trans_subset ((hXe' _ hFXe').mpr ((insert_subset_insert hXFX).trans heFX'))),

  rw hunique FXe ⟨hFXe, insert_subset.mpr ⟨heFXe, hFXFXe⟩, hFXemin⟩ at hssu,
  rwa ← (hmin _ hFXf hFXFXf hssu) at hfFXf,
end)

@[simp] lemma matroid_of_flat_apply (flat : set E → Prop) (univ_flat : flat univ)
(flat_inter : ∀ F₁ F₂, flat F₁ → flat F₂ → flat (F₁ ∩ F₂))
(flat_partition : ∀ F₀ e, flat F₀ → e ∉ F₀ →
∃! F₁, flat F₁ ∧ insert e F₀ ⊆ F₁ ∧ ∀ F, flat F → F₀ ⊆ F → F ⊂ F₁ → F₀ = F) :
  (matroid_of_flat flat univ_flat flat_inter flat_partition).flat = flat :=
begin
  ext F,
  simp_rw [matroid_of_flat, matroid.flat_iff_cl_self, matroid_of_cl_apply],
  refine ⟨λ hF, _, λ hF, _⟩,
  { rw ←hF, exact (matroid_of_flat_aux flat univ_flat flat_inter _).1},
  exact (subset_sInter (λ F', and.right)).antisymm' (sInter_subset_of_mem ⟨hF,rfl.subset⟩),
end

end from_axioms


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

import analysis.specific_limits.normed

/-!
# Normed groups homomorphisms

This file gathers definitions and elementary constructions about bounded group homomorphisms
between normed (abelian) groups (abbreviated to "normed group homs").

The main lemmas relate the boundedness condition to continuity and Lipschitzness.

The main construction is to endow the type of normed group homs between two given normed groups
with a group structure and a norm, giving rise to a normed group structure. We provide several
simple constructions for normed group homs, like kernel, range and equalizer.

Some easy other constructions are related to subgroups of normed groups.

Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the
theory of `semi_normed_group_hom` and we specialize to `normed_group_hom` when needed.
-/

noncomputable theory
open_locale nnreal big_operators

/-- A morphism of seminormed abelian groups is a bounded group homomorphism. -/
structure normed_group_hom (V W : Type*) [semi_normed_group V] [semi_normed_group W] :=
(to_fun : V → W)
(map_add' : ∀ v₁ v₂, to_fun (v₁ + v₂) = to_fun v₁ + to_fun v₂)
(bound' : ∃ C, ∀ v, ∥to_fun v∥ ≤ C * ∥v∥)

namespace add_monoid_hom

variables {V W : Type*} [semi_normed_group V] [semi_normed_group W] {f g : normed_group_hom V W}

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom'` for a version that uses `ℝ≥0` for the bound. -/
def mk_normed_group_hom (f : V →+ W)
  (C : ℝ) (h : ∀ v, ∥f v∥ ≤ C * ∥v∥) : normed_group_hom V W :=
{ bound' := ⟨C, h⟩, ..f }

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom` for a version that uses `ℝ` for the bound. -/
def mk_normed_group_hom' (f : V →+ W) (C : ℝ≥0) (hC : ∀ x, ∥f x∥₊ ≤ C * ∥x∥₊) :
  normed_group_hom V W :=
{ bound' := ⟨C, hC⟩ .. f}

end add_monoid_hom

lemma exists_pos_bound_of_bound {V W : Type*} [semi_normed_group V] [semi_normed_group W]
  {f : V → W} (M : ℝ) (h : ∀x, ∥f x∥ ≤ M * ∥x∥) :
  ∃ N, 0 < N ∧ ∀x, ∥f x∥ ≤ N * ∥x∥ :=
⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _), λx, calc
  ∥f x∥ ≤ M * ∥x∥ : h x
  ... ≤ max M 1 * ∥x∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ⟩

namespace normed_group_hom

variables {V V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group V₁] [semi_normed_group V₂] [semi_normed_group V₃]
variables {f g : normed_group_hom V₁ V₂}

instance : has_coe_to_fun (normed_group_hom V₁ V₂) (λ _, V₁ → V₂) := ⟨normed_group_hom.to_fun⟩

initialize_simps_projections normed_group_hom (to_fun → apply)

lemma coe_inj (H : (f : V₁ → V₂) = g) : f = g :=
by cases f; cases g; congr'; exact funext H

lemma coe_injective : @function.injective (normed_group_hom V₁ V₂) (V₁ → V₂) coe_fn :=
by apply coe_inj

lemma coe_inj_iff : f = g ↔ (f : V₁ → V₂) = g := ⟨congr_arg _, coe_inj⟩

@[ext] lemma ext (H : ∀ x, f x = g x) : f = g := coe_inj $ funext H

lemma ext_iff : f = g ↔ ∀ x, f x = g x := ⟨by rintro rfl x; refl, ext⟩

variables (f g)

@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl

@[simp] lemma coe_mk (f) (h₁) (h₂) (h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : normed_group_hom V₁ V₂) = f := rfl

@[simp] lemma coe_mk_normed_group_hom (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom C hC) = f := rfl

@[simp] lemma coe_mk_normed_group_hom' (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom' C hC) = f := rfl

/-- The group homomorphism underlying a bounded group homomorphism. -/
def to_add_monoid_hom (f : normed_group_hom V₁ V₂) : V₁ →+ V₂ :=
add_monoid_hom.mk' f f.map_add'

@[simp] lemma coe_to_add_monoid_hom : ⇑f.to_add_monoid_hom = f := rfl

lemma to_add_monoid_hom_injective :
  function.injective (@normed_group_hom.to_add_monoid_hom V₁ V₂ _ _) :=
λ f g h, coe_inj $ show ⇑f.to_add_monoid_hom = g, by { rw h, refl }

@[simp]

@[simp] lemma map_zero : f 0 = 0 := f.to_add_monoid_hom.map_zero

@[simp] lemma map_add (x y) : f (x + y) = f x + f y := f.to_add_monoid_hom.map_add _ _

@[simp] lemma map_sum {ι : Type*} (v : ι → V₁) (s : finset ι) :
  f (∑ i in s, v i) = ∑ i in s, f (v i) :=
f.to_add_monoid_hom.map_sum _ _

@[simp] lemma map_sub (x y) : f (x - y) = f x - f y := f.to_add_monoid_hom.map_sub _ _

@[simp] lemma map_neg (x) : f (-x) = -(f x) := f.to_add_monoid_hom.map_neg _

lemma bound : ∃ C, 0 < C ∧ ∀ x, ∥f x∥ ≤ C * ∥x∥ :=
let ⟨C, hC⟩ := f.bound' in exists_pos_bound_of_bound _ hC

theorem antilipschitz_of_norm_ge {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) :
  antilipschitz_with K f :=
antilipschitz_with.of_le_mul_dist $
λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y)

/-- A normed group hom is surjective on the subgroup `K` with constant `C` if every element
`x` of `K` has a preimage whose norm is bounded above by `C*∥x∥`. This is a more
abstract version of `f` having a right inverse defined on `K` with operator norm
at most `C`. -/
def surjective_on_with (f : normed_group_hom V₁ V₂) (K : add_subgroup V₂) (C : ℝ) : Prop :=
  ∀ h ∈ K, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥

lemma surjective_on_with.mono {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C C' : ℝ}
  (h : f.surjective_on_with K C) (H : C ≤ C') : f.surjective_on_with K C' :=
begin
  intros k k_in,
  rcases h k k_in with ⟨g, rfl, hg⟩,
  use [g, rfl],
  by_cases Hg : ∥f g∥ = 0,
  { simpa [Hg] using hg },
  { exact hg.trans ((mul_le_mul_right $ (ne.symm Hg).le_iff_lt.mp (norm_nonneg _)).mpr H) }
end

lemma surjective_on_with.exists_pos {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : ∃ C' > 0, f.surjective_on_with K C' :=
begin
  refine ⟨|C| + 1, _, _⟩,
  { linarith [abs_nonneg C] },
  { apply h.mono,
    linarith [le_abs_self C] }
end

lemma surjective_on_with.surj_on {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : set.surj_on f set.univ K :=
λ x hx, (h x hx).imp $ λ a ⟨ha, _⟩, ⟨set.mem_univ _, ha⟩

/-! ### The operator norm -/

/-- The operator norm of a seminormed group homomorphism is the inf of all its bounds. -/
def op_norm (f : normed_group_hom V₁ V₂) := Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥}
instance has_op_norm : has_norm (normed_group_hom V₁ V₂) := ⟨op_norm⟩

lemma norm_def : ∥f∥ = Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := rfl

-- So that invocations of `le_cInf` make sense: we show that the set of
-- bounds is nonempty and bounded below.
lemma bounds_nonempty {f : normed_group_hom V₁ V₂} :
  ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } :=
let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩

lemma bounds_bdd_below {f : normed_group_hom V₁ V₂} :
  bdd_below {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} :=
⟨0, λ _ ⟨hn, _⟩, hn⟩

lemma op_norm_nonneg : 0 ≤ ∥f∥ :=
le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx)

/-- The fundamental property of the operator norm: `∥f x∥ ≤ ∥f∥ * ∥x∥`. -/
theorem le_op_norm (x : V₁) : ∥f x∥ ≤ ∥f∥ * ∥x∥ :=
begin
  obtain ⟨C, Cpos, hC⟩ := f.bound,
  replace hC := hC x,
  by_cases h : ∥x∥ = 0,
  { rwa [h, mul_zero] at ⊢ hC },
  have hlt : 0 < ∥x∥ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h),
  exact (div_le_iff hlt).mp (le_cInf bounds_nonempty (λ c ⟨_, hc⟩,
    (div_le_iff hlt).mpr $ by { apply hc })),
end

theorem le_op_norm_of_le {c : ℝ} {x} (h : ∥x∥ ≤ c) : ∥f x∥ ≤ ∥f∥ * c :=
le_trans (f.le_op_norm x) (mul_le_mul_of_nonneg_left h f.op_norm_nonneg)

theorem le_of_op_norm_le {c : ℝ} (h : ∥f∥ ≤ c) (x : V₁) : ∥f x∥ ≤ c * ∥x∥ :=
(f.le_op_norm x).trans (mul_le_mul_of_nonneg_right h (norm_nonneg x))

/-- continuous linear maps are Lipschitz continuous. -/
theorem lipschitz : lipschitz_with ⟨∥f∥, op_norm_nonneg f⟩ f :=
lipschitz_with.of_dist_le_mul $ λ x y,
  by { rw [dist_eq_norm, dist_eq_norm, ←map_sub], apply le_op_norm }

protected lemma uniform_continuous (f : normed_group_hom V₁ V₂) :
  uniform_continuous f := f.lipschitz.uniform_continuous

@[continuity]
protected lemma continuous (f : normed_group_hom V₁ V₂) : continuous f :=
f.uniform_continuous.continuous

lemma ratio_le_op_norm (x : V₁) : ∥f x∥ / ∥x∥ ≤ ∥f∥ :=
div_le_of_nonneg_of_le_mul (norm_nonneg _) f.op_norm_nonneg (le_op_norm _ _)

/-- If one controls the norm of every `f x`, then one controls the norm of `f`. -/
lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ∥f x∥ ≤ M * ∥x∥) :
  ∥f∥ ≤ M :=
cInf_le bounds_bdd_below ⟨hMp, hM⟩

lemma op_norm_eq_of_bounds {M : ℝ} (M_nonneg : 0 ≤ M)
  (h_above : ∀ x, ∥f x∥ ≤ M*∥x∥) (h_below : ∀ N ≥ 0, (∀ x, ∥f x∥ ≤ N*∥x∥) → M ≤ N) :
  ∥f∥ = M :=
le_antisymm (f.op_norm_le_bound M_nonneg h_above)
  ((le_cInf_iff normed_group_hom.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $
   λ N ⟨N_nonneg, hN⟩, h_below N N_nonneg hN)

theorem op_norm_le_of_lipschitz {f : normed_group_hom V₁ V₂} {K : ℝ≥0} (hf : lipschitz_with K f) :
  ∥f∥ ≤ K :=
f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, f.map_zero] using hf.dist_le_mul x 0

/-- If a bounded group homomorphism map is constructed from a group homomorphism via the constructor
`mk_normed_group_hom`, then its norm is bounded by the bound given to the constructor if it is
nonnegative. -/
lemma mk_normed_group_hom_norm_le (f : V₁ →+ V₂) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ C :=
op_norm_le_bound _ hC h

/-- If a bounded group homomorphism map is constructed from a group homomorphism
via the constructor `mk_normed_group_hom`, then its norm is bounded by the bound
given to the constructor or zero if this bound is negative. -/
lemma mk_normed_group_hom_norm_le' (f : V₁ →+ V₂) {C : ℝ} (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ max C 0 :=
op_norm_le_bound _ (le_max_right _ _) $ λ x, (h x).trans $
  mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg x)

alias mk_normed_group_hom_norm_le ← add_monoid_hom.mk_normed_group_hom_norm_le
alias mk_normed_group_hom_norm_le' ← add_monoid_hom.mk_normed_group_hom_norm_le'

/-! ### Addition of normed group homs -/

/-- Addition of normed group homs. -/
instance : has_add (normed_group_hom V₁ V₂) :=
⟨λ f g, (f.to_add_monoid_hom + g.to_add_monoid_hom).mk_normed_group_hom (∥f∥ + ∥g∥) $ λ v, calc
  ∥f v + g v∥
      ≤ ∥f v∥ + ∥g v∥ : norm_add_le _ _
  ... ≤ ∥f∥ * ∥v∥ + ∥g∥ * ∥v∥ : add_le_add (le_op_norm f v) (le_op_norm g v)
  ... = (∥f∥ + ∥g∥) * ∥v∥ : by rw add_mul⟩

/-- The operator norm satisfies the triangle inequality. -/
theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ :=
mk_normed_group_hom_norm_le _ (add_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

/--
Terms containing `@has_add.add (has_coe_to_fun.F ...) pi.has_add`
seem to cause leanchecker to [crash due to an out-of-memory
condition](https://github.com/leanprover-community/lean/issues/543).
As a workaround, we add a type annotation: `(f + g : V₁ → V₂)`
-/
library_note "addition on function coercions"

-- see Note [addition on function coercions]
@[simp] lemma coe_add (f g : normed_group_hom V₁ V₂) : ⇑(f + g) = (f + g : V₁ → V₂) := rfl
@[simp] lemma add_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f + g : normed_group_hom V₁ V₂) v = f v + g v := rfl

/-! ### The zero normed group hom -/

instance : has_zero (normed_group_hom V₁ V₂) :=
⟨(0 : V₁ →+ V₂).mk_normed_group_hom 0 (by simp)⟩

instance : inhabited (normed_group_hom V₁ V₂) := ⟨0⟩

/-- The norm of the `0` operator is `0`. -/
theorem op_norm_zero : ∥(0 : normed_group_hom V₁ V₂)∥ = 0 :=
le_antisymm (cInf_le bounds_bdd_below
    ⟨ge_of_eq rfl, λ _, le_of_eq (by { rw [zero_mul], exact norm_zero })⟩)
    (op_norm_nonneg _)

/-- For normed groups, an operator is zero iff its norm vanishes. -/
theorem op_norm_zero_iff {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂]
  {f : normed_group_hom V₁ V₂} : ∥f∥ = 0 ↔ f = 0 :=
iff.intro
  (λ hn, ext (λ x, norm_le_zero_iff.1
    (calc _ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _
     ...     = _ : by rw [hn, zero_mul])))
  (λ hf, by rw [hf, op_norm_zero] )

-- see Note [addition on function coercions]
@[simp] lemma coe_zero : ⇑(0 : normed_group_hom V₁ V₂) = (0 : V₁ → V₂) := rfl
@[simp] lemma zero_apply (v : V₁) : (0 : normed_group_hom V₁ V₂) v = 0 := rfl

variables {f g}

/-! ### The identity normed group hom -/

variable (V)

/-- The identity as a continuous normed group hom. -/
@[simps]
def id : normed_group_hom V V :=
(add_monoid_hom.id V).mk_normed_group_hom 1 (by simp [le_refl])

/-- The norm of the identity is at most `1`. It is in fact `1`, except when the norm of every
element vanishes, where it is `0`. (Since we are working with seminorms this can happen even if the
space is non-trivial.) It means that one can not do better than an inequality in general. -/
lemma norm_id_le : ∥(id V : normed_group_hom V V)∥ ≤ 1 :=
op_norm_le_bound _ zero_le_one (λx, by simp)

/-- If there is an element with norm different from `0`, then the norm of the identity equals `1`.
(Since we are working with seminorms supposing that the space is non-trivial is not enough.) -/
lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : V), ∥x∥ ≠ 0 ) :
  ∥(id V)∥ = 1 :=
le_antisymm (norm_id_le V) $ let ⟨x, hx⟩ := h in
have _ := (id V).ratio_le_op_norm x,
by rwa [id_apply, div_self hx] at this

/-- If a normed space is non-trivial, then the norm of the identity equals `1`. -/
lemma norm_id {V : Type*} [normed_group V] [nontrivial V] : ∥(id V)∥ = 1 :=
begin
  refine norm_id_of_nontrivial_seminorm V _,
  obtain ⟨x, hx⟩ := exists_ne (0 : V),
  exact ⟨x, ne_of_gt (norm_pos_iff.2 hx)⟩,
end

lemma coe_id : ((normed_group_hom.id V) : V → V) = (_root_.id : V → V) := rfl

/-! ### The negation of a normed group hom -/

/-- Opposite of a normed group hom. -/
instance : has_neg (normed_group_hom V₁ V₂) :=
⟨λ f, (-f.to_add_monoid_hom).mk_normed_group_hom (∥f∥) (λ v, by simp [le_op_norm f v])⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_neg (f : normed_group_hom V₁ V₂) : ⇑(-f) = (-f : V₁ → V₂) := rfl
@[simp] lemma neg_apply (f : normed_group_hom V₁ V₂) (v : V₁) :
  (-f : normed_group_hom V₁ V₂) v = - (f v) := rfl

lemma op_norm_neg (f : normed_group_hom V₁ V₂) : ∥-f∥ = ∥f∥ :=
by simp only [norm_def, coe_neg, norm_neg, pi.neg_apply]

/-! ### Subtraction of normed group homs -/

/-- Subtraction of normed group homs. -/
instance : has_sub (normed_group_hom V₁ V₂) :=
⟨λ f g,
{ bound' :=
  begin
    simp only [add_monoid_hom.sub_apply, add_monoid_hom.to_fun_eq_coe, sub_eq_add_neg],
    exact (f + -g).bound'
  end,
  .. (f.to_add_monoid_hom - g.to_add_monoid_hom) }⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_sub (f g : normed_group_hom V₁ V₂) : ⇑(f - g) = (f - g : V₁ → V₂) := rfl
@[simp] lemma sub_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f - g : normed_group_hom V₁ V₂) v = f v - g v := rfl

/-! ### Scalar actions on normed group homs -/

section has_scalar

variables {R R' : Type*}
  [monoid_with_zero R] [distrib_mul_action R V₂] [pseudo_metric_space R] [has_bounded_smul R V₂]
  [monoid_with_zero R'] [distrib_mul_action R' V₂] [pseudo_metric_space R'] [has_bounded_smul R' V₂]

instance : has_scalar R (normed_group_hom V₁ V₂) :=
{ smul := λ r f,
  { to_fun := r • f,
    map_add' := (r • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in  ⟨dist r 0 * b, λ x, begin
      have := dist_smul_pair r (f x) (f 0),
      rw [f.map_zero, smul_zero, dist_zero_right, dist_zero_right] at this,
      rw mul_assoc,
      refine this.trans _,
      refine mul_le_mul_of_nonneg_left _ dist_nonneg,
      exact hb x
    end⟩ } }

@[simp] lemma coe_smul (r : R) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma smul_apply (r : R) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

instance [smul_comm_class R R' V₂] : smul_comm_class R R' (normed_group_hom V₁ V₂) :=
{ smul_comm := λ r r' f, ext $ λ v, smul_comm _ _ _ }

instance [has_scalar R R'] [is_scalar_tower R R' V₂] :
  is_scalar_tower R R' (normed_group_hom V₁ V₂) :=
{ smul_assoc := λ r r' f, ext $ λ v, smul_assoc _ _ _ }

instance [distrib_mul_action Rᵐᵒᵖ V₂] [is_central_scalar R V₂] :
  is_central_scalar R (normed_group_hom V₁ V₂) :=
{ op_smul_eq_smul := λ r f, ext $ λ v, op_smul_eq_smul _ _ }

end has_scalar

instance has_nat_scalar : has_scalar ℕ (normed_group_hom V₁ V₂) :=
{ smul := λ n f,
  { to_fun := n • f,
    map_add' := (n • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in ⟨n • b, λ v, begin
      rw [pi.smul_apply, nsmul_eq_mul, mul_assoc],
      exact (norm_nsmul_le _ _).trans (mul_le_mul_of_nonneg_left (hb _) (nat.cast_nonneg _)),
    end⟩ } }

@[simp] lemma coe_nsmul (r : ℕ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma nsmul_apply (r : ℕ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

instance has_int_scalar : has_scalar ℤ (normed_group_hom V₁ V₂) :=
{ smul := λ z f,
  { to_fun := z • f,
    map_add' := (z • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in ⟨∥z∥ • b, λ v, begin
      rw [pi.smul_apply, smul_eq_mul, mul_assoc],
      exact (norm_zsmul_le _ _).trans  (mul_le_mul_of_nonneg_left (hb _) $ norm_nonneg _),
    end⟩ } }

@[simp] lemma coe_zsmul (r : ℤ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma zsmul_apply (r : ℤ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

/-! ### Normed group structure on normed group homs -/

/-- Homs between two given normed groups form a commutative additive group. -/
instance : add_comm_group (normed_group_hom V₁ V₂) :=
coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-- Normed group homomorphisms themselves form a seminormed group with respect to
    the operator norm. -/
instance to_semi_normed_group : semi_normed_group (normed_group_hom V₁ V₂) :=
semi_normed_group.of_core _ ⟨op_norm_zero, op_norm_add_le, op_norm_neg⟩

/-- Normed group homomorphisms themselves form a normed group with respect to
    the operator norm. -/
instance to_normed_group {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂] :
  normed_group (normed_group_hom V₁ V₂) :=
normed_group.of_core _ ⟨λ f, op_norm_zero_iff, op_norm_add_le, op_norm_neg⟩

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

@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) :
  ⇑(∑ i in s, f i) = ∑ i in s, (f i) :=
(coe_fn_add_hom : _ →+ (V₁ → V₂)).map_sum f s

lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) (v : V₁) :
  (∑ i in s, f i) v = ∑ i in s, (f i v) :=
by simp only [coe_sum, finset.sum_apply]

/-! ### Module structure on normed group homs -/

instance {R : Type*} [monoid_with_zero R] [distrib_mul_action R V₂]
  [pseudo_metric_space R] [has_bounded_smul R V₂] :
  distrib_mul_action R (normed_group_hom V₁ V₂) :=
function.injective.distrib_mul_action coe_fn_add_hom coe_injective coe_smul

instance {R : Type*} [semiring R] [module R V₂]
  [pseudo_metric_space R] [has_bounded_smul R V₂] :
  module R (normed_group_hom V₁ V₂) :=
function.injective.module _ coe_fn_add_hom coe_injective coe_smul

/-! ### Composition of normed group homs -/

/-- The composition of continuous normed group homs. -/
@[simps]
protected def comp (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  normed_group_hom V₁ V₃ :=
(g.to_add_monoid_hom.comp f.to_add_monoid_hom).mk_normed_group_hom (∥g∥ * ∥f∥) $ λ v, calc
∥g (f v)∥ ≤ ∥g∥ * ∥f v∥ : le_op_norm _ _
... ≤ ∥g∥ * (∥f∥ * ∥v∥) : mul_le_mul_of_nonneg_left (le_op_norm _ _) (op_norm_nonneg _)
... = ∥g∥ * ∥f∥ * ∥v∥   : by rw mul_assoc

lemma norm_comp_le (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  ∥g.comp f∥ ≤ ∥g∥ * ∥f∥ :=
mk_normed_group_hom_norm_le _ (mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

lemma norm_comp_le_of_le {g : normed_group_hom V₂ V₃} {C₁ C₂ : ℝ} (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) :
  ∥g.comp f∥ ≤ C₂ * C₁ :=
le_trans (norm_comp_le g f) $ mul_le_mul hg hf (norm_nonneg _) (le_trans (norm_nonneg _) hg)

lemma norm_comp_le_of_le' {g : normed_group_hom V₂ V₃} (C₁ C₂ C₃ : ℝ) (h : C₃ = C₂ * C₁)
  (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) : ∥g.comp f∥ ≤ C₃ :=
by { rw h, exact norm_comp_le_of_le hg hf }

/-- Composition of normed groups hom as an additive group morphism. -/
def comp_hom : (normed_group_hom V₂ V₃) →+ (normed_group_hom V₁ V₂) →+ (normed_group_hom V₁ V₃) :=
add_monoid_hom.mk' (λ g, add_monoid_hom.mk' (λ f, g.comp f)
  (by { intros, ext, exact g.map_add _ _ }))
  (by { intros, ext, simp only [comp_apply, pi.add_apply, function.comp_app,
                                add_monoid_hom.add_apply, add_monoid_hom.mk'_apply, coe_add] })

@[simp] lemma comp_zero (f : normed_group_hom V₂ V₃) : f.comp (0 : normed_group_hom V₁ V₂) = 0 :=
by { ext, exact f.map_zero }

@[simp] lemma zero_comp (f : normed_group_hom V₁ V₂) : (0 : normed_group_hom V₂ V₃).comp f = 0 :=
by { ext, refl }

lemma comp_assoc {V₄: Type* } [semi_normed_group V₄] (h : normed_group_hom V₃ V₄)
  (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  (h.comp g).comp f = h.comp (g.comp f) :=
by { ext, refl }

lemma coe_comp (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) :
  (g.comp f : V₁ → V₃) = (g : V₂ → V₃) ∘ (f : V₁ → V₂) := rfl

end normed_group_hom

namespace normed_group_hom

variables {V W V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group W] [semi_normed_group V₁] [semi_normed_group V₂]
[semi_normed_group V₃]

/-- The inclusion of an `add_subgroup`, as bounded group homomorphism. -/
@[simps] def incl (s : add_subgroup V) : normed_group_hom s V :=
{ to_fun := (coe : s → V),
  map_add' := λ v w, add_subgroup.coe_add _ _ _,
  bound' := ⟨1, λ v, by { rw [one_mul], refl }⟩ }

lemma norm_incl {V' : add_subgroup V} (x : V') : ∥incl _ x∥ = ∥x∥ :=
rfl

/-!### Kernel -/
section kernels
variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The kernel of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def ker : add_subgroup V₁ := f.to_add_monoid_hom.ker

lemma mem_ker (v : V₁) : v ∈ f.ker ↔ f v = 0 :=
by { erw f.to_add_monoid_hom.mem_ker, refl }

/-- Given a normed group hom `f : V₁ → V₂` satisfying `g.comp f = 0` for some `g : V₂ → V₃`,
    the corestriction of `f` to the kernel of `g`. -/
@[simps] def ker.lift (h : g.comp f = 0) :
  normed_group_hom V₁ g.ker :=
{ to_fun := λ v, ⟨f v, by { erw g.mem_ker, show (g.comp f) v = 0, rw h, refl }⟩,
  map_add' := λ v w, by { simp only [map_add], refl },
  bound' := f.bound' }

@[simp] lemma ker.incl_comp_lift (h : g.comp f = 0) :
  (incl g.ker).comp (ker.lift f g h) = f :=
by { ext, refl }

@[simp]
lemma ker_zero : (0 : normed_group_hom V₁ V₂).ker = ⊤ :=
by { ext, simp [mem_ker] }

lemma coe_ker : (f.ker : set V₁) = (f : V₁ → V₂) ⁻¹' {0} := rfl

lemma is_closed_ker {V₂ : Type*} [normed_group V₂] (f : normed_group_hom V₁ V₂) :
  is_closed (f.ker : set V₁) :=
f.coe_ker ▸ is_closed.preimage f.continuous (t1_space.t1 0)

end kernels

/-! ### Range -/
section range

variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The image of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def range : add_subgroup V₂ := f.to_add_monoid_hom.range

lemma mem_range (v : V₂) : v ∈ f.range ↔ ∃ w, f w = v :=
by { rw [range, add_monoid_hom.mem_range], refl }

@[simp]
lemma mem_range_self (v : V₁) : f v ∈ f.range :=
⟨v, rfl⟩

lemma comp_range : (g.comp f).range = add_subgroup.map g.to_add_monoid_hom f.range :=
by { erw add_monoid_hom.map_range, refl }

lemma incl_range (s : add_subgroup V₁) : (incl s).range = s :=
by { ext x, exact ⟨λ ⟨y, hy⟩, by { rw ← hy; simp }, λ hx, ⟨⟨x, hx⟩, by simp⟩⟩ }

@[simp]
lemma range_comp_incl_top : (f.comp (incl (⊤ : add_subgroup V₁))).range = f.range :=
by simpa [comp_range, incl_range, ← add_monoid_hom.range_eq_map]

end range

variables {f : normed_group_hom V W}

/-- A `normed_group_hom` is *norm-nonincreasing* if `∥f v∥ ≤ ∥v∥` for all `v`. -/
def norm_noninc (f : normed_group_hom V W) : Prop :=
∀ v, ∥f v∥ ≤ ∥v∥

namespace norm_noninc

lemma norm_noninc_iff_norm_le_one : f.norm_noninc ↔ ∥f∥ ≤ 1 :=
begin
  refine ⟨λ h, _, λ h, λ v, _⟩,
  { refine op_norm_le_bound _ (zero_le_one) (λ v, _),
    simpa [one_mul] using h v },
  { simpa using le_of_op_norm_le f h v }
end

lemma zero : (0 : normed_group_hom V₁ V₂).norm_noninc :=
λ v, by simp

lemma id : (id V).norm_noninc :=
λ v, le_rfl

lemma comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : g.norm_noninc) (hf : f.norm_noninc) :
  (g.comp f).norm_noninc :=
λ v, (hg (f v)).trans (hf v)

@[simp] lemma neg_iff {f : normed_group_hom V₁ V₂} : (-f).norm_noninc ↔ f.norm_noninc :=
⟨λ h x, by { simpa using h x }, λ h x, (norm_neg (f x)).le.trans (h x)⟩

end norm_noninc

section isometry

lemma isometry_iff_norm (f : normed_group_hom V W) :
  isometry f ↔ ∀ v, ∥f v∥ = ∥v∥ :=
add_monoid_hom.isometry_iff_norm f.to_add_monoid_hom

lemma isometry_of_norm (f : normed_group_hom V W) (hf : ∀ v, ∥f v∥ = ∥v∥) :
  isometry f :=
f.isometry_iff_norm.mpr hf

lemma norm_eq_of_isometry {f : normed_group_hom V W} (hf : isometry f) (v : V) :
  ∥f v∥ = ∥v∥ :=
f.isometry_iff_norm.mp hf v

lemma isometry_id : @isometry V V _ _ (id V) :=
isometry_id

lemma isometry_comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : isometry g) (hf : isometry f) :
  isometry (g.comp f) :=
hg.comp hf

lemma norm_noninc_of_isometry (hf : isometry f) : f.norm_noninc :=
λ v, le_of_eq $ norm_eq_of_isometry hf v

end isometry

variables {W₁ W₂ W₃ : Type*} [semi_normed_group W₁] [semi_normed_group W₂] [semi_normed_group W₃]
variables (f) (g : normed_group_hom V W)
variables {f₁ g₁ : normed_group_hom V₁ W₁}
variables {f₂ g₂ : normed_group_hom V₂ W₂}
variables {f₃ g₃ : normed_group_hom V₃ W₃}

/-- The equalizer of two morphisms `f g : normed_group_hom V W`. -/
def equalizer := (f - g).ker

namespace equalizer

/-- The inclusion of `f.equalizer g` as a `normed_group_hom`. -/
def ι : normed_group_hom (f.equalizer g) V := incl _

lemma comp_ι_eq : f.comp (ι f g) = g.comp (ι f g) :=
by { ext, rw [comp_apply, comp_apply, ← sub_eq_zero, ← normed_group_hom.sub_apply], exact x.2 }

variables {f g}

/-- If `φ : normed_group_hom V₁ V` is such that `f.comp φ = g.comp φ`, the induced morphism
`normed_group_hom V₁ (f.equalizer g)`. -/
@[simps]
def lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ v, ⟨φ v, show (f - g) (φ v) = 0,
    by rw [normed_group_hom.sub_apply, sub_eq_zero, ← comp_apply, h, comp_apply]⟩,
  map_add' := λ v₁ v₂, by { ext, simp only [map_add, add_subgroup.coe_add, subtype.coe_mk] },
  bound' := by { obtain ⟨C, C_pos, hC⟩ := φ.bound, exact ⟨C, hC⟩ } }

@[simp] lemma ι_comp_lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  (ι _ _).comp (lift φ h) = φ :=
by { ext, refl }

/-- The lifting property of the equalizer as an equivalence. -/
@[simps]
def lift_equiv : {φ : normed_group_hom V₁ V // f.comp φ = g.comp φ} ≃
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ φ, lift φ φ.prop,
  inv_fun := λ ψ, ⟨(ι f g).comp ψ, by { rw [← comp_assoc, ← comp_assoc, comp_ι_eq] }⟩,
  left_inv := λ φ, by simp,
  right_inv := λ ψ, by { ext, refl } }

/-- Given `φ : normed_group_hom V₁ V₂` and `ψ : normed_group_hom W₁ W₂` such that
`ψ.comp f₁ = f₂.comp φ` and `ψ.comp g₁ = g₂.comp φ`, the induced morphism
`normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂)`. -/
def map (φ : normed_group_hom V₁ V₂) (ψ : normed_group_hom W₁ W₂)
  (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂) :=
lift (φ.comp $ ι _ _) $
by { simp only [← comp_assoc, ← hf, ← hg], simp only [comp_assoc, comp_ι_eq] }

variables {φ : normed_group_hom V₁ V₂} {ψ : normed_group_hom W₁ W₂}
variables {φ' : normed_group_hom V₂ V₃} {ψ' : normed_group_hom W₂ W₃}

@[simp] lemma ι_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  (ι f₂ g₂).comp (map φ ψ hf hg) = φ.comp (ι _ _) :=
ι_comp_lift _ _

@[simp] lemma map_id : map (id V₁) (id W₁) rfl rfl = id (f₁.equalizer g₁) :=
by { ext, refl }

lemma comm_sq₂ (hf : ψ.comp f₁ = f₂.comp φ) (hf' : ψ'.comp f₂ = f₃.comp φ') :
  (ψ'.comp ψ).comp f₁ = f₃.comp (φ'.comp φ) :=
by rw [comp_assoc, hf, ← comp_assoc, hf', comp_assoc]

lemma map_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hf' : ψ'.comp f₂ = f₃.comp φ') (hg' : ψ'.comp g₂ = g₃.comp φ') :
  (map φ' ψ' hf' hg').comp (map φ ψ hf hg) =
    map (φ'.comp φ) (ψ'.comp ψ) (comm_sq₂ hf hf') (comm_sq₂ hg hg') :=
by { ext, refl }

lemma ι_norm_noninc : (ι f g).norm_noninc := λ v, le_rfl

/-- The lifting of a norm nonincreasing morphism is norm nonincreasing. -/
lemma lift_norm_noninc (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) (hφ : φ.norm_noninc) :
  (lift φ h).norm_noninc :=
hφ

/-- If `φ` satisfies `∥φ∥ ≤ C`, then the same is true for the lifted morphism. -/
lemma norm_lift_le (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ)
  (C : ℝ) (hφ : ∥φ∥ ≤ C) : ∥(lift φ h)∥ ≤ C := hφ

lemma map_norm_noninc (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hφ : φ.norm_noninc) : (map φ ψ hf hg).norm_noninc :=
lift_norm_noninc _ _ $ hφ.comp ι_norm_noninc

lemma norm_map_le (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (C : ℝ) (hφ : ∥φ.comp (ι f₁ g₁)∥ ≤ C) : ∥map φ ψ hf hg∥ ≤ C :=
norm_lift_le _ _ _ hφ

end equalizer

end normed_group_hom

section controlled_closure
open filter finset
open_locale topological_space
variables {G : Type*} [normed_group G] [complete_space G]
variables {H : Type*} [normed_group H]

/-- Given `f : normed_group_hom G H` for some complete `G` and a subgroup `K` of `H`, if every
element `x` of `K` has a preimage under `f` whose norm is at most `C*∥x∥` then the same holds for
elements of the (topological) closure of `K` with constant `C+ε` instead of `C`, for any
positive `ε`.
-/
lemma controlled_closure_of_complete  {f : normed_group_hom G H} {K : add_subgroup H}
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : f.surjective_on_with K C) :
  f.surjective_on_with K.topological_closure (C + ε) :=
begin
  rintros (h : H) (h_in : h ∈ K.topological_closure),
  /- We first get rid of the easy case where `h = 0`.-/
  by_cases hyp_h : h = 0,
  { rw hyp_h,
    use 0,
    simp },
  /- The desired preimage will be constructed as the sum of a series. Convergence of
  the series will be guaranteed by completeness of `G`. We first write `h` as the sum
  of a sequence `v` of elements of `K` which starts close to `h` and then quickly goes to zero.
  The sequence `b` below quantifies this. -/
  set b : ℕ → ℝ := λ i, (1/2)^i*(ε*∥h∥/2)/C,
  have b_pos : ∀ i, 0 < b i,
  { intro i,
    field_simp [b, hC],
    exact div_pos (mul_pos hε (norm_pos_iff.mpr hyp_h))
                  (mul_pos (by norm_num : (0 : ℝ) < 2^i*2) hC) },
  obtain ⟨v : ℕ → H, lim_v : tendsto (λ (n : ℕ), ∑ k in range (n + 1), v k) at_top (𝓝 h),
    v_in : ∀ n, v n ∈ K, hv₀ : ∥v 0 - h∥ < b 0, hv : ∀ n > 0, ∥v n∥ < b n⟩ :=
    controlled_sum_of_mem_closure h_in b_pos,
  /- The controlled surjectivity assumption on `f` allows to build preimages `u n` for all
  elements `v n` of the `v` sequence.-/
  have : ∀ n, ∃ m' : G, f m' = v n ∧ ∥m'∥ ≤ C * ∥v n∥ := λ (n : ℕ), hyp (v n) (v_in n),
  choose u hu hnorm_u using this,
  /- The desired series `s` is then obtained by summing `u`. We then check our choice of
  `b` ensures `s` is Cauchy. -/
  set s : ℕ → G := λ n, ∑ k in range (n+1), u k,
  have : cauchy_seq s,
  { apply normed_group.cauchy_series_of_le_geometric'' (by norm_num) one_half_lt_one,
    rintro n (hn : n ≥ 1),
    calc ∥u n∥ ≤ C*∥v n∥ : hnorm_u n
    ... ≤ C * b n : mul_le_mul_of_nonneg_left (hv _ $ nat.succ_le_iff.mp hn).le hC.le
    ... = (1/2)^n * (ε * ∥h∥/2) : by simp [b, mul_div_cancel' _ hC.ne.symm]
    ... = (ε * ∥h∥/2) * (1/2)^n : mul_comm _ _ },
  /- We now show that the limit `g` of `s` is the desired preimage. -/
  obtain ⟨g : G, hg⟩ := cauchy_seq_tendsto_of_complete this,
  refine ⟨g, _, _⟩,
  { /- We indeed get a preimage. First note: -/
    have : f ∘ s = λ n, ∑ k in range (n + 1), v k,
    { ext n,
      simp [f.map_sum, hu] },
    /- In the above equality, the left-hand-side converges to `f g` by continuity of `f` and
       definition of `g` while the right-hand-side converges to `h` by construction of `v` so
       `g` is indeed a preimage of `h`. -/
    rw ← this at lim_v,
    exact tendsto_nhds_unique ((f.continuous.tendsto g).comp hg) lim_v },
  { /- Then we need to estimate the norm of `g`, using our careful choice of `b`. -/
    suffices : ∀ n, ∥s n∥ ≤ (C + ε) * ∥h∥,
      from le_of_tendsto' (continuous_norm.continuous_at.tendsto.comp hg) this,
    intros n,
    have hnorm₀ : ∥u 0∥ ≤ C*b 0 + C*∥h∥,
    { have := calc
      ∥v 0∥ ≤ ∥h∥ + ∥v 0 - h∥ : norm_le_insert' _ _
      ... ≤ ∥h∥ + b 0 : by apply add_le_add_left hv₀.le,
      calc ∥u 0∥ ≤ C*∥v 0∥ : hnorm_u 0
      ... ≤ C*(∥h∥ + b 0) : mul_le_mul_of_nonneg_left this hC.le
      ... = C * b 0 + C * ∥h∥ : by rw [add_comm, mul_add] },
    have : ∑ k in range (n + 1), C * b k ≤ ε * ∥h∥ := calc
      ∑ k in range (n + 1), C * b k = (∑ k in range (n + 1), (1 / 2) ^ k) * (ε * ∥h∥ / 2) :
                     by simp only [b, mul_div_cancel' _ hC.ne.symm, ← sum_mul]
      ... ≤  2 * (ε * ∥h∥ / 2) : mul_le_mul_of_nonneg_right (sum_geometric_two_le _)
                                                            (by nlinarith [hε, norm_nonneg h])
      ... = ε * ∥h∥ : mul_div_cancel' _ two_ne_zero,
    calc ∥s n∥ ≤ ∑ k in range (n+1), ∥u k∥ : norm_sum_le _ _
    ... = ∑ k in range n, ∥u (k + 1)∥ + ∥u 0∥ : sum_range_succ' _ _
    ... ≤ ∑ k in range n, C*∥v (k + 1)∥ + ∥u 0∥ : add_le_add_right (sum_le_sum (λ _ _, hnorm_u _)) _
    ... ≤ ∑ k in range n, C*b (k+1) + (C*b 0 + C*∥h∥) :
      add_le_add (sum_le_sum (λ k _, mul_le_mul_of_nonneg_left (hv _ k.succ_pos).le hC.le)) hnorm₀
    ... = ∑ k in range (n+1), C*b k + C*∥h∥ : by rw [← add_assoc, sum_range_succ']
    ... ≤ (C+ε)*∥h∥ : by { rw [add_comm, add_mul], apply add_le_add_left this } }
end

/-- Given `f : normed_group_hom G H` for some complete `G`, if every element `x` of the image of
an isometric immersion `j : normed_group_hom K H` has a preimage under `f` whose norm is at most
`C*∥x∥` then the same holds for elements of the (topological) closure of this image with constant
`C+ε` instead of `C`, for any positive `ε`.
This is useful in particular if `j` is the inclusion of a normed group into its completion
(in this case the closure is the full target group).
-/
lemma controlled_closure_range_of_complete {f : normed_group_hom G H}
  {K : Type*} [semi_normed_group K] {j : normed_group_hom K H} (hj : ∀ x, ∥j x∥ = ∥x∥)
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : ∀ k, ∃ g, f g = j k ∧ ∥g∥ ≤ C*∥k∥) :
  f.surjective_on_with j.range.topological_closure (C + ε) :=
begin
  replace hyp : ∀ h ∈ j.range, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥,
  { intros h h_in,
    rcases (j.mem_range _).mp h_in with ⟨k, rfl⟩,
    rw hj,
    exact hyp k },
  exact controlled_closure_of_complete hC hε hyp
end
end controlled_closure


/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Std.Data.Ord
import Std.Tactic.Simpa

/-! ## Ordering -/

@[simp] theorem Ordering.swap_swap {o : Ordering} : o.swap.swap = o := by cases o <;> rfl

@[simp] theorem Ordering.swap_inj {o₁ o₂ : Ordering} : o₁.swap = o₂.swap ↔ o₁ = o₂ :=
  ⟨fun h => by simpa using congrArg swap h, congrArg _⟩

namespace Std

/-- `TotalBLE le` asserts that `le` has a total order, that is, `le a b ∨ le b a`. -/
class TotalBLE (le : α → α → Bool) : Prop where
  /-- `le` is total: either `le a b` or `le b a`. -/
  total : le a b ∨ le b a

/-- `OrientedCmp cmp` asserts that `cmp` is determined by the relation `cmp x y = .lt`. -/
class OrientedCmp (cmp : α → α → Ordering) : Prop where
  /-- The comparator operation is symmetric, in the sense that if `cmp x y` equals `.lt` then
  `cmp y x = .gt` and vice versa. -/
  symm (x y) : (cmp x y).swap = cmp y x

namespace OrientedCmp

theorem cmp_eq_gt [OrientedCmp cmp] : cmp x y = .gt ↔ cmp y x = .lt := by
  rw [← Ordering.swap_inj, symm]; exact .rfl

theorem cmp_eq_eq_symm [OrientedCmp cmp] : cmp x y = .eq ↔ cmp y x = .eq := by
  rw [← Ordering.swap_inj, symm]; exact .rfl

theorem cmp_refl [OrientedCmp cmp] : cmp x x = .eq :=
  match e : cmp x x with
  | .lt => nomatch e.symm.trans (cmp_eq_gt.2 e)
  | .eq => rfl
  | .gt => nomatch (cmp_eq_gt.1 e).symm.trans e

end OrientedCmp

/-- `TransCmp cmp` asserts that `cmp` induces a transitive relation. -/
class TransCmp (cmp : α → α → Ordering) extends OrientedCmp cmp : Prop where
  /-- The comparator operation is transitive. -/
  le_trans : cmp x y ≠ .gt → cmp y z ≠ .gt → cmp x z ≠ .gt

namespace TransCmp
variable [TransCmp cmp]
open OrientedCmp Decidable

theorem ge_trans (h₁ : cmp x y ≠ .lt) (h₂ : cmp y z ≠ .lt) : cmp x z ≠ .lt := by
  have := @TransCmp.le_trans _ cmp _ z y x
  simp [cmp_eq_gt] at *; exact this h₂ h₁

theorem lt_asymm (h : cmp x y = .lt) : cmp y x ≠ .lt :=
  fun h' => nomatch h.symm.trans (cmp_eq_gt.2 h')

theorem gt_asymm (h : cmp x y = .gt) : cmp y x ≠ .gt :=
  mt cmp_eq_gt.1 <| lt_asymm <| cmp_eq_gt.1 h

theorem le_lt_trans (h₁ : cmp x y ≠ .gt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=
  byContradiction fun h₃ => ge_trans (mt cmp_eq_gt.2 h₁) h₃ h₂

theorem lt_le_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z ≠ .gt) : cmp x z = .lt :=
  byContradiction fun h₃ => ge_trans h₃ (mt cmp_eq_gt.2 h₂) h₁

theorem lt_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=
  le_lt_trans (gt_asymm <| cmp_eq_gt.2 h₁) h₂

theorem gt_trans (h₁ : cmp x y = .gt) (h₂ : cmp y z = .gt) : cmp x z = .gt := by
  rw [cmp_eq_gt] at h₁ h₂ ⊢; exact lt_trans h₂ h₁

theorem cmp_congr_left (xy : cmp x y = .eq) : cmp x z = cmp y z :=
  match yz : cmp y z with
  | .lt => byContradiction (ge_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)
  | .gt => byContradiction (le_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)
  | .eq => match xz : cmp x z with
    | .lt => nomatch ge_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz
    | .gt => nomatch le_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz
    | .eq => rfl

theorem cmp_congr_right [TransCmp cmp] (yz : cmp y z = .eq) : cmp x y = cmp x z := by
  rw [← Ordering.swap_inj, symm, symm, cmp_congr_left yz]

end TransCmp

/-- Pull back a comparator by a function `f`, by applying the comparator to both arguments. -/
@[inline] def byKey (f : α → β) (cmp : β → β → Ordering) (a b : α) : Ordering := cmp (f a) (f b)

instance (f : α → β) (cmp : β → β → Ordering) [OrientedCmp cmp] : OrientedCmp (byKey f cmp) where
  symm a b := OrientedCmp.symm (f a) (f b)

instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCmp (byKey f cmp) where
  le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂

instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCmp (byKey f cmp) where
  le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂