/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes

Proof of Fermat's theorem on the sum of two squares. Every prime congruent to 1 mod 4 is the sum
of two squares
-/

import data.zsqrtd.gaussian_int data.zmod.quadratic_reciprocity ring_theory.principal_ideal_domain

open gaussian_int principal_ideal_domain zsqrtd

local notation `ℤ[i]` := gaussian_int

namespace nat
namespace prime

lemma sum_two_squares {p : ℕ} (hp : p.prime) (hp1 : p % 4 = 1) :
  ∃ a b : ℕ, a ^ 2 + b ^ 2 = p :=
let ⟨k, hk⟩ := (zmodp.exists_pow_two_eq_neg_one_iff_mod_four_ne_three hp).2 $
  by rw hp1; exact dec_trivial in
have hpk : p ∣ k.val ^ 2 + 1,
  by rw [← zmodp.eq_zero_iff_dvd_nat hp]; simp *,
have hkmul : (k.val ^ 2 + 1 : ℤ[i]) = ⟨k.val, 1⟩ * ⟨k.val, -1⟩ :=
  by simp [_root_.pow_two, zsqrtd.ext],
have hpne1 : p ≠ 1, from (ne_of_lt (hp.gt_one)).symm,
have hkltp : 1 + k.val * k.val < p * p,
  from calc 1 + k.val * k.val ≤ k.val + k.val * k.val :
    add_le_add_right (nat.pos_of_ne_zero
      (λ hk0, by clear_aux_decl; simp [*, nat.pow_succ] at *)) _
  ... = k.val * (k.val + 1) : by simp [mul_add]
  ... < p * p : mul_lt_mul k.2 k.2 (nat.succ_pos _) (nat.zero_le _),
have hpk₁ : ¬ (p : ℤ[i]) ∣ ⟨k.val, -1⟩ :=
  λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
    calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k.val, -1⟩).nat_abs : by rw hx
    ... < (norm (p : ℤ[i])).nat_abs : by simpa [norm] using hkltp
    ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
      (λ hx0, (show (-1 : ℤ) ≠ 0, from dec_trivial) $
         by simpa [hx0] using congr_arg zsqrtd.im hx),
have hpk₂ : ¬ (p : ℤ[i]) ∣ ⟨k.val, 1⟩ :=
  λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
    calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k.val, 1⟩).nat_abs : by rw hx
    ... < (norm (p : ℤ[i])).nat_abs : by simpa [norm] using hkltp
    ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
      (λ hx0, (show (1 : ℤ) ≠ 0, from dec_trivial) $
          by simpa [hx0] using congr_arg zsqrtd.im hx),
have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2 $
  by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
  exact λ h, (ne_of_lt hp.gt_one).symm h.1,
let ⟨y, hy⟩ := hpk in
have hpi : ¬ irreducible (p : ℤ[i]),
  from mt irreducible_iff_prime.1
    (λ hp, by have := hp.2.2 ⟨k.val, 1⟩ ⟨k.val, -1⟩
        ⟨y, by rw [← hkmul, ← nat.cast_mul p, ← hy]; simp⟩;
      clear_aux_decl; tauto),
have hab : ∃ a b, (p : ℤ[i]) = a * b ∧ ¬ is_unit a ∧ ¬ is_unit b,
  by simpa [irreducible, hpu, classical.not_forall, not_or_distrib] using hpi,
let ⟨a, b, hpab, hau, hbu⟩ := hab in
have hnap : (norm a).nat_abs = p, from ((hp.mul_eq_prime_pow_two_iff
    (mt norm_eq_one_iff.1 hau) (mt norm_eq_one_iff.1 hbu)).1 $
  by rw [← int.coe_nat_inj', int.coe_nat_pow, _root_.pow_two,
    ← @norm_nat_cast (-1), hpab];
    simp).1,
⟨a.re.nat_abs, a.im.nat_abs, by simpa [nat_abs_norm_eq, pow_two] using hnap⟩

end prime
end nat


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.finset.sort
import data.fin.vec_notation
import data.sign
import linear_algebra.affine_space.combination
import linear_algebra.affine_space.affine_equiv
import linear_algebra.basis

/-!
# Affine independence

This file defines affinely independent families of points.

## Main definitions

* `affine_independent` defines affinely independent families of points
  as those where no nontrivial weighted subtraction is `0`.  This is
  proved equivalent to two other formulations: linear independence of
  the results of subtracting a base point in the family from the other
  points in the family, or any equal affine combinations having the
  same weights.  A bundled type `simplex` is provided for finite
  affinely independent families of points, with an abbreviation
  `triangle` for the case of three points.

## References

* https://en.wikipedia.org/wiki/Affine_space

-/

noncomputable theory
open_locale big_operators affine
open function

section affine_independent

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*}
include V

/-- An indexed family is said to be affinely independent if no
nontrivial weighted subtractions (where the sum of weights is 0) are
0. -/
def affine_independent (p : ι → P) : Prop :=
∀ (s : finset ι) (w : ι → k), ∑ i in s, w i = 0 → s.weighted_vsub p w = (0:V) → ∀ i ∈ s, w i = 0

/-- The definition of `affine_independent`. -/
lemma affine_independent_def (p : ι → P) :
  affine_independent k p ↔
    ∀ (s : finset ι) (w : ι → k),
      ∑ i in s, w i = 0 → s.weighted_vsub p w = (0 : V) → ∀ i ∈ s, w i = 0 :=
iff.rfl

/-- A family with at most one point is affinely independent. -/
lemma affine_independent_of_subsingleton [subsingleton ι] (p : ι → P) :
  affine_independent k p :=
λ s w h hs i hi, fintype.eq_of_subsingleton_of_sum_eq h i hi

/-- A family indexed by a `fintype` is affinely independent if and
only if no nontrivial weighted subtractions over `finset.univ` (where
the sum of the weights is 0) are 0. -/
lemma affine_independent_iff_of_fintype [fintype ι] (p : ι → P) :
  affine_independent k p ↔
    ∀ w : ι → k, ∑ i, w i = 0 → finset.univ.weighted_vsub p w = (0 : V) → ∀ i, w i = 0 :=
begin
  split,
  { exact λ h w hw hs i, h finset.univ w hw hs i (finset.mem_univ _) },
  { intros h s w hw hs i hi,
    rw finset.weighted_vsub_indicator_subset _ _ (finset.subset_univ s) at hs,
    rw set.sum_indicator_subset _ (finset.subset_univ s) at hw,
    replace h := h ((↑s : set ι).indicator w) hw hs i,
    simpa [hi] using h }
end

