import signed_measure
import order.symm_diff

/-
This file contains the definition of positive and negative sets and
the Hahn decomposition theorem.
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal

variables {α β : Type*} [measurable_space α]

namespace signed_measure

open filter measure_theory

/-- A set `i` is positive with respect to a signed measure if for all
measurable set `j`, `j ⊆ i`, `j` has non-negative measure. -/
def positive (s : signed_measure α) (i : set α) : Prop :=
∀ j ⊆ i, measurable_set j → 0 ≤ s j

/-- A set `i` is negative with respect to a signed measure if for all
measurable set `j`, `j ⊆ i`, `j` has non-positive measure. -/
def negative (s : signed_measure α) (i : set α) : Prop :=
∀ j ⊆ i, measurable_set j → s j ≤ 0

variables {s : signed_measure α} {i j : set α}

lemma empty_positive : s.positive ∅ :=
begin
  intros j hj _,
  rw [set.subset_eq_empty hj rfl, s.measure_of_empty],
end

lemma empty_negative : s.negative ∅ :=
begin
  intros j hj _,
  rw [set.subset_eq_empty hj rfl, s.measure_of_empty],
end

lemma positive_nonneg_measure (hi₁ : measurable_set i) (hi₂ : s.positive i) :
  0 ≤ s i :=
hi₂ i set.subset.rfl hi₁

lemma negative_nonpos_measure (hi₁ : measurable_set i) (hi₂ : s.negative i) :
  s i ≤ 0 :=
hi₂ i set.subset.rfl hi₁

lemma positive_subset_positive (hi : s.positive i) (hij : j ⊆ i) :
  s.positive j :=
begin
  intros k hk,
  exact hi _ (set.subset.trans hk hij),
end

lemma negative_subset_negative (hi : s.negative i) (hij : j ⊆ i) :
  s.negative j :=
begin
  intros k hk,
  exact hi _ (set.subset.trans hk hij),
end

lemma positive_union_positive
  (hi₁ : measurable_set i) (hi₂ : s.positive i)
  (hj₁ : measurable_set j) (hj₂ : s.positive j) : s.positive (i ∪ j) :=
begin
  intros a ha₁ ha₂,
  have h₁ := measurable_set.inter ha₂ hi₁,
  have h₂ := measurable_set.diff (measurable_set.inter ha₂ hj₁) h₁,
  rw [← set.union_inter_diff_eq ha₁,
      measure_of_union set.union_inter_diff_disjoint h₁ h₂],
  refine add_nonneg (hi₂ _ (a.inter_subset_right i) h₁) _,
  exact hj₂ _ (set.subset.trans ((a ∩ j).diff_subset (a ∩ i)) (a.inter_subset_right j)) h₂,
end

lemma positive_Union_negative {f : ℕ → set α}
  (hf₁ : ∀ n, measurable_set (f n)) (hf₂ : ∀ n, s.positive (f n)) :
  s.positive ⋃ n, f n :=
begin
  intros a ha₁ ha₂,
  rw [← set.Union_inter_diff_eq ha₁, s.measure_of_disjoint_Union _ set.Union_inter_diff_disjoint],
  refine tsum_nonneg (λ n, hf₂ n _ _ _),
  { exact set.subset.trans (set.diff_subset _ _) (set.inter_subset_right _ _) },
  { refine measurable_set.diff (measurable_set.inter ha₂ (hf₁ n)) _,
    exact measurable_set.Union (λ m, measurable_set.Union_Prop (λ _, hf₁ m)) },
  { intro n,
    refine measurable_set.diff (measurable_set.inter ha₂ (hf₁ n)) _,
    exact measurable_set.Union (λ m, measurable_set.Union_Prop (λ _, hf₁ m)) }
end

lemma negative_union_negative
  (hi₁ : measurable_set i) (hi₂ : s.negative i)
  (hj₁ : measurable_set j) (hj₂ : s.negative j) : s.negative (i ∪ j) :=
begin
  intros a ha₁ ha₂,
  have h₁ := measurable_set.inter ha₂ hi₁,
  have h₂ := measurable_set.diff (measurable_set.inter ha₂ hj₁) h₁,
  rw [← set.union_inter_diff_eq ha₁,
      measure_of_union set.union_inter_diff_disjoint h₁ h₂],
  refine add_nonpos (hi₂ _ (a.inter_subset_right i) h₁) _,
  exact hj₂ _ (set.subset.trans ((a ∩ j).diff_subset (a ∩ i)) (a.inter_subset_right j)) h₂,
end

lemma negative_Union_negative {f : ℕ → set α}
  (hf₁ : ∀ n, measurable_set (f n)) (hf₂ : ∀ n, s.negative (f n)) :
  s.negative ⋃ n, f n :=
begin
  intros a ha₁ ha₂,
  rw [← set.Union_inter_diff_eq ha₁, s.measure_of_disjoint_Union _ set.Union_inter_diff_disjoint],
  refine tsum_nonpos (λ n, hf₂ n _ _ _),
  { exact set.subset.trans (set.diff_subset _ _) (set.inter_subset_right _ _) },
  { refine measurable_set.diff (measurable_set.inter ha₂ (hf₁ n)) _,
    exact measurable_set.Union (λ m, measurable_set.Union_Prop (λ _, hf₁ m)) },
  { intro n,
    refine measurable_set.diff (measurable_set.inter ha₂ (hf₁ n)) _,
    exact measurable_set.Union (λ m, measurable_set.Union_Prop (λ _, hf₁ m)) }
end

lemma exists_pos_measure_of_not_negative (hi : ¬ s.negative i) :
  ∃ (j : set α) (hj₁ : j ⊆ i) (hj₂ : measurable_set j), 0 < s j :=
begin
  rw negative at hi,
  push_neg at hi,
  obtain ⟨j, hj₁, hj₂, hj⟩ := hi,
  exact ⟨j, hj₁, hj₂, hj⟩,
end

/-- The underlying function for `signed_measure.positive_to_measure`. -/
def positive_to_measure_of_measure (s : signed_measure α)
  (i : set α) (hi₁ : measurable_set i) (hi₂ : s.positive i)
  (j : set α) (hj₁ : measurable_set j) : ℝ≥0∞ :=
some ⟨s (i ∩ j), positive_nonneg_measure (measurable_set.inter hi₁ hj₁)
  (positive_subset_positive hi₂ $ set.inter_subset_left _ _)⟩

/-- Given a signed measure `s` and a positive measurable set `i`, `positive_to_measure`
provides the measure mapping measurable sets `j` to `s (i ∩ j)`. -/
def positive_to_measure (s : signed_measure α)
  (i : set α) (hi₁ : measurable_set i) (hi₂ : s.positive i) : measure α :=
