/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

1-point elimination for ∃.

This implements a conversion transforming
  `∃x, t[x, x = a] ~> t[a, rfl]`
where `t` is an expression consiting of existentials and conjunctions, and the equality is either
the type of one of the existentials or in one of the conjunctions.

Concrete examples:
  `∃a, a = t ∧ p a                     ~>   p t`
  `∃a, p a ∧ ∃b, ∃h : a = f b, q a h   ~>   ∃b, p (f b) ∧ q (f b) rfl`

This is implemented by
* `find`: find all possible equalities, and keep track of dependencies on `x`
* `reorder_non_dependent`: move all existentials which are not dependent on `x` before the first one
* `elim_equality`: walk to the equality and bring it in the normal form
    eq : E
    ex : ∃h:E, q
    cn : E ∧ q
  end finally eliminated it.

To bring it into normal form we need to keep care of the following cases:
  l : p ∧ X
  r : X ∧ p
  e : ∃a, X
applying these rules:
  l_eq : p ∧ E            ~>  E ∧ p
  l_ex : p ∧ (∃h:E, q h)  ~>  ∃h:E, p ∧ q h
  l_cn : p ∧ (E ∧ q)      ~>  E ∧ (p ∧ q)
  r_eq : E ∧ p            ~>  E ∧ p
  r_ex : (∃h:E, q h) ∧ p  ~>  ∃h:E, q h ∧ p
  r_cn : (E ∧ q) ∧ p      ~>  E ∧ (q ∧ p)
  e_eq_Prop : ∃a, E       ~>  E ∧ a
  e_eq : ∃a, E            ~>  E ∧ nonempty a
  e_ex : ∃a, ∃h:E, q h a  ~>  ∃h:E, ∃a, q h a
  e_cn : ∃a, E ∧ p a      ~>  E ∧ (∃a, p a)

And finally for elimination:
  elim_eq : ∃x, x = t           ~>  true
  elim_ex : ∃x, ∃h:x = t, p x h ~>  p t rfl
  elim_cn : ∃x, (x = t) ∧ p x   ~>  p t

This tactic is inspired by the one-point elimination in Isabelle's simplifier.
-/
import simp_loop.conv

namespace simp_loop
open conv_t tactic expr

namespace exists_eq_elim

section

section
lemma l_eq {p E : Prop} : (p ∧ E) ↔ (E ∧ p) :=
and_comm _ _
lemma l_ex {p E : Prop} {r : E → Prop} : (p ∧ (∃h:E, r h)) ↔ (∃h:E, p ∧ r h) :=
⟨λ⟨h, e, r⟩, ⟨e, h, r⟩, λ⟨e, h, r⟩, ⟨h, e, r⟩⟩
lemma l_cn {p q E : Prop} : (p ∧ (E ∧ q)) ↔ (E ∧ (p ∧ q)) :=
⟨λ⟨h, e, r⟩, ⟨e, h, r⟩, λ⟨e, h, r⟩, ⟨h, e, r⟩⟩
lemma r_eq {p E : Prop} : (E ∧ p) ↔ (E ∧ p) :=
iff.refl _
lemma r_ex {p E : Prop} {r : E → Prop} : ((∃h:E, r h) ∧ p) ↔ (∃h:E, r h ∧ p) :=
⟨λ⟨⟨e, r⟩, h⟩, ⟨e, r, h⟩, λ⟨e, r, h⟩, ⟨⟨e, r⟩, h⟩⟩
lemma r_cn {p q E : Prop} : ((E ∧ q) ∧ p) ↔ (E ∧ (q ∧ p)) :=
⟨λ⟨⟨e, r⟩, h⟩, ⟨e, r, h⟩, λ⟨e, r, h⟩, ⟨⟨e, r⟩, h⟩⟩
lemma e_eq_Prop {p E : Prop} : (∃a:p, E) ↔ (E ∧ p) :=
⟨λ⟨a, h⟩, ⟨h, a⟩, λ⟨h, a⟩, ⟨a, h⟩⟩
lemma e_eq {α : Sort*} {E : Prop} : (∃a:α, E) ↔ (E ∧ nonempty α) :=
⟨λ⟨a, h⟩, ⟨h, ⟨a⟩⟩, λ⟨h, ⟨a⟩⟩, ⟨a, h⟩⟩
lemma e_ex {α : Sort*} {E : Prop} {s : E → α → Prop} : (∃a:α, ∃h:E, s h a) ↔ (∃h:E, ∃a:α, s h a) :=
⟨λ⟨a, h, t⟩, ⟨h, a, t⟩, λ⟨a, h, t⟩, ⟨h, a, t⟩⟩
lemma e_cn {α : Sort*} {E : Prop} {t : α → Prop} : (∃a:α, E ∧ t a) ↔ (E ∧ (∃a:α, t a)) :=
⟨λ⟨a, e, t⟩, ⟨e, ⟨a, t⟩⟩, λ⟨e, ⟨a, t⟩⟩, ⟨a, e, t⟩⟩