/-- A family is affinely independent if and only if the differences
from a base point in that family are linearly independent. -/
lemma affine_independent_iff_linear_independent_vsub (p : ι → P) (i1 : ι) :
  affine_independent k p ↔ linear_independent k (λ i : {x // x ≠ i1}, (p i -ᵥ p i1 : V)) :=
begin
  classical,
  split,
  { intro h,
    rw linear_independent_iff',
    intros s g hg i hi,
    set f : ι → k := λ x, if hx : x = i1 then -∑ y in s, g y else g ⟨x, hx⟩ with hfdef,
    let s2 : finset ι := insert i1 (s.map (embedding.subtype _)),
    have hfg : ∀ x : {x // x ≠ i1}, g x = f x,
    { intro x,
      rw hfdef,
      dsimp only [],
      erw [dif_neg x.property, subtype.coe_eta] },
    rw hfg,
    have hf : ∑ ι in s2, f ι = 0,
    { rw [finset.sum_insert (finset.not_mem_map_subtype_of_not_property s (not_not.2 rfl)),
          finset.sum_subtype_map_embedding (λ x hx, (hfg x).symm)],
      rw hfdef,
      dsimp only [],
      rw dif_pos rfl,
      exact neg_add_self _ },
    have hs2 : s2.weighted_vsub p f = (0:V),
    { set f2 : ι → V := λ x, f x • (p x -ᵥ p i1) with hf2def,
      set g2 : {x // x ≠ i1} → V := λ x, g x • (p x -ᵥ p i1) with hg2def,
      have hf2g2 : ∀ x : {x // x ≠ i1}, f2 x = g2 x,
      { simp_rw [hf2def, hg2def, hfg],
        exact λ x, rfl },
      rw [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero s2 f p hf (p i1),
          finset.weighted_vsub_of_point_insert, finset.weighted_vsub_of_point_apply,
          finset.sum_subtype_map_embedding (λ x hx, hf2g2 x)],
      exact hg },
    exact h s2 f hf hs2 i (finset.mem_insert_of_mem (finset.mem_map.2 ⟨i, hi, rfl⟩)) },
  { intro h,
    rw linear_independent_iff' at h,
    intros s w hw hs i hi,
    rw [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero s w p hw (p i1),
        ←s.weighted_vsub_of_point_erase w p i1, finset.weighted_vsub_of_point_apply] at hs,
    let f : ι → V := λ i, w i • (p i -ᵥ p i1),
    have hs2 : ∑ i in (s.erase i1).subtype (λ i, i ≠ i1), f i = 0,
    { rw [←hs],
      convert finset.sum_subtype_of_mem f (λ x, finset.ne_of_mem_erase) },
    have h2 := h ((s.erase i1).subtype (λ i, i ≠ i1)) (λ x, w x) hs2,
    simp_rw [finset.mem_subtype] at h2,
    have h2b : ∀ i ∈ s, i ≠ i1 → w i = 0 :=
      λ i his hi, h2 ⟨i, hi⟩ (finset.mem_erase_of_ne_of_mem hi his),
    exact finset.eq_zero_of_sum_eq_zero hw h2b i hi }
end

/-- A set is affinely independent if and only if the differences from
a base point in that set are linearly independent. -/
lemma affine_independent_set_iff_linear_independent_vsub {s : set P} {p₁ : P} (hp₁ : p₁ ∈ s) :
  affine_independent k (λ p, p : s → P) ↔
  linear_independent k (λ v, v : (λ p, (p -ᵥ p₁ : V)) '' (s \ {p₁}) → V) :=
begin
  rw affine_independent_iff_linear_independent_vsub k (λ p, p : s → P) ⟨p₁, hp₁⟩,
  split,
  { intro h,
    have hv : ∀ v : (λ p, (p -ᵥ p₁ : V)) '' (s \ {p₁}), (v : V) +ᵥ p₁ ∈ s \ {p₁} :=
      λ v, (vsub_left_injective p₁).mem_set_image.1
             ((vadd_vsub (v : V) p₁).symm ▸ v.property),
    let f : (λ p : P, (p -ᵥ p₁ : V)) '' (s \ {p₁}) → {x : s // x ≠ ⟨p₁, hp₁⟩} :=
      λ x, ⟨⟨(x : V) +ᵥ p₁, set.mem_of_mem_diff (hv x)⟩,
            λ hx, set.not_mem_of_mem_diff (hv x) (subtype.ext_iff.1 hx)⟩,
    convert h.comp f
      (λ x1 x2 hx, (subtype.ext (vadd_right_cancel p₁ (subtype.ext_iff.1 (subtype.ext_iff.1 hx))))),
    ext v,
    exact (vadd_vsub (v : V) p₁).symm },
  { intro h,
    let f : {x : s // x ≠ ⟨p₁, hp₁⟩} → (λ p : P, (p -ᵥ p₁ : V)) '' (s \ {p₁}) :=
      λ x, ⟨((x : s) : P) -ᵥ p₁, ⟨x, ⟨⟨(x : s).property, λ hx, x.property (subtype.ext hx)⟩, rfl⟩⟩⟩,
    convert h.comp f
      (λ x1 x2 hx, subtype.ext (subtype.ext (vsub_left_cancel (subtype.ext_iff.1 hx)))) }
end

/-- A set of nonzero vectors is linearly independent if and only if,
given a point `p₁`, the vectors added to `p₁` and `p₁` itself are
affinely independent. -/
lemma linear_independent_set_iff_affine_independent_vadd_union_singleton {s : set V}
  (hs : ∀ v ∈ s, v ≠ (0 : V)) (p₁ : P) : linear_independent k (λ v, v : s → V) ↔
  affine_independent k (λ p, p : {p₁} ∪ ((λ v, v +ᵥ p₁) '' s) → P) :=
begin
  rw affine_independent_set_iff_linear_independent_vsub k
    (set.mem_union_left _ (set.mem_singleton p₁)),
  have h : (λ p, (p -ᵥ p₁ : V)) '' (({p₁} ∪ (λ v, v +ᵥ p₁) '' s) \ {p₁}) = s,
  { simp_rw [set.union_diff_left, set.image_diff (vsub_left_injective p₁), set.image_image,
             set.image_singleton, vsub_self, vadd_vsub, set.image_id'],
    exact set.diff_singleton_eq_self (λ h, hs 0 h rfl) },
  rw h
end

/-- A family is affinely independent if and only if any affine
combinations (with sum of weights 1) that evaluate to the same point
have equal `set.indicator`. -/
lemma affine_independent_iff_indicator_eq_of_affine_combination_eq (p : ι → P) :
  affine_independent k p ↔ ∀ (s1 s2 : finset ι) (w1 w2 : ι → k), ∑ i in s1, w1 i = 1 →
    ∑ i in s2, w2 i = 1 → s1.affine_combination k p w1 = s2.affine_combination k p w2 →
      set.indicator ↑s1 w1 = set.indicator ↑s2 w2 :=
begin
  classical,
  split,
  { intros ha s1 s2 w1 w2 hw1 hw2 heq,
    ext i,
    by_cases hi : i ∈ (s1 ∪ s2),
    { rw ←sub_eq_zero,
      rw set.sum_indicator_subset _ (finset.subset_union_left s1 s2) at hw1,
      rw set.sum_indicator_subset _ (finset.subset_union_right s1 s2) at hw2,
      have hws : ∑ i in s1 ∪ s2, (set.indicator ↑s1 w1 - set.indicator ↑s2 w2) i = 0,
      { simp [hw1, hw2] },
      rw [finset.affine_combination_indicator_subset _ _ (finset.subset_union_left s1 s2),
          finset.affine_combination_indicator_subset _ _ (finset.subset_union_right s1 s2),
          ←@vsub_eq_zero_iff_eq V, finset.affine_combination_vsub] at heq,
      exact ha (s1 ∪ s2) (set.indicator ↑s1 w1 - set.indicator ↑s2 w2) hws heq i hi },
    { rw [←finset.mem_coe, finset.coe_union] at hi,
      simp [mt (set.mem_union_left ↑s2) hi, mt (set.mem_union_right ↑s1) hi] } },
  { intros ha s w hw hs i0 hi0,
    let w1 : ι → k := function.update (function.const ι 0) i0 1,
    have hw1 : ∑ i in s, w1 i = 1,
    { rw [finset.sum_update_of_mem hi0, finset.sum_const_zero, add_zero] },
    have hw1s : s.affine_combination k p w1 = p i0 :=
      s.affine_combination_of_eq_one_of_eq_zero w1 p hi0 (function.update_same _ _ _)
                                                (λ _ _ hne, function.update_noteq hne _ _),
    let w2 := w + w1,
    have hw2 : ∑ i in s, w2 i = 1,
    { simp [w2, finset.sum_add_distrib, hw, hw1] },
    have hw2s : s.affine_combination k p w2 = p i0,
    { simp [w2, ←finset.weighted_vsub_vadd_affine_combination, hs, hw1s] },
    replace ha := ha s s w2 w1 hw2 hw1 (hw1s.symm ▸ hw2s),
    have hws : w2 i0 - w1 i0 = 0,
    { rw ←finset.mem_coe at hi0,
      rw [←set.indicator_of_mem hi0 w2, ←set.indicator_of_mem hi0 w1, ha, sub_self] },
    simpa [w2] using hws }
end

/-- A finite family is affinely independent if and only if any affine
combinations (with sum of weights 1) that evaluate to the same point are equal. -/
lemma affine_independent_iff_eq_of_fintype_affine_combination_eq [fintype ι] (p : ι → P) :
  affine_independent k p ↔ ∀ (w1 w2 : ι → k), ∑ i, w1 i = 1 → ∑ i, w2 i = 1 →
    finset.univ.affine_combination k p w1 = finset.univ.affine_combination k p w2 → w1 = w2 :=
begin
  rw affine_independent_iff_indicator_eq_of_affine_combination_eq,
  split,
  { intros h w1 w2 hw1 hw2 hweq,
    simpa only [set.indicator_univ, finset.coe_univ] using h _ _ w1 w2 hw1 hw2 hweq, },
  { intros h s1 s2 w1 w2 hw1 hw2 hweq,
    have hw1' : ∑ i, (s1 : set ι).indicator w1 i = 1,
    { rwa set.sum_indicator_subset _ (finset.subset_univ s1) at hw1, },
    have hw2' : ∑ i, (s2 : set ι).indicator w2 i = 1,
    { rwa set.sum_indicator_subset _ (finset.subset_univ s2) at hw2, },
    rw [finset.affine_combination_indicator_subset w1 p (finset.subset_univ s1),
        finset.affine_combination_indicator_subset w2 p (finset.subset_univ s2)] at hweq,
    exact h _ _ hw1' hw2' hweq, },
end

variables {k}

/-- If we single out one member of an affine-independent family of points and affinely transport
all others along the line joining them to this member, the resulting new family of points is affine-
independent.

This is the affine version of `linear_independent.units_smul`. -/
lemma affine_independent.units_line_map
  {p : ι → P} (hp : affine_independent k p) (j : ι) (w : ι → units k) :
  affine_independent k (λ i, affine_map.line_map (p j) (p i) (w i : k)) :=
begin
  rw affine_independent_iff_linear_independent_vsub k _ j at hp ⊢,
  simp only [affine_map.line_map_vsub_left, affine_map.coe_const, affine_map.line_map_same],
  exact hp.units_smul (λ i, w i),
end

lemma affine_independent.indicator_eq_of_affine_combination_eq {p : ι → P}
  (ha : affine_independent k p) (s₁ s₂ : finset ι) (w₁ w₂ : ι → k) (hw₁ : ∑ i in s₁, w₁ i = 1)
  (hw₂ : ∑ i in s₂, w₂ i = 1) (h : s₁.affine_combination k p w₁ = s₂.affine_combination k p w₂) :
  set.indicator ↑s₁ w₁ = set.indicator ↑s₂ w₂ :=
(affine_independent_iff_indicator_eq_of_affine_combination_eq k p).1 ha s₁ s₂ w₁ w₂ hw₁ hw₂ h

/-- An affinely independent family is injective, if the underlying
ring is nontrivial. -/
protected lemma affine_independent.injective [nontrivial k] {p : ι → P}
  (ha : affine_independent k p) :
  function.injective p :=
begin
  intros i j hij,
  rw affine_independent_iff_linear_independent_vsub _ _ j at ha,
  by_contra hij',
  exact ha.ne_zero ⟨i, hij'⟩ (vsub_eq_zero_iff_eq.mpr hij)
end

/-- If a family is affinely independent, so is any subfamily given by
composition of an embedding into index type with the original
family. -/
lemma affine_independent.comp_embedding {ι2 : Type*} (f : ι2 ↪ ι) {p : ι → P}
    (ha : affine_independent k p) : affine_independent k (p ∘ f) :=
begin
  classical,
  intros fs w hw hs i0 hi0,
  let fs' := fs.map f,
  let w' := λ i, if h : ∃ i2, f i2 = i then w h.some else 0,
  have hw' : ∀ i2 : ι2, w' (f i2) = w i2,
  { intro i2,
    have h : ∃ i : ι2, f i = f i2 := ⟨i2, rfl⟩,
    have hs : h.some = i2 := f.injective h.some_spec,
    simp_rw [w', dif_pos h, hs] },
  have hw's : ∑ i in fs', w' i = 0,
  { rw [←hw, finset.sum_map],
    simp [hw'] },
  have hs' : fs'.weighted_vsub p w' = (0:V),
  { rw [←hs, finset.weighted_vsub_map],
    congr' with i,
    simp [hw'] },
  rw [←ha fs' w' hw's hs' (f i0) ((finset.mem_map' _).2 hi0), hw']
end

/-- If a family is affinely independent, so is any subfamily indexed
by a subtype of the index type. -/
protected lemma affine_independent.subtype {p : ι → P}
    (ha : affine_independent k p) (s : set ι) : affine_independent k (λ i : s, p i) :=
ha.comp_embedding (embedding.subtype _)

/-- If an indexed family of points is affinely independent, so is the
corresponding set of points. -/
protected lemma affine_independent.range {p : ι → P} (ha : affine_independent k p) :
  affine_independent k (λ x, x : set.range p → P) :=
begin
  let f : set.range p → ι := λ x, x.property.some,
  have hf : ∀ x, p (f x) = x := λ x, x.property.some_spec,
  let fe : set.range p ↪ ι := ⟨f, λ x₁ x₂ he, subtype.ext (hf x₁ ▸ hf x₂ ▸ he ▸ rfl)⟩,
  convert ha.comp_embedding fe,
  ext,
  simp [hf]
end

lemma affine_independent_equiv {ι' : Type*} (e : ι ≃ ι') {p : ι' → P} :
  affine_independent k (p ∘ e) ↔ affine_independent k p :=
begin
  refine ⟨_, affine_independent.comp_embedding e.to_embedding⟩,
  intros h,
  have : p = p ∘ e ∘ e.symm.to_embedding, { ext, simp, },
  rw this,
  exact h.comp_embedding e.symm.to_embedding,
end

/-- If a set of points is affinely independent, so is any subset. -/
protected lemma affine_independent.mono {s t : set P}
  (ha : affine_independent k (λ x, x : t → P)) (hs : s ⊆ t) :
  affine_independent k (λ x, x : s → P) :=
ha.comp_embedding (s.embedding_of_subset t hs)

/-- If the range of an injective indexed family of points is affinely
independent, so is that family. -/
lemma affine_independent.of_set_of_injective {p : ι → P}
  (ha : affine_independent k (λ x, x : set.range p → P)) (hi : function.injective p) :
  affine_independent k p :=
ha.comp_embedding
  (⟨λ i, ⟨p i, set.mem_range_self _⟩, λ x y h, hi (subtype.mk_eq_mk.1 h)⟩ : ι ↪ set.range p)

section composition

variables {V₂ P₂ : Type*} [add_comm_group V₂] [module k V₂] [affine_space V₂ P₂]
include V₂

/-- If the image of a family of points in affine space under an affine transformation is affine-
independent, then the original family of points is also affine-independent. -/
lemma affine_independent.of_comp {p : ι → P} (f : P →ᵃ[k] P₂) (hai : affine_independent k (f ∘ p)) :
  affine_independent k p :=
begin
  cases is_empty_or_nonempty ι with h h, { haveI := h, apply affine_independent_of_subsingleton, },
  obtain ⟨i⟩ := h,
  rw affine_independent_iff_linear_independent_vsub k p i,
  simp_rw [affine_independent_iff_linear_independent_vsub k (f ∘ p) i, function.comp_app,
    ← f.linear_map_vsub] at hai,
  exact linear_independent.of_comp f.linear hai,
end

/-- The image of a family of points in affine space, under an injective affine transformation, is
affine-independent. -/
lemma affine_independent.map'
  {p : ι → P} (hai : affine_independent k p) (f : P →ᵃ[k] P₂) (hf : function.injective f) :
  affine_independent k (f ∘ p) :=
begin
  cases is_empty_or_nonempty ι with h h, { haveI := h, apply affine_independent_of_subsingleton, },
  obtain ⟨i⟩ := h,
  rw affine_independent_iff_linear_independent_vsub k p i at hai,
  simp_rw [affine_independent_iff_linear_independent_vsub k (f ∘ p) i, function.comp_app,
    ← f.linear_map_vsub],
  have hf' : f.linear.ker = ⊥, { rwa [linear_map.ker_eq_bot, f.linear_injective_iff], },
  exact linear_independent.map' hai f.linear hf',
end

/-- Injective affine maps preserve affine independence. -/
lemma affine_map.affine_independent_iff {p : ι → P} (f : P →ᵃ[k] P₂) (hf : function.injective f) :
  affine_independent k (f ∘ p) ↔ affine_independent k p :=
⟨affine_independent.of_comp f, λ hai, affine_independent.map' hai f hf⟩

/-- Affine equivalences preserve affine independence of families of points. -/
lemma affine_equiv.affine_independent_iff {p : ι → P} (e : P ≃ᵃ[k] P₂) :
  affine_independent k (e ∘ p) ↔ affine_independent k p :=
e.to_affine_map.affine_independent_iff e.to_equiv.injective

/-- Affine equivalences preserve affine independence of subsets. -/
lemma affine_equiv.affine_independent_set_of_eq_iff {s : set P} (e : P ≃ᵃ[k] P₂) :
  affine_independent k (coe : (e '' s) → P₂) ↔ affine_independent k (coe : s → P) :=
begin
  have : e ∘ (coe : s → P) = (coe : e '' s → P₂) ∘ ((e : P ≃ P₂).image s) := rfl,
  rw [← e.affine_independent_iff, this, affine_independent_equiv],
end

end composition

/-- If a family is affinely independent, and the spans of points
indexed by two subsets of the index type have a point in common, those
subsets of the index type have an element in common, if the underlying
ring is nontrivial. -/
lemma affine_independent.exists_mem_inter_of_exists_mem_inter_affine_span [nontrivial k]
    {p : ι → P} (ha : affine_independent k p) {s1 s2 : set ι} {p0 : P}
    (hp0s1 : p0 ∈ affine_span k (p '' s1)) (hp0s2 : p0 ∈ affine_span k (p '' s2)):
  ∃ (i : ι), i ∈ s1 ∩ s2 :=
begin
  rw set.image_eq_range at hp0s1 hp0s2,
  rw [mem_affine_span_iff_eq_affine_combination,
      ←finset.eq_affine_combination_subset_iff_eq_affine_combination_subtype] at hp0s1 hp0s2,
  rcases hp0s1 with ⟨fs1, hfs1, w1, hw1, hp0s1⟩,
  rcases hp0s2 with ⟨fs2, hfs2, w2, hw2, hp0s2⟩,
  rw affine_independent_iff_indicator_eq_of_affine_combination_eq at ha,
  replace ha := ha fs1 fs2 w1 w2 hw1 hw2 (hp0s1 ▸ hp0s2),
  have hnz : ∑ i in fs1, w1 i ≠ 0 := hw1.symm ▸ one_ne_zero,
  rcases finset.exists_ne_zero_of_sum_ne_zero hnz with ⟨i, hifs1, hinz⟩,
  simp_rw [←set.indicator_of_mem (finset.mem_coe.2 hifs1) w1, ha] at hinz,
  use [i, hfs1 hifs1, hfs2 (set.mem_of_indicator_ne_zero hinz)]
end

/-- If a family is affinely independent, the spans of points indexed
by disjoint subsets of the index type are disjoint, if the underlying
ring is nontrivial. -/
lemma affine_independent.affine_span_disjoint_of_disjoint [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) {s1 s2 : set ι} (hd : disjoint s1 s2) :
  disjoint (affine_span k (p '' s1) : set P) (affine_span k (p '' s2)) :=
begin
  refine set.disjoint_left.2 (λ p0 hp0s1 hp0s2, _),
  cases ha.exists_mem_inter_of_exists_mem_inter_affine_span hp0s1 hp0s2 with i hi,
  exact set.disjoint_iff.1 hd hi,
end

/-- If a family is affinely independent, a point in the family is in
the span of some of the points given by a subset of the index type if
and only if that point's index is in the subset, if the underlying
ring is nontrivial. -/
@[simp] protected lemma affine_independent.mem_affine_span_iff [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) (i : ι) (s : set ι) :
  p i ∈ affine_span k (p '' s) ↔ i ∈ s :=
begin
  split,
  { intro hs,
    have h := affine_independent.exists_mem_inter_of_exists_mem_inter_affine_span
      ha hs (mem_affine_span k (set.mem_image_of_mem _ (set.mem_singleton _))),
    rwa [←set.nonempty_def, set.inter_singleton_nonempty] at h },
  { exact λ h, mem_affine_span k (set.mem_image_of_mem p h) }
end

/-- If a family is affinely independent, a point in the family is not
in the affine span of the other points, if the underlying ring is
nontrivial. -/
lemma affine_independent.not_mem_affine_span_diff [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) (i : ι) (s : set ι) :
  p i ∉ affine_span k (p '' (s \ {i})) :=
by simp [ha]

lemma exists_nontrivial_relation_sum_zero_of_not_affine_ind
  {t : finset V} (h : ¬ affine_independent k (coe : t → V)) :
  ∃ f : V → k, ∑ e in t, f e • e = 0 ∧ ∑ e in t, f e = 0 ∧ ∃ x ∈ t, f x ≠ 0 :=
begin
  classical,
  rw affine_independent_iff_of_fintype at h,
  simp only [exists_prop, not_forall] at h,
  obtain ⟨w, hw, hwt, i, hi⟩ := h,
  simp only [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero _ w (coe : t → V) hw 0,
    vsub_eq_sub, finset.weighted_vsub_of_point_apply, sub_zero] at hwt,
  let f : Π (x : V), x ∈ t → k := λ x hx, w ⟨x, hx⟩,
  refine ⟨λ x, if hx : x ∈ t then f x hx else (0 : k), _, _, by { use i, simp [hi, f], }⟩,
  suffices : ∑ (e : V) in t, dite (e ∈ t) (λ hx, (f e hx) • e) (λ hx, 0) = 0,
  { convert this, ext, by_cases hx : x ∈ t; simp [hx], },
  all_goals
  { simp only [finset.sum_dite_of_true (λx h, h), subtype.val_eq_coe, finset.mk_coe, f, hwt, hw], },
end

/-- Viewing a module as an affine space modelled on itself, we can characterise affine independence
in terms of linear combinations. -/
lemma affine_independent_iff {ι} {p : ι → V} :
  affine_independent k p ↔
  ∀ (s : finset ι) (w : ι → k), s.sum w = 0 → ∑ e in s, w e • p e = 0 → ∀ (e ∈ s), w e = 0 :=
forall₃_congr (λ s w hw, by simp [s.weighted_vsub_eq_linear_combination hw])

/-- Given an affinely independent family of points, a weighted subtraction lies in the
`vector_span` of two points given as affine combinations if and only if it is a weighted
subtraction with weights a multiple of the difference between the weights of the two points. -/
lemma weighted_vsub_mem_vector_span_pair {p : ι → P} (h : affine_independent k p)
  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 0) (hw₁ : ∑ i in s, w₁ i = 1)
  (hw₂ : ∑ i in s, w₂ i = 1) :
  s.weighted_vsub p w ∈
    vector_span k ({s.affine_combination k p w₁, s.affine_combination k p w₂} : set P) ↔
    ∃ r : k, ∀ i ∈ s, w i = r * (w₁ i - w₂ i) :=
begin
  rw mem_vector_span_pair,
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with ⟨r, hr⟩,
    refine ⟨r, λ i hi, _⟩,
    rw [s.affine_combination_vsub, ←s.weighted_vsub_const_smul, ←sub_eq_zero, ←map_sub] at hr,
    have hw' : ∑ j in s, (r • (w₁ - w₂) - w) j = 0,
    { simp_rw [pi.sub_apply, pi.smul_apply, pi.sub_apply, smul_sub, finset.sum_sub_distrib,
               ←finset.smul_sum, hw, hw₁, hw₂, sub_self] },
    have hr' := h s _ hw' hr i hi,
    rw [eq_comm, ←sub_eq_zero, ←smul_eq_mul],
    exact hr' },
  { rcases h with ⟨r, hr⟩,
    refine ⟨r, _⟩,
    let w' := λ i, r * (w₁ i - w₂ i),
    change ∀ i ∈ s, w i = w' i at hr,
    rw [s.weighted_vsub_congr hr (λ _ _, rfl), s.affine_combination_vsub,
        ←s.weighted_vsub_const_smul],
    congr }
end

/-- Given an affinely independent family of points, an affine combination lies in the
span of two points given as affine combinations if and only if it is an affine combination
with weights those of one point plus a multiple of the difference between the weights of the
two points. -/
lemma affine_combination_mem_affine_span_pair {p : ι → P} (h : affine_independent k p)
  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1) (hw₁ : ∑ i in s, w₁ i = 1)
  (hw₂ : ∑ i in s, w₂ i = 1) :
  s.affine_combination k p w ∈
    line[k, s.affine_combination k p w₁, s.affine_combination k p w₂] ↔
    ∃ r : k, ∀ i ∈ s, w i = r * (w₂ i - w₁ i) + w₁ i :=
begin
  rw [←vsub_vadd (s.affine_combination k p w) (s.affine_combination k p w₁),
      affine_subspace.vadd_mem_iff_mem_direction _ (left_mem_affine_span_pair _ _ _),
      direction_affine_span, s.affine_combination_vsub, set.pair_comm,
      weighted_vsub_mem_vector_span_pair h _ hw₂ hw₁],
  { simp only [pi.sub_apply, sub_eq_iff_eq_add] },
  { simp_rw [pi.sub_apply, finset.sum_sub_distrib, hw, hw₁, sub_self] }
end

end affine_independent

section division_ring

variables {k : Type*} {V : Type*} {P : Type*} [division_ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*}
include V

/-- An affinely independent set of points can be extended to such a
set that spans the whole space. -/
lemma exists_subset_affine_independent_affine_span_eq_top {s : set P}
  (h : affine_independent k (λ p, p : s → P)) :
  ∃ t : set P, s ⊆ t ∧ affine_independent k (λ p, p : t → P) ∧ affine_span k t = ⊤ :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨p₁, hp₁⟩,
  { have p₁ : P := add_torsor.nonempty.some,
    let hsv := basis.of_vector_space k V,
    have hsvi := hsv.linear_independent,
    have hsvt := hsv.span_eq,
    rw basis.coe_of_vector_space at hsvi hsvt,
    have h0 : ∀ v : V, v ∈ (basis.of_vector_space_index _ _) → v ≠ 0,
    { intros v hv, simpa using hsv.ne_zero ⟨v, hv⟩ },
    rw linear_independent_set_iff_affine_independent_vadd_union_singleton k h0 p₁ at hsvi,
    exact ⟨{p₁} ∪ (λ v, v +ᵥ p₁) '' _, set.empty_subset _, hsvi,
         affine_span_singleton_union_vadd_eq_top_of_span_eq_top p₁ hsvt⟩ },
  { rw affine_independent_set_iff_linear_independent_vsub k hp₁ at h,
    let bsv := basis.extend h,
    have hsvi := bsv.linear_independent,
    have hsvt := bsv.span_eq,
    rw basis.coe_extend at hsvi hsvt,
    have hsv := h.subset_extend (set.subset_univ _),
    have h0 : ∀ v : V, v ∈ (h.extend _) → v ≠ 0,
    { intros v hv, simpa using bsv.ne_zero ⟨v, hv⟩ },
    rw linear_independent_set_iff_affine_independent_vadd_union_singleton k h0 p₁ at hsvi,
    refine ⟨{p₁} ∪ (λ v, v +ᵥ p₁) '' h.extend (set.subset_univ _), _, _⟩,
    { refine set.subset.trans _ (set.union_subset_union_right _ (set.image_subset _ hsv)),
      simp [set.image_image] },
    { use [hsvi, affine_span_singleton_union_vadd_eq_top_of_span_eq_top p₁ hsvt] } }
end

variables (k V)

lemma exists_affine_independent (s : set P) :
  ∃ t ⊆ s, affine_span k t = affine_span k s ∧ affine_independent k (coe : t → P) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨p, hp⟩,
  { exact ⟨∅, set.empty_subset ∅, rfl, affine_independent_of_subsingleton k _⟩, },
  obtain ⟨b, hb₁, hb₂, hb₃⟩ := exists_linear_independent k ((equiv.vadd_const p).symm '' s),
  have hb₀ : ∀ (v : V), v ∈ b → v ≠ 0, { exact λ v hv, hb₃.ne_zero (⟨v, hv⟩ : b), },
  rw linear_independent_set_iff_affine_independent_vadd_union_singleton k hb₀ p at hb₃,
  refine ⟨{p} ∪ (equiv.vadd_const p) '' b, _, _, hb₃⟩,
  { apply set.union_subset (set.singleton_subset_iff.mpr hp),
    rwa ← (equiv.vadd_const p).subset_image' b s, },
  { rw [equiv.coe_vadd_const_symm, ← vector_span_eq_span_vsub_set_right k hp] at hb₂,
    apply affine_subspace.ext_of_direction_eq,
    { have : submodule.span k b = submodule.span k (insert 0 b), { simp, },
      simp only [direction_affine_span, ← hb₂, equiv.coe_vadd_const, set.singleton_union,
        vector_span_eq_span_vsub_set_right k (set.mem_insert p _), this],
      congr,
      change (equiv.vadd_const p).symm '' insert p ((equiv.vadd_const p) '' b) = _,
      rw [set.image_insert_eq, ← set.image_comp],
      simp, },
    { use p,
      simp only [equiv.coe_vadd_const, set.singleton_union, set.mem_inter_iff, coe_affine_span],
      exact ⟨mem_span_points k _ _ (set.mem_insert p _), mem_span_points k _ _ hp⟩, }, },
end

variables (k) {V P}

/-- Two different points are affinely independent. -/
lemma affine_independent_of_ne {p₁ p₂ : P} (h : p₁ ≠ p₂) : affine_independent k ![p₁, p₂] :=
begin
  rw affine_independent_iff_linear_independent_vsub k ![p₁, p₂] 0,
  let i₁ : {x // x ≠ (0 : fin 2)} := ⟨1, by norm_num⟩,
  have he' : ∀ i, i = i₁,
  { rintro ⟨i, hi⟩,
    ext,
    fin_cases i,
    { simpa using hi } },
  haveI : unique {x // x ≠ (0 : fin 2)} := ⟨⟨i₁⟩, he'⟩,
  have hz : (![p₁, p₂] ↑default -ᵥ ![p₁, p₂] 0 : V) ≠ 0,
  { rw he' default, simpa using h.symm },
  exact linear_independent_unique _ hz
end

variables {k V P}

/-- If all but one point of a family are affinely independent, and that point does not lie in
the affine span of that family, the family is affinely independent. -/
lemma affine_independent.affine_independent_of_not_mem_span {p : ι → P} {i : ι}
  (ha : affine_independent k (λ x : {y // y ≠ i}, p x))
  (hi : p i ∉ affine_span k (p '' {x | x ≠ i})) : affine_independent k p :=
begin
  classical,
  intros s w hw hs,
  let s' : finset {y // y ≠ i} := s.subtype (≠ i),
  let p' : {y // y ≠ i} → P := λ x, p x,
  by_cases his : i ∈ s ∧ w i ≠ 0,
  { refine false.elim (hi _),
    let wm : ι → k := -(w i)⁻¹ • w,
    have hms : s.weighted_vsub p wm = (0 : V), { simp [wm, hs] },
    have hwm : ∑ i in s, wm i = 0, { simp [wm, ←finset.mul_sum, hw] },
    have hwmi : wm i = -1, { simp [wm, his.2] },
    let w' : {y // y ≠ i} → k := λ x, wm x,
    have hw' : ∑ x in s', w' x = 1,
    { simp_rw [w', finset.sum_subtype_eq_sum_filter],
      rw ←s.sum_filter_add_sum_filter_not (≠ i) at hwm,
      simp_rw [not_not, finset.filter_eq', if_pos his.1, finset.sum_singleton, ←wm, hwmi,
               ←sub_eq_add_neg, sub_eq_zero] at hwm,
      exact hwm },
    rw [←s.affine_combination_eq_of_weighted_vsub_eq_zero_of_eq_neg_one hms his.1 hwmi,
        ←(subtype.range_coe : _ = {x | x ≠ i}), ←set.range_comp,
        ←s.affine_combination_subtype_eq_filter],
    exact affine_combination_mem_affine_span hw' p' },
  { rw [not_and_distrib, not_not] at his,
    let w' : {y // y ≠ i} → k := λ x, w x,
    have hw' : ∑ x in s', w' x = 0,
    { simp_rw [finset.sum_subtype_eq_sum_filter],
      rw [finset.sum_filter_of_ne, hw],
      rintro x hxs hwx rfl,
      exact hwx (his.neg_resolve_left hxs) },
    have hs' : s'.weighted_vsub p' w' = (0 : V),
    { simp_rw finset.weighted_vsub_subtype_eq_filter,
      rw [finset.weighted_vsub_filter_of_ne, hs],
      rintro x hxs hwx rfl,
      exact hwx (his.neg_resolve_left hxs) },
    intros j hj,
    by_cases hji : j = i,
    { rw hji at hj,
      exact hji.symm ▸ (his.neg_resolve_left hj) },
    { exact ha s' w' hw' hs' ⟨j, hji⟩ (finset.mem_subtype.2 hj) } }
end

/-- If distinct points `p₁` and `p₂` lie in `s` but `p₃` does not, the three points are affinely
independent. -/
lemma affine_independent_of_ne_of_mem_of_mem_of_not_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
  (hp₁p₂ : p₁ ≠ p₂) (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∉ s) :
  affine_independent k ![p₁, p₂, p₃] :=
begin
  have ha : affine_independent k (λ x : {x : fin 3 // x ≠ 2}, ![p₁, p₂, p₃] x),
  { rw ←affine_independent_equiv ((fin_succ_above_equiv (2 : fin 3)).to_equiv),
    convert affine_independent_of_ne k hp₁p₂,
    ext x,
    fin_cases x;
      refl },
  refine ha.affine_independent_of_not_mem_span _,
  intro h,
  refine hp₃ ((affine_subspace.le_def' _ s).1 _ p₃ h),
  simp_rw [affine_span_le, set.image_subset_iff, set.subset_def, set.mem_preimage],
  intro x,
  fin_cases x;
    simp [hp₁, hp₂]
end

/-- If distinct points `p₁` and `p₃` lie in `s` but `p₂` does not, the three points are affinely
independent. -/
lemma affine_independent_of_ne_of_mem_of_not_mem_of_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
  (hp₁p₃ : p₁ ≠ p₃) (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∉ s) (hp₃ : p₃ ∈ s) :
  affine_independent k ![p₁, p₂, p₃] :=
begin
  rw ←affine_independent_equiv (equiv.swap (1 : fin 3) 2),
  convert affine_independent_of_ne_of_mem_of_mem_of_not_mem hp₁p₃ hp₁ hp₃ hp₂ using 1,
  ext x,
  fin_cases x;
    refl
end

/-- If distinct points `p₂` and `p₃` lie in `s` but `p₁` does not, the three points are affinely
independent. -/
lemma affine_independent_of_ne_of_not_mem_of_mem_of_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
  (hp₂p₃ : p₂ ≠ p₃) (hp₁ : p₁ ∉ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) :
  affine_independent k ![p₁, p₂, p₃] :=
begin
  rw ←affine_independent_equiv (equiv.swap (0 : fin 3) 2),
  convert affine_independent_of_ne_of_mem_of_mem_of_not_mem hp₂p₃.symm hp₃ hp₂ hp₁ using 1,
  ext x,
  fin_cases x;
    refl
end

end division_ring

section ordered

variables {k : Type*} {V : Type*} {P : Type*} [linear_ordered_ring k] [add_comm_group V]
variables [module k V] [affine_space V P] {ι : Type*}
include V

local attribute [instance] linear_ordered_ring.decidable_lt

/-- Given an affinely independent family of points, suppose that an affine combination lies in
the span of two points given as affine combinations, and suppose that, for two indices, the
coefficients in the first point in the span are zero and those in the second point in the span
have the same sign. Then the coefficients in the combination lying in the span have the same
sign. -/
lemma sign_eq_of_affine_combination_mem_affine_span_pair {p : ι → P} (h : affine_independent k p)
  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1) (hw₁ : ∑ i in s, w₁ i = 1)
  (hw₂ : ∑ i in s, w₂ i = 1)
  (hs : s.affine_combination k p w ∈
    line[k, s.affine_combination k p w₁, s.affine_combination k p w₂])
  {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (hi0 : w₁ i = 0) (hj0 : w₁ j = 0)
  (hij : sign (w₂ i) = sign (w₂ j)) : sign (w i) = sign (w j) :=
begin
  rw affine_combination_mem_affine_span_pair h hw hw₁ hw₂ at hs,
  rcases hs with ⟨r, hr⟩,
  dsimp only at hr,
  rw [hr i hi, hr j hj, hi0, hj0, add_zero, add_zero, sub_zero, sub_zero, sign_mul, sign_mul, hij]
end

/-- Given an affinely independent family of points, suppose that an affine combination lies in
the span of one point of that family and a combination of another two points of that family given
by `line_map` with coefficient between 0 and 1. Then the coefficients of those two points in the
combination lying in the span have the same sign. -/
lemma sign_eq_of_affine_combination_mem_affine_span_single_line_map {p : ι → P}
  (h : affine_independent k p) {w : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1)
  {i₁ i₂ i₃ : ι} (h₁ : i₁ ∈ s) (h₂ : i₂ ∈ s) (h₃ : i₃ ∈ s) (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃)
  (h₂₃ : i₂ ≠ i₃) {c : k} (hc0 : 0 < c) (hc1 : c < 1)
  (hs : s.affine_combination k p w ∈ line[k, p i₁, affine_map.line_map (p i₂) (p i₃) c]) :
  sign (w i₂) = sign (w i₃) :=
begin
  classical,
  rw [←s.affine_combination_affine_combination_single_weights k p h₁,
      ←s.affine_combination_affine_combination_line_map_weights p h₂ h₃ c] at hs,
  refine sign_eq_of_affine_combination_mem_affine_span_pair h hw
    (s.sum_affine_combination_single_weights k h₁)
    (s.sum_affine_combination_line_map_weights h₂ h₃ c) hs h₂ h₃
    (finset.affine_combination_single_weights_apply_of_ne k h₁₂.symm)
    (finset.affine_combination_single_weights_apply_of_ne k h₁₃.symm) _,
  rw [finset.affine_combination_line_map_weights_apply_left h₂₃,
      finset.affine_combination_line_map_weights_apply_right h₂₃],
  simp [hc0, sub_pos.2 hc1]
end

end ordered

namespace affine

variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [module k V]
variables [affine_space V P]
include V

/-- A `simplex k P n` is a collection of `n + 1` affinely
independent points. -/
structure simplex (n : ℕ) :=
(points : fin (n + 1) → P)
(independent : affine_independent k points)

/-- A `triangle k P` is a collection of three affinely independent points. -/
abbreviation triangle := simplex k P 2

namespace simplex

variables {P}

/-- Construct a 0-simplex from a point. -/
def mk_of_point (p : P) : simplex k P 0 :=
⟨λ _, p, affine_independent_of_subsingleton k _⟩

/-- The point in a simplex constructed with `mk_of_point`. -/
@[simp] lemma mk_of_point_points (p : P) (i : fin 1) : (mk_of_point k p).points i = p :=
rfl

instance [inhabited P] : inhabited (simplex k P 0) :=
⟨mk_of_point k default⟩

instance nonempty : nonempty (simplex k P 0) :=
⟨mk_of_point k $ add_torsor.nonempty.some⟩

variables {k V}

/-- Two simplices are equal if they have the same points. -/
@[ext] lemma ext {n : ℕ} {s1 s2 : simplex k P n} (h : ∀ i, s1.points i = s2.points i) :
  s1 = s2 :=
begin
  cases s1,
  cases s2,
  congr' with i,
  exact h i
end

/-- Two simplices are equal if and only if they have the same points. -/
lemma ext_iff {n : ℕ} (s1 s2 : simplex k P n): s1 = s2 ↔ ∀ i, s1.points i = s2.points i :=
⟨λ h _, h ▸ rfl, ext⟩

/-- A face of a simplex is a simplex with the given subset of
points. -/
def face {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ} (h : fs.card = m + 1) :
  simplex k P m :=
⟨s.points ∘ fs.order_emb_of_fin h,
  s.independent.comp_embedding (fs.order_emb_of_fin h).to_embedding⟩

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
lemma face_points {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
  (h : fs.card = m + 1) (i : fin (m + 1)) :
  (s.face h).points i = s.points (fs.order_emb_of_fin h i) :=
rfl

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
lemma face_points' {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
  (h : fs.card = m + 1) : (s.face h).points = s.points ∘ (fs.order_emb_of_fin h) :=
rfl

/-- A single-point face equals the 0-simplex constructed with
`mk_of_point`. -/
@[simp] lemma face_eq_mk_of_point {n : ℕ} (s : simplex k P n) (i : fin (n + 1)) :
  s.face (finset.card_singleton i) = mk_of_point k (s.points i) :=
by { ext, simp [face_points] }

/-- The set of points of a face. -/
@[simp] lemma range_face_points {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))}
  {m : ℕ} (h : fs.card = m + 1) : set.range (s.face h).points = s.points '' ↑fs :=
by rw [face_points', set.range_comp, finset.range_order_emb_of_fin]

/-- Remap a simplex along an `equiv` of index types. -/
@[simps]
def reindex {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) : simplex k P n :=
⟨s.points ∘ e.symm, (affine_independent_equiv e.symm).2 s.independent⟩

/-- Reindexing by `equiv.refl` yields the original simplex. -/
@[simp] lemma reindex_refl {n : ℕ} (s : simplex k P n) :
  s.reindex (equiv.refl (fin (n + 1))) = s :=
ext $ λ _, rfl

/-- Reindexing by the composition of two equivalences is the same as reindexing twice. -/
@[simp] lemma reindex_trans {n₁ n₂ n₃ : ℕ} (e₁₂ : fin (n₁ + 1) ≃ fin (n₂ + 1))
  (e₂₃ : fin (n₂ + 1) ≃ fin (n₃ + 1)) (s : simplex k P n₁) :
  s.reindex (e₁₂.trans e₂₃) = (s.reindex e₁₂).reindex e₂₃ :=
rfl

/-- Reindexing by an equivalence and its inverse yields the original simplex. -/
@[simp] lemma reindex_reindex_symm {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
  (s.reindex e).reindex e.symm = s :=
by rw [←reindex_trans, equiv.self_trans_symm, reindex_refl]

/-- Reindexing by the inverse of an equivalence and that equivalence yields the original simplex. -/
@[simp] lemma reindex_symm_reindex {m n : ℕ} (s : simplex k P m) (e : fin (n + 1) ≃ fin (m + 1)) :
  (s.reindex e.symm).reindex e = s :=
by rw [←reindex_trans, equiv.symm_trans_self, reindex_refl]

/-- Reindexing a simplex produces one with the same set of points. -/
@[simp] lemma reindex_range_points {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
  set.range (s.reindex e).points = set.range s.points :=
by rw [reindex, set.range_comp, equiv.range_eq_univ, set.image_univ]

end simplex

end affine

namespace affine
namespace simplex

variables {k : Type*} {V : Type*} {P : Type*} [division_ring k]
          [add_comm_group V] [module k V] [affine_space V P]
include V

/-- The centroid of a face of a simplex as the centroid of a subset of
the points. -/
@[simp] lemma face_centroid_eq_centroid {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))}
  {m : ℕ} (h : fs.card = m + 1) :
  finset.univ.centroid k (s.face h).points = fs.centroid k s.points :=
begin
  convert (finset.univ.centroid_map k (fs.order_emb_of_fin h).to_embedding s.points).symm,
  rw [← finset.coe_inj, finset.coe_map, finset.coe_univ, set.image_univ],
  simp
end

/-- Over a characteristic-zero division ring, the centroids given by
two subsets of the points of a simplex are equal if and only if those
faces are given by the same subset of points. -/
@[simp] lemma centroid_eq_iff [char_zero k] {n : ℕ} (s : simplex k P n)
  {fs₁ fs₂ : finset (fin (n + 1))} {m₁ m₂ : ℕ} (h₁ : fs₁.card = m₁ + 1) (h₂ : fs₂.card = m₂ + 1) :
  fs₁.centroid k s.points = fs₂.centroid k s.points ↔ fs₁ = fs₂ :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  rw [finset.centroid_eq_affine_combination_fintype,
      finset.centroid_eq_affine_combination_fintype] at h,
  have ha := (affine_independent_iff_indicator_eq_of_affine_combination_eq k s.points).1
    s.independent _ _ _ _ (fs₁.sum_centroid_weights_indicator_eq_one_of_card_eq_add_one k h₁)
    (fs₂.sum_centroid_weights_indicator_eq_one_of_card_eq_add_one k h₂) h,
  simp_rw [finset.coe_univ, set.indicator_univ, function.funext_iff,
           finset.centroid_weights_indicator_def, finset.centroid_weights, h₁, h₂] at ha,
  ext i,
  specialize ha i,
  have key : ∀ n : ℕ, (n : k) + 1 ≠ 0 := λ n h, by norm_cast at h,
  -- we should be able to golf this to `refine ⟨λ hi, decidable.by_contradiction (λ hni, _), ...⟩`,
  -- but for some unknown reason it doesn't work.
  split; intro hi; by_contra hni,
  { simpa [hni, hi, key] using ha },
  { simpa [hni, hi, key] using ha.symm }
end

/-- Over a characteristic-zero division ring, the centroids of two
faces of a simplex are equal if and only if those faces are given by
the same subset of points. -/
lemma face_centroid_eq_iff [char_zero k] {n : ℕ} (s : simplex k P n)
  {fs₁ fs₂ : finset (fin (n + 1))} {m₁ m₂ : ℕ} (h₁ : fs₁.card = m₁ + 1) (h₂ : fs₂.card = m₂ + 1) :
  finset.univ.centroid k (s.face h₁).points = finset.univ.centroid k (s.face h₂).points ↔
    fs₁ = fs₂ :=
begin
  rw [face_centroid_eq_centroid, face_centroid_eq_centroid],
  exact s.centroid_eq_iff h₁ h₂
end

/-- Two simplices with the same points have the same centroid. -/
lemma centroid_eq_of_range_eq {n : ℕ} {s₁ s₂ : simplex k P n}
  (h : set.range s₁.points = set.range s₂.points) :
  finset.univ.centroid k s₁.points = finset.univ.centroid k s₂.points :=
begin
  rw [←set.image_univ, ←set.image_univ, ←finset.coe_univ] at h,
  exact finset.univ.centroid_eq_of_inj_on_of_image_eq k _
    (λ _ _ _ _ he, affine_independent.injective s₁.independent he)
    (λ _ _ _ _ he, affine_independent.injective s₂.independent he) h
end

end simplex
end affine


import data.set.basic -- hide
open set -- hide

/- Tactic : ext

## Summary

If `A` and `B` are sets and the goal is `A = B`, then
using the `ext` tactic will change it to `x ∈ A ↔ x ∈ B`.

Variant: `ext y` will change the goal to `y ∈ A ↔ y ∈ B`.

## Details

This tactic applies the "extensionality" axiom of set theory,
which says that two sets are equal iff for all `x`, `x` belongs
to the first iff `x` belongs to the second.

### Example:
If it looks like this in the top right hand box:
```
A B : set X
⊢ A = B
```

then

`ext,`

will change the goal into
```
A B : set X
x : X
⊢ x ∈ A ↔ x ∈ B
```
-/

/- Tactic : left and right

## Summary

`left` and `right` work on the goal, and they change
`⊢ P ∨ Q` to `⊢ P` and `⊢ Q` respectively.

## Details

The tactics `left` and `right` work on a goal which is a type with
two constructors, the classic example being `P ∨ Q`.
To prove `P ∨ Q` it suffices to either prove `P` or prove `Q`,
and once you know which one you are going for you can change
the goal with `left` or `right` to the appropriate choice.
-/

/- Tactic : cases

## Summary:

`cases` is a tactic which works on hypotheses.
If `h : P ∧ Q` or `h : P ↔ Q` is a hypothesis then `cases h with h1 h2` will remove `h`
from the list of hypotheses and replace it with the "ingredients" of `h`,
i.e. `h1 : P` and `h2 : Q`, or `h1 : P → Q` and `h2 : Q → P`. Also
works with `h : P ∨ Q` and `n : mynat`.

## Details

How does one prove `P ∧ Q`? The way to do it is to prove `P` and to
prove `Q`. There are hence two ingredients which go into a proof of
`P ∧ Q`, and the `cases` tactic extracts them.

More precisely, if the local context contains
```
h : P ∧ Q`
```

then after the tactic `cases h with p q,` the local context will
change to
```
p : P,
q : Q
```
and `h` will disappear.

Similarly `h : P ↔ Q` is proved by proving `P → Q` and `Q → P`,
and `cases h with hpq hqp` will delete our assumption `h` and
replace it with
```
hpq : P → Q,
hqp : Q → P
```

Be warned though -- `rw h` works with `h : P ↔ Q` (`rw` works with
`=` and `↔`), whereas you cannot rewrite with an implication.

`cases` also works with hypotheses of the form `P ∨ Q`. Here the situation
is different however.
To prove `P ∨ Q` you need to give either a proof of `P` *or* a proof
of `Q`, so if `h : P ∨ Q` then `cases h with p q` will change one goal
into two, one with `p : P` and the other with `q : Q`.
-/

/-
The following lemma can be proved using `ext`, `split`, `cases`, `left`, `right` tactics. Learn what
they do in the side-bar, and use them to clear this goal.

If you are lazy, the `finish` tactic will take the fun out of this exercise. So try to not use it.
-/

variables {X Y : Type} -- hide

/- Lemma :
The distributive property of ∩ with respect to ∪.
-/
lemma inter_union (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext,
  split,
  {
    intro h,
    cases h,
    cases h_right,
    {
      left,
      split;
      assumption,
    },
    {
      right,
      split;
      assumption,
    }
  },
  {
    intro h,
    cases h,
    {
      split,
      {
        exact h.1,
      },
      {
        left,
        exact h.2,
      },
    },
    {
      split,
      {
        exact h.1,
      },
      {
        right,
        exact h.2,
      }
    }
  }
end


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

universes u v u_1 w

namespace Mathlib

/-!
# `ulift` instances for module and multiplicative actions

This file defines instances for module, mul_action and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We also provide `ulift.semimodule_equiv : ulift M ≃ₗ[R] M`.

-/

namespace ulift

protected instance has_scalar {R : Type u} {M : Type v} [has_scalar R M] : has_scalar (ulift R) M :=
  has_scalar.mk fun (s : ulift R) (x : M) => down s • x

@[simp] theorem smul_down {R : Type u} {M : Type v} [has_scalar R M] (s : ulift R) (x : M) : s • x = down s • x :=
  rfl

protected instance has_scalar' {R : Type u} {M : Type v} [has_scalar R M] : has_scalar R (ulift M) :=
  has_scalar.mk fun (s : R) (x : ulift M) => up (s • down x)

@[simp] theorem smul_down' {R : Type u} {M : Type v} [has_scalar R M] (s : R) (x : ulift M) : down (s • x) = s • down x :=
  rfl

protected instance is_scalar_tower {R : Type u} {M : Type v} {N : Type w} [has_scalar R M] [has_scalar M N] [has_scalar R N] [is_scalar_tower R M N] : is_scalar_tower (ulift R) M N :=
  is_scalar_tower.mk
    fun (x : ulift R) (y : M) (z : N) =>
      (fun (this : (down x • y) • z = down x • y • z) => this) (smul_assoc (down x) y z)

protected instance is_scalar_tower' {R : Type u} {M : Type v} {N : Type w} [has_scalar R M] [has_scalar M N] [has_scalar R N] [is_scalar_tower R M N] : is_scalar_tower R (ulift M) N :=
  is_scalar_tower.mk
    fun (x : R) (y : ulift M) (z : N) =>
      (fun (this : (x • down y) • z = x • down y • z) => this) (smul_assoc x (down y) z)

protected instance is_scalar_tower'' {R : Type u} {M : Type v} {N : Type w} [has_scalar R M] [has_scalar M N] [has_scalar R N] [is_scalar_tower R M N] : is_scalar_tower R M (ulift N) :=
  is_scalar_tower.mk
    fun (x : R) (y : M) (z : ulift N) =>
      (fun (this : up ((x • y) • down z) = up (x • y • down z)) => this)
        (eq.mpr (id (Eq._oldrec (Eq.refl (up ((x • y) • down z) = up (x • y • down z))) (smul_assoc x y (down z))))
          (Eq.refl (up (x • y • down z))))

protected instance mul_action {R : Type u} {M : Type v} [monoid R] [mul_action R M] : mul_action (ulift R) M :=
  mul_action.mk sorry sorry

protected instance mul_action' {R : Type u} {M : Type v} [monoid R] [mul_action R M] : mul_action R (ulift M) :=
  mul_action.mk sorry sorry

protected instance distrib_mul_action {R : Type u} {M : Type v} [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action (ulift R) M :=
  distrib_mul_action.mk sorry sorry

protected instance distrib_mul_action' {R : Type u} {M : Type v} [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R (ulift M) :=
  distrib_mul_action.mk sorry sorry

protected instance semimodule {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : semimodule (ulift R) M :=
  semimodule.mk sorry sorry

protected instance semimodule' {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : semimodule R (ulift M) :=
  semimodule.mk sorry sorry

/--
The `R`-linear equivalence between `ulift M` and `M`.
-/
def semimodule_equiv {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : linear_equiv R (ulift M) M :=
  linear_equiv.mk down sorry sorry up sorry sorry


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import topology.sequences
import .setup_definition

/-!
# `extend_to_epsilon`

This file proves a property of values of measures on intervals.

Given a (probability) measure μ on ℝ, for every ε > 0, given
a real number t such that μ(0,t] > ε we exhibit a θ such
that μ(0,t) > ε and μ(θ,t] ≤ ε.

This is a largely technical lemma used in other parts of
the stump proof.

## Notations

This file uses the local notation `f ⟶ limit` for
`tendsto f at_top (nhds limit)` for better readability of
some proof states.

## Implementation notes

We prove this lemma for `μ` a  probability measure on the
non-negative real numbers `nnreal`. Note, however that we do
not use that `μ` is a probability measure anywhere,and this
theorem holds for an arbitrary measure on a conditionally
complete, linearly ordered topological space α with an
orderable topology.

## Tags

measure, intervals
-/

noncomputable theory

local attribute [instance, priority 0] classical.prop_decidable

universe u

open set lattice nnreal probability_measure filter nat measure_theory topological_space

local notation f `⟶` limit := tendsto f at_top (nhds limit)

section stump
variables (μ: probability_measure ℍ) (target: ℍ) (n: ℕ)

/-- `inc_seq_of x n` takes a sequence `x` and returns the
    `n`th maximum member. -/
noncomputable def inc_seq_of  (x : ℕ → nnreal) : ℕ → nnreal
| 0 := x 0
| (nat.succ n) := max (x (nat.succ n)) (inc_seq_of n)

lemma inc_seq_increasing' (x : ℕ → nnreal) : ∀ n:ℕ, inc_seq_of x n ≤ inc_seq_of x (succ n) :=
begin
  intros n,
  induction n with k ih,
  {simp [inc_seq_of], right, refl},
  {
    by_cases (inc_seq_of x k ≤ x (succ k)),
    simp [inc_seq_of,h] at ih ⊢, cases ih,
    right, refl,
    simp [inc_seq_of,h] at ih ⊢, right,
    split, rw not_le at h, apply le_of_lt h, refl
  }
end

lemma inc_seq_mono {x : ℕ → nnreal} : ∀ n m:ℕ, (n ≤ m) → inc_seq_of x n ≤ inc_seq_of x m :=
begin
  intros n m hnm,
  induction hnm with k, by refl,
  {
    rw inc_seq_of,
    by_cases (inc_seq_of x k ≤ x (succ k)),
    simp [h], refine le_trans hnm_ih h,
    simp [h], simp at h, right, assumption,
  }
end

lemma inc_seq_le_of_seq_le {x : ℕ → nnreal} {θ : nnreal} (hx : ∀ n, x n ≤ θ) : ∀ n, inc_seq_of x n ≤ θ :=
begin
    intros n ,
    induction n with k ih, by rw inc_seq_of;exact hx 0,
    {
    rw inc_seq_of,
    by_cases (inc_seq_of x k ≤ x (succ k)),
    simp [h], exact hx _,
    simp [h], exact ⟨hx _, ih⟩,
    }
end

lemma inc_seq_of_exists_index (x : ℕ → nnreal) : ∀ n : ℕ, ∃ k : ℕ, inc_seq_of x n = x k :=
begin
    intros n,
    induction n with n₀ ih, by rw inc_seq_of; existsi 0; refl,
    {
    rw inc_seq_of,
    by_cases (inc_seq_of x n₀ ≤ x (succ n₀)),
    simp [h], existsi (succ n₀), refl,
    rw max, split_ifs,
      exact ih,
      existsi (succ n₀), refl,
    }
end

lemma inc_seq_of_exists_index' (x : ℕ → nnreal) : ∀ nₖ : ℕ, ∃ n : ℕ, (inc_seq_of x nₖ = x n) ∧ (n ≤ nₖ) :=
begin
    intros n,
    induction n with n₀ ih, by rw inc_seq_of; existsi 0 ; exact ⟨rfl, by refl⟩,
    {
    rw inc_seq_of,
    by_cases (inc_seq_of x n₀ ≤ x (succ n₀)),
      simp[h], existsi (succ n₀), exact ⟨rfl, by refl⟩,
      rw max, split_ifs, choose k hk using ih,
      exact ⟨k, and.intro hk.left (le_succ_of_le hk.right)⟩,
      choose k hk using ih, existsi k, rw not_le at h_1, rw not_le at h, exfalso,
      have h₁ := lt_trans h h_1, have h₂ := lt_irrefl (x (succ n₀)),
      exact h₂ h₁,
    }
end

lemma seq_le_inc_seq (x : ℕ → nnreal) : ∀ n, x n ≤ inc_seq_of x n :=
begin
    intros n,
    induction n with k ih, by refl,
    {
    rw inc_seq_of,
    by_cases (inc_seq_of x k ≤ x (succ k)),
      simp [h] ; refl,
      simp [h],left ; refl,
    },
end

/-- This theorem states that the sequence of maximums of a sequence
 (converging to a point greater than every member of the sequence)
 also converges to the same limit.
 The proof uses the sandwich theorem. -/
theorem tendsto_inc_seq_of_eq_tendsto (x : ℕ → nnreal) (θ : nnreal) (h : tendsto x at_top (nhds θ)) (hfs : ∀ n:ℕ, (x n) ≤ θ ): tendsto (inc_seq_of x) at_top (nhds θ) :=
begin
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le h (tendsto_const_nhds) _ _,
  rw mem_at_top_sets, dsimp, existsi 0, intros b _, exact (seq_le_inc_seq x b),
  rw mem_at_top_sets, dsimp, existsi 0, intros b _, exact inc_seq_le_of_seq_le hfs _,
end

lemma lim_le_of_seq_le {x : ℕ → ℍ} {θ y: nnreal} (lim : tendsto x at_top (nhds θ)) (hx : ∀ n, x n ≤ y) : θ ≤ y :=
begin
  refine le_of_tendsto at_top_ne_bot lim _,
  rw mem_at_top_sets, existsi 0, intros b _, exact hx _,
end

/-- Helper lemma for extend_to_epsilon proof. -/
lemma Ioc_eq_Union_IccB {θ target : nnreal} (h : θ < target):let y := λ n:ℕ, θ + (target - θ)/(n+1) in
let B := λ n:ℕ, Icc (y n) target in
 Ioc (θ) target = ⋃ i:ℕ, B i :=
begin
  intros y B,
   have hB₁ : ∀ i, B i ⊆ B (succ i),
   {
    assume i, dsimp [B],
    refine Icc_subset_Icc _ (by refl), dsimp [y], simp,
    rw nnreal.coe_le, rw nnreal.coe_div, rw nnreal.coe_div,
    rw (nnreal.coe_sub _ _ (le_of_lt h)), rw _root_.div_le_div_left, simp, exact zero_le_one,
    rwa [sub_pos,←nnreal.coe_lt], all_goals{simp},
    refine add_pos (zero_lt_one) (_),
    repeat {exact add_pos_of_pos_of_nonneg (zero_lt_one) (by simp)},
  },
  ext z,
  rw mem_Union, dsimp [B,Ioc,Icc,y],
  fsplit,
  assume H,
  have pos₀ : 0 < target - θ, by rw [nnreal.coe_pos, nnreal.coe_sub _ _ (le_of_lt (lt_of_lt_of_le H.1 H.2)), sub_pos,←nnreal.coe_lt]; exact lt_of_lt_of_le H.1 H.2,
  let ε₀ := z - θ,
  have pos₁ : (ε₀/(target - θ) : nnreal) > 0,
  {
    rw nnreal.div_def, refine mul_pos _ _,
    simp [ε₀],
    change (0 < z - θ),
    rw [nnreal.coe_pos, nnreal.coe_sub, sub_pos,←nnreal.coe_lt], exact H.1, exact le_of_lt H.1,
    change (0 < (target - θ)⁻¹),
    rwa nnreal.inv_pos,
  },
  have := nnreal.coe_pos.1 pos₁, replace := exists_nat_one_div_lt this,
  choose n hyp using this, existsi n,
  refine ⟨ _ , H.2 ⟩,
  suffices : (target - θ)/(n+1) < ε₀,
  refine le_of_lt _,
  convert (add_lt_add_left this θ),
  rw [add_comm, sub_add_cancel_of_le (le_of_lt H.1)],
  rw nnreal.coe_div at hyp,
  simp [-add_comm] at hyp, rw nnreal.div_def,
  rw nnreal.coe_lt, rw nnreal.coe_mul,
  rw lt_div_iff at hyp, rw mul_comm, simpa [-add_comm], rwa ←nnreal.coe_pos,
  assume H', choose j hyp' using H',
  refine ⟨ _ , hyp'.2 ⟩,
  replace hyp' := hyp'.1,
  suffices : 0 < (target - θ) / (↑j + 1) ,
  calc θ < θ + ((target - θ) / (↑j + 1)) : by rwa (lt_add_iff_pos_right _)
    ... ≤ z                             : hyp',
  rw [nnreal.coe_pos, nnreal.coe_div], refine div_pos _ _,
  rwa [nnreal.coe_sub _ _ (le_of_lt h), sub_pos,←nnreal.coe_lt], simp, exact add_pos_of_pos_of_nonneg (zero_lt_one) (by simp)
end

/-- Main theorem: given a (probability) measure μ on ℝ,
for every ε > 0, given a real number t such that μ(0,t] > ε
we exhibit a θ such that μ(0,t) > ε and μ(θ,t] ≤ ε. -/
theorem extend_to_epsilon_1:
∀ ε: nnreal, ε > 0 →
μ (Ioc 0 target) > ε →
∃ θ: nnreal, μ (Icc θ target) ≥ ε ∧ μ (Ioc θ target) ≤ ε
 :=
begin
  intros ε h₁ h₂,
  let K :=  {x: ℍ | μ (Icc x target) ≥ ε},
  /- We hope to prove that the supremum of the above set is the required number. -/
  let θ :=  Sup K,
  existsi θ,
  /- The set K is non-empty since 0 ∈ K. -/
  have Kne : K ≠ ∅,
  {
    assume not, have zeroK : (0:nnreal) ∈ K,
    replace h₂ : μ (Ioc 0 target) ≥ ε, by exact le_of_lt h₂,
    simp [h₂],
    suffices : μ (Icc 0 target) ≥ μ (Ioc 0 target), exact le_trans h₂ this, refine prob_mono _ _, rintros x ⟨hx₁,hx₂⟩, exact and.intro (le_of_lt hx₁) hx₂, finish,
  },
  /- The set K is bounded above as `target` is an upper-bound. -/
  have Kbdd : bdd_above K,
  {
    existsi target, assume y yinK, dsimp at yinK,by_contradiction,  rw [Icc] at yinK,
    suffices : μ {x : ℍ | y ≤ x ∧ x ≤ target} = 0, rw this at yinK, change (0 < ε) at h₁, rw ←not_le at h₁, exact h₁ yinK,
    suffices : {x : ℍ | y ≤ x ∧ x ≤ target} = ∅, rw this, exact prob_empty μ,
    suffices : ∀ x : ℍ, ¬ (y ≤ x ∧ x ≤ target), simp [this],
    rintros _ ⟨hx₁,hx₂⟩, exact a (le_trans hx₁ hx₂)
  },
  /- Since K is non-empty and bounded above, it's supremum is contained in it's closure. -/
  have SupinClK : θ ∈ closure K, by exact cSup_mem_closure Kne Kbdd,
  /- Since the closure K is equal to the sequential closure, θ belongs to the sequential closure of K. -/
  have : θ ∈ sequential_closure K,
  {
    suffices : sequential_closure K = closure K, rwa this,
    exact sequential_space.sequential_closure_eq_closure K,
  },
  /- Hence, there exists a sequence x in K converging to θ. -/
  have seq : ∃ x : ℕ → nnreal, (∀ n : ℕ, x n ∈ K) ∧ (tendsto x at_top (nhds θ)), by rw sequential_closure at this ; simpa [this], clear this,
  choose x hn using seq, rcases hn with ⟨h₁,lim⟩,
  /- Now, the interval [ θ , target ] is the infinite intersection of the intervals [ zₙ = max_{k ≤ n} xₖ , target]. Note that the maximums are ≤ θ since the sequence itself is ≤ θ. -/
  have Iccintereq : Icc θ target = (⋂ (n : ℕ), Icc (inc_seq_of x n) target),
  {
    ext y,
    rw mem_Inter, fsplit,
    assume h i, dsimp [Icc] at h |-, rcases h with ⟨g₁,g₂⟩,
    refine ⟨ _, g₂⟩, simp [θ] at g₁, rw cSup_le_iff Kbdd Kne at g₁, refine inc_seq_le_of_seq_le _ _, assume i, exact g₁ (x i) (h₁ i),
    assume h, dsimp [Icc] at h |-,
    refine ⟨ _ , (h 0).2⟩, refine le_of_tendsto at_top_ne_bot lim _, rw mem_at_top_sets, dsimp, existsi 0, intros b _, exact le_trans (seq_le_inc_seq x b) ((h b).left),
  },
  /- Let s(n) denote the interval [zₙ , target]. -/
  let s := λ n, Icc (inc_seq_of x n) target,
  /- We have lim_{n → ∞} μ [zₙ, target] = μ ([θ, target]). Crucially, we use the fact that measures are continuous from above. -/
  have : tendsto (μ.to_measure ∘ s) at_top (nhds (μ.to_measure (⋂ (n : ℕ), s n))),
  {
    refine tendsto_measure_Inter _ _ _,
    show ∀ (n : ℕ), is_measurable (s n), from assume n, is_measurable_of_is_closed is_closed_Icc,
    show ∀ (n m : ℕ), n ≤ m → s m ⊆ s n, from assume n m hnm, Icc_subset_Icc (inc_seq_mono _ _ hnm) (by refl),
    existsi 0, apply to_measure_lt_top,
  },
  /- From this the first conclusion follows, by using the fact that if aₙ⟶b and aₙ ≥ c then b ≥ c. -/
  have part₁ : μ (Icc θ target) ≥ ε,
  {
    rw ←Iccintereq at this,
    change (ε ≤ μ (Icc θ target)),
    rw prob_apply,
    rw ←ennreal.coe_le_coe, rw ennreal.coe_to_nnreal (to_measure_ne_top _ _),
    refine ge_of_tendsto (at_top_ne_bot) this _, clear this,
    rw mem_at_top_sets, dsimp, existsi 0, intros b hb,
    dsimp [s],
    have := inc_seq_of_exists_index x b,
    choose k₀ hk₀ using this, rw hk₀,
    replace h₁ := h₁ k₀,
    rw ← coe_eq_to_measure,
    rw ennreal.coe_le_coe, assumption,
    exact is_measurable_of_is_closed is_closed_Icc,
  },
  /- The remaining proof proceeds by casing on target ≤ θ.-/
  by_cases (target ≤ θ),
  /- If target ≤ θ then [θ,target] = ∅ and the conclusion follows. -/
  have Iocempty : Ioc θ target = ∅, from Ioc_eq_empty h,
  exact ⟨part₁,by simp [Iocempty]⟩,
  /- If not, we define a sequence yₙ := {θ + (target - θ)/(n+1)}. -/
  simp at h,
  let y := λ n:ℕ, θ + (target - θ)/(n+1),
  /- Prove that θ < yₙ ≤ target. -/
  have hb : ∀ n, (θ < y n) ∧ (y n ≤ target),
  {
    assume n, split,
    dsimp [y],
    suffices : 0 < target - θ,
    norm_num, rw nnreal.div_def, refine mul_pos this _,
    apply nnreal.inv_pos.2, rw zero_lt_iff_ne_zero, simp,
    rw nnreal.coe_pos, rw nnreal.coe_sub,
    rw sub_pos, rwa ←nnreal.coe_lt, exact le_of_lt h,
    dsimp [y],
    calc (θ + (target - θ) / (n + 1))
    = θ + (target - θ)*(n+1)⁻¹ :by rw ←nnreal.div_def
    ... ≤ θ + ((target - θ)*1) : by simp; exact mul_le_of_le_one_right (le_of_lt (by rwa [nnreal.coe_pos, nnreal.coe_sub, sub_pos,←nnreal.coe_lt];exact le_of_lt h)) (by rw [nnreal.inv_le,mul_one];repeat{simp})
    ... = θ + (target - θ)   : by rw mul_one
    ... = θ + target - θ : by rw [←nnreal.eq_iff,nnreal.coe_add, (nnreal.coe_sub _ _ (le_of_lt h))]; simp
    ... = target     : by rw nnreal.add_sub_cancel',
  },
  /- Prove that ∀ n, μ[yₙ, target] < ε. -/
  have ha : ∀ n, μ (Icc (y n) target) < ε,
  {
    by_contradiction, push_neg at a, choose n ha using a,
    have yinK : (y n) ∈ K, from ha,
    have : y n ≤ θ, from le_cSup (Kbdd) yinK,
    exact (not_le.2 (hb n).left this),
  },
  let B := λ n:ℕ, Icc (y n) target,
  /- From a helper lemma above, we get that
  (θ, target] = ⋃(n:ℕ),[yₙ,target]. -/
  have hB₂ : Ioc (θ) target = ⋃ i:ℕ, B i, from Ioc_eq_Union_IccB h,
  let s' := λ n, Icc (y n) target,
  /- Now we prove, using the fact that measures are continuous from below, that μ [yₙ, target] → μ (θ, target]. -/
  have : tendsto (μ.to_measure ∘ s') at_top (nhds (μ.to_measure (⋃ (n : ℕ), s' n))),
  {
    refine tendsto_measure_Union _ _,
    assume n, exact is_measurable_of_is_closed is_closed_Icc,
    unfold monotone, dsimp [s'],
    assume a b hab, refine Icc_subset_Icc _ (by refl),
    dsimp [y], rw add_le_add_iff_left,
    rw nnreal.div_def, rw nnreal.div_def,
    refine mul_le_mul_of_nonneg_left _ (le_of_lt (by rwa [nnreal.coe_pos,nnreal.coe_sub _ _ (le_of_lt h), sub_pos,←nnreal.coe_lt])),
    rw nnreal.coe_le, simp, rw inv_le_inv _ _, simpa,
    repeat{exact add_pos_of_pos_of_nonneg (zero_lt_one) (by simp)},
  },
  /- Show the remaining conclusion. -/
  have part₂ : μ (Ioc θ target) ≤ ε,
  {
    rw ←hB₂ at this, rw [prob_apply, ←ennreal.coe_le_coe, ennreal.coe_to_nnreal (to_measure_ne_top _ _)],
    refine le_of_tendsto (at_top_ne_bot) this _, clear this,
    rw mem_at_top_sets, existsi 0, intros b hb,
    dsimp [s'],
    refine le_of_lt _ ,
    rw ← coe_eq_to_measure,
    rw ennreal.coe_lt_coe, exact (ha b),
    exact (is_measurable_of_is_open (is_open_lt continuous_const continuous_id)).inter (is_measurable_of_is_closed (is_closed_le continuous_id continuous_const)),
  },
  exact ⟨part₁,part₂⟩,
end

end stump


/-
Copyright (c) 2020 Bjørn Kjos-Hanssen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Bjørn Kjos-Hanssen.
Zulip chat help from:
  Alex J. Best, Johan Commelin, Kyle Miller, Pedro Minicz, Reid Barton, Scott Morrison, Heather Macbeth.
Code contribution and definition of D improvement from:
  Jason Greuling
-/
import data.finset  -- finite set
import data.set -- to make backslash work as set difference
import data.finset.basic
import topology.metric_space.basic

import data.real.basic

import delta

import data.set.basic

--set_option profiler true

--set_option pp.all true -- this makes tactic proofs look weird, like has_mem.mem instead of just ∈

/-!
# A theorem on metrics based on min and max
In this file we give a formal proof that in terms of
d(X,Y)= m min(|X\Y|, |Y\X|) + M max(|X\Y|, |Y\X|)
the function
D(X,Y) = d(X,Y)/(|X ∩ Y|+d(X,Y))
is a metric if and only if m ≤ M and 1 ≤ M.
In particular, taking m=M=1, the Jaccard distance is a metric on finset ℕ.
## Main results
- `noncomputable instance jaccard_nid.metric_space`: the proof of the main result described above.
- `noncomputable instance jaccard.metric_space`: the special case of the Jaccard distance.
## Notation
 - `|_|` : Notation for cardinality.
## References
See [KNYHLM20] for the original proof (https://math.hawaii.edu/~bjoern/nid-walcom.pdf).
-/

open finset

local notation |X| := X.card

variables {m M : ℝ} -- in delta.lean but can't import variables

section jaccard_nid

variables {α : Type*} [decidable_eq α]
--#check δ

/-- using Lean's "group with zero" to hand the case 0/0=0 -/
noncomputable def D : ℝ → ℝ → finset α → (finset α → ℝ) :=
  λ m M x y, (δ m M x y) / (|x ∩ y| + δ m M x y)

lemma cap_sdiff (X Y Z : finset α): X ∩ Z  ⊆  X ∩ Y ∪ Z \ Y :=
  have h: ∀ a : α, a ∈ X ∩ Z → a ∈ X ∩ Y ∪ Z \ Y,
  by {intro a,intro g,rw mem_inter at g,rw[mem_union,mem_inter,mem_sdiff],by_cases (a ∈ Y),cc,cc,},
  (iff.elim_right subset_iff) h

lemma sdiff_cap (X Y Z : finset α): X ∩ Z \ Y ⊆ Z \ Y := -- by show_term{tidy} -- by tidy?
by {intros a a_1,  simp at *, cases a_1, cases a_1_left, split, assumption, assumption}

--#print sdiff_cap

theorem twelve_end (X Y Z : finset α) : |X ∩ Z| ≤ |X ∩ Y| + max (|Z \ Y|) (|Y \ Z|) :=
let z_y := |Z \ Y|, y_z := |Y \ Z|, y := |Y|, z := |Z| in
(em (y ≤ z)).elim(
  λ h: y ≤ z, calc |X ∩ Z| ≤ |X ∩ Y  ∪  Z \ Y|     : card_le_of_subset (cap_sdiff X Y Z)
                       ... ≤ |X ∩ Y| + |Z \ Y|     : card_union_le (X ∩ Y) (Z \ Y)
                       ... = |X ∩ Y| + max z_y y_z : by rw[max_eq_left (sdiff_card Z Y h)]
)(
  λ h: ¬ y ≤ z,
  have h1: z ≤ y, from le_of_lt ((iff.elim_right lt_iff_not_ge') h),
  have h_diff: z_y ≤ y_z, from sdiff_card Y Z h1, let
    x110 := |X ∩ Y \ Z|, x111 := |X ∩ Y ∩ Z|, x010 := |Y \ X \ Z|,
    x111 := |X ∩ Y ∩ Z|, x101 := |X ∩ Z \ Y|, xz := |X ∩ Z|,
    xy := |X ∩ Y|, xz_y := |X ∩ Z \ Y| in
  have r: xz_y ≤ z_y, from card_le_of_subset (sdiff_cap X Y Z),
  have uni_xz:  X ∩ Z = (X ∩ Z \ Y) ∪ (X ∩ Y ∩ Z), by { tidy, by_cases h: a ∈ Y, cc, cc},
  have uni_xy:  (X ∩ Y \ Z) ∪ (X ∩ Y ∩ Z) = X ∩ Y, by { tidy, by_cases h: a ∈ Z, cc, cc},
  have uni_y_z: (X ∩ Y \ Z) ∪ (Y \ X \ Z) = Y \ Z, by { tidy, by_cases h: a ∈ X, cc, cc},
  have dis_xz:  disjoint (X ∩ Z \ Y) (X ∩ Y ∩ Z), by { rw disjoint_iff, tidy},
  have dis_xy:  disjoint (X ∩ Y \ Z) (X ∩ Y ∩ Z), by { rw disjoint_iff, tidy},
  have dis_y_z: disjoint (X ∩ Y \ Z) (Y \ X \ Z), by { rw disjoint_iff, tidy},
  have sum_xz: xz = x101 + x111, from calc
               xz = ((X ∩ Z \ Y) ∪ (X ∩ Y ∩ Z)).card : congr_arg card uni_xz
              ... = x101 + x111: card_disjoint_union dis_xz,
  have sum_xy:  x110 + x111 = xy, from calc
                x110 + x111 = ((X ∩ Y \ Z) ∪ (X ∩ Y ∩ Z)).card: (card_disjoint_union dis_xy).symm
                        ... = xy: (congr_arg card uni_xy),
  have sum_y_z: x110 + x010 = y_z, from calc
                x110 + x010 = ((X ∩ Y \ Z) ∪ (Y \ X \ Z)).card: (card_disjoint_union dis_y_z).symm
                        ... = y_z: congr_arg card uni_y_z,
  have prelim: x101 ≤ x110 + x110 + x010, from calc
               x101 ≤ y_z                 : le_trans r h_diff
                ... = x110 + x010          : by rw[sum_y_z]
                ... = 0 + (x110 + x010)    : by ring
                ... ≤ x110 + (x110 + x010) : add_le_add_right (nat.zero_le x110) (x110 + x010)
                ... = x110 + x110 + x010   : by ring,
  calc xz = x101 + x111                   : sum_xz
      ... ≤ x110 + x110 + x010 + x111     : add_le_add_right prelim x111
      ... = (x110 + x111) + (x110 + x010) : by ring
      ... = xy            + max z_y y_z   : by rw[sum_xy,sum_y_z,max_eq_right h_diff]
)

theorem twelve_middle (hm: 0 ≤ m) (hM: 0 < M) (X Y Z : finset α) :
let y_z := |Y\Z|, z_y := |Z\Y|, xy := |X ∩ Y|, xz := |X ∩ Z| in
(|X ∩ Z|:ℝ) ≤ (xy:ℝ) + (max z_y y_z:ℝ) + (m/M) * (min z_y y_z:ℝ) :=
let y_z := |Y\Z|, z_y := |Z\Y|, xy := |X ∩ Y|, xz := |X ∩ Z| in
    have b: 0 ≤ m/M ↔ 0*M ≤ m, from le_div_iff hM,
    have a: 0*M ≤ m, from calc
            0*M = 0 : by ring
            ... ≤ m : hm,
    have g:0 ≤ m/M, from (iff.elim_right b) a,
    have e:0 ≤ min z_y y_z, from le_min (nat.zero_le z_y) (nat.zero_le y_z),
    have f:0 ≤ (min z_y y_z:ℝ), begin norm_cast,exact e, end,
    let maxzy := (max z_y y_z:ℝ) in
    calc
    (xz:ℝ) ≤ (xy:ℝ) + (max z_y y_z:ℝ): by {norm_cast,exact (twelve_end X Y Z)}
       ... = (xy:ℝ) + maxzy + 0                       : by ring
       ... ≤ (xy:ℝ) + maxzy + (m/M) * (min z_y y_z:ℝ) :
              add_le_add_left (mul_nonneg g f) ((xy:ℝ) + maxzy)

theorem jn_self  (X : finset α): D m M X X = 0 :=
    show (δ m M X X) / (|X ∩ X| + δ m M X X) = 0, by rw[delta_self,zero_div]

theorem delta_nonneg {x y : finset α} (hm: 0 ≤ m) (hM: m ≤ M): 0 ≤ δ m M x y :=
  have alpha: δ m M x x ≤ δ m M x y + δ m M y x, from seventeen_right hm hM,
  have 0 ≤ 2 * δ m M x y, from calc
       0 = δ m M x x: by rw[delta_self]
     ... ≤ δ m M x y + δ m M y x: seventeen_right hm hM
     ... = 2 * δ m M x y: by rw [delta_comm, two_mul],
  nonneg_of_mul_nonneg_left this zero_lt_two

theorem jn_comm (X Y : finset α): D m M X Y = D m M Y X :=
    show (δ m M X Y) / (|X ∩ Y| + δ m M X Y)  = (δ m M Y X) / (|Y ∩ X| + δ m M Y X), from
    by rw[delta_comm,delta_comm,inter_comm]

lemma card_inter_nonneg (X Y : finset α):
  0 ≤ (|X ∩ Y|:ℝ) := by { norm_cast, exact (nat.zero_le (|X ∩ Y|))}

lemma D_denom_nonneg (X Y : finset α) (hm: 0 ≤ m) (hM: m ≤ M):
  0 ≤ (|X ∩ Y|:ℝ) + δ m M X Y := add_nonneg (card_inter_nonneg X Y) (delta_nonneg hm hM)

theorem eq_of_jn_eq_zero (hm: 0 < m) (hM: m ≤ M) (X Y : finset α) (h: D m M X Y = 0) : X = Y :=
    have h1: (δ m M X Y) = 0 ∨ ((|X ∩ Y|:ℝ) + δ m M X Y) = 0, from
      (iff.elim_left (div_eq_zero_iff)) h,
    h1.elim(
        assume g: δ m M X Y = 0,
        eq_of_delta_eq_zero hm hM X Y g
    )(
        assume g: (|X ∩ Y|:ℝ) + δ m M X Y = 0,
        have denom:  0 = δ m M X Y + |X ∩ Y| , begin rw[add_comm] at g, exact g.symm, end,
        have nonneg: 0 ≤ δ m M X Y, from delta_nonneg (le_of_lt hm) hM,
        have zero:   0 = δ m M X Y, from
            eq_zero_of_nonneg_of_nonneg_of_add_zero nonneg (card_inter_nonneg X Y) denom,
        eq_of_delta_eq_zero hm hM X Y (eq.symm zero)
    )

theorem D_nonneg (X Y : finset α) (hm: 0 ≤ m) (hM: m ≤ M): 0 ≤ D m M X Y :=
have hc: 0 ≤ δ m M X Y, from delta_nonneg hm hM,
(em (0 < (|X ∩ Y|:ℝ) + δ m M X Y)).elim(
  λ hd: 0 < (|X ∩ Y|:ℝ) + δ m M X Y,
  calc
    0 = 0         / ((|X ∩ Y|:ℝ) + δ m M X Y) : by rw[zero_div]
  ... ≤ δ m M X Y / ((|X ∩ Y|:ℝ) + δ m M X Y) : div_le_div hc hc hd (by apply_rules le_refl)
)(
  λ hd: ¬ 0 < (|X ∩ Y|:ℝ) + δ m M X Y,  -- in this case, X = Y = ∅
  have hd2: 0 ≤ (|X ∩ Y|:ℝ) + δ m M X Y, from D_denom_nonneg X Y hm hM,
  have hdd: 0 = (|X ∩ Y|:ℝ) + δ m M X Y, from
    by_contra (
      λ hh: ¬ 0 = (|X ∩ Y|:ℝ) + δ m M X Y,
      hd ((iff.elim_right lt_iff_le_and_ne) (and.intro hd2 hh))
    ),
  calc 0 ≤ 0: le_refl 0
  ... = δ m M X Y / 0: by rw[div_zero]
  ... = δ m M X Y / ((|X ∩ Y|:ℝ) + δ m M X Y): by rw[hdd]
)

theorem D_empty_1 (m M : ℝ) {X Y : finset α} (hm: 0 < m) (hM: m ≤ M):
  X = ∅ → Y ≠ ∅ → D m M X Y = 1 :=
λ hx: X = ∅, λ hy: Y ≠ ∅,
have hhh: X ∩ Y = ∅, from calc
          X ∩ Y = ∅ ∩ Y : by rw hx
            ... = ∅ :empty_inter Y,
have h: |X ∩ Y| = 0, from calc |X∩ Y|=|(∅:finset α)|: by rw hhh
... = 0: card_empty,
have h1: X ≠ Y, from
  assume h2: X = Y,
  have h3: Y = ∅, from eq.trans h2.symm hx,
  hy h3,
have h0: δ m M X Y ≠ 0, from
  assume h2: δ m M X Y = 0,
  have h3: X = Y, from eq_of_delta_eq_zero (hm) hM X Y h2,
  h1 h3,
have hh: (|X ∩ Y|:ℝ) = 0, begin norm_cast,exact h, end,
calc
(δ m M X Y)/(|X ∩ Y| + δ m M X Y) = (δ m M X Y)/(0 + δ m M X Y) : by rw[hh]
                              ... = (δ m M X Y)/(δ m M X Y)     : by rw[zero_add]
                              ... = 1                           : div_self h0

theorem D_empty_2  (m M : ℝ) {X Y : finset α} (hm: 0 < m) (hM: m ≤ M):
  X ≠ ∅ → Y = ∅ → D m M X Y = 1
:= λ hx: X ≠ ∅, λ hy: Y = ∅, let dxy := δ m M X Y, dyx := δ m M Y X in calc
dxy / (|X ∩ Y| + dxy) = (δ m M Y X)/(|Y ∩ X| + δ m M Y X) : by rw[delta_comm,inter_comm]
                  ... = 1                                 : D_empty_1 m M hm hM hy hx

lemma div_self_le_one (a:ℝ): a/a ≤ 1 :=
(em (a=0)).elim(
  λ h: a = 0, calc
    a/a = a/0: by rw[h]
    ... = 0  : div_zero a
    ... ≤ 1  : zero_le_one
)(
  λ h: a ≠ 0,
  calc a/a = 1: div_self h
  ... ≤ 1: le_refl 1
)

theorem D_bounded (m M : ℝ) (X Y : finset α) (hm: 0 ≤ m) (hM: m ≤ M): D m M X Y ≤ 1
  :=
  (em (0 = (|X ∩ Y|:ℝ) + δ m M X Y)).elim(
    λ h0: 0 = (|X ∩ Y|:ℝ) + δ m M X Y,
    calc
    (δ m M X Y)/(|X ∩ Y| + δ m M X Y) = (δ m M X Y)/0: by rw[h0]
                                  ... = 0: div_zero (δ m M X Y)
                                  ... ≤ 1: zero_le_one
  )(
    λ h0: 0 ≠ (|X ∩ Y|:ℝ) + δ m M X Y,
    let dxy := δ m M X Y in
    have hd2: 0 ≤ (|X ∩ Y|:ℝ) + dxy, from D_denom_nonneg X Y hm hM,

    have pos: 0 < (|X ∩ Y|:ℝ) + dxy, from (iff.elim_right lt_iff_le_and_ne) (and.intro hd2 h0),
    have h: dxy ≤ |X ∩ Y| + dxy, from
       calc dxy =    0    + dxy: by rw[zero_add]
            ... ≤ |X ∩ Y| + dxy: add_le_add_right (card_inter_nonneg X Y) (dxy),
    calc         dxy /(|X ∩ Y| + dxy)
    ≤ (|X ∩ Y| + dxy)/(|X ∩ Y| + dxy): div_le_div hd2 h pos (le_refl (|X ∩ Y| + dxy)) ...
    ≤ 1: div_self_le_one (|X ∩ Y| + dxy)
  )

theorem intersect_cases (m M : ℝ) (Y Z : finset α) (hm: 0<m) (hM: m≤ M) (hy: Y ≠ ∅) (hz: Z ≠ ∅):
    let ayz := (|Z ∩ Y|:ℝ), dyz :=  (δ m M Z Y) in 0 < (ayz + dyz) :=

    let ayz := (|Z ∩ Y|:ℝ), dyz :=  (δ m M Z Y) in

    (em (Y ∩ Z = ∅)).elim(
        λ hxy : Y ∩ Z = ∅,
        have decompose: Y = Y ∩ Z ∪ Y \ Z, begin tidy,by_cases (a ∈ Z),cc,cc, end,
        have non_empty: ∅ ≠ Y \ Z, from
          assume h: ∅ = Y \ Z,
          have h1:Y = ∅, from
            calc Y = Y ∩ Z ∪ Y \ Z : decompose
               ... =   ∅   ∪   ∅   : by rw[hxy,h]
               ... =       ∅       : by rw union_empty,
          hy h1,
        have ne_prelim: Z ≠ Y, from
          assume h: Z = Y,
          have h0: Y \ Z = ∅, from calc
                   Y \ Z = Z \ Z: by rw[h]
                     ... = ∅: sdiff_self Z,
          have h1: ∅ = Y \ Z, from h0.symm,
          non_empty h1,
        have ne: 0 ≠ dyz, from
          λ zero_eq_delta: 0 = dyz,
          have eq: Z = Y, from eq_of_delta_eq_zero hm hM Z Y zero_eq_delta.symm,
          ne_prelim eq,
        have le: 0 ≤ dyz, from delta_nonneg (le_of_lt hm) hM,
        calc 0 <       dyz: (iff.elim_right lt_iff_le_and_ne) (and.intro le ne)
           ... =  0  + dyz: by rw[zero_add]
           ... ≤ ayz + dyz: add_le_add_right (card_inter_nonneg Z Y) dyz
    )(
        λ hxy : Y ∩ Z ≠ ∅,
          have card_zero: |Y ∩ Z| = 0 ↔ Y ∩ Z = ∅, from card_eq_zero,
          have ne_nat: |Y ∩ Z| ≠ 0, from
            λ h: |Y ∩ Z| = 0,
            hxy ((iff.elim_left card_zero) h),
          have le: 0 ≤ (|Y ∩ Z|:ℝ), from card_inter_nonneg Y Z,
          have ne: 0 ≠ (|Y ∩ Z|:ℝ), begin norm_cast,exact ne_nat.symm, end,
          calc 0 < (|Y ∩ Z|:ℝ): (iff.elim_right lt_iff_le_and_ne) (and.intro le ne)
            ... = ayz      : by rw[inter_comm]
            ... = ayz +  0 : by rw[add_zero]
            ... ≤ ayz + dyz: add_le_add_left (delta_nonneg (le_of_lt hm) hM) ayz
    )

lemma four_immediate_from (m M : ℝ) (X Y Z : finset α)
  (hm: 0 < m) (hM: m ≤ M) (h1M: 1 ≤ M)
  (hx: X ≠ ∅) (hz: Z ≠ ∅):
  let axy := (|X ∩ Y|:ℝ), dxz := δ m M X Z, dyz := δ m M Z Y,
      axz := (|X ∩ Z|:ℝ), denom := axy+dxz+dyz in

  dxz/denom ≤ dxz/(axz + dxz) :=

  let dxy := (δ m M X Y), axy := (|X ∩ Y|:ℝ), dxz := δ m M X Z,
    dyz :=  (δ m M Z Y), ayz := (|Z ∩ Y|:ℝ), axz := (|X ∩ Z|:ℝ),
    y_z : ℕ := (Y \ Z).card, z_y : ℕ := (Z \ Y).card,x_z : ℕ := (X \ Z).card,
    z_x : ℕ := (Z \ X).card, xy : ℕ := (X ∩ Y).card,
    xz : ℕ := (X ∩ Z).card,  yz : ℕ := (Y ∩ Z).card,
    mini := (min (|Z \ Y|) (|Y \ Z|) : ℝ), maxi := (max (|Z \ Y|) (|Y \ Z|) : ℝ),
    denom := (axy+dxz+dyz)
  in
  have twelve_end_real: (xz:ℝ) ≤ (xy:ℝ) + max (|Z \ Y| : ℝ) (|Y \ Z| : ℝ), from
    have ddd: xz ≤ xy + max ((Z \ Y).card) ((Y \ Z).card), from twelve_end X Y Z,
    begin norm_cast,exact ddd, end,
  have max_nonneg_real: 0 ≤ (max (|Z \ Y|) (|Y \ Z|) : ℝ), from
    have 0 ≤ max z_y y_z, from nat.zero_le (max z_y y_z),
    begin norm_cast, exact this,end,
  have min_nonneg_real: 0 ≤ (min (|Z \ Y|) (|Y \ Z|) : ℝ), from
    have 0 ≤ min z_y y_z, from nat.zero_le (min z_y y_z),
    begin norm_cast, exact this,end,
  have mmin_nonneg : 0 ≤ m * mini, from mul_nonneg (le_of_lt hm) min_nonneg_real,
  have use_h1M: 1 * maxi ≤ M * maxi, from mul_le_mul_of_nonneg_right h1M max_nonneg_real,
  have four_would_follow_from : axz ≤ axy + dyz, from calc
      axz ≤ (xy:ℝ) +     maxi             : twelve_end_real
      ... = (xy:ℝ) + 1 * maxi             : by ring
      ... ≤ (xy:ℝ) + M * maxi             : add_le_add_left use_h1M (xy:ℝ)
      ... = (xy:ℝ) + M * maxi + 0         : by rw[add_zero]
      ... ≤ (xy:ℝ) + M * maxi + m * mini  : add_le_add_left mmin_nonneg ((xy:ℝ) + M * maxi)
      ... = (xy:ℝ) + (M * (max (|Z \ Y|) (|Y \ Z|) : ℝ) + m * (min (|Z \ Y|) (|Y \ Z|) : ℝ)):
        by rw[add_assoc]
      ... = (|X ∩ Y|:ℝ)    + (δ m M Z Y): begin norm_cast, end,
  have le_denom:(axz + dxz) ≤ denom, from
      calc axz + dxz ≤ axy + dyz + dxz : add_le_add_right four_would_follow_from dxz
                  ... = axy + dxz + dyz : by ring,
  have denom_pos : 0 < (axz + dxz), from intersect_cases m M Z X hm hM hz hx,
  have d_nonneg: 0 ≤ dxz, from delta_nonneg (le_of_lt hm) hM,
  div_le_div_of_le_left d_nonneg denom_pos le_denom

 lemma four_immediate_from_and  (m M : ℝ) (X Y Z : finset α)
  (hm: 0 < m) (hM: m ≤ M) (h1M: 1 ≤ M)
  (hy: Y ≠ ∅) (hz: Z ≠ ∅):
  (δ m M Z Y)/((|X ∩ Y|:ℝ) + δ m M X Z + δ m M Z Y) ≤ (δ m M Z Y)/((|Z ∩ Y|:ℝ) + δ m M Z Y) :=

  let dzy := δ m M Z Y, dyz := δ m M Y Z, dxz := δ m M X Z, dzx := δ m M Z X in
  have S: (dyz) / ((|Y ∩ X|:ℝ) + (dyz) + (dzx)) ≤ (dyz) / ((|Y ∩ Z|:ℝ) + dyz), from
    four_immediate_from m M Y X Z hm hM h1M hy hz,
  have dzy_comm: dzy = dyz, from delta_comm,
  have dxz_comm: dxz = dzx, from delta_comm,
  have ring_in_denom: (|Y ∩ X|:ℝ) + dzx + dyz = (|Y ∩ X|:ℝ) + dyz + dzx, by ring,
  calc   dzy / ((|X ∩ Y|:ℝ) + dxz + dzy)
       = dyz / ((|Y ∩ X|:ℝ) + dyz + dzx) : by rw[inter_comm,dxz_comm,dzy_comm,ring_in_denom]
   ... ≤ dyz / ((|Y ∩ Z|:ℝ) + dyz)       : S
   ... = dzy / ((|Z ∩ Y|:ℝ) + dzy)       : by rw[inter_comm,dzy_comm]

lemma mul_le_mul_rt {a b c : ℝ} (h : 0 ≤ c) : a ≤ b → a * c ≤ b * c :=
(em (0 = c)).elim(
  λ h0: 0 = c,
  λ hab: a ≤ b,
  calc a* c = a * 0: by rw h0
  ... = 0: mul_zero a
  ... ≤ 0: le_refl 0
  ... = b * 0: by rw[mul_zero b]
  ... = b * c: by rw h0
)(
  λ h0: 0 ≠ c,
  λ hab: a ≤ b,
  have h1: 0 < c, from (iff.elim_right lt_iff_le_and_ne) (and.intro h h0),
  (iff.elim_right (mul_le_mul_right h1)) hab
)

lemma abc_lemma {a b c : ℝ} (h : 0 ≤ a) (hb : a ≤ b) (hc : 0 ≤ c) : (a/(a+c)) ≤ (b/(b+c)) :=

(em (0 = a)).elim(
  λ ha: 0 = a,
  (em (0 = b)).elim(
    λ hhb: 0 = b, -- a=b=0
        calc  a/(a+c)
            = 0/(0+c): by rw ha
        ... ≤ 0/(0+c): le_refl (0/(0+c))
        ... = b/(b+c): by rw hhb
  )(
    λ hhb: 0 ≠ b, -- a=0, b ≠ 0
      have g0: 0 ≤ b, from (le_trans h hb),
      have g: 0 ≤ b + c, from add_nonneg g0 hc,
        calc  a/(a+c)
            = 0/(a+c): by rw ha
        ... = 0: by rw zero_div
        ... ≤ b/(b+c): div_nonneg g0 g
  )
)(
  λ hh: 0 ≠ a, -- then, since a ≤ b, b ≠ 0 as well
        have ha: 0 < a, from (iff.elim_right lt_iff_le_and_ne) (and.intro h hh),
        have numer : a*(b+c) ≤ b*(a+c), from calc
          a*(b+c) = a*b + a*c : by rw left_distrib
              ... ≤ a*b + b*c : add_le_add_left (mul_le_mul_rt hc hb) (a*b)
              ... = b * (a+c) : by ring,
        have h6 : 0 < a+c, from lt_add_of_pos_of_le ha hc,
        have h7 : 0 < b+c, from lt_add_of_pos_of_le (has_lt.lt.trans_le ha hb) hc,
        (iff.elim_right (div_le_div_iff h6 h7)) numer
  )

theorem three (X Y Z : finset α) (hm: 0 < m) (hM: m ≤ M):
let axy := (|X ∩ Y| : ℝ), dxy := δ m M X Y, dxz := δ m M X Z,
    dyz := δ m M Z Y, denom := (axy+dxz+dyz) in

dxy/(axy + dxy) ≤ (dxz+dyz)/denom :=

let axy := (|X ∩ Y| : ℝ), dxy := δ m M X Y, dxz := δ m M X Z, dzy := δ m M Y Z, dyz := δ m M Z Y,
    axy := (|X ∩ Y| : ℝ), denom := (axy+dxz+dyz) in

  have hd : 0 ≤ δ m M X Y, from delta_nonneg (le_of_lt hm) hM,
  have h0 : δ m M Z Y = δ m M Y Z , by rw delta_comm,
  have h1 : dxy ≤ dxz + dzy, from calc
    dxy ≤ dxz + δ m M Z Y: delta_triangle X Z Y hm hM
    ... = dxz + δ m M Y Z: by rw h0,
  have h2: dxz + dyz + axy = axy + dxz + dyz, by ring,
    calc  dxy / (axy + dxy)
        = dxy / (dxy + axy)                           : by rw add_comm axy dxy
    ... ≤ (dxz + δ m M Y Z) / (dxz + dzy + axy)       : abc_lemma hd h1 (card_inter_nonneg X Y)
    ... = (dxz + δ m M Z Y) / (dxz + δ m M Z Y + axy) : by rw h0
    ... = (dxz + δ m M Z Y) / (axy + dxz + δ m M Z Y) : by rw h2

 theorem jn_triangle_nonempty
  (m M : ℝ) (X Y Z : finset α) (hm: 0 < m) (hM: m ≤ M) (h1M: 1 ≤ M)
  (hx: X ≠ ∅) (hy: Y ≠ ∅) (hz: Z ≠ ∅): D m M X Y ≤ D m M X Z + D m M Z Y :=
  let dxy := (δ m M X Y), axy := (|X ∩ Y|:ℝ), dxz := δ m M X Z,
    dyz :=  (δ m M Z Y), ayz := (|Z ∩ Y|:ℝ), axz := (|X ∩ Z|:ℝ),
    denom := (axy+dxz+dyz)
  in
    have hzM: 0 < M, from calc
             0 < m: hm
           ... ≤ M: hM,
    have three: dxy/(axy + dxy) ≤ (dxz+dyz)/denom, from three X Y Z hm hM,
    have four: (dxz+dyz)/denom ≤ dxz/(axz + dxz) + dyz/(ayz + dyz), from calc
    (dxz+dyz)/denom = dxz/denom + dyz/denom: add_div dxz dyz denom
                ... ≤ dxz/(axz + dxz)   + dyz/denom:
                add_le_add_right
                (four_immediate_from m M X Y Z hm hM h1M hx hz)
                ((dyz)/denom)
                ... ≤ dxz/(axz + dxz)   + dyz/(ayz + dyz)  :
                add_le_add_left
                (four_immediate_from_and m M X Y Z hm hM h1M hy hz)
                (dxz/(axz + dxz)),
    le_trans three four

theorem jn_triangle (m M : ℝ) (X Y Z : finset α)
(hm: 0 < m) (hM: m ≤ M) (h1M: 1 ≤ M): D m M X Y ≤ D m M X Z + D m M Z Y :=
let dxz := D m M X Z in
    (em (X=∅)).elim(
        λ hx: X = ∅,
        (em (Y=∅)).elim(
            λ hy: Y = ∅,
            have h1: X = Y, from eq.trans hx hy.symm, calc
            D m M X Y = D m M X X          : by rw[h1]
                  ... = 0                     : jn_self X
                  ... ≤             D m M Z Y : D_nonneg Z Y (le_of_lt hm) hM
                  ... = 0         + D m M Z Y : eq.symm (zero_add (D m M Z Y))
                  ... ≤ D m M X Z + D m M Z Y :
                  add_le_add_right (D_nonneg X Z (le_of_lt hm) hM) (D m M Z Y)
        )(
            λ hy: Y ≠ ∅,
            (em (Z = ∅)).elim(
                λ hz: Z = ∅, -- 010 non Y nonempty
                have h3: D m M Z Y = 1, from D_empty_1 m M hm hM hz hy,
                calc D m M X Y =             1: D_empty_1 m M hm hM hx hy
                        ... = 0         + 1: by rw[zero_add]
                        ... ≤ D m M X Z + 1: add_le_add_right (D_nonneg X Z (le_of_lt hm) hM) 1
                        ... = D m M X Z + D m M Z Y: by rw[h3]
            )(
                λ hz: Z ≠ ∅, -- 011 only X empty
                have h1: D m M X Y = 1, from D_empty_1 m M hm hM hx hy,
                have h2: D m M X Z = 1, from D_empty_1 m M hm hM hx hz,
                calc D m M X Y = 1: h1
                        ... = 1 + 0: by rw[add_zero]
                        ... ≤ 1 + D m M Z Y: add_le_add_left (D_nonneg Z Y (le_of_lt hm) hM) 1
                        ... = D m M X Z + D m M Z Y: by rw[h2]
            )
        )
    )(
      λ hx: X ≠ ∅,
      (em (Y=∅)).elim(
        λ hy: Y = ∅,
        (em (Z = ∅)).elim(
          λ hz: Z = ∅, -- 100 only X nonempty
          calc D m M X Y =     1                  : D_empty_2 m M hm hM hx hy
                     ... =     1     +      0     : by rw[add_zero]
                     ... ≤     1     +  D m M Z Y : add_le_add_left (D_nonneg Z Y (le_of_lt hm) hM) 1
                     ... = D m M X Z +  D m M Z Y : by rw[D_empty_2 m M hm hM hx hz]
        )(
          λ hz: Z ≠ ∅, -- 101 only Y empty
          calc D m M X Y =                 1    : D_empty_2 m M hm hM hx hy
                     ... =     0     +     1    : by rw[zero_add]
                     ... ≤ D m M X Z +     1    : add_le_add_right (D_nonneg X Z (le_of_lt hm) hM) 1
                     ... = D m M X Z + D m M Z Y : by rw[D_empty_2 m M hm hM hz hy]
        )
      )(
        λ hy: Y ≠ ∅,
        (em (Z = ∅)).elim(
          λ hz: Z = ∅, -- 110 only Z is empty
          have h2: D m M X Z = 1, from D_empty_2 m M hm hM hx hz,
          have h3: D m M Z Y = 1, from D_empty_1 m M hm hM hz hy,
          calc D m M X Y ≤             1: D_bounded m M X Y (le_of_lt hm) hM
                     ... =         0 + 1: by rw[zero_add]
                     ... ≤         1 + 1: add_le_add_right zero_le_one 1
                     ... = D m M X Z + D m M Z Y: by rw[h2,h3]
        )(
            λ hz: Z ≠ ∅, -- 111
            jn_triangle_nonempty m M X Y Z hm hM h1M hx hy hz
        )
      )
    )

noncomputable instance jaccard_nid.metric_space
(hm : 0 < m) (hM : m ≤ M) (h1M: 1 ≤ M): metric_space (finset α) := {
        dist               := λx y, D m M x y,
        dist_self          := jn_self,
        eq_of_dist_eq_zero := eq_of_jn_eq_zero hm hM,
        dist_comm          := λ x y, jn_comm x y,
        dist_triangle      := λ x z y, jn_triangle m M x y z hm hM h1M
    }

noncomputable def J : finset α → (finset α → ℝ) :=
  λ x y, (δ 1 1 x y) / ((|x ∩ y|:ℝ) + δ 1 1 x y)

--Easy but not done yet:
--theorem J_characterization (X Y : finset α):
--J X Y = ((|X \ Y|) + (|Y \ X|)) / (|X ∪ Y|) :=
--let dxy := (1:ℝ) * (max (|X \ Y|) (|Y \ X|):ℝ) + (1:ℝ) * (min (|X \ Y|) (|Y \ X|):ℝ) in
--calc dxy / ((|X ∩ Y|:ℝ) + dxy) = ((|X \ Y|) + (|Y \ X|)) / (|X ∪ Y|): sorry

noncomputable instance jaccard.metric_space
(hm : (0:ℝ) < (1:ℝ)) (hM : (1:ℝ) ≤ (1:ℝ)) (h1M: (1:ℝ) ≤ (1:ℝ)): metric_space (finset ℕ) := {
        dist               := λx y, D 1 1 x y,
        dist_self          := jn_self,
        eq_of_dist_eq_zero := eq_of_jn_eq_zero hm hM,
        dist_comm          := λ x y, jn_comm x y,
        dist_triangle      := λ x z y, jn_triangle 1 1 x y z hm hM h1M
    }

end jaccard_nid