/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import data.zmod.basic
import group_theory.order_of_element
import data.nat.basic
import tactic.interval_cases
import group_theory.specific_groups.dihedral
import group_theory.specific_groups.cyclic

/-!
# Quaternion Groups

We define the (generalised) quaternion groups `quaternion_group n` of order `4n`, also known as
dicyclic groups, with elements `a i` and `xa i` for `i : zmod n`. The (generalised) quaternion
groups can be defined by the presentation
$\langle a, x | a^{2n} = 1, x^2 = a^n, x^{-1}ax=a^{-1}\rangle$. We write `a i` for
$a^i$ and `xa i` for $x * a^i$. For `n=2` the quaternion group `quaternion_group 2` is isomorphic to
the unit integral quaternions `units (quaternion ℤ)`.

## Main definition

`quaternion_group n`: The (generalised) quaternion group of order `4n`.

## Implementation notes

This file is heavily based on `dihedral_group` by Shing Tak Lam.

In mathematics, the name "quaternion group" is reserved for the cases `n ≥ 2`. Since it would be
inconvenient to carry around this condition we define `quaternion_group` also for `n = 0` and
`n = 1`. `quaternion_group 0` is isomorphic to the infinite dihedral group, while
`quaternion_group 1` is isomorphic to a cyclic group of order `4`.

## References

* https://en.wikipedia.org/wiki/Dicyclic_group
* https://en.wikipedia.org/wiki/Quaternion_group

## TODO

Show that `quaternion_group 2 ≃* units (quaternion ℤ)`.

-/

/--
The (generalised) quaternion group `quaternion_group n` of order `4n`. It can be defined by the
presentation $\langle a, x | a^{2n} = 1, x^2 = a^n, x^{-1}ax=a^{-1}\rangle$. We write `a i` for
$a^i$ and `xa i` for $x * a^i$.
-/
@[derive decidable_eq]
inductive quaternion_group (n : ℕ) : Type
| a : zmod (2 * n) → quaternion_group
| xa : zmod (2 * n) → quaternion_group

namespace quaternion_group

variables {n : ℕ}

/--
Multiplication of the dihedral group.
-/
private def mul : quaternion_group n → quaternion_group n → quaternion_group n
| (a i) (a j) := a (i + j)
| (a i) (xa j) := xa (j - i)
| (xa i) (a j) := xa (i + j)
| (xa i) (xa j) := a (n + j - i)

/--
The identity `1` is given by `aⁱ`.
-/
private def one : quaternion_group n := a 0

instance : inhabited (quaternion_group n) := ⟨one⟩

/--
The inverse of an element of the quaternion group.
-/
private def inv : quaternion_group n → quaternion_group n
| (a i) := a (-i)
| (xa i) := xa (n + i)

/--
The group structure on `quaternion_group n`.
-/
instance : group (quaternion_group n) :=
{ mul := mul,
  mul_assoc :=
    begin
      rintros (i | i) (j | j) (k | k);
      simp only [mul];
      abel,
      simp only [neg_mul_eq_neg_mul_symm, one_mul, int.cast_one, gsmul_eq_mul, int.cast_neg,
                 add_right_inj],
      calc -(n : zmod (2 * n)) = 0 - n : by rw zero_sub
        ... = 2 * n - n : by { norm_cast, simp, }
        ... = n : by ring
    end,
  one := one,
  one_mul :=
    begin
      rintros (i | i),
      { exact congr_arg a (zero_add i) },
      { exact congr_arg xa (sub_zero i) },
    end,
  mul_one := begin
      rintros (i | i),
      { exact congr_arg a (add_zero i) },
      { exact congr_arg xa (add_zero i) },
    end,
  inv := inv,
  mul_left_inv := begin
      rintros (i | i),
      { exact congr_arg a (neg_add_self i) },
      { exact congr_arg a (sub_self (n + i)) },
    end }

variable {n}

@[simp] lemma a_mul_a (i j : zmod (2 * n)) : a i * a j = a (i + j) := rfl
@[simp] lemma a_mul_xa (i j : zmod (2 * n)) : a i * xa j = xa (j - i) := rfl
@[simp]

lemma one_def : (1 : quaternion_group n) = a 0 := rfl

