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

! This file was ported from Lean 3 source module measure_theory.decomposition.signed_hahn
! leanprover-community/mathlib commit bc7d81beddb3d6c66f71449c5bc76c38cb77cf9e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.VectorMeasure
import Mathbin.Order.SymmDiff

/-!
# 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 section

open Classical BigOperators NNReal ENNReal MeasureTheory

variable {α β : Type _} [MeasurableSpace α]

variable {M : Type _} [AddCommMonoid M] [TopologicalSpace M] [OrderedAddCommMonoid M]

namespace MeasureTheory

namespace SignedMeasure

open Filter VectorMeasure

variable {s : SignedMeasure α} {i j : Set α}

section ExistsSubsetRestrictNonpos

/-! ### 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 : SignedMeasure α) (i : Set α) (n : ℕ) : Prop :=
  ∃ k : Set α, k ⊆ i ∧ MeasurableSet k ∧ (1 / (n + 1) : ℝ) < s k
#align measure_theory.signed_measure.exists_one_div_lt measure_theory.signed_measure.exists_one_div_lt

private theorem exists_nat_one_div_lt_measure_of_not_negative (hi : ¬s ≤[i] 0) :
    ∃ n : ℕ, ExistsOneDivLt s i n :=
  let ⟨k, hj₁, hj₂, hj⟩ := exists_pos_measure_of_not_restrict_le_zero s hi
  let ⟨n, hn⟩ := exists_nat_one_div_lt hj
  ⟨n, k, hj₂, hj₁, hn⟩
#align measure_theory.signed_measure.exists_nat_one_div_lt_measure_of_not_negative measure_theory.signed_measure.exists_nat_one_div_lt_measure_of_not_negative

/-- 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 : SignedMeasure α) (i : Set α) : ℕ :=
  if hi : ¬s ≤[i] 0 then Nat.find (exists_nat_one_div_lt_measure_of_not_negative hi) else 0
#align measure_theory.signed_measure.find_exists_one_div_lt measure_theory.signed_measure.find_exists_one_div_lt

private theorem find_exists_one_div_lt_spec (hi : ¬s ≤[i] 0) :
    ExistsOneDivLt s i (findExistsOneDivLt s i) :=
  by
  rw [find_exists_one_div_lt, dif_pos hi]
  convert Nat.find_spec _
#align measure_theory.signed_measure.find_exists_one_div_lt_spec measure_theory.signed_measure.find_exists_one_div_lt_spec

private theorem find_exists_one_div_lt_min (hi : ¬s ≤[i] 0) {m : ℕ}
    (hm : m < findExistsOneDivLt s i) : ¬ExistsOneDivLt s i m :=
  by
  rw [find_exists_one_div_lt, dif_pos hi] at hm
  exact Nat.find_min _ hm
#align measure_theory.signed_measure.find_exists_one_div_lt_min measure_theory.signed_measure.find_exists_one_div_lt_min

/-- 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 : SignedMeasure α) (i : Set α) : Set α :=
  if hi : ¬s ≤[i] 0 then Classical.choose (findExistsOneDivLt_spec hi) else ∅
#align measure_theory.signed_measure.some_exists_one_div_lt measure_theory.signed_measure.some_exists_one_div_lt

private theorem some_exists_one_div_lt_spec (hi : ¬s ≤[i] 0) :
    someExistsOneDivLt s i ⊆ i ∧
      MeasurableSet (someExistsOneDivLt s i) ∧
        (1 / (findExistsOneDivLt s i + 1) : ℝ) < s (someExistsOneDivLt s i) :=
  by
  rw [some_exists_one_div_lt, dif_pos hi]
  exact Classical.choose_spec (find_exists_one_div_lt_spec hi)
#align measure_theory.signed_measure.some_exists_one_div_lt_spec measure_theory.signed_measure.some_exists_one_div_lt_spec

private theorem some_exists_one_div_lt_subset : someExistsOneDivLt s i ⊆ i :=
  by
  by_cases hi : ¬s ≤[i] 0
  ·
    exact
      let ⟨h, _⟩ := some_exists_one_div_lt_spec hi
      h
  · rw [some_exists_one_div_lt, dif_neg hi]
    exact Set.empty_subset _
#align measure_theory.signed_measure.some_exists_one_div_lt_subset measure_theory.signed_measure.some_exists_one_div_lt_subset

private theorem some_exists_one_div_lt_subset' : someExistsOneDivLt s (i \ j) ⊆ i :=
  Set.Subset.trans someExistsOneDivLt_subset (Set.diff_subset _ _)
#align measure_theory.signed_measure.some_exists_one_div_lt_subset' measure_theory.signed_measure.some_exists_one_div_lt_subset'

private theorem some_exists_one_div_lt_measurable_set : MeasurableSet (someExistsOneDivLt s i) :=
  by
  by_cases hi : ¬s ≤[i] 0
  ·
    exact
      let ⟨_, h, _⟩ := some_exists_one_div_lt_spec hi
      h
  · rw [some_exists_one_div_lt, dif_neg hi]
    exact MeasurableSet.empty
#align measure_theory.signed_measure.some_exists_one_div_lt_measurable_set measure_theory.signed_measure.some_exists_one_div_lt_measurable_set

private theorem some_exists_one_div_lt_lt (hi : ¬s ≤[i] 0) :
    (1 / (findExistsOneDivLt s i + 1) : ℝ) < s (someExistsOneDivLt s i) :=
  let ⟨_, _, h⟩ := someExistsOneDivLt_spec hi
  h
#align measure_theory.signed_measure.some_exists_one_div_lt_lt measure_theory.signed_measure.some_exists_one_div_lt_lt

/-- 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 : SignedMeasure α) (i : Set α) : ℕ → Set α
  | 0 => someExistsOneDivLt s (i \ ∅)
  |-- I used `i \ ∅` instead of `i` to simplify some proofs
      n +
      1 =>
    someExistsOneDivLt s
      (i \
        ⋃ k ≤ n,
          have : k < n + 1 := Nat.lt_succ_iff.mpr H
          restrict_nonpos_seq k)
#align measure_theory.signed_measure.restrict_nonpos_seq measure_theory.signed_measure.restrict_nonpos_seq

private theorem restrict_nonpos_seq_succ (n : ℕ) :
    restrictNonposSeq s i n.succ = someExistsOneDivLt s (i \ ⋃ k ≤ n, restrictNonposSeq s i k) := by
  rw [restrict_nonpos_seq]
#align measure_theory.signed_measure.restrict_nonpos_seq_succ measure_theory.signed_measure.restrict_nonpos_seq_succ

private theorem restrict_nonpos_seq_subset (n : ℕ) : restrictNonposSeq s i n ⊆ i := by
  cases n <;>
    · rw [restrict_nonpos_seq]
      exact some_exists_one_div_lt_subset'
#align measure_theory.signed_measure.restrict_nonpos_seq_subset measure_theory.signed_measure.restrict_nonpos_seq_subset

private theorem restrict_nonpos_seq_lt (n : ℕ) (hn : ¬s ≤[i \ ⋃ k ≤ n, restrictNonposSeq s i k] 0) :
    (1 / (findExistsOneDivLt s (i \ ⋃ k ≤ n, restrictNonposSeq s i k) + 1) : ℝ) <
      s (restrictNonposSeq s i n.succ) :=
  by
  rw [restrict_nonpos_seq_succ]
  apply some_exists_one_div_lt_lt hn
#align measure_theory.signed_measure.restrict_nonpos_seq_lt measure_theory.signed_measure.restrict_nonpos_seq_lt

private theorem measure_of_restrict_nonpos_seq (hi₂ : ¬s ≤[i] 0) (n : ℕ)
    (hn : ¬s ≤[i \ ⋃ k < n, restrictNonposSeq s i k] 0) : 0 < s (restrictNonposSeq s i n) :=
  by
  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 :=
      by
      refine' mt (restrict_le_zero_subset _ _ (by simp [Nat.lt_succ_iff])) hn
      convert measurable_of_not_restrict_le_zero _ hn
      exact funext fun 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
#align measure_theory.signed_measure.measure_of_restrict_nonpos_seq measure_theory.signed_measure.measure_of_restrict_nonpos_seq

private theorem restrict_nonpos_seq_measurable_set (n : ℕ) :
    MeasurableSet (restrictNonposSeq s i n) := by
  cases n <;>
    · rw [restrict_nonpos_seq]
      exact some_exists_one_div_lt_measurable_set
#align measure_theory.signed_measure.restrict_nonpos_seq_measurable_set measure_theory.signed_measure.restrict_nonpos_seq_measurable_set

private theorem restrict_nonpos_seq_disjoint' {n m : ℕ} (h : n < m) :
    restrictNonposSeq s i n ∩ restrictNonposSeq s i m = ∅ :=
  by
  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₁⟩⟩)
#align measure_theory.signed_measure.restrict_nonpos_seq_disjoint' measure_theory.signed_measure.restrict_nonpos_seq_disjoint'

private theorem restrict_nonpos_seq_disjoint : Pairwise (Disjoint on restrictNonposSeq s i) :=
  by
  intro n m h
  rw [Function.onFun, 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]
#align measure_theory.signed_measure.restrict_nonpos_seq_disjoint measure_theory.signed_measure.restrict_nonpos_seq_disjoint

