/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.cont_mdiff_mfderiv
import topology.continuous_function.basic

/-!
# Smooth bundled map

In this file we define the type `cont_mdiff_map` of `n` times continuously differentiable
bundled maps.
-/

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
(M : Type*) [topological_space M] [charted_space H M]
(M' : Type*) [topological_space M'] [charted_space H' M']
{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H'']
{I'' : model_with_corners 𝕜 E'' H''}
{M'' : Type*} [topological_space M''] [charted_space H'' M'']
(n : ℕ∞)

/-- Bundled `n` times continuously differentiable maps. -/
@[protect_proj]
structure cont_mdiff_map :=
(to_fun                  : M → M')
(cont_mdiff_to_fun : cont_mdiff I I' n to_fun)

/-- Bundled smooth maps. -/
@[reducible] def smooth_map := cont_mdiff_map I I' M M' ⊤

localized "notation (name := cont_mdiff_map) `C^` n `⟮` I `, ` M `; ` I' `, ` M' `⟯` :=
  cont_mdiff_map I I' M M' n" in manifold
localized "notation (name := cont_mdiff_map.self) `C^` n `⟮` I `, ` M `; ` k `⟯` :=
  cont_mdiff_map I (model_with_corners_self k k) M k n" in manifold

open_locale manifold

namespace cont_mdiff_map

variables {I} {I'} {M} {M'} {n}

instance : has_coe_to_fun C^n⟮I, M; I', M'⟯ (λ _, M → M') := ⟨cont_mdiff_map.to_fun⟩
instance : has_coe C^n⟮I, M; I', M'⟯ C(M, M') :=
⟨λ f, ⟨f, f.cont_mdiff_to_fun.continuous⟩⟩

attribute [to_additive_ignore_args 21] cont_mdiff_map
  cont_mdiff_map.has_coe_to_fun cont_mdiff_map.continuous_map.has_coe
variables {f g : C^n⟮I, M; I', M'⟯}

@[simp] lemma coe_fn_mk (f : M → M') (hf : cont_mdiff I I' n f) :
  (mk f hf : M → M') = f :=
rfl

protected lemma cont_mdiff (f : C^n⟮I, M; I', M'⟯) :
  cont_mdiff I I' n f := f.cont_mdiff_to_fun

protected lemma smooth (f : C^∞⟮I, M; I', M'⟯) :
  smooth I I' f := f.cont_mdiff_to_fun

protected lemma mdifferentiable' (f : C^n⟮I, M; I', M'⟯) (hn : 1 ≤ n) :
  mdifferentiable I I' f :=
f.cont_mdiff.mdifferentiable hn

protected

protected lemma mdifferentiable_at (f : C^∞⟮I, M; I', M'⟯) {x} :
  mdifferentiable_at I I' f x :=
f.mdifferentiable x

lemma coe_inj ⦃f g : C^n⟮I, M; I', M'⟯⦄ (h : (f : M → M') = g) : f = g :=
by cases f; cases g; cases h; refl

@[ext] theorem ext (h : ∀ x, f x = g x) : f = g :=
by cases f; cases g; congr'; exact funext h

instance : continuous_map_class C^n⟮I, M; I', M'⟯ M M' :=
{ coe := (λ f, ⇑f),
  coe_injective' := coe_inj,
  map_continuous := λ f, f.cont_mdiff.continuous }

/-- The identity as a smooth map. -/
def id : C^n⟮I, M; I, M⟯ := ⟨id, cont_mdiff_id⟩

/-- The composition of smooth maps, as a smooth map. -/
def comp (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) : C^n⟮I, M; I'', M''⟯ :=
{ to_fun := λ a, f (g a),
  cont_mdiff_to_fun := f.cont_mdiff_to_fun.comp g.cont_mdiff_to_fun, }

@[simp] lemma comp_apply (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) (x : M) :
  f.comp g x = f (g x) := rfl

instance [inhabited M'] : inhabited C^n⟮I, M; I', M'⟯ :=
⟨⟨λ _, default, cont_mdiff_const⟩⟩

/-- Constant map as a smooth map -/
def const (y : M') : C^n⟮I, M; I', M'⟯ := ⟨λ x, y, cont_mdiff_const⟩

end cont_mdiff_map

instance continuous_linear_map.has_coe_to_cont_mdiff_map :
  has_coe (E →L[𝕜] E') C^n⟮𝓘(𝕜, E), E; 𝓘(𝕜, E'), E'⟯ :=
⟨λ f, ⟨f.to_fun, f.cont_mdiff⟩⟩


def f (x y : Nat) := x + 2*y

namespace Foo

local infix:65 (priority := high) "+" => f

theorem ex1 (x y : Nat) : x + y = f x y := rfl

#check 1 + 2

end Foo

#check 1 + 2
theorem ex2 (x y : Nat) : x + y = HAdd.hAdd x y := rfl

open Foo

theorem ex3 (x y : Nat) : x + y = HAdd.hAdd x y := rfl
#check 1 + 2

section
def g (x y : Nat) := 3*(x+y)

local infix:65 (priority := high) "  +  " => g

theorem ex4 (x y : Nat) : x + y = g x y := rfl

#check 1 + 2

end

theorem ex5 (x y : Nat) : x + y = HAdd.hAdd x y := rfl
#check 1 + 2


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.eq_to_hom

/-!
# The category paths on a quiver.
-/

universes v₁ v₂ u₁ u₂

namespace category_theory

section

/--
A type synonym for the category of paths in a quiver.
-/
def paths (V : Type u₁) : Type u₁ := V

instance (V : Type u₁) [inhabited V] : inhabited (paths V) := ⟨(default V : V)⟩

variables (V : Type u₁) [quiver.{v₁+1} V]

namespace paths

instance category_paths : category.{max u₁ v₁} (paths V) :=
{ hom := λ (X Y : V), quiver.path X Y,
  id := λ X, quiver.path.nil,
  comp := λ X Y Z f g, quiver.path.comp f g, }

variables {V}

/--
The inclusion of a quiver `V` into its path category, as a prefunctor.
-/
@[simps]
def of : prefunctor V (paths V) :=
{ obj := λ X, X,
  map := λ X Y f, f.to_path, }

local attribute [ext] functor.ext

/-- Two functors out of a path category are equal when they agree on singleton paths. -/
@[ext]
lemma ext_functor {C} [category C]
  {F G : paths V ⥤ C}
  (h_obj : F.obj = G.obj)
  (h : ∀ (a b : V) (e : a ⟶ b), F.map e.to_path =
  eq_to_hom (congr_fun h_obj a) ≫ G.map e.to_path ≫ eq_to_hom (congr_fun h_obj.symm b)) :
  F = G :=
begin
  ext X Y f,
  { induction f with Y' Z' g e ih,
    { erw [F.map_id, G.map_id, category.id_comp, eq_to_hom_trans, eq_to_hom_refl], },
    { erw [F.map_comp g e.to_path, G.map_comp g e.to_path, ih, h],
      simp only [category.id_comp, eq_to_hom_refl, eq_to_hom_trans_assoc, category.assoc], }, },
  { intro X, rw h_obj, }
end

end paths

variables (W : Type u₂) [quiver.{v₂+1} W]

-- A restatement of `prefunctor.map_path_comp` using `f ≫ g` instead of `f.comp g`.
@[simp] lemma prefunctor.map_path_comp' (F : prefunctor V W)
  {X Y Z : paths V} (f : X ⟶ Y) (g : Y ⟶ Z) :
  F.map_path (f ≫ g) = (F.map_path f).comp (F.map_path g) :=
prefunctor.map_path_comp _ _ _

end

section

variables {C : Type u₁} [category.{v₁} C]

open quiver

/-- A path in a category can be composed to a single morphism. -/
@[simp]
def compose_path {X : C} : Π {Y : C} (p : path X Y), X ⟶ Y
| _ path.nil := 𝟙 X
| _ (path.cons p e) := compose_path p ≫ e

@[simp]
lemma compose_path_comp {X Y Z : C} (f : path X Y) (g : path Y Z) :
  compose_path (f.comp g) = compose_path f ≫ compose_path g :=
begin
  induction g with Y' Z' g e ih,
  { simp, },
  { simp [ih], },
end

end

end category_theory


import .fibrant data.fin data.equiv .facts algebra.category .facts

open nat equiv fin eq.ops sum unit prod.ops function

-- facts about a type family indexed by the strict finite type

definition pi_fin0_unit_equiv {X : fin 0 → Type} : (Π i, X i) ≃ unit :=
  equiv.mk (λ x, unit.star) (λ x i, fin.elim0 i)
  begin unfold left_inverse, intro, apply funext, intro, apply (elim0 x_1) end
  begin
  intro, cases x, reflexivity
  end

lemma pi_sum_fin_unit_equiv {n} {X : (unit + fin n) → Type} : (Π i, X i) ≃ (X (inl ⋆) × Π i, X (inr i)) :=
  equiv.mk
    (λ x, (x (inl ⋆), λ y, x (inr y)))
    (λ p, λ z, sum.cases_on z (λ x1, unit.cases_on x1 p.1) (λ x2, p.2 x2))
  begin
    unfold left_inverse, esimp, intro, apply funext, intro i,
    cases i,
      { esimp, cases a, esimp },
      { esimp }
  end
  begin
    unfold right_inverse, unfold left_inverse, apply prod.eta
  end

definition pi_sum_fin_unit_equiv' {n} (Heq : fin n + unit ≃ fin (nat.succ n))
      {X : fin (nat.succ n) → Type}
      : (Π i, X (Heq ∙ i)) ≃ (X (Heq ∙ (inr ⋆)) × Π i, X (Heq ∙ (inl i))) :=
 equiv.mk
   (λ x, (x (inr ⋆), λ y, x (inl y)))
   (λ p, λ z, sum.cases_on z (λ x2, p.2 x2) (λ x1, unit.cases_on x1 p.1))
   begin
     unfold left_inverse, esimp, intro x, apply funext, intro i,
     cases i, esimp, cases a, esimp
   end
   begin
     unfold right_inverse, unfold left_inverse, apply prod.eta
   end

-- ref:lem:finite-cofibrant
-- Lemma 3.23 (iii)
definition finite_cofibrant {n : ℕ} {X : fin n → Fib}
  : is_fibrant (Π i, X i) :=
  begin
    induction n with n IHn,
    { apply (equiv_is_fibrant (equiv.symm pi_fin0_unit_equiv)) },
    { have HeqFinSum : fin n + unit ≃ fin (succ n), from (fin_sum_unit_equiv n),
      apply equiv_is_fibrant,
        apply pi_congr₁,
        apply equiv_is_fibrant, apply (equiv.symm (pi_sum_fin_unit_equiv' HeqFinSum))}
end

namespace fin

  definition lift_down {n : ℕ} (i : fin (nat.succ n)) (Hne : i ≠ maxi) : fin n := fin.mk (val i) (lt_max_of_ne_max Hne)

  definition lift_succ_lift_down_inverse {n : ℕ} {i : fin (nat.succ n)} {Hne : i ≠ maxi} :
    (lift_succ (lift_down i Hne)) = i :=
    begin cases i, esimp end

  open decidable equiv.ops

  -- inspired by Paolo Capriotti's Agda implementation

  definition fin_transpose {n} (i j k : fin n) : fin n :=
    match fin.has_decidable_eq _ i k with
    | inl _ := j
    | inr _ := match fin.has_decidable_eq _ j k with
               | inl _ := i
               | inr _ := k
               end
  end

  lemma fin_transpose_invol {n} {i j k : fin n} : fin_transpose i j (fin_transpose i j k) = k :=
    begin
      unfold fin_transpose,
      cases (fin.has_decidable_eq n i k) with [i_eq_k, i_ne_k]: esimp,
      cases (fin.has_decidable_eq n i j) with [i_eq_j, j_ne_k]: esimp, apply i_eq_j⁻¹ ⬝ i_eq_k,
      cases (fin.has_decidable_eq n j j) with [j_eq_j, j_ne_j]: esimp, assumption, apply absurd rfl j_ne_j,
      cases (fin.has_decidable_eq n j k) with [j_eq_k, j_ne_k]: esimp,
      cases (fin.has_decidable_eq n i i) with [i_eq_i, i_ne_i]: esimp, assumption,
      cases (fin.has_decidable_eq n j i) with [j_eq_i, j_ne_i]: esimp: apply absurd rfl i_ne_i,
      cases (fin.has_decidable_eq n i k) with [i_eq_k, i_ne_k]: esimp, rewrite i_eq_k at i_ne_k, apply absurd rfl i_ne_k,
      cases (fin.has_decidable_eq n j k) with [j_eq_k, j_ne_k]: esimp, apply absurd j_eq_k j_ne_k
      end

  definition fin_transpose_equiv [instance] {n} (i j : fin n) : fin n ≃ fin n:=
  equiv.mk (fin_transpose i j) (fin_transpose i j) (λ k, fin_transpose_invol) (λ k, fin_transpose_invol)

  definition fin_transpose_β₁ {n : ℕ} {i j : fin n} : fin_transpose i i j = j :=
  begin
    unfold fin_transpose,
    cases (fin.has_decidable_eq n i j) with [i_eq_j, i_ne_j]: esimp, apply i_eq_j
  end

  definition fin_transpose_β₂ {n : ℕ} {i j : fin n} : fin_transpose i j j = i :=
  begin
    unfold fin_transpose,
    cases (fin.has_decidable_eq n i j) with [i_eq_j, i_ne_j]: esimp, apply i_eq_j⁻¹,
    cases (fin.has_decidable_eq n j j) with [j_eq_j, j_ne_j]: esimp, apply absurd rfl j_ne_j
  end

  definition fin_transpose_inj {n : ℕ} {i j : fin n} : injective (fin_transpose i j) :=
  begin
    refine (injective_of_left_inverse (@left_inv (fin n) (fin n) (fin_transpose_equiv _ _)))
  end

  -- removing any element from fin is equivalent to removing maximal element
  -- we use transpositions defined above to prove this
  definition fin_remove_max_equiv [instance] {n : ℕ} (z : fin (nat.succ n)) :
    (Σ i : fin (nat.succ n), i ≠ z) ≃ (Σ i : fin (nat.succ n), i ≠ maxi) :=
    begin
    assert H : Π (x : fin (nat.succ n)), x = z ≃ (fin_transpose maxi z x = maxi),
    begin
    intros, refine equiv.mk (λ Heq, Heq⁻¹ ▹ fin_transpose_β₂) _ _ _,
    { intros, assert Heq : fin_transpose maxi z x = fin_transpose maxi z z, begin rewrite fin_transpose_β₂, assumption end,
      apply fin_transpose_inj, assumption },
    { unfold left_inverse, intro, esimp },
    { unfold right_inverse, intro, esimp }
    end,
    refine @sigma_congr _ _ _ _ (fin_transpose_equiv maxi z) (λ x, @pi_congr _ _ _ _ (H _) (λ y, equiv.refl _))
    end

  open sigma.ops

  -- removing maximal element gives us a set with smaller cardinality
  -- we use it as a base case to remove any element and get a set with smaller cardinality
  definition fin_remove_max [instance] {n : ℕ} : (Σ i : fin (nat.succ n), i ≠ maxi) ≃ fin n :=
    begin
      refine equiv.mk (λ j, lift_down _ j.2) (λi,⟨lift_succ i,lift_succ_ne_max⟩) _ _,
      { unfold left_inverse, intro j, cases j, congruence,
        rewrite lift_succ_lift_down_inverse },
      { unfold right_inverse, unfold left_inverse, intro i, cases i, unfold lift_down }
    end

  -- now we can remove any element from fin using equivalences defined above
  definition fin_remove_equiv {n : ℕ } (z : fin (nat.succ n))
    : (Σ i : fin (nat.succ n), i ≠ z) ≃ fin n := fin_remove_max ∘ (fin_remove_max_equiv z)
end fin

-- some facts about finite categories

namespace fincat
  universe variables u v
  variables {C C' : Category.{u v}}
  open category sigma.ops eq equiv.ops

  definition is_obj_finite [class] (C : Category) := Σ n, C ≃ fin n
  definition is_obj_finite_eq [finC : is_obj_finite C] := finC.2

  attribute is_obj_finite_eq [instance]

  definition fincat_ne_maxi {n : ℕ} {z : C} {f : C → fin (succ n)} (inj_f : injective f)
    (max_z : f z = maxi) {o : C} (p : o ≠ z) : f o ≠ (maxi : fin (succ n)) :=
    begin
      unfold ne, unfold not, intro,
      apply p, rewrite -max_z at a, apply inj_f a
  end

  definition eq_of_finN_eq [finC : is_obj_finite C] {c c' : C} : c = c' → to_fun (fin (finC.1)) c = to_fun (fin (finC.1)) c' :=
    begin
      intro Heq, cases finC with [n, φ], esimp, apply (ap _ Heq)
    end

  definition finN_eq_of_eq [finC : is_obj_finite C] {c c' : C} : to_fun (fin (finC.1)) c = to_fun (fin (finC.1)) c' → c = c' :=
    begin
      intro Heq, cases finC with [n, φ], cases φ with [f,g,l,r], esimp at *,
      apply (injective_of_left_inverse l), apply Heq
    end

  definition eq_iff_finN_eq [finC : is_obj_finite C] {c c' : C} :
    to_fun (fin (finC.1)) c = to_fun (fin (finC.1)) c' ↔ c = c' := iff.intro finN_eq_of_eq eq_of_finN_eq

  definition has_decidable_eq [instance] [finC : is_obj_finite C] {c c' : C} : decidable (c = c') :=
    decidable_of_decidable_of_iff (fin.has_decidable_eq _ _ _) eq_iff_finN_eq

  definition fincat_ob_remove_fin_equiv {n : ℕ} (z : C) [φ : C ≃ fin (succ n)] : (Σ c, c ≠ z) ≃ fin n :=
    begin
    cases φ with [f,g,l,r], esimp at *,
    assert Hequiv: (Σ c, c ≠ z) ≃ Σ (i : fin (succ n)), i ≠ f z,
      begin refine equiv.mk _ _ _ _,
      intro j, cases j with [c, p_ne], existsi f c, intros, apply p_ne, apply (injective_of_left_inverse l), assumption,
      intro i, cases i with [i', p_ne], existsi g i', intros, apply p_ne, rewrite -a, apply (r i')⁻¹,
      unfold left_inverse, intro x, cases x with [c, p_ne], esimp, congruence, apply l,
      unfold right_inverse, unfold left_inverse, unfold injective_of_left_inverse, intro x,
      cases x with [i, p_ne], esimp, congruence, apply r end,
      apply (fin.fin_remove_equiv _) ∘ Hequiv
    end
end fincat


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import linear_algebra.affine_space.affine_map
import linear_algebra.general_linear_group
import algebra.invertible

/-!
# Affine equivalences

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

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

We equip `affine_equiv k P P` with a `group` structure with multiplication corresponding to
composition in `affine_equiv.group`.

## Tags

affine space, affine equivalence
-/

open function set
open_locale affine

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
@[nolint has_nonempty_instance]
structure affine_equiv (k P₁ P₂ : Type*) {V₁ V₂ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂] extends P₁ ≃ P₂ :=
(linear : V₁ ≃ₗ[k] V₂)
(map_vadd' : ∀ (p : P₁) (v : V₁), to_equiv (v +ᵥ p) = linear v +ᵥ to_equiv p)

notation P₁ ` ≃ᵃ[`:25 k:25 `] `:0 P₂:0 := affine_equiv k P₁ P₂

variables {k P₁ P₂ P₃ P₄ V₁ V₂ V₃ V₄ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
  [add_comm_group V₃] [module k V₃] [add_torsor V₃ P₃]
  [add_comm_group V₄] [module k V₄] [add_torsor V₄ P₄]

namespace affine_equiv

include V₁ V₂

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ := { .. e }

@[simp] lemma to_affine_map_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
  to_affine_map (mk f f' h) = ⟨f, f', h⟩ :=
rfl

@[simp] lemma linear_to_affine_map (e : P₁ ≃ᵃ[k] P₂) : e.to_affine_map.linear = e.linear := rfl

lemma to_affine_map_injective : injective (to_affine_map : (P₁ ≃ᵃ[k] P₂) → (P₁ →ᵃ[k] P₂)) :=
begin
  rintros ⟨e, el, h⟩ ⟨e', el', h'⟩ H,
  simp only [to_affine_map_mk, equiv.coe_inj, linear_equiv.to_linear_map_inj] at H,
  congr,
  exacts [H.1, H.2]
end

@[simp] lemma to_affine_map_inj {e e' : P₁ ≃ᵃ[k] P₂} :
  e.to_affine_map = e'.to_affine_map ↔ e = e' :=
to_affine_map_injective.eq_iff

instance equiv_like : equiv_like (P₁ ≃ᵃ[k] P₂) P₁ P₂ :=
{ coe := λ f, f.to_fun,
  inv := λ f, f.inv_fun,
  left_inv := λ f, f.left_inv,
  right_inv := λ f, f.right_inv,
  coe_injective' := λ f g h _, to_affine_map_injective (fun_like.coe_injective h) }

instance : has_coe_to_fun (P₁ ≃ᵃ[k] P₂) (λ _, P₁ → P₂) := fun_like.has_coe_to_fun

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) := ⟨affine_equiv.to_equiv⟩

variables {k P₁}

@[simp] lemma map_vadd (e : P₁ ≃ᵃ[k] P₂) (p : P₁) (v : V₁) : e (v +ᵥ p) = e.linear v +ᵥ e p :=
e.map_vadd' p v

@[simp] lemma coe_to_equiv (e : P₁ ≃ᵃ[k] P₂) : ⇑e.to_equiv = e := rfl

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ →ᵃ[k] P₂) := ⟨to_affine_map⟩

@[simp] lemma coe_to_affine_map (e : P₁ ≃ᵃ[k] P₂) :
  (e.to_affine_map : P₁ → P₂) = (e : P₁ → P₂) :=
rfl

@[norm_cast, simp] lemma coe_coe (e : P₁ ≃ᵃ[k] P₂) : ((e : P₁ →ᵃ[k] P₂) : P₁ → P₂) = e := rfl

@[simp] lemma coe_linear (e : P₁ ≃ᵃ[k] P₂) : (e : P₁ →ᵃ[k] P₂).linear = e.linear := rfl

@[ext] lemma ext {e e' : P₁ ≃ᵃ[k] P₂} (h : ∀ x, e x = e' x) : e = e' :=
fun_like.ext _ _ h

lemma coe_fn_injective : @injective (P₁ ≃ᵃ[k] P₂) (P₁ → P₂) coe_fn :=
fun_like.coe_injective

@[simp, norm_cast] lemma coe_fn_inj {e e' : P₁ ≃ᵃ[k] P₂} : (e : P₁ → P₂) = e' ↔ e = e' :=
coe_fn_injective.eq_iff

lemma to_equiv_injective : injective (to_equiv : (P₁ ≃ᵃ[k] P₂) → (P₁ ≃ P₂)) :=
λ e e' H, ext $ equiv.ext_iff.1 H

@[simp] lemma to_equiv_inj {e e' : P₁ ≃ᵃ[k] P₂} : e.to_equiv = e'.to_equiv ↔ e = e' :=
to_equiv_injective.eq_iff

@[simp] lemma coe_mk (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (h) :
  ((⟨e, e', h⟩ : P₁ ≃ᵃ[k] P₂) : P₁ → P₂) = e :=
rfl

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes a map `e : P₁ → P₂`, a linear equivalence
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' (e : P₁ → P₂) (e' : V₁ ≃ₗ[k] V₂) (p : P₁) (h : ∀ p' : P₁, e p' = e' (p' -ᵥ p) +ᵥ e p) :
  P₁ ≃ᵃ[k] P₂ :=
{ to_fun := e,
  inv_fun := λ q' : P₂, e'.symm (q' -ᵥ e p) +ᵥ p,
  left_inv := λ p', by simp [h p'],
  right_inv := λ q', by simp [h (e'.symm (q' -ᵥ e p) +ᵥ p)],
  linear := e',
  map_vadd' := λ p' v, by { simp [h p', h (v +ᵥ p'), vadd_vsub_assoc, vadd_vadd] } }

@[simp] lemma coe_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) : ⇑(mk' e e' p h) = e := rfl
@[simp] lemma linear_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) :
  (mk' e e' p h).linear = e' := rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
@[symm] def symm (e : P₁ ≃ᵃ[k] P₂) : P₂ ≃ᵃ[k] P₁ :=
{ to_equiv := e.to_equiv.symm,
  linear := e.linear.symm,
  map_vadd' := λ v p, e.to_equiv.symm.apply_eq_iff_eq_symm_apply.2 $
    by simpa using (e.to_equiv.apply_symm_apply v).symm }

@[simp] lemma symm_to_equiv (e : P₁ ≃ᵃ[k] P₂) : e.to_equiv.symm = e.symm.to_equiv := rfl

@[simp] lemma symm_linear (e : P₁ ≃ᵃ[k] P₂) : e.linear.symm = e.symm.linear := rfl

/-- See Note [custom simps projection] -/
def simps.apply (e : P₁ ≃ᵃ[k] P₂) : P₁ → P₂ := e

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : P₁ ≃ᵃ[k] P₂) : P₂ → P₁ := e.symm

initialize_simps_projections affine_equiv
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, linear → linear as_prefix, -to_equiv)

protected lemma bijective (e : P₁ ≃ᵃ[k] P₂) : bijective e := e.to_equiv.bijective
protected lemma surjective (e : P₁ ≃ᵃ[k] P₂) : surjective e := e.to_equiv.surjective
protected lemma injective (e : P₁ ≃ᵃ[k] P₂) : injective e := e.to_equiv.injective

/-- Bijective affine maps are affine isomorphisms. -/
@[simps]
noncomputable def of_bijective {φ : P₁ →ᵃ[k] P₂} (hφ : function.bijective φ) : P₁ ≃ᵃ[k] P₂ :=
{ linear := linear_equiv.of_bijective φ.linear (φ.linear_bijective_iff.mpr hφ),
  map_vadd' := φ.map_vadd,
  ..(equiv.of_bijective _ hφ) }

lemma of_bijective.symm_eq {φ : P₁ →ᵃ[k] P₂} (hφ : function.bijective φ) :
  (of_bijective hφ).symm.to_equiv = (equiv.of_bijective _ hφ).symm := rfl

@[simp] lemma range_eq (e : P₁ ≃ᵃ[k] P₂) : range e = univ := e.surjective.range_eq

@[simp] lemma apply_symm_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₂) : e (e.symm p) = p :=
e.to_equiv.apply_symm_apply p

@[simp] lemma symm_apply_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₁) : e.symm (e p) = p :=
e.to_equiv.symm_apply_apply p

lemma apply_eq_iff_eq_symm_apply (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂} : e p₁ = p₂ ↔ p₁ = e.symm p₂ :=
e.to_equiv.apply_eq_iff_eq_symm_apply

@[simp] lemma apply_eq_iff_eq (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂ : P₁} : e p₁ = e p₂ ↔ p₁ = p₂ :=
e.to_equiv.apply_eq_iff_eq

@[simp] lemma image_symm (f : P₁ ≃ᵃ[k] P₂) (s : set P₂) : f.symm '' s = f ⁻¹' s :=
f.symm.to_equiv.image_eq_preimage _

@[simp] lemma preimage_symm (f : P₁ ≃ᵃ[k] P₂) (s : set P₁) : f.symm ⁻¹' s = f '' s :=
(f.symm.image_symm _).symm

variables (k P₁)

omit V₂

/-- Identity map as an `affine_equiv`. -/
@[refl] def refl : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.refl P₁,
  linear := linear_equiv.refl k V₁,
  map_vadd' := λ _ _, rfl }

@[simp] lemma coe_refl : ⇑(refl k P₁) = id := rfl

@[simp] lemma coe_refl_to_affine_map : ↑(refl k P₁) = affine_map.id k P₁ := rfl

@[simp] lemma refl_apply (x : P₁) : refl k P₁ x = x := rfl

@[simp] lemma to_equiv_refl : (refl k P₁).to_equiv = equiv.refl P₁ := rfl

@[simp] lemma linear_refl : (refl k P₁).linear = linear_equiv.refl k V₁ := rfl

@[simp] lemma symm_refl : (refl k P₁).symm = refl k P₁ := rfl

variables {k P₁}
include V₂ V₃

/-- Composition of two `affine_equiv`alences, applied left to right. -/
@[trans] def trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : P₁ ≃ᵃ[k] P₃ :=
{ to_equiv := e.to_equiv.trans e'.to_equiv,
  linear := e.linear.trans e'.linear,
  map_vadd' := λ p v, by simp only [linear_equiv.trans_apply, coe_to_equiv, (∘),
    equiv.coe_trans, map_vadd] }

@[simp] lemma coe_trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : ⇑(e.trans e') = e' ∘ e := rfl

@[simp] lemma coe_trans_to_affine_map (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) :
  (e.trans e' : P₁ →ᵃ[k] P₃) = (e' : P₂ →ᵃ[k] P₃).comp e :=
rfl

@[simp]
lemma trans_apply (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) (p : P₁) : e.trans e' p = e' (e p) := rfl

include V₄

lemma trans_assoc (e₁ : P₁ ≃ᵃ[k] P₂) (e₂ : P₂ ≃ᵃ[k] P₃) (e₃ : P₃ ≃ᵃ[k] P₄) :
  (e₁.trans e₂).trans e₃ = e₁.trans (e₂.trans e₃) :=
ext $ λ _, rfl

omit V₃ V₄

@[simp] lemma trans_refl (e : P₁ ≃ᵃ[k] P₂) : e.trans (refl k P₂) = e :=
ext $ λ _, rfl

@[simp] lemma refl_trans (e : P₁ ≃ᵃ[k] P₂) : (refl k P₁).trans e = e :=
ext $ λ _, rfl

@[simp] lemma self_trans_symm (e : P₁ ≃ᵃ[k] P₂) : e.trans e.symm = refl k P₁ :=
ext e.symm_apply_apply

@[simp] lemma symm_trans_self (e : P₁ ≃ᵃ[k] P₂) : e.symm.trans e = refl k P₂ :=
ext e.apply_symm_apply

@[simp] lemma apply_line_map (e : P₁ ≃ᵃ[k] P₂) (a b : P₁) (c : k) :
  e (affine_map.line_map a b c) = affine_map.line_map (e a) (e b) c :=
e.to_affine_map.apply_line_map a b c

omit V₂

instance : group (P₁ ≃ᵃ[k] P₁) :=
{ one := refl k P₁,
  mul := λ e e', e'.trans e,
  inv := symm,
  mul_assoc := λ e₁ e₂ e₃, trans_assoc _ _ _,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

lemma one_def : (1 : P₁ ≃ᵃ[k] P₁) = refl k P₁ := rfl

@[simp] lemma coe_one : ⇑(1 : P₁ ≃ᵃ[k] P₁) = id := rfl

lemma mul_def (e e' : P₁ ≃ᵃ[k] P₁) : e * e' = e'.trans e := rfl

@[simp] lemma coe_mul (e e' : P₁ ≃ᵃ[k] P₁) : ⇑(e * e') = e ∘ e' := rfl

lemma inv_def (e : P₁ ≃ᵃ[k] P₁) : e⁻¹ = e.symm := rfl

/-- `affine_equiv.linear` on automorphisms is a `monoid_hom`. -/
@[simps] def linear_hom : (P₁ ≃ᵃ[k] P₁) →* (V₁ ≃ₗ[k] V₁) :=
{ to_fun := linear,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

/-- The group of `affine_equiv`s are equivalent to the group of units of `affine_map`.

This is the affine version of `linear_map.general_linear_group.general_linear_equiv`. -/
@[simps]
def equiv_units_affine_map : (P₁ ≃ᵃ[k] P₁) ≃* (P₁ →ᵃ[k] P₁)ˣ :=
{ to_fun := λ e, ⟨e, e.symm, congr_arg coe e.symm_trans_self, congr_arg coe e.self_trans_symm⟩,
  inv_fun := λ u,
  { to_fun := (u : P₁ →ᵃ[k] P₁), inv_fun := (↑(u⁻¹) : P₁ →ᵃ[k] P₁),
    left_inv := affine_map.congr_fun u.inv_mul,
    right_inv := affine_map.congr_fun u.mul_inv,
    linear := linear_map.general_linear_group.general_linear_equiv _ _ $
      units.map (by exact affine_map.linear_hom) u,
    map_vadd' := λ _ _, (u : P₁ →ᵃ[k] P₁).map_vadd _ _ },
  left_inv := λ e, affine_equiv.ext $ λ x, rfl,
  right_inv := λ u, units.ext $ affine_map.ext $ λ x, rfl,
  map_mul' := λ e₁ e₂, rfl }

variable (k)

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
@[simps]
def vadd_const (b : P₁) : V₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.vadd_const b,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p v, add_vadd _ _ _ }

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P₁) : P₁ ≃ᵃ[k] V₁ :=
{ to_equiv := equiv.const_vsub p,
  linear := linear_equiv.neg k,
  map_vadd' := λ p' v, by simp [vsub_vadd_eq_vsub_sub, neg_add_eq_sub] }

@[simp] lemma coe_const_vsub (p : P₁) : ⇑(const_vsub k p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P₁) : ⇑(const_vsub k p).symm = λ v, -v +ᵥ p := rfl

variable (P₁)

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space.

Note that there is no need for an `affine_map.const_vadd` as it is always an equivalence.
This is roughly to `distrib_mul_action.to_linear_equiv` as `+ᵥ` is to `•`. -/
@[simps apply linear]
def const_vadd (v : V₁) : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.const_vadd P₁ v,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p w, vadd_comm _ _ _ }

@[simp] lemma const_vadd_zero : const_vadd k P₁ 0 = affine_equiv.refl _ _ := ext $ zero_vadd _

@[simp] lemma const_vadd_add (v w : V₁) :
  const_vadd k P₁ (v + w) = (const_vadd k P₁ w).trans (const_vadd k P₁ v) := ext $ add_vadd _ _

@[simp] lemma const_vadd_symm (v : V₁) : (const_vadd k P₁ v).symm = const_vadd k P₁ (-v) :=
ext $ λ _, rfl

/-- A more bundled version of `affine_equiv.const_vadd`. -/
@[simps]
def const_vadd_hom : multiplicative V₁ →* P₁ ≃ᵃ[k] P₁ :=
{ to_fun := λ v, const_vadd k P₁ v.to_add,
  map_one' := const_vadd_zero _ _,
  map_mul' := const_vadd_add _ _ }

lemma const_vadd_nsmul (n : ℕ) (v : V₁) : const_vadd k P₁ (n • v) = (const_vadd k P₁ v)^n :=
(const_vadd_hom k P₁).map_pow _ _

lemma const_vadd_zsmul (z : ℤ) (v : V₁) : const_vadd k P₁ (z • v) = (const_vadd k P₁ v)^z :=
(const_vadd_hom k P₁).map_zpow _ _

section homothety

omit V₁

variables {R V P : Type*} [comm_ring R] [add_comm_group V] [module R V] [affine_space V P]
include V

/-- Fixing a point in affine space, homothety about this point gives a group homomorphism from (the
centre of) the units of the scalars into the group of affine equivalences. -/
def homothety_units_mul_hom (p : P) : Rˣ →* P ≃ᵃ[R] P :=
equiv_units_affine_map.symm.to_monoid_hom.comp $ units.map (affine_map.homothety_hom p)

@[simp] lemma coe_homothety_units_mul_hom_apply (p : P) (t : Rˣ) :
  (homothety_units_mul_hom p t : P → P) = affine_map.homothety p (t : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_apply_symm (p : P) (t : Rˣ) :
  ((homothety_units_mul_hom p t).symm : P → P) = affine_map.homothety p (↑t⁻¹ : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_eq_homothety_hom_coe (p : P) :
  (coe : (P ≃ᵃ[R] P) → P →ᵃ[R] P) ∘ homothety_units_mul_hom p =
  (affine_map.homothety_hom p) ∘ (coe : Rˣ → R) :=
funext $ λ _, rfl

end homothety

variable {P₁}
open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P₁) : P₁ ≃ᵃ[k] P₁ := (const_vsub k x).trans (vadd_const k x)

lemma point_reflection_apply (x y : P₁) : point_reflection k x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P₁) : (point_reflection k x).symm = point_reflection k x :=
to_equiv_injective $ equiv.point_reflection_symm x

@[simp] lemma to_equiv_point_reflection (x : P₁) :
  (point_reflection k x).to_equiv = equiv.point_reflection x :=
rfl

@[simp] lemma point_reflection_self (x : P₁) : point_reflection k x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P₁) : involutive (point_reflection k x : P₁ → P₁) :=
equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P₁} (h : injective (bit0 : V₁ → V₁)) :
  point_reflection k x y = y ↔ y = x :=
equiv.point_reflection_fixed_iff_of_injective_bit0 h

lemma injective_point_reflection_left_of_injective_bit0 (h : injective (bit0 : V₁ → V₁)) (y : P₁) :
  injective (λ x : P₁, point_reflection k x y) :=
equiv.injective_point_reflection_left_of_injective_bit0 h y

lemma injective_point_reflection_left_of_module [invertible (2:k)]:
  ∀ y, injective (λ x : P₁, point_reflection k x y) :=
injective_point_reflection_left_of_injective_bit0 k $ λ x y h,
  by rwa [bit0, bit0, ← two_smul k x, ← two_smul k y,
    (is_unit_of_invertible (2:k)).smul_left_cancel] at h

lemma point_reflection_fixed_iff_of_module [invertible (2:k)] {x y : P₁} :
  point_reflection k x y = y ↔ y = x :=
((injective_point_reflection_left_of_module k y).eq_iff' (point_reflection_self k y)).trans eq_comm

end affine_equiv

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : V₁ ≃ᵃ[k] V₂ :=
{ to_equiv := e.to_equiv,
  linear := e,
  map_vadd' := λ p v, e.map_add v p }

@[simp] lemma coe_to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : ⇑e.to_affine_equiv = e := rfl

end linear_equiv

namespace affine_map

open affine_equiv

include V₁

lemma line_map_vadd (v v' : V₁) (p : P₁) (c : k) :
  line_map v v' c +ᵥ p = line_map (v +ᵥ p) (v' +ᵥ p) c :=
(vadd_const k p).apply_line_map v v' c

lemma line_map_vsub (p₁ p₂ p₃ : P₁) (c : k) :
  line_map p₁ p₂ c -ᵥ p₃ = line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃) c :=
(vadd_const k p₃).symm.apply_line_map p₁ p₂ c

lemma vsub_line_map (p₁ p₂ p₃ : P₁) (c : k) :
  p₁ -ᵥ line_map p₂ p₃ c = line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃) c :=
(const_vsub k p₁).apply_line_map p₂ p₃ c

lemma vadd_line_map (v : V₁) (p₁ p₂ : P₁) (c : k) :
  v +ᵥ line_map p₁ p₂ c = line_map (v +ᵥ p₁) (v +ᵥ p₂) c :=
(const_vadd k P₁ v).apply_line_map p₁ p₂ c

variables {R' : Type*} [comm_ring R'] [module R' V₁]

lemma homothety_neg_one_apply (c p : P₁) :
  homothety c (-1:R') p = point_reflection R' c p :=
by simp [homothety_apply, point_reflection_apply]

end affine_map


import algebra.big_operators.ring
import data.finset.finsupp
import probability.density
import probability.independence
import probability.conditional_expectation
import probability.notation
import probability.cond_count
import analysis.special_functions.log.base
import data.nat.basic
import data.finset.basic

open finset measure_theory probability_theory
open_locale big_operators measure_theory ennreal

variables {α : Type*} [decidable_eq α]
variables {𝒮 : finset (finset α)} {G : finset (finset α)} {U : finset α} {t : ℕ}

section partition

  def tuples_on (s : finset α) (m t : ℕ) : finset (ℕ → finset α) :=
  (finset.pi (range t) (λ _, s.powerset_len m)).map $
    { to_fun := λ f i, if h : i < t then f i (by simpa using h) else ∅,
      inj' :=
      begin
        rintro f g h,
        ext x hx : 2,
        simpa [dif_pos (finset.mem_range.1 hx)] using function.funext_iff.1 h x,
      end }

  lemma mem_tuples_on {m t : ℕ} {s : finset α} (f : ℕ → finset α) :
    f ∈ tuples_on s m t ↔ (∀ i < t, f i ⊆ s ∧ (f i).card = m) ∧ ∀ i ≥ t, f i = ∅ :=
  begin
    simp only [tuples_on, finset.mem_map, finset.mem_range, finset.mem_pi,
      function.embedding.coe_fn_mk, exists_prop, ge_iff_le, mem_powerset_len],
    split,
    { rintro ⟨f, hf₁, rfl⟩,
      refine ⟨λ i hi, _, λ i hi, _⟩,
      { simpa [dif_pos hi] using hf₁ _ hi },
      simp only [dif_neg hi.not_lt] },
    rintro ⟨hf₁, hf₂⟩,
    refine ⟨λ i _, f i, hf₁, _⟩,
    ext i : 1,
    split_ifs,
    { refl },
    rw hf₂ _ (le_of_not_lt h),
  end

  -- We view s,m,t- partitions as ordered sequences W0, W1, W2, ... with the conditions:
  --   Wj for j ≥ t is empty
  --      (essentially this says W is defined up to but not including t)
  --   Wj for j < t is a subset of s
  --   Wj for j < t has cardinality m
  --   the collection {Wj for j < t} is pairwise disjoint
  -- In most cases we will have `s` as our entire finite universe
  -- NOTE the union of the Wj might not be s

  -- This is not a standard way of defining partitions, but it is *vital* for ours to be ordered
  -- so I use this version
  -- `partitions_on s m t` is the finite set of these partitions
  -- its Lean definition isn't very helpful, but `mem_partitions_on` says it does what it's meant to.
  -- So when proving things about `partitions_on`, you almost always want to be using this lemma
  -- rather than the definition (or `mem_partitions_on'` which is logically equivalent but sometimes
  -- may be more useful)

  def partitions_on (s : finset α) (m t : ℕ) : finset (ℕ → finset α) :=
  (tuples_on s m t).filter (λ f, ∀ i j < t, i ≠ j → disjoint (f i) (f j))

  lemma mem_partitions_on {m t : ℕ} {s : finset α} (f : ℕ → finset α) :
    f ∈ partitions_on s m t ↔
      (∀ i < t, f i ⊆ s ∧ (f i).card = m) ∧ (∀ i ≥ t, f i = ∅) ∧
      ∀ i j < t, i ≠ j → disjoint (f i) (f j) :=
  by simp only [partitions_on, mem_filter, mem_tuples_on, and_assoc]

  lemma mem_partitions_on' {m t : ℕ} {s : finset α} (f : ℕ → finset α) :
    f ∈ partitions_on s m t ↔
      (∀ i < t, (f i).card = m) ∧
      (∀ i ≥ t, f i = ∅) ∧
      (∀ i, f i ⊆ s) ∧
      ∀ i j, i ≠ j → disjoint (f i) (f j) :=
  begin
    rw mem_partitions_on,
    split,
    { rintro ⟨hf₁, hf₂, hf₃⟩,
      refine ⟨λ i hi, (hf₁ _ hi).2, hf₂, λ i, _, _⟩,
      { cases lt_or_le i t,
        { apply (hf₁ _ ‹_›).1 },
        rw hf₂ _ h,
        simp },
      intros i j h,
      wlog : i ≤ j using i j,
      { cases lt_or_le j t,
        { exact hf₃ i (case.trans_lt h_1) j ‹_› h },
        rw hf₂ j h_1,
        apply disjoint_empty_right },
      exact (this h.symm).symm },
    { rintro ⟨hf₁, hf₂, hf₃, hf₄⟩,
      exact ⟨λ i hi, ⟨hf₃ _, hf₁ _ hi⟩, hf₂, λ i _ j _, hf₄ i j⟩ }
  end

  lemma partitions_on_zero {s : finset α} {m : ℕ} :
    partitions_on s m 0 = {λ _, ∅} :=
  begin
    ext,
    split,
    { rw mem_partitions_on,
      intro h,
      rcases h with ⟨h1, h2, h3⟩,
      norm_num,
      ext1,
      have hx : 0 ≤ x := by linarith,
      exact h2 x hx, },
    { intro h,
      rw mem_partitions_on,
      refine ⟨_, _, _⟩,
      { intros i hi,
        norm_num at h,
        simp only [h, empty_subset, card_empty, true_and],
        linarith, },
      { intros i hi,
        norm_num at h,
        rw h, },
      { intros i hi j hj hij,
        norm_num at h,
        simp only [h, disjoint_empty_right], }, },
  end

  lemma subset_of_mem_partitions_on {m t : ℕ} {s : finset α} {f : ℕ → finset α}
    (hf : f ∈ partitions_on s m t) :
    (range t).bUnion f ⊆ s :=
  begin
    simp only [bUnion_subset, finset.mem_range],
    intros i hi,
    exact (((mem_partitions_on f).1 hf).1 i hi).1,
  end

  lemma card_bUnion_of_mem_partitions_on {m t : ℕ} {s : finset α} {f : ℕ → finset α}
    (hf : f ∈ partitions_on s m t) :
    ((range t).bUnion f).card = m * t :=
  begin
    rw mem_partitions_on at hf,
    rw [card_bUnion, mul_comm, finset.sum_const_nat, card_range],
    { intros i hi,
      exact (hf.1 i (by simpa using hi)).2 },
    simpa only [mem_range] using hf.2.2,
  end

  def split_partition (f : ℕ → finset α) : (ℕ → finset α) × finset α := (λ i, f (i+1), f 0)
  lemma split_partition_bij :
    function.bijective (split_partition : (ℕ → finset α) → (ℕ → finset α) × finset α) :=
  begin
    split,
    { intros f₁ f₂ h,
      ext n : 1,
      simp only [split_partition, prod.mk.inj_iff] at h,
      cases n,
      { exact h.2 },
      have := function.funext_iff.1 h.1 n,
      exact this },
    rintro ⟨f₁, f₂⟩,
    exact ⟨λ n, nat.cases_on n f₂ f₁, rfl⟩,
  end

  lemma split_partition_strong_surj {s : finset α} {m t} (f₁ : ℕ → finset α) (f₂ : finset α)
    (hf₁ : f₁ ∈ partitions_on s m t) (hf₂ : f₂ ⊆ s \ (range t).bUnion f₁)
    (hf₃ : f₂.card = m) :
    ∃ f : ℕ → finset α, f ∈ partitions_on s m (t + 1) ∧
      (split_partition f).fst = f₁ ∧ (split_partition f).snd = f₂ :=
  begin
    refine ⟨λ n, nat.cases_on n f₂ f₁, _, rfl, rfl⟩,
    rw mem_partitions_on,
    refine ⟨_, _, _⟩,
    { intros i hi,
      refine ⟨_, _⟩,
      { cases i,
        { dsimp only,
          exact subset_trans hf₂ (finset.sdiff_subset s _), },
        { dsimp only,
          have hit : i < t,
          { rw nat.succ_eq_add_one at hi,
            linarith, },
          rw mem_partitions_on at hf₁,
          rcases hf₁ with ⟨h1, h2, h3⟩,
          exact (h1 i hit).1, }, },
      { cases i,
        { dsimp only,
          exact hf₃, },
        { dsimp only,
          have hit : i < t,
          { rw nat.succ_eq_add_one at hi, linarith, },
          rw mem_partitions_on at hf₁,
          rcases hf₁ with ⟨h1, h2, h3⟩,
          exact (h1 i hit).2, }, }, },
    { intros i hi,
      cases i,
      { dsimp only,
        exfalso,
        linarith, },
      { dsimp only,
        have hit : i ≥ t,
        { rw nat.succ_eq_add_one at hi, linarith, },
        rw mem_partitions_on at hf₁,
        rcases hf₁ with ⟨h1, h2, h3⟩,
        exact h2 i hit, }, },
    { intros i hi j hj hij,
      rw mem_partitions_on at hf₁,
      rcases hf₁ with ⟨h1, h2, h3⟩,
      cases i,
      { cases j,
        { exfalso,
          norm_cast at hij, },
        { dsimp only,
          have hjt : j < t,
          { rw nat.succ_eq_add_one at hj, linarith, },
          suffices : disjoint f₂ ((range t).bUnion f₁),
          { have h : f₁ j ⊆ (range t).bUnion f₁,
            { apply finset.subset_bUnion_of_mem,
              exact mem_range.mpr hjt, },
            apply finset.disjoint_of_subset_right h,
            exact this, },
          { apply finset.disjoint_of_subset_left hf₂,
            exact finset.sdiff_disjoint, }, }, },
      { cases j,
        { dsimp only,
          have hit : i < t,
          { rw nat.succ_eq_add_one at hi, linarith, },
          suffices : disjoint ((range t).bUnion f₁) f₂,
          { have h : f₁ i ⊆ (range t).bUnion f₁,
            { apply finset.subset_bUnion_of_mem,
              exact mem_range.mpr hit, },
            apply finset.disjoint_of_subset_left h,
            exact this, },
          { apply finset.disjoint_of_subset_right hf₂,
            exact finset.disjoint_sdiff, }, },
        { dsimp only,
          have hij' : i ≠ j,
          { simpa only [ne.def, add_left_inj] using hij, },
          have hi' : i < t,
          { rw nat.succ_eq_add_one at hi, linarith, },
          have hj' : j < t,
          { rw nat.succ_eq_add_one at hj, linarith, },
          exact h3 i hi' j hj' hij', }, }, },
  end

  -- state and prove that if `f ∈ partitions_on s m (t+1)`, then these three are true
  -- (split_partition f).1 ∈ partitions_on s m t
  -- (split_partition f).2 ⊆ s \ (range t).bUnion (split_partition f).1
  -- (split_partition f).2.card = m

  lemma card_partitions_on {s : finset α} {m t : ℕ} :
    (partitions_on s m t).card = ∏ i in range t, (s.card - m * i).choose m :=
  begin
    induction t with t ih,
    { rw [finset.range_zero, finset.prod_empty, partitions_on_zero, finset.card_singleton] },
    rw [finset.prod_range_succ, ←ih],
    let extension : finset (Σ (i : ℕ → finset α), finset α) :=
      (partitions_on s m t).sigma (λ f, (s \ (range t).bUnion f).powerset_len m),
    have : extension.card = (partitions_on s m t).card * (s.card - m * t).choose m,
    { simp only [finset.card_sigma, finset.card_powerset_len],
      have : ∀ f ∈ partitions_on s m t,
        (s \ (range t).bUnion f).card.choose m = (s.card - m * t).choose m,
      { intros f hf,
        have : (range t).bUnion f ⊆ s,
        { apply subset_of_mem_partitions_on hf },
        rw [card_sdiff this, card_bUnion_of_mem_partitions_on hf] },
      rw [sum_congr rfl this, sum_const, smul_eq_mul] },
    rw ←this,
    refine card_congr (λ f _, ⟨(split_partition f).1, (split_partition f).2⟩) _ _ _,
    { intros f hf,
      rw mem_partitions_on' at hf,
      simp only [extension, mem_sigma, mem_powerset_len],
      refine ⟨_, _, _⟩,
      { rcases hf with ⟨hf1, hf2, hf3, hf4⟩,
        rw mem_partitions_on,
        refine ⟨_, _, _⟩,
        { intros i hi,
          refine ⟨_, _⟩,
          { apply hf3, },
          { apply hf1,
            exact nat.succ_lt_succ hi, }, },
        { intros i hi,
          apply hf2,
          exact nat.succ_le_succ hi, },
        { intros i hi j hj hij,
          apply hf4,
          exact (add_ne_add_left 1).mpr hij, }, },
      { change f 0 ⊆ s \ (range t).bUnion (split_partition f).fst,
        rw finset.subset_iff,
        intros x hx,
        rw finset.mem_sdiff,
        have hfs : f 0 ⊆ s,
        { apply hf.2.2.1, },
        simp only [finset.mem_of_subset hfs hx, mem_bUnion, mem_range, exists_prop, not_exists, not_and, true_and],
        intros i hi,
        by_contra c,
        have hfd : disjoint (f 0) ((split_partition f).fst i),
        { apply hf.2.2.2,
          linarith, },
        rw finset.disjoint_iff_ne at hfd,
        specialize hfd x hx x c,
        apply hfd, refl, },
      { apply hf.1,
        exact ne_zero.pos (nat.succ t), }, },
    { rintro f₁ f₂ hf₁ hf₂,
      simp only [heq_iff_eq, and_imp],
      intros h₁ h₂,
      refine split_partition_bij.1 _,
      ext : 1; assumption },
    rintro ⟨f₁, f₂⟩,
    simp only [mem_sigma, sigma.mk.inj_iff, heq_iff_eq, exists_prop, and_imp,
      mem_powerset_len],
    apply split_partition_strong_surj,
  end

  lemma card_partition_fix_first {s : finset α} {m t : ℕ} {V : finset α}
    (hV : V.card = m) (hV' : V ⊆ s) :
    ((partitions_on s m (t + 1)).filter (λ f : ℕ → finset α, f 0 = V)).card =
      (partitions_on (s \ V) m t).card :=
  begin
    refine card_congr (λ f _, (split_partition f).1) _ _ _,
    { simp only [mem_filter, and_imp],
      rintro f hf rfl,
      rw [mem_partitions_on'] at hf ⊢,
      refine ⟨λ i hi, hf.1 _ (by simpa using hi), λ i hi, hf.2.1 _ (by simpa using hi),
        _, λ i j h, hf.2.2.2 (i+1) (j+1) (by simpa using h)⟩,
      intros i x hx,
      rw [mem_sdiff],
      exact ⟨hf.2.2.1 _ hx, disjoint_left.1 (hf.2.2.2 (i+1) 0 (nat.succ_ne_zero _)) hx⟩ },
    { simp only [mem_filter, and_imp],
      intros f₁ f₂ hf₁ h₁ hf₂ h₂ h,
      refine split_partition_bij.1 _,
      ext : 1,
      { exact h },
      rw [split_partition, split_partition],
      exact h₁.trans h₂.symm },
    { simp only [mem_filter, exists_prop],
      intros f hf,
      refine ⟨λ n, nat.cases_on n V f, ⟨_, rfl⟩, rfl⟩,
      rw [mem_partitions_on'] at hf ⊢,
      rcases hf with ⟨hf1, hf2, hf3, hf4⟩,
      refine ⟨_, _, _, _⟩,
      { intros i hi,
        cases i,
        { dsimp only,
          exact hV, },
        { dsimp only,
          have hi' : i < t,
          {rw nat.succ_eq_add_one at hi, linarith, },
          exact hf1 i hi', }, },
      { intros i hi,
        cases i,
        { exfalso,
          linarith, },
        { dsimp only,
          have hi' : i ≥ t,
          {rw nat.succ_eq_add_one at hi, linarith, },
          exact hf2 i hi', }, },
      { intro i,
        cases i,
        { dsimp only,
          exact hV', },
        { dsimp only,
          have := finset.sdiff_subset s V,
          specialize hf3 i,
          exact subset_trans hf3 this, }, },
      { intros i j hij,
        cases i,
        { cases j,
          { exfalso,
            apply hij,
            refl, },
          { dsimp only,
            specialize hf3 j,
            have : disjoint V (s \ V) := finset.disjoint_sdiff,
            exact finset.disjoint_of_subset_right hf3 this, }, },
        { cases j,
          { dsimp only,
            specialize hf3 i,
            have : disjoint V (s \ V) := finset.disjoint_sdiff,
            rw disjoint.comm at this,
            exact finset.disjoint_of_subset_left hf3 this, },
          { dsimp only,
            have hij' : i ≠ j,
            { simpa only [ne.def, add_left_inj] using hij, },
            exact hf4 i j hij', }, }, }, },
  end

  lemma partition_swap {s : finset α} {m t : ℕ} {f : ℕ → finset α} (hf : f ∈ partitions_on s m t)
    {i j : ℕ} (hi : i < t) (hj : j < t) :
    f ∘ equiv.swap i j ∈ partitions_on s m t :=
  begin
    rw mem_partitions_on' at hf ⊢,
    refine ⟨λ k hk, hf.1 _ _, λ k hk, hf.2.1 _ _, λ k, hf.2.2.1 _, λ _ _ h, hf.2.2.2 _ _ _⟩,
    { rcases eq_or_ne k i with rfl | ik,
      { rwa equiv.swap_apply_left },
      rcases eq_or_ne k j with rfl | jk,
      { rwa equiv.swap_apply_right },
      rwa equiv.swap_apply_of_ne_of_ne ik jk },
    { rwa equiv.swap_apply_of_ne_of_ne (hi.trans_le hk).ne' (hj.trans_le hk).ne' },
    { simpa using h },
  end

  lemma card_partition_fix_swap {s : finset α} {m t : ℕ} {V : finset α} {i j : ℕ}
    (hi : i < t) (hj : j < t) :
    ((partitions_on s m t).filter (λ f : ℕ → finset α, f i = V)).card =
      ((partitions_on s m t).filter (λ f : ℕ → finset α, f j = V)).card :=
  begin
    refine card_congr (λ f _, f ∘ equiv.swap i j) _ _ _,
    { simp only [mem_filter, function.comp_app, equiv.swap_apply_right, and_imp],
      intros f hf hf',
      refine ⟨_, hf'⟩,
      apply partition_swap hf hi hj },
    { intros f₁ f₂ _ _ h,
      refine function.surjective.injective_comp_right _ h,
      apply equiv.surjective },
    intros f hf,
    simp only [mem_filter, exists_prop, and_assoc] at hf ⊢,
    refine ⟨f ∘ equiv.swap i j, partition_swap hf.1 hi hj, _, _⟩,
    { simpa using hf.2 },
    ext x : 1,
    simp [equiv.swap_apply_self],
  end

  lemma card_partition_fix' {s : finset α} {m t : ℕ} {V : finset α}
    (hV : V.card = m) (hV' : V ⊆ s) {i : ℕ} (hi : i < t + 1) :
    ((partitions_on s m (t + 1)).filter (λ f : ℕ → finset α, f i = V)).card *
      s.card.choose m =
      (partitions_on s m (t + 1)).card :=
  begin
    rw [card_partition_fix_swap hi nat.succ_pos', card_partition_fix_first hV hV',
      card_partitions_on, card_partitions_on, card_sdiff hV', hV, finset.prod_range_succ', mul_zero,
      nat.sub_zero],
    simp only [mul_add_one, nat.sub_sub, add_comm],
  end

  lemma card_partition_fix {s : finset α} {m t : ℕ} {V : finset α}
    (hV : V.card = m) (hV' : V ⊆ s) {i : ℕ} (hi : i < t) :
    ((partitions_on s m t).filter (λ f : ℕ → finset α, f i = V)).card * s.card.choose m =
      (partitions_on s m t).card :=
  begin
    cases t,
    { simpa using hi },
    apply card_partition_fix' hV hV' hi,
  end

end partition

def shadow (G : finset (finset α)) (U : finset α) : finset (finset α) := G.filter (λ Y, Y ⊆ U)

lemma shadow_subset : shadow G U ⊆ G :=
begin
  unfold shadow,
  simp only [finset.filter_subset],
  -- an alternative is
  -- rw finset.subset_iff,
  -- intros x h,
  -- refine finset.mem_of_mem_filter _ h,
end

-- defined for uniform distribution
def spread (ε : ℝ) (U : finset (finset α)) : Prop :=
∀ (Z : finset α), (finset.card (U.filter (λ u, Z ⊆ u)) : ℝ) ≤ ε ^ Z.card * U.card

----- Lemmas for spred_iff_ratio ---------------------
def spr_1 (a b c : ℝ ) (hc : 0 < c ): (a≤ b) → (a/c ≤  b / c) :=
begin
  intros h, exact (div_le_div_right hc).mpr h,
end

lemma zer_zerco : 0 = ((0:ℕ ): ℝ )  := by simp
----------------------------------------------

lemma spread_iff_ratio (ε : ℝ) (U : finset (finset α)) {he : 0 ≤ ε } :
  spread ε U ↔ ∀ (Z : finset α), (finset.card (U.filter (λ u, Z ⊆ u)) : ℝ) / U.card ≤ ε ^ Z.card :=
begin
  split,
  {
    unfold spread,
    intros h Z,
    cases nat.eq_zero_or_pos U.card, --patter match wrt U.card

    { --When U.card = 0
    have zz  : ∀ r : ℝ ,  r / (0: ℝ ) = 0 := λ r, div_zero r,
    rw h_1,

    rw ← zer_zerco,
    rw zz,
    exact pow_nonneg he Z.card,
    },

    { -- When U.card > 0
    specialize h Z,

    have hUcard : 0 < (U.card : ℝ ), exact nat.cast_pos.mpr h_1,

    convert spr_1 ↑((filter (λ (u : finset α), Z ⊆ u) U).card)  (ε^(Z.card) * ↑(U.card)) ↑(U.card) (nat.cast_pos.mpr h_1) h,
    symmetry,
    apply mul_div_cancel,
    exact ne_of_gt ( nat.cast_pos.mpr h_1),
    }
  },

  {
    unfold spread,
    intros h Z,
    specialize h Z,

    have hUcard : 0 ≤ (U.card : ℝ ) :=
    begin
      rw zer_zerco,
      exact nat.cast_le.mpr(zero_le (U.card )),
    end,

    have H := mul_le_mul_of_nonneg_right h hUcard,

    cases nat.eq_zero_or_pos U.card,
    { -- When U.card = 0
      have fil_zero : (filter (λ (u : finset α), Z ⊆ u) U).card =0,
      {
        apply nat.eq_zero_of_le_zero,
        rw ← h_1,
        apply finset.card_le_of_subset,
        apply finset.filter_subset,
      },

      rw fil_zero, rw h_1, simp,
    },

    { -- When U.card > 0
      rw div_mul_cancel ↑((filter (λ (u : finset α), Z ⊆ u) U).card) at H,
      exact H,
      exact ne_of_gt ( nat.cast_pos.mpr h_1),
    }

  }
end

def to_antichain (G : finset (finset α)) : finset (finset α) :=
G.filter (λ A, ∀ B ∈ G, B ⊆ A → B = A)

lemma ssubset_thing {β : Type*} {X Y : finset β} : (¬ Y ⊂ X) ↔ (Y ⊆ X → Y = X) :=
begin
  split,
  { intros hY hYX,
    by_contra h,
    have hp : Y ⊂ X,
    { rw finset.ssubset_iff_subset_ne, split, exact hYX, exact h, },
    apply hY,
    exact hp, },
  { intros hY hYX,
    cases hYX with h1 h2,
    specialize hY h1,
    finish, },
end

lemma to_antichain_eq : to_antichain G = G.filter (λ A, ∀ B ∈ G, ¬ B ⊂ A) :=
begin
  simpa only [ssubset_thing],
end

lemma to_antichain_subset : to_antichain G ⊆ G :=
begin
  apply filter_subset,
end

lemma is_antichain_to_antichain : is_antichain (⊆) (to_antichain G : set (finset α)) :=
begin
  intros A h1 B h2 h3 h4,
  unfold to_antichain at h1,
  rw finset.mem_coe at h1,
  rw finset.mem_filter at h1,
  cases h1 with h5 h6,
  specialize h6 B,
  unfold to_antichain at h2,
  rw finset.mem_coe at h2,
  rw finset.mem_filter at h2,
  cases h2 with h7 h8,
  specialize h8 A,
  have h9 := h8(h5),
  have h11 := h9(h4),
  apply h3,
  exact h11,
end

-- mathematically solvable by induction on cardinality of A
lemma contains_subset {A} (hA : A ∈ G) : ∃ B ∈ to_antichain G, B ⊆ A :=
begin
  set n := finset.card A with h,
  clear_value n,
  induction n using nat.strong_induction_on with n ih generalizing A,
  -- for n being zero, empty set A must be in G' as there is no proper subset of an empty set
  -- have hA' : A = ∅,
  -- { rw ← finset.card_eq_zero, linarith, },
  -- use A,
  -- split,
  -- { unfold to_antichain,
  --   rw finset.mem_filter,
  --   split, exact hA,
  --   intros B hB hBA,
  --   suffices : B = ∅,
  --   rw hA', exact this,
  --   rw hA' at hBA,
  --   rwa finset.subset_empty at hBA, },
  -- { simp only [subset_refl], },
  -- for inductive step, we consider two cases, A in G' or otherwise
  have q : A ∈ to_antichain G ∨ A ∉ to_antichain G := by finish,
  cases q with h1 h2,
  -- for A in G', use A and done
  use A,
  split, exact h1,
  simp only [subset_refl],
  -- for A in G, there exists a proper subset of A in G, named A', |A'| < |A|, apply inductive hypothesis
  have p : ∃ (C : finset α), C ∈ G ∧ C ⊂ A,
  { by_contra hp,
    push_neg at hp,
    apply h2,
    unfold to_antichain,
    rw finset.mem_filter,
    split, exact hA,
    intros B hB,
    rw ← ssubset_thing,
    specialize hp B hB,
    exact hp, },
  rcases p with ⟨C, ⟨p1, p2⟩⟩,
  have hC : C.card < n,
  { rw h,
    refine finset.card_lt_card p2, },
  suffices : ∃ (B : finset α) (H : B ∈ to_antichain G), B ⊆ C,
  { rcases this with ⟨B, ⟨hB1, hB2⟩⟩,
    use B,
    split, exact hB1,
    refine subset_trans hB2 _,
    rw subset_iff_ssubset_or_eq,
    left, exact p2, },
  { specialize ih C.card hC p1,
    simp only [eq_self_iff_true, exists_prop, forall_true_left] at ih,
    cases ih with B hB,
    use B,
    exact hB, },
end

lemma exists_subset_minimal {S : finset (finset α)} (hS : S.nonempty) :
  ∃ X ∈ S, ∀ Y ∈ S, Y ⊆ X → Y = X :=
begin
  -- more difficult alternative: set M : finset (finset α) := S.filter(λ X : finset α, ∀ Y : finset α, Y ∈ S → X.card ≤ Y.card),
  set T : finset (finset α) := to_antichain S,
  -- claim T is non-empty
  have hT : T.nonempty,
  { have := finset.nonempty.bex hS,
    cases this with A hA,
    have := contains_subset hA,
    rcases this with ⟨B, ⟨hB1, hB2⟩⟩,
    simp only [finset.nonempty],
    use B,
    exact hB1, },
  have := finset.nonempty.bex hT,
  cases this with X hX,
  -- use X ∈ T
  use X,
  simpa [T, to_antichain, finset.mem_filter] using hX,
end

variables {W : ℕ → finset α} {i : ℕ}

-- WARNING! : INDEXED DIFFERENTLY FROM THE PDF
-- we only care about this definition for 0 ≤ i < t
-- this is 𝒢 the function
def the_partial_function (W : ℕ → finset α) (𝒮 : finset (finset α)) (t : ℕ) : ℕ → finset (finset α)
| i :=
    finset.image (λ S, S \ (finset.range (i+1)).bUnion W) $
    @finset.filter _
      (λ S, 2 ^ (t - i - 1) ≤ (S \ (finset.range (i+1)).bUnion W).card ∧
            (∀ j < i, ∀ X ∈ the_partial_function j, ¬ X ⊆ S) ∧
            ∀ S' ∈ 𝒮, S' \ (finset.range (i+1)).bUnion W ⊂ S \ (finset.range (i+1)).bUnion W →
              ¬ ∀ (j < i), ∀ (X ∈ the_partial_function j), ¬ X ⊆ S')
      (λ S, @and.decidable _ _ _ (@and.decidable _ _ _ finset.decidable_dforall_finset))
      -- this decidability detour is *really weird*, it indicates something is bad in mathlib
      -- I think...
    𝒮

def the_function (W : ℕ → finset α) (𝒮 : finset (finset α)) (t : ℕ) :=
(finset.range t).bUnion (the_partial_function W 𝒮 t)

lemma bUnion_indep {i : ℕ} (W₁ W₂ : ℕ → finset α) (h : ∀ j ≤ i, W₁ j = W₂ j) :
  (range (i+1)).bUnion W₁ = (range (i+1)).bUnion W₂ :=
begin
  ext x,
  simp only [finset.mem_range_succ_iff, finset.mem_bUnion],
  refine bex_congr (λ j hj, _),
  rw h _ hj
end

lemma the_partial_function_indep {𝒮 : finset (finset α)} {t i : ℕ} (W₁ W₂ : ℕ → finset α)
  (h : ∀ j ≤ i, W₁ j = W₂ j) :
  the_partial_function W₁ 𝒮 t i = the_partial_function W₂ 𝒮 t i :=
begin
  induction i using nat.strong_induction_on with i ih,
  -- change finset.image _ _ = finset.image _ _,
  -- -- induction i,
  rw [the_partial_function.equations._eqn_1 W₂, the_partial_function],
  rw [bUnion_indep W₁ W₂ h],
  have : ∀ (p : finset α → Prop), (∀ j < i, ∀ X ∈ the_partial_function W₁ 𝒮 t j, p X) ↔
    (∀ j < i, ∀ X ∈ the_partial_function W₂ 𝒮 t j, p X),
  { intro p,
    refine ball_congr (λ j hj, _),
    rw ih j hj (λ k hk, h _ (hk.trans hj.le)) },
  congr' 2,
  ext S,
  simp only [this],
end

lemma part_two_a_helper (ht : 1 ≤ t) (S) (h : ¬ S ⊆ (finset.range t).bUnion W) :
  2 ^ (t-1 - (t-1)) ≤ (S \ (finset.range (t-1 + 1)).bUnion W).card :=
begin
  have proof_subset : ∀ x : finset α, ∀ y : finset α, (x \ y).card = 0 → x ⊆ y,
    {intros hx hy card,
    have proof_empty : hx \ hy = ∅ := iff.elim_left finset.card_eq_zero card,
    have proof_final : hx ⊆ hy,
      {have temp1 := iff.elim_left finset.eq_empty_iff_forall_not_mem proof_empty,
      intros hx2 assump1,
      have assump2:hx2 ∉ hx \ hy := temp1 hx2,
      by_contra hnp,
      refine assump2 _,
      exact iff.elim_right (finset.mem_sdiff) (and.intro assump1 hnp),},
    exact proof_final,},
  have proof_card_zero : ∀ x:ℕ, (¬ 1 ≤ x ) → x = 0,
    {intro x,
    intro ineq,
    linarith,},
  have bound_simp : 1 ≤ (S \ (finset.range (t)).bUnion W).card,
    {by_contra bound2,
    exact h (proof_subset S ((finset.range (t)).bUnion W) (proof_card_zero (S \ (finset.range (t)).bUnion W).card bound2)),},
  have final : 2 ^ (t-1 - (t-1)) ≤ (S \ (finset.range (t-1 + 1)).bUnion W).card,
    {simp,
    have equality:t-1+1 = t, {linarith},
    rw equality,
    exact bound_simp,},
  exact final,
end
/-
lemma thm1_part_two (W : ℕ → finset α) (𝒮 : finset (finset α)) (t : ℕ) (ht : 1 ≤ t) :
  (∃ S ∈ 𝒮, S ⊆ (range t).bUnion W) ∨ ∀ S ∈ 𝒮, ∃ X ∈ the_function W 𝒮 t, X ⊆ S :=
begin
  by_contra,
  have h := not_or_distrib.1 h,
  have not_sub_w := h.1,
  apply h.2,
  intros hs el_s,
  let set_s' := finset.filter (λ Y, Y \ ((range t).bUnion W) ⊆ hs \ ((range t).bUnion W) ∧ (∀ (j:ℕ), j< t-1 → ∀ X:finset α, X ∈ the_partial_function W 𝒮 t j → ¬ X ⊆ Y)) 𝒮,
  by_contra assump,
  have non_empt : (∃ x:finset α, x ∈ set_s'),
    {use hs,
    rw finset.mem_filter,
    split, {exact el_s,},
      {split, {apply finset.subset_of_eq, refl,},
        {intros j bound X in_g,
        by_contra,
        have assump_pf:∃ x2 ∈ the_function W 𝒮 t, x2 ⊆ hs,
          {use X,
          split,
            {rw the_function,
            rw finset.mem_bUnion,
            use j,
            split,
              {rw finset.mem_range,
              linarith,},
              {exact in_g,}},{exact h,}},
        exact assump assump_pf,}}},
  let rem_w := λ (x:finset α), x \ (range t).bUnion W,
  let set_s'_map := finset.image rem_w set_s',
  have non_empt_im:set_s'_map.nonempty := finset.nonempty.image non_empt rem_w,
  have ex_min := exists_subset_minimal non_empt_im,
  cases ex_min with X ex_min,
  cases ex_min with X_el ex_min,
  apply assump,
  use X,
  have X_w := finset.mem_image.1 X_el,
  cases X_w with a aw_eq_x,
  cases aw_eq_x with a_in_s' func_a_x,
  have rw_X:a\(range t).bUnion W = X,{exact func_a_x,},
  have equality:t-1+1 = t, {rw nat.sub_add_cancel ht},
  have a_in_s := finset.mem_of_mem_filter a a_in_s',
  split,
    {rw the_function,
    rw finset.mem_bUnion,
    use t-1,
    rw finset.mem_range,
    split, {linarith,},
      {rw the_partial_function,
      rw finset.mem_image,
      use a,
      split,
        {rw finset.mem_filter,
        refine ⟨_,_,_,_⟩,
          {exact a_in_s,},
          {have rw_not_sub_w,
            {have el_imply := ((not_exists.1 not_sub_w) a),
            have el_imply_clean := not_exists.1 el_imply,
            exact el_imply_clean a_in_s,},
          have pow2_eq : ∀ (vr:ℕ), vr ≥ 1 → 2 ^ (vr-(vr-1)-1) = 2 ^ (vr-1 - (vr-1)),
          { intros vr ineq,
            rw [nat.sub_self, nat.sub_sub, nat.sub_add_cancel ineq, nat.sub_self] },
          rw (pow2_eq t ht),
          exact part_two_a_helper ht a rw_not_sub_w,},
          {exact (finset.mem_filter.1 a_in_s').2.2,},
          {rw equality,
          intros hs' hs'_in_s hs'_sub,
          have strict_sub_hs := finset.ssubset_of_ssubset_of_subset hs'_sub (finset.mem_filter.1 a_in_s').2.1,
          by_contra minset_prop,
          have sub_hs := (finset.ssubset_iff_subset_ne.1 strict_sub_hs).1,
          have fulfills_minset_prop := and.intro sub_hs minset_prop,
          have hs'_in_minset:hs' ∈ set_s' := finset.mem_filter.2 (and.intro hs'_in_s fulfills_minset_prop),
          have hs'_w_in_minset_map:hs'\ (range t).bUnion W ∈ set_s'_map,{apply finset.mem_image.2,use hs',use hs'_in_minset,},
          have s'_is_minset:hs'\ (range t).bUnion W = a\ (range t).bUnion W,
            {rw rw_X,
            have hs'_sub_x:hs'\ (range t).bUnion W ⊆ X,
              {rw eq.symm rw_X,
              exact (finset.ssubset_iff_subset_ne.1 hs'_sub).1,},
            exact ex_min (hs'\ (range t).bUnion W) hs'_w_in_minset_map hs'_sub_x,},
          exact (finset.ssubset_iff_subset_ne.1 hs'_sub).2 s'_is_minset,}},
        {rw equality,exact func_a_x,},},},
    {rw eq.symm rw_X,
    have a_w_sub_hs_w:a\ (range t).bUnion W ⊆ hs\ (range t).bUnion W := (finset.mem_filter.1 a_in_s').2.1,
    have hs_w_sub_hs: hs\ (range t).bUnion W ⊆ hs := finset.sdiff_subset hs ((range t).bUnion W),
    exact finset.subset.trans a_w_sub_hs_w hs_w_sub_hs,}
end-/

def sample_space (α : Type*) [fintype α] [decidable_eq α] (m t : ℕ) :=
partitions_on (finset.univ : finset α) m t

def finset.expectation {α M : Type*} [field M] (s : finset α) (f : α → M) : M :=
(∑ x in s, f x) / s.card

local notation (name := finset.expectation)
  `𝔼` binders ` in ` s `, ` r:(scoped:67 f, finset.expectation s f) := r

lemma expectation_eq {α M : Type*} [field M] {s : finset α} {f : α → M} :
  𝔼 x in s, f x = ∑ x in s, f x / s.card :=
by rw [finset.expectation, sum_div]

variables [fintype α]

lemma thm1_part_one {m t : ℕ} {𝒮 : finset (finset α)} {U : finset (finset α)} {ε : ℝ}
  (hm : 1 ≤ m) (ht : 1 ≤ t) (hε : 0 < ε)
  (hS : ∀ S ∈ 𝒮, finset.card S ≤ 2 ^ t) (hU : spread ε U)
  (h : ∀ (R : finset α) i < t,
    (((sample_space α m t).filter (λ (W : ℕ → finset α), W i ⊆ R)).card : ℝ) ≤
      ((64 * ε) ^ (m - R.card) / (fintype.card α).choose R.card) * (sample_space α m t).card) :
  𝔼 W in sample_space α m t, 𝔼 u in U, ((shadow (the_function W 𝒮 t) u).card : ℝ) < 1 / 8 :=
begin
  sorry
end

lemma filter_const {α : Type*} (p : Prop) [decidable p] (s : finset α) :
  s.filter (λ _, p) = if p then s else ∅ :=
begin
  by_cases p,
  { rw [filter_true_of_mem (λ _ _, h), if_pos h] },
  { rw [filter_false_of_mem (λ _ _, h), if_neg h] },
end

lemma powerset_filter_subset {α : Type*} [decidable_eq α] (n : ℕ) (s t : finset α) :
  (powerset_len n s).filter (λ i, i ⊆ t) = (powerset_len n (s ∩ t)) :=
by { ext x, simp [mem_powerset_len, subset_inter_iff, and.right_comm] }

lemma partitions_on_subset {s₁ s₂ : finset α} {m t} (h : s₁ ⊆ s₂):
  partitions_on s₁ m t ⊆ partitions_on s₂ m t :=
filter_subset_filter _ (map_subset_map.2 (pi_subset _ _ (λ _ _, powerset_len_mono h)))

lemma partitions_on_of_subset {s₁ s₂ : finset α} {m t} {f : ℕ → finset α} (h : ∀ i < t, f i ⊆ s₁) :
  f ∈ partitions_on s₂ m t → f ∈ partitions_on s₁ m t :=
by simp [mem_partitions_on, h] {contextual := tt}

open_locale classical

lemma partitions_on_eq {s : finset α} {m t} :
  partitions_on s m t = (s.powerset_len (m * t)).bUnion (λ W, partitions_on W m t) :=
begin
  ext f,
  simp only [mem_bUnion, exists_prop, mem_powerset_len, and_assoc],
  split,
  { rintro hf,
    refine ⟨(range t).bUnion f, subset_of_mem_partitions_on hf, card_bUnion_of_mem_partitions_on hf,
      _⟩,
    simp only [mem_partitions_on],
    simp only [mem_partitions_on'] at hf,
    exact ⟨λ i hi, ⟨subset_bUnion_of_mem _ (by simpa using hi), hf.1 _ hi⟩, hf.2.1,
      λ _ _ _ _ h, hf.2.2.2 _ _ h⟩ },
  rintro ⟨W, hW, hW', hf⟩,
  simp only [mem_partitions_on'] at hf ⊢,
  exact ⟨hf.1, hf.2.1, λ i, (hf.2.2.1 _).trans hW, hf.2.2.2⟩,
end

lemma partitions_on_inj_on {m t : ℕ} {W₁ W₂ : finset α}
  (hW₁ : W₁.card = m * t) (hW₂ : W₂.card = m * t) {f} :
  f ∈ partitions_on W₁ m t → f ∈ partitions_on W₂ m t → W₁ = W₂ :=
begin
  intros hf₁ hf₂,
  rw [←eq_of_subset_of_card_le (subset_of_mem_partitions_on hf₁),
      ←eq_of_subset_of_card_le (subset_of_mem_partitions_on hf₂)],
  { rw [hW₂, card_bUnion_of_mem_partitions_on hf₂] },
  { rw [hW₁, card_bUnion_of_mem_partitions_on hf₁] },
end

lemma random_partition (R : finset α) {m i : ℕ} (hi : i < t) :
  (fintype.card α).choose m *
    ((sample_space α m t).filter (λ Ws : ℕ → finset α, Ws i ⊆ R)).card =
      R.card.choose m * (sample_space α m t).card :=
begin
  have : ∀ (Ws : ℕ → finset α), Ws ∈ sample_space α m t →
    Ws i ∈ powerset_len m (univ : finset α),
  { simp only [mem_powerset_len_univ_iff, sample_space, mem_partitions_on', and_imp],
    intros f hf _ _ _,
    apply hf _ hi },
  have := @finset.bUnion_filter_eq_of_maps_to _ _ _ _ (sample_space α m t)
    (univ.powerset_len m) (λ f, f i) this,
  conv_lhs {rw ←this},
  rw [filter_bUnion, finset.card_bUnion],
  { have : ∀ x ∈ powerset_len m (univ : finset α),
      (((sample_space α m t).filter (λ (Ws : ℕ → finset α), Ws i = x)).filter
        (λ (Ws : ℕ → finset α), Ws i ⊆ R)).card =
      (((sample_space α m t).filter (λ (Ws : ℕ → finset α), Ws i = x)).filter
        (λ _, x ⊆ R)).card,
    { intros x hx,
      rw [filter_filter, filter_filter],
      congr' 2,
      ext f,
      simp { contextual := tt } },
    rw [sum_congr rfl this],
    simp only [filter_const, apply_ite finset.card, card_empty, sample_space],
    rw [←sum_filter],
    have : ∑ (a : finset α) in filter (λ (a : finset α), a ⊆ R) (powerset_len m univ),
      (fintype.card α).choose m *
        (filter (λ (Ws : ℕ → finset α), Ws i = a) (partitions_on univ m t)).card =
      ∑ (a : finset α) in powerset_len m R, (partitions_on univ m t).card,
    { apply finset.sum_congr _ _,
      { convert (powerset_filter_subset m univ R).trans _,
        rw univ_inter },
      intros x hx,
      rw [mul_comm, ←card_univ, card_partition_fix _ (subset_univ _) hi],
      rw mem_powerset_len at hx,
      exact hx.2 },
    rw [mul_sum, this, sum_const, smul_eq_mul, card_powerset_len] },
  simp only [mem_powerset_len_univ_iff],
  intros W₁ hW₁ W₂ hW₂ h,
  rw finset.disjoint_left,
  simp only [mem_filter, not_and, and_imp],
  rintro f _ rfl _ _ rfl,
  cases h rfl
end

lemma cor1 {m t : ℕ} {𝒮 : finset (finset α)} {U : finset (finset α)} {ε : ℝ}
  (hm : 1 ≤ m) (ht : 1 ≤ t) (hε : 0 < ε) (hn : ε ≤ m / 64 * fintype.card α)
  (hS : ∀ S ∈ 𝒮, finset.card S ≤ 2 ^ t) (hU : spread ε U) :
  𝔼 Ws in sample_space α m t,
    𝔼 u in U, ((shadow (the_function Ws 𝒮 t) u).card : ℝ) < 1 / 8 ∧
  ∀ W, (∃ S ∈ 𝒮, S ⊆ W) ∨ ∀ Ws ∈ partitions_on W m t, ∀ S ∈ 𝒮, ∃ X ∈ the_function Ws 𝒮 t, X ⊆ S :=
begin
  sorry
end

-- the things from here down are Bhavik's proofs of stuff which is now (probably) not necessary
-- but I'm keeping them just in case they turn out useful

-- lemma part_one_one_easy_bit (R : finset α) (h : ¬ ∃ T ∈ the_partial_function W 𝒮 t i, T ⊆ R) :
--   ((the_partial_function W 𝒮 t i).filter (λ T, R = T ∪ W i)).card ≤ 2 ^ (2 ^ (t - i)) :=
-- begin
--   rw [finset.filter_false_of_mem, card_empty],
--   { apply nat.zero_le _ },
--   rintro T hT rfl,
--   exact h ⟨T, hT, subset_union_left _ _⟩,
-- end

-- lemma part_one_one_other_easy_bit (R : finset α) (hR : ¬ W i ⊆ R) :
--   ((the_partial_function W 𝒮 t i).filter (λ T, R = T ∪ W i)).card ≤ 2 ^ (2 ^ (t - i)) :=
-- begin
--   rw [finset.filter_false_of_mem, card_empty],
--   { apply nat.zero_le _ },
--   rintro T hT rfl,
--   exact hR (subset_union_right _ _),
-- end

-- lemma part_one_one_hard_bit_first_step {R : finset α} (hR : W i ⊆ R)
--   (h : ∃ T ∈ the_partial_function W 𝒮 t i, T ⊆ R) :
--   (𝒮.filter (λ S, S \ (finset.range i).bUnion W ⊆ R ∧
--     S \ (finset.range (i + 1)).bUnion W ∈ the_partial_function' W 𝒮 t i)).nonempty :=
-- begin
--   obtain ⟨T, hT₁, hT₂⟩ := h,
--   rw [the_partial_function_eq] at hT₁,
--   replace hT₁ := to_antichain_subset hT₁,
--   simp only [the_partial_function', mem_filter, finset.mem_image, exists_prop, and_assoc,
--     finset.nonempty] at hT₁ ⊢,
--   obtain ⟨S, hS₁, hS₂, rfl⟩ := hT₁,
--   refine ⟨S, hS₁, _, S, hS₁, hS₂, rfl⟩,
--   rw [range_succ, finset.bUnion_insert, sdiff_union_distrib] at hT₂,
--   intros x hx,
--   by_cases x ∈ W i,
--   { apply hR h },
--   apply hT₂,
--   simp only [finset.mem_inter, mem_sdiff, finset.mem_bUnion, finset.mem_range, exists_prop,
--     not_exists, not_and] at hx ⊢,
--   tauto
-- end

-- #check cond_count
-- #check matrix.vec_cons
-- lemma part_one_one (R : finset α)  (hS : ∀ S ∈ 𝒮, finset.card S ≤ 2 ^ t) :
--   ((the_partial_function W 𝒮 t i).filter (λ T, R = T ∪ W i)).card ≤ 2 ^ (2 ^ (t - i)) :=
-- begin
--   -- by_cases h₁ : W i ⊆ R,
--   -- { by_cases h₂ : ∃ T ∈ the_partial_function W 𝒮 t i, T ⊆ R,
--   --   { apply part_one_one_hard_bit _ h₁ hS h₂ },
--   --   apply part_one_one_easy_bit _ h₂ },
--   -- apply part_one_one_other_easy_bit _ h₁,
-- end

--#exit
/-
-- variables {Ω : Type*} [measurable_space Ω] {μ : measure Ω}

lemma exists_uniform' (ε : ℝ) (U : finset (finset α)) : ∃ (μ : measure (finset α))
  (UU : finset α → finset α), pdf.is_uniform UU (U : set (finset α)) μ measure.count :=
⟨_, _, exists_uniform _ _ measurable_space.measurable_set_top⟩

--notation X ` ⊈ ` Y := ¬ (X ⊆ Y)
-/
-------------------------------------------------------------------------

-- noncomputable def lhs_sample_space (m t : ℕ) (U : finset (finset α)) :=
-- U.product
--   (finset.sigma (((finset.univ : finset α).powerset_len (m * t)).bUnion (λ W, partitions_on W m t)) $
--     (λ Ws, the_function Ws 𝒮 t))

--   #check lhs_sample_space

lemma lem2_part1 {m t : ℕ} {𝒮 : finset (finset α)} {U : finset (finset α)} {ε : ℝ}   (hm : 1 ≤ m)
  (ht : 1 ≤ t) (hε : 0 < ε) (hn : ε ≤ m / 64 * fintype.card α)
  (hS : ∀ S ∈ 𝒮, finset.card S ≤ 2 ^ t) (hU : spread ε U) :
  (((sample_space α m t).filter
      (λ Ws, ∀ S ∈ 𝒮, (shadow (the_function Ws 𝒮 t) S).nonempty)).card : ℝ) /
    (sample_space α m t).card ≤
  𝔼 Ws in sample_space α m t, 𝔼 u in U, ((shadow (the_function Ws 𝒮 t) u).card : ℝ) :=
begin
  sorry
end

lemma bUnion_ite {α β : Type*} (s : finset α) (p : α → Prop) [decidable_pred p] (f : α → finset β) :
  s.bUnion (λ i, if p i then f i else ∅) = (s.filter p).bUnion f :=
begin
  ext x,
  simp only [mem_bUnion, exists_prop, mem_filter],
  refine exists_congr (λ a, _),
  split_ifs,
  { simp [h] },
  { simp [h] },
end

open finset

lemma lem2_part2 {m t : ℕ} {𝒮 : finset (finset α)} {U : finset (finset α)} {ε : ℝ}   (hm : 1 ≤ m)
  (ht : 1 ≤ t) (hε : 0 < ε) (hn : ε ≤ m / 64 * fintype.card α)
  (hS : ∀ S ∈ 𝒮, finset.card S ≤ 2 ^ t) (hU : spread ε U) :
  (card (((univ : finset α).powerset_len (m * t)).filter (λ w, ∀T ∈ 𝒮, ¬ T ⊆ w)) : ℝ) /
    ((fintype.card α).choose (m*t)) ≤
  (((sample_space α m t).filter
    (λ Ws, ∀ S ∈ 𝒮, (shadow (the_function Ws 𝒮 t) S).nonempty)).card : ℝ) /
  (sample_space α m t).card :=
begin
  have : ∀ (Ws : ℕ → finset α),
    Ws ∈ sample_space α m t → (∀ S ∈ 𝒮, ¬ S ⊆ (range t).bUnion Ws) →
      ∀ S ∈ 𝒮, (shadow (the_function Ws 𝒮 t) S).nonempty,
  { intros Ws h h' S hS',
    obtain ⟨X, hX, hX'⟩ := ((cor1 hm ht hε hn hS hU).2 ((range t).bUnion Ws)).resolve_left
      (by simpa using h') Ws _ _ hS',
    { refine ⟨X, _⟩,
      simp only [shadow, mem_filter, hX, hX', and_self] },
    apply partitions_on_of_subset _ h,
    intros i hi,
    exact subset_bUnion_of_mem _ (by simpa using hi) }, -- trivial statement about partitions
  have : (sample_space α m t).filter
      (λ Ws, ∀ S ∈ 𝒮, ¬ S ⊆ (range t).bUnion Ws) ⊆
        (sample_space α m t).filter
      (λ (Ws : ℕ → finset α), ∀ S ∈ 𝒮, (shadow (the_function Ws 𝒮 t) S).nonempty),
  { intros Ws hWs,
    simp only [mem_filter] at hWs ⊢,
    exact ⟨hWs.1, this _ hWs.1 hWs.2⟩ },
  refine le_trans _ (div_le_div_of_le (nat.cast_nonneg _) (nat.cast_le.2 (card_le_of_subset this))),
  rw [sample_space, partitions_on_eq, filter_bUnion],
  have : (powerset_len (m * t) univ).bUnion (λ a, filter
    (λ (Ws : ℕ → finset α), ∀ S ∈ 𝒮, ¬S ⊆ (range t).bUnion Ws) (partitions_on a m t)) =
         (powerset_len (m * t) univ).bUnion (λ a, filter
    (λ (Ws : ℕ → finset α), ∀ S ∈ 𝒮, ¬S ⊆ a) (partitions_on a m t)),
  { ext a,
    simp only [mem_bUnion, mem_filter, exists_prop, mem_powerset_len_univ_iff],
    refine exists_congr (λ W, _),
    simp only [and.congr_right_iff],
    intros hW hW',
    refine ball_congr (λ S hS, _),
    congr' 3,
    apply eq_of_subset_of_card_le (subset_of_mem_partitions_on hW'),
    rw [card_bUnion_of_mem_partitions_on hW', hW] },
  rw [this],
  simp only [filter_const, bUnion_ite],
  rw [card_bUnion, card_bUnion],
  { simp only [card_partitions_on],
    rw [@sum_const_nat _ _ (∏ (i : ℕ) in range t, ((m * t - m * i).choose m)),
        @sum_const_nat _ _ (∏ (i : ℕ) in range t, ((m * t - m * i).choose m)),
        nat.cast_mul, nat.cast_mul, mul_div_mul_right, card_powerset_len, card_univ],
    { rw nat.cast_ne_zero,
      rw finset.prod_ne_zero_iff,
      intros i hi,
      rw [ne.def, nat.choose_eq_zero_iff, not_lt, ←nat.mul_sub_left_distrib],
      apply le_mul_of_one_le_right',
      rw nat.succ_le_iff,
      rw mem_range at hi,
      apply nat.sub_pos_of_lt hi },
    { intros x hx,
      simp only [mem_powerset_len_univ_iff] at hx,
      simp only [hx] },
    { intros x hx,
      simp only [mem_filter, mem_powerset_len_univ_iff] at hx,
      simp only [hx.1] } },
  { simp only [mem_powerset_len_univ_iff, ne.def, finset.disjoint_left],
    intros W₁ hW₁ W₂ hW₂ h f hf₁ hf₂,
    exact h (partitions_on_inj_on hW₁ hW₂ hf₁ hf₂) },
  { simp only [mem_powerset_len_univ_iff, ne.def, finset.disjoint_left, mem_filter],
    intros W₁ hW₁ W₂ hW₂ h f hf₁ hf₂,
    exact h (partitions_on_inj_on hW₁.1 hW₂.1 hf₁ hf₂) },
end

theorem Lem2 (S : finset (finset α)) (W : finset(finset α) ) (t m: ℕ )
(hel : ∀T ∈ S, (finset.card T:ℝ ) ≤ (2^t:ℝ ) ) (h_sp : spread (m*64⁻¹ / (fintype.card α )⁻¹) S):
  (finset.card ((univ.powerset_len (m * t)).filter (λ w, ∀T ∈ S, ¬ (T ⊆ w) )) : ℝ) ≤
    (nat.choose (fintype.card α) (m*t)) / 8 :=
begin
  sorry
end

theorem Cor2_easyver (S : finset (finset α) )(n k w m:ℕ )(hSk : ∀T∈S, finset.card T = k) (hk : 2 ≤ k)
(hn : n = 2*w*m*t) ( ε:ℝ ) (he : 0 ≤ ε ) (hspr : spread ε S) :
 ∃(T : finset (finset α ) ),  (T ⊆ S) ∧  (∀ B₁  B₂ ∈ T, B₁ ≠ B₂ →  disjoint B₁ B₂ )
 ∧ (2^(-9 : ℝ )*ε⁻¹/(real.logb  2 k) ≤ T.card ) :=
begin
  set t:= nat.ceil (real.logb 2 k) with ht,
  have h_t_le : real.logb 2 k ≤ t,
  {
    rw ht, exact nat.le_ceil (real.logb 2 ↑k),
  },

  sorry

end

theorem Cor2 (S : finset (finset α) )( k:ℕ )(hSk : ∀T∈S, finset.card T = k)
( ε:ℝ ) (he : 0 ≤ ε ) (hspr : spread ε S) : 2 ≤ k →  ∃(T : finset (finset α ) ),
 (T ⊆ S) ∧  (∀ B₁  B₂ ∈ T, B₁ ≠ B₂ →  disjoint B₁ B₂ ) ∧  (2^(-9 : ℝ )*ε⁻¹/(real.logb  2 k) ≤ T.card ) :=
begin
  set t:= nat.ceil (real.logb 2 k) with ht,
  have h_t_le : real.logb 2 k ≤ t := nat.le_ceil (real.logb 2 ↑k),

--Choose random partiiton of [n]

--Lemma2 is applicable

--Apply Lemma 2

--Expectation > w implies actual such case

--use the right T

--split,

sorry
end

--Using different index. We use w+1 , k+1 for w, k in the paper. Then we can have induction from k=1,
--and we don't need the prooves that 1 ≤ w,k.

-- lemma finset.sdiff_inter_sdiff_eq (a b c : finset α) : (a \ c) ∩ (b \ c) = (a ∩ b) \ c:=
-- begin
--   rw finset.inter_sdiff,
--   rw inter_comm,
--   rw finset.inter_sdiff,
--   rw inter_comm b a,
--   rw finset.sdiff_eq_self_iff_disjoint,
--   exact sdiff_disjoint,
-- end

-- lemma finset.sdiff_union_subset (a b c : finset α) (h1 : a = b \ c) (h2 : c ⊆ b) : b = a ∪ c :=
-- begin
--   rw h1,
--   rw ← finset.inter_eq_left_iff_subset at h2,
--   nth_rewrite 1 ← h2,
--   rw inter_comm,
--   rw finset.sdiff_union_inter,
-- end

def sunflower {α : Type*}[decidable_eq α ] (S : finset (finset α )) (num_petal: ℕ ) : Prop :=
  (finset.card S = num_petal) ∧ (∃(C : finset α), ∀ P₁ P₂ ∈ S, P₁ ≠ P₂ →  P₁ ∩ P₂ = C)

def Thm3 (w : ℕ)(k: ℕ ){S: finset (finset α )} (hT : ∀ T ∈ S, finset.card T = k+1)
: Prop :=  ∃r : ℝ , r ≤  (2:ℝ)^(10:ℝ)*(w+1 : ℝ )*(real.logb 2 (k+1)) ∧ (r^(k+1) ≤ S.card → ∃F⊆S, ( sunflower F (w+1)))

def smaller_sunflower {α : Type*}[decidable_eq α ] (S : finset (finset α )) (Z : finset α) : finset (finset α ) :=
S.image (λ s, s \ Z)

lemma sunflower_iff_smaller {S : finset (finset α)} {Z : finset α} (n: ℕ) (h : ∀ s ∈ S, Z ⊆ s) :
  sunflower S n ↔ sunflower (smaller_sunflower S Z) n :=
begin
  have injective : set.inj_on (λ s, s \ Z) S,
  { intros a ha b hb hab,
    dsimp at hab,
    have hZa : Z ⊆ a := h a ha,
    have hZb : Z ⊆ b := h b hb,
    suffices : (a \ Z) ∪ Z = (b \ Z) ∪ Z,
    { simp only [finset.sdiff_union_self_eq_union] at this,
      rw ← finset.union_eq_left_iff_subset at hZa hZb,
      simpa [hZa, hZb] using this, },
    { rw hab, } },
  split,
  { intro hS,
    cases hS with hS1 hS2,
    refine ⟨_, _⟩,
    { rw ← hS1,
      exact finset.card_image_of_inj_on injective, },
    { rcases hS2 with ⟨C, hS⟩,
      use C \ Z,
      intros P₁ hP₁ P₂ hP₂ hP,
      have hPs : ∀ P ∈ smaller_sunflower S Z, ∃ s ∈ S, P = s \ Z,
      { intros x hx,
        unfold smaller_sunflower at hx,
        rw finset.mem_image at hx,
        rcases hx with ⟨s, h1, h2⟩,
        use s,
        simp only [h1, h2, eq_self_iff_true, and_self], },
      have hP1 : ∃ s₁ ∈ S, P₁ = s₁ \ Z := hPs P₁ hP₁,
      have hP2 : ∃ s₂ ∈ S, P₂ = s₂ \ Z := hPs P₂ hP₂,
      rcases hP1 with ⟨s₁, hs₁, hP1⟩,
      rcases hP2 with ⟨s₂, hs₂, hP2⟩,
      rw [hP1, hP2],
      rw finset.inter_sdiff,
      rw inter_comm,
      rw finset.inter_sdiff,
      rw inter_comm s₂ s₁,
      simp only [finset.sdiff_idem],
      have hs : s₁ ≠ s₂,
      { by_contra,
        apply hP,
        rw [hP1, hP2, h], },
      have := hS s₁ hs₁ s₂ hs₂ hs,
      rw this, }, },
  { intro hP,
    cases hP with hP1 hP2,
    refine ⟨_, _⟩,
    { rw ← finset.card_image_of_inj_on injective,
      exact hP1, },
    { rcases hP2 with ⟨C, hP⟩,
      use C ∪ Z,
      intros s₁ hs₁ s₂ hs₂ hs,
      have hPs' : ∀ s ∈ S, ∃ P ∈ smaller_sunflower S Z, s = P ∪ Z,
      { intros s hs,
        use s \ Z,
        simp only [h s hs, sdiff_union_self_eq_union, left_eq_union_iff_subset, and_true],
        unfold smaller_sunflower,
        rw finset.mem_image,
        use s,
        simp only [hs, eq_self_iff_true, and_self], },
      have hS1 : ∃ P₁ ∈ smaller_sunflower S Z, s₁ = P₁ ∪ Z := hPs' s₁ hs₁,
      have hS2 : ∃ P₂ ∈ smaller_sunflower S Z, s₂ = P₂ ∪ Z := hPs' s₂ hs₂,
      rcases hS1 with ⟨P₁, hP₁, hS1⟩,
      rcases hS2 with ⟨P₂, hP₂, hS2⟩,
      have hp : P₁ ≠ P₂,
      { by_contra,
        apply hs,
        rw [hS1, hS2, h], },
      have := hP P₁ hP₁ P₂ hP₂ hp,
      rw [hS1, hS2],
      rw ← finset.union_distrib_right,
      rw this, }, },
end

theorem Thm3' {w : ℕ}(k : ℕ ){r: ℝ}{S: finset (finset α )}  (hT : ∀ T ∈ S, finset.card T = k+1)
: (w+1 : ℝ) = r → (real.logb 2 (k+1) = r * (2^9)⁻¹ * (w+1)⁻¹ ) →  (r^(k+1) ≤ finset.card S) → ∃F⊆S, ( sunflower F (w+1)) :=
-- I think r can be equal to 2^9 * w * log(k+1) and w+1 = r
begin
  induction k using nat.case_strong_induction_on with k ih generalizing S,
  {
    simp at *,
    intros hwr h_log hrkS, --- I dont understand k=0 case.
    have hU : ∃U ⊆ S, (finset.card U  = w+1) ∧ (∀ P₁ P₂ ∈ U, P₁ ≠ P₂ →  disjoint P₁ P₂),
    {
      rw ← hwr at hrkS, norm_cast at hrkS, --push_cast
      have tmp := exists_smaller_set S (w+1) hrkS,
      cases tmp, use tmp_w,
      split,
      { exact tmp_h.1 },
      {split, exact tmp_h.2,
        intros P1 hP1 P2 hP2 h12,
        have h_sing : ∀P ∈ tmp_w, finset.card P = 1 :=
        begin
          rw subset_iff at tmp_h, intros P hPP,
          have hSS := tmp_h.1 hPP, exact hT P hSS,
        end,
        obtain ⟨p1, rfl ⟩ := finset.card_eq_one.1 (h_sing P1 hP1),
        obtain ⟨p2, rfl ⟩:= finset.card_eq_one.1 (h_sing P2 hP2),
        simp,
        intro P12,
        exact h12 (finset.singleton_inj.2 P12),
      },
    },

    rcases hU with ⟨U,hU1,hU2,hU3⟩,
    use U, split, exact hU1,
    split, exact hU2,
    use ∅,
    simp only [ finset.disjoint_iff_inter_eq_empty] at hU3,
    exact hU3,
  },

  {
    intros hwr hn hrkS,
    by_contra, simp at h,

    -- S is not (r⁻¹)-spread
    have h_S_nspread : ¬(spread r⁻¹ S ),
    {
      by_contra htmp,
      have k2tmp : 2 ≤ k + 2 := by linarith,
      have rinv_pos : 0 ≤ r⁻¹ := begin rw ← hwr, apply le_of_lt, rw inv_pos, exact w.cast_add_one_pos,  end,
      have COR2:= Cor2 S (k+2) hT r⁻¹ rinv_pos htmp k2tmp,
      rcases COR2 with ⟨Ttmp,hTT1, hTT2, hTT3⟩,
      have hTtmpcard : (w+1) ≤ finset.card Ttmp,
      {
        simp at hn, simp at hTT3,
        sorry,
      },
      have Ttmptmp := exists_smaller_set Ttmp (w+1) hTtmpcard,
      rcases Ttmptmp with ⟨C, hC1, hC2 ⟩,
      specialize h C (subset_trans hC1 hTT1),
      apply h,
      split, exact hC2,
      use ∅,
      intros P1 hP1 P2 hP2 h12,
      simp only [ finset.disjoint_iff_inter_eq_empty] at hTT2,
      apply hTT2 P1 (subset_iff.1 hC1 hP1) P2 ( subset_iff.1 hC1 hP2) h12,
    },

    -- Construction of Z and S'
    have hZ : ∃(Z:finset α), (finset.card (S.filter (λ s, Z ⊆ s)) : ℝ) > r^(k- finset.card Z),
    {
      by_contra h_con, simp at h_con,
      apply h_S_nspread,
      unfold spread,
      intros Z,
      specialize h_con Z,
      have temp : r ^ (k - Z.card) ≤ r⁻¹ ^ Z.card * ↑(S.card),
      {
        --use hrKS and hwr
        sorry
      },
      convert (le_trans h_con temp),
    },
    rcases hZ with ⟨Z,hZ⟩,
    --define S'
    let S' := S.filter (λ s, Z ⊆ s),

    -- S'' is the sunflower
    have hSmall :  sunflower (smaller_sunflower S' Z) (w+1), --change that some subset of S' is a sunflower
    {
      sorry --nontrivial sorry but not hard
    },
    --S is the sunflower
    have h_contains_Z :  ∀ s ∈ S', Z ⊆ s,
    {
      intros s, rw finset.mem_filter, intros hs, exact hs.2,
    },
    have hSprime : sunflower S' (w+1) := (sunflower_iff_smaller (w+1) h_contains_Z).2 hSmall,
    apply h S' (finset.filter_subset (λ s, Z ⊆ s) S) hSprime,
  }
end

/-theorem Thm3 {w k : ℕ}{S: finset (finset α )} (hw : 1 ≤ w) ( hk : 1 ≤ k) (hT : ∀ T ∈ S, finset.card T = k)
: ∃r : ℝ , r ≤  (2:ℝ)^(10:ℝ)*(w : ℝ )*(real.logb 2 k) ∧
(r^k ≤ S.card → ∃F⊆S, ( sunflower F w)) :=
begin

sorry

end -/


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12a_2013_p7
  (s : ℕ → ℝ)
  (h₀: ∀ n, s (n + 2) = s (n + 1) + s n)
  (h₁ : s 9 = 110)
  (h₂ : s 7 = 42) :
  s 4 = 10 :=
begin
  simp only [*] at *,
  linarith,
end


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monad.types
import Mathlib.category_theory.monad.limits
import Mathlib.category_theory.equivalence
import Mathlib.topology.category.CompHaus
import Mathlib.data.set.constructions
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!

# Compacta and Compact Hausdorff Spaces

Recall that, given a monad `M` on `Type*`, an *algebra* for `M` consists of the following data:
- A type `X : Type*`
- A "structure" map `M X → X`.
This data must also satisfy a distributivity and unit axiom, and algebras for `M` form a category
in an evident way.

See the file `category_theory.monad.algebra` for a general version, as well as the following link.
https://ncatlab.org/nlab/show/monad

This file proves the equivalence between the category of *compact Hausdorff topological spaces*
and the category of algebras for the *ultrafilter monad*.

## Notation:

Here are the main objects introduced in this file.
- `Compactum` is the type of compacta, which we define as algebras for the ultrafilter monad.
- `Compactum_to_CompHaus` is the functor `Compactum ⥤ CompHaus`. Here `CompHaus` is the usual
  category of compact Hausdorff spaces.
- `Compactum_to_CompHaus.is_equivalence` is a term of type `is_equivalence Compactum_to_CompHaus`.

The proof of this equivalence is a bit technical. But the idea is quite simply that the structure
map `ultrafilter X → X` for an algebra `X` of the ultrafilter monad should be considered as the map
sending an ultrafilter to its limit in `X`. The topology on `X` is then defined by mimicking the
characterization of open sets in terms of ultrafilters.

Any `X : Compactum` is endowed with a coercion to `Type*`, as well as the following instances:
- `topological_space X`.
- `compact_space X`.
- `t2_space X`.

Any morphism `f : X ⟶ Y` of is endowed with a coercion to a function `X → Y`, which is shown to
be continuous in `continuous_of_hom`.

The function `Compactum.of_topological_space` can be used to construct a `Compactum` from a
topological space which satisfies `compact_space` and `t2_space`.

We also add wrappers around structures which already exist. Here are the main ones, all in the
`Compactum` namespace:

- `forget : Compactum ⥤ Type*` is the forgetful functor, which induces a `concrete_category`
  instance for `Compactum`.
- `free : Type* ⥤ Compactum` is the left adjoint to `forget`, and the adjunction is in `adj`.
- `str : ultrafilter X → X` is the structure map for `X : Compactum`.
  The notation `X.str` is preferred.
- `join : ultrafilter (ultrafilter X) → ultrafilter X` is the monadic join for `X : Compactum`.
  Again, the notation `X.join` is preferred.
- `incl : X → ultrafilter X` is the unit for `X : Compactum`. The notation `X.incl` is preferred.

## References

- E. Manes, Algebraic Theories, Graduate Texts in Mathematics 26, Springer-Verlag, 1976.
- https://ncatlab.org/nlab/show/ultrafilter

-/

/-- The type `Compactum` of Compacta, defined as algebras for the ultrafilter monad. -/
def Compactum := category_theory.monad.algebra (category_theory.of_type_functor ultrafilter)

namespace Compactum

/-- The forgetful functor to Type* -/
def forget : Compactum ⥤ Type u_1 :=
  category_theory.monad.forget (category_theory.of_type_functor ultrafilter)

/-- The "free" Compactum functor. -/
def free : Type u_1 ⥤ Compactum :=
  category_theory.monad.free (category_theory.of_type_functor ultrafilter)

/-- The adjunction between `free` and `forget`. -/
def adj : free ⊣ forget := category_theory.monad.adj (category_theory.of_type_functor ultrafilter)

-- Basic instances

protected instance category_theory.concrete_category :
    category_theory.concrete_category Compactum :=
  category_theory.concrete_category.mk forget

protected instance has_coe_to_sort : has_coe_to_sort Compactum :=
  has_coe_to_sort.mk (Type u_1) (category_theory.functor.obj forget)

protected instance category_theory.has_hom.hom.has_coe_to_fun {X : Compactum} {Y : Compactum} :
    has_coe_to_fun (X ⟶ Y) :=
  has_coe_to_fun.mk (fun (f : X ⟶ Y) => ↥X → ↥Y)
    fun (f : X ⟶ Y) => category_theory.monad.algebra.hom.f f

protected instance category_theory.limits.has_limits :
    category_theory.limits.has_limits Compactum :=
  category_theory.has_limits_of_has_limits_creates_limits forget

/-- The structure map for a compactum, essentially sending an ultrafilter to its limit. -/
def str (X : Compactum) : ultrafilter ↥X → ↥X := category_theory.monad.algebra.a X

/-- The monadic join. -/
def join (X : Compactum) : ultrafilter (ultrafilter ↥X) → ultrafilter ↥X :=
  category_theory.nat_trans.app μ_ ↥X

/-- The inclusion of `X` into `ultrafilter X`. -/
def incl (X : Compactum) : ↥X → ultrafilter ↥X :=
  category_theory.nat_trans.app η_ (category_theory.functor.obj forget X)

@[simp] theorem str_incl (X : Compactum) (x : ↥X) : str X (incl X x) = x := sorry

@[simp] theorem str_hom_commute (X : Compactum) (Y : Compactum) (f : X ⟶ Y) (xs : ultrafilter ↥X) :
    coe_fn f (str X xs) = str Y (ultrafilter.map (⇑f) xs) :=
  sorry

@[simp] theorem join_distrib (X : Compactum) (uux : ultrafilter (ultrafilter ↥X)) :
    str X (join X uux) = str X (ultrafilter.map (str X) uux) :=
  sorry

protected instance topological_space {X : Compactum} : topological_space ↥X :=
  topological_space.mk (fun (U : set ↥X) => ∀ (F : ultrafilter ↥X), str X F ∈ U → U ∈ F) sorry sorry
    sorry

theorem is_closed_iff {X : Compactum} (S : set ↥X) :
    is_closed S ↔ ∀ (F : ultrafilter ↥X), S ∈ F → str X F ∈ S :=
  sorry

protected instance compact_space {X : Compactum} : compact_space ↥X :=
  compact_space.mk
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (is_compact set.univ)) (propext compact_iff_ultrafilter_le_nhds)))
      fun (F : ultrafilter ↥X) (h : ↑F ≤ filter.principal set.univ) =>
        Exists.intro (str X F)
          (Exists.intro trivial
            (eq.mpr (id (Eq._oldrec (Eq.refl (↑F ≤ nhds (str X F))) (propext le_nhds_iff)))
              fun (S : set ↥X) (h1 : str X F ∈ S) (h2 : is_open S) => h2 F h1)))

/-- A local definition used only in the proofs. -/
/-- A local definition used only in the proofs. -/
theorem is_closed_cl {X : Compactum} (A : set ↥X) : is_closed (cl A) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_closed (cl A))) (propext (is_closed_iff (cl A)))))
    fun (F : ultrafilter ↥X) (hF : cl A ∈ F) =>
      cl_cl A (Exists.intro F { left := hF, right := rfl })

theorem str_eq_of_le_nhds {X : Compactum} (F : ultrafilter ↥X) (x : ↥X) :
    ↑F ≤ nhds x → str X F = x :=
  sorry

theorem le_nhds_of_str_eq {X : Compactum} (F : ultrafilter ↥X) (x : ↥X) :
    str X F = x → ↑F ≤ nhds x :=
  fun (h : str X F = x) =>
    iff.mpr le_nhds_iff
      fun (s : set ↥X) (hx : x ∈ s) (hs : is_open s) =>
        hs F (eq.mpr (id (Eq._oldrec (Eq.refl (str X F ∈ s)) h)) hx)

-- All the hard work above boils down to this t2_space instance.

protected instance t2_space {X : Compactum} : t2_space ↥X :=
  eq.mpr (id (Eq._oldrec (Eq.refl (t2_space ↥X)) (propext t2_iff_ultrafilter)))
    fun (x y : ↥X) (F : ultrafilter ↥X) (hx : ↑F ≤ nhds x) (hy : ↑F ≤ nhds y) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (x = y)) (Eq.symm (str_eq_of_le_nhds F x hx))))
        (eq.mpr (id (Eq._oldrec (Eq.refl (str X F = y)) (Eq.symm (str_eq_of_le_nhds F y hy))))
          (Eq.refl (str X F)))

/-- The structure map of a compactum actually computes limits. -/
theorem Lim_eq_str {X : Compactum} (F : ultrafilter ↥X) : ultrafilter.Lim F = str X F :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (ultrafilter.Lim F = str X F)) (propext ultrafilter.Lim_eq_iff_le_nhds)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑F ≤ nhds (str X F))) (propext le_nhds_iff)))
      fun (s : set ↥X) (ᾰ : str X F ∈ s) (ᾰ_1 : is_open s) => ᾰ_1 F ᾰ)

theorem cl_eq_closure {X : Compactum} (A : set ↥X) : cl A = closure A := sorry

/-- Any morphism of compacta is continuous. -/
theorem continuous_of_hom {X : Compactum} {Y : Compactum} (f : X ⟶ Y) : continuous ⇑f := sorry

/-- Given any compact Hausdorff space, we construct a Compactum. -/
def of_topological_space (X : Type u_1) [topological_space X] [compact_space X] [t2_space X] :
    Compactum :=
  category_theory.monad.algebra.mk X ultrafilter.Lim

/-- Any continuous map between Compacta is a morphism of compacta. -/
def hom_of_continuous {X : Compactum} {Y : Compactum} (f : ↥X → ↥Y) (cont : continuous f) : X ⟶ Y :=
  category_theory.monad.algebra.hom.mk f

end Compactum

/-- The functor functor from Compactum to CompHaus. -/
def Compactum_to_CompHaus : Compactum ⥤ CompHaus :=
  category_theory.functor.mk (fun (X : Compactum) => CompHaus.mk (category_theory.bundled.mk ↥X))
    fun (X Y : Compactum) (f : X ⟶ Y) => continuous_map.mk ⇑f

namespace Compactum_to_CompHaus

/-- The functor Compactum_to_CompHaus is full. -/
def full : category_theory.full Compactum_to_CompHaus :=
  category_theory.full.mk
    fun (X Y : Compactum)
      (f :
      category_theory.functor.obj Compactum_to_CompHaus X ⟶
        category_theory.functor.obj Compactum_to_CompHaus Y) =>
      Compactum.hom_of_continuous (continuous_map.to_fun f) sorry

/-- The functor Compactum_to_CompHaus is faithful. -/
theorem faithful : category_theory.faithful Compactum_to_CompHaus := category_theory.faithful.mk

/-- This definition is used to prove essential surjectivity of Compactum_to_CompHaus. -/
def iso_of_topological_space {D : CompHaus} :
    category_theory.functor.obj Compactum_to_CompHaus (Compactum.of_topological_space ↥D) ≅ D :=
  category_theory.iso.mk (continuous_map.mk id) (continuous_map.mk id)

/-- The functor Compactum_to_CompHaus is essentially surjective. -/
theorem ess_surj : category_theory.ess_surj Compactum_to_CompHaus :=
  category_theory.ess_surj.mk
    fun (X : CompHaus) =>
      Exists.intro (Compactum.of_topological_space ↥X) (Nonempty.intro iso_of_topological_space)

/-- The functor Compactum_to_CompHaus is an equivalence of categories. -/
def is_equivalence : category_theory.is_equivalence Compactum_to_CompHaus :=
  category_theory.equivalence.equivalence_of_fully_faithfully_ess_surj Compactum_to_CompHaus

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Theory of complete Boolean algebras.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.complete_lattice
import Mathlib.PostPort

universes u_1 l u w

namespace Mathlib

/-- A complete distributive lattice is a bit stronger than the name might
  suggest; perhaps completely distributive lattice is more descriptive,
  as this class includes a requirement that the lattice join
  distribute over *arbitrary* infima, and similarly for the dual. -/
class complete_distrib_lattice (α : Type u_1) extends complete_lattice α where
  infi_sup_le_sup_Inf :
    ∀ (a : α) (s : set α), (infi fun (b : α) => infi fun (H : b ∈ s) => a ⊔ b) ≤ a ⊔ Inf s
  inf_Sup_le_supr_inf :
    ∀ (a : α) (s : set α), a ⊓ Sup s ≤ supr fun (b : α) => supr fun (H : b ∈ s) => a ⊓ b

theorem sup_Inf_eq {α : Type u} [complete_distrib_lattice α] {a : α} {s : set α} :
    a ⊔ Inf s = infi fun (b : α) => infi fun (H : b ∈ s) => a ⊔ b :=
  le_antisymm (le_infi fun (i : α) => le_infi fun (h : i ∈ s) => sup_le_sup_left (Inf_le h) a)
    (complete_distrib_lattice.infi_sup_le_sup_Inf a s)

theorem Inf_sup_eq {α : Type u} [complete_distrib_lattice α] {b : α} {s : set α} :
    Inf s ⊔ b = infi fun (a : α) => infi fun (H : a ∈ s) => a ⊔ b :=
  sorry

theorem inf_Sup_eq {α : Type u} [complete_distrib_lattice α] {a : α} {s : set α} :
    a ⊓ Sup s = supr fun (b : α) => supr fun (H : b ∈ s) => a ⊓ b :=
  le_antisymm (complete_distrib_lattice.inf_Sup_le_supr_inf a s)
    (supr_le fun (i : α) => supr_le fun (h : i ∈ s) => inf_le_inf_left a (le_Sup h))

theorem Sup_inf_eq {α : Type u} [complete_distrib_lattice α] {b : α} {s : set α} :
    Sup s ⊓ b = supr fun (a : α) => supr fun (H : a ∈ s) => a ⊓ b :=
  sorry

theorem Inf_sup_Inf {α : Type u} [complete_distrib_lattice α] {s : set α} {t : set α} :
    Inf s ⊔ Inf t =
        infi fun (p : α × α) => infi fun (H : p ∈ set.prod s t) => prod.fst p ⊔ prod.snd p :=
  sorry

theorem Sup_inf_Sup {α : Type u} [complete_distrib_lattice α] {s : set α} {t : set α} :
    Sup s ⊓ Sup t =
        supr fun (p : α × α) => supr fun (H : p ∈ set.prod s t) => prod.fst p ⊓ prod.snd p :=
  sorry

protected instance complete_distrib_lattice.bounded_distrib_lattice {α : Type u}
    [d : complete_distrib_lattice α] : bounded_distrib_lattice α :=
  bounded_distrib_lattice.mk complete_distrib_lattice.sup complete_distrib_lattice.le
    complete_distrib_lattice.lt complete_distrib_lattice.le_refl complete_distrib_lattice.le_trans
    complete_distrib_lattice.le_antisymm complete_distrib_lattice.le_sup_left
    complete_distrib_lattice.le_sup_right complete_distrib_lattice.sup_le
    complete_distrib_lattice.inf complete_distrib_lattice.inf_le_left
    complete_distrib_lattice.inf_le_right complete_distrib_lattice.le_inf sorry
    complete_distrib_lattice.top complete_distrib_lattice.le_top complete_distrib_lattice.bot
    complete_distrib_lattice.bot_le

/-- A complete boolean algebra is a completely distributive boolean algebra. -/
class complete_boolean_algebra (α : Type u_1) extends boolean_algebra α, complete_distrib_lattice α
    where

theorem compl_infi {α : Type u} {ι : Sort w} [complete_boolean_algebra α] {f : ι → α} :
    infi fᶜ = supr fun (i : ι) => f iᶜ :=
  le_antisymm
    (compl_le_of_compl_le (le_infi fun (i : ι) => compl_le_of_compl_le (le_supr (compl ∘ f) i)))
    (supr_le fun (i : ι) => compl_le_compl (infi_le f i))

theorem compl_supr {α : Type u} {ι : Sort w} [complete_boolean_algebra α] {f : ι → α} :
    supr fᶜ = infi fun (i : ι) => f iᶜ :=
  sorry

theorem compl_Inf {α : Type u} [complete_boolean_algebra α] {s : set α} :
    Inf sᶜ = supr fun (i : α) => supr fun (H : i ∈ s) => iᶜ :=
  sorry

theorem compl_Sup {α : Type u} [complete_boolean_algebra α] {s : set α} :
    Sup sᶜ = infi fun (i : α) => infi fun (H : i ∈ s) => iᶜ :=
  sorry

end Mathlib