private def fintype_helper : (zmod (2 * n) ⊕ zmod (2 * n)) ≃ quaternion_group n :=
{ inv_fun := λ i, match i with
                 | (a j) := sum.inl j
                 | (xa j) := sum.inr j
                 end,
  to_fun := λ i, match i with
                 | (sum.inl j) := a j
                 | (sum.inr j) := xa j
                 end,
  left_inv := by rintro (x | x); refl,
  right_inv := by rintro (x | x); refl }

/-- The special case that more or less by definition `quaternion_group 0` is isomorphic to the
infinite dihedral group. -/
def quaternion_group_zero_equiv_dihedral_group_zero : quaternion_group 0 ≃* dihedral_group 0 :=
{ to_fun := λ i, quaternion_group.rec_on i dihedral_group.r dihedral_group.sr,
  inv_fun := λ i, match i with
                | (dihedral_group.r j) := a j
                | (dihedral_group.sr j) := xa j
                end,
  left_inv := by rintro (k | k); refl,
  right_inv := by rintro (k | k); refl,
  map_mul' := by { rintros (k | k) (l | l); { dsimp, simp, }, } }

/-- Some of the lemmas on `zmod m` require that `m` is positive, as `m = 2 * n` is the case relevant
in this file but we don't want to write `[fact (0 < 2 * n)]` we make this lemma a local instance. -/
private lemma succ_mul_pos_fact {m : ℕ} [hn : fact (0 < n)] : fact (0 < (nat.succ m) * n) :=
⟨nat.succ_mul_pos m hn.1⟩

local attribute [instance] succ_mul_pos_fact

/--
If `0 < n`, then `quaternion_group n` is a finite group.
-/
instance [fact (0 < n)] : fintype (quaternion_group n) := fintype.of_equiv _ fintype_helper

instance : nontrivial (quaternion_group n) := ⟨⟨a 0, xa 0, dec_trivial⟩⟩

/--
If `0 < n`, then `quaternion_group n` has `4n` elements.
-/
lemma card [fact (0 < n)] : fintype.card (quaternion_group n) = 4 * n :=
begin
  rw [← fintype.card_eq.mpr ⟨fintype_helper⟩, fintype.card_sum, zmod.card, two_mul],
  ring
end

@[simp] lemma a_one_pow (k : ℕ) : (a 1 : quaternion_group n) ^ k = a k :=
begin
  induction k with k IH,
  { refl },
  { rw [pow_succ, IH, a_mul_a],
    congr' 1,
    norm_cast,
    rw nat.one_add }
end

@[simp] lemma a_one_pow_n : (a 1 : quaternion_group n)^(2 * n) = 1 :=
begin
  cases n,
  { simp_rw [mul_zero, pow_zero] },
  { rw [a_one_pow, one_def],
    congr' 1,
    exact zmod.nat_cast_self _ }
end

@[simp] lemma xa_sq (i : zmod (2 * n)) : xa i ^ 2 = a n :=
begin
  simp [sq]
end

@[simp] lemma xa_pow_four (i : zmod (2 * n)) : xa i ^ 4 = 1 :=
begin
  simp only [pow_succ, sq, xa_mul_xa, xa_mul_a, add_sub_cancel, add_sub_assoc, add_sub_cancel',
             sub_self, add_zero],
  norm_cast,
  rw ← two_mul,
  simp [one_def],
end

/--
If `0 < n`, then `xa i` has order 4.
-/
@[simp] lemma order_of_xa [hpos : fact (0 < n)] (i : zmod (2 * n)) : order_of (xa i) = 4 :=
begin
  change _ = 2^2,
  haveI : fact(nat.prime 2) := fact.mk (nat.prime_two),
  apply order_of_eq_prime_pow,
  { intro h,
    simp only [pow_one, xa_sq] at h,
    injection h with h',
    apply_fun zmod.val at h',
    apply_fun ( / n) at h',
    simp only [zmod.val_nat_cast, zmod.val_zero, nat.zero_div, nat.mod_mul_left_div_self,
             nat.div_self hpos.1] at h',
    norm_num at h' },
  { norm_num }
end

/-- In the special case `n = 1`, `quaternion 1` is a cyclic group (of order `4`). -/
lemma quaternion_group_one_is_cyclic : is_cyclic (quaternion_group 1) :=
begin
  apply is_cyclic_of_order_of_eq_card,
  rw [card, mul_one],
  exact order_of_xa 0
end

/--
If `0 < n`, then `a 1` has order `2 * n`.
-/
@[simp] lemma order_of_a_one [hn : fact (0 < n)] : order_of (a 1 : quaternion_group n) = 2 * n :=
begin
  cases (nat.le_of_dvd (nat.succ_mul_pos _ hn.1)
    (order_of_dvd_of_pow_eq_one (@a_one_pow_n n))).lt_or_eq with h h,
  { have h1 : (a 1 : quaternion_group n)^(order_of (a 1)) = 1 := pow_order_of_eq_one _,
    rw a_one_pow at h1,
    injection h1 with h2,
    rw [← zmod.val_eq_zero, zmod.val_nat_cast, nat.mod_eq_of_lt h] at h2,
    exact absurd h2.symm (order_of_pos _).ne },
  { exact h }
end

/--
If `0 < n`, then `a i` has order `(2 * n) / gcd (2 * n) i`.
-/
lemma order_of_a [fact (0 < n)] (i : zmod (2 * n)) :
  order_of (a i) = (2 * n) / nat.gcd (2 * n) i.val :=
begin
  conv_lhs { rw ← zmod.nat_cast_zmod_val i },
  rw [← a_one_pow, order_of_pow, order_of_a_one]
end

end quaternion_group


import data.complex.basic

definition has_coe_NZ : has_coe ℕ ℤ := by apply_instance
definition has_coe_NQ : has_coe ℕ ℚ := by apply_instance
definition has_coe_NR : has_coe ℕ ℝ := by apply_instance
definition has_coe_NC : has_coe ℕ ℂ := by apply_instance
definition has_coe_ZQ : has_coe ℤ ℚ := by apply_instance
definition has_coe_ZR : has_coe ℤ ℝ := by apply_instance
definition has_coe_ZC : has_coe ℤ ℂ := by apply_instance
-- definition has_coe_QR : has_coe ℚ ℝ := by apply_instance -- fails
noncomputable definition has_coe_QR : has_coe ℚ ℝ := by apply_instance
-- definition has_coe_QC : has_coe ℚ ℂ := by apply_instance -- fails
noncomputable definition has_coe_QC : has_coe ℚ ℂ := by apply_instance
definition has_coe_RC : has_coe ℝ ℂ := by apply_instance

definition coe_NZ : ℕ → ℤ := has_coe_NZ.coe
definition coe_NQ : ℕ → ℚ := has_coe_NQ.coe
definition coe_NR : ℕ → ℝ := has_coe_NR.coe
definition coe_NC : ℕ → ℂ := has_coe_NC.coe
definition coe_ZQ : ℤ → ℚ := has_coe_ZQ.coe
definition coe_ZR : ℤ → ℝ := has_coe_ZR.coe
definition coe_ZC : ℤ → ℂ := has_coe_ZC.coe
noncomputable definition coe_QR : ℚ → ℝ := has_coe_QR.coe
noncomputable definition coe_QC : ℚ → ℂ := has_coe_QC.coe
definition coe_RC : ℝ → ℂ := has_coe_RC.coe

-- The ten theorems below are what I would like to access easily in Lean.
-- I don't know what to call them; the current names are just placeholders.

-- N to Z is never a problem
theorem NZQ (x : ℕ) : coe_ZQ (coe_NZ x) = coe_NQ x := rfl
theorem NZR (x : ℕ) : coe_ZR (coe_NZ x) = coe_NR x := rfl
theorem NZC (x : ℕ) : coe_ZC (coe_NZ x) = coe_NC x := rfl

-- the problems start now
theorem ZQR (x : ℤ) : coe_QR (coe_ZQ x) = coe_ZR x := sorry -- simp fails
theorem QRC (x : ℚ) : coe_RC (coe_QR x) = coe_QC x := sorry -- simp fails
theorem ZRC (x : ℤ) : coe_RC (coe_ZR x) = coe_ZC x := sorry -- simp fails

theorem NQR (x : ℕ) : coe_QR (coe_NQ x) = coe_NR x := by rw [←NZQ,ZQR,←NZR]
theorem ZQC (x : ℤ) : coe_QC (coe_ZQ x) = coe_ZC x := by rw [←QRC,←ZRC,←ZQR]
theorem NQC (x : ℕ) : coe_QC (coe_NQ x) = coe_NC x := by rw [←NZC,←NZQ,←ZQC]
theorem NRC (x : ℕ) : coe_RC (coe_NR x) = coe_NC x := by rw [←NQC,←QRC,←NQR]

-- cool stuff my stuents constantly want to be able to do
example (x : ℤ) : ((x : ℚ) : ℝ) = x := ZQR x
example (x : ℤ) : let (y : ℚ) := ↑x in let (z : ℝ) := ↑y in z = ↑x := ZQR x

-- Gabriel's answer
example (x : ℤ) : ((x : ℚ) : ℝ) = x := by simp


import tidy.tidy
import data.set

open set

structure boolean_algebra ( α : Type ) :=
  ( contains : set (set α) )
  ( contains_universe : contains univ )
  ( complements : ∀ { s : set α }, contains s → contains (compl s) )
  ( unions : ∀ { s t : set α }, contains s → contains t → contains (s ∪ t) )

definition intersection_of_boolean_algebras { α β : Type } ( algebras : α → boolean_algebra β ) : boolean_algebra β :=
{
  contains          := λ s, ∀ a : α, (algebras a).contains s,
  contains_universe := begin intro a, exact (algebras a).contains_universe, end,
  complements       := begin intro s, intro f, intro a, exact (algebras a).complements (f a) end,
  unions            := begin intros s t, intros f g, intro a, exact (algebras a).unions (f a) (g a) end
}

definition boolean_algebra_coarser { α } ( B C : boolean_algebra α ) := C.contains ⊆ B.contains

structure boolean_algebra_containing { α } ( X : set (set α) ) :=
  ( algebra    : boolean_algebra α )
  ( containing : ∀ s ∈ X, algebra.contains s )

definition coarsest_boolean_algebra_containing { α } ( X : set (set α) ) : boolean_algebra α :=
intersection_of_boolean_algebras (@boolean_algebra_containing.algebra _ X)

definition countable_union        { α : Type } (f : ℕ → set α) : set α := (λ a : α, ∃ n : ℕ, a ∈ (f n))
definition countable_intersection { α : Type } (f : ℕ → set α) : set α := (λ a : α, ∀ n : ℕ, a ∈ (f n))

lemma complement_of_countable_union_as_countable_intersection { α } (f: ℕ → set α) : compl (countable_union f) = countable_intersection (compl ∘ f) :=
begin
  unfold countable_union countable_intersection set.compl,
  apply funext,
  intros x,
  dsimp',
  unfold set.mem set.compl,
  dsimp',
  apply propext,
  split,
  {
    intros,
    exact a ⟨ n, a_1 ⟩,
  },
  {
    intros,
    apply exists.elim a_1 a,
  }
end

lemma countable_union_of_complements_as_subset { α } (f: ℕ → set α) : countable_union (compl ∘ f) ⊆ compl (countable_intersection f) :=
begin
  unfold countable_union countable_intersection set.compl,
  intros x,
  dsimp',
  unfold set.mem set.compl,
  dsimp',
  intros,
  have p : ∀ n, ((f n x) → false) → false,
  intros n,
  exact non_contradictory_intro (a_1 n),
  apply exists.elim a p,
end

structure sigma_algebra ( α : Type ) extends boolean_algebra α :=
  ( countable_unions        : ∀ { f : ℕ → set α }, (Π n : ℕ, contains (f n)) → contains (countable_union        f) )
  ( countable_intersections : ∀ { f : ℕ → set α }, (Π n : ℕ, contains (f n)) → contains (countable_intersection f) )

-- It requires classical logic, apparently, to deduce countable intersections from countable unions.

structure is_sigma_algebra { α } ( contains : set (set α ) ) :=
  ( sigma_algebra : sigma_algebra α )
  ( witness : sigma_algebra.contains = contains )

definition intersection_of_sigma_algebras { α β : Type } ( algebras : α → sigma_algebra β ) : sigma_algebra β :=
{ @intersection_of_boolean_algebras α β (λ a, (algebras a).to_boolean_algebra) with
  countable_unions := begin
                        intros s w,
                        intro a,
                        tidy,
                        let v := λ n, w n a,
                        exact (algebras a).countable_unions v,
                      end,
  countable_intersections := begin
                        intros s w,
                        intro a,
                        tidy,
                        let v := λ n, w n a,
                        exact (algebras a).countable_intersections v,
                      end
}

structure sigma_algebra_containing { α } ( X : set (set α) ) :=
  ( algebra    : sigma_algebra α )
  ( containing : ∀ s ∈ X, algebra.contains s )

definition coarsest_sigma_algebra_containing { α } ( X : set (set α) ) : sigma_algebra α :=
intersection_of_sigma_algebras (@sigma_algebra_containing.algebra _ X)

lemma coarsest_sigma_algebra_contains_generators { α } ( X : set (set α) ) : X ⊆ (coarsest_sigma_algebra_containing X).contains :=
begin
  tidy,
  unfold set.subset,
  tidy,
  unfold set.mem,
  tidy,
  have p := a_2.containing a a_1,
  tidy
end

lemma sigma_algebra_containing_contains_coarsest_sigma_algebra_containing
  { α }
  ( X : set (set α) )
  ( m : sigma_algebra α )
  ( w : X ⊆ m.contains )
  : (coarsest_sigma_algebra_containing X).contains ⊆ m.contains :=
begin
  tidy,
  unfold set.subset,
  intros Y,
  intros p,
  tidy,
  unfold set.mem at p,
  let c : sigma_algebra_containing X := ⟨ m, ♯ ⟩,
  let q := p c,
  tidy,
end

structure decreasing_sequence ( α : Type ) :=
  ( sets : ℕ → set α )
  ( decreasing : ∀ n : ℕ, (sets (n+1)) ⊆ (sets n) )

attribute [applicable] decreasing_sequence.decreasing

definition countable_decreasing_intersection { α } ( f: decreasing_sequence α ) : set α := countable_intersection f.sets

structure increasing_sequence ( α : Type ) :=
  ( sets : ℕ → set α )
  ( increasing : ∀ n : ℕ, (sets n) ⊆ (sets (n+1)) )

attribute [applicable] increasing_sequence.increasing

definition countable_increasing_union { α } ( f: increasing_sequence α ) : set α := countable_union f.sets

@[applicable] lemma compl_subset_compl { α } ( X Y : set α ) ( p : Y ⊆ X ) : (-X) ⊆ (-Y) :=
begin
  tidy,
  unfold set.subset,
  unfold set.subset at p,
  intros,
  unfold set.compl,
  unfold set.compl at a_1,
  tidy,
  unfold set.mem,
  unfold set.mem at a_1,
  intros,
  exact a_1 (p a_2),
end

def complement_decreasing_sequence { α } ( f : decreasing_sequence α ) : increasing_sequence α :=
{
  sets := λ n, -(f.sets n),
  increasing := ♯
}
def complement_increasing_sequence { α } ( f : increasing_sequence α ) : decreasing_sequence α :=
{
  sets := λ n, -(f.sets n),
  decreasing := ♯
}

lemma complement_decreasing_intersection { α } ( f: decreasing_sequence α ) : -(countable_decreasing_intersection f) = countable_increasing_union (complement_decreasing_sequence f) :=
begin
  tidy,
  unfold compl,
  unfold complement_decreasing_sequence,
  unfold countable_decreasing_intersection,
  unfold countable_increasing_union,
  unfold countable_intersection,
  unfold countable_union,
  tidy,
  unfold set.mem,
  unfold compl,
  tidy,
  admit
end

lemma complement_increasing_union { α } ( f: increasing_sequence α ) : -(countable_increasing_union f) = countable_decreasing_intersection (complement_increasing_sequence f) := sorry

structure monotone_class ( α : Type ) :=
  ( contains : set (set α) )
  ( countable_decreasing_intersections : ∀ f : decreasing_sequence α, (Π n : ℕ, contains (f.sets n)) → contains (countable_decreasing_intersection f))
  ( countable_increasing_unions        : ∀ f : increasing_sequence α, (Π n : ℕ, contains (f.sets n)) → contains (countable_increasing_union        f))

instance { α } : has_subset (monotone_class α) := {
  subset := λ m n, m.contains ⊆ n.contains
}

@[applicable] lemma monotone_class.equality { α } { m n : monotone_class α } ( p : m.contains = n.contains ) : m = n :=
begin
  cases m,
  cases n,
  tidy,
end

@[applicable] lemma monotone_class.antisymmetry { α } { m n : monotone_class α } ( p : m ⊆ n ) ( q : n ⊆ m ) : m = n :=
begin
  apply monotone_class.equality,
  apply subset.antisymm,
  exact p,
  exact q,
end

structure is_monotone_class { α } ( contains : set (set α ) ) :=
  ( monotone_class : monotone_class α )
  ( witness : monotone_class.contains = contains )

definition intersection_of_monotone_classes { α β : Type } ( classes : α → monotone_class β ) : monotone_class β :=
{
  contains          := λ s, ∀ a : α, (classes a).contains s,
  countable_decreasing_intersections := begin
                                          intros f w a,
                                          let v := λ n, w n a,
                                          exact (classes a).countable_decreasing_intersections f v,
                                        end,
  countable_increasing_unions        := begin
                                          intros f w a,
                                          let v := λ n, w n a,
                                          exact (classes a).countable_increasing_unions f v,
                                        end
}

@[reducible] definition monotone_class.intersect { α : Type } ( m n : monotone_class α ) : monotone_class α :=
{
  contains := λ s, m.contains s ∧ n.contains s,
  countable_decreasing_intersections := begin
                                          intros,
                                          split,
                                          let v := λ n, (a n).left,
                                          exact m.countable_decreasing_intersections f v,
                                          let w := λ n, (a n).right,
                                          exact n.countable_decreasing_intersections f w,
                                 end,
  countable_increasing_unions := begin
                                   intros,
                                   split,
                                   let v := λ n, (a n).left,
                                   exact m.countable_increasing_unions f v,
                                   let w := λ n, (a n).right,
                                   exact n.countable_increasing_unions f w,
                                 end
}
instance { α } : has_inter (monotone_class α) := {
  inter := monotone_class.intersect
}

structure monotone_class_containing { α } ( X : set (set α) ) :=
  ( monotone_class      : monotone_class α )
  ( containing : ∀ s ∈ X, monotone_class.contains s )

definition coarsest_monotone_class_containing { α } ( X : set (set α) ) : monotone_class α :=
intersection_of_monotone_classes (@monotone_class_containing.monotone_class _ X)

lemma coarsest_monotone_class_contains_generators { α } ( X : set (set α) ) : X ⊆ (coarsest_monotone_class_containing X).contains :=
begin
  tidy,
  unfold set.subset,
  tidy,
  unfold set.mem,
  tidy,
  have p := a_2.containing a a_1,
  tidy
end

lemma monotone_class_containing_contains_coarsest_monotone_class_containing
  { α }
  ( X : set (set α) )
  ( m : monotone_class α )
  ( w : X ⊆ m.contains )
  : (coarsest_monotone_class_containing X).contains ⊆ m.contains :=
begin
  tidy,
  unfold set.subset,
  intros Y,
  intros p,
  tidy,
  unfold set.mem at p,
  let c : monotone_class_containing X := ⟨ m, ♯ ⟩,
  let q := p c,
  tidy,
end

@[reducible] definition monotone_class.complement { α } ( M : monotone_class α ) : monotone_class α := {
  contains := λ s, M.contains (- s),
  countable_decreasing_intersections := begin
                                          intros f w,
                                          rewrite complement_decreasing_intersection,
                                          apply M.countable_increasing_unions,
                                          unfold complement_decreasing_sequence,
                                          tidy,
                                        end,
  countable_increasing_unions        := begin
                                          intros f w,
                                          rewrite complement_increasing_union,
                                          apply M.countable_decreasing_intersections,
                                          unfold complement_increasing_sequence,
                                          tidy,
                                        end
}

lemma monotone_class_generated_by_a_boolean_algebra_equals_its_complement { α } ( B : boolean_algebra α ) : (coarsest_monotone_class_containing B.contains).contains = (coarsest_monotone_class_containing B.contains).complement.contains :=
begin
  let C := coarsest_monotone_class_containing (B.contains),
  let D := C ∩ (C.complement),
  have p : D ⊆ C, {
    tidy,
    unfold set.mem,
    unfold set.mem at a_1,
    tidy,
    exact (a_1.left a_2)
  },
  have q : B.contains ⊆ D.contains, {
    tidy,
    unfold set.mem,
    tidy,
    exact a_2.containing a a_1,
    exact a_2.containing (compl a) (B.complements a_1),
  },
  have r : C ⊆ D, {
    admit,
  },
  have s : C = D, {  },
  admit
end

lemma monotone_class_generated_by_a_boolean_algebra_is_a_sigma_algebra
  { α }
  ( B : boolean_algebra α )
  : is_sigma_algebra (coarsest_monotone_class_containing B.contains).contains :=
begin
  fsplit,
  fsplit,
  fsplit,
  {
    -- first we specify the underlying family of sets
    exact (coarsest_monotone_class_containing B.contains).contains,
  },
  {
    -- the universe is in the monotone class because it is in the boolean algebra
    apply coarsest_monotone_class_contains_generators,
    exact B.contains_universe,
  },
  {
    -- contains complements?
    admit,
  },
  admit,
  admit,
  admit,
  admit,
end

lemma sigma_algebra_generated_by_a_boolean_algebra_is_a_monotone_class
  { α }
  ( B : boolean_algebra α )
  : is_monotone_class (coarsest_sigma_algebra_containing B.contains).contains :=
begin
  let M := coarsest_sigma_algebra_containing B.contains,
  fsplit,
  fsplit,
  {
    exact M.contains,
  },
  {
    -- decreasing intersections
    have c := M.countable_intersections,
    intros f n w,
    exact c n w,
  },
  {
    -- increasing unions
    have c := M.countable_unions,
    intros f n w,
    exact c n w,
  },
  tidy,
end

private lemma monotone_class_generated_by_a_boolean_algebra_as_a_sigma_algebra  { α } ( B : boolean_algebra α ) : (coarsest_monotone_class_containing (B.contains)).contains = (monotone_class_generated_by_a_boolean_algebra_is_a_sigma_algebra B).sigma_algebra.contains :=
begin
  rewrite (monotone_class_generated_by_a_boolean_algebra_is_a_sigma_algebra B).witness,
end
private lemma sigma_algebra_generated_by_a_boolean_algebra_as_a_monotone_class  { α } ( B : boolean_algebra α ) : (coarsest_sigma_algebra_containing (B.contains)).contains = (sigma_algebra_generated_by_a_boolean_algebra_is_a_monotone_class B).monotone_class.contains :=
begin
  rewrite (sigma_algebra_generated_by_a_boolean_algebra_is_a_monotone_class B).witness,
end

theorem monotone_class_lemma
  { α }
  ( B : boolean_algebra α )
  : (coarsest_sigma_algebra_containing B.contains).contains = (coarsest_monotone_class_containing B.contains).contains :=
begin
  apply subset.antisymm,
  {
    rewrite monotone_class_generated_by_a_boolean_algebra_as_a_sigma_algebra,
    -- FIXME why does unification fail without specifying arguments?
    apply sigma_algebra_containing_contains_coarsest_sigma_algebra_containing
      B.contains
      ((monotone_class_generated_by_a_boolean_algebra_is_a_sigma_algebra B).sigma_algebra),
    rewrite ← monotone_class_generated_by_a_boolean_algebra_as_a_sigma_algebra,
    apply coarsest_monotone_class_contains_generators B.contains
  },
  {
    rewrite sigma_algebra_generated_by_a_boolean_algebra_as_a_monotone_class,
    -- FIXME
    apply monotone_class_containing_contains_coarsest_monotone_class_containing
      B.contains
      ((sigma_algebra_generated_by_a_boolean_algebra_is_a_monotone_class B).monotone_class),
    rewrite ← sigma_algebra_generated_by_a_boolean_algebra_as_a_monotone_class,
    apply coarsest_sigma_algebra_contains_generators B.contains
  }
end