private theorem exists_subset_restrict_nonpos' (hi₁ : MeasurableSet i) (hi₂ : s i < 0)
    (hn : ¬∀ n : ℕ, ¬s ≤[i \ ⋃ l < n, restrictNonposSeq s i l] 0) :
    ∃ j : Set α, MeasurableSet j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
  by
  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 : MeasurableSet (⋃ (l : ℕ) (H : l < k), restrict_nonpos_seq s i l) :=
    MeasurableSet.unionᵢ fun _ => MeasurableSet.unionᵢ fun _ => 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) :=
      by
      intro 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
        MeasurableSet.unionᵢ fun _ =>
          MeasurableSet.unionᵢ fun _ => restrict_nonpos_seq_measurable_set _
    suffices 0 ≤ ∑' l : ℕ, s (⋃ H : l < k, restrict_nonpos_seq s i l)
      by
      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 fun _ => 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_iff]
      exact fun h' => False.elim (h h')
  · intro
    exact MeasurableSet.unionᵢ fun _ => restrict_nonpos_seq_measurable_set _
  · intro a b hab
    refine' set.disjoint_Union_left.mpr fun ha => _
    refine' set.disjoint_Union_right.mpr fun hb => _
    exact restrict_nonpos_seq_disjoint hab
  · apply Set.unionᵢ_subset
    intro a x
    simp only [and_imp, exists_prop, Set.mem_unionᵢ]
    intro _ hx
    exact restrict_nonpos_seq_subset _ hx
  · infer_instance
#align measure_theory.signed_measure.exists_subset_restrict_nonpos' measure_theory.signed_measure.exists_subset_restrict_nonpos'