lemma elim_eq_left {α : Sort*} {a : α} : (∃x, x = a) ↔ true :=
⟨λ_, ⟨⟩, λ_, ⟨a, rfl⟩⟩
lemma elim_eq_right {α : Sort*} {a : α} : (∃x, a = x) ↔ true :=
⟨λ_, ⟨⟩, λ_, ⟨a, rfl⟩⟩
lemma elim_ex_left {α : Sort*} {a : α} {q : Πx, x = a → Prop} : (∃x, ∃h:x = a, q x h) ↔ q a rfl :=
⟨λ⟨x, rfl, q⟩, q, λh, ⟨a, rfl, h⟩⟩
lemma elim_ex_right {α : Sort*} {a : α} {q : Πx, a = x → Prop} : (∃x, ∃h:a = x, q x h) ↔ q a rfl :=
⟨λ⟨x, rfl, q⟩, q, λh, ⟨a, rfl, h⟩⟩
lemma elim_cn_left {α : Sort*} {a : α} {p : α → Prop} : (∃x, (x = a) ∧ p x) ↔ p a :=
⟨λ⟨x, rfl, p⟩, p, λh, ⟨a, rfl, h⟩⟩
lemma elim_cn_right {α : Sort*} {a : α} {p : α → Prop} : (∃x, (a = x) ∧ p x) ↔ p a :=
⟨λ⟨x, rfl, p⟩, p, λh, ⟨a, rfl, h⟩⟩

lemma l_congr {p q r : Prop} (h : q ↔ r) : p ∧ q ↔ p ∧ r :=
and_congr (iff.refl p) h
lemma r_congr {p q r : Prop} (h : q ↔ r) : q ∧ p ↔ r ∧ p :=
and_congr h (iff.refl p)
lemma ex_congr {α : Sort*} {p q : α → Prop} (h : ∀a, p a ↔ q a) : (∃a, p a) ↔ (∃a, q a) :=
exists_congr h

lemma comm_l {α : Sort*} {p : Prop} {q : α → Prop} : p ∧ (∃a, q a) ↔ ∃a, p ∧ q a :=
⟨λ⟨a, hq, hp⟩, ⟨hq, ⟨a, hp⟩⟩, λ ⟨hq, ⟨a, hp⟩⟩, ⟨a, hq, hp⟩⟩
lemma comm_r {α : Sort*} {p : Prop} {q : α → Prop} : (∃a, q a) ∧ p ↔ ∃a, q a ∧ p :=
⟨λ ⟨⟨a, hp⟩, hq⟩, ⟨a, hp, hq⟩, λ⟨a, hp, hq⟩, ⟨⟨a, hp⟩, hq⟩⟩
lemma comm_ex {α : Sort*} {β : Sort*} {p : α → β → Prop} : (∃a b, p a b) ↔ (∃b a, p a b) :=
⟨λ⟨a, ⟨b, h⟩⟩, ⟨b, ⟨a, h⟩⟩, λ⟨a, ⟨b, h⟩⟩, ⟨b, ⟨a, h⟩⟩⟩

end

end

meta inductive info
| binder (v : expr) (dependent : bool) | operator (side : bool)

namespace info
open format
meta instance : has_to_format info :=
⟨λi, match i with
| info.binder v d := to_fmt "binder " ++ to_fmt v ++ " " ++ to_fmt d
| info.operator s := to_fmt "operator " ++ to_fmt s
end⟩
end info

meta inductive norm_form
| eq | ex | cn

namespace norm_form
open format
meta instance : has_to_format norm_form :=
⟨λi, match i with
| norm_form.eq := to_fmt "eq"
| norm_form.ex := to_fmt "ex"
| norm_form.cn := to_fmt "cn"
end⟩
end norm_form

meta def check_eq (x : expr) (deps : list expr) : expr → bool
| `(%%l = %%r) := (l = x ∧ deps.all (λx, ¬ x.occurs r)) ∨ (r = x ∧ deps.all (λx, ¬ x.occurs l))
| _ := ff

meta def congr_ex {α} (c : conv α) : conv α := congr_binder ``ex_congr (λ_, c)

meta def congr {α} (c : conv α) : info → conv α
| (info.binder _ _) := congr_ex c
| (info.operator tt) := congr_simple ``r_congr c
| (info.operator ff) := congr_simple ``l_congr c

meta def apply_norm (n_eq n_ex n_cn : list name) : norm_form → conv norm_form
| norm_form.eq := do n_eq.mfirst apply_const, return norm_form.cn
| norm_form.ex := do n_ex.mfirst apply_const, return norm_form.ex
| norm_form.cn := do n_cn.mfirst apply_const, return norm_form.cn

meta def analyse (v : expr) (deps : list expr) : expr → tactic (option $ list $ info × expr)
| `(@Exists %%α %%p) := if check_eq v deps α then
    return none
  else do
    (lam pp_n bi domain body) ← return p | return (some []),
    x ← mk_local' pp_n bi domain,
    return [(info.binder x (deps.any $ λv, v.occurs α), body.instantiate_var x)]
| `(%%p ∧ %%q) := return [(info.operator tt, p), (info.operator ff, q)]
| t := return $ if check_eq v deps t then none else some []

meta def find (v : expr) : list expr → expr → tactic (list $ list info) | deps e := do
some is ← analyse v deps e | return [[]],
iss ← is.mmap (λ⟨i, t⟩, do
  deps ← return $ match i with (info.binder v tt) := v :: deps | _ := deps end,
  iss ← find deps t,
  return $ iss.map $ λis, i :: is),
return iss.join

meta def reorder_equality : list info → conv norm_form
| [] := (do -- trace "reorder_equality []", trace_lhs,
  `(_ = _) ← lhs, return norm_form.eq) <|> return norm_form.ex