measure.of_measurable (s.positive_to_measure_of_measure i hi₁ hi₂)
  (by { simp_rw [positive_to_measure_of_measure, set.inter_empty i, s.measure_of_empty], refl })
  begin
    intros f hf₁ hf₂,
    simp_rw [positive_to_measure_of_measure, set.inter_Union],
    have h₁ : ∀ n, measurable_set (i ∩ f n) := λ n, hi₁.inter (hf₁ n),
    have h₂ : pairwise (disjoint on λ (n : ℕ), i ∩ f n),
    { rintro n m hnm x ⟨⟨_, hx₁⟩, _, hx₂⟩,
      exact hf₂ n m hnm ⟨hx₁, hx₂⟩ },
    simp_rw [s.measure_of_disjoint_Union h₁ h₂, ennreal.some_eq_coe,
      ← ennreal.coe_tsum (nnreal.summable_coe_of_summable _ (summable_measure_of h₁ h₂))],
    rw ← nnreal.tsum_coe_eq_of_nonneg,
  end

lemma positive_to_measure_apply (hi₁ : measurable_set i) (hi₂ : s.positive i)
  {j : set α} (hj₁ : measurable_set j) :
  s.positive_to_measure i hi₁ hi₂ j =
  some ⟨s (i ∩ j), positive_nonneg_measure (measurable_set.inter hi₁ hj₁)
  (positive_subset_positive hi₂ $ set.inter_subset_left _ _)⟩ :=
by { rw [positive_to_measure, measure.of_measurable_apply _ hj₁], refl }

/-- `signed_measure.positive_to_measure` is a finite measure (this is a def since it
takes arguments). -/
def positive_to_measure_finite (hi₁ : measurable_set i) (hi₂ : s.positive i) :
  finite_measure (s.positive_to_measure i hi₁ hi₂) :=
{ measure_univ_lt_top :=
  begin
    rw [positive_to_measure_apply hi₁ hi₂ measurable_set.univ, ennreal.some_eq_coe],
    exact ennreal.coe_lt_top,
  end }

/-- The underlying function for `signed_measure.negative_to_measure`. -/
def negative_to_measure_of_measure (s : signed_measure α)
  (i : set α) (hi₁ : measurable_set i) (hi₂ : s.negative i)
  (j : set α) (hj₁ : measurable_set j) : ℝ≥0∞ :=
some ⟨-s (i ∩ j), le_neg.1 $ (@neg_zero ℝ _).symm ▸
  negative_nonpos_measure (measurable_set.inter hi₁ hj₁)
    (negative_subset_negative hi₂ $ set.inter_subset_left _ _)⟩

/-- Given a signed measure `s` and a positive measurable set `i`, `positive_to_measure`
provides the measure mapping measurable sets `j` to `s (i ∩ j)`. -/
def negative_to_measure (s : signed_measure α)
  (i : set α) (hi₁ : measurable_set i) (hi₂ : s.negative i) : measure α :=
measure.of_measurable (s.negative_to_measure_of_measure i hi₁ hi₂)
  (by { simp_rw [negative_to_measure_of_measure, set.inter_empty i, s.measure_of_empty, neg_zero], refl })
  begin
    intros f hf₁ hf₂,
    simp_rw [negative_to_measure_of_measure, set.inter_Union],
    have h₁ : ∀ n, measurable_set (i ∩ f n) := λ n, hi₁.inter (hf₁ n),
    have h₂ : pairwise (disjoint on λ (n : ℕ), i ∩ f n),
    { rintro n m hnm x ⟨⟨_, hx₁⟩, _, hx₂⟩,
      exact hf₂ n m hnm ⟨hx₁, hx₂⟩ },
    simp_rw [s.measure_of_disjoint_Union h₁ h₂, ennreal.some_eq_coe],
    rw ← ennreal.coe_tsum,
    simp_rw [← tsum_neg (summable_measure_of h₁ h₂)],
    { rw [ennreal.coe_eq_coe, ← nnreal.tsum_coe_eq_of_nonneg] },
    exact nnreal.summable_coe_of_summable _ (summable_neg_iff.2 (summable_measure_of h₁ h₂))
  end

lemma negative_to_measure_apply (hi₁ : measurable_set i) (hi₂ : s.negative i)
  {j : set α} (hj₁ : measurable_set j) :
  s.negative_to_measure i hi₁ hi₂ j =
  some ⟨-s (i ∩ j), le_neg.1 $ (@neg_zero ℝ _).symm ▸
  negative_nonpos_measure (measurable_set.inter hi₁ hj₁)
    (negative_subset_negative hi₂ $ set.inter_subset_left _ _)⟩ :=
by { rw [negative_to_measure, measure.of_measurable_apply _ hj₁], refl }

/-- `signed_measure.negative_to_measure` is a finite measure (this is a def since it
takes arguments). -/
def negative_to_measure_finite (hi₁ : measurable_set i) (hi₂ : s.negative i) :
  finite_measure (s.negative_to_measure i hi₁ hi₂) :=
{ measure_univ_lt_top :=
  begin
    rw [negative_to_measure_apply hi₁ hi₂ measurable_set.univ, ennreal.some_eq_coe],
    exact ennreal.coe_lt_top,
  end }

section exists_negative_set

def p (s : signed_measure α) (i j : set α) (n : ℕ) : Prop :=
∃ (k : set α) (hj₁ : k ⊆ i \ j) (hj₂ : measurable_set k), (1 / (n + 1) : ℝ) < s k

lemma exists_nat_one_div_lt_measure_of_not_negative (hi : ¬ s.negative (i \ j)) :
  ∃ (n : ℕ), s.p i j n :=
let ⟨k, hj₁, hj₂, hj⟩ := exists_pos_measure_of_not_negative hi in
let ⟨n, hn⟩ := exists_nat_one_div_lt hj in ⟨n, k, hj₁, hj₂, hn⟩

def aux₀ (s : signed_measure α) (i j : set α) : ℕ :=
if hi : ¬ s.negative (i \ j) then nat.find (exists_nat_one_div_lt_measure_of_not_negative hi)
                       else 0

lemma aux₀_spec (hi : ¬ s.negative (i \ j)) : s.p i j (s.aux₀ i j) :=
begin
  rw [aux₀, dif_pos hi],
  convert nat.find_spec _,
end

lemma aux₀_min (hi : ¬ s.negative (i \ j)) {m : ℕ} (hm : m < s.aux₀ i j) : ¬ s.p i j m :=
begin
  rw [aux₀, dif_pos hi] at hm,
  exact nat.find_min _ hm
end

def aux₁ (s : signed_measure α) (i j : set α) : set α :=
if hi : ¬ s.negative (i \ j) then classical.some (aux₀_spec hi) else ∅

lemma aux₁_spec (hi : ¬ s.negative (i \ j)) :
  ∃ (hj₁ : (s.aux₁ i j) ⊆ i \ j) (hj₂ : measurable_set (s.aux₁ i j)),
  (1 / (s.aux₀ i j + 1) : ℝ) < s (s.aux₁ i j) :=
begin
  rw [aux₁, dif_pos hi],
  exact classical.some_spec (aux₀_spec hi),
end

lemma aux₁_subset : s.aux₁ i j ⊆ i \ j :=
begin
  by_cases hi : ¬ s.negative (i \ j),
  { exact let ⟨h, _⟩ := aux₁_spec hi in h },
  { rw [aux₁, dif_neg hi],
    exact set.empty_subset _ },
end

lemma aux₁_subset'' : s.aux₁ i j ⊆ i :=
set.subset.trans aux₁_subset (set.diff_subset _ _)