/-- A measurable set of negative measure has a negative subset of negative measure. -/
theorem exists_subset_restrict_nonpos (hi : s i < 0) :
    ∃ j : Set α, MeasurableSet j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
  by
  have hi₁ : MeasurableSet i := by_contradiction fun 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 : ℕ → ℕ := fun 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 :=
    by
    intro n
    convert hn (n + 1) <;>
      · ext l
        simp only [exists_prop, Set.mem_unionᵢ, and_congr_left_iff]
        exact fun _ => nat.lt_succ_iff.symm
  have h₁ : s i = s A + ∑' l, s (restrict_nonpos_seq s i l) :=
    by
    rw [hA, ← s.of_disjoint_Union_nat, add_comm, of_add_of_diff]
    exact MeasurableSet.unionᵢ fun _ => restrict_nonpos_seq_measurable_set _
    exacts[hi₁, Set.unionᵢ_subset fun _ => restrict_nonpos_seq_subset _, fun _ =>
      restrict_nonpos_seq_measurable_set _, restrict_nonpos_seq_disjoint]
  have h₂ : s A ≤ s i := by
    rw [h₁]
    apply le_add_of_nonneg_right
    exact tsum_nonneg fun n => le_of_lt (measure_of_restrict_nonpos_seq h _ (hn n))
  have h₃' : Summable fun n => (1 / (bdd n + 1) : ℝ) :=
    by
    have : Summable fun l => s (restrict_nonpos_seq s i l) :=
      HasSum.summable
        (s.m_Union (fun _ => restrict_nonpos_seq_measurable_set _) restrict_nonpos_seq_disjoint)
    refine'
      summable_of_nonneg_of_le (fun n => _) (fun 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 (fun n => (bdd n : ℝ) + 1) at_top at_top :=
    by
    simp only [one_div] at h₃'
    exact Summable.tendsto_atTop_of_pos h₃' fun n => Nat.cast_add_one_pos (bdd n)
  have h₄ : tendsto (fun n => (bdd n : ℝ)) at_top at_top :=
    by
    convert at_top.tendsto_at_top_add_const_right (-1) h₃
    simp
  have A_meas : MeasurableSet A :=
    hi₁.diff (MeasurableSet.unionᵢ fun _ => 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 :=
    by
    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 := by
        linarith (config := { restrict_type := ℝ }) [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, restrict_nonpos_seq s i l :=
    by
    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₁
#align measure_theory.signed_measure.exists_subset_restrict_nonpos MeasureTheory.SignedMeasure.exists_subset_restrict_nonpos

end ExistsSubsetRestrictNonpos

/-- The set of measures of the set of measurable negative sets. -/
def measureOfNegatives (s : SignedMeasure α) : Set ℝ :=
  s '' { B | MeasurableSet B ∧ s ≤[B] 0 }
#align measure_theory.signed_measure.measure_of_negatives MeasureTheory.SignedMeasure.measureOfNegatives

theorem zero_mem_measureOfNegatives : (0 : ℝ) ∈ s.measureOfNegatives :=
  ⟨∅, ⟨MeasurableSet.empty, le_restrict_empty _ _⟩, s.Empty⟩
#align measure_theory.signed_measure.zero_mem_measure_of_negatives MeasureTheory.SignedMeasure.zero_mem_measureOfNegatives

theorem bddBelow_measureOfNegatives : BddBelow s.measureOfNegatives :=
  by
  simp_rw [BddBelow, Set.Nonempty, mem_lowerBounds]
  by_contra' h
  have h' : ∀ n : ℕ, ∃ y : ℝ, y ∈ s.measure_of_negatives ∧ y < -n := fun n => h (-n)
  choose f hf using h'
  have hf' : ∀ n : ℕ, ∃ B, MeasurableSet B ∧ s ≤[B] 0 ∧ s B < -n :=
    by
    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 := by
    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 MeasurableSet.unionᵢ hmeas
    · infer_instance
    · exact (MeasurableSet.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))
#align measure_theory.signed_measure.bdd_below_measure_of_negatives MeasureTheory.SignedMeasure.bddBelow_measureOfNegatives

/-- Alternative formulation of `measure_theory.signed_measure.exists_is_compl_positive_negative`
(the Hahn decomposition theorem) using set complements. -/
theorem exists_compl_positive_negative (s : SignedMeasure α) :
    ∃ i : Set α, MeasurableSet i ∧ 0 ≤[i] s ∧ s ≤[iᶜ] 0 :=
  by
  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, MeasurableSet (B n) := fun n => (hB n).1.1
  have hB₂ : ∀ n, s ≤[B n] 0 := fun n => (hB n).1.2
  set A := ⋃ n, B n with hA
  have hA₁ : MeasurableSet A := MeasurableSet.unionᵢ hB₁
  have hA₂ : s ≤[A] 0 := restrict_le_restrict_Union _ _ hB₁ hB₂
  have hA₃ : s A = Inf s.measure_of_negatives :=
    by
    apply le_antisymm
    · refine' le_of_tendsto_of_tendsto tendsto_const_nhds hf₂ (eventually_of_forall fun 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₁ fun m =>
            let ⟨_, h⟩ := (hB m).1
            h
        refine'
          nonpos_of_restrict_le_zero _ (restrict_le_zero_subset _ _ (Set.diff_subset _ _) this)
        exact MeasurableSet.unionᵢ hB₁
      · infer_instance
      · exact (MeasurableSet.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]
  intro 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 :=
    by
    rw [← hA₃,
      of_union (Set.disjoint_of_subset_right (Set.Subset.trans hD hC₁) disjoint_compl_right) hA₁
        hD₁]
    linarith
    infer_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₂
#align measure_theory.signed_measure.exists_compl_positive_negative MeasureTheory.SignedMeasure.exists_compl_positive_negative

/-- **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_isCompl_positive_negative (s : SignedMeasure α) :
    ∃ i j : Set α, MeasurableSet i ∧ 0 ≤[i] s ∧ MeasurableSet j ∧ s ≤[j] 0 ∧ IsCompl i j :=
  let ⟨i, hi₁, hi₂, hi₃⟩ := exists_compl_positive_negative s
  ⟨i, iᶜ, hi₁, hi₂, hi₁.compl, hi₃, isCompl_compl⟩
#align measure_theory.signed_measure.exists_is_compl_positive_negative MeasureTheory.SignedMeasure.exists_isCompl_positive_negative

/-- The symmetric difference of two Hahn decompositions has measure zero. -/
theorem of_symmDiff_compl_positive_negative {s : SignedMeasure α} {i j : Set α}
    (hi : MeasurableSet i) (hj : MeasurableSet j) (hi' : 0 ≤[i] s ∧ s ≤[iᶜ] 0)
    (hj' : 0 ≤[j] s ∧ s ≤[jᶜ] 0) : s (i ∆ j) = 0 ∧ s (iᶜ ∆ jᶜ) = 0 :=
  by
  rw [restrict_le_restrict_iff s 0, restrict_le_restrict_iff 0 s] at hi' hj'
  constructor
  · rw [symmDiff_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 (IsCompl.disjoint isCompl_compl)))
    · exact hj.compl.inter hi
    · exact hi.compl.inter hj
  · rw [symmDiff_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 _ _)
            (IsCompl.disjoint isCompl_compl))
    · exact hj.inter hi.compl
    · exact hi.inter hj.compl
  all_goals measurability
#align measure_theory.signed_measure.of_symm_diff_compl_positive_negative MeasureTheory.SignedMeasure.of_symmDiff_compl_positive_negative

end SignedMeasure

end MeasureTheory


import Mathlib.Tactic.LeftRight
import Mathlib.Tactic.Basic
import Lean.Meta.Tactic.Apply
import Lean.Meta.Tactic.Cases
import PropositionWorld.Level8 -- not_iff_imp_false
/-!
# Advanced proposition world.

You already know enough to embark on advanced addition world. But here are just a couple
more things.

## Level 9: `exfalso` and proof by contradiction.

It's certainly true that `P ∧ (¬ P) ⟹ Q` for any propositions `P`
and `Q`, because the left hand side of the implication is false. But how do
we prove that `false` implies any proposition `Q`? A cheap way of doing it in
Lean is using the [`exfalso` tactic](../Tactics/exfalso.lean.md), which changes any goal at all to `false`.
You might think this is a step backwards, but if you have a hypothesis `h : ¬ P`
then after `rw not_iff_imp_false at h,` you can `apply h,` to make progress.

## Lemma
If `P` and `Q` are true/false statements, then `(P ∧ (¬ P)) ⟹ Q.`
-/
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by
  intro h
  cases h with
  | intro p np =>
    exfalso
    apply np
    assumption

/-!
## Pro tip.

`¬ P` is actually `P → false` *by definition* and since `np: ¬ P` is a hypothesis,
`apply q` changes `⊢ False` to `⊢ P`.  Neat trick.  We started with `⊢ Q`, but
could not prove it so we jumped to `False` so we could use `np: ¬ P` to get to
the desired goal `⊢ P`.

Next up [Level 10](./Level10.lean.md)
-/


import algebra.group_power

theorem Q3a (n : int) : (3:ℤ) ∣ n ^ 2 → (3:ℤ) ∣ n := sorry

def exists_sqrt_3 := square_root.exists_unique_square_root 3 (by norm_num)

noncomputable def sqrt3 := classical.some (exists_sqrt_3)
def sqrt3_proof := classical.some_spec (exists_sqrt_3)

example : sqrt3 ** 2 = 3 := sqrt3_proof.right.left

noncomputable example : monoid ℝ := by apply_instance

theorem no_rational_squared_is_three : ¬ (∃ (q:ℚ),q**2=3) := sorry

theorem Q3b : M1F.is_irrational (sqrt3) := sorry


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Eric Wieser
-/

import algebra.char_p.basic
import ring_theory.ideal.quotient

/-!
# Characteristic of quotients rings
-/

universes u v

namespace char_p

theorem quotient (R : Type u) [comm_ring R] (p : ℕ) [hp1 : fact p.prime] (hp2 : ↑p ∈ nonunits R) :
  char_p (R ⧸ (ideal.span {p} : ideal R)) p :=
have hp0 : (p : R ⧸ (ideal.span {p} : ideal R)) = 0,
  from map_nat_cast (ideal.quotient.mk (ideal.span {p} : ideal R)) p ▸
    ideal.quotient.eq_zero_iff_mem.2 (ideal.subset_span $ set.mem_singleton _),
ring_char.of_eq $ or.resolve_left ((nat.dvd_prime hp1.1).1 $ ring_char.dvd hp0) $ λ h1,
hp2 $ is_unit_iff_dvd_one.2 $ ideal.mem_span_singleton.1 $ ideal.quotient.eq_zero_iff_mem.1 $
@@subsingleton.elim (@@char_p.subsingleton _ $ ring_char.of_eq h1) _ _

/-- If an ideal does not contain any coercions of natural numbers other than zero, then its quotient
inherits the characteristic of the underlying ring. -/
lemma quotient' {R : Type*} [comm_ring R] (p : ℕ) [char_p R p] (I : ideal R)
  (h : ∀ x : ℕ, (x : R) ∈ I → (x : R) = 0) :
  char_p (R ⧸ I) p :=
⟨λ x, begin
  rw [←cast_eq_zero_iff R p x, ←map_nat_cast (ideal.quotient.mk I)],
  refine ideal.quotient.eq.trans (_ : ↑x - 0 ∈ I ↔ _),
  rw sub_zero,
  exact ⟨h x, λ h', h'.symm ▸ I.zero_mem⟩,
end⟩

end char_p


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import tactic

/-!
# Conjuntos
-/

/- Definimos un tipo `Ω` y tres conjuntos `X`, `Y`, `Z` cuyos elementos son de tipo `Ω`.
  Para nuestro modelo mental, podemos pensar que estamos definiendo un conjunto `Ω` y tres
  subconjuntos `X`, `Y`, `Z` del mismo.
  Definimos también elementos `a, b, c, x, y, z` de `Ω`.
 -/
variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

-- Abrimos un `namespace` para evitar conflictos con los nombres.
namespace conjuntos

/-!

# Subconjuntos

El símbolo `⊆` se escribe mediante `\sub` o `\ss`
-/

-- `X ⊆ Y` significa `∀ a, a ∈ X → a ∈ Y`, por definición.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  refl -- por definición
end

lemma subset_refl : X ⊆ X :=
begin
  sorry,
end

/- En este lema, tras empezar con `rw subset_def at *`, la hipótesis `hYZ` se transforma en
`hYZ : ∀ (a : Ω), a ∈ Y → a ∈ Z` (y similarmente para `hXY`).
Como `hYZ` es una implicación, una vez reducimos la meta a `a ∈ Z`, podemos avanzar en la
demostración utilizando `apply hYZ`.
Frecuentemente, también es útil pensar en `hYZ` como una función, que dados un término `a` de
tipo `Ω` y una demostración `haY` de que `a ∈ Y`, devuelve una demostración `haZ` de `a ∈ Z`.
-/
lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  rw subset_def at *,
  sorry
end

/-!

# Igualdad de conjuntos
Dos conjuntos son iguales si y sólo si tienen los mismos elementos.
En Lean, el nombre de este lema es `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

/- Cuando queremos reducir la meta `⊢ X = Y` a demostrar `a ∈ X ↔ a ∈ Y` para `a : Ω`
  arbitrario, utilizamos la táctica `ext`. -/

lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  ext a,
  sorry
end

/-!

### Uniones e intersecciones

Notación: `\cup` o `\un` para obtener `∪`, y `\cap` o `\i` para `∩`

-/

lemma union_def : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  refl,
end

lemma inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  refl,
end

/- Uniones. -/

lemma union_self : X ∪ X = X :=
begin
  sorry
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  sorry
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  sorry
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  sorry
end

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  sorry
end

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  sorry
end

/- Intersecciones -/

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  sorry
end

lemma inter_self : X ∩ X = X :=
begin
  sorry
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  sorry
end

lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  sorry
end

/-!

### Para todo y existe

-/

lemma not_exists_iff_forall_not : ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  sorry,
end

example : ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  sorry,
end

end conjuntos


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import order.bounds
import data.set.intervals.image_preimage

/-!
# Intervals without endpoints ordering

In any decidable linear order `α`, we define the set of elements lying between two elements `a` and
`b` as `Icc (min a b) (max a b)`.

`Icc a b` requires the assumption `a ≤ b` to be meaningful, which is sometimes inconvenient. The
interval as defined in this file is always the set of things lying between `a` and `b`, regardless
of the relative order of `a` and `b`.

For real numbers, `Icc (min a b) (max a b)` is the same as `segment a b`.

## Notation

We use the localized notation `[a, b]` for `interval a b`. One can open the locale `interval` to
make the notation available.

-/

universe u

namespace set

section linear_order

variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ x : α}

/-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
def interval (a b : α) := Icc (min a b) (max a b)

localized "notation `[`a `, ` b `]` := interval a b" in interval

@[simp] lemma interval_of_le (h : a ≤ b) : [a, b] = Icc a b :=
by rw [interval, min_eq_left h, max_eq_right h]

@[simp] lemma interval_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
by { rw [interval, min_eq_right h, max_eq_left h] }

lemma interval_swap (a b : α) : [a, b] = [b, a] :=
or.elim (le_total a b) (by simp {contextual := tt}) (by simp {contextual := tt})

lemma interval_of_lt (h : a < b) : [a, b] = Icc a b :=
interval_of_le (le_of_lt h)

lemma interval_of_gt (h : b < a) : [a, b] = Icc b a :=
interval_of_ge (le_of_lt h)

lemma interval_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a :=
interval_of_gt (lt_of_not_ge h)

lemma interval_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b :=
interval_of_lt (lt_of_not_ge h)

@[simp] lemma interval_self : [a, a] = {a} :=
set.ext $ by simp [le_antisymm_iff, and_comm]

@[simp] lemma nonempty_interval : set.nonempty [a, b] :=
by { simp only [interval, min_le_iff, le_max_iff, nonempty_Icc], left, left, refl }

@[simp] lemma left_mem_interval : a ∈ [a, b] :=
by { rw [interval, mem_Icc], exact ⟨min_le_left _ _, le_max_left _ _⟩ }

@[simp] lemma right_mem_interval : b ∈ [a, b] :=
by { rw interval_swap, exact left_mem_interval }

lemma Icc_subset_interval : Icc a b ⊆ [a, b] :=
by { assume x h, rwa interval_of_le, exact le_trans h.1 h.2 }

lemma Icc_subset_interval' : Icc b a ⊆ [a, b] :=
by { rw interval_swap, apply Icc_subset_interval }

lemma mem_interval_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] :=
Icc_subset_interval ⟨ha, hb⟩

lemma mem_interval_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] :=
Icc_subset_interval' ⟨hb, ha⟩

lemma not_mem_interval_of_lt {c : α} (ha : c < a) (hb : c < b) : c ∉ interval a b :=
not_mem_Icc_of_lt $ lt_min_iff.mpr ⟨ha, hb⟩

lemma not_mem_interval_of_gt {c : α} (ha : a < c) (hb : b < c) : c ∉ interval a b :=
not_mem_Icc_of_gt $ max_lt_iff.mpr ⟨ha, hb⟩

lemma interval_subset_interval (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
Icc_subset_Icc (le_min h₁.1 h₂.1) (max_le h₁.2 h₂.2)

lemma interval_subset_interval_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
iff.intro (λh, ⟨h left_mem_interval, h right_mem_interval⟩) (λ h, interval_subset_interval h.1 h.2)

lemma interval_subset_interval_iff_le :
  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
by { rw [interval, interval, Icc_subset_Icc_iff], exact min_le_max }

lemma interval_subset_interval_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] :=
interval_subset_interval h right_mem_interval

lemma interval_subset_interval_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] :=
interval_subset_interval left_mem_interval h

lemma bdd_below_bdd_above_iff_subset_interval (s : set α) :
  bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ [a, b] :=
begin
  rw [bdd_below_bdd_above_iff_subset_Icc],
  split,
  { rintro ⟨a, b, h⟩, exact ⟨a, b, λ x hx, Icc_subset_interval (h hx)⟩ },
  { rintro ⟨a, b, h⟩, exact ⟨min a b, max a b, h⟩ }
end

end linear_order

open_locale interval

section ordered_add_comm_group

variables {α : Type u} [linear_ordered_add_comm_group α] (a b c x y : α)

@[simp] lemma preimage_const_add_interval : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
by simp only [interval, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]

@[simp] lemma preimage_add_const_interval : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
by simpa only [add_comm] using preimage_const_add_interval a b c

@[simp] lemma preimage_neg_interval : -([a, b]) = [-a, -b] :=
by simp only [interval, preimage_neg_Icc, min_neg_neg, max_neg_neg]

@[simp] lemma preimage_sub_const_interval : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_const_sub_interval : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
by { rw [interval, interval, preimage_const_sub_Icc],
  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }

@[simp] lemma image_const_add_interval : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
by simp [add_comm]

@[simp] lemma image_add_const_interval : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
by simp

@[simp] lemma image_const_sub_interval : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_sub_const_interval : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
by simp [sub_eq_add_neg, add_comm]

lemma image_neg_interval : has_neg.neg '' [a, b] = [-a, -b] := by simp

variables {a b c x y}

/-- If `[x, y]` is a subinterval of `[a, b]`, then the distance between `x` and `y`
is less than or equal to that of `a` and `b` -/
lemma abs_sub_le_of_subinterval (h : [x, y] ⊆ [a, b]) : abs (y - x) ≤ abs (b - a) :=
begin
  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
  rw [interval_subset_interval_iff_le] at h,
  exact sub_le_sub h.2 h.1,
end

/-- If `x ∈ [a, b]`, then the distance between `a` and `x` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_left_of_mem_interval (h : x ∈ [a, b]) : abs (x - a) ≤ abs (b - a) :=
abs_sub_le_of_subinterval (interval_subset_interval_left h)

/-- If `x ∈ [a, b]`, then the distance between `x` and `b` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_right_of_mem_interval (h : x ∈ [a, b]) : abs (b - x) ≤ abs (b - a) :=
abs_sub_le_of_subinterval (interval_subset_interval_right h)

end ordered_add_comm_group

section linear_ordered_field

variables {k : Type u} [linear_ordered_field k] {a : k}

@[simp] lemma preimage_mul_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
(lt_or_gt_of_ne ha).elim
  (λ ha, by simp [interval, ha, ha.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
  (λ (ha : 0 < a), by simp [interval, ha, ha.le, min_div_div_right, max_div_div_right])

@[simp] lemma preimage_const_mul_interval (ha : a ≠ 0) (b c : k) :
  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
by simp only [← preimage_mul_const_interval ha, mul_comm]

@[simp] lemma preimage_div_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
by simp only [div_eq_mul_inv, preimage_mul_const_interval (inv_ne_zero ha), inv_inv']

@[simp] lemma image_mul_const_interval (a b c : k) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
if ha : a = 0 then by simp [ha] else
calc (λ x, x * a) '' [b, c] = (λ x, x * a⁻¹) ⁻¹' [b, c] :
  (units.mk0 a ha).mul_right.image_eq_preimage _
... = (λ x, x / a) ⁻¹' [b, c] : by simp only [div_eq_mul_inv]
... = [b * a, c * a] : preimage_div_const_interval ha _ _

@[simp] lemma image_const_mul_interval (a b c : k) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
by simpa only [mul_comm] using image_mul_const_interval a b c

@[simp] lemma image_div_const_interval (a b c : k) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
by simp only [div_eq_mul_inv, image_mul_const_interval]

end linear_ordered_field

end set


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.basic

/-!
# Circular order hierarchy

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

This file defines circular preorders, circular partial orders and circular orders.

## Hierarchy

* A ternary "betweenness" relation `btw : α → α → α → Prop` forms a `circular_order` if it is
  - reflexive: `btw a a a`
  - cyclic: `btw a b c → btw b c a`
  - antisymmetric: `btw a b c → btw c b a → a = b ∨ b = c ∨ c = a`
  - total: `btw a b c ∨ btw c b a`
  along with a strict betweenness relation `sbtw : α → α → α → Prop` which respects
  `sbtw a b c ↔ btw a b c ∧ ¬ btw c b a`, analogously to how `<` and `≤` are related, and is
  - transitive: `sbtw a b c → sbtw b d c → sbtw a d c`.
* A `circular_partial_order` drops totality.
* A `circular_preorder` further drops antisymmetry.

The intuition is that a circular order is a circle and `btw a b c` means that going around
clockwise from `a` you reach `b` before `c` (`b` is between `a` and `c` is meaningless on an
unoriented circle). A circular partial order is several, potentially intersecting, circles. A
circular preorder is like a circular partial order, but several points can coexist.

Note that the relations between `circular_preorder`, `circular_partial_order` and `circular_order`
are subtler than between `preorder`, `partial_order`, `linear_order`. In particular, one cannot
simply extend the `btw` of a `circular_partial_order` to make it a `circular_order`.

One can translate from usual orders to circular ones by "closing the necklace at infinity". See
`has_le.to_has_btw` and `has_lt.to_has_sbtw`. Going the other way involves "cutting the necklace" or
"rolling the necklace open".

## Examples

Some concrete circular orders one encounters in the wild are `zmod n` for `0 < n`, `circle`,
`real.angle`...

## Main definitions

* `set.cIcc`: Closed-closed circular interval.
* `set.cIoo`: Open-open circular interval.

## Notes

There's an unsolved diamond on `order_dual α` here. The instances `has_le α → has_btw αᵒᵈ` and
`has_lt α → has_sbtw αᵒᵈ` can each be inferred in two ways:
* `has_le α` → `has_btw α` → `has_btw αᵒᵈ` vs
  `has_le α` → `has_le αᵒᵈ` → `has_btw αᵒᵈ`
* `has_lt α` → `has_sbtw α` → `has_sbtw αᵒᵈ` vs
  `has_lt α` → `has_lt αᵒᵈ` → `has_sbtw αᵒᵈ`
The fields are propeq, but not defeq. It is temporarily fixed by turning the circularizing instances
into definitions.

## TODO

Antisymmetry is quite weak in the sense that there's no way to discriminate which two points are
equal. This prevents defining closed-open intervals `cIco` and `cIoc` in the neat `=`-less way. We
currently haven't defined them at all.

What is the correct generality of "rolling the necklace" open? At least, this works for `α × β` and
`β × α` where `α` is a circular order and `β` is a linear order.

What's next is to define circular groups and provide instances for `zmod n`, the usual circle group
`circle`, `real.angle`, and `roots_of_unity M`. What conditions do we need on `M` for this last one
to work?

We should have circular order homomorphisms. The typical example is
`days_to_month : days_of_the_year →c months_of_the_year` which relates the circular order of days
and the circular order of months. Is `α →c β` a good notation?

## References

* https://en.wikipedia.org/wiki/Cyclic_order
* https://en.wikipedia.org/wiki/Partial_cyclic_order

## Tags

circular order, cyclic order, circularly ordered set, cyclically ordered set
-/

/-- Syntax typeclass for a betweenness relation. -/
class has_btw (α : Type*) :=
(btw : α → α → α → Prop)

export has_btw (btw)

/-- Syntax typeclass for a strict betweenness relation. -/
class has_sbtw (α : Type*) :=
(sbtw : α → α → α → Prop)

export has_sbtw (sbtw)

/-- A circular preorder is the analogue of a preorder where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive and cyclic. `sbtw` is transitive.
-/
class circular_preorder (α : Type*) extends has_btw α, has_sbtw α :=
(btw_refl (a : α) : btw a a a)
(btw_cyclic_left {a b c : α} : btw a b c → btw b c a)
(sbtw := λ a b c, btw a b c ∧ ¬btw c b a)
(sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ (btw a b c ∧ ¬btw c b a) . order_laws_tac)
(sbtw_trans_left {a b c d : α} : sbtw a b c → sbtw b d c → sbtw a d c)

export circular_preorder (btw_refl) (btw_cyclic_left) (sbtw_trans_left)

/-- A circular partial order is the analogue of a partial order where you can loop around. `≤` and
`<` are replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic and
antisymmetric. `sbtw` is transitive. -/
class circular_partial_order (α : Type*) extends circular_preorder α :=
(btw_antisymm {a b c : α} : btw a b c → btw c b a → a = b ∨ b = c ∨ c = a)

export circular_partial_order (btw_antisymm)

/-- A circular order is the analogue of a linear order where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic, antisymmetric and total.
`sbtw` is transitive. -/
class circular_order (α : Type*) extends circular_partial_order α :=
(btw_total : ∀ a b c : α, btw a b c ∨ btw c b a)

export circular_order (btw_total)

/-! ### Circular preorders -/

section circular_preorder
variables {α : Type*} [circular_preorder α]

lemma btw_rfl {a : α} : btw a a a :=
btw_refl _

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_cyclic_left        ← has_btw.btw.cyclic_left
lemma has_btw.btw.cyclic_left {a b c : α} (h : btw a b c) : btw b c a :=
btw_cyclic_left h

lemma btw_cyclic_right {a b c : α} (h : btw a b c) : btw c a b :=
h.cyclic_left.cyclic_left

alias btw_cyclic_right ← has_btw.btw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw btw_cyclic` cycles to the right while
`rw ←btw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma btw_cyclic {a b c : α} : btw a b c ↔ btw c a b :=
⟨btw_cyclic_right, btw_cyclic_left⟩

lemma sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ btw a b c ∧ ¬btw c b a :=
circular_preorder.sbtw_iff_btw_not_btw

lemma btw_of_sbtw {a b c : α} (h : sbtw a b c) : btw a b c :=
(sbtw_iff_btw_not_btw.1 h).1

alias btw_of_sbtw ← has_sbtw.sbtw.btw

lemma not_btw_of_sbtw {a b c : α} (h : sbtw a b c) : ¬btw c b a :=
(sbtw_iff_btw_not_btw.1 h).2

alias not_btw_of_sbtw ← has_sbtw.sbtw.not_btw

lemma not_sbtw_of_btw {a b c : α} (h : btw a b c) : ¬sbtw c b a :=
λ h', h'.not_btw h

alias not_sbtw_of_btw ← has_btw.btw.not_sbtw

lemma sbtw_of_btw_not_btw {a b c : α} (habc : btw a b c) (hcba : ¬btw c b a) : sbtw a b c :=
sbtw_iff_btw_not_btw.2 ⟨habc, hcba⟩

alias sbtw_of_btw_not_btw ← has_btw.btw.sbtw_of_not_btw

lemma sbtw_cyclic_left {a b c : α} (h : sbtw a b c) : sbtw b c a :=
h.btw.cyclic_left.sbtw_of_not_btw (λ h', h.not_btw h'.cyclic_left)

alias sbtw_cyclic_left ← has_sbtw.sbtw.cyclic_left

lemma sbtw_cyclic_right {a b c : α} (h : sbtw a b c) : sbtw c a b :=
h.cyclic_left.cyclic_left

alias sbtw_cyclic_right ← has_sbtw.sbtw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw sbtw_cyclic` cycles to the right while
`rw ←sbtw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma sbtw_cyclic {a b c : α} : sbtw a b c ↔ sbtw c a b :=
⟨sbtw_cyclic_right, sbtw_cyclic_left⟩

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_trans_left        ← has_btw.btw.trans_left
lemma has_sbtw.sbtw.trans_left {a b c d : α} (h : sbtw a b c) : sbtw b d c → sbtw a d c :=
sbtw_trans_left h

lemma sbtw_trans_right {a b c d : α} (hbc : sbtw a b c) (hcd : sbtw a c d) : sbtw a b d :=
(hbc.cyclic_left.trans_left hcd.cyclic_left).cyclic_right

alias sbtw_trans_right ← has_sbtw.sbtw.trans_right

lemma sbtw_asymm {a b c : α} (h : sbtw a b c) : ¬ sbtw c b a :=
h.btw.not_sbtw

alias sbtw_asymm ← has_sbtw.sbtw.not_sbtw

lemma sbtw_irrefl_left_right {a b : α} : ¬ sbtw a b a := λ h, h.not_btw h.btw
lemma sbtw_irrefl_left {a b : α} : ¬ sbtw a a b := λ h, sbtw_irrefl_left_right h.cyclic_left
lemma sbtw_irrefl_right {a b : α} : ¬ sbtw a b b := λ h, sbtw_irrefl_left_right h.cyclic_right
lemma sbtw_irrefl (a : α) : ¬ sbtw a a a := sbtw_irrefl_left_right

end circular_preorder

/-! ### Circular partial orders -/

section circular_partial_order
variables {α : Type*} [circular_partial_order α]

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_antisymm        ← has_btw.btw.antisymm
lemma has_btw.btw.antisymm {a b c : α} (h : btw a b c) : btw c b a → a = b ∨ b = c ∨ c = a :=
btw_antisymm h

end circular_partial_order

/-! ### Circular orders -/

section circular_order
variables {α : Type*} [circular_order α]

lemma btw_refl_left_right (a b : α) : btw a b a :=
(or_self _).1 (btw_total a b a)

lemma btw_rfl_left_right {a b : α} : btw a b a :=
btw_refl_left_right _ _

lemma btw_refl_left (a b : α) : btw a a b :=
btw_rfl_left_right.cyclic_right

lemma btw_rfl_left {a b : α} : btw a a b :=
btw_refl_left _ _

lemma btw_refl_right (a b : α) : btw a b b :=
btw_rfl_left_right.cyclic_left

lemma btw_rfl_right {a b : α} : btw a b b :=
btw_refl_right _ _

lemma sbtw_iff_not_btw {a b c : α} : sbtw a b c ↔ ¬ btw c b a :=
begin
  rw sbtw_iff_btw_not_btw,
  exact and_iff_right_of_imp (btw_total _ _ _).resolve_left,
end

lemma btw_iff_not_sbtw {a b c : α} : btw a b c ↔ ¬ sbtw c b a :=
iff_not_comm.1 sbtw_iff_not_btw

end circular_order

/-! ### Circular intervals -/

namespace set

section circular_preorder
variables {α : Type*} [circular_preorder α]

/-- Closed-closed circular interval -/
def cIcc (a b : α) : set α := {x | btw a x b}

/-- Open-open circular interval -/
def cIoo (a b : α) : set α := {x | sbtw a x b}

@[simp] lemma mem_cIcc {a b x : α} : x ∈ cIcc a b ↔ btw a x b := iff.rfl
@[simp] lemma mem_cIoo {a b x : α} : x ∈ cIoo a b ↔ sbtw a x b := iff.rfl

end circular_preorder

section circular_order
variables {α : Type*} [circular_order α]

lemma left_mem_cIcc (a b : α) : a ∈ cIcc a b := btw_rfl_left
lemma right_mem_cIcc (a b : α) : b ∈ cIcc a b := btw_rfl_right

lemma compl_cIcc {a b : α} : (cIcc a b)ᶜ = cIoo b a :=
begin
  ext,
  rw [set.mem_cIoo, sbtw_iff_not_btw],
  refl,
end

lemma compl_cIoo {a b : α} : (cIoo a b)ᶜ = cIcc b a :=
begin
  ext,
  rw [set.mem_cIcc, btw_iff_not_sbtw],
  refl,
end

end circular_order
end set

/-! ### Circularizing instances -/

/-- The betweenness relation obtained from "looping around" `≤`.
See note [reducible non-instances]. -/
@[reducible]
def has_le.to_has_btw (α : Type*) [has_le α] : has_btw α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b) }

/-- The strict betweenness relation obtained from "looping around" `<`.
See note [reducible non-instances]. -/
@[reducible]
def has_lt.to_has_sbtw (α : Type*) [has_lt α] : has_sbtw α :=
{ sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b) }

/-- The circular preorder obtained from "looping around" a preorder.
See note [reducible non-instances]. -/
@[reducible]
def preorder.to_circular_preorder (α : Type*) [preorder α] : circular_preorder α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b),
  sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b),
  btw_refl := λ a, or.inl ⟨le_rfl, le_rfl⟩,
  btw_cyclic_left := λ a b c h, begin
    unfold btw at ⊢ h,
    rwa [←or.assoc, or_comm],
  end,
  sbtw_trans_left := λ a b c d, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hbd, hdc⟩ | ⟨hdc, hcb⟩ | ⟨hcb, hbd⟩),
    { exact or.inl ⟨hab.trans hbd, hdc⟩ },
    { exact (hbc.not_lt hcb).elim },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inr ⟨hca, hab.trans hbd⟩) }
  end,
  sbtw_iff_btw_not_btw := λ a b c, begin
    simp_rw lt_iff_le_not_le,
    set x₀ := a ≤ b,
    set x₁ := b ≤ c,
    set x₂ := c ≤ a,
    have : x₀ → x₁ → a ≤ c := le_trans,
    have : x₁ → x₂ → b ≤ a := le_trans,
    have : x₂ → x₀ → c ≤ b := le_trans,
    clear_value x₀ x₁ x₂,
    tauto!,
  end }

/-- The circular partial order obtained from "looping around" a partial order.
See note [reducible non-instances]. -/
@[reducible]
def partial_order.to_circular_partial_order (α : Type*) [partial_order α] :
  circular_partial_order α :=
{ btw_antisymm := λ a b c, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hcb, hba⟩ | ⟨hba, hac⟩ | ⟨hac, hcb⟩),
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inr $ hca.antisymm hac) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inr $ hca.antisymm hac) }
  end,
  .. preorder.to_circular_preorder α }

/-- The circular order obtained from "looping around" a linear order.
See note [reducible non-instances]. -/
@[reducible]
def linear_order.to_circular_order (α : Type*) [linear_order α] :
  circular_order α :=
{ btw_total := λ a b c, begin
    cases le_total a b with hab hba; cases le_total b c with hbc hcb;
      cases le_total c a with hca hac,
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inr $ or.inr ⟨hca, hab⟩) },
    { exact or.inr (or.inr $ or.inr ⟨hac, hcb⟩) },
    { exact or.inl (or.inr $ or.inl ⟨hbc, hca⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) },
    { exact or.inr (or.inl ⟨hcb, hba⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) }
  end,
  .. partial_order.to_circular_partial_order α }

/-! ### Dual constructions -/

section order_dual

instance (α : Type*) [has_btw α] : has_btw αᵒᵈ := ⟨λ a b c : α, btw c b a⟩
instance (α : Type*) [has_sbtw α] : has_sbtw αᵒᵈ := ⟨λ a b c : α, sbtw c b a⟩

instance (α : Type*) [h : circular_preorder α] : circular_preorder αᵒᵈ :=
{ btw_refl := btw_refl,
  btw_cyclic_left := λ a b c, btw_cyclic_right,
  sbtw_trans_left := λ a b c d habc hbdc, hbdc.trans_right habc,
  sbtw_iff_btw_not_btw := λ a b c, @sbtw_iff_btw_not_btw α _ c b a,
  .. order_dual.has_btw α,
  .. order_dual.has_sbtw α }

instance (α : Type*) [circular_partial_order α] : circular_partial_order αᵒᵈ :=
{ btw_antisymm := λ a b c habc hcba, @btw_antisymm α _ _ _ _ hcba habc,
  .. order_dual.circular_preorder α }

instance (α : Type*) [circular_order α] : circular_order αᵒᵈ :=
{ btw_total := λ a b c, btw_total c b a, .. order_dual.circular_partial_order α }

end order_dual


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Yaël Dillies
-/
import order.cover
import order.lattice_intervals

/-!
# Modular Lattices

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

This file defines (semi)modular lattices, a kind of lattice useful in algebra.
For examples, look to the subobject lattices of abelian groups, submodules, and ideals, or consider
any distributive lattice.

## Typeclasses

We define (semi)modularity typeclasses as Prop-valued mixins.

* `is_weak_upper_modular_lattice`: Weakly upper modular lattices. Lattice where `a ⊔ b` covers `a`
  and `b` if `a` and `b` both cover `a ⊓ b`.
* `is_weak_lower_modular_lattice`: Weakly lower modular lattices. Lattice where `a` and `b` cover
  `a ⊓ b` if `a ⊔ b` covers both `a` and `b`
* `is_upper_modular_lattice`: Upper modular lattices. Lattices where `a ⊔ b` covers `a` if `b`
  covers `a ⊓ b`.
* `is_lower_modular_lattice`: Lower modular lattices. Lattices where `a` covers `a ⊓ b` if `a ⊔ b`
  covers `b`.
- `is_modular_lattice`: Modular lattices. Lattices where `a ≤ c → (a ⊔ b) ⊓ c = a ⊔ (b ⊓ c)`. We
  only require an inequality because the other direction holds in all lattices.

## Main Definitions

- `inf_Icc_order_iso_Icc_sup` gives an order isomorphism between the intervals
  `[a ⊓ b, a]` and `[b, a ⊔ b]`.
  This corresponds to the diamond (or second) isomorphism theorems of algebra.

## Main Results

- `is_modular_lattice_iff_inf_sup_inf_assoc`:
  Modularity is equivalent to the `inf_sup_inf_assoc`: `(x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z`
- `distrib_lattice.is_modular_lattice`: Distributive lattices are modular.

## References

* [Manfred Stern, *Semimodular lattices. {Theory} and applications*][stern2009]
* [Wikipedia, *Modular Lattice*][https://en.wikipedia.org/wiki/Modular_lattice]

## TODO

- Relate atoms and coatoms in modular lattices
-/

open set

variable {α : Type*}

/-- A weakly upper modular lattice is a lattice where `a ⊔ b` covers `a` and `b` if `a` and `b` both
cover `a ⊓ b`. -/
class is_weak_upper_modular_lattice (α : Type*) [lattice α] : Prop :=
(covby_sup_of_inf_covby_covby {a b : α} : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b)

/-- A weakly lower modular lattice is a lattice where `a` and `b` cover `a ⊓ b` if `a ⊔ b` covers
both `a` and `b`. -/
class is_weak_lower_modular_lattice (α : Type*) [lattice α] : Prop :=
(inf_covby_of_covby_covby_sup {a b : α} : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a)

/-- An upper modular lattice, aka semimodular lattice, is a lattice where `a ⊔ b` covers `a` and `b`
if either `a` or `b` covers `a ⊓ b`. -/
class is_upper_modular_lattice (α : Type*) [lattice α] : Prop :=
(covby_sup_of_inf_covby {a b : α} : a ⊓ b ⋖ a → b ⋖ a ⊔ b)

/-- A lower modular lattice is a lattice where `a` and `b` both cover `a ⊓ b` if `a ⊔ b` covers
either `a` or `b`. -/
class is_lower_modular_lattice (α : Type*) [lattice α] : Prop :=
(inf_covby_of_covby_sup {a b : α} : a ⋖ a ⊔ b → a ⊓ b ⋖ b)

/-- A modular lattice is one with a limited associativity between `⊓` and `⊔`. -/
class is_modular_lattice (α : Type*) [lattice α] : Prop :=
(sup_inf_le_assoc_of_le : ∀ {x : α} (y : α) {z : α}, x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z))

section weak_upper_modular
variables [lattice α] [is_weak_upper_modular_lattice α] {a b : α}

lemma covby_sup_of_inf_covby_of_inf_covby_left : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b :=
is_weak_upper_modular_lattice.covby_sup_of_inf_covby_covby

lemma covby_sup_of_inf_covby_of_inf_covby_right : a ⊓ b ⋖ a → a ⊓ b ⋖ b → b ⋖ a ⊔ b :=
by { rw [inf_comm, sup_comm], exact λ ha hb, covby_sup_of_inf_covby_of_inf_covby_left hb ha }

alias covby_sup_of_inf_covby_of_inf_covby_left ← covby.sup_of_inf_of_inf_left
alias covby_sup_of_inf_covby_of_inf_covby_right ← covby.sup_of_inf_of_inf_right

instance : is_weak_lower_modular_lattice (order_dual α) :=
⟨λ a b ha hb, (ha.of_dual.sup_of_inf_of_inf_left hb.of_dual).to_dual⟩

end weak_upper_modular

section weak_lower_modular
variables [lattice α] [is_weak_lower_modular_lattice α] {a b : α}

lemma inf_covby_of_covby_sup_of_covby_sup_left : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a :=
is_weak_lower_modular_lattice.inf_covby_of_covby_covby_sup

lemma inf_covby_of_covby_sup_of_covby_sup_right : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ b :=
by { rw [sup_comm, inf_comm], exact λ ha hb, inf_covby_of_covby_sup_of_covby_sup_left hb ha }

alias inf_covby_of_covby_sup_of_covby_sup_left ← covby.inf_of_sup_of_sup_left
alias inf_covby_of_covby_sup_of_covby_sup_right ← covby.inf_of_sup_of_sup_right

instance : is_weak_upper_modular_lattice (order_dual α) :=
⟨λ a b ha hb, (ha.of_dual.inf_of_sup_of_sup_left hb.of_dual).to_dual⟩

end weak_lower_modular

section upper_modular
variables [lattice α] [is_upper_modular_lattice α] {a b : α}

lemma covby_sup_of_inf_covby_left : a ⊓ b ⋖ a → b ⋖ a ⊔ b :=
is_upper_modular_lattice.covby_sup_of_inf_covby

lemma covby_sup_of_inf_covby_right : a ⊓ b ⋖ b → a ⋖ a ⊔ b :=
by { rw [sup_comm, inf_comm], exact covby_sup_of_inf_covby_left }

alias covby_sup_of_inf_covby_left ← covby.sup_of_inf_left
alias covby_sup_of_inf_covby_right ← covby.sup_of_inf_right

@[priority 100] -- See note [lower instance priority]
instance is_upper_modular_lattice.to_is_weak_upper_modular_lattice :
  is_weak_upper_modular_lattice α :=
⟨λ a b _, covby.sup_of_inf_right⟩

instance : is_lower_modular_lattice (order_dual α) := ⟨λ a b h, h.of_dual.sup_of_inf_left.to_dual⟩

end upper_modular

section lower_modular
variables [lattice α] [is_lower_modular_lattice α] {a b : α}

lemma inf_covby_of_covby_sup_left : a ⋖ a ⊔ b → a ⊓ b ⋖ b :=
is_lower_modular_lattice.inf_covby_of_covby_sup

lemma inf_covby_of_covby_sup_right : b ⋖ a ⊔ b → a ⊓ b ⋖ a :=
by { rw [inf_comm, sup_comm], exact inf_covby_of_covby_sup_left }

alias inf_covby_of_covby_sup_left ← covby.inf_of_sup_left
alias inf_covby_of_covby_sup_right ← covby.inf_of_sup_right

@[priority 100] -- See note [lower instance priority]
instance is_lower_modular_lattice.to_is_weak_lower_modular_lattice :
  is_weak_lower_modular_lattice α :=
⟨λ a b _, covby.inf_of_sup_right⟩

instance : is_upper_modular_lattice (order_dual α) := ⟨λ a b h, h.of_dual.inf_of_sup_left.to_dual⟩

end lower_modular

section is_modular_lattice
variables [lattice α] [is_modular_lattice α]

theorem sup_inf_assoc_of_le {x : α} (y : α) {z : α} (h : x ≤ z) :
  (x ⊔ y) ⊓ z = x ⊔ (y ⊓ z) :=
le_antisymm (is_modular_lattice.sup_inf_le_assoc_of_le y h)
  (le_inf (sup_le_sup_left inf_le_left _) (sup_le h inf_le_right))

theorem is_modular_lattice.inf_sup_inf_assoc {x y z : α} :
  (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
(sup_inf_assoc_of_le y inf_le_right).symm

lemma inf_sup_assoc_of_le {x : α} (y : α) {z : α} (h : z ≤ x) :
  (x ⊓ y) ⊔ z = x ⊓ (y ⊔ z) :=
by rw [inf_comm, sup_comm, ← sup_inf_assoc_of_le y h, inf_comm, sup_comm]

instance : is_modular_lattice αᵒᵈ :=
⟨λ x y z xz, le_of_eq (by { rw [inf_comm, sup_comm, eq_comm, inf_comm, sup_comm],
  exact @sup_inf_assoc_of_le α _ _ _ y _ xz })⟩

variables {x y z : α}

theorem is_modular_lattice.sup_inf_sup_assoc :
  (x ⊔ z) ⊓ (y ⊔ z) = ((x ⊔ z) ⊓ y) ⊔ z :=
@is_modular_lattice.inf_sup_inf_assoc αᵒᵈ _ _ _ _ _

theorem eq_of_le_of_inf_le_of_sup_le (hxy : x ≤ y) (hinf : y ⊓ z ≤ x ⊓ z) (hsup : y ⊔ z ≤ x ⊔ z) :
  x = y :=
le_antisymm hxy $
  have h : y ≤ x ⊔ z,
    from calc y ≤ y ⊔ z : le_sup_left
      ... ≤ x ⊔ z : hsup,
  calc y ≤ (x ⊔ z) ⊓ y : le_inf h le_rfl
    ... = x ⊔ (z ⊓ y) : sup_inf_assoc_of_le _ hxy
    ... ≤ x ⊔ (z ⊓ x) : sup_le_sup_left
      (by rw [inf_comm, @inf_comm _ _ z]; exact hinf) _
    ... ≤ x : sup_le le_rfl inf_le_right

theorem sup_lt_sup_of_lt_of_inf_le_inf (hxy : x < y) (hinf : y ⊓ z ≤ x ⊓ z) : x ⊔ z < y ⊔ z :=
lt_of_le_of_ne
  (sup_le_sup_right (le_of_lt hxy) _)
  (λ hsup, ne_of_lt hxy $ eq_of_le_of_inf_le_of_sup_le (le_of_lt hxy) hinf
    (le_of_eq hsup.symm))

theorem inf_lt_inf_of_lt_of_sup_le_sup (hxy : x < y) (hinf : y ⊔ z ≤ x ⊔ z) : x ⊓ z < y ⊓ z :=
@sup_lt_sup_of_lt_of_inf_le_inf αᵒᵈ _ _ _ _ _ hxy hinf

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Artinian, then `M` is Artinian. -/
theorem well_founded_lt_exact_sequence
  {β γ : Type*} [partial_order β] [preorder γ]
  (h₁ : well_founded ((<) : β → β → Prop))
  (h₂ : well_founded ((<) : γ → γ → Prop))
  (K : α) (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ)
  (gci : galois_coinsertion f₁ f₂)
  (gi : galois_insertion g₂ g₁)
  (hf : ∀ a, f₁ (f₂ a) = a ⊓ K)
  (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
  well_founded ((<) : α → α → Prop) :=
subrelation.wf
  (λ A B hAB, show prod.lex (<) (<) (f₂ A, g₂ A) (f₂ B, g₂ B),
    begin
      simp only [prod.lex_def, lt_iff_le_not_le, ← gci.l_le_l_iff,
        ← gi.u_le_u_iff, hf, hg, le_antisymm_iff],
      simp only [gci.l_le_l_iff, gi.u_le_u_iff, ← lt_iff_le_not_le, ← le_antisymm_iff],
      cases lt_or_eq_of_le (inf_le_inf_right K (le_of_lt hAB)) with h h,
      { exact or.inl h },
      { exact or.inr ⟨h, sup_lt_sup_of_lt_of_inf_le_inf hAB (le_of_eq h.symm)⟩ }
    end)
  (inv_image.wf _ (prod.lex_wf h₁ h₂))

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Noetherian, then `M` is Noetherian.  -/
theorem well_founded_gt_exact_sequence
  {β γ : Type*} [preorder β] [partial_order γ]
  (h₁ : well_founded ((>) : β → β → Prop))
  (h₂ : well_founded ((>) : γ → γ → Prop))
  (K : α) (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ)
  (gci : galois_coinsertion f₁ f₂)
  (gi : galois_insertion g₂ g₁)
  (hf : ∀ a, f₁ (f₂ a) = a ⊓ K)
  (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
  well_founded ((>) : α → α → Prop) :=
@well_founded_lt_exact_sequence αᵒᵈ _ _ γᵒᵈ βᵒᵈ _ _ h₂ h₁ K g₁ g₂ f₁ f₂ gi.dual gci.dual hg hf

/-- The diamond isomorphism between the intervals `[a ⊓ b, a]` and `[b, a ⊔ b]` -/
@[simps]
def inf_Icc_order_iso_Icc_sup (a b : α) : set.Icc (a ⊓ b) a ≃o set.Icc b (a ⊔ b) :=
{ to_fun := λ x, ⟨x ⊔ b, ⟨le_sup_right, sup_le_sup_right x.prop.2 b⟩⟩,
  inv_fun := λ x, ⟨a ⊓ x, ⟨inf_le_inf_left a x.prop.1, inf_le_left⟩⟩,
  left_inv := λ x, subtype.ext (by { change a ⊓ (↑x ⊔ b) = ↑x,
    rw [sup_comm, ← inf_sup_assoc_of_le _ x.prop.2, sup_eq_right.2 x.prop.1] }),
  right_inv := λ x, subtype.ext (by { change a ⊓ ↑x ⊔ b = ↑x,
    rw [inf_comm, inf_sup_assoc_of_le _ x.prop.1, inf_eq_left.2 x.prop.2] }),
  map_rel_iff' := λ x y, begin
    simp only [subtype.mk_le_mk, equiv.coe_fn_mk, and_true, le_sup_right],
    rw [← subtype.coe_le_coe],
    refine ⟨λ h, _, λ h, sup_le_sup_right h _⟩,
    rw [← sup_eq_right.2 x.prop.1, inf_sup_assoc_of_le _ x.prop.2, sup_comm,
      ← sup_eq_right.2 y.prop.1, inf_sup_assoc_of_le _ y.prop.2, @sup_comm _ _ b],
    exact inf_le_inf_left _ h
  end }

lemma inf_strict_mono_on_Icc_sup {a b : α} : strict_mono_on (λ c, a ⊓ c) (Icc b (a ⊔ b)) :=
strict_mono.of_restrict (inf_Icc_order_iso_Icc_sup a b).symm.strict_mono

lemma sup_strict_mono_on_Icc_inf {a b : α} : strict_mono_on (λ c, c ⊔ b) (Icc (a ⊓ b) a) :=
strict_mono.of_restrict (inf_Icc_order_iso_Icc_sup a b).strict_mono

/-- The diamond isomorphism between the intervals `]a ⊓ b, a[` and `}b, a ⊔ b[`. -/
@[simps]
def inf_Ioo_order_iso_Ioo_sup (a b : α) : Ioo (a ⊓ b) a ≃o Ioo b (a ⊔ b) :=
{ to_fun := λ c, ⟨c ⊔ b,
    le_sup_right.trans_lt $ sup_strict_mono_on_Icc_inf (left_mem_Icc.2 inf_le_left)
      (Ioo_subset_Icc_self c.2) c.2.1,
    sup_strict_mono_on_Icc_inf (Ioo_subset_Icc_self c.2) (right_mem_Icc.2 inf_le_left) c.2.2⟩,
  inv_fun := λ c, ⟨a ⊓ c,
    inf_strict_mono_on_Icc_sup (left_mem_Icc.2 le_sup_right) (Ioo_subset_Icc_self c.2) c.2.1,
    inf_le_left.trans_lt' $ inf_strict_mono_on_Icc_sup (Ioo_subset_Icc_self c.2)
      (right_mem_Icc.2 le_sup_right) c.2.2⟩,
  left_inv := λ c, subtype.ext $
    by { dsimp, rw [sup_comm, ←inf_sup_assoc_of_le _ c.prop.2.le, sup_eq_right.2 c.prop.1.le] },
  right_inv := λ c, subtype.ext $
    by { dsimp, rw [inf_comm, inf_sup_assoc_of_le _ c.prop.1.le, inf_eq_left.2 c.prop.2.le] },
  map_rel_iff' := λ c d, @order_iso.le_iff_le _ _ _ _ (inf_Icc_order_iso_Icc_sup _ _)
    ⟨c.1, Ioo_subset_Icc_self c.2⟩ ⟨d.1, Ioo_subset_Icc_self d.2⟩ }

@[priority 100] -- See note [lower instance priority]
instance is_modular_lattice.to_is_lower_modular_lattice : is_lower_modular_lattice α :=
⟨λ a b, by { simp_rw [covby_iff_Ioo_eq, @sup_comm _ _ a, @inf_comm _ _ a, ←is_empty_coe_sort,
  right_lt_sup, inf_lt_left, (inf_Ioo_order_iso_Ioo_sup _ _).symm.to_equiv.is_empty_congr],
    exact id }⟩

@[priority 100] -- See note [lower instance priority]
instance is_modular_lattice.to_is_upper_modular_lattice : is_upper_modular_lattice α :=
⟨λ a b, by { simp_rw [covby_iff_Ioo_eq, ←is_empty_coe_sort,
  right_lt_sup, inf_lt_left, (inf_Ioo_order_iso_Ioo_sup _ _).to_equiv.is_empty_congr], exact id }⟩

end is_modular_lattice

namespace is_compl
variables [lattice α] [bounded_order α] [is_modular_lattice α]

/-- The diamond isomorphism between the intervals `set.Iic a` and `set.Ici b`. -/
def Iic_order_iso_Ici {a b : α} (h : is_compl a b) : set.Iic a ≃o set.Ici b :=
(order_iso.set_congr (set.Iic a) (set.Icc (a ⊓ b) a) (h.inf_eq_bot.symm ▸ set.Icc_bot.symm)).trans $
  (inf_Icc_order_iso_Icc_sup a b).trans
  (order_iso.set_congr (set.Icc b (a ⊔ b)) (set.Ici b) (h.sup_eq_top.symm ▸ set.Icc_top))

end is_compl

theorem is_modular_lattice_iff_inf_sup_inf_assoc [lattice α] :
  is_modular_lattice α ↔ ∀ (x y z : α), (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
⟨λ h, @is_modular_lattice.inf_sup_inf_assoc _ _ h, λ h, ⟨λ x y z xz, by rw [← inf_eq_left.2 xz, h]⟩⟩

namespace distrib_lattice

@[priority 100]
instance [distrib_lattice α] : is_modular_lattice α :=
⟨λ x y z xz, by rw [inf_sup_right, inf_eq_left.2 xz]⟩

end distrib_lattice

theorem disjoint.disjoint_sup_right_of_disjoint_sup_left
  [lattice α] [order_bot α] [is_modular_lattice α] {a b c : α}
  (h : disjoint a b) (hsup : disjoint (a ⊔ b) c) :
  disjoint a (b ⊔ c) :=
begin
  rw [disjoint_iff_inf_le, ← h.eq_bot, sup_comm],
  apply le_inf inf_le_left,
  apply (inf_le_inf_right (c ⊔ b) le_sup_right).trans,
  rw [sup_comm, is_modular_lattice.sup_inf_sup_assoc, hsup.eq_bot, bot_sup_eq]
end

theorem disjoint.disjoint_sup_left_of_disjoint_sup_right
  [lattice α] [order_bot α] [is_modular_lattice α] {a b c : α}
  (h : disjoint b c) (hsup : disjoint a (b ⊔ c)) :
  disjoint (a ⊔ b) c :=
begin
  rw [disjoint.comm, sup_comm],
  apply disjoint.disjoint_sup_right_of_disjoint_sup_left h.symm,
  rwa [sup_comm, disjoint.comm] at hsup,
end

namespace is_modular_lattice

variables [lattice α] [is_modular_lattice α] {a : α}

instance is_modular_lattice_Iic : is_modular_lattice (set.Iic a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

instance is_modular_lattice_Ici : is_modular_lattice (set.Ici a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

section complemented_lattice
variables [bounded_order α] [complemented_lattice α]

instance complemented_lattice_Iic : complemented_lattice (set.Iic a) :=
⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
  ⟨⟨y ⊓ a, set.mem_Iic.2 inf_le_right⟩, begin
    split,
    { rw disjoint_iff_inf_le,
      change x ⊓ (y ⊓ a) ≤ ⊥, -- improve lattice subtype API
      rw ← inf_assoc,
      exact le_trans inf_le_left hy.1.le_bot },
    { rw codisjoint_iff_le_sup,
      change a ≤ x ⊔ (y ⊓ a), -- improve lattice subtype API
      rw [← sup_inf_assoc_of_le _ (set.mem_Iic.1 hx), hy.2.eq_top, top_inf_eq] }
  end⟩⟩

instance complemented_lattice_Ici : complemented_lattice (set.Ici a) :=
⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
  ⟨⟨y ⊔ a, set.mem_Ici.2 le_sup_right⟩, begin
    split,
    { rw disjoint_iff_inf_le,
      change x ⊓ (y ⊔ a) ≤ a, -- improve lattice subtype API
      rw [← inf_sup_assoc_of_le _ (set.mem_Ici.1 hx), hy.1.eq_bot, bot_sup_eq] },
    { rw codisjoint_iff_le_sup,
      change ⊤ ≤ x ⊔ (y ⊔ a), -- improve lattice subtype API
      rw ← sup_assoc,
      exact le_trans hy.2.top_le le_sup_left }
  end⟩⟩

end complemented_lattice

end is_modular_lattice


section sec_3_redo
open classical

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
begin
  split; {
    intro h,
    cases h with p q,
    split; assumption
  }
end
example : p ∨ q ↔ q ∨ p :=
begin
  split; {
    intro h,
    cases h with p q; { left; assumption } <|> { right; assumption }
  }
end

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
begin
  split; {
    intro h,
    cases h with h1 h2,
    cases h1 with h11 h12 <|> cases h2 with h22 h23,
    repeat { split }; assumption,
  }
end
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
begin
  split; {
    intro h,
    cases h; try { cases h },
    all_goals {
      { repeat { { left; assumption } <|> right }; assumption } <|>
      { repeat { { right; assumption } <|> left }; assumption } }
  }
end

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  split,
    intros h,
    cases h with hp hqr,
    cases hqr with hq hr;
    { left; split; assumption } <|> { right; split; assumption },
  intros h,
  cases h; cases h with hq hqr; split;
  { assumption <|> { left; assumption}  <|> { right; assumption} }
end
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
begin
  split,
    intros h,
    cases h with hp hqr;
    try {cases hqr with hq hr}; {
      split; {left; assumption} <|> {right; assumption}
    },
  intros h,
  cases h with hpq hpr;
  cases hpq with hp hq;
  cases hpr with hp2 hr;
  { assumption <|> {left; assumption}  <|> { right; split; assumption} }
end

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
begin
  split,
    intros hpqr hpq,
    cases hpq with hp hq,
    apply hpqr; assumption,
  intros hpqr hp hq,
  apply hpqr; split; assumption,
end
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
begin
  split,
    intros hpqr,
    split; intros hpq; apply hpqr; {{left; assumption} <|> {right; assumption}},
  intros hprqr hpq,
  cases hprqr with hpr hqr,
  cases hpq with hp hq; { apply hpr; assumption } <|> { apply hqr; assumption }
end
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
begin
  split,
    intros hnpq,
    split; intros hpq; apply hnpq; {left; assumption}  <|> { right; assumption},
  intros hnpnq hpq,
  cases hnpnq with hnp hnq,
  cases hpq with hp hq;
  { apply hnp; assumption } <|> { apply hnq; assumption }
end
example : ¬p ∨ ¬q → ¬(p ∧ q) :=
begin
  intros hnpnq hpq,
  cases hpq with hp hq,
  cases hnpnq with hnp hnq;
  { apply hnp; assumption } <|> { apply hnq; assumption }
end
example : ¬(p ∧ ¬p) :=
begin
  intros hpnp,
  cases hpnp with hp hnp,
  apply hnp,
  assumption,
end
example : p ∧ ¬q → ¬(p → q) :=
begin
  intros hpnq hpq,
  cases hpnq with hp hnq,
  apply hnq,
  apply hpq,
  apply hp,
end
example : ¬p → (p → q) :=
begin
  intros hnp hp,
  cases (hnp hp),
end
example : (¬p ∨ q) → (p → q) :=
begin
  intros hnpq hp,
  cases hnpq with hnp hq,
    cases (hnp hp),
  apply hq,
end

example : ¬(p ↔ ¬p) :=
begin
  intro heqpnp,
  cases heqpnp with hpnp hnpp,
  apply hpnp;
    apply hnpp;
      intros p;
        apply hpnp; assumption,
end
end sec_3_redo

example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by split; split <|> left; assumption <|> right; {left; assumption} <|> {right; assumption}

example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
begin
  split,
  all_goals { try {split} },
  all_goals { repeat { {left; assumption} <|> right } },
  all_goals { assumption },
end