| (i@(info.binder _ _)::xs)  := congr (reorder_equality xs) i >>= apply_norm [``e_eq_Prop, ``e_eq] [``e_ex] [``e_cn]
| (i@(info.operator tt)::xs) := congr (reorder_equality xs) i >>= apply_norm [``r_eq] [``r_ex] [``r_cn]
| (i@(info.operator ff)::xs) := congr (reorder_equality xs) i >>= apply_norm [``l_eq] [``l_ex] [``l_cn]

meta def elim_equality (l : list info) : conv unit := do
-- trace (to_fmt "elim_equality " ++ to_fmt l),
n ← congr_ex (reorder_equality l),
-- trace (to_fmt "elim_equality [reordered] " ++ to_fmt n), trace_lhs,
apply_norm [``elim_eq_left, ``elim_eq_right] [``elim_ex_left, ``elim_ex_right] [``elim_cn_left, ``elim_cn_right] n,
skip

meta def reorder_non_dependent : list info → conv (option (list info))
| []      := return none
| (i::is) := (do info.binder _ ff ← return i, return is) <|> (do
  some is' ← congr (reorder_non_dependent is) i | return none,
  r ← return $ match i with
  | info.binder _ _  := ``comm_ex
  | info.operator tt := ``comm_r
  | info.operator ff := ``comm_l
  end,
  apply_const r,
  return (i :: is'))

meta def reorder_and_elim : list info → conv unit | l := do
-- trace (to_fmt "reorder_and_elim " ++ to_fmt l),
some l' ← congr_ex (reorder_non_dependent l) | elim_equality l,
apply_const ``comm_ex,
congr_ex (reorder_and_elim l')

meta def run : conv unit := do
pss ← congr_binder ``ex_congr (λv, do t ← lhs, find v [v] t),
pss.mfirst reorder_and_elim

section test

variables {α : Sort*} {β : Sort*} {γ : β → Sort*} {δ : α → Sort*}

example {f : α → β} {a : α} {p : β → Prop} :
  (∃b, ∃c:γ b, ∃h : f a = b, p b) ↔ (∃c:γ (f a), p (f a)) :=
by conversion exists_eq_elim.run

example {f : α → β} {p : β → Prop} :
  (∃b, ∃c:γ b, ∃a, ∃h : f a = b, p b) ↔ (∃a, ∃c:γ (f a), p (f a)) :=
by conversion exists_eq_elim.run

example {f : Πa, δ a → β} {p : β → Prop} :
  (∃b, ∃c:γ b, ∃a, ∃d:δ a, ∃h : f a d = b, p b) ↔ (∃a, ∃d:δ a, ∃c:γ (f a d), p (f a d)) :=
by conversion exists_eq_elim.run

example {f : Πa, δ a → β} {p : β → Prop} :
  (∃b, ∃a, ∃c:γ b, ∃d:δ a, ∃h : f a d = b, p b) ↔ (∃a, ∃d:δ a, ∃c:γ (f a d), p (f a d)) :=
by conversion exists_eq_elim.run

example {f : Πa, δ a → β} {p : β → Prop} :
  (∃b, ∃a, ∃d:δ a, ∃c:γ b, ∃h : f a d = b, p b) ↔ (∃a, ∃d:δ a, ∃c:γ (f a d), p (f a d)) :=
by conversion exists_eq_elim.run

example {f : Πa, δ a → β} {p : β → Prop} :
  (∃b, ∃a, ∃d:δ a, ∃h : f a d = b, ∃c:γ b, p b) ↔ (∃a, ∃d:δ a, ∃c:γ (f a d), p (f a d)) :=
by conversion exists_eq_elim.run

example {f : Πa, δ a → β} {p : β → Prop} :
  (∃b, ∃a, ∃d:δ a, ∃h' : a = a ∧ b = b, ∃h : f a d = b, ∃c:γ b, p b) ↔
    (∃a (d : δ a) (h' : a = a ∧ f a d = f a d) (c : γ (f a d)), p (f a d)) :=
by conversion exists_eq_elim.run

example {f : α → β} {q : β → α → Prop} {p : β → Prop} :
  (∃b a, ∃h:q b a, ∃h' : b = b, ∃h : f a = b, ∃c:γ b, p b) ↔
    (∃a (h : q (f a) a) (h : f a = f a) (c : γ (f a)), p (f a)) :=
by conversion exists_eq_elim.run

example {f : α → β} {p : β → Prop} :
  (∃a, (∃c, ∃h: a = a , ∃b : β, a = f c) ∧ (∃c:α, p a)) ↔
    (∃a (b:β), f a = f a ∧ ∃ (c : α), p (f a))  :=
by conversion exists_eq_elim.run

example {f : α → β} {p : β → Prop} :
  (∃a, (∃c, ∃h: a = a , ∃b : β, a = f c) ∧ (∃c:α, p a)) ↔
    (∃a (b:β), f a = f a ∧ ∃ (c : α), p (f a))  :=
by conversion exists_eq_elim.run

example {f g : α → β} {p : α → Prop} :
  (∃b, ∃a:(λb:β, α) b, ∃a₂, ∃h:f a = b, b = g a₂ ∧ p a₂) ↔
    (∃a₂ (a : (λ (b : β), α) (g a₂)) (h : f a = g a₂), p a₂)  :=
by conversion exists_eq_elim.run

example {p q r : α → Prop} {a : α}:
  (∃a', (p a' ∧ r a') ∧ (a = a' ∧ q a)) ↔ (p a ∧ r a) ∧ q a :=
by conversion exists_eq_elim.run

example {p q r : α → Prop} {a : α} :
  (∃a', (p a' ∧ r a') ∧ (a' = a ∧ q a)) ↔ (p a ∧ r a) ∧ q a :=
by conversion exists_eq_elim.run

example {p : α → Prop} {q : Prop} :
  (∃a, p a ∧ ∃a', a = a' ∧ q) ↔ (∃a, p a ∧ q) :=
by conversion exists_eq_elim.run

end test

end exists_eq_elim
end simp_loop


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.multiset.sort
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Sort
import Mathbin.Data.Multiset.Basic

/-!
# Construct a sorted list from a multiset.

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

namespace Multiset

open List

variable {α : Type _}

section Sort

variable (r : α → α → Prop) [DecidableRel r] [IsTrans α r] [IsAntisymm α r] [IsTotal α r]

#print Multiset.sort /-
/-- `sort s` constructs a sorted list from the multiset `s`.
  (Uses merge sort algorithm.) -/
def sort (s : Multiset α) : List α :=
  Quot.liftOn s (mergeSort r) fun a b h =>
    eq_of_perm_of_sorted ((perm_mergeSort _ _).trans <| h.trans (perm_mergeSort _ _).symm)
      (sorted_mergeSort r _) (sorted_mergeSort r _)
#align multiset.sort Multiset.sort
-/

#print Multiset.coe_sort /-
@[simp]
theorem coe_sort (l : List α) : sort r l = mergeSort r l :=
  rfl
#align multiset.coe_sort Multiset.coe_sort
-/

#print Multiset.sort_sorted /-
@[simp]
theorem sort_sorted (s : Multiset α) : Sorted r (sort r s) :=
  Quot.inductionOn s fun l => sorted_mergeSort r _
#align multiset.sort_sorted Multiset.sort_sorted
-/

#print Multiset.sort_eq /-
@[simp]
theorem sort_eq (s : Multiset α) : ↑(sort r s) = s :=
  Quot.inductionOn s fun l => Quot.sound <| perm_mergeSort _ _
#align multiset.sort_eq Multiset.sort_eq
-/

#print Multiset.mem_sort /-
@[simp]
theorem mem_sort {s : Multiset α} {a : α} : a ∈ sort r s ↔ a ∈ s := by rw [← mem_coe, sort_eq]
#align multiset.mem_sort Multiset.mem_sort
-/

/- warning: multiset.length_sort -> Multiset.length_sort is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (r : α -> α -> Prop) [_inst_1 : DecidableRel.{succ u1} α r] [_inst_2 : IsTrans.{u1} α r] [_inst_3 : IsAntisymm.{u1} α r] [_inst_4 : IsTotal.{u1} α r] {s : Multiset.{u1} α}, Eq.{1} Nat (List.length.{u1} α (Multiset.sort.{u1} α r (fun (a : α) (b : α) => _inst_1 a b) _inst_2 _inst_3 _inst_4 s)) (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{u1} α) -> Nat) (AddMonoidHom.hasCoeToFun.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{u1} α) s)
but is expected to have type
  forall {α : Type.{u1}} (r : α -> α -> Prop) [_inst_1 : DecidableRel.{succ u1} α r] [_inst_2 : IsTrans.{u1} α r] [_inst_3 : IsAntisymm.{u1} α r] [_inst_4 : IsTotal.{u1} α r] {s : Multiset.{u1} α}, Eq.{1} Nat (List.length.{u1} α (Multiset.sort.{u1} α r (fun (a : α) (b : α) => _inst_1 a b) _inst_2 _inst_3 _inst_4 s)) (FunLike.coe.{succ u1, succ u1, 1} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) (fun (_x : Multiset.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u1} α) => Nat) _x) (AddHomClass.toFunLike.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) Nat (AddZeroClass.toAdd.{u1} (Multiset.{u1} α) (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{u1} α) s)
Case conversion may be inaccurate. Consider using '#align multiset.length_sort Multiset.length_sortₓ'. -/
@[simp]
theorem length_sort {s : Multiset α} : (sort r s).length = s.card :=
  Quot.inductionOn s <| length_mergeSort _
#align multiset.length_sort Multiset.length_sort

#print Multiset.sort_zero /-
@[simp]
theorem sort_zero : sort r 0 = [] :=
  List.mergeSort_nil r
#align multiset.sort_zero Multiset.sort_zero
-/

#print Multiset.sort_singleton /-
@[simp]
theorem sort_singleton (a : α) : sort r {a} = [a] :=
  List.mergeSort_singleton r a
#align multiset.sort_singleton Multiset.sort_singleton
-/

end Sort

-- TODO: use a sort order if available, gh-18166
unsafe instance [Repr α] : Repr (Multiset α) :=
  ⟨fun s => "{" ++ String.intercalate ", " (s.unquot.map repr) ++ "}"⟩

end Multiset


/-
Copyright (c) 2018 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudryashov
-/
import logic.function.iterate
import topology.metric_space.basic
import category_theory.endomorphism
import category_theory.types

/-!
# Lipschitz continuous functions

A map `f : α → β` between two (extended) metric spaces is called *Lipschitz continuous*
with constant `K ≥ 0` if for all `x, y` we have `edist (f x) (f y) ≤ K * edist x y`.
For a metric space, the latter inequality is equivalent to `dist (f x) (f y) ≤ K * dist x y`.
There is also a version asserting this inequality only for `x` and `y` in some set `s`.

In this file we provide various ways to prove that various combinations of Lipschitz continuous
functions are Lipschitz continuous. We also prove that Lipschitz continuous functions are
uniformly continuous.

## Main definitions and lemmas

* `lipschitz_with K f`: states that `f` is Lipschitz with constant `K : ℝ≥0`
* `lipschitz_on_with K f`: states that `f` is Lipschitz with constant `K : ℝ≥0` on a set `s`
* `lipschitz_with.uniform_continuous`: a Lipschitz function is uniformly continuous
* `lipschitz_on_with.uniform_continuous_on`: a function which is Lipschitz on a set is uniformly
  continuous on that set.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ℝ≥0∞`. Constructors whose names end with `'` take `K : ℝ` as an
argument, and return `lipschitz_with (nnreal.of_real K) f`.
-/

universes u v w x

open filter function set
open_locale topological_space nnreal ennreal

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Type x}

