/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.measure.vector_measure
import order.symm_diff

/-!
# Hahn decomposition

This file proves the Hahn decomposition theorem (signed version). The Hahn decomposition theorem
states that, given a signed measure `s`, there exist complementary, measurable sets `i` and `j`,
such that `i` is positive and `j` is negative with respect to `s`; that is, `s` restricted on `i`
is non-negative and `s` restricted on `j` is non-positive.

The Hahn decomposition theorem leads to many other results in measure theory, most notably,
the Jordan decomposition theorem, the Lebesgue decomposition theorem and the Radon-Nikodym theorem.

## Main results

* `measure_theory.signed_measure.exists_is_compl_positive_negative` : the Hahn decomposition
  theorem.
* `measure_theory.signed_measure.exists_subset_restrict_nonpos` : A measurable set of negative
  measure contains a negative subset.

## Notation

We use the notations `0 ≤[i] s` and `s ≤[i] 0` to denote the usual definitions of a set `i`
being positive/negative with respect to the signed measure `s`.

## Tags

Hahn decomposition theorem
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal measure_theory

variables {α β : Type*} [measurable_space α]
variables {M : Type*} [add_comm_monoid M] [topological_space M] [ordered_add_comm_monoid M]

namespace measure_theory

namespace signed_measure

open filter vector_measure

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

section exists_subset_restrict_nonpos

/-! ### exists_subset_restrict_nonpos

In this section we will prove that a set `i` whose measure is negative contains a negative subset
`j` with respect to the signed measure `s` (i.e. `s ≤[j] 0`), whose measure is negative. This lemma
is used to prove the Hahn decomposition theorem.

To prove this lemma, we will construct a sequence of measurable sets $(A_n)_{n \in \mathbb{N}}$,
such that, for all $n$, $s(A_{n + 1})$ is close to maximal among subsets of
$i \setminus \bigcup_{k \le n} A_k$.

This sequence of sets does not necessarily exist. However, if this sequence terminates; that is,
there does not exists any sets satisfying the property, the last $A_n$ will be a negative subset
of negative measure, hence proving our claim.

In the case that the sequence does not terminate, it is easy to see that
$i \setminus \bigcup_{k = 0}^\infty A_k$ is the required negative set.

To implement this in Lean, we define several auxilary definitions.

- given the sets `i` and the natural number `n`, `exists_one_div_lt s i n` is the property that
  there exists a measurable set `k ⊆ i` such that `1 / (n + 1) < s k`.
- given the sets `i` and that `i` is not negative, `find_exists_one_div_lt s i` is the
  least natural number `n` such that `exists_one_div_lt s i n`.
- given the sets `i` and that `i` is not negative, `some_exists_one_div_lt` chooses the set
  `k` from `exists_one_div_lt s i (find_exists_one_div_lt s i)`.
- lastly, given the set `i`, `restrict_nonpos_seq s i` is the sequence of sets defined inductively
  where
  `restrict_nonpos_seq s i 0 = some_exists_one_div_lt s (i \ ∅)` and
  `restrict_nonpos_seq s i (n + 1) = some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq k)`.
  This definition represents the sequence $(A_n)$ in the proof as described above.

With these definitions, we are able consider the case where the sequence terminates separately,
allowing us to prove `exists_subset_restrict_nonpos`.
-/

/-- Given the set `i` and the natural number `n`, `exists_one_div_lt s i j` is the property that
there exists a measurable set `k ⊆ i` such that `1 / (n + 1) < s k`. -/
private def exists_one_div_lt (s : signed_measure α) (i : set α) (n : ℕ) : Prop :=
∃ k : set α, k ⊆ i ∧ measurable_set k ∧ (1 / (n + 1) : ℝ) < s k

private lemma exists_nat_one_div_lt_measure_of_not_negative (hi : ¬ s ≤[i] 0) :
  ∃ (n : ℕ), exists_one_div_lt s i n :=
let ⟨k, hj₁, hj₂, hj⟩ := exists_pos_measure_of_not_restrict_le_zero s hi in
let ⟨n, hn⟩ := exists_nat_one_div_lt hj in ⟨n, k, hj₂, hj₁, hn⟩

/-- Given the set `i`, if `i` is not negative, `find_exists_one_div_lt s i` is the
least natural number `n` such that `exists_one_div_lt s i n`, otherwise, it returns 0. -/
private def find_exists_one_div_lt (s : signed_measure α) (i : set α) : ℕ :=
if hi : ¬ s ≤[i] 0 then nat.find (exists_nat_one_div_lt_measure_of_not_negative hi) else 0

private lemma find_exists_one_div_lt_spec (hi : ¬ s ≤[i] 0) :
  exists_one_div_lt s i (find_exists_one_div_lt s i) :=
begin
  rw [find_exists_one_div_lt, dif_pos hi],
  convert nat.find_spec _,
end

private lemma find_exists_one_div_lt_min (hi : ¬ s ≤[i] 0) {m : ℕ}
  (hm : m < find_exists_one_div_lt s i) : ¬ exists_one_div_lt s i m :=
begin
  rw [find_exists_one_div_lt, dif_pos hi] at hm,
  exact nat.find_min _ hm
end

/-- Given the set `i`, if `i` is not negative, `some_exists_one_div_lt` chooses the set
`k` from `exists_one_div_lt s i (find_exists_one_div_lt s i)`, otherwise, it returns the
empty set. -/
private def some_exists_one_div_lt (s : signed_measure α) (i : set α) : set α :=
if hi : ¬ s ≤[i] 0 then classical.some (find_exists_one_div_lt_spec hi) else ∅

private lemma some_exists_one_div_lt_spec (hi : ¬ s ≤[i] 0) :
  (some_exists_one_div_lt s i) ⊆ i ∧ measurable_set (some_exists_one_div_lt s i) ∧
  (1 / (find_exists_one_div_lt s i + 1) : ℝ) < s (some_exists_one_div_lt s i) :=
begin
  rw [some_exists_one_div_lt, dif_pos hi],
  exact classical.some_spec (find_exists_one_div_lt_spec hi),
end

private lemma some_exists_one_div_lt_subset : some_exists_one_div_lt s i ⊆ i :=
begin
  by_cases hi : ¬ s ≤[i] 0,
  { exact let ⟨h, _⟩ := some_exists_one_div_lt_spec hi in h },
  { rw [some_exists_one_div_lt, dif_neg hi],
    exact set.empty_subset _ },