lemma aux₁_subset' {k : set α} (hk : i \ k ⊆ i \ j) : s.aux₁ i k ⊆ i \ j :=
begin
  by_cases hi : ¬ s.negative (i \ k),
  { exact let ⟨h, _⟩ := aux₁_spec hi in set.subset.trans h hk },
  { rw [aux₁, dif_neg hi],
    exact set.empty_subset _ },
end

lemma aux₁_measurable_set : measurable_set (s.aux₁ i j) :=
begin
  by_cases hi : ¬ s.negative (i \ j),
  { exact let ⟨_, h, _⟩ := aux₁_spec hi in h },
  { rw [aux₁, dif_neg hi],
    exact measurable_set.empty }
end

lemma aux₁_lt (hi : ¬ s.negative (i \ j)) :
  (1 / (s.aux₀ i j + 1) : ℝ) < s (s.aux₁ i j) :=
let ⟨_, _, h⟩ := aux₁_spec hi in h

noncomputable
def aux (s : signed_measure α) (i : set α) : ℕ → set α
| 0 := s.aux₁ i ∅
| (n + 1) := s.aux₁ i ⋃ k ≤ n,
  have k < n + 1 := nat.lt_succ_iff.mpr H,
  aux k

lemma aux_succ (n : ℕ) : s.aux i n.succ = s.aux₁ i ⋃ k ≤ n, s.aux i k :=
by rw aux

lemma aux_subset (n : ℕ) :
  s.aux i n ⊆ i :=
begin
  cases n;
  { rw aux, exact aux₁_subset'' }
end

lemma aux_spec (n : ℕ) (h : ¬ s.negative (i \ ⋃ k ≤ n, s.aux i k)) :
  s.p i (s.aux i n) (s.aux₀ i (⋃ k ≤ n, s.aux i k)) :=
begin
  rcases aux₀_spec h with ⟨k, hk₁, hk₂, hk₃⟩,
  refine ⟨k, set.subset.trans hk₁ _, hk₂, hk₃⟩,
  apply set.diff_subset_diff_right,
  intros x hx,
  simp only [exists_prop, set.mem_Union],
  exact ⟨n, le_rfl, hx⟩,
end

lemma aux_lt (n : ℕ) (hn :¬ s.negative (i \ ⋃ l ≤ n, s.aux i l)) :
  (1 / (s.aux₀ i (⋃ k ≤ n, s.aux i k) + 1) : ℝ) < s (s.aux i n.succ) :=
begin
  rw aux_succ,
  apply aux₁_lt hn,
end

lemma not_negative_subset (hi : ¬ s.negative i) (h : i ⊆ j) : ¬ s.negative j :=
λ h', hi $ negative_subset_negative h' h

lemma measure_of_aux (hi₂ : ¬ s.negative i)
  (n : ℕ) (hn : ¬ s.negative (i \ ⋃ k < n, s.aux i k)) :
  0 < s (s.aux i n) :=
begin
  cases n,
  { rw aux, rw ← @set.diff_empty _ i at hi₂,
    rcases aux₁_spec hi₂ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) },
  { rw aux_succ,
    have h₁ : ¬ s.negative (i \ ⋃ (k : ℕ) (H : k ≤ n), s.aux i k),
    { apply not_negative_subset hn,
      apply set.diff_subset_diff_right,
      intros x,
      simp_rw [set.mem_Union],
      rintro ⟨n, hn₁, hn₂⟩,
      refine ⟨n, nat.lt_succ_iff.mpr hn₁, hn₂⟩ },
    rcases aux₁_spec h₁ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) }
end

lemma aux_measurable_set (n : ℕ) :
  measurable_set (s.aux i n) :=
begin
  cases n,
  { rw aux,
    exact aux₁_measurable_set },
  { rw aux,
    exact aux₁_measurable_set }
end

lemma aux_lt' (hi : ¬ s.negative i) :
  (1 / (s.aux₀ i ∅ + 1) : ℝ) < s (s.aux i 0) :=
begin
  rw aux,
  rw ← @set.diff_empty _ i at hi,
  exact aux₁_lt hi,
end

lemma aux_disjoint' {n m : ℕ} (h : n < m) : s.aux i n ∩ s.aux i m = ∅ :=
begin
  rw set.eq_empty_iff_forall_not_mem,
  rintro x ⟨hx₁, hx₂⟩,
  cases m, linarith,
  { rw aux at hx₂,
    exact (aux₁_subset hx₂).2
      (set.mem_Union.2 ⟨n, set.mem_Union.2 ⟨nat.lt_succ_iff.mp h, hx₁⟩⟩) }
end

