import prelim.induction prelim.collections .rankfun
open set

universe u

open_locale classical
noncomputable theory
----------------------------------------------------------------

variables {α : Type*} [fintype α]

namespace indep_family

def is_set_basis (M : indep_family α) :=
  λ B X, B ⊆ X ∧ M.indep B ∧ ∀ J, B ⊂ J → J ⊆ X → ¬M.indep J

lemma extends_to_basis {M : indep_family α} {I X : set α} :
  I ⊆ X → M.indep I → ∃ B, I ⊆ B ∧ M.is_set_basis B X :=
  begin
    intros h₁ h₂,
    rcases maximal_example (λ I, (I ⊆ X ∧ M.indep I)) ⟨h₁, h₂⟩ with ⟨B, ⟨hB, ⟨h₁B, h₂B⟩⟩⟩, use B,
    from ⟨hB, ⟨h₁B.1,⟨h₁B.2,λ J h₁J h₂J, not_and.mp (h₂B J h₁J) h₂J⟩⟩⟩
  end

/-- choose extension of an independent set I to a basis of X-/
def choose_extension_to_basis (M : indep_family α) {I X : set α} (hIX : I ⊆ X) (hInd : M.indep I) : set α :=
  classical.some (extends_to_basis hIX hInd)

/-- choose a basis of X -/
def choose_set_basis (M : indep_family α) (X : set α) :=
  M.choose_extension_to_basis (empty_subset X) (M.I1)

/-- properties of the choice of a basis of X-/
def choose_extension_to_basis_spec (M : indep_family α) {I X : set α} (hIX : I ⊆ X) (hInd : M.indep I) : _ :=
  classical.some_spec (extends_to_basis hIX hInd)

lemma choice_of_extension_to_basis_is_valid (M : indep_family α) {I X : set α} (hIX : I ⊆ X) (hInd : M.indep I) :
  I ⊆ (choose_extension_to_basis M hIX hInd) ∧ is_set_basis M (choose_extension_to_basis M hIX hInd) X :=
  classical.some_spec (extends_to_basis hIX hInd)

lemma choice_of_set_basis_is_valid (M : indep_family α) (X : set α) :
  is_set_basis M (M.choose_set_basis X) X :=
  (choice_of_extension_to_basis_is_valid M (empty_subset X) (M.I1)).2

lemma has_ext_to_basis (M : indep_family α) {I X : set α} :
  I ⊆ X → M.indep I → ∃ B, I ⊆ B ∧ is_set_basis M B X :=
  λ hIX hI, by {use choose_extension_to_basis M hIX hI,
                  from choice_of_extension_to_basis_is_valid M hIX hI}

lemma has_basis (M : indep_family α) (X : set α) :
  ∃ B, M.is_set_basis B X :=
  by {use choose_set_basis M X, from choice_of_set_basis_is_valid M X}

lemma size_ind_le_size_set_basis {M : indep_family α} {I B X : set α} :
  I ⊆ X → M.indep I → M.is_set_basis B X → size I ≤ size B :=
  begin
    intros hIX hI hB, by_contra hlt, push_neg at hlt,
    rcases M.I3 B I hlt hB.2.1 hI with ⟨e, ⟨h₁e, h₂e⟩ ⟩,
    rw mem_diff_iff at h₁e, refine hB.2.2 (B ∪ {e}) _ _ h₂e,
    from ssub_of_add_nonmem h₁e.2,
    from union_subset hB.1 (subset_of_mem_of_subset h₁e.1 hIX),
  end

lemma set_bases_equicardinal {M : indep_family α} {X B₁ B₂ : set α} :
  M.is_set_basis B₁ X → M.is_set_basis B₂ X → size B₁ = size B₂ :=
begin
  intros h₁ h₂, apply le_antisymm,
  from size_ind_le_size_set_basis h₁.1 h₁.2.1 h₂,
  from size_ind_le_size_set_basis h₂.1 h₂.2.1 h₁,
end

--lemma basis_ext_inter_set {M : indep_family α} {X B₁ }

def I_to_r (M : indep_family α) : (set α → ℤ) :=
  λ X, size (M.choose_set_basis X)

lemma I_to_r_max (M : indep_family α) (X : set α) :
  ∃ B, B ⊆ X ∧ M.indep B ∧ size B = M.I_to_r X :=
  by {use M.choose_set_basis X, have h := M.choice_of_set_basis_is_valid X,
            from ⟨h.1,⟨h.2.1,rfl⟩⟩}

lemma I_to_r_ub {M : indep_family α} {I X : set α} :
  I ⊆ X → M.indep I → size I ≤ M.I_to_r X :=
begin
  intros hI hInd, by_contra a, push_neg at a,
  let J := M.choose_set_basis X,
  have : M.is_set_basis J X := M.choice_of_set_basis_is_valid X,
  have := size_ind_le_size_set_basis hI hInd this,
  have : M.I_to_r X = size J := rfl,
  linarith,
end

lemma I_to_r_eq_iff {M : indep_family α} {X : set α} {n : ℤ} :
  M.I_to_r X = n ↔ ∃ B, M.is_set_basis B X ∧ size B = n :=
  let B₀ := M.choose_set_basis X, hB₀ := M.choice_of_set_basis_is_valid X in
begin
  refine ⟨λ h, ⟨B₀, ⟨hB₀,by {rw ←h, refl}⟩⟩, λ h,_⟩,
  rcases h with ⟨B, ⟨hB, hBsize⟩⟩,
  from (rfl.congr hBsize).mp (eq.symm (set_bases_equicardinal hB hB₀)),
end

lemma has_set_basis_with_size (M : indep_family α) (X : set α) :
  ∃ B, M.is_set_basis B X ∧ size B = M.I_to_r X :=
  I_to_r_eq_iff.mp (rfl : M.I_to_r X = M.I_to_r X)

lemma I_to_r_of_set_basis {M : indep_family α} {B X : set α} :
  M.is_set_basis B X → M.I_to_r X = size B :=
  λ h, set_bases_equicardinal (M.choice_of_set_basis_is_valid X) h

lemma has_nested_basis_pair (M : indep_family α){X Y : set α} :
  X ⊆ Y → ∃ BX BY, BX ⊆ BY ∧ M.is_set_basis BX X ∧ M.is_set_basis BY Y :=
begin
  intro hXY, rcases M.has_basis X with ⟨BX,hBX⟩,
  rcases M.has_ext_to_basis (subset.trans hBX.1 hXY) hBX.2.1 with ⟨BY, hBY⟩,
  use BX, use BY, from ⟨hBY.1,⟨hBX, hBY.2⟩⟩,
end

-----------------------------------------------------------------------

lemma I_to_R0 (M : indep_family α) :
  satisfies_R0 M.I_to_r :=
λ X, by {have := I_to_r_ub (empty_subset X) (M.I1), rw size_empty at this, assumption}

lemma I_to_R1 (M : indep_family α) :
  satisfies_R1 M.I_to_r :=
λ X, by {rcases M.I_to_r_max X with ⟨B, ⟨hBX, ⟨_, hsB⟩⟩⟩, from (eq.symm hsB).trans_le (size_monotone hBX)}

lemma I_to_r_of_indep (M : indep_family α) (I : set α) :
  M.indep I → M.I_to_r I = size I :=
λ h, le_antisymm (M.I_to_R1 I) (I_to_r_ub (subset_refl I) h)

lemma I_to_R2 (M : indep_family α) :
  satisfies_R2 M.I_to_r :=
begin
  intros X Y hXY, rcases M.I_to_r_max X with ⟨B,⟨hBX,⟨hIB,hsB⟩⟩⟩,
  have := I_to_r_ub (subset.trans hBX hXY) hIB, rw hsB at this, assumption
end

lemma I_to_r_eq_rank_basis_union {M : indep_family α} {B X: set α} (Y : set α) :
  M.is_set_basis B X → M.I_to_r (B ∪ Y) = M.I_to_r (X ∪ Y) :=
begin
  intro h,
  rcases M.has_ext_to_basis (subset.trans (h.1) (subset_union_left X Y)) h.2.1 with ⟨Bα, ⟨hαs, hαb⟩⟩,
  have h₁ := I_to_r_ub (_ : Bα ⊆ B ∪ Y) hαb.2.1,
  { linarith [M.I_to_R2 _ _ (union_subset_union_left Y h.1), I_to_r_of_set_basis hαb]},
  have : B = Bα ∩ X := by
  { have := I_to_r_ub (inter_subset_right Bα X) (M.I2 _ _ (inter_subset_left Bα X) hαb.2.1),
    rw [I_to_r_of_set_basis h] at this,
    exact eq_of_le_size_subset (subset_inter hαs h.1) this, },
  have h' := subset_iff_inter_eq_left.mp hαb.1, rw [inter_distrib_left, ←this] at h',
  rw ←h',
  exact union_subset_union_right _ (inter_subset_right Bα Y),
end

lemma I_to_R3 (M : indep_family α) :
  satisfies_R3 M.I_to_r :=
begin
  intros X Y,
  rcases M.has_nested_basis_pair (inter_subset_left X Y) with ⟨BI, BX, ⟨hss, ⟨hBI, hBX⟩⟩⟩,
  rcases M.has_ext_to_basis (subset.trans hBI.1 (inter_subset_right X Y)) hBI.2.1 with ⟨BY, ⟨hBIBY,hBY⟩⟩,
  rcases M.has_ext_to_basis (subset_union_left BX BY) hBX.2.1 with ⟨Bα, ⟨hBXBα,hBα⟩⟩,
  rw [←I_to_r_eq_rank_basis_union Y hBX, union_comm BX _,
      ←I_to_r_eq_rank_basis_union BX hBY, union_comm BY,
       I_to_r_of_set_basis hBI, I_to_r_of_set_basis hBX,
       I_to_r_of_set_basis hBα, I_to_r_of_set_basis hBY],
  have := size_monotone hBα.1, have := size_monotone (subset_inter hss hBIBY),
  linarith[size_modular BX BY]
end

end indep_family

namespace matroid

def of_indep_family (MI: indep_family α) : matroid α :=
  ⟨MI.I_to_r, MI.I_to_R0, MI.I_to_R1, MI.I_to_R2, MI.I_to_R3⟩

lemma indep_of_indep_family (MI : indep_family α) :
  (matroid.of_indep_family MI).is_indep = MI.indep :=
begin
  unfold is_indep of_indep_family, dsimp only, ext X,
  rcases MI.has_set_basis_with_size X with ⟨B, ⟨hB₁, hB₂, hB₃⟩, hBX⟩,
  refine ⟨λ h, _, λ h, _⟩,
  rw [←eq_of_eq_size_subset hB₁ _], from hB₂,
  from eq.trans hBX h,
  cases subset_ssubset_or_eq hB₁ with h' h',
  from false.elim (hB₃ _  h' (subset_refl _) h),
  rw h' at hBX, from hBX.symm,
end

end matroid


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module data.set.semiring
! leanprover-community/mathlib commit 62e8311c791f02c47451bf14aa2501048e7c2f33
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Kleene
import Mathlib.Data.Set.Pointwise.SMul

/-!
# Sets as a semiring under union

This file defines `SetSemiring α`, an alias of `Set α`, which we endow with `∪` as addition and
pointwise `*` as multiplication. If `α` is a (commutative) monoid, `SetSemiring α` is a
(commutative) semiring.
-/

open Function Set

open Pointwise

variable {α β : Type _}

-- Porting note: mathlib3 uses `deriving Inhabited, PartialOrder, OrderBot`
/-- An alias for `Set α`, which has a semiring structure given by `∪` as "addition" and pointwise
  multiplication `*` as "multiplication". -/
def SetSemiring (α : Type _) : Type _ :=
  Set α
#align set_semiring SetSemiring

noncomputable instance (α : Type _) : Inhabited (SetSemiring α) :=
  (inferInstance : Inhabited (Set _))

instance (α : Type _) : PartialOrder (SetSemiring α) :=
  (inferInstance : PartialOrder (Set _))

instance (α : Type _) : OrderBot (SetSemiring α) :=
  (inferInstance : OrderBot (Set _))

/-- The identity function `Set α → SetSemiring α`. -/
protected def Set.up : Set α ≃ SetSemiring α :=
  Equiv.refl _
#align set.up Set.up

namespace SetSemiring

/-- The identity function `SetSemiring α → Set α`. -/
protected def down : SetSemiring α ≃ Set α :=
  Equiv.refl _
#align set_semiring.down SetSemiring.down

--Porting note: new, since dot notation doesn't work
open SetSemiring (down)
open Set (up)

--Porting note: dot notation no longer works
@[simp]
protected theorem down_up (s : Set α) : SetSemiring.down (Set.up s) = s :=
  rfl
#align set_semiring.down_up SetSemiring.down_up

--Porting note: dot notation no longer works
@[simp]
protected theorem up_down (s : SetSemiring α) : Set.up (SetSemiring.down s) = s :=
  rfl
#align set_semiring.up_down SetSemiring.up_down

-- TODO: These lemmas are not tagged `simp` because `Set.le_eq_subset` simplifies the LHS
--Porting note: dot notation no longer works
theorem up_le_up {s t : Set α} : Set.up s ≤ Set.up t ↔ s ⊆ t :=
  Iff.rfl
#align set_semiring.up_le_up SetSemiring.up_le_up

--Porting note: dot notation no longer works
theorem up_lt_up {s t : Set α} : Set.up s < Set.up t ↔ s ⊂ t :=
  Iff.rfl
#align set_semiring.up_lt_up SetSemiring.up_lt_up

--Porting note: dot notation no longer works
@[simp]
theorem down_subset_down {s t : SetSemiring α} : SetSemiring.down s ⊆ SetSemiring.down t ↔ s ≤ t :=
  Iff.rfl
#align set_semiring.down_subset_down SetSemiring.down_subset_down

--Porting note: dot notation no longer works
@[simp]
theorem down_ssubset_down {s t : SetSemiring α} : SetSemiring.down s ⊂ SetSemiring.down t ↔ s < t :=
  Iff.rfl
#align set_semiring.down_ssubset_down SetSemiring.down_ssubset_down

--Porting note: dot notation no longer works
instance : AddCommMonoid (SetSemiring α) where
  add s t := Set.up (SetSemiring.down s ∪ SetSemiring.down t)
  zero := Set.up (∅ : Set α)
  add_assoc := union_assoc
  zero_add := empty_union
  add_zero := union_empty
  add_comm := union_comm

theorem zero_def : (0 : SetSemiring α) = Set.up ∅ :=
  rfl
#align set_semiring.zero_def SetSemiring.zero_def

@[simp]
theorem down_zero : down (0 : SetSemiring α) = ∅ :=
  rfl
#align set_semiring.down_zero SetSemiring.down_zero

@[simp]
theorem _root_.Set.up_empty : Set.up (∅ : Set α) = 0 :=
  rfl
#align set.up_empty Set.up_empty

theorem add_def (s t : SetSemiring α) : s + t = up (down s ∪ down t) :=
  rfl
#align set_semiring.add_def SetSemiring.add_def

@[simp]
theorem down_add (s t : SetSemiring α) : down (s + t) = down s ∪ down t :=
  rfl
#align set_semiring.down_add SetSemiring.down_add

@[simp]
theorem _root_.Set.up_union (s t : Set α) : up (s ∪ t) = up s + up t :=
  rfl
#align set.up_union Set.up_union

/- Since addition on `SetSemiring` is commutative (it is set union), there is no need
to also have the instance `CovariantClass (SetSemiring α) (SetSemiring α) (swap (+)) (≤)`. -/
instance covariantClass_add : CovariantClass (SetSemiring α) (SetSemiring α) (· + ·) (· ≤ ·) :=
  ⟨fun _ _ _ => union_subset_union_right _⟩
#align set_semiring.covariant_class_add SetSemiring.covariantClass_add

section Mul

variable [Mul α]

--Porting note: dot notation no longer works
instance : NonUnitalNonAssocSemiring (SetSemiring α) :=
  { (inferInstance : AddCommMonoid (SetSemiring α)) with
    mul := fun s t => Set.up (image2 (· * ·) (SetSemiring.down s) (SetSemiring.down t))
    zero_mul := fun _ => empty_mul
    mul_zero := fun _ => mul_empty
    left_distrib := fun _ _ _ => mul_union
    right_distrib := fun _ _ _ => union_mul }

-- TODO: port
theorem mul_def (s t : SetSemiring α) : s * t = up (down s * down t) :=
  rfl
#align set_semiring.mul_def SetSemiring.mul_def

@[simp]
theorem down_mul (s t : SetSemiring α) : down (s * t) = down s * down t :=
  rfl
#align set_semiring.down_mul SetSemiring.down_mul

@[simp]
theorem _root_.Set.up_mul (s t : Set α) : up (s * t) = up s * up t :=
  rfl
#align set.up_mul Set.up_mul

instance : NoZeroDivisors (SetSemiring α) :=
  ⟨fun {a b} ab =>
    a.eq_empty_or_nonempty.imp_right fun ha =>
      b.eq_empty_or_nonempty.resolve_right fun hb =>
        Nonempty.ne_empty ⟨_, mul_mem_mul ha.some_mem hb.some_mem⟩ ab⟩

instance covariantClass_mul_left :
    CovariantClass (SetSemiring α) (SetSemiring α) (· * ·) (· ≤ ·) :=
  ⟨fun _ _ _ => mul_subset_mul_left⟩
#align set_semiring.covariant_class_mul_left SetSemiring.covariantClass_mul_left

instance covariantClass_mul_right :
    CovariantClass (SetSemiring α) (SetSemiring α) (swap (· * ·)) (· ≤ ·) :=
  ⟨fun _ _ _ => mul_subset_mul_right⟩
#align set_semiring.covariant_class_mul_right SetSemiring.covariantClass_mul_right

end Mul

section One

variable [One α]

-- porting note: noncomputable?
noncomputable instance : One (SetSemiring α) where one := Set.up (1 : Set α)

theorem one_def : (1 : SetSemiring α) = Set.up 1 :=
  rfl
#align set_semiring.one_def SetSemiring.one_def

@[simp]
theorem down_one : down (1 : SetSemiring α) = 1 :=
  rfl
#align set_semiring.down_one SetSemiring.down_one

@[simp]
theorem _root_.Set.up_one : up (1 : Set α) = 1 :=
  rfl
#align set.up_one Set.up_one

end One

instance [MulOneClass α] : NonAssocSemiring (SetSemiring α) :=
  { (inferInstance : NonUnitalNonAssocSemiring (SetSemiring α)),
    Set.mulOneClass with
    one := 1
    mul := (· * ·) }

instance [Semigroup α] : NonUnitalSemiring (SetSemiring α) :=
  { (inferInstance : NonUnitalNonAssocSemiring (SetSemiring α)), Set.semigroup with }

instance [Monoid α] : IdemSemiring (SetSemiring α) :=
  { (inferInstance : NonAssocSemiring (SetSemiring α)),
    (inferInstance : NonUnitalSemiring (SetSemiring α)),
    (inferInstance : CompleteBooleanAlgebra (Set α)) with }

instance [CommSemigroup α] : NonUnitalCommSemiring (SetSemiring α) :=
  { (inferInstance : NonUnitalSemiring (SetSemiring α)), Set.commSemigroup with }

instance [CommMonoid α] : IdemCommSemiring (SetSemiring α) :=
  { (inferInstance : IdemSemiring (SetSemiring α)),
    (inferInstance : CommMonoid (Set α)) with }

instance [CommMonoid α] : CommMonoid (SetSemiring α) :=
  { (inferInstance : Monoid (SetSemiring α)), Set.commSemigroup with }

instance [CommMonoid α] : CanonicallyOrderedCommSemiring (SetSemiring α) :=
  { (inferInstance : Semiring (SetSemiring α)), (inferInstance : CommMonoid (SetSemiring α)),
    (inferInstance : PartialOrder (SetSemiring α)), (inferInstance : OrderBot (SetSemiring α)),
    (inferInstance : NoZeroDivisors (SetSemiring α)) with
    add_le_add_left := fun _ _ => add_le_add_left
    exists_add_of_le := fun {_ b} ab => ⟨b, (union_eq_right_iff_subset.2 ab).symm⟩
    le_self_add := subset_union_left }

/-- The image of a set under a multiplicative homomorphism is a ring homomorphism
with respect to the pointwise operations on sets. -/
def imageHom [MulOneClass α] [MulOneClass β] (f : α →* β) : SetSemiring α →+* SetSemiring β
    where
  toFun s := up (image f (down s))
  map_zero' := image_empty _
  map_one' := by
    dsimp only  -- porting note: structures do not do this automatically any more
    rw [down_one, image_one, map_one, singleton_one, up_one]
  map_add' := image_union _
  map_mul' _ _ := image_mul f
#align set_semiring.image_hom SetSemiring.imageHom

lemma imageHom_def [MulOneClass α] [MulOneClass β] (f : α →* β) (s : SetSemiring α) :
    imageHom f s = up (image f (down s)) :=
  rfl
#align set_semiring.image_hom_def SetSemiring.imageHom_def

@[simp]
lemma down_imageHom [MulOneClass α] [MulOneClass β] (f : α →* β) (s : SetSemiring α) :
    down (imageHom f s) = f '' down s :=
  rfl
#align set_semiring.down_image_hom SetSemiring.down_imageHom

@[simp]
lemma _root_.Set.up_image [MulOneClass α] [MulOneClass β] (f : α →* β) (s : Set α) :
    up (f '' s) = imageHom f (up s) :=
  rfl
#align set.up_image Set.up_image

end SetSemiring


-- Reconstrucción de espacios topológicos en Lean
-- =====================================================================

-- =====================================================================
-- § Introducción                                                     --
-- =====================================================================

-- Mathlib tiene una gran biblioteca de resultados sobre espacios
-- topológicos, incluyendo varias construcciones, axiomas de separación,
-- el teorema de Tychonoff, gavillas, la compactificación de Stone-Čech,
-- Heine-Cantor, por nombrar sólo algunos.
--
-- Véase https://leanprover-community.github.io/theories/topology.html
-- que para un (subconjunto) de lo que hay en la biblioteca.
--
-- Pero hoy ignoraremos todo eso y construiremos nuestra propia versión
-- de los espacios topológicos desde cero.
--
-- Primero un poco de preparación, vamos a hacer definiciones que
-- involucran a los números reales, cuya teoría no es computable, y
-- usaremos conjuntos

-- ---------------------------------------------------------------------
-- Ejercicio 1. Importar las librerías de tácricas, conjuntos finitos y la
-- de los números reales.
-- ---------------------------------------------------------------------

import tactic
import data.set.finite
import data.real.basic

-- ---------------------------------------------------------------------
-- Ejercicio 2. Declarar la teoría como no computable.
-- ---------------------------------------------------------------------

noncomputable theory

-- ---------------------------------------------------------------------
-- Ejercicio 3. Abrir el espacio de nombre de los conjuntos (`set`).
-- ---------------------------------------------------------------------

open set

-- =====================================================================
-- § ¿Qué es un espacio topológico?                                   --
-- =====================================================================

-- Un espacio topológico, según la Wikipedia, es un par ordenado (X, τ),
-- donde X es un conjunto y τ es una colección de subconjuntos de X, que
-- satisface los siguientes axiomas:
-- + A1. El conjunto vacío pertenece a τ.
-- + A2. El propio X pertenece a τ.
-- + A3. Cualquier unión arbitraria (finita o infinita) de miembros de τ
--   sigue perteneciendo a τ.
-- + A4, La intersección de cualquier número finito de miembros de τ sigue
--   perteneciendo a τ.

-- ---------------------------------------------------------------------
-- Ejercicio 4. Definir la clase de los espacios topológios
-- correspondiente a la definición de la Wikipedia.
-- ---------------------------------------------------------------------

class topological_space_wiki :=
  (X : Type)                                    -- El tipo baśico
  (τ : set (set X))                             -- Los abiertos
  (empty_mem : ∅ ∈ τ)                           -- A1
  (univ_mem : univ ∈ τ)                         -- A2
  (union : ∀ B ⊆ τ, ⋃₀ B ∈ τ)                   -- A3
  (inter : ∀ (B ⊆ τ) (h : finite B), ⋂₀ B ∈ τ)  -- A4

-- ---------------------------------------------------------------------
-- Ejercicio 5. Definir la clase de los espacios topológicos usando el
-- predicado `is_open : set X → Prop` en lugar del conjunto de los
-- abiertos y usando sólo la intersección binaria de abiertos.
-- ---------------------------------------------------------------------

@[ext]
class topological_space (X : Type) :=
  (is_open : set X → Prop)
  -- (empty_mem : is_open ∅) -- Se demostrará en el ejercicio 8
  (univ_mem : is_open univ)
  (union : ∀ (B : set (set X)) (h : ∀ b ∈ B, is_open b), is_open (⋃₀ B))
  (inter : ∀ (A B : set X) (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

-- --------
-------------------------------------------------------------
-- Ejercicio 6. Abrir el espacio de nombre de los espacios topológicos
-- (`topological_space`).
-- ---------------------------------------------------------------------

namespace topological_space

-- ---------------------------------------------------------------------
-- Ejercicio 7. Demostrar que la intersección de tres abiertos es un
-- conjunto abierto.
-- ---------------------------------------------------------------------

example
  (X : Type)
  [topological_space X]
  (U V W : set X)
  (hU : is_open U)
  (hV : is_open V)
  (hW : is_open W)
  : is_open (U ∩ V ∩ W) :=
begin
  apply inter _ _ _ hW,
  exact inter _ _ hU hV,
end

-- ---------------------------------------------------------------------
-- Ejercicio 8. Uno de los axiomas de un espacio topológico que tenemos es
-- no necesario, se deduce de los otros. Si lo eliminamos tendremos
-- menos trabajo que hacer cada vez que queramos crear un nuevo espacio
-- topológico así que:
--
-- 1. Identifica y elimina el axioma innecesario, asegúrate de
--    eliminarlo en todo el archivo.
-- 2. Volver a añadir el axioma como un lema con el mismo nombre y
--    demostrarlo en base a los otros, para que la interfaz sea la
--    misma.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (X : Type)
  [topological_space X]
  : is_open (∅ : set X) :=
begin
  have h1: (∅ : set X) = ⋃₀(∅ : set (set X)) := sUnion_empty.symm,
  rw h1,
  apply union,
  simp,
end

-- 2ª demostración
lemma empty_mem
  (X : Type)
  [topological_space X]
  : is_open (∅ : set X) :=
begin
  convert union (∅ : set (set X)) _ ;
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio 9. Definir la topología discreta en la que todos los
-- subconjuntos son abiertos.
-- ---------------------------------------------------------------------

def discrete (X : Type) : topological_space X :=
{ is_open  := λ U, true,
  univ_mem := trivial,
  union    := begin intros B h, trivial, end,
  inter    := begin intros A hA B hB, trivial, end }

-- ---------------------------------------------------------------------
-- Ejercicio 10. Los conjuntos costructibles de un espacio topológico
-- son los obtenidos mediante las siguientes reglas:
-- + La intersección de un conjunto abierto y otro cerrado es
--   construible.
-- + La unión de cualquier par de conjuntos construibles es
--   construible.
-- ---------------------------------------------------------------------

inductive is_constructible {X : Type} (T : topological_space X) : set X → Prop
| locally_closed :
    ∀ (A B : set X), is_open A → is_open B → is_constructible (A ∩ Bᶜ)
| union :
    ∀ A B, is_constructible A → is_constructible B → is_constructible (A ∪ B)

-- ---------------------------------------------------------------------
-- Ejercicio 11. Demostrar que el vacío es construible.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {X : Type}
  (T : topological_space X)
  : is_constructible T ∅ :=
begin
  have h1 : univ ∩ univᶜ = (∅ : set X),
    { calc univ ∩ univᶜ
           = univ ∩ ∅   : congr_arg ((∩) univ) compl_univ
       ... = ∅          : inter_empty univ, },
  rw ←h1,
  apply is_constructible.locally_closed,
  exact univ_mem,
  exact univ_mem,
end

-- 2ª demostración
example
  {X : Type}
  (T : topological_space X)
  : is_constructible T ∅ :=
begin
  have h1 : univ ∩ univᶜ = (∅ : set X),
    { simp, },
  rw ←h1,
  exact is_constructible.locally_closed univ univ univ_mem univ_mem,
end

-- 3ª demostración
example
  {X : Type}
  (T : topological_space X)
  : is_constructible T ∅ :=
begin
  have := is_constructible.locally_closed univ univ univ_mem univ_mem,
  simpa,
end

-- 4ª demostración
example
  {X : Type}
  (T : topological_space X)
  : is_constructible T ∅ :=
begin
  convert is_constructible.locally_closed univ univ univ_mem univ_mem,
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio 12. Para cada conjunto de conjuntos de X, definir los
-- abiertos generados por X mediante las siguientes reglas:
-- + Los elementos de g son abiertos.
-- + El universal es abierto.
-- + La intersección de dos abiertos es abierto.
-- + La unión de un conjunto de abiertos es abierto.
-- ---------------------------------------------------------------------

inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
| basic  : ∀ s ∈ g, generated_open s
| univ   : generated_open univ
| inter  : ∀s t, generated_open s → generated_open t → generated_open (s ∩ t)
| sUnion : ∀k, (∀ s ∈  k, generated_open s) → generated_open (⋃₀ k)

-- ---------------------------------------------------------------------
-- Ejercicio 13. Sea g un conjunto de conjuntos de X. Demostrar que el
-- vacío es un abierto generado por g.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (X : Type)
  (g : set (set X))
  : generated_open X g ∅ :=
begin
  have h1 : ⋃₀(∅ : set (set X)) = ∅ := sUnion_empty,
  rw ←h1,
  apply generated_open.sUnion,
  simp,
end

-- 2ª demostración
lemma generated_open.empty
  (X : Type)
  (g : set (set X))
  : generated_open X g ∅ :=
begin
  have := generated_open.sUnion (∅ : set (set X)),
  simpa,
end

-- ---------------------------------------------------------------------
-- Ejercicio 14. Para cada conjunto de conjuntos de X, definir el
-- espacio topológico generado por g.
-- ---------------------------------------------------------------------

def generate_from (X : Type) (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := generated_open.univ,
  inter     := generated_open.inter,
  union     := generated_open.sUnion }

-- ---------------------------------------------------------------------
-- Ejercicio 15. Definir la topología indiscreta sobre X; es decir, la
-- topología cuyos únicos abiertos son el vacío y el universal.
-- ---------------------------------------------------------------------

def indiscrete (X : Type) : topological_space X :=
  generate_from X ∅

-- ---------------------------------------------------------------------
-- Ejercicio 16. Definir el producto de dos espacios topológicos.
-- ---------------------------------------------------------------------

instance prod.topological_space
  (X Y : Type)
  [topological_space X]
  [topological_space Y]
  : topological_space (X × Y) :=
topological_space.generate_from
  (X × Y)
  {U | ∃ (Ux : set X) (Uy : set Y) (hx : is_open Ux) (hy : is_open Uy),
       U = set.prod Ux Uy}

-- ---------------------------------------------------------------------
-- Ejercicio 17. Sean X e Y dos espacios topológicos y S ⊆ X × Y.
-- Demostrar que S es un abiertos del producto de X e Y si, y sólo si,
-- para todo (a,b) ∈ S, existen abiertos U y V tales que a ∈ U, b ∈ V
-- y U × V ⊆ S.
-- ---------------------------------------------------------------------

lemma is_open_prod_iff
  (X Y : Type)
  [topological_space X]
  [topological_space Y]
  {s : set (X × Y)}
  : is_open s ↔ (∀a b, (a, b) ∈ s → ∃u v, is_open u ∧
                                          is_open v ∧
                                          a ∈ u ∧
                                          b ∈ v ∧
                                          set.prod u v ⊆ s) :=
sorry

-- =====================================================================
-- § Espacios métricos                                                --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir localmente la teoría de los grandes operadores.
-- ---------------------------------------------------------------------

open_locale big_operators

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los espacios métricos.
-- ---------------------------------------------------------------------

class metric_space_basic (X : Type) :=
  (dist : X → X → ℝ)
  (dist_eq_zero_iff : ∀ x y, dist x y = 0 ↔ x = y)
  (dist_symm : ∀ x y, dist x y = dist y x)
  (triangle : ∀ x y z, dist x z ≤ dist x y + dist y z)

-- ---------------------------------------------------------------------
-- Ejercicio. Crear el espacio de nombre metric_space_basic
-- ---------------------------------------------------------------------

namespace metric_space_basic

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombres topological_space.
-- ---------------------------------------------------------------------

open topological_space

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la distancia en los espacios métricos es no
-- negativa.
-- ---------------------------------------------------------------------

lemma dist_nonneg
  {X : Type}
  [metric_space_basic X]
  (x y : X)
  : 0 ≤ dist x y :=
begin
  have h : 0 ≤ 2 * dist x y,
    { calc 0
           = dist x x            : by rw (dist_eq_zero_iff x x).mpr rfl
       ... ≤ dist x y + dist y x : triangle x y x
       ... = dist x y + dist x y : by rw dist_symm
       ... = 2 * dist x y        : by rw two_mul (dist x y) },
  linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Sea X un espacio métrico. Definir el espacio topológico
-- generado por X.
-- ---------------------------------------------------------------------

instance {X : Type} [metric_space_basic X] : topological_space X :=
  generate_from X { B | ∃ (x : X) r, B = {y | dist x y < r} }

-- end metric_space_basic
--
-- open metric_space_basic

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el producto de dos espacios métricos.
-- ---------------------------------------------------------------------

instance prod.metric_space_basic
  (X Y : Type)
  [metric_space_basic X]
  [metric_space_basic Y]
  : metric_space_basic (X × Y) :=
{ dist := λ u v, max (dist u.fst v.fst) (dist u.snd v.snd),
  dist_eq_zero_iff :=
    begin
      intros u v,
      split,
      { intro h,
        have hf := dist_nonneg u.fst v.fst,
        have hs := dist_nonneg u.snd v.snd,
        have := max_le_iff.mp (le_of_eq h),
        ext,
        { rw ← dist_eq_zero_iff, linarith, },
        { rw ← dist_eq_zero_iff, linarith, }},
      { intro h,
        rw h,
        rw (dist_eq_zero_iff _ _).mpr,
        { rw (dist_eq_zero_iff _ _).mpr,
          rw max_self,
          refl,  },
        { refl, }},
    end,
  dist_symm :=
    begin
      intros u v,
      simp [metric_space_basic.dist_symm],
    end,
  triangle :=
    begin
      intros x y z,
      have hf := triangle x.fst y.fst z.fst,
      have hs := triangle x.snd y.snd z.snd,
      simp only [max],
      split_ifs; linarith,
    end
  }

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase de los espacios topológicos de tipo T₂.
-- ---------------------------------------------------------------------

class t2_space (X : Type) [topological_space X] :=
(t2 : ∀ (x y : X) (h : x ≠ y), ∃ (Ux Uy : set X)
                                 (hUx : is_open Ux)
                                 (hUy : is_open Uy)
                                 (hx : x ∈ Ux)
                                 (hy : y ∈ Uy),
                                Ux ∩ Uy = ∅

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si X es un espacio topológico T₂, entonces
--    {xy : X × X | xy.fst ≠ xy.snd }
-- es abierto.
-- ---------------------------------------------------------------------

example
  (X : Type)
  [topological_space X]
  [t2_space X]
  : is_open {xy : X × X | xy.fst ≠ xy.snd } :=
begin
  rw is_open_prod_iff X X,
  intros x y h,
  obtain ⟨Ux, Uy, hUx, hUy, hx, hy, hxy⟩ := t2_space.t2 x y h,
  use [Ux, Uy, hUx, hUy, hx, hy],
  rintros ⟨tx, ty⟩ ⟨ht1, ht2⟩,
  dsimp,
  intro txy,
  rw txy at *,
  have : ty ∈ Ux ∩ Uy := ⟨ht1, ht2⟩,
  rw hxy at this,
  exact this,
end

-- Nota: Desgraciadamente, hemos creado dos topologías en `X × Y`, una a
-- través de `prod.topology` que hemos definido antes como el producto
-- de las dos topologías procedentes de las respectivas estructuras del
-- espacio métrico. Y una procedente de la métrica sobre el producto.
--
-- Estos son iguales, es decir, la misma topología (de lo contrario,
-- matemáticamente el producto no sería una buena definición). Sin
-- embargo no son iguales por definición, existe una prueba no trivial
-- para demostrar que son iguales. El sistema de clases de tipos (que
-- encuentra la instancia del espacio topológico relevante cuando usamos
-- lemas que implican espacios topológicos) no es capaz de comprobar que
-- las estructuras de espacios topológicos que son iguales por alguna
-- razón no trivial son iguales sobre la marcha, por lo que se bloquea.
--
-- Podemos usar `extends` para decir que un espacio métrico es una
-- estructura extra además de ser un espacio topológico por lo que
-- estamos haciendo una elección de topología para cada espacio métrico.
--
-- Esto puede no ser *definidamente* igual a la topología inducida, pero
-- deberíamos añadir el axioma de que la métrica y la topología son
-- iguales para evitar que creemos una métrica induciendo una topología
-- diferente a la estructura topológica que elegimos.

class metric_space (X : Type) extends topological_space X, metric_space_basic X :=
  (compatible : ∀ U, is_open U ↔ generated_open X { B | ∃ (x : X) r, B = {y | dist x y < r}} U)

namespace metric_space

open topological_space

/- This might seem a bit inconvenient to have to define a topological space each time
we want a metric space.

We would still like a way of making a `metric_space` just given a metric and some
properties it satisfies, i.e. a `metric_space_basic`, so we should setup a metric space
constructor from a `metric_space_basic` by setting the topology to be the induced one. -/

def of_basic {X : Type} (m : metric_space_basic X) : metric_space X :=
{ compatible := begin intros, refl, /- this should work when the above parts are complete -/ end,
  ..m,
  ..@metric_space_basic.topological_space X m }

/- Now lets define the product of two metric spaces properly -/
instance {X Y : Type} [metric_space X] [metric_space Y] : metric_space (X × Y) :=
{ compatible :=
  begin
    -- Let's not fill this in for the demo, let me know if you do it!
    -- sorry
      rintros U,
      rw is_open_prod_iff,
      split; intro h,
      sorry,
      sorry,
    -- sorry
  end,
  ..prod.topological_space X Y,
  ..prod.metric_space_basic X Y, }

/- unregister the bad instance we defined earlier -/
local attribute [-instance] metric_space_basic.topological_space

/- Now this will work, there is only one topological space on the product, we can
rewrite like we tried to before a lemma about topologies our result on metric spaces,
as there is only one topology here.

## Exercise 6 [long?]:
Complete the proof of the example (you can generalise the 100 too if it makes it
feel less silly). -/

example (X : Type) [metric_space X] : is_open {xy : X × X | dist xy.fst xy.snd < 100 } :=
begin
  rw is_open_prod_iff X X,
  -- sorry
  intros x y h,
  use [{t | dist x t < 50 - dist x y / 2}, {t | dist y t < 50 - dist x y / 2}],
  split,
  { rw compatible,
    apply generated_open.basic,
    use [x, 50 - dist x y / 2], },
  split,
  { rw compatible,
    apply generated_open.basic,
    use [y, 50 - dist x y / 2], },
  split,
  { dsimp,
    rw (metric_space_basic.dist_eq_zero_iff x x).mpr rfl,
    change dist x y < 100 at h,
    linarith, },
  split,
  { dsimp,
    rw (metric_space_basic.dist_eq_zero_iff y y).mpr rfl,
    change dist x y < 100 at h,
    linarith, },
  rintros ⟨tx, ty⟩ ⟨htx, hty⟩,
  dsimp at *,
  calc dist tx ty ≤ dist tx x + dist x ty            : triangle tx x ty
             ...  ≤ dist tx x + dist x y + dist y ty : by linarith [triangle x y ty]
             ...  = dist x tx + dist x y + dist y ty : by rw dist_symm
              ... < 100                              : by linarith,
  -- sorry
end

end metric_space

namespace topological_space
/- As mentioned, there are many definitions of a topological space, for instance
one can define them via specifying a set of closed sets satisfying various
axioms, this is equivalent and sometimes more convenient.

We _could_ create two distinct Types defined by different data and provide an
equivalence between theses types, e.g. `topological_space_via_open_sets` and
`topological_space_via_closed_sets`, but this would quickly get unwieldy.
What's better is to make an alternative _constructor_ for our original
topological space. This is a function takes a set of subsets satisfying the
axioms to be the closed sets of a topological space and creates the
topological space defined by the corresponding set of open sets.

## Exercise 7 [medium]:
Complete the following constructor of a topological space from a set of subsets
of a given type `X` satisfying the axioms for the closed sets of a topology.
Hint: there are many useful lemmas about complements in mathlib, with names
involving `compl`, like `compl_empty`, `compl_univ`, `compl_compl`, `compl_sUnion`,
`mem_compl_image`, `compl_inter`, `compl_compl'`, `you can #check them to see what they say. -/

def mk_closed_sets
  (X : Type)
  (σ : set (set X))
  (empty_mem : ∅ ∈ σ)
  (univ_mem : univ ∈ σ)
  (inter : ∀ B ⊆ σ, ⋂₀ B ∈ σ)
  (union : ∀ (A ∈ σ) (B ∈ σ), A ∪ B ∈ σ) :
topological_space X := {
  is_open := λ U, U ∈ compl '' σ, -- the corresponding `is_open`
  empty_mem :=
    -- sorry
    begin
      use univ,
      split,
      assumption,
      exact compl_univ,
    end
    -- sorry
  ,
  univ_mem :=
    -- sorry
    begin
      use ∅,
      split,
      assumption,
      exact compl_empty,
    end
    -- sorry
  ,
  union :=
    -- sorry
    begin
      intros B hB,
      use (⋃₀ B)ᶜ,
      split,
      { rw compl_sUnion,
        apply inter,
        intros b hb,
        have := hB bᶜ ((mem_compl_image b B).mp hb),
        rw mem_compl_image at this,
        simpa, },
      { exact compl_compl (⋃₀ B) }
    end
    -- sorry
  ,
  inter :=
    -- sorry
    begin
      rintros A B ⟨Ac, hA, rfl⟩ ⟨Bc, hB, rfl⟩,
      rw [mem_compl_image, compl_inter, compl_compl, compl_compl],
      exact union _ hA _ hB,
    end
    -- sorry
    }

/- Here are some more exercises:

## Exercise 8 [medium/long]:
Define the cofinite topology on any type (PR it to mathlib?).

## Exercise 9 [medium/long]:
Define a normed space?

## Exercise 10 [medium/long]:
Define more separation axioms?

-/

end topological_space


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.hom.non_unital_alg
import algebra.lie.basic

/-!
# Lie algebras as non-unital, non-associative algebras

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

The definition of Lie algebras uses the `has_bracket` typeclass for multiplication whereas we have a
separate `has_mul` typeclass used for general algebras.

It is useful to have a special typeclass for Lie algebras because:
 * it enables us to use the traditional notation `⁅x, y⁆` for the Lie multiplication,
 * associative algebras carry a natural Lie algebra structure via the ring commutator and so we need
   them to carry both `has_mul` and `has_bracket` simultaneously,
 * more generally, Poisson algebras (not yet defined) need both typeclasses.

However there are times when it is convenient to be able to regard a Lie algebra as a general
algebra and we provide some basic definitions for doing so here.

## Main definitions

  * `commutator_ring` turns a Lie ring into a `non_unital_non_assoc_semiring` by turning its
    `has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`).
  * `lie_hom.to_non_unital_alg_hom`

## Tags

lie algebra, non-unital, non-associative
-/

universes u v w

variables (R : Type u) (L : Type v) [comm_ring R] [lie_ring L] [lie_algebra R L]

/-- Type synonym for turning a `lie_ring` into a `non_unital_non_assoc_semiring`.

A `lie_ring` can be regarded as a `non_unital_non_assoc_semiring` by turning its
`has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). -/
def commutator_ring (L : Type v) : Type v := L

/-- A `lie_ring` can be regarded as a `non_unital_non_assoc_semiring` by turning its
`has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). -/
instance : non_unital_non_assoc_semiring (commutator_ring L) :=
show non_unital_non_assoc_semiring L, from
{ mul           := has_bracket.bracket,
  left_distrib  := lie_add,
  right_distrib := add_lie,
  zero_mul      := zero_lie,
  mul_zero      := lie_zero,
  .. (infer_instance : add_comm_monoid L) }

namespace lie_algebra

instance (L : Type v) [nonempty L] : nonempty (commutator_ring L) :=
‹nonempty L›

instance (L : Type v) [inhabited L] : inhabited (commutator_ring L) :=
‹inhabited L›

instance : lie_ring (commutator_ring L) :=
show lie_ring L, by apply_instance

instance : lie_algebra R (commutator_ring L) :=
show lie_algebra R L, by apply_instance

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
reinterpret the `smul_lie` law as an `is_scalar_tower`. -/
instance is_scalar_tower : is_scalar_tower R (commutator_ring L) (commutator_ring L) := ⟨smul_lie⟩

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
reinterpret the `lie_smul` law as an `smul_comm_class`. -/
instance smul_comm_class : smul_comm_class R (commutator_ring L) (commutator_ring L) :=
⟨λ t x y, (lie_smul t x y).symm⟩

end lie_algebra

namespace lie_hom

variables {R L} {L₂ : Type w} [lie_ring L₂] [lie_algebra R L₂]

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
regard a `lie_hom` as a `non_unital_alg_hom`. -/
@[simps]
def to_non_unital_alg_hom (f : L →ₗ⁅R⁆ L₂) : commutator_ring L →ₙₐ[R] commutator_ring L₂ :=
{ to_fun := f,
  map_zero' := f.map_zero,
  map_mul'  := f.map_lie,
  ..f }

lemma to_non_unital_alg_hom_injective :
  function.injective (to_non_unital_alg_hom : _ → (commutator_ring L →ₙₐ[R] commutator_ring L₂)) :=
λ f g h, ext $ non_unital_alg_hom.congr_fun h

end lie_hom


/-
Authors : James Gibson
-/

import tactic
import measure_theory.measurable_space
import probability.independence
import data.complex.exponential
import analysis.special_functions.exp

open topological_space measure_theory.measure probability_theory filter
open_locale classical measure_theory nnreal ennreal big_operators topological_space

namespace measure_theory

/-Helpful lemma about a in the ennreals.-/
lemma help_lemma (a : ℝ≥0∞) (h1 : a ≤ 1) (h2 :1 - a = 0):
  a = 1 :=
begin
  rw tsub_eq_zero_iff_le at h2,
  exact ge_antisymm h2 h1,
end

/-One minus x is bounded from above by e^-x for all x.-/
lemma exp_bound_one_sub_x (x : ℝ) :
  1 - x ≤ real.exp (-x) :=
begin
  sorry,
end

/-The Inter over j of the Inter up to j equals the total Inter for indexed sets.-/
lemma Inter_Inter_eq_Inter {α : Type*} (s : ℕ → set α) :
  (⋂ (j : ℕ), ⋂ (i : ℕ) (h : i ≤ j), s i) = ⋂ (i : ℕ), s i :=
begin
  ext,
  split,
  { intros h s hs',
    cases hs' with a b,
    rw ← b,
    simp at h,
    exact h (a + 1) (a) (by norm_num),},
  { intros h s' hs',
    simp only [set.mem_range] at hs',
    simp at h,
    cases hs' with y,
    rw ← hs'_h,
    simp,
    intros i hi,
    exact h i,}
end

/-The sigma algebra generated by a set equals the sigma algebra generated by its complement.-/
lemma gen_singl_eq_compl_gen {α : Type*} {s : set α} :
  (@measurable_space.generate_from α {s}) = (measurable_space.generate_from {sᶜ}) :=
begin
  sorry,
end

/-If 0 ≤ f ≤ g, then any finite product of the fs is less than the same finite prod of the gs-/
lemma pos_prod_lt_lt (f g : ℕ → ℝ) (h₁ : ∀ (n : ℕ), 0 ≤ f n) (h : ∀ (n : ℕ), f n ≤ g n) (a : ℕ):
  ∏ (x : ℕ) in finset.range a.succ, f x ≤ ∏ (x : ℕ) in finset.range a.succ, g x :=
begin
  sorry,
end

/-If a sequence tends to -∞ as it goes to ∞, then the exp of the function tendsto 0 as it goes to ∞.-/
lemma tendsto_exp_comp (s : ℕ → ℝ) : tendsto s at_top at_bot →
  tendsto (λ (a : ℕ), real.exp (s a)) at_top (𝓝 0) :=
begin
  sorry,
end

/-Reverse of the Borel Cantelli lemma. For a sequence of measurable sets s, the sum of whose measure is
    +∞, then the measure of the limsup of s is equal to one.-/
lemma Borel_cantelli_reverse
  {α : Type*} (m : measurable_space α) (μ : measure α) [hpm : is_probability_measure μ]
  {s : ℕ → set α} (hs : tendsto (λ (a : ℕ), ∑ (x : ℕ) in finset.range a, μ (s x)) at_top at_top)
  (hsI : Indep_set s μ) [add_comm_monoid ℕ] [topological_space ℕ]
  [comm_monoid ℕ] {hm : ∀ (i : ℕ), measurable_set (s (i))}:
  μ(limsup at_top s) = 1 :=
begin
  /-exchange lim sup to set operations.-/
  rw limsup_eq_infi_supr_of_nat',
  /-rw goal to the measure of the compliment of the limsup being 0-/
  suffices : 1 - μ(⨅ (n : ℕ), ⨆ (i : ℕ), s (i + n)) = 0,
  {  exact help_lemma (μ(⨅ (n : ℕ), ⨆ (i : ℕ), s (i + n))) prob_le_one this},
  rw ← hpm.measure_univ,
  have hlimsupm : measurable_set (⨅ (n : ℕ), ⨆ (i : ℕ), s (i + n)) :=
    measurable_set.Inter (λ b, measurable_set.Union $ λ c, hm _),
      /-cred to Jason-/
  rw ← measure_compl hlimsupm,
  swap, sorry,
  /-move compliment inside the set operations.-/
  rw compl_infi,
  simp only [set.supr_eq_Union, set.compl_Union, measure_Union_null_iff],
  intros i,
  /-use independence of sets s n to prove independence of family s (n + i) for fixed i-/
  have hs_add_i_I: Indep_set (s ∘ (λ n, n + i))ᶜ μ,
  { unfold Indep_set,
    dsimp,
    simp_rw ← gen_singl_eq_compl_gen,
    intros s_1 f hyp,
    let adder : ℕ ↪ ℕ := ⟨(λ n, n + i), sorry⟩,
    let s_2 : finset ℕ := finset.map adder s_1,
    specialize @hsI s_2 (f ∘ (λ n, n-i)),
    dsimp at *,
    have : μ (⋂ (i : ℕ) (H : i ∈ s_1), f i) = s_1.prod (λ (i : ℕ), μ (f i)) ↔
      μ (⋂ (i_1 : ℕ) (H : i_1 ∈ s_2), f (i_1 - i)) = s_2.prod (λ (i_1 : ℕ), μ (f (i_1 - i))),
    { congr' 2,
      swap,
      /-True but want to move on for now.-/
      sorry,
      /-Also true but want to move on for now-/
      congr' 1,
      sorry},
    rw this,
    apply hsI,
    intros i_1 hi_1,
    have this2 : i_1 - i ∈ s_1, sorry,
    specialize hyp (i_1 - i) this2,
    let hyp' : i ≤ i_1 := sorry,
    rw nat.sub_add_cancel hyp' at hyp,
    exact hyp,
    },
  /-change intersection into 2 intersections, Move the first intersection outside of the measure
      into an infimum-/
  rw [← Inter_Inter_eq_Inter, measure_Inter_eq_infi _ _ ],
  swap, sorry,
  swap, exact encodable.nat,
  swap, sorry,
  swap, sorry,
  /-Unfold Indep_set since there isnt much api for independence-/
  unfold Indep_set at *,
  /-convert intersection into intersection over finite set-/
  simp_rw [← nat.lt_succ_iff, ← finset.mem_range],
  /-convert infimum equals zero into tendsto 0 proposition-/
  rw [← ennreal.bot_eq_zero, infi_eq_bot],
  dsimp,
  /-change lt into a le in goal-/
  suffices : ∀ ( b : ℝ≥0∞), b > 0 →
    (∃ (i_1 : ℕ), μ (⋂ (i_2 : ℕ) (x : i_2 ∈ finset.range i_1.succ), (s (i_2 + i))ᶜ) ≤ b),
  { intros b hb,
    have h₁ : b ≠ 0, intro h, finish,
    specialize this (b / 2) (ennreal.half_pos h₁),
    by_cases b ≠ ⊤,
    have h₂ : (b / 2) < b, exact ennreal.half_lt_self h₁ h,
    { cases this with i_1,
      use i_1,
      exact gt_of_gt_of_ge h₂ this_h},
    dsimp at h,
    rw not_not at h,
    use 1, rw h,
    exact gt_of_gt_of_ge (gt_iff_lt.mpr ennreal.one_lt_top) prob_le_one,
  },
  /-change into form which can be written into a tendsto form-/
  suffices : ∀ (b : ℝ≥0∞), b > 0 →
    (∃ (i_1 : ℕ), ∀ (i_2 : ℕ), i_2 ≥ i_1 → μ (⋂ (i_3 : ℕ) (x : i_3 ∈ finset.range i_2.succ), (s (i_3 + i))ᶜ) ≤ b),
  { intros b hb,
    obtain ⟨N, hN⟩ : ∃ (i_1 : ℕ), ∀ (i_2 : ℕ), i_2 ≥ i_1 →
      μ (⋂ (i_3 : ℕ) (x : i_3 ∈ finset.range i_2.succ), (s (i_3 + i))ᶜ) ≤ b :=
      this b hb,
    use N,
    exact hN N (by norm_num),
  },
  /-change into a tendsto proposition-/
  rw ← ennreal.tendsto_at_top_zero,
  unfold Indep at hs_add_i_I,
  unfold Indep_sets at hs_add_i_I,
  /-change measure of intersection to product of measures by continuity-/
  have big_help : (λ (n : ℕ), μ (⋂ (i_3 : ℕ) (x : i_3 ∈ finset.range n.succ), (s (i_3 + i))ᶜ)) =
    (λ (n : ℕ), ∏ (i_3 : ℕ) in finset.range n.succ, μ (s (i_3 + i))ᶜ),
    ext1,
    specialize @hs_add_i_I (finset.range x.succ) (λ n, (s (n + i))ᶜ),
    apply hs_add_i_I,
    intros j hj, dsimp,
    change (measurable_space.generate_from {(s (j + i))ᶜ}).measurable_set' (s (j + i))ᶜ,
    /-exact (measurable_space.generate_from {(s (j + i))ᶜ}).measurable_set' (s (j + i))ᶜ,-/
    sorry,
  rw big_help,  clear big_help, clear hs_add_i_I,
  /-left unfinished due to time constraints-/
  have this2 : ∀ (i_3 : ℕ), μ ((s (i_3 + i))ᶜ) = 1 - μ (s (i_3 + i)), from sorry,
  simp_rw this2,
  /-convert to convergence in reals so we can apply exp function-/
  suffices : tendsto (λ (n : ℕ), ennreal.of_real (∏ (x : ℕ) in finset.range n.succ,  (1 - μ (s (x + i))).to_real))
    at_top (𝓝 (ennreal.of_real 0)), sorry,
  apply ennreal.tendsto_of_real,
  /-move 1 outside of to_real-/
  simp_rw [ennreal.to_real_sub_of_le prob_le_one ennreal.one_ne_top, ennreal.one_to_real],
  /-replace goal with tendsto of sequence which bounds the function in the previous tendsto-/
  suffices : tendsto (λ (a : ℕ), ∏ (x : ℕ) in finset.range a.succ, real.exp(-(μ (s (x + i))).to_real)) at_top (𝓝 0),
    sorry,
  /-exchange product of exps with exp of a sum-/
  simp_rw ← real.exp_sum,
  /-replace goal with showing sequence tends to -∞-/
  apply tendsto_exp_comp,
  /-replace goal with showing the negative of the sequence tends to +∞-/
  suffices : tendsto (λ (a : ℕ), ∑ (x : ℕ) in finset.range a, μ(s (x + i))) at_top at_top,
    sorry,
  suffices : tendsto (λ (a : ℕ), ∑ (x : ℕ) in finset.range a, μ(s x)) at_top at_top,
    sorry,
  simp,
  /-result should follow diectly from here but I have ran out of time-/
  assumption,
end

end measure_theory


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import combinatorics.simple_graph.connectivity
import data.fin.succ_pred
import order.succ_pred.relation

/-!
# The Hasse diagram as a graph

This file defines the Hasse diagram of an order (graph of `covby`, the covering relation) and the
path graph on `n` vertices.

## Main declarations

* `simple_graph.hasse`: Hasse diagram of an order.
* `simple_graph.path_graph`: Path graph on `n` vertices.
-/

open order order_dual relation

namespace simple_graph
variables (α β : Type*)

section preorder
variables [preorder α] [preorder β]

/-- The Hasse diagram of an order as a simple graph. The graph of the covering relation. -/
def hasse : simple_graph α :=
{ adj := λ a b, a ⋖ b ∨ b ⋖ a,
  symm := λ a b, or.symm,
  loopless := λ a h, h.elim (irrefl _) (irrefl _) }

variables {α β} {a b : α}

@[simp] lemma hasse_adj : (hasse α).adj a b ↔ a ⋖ b ∨ b ⋖ a := iff.rfl

/-- `αᵒᵈ` and `α` have the same Hasse diagram. -/
def hasse_dual_iso : hasse αᵒᵈ ≃g hasse α :=
{ map_rel_iff' := λ a b, by simp [or_comm],
  ..of_dual }

@[simp] lemma hasse_dual_iso_apply (a : αᵒᵈ) : hasse_dual_iso a = of_dual a := rfl
@[simp] lemma hasse_dual_iso_symm_apply (a : α) : hasse_dual_iso.symm a = to_dual a := rfl

end preorder

section linear_order
variables [linear_order α]

lemma hasse_preconnected_of_succ [succ_order α] [is_succ_archimedean α] : (hasse α).preconnected :=
λ a b, begin
  rw reachable_iff_refl_trans_gen,
  exact refl_trans_gen_of_succ _ (λ c hc, or.inl $ covby_succ_of_not_is_max hc.2.not_is_max)
    (λ c hc, or.inr $ covby_succ_of_not_is_max hc.2.not_is_max),
end

lemma hasse_preconnected_of_pred [pred_order α] [is_pred_archimedean α] : (hasse α).preconnected :=
λ a b, begin
  rw [reachable_iff_refl_trans_gen, ←refl_trans_gen_swap],
  exact refl_trans_gen_of_pred _ (λ c hc, or.inl $ pred_covby_of_not_is_min hc.1.not_is_min)
    (λ c hc, or.inr $ pred_covby_of_not_is_min hc.1.not_is_min),
end

end linear_order

/-- The path graph on `n` vertices. -/
def path_graph (n : ℕ) : simple_graph (fin n) := hasse _

lemma path_graph_preconnected (n : ℕ) : (path_graph n).preconnected := hasse_preconnected_of_succ _
lemma path_graph_connected (n : ℕ) : (path_graph (n + 1)).connected := ⟨path_graph_preconnected _⟩

end simple_graph


import classes.unrestricted.basics.toolbox
import utilities.list_utils
import utilities.written_by_others.trim_assoc

inductive alphabet
| _a : alphabet
| _b : alphabet
| _c : alphabet

inductive inner
| _S : inner
| _L : inner
| _R : inner
| _X : inner
| _B : inner
| _M : inner
| _E : inner
| _C : inner
| _K : inner

private def a_ := alphabet._a
private def b_ := alphabet._b
private def c_ := alphabet._c

private def S_ := inner._S
private def L_ := inner._L
private def R_ := inner._R
private def X_ := inner._X
private def B_ := inner._B
private def M_ := inner._M
private def E_ := inner._E
private def C_ := inner._C
private def K_ := inner._K

private def my_char : Type := symbol alphabet inner

private def a : my_char := symbol.terminal a_
private def b : my_char := symbol.terminal b_
private def c : my_char := symbol.terminal c_

private def S : my_char := symbol.nonterminal S_
private def L : my_char := symbol.nonterminal L_
private def R : my_char := symbol.nonterminal R_
private def X : my_char := symbol.nonterminal X_
private def B : my_char := symbol.nonterminal B_
private def M : my_char := symbol.nonterminal M_
private def E : my_char := symbol.nonterminal E_
private def C : my_char := symbol.nonterminal C_
private def K : my_char := symbol.nonterminal K_

/-
Grammar for unary multiplication
{ a^m . b^n . c^(m*n) | m n ∈ ℕ }
example   2 * 3 = 6

          S
S → LR
          LR
L → aLX
          aaLXXR
R → BR
          aaLXXBBBR
L → M
          aaMXXBBBR
R → E
          aaMXXBBBE
XB → BCX
CB → BC
XC → CX
          aaMBBBCCCCCCXXE
XE → E
          aaMBBBCCCCCCE
MB → bM
          aabbbMCCCCCCE
M → K
          aabbbKCCCCCCE
KC → cK
          aabbbccccccKE
KE → ∅
          aabbbcccccc
-/

private def my_rule : Type := grule alphabet inner

private def S_LR   : my_rule := grule.mk  [] S_ [] [L, R]
private def L_aLX  : my_rule := grule.mk  [] L_ [] [a, L, X]
private def R_BR   : my_rule := grule.mk  [] R_ [] [B, R]
private def L_M    : my_rule := grule.mk  [] L_ [] [M]
private def R_E    : my_rule := grule.mk  [] R_ [] [E]
private def XB_BCX : my_rule := grule.mk [X] B_ [] [B, C, X]
private def CB_BC  : my_rule := grule.mk [C] B_ [] [B, C]
private def XC_CX  : my_rule := grule.mk [X] C_ [] [C, X]
private def XE_E   : my_rule := grule.mk [X] E_ [] [E]      -- shortens the word
private def MB_bM  : my_rule := grule.mk [M] B_ [] [b, M]
private def M_K    : my_rule := grule.mk  [] M_ [] [K]
private def KC_cK  : my_rule := grule.mk [K] C_ [] [c, K]
private def KE_nil : my_rule := grule.mk [K] E_ [] []       -- shortens the word

private def gr_mul : grammar alphabet :=
grammar.mk inner S_ [S_LR, L_aLX, R_BR, L_M, R_E, XB_BCX, CB_BC, XC_CX, XE_E, MB_bM, M_K, KC_cK, KE_nil]

private meta def grammar_step (rule : pexpr) (pref post : pexpr) : tactic unit := `[
  apply grammar_deri_of_tran_deri,
  tactic.use [rule],
  split_ile,
  tactic.use [pref, post],
  split;
  refl
]

-- example 0 * 0 = 0
example : grammar_generates gr_mul [] :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  grammar_step ``(L_M) ``([]) ``([R]),
  grammar_step ``(R_E) ``([M]) ``([]),
  grammar_step ``(M_K) ``([]) ``([E]),
  grammar_step ``(KE_nil) ``([]) ``([]),
  apply grammar_deri_self,
end

-- example 1 * 1 = 1
example : grammar_generates gr_mul [a_, b_, c_] :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  grammar_step ``(L_aLX) ``([]) ``([R]),
  grammar_step ``(R_BR) ``([a, L, X]) ``([]),
  grammar_step ``(L_M) ``([a]) ``([X, B, R]),
  grammar_step ``(R_E) ``([a, M, X, B]) ``([]),
  grammar_step ``(XB_BCX) ``([a, M]) ``([E]),
  grammar_step ``(XE_E) ``([a, M, B, C]) ``([]),
  grammar_step ``(MB_bM) ``([a]) ``([C, E]),
  grammar_step ``(M_K) ``([a, b]) ``([C, E]),
  grammar_step ``(KC_cK) ``([a, b]) ``([E]),
  grammar_step ``(KE_nil) ``([a, b, c]) ``([]),
  apply grammar_deri_self,
end

-- example 2 * 1 = 2
example : grammar_generates gr_mul [a_, a_, b_, c_, c_] :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  grammar_step ``(L_aLX) ``([]) ``([R]),
  grammar_step ``(R_BR) ``([a, L, X]) ``([]),
  grammar_step ``(L_aLX) ``([a]) ``([X, B, R]),
  grammar_step ``(L_M) ``([a, a]) ``([X, X, B, R]),
  grammar_step ``(R_E) ``([a, a, M, X, X, B]) ``([]),
  grammar_step ``(XB_BCX) ``([a, a, M, X]) ``([E]),
  grammar_step ``(XE_E) ``([a, a, M, X, B, C]) ``([]),
  grammar_step ``(XB_BCX) ``([a, a, M]) ``([C, E]),
  grammar_step ``(XC_CX) ``([a, a, M, B, C]) ``([E]),
  grammar_step ``(XE_E) ``([a, a, M, B, C, C]) ``([]),
  grammar_step ``(MB_bM) ``([a, a]) ``([C, C, E]),
  grammar_step ``(M_K) ``([a, a, b]) ``([C, C, E]),
  grammar_step ``(KC_cK) ``([a, a, b]) ``([C, E]),
  grammar_step ``(KC_cK) ``([a, a, b, c]) ``([E]),
  grammar_step ``(KE_nil) ``([a, a, b, c, c]) ``([]),
  apply grammar_deri_self,
end

-- example 3 * 3 = 9
example : grammar_generates gr_mul [a_, a_, a_, b_, b_, b_, c_, c_, c_, c_, c_, c_, c_, c_, c_] :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  grammar_step ``(L_aLX) ``([]) ``([R]),
  grammar_step ``(L_aLX) ``([a]) ``([X, R]),
  grammar_step ``(L_aLX) ``([a, a]) ``([X, X, R]),
  grammar_step ``(R_BR) ``([a, a, a, L, X, X, X]) ``([]),
  grammar_step ``(R_BR) ``([a, a, a, L, X, X, X, B]) ``([]),
  grammar_step ``(R_BR) ``([a, a, a, L, X, X, X, B, B]) ``([]),
  grammar_step ``(L_M) ``([a, a, a]) ``([X, X, X, B, B, B, R]),
  grammar_step ``(R_E) ``([a, a, a, M, X, X, X, B, B, B]) ``([]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X, X]) ``([B, B, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X, X, B, C]) ``([B, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X, X, B, C, B, C]) ``([E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, X, B]) ``([C, B, C, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, X, B, B, C]) ``([C, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, X, B, B]) ``([C, C, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X]) ``([B, B, C, C, C, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X, B, C]) ``([B, C, C, C, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, X, B, C, B, C]) ``([C, C, C, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, X, B, C, B, C, B, C]) ``([C, C, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, X, B, C, B, C, B, C, C]) ``([C, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, X, B, C, B, C, B, C, C, C]) ``([X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, B]) ``([C, B, C, C, C, C, X, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, B, B, C]) ``([C, C, C, C, X, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, X, B, B]) ``([C, C, C, C, C, X, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M]) ``([B, B, C, C, C, C, C, C, X, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, B, C]) ``([B, C, C, C, C, C, C, X, X, E]),
  grammar_step ``(XB_BCX) ``([a, a, a, M, B, C, B, C]) ``([C, C, C, C, C, C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C]) ``([C, C, C, C, C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C, C]) ``([C, C, C, C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C, C, C]) ``([C, C, C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C, C, C, C]) ``([C, C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C, C, C, C, C]) ``([C, X, X, E]),
  grammar_step ``(XC_CX) ``([a, a, a, M, B, C, B, C, B, C, C, C, C, C, C]) ``([X, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, B]) ``([C, B, C, C, C, C, C, C, C, X, X, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, B, B, C]) ``([C, C, C, C, C, C, C, X, X, X, E]),
  grammar_step ``(CB_BC) ``([a, a, a, M, B, B]) ``([C, C, C, C, C, C, C, C, X, X, X, E]),
  -- a^3.M.B^3.C^9.X^3.E
  apply grammar_deri_of_deri_deri,
  {
    change
      grammar_derives gr_mul
        ([a, a, a, M, B, B, B, C, C, C, C, C, C, C, C, C] ++ [X, X, X, E])
        ([a, a, a, M, B, B, B, C, C, C, C, C, C, C, C, C] ++ [E]),
    apply grammar_deri_with_prefix,
    grammar_step ``(XE_E) ``([X, X]) ``([]),
    grammar_step ``(XE_E) ``([X]) ``([]),
    grammar_step ``(XE_E) ``([]) ``([]),
    apply grammar_deri_self,
  },
  change
    grammar_derives gr_mul
      ([a, a, a] ++ [M, B, B, B, C, C, C, C, C, C, C, C, C, E])
      ([a, a, a] ++ [b, b, b, c, c, c, c, c, c, c, c, c]),
  apply grammar_deri_with_prefix,
  grammar_step ``(MB_bM) ``([]) ``([B, B, C, C, C, C, C, C, C, C, C, E]),
  grammar_step ``(MB_bM) ``([b]) ``([B, C, C, C, C, C, C, C, C, C, E]),
  grammar_step ``(MB_bM) ``([b, b]) ``([C, C, C, C, C, C, C, C, C, E]),
  change
    grammar_derives gr_mul
      ([b, b, b] ++ [M, C, C, C, C, C, C, C, C, C, E])
      ([b, b, b] ++ [c, c, c, c, c, c, c, c, c]),
  apply grammar_deri_with_prefix,
  grammar_step ``(M_K) ``([]) ``([C, C, C, C, C, C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([]) ``([C, C, C, C, C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([c]) ``([C, C, C, C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([c, c]) ``([C, C, C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([c, c, c]) ``([C, C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([c, c, c, c]) ``([C, C, C, C, E]),
  grammar_step ``(KC_cK) ``([c, c, c, c, c]) ``([C, C, C, E]),
  grammar_step ``(KC_cK) ``([c, c, c, c, c, c]) ``([C, C, E]),
  grammar_step ``(KC_cK) ``([c, c, c, c, c, c, c]) ``([C, E]),
  grammar_step ``(KC_cK) ``([c, c, c, c, c, c, c, c]) ``([E]),
  grammar_step ``(KE_nil) ``([c, c, c, c, c, c, c, c, c]) ``([]),
  apply grammar_deri_self,
end

private lemma sub_suc_suc {m n : ℕ} (n_lt_m : n < m) : m - n = (m - n.succ).succ :=
begin
  omega,
end

private lemma steps_L_aLX (m : ℕ) :
  grammar_derives gr_mul [L, R] (list.repeat a m ++ [L] ++ list.repeat X m ++ [R]) :=
begin
  induction m with k ih,
  {
    apply grammar_deri_self,
  },
  apply grammar_deri_of_deri_tran ih,
  use L_aLX,
  split_ile,
  use [list.repeat a k, list.repeat X k ++ [R]],
  split,
  {
    simp [L, L_aLX, list.append_nil, list.append_assoc],
  },
  {
    rw list.repeat_succ_eq_append_singleton a,
    rw list.repeat_succ_eq_singleton_append X,
    simp [L, L_aLX, list.append_assoc],
  },
end

private lemma steps_R_BR (m n : ℕ) :
  grammar_derives gr_mul
    (list.repeat a m ++ [L] ++ list.repeat X m ++ [R])
    (list.repeat a m ++ [L] ++ list.repeat X m ++ list.repeat B n ++ [R]) :=
begin
  induction n with k ih,
  {
    rw [list.repeat, list.append_nil],
    apply grammar_deri_self,
  },
  apply grammar_deri_of_deri_tran ih,
  use R_BR,
  split_ile,
  use [list.repeat a m ++ [L] ++ list.repeat X m ++ list.repeat B k, []],
  split,
  {
    simp [R, R_BR, list.append_nil],
  },
  {
    rw list.repeat_succ_eq_append_singleton B,
    simp [R, R_BR, list.append_nil, list.append_assoc],
  },
end

private lemma steps_quadratic (m n : ℕ) :
  grammar_derives gr_mul
    (list.repeat a m ++ [M] ++ list.repeat X m ++ list.repeat B n ++ [E])
    (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++
      list.repeat X m ++ [E]) :=
begin
  apply grammar_deri_with_postfix,
  repeat {
    rw list.append_assoc (list.repeat a m ++ [M]),
  },
  apply grammar_deri_with_prefix,

  have parametrized : ∀ q : ℕ, q ≤ m →
    grammar_derives gr_mul
      (list.repeat X m ++ list.repeat B n)
      (list.repeat X (m - q) ++ list.repeat B n ++ list.repeat C (q * n) ++ list.repeat X q),
  {
    intros q q_le_m,
    induction q with k ih,
    {
      rw [nat.sub_zero, zero_mul, list.repeat_zero, list.repeat_zero, list.append_nil, list.append_nil],
      apply grammar_deri_self,
    },
    apply grammar_deri_of_deri_deri (ih (nat.le_of_succ_le q_le_m)),

    have big_step_generateCs :
      grammar_derives gr_mul
        (list.repeat X (m - k) ++ list.repeat B n ++ list.repeat C (k * n) ++ list.repeat X k)
        (list.repeat X (m - k.succ) ++ [B, C] ^ n ++ [X] ++ list.repeat C (k * n) ++ list.repeat X k),
    {
      apply grammar_deri_with_postfix,
      apply grammar_deri_with_postfix,

      have aux_generateCs : ∀ p : ℕ, p ≤ n →
        grammar_derives gr_mul
          (list.repeat X (m - k) ++ list.repeat B n)
          (list.repeat X (m - k.succ) ++ [B, C] ^ p ++ [X] ++ list.repeat B (n - p)),
      {
        intros p p_le_n,
        induction p with r ih,
        {
          rw nat.sub_zero,
          unfold list.n_times,
          rw list.repeat_zero,
          rw list.join,
          rw list.append_nil,
          rw ←list.repeat_succ_eq_append_singleton,
          rw ←sub_suc_suc, swap,
          {
            rwa nat.succ_le_iff at q_le_m,
          },
          apply grammar_deri_self,
        },
        apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le p_le_n)),
        use XB_BCX,
        split_ile,
        use list.repeat X (m - k.succ) ++ [B, C] ^ r,
        use list.repeat B (n - r.succ),
        split,
        {
          repeat {
            rw list.append_assoc,
          },
          trim,
          have r_lt_n : r < n,
          {
            rwa nat.succ_le_iff at p_le_n,
          },
          rw sub_suc_suc r_lt_n,
          rw list.repeat_succ_eq_singleton_append B,
          repeat {
            rw ←list.append_assoc,
          },
          refl,
        },
        {
          trim,
          unfold list.n_times,
          rw list.repeat_succ_eq_append_singleton,
          rw list.join_append,
          finish,
        },
      },
      have generatedCs := aux_generateCs n (by refl),
      rwa [nat.sub_self, list.repeat_zero, list.append_nil] at generatedCs,
    },
    apply grammar_deri_of_deri_deri big_step_generateCs,
    clear big_step_generateCs,

    have big_step_bubbleCs :
      grammar_derives gr_mul
        (list.repeat X (m - k.succ) ++ [B, C] ^ n ++ [X] ++ list.repeat C (k * n) ++ list.repeat X k)
        (list.repeat X (m - k.succ) ++ list.repeat B n ++ list.repeat C n ++ [X] ++
          list.repeat C (k * n) ++ list.repeat X k),
    {
      apply grammar_deri_with_postfix,
      apply grammar_deri_with_postfix,
      apply grammar_deri_with_postfix,
      rw list.append_assoc,
      apply grammar_deri_with_prefix,

      have aux_bubbleCs : ∀ s : ℕ, s ≤ n →
        grammar_derives gr_mul
          ([B, C] ^ n)
          (list.repeat B s ++ list.repeat C s ++ [B, C] ^ (n - s)),
      {
        intros s s_le_n,
        induction s with z ih,
        {
          rw list.repeat_zero,
          rw list.nil_append,
          rw list.repeat_zero,
          rw list.nil_append,
          rw nat.sub_zero,
          apply grammar_deri_self,
        },
        apply grammar_deri_of_deri_deri (ih (nat.le_of_succ_le s_le_n)),
        have z_lt_n : z < n,
        {
          rwa nat.succ_le_iff at s_le_n,
        },
        rw sub_suc_suc z_lt_n,
        unfold list.n_times,
        rw list.repeat_succ_eq_singleton_append,
        rw list.join_append,
        rw list.join_singleton,
        repeat {
          rw ←list.append_assoc,
        },
        apply grammar_deri_with_postfix,
        rw list.repeat_succ_eq_append_singleton B,
        rw list.append_assoc,
        rw list.append_assoc,
        apply grammar_deri_with_prefix,
        rw list.repeat_succ_eq_append_singleton C,
        convert_to
          grammar_derives gr_mul
            (list.repeat C z ++ [B] ++ [C])
            ([B] ++ list.repeat C z ++ [C]),
        {
          rw list.append_assoc,
          refl,
        },
        apply grammar_deri_with_postfix,

        have aux_bubbleB : ∀ x : ℕ, x ≤ z →
          grammar_derives gr_mul
            (list.repeat C z ++ [B])
            (list.repeat C (z - x) ++ [B] ++ list.repeat C x),
        {
          intros x x_le_z,
          induction x with y ih,
          {
            rw [nat.sub_zero, list.repeat_zero, list.append_nil],
            apply grammar_deri_self,
          },
          apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le x_le_z)),
          use CB_BC,
          split_ile,
          use [list.repeat C (z - y.succ), list.repeat C y],
          split,
          {
            trim,
            have y_lt_z : y < z,
            {
              rwa nat.succ_le_iff at x_le_z,
            },
            rw sub_suc_suc y_lt_z,
            rw list.repeat_succ_eq_append_singleton C,
            repeat {
              rw list.append_assoc,
            },
            refl,
          },
          {
            rw list.repeat_succ_eq_singleton_append C,
            rw ←list.append_assoc,
            trim,
          },
        },
        have bubbledB := aux_bubbleB z (by refl),
        rwa [nat.sub_self, list.repeat_zero, list.nil_append] at bubbledB,
      },
      have bubbledCs := aux_bubbleCs n (by refl),
      rw nat.sub_self at bubbledCs,
      unfold list.n_times at bubbledCs,
      rw list.append_assoc at bubbledCs,
      rw list.repeat_zero at bubbledCs,
      rw list.join at bubbledCs,
      rwa list.append_nil at bubbledCs,
    },
    apply grammar_deri_of_deri_deri big_step_bubbleCs,
    clear big_step_bubbleCs,

    repeat {
      rw list.append_assoc,
    },
    apply grammar_deri_with_prefix,
    apply grammar_deri_with_prefix,
    rw nat.succ_mul,
    rw add_comm,
    rw list.repeat_add,
    rw list.append_assoc,
    apply grammar_deri_with_prefix,
    rw list.repeat_succ_eq_singleton_append X,
    repeat {
      rw ←list.append_assoc,
    },
    apply grammar_deri_with_postfix,

    have skipCs : ∀ d e : ℕ, d ≤ e →
      grammar_derives gr_mul
        ([X] ++ list.repeat C e)
        (list.repeat C d ++ [X] ++ list.repeat C (e - d)),
    {
      intros d e d_le_e,
      induction d with f ih,
      {
        apply grammar_deri_self,
      },
      apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le d_le_e)),
      use XC_CX,
      split_ile,
      use [list.repeat C f, list.repeat C (e - f.succ)],
      split,
      {
        have f_lt_e : f < e,
        {
          rwa nat.succ_le_iff at d_le_e,
        },
        rw sub_suc_suc f_lt_e,
        rw list.repeat_succ_eq_singleton_append C,
        rw ←list.append_assoc,
        trim,
      },
      {
        rw list.repeat_succ_eq_append_singleton C,
        trim,
        rw list.append_assoc,
        refl,
      },
    },
    have almost := skipCs (k * n) (k * n) (by refl),
    rwa [nat.sub_self, list.repeat_zero, list.append_nil] at almost,
  },
  convert parametrized m (by refl),
  rw [nat.sub_self, list.repeat_zero, list.nil_append],
end

private lemma steps_XE_E (m n : ℕ) :
  grammar_derives gr_mul
    (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ list.repeat X m ++ [E])
    (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ [E]) :=
begin
  have backwards : ∀ q : ℕ, q ≤ m →
    grammar_derives gr_mul
      (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ list.repeat X m ++ [E])
      (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ list.repeat X (m - q) ++ [E]),
  {
    intros q ass,
    induction q with k ih,
    {
      apply grammar_deri_self,
    },
    apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le ass)),
    use XE_E,
    split_ile,
    use [list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ list.repeat X (m - k.succ), []],
    split,
    {
      have detach_X : list.repeat X (m - k) = list.repeat X (m - k.succ) ++ [X],
      {
        have k_lt_m : k < m,
        {
          rwa nat.succ_le_iff at ass,
        },
        rw sub_suc_suc k_lt_m,
        apply list.repeat_succ_eq_append_singleton,
      },
      rw detach_X,
      finish,
    },
    {
      rw list.append_nil,
      refl,
    },
  },
  have almost := backwards m (by refl),
  rwa [nat.sub_self, list.repeat_zero, list.append_nil] at almost,
end

private lemma steps_MB_bM (m n : ℕ) :
  grammar_derives gr_mul
    (list.repeat a m ++ [M] ++ list.repeat B n ++ list.repeat C (m * n) ++ [E])
    (list.repeat a m ++ list.repeat b n ++ [M] ++ list.repeat C (m * n) ++ [E]) :=
begin
  apply grammar_deri_with_postfix,
  apply grammar_deri_with_postfix,
  rw list.append_assoc,
  rw list.append_assoc,
  apply grammar_deri_with_prefix,

  have bees : ∀ k : ℕ, k ≤ n →
    grammar_derives gr_mul ([M] ++ list.repeat B n) (list.repeat b k ++ [M] ++ list.repeat B (n - k)),
  {
    intros k ass,
    induction k with q ih,
    {
      apply grammar_deri_self,
    },
    apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le ass)),
    use MB_bM,
    split_ile,
    use [list.repeat b q, list.repeat B (n - q.succ)],
    split,
    {
      have q_lt_n : q < n,
      {
        rwa nat.succ_le_iff at ass,
      },
      rw sub_suc_suc q_lt_n,
      rw list.repeat_succ_eq_singleton_append,
      repeat {
        rw list.append_assoc,
      },
      trim,
    },
    {
      rw list.repeat_succ_eq_append_singleton b,
      trim,
      rw list.append_assoc,
      refl,
    },
  },
  have almost := bees n (by refl),
  rwa [nat.sub_self, list.repeat_zero, list.append_nil] at almost,
end

private lemma steps_KC_cK (m n : ℕ) :
  grammar_derives gr_mul
    (list.repeat a m ++ list.repeat b n ++ [K] ++ list.repeat C (m * n) ++ [E])
    (list.repeat a m ++ list.repeat b n ++ list.repeat c (m * n) ++ [K] ++ [E]) :=
begin
  apply grammar_deri_with_postfix,
  repeat {
    rw list.append_assoc,
  },
  apply grammar_deri_with_prefix,
  apply grammar_deri_with_prefix,

  have terminating : ∀ p q : ℕ, p ≤ q →
    grammar_derives gr_mul ([K] ++ list.repeat C q) (list.repeat c p ++ [K] ++ list.repeat C (q - p)),
  {
    intros p q ass,
    induction p with r ih,
    {
      apply grammar_deri_self,
    },
    apply grammar_deri_of_deri_tran (ih (nat.le_of_succ_le ass)),
    clear ih,
    use KC_cK,
    split_ile,
    use [list.repeat c r, list.repeat C (q - r.succ)],
    split,
    {
      have r_lt_q : r < q,
      {
        rwa nat.succ_le_iff at ass,
      },
      rw sub_suc_suc r_lt_q,
      rw list.repeat_succ_eq_singleton_append,
      repeat {
        rw list.append_assoc,
      },
      trim,
    },
    {
      rw list.repeat_succ_eq_append_singleton c,
      trim,
      rw list.append_assoc,
      refl,
    },
  },
  have almost := terminating (m * n) (m * n) (by refl),
  rwa [nat.sub_self, list.repeat_zero, list.append_nil] at almost,
end

-- example 3 * 3 = 9 reproved using the new lemmata
example : grammar_generates gr_mul [a_, a_, a_, b_, b_, b_, c_, c_, c_, c_, c_, c_, c_, c_, c_] :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  apply grammar_deri_of_deri_deri (steps_L_aLX 3),
  apply grammar_deri_of_deri_deri (steps_R_BR 3 3),
  grammar_step ``(L_M) ``([a, a, a]) ``([X, X, X, B, B, B, R]),
  grammar_step ``(R_E) ``([a, a, a, M, X, X, X, B, B, B]) ``([]),
  apply grammar_deri_of_deri_deri (steps_quadratic 3 3),
  apply grammar_deri_of_deri_deri (steps_XE_E 3 3),
  apply grammar_deri_of_deri_deri (steps_MB_bM 3 3),
  grammar_step ``(M_K) ``([a, a, a, b, b, b]) ``([C, C, C, C, C, C, C, C, C, E]),
  apply grammar_deri_of_deri_deri (steps_KC_cK 3 3),
  apply grammar_deri_of_tran,
  use KE_nil,
  split_ile,
  use [[a, a, a, b, b, b, c, c, c, c, c, c, c, c, c], []],
  split;
  refl,
end

-- example 7 * 11 = 77
example : grammar_generates gr_mul (list.repeat a_ 7 ++ list.repeat b_ 11 ++ list.repeat c_ 77) :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  apply grammar_deri_of_deri_deri (steps_L_aLX 7),
  apply grammar_deri_of_deri_deri (steps_R_BR 7 11),
  grammar_step ``(L_M) ``(list.repeat a 7) ``(list.repeat X 7 ++ list.repeat B 11 ++ [R]),
  grammar_step ``(R_E) ``(list.repeat a 7 ++ [M] ++ list.repeat X 7 ++ list.repeat B 11) ``([]),
  apply grammar_deri_of_deri_deri (steps_quadratic 7 11),
  apply grammar_deri_of_deri_deri (steps_XE_E 7 11),
  apply grammar_deri_of_deri_deri (steps_MB_bM 7 11),
  grammar_step ``(M_K) ``((list.repeat a 7 ++ list.repeat b 11)) ``(list.repeat C 77 ++ [E]),
  apply grammar_deri_of_deri_deri (steps_KC_cK 7 11),
  apply grammar_deri_of_tran,
  use KE_nil,
  split_ile,
  use [(list.repeat a 7 ++ list.repeat b 11 ++ list.repeat c 77), []],
  split;
  refl,
end

private theorem multiplication_complete (m n : ℕ) :
  grammar_generates gr_mul (list.repeat a_ m ++ list.repeat b_ n ++ list.repeat c_ (m * n)) :=
begin
  grammar_step ``(S_LR) ``([]) ``([]),
  apply grammar_deri_of_deri_deri (steps_L_aLX m),
  apply grammar_deri_of_deri_deri (steps_R_BR m n),
  apply grammar_deri_of_tran_deri,
  {
    use L_M,
    split_ile,
    use [list.repeat a m, list.repeat X m ++ list.repeat B n ++ [R]],
    split;
    finish,
  },
  apply grammar_deri_of_tran_deri,
  {
    use R_E,
    split_ile,
    use [list.repeat a m ++ [M] ++ list.repeat X m ++ list.repeat B n, []],
    split;
    finish,
  },
  rw ←list.singleton_append,
  repeat {
    rw ←list.append_assoc,
  },
  apply grammar_deri_of_deri_deri (steps_quadratic m n),
  apply grammar_deri_of_deri_deri (steps_XE_E m n),
  apply grammar_deri_of_deri_deri (steps_MB_bM m n),
  apply grammar_deri_of_tran_deri,
  {
    use M_K,
    split_ile,
    use [list.repeat a m ++ list.repeat b n, list.repeat C (m * n) ++ [E]],
    split;
    finish,
  },
  repeat {
    rw ←list.append_assoc,
  },
  apply grammar_deri_of_deri_deri (steps_KC_cK m n),
  apply grammar_deri_of_tran,
  use KE_nil,
  split_ile,
  unfold KE_nil,
  use [(list.repeat a m ++ list.repeat b n ++ list.repeat c (m * n)), []],
  split,
  {
    finish,
  },
  rw list.map_append_append,
  repeat {
    rw list.map_repeat,
  },
  repeat {
    rw list.append_assoc,
  },
  congr,
  rw list.append_nil,
  rw list.append_nil,
  refl,
end

-- example 3 * 3 = 9 reproved using the new theorem
example : grammar_generates gr_mul [a_, a_, a_, b_, b_, b_, c_, c_, c_, c_, c_, c_, c_, c_, c_] :=
begin
  exact multiplication_complete 3 3,
end

-- example 1001 * 587 = 587587
example : grammar_generates gr_mul (list.repeat a_ 1001 ++ list.repeat b_ 587 ++ list.repeat c_ 587587) :=
begin
  have pe : 587587 = 1001 * 587,
  {
    norm_num,
  },
  rw pe,
  apply multiplication_complete,
end