end

private lemma some_exists_one_div_lt_subset' : some_exists_one_div_lt s (i \ j) ⊆ i :=
set.subset.trans some_exists_one_div_lt_subset (set.diff_subset _ _)

private

private lemma some_exists_one_div_lt_lt (hi : ¬ s ≤[i] 0) :
  (1 / (find_exists_one_div_lt s i + 1) : ℝ) < s (some_exists_one_div_lt s i) :=
let ⟨_, _, h⟩ := some_exists_one_div_lt_spec hi in h

/-- Given the set `i`, `restrict_nonpos_seq s i` is the sequence of sets defined inductively where
`restrict_nonpos_seq s i 0 = some_exists_one_div_lt s (i \ ∅)` and
`restrict_nonpos_seq s i (n + 1) = some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq k)`.

For each `n : ℕ`,`s (restrict_nonpos_seq s i n)` is close to maximal among all subsets of
`i \ ⋃ k ≤ n, restrict_nonpos_seq s i k`. -/
private def restrict_nonpos_seq (s : signed_measure α) (i : set α) : ℕ → set α
| 0 := some_exists_one_div_lt s (i \ ∅) -- I used `i \ ∅` instead of `i` to simplify some proofs
| (n + 1) := some_exists_one_div_lt s (i \ ⋃ k ≤ n,
  have k < n + 1 := nat.lt_succ_iff.mpr H,
  restrict_nonpos_seq k)

private lemma restrict_nonpos_seq_succ (n : ℕ) :
  restrict_nonpos_seq s i n.succ =
  some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) :=
by rw restrict_nonpos_seq

private lemma restrict_nonpos_seq_subset (n : ℕ) :
  restrict_nonpos_seq s i n ⊆ i :=
begin
  cases n;
  { rw restrict_nonpos_seq, exact some_exists_one_div_lt_subset' }
end

private lemma restrict_nonpos_seq_lt
  (n : ℕ) (hn : ¬ s ≤[i \ ⋃ k ≤ n, restrict_nonpos_seq s i k] 0) :
  (1 / (find_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) + 1) : ℝ)
  < s (restrict_nonpos_seq s i n.succ) :=
begin
  rw restrict_nonpos_seq_succ,
  apply some_exists_one_div_lt_lt hn,
end

private lemma measure_of_restrict_nonpos_seq (hi₂ : ¬ s ≤[i] 0)
  (n : ℕ) (hn : ¬ s ≤[i \ ⋃ k < n, restrict_nonpos_seq s i k] 0) :
  0 < s (restrict_nonpos_seq s i n) :=
begin
  cases n,
  { rw restrict_nonpos_seq, rw ← @set.diff_empty _ i at hi₂,
    rcases some_exists_one_div_lt_spec hi₂ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) },
  { rw restrict_nonpos_seq_succ,
    have h₁ : ¬ s ≤[i \ ⋃ (k : ℕ) (H : k ≤ n), restrict_nonpos_seq s i k] 0,
    { refine mt (restrict_le_zero_subset _ _ (by simp [nat.lt_succ_iff])) hn,
      convert measurable_of_not_restrict_le_zero _ hn,
      exact funext (λ x, by rw nat.lt_succ_iff) },
    rcases some_exists_one_div_lt_spec h₁ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) }
end

private lemma restrict_nonpos_seq_measurable_set (n : ℕ) :
  measurable_set (restrict_nonpos_seq s i n) :=
begin
  cases n;
  { rw restrict_nonpos_seq,
    exact some_exists_one_div_lt_measurable_set },
end

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