lemma aux_disjoint : pairwise (disjoint on (s.aux i)) :=
begin
  intros n m h,
  rcases lt_or_gt_of_ne h with (h | h),
  { intro x,
    rw [set.inf_eq_inter, aux_disjoint' h],
    exact id },
  { intro x,
    rw [set.inf_eq_inter, set.inter_comm, aux_disjoint' h],
    exact id }
end

private lemma exists_negative_set' (hi₁ : measurable_set i) (hi₂ : s i < 0)
  (hn : ¬ ∀ n : ℕ, ¬ s.negative (i \ ⋃ l < n, s.aux i l)) :
  ∃ (j : set α) (hj₁ : measurable_set j) (hj₂ : j ⊆ i), s.negative j ∧ s j < 0 :=
begin
  by_cases s.negative i,
  { exact ⟨i, hi₁, set.subset.refl _, h, hi₂⟩ },
  { push_neg at hn,
    set k := nat.find hn with hk₁,
    have hk₂ : s.negative (i \ ⋃ l < k, s.aux i l) := nat.find_spec hn,
    have hmeas : measurable_set (⋃ (l : ℕ) (H : l < k), s.aux i l),
      exact (measurable_set.Union $ λ _,
        measurable_set.Union_Prop (λ _, aux_measurable_set _)),
    refine ⟨i \ ⋃ l < k, s.aux i l, measurable_set.diff hi₁ hmeas,
            set.diff_subset _ _, hk₂, _⟩,
    rw measure_of_diff' hmeas hi₁,
    rw s.measure_of_disjoint_Union,
    { have h₁ : ∀ l < k, 0 ≤ s (s.aux i l),
      { intros l hl,
        exact le_of_lt (measure_of_aux h _
          (not_negative_subset (nat.find_min hn hl) (set.subset.refl _))) },
      suffices : 0 ≤ ∑' (l : ℕ), s (⋃ (H : l < k), s.aux i l),
        linarith,
      refine tsum_nonneg _,
      intro l, by_cases l < k,
      { convert h₁ _ h,
        ext,
        rw [set.mem_Union, exists_prop, and_iff_right_iff_imp],
        exact λ _, h },
      { convert le_of_eq s.measure_of_empty.symm,
        ext, simp only [exists_prop, set.mem_empty_eq, set.mem_Union, not_and, iff_false],
        exact λ h', false.elim (h h') } },
    { intro, exact measurable_set.Union_Prop (λ _, aux_measurable_set _) },
    { intros a b hab x hx,
      simp only [exists_prop, set.mem_Union, set.mem_inter_eq, set.inf_eq_inter] at hx,
      exact let ⟨⟨_, hx₁⟩, _, hx₂⟩ := hx in aux_disjoint a b hab ⟨hx₁, hx₂⟩ },
    { apply set.Union_subset,
      intros a x,
      simp only [and_imp, exists_prop, set.mem_Union],
      intros _ hx,
      exact aux_subset _ hx } }
end .

/-- A measurable set of negative measure has a negative subset of negative measure. -/
theorem exists_negative_set (hi₁ : measurable_set i) (hi₂ : s i < 0) :
  ∃ (j : set α) (hj₁ : measurable_set j) (hj₂ : j ⊆ i), s.negative j ∧ s j < 0 :=
begin
  by_cases s.negative i,
  { exact ⟨i, hi₁, set.subset.refl _, h, hi₂⟩ },
  { by_cases hn : ∀ n : ℕ, ¬ s.negative (i \ ⋃ l < n, s.aux i l),
    { set A := i \ ⋃ l, s.aux i l with hA,
      set bdd : ℕ → ℕ := λ n, s.aux₀ i (⋃ k ≤ n, s.aux i k) with hbdd,

      have hn' : ∀ n : ℕ, ¬ s.negative (i \ ⋃ l ≤ n, s.aux i l),
      { intro n,
        convert hn (n + 1), ext l,
        simp only [exists_prop, set.mem_Union, and.congr_left_iff],
        exact λ _, nat.lt_succ_iff.symm },
      have h₁ : s i = s A + ∑' l, s (s.aux i l),
      { rw [hA, ← s.measure_of_disjoint_Union, add_comm, measure_of_diff],
        exact measurable_set.Union (λ _, aux_measurable_set _),
        exacts [hi₁, set.Union_subset (λ _, aux_subset _), λ _,
                aux_measurable_set _, aux_disjoint] },
      have h₂ : s A ≤ s i,
      { rw h₁,
        apply le_add_of_nonneg_right,
        exact tsum_nonneg (λ n, le_of_lt (measure_of_aux h _ (hn n))) },
      have h₃' : summable (λ n, (1 / (bdd n + 1) : ℝ)),
      { have : summable (λ l, s (s.aux i l)),
          exact summable_measure_of (λ _, aux_measurable_set _) aux_disjoint,
        refine summable_of_nonneg_of_le_succ _ _ this,
        { intro _, exact le_of_lt nat.one_div_pos_of_nat },
        { intro n, exact le_of_lt (aux_lt n (hn' n)) } },
      have h₃ : tendsto (λ n, (bdd n : ℝ) + 1) at_top at_top,
      { simp only [one_div] at h₃',
        exact tendsto_top_of_pos_summable_inv h₃' (λ n, nat.cast_add_one_pos (bdd n)) },
      have h₄ : tendsto (λ n, (bdd n : ℝ)) at_top at_top,
      { convert at_top.tendsto_at_top_add_const_right (-1) h₃, simp },

      refine ⟨A, _, _, _, _⟩,
      { exact measurable_set.diff hi₁ (measurable_set.Union (λ _, aux_measurable_set _)) },
      { exact set.diff_subset _ _ },
      { by_contra hnn,
        rw negative at hnn, push_neg at hnn,
        obtain ⟨E, hE₁, hE₂, hE₃⟩ := hnn,
        have : ∃ k, 1 ≤ bdd k ∧ 1 / (bdd k : ℝ) < s E,
        { rw tendsto_at_top_at_top at h₄,
          obtain ⟨k, hk⟩ := h₄ (max (1 / s E + 1) 1),
          refine ⟨k, _, _⟩,
          { have hle := le_of_max_le_right (hk k le_rfl),
            norm_cast at hle,
            exact hle },
          { have : 1 / s E < bdd k, linarith [le_of_max_le_left (hk k le_rfl)],
            rw one_div at this ⊢,
            rwa inv_lt (lt_trans (inv_pos.2 hE₃) this) hE₃,
          } },
        obtain ⟨k, hk₁, hk₂⟩ := this,
        have hA' : A ⊆ i \ ⋃ l ≤ k, s.aux i l,
        { rw hA,
          apply set.diff_subset_diff_right,
          intro x, simp only [set.mem_Union],
          rintro ⟨n, _, hn₂⟩,
          exact ⟨n, hn₂⟩ },
        refine aux₀_min (hn' k) (nat.sub_one_lt hk₁) _,
        refine ⟨E, set.subset.trans hE₁ hA', hE₂, _⟩,
        convert hk₂, norm_cast,
        exact nat.sub_add_cancel hk₁ },
      { exact lt_of_le_of_lt h₂ hi₂ } },
    { exact exists_negative_set' hi₁ hi₂ hn } }
end .

end exists_negative_set

/-- The set of measurable negative sets. -/
def negatives (s : signed_measure α) : set (set α) :=
  { B | ∃ (hB₁ : measurable_set B), s.negative B }

/-- The set of measures of the set of measurable negative sets. -/
def measure_of_negatives (s : signed_measure α) : set ℝ :=
  s '' s.negatives

lemma zero_mem_measure_of_negatives : (0 : ℝ) ∈ s.measure_of_negatives :=
⟨∅, ⟨measurable_set.empty, empty_negative⟩, s.measure_of_empty⟩

lemma measure_of_negatives_bdd_below :
  ∃ x, ∀ y ∈ s.measure_of_negatives, x ≤ y :=
begin
  by_contra, push_neg at h,
  have h' : ∀ n : ℕ, ∃ y : ℝ, y ∈ s.measure_of_negatives ∧ y < -n := λ n, h (-n),
  choose f hf using h',
  have hf' : ∀ n : ℕ, ∃ B ∈ s.negatives, s B < -n,
  { intro n,
    rcases hf n with ⟨⟨B, hB₁, hB₂⟩, hlt⟩,
    exact ⟨B, hB₁, hB₂.symm ▸ hlt⟩ },
  choose B hB using hf',
  have hmeas : ∀ n, measurable_set (B n) := λ n, let ⟨h, _⟩ := (hB n).1 in h,
  set A := ⋃ n, B n with hA,
  refine not_forall_le_neg_nat (s A) (λ n, _),
  refine le_trans _ (le_of_lt (hB n).2),
  rw [hA, ← set.diff_union_of_subset (set.subset_Union _ n),
      measure_of_union (disjoint.comm.1 set.disjoint_diff) _ (hmeas n)],
  { refine add_le_of_nonpos_left _,
    have : s.negative A := negative_Union_negative hmeas (λ m, let ⟨_, h⟩ := (hB m).1 in h),
    refine negative_nonpos_measure _ (negative_subset_negative this (set.diff_subset _ _)),
    refine measurable_set.diff (measurable_set.Union hmeas) (hmeas n) },
  { exact measurable_set.diff (measurable_set.Union hmeas) (hmeas n) },
end

/-- The Hahn decomposition thoerem: Given the signed measure `s`, there exists
disjoint measurable sets `i`, `j` such that `i` is positive, `j` is negative
and `i ∪ j = set.univ`.  -/
theorem exists_disjoint_positive_negative_union_eq (s : signed_measure α) :
  ∃ (i j : set α) (hi₁ : measurable_set i) (hi₂ : s.positive i)
                  (hj₁ : measurable_set j) (hj₂ : s.negative j),
  disjoint i j ∧ i ∪ j = set.univ :=
begin
  obtain ⟨f, hf₁, hf₂⟩ := exists_tendsto_Inf
    ⟨0, @zero_mem_measure_of_negatives _ _ s⟩ measure_of_negatives_bdd_below,

  choose B hB using hf₁,
  have hB₁ : ∀ n, measurable_set (B n) := λ n, let ⟨h, _⟩ := (hB n).1 in h,
  have hB₂ : ∀ n, s.negative (B n) := λ n, let ⟨_, h⟩ := (hB n).1 in h,

  set A := ⋃ n, B n with hA,
  have hA₁ : measurable_set A := measurable_set.Union hB₁,
  have hA₂ : s.negative A := negative_Union_negative hB₁ hB₂,
  have hA₃ : s A = Inf s.measure_of_negatives,
  { apply has_le.le.antisymm,
    { refine le_of_tendsto_of_tendsto tendsto_const_nhds hf₂ (eventually_of_forall _),
      intro n,
      rw [← (hB n).2, hA, ← set.diff_union_of_subset (set.subset_Union _ n),
      measure_of_union (disjoint.comm.1 set.disjoint_diff) _ (hB₁ n)],
      { refine add_le_of_nonpos_left _,
        have : s.negative A := negative_Union_negative hB₁ (λ m, let ⟨_, h⟩ := (hB m).1 in h),
        refine negative_nonpos_measure _ (negative_subset_negative this (set.diff_subset _ _)),
        refine measurable_set.diff (measurable_set.Union hB₁) (hB₁ n) },
      { exact measurable_set.diff (measurable_set.Union hB₁) (hB₁ n) } },
    { exact real.Inf_le _ measure_of_negatives_bdd_below ⟨A, ⟨hA₁, hA₂⟩, rfl⟩ } },

  refine ⟨Aᶜ, A, measurable_set.compl hA₁, _, hA₁, hA₂,
          disjoint_compl_left, (set.union_comm A Aᶜ) ▸ set.union_compl_self A⟩,
  intros C hC hC₁,
  by_contra hC₂, push_neg at hC₂,
  rcases exists_negative_set hC₁ hC₂ with ⟨D, hD₁, hD, hD₂, hD₃⟩,

  have : s (A ∪ D) < Inf s.measure_of_negatives,
  { rw [← hA₃, measure_of_union (set.disjoint_of_subset_right (set.subset.trans hD hC)
        disjoint_compl_right) hA₁ hD₁],
    linarith },
  refine not_le.2 this _,
  refine real.Inf_le _ measure_of_negatives_bdd_below ⟨A ∪ D, ⟨_, _⟩, rfl⟩,
  { exact measurable_set.union hA₁ hD₁ },
  { exact negative_union_negative hA₁ hA₂ hD₁ hD₂ }
end

/-- Alternative formulation of `exists_disjoint_positive_negative_union_eq`. -/
lemma exists_compl_positive_negative (s : signed_measure α) :
  ∃ (i : set α) (hi₁ : measurable_set i), s.positive i ∧ s.negative iᶜ :=
begin
  obtain ⟨i, j, hi₁, hi₂, _, hj₂, hdisj, huniv⟩ :=
    s.exists_disjoint_positive_negative_union_eq,
  refine ⟨i, hi₁, hi₂, _⟩,
  rw [set.compl_eq_univ_diff, ← huniv,
      set.union_diff_cancel_left (set.disjoint_iff.mp hdisj)],
  exact hj₂,
end

/-- The symmetric difference of two Hahn decompositions is a null-set. -/
lemma of_symm_diff_compl_positive_negative {s : signed_measure α}
  {i j : set α} (hi : measurable_set i) (hj : measurable_set j)
  (hi' : s.positive i ∧ s.negative iᶜ) (hj' : s.positive j ∧ s.negative jᶜ) :
  s (i Δ j) = 0 ∧ s (iᶜ Δ jᶜ) = 0 :=
begin
  split,
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        set.sup_eq_union, measure_of_union,
        le_antisymm (hi'.2 _ (set.inter_subset_left _ _)
          (measurable_set.inter (measurable_set.compl hi) hj))
          (hj'.1 _ ( set.inter_subset_right _ _)
          (measurable_set.inter (measurable_set.compl hi) hj)),
        le_antisymm (hj'.2 _ (set.inter_subset_left _ _)
          (measurable_set.inter (measurable_set.compl hj) hi))
          (hi'.1 _ (set.inter_subset_right _ _)
          (measurable_set.inter (measurable_set.compl hj) hi)), add_zero],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _)
        (disjoint.comm.1 j.disjoint_compl)) },
    { exact measurable_set.inter (measurable_set.compl hj) hi },
    { exact measurable_set.inter (measurable_set.compl hi) hj } },
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        compl_compl, compl_compl, set.sup_eq_union, measure_of_union,
        le_antisymm (hi'.2 _ (set.inter_subset_right _ _)
          (measurable_set.inter hj (measurable_set.compl hi)))
          (hj'.1 _ (set.inter_subset_left _ _)
          (measurable_set.inter hj (measurable_set.compl hi))),
        le_antisymm (hj'.2 _ (set.inter_subset_right _ _)
          (measurable_set.inter hi (measurable_set.compl hj)))
          (hi'.1 _ (set.inter_subset_left _ _)
          (measurable_set.inter hi (measurable_set.compl hj))), add_zero],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _) j.disjoint_compl) },
    { exact measurable_set.inter hj hi.compl },
    { exact measurable_set.inter hi hj.compl } }
end

end signed_measure


import Lean.Elab
open Nat

structure ProvedSkip(n m: Nat) where
  result : Nat
  lt : m < n → result = m
  ge : n ≤ m → result = m + 1

def provedSkip (n m : Nat) : ProvedSkip n m :=
  if c : m < n then
    ⟨m, fun _ => rfl, fun hyp => False.elim (Nat.lt_irrefl m (Nat.lt_of_lt_of_le c hyp))⟩
  else
    ⟨m + 1, fun hyp => absurd hyp c, fun _ => rfl⟩

def skip: Nat → Nat → Nat :=
  fun n m => (provedSkip n m).result

theorem skip_below_eq(n m : Nat) : m < n → (skip n m = m) :=
  fun hyp => (provedSkip n m).lt hyp

theorem skip_above_eq(n m : Nat) : n ≤ m → (skip n m = m + 1) :=
  fun hyp => (provedSkip n m).ge hyp

theorem skip_not_below_eq(n m : Nat) : Not (m < n) → (skip n m = m + 1) :=
  fun hyp =>
    let lem : n ≤ m :=
      match Nat.lt_or_ge m n with
      | Or.inl lt => absurd lt hyp
      | Or.inr ge => ge
    skip_above_eq n m lem

theorem skip_lt: (k j: Nat) →  skip k j < j + 2 :=
    fun k j =>
      if c : j < k then
        let eqn := skip_below_eq k j c
        by
          rw [eqn]
          apply Nat.le_step
          apply Nat.le_refl
          done
      else
        let eqn := skip_not_below_eq k j c
        by
          rw [eqn]
          apply Nat.le_refl
          done

theorem skip_le_succ {n k j : Nat} : j < n → skip k j < n + 1 :=
   by
    intro hyp
    apply Nat.le_trans (skip_lt k j)
    apply Nat.succ_lt_succ
    exact hyp

def FinSeq (n: Nat) (α : Type) : Type := (k : Nat) → k < n → α

theorem witness_independent{α : Type}{n : Nat}(seq: FinSeq n α) :
    (i : Nat)→ (j : Nat) → (iw : i < n) → (jw : j < n) →
        (i = j) → seq i iw = seq j jw :=
        fun i j iw jw eqn =>
          match j, eqn, jw with
          | .(i), rfl, ijw =>
               rfl

namespace FinSeq
def init {α : Type}{n: Nat}(seq : FinSeq (n + 1) α): FinSeq n α :=
  fun k w =>
      seq k (Nat.le_step w)

def last{α : Type}{n: Nat}(seq : FinSeq (n + 1) α): α :=
  seq n (Nat.le_refl _)

def delete{α : Type}{n: Nat}(k : Nat) (kw : k < (n + 1)) (seq : FinSeq (n + 1) α): FinSeq n α :=
  fun j w =>
    seq (skip k j) (skip_le_succ w)

end FinSeq

inductive Vector (α : Type) : Nat → Type where
  | nil : Vector α zero
  | cons{n: Nat}(head: α) (tail: Vector  α n) : Vector α  (n + 1)

infixr:66 "+:" => Vector.cons

open Vector

def Vector.coords {α : Type}{n : Nat}(v: Vector α n) : FinSeq n α :=
  fun j jw =>
  match n, v, j, jw with
  | .(zero), nil, k, lt => nomatch lt
  | m + 1, cons head tail, zero, lt => head
  | m + 1, cons head tail, j + 1, w =>  tail.coords j (Nat.le_of_succ_le_succ w)

def seqVecAux {α: Type}{n m l: Nat}: (s : n + m = l) →
    (seq1 : FinSeq n α) → (accum : Vector α m) →
       Vector α l:=
    match n with
    | zero => fun s => fun _ => fun seq2 =>
      by
        have ss : l = m := by
          rw [← s]
          apply Nat.zero_add
          done
        have sf : Vector α l = Vector α m := by
          rw [ss]
        exact Eq.mpr sf seq2
        done
    | k + 1 => fun s seq1 seq2 =>
      let ss : k + (m + 1)  = l :=
        by
          rw [← s]
          rw [(Nat.add_comm m 1)]
          rw [(Nat.add_assoc k 1 m)]
          done
      seqVecAux ss (seq1.init) ((seq1.last) +: seq2)

def FinSeq.vec {α : Type}{n: Nat} : FinSeq n α  →  Vector α n :=
    fun seq => seqVecAux (Nat.add_zero n) seq Vector.nil

def Clause(n : Nat) : Type := Vector (Option Bool) n

def Valuation(n: Nat) : Type := Vector Bool n

inductive SatAnswer{dom n: Nat}(clauses : Vector (Clause n) dom) where
  | unsat : SatAnswer clauses
  | sat :  SatAnswer clauses

structure SimpleRestrictionClauses{dom n: Nat}
    (clauses: Vector (Clause (n + 1)) dom) where
  codom : Nat
  restClauses : Vector  (Clause n) codom

def prependRes{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
        (rd : SimpleRestrictionClauses clauses) →
           (head : Clause (n + 1)) →
        SimpleRestrictionClauses (head +: clauses) :=
        fun rd  head =>
          if c : head.coords focus focusLt = some branch then
            ⟨rd.codom, rd.restClauses⟩
          else
            ⟨rd.codom + 1, (FinSeq.vec (FinSeq.delete focus focusLt head.coords)) +: rd.restClauses⟩

def restClauses{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
        (clauses: Vector (Clause (n + 1)) dom) :
         SimpleRestrictionClauses clauses :=
            match dom, clauses with
            | 0, _ =>  ⟨0, Vector.nil⟩
            | m + 1, Vector.cons head clauses =>
                prependRes branch focus focusLt clauses
                            (restClauses branch focus focusLt clauses) head

def answerSAT{n dom : Nat}: (clauses : Vector (Clause n) dom) →  SatAnswer clauses :=
      match n with
      | zero =>
           match dom with
            | zero => fun cls => SatAnswer.sat
            | l + 1 => fun _ =>  SatAnswer.unsat
      | m + 1 =>
        fun clauses =>
        let cls := clauses
        let bd := zero_lt_succ m
        let rd  :=
            restClauses false zero bd clauses
        let subCls := rd.restClauses
        let subSol: SatAnswer subCls := answerSAT subCls
        match subSol with
        | SatAnswer.sat   =>
          SatAnswer.sat
        | SatAnswer.unsat  =>
            let rd := restClauses true zero bd cls -- replacing cls by clauses fixes this
            let subCls := rd.restClauses
            let subSol : SatAnswer subCls := answerSAT subCls
            match subSol with
            | SatAnswer.sat   =>
                SatAnswer.sat
            | SatAnswer.unsat   =>
                SatAnswer.unsat

open Lean.Meta
open Lean.Elab.Term

syntax (name:= nrmlform)"whnf!" term : term
@[term_elab nrmlform] def normalformImpl : TermElab :=
  fun stx expectedType? =>
  match stx with
  | `(whnf! $s) =>
      do
        let t ← elabTerm s none
        let e ← whnf t
        return e
  | _ => Lean.Elab.throwIllFormedSyntax

def cls1 : Clause 2 := -- ¬P
  (some false) +: (none) +: Vector.nil

def cls2 : Clause 2 := (some true) +: none +: Vector.nil  -- P

def egStatement := cls1 +: cls2 +: Vector.nil

def egAnswer : SatAnswer egStatement := answerSAT egStatement

def egAnswerNorm : SatAnswer egStatement := whnf! egAnswer


import topology.separation topology.subset_properties tactic.push_neg data.real.basic
import analysis.complex.exponential

open function set finset

local attribute [instance] classical.dec
noncomputable theory

def set_nat_to_seq (s : set ℕ) (n : ℕ) : ℝ := if n ∈ s then (3⁻¹)^n else 0
--#print cauchy_seq
lemma is_cau_seq_set_nat_to_seq (s : set ℕ) : is_cau_seq abs
  (λ n, (range n).sum (set_nat_to_seq s)) :=
is_cau_series_of_abv_le_cau 0 (λ m hm, show abs (set_nat_to_seq s m) ≤ ((3 : ℝ)⁻¹) ^ m,
    from if h : m ∈ s then by simp [set_nat_to_seq, h,
      abs_of_nonneg (pow_nonneg (inv_nonneg.2 (show (3 : ℝ) ≥ 0, by norm_num)) _)]
    else by rw [set_nat_to_seq, if_neg h, abs_zero];
      exact pow_nonneg (inv_nonneg.2 (by norm_num)) _)
  (is_cau_geo_series (3⁻¹ : ℝ) (by rw [abs_of_nonneg]; norm_num))

def set_nat_to_cau_seq (s : set ℕ) : cau_seq ℝ abs := ⟨_, is_cau_seq_set_nat_to_seq s⟩

lemma lim_set_nat_to_seq_injective_mul_three_pow_eq (s : set ℕ) : ∀ (n : ℕ),
  ⌊cau_seq.lim (set_nat_to_cau_seq s) * 3^n⌋ = (range n).sum (λ m, if m ∈ s then 3^(n-m) else 0)
| 0     := by simp
| (n+1) := _
#print set.Inter
#print compact_elim_finite_subcover_image
variables {α : Type*} [topological_space α]

lemma cantor_intersection (c : ℕ → set α) (hc : ∀ n, compact (c n))
  (hn : ∀ n, c n ≠ ∅) (hmono : ∀ m n, m ≤ n → c n ⊆ c m) : (⋂ n, c n) ≠ ∅ :=
λ h,
let U : Π n:ℕ, set α := λ n, c 0 \ c n in
-- have hU : ∀ n : ℕ, (⋃ (m : ℕ) (hm : n ≤ m), U m) = c 0 \ ⋂ (m : ℕ) (hm : n ≤ m), c m,
--   from λ n, by simp only [diff_Inter_left, U],
have ∀ x : α, ∃ n, x ∉ c n, by simpa [set.ext_iff, classical.not_forall] using h,
have (⋃ (n : ℕ) (h : n ∈ @univ ℕ), U n) = c 0, by simp [set.ext_iff, this],
have hc : compact (⋂ n, c n), from sorry,
have hU : ∀ n, n ∈ @univ ℕ → is_open (U n), from λ _ _, is_open_diff _ _,
let ⟨s, hs⟩ := compact_elim_finite_subcover_image hc
  _ _ in
begin

end

local attribute [instance] classical.dec
--#print not_mem_closure

lemma exists_subset_not_mem_closure [t2_space α] (h : ∀ x : α, ¬ is_open ({x} : set α)) :
  ∀ x : α, ∀ U : set α, is_open U → U ≠ ∅ → ∃ V ⊆ U, x ∉ closure V ∧ V ≠ ∅ :=
λ x U hU hUn,
have hUxn : U \ {x} ≠ ∅, from mt diff_eq_empty.1 $
  λ hUx, if hxU : x ∈ U
    then h x $ by convert hU; exact set.subset.antisymm (by simpa) hUx
    else hUn $ eq_empty_iff_forall_not_mem.2
      (λ y hy, hxU $ by convert hy; simpa [eq_comm] using hUx hy),
let ⟨y, hy⟩ := set.exists_mem_of_ne_empty hUxn in
let ⟨W₁, W₂, hW₁o, hW₂o, hxW, hyW, hW⟩ := t2_space.t2 x y (by finish) in
⟨W₂ ∩ U, inter_subset_right _ _, begin
  rw mem_closure_iff,
  push_neg,
  exact ⟨W₁, hW₁o, hxW, by rw [← inter_assoc, hW, empty_inter]⟩,
end, set.ne_empty_of_mem ⟨hyW, hy.1⟩⟩

def uncountable_space_aux [t2_space α] [nonempty α] (h : ∀ x : α, ¬ is_open ({x} : set α)) (f : ℕ → α) :
  Π n : ℕ,  {s : set α // is_closed s ∧ f n ∉ s ∧ s ≠ ∅}
| 0     := have h : _ := exists_subset_not_mem_closure h (f 0)
    univ is_open_univ (by simp),
  ⟨closure (classical.some h), is_closed_closure, (classical.some_spec h).snd.1,
    λ hV, (classical.some_spec h).snd.2 (eq_empty_of_subset_empty $
      by convert subset_closure; exact hV.symm)⟩
| (n+1) := have h : _ := exists_subset_not_mem_closure h (f (n+1))
    (-uncountable_space_aux n) (is_open_compl_iff.2
    (uncountable_space_aux n).2.1)
    (set.ne_empty_of_mem (uncountable_space_aux n).2.2.1),
  ⟨closure (classical.some h), is_closed_closure, (classical.some_spec h).snd.1,
    λ hV, (classical.some_spec h).snd.2 (eq_empty_of_subset_empty $
      by convert subset_closure; exact hV.symm)⟩

lemma uncountable [compact_space α] [t2_space α]
  [n : nonempty α] (h : ∀ x : α, ¬ is_open ({x} : set α)) (f : ℕ → α) : ¬surjective f :=
let ⟨x⟩ := n in
λ h, let ⟨y, hy⟩ := _ in


import inner_product_spaces.complex_ip.ip_normed_space
import linear_algebra.basis

noncomputable theory

variables {α : Type*}

open complex set module submodule

variables [decidable_eq α] [add_comm_group α] [vector_space ℂ α] [ℂ_inner_product_space α]

def orthog_set (L : set α) : Prop :=
∀ (a b ∈ L), a ≠ b → a ⊥ b

lemma emptyset_orthog : orthog_set (∅ : set α) :=
begin
    dsimp [orthog_set],
    simp,
end

lemma add_elt_to_orthog (L : set α) (x : α) (h : orthog_set L) (w : ∀ (y ∈ L), x ⊥ y) : orthog_set (L ∪ {x}) :=
begin
    dsimp [orthog_set] at *,
    intros a b k₁ k₂ k₃,
    cases k₁,
    cases k₂,

    exact h a b k₁ k₂ k₃,

    have k₄ := w a k₁,
    apply orthog_symm,
    have k₅ := eq_of_mem_singleton k₂,
    rw [k₅],
    exact k₄,

    cases k₂,

    have k₄ := eq_of_mem_singleton k₁,
    have k₅ := w b k₂,
    rw [←k₄] at k₅,
    exact k₅,

    have k₄ := eq_of_mem_singleton k₁,
    have k₅ := (eq_of_mem_singleton k₂).symm,
    rw [←k₄] at k₅,
    contradiction,
end

lemma orthog_subset (L S : set α) (h : orthog_set L) (w : S ⊆ L) : orthog_set S :=
begin
    dsimp [orthog_set] at *,
    dsimp [(⊆), set.subset] at w,
    intros a b k₁ k₂ k₃,
    exact (h a b (w k₁) (w k₂) k₃),
end

def orthonormal (L : set α) : Prop :=
orthog_set L ∧ ∀ (a ∈ L), ∥a∥=1

def normalise (L : set α) := image (λ (a : α), (1/∥a∥ : ℂ) • a) L

lemma elem_of_normalised (L : set α) (x : α) : x ∈ normalise L → ∃ (y ∈ L) (a : ℂ), a • y = x :=
begin
    intros h,
    dsimp [normalise, image] at h,
    cases h with y h,
    cases h,
    use y,
    use h_left,
    use (1 / ∥y∥),
    exact h_right,
end

lemma elem_of_normalised' (L : set α) (x : α) : (x ∈ L) → (((1 / ∥x∥ : ℂ) • x) ∈ normalise L) :=
begin
    intros h,
    dsimp [normalise, image],
    use x,
    split,

    exact h,
    refl,
end

lemma norm_one_of_normalised (L : set α) (h : (0 : α) ∉ L) : ∀ (a ∈ (normalise L)), ∥a∥=1 :=
begin
    intros a w,
    dsimp [normalise] at w,
    simp at w,
    cases w with b k₁,
    cases k₁ with k₁ k₂,
    have k₃ : b ≠ 0, begin
        by_contradiction,
        simp only [not_not] at a_1,
        rw [a_1] at k₁,
        contradiction,
    end,
    rw [←k₂, ip_norm_smul],
    simp,
    exact (inv_mul_cancel ((norm_neq_zero_iff_neq_zero b).2 k₃)),
end

lemma zero_not_elem_of_normalised (L : set α) : (0 : α) ∉ L → (0 : α) ∉ normalise L :=
begin
    intros h,
    by_contradiction,

    have w := norm_one_of_normalised L h 0 a,
    simp at w,
    exact w,
end

lemma orthog_normalised_of_orthog (L : set α) (h : orthog_set L) : orthog_set (normalise L) :=
begin
    dsimp [orthog_set] at *,
    dsimp [normalise],
    simp,
    intros a b x k₁ k₂ y k₃ k₄ k₅,
    have k₆ : x ≠ y, begin
        by_contradiction,
        simp only [not_not] at a_1,
        rw [a_1] at k₂,
        rw [k₂] at k₄,
        contradiction,
    end,
    have k₇ := h x y k₁ k₃ k₆,
    have k₈ := mul_orthog x y (↑∥x∥)⁻¹ (↑∥y∥)⁻¹ k₇,
    rw [k₂, k₄] at k₈,
    exact k₈,
end

lemma orthonormal_normalised_of_orthog_set (L : set α) (h : orthog_set L) (w : (0 : α) ∉ L) : orthonormal (normalise L) :=
⟨orthog_normalised_of_orthog L h, norm_one_of_normalised L w⟩

lemma orthog_set_is_lin_indep (L : set α) (h : orthog_set L) (w : (0 : α) ∉ L) : linear_independent ℂ L :=
begin
    rw [linear_independent_iff],
    intros l k₁ k₂,
    dsimp [lc.total, finsupp.sum] at k₂,
    sorry,
end

lemma scale_elem_in_span (L : set α) (x : α) (a : ℂ) : x ∈ span ℂ L → (a • x) ∈ span ℂ L :=
begin
    intros h,
    rw [mem_span] at *,
    intros p k,
    have w := h p k,
    have l := smul p a w,
    exact l,
end

lemma normalised_subset_span (L : set α) : normalise L ⊆ ↑(span ℂ L) :=
begin
    have w : ∀ (x : α), (x ∈ normalise L) → x ∈ ↑(span ℂ L) := begin
        intros x a,
        have w₁ := elem_of_normalised L x a,
        cases w₁ with y w₁,
        cases w₁ with w₁ w₂,
        cases w₂ with a w₂,
        have w₃ := @subset_span ℂ _ _ _ _ _,
        have w₄ := w₃ w₁,
        have w₅ := scale_elem_in_span L y a w₄,
        rw [w₂] at w₅,
        exact w₅,
    end,
    exact w,
end

lemma in_submodule_of_normalised_in_submodule (L : set α) (p : submodule ℂ α) : (normalise L ⊆ ↑p) → L ⊆ ↑p :=
begin
    intros k,
    have w : ∀ (x : α), x ∈ L → x ∈ ↑p := begin
        intros x l,
        by_cases (x = 0),

        rw [mem_coe p, h],
        exact zero_mem p,

        have w₁ := elem_of_normalised' L x l,
        have w₂ := k w₁,
        rw [mem_coe] at w₂,
        have w₃ := smul p ↑∥x∥ w₂,
        simp [smul_smul] at w₃,
        have w₄ := of_real_ne_zero.2 ((norm_neq_zero_iff_neq_zero x).2 h),
        have w₅ := div_self w₄,
        have w₆ : ↑∥x∥/↑∥x∥ = ↑∥x∥*(↑∥x∥)⁻¹ := begin
            rw [←mul_one ↑∥x∥, mul_div_assoc ↑∥x∥ (1 : ℂ), one_div_eq_inv],
            simp,
            recover,
            repeat {apply_instance},
        end,
        rw [←w₆, w₅, one_smul] at w₃,
        rw [mem_coe],
        exact w₃,
    end,
    exact w,
end

lemma span_of_normalised_is_span (L : set α) : span ℂ (normalise L) = span ℂ L :=
begin
    ext,
    rw [mem_span],
    split,

    intros h,
    exact (h (span ℂ L)) (normalised_subset_span L),

    intros h p w,
    have h' := mem_span.1 h,
    have h₁ := h' p,
    clear h',
    exact h₁ (in_submodule_of_normalised_in_submodule L p w),
end

def orthonormal_basis (L : set α) := orthonormal L ∧ is_basis ℂ L

theorem normalised_basis_is_orthonormal_basis (L : set α) : is_basis ℂ L → orthog_set L → orthonormal_basis (normalise L) :=
begin
    intros h k,
    dsimp [orthonormal_basis, is_basis] at *,
    cases h,
    have w := zero_not_mem_of_linear_independent (@zero_ne_one ℂ _) h_left,
    split,

    dsimp [orthonormal],
    split,
    exact orthog_normalised_of_orthog L k,

    exact norm_one_of_normalised L w,

    split,

    have h₁ := orthog_normalised_of_orthog L k,
    have h₂ := zero_not_elem_of_normalised L w,
    exact orthog_set_is_lin_indep _ h₁ h₂,

    rw [←span_of_normalised_is_span L] at h_right,
    exact h_right,
end

section perp_space

def perp (L : set α) : set α := {x | ∀ (y ∈ L), x ⊥ y}

lemma perp_perp (L : set α) : L ⊆ perp (perp L) :=
begin
    have w : ∀ (x : α), x ∈ L → x ∈ perp (perp L) := begin
        intros x h,
        dsimp [perp],
        intros y k,
        have k₁ := orthog_symm y x (k x h),
        exact k₁,
    end,
    exact w,
end

lemma perp_antitone (S : set α) (L : set α) : S ⊆ L → perp L ⊆ perp S :=
begin
    intros h,
    have w : ∀ (x : α), x ∈ perp L → x ∈ perp S := begin
        intros x w,
        dsimp [perp] at *,
        intros y k,
        exact w y (h k),
    end,
    exact w,
end

variables {S : set α}
variables [add_comm_group S] [vector_space ℂ S] [subspace ℂ S]

set_option trace.class_instances true
lemma perp_closed : ∀ (x y : α), (x ∈ perp S) → (y ∈ perp S) → ((x+y) ∈ perp S) :=
begin
    -- intros x y h₁ h₂,
    -- dsimp [perp] at *,
    -- intros z k,
    -- have w₁ := h₁ z k,
    -- have w₂ := h₂ z k,
    -- dsimp [orthog] at *,
    -- rw [add_in_fst_coord, h₁, h₂],
    sorry,
end

instance perp_has_add : has_add (perp S) := ⟨λ x y : α, @has_add.add α sorry x y⟩

lemma perp_add_assoc (x y z : perp S) : (x + y) + z = x + (y + z) :=
begin
    sorry,
end

instance perp_space_is_add_comm_group : add_comm_group (perp S) :=
begin
    refine {add := sorry, add_assoc := perp_add_assoc, zero := (0 : α)}
end

instance perp_space_is_vector_space : vector_space ℂ (perp S) :=
begin
    sorry,
end

end perp_space