/-- A function `f` is Lipschitz continuous with constant `K ≥ 0` if for all `x, y`
we have `dist (f x) (f y) ≤ K * dist x y` -/
def lipschitz_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β) :=
∀x y, edist (f x) (f y) ≤ K * edist x y

lemma lipschitz_with_iff_dist_le_mul [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} : lipschitz_with K f ↔ ∀ x y, dist (f x) (f y) ≤ K * dist x y :=
by { simp only [lipschitz_with, edist_nndist, dist_nndist], norm_cast }

alias lipschitz_with_iff_dist_le_mul ↔ lipschitz_with.dist_le_mul lipschitz_with.of_dist_le_mul

/-- A function `f` is Lipschitz continuous with constant `K ≥ 0` on `s` if for all `x, y` in `s`
we have `dist (f x) (f y) ≤ K * dist x y` -/
def lipschitz_on_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β)
  (s : set α) :=
∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), edist (f x) (f y) ≤ K * edist x y

@[simp] lemma lipschitz_on_with_empty [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0)
  (f : α → β) : lipschitz_on_with K f ∅ :=
λ x x_in y y_in, false.elim x_in

lemma lipschitz_on_with.mono [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {s t : set α} {f : α → β} (hf : lipschitz_on_with K f t) (h : s ⊆ t) : lipschitz_on_with K f s :=
λ x x_in y y_in, hf (h x_in) (h y_in)

lemma lipschitz_on_with_iff_dist_le_mul [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {s : set α} {f : α → β} :
  lipschitz_on_with K f s ↔ ∀ (x ∈ s) (y ∈ s), dist (f x) (f y) ≤ K * dist x y :=
by { simp only [lipschitz_on_with, edist_nndist, dist_nndist], norm_cast }

alias lipschitz_on_with_iff_dist_le_mul ↔
  lipschitz_on_with.dist_le_mul lipschitz_on_with.of_dist_le_mul

@[simp] lemma lipschitz_on_univ [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {f : α → β} : lipschitz_on_with K f univ ↔ lipschitz_with K f :=
by simp [lipschitz_on_with, lipschitz_with]

lemma lipschitz_on_with_iff_restrict [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {f : α → β} {s : set α} : lipschitz_on_with K f s ↔ lipschitz_with K (s.restrict f) :=
by simp only [lipschitz_on_with, lipschitz_with, set_coe.forall', restrict, subtype.edist_eq]

namespace lipschitz_with

section emetric

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {K : ℝ≥0} {f : α → β}

lemma edist_le_mul (h : lipschitz_with K f) (x y : α) : edist (f x) (f y) ≤ K * edist x y := h x y

lemma edist_lt_top (hf : lipschitz_with K f) {x y : α} (h : edist x y < ⊤) :
  edist (f x) (f y) < ⊤ :=
lt_of_le_of_lt (hf x y) $ ennreal.mul_lt_top ennreal.coe_lt_top h

lemma mul_edist_le (h : lipschitz_with K f) (x y : α) :
  (K⁻¹ : ℝ≥0∞) * edist (f x) (f y) ≤ edist x y :=
begin
  have := h x y,
  rw [mul_comm] at this,
  replace := ennreal.div_le_of_le_mul this,
  rwa [div_eq_mul_inv, mul_comm] at this
end

protected lemma of_edist_le (h : ∀ x y, edist (f x) (f y) ≤ edist x y) :
  lipschitz_with 1 f :=
λ x y, by simp only [ennreal.coe_one, one_mul, h]

protected lemma weaken (hf : lipschitz_with K f) {K' : ℝ≥0} (h : K ≤ K') :
  lipschitz_with K' f :=
assume x y, le_trans (hf x y) $ ennreal.mul_right_mono (ennreal.coe_le_coe.2 h)

lemma ediam_image_le (hf : lipschitz_with K f) (s : set α) :
  emetric.diam (f '' s) ≤ K * emetric.diam s :=
begin
  apply emetric.diam_le,
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩,
  calc edist (f x) (f y) ≤ ↑K * edist x y : hf.edist_le_mul x y
                     ... ≤ ↑K * emetric.diam s :
    ennreal.mul_left_mono (emetric.edist_le_diam_of_mem hx hy)
end

/-- A Lipschitz function is uniformly continuous -/
protected lemma uniform_continuous (hf : lipschitz_with K f) :
  uniform_continuous f :=
begin
  refine emetric.uniform_continuous_iff.2 (λε εpos, _),
  use [ε/K, canonically_ordered_semiring.mul_pos.2 ⟨εpos, ennreal.inv_pos.2 $ ennreal.coe_ne_top⟩],
  assume x y Dxy,
  apply lt_of_le_of_lt (hf.edist_le_mul x y),
  rw [mul_comm],
  exact ennreal.mul_lt_of_lt_div Dxy
end

/-- A Lipschitz function is continuous -/
protected lemma continuous (hf : lipschitz_with K f) :
  continuous f :=
hf.uniform_continuous.continuous

protected lemma const (b : β) : lipschitz_with 0 (λa:α, b) :=
assume x y, by simp only [edist_self, zero_le]

protected lemma id : lipschitz_with 1 (@id α) :=
lipschitz_with.of_edist_le $ assume x y, le_refl _

protected lemma subtype_val (s : set α) : lipschitz_with 1 (subtype.val : s → α) :=
lipschitz_with.of_edist_le $ assume x y, le_refl _

protected lemma subtype_coe (s : set α) : lipschitz_with 1 (coe : s → α) :=
lipschitz_with.subtype_val s

protected lemma restrict (hf : lipschitz_with K f) (s : set α) :
  lipschitz_with K (s.restrict f) :=
λ x y, hf x y

protected lemma comp {Kf Kg : ℝ≥0} {f : β → γ} {g : α → β}
  (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf * Kg) (f ∘ g) :=
assume x y,
calc edist (f (g x)) (f (g y)) ≤ Kf * edist (g x) (g y) : hf _ _
... ≤ Kf * (Kg * edist x y) : ennreal.mul_left_mono (hg _ _)
... = (Kf * Kg : ℝ≥0) * edist x y : by rw [← mul_assoc, ennreal.coe_mul]

protected lemma prod_fst : lipschitz_with 1 (@prod.fst α β) :=
lipschitz_with.of_edist_le $ assume x y, le_max_left _ _

protected lemma prod_snd : lipschitz_with 1 (@prod.snd α β) :=
lipschitz_with.of_edist_le $ assume x y, le_max_right _ _

protected lemma prod {f : α → β} {Kf : ℝ≥0} (hf : lipschitz_with Kf f)
  {g : α → γ} {Kg : ℝ≥0} (hg : lipschitz_with Kg g) :
  lipschitz_with (max Kf Kg) (λ x, (f x, g x)) :=
begin
  assume x y,
  rw [ennreal.coe_mono.map_max, prod.edist_eq, ennreal.max_mul],
  exact max_le_max (hf x y) (hg x y)
end

protected lemma uncurry {f : α → β → γ} {Kα Kβ : ℝ≥0} (hα : ∀ b, lipschitz_with Kα (λ a, f a b))
  (hβ : ∀ a, lipschitz_with Kβ (f a)) :
  lipschitz_with (Kα + Kβ) (function.uncurry f) :=
begin
  rintros ⟨a₁, b₁⟩ ⟨a₂, b₂⟩,
  simp only [function.uncurry, ennreal.coe_add, add_mul],
  apply le_trans (edist_triangle _ (f a₂ b₁) _),
  exact add_le_add (le_trans (hα _ _ _) $ ennreal.mul_left_mono $ le_max_left _ _)
    (le_trans (hβ _ _ _) $ ennreal.mul_left_mono $ le_max_right _ _)
end

protected lemma iterate {f : α → α} (hf : lipschitz_with K f) :
  ∀n, lipschitz_with (K ^ n) (f^[n])
| 0       := lipschitz_with.id
| (n + 1) := by rw [pow_succ']; exact (iterate n).comp hf

lemma edist_iterate_succ_le_geometric {f : α → α} (hf : lipschitz_with K f) (x n) :
  edist (f^[n] x) (f^[n + 1] x) ≤ edist x (f x) * K ^ n :=
begin
  rw [iterate_succ, mul_comm],
  simpa only [ennreal.coe_pow] using (hf.iterate n) x (f x)
end

open category_theory

protected lemma mul {f g : End α} {Kf Kg} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
  lipschitz_with (Kf * Kg) (f * g : End α) :=
hf.comp hg

/-- The product of a list of Lipschitz continuous endomorphisms is a Lipschitz continuous
endomorphism. -/
protected lemma list_prod (f : ι → End α) (K : ι → ℝ≥0) (h : ∀ i, lipschitz_with (K i) (f i)) :
  ∀ l : list ι, lipschitz_with (l.map K).prod (l.map f).prod
| [] := by simp [types_id, lipschitz_with.id]
| (i :: l) := by { simp only [list.map_cons, list.prod_cons], exact (h i).mul (list_prod l) }

protected lemma pow {f : End α} {K} (h : lipschitz_with K f) :
  ∀ n : ℕ, lipschitz_with (K^n) (f^n : End α)
| 0       := lipschitz_with.id
| (n + 1) := by { rw [pow_succ, pow_succ], exact h.mul (pow n) }

end emetric

section metric

variables [pseudo_metric_space α] [pseudo_metric_space β] [pseudo_metric_space γ] {K : ℝ≥0}

protected lemma of_dist_le' {f : α → β} {K : ℝ} (h : ∀ x y, dist (f x) (f y) ≤ K * dist x y) :
  lipschitz_with (nnreal.of_real K) f :=
of_dist_le_mul $ λ x y, le_trans (h x y) $
  mul_le_mul_of_nonneg_right (nnreal.le_coe_of_real K) dist_nonneg

protected lemma mk_one {f : α → β} (h : ∀ x y, dist (f x) (f y) ≤ dist x y) :
  lipschitz_with 1 f :=
of_dist_le_mul $ by simpa only [nnreal.coe_one, one_mul] using h

/-- For functions to `ℝ`, it suffices to prove `f x ≤ f y + K * dist x y`; this version
doesn't assume `0≤K`. -/
protected lemma of_le_add_mul' {f : α → ℝ} (K : ℝ) (h : ∀x y, f x ≤ f y + K * dist x y) :
  lipschitz_with (nnreal.of_real K) f :=
have I : ∀ x y, f x - f y ≤ K * dist x y,
  from assume x y, sub_le_iff_le_add'.2 (h x y),
lipschitz_with.of_dist_le' $
assume x y,
abs_sub_le_iff.2 ⟨I x y, dist_comm y x ▸ I y x⟩

/-- For functions to `ℝ`, it suffices to prove `f x ≤ f y + K * dist x y`; this version
assumes `0≤K`. -/
protected lemma of_le_add_mul {f : α → ℝ} (K : ℝ≥0) (h : ∀x y, f x ≤ f y + K * dist x y) :
  lipschitz_with K f :=
by simpa only [nnreal.of_real_coe] using lipschitz_with.of_le_add_mul' K h

protected lemma of_le_add {f : α → ℝ} (h : ∀ x y, f x ≤ f y + dist x y) :
  lipschitz_with 1 f :=
lipschitz_with.of_le_add_mul 1 $ by simpa only [nnreal.coe_one, one_mul]

protected lemma le_add_mul {f : α → ℝ} {K : ℝ≥0} (h : lipschitz_with K f) (x y) :
  f x ≤ f y + K * dist x y :=
sub_le_iff_le_add'.1 $ le_trans (le_abs_self _) $ h.dist_le_mul x y

protected lemma iff_le_add_mul {f : α → ℝ} {K : ℝ≥0} :
  lipschitz_with K f ↔ ∀ x y, f x ≤ f y + K * dist x y :=
⟨lipschitz_with.le_add_mul, lipschitz_with.of_le_add_mul K⟩

lemma nndist_le {f : α → β} (hf : lipschitz_with K f) (x y : α) :
  nndist (f x) (f y) ≤ K * nndist x y :=
hf.dist_le_mul x y

lemma diam_image_le {f : α → β} (hf : lipschitz_with K f) (s : set α) (hs : metric.bounded s) :
  metric.diam (f '' s) ≤ K * metric.diam s :=
begin
  apply metric.diam_le_of_forall_dist_le (mul_nonneg K.coe_nonneg metric.diam_nonneg),
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩,
  calc dist (f x) (f y) ≤ ↑K * dist x y      : hf.dist_le_mul x y
                    ... ≤ ↑K * metric.diam s :
    mul_le_mul_of_nonneg_left (metric.dist_le_diam_of_mem hs hx hy) K.2
end

protected lemma dist_left (y : α) : lipschitz_with 1 (λ x, dist x y) :=
lipschitz_with.of_le_add $ assume x z, by { rw [add_comm], apply dist_triangle }

protected lemma dist_right (x : α) : lipschitz_with 1 (dist x) :=
lipschitz_with.of_le_add $ assume y z, dist_triangle_right _ _ _

protected lemma dist : lipschitz_with 2 (function.uncurry $ @dist α _) :=
lipschitz_with.uncurry lipschitz_with.dist_left lipschitz_with.dist_right

lemma dist_iterate_succ_le_geometric {f : α → α} (hf : lipschitz_with K f) (x n) :
  dist (f^[n] x) (f^[n + 1] x) ≤ dist x (f x) * K ^ n :=
begin
  rw [iterate_succ, mul_comm],
  simpa only [nnreal.coe_pow] using (hf.iterate n).dist_le_mul x (f x)
end

end metric

end lipschitz_with

namespace lipschitz_on_with

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {K : ℝ≥0} {s : set α} {f : α → β}

protected lemma uniform_continuous_on (hf : lipschitz_on_with K f s) : uniform_continuous_on f s :=
uniform_continuous_on_iff_restrict.mpr (lipschitz_on_with_iff_restrict.mp hf).uniform_continuous

protected lemma continuous_on (hf : lipschitz_on_with K f s) : continuous_on f s :=
hf.uniform_continuous_on.continuous_on

end lipschitz_on_with

open metric

/-- If a function is locally Lipschitz around a point, then it is continuous at this point. -/
lemma continuous_at_of_locally_lipschitz [metric_space α] [metric_space β] {f : α → β} {x : α}
  {r : ℝ} (hr : 0 < r) (K : ℝ) (h : ∀y, dist y x < r → dist (f y) (f x) ≤ K * dist y x) :
  continuous_at f x :=
begin
  refine (nhds_basis_ball.tendsto_iff nhds_basis_closed_ball).2
    (λε εpos, ⟨min r (ε / max K 1), _, λ y hy, _⟩),
  { simp [hr, div_pos εpos, zero_lt_one] },
  have A : max K 1 ≠ 0 := ne_of_gt (lt_max_iff.2 (or.inr zero_lt_one)),
  calc dist (f y) (f x)
    ≤ K * dist y x : h y (lt_of_lt_of_le hy (min_le_left _ _))
    ... ≤ max K 1 * dist y x : mul_le_mul_of_nonneg_right (le_max_left K 1) dist_nonneg
    ... ≤ max K 1 * (ε / max K 1) :
      mul_le_mul_of_nonneg_left (le_of_lt (lt_of_lt_of_le hy (min_le_right _ _)))
        (le_trans zero_le_one (le_max_right K 1))
    ... = ε : mul_div_cancel' _ A
end


import order.bounded_lattice set_theory.cardinal data.subtype

open_locale cardinal
universe u

section
parameters {α : Type u} [partial_order α]

-- A chain is a subset of faces where every pair of elements is related.
def is_chain (faces chain : set α) : Prop :=
chain ⊆ faces ∧ ∀ face₀ face₁ ∈ chain, face₀ ≤ face₁ ∨ face₁ ≤ face₀

namespace is_chain
-- The empty set is a chain.
lemma empty_chain (faces : set α) : is_chain faces ∅ :=
⟨set.empty_subset faces, λ _ _ h, absurd h $ set.not_mem_empty _⟩

-- A single face forms a chain.
lemma chain_single (faces : set α) (face ∈ faces) : is_chain faces {face} :=
⟨set.singleton_subset_iff.mpr ‹_›, λ _ _ (h₀ : _ = _) (h₁ : _ = _), by rw [h₀, h₁]; tauto⟩

-- A chain from the empty set is the empty set.
lemma no_faces (chain : set α) : is_chain ∅ chain ↔ chain = ∅ :=
⟨λ h, eq_bot_iff.mpr h.left, λ h, by rw h; apply empty_chain⟩

end is_chain

-- A flag is a maximal chain.
def is_flag (faces chain : set α) : Prop :=
is_chain faces chain ∧ ¬ ∃ chain', is_chain faces chain' → chain ⊂ chain'

-- A section is a set of faces bounded by two others.
def section_of {faces : set α} (face₀ face₁ ∈ faces) : face₀ ≤ face₁ → set α :=
λ _, {face ∈ faces | face₀ ≤ face ∧ face ≤ face₁}

section section_of
lemma section_single (faces : set α) (face ∈ faces) : section_of face face ‹_› ‹_› (le_refl _) = {face} :=
set.ext
  (λ face',
    ⟨(λ hf, begin
      cases hf with _ _,
      finish,
    end),
    (λ h, begin
      induction h,
      fconstructor,
      exact H,
      tauto,
    end)⟩)

#check set.Ioo
-- add lemmas about section_of {x} _ _ = {x}

end section_of

theorem is_flag.imp_is_chain {faces chain : set α} : is_flag faces chain → is_chain faces chain :=
and.left

def chains (faces : set α) : set (set α) :=
{chain | is_chain faces chain}

def flags (faces : set α) : set (set α) :=
{chain | is_flag faces chain}

theorem flags_sub_chains (faces : set α) : flags faces ⊆ chains faces :=
λ _, is_flag.imp_is_chain

def is_rank_of_face {faces : set α} (face ∈ faces) (c : cardinal) : Prop :=
∀ chain ∈ chains faces, face ∈ chain → (∀ face' ∈ chain, face' ≤ face) → # chain = c + 1

def proper_faces (faces : set α) : set α :=
{face ∈ faces | ∃ face₀ face₁ ∈ faces, face₀ < face ∧ face < face₁}

def connected (faces : set α) : Prop :=
∀ face₀ face₁ ∈ proper_faces faces, ∃ chain ∈ chains faces, face₀ ∈ chain ∧ face₁ ∈ chain

def strongly_connected (faces : set α) : Prop :=
∀ face₀ face₁ ∈ faces, face₀ ≤ face₁ → connected (section_of face₀ face₁ ‹_› ‹_› ‹_›)

end

structure abstract_polytope (α : Type u) [partial_order α] :=
(faces : set α)
(has_bot : ∃ face ∈ faces, ∀ face' ∈ faces, face ≤ face')
(has_top : ∃ face ∈ faces, ∀ face' ∈ faces, face' ≤ face)
(flags_same_card : ∃ c, ∀ flag ∈ flags faces, # (flag : set α) = c)
(is_scon : strongly_connected faces)
(diamond : ∀ (face₀ face₁ ∈ faces) c, face₀ < face₁ → is_rank_of_face face₀ ‹_› c → is_rank_of_face face₁ ‹_› (c + 2) →
  ∃ d₀ d₁ ∈ faces, d₀ ≠ d₁ ∧ {face ∈ faces | face₀ < face ∧ face < face₁} = {d₀, d₁})

namespace abstract_polytope

def nullitope (α : Type u) [partial_order α] [inhabited α] : abstract_polytope α :=
let x := arbitrary α in
⟨
  {x},
  ⟨x, rfl, λ _ h, le_of_eq $ eq.symm h⟩,
  ⟨x, rfl, λ _ h, ge_of_eq $ eq.symm h⟩,
  ⟨1, λ chain (h : _ ∧ _), begin
    rcases h with ⟨⟨hll, _⟩, h⟩,
    rw set.subset_singleton_iff at hll,
    push_neg at h,
    sorry,
  end⟩,
  begin
    rintros _ _ h₀ h₁ hle _ _ hf₀,
    rw set.mem_singleton_iff at h₀ h₁,
    cases h₀, cases h₁,
    rcases hf₀ with ⟨_, _, _, _, _, ⟨hltl, htlr⟩⟩,
    sorry,
  end,
  begin
    intros _ _ h₀ h₁ c hlt,
    rw set.mem_singleton_iff at h₀ h₁,
    rw [h₀, h₁] at hlt,
    exact absurd hlt (asymm hlt)
  end,
⟩

end abstract_polytope


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