private lemma restrict_nonpos_seq_disjoint : pairwise (disjoint on (restrict_nonpos_seq s i)) :=
begin
  intros n m h,
  rw [function.on_fun, set.disjoint_iff_inter_eq_empty],
  rcases lt_or_gt_of_ne h with (h | h),
  { rw [restrict_nonpos_seq_disjoint' h] },
  { rw [set.inter_comm, restrict_nonpos_seq_disjoint' h] }
end

private lemma exists_subset_restrict_nonpos' (hi₁ : measurable_set i) (hi₂ : s i < 0)
  (hn : ¬ ∀ n : ℕ, ¬ s ≤[i \ ⋃ l < n, restrict_nonpos_seq s i l] 0) :
  ∃ j : set α, measurable_set j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
begin
  by_cases s ≤[i] 0, { exact ⟨i, hi₁, set.subset.refl _, h, hi₂⟩ },
  push_neg at hn,
  set k := nat.find hn with hk₁,
  have hk₂ : s ≤[i \ ⋃ l < k, restrict_nonpos_seq s i l] 0 := nat.find_spec hn,
  have hmeas : measurable_set (⋃ (l : ℕ) (H : l < k), restrict_nonpos_seq s i l) :=
    (measurable_set.Union $ λ _, measurable_set.Union
      (λ _, restrict_nonpos_seq_measurable_set _)),
  refine ⟨i \ ⋃ l < k, restrict_nonpos_seq s i l, hi₁.diff hmeas, set.diff_subset _ _, hk₂, _⟩,
  rw [of_diff hmeas hi₁, s.of_disjoint_Union_nat],
  { have h₁ : ∀ l < k, 0 ≤ s (restrict_nonpos_seq s i l),
    { intros l hl,
      refine le_of_lt (measure_of_restrict_nonpos_seq h _ _),
      refine mt (restrict_le_zero_subset _ (hi₁.diff _) (set.subset.refl _)) (nat.find_min hn hl),
      exact (measurable_set.Union $ λ _, measurable_set.Union
        (λ _, restrict_nonpos_seq_measurable_set _)) },
    suffices : 0 ≤ ∑' (l : ℕ), s (⋃ (H : l < k), restrict_nonpos_seq s i l),
    { rw sub_neg,
      exact lt_of_lt_of_le hi₂ this },
    refine tsum_nonneg _,
    intro l, by_cases l < k,
    { convert h₁ _ h,
      ext x,
      rw [set.mem_Union, exists_prop, and_iff_right_iff_imp],
      exact λ _, h },
    { convert le_of_eq s.empty.symm,
      ext, simp only [exists_prop, set.mem_empty_iff_false, set.mem_Union, not_and, iff_false],
      exact λ h', false.elim (h h') } },
  { intro, exact measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _) },
  { intros a b hab,
    refine set.disjoint_Union_left.mpr (λ ha, _),
    refine set.disjoint_Union_right.mpr (λ hb, _),
    exact restrict_nonpos_seq_disjoint hab },
  { apply set.Union_subset,
    intros a x,
    simp only [and_imp, exists_prop, set.mem_Union],
    intros _ hx,
    exact restrict_nonpos_seq_subset _ hx },
  { apply_instance }
end

/-- A measurable set of negative measure has a negative subset of negative measure. -/
theorem exists_subset_restrict_nonpos (hi : s i < 0) :
  ∃ j : set α, measurable_set j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
begin
  have hi₁ : measurable_set i :=
    classical.by_contradiction (λ h, ne_of_lt hi $ s.not_measurable h),
  by_cases s ≤[i] 0, { exact ⟨i, hi₁, set.subset.refl _, h, hi⟩ },
  by_cases hn : ∀ n : ℕ, ¬ s ≤[i \ ⋃ l < n, restrict_nonpos_seq s i l] 0,
  swap, { exact exists_subset_restrict_nonpos' hi₁ hi hn },
  set A := i \ ⋃ l, restrict_nonpos_seq s i l with hA,
  set bdd : ℕ → ℕ := λ n,
    find_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) with hbdd,
  have hn' : ∀ n : ℕ, ¬ s ≤[i \ ⋃ l ≤ n, restrict_nonpos_seq s i l] 0,
  { 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 (restrict_nonpos_seq s i l),
  { rw [hA, ← s.of_disjoint_Union_nat, add_comm, of_add_of_diff],
    exact measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _),
    exacts [hi₁, set.Union_subset (λ _, restrict_nonpos_seq_subset _), λ _,
            restrict_nonpos_seq_measurable_set _, restrict_nonpos_seq_disjoint] },
  have h₂ : s A ≤ s i,
  { rw h₁,
    apply le_add_of_nonneg_right,
    exact tsum_nonneg (λ n, le_of_lt (measure_of_restrict_nonpos_seq h _ (hn n))) },
  have h₃' : summable (λ n, (1 / (bdd n + 1) : ℝ)),
  { have : summable (λ l, s (restrict_nonpos_seq s i l)) :=
      has_sum.summable (s.m_Union (λ _, restrict_nonpos_seq_measurable_set _)
        restrict_nonpos_seq_disjoint),
    refine summable_of_nonneg_of_le (λ n, _) (λ n, _)
      (summable.comp_injective this nat.succ_injective),
    { exact le_of_lt nat.one_div_pos_of_nat },
    { exact le_of_lt (restrict_nonpos_seq_lt n (hn' n)) } },
  have h₃ : tendsto (λ n, (bdd n : ℝ) + 1) at_top at_top,
  { simp only [one_div] at h₃',
    exact summable.tendsto_top_of_pos 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 },
  have A_meas : measurable_set A :=
    hi₁.diff (measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _)),
  refine ⟨A, A_meas, set.diff_subset _ _, _, h₂.trans_lt hi⟩,
  by_contra hnn,
  rw restrict_le_restrict_iff _ _ A_meas 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)] {restrict_type := ℝ} },
      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, restrict_nonpos_seq s i l,
  { apply set.diff_subset_diff_right,
    intro x, simp only [set.mem_Union],
    rintro ⟨n, _, hn₂⟩,
    exact ⟨n, hn₂⟩ },
  refine find_exists_one_div_lt_min (hn' k)
    (buffer.lt_aux_2 hk₁) ⟨E, set.subset.trans hE₂ hA', hE₁, _⟩,
  convert hk₂, norm_cast,
  exact tsub_add_cancel_of_le hk₁
end

end exists_subset_restrict_nonpos

/-- The set of measures of the set of measurable negative sets. -/
def measure_of_negatives (s : signed_measure α) : set ℝ :=
s '' { B | measurable_set B ∧ s ≤[B] 0 }

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

lemma bdd_below_measure_of_negatives :
  bdd_below s.measure_of_negatives :=
begin
  simp_rw [bdd_below, set.nonempty, mem_lower_bounds],
  by_contra' h,
  have h' : ∀ n : ℕ, ∃ y : ℝ, y ∈ s.measure_of_negatives ∧ y < -n := λ n, h (-n),
  choose f hf using h',
  have hf' : ∀ n : ℕ, ∃ B, measurable_set B ∧ s ≤[B] 0 ∧ s B < -n,
  { intro n,
    rcases hf n with ⟨⟨B, ⟨hB₁, hBr⟩, hB₂⟩, hlt⟩,
    exact ⟨B, hB₁, hBr, hB₂.symm ▸ hlt⟩ },
  choose B hmeas hr h_lt using hf',
  set A := ⋃ n, B n with hA,
  have hfalse : ∀ n : ℕ, s A ≤ -n,
  { intro n,
    refine le_trans _ (le_of_lt (h_lt _)),
    rw [hA, ← set.diff_union_of_subset (set.subset_Union _ n),
        of_union set.disjoint_sdiff_left _ (hmeas n)],
    { refine add_le_of_nonpos_left _,
      have : s ≤[A] 0 := restrict_le_restrict_Union _ _ hmeas hr,
      refine nonpos_of_restrict_le_zero _ (restrict_le_zero_subset _ _ (set.diff_subset _ _) this),
      exact measurable_set.Union hmeas },
    { apply_instance },
    { exact (measurable_set.Union hmeas).diff (hmeas n) } },
  rcases exists_nat_gt (-(s A)) with ⟨n, hn⟩,
  exact lt_irrefl _ ((neg_lt.1 hn).trans_le (hfalse n)),
end

/-- Alternative formulation of `measure_theory.signed_measure.exists_is_compl_positive_negative`
(the Hahn decomposition theorem) using set complements. -/
lemma exists_compl_positive_negative (s : signed_measure α) :
  ∃ i : set α, measurable_set i ∧ 0 ≤[i] s ∧ s ≤[iᶜ] 0 :=
begin
  obtain ⟨f, _, hf₂, hf₁⟩ := exists_seq_tendsto_Inf
    ⟨0, @zero_mem_measure_of_negatives _ _ s⟩ bdd_below_measure_of_negatives,
  choose B hB using hf₁,
  have hB₁ : ∀ n, measurable_set (B n) := λ n, (hB n).1.1,
  have hB₂ : ∀ n, s ≤[B n] 0 := λ n, (hB n).1.2,
  set A := ⋃ n, B n with hA,
  have hA₁ : measurable_set A := measurable_set.Union hB₁,
  have hA₂ : s ≤[A] 0 := restrict_le_restrict_Union _ _ hB₁ hB₂,
  have hA₃ : s A = Inf s.measure_of_negatives,
  { apply le_antisymm,
    { refine le_of_tendsto_of_tendsto tendsto_const_nhds hf₂ (eventually_of_forall (λ n, _)),
      rw [← (hB n).2, hA, ← set.diff_union_of_subset (set.subset_Union _ n),
          of_union set.disjoint_sdiff_left _ (hB₁ n)],
      { refine add_le_of_nonpos_left _,
        have : s ≤[A] 0 :=
          restrict_le_restrict_Union _ _ hB₁ (λ m, let ⟨_, h⟩ := (hB m).1 in h),
        refine nonpos_of_restrict_le_zero _
          (restrict_le_zero_subset _ _ (set.diff_subset _ _) this),
        exact measurable_set.Union hB₁ },
      { apply_instance },
      { exact (measurable_set.Union hB₁).diff (hB₁ n) } },
    { exact cInf_le bdd_below_measure_of_negatives ⟨A, ⟨hA₁, hA₂⟩, rfl⟩ } },
  refine ⟨Aᶜ, hA₁.compl, _, (compl_compl A).symm ▸ hA₂⟩,
  rw restrict_le_restrict_iff _ _ hA₁.compl,
  intros C hC hC₁,
  by_contra' hC₂,
  rcases exists_subset_restrict_nonpos hC₂ with ⟨D, hD₁, hD, hD₂, hD₃⟩,
  have : s (A ∪ D) < Inf s.measure_of_negatives,
  { rw [← hA₃, of_union (set.disjoint_of_subset_right (set.subset.trans hD hC₁)
        disjoint_compl_right) hA₁ hD₁],
    linarith, apply_instance },
  refine not_le.2 this _,
  refine cInf_le bdd_below_measure_of_negatives ⟨A ∪ D, ⟨_, _⟩, rfl⟩,
  { exact hA₁.union hD₁ },
  { exact restrict_le_restrict_union _ _ hA₁ hA₂ hD₁ hD₂ },
end

/-- **The Hahn decomposition thoerem**: Given a signed measure `s`, there exist
complement measurable sets `i` and `j` such that `i` is positive, `j` is negative. -/
theorem exists_is_compl_positive_negative (s : signed_measure α) :
  ∃ i j : set α, measurable_set i ∧ 0 ≤[i] s ∧ measurable_set j ∧ s ≤[j] 0 ∧ is_compl i j :=
let ⟨i, hi₁, hi₂, hi₃⟩ := exists_compl_positive_negative s in
  ⟨i, iᶜ, hi₁, hi₂, hi₁.compl, hi₃, is_compl_compl⟩

/-- The symmetric difference of two Hahn decompositions has measure zero. -/
lemma of_symm_diff_compl_positive_negative {s : signed_measure α}
  {i j : set α} (hi : measurable_set i) (hj : measurable_set j)
  (hi' : 0 ≤[i] s ∧ s ≤[iᶜ] 0) (hj' : 0 ≤[j] s ∧ s ≤[jᶜ] 0) :
  s (i ∆ j) = 0 ∧ s (iᶜ ∆ jᶜ) = 0 :=
begin
  rw [restrict_le_restrict_iff s 0, restrict_le_restrict_iff 0 s] at hi' hj',
  split,
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        set.sup_eq_union, of_union,
        le_antisymm (hi'.2 (hi.compl.inter hj) (set.inter_subset_left _ _))
          (hj'.1 (hi.compl.inter hj) (set.inter_subset_right _ _)),
        le_antisymm (hj'.2 (hj.compl.inter hi) (set.inter_subset_left _ _))
          (hi'.1 (hj.compl.inter hi) (set.inter_subset_right _ _)),
        zero_apply, zero_apply, zero_add],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _)
        (disjoint.comm.1 (is_compl.disjoint is_compl_compl))) },
    { exact hj.compl.inter hi },
    { exact hi.compl.inter hj } },
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        compl_compl, compl_compl, set.sup_eq_union, of_union,
        le_antisymm (hi'.2 (hj.inter hi.compl) (set.inter_subset_right _ _))
          (hj'.1 (hj.inter hi.compl) (set.inter_subset_left _ _)),
        le_antisymm (hj'.2 (hi.inter hj.compl) (set.inter_subset_right _ _))
          (hi'.1 (hi.inter hj.compl) (set.inter_subset_left _ _)),
        zero_apply, zero_apply, zero_add],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _)
        (is_compl.disjoint is_compl_compl)) },
    { exact hj.inter hi.compl },
    { exact hi.inter hj.compl } },
  all_goals { measurability },
end

end signed_measure

end measure_theory


/-
This is a d∃∀duction file providing exercises for sets and maps. French version.
-/

import data.set
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object

-- dEAduction definitions
import set_definitions

-------------------------
-- dEAduction METADATA --
-------------------------
/- dEAduction
Title
    Ensembles et applications
Author
    Frédéric Le Roux, Camille Lichère, Zoé Mesnil
Institution
    Université du monde
Description
    Ce fichier contient une série d'exercices concernant les opérations ensemblistes
    préservées par image directe ou réciproque par une application.
    ATTENTION, certains énoncés sont faux ! Si vous n'arrivez pas à démontrer un énoncé,
    cherchez un contre-exemple...
AvailableProof
    proof_methods new_object
AvailableMagic
    assumption
AvailableExercises
  UNTIL_NOW -image_directe_et_inclusion_II -image_reciproque_et_inclusion_II -image_directe_et_intersection_II
  -image_de_image_reciproque_I -image_reciproque_de_image_II
  -injective_si_compo_injective_I -surjective_si_compo_surjective_II
  -image_directe_et_intersection_VI
AvailableDefinitions
  UNTIL_NOW -singleton -paire
AvailableTheorems
  UNTIL_NOW -image_singleton -image_paire
-/

local attribute [instance] classical.prop_decidable
---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
parameters {X Y Z: Type}

open set

------------------
-- COURSE TITLE --
------------------
namespace ensembles_et_applications
/- dEAduction
PrettyName
    Ensembles et applications
-/

namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
/- dEAduction
ImplicitUse
  True
-/
begin
    exact iff.rfl
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
-/
begin
     exact set.ext_iff
end

-- Unfortunately split cannot work
lemma definition.double_inclusion (A A' : set X) :
A = A' ↔ (A ⊆ A' ∧ A' ⊆ A) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles : double inclusion
ImplicitUse
  True
-/
begin
    exact set.subset.antisymm_iff
end

lemma definition.ensemble_vide
{A: set X} :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

lemma theorem.ensemble_non_vide
(A: set X) :
(A ≠ ∅) ↔ ∃ x : X, x ∈ A
:=
begin
    todo
end

lemma definition.singleton
{x x_0: X} :
(x ∈  (sing x_0) ) ↔ x=x_0
:=
begin
    refl,
end

lemma definition.paire
{x x_0 x_1: X} :
(x ∈ (pair x_0 x_1) ) ↔ (x=x_0 ∨ x=x_1)
:=
begin
    refl,
end

end generalites

---------------
-- SECTION 1 --
---------------
namespace unions_et_intersections
-- variables unions_et_intersections --
variables {A B C : set X}

lemma definition.intersection_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
/- dEAduction
PrettyName
    Intersection de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

lemma definition.union_deux_ensembles  {A : set X} {B : set X} {x : X} :
x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
/- dEAduction
PrettyName
    Union de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

end unions_et_intersections

namespace applications

-- variables applications --

variables  {A A': set X}
variables {f: X → Y} {B B': set Y}

lemma definition.image_directe (y : Y) :
y ∈ f '' A ↔ ∃ x : X, x ∈ A ∧  f x = y
:=
begin
    todo
end

lemma theorem.image_directe :
∀ f: X→Y, ∀{A: set X}, ∀{x: X},
 (x ∈ A → f x ∈ f '' A)
:=
begin
    todo
end

lemma definition.image_reciproque (x:X) :
x ∈ f  ⁻¹' B ↔ f(x) ∈ B
:=
begin
    todo
end

variables (g : Y → Z)

lemma definition.composition {x:X}:
composition g f x = g (f x)
:=
begin
    todo,
end

lemma definition.injectivite :
injective f ↔ ∀ x x' : X, (f x = f x' → x = x')
:=
/- dEAduction
PrettyName
    Application injective
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.surjectivite :
surjective f ↔ ∀ y : Y, ∃ x : X, y = f x
:=
/- dEAduction
PrettyName
    Application surjective
ImplicitUse
    True
-/
begin
    refl,
end

lemma theorem.image_singleton :
∀ {f: X→Y}, ∀{x_0: X},
 f '' (sing x_0) = sing (f(x_0))
:=
/- dEAduction
PrettyName
  Image d'un singleton
-/
begin
    todo
end

lemma theorem.image_paire :
∀ {f: X→Y}, ∀{x_0 x_1: X},
 f '' (pair x_0 x_1) = pair (f x_0) (f x_1)
:=
/- dEAduction
PrettyName
  Image d'une paire
-/
begin
    todo
end

end applications

end definitions

-----------------
--- EXERCICES ---
-----------------
namespace exercices
variables  {A A': set X}
variables {f: X → Y} {g: Y → Z} {B B': set Y}

/-
ANCIEN SCHEMA :

1. ∀A,B⊆E A⊆B⇒f(A)⊆f(B)
2. ∀A,B⊆E f(A)⊆f(B)⇒A⊆B
3. Sif estinjective,alors∀A,B⊆E f(A)⊆f(B)⇒A⊆B
4. f est injective sietseulementsi ∀A,B⊆E f(A)⊆f(B)⇒A⊆B

5. ∀A,B⊆F A⊆B⇒f−1(A)⊆f−1(B)
6. ∀A,B⊆F f−1(A)⊆f−1(B)⇒A⊆B
7. Si f est surjective, alors ∀A,B ⊆ F f−1(A) ⊆ f−1(B) ⇒ A ⊆ B
8. festsurjectivesietseulementsi∀A,B⊆F f−1(A)⊆f−1(B)⇒A⊆B

9. ∀A ⊆ F f(f−1(A)) ⊆ A
10. ∀A ⊆ F A ⊆ f(f−1(A))
11. Si f est surjective, alors ∀A ⊆ F A ⊆ f(f−1(A))
12. f est surjective si et seulement si ∀A ⊆ F A = f(f−1(A))

13. ∀A ⊆ E A ⊆ f−1(f(A))
14. ∀A ⊆ E f−1(f(A)) ⊆ A
15. Si f est injective alors ∀A ⊆ E f−1(f(A)) ⊆ A
16. f est injective si et seulement si ∀A ⊆ E f−1(f(A)) = A

17. ∀A,B⊆E f(A∩B)⊆f(A)∩f(B)
18. ∀A,B⊆E f(A)∩f(B)⊆f(A∩B)
19. Sif estinjective,alors∀A,B⊆E f(A)∩f(B)⊆f(A∩B)
20. f estinjectivesietseulementsi∀A,B⊆E f(A)∩f(B)=f(A∩B)

21. ∀A,B⊆E 22.∀A,B⊆F 23.∀A,B⊆F
22. f(A∪B)=f(A)∪f(B)
23. f−1(A ∩ B) = f−1(A) ∩ f−1(B) f−1(A ∪ B) = f−1(A) ∪ f−1(B)
-/

-----------------------------------------------------------
-- Atelier 2 : images directe et réciproque, composition --
-----------------------------------------------------------
namespace composition_et_images

lemma exercise.composition_image_directe
(A: set X) :
(composition g f) '' A = g '' (f '' A)
:=
/- dEAduction
PrettyName
    Image directe par une composition
-/
begin
    have H:= @definitions.applications.theorem.image_directe,
    hypo_analysis,
    todo
end

lemma exercise.composition_image_reciproque
(C: set Z) :
(composition g f) ⁻¹' C = f ⁻¹' (g ⁻¹' C)
:=
/- dEAduction
PrettyName
    Image réciproque par une composition
-/
begin
    todo
end

end composition_et_images

namespace image_et_image_reciproque
/- dEAduction
PrettyName
  Image et image réciproque
-/

lemma exercise.image_reciproque_de_image_I :
∀ A, A ⊆ f ⁻¹' (f '' (A))
:=
/- dEAduction
PrettyName
  Image réciproque de l'image
-/
begin
  todo
end

lemma exercise.image_reciproque_de_image_II :
∀ A, f ⁻¹' (f '' (A)) ⊆ A
:=
/- dEAduction
PrettyName
  Image réciproque de l'image : inclusion réciproque
-/
begin
  todo
end

lemma exercise.image_de_image_reciproque_I :
∀ B, B ⊆ f '' (f ⁻¹' (B))
:=
/- dEAduction
PrettyName
  Image de l'image réciproque
-/
begin
  todo
end

lemma exercise.image_de_image_reciproque_II :
∀ B, f '' (f ⁻¹' (B)) ⊆ B
:=
/- dEAduction
PrettyName
  Image de l'image réciproque : inclusion réciproque
-/
begin
  todo
end

end image_et_image_reciproque

------------------------------------
-- Atelier 3 : Rédiger une preuve --
------------------------------------

---------------------------------
namespace images_inclusion
/- dEAduction
PrettyName
  Images et inclusion
-/

lemma exercise.image_directe_et_inclusion :
∀ A A': set X, A ⊆ A' → f '' (A) ⊆ f '' (A')
:=
/- dEAduction
PrettyName
  Image directe et inclusion
-/
begin
  todo
end

-- lemma exercise.image_directe_et_inclusion_II :
-- ∀ A A': set X,  f '' (A) ⊆ f '' (A') → A ⊆ A'
-- :=
-- /- dEAduction
-- PrettyName
--   Image directe et inclusion : implication réciproque
-- -/
-- begin
--   todo
-- end

lemma exercise.image_reciproque_et_inclusion :
∀ B B': set Y, B ⊆ B' → f ⁻¹' (B) ⊆ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et inclusion
-/
begin
  todo
end

-- lemma exercise.image_reciproque_et_inclusion_II :
-- ∀ B B': set Y,  f ⁻¹' (B) ⊆ f ⁻¹' (B') → B ⊆ B'
-- :=
-- /- dEAduction
-- PrettyName
--   Image réciproque et inclusion : implication réciproque
-- -/
-- begin
--   todo
-- end

end images_inclusion

namespace images_union
/- dEAduction
PrettyName
  Images et union
-/

lemma exercise.image_directe_union :
∀ A A' : set X, f '' ( A ∪ A') = f '' (A) ∪ f '' (A')
:=
/- dEAduction
PrettyName
  Image directe et union
-/
begin
  todo
end

lemma exercise.image_reciproque_union :
∀ B B' : set Y, f ⁻¹' ( B ∪ B') = f ⁻¹' (B) ∪ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et union
-/
begin
  todo
end

end images_union

------------------------------------------
-- Atelier 4 : Injectivité, surjectvité --
------------------------------------------

namespace injectivite_surjectivite_composition
/- dEAduction
PrettyName
    Injectivité/surjectivité et composition
-/

lemma exercise.composition_injections
(H1 : injective f) (H2 : injective g)
:
injective (composition g f)
:=
/- dEAduction
PrettyName
    Composition d'injections
-/
begin
    todo
end

lemma exercise.composition_surjections
(H1 : surjective f) (H2 : surjective g) :
surjective (composition g f)
:=
/- dEAduction
PrettyName
    Composition de surjections
-/
begin
    todo
end

lemma exercise.injective_si_compo_injective_I
(H1 : injective (composition g f)) :
injective g
:=
/- dEAduction
PrettyName
    Injective si composition injective (i)
-/
begin
    todo
end

lemma exercise.injective_si_compo_injective_II
(H1 : injective (composition g f)) :
injective f
:=
/- dEAduction
PrettyName
    Injective si composition injective (ii)
-/
begin
    todo
end

lemma exercise.surjective_si_compo_surjective_I
(H1 : surjective (composition g f)) :
surjective g
:=
/- dEAduction
PrettyName
    Surjective si composition surjective (i)
-/
begin
    todo
end

lemma exercise.surjective_si_coompo_surjective_II
(H1 : surjective (composition g f)) :
surjective f
:=
/- dEAduction
PrettyName
    Surjective si composition surjective (ii)
-/
begin
    todo
end

end injectivite_surjectivite_composition

-------------------------------------------------
-- Atelier 5 : Conjecturer, démontrer, rédiger --
-------------------------------------------------
namespace image_intersection
/- dEAduction
PrettyName
  Image de l'intersection
-/

lemma exercise.image_directe_et_intersection_I :
∀ A B: set X, f '' (A ∩ B) ⊆ f '' (A) ∩ f '' (B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (i)
-/
begin
  todo
end

lemma exercise.image_directe_et_intersection_II :
∀ A B: set X,  f '' (A) ∩ f '' (B) ⊆ f '' (A ∩ B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (ii)
-/
begin
  todo
end

lemma exercise.image_directe_et_intersection_III
(H : injective f) :
∀ A B: set X,  f '' (A) ∩ f '' (B) ⊆ f '' (A ∩ B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (iii)
-/
begin
  todo
end

lemma exercise.image_directe_et_intersection_VI
(H : surjective f) :
∀ A B: set X,  f '' (A) ∩ f '' (B) ⊆ f '' (A ∩ B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (iv)
-/
begin
  todo
end

lemma exercise.image_reciproque_inter :
∀ A' B' : set Y, f ⁻¹' ( A' ∩ B') = f ⁻¹' (A') ∩ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et intersection
-/
begin
  todo
end

end image_intersection

namespace image_et_image_reciproque_II
/- dEAduction
PrettyName
  Image et image réciproque II
-/

lemma exercise.image_reciproque_de_image_III :
(injective f) → ∀ A, f ⁻¹' (f '' (A)) ⊆ A
:=
/- dEAduction
PrettyName
  Image réciproque de l'image, et injectivité
-/
begin
  todo
end

lemma exercise.image_reciproque_de_image_IV :
(surjective f) → ∀ A, f ⁻¹' (f '' (A)) ⊆ A
:=
/- dEAduction
PrettyName
  Image réciproque de l'image, et surjectivité
-/
begin
  todo
end

lemma exercise.image_de_image_reciproque_III :
(injective f) → ∀ B, B ⊆ f '' (f ⁻¹' (B))
:=
/- dEAduction
PrettyName
  Image de l'image réciproque, et injectivité
-/
begin
  todo
end

lemma exercise.image_de_image_reciproque_IV :
(surjective f) → ∀ B, B ⊆ f '' (f ⁻¹' (B))
:=
/- dEAduction
PrettyName
  Image de l'image réciproque, et surjectivité
-/
begin
  todo
end

end image_et_image_reciproque_II

namespace injectivite_surjectivite_caracterisation
/- dEAduction
PrettyName
  Formules caractérisant l'injectivité et la surjectivité
-/

lemma exercise.caracterisation_injectivite :
∀ f: X→Y, (∀ A: set X, A = f ⁻¹' (f '' A)) → injective f
:=
/- dEAduction
PrettyName
  Une caractérisation de l'injectivité
AvailableDefinitions
  UNTIL_NOW
AvailableTheorems
  UNTIL_NOW
-/
begin
  todo
end

lemma exercise.caracterisation_surjectivite :
∀ f: X→Y, (∀ B: set Y, B = f '' (f ⁻¹' B) ) → surjective f
:=
/- dEAduction
PrettyName
  Une caractérisation de la surjectivité
AvailableDefinitions
  UNTIL_NOW
AvailableTheorems
  UNTIL_NOW
-/
begin
  todo
end

lemma exercise.caracterisation_injectivite_II :
∀ f: X→Y, (∀ A A': set X, f '' A ⊆ f '' A' → A ⊆ A' ) → injective f
:=
/- dEAduction
PrettyName
  Une autre caractérisation de l'injectivité
AvailableDefinitions
  UNTIL_NOW
AvailableTheorems
  UNTIL_NOW
-/
begin
  todo
end

lemma exercise.caracterisation_injectivite_III :
∀ f: X→Y, (∀ A A': set X, f '' (A ∩  A') = f '' A ∩ f '' A' ) → injective f
:=
/- dEAduction
PrettyName
  Une autre caractérisation de l'injectivité
AvailableDefinitions
  UNTIL_NOW
AvailableTheorems
  UNTIL_NOW
-/
begin
  todo
end

lemma exercise.caracterisation_surjectivite_II :
∀ f: X→Y, (∀ B B': set Y, (f ⁻¹' B ⊆ f ⁻¹' B' → B ⊆ B') ) → surjective f
:=
/- dEAduction
PrettyName
  Une autre caractérisation de la surjectivité
AvailableDefinitions
  UNTIL_NOW
AvailableTheorems
  UNTIL_NOW
-/
begin
  todo
end

end injectivite_surjectivite_caracterisation

namespace injectivite_surjectivite_autres
/- dEAduction
PrettyName
  Injectivité/surjectivité : divers
-/

lemma exercise.injectivite_surjecivite (f: X → Y) (g: Y → Z)
(H1 : injective (composition g f)) (H2 : surjective f)
:
injective g
:=
/- dEAduction
PrettyName
    Injectivité et surjectivité
-/
begin
    todo
end

lemma exercise.injectivite_categorielle
(f: Y → Z):
(injective f) → (∀X: Type, ∀ g h : X → Y, (composition f g) = (composition f h) → g = h)
:=
/- dEAduction
PrettyName
    Injectivité catégorielle
-/
begin
    todo
end

lemma exercise.surjectivite_categorielle
(f: X → Y):
(surjective f) →  (∀Z: Type, ∀ g h : Y → Z, (composition g f ) = (composition h f ) → g = h)
:=
/- dEAduction
PrettyName
    Surjectivité catégorielle
-/
begin
    todo
end

lemma exercise.surjective_ssi_inverse_droite : (surjective f) ↔
∃ F: Y → X, (composition f F) = Identite :=
/- dEAduction
PrettyName
    (*) Surjectivité et inverse à droite
-/
begin
    todo
end

lemma exercise.image_directe_et_inclusion_III :
(injective f) →  (∀ A B: set X,  f '' (A) ⊆ f '' (B) → A ⊆ B)
:=
/- dEAduction
PrettyName
  Image directe et inclusion (iii)
-/
begin
  todo
end

lemma exercise.image_reciproque_et_inclusion_III :
(surjective f) → (∀ A' B': set Y,  f ⁻¹' (A') ⊆ f ⁻¹' (B') → A' ⊆ B')
:=
/- dEAduction
PrettyName
  Image réciproque et inclusion (iii)
-/
begin
  intros surj_f A B incl y y_dans_A,
  have ex_x := surj_f y, cases ex_x with x eq,
  have but: (x dans (set.preimage f A)),

end

end injectivite_surjectivite_autres

end exercices

end ensembles_et_applications

end course


import data.finset

namespace finset
variables {α : Type*}
section
@[simp] lemma subset_to_set (s₁ s₂ : finset α) : s₁.to_set ⊆ s₂.to_set ↔ s₁ ⊆ s₂  := by finish
@[simp] lemma mem_to_set (s : finset α) : ∀ a, a ∈ s.to_set ↔ a ∈ s := by finish

lemma insert_to_set [decidable_eq α] (s : finset α) (a : α) : (insert a s).to_set = insert a (s.to_set) :=
    by ext x; finish

lemma ne_of_mem_and_not_mem {s : finset α} {a b : α} (ha : a ∈ s) (hb : b ∉ s) : a ≠ b :=
    λ h, hb (by rwa h at ha)

lemma not_mem_subset_of_not_mem {s₁ s₂ : finset α} {a : α} (hs : s₁ ⊆ s₂) (ha : a ∉ s₂) : a ∉ s₁ := λ h, ha (hs h)

lemma subset_of_union_left [decidable_eq α] {s₁ s₂} (s₃ : finset α) (hs : s₁ ⊆ s₂) :
s₁ ⊆ s₂ ∪ s₃ := subset.trans hs (subset_union_left s₂ s₃)

lemma subset_of_union_right [decidable_eq α] {s₁ s₃} (s₂ : finset α) (hs : s₁ ⊆ s₃) :
s₁ ⊆ s₂ ∪ s₃ := subset.trans hs (subset_union_right s₂ s₃)

lemma union_subset' [decidable_eq α] {s₁ s₂ s₃ s₄ : finset α} (h₁ : s₁ ⊆ s₂) (h₂ : s₃ ⊆ s₄) :
s₁ ∪ s₃ ⊆ s₂ ∪ s₄ := union_subset (subset_of_union_left s₄ h₁) (subset_of_union_right s₂ h₂)

lemma union_subset'_symm [decidable_eq α] {s₁ s₂ s₃ s₄ : finset α} (h₁ : s₁ ⊆ s₄) (h₂ : s₃ ⊆ s₂) :
s₁ ∪ s₃ ⊆ s₂ ∪ s₄ := union_subset (subset_of_union_right s₂ h₁) (subset_of_union_left s₄ h₂)
end

lemma mem_fold_union {β : Type*} [decidable_eq α] [decidable_eq β] {s : finset α} {a : β} {f : α → finset β} :
    {a} ⊆ s.fold (∪) ∅ f → ∃ b ∈ s, {a} ⊆ f b :=
begin
    apply finset.induction_on s, finish [subset_empty],
    intros a' s' has' ih ha,
    simp [subset_iff] at ha ih ⊢,
    cases ha, apply exists.intro a', simp [ha],
    cases ih ha, apply exists.intro w, finish,
end

section sort
variables [decidable_linear_order α]

@[simp] lemma sort_eq_nil (s : finset α) : s.sort (≥) = [] ↔ s = ∅ :=
⟨λ h, begin
    have h' : ↑(sort (≥) s) = (∅ : multiset α),
        simp [h],
    simpa using h',
end,
λ h, by finish⟩

lemma sort_ne_nil (s : finset α) : (s.sort (≥)) ≠ [] ↔ s ≠ ∅ := by simp

lemma sort_singleton [decidable_eq α] {s : finset α} {a} : (s.sort (≥)) = [a] ↔ s = {a} := ⟨λ hs, begin
    ext a',
    have h := @mem_sort _ (≥) _ _ _ _ s,
    split; intro ha',
    rwa [←@h a', hs] at ha',
    simpa [(@h a').symm, hs] using ha',
end, λ h, begin finish [h], end⟩

lemma sort_hd_rel [inhabited α] [decidable_eq α] {s : finset α} : ∀ a ∈ (s.sort (≥)).tail, (s.sort (≥)).head ≥ a := begin
    have h := sort_sorted (≥) s,
    cases (s.sort (≥)); simp at h ⊢, exact h.left,
end

end sort

end finset


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma

! This file was ported from Lean 3 source module data.vector.mem
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Vector.Basic

/-!
# Theorems about membership of elements in vectors

This file contains theorems for membership in a `v.toList` for a vector `v`.
Having the length available in the type allows some of the lemmas to be
  simpler and more general than the original version for lists.
In particular we can avoid some assumptions about types being `inhabited`,
  and make more general statements about `head` and `tail`.
-/

namespace Vector

variable {α β : Type _} {n : ℕ} (a a' : α)

@[simp]
theorem get_mem (i : Fin n) (v : Vector α n) : v.get i ∈ v.toList := by
  rw [get_eq_get]
  exact List.get_mem _ _ _
#align vector.nth_mem Vector.get_mem

theorem mem_iff_get (v : Vector α n) : a ∈ v.toList ↔ ∃ i, v.get i = a := by
  simp only [List.mem_iff_get, Fin.exists_iff, Vector.get_eq_get]
  exact
    ⟨fun ⟨i, hi, h⟩ => ⟨i, by rwa [toList_length] at hi, h⟩, fun ⟨i, hi, h⟩ =>
      ⟨i, by rwa [toList_length], h⟩⟩
#align vector.mem_iff_nth Vector.mem_iff_get

theorem not_mem_nil : a ∉ (Vector.nil : Vector α 0).toList := by
  unfold Vector.nil
  dsimp
  simp
#align vector.not_mem_nil Vector.not_mem_nil

theorem not_mem_zero (v : Vector α 0) : a ∉ v.toList :=
  (Vector.eq_nil v).symm ▸ not_mem_nil a
#align vector.not_mem_zero Vector.not_mem_zero

theorem mem_succ_iff (v : Vector α (n + 1)) : a ∈ v.toList ↔ a = v.head ∨ a ∈ v.tail.toList := by
  obtain ⟨a', v', h⟩ := exists_eq_cons v
  simp_rw [h, Vector.mem_cons_iff, Vector.head_cons, Vector.tail_cons]
#align vector.mem_succ_iff Vector.mem_succ_iff

theorem mem_cons_self (v : Vector α n) : a ∈ (a ::ᵥ v).toList :=
  (Vector.mem_iff_get a (a ::ᵥ v)).2 ⟨0, Vector.get_cons_zero a v⟩
#align vector.mem_cons_self Vector.mem_cons_self

@[simp]
theorem head_mem (v : Vector α (n + 1)) : v.head ∈ v.toList :=
  (Vector.mem_iff_get v.head v).2 ⟨0, Vector.get_zero v⟩
#align vector.head_mem Vector.head_mem

theorem mem_cons_of_mem (v : Vector α n) (ha' : a' ∈ v.toList) : a' ∈ (a ::ᵥ v).toList :=
  (Vector.mem_cons_iff a a' v).2 (Or.inr ha')
#align vector.mem_cons_of_mem Vector.mem_cons_of_mem

theorem mem_of_mem_tail (v : Vector α n) (ha : a ∈ v.tail.toList) : a ∈ v.toList := by
  induction' n with n _
  · exact False.elim (Vector.not_mem_zero a v.tail ha)
  · exact (mem_succ_iff a v).2 (Or.inr ha)
#align vector.mem_of_mem_tail Vector.mem_of_mem_tail

theorem mem_map_iff (b : β) (v : Vector α n) (f : α → β) :
    b ∈ (v.map f).toList ↔ ∃ a : α, a ∈ v.toList ∧ f a = b := by
  rw [Vector.toList_map, List.mem_map]
#align vector.mem_map_iff Vector.mem_map_iff

theorem not_mem_map_zero (b : β) (v : Vector α 0) (f : α → β) : b ∉ (v.map f).toList := by
  simpa only [Vector.eq_nil v, Vector.map_nil, Vector.toList_nil] using List.not_mem_nil b
#align vector.not_mem_map_zero Vector.not_mem_map_zero

theorem mem_map_succ_iff (b : β) (v : Vector α (n + 1)) (f : α → β) :
    b ∈ (v.map f).toList ↔ f v.head = b ∨ ∃ a : α, a ∈ v.tail.toList ∧ f a = b := by
  rw [mem_succ_iff, head_map, tail_map, mem_map_iff, @eq_comm _ b]
#align vector.mem_map_succ_iff Vector.mem_map_succ_iff

end Vector