import category_theory.limits.shapes.products
import for_mathlib.Profinite.compat_discrete_quotient
import topology.category.Profinite
import for_mathlib.quotient_map
import category_theory.limits.shapes.finite_limits

/-!

In this file we show that a finite disjoint union of profinite sets agrees with the coproduct.
*Note:* The existence of the coproduct is currently shown using some abstract nonsense.

-/

namespace Profinite

universe u
variables {α : Type u} [fintype α] (X : α → Profinite.{u})

def empty : Profinite.{u} := Profinite.of pempty
def empty.elim (X : Profinite.{u}) : empty ⟶ X :=  { to_fun := pempty.elim }

def sum (X Y : Profinite.{u}) : Profinite.{u} :=
Profinite.of $ X ⊕ Y

def sum.inl (X Y : Profinite.{u}) : X ⟶ sum X Y :=
{ to_fun := _root_.sum.inl }

def sum.inr (X Y : Profinite.{u}) : Y ⟶ sum X Y :=
{ to_fun := _root_.sum.inr }

def sum.desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) : sum X Y ⟶ Z :=
{ to_fun := λ x, _root_.sum.rec_on x f g,
  continuous_to_fun := begin
    simp only [continuous_sup_dom, continuous_coinduced_dom],
    exact ⟨f.continuous, g.continuous⟩
  end }

@[simp, reassoc]
lemma sum.inl_desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inl X Y ≫ sum.desc X Y f g = f := by { ext, refl }

@[simp, reassoc]
lemma sum.inr_desc {Z} (X Y : Profinite.{u}) (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inr X Y ≫ sum.desc X Y f g = g := by { ext, refl }

lemma sum.hom_ext {Z} (X Y : Profinite.{u}) (e₁ e₂ : sum X Y ⟶ Z)
  (hl : sum.inl X Y ≫ e₁ = sum.inl X Y ≫ e₂) (hr : sum.inr X Y ≫ e₁ = sum.inr X Y ≫ e₂) :
  e₁ = e₂ :=
begin
  ext (u|u),
  { apply_fun (λ e, e u) at hl, exact hl },
  { apply_fun (λ e, e u) at hr, exact hr },
end

def sigma : Profinite.{u} :=
Profinite.of $ Σ a, X a

def sigma.ι (a : α) : X a ⟶ sigma X :=
{ to_fun := λ t, ⟨_,t⟩,
  continuous_to_fun := begin
    apply continuous_Sup_rng,
    exact ⟨a,rfl⟩,
    apply continuous_coinduced_rng,
  end }

lemma sigma.ι_injective (a : α) : function.injective (sigma.ι X a) :=
by { dsimp [sigma.ι], exact sigma_mk_injective }

lemma sigma.ι_jointly_surjective (t : sigma X) : ∃ a (x : X a), sigma.ι X a x = t :=
by { rcases t with ⟨a,t⟩, exact ⟨a,t,rfl⟩ }

def sigma.desc {Y} (f : Π a, X a ⟶ Y) : sigma X ⟶ Y :=
{ to_fun := λ ⟨a,t⟩, f a t,
  continuous_to_fun := begin
    rw continuous_Sup_dom,
    rintros _ ⟨a,rfl⟩,
    resetI,
    rw continuous_coinduced_dom,
    exact (f a).continuous
  end }

lemma sigma.desc_surjective {Y} (f : Π a, X a ⟶ Y) (surj : ∀ y, ∃ a (x : X a), f a x = y) :
  function.surjective (sigma.desc X f) :=
begin
  intros y,
  obtain ⟨a,x,hx⟩ := surj y,
  exact ⟨⟨a,x⟩,hx⟩,
end

@[simp, reassoc]
lemma sigma.ι_desc {Y} (a) (f : Π a, X a ⟶ Y) : sigma.ι X a ≫ sigma.desc X f = f a :=
by { ext, refl }

lemma sigma.hom_ext {Y} (f g : sigma X ⟶ Y) (w : ∀ a, sigma.ι X a ≫ f = sigma.ι X a ≫ g) :
  f = g :=
begin
  ext ⟨a,t⟩,
  specialize w a,
  apply_fun (λ e, e t) at w,
  exact w,
end

open category_theory

def sigma_cofan : limits.cofan X :=
limits.cofan.mk (sigma X) (sigma.ι X)

def sigma_cofan_is_colimit : limits.is_colimit (sigma_cofan X) :=
{ desc := λ S, sigma.desc _ $ λ a, S.ι.app ⟨a⟩,
  fac' := begin
    rintros S ⟨j⟩,
    ext t,
    refl,
  end,
  uniq' := begin
    intros S m h,
    apply sigma.hom_ext,
    intros a,
    convert h ⟨a⟩,
    simp,
  end }

def pullback {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) : Profinite :=
{ to_CompHaus :=
  { to_Top := Top.of { a : X × Y | f a.1 = g a.2 },
    is_compact := begin
      erw ← is_compact_iff_compact_space,
      apply is_closed.is_compact,
      apply is_closed_eq,
      all_goals { continuity },
    end,
    is_hausdorff := begin
      change t2_space { a : X × Y | f a.1 = g a.2 },
      apply_instance
    end },
  is_totally_disconnected := subtype.totally_disconnected_space }

def pullback.fst {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback f g ⟶ X := { to_fun := λ a, a.1.1 }

def pullback.snd {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback f g ⟶ Y := { to_fun := λ a, a.1.2 }

@[reassoc]
lemma pullback.condition {X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) :
  pullback.fst f g ≫ f = pullback.snd f g ≫ g := by { ext ⟨t,ht⟩, exact ht }

def pullback.lift {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) : W ⟶ pullback f g :=
{ to_fun := λ t, ⟨(e₁ t, e₂ t), by { apply_fun (λ ee, ee t) at w, exact w }⟩ }

@[simp, reassoc]
lemma pullback.lift_fst {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) :
  pullback.lift f g e₁ e₂ w ≫ pullback.fst f g = e₁ := by { ext, refl }

@[simp, reassoc]
lemma pullback.lift_snd {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B)
  (e₁ : W ⟶ X) (e₂ : W ⟶ Y) (w : e₁ ≫ f = e₂ ≫ g) :
  pullback.lift f g e₁ e₂ w ≫ pullback.snd f g = e₂ := by { ext, refl }

lemma pullback.hom_ext {W X Y B : Profinite.{u}} (f : X ⟶ B) (g : Y ⟶ B) (e₁ e₂ : W ⟶ pullback f g)
  (w₁ : e₁ ≫ pullback.fst f g = e₂ ≫ pullback.fst f g)
  (w₂ : e₁ ≫ pullback.snd f g = e₂ ≫ pullback.snd f g) : e₁ = e₂ :=
begin
  ext t,
  { apply_fun (λ e, e t) at w₁, exact w₁ },
  { apply_fun (λ e, e t) at w₂, exact w₂ },
end

def sigma_pullback_to_pullback_sigma {B} (f : Π a, X a ⟶ B) :
  sigma (λ a : α × α, pullback (f a.1) (f a.2)) ⟶ pullback (sigma.desc X f) (sigma.desc X f) :=
sigma.desc _ $ λ a, pullback.lift _ _
  (pullback.fst _ _ ≫ sigma.ι _ _) (pullback.snd _ _ ≫ sigma.ι _ _) begin
    cases a, dsimp at *, ext1 x, cases x, assumption,
  end

instance {B} (f : Π a, X a ⟶ B) : is_iso (sigma_pullback_to_pullback_sigma X f) :=
is_iso_of_bijective _
begin
  split,
  { rintros ⟨⟨a,b⟩,⟨⟨x₁,x₂⟩,hx⟩⟩ ⟨⟨a',b'⟩,⟨⟨x'₁,x'₂⟩,hx'⟩⟩ h,
    dsimp [sigma_pullback_to_pullback_sigma, sigma.desc, pullback.lift,
      sigma.ι, pullback.fst, pullback.snd] at *,
    tidy },
  { rintros ⟨⟨⟨a,x⟩,⟨b,y⟩⟩,h⟩,
    refine ⟨⟨⟨a,b⟩,⟨⟨x,y⟩,h⟩⟩,rfl⟩ }
end

@[simp]
lemma sigma_pullback_to_pullback_sigma_fst {B} (f : Π a, X a ⟶ B) :
  sigma_pullback_to_pullback_sigma X f ≫ pullback.fst _ _ =
  sigma.desc _ (λ a, pullback.fst _ _ ≫ sigma.ι _ a.1) := by ext ⟨_,_⟩; refl

@[simp]
lemma sigma_pullback_to_pullback_sigma_snd {B} (f : Π a, X a ⟶ B) :
  sigma_pullback_to_pullback_sigma X f ≫ pullback.snd _ _ =
  sigma.desc _ (λ a, pullback.snd _ _ ≫ sigma.ι _ a.2) := by ext ⟨_,_⟩; refl

lemma sigma_iso_of_equiv_aux
  {α β : Type u}
  [fintype α]
  [fintype β]
  (e : α ≃ β)
  (X : β → Profinite.{u})
  (b : β)
  (h : b = (e ((e.symm) b))) :
  eq_to_hom (by rw h) ≫ sigma.ι _ _ = sigma.ι X b :=
begin
  induction h,
  simp,
end

def sigma_iso_of_equiv {α β : Type u} [fintype α] [fintype β] (e : α ≃ β)
  (X : β → Profinite.{u}) :
  sigma (X ∘ e) ≅ sigma X :=
{ hom := sigma.desc _ $ λ a, sigma.ι _ (e a),
  inv := sigma.desc _ $ λ b, eq_to_hom (by simp) ≫ sigma.ι _ (e.symm b),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    intros a,
    dsimp,
    simp only [sigma.ι_desc_assoc, sigma.ι_desc, category.comp_id],
    apply sigma_iso_of_equiv_aux,
    simp,
  end,
  inv_hom_id' := begin
    apply sigma.hom_ext,
    intros b,
    dsimp,
    simp only [sigma.ι_desc_assoc, category.assoc, sigma.ι_desc, category.comp_id],
    apply sigma_iso_of_equiv_aux,
    simp,
  end }

def sigma_iso_empty : sigma pempty.elim ≅ empty :=
{ hom := sigma.desc _ $ λ a, a.elim,
  inv := empty.elim _,
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros ⟨⟩
  end,
  inv_hom_id' := begin
    ext ⟨⟩
  end }

-- fin_zero_elim is terrible!
def sigma_iso_empty' (X : (pempty : Type u) → Profinite.{u}) : sigma X ≅ (empty : Profinite.{u}) :=
{ hom := sigma.desc _ $ λ i, i.elim,
  inv := empty.elim _,
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros ⟨⟩,
  end,
  inv_hom_id' := by { ext ⟨⟩ } }

def sigma_sum_iso {α β : Type u} [fintype α] [fintype β]
  (X : α → Profinite.{u}) (Y : β → Profinite.{u}) :
  sigma (λ (x : α ⊕ β), sum.rec_on x X Y) ≅ sum (sigma X) (sigma Y) :=
{ hom := sigma.desc _ $ λ x, sum.rec_on x
    (λ a, by { dsimp, exact sigma.ι _ _ } ≫ Profinite.sum.inl _ _)
    (λ b, by { dsimp, exact sigma.ι _ _ } ≫ Profinite.sum.inr _ _),
  inv := sum.desc _ _
    (sigma.desc _ $ λ a, begin
        refine _ ≫ sigma.ι _ (_root_.sum.inl a),
        exact 𝟙 _
      end)
    (sigma.desc _ $ λ b, begin
        refine _ ≫ sigma.ι _ (_root_.sum.inr b),
        exact 𝟙 _
    end),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (a|b),
    all_goals { dsimp, simp }
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals
    { dsimp,
      simp,
      apply sigma.hom_ext,
      intros,
      simp },
  end }

def sigma_sum_iso' {α β : Type u} [fintype α] [fintype β]
  (X : α ⊕ β → Profinite.{u}) :
  sigma X ≅ sum (sigma (X ∘ _root_.sum.inl)) (sigma (X ∘ _root_.sum.inr)) :=
{ hom := sigma.desc _ $ λ x, sum.rec_on x (λ a, begin
    exact sigma.ι (X ∘ _root_.sum.inl) a,
  end ≫ sum.inl _ _) (λ b, begin
    exact sigma.ι (X ∘ _root_.sum.inr) b
  end ≫ sum.inr _ _),
  inv := sum.desc _ _ (sigma.desc _ $ λ a, sigma.ι _ _) (sigma.desc _ $ λ b, sigma.ι _ _),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (a|b),
    all_goals { dsimp, simp },
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals
    { dsimp,
      simp,
      apply sigma.hom_ext,
      intros, simp }
  end }

def sigma_punit_iso (X : (punit : Type u) → Profinite.{u}) :
  X punit.star ≅ sigma X :=
{ hom := sigma.ι _ _,
  inv := sigma.desc _ $ λ ⟨⟩, 𝟙 _ }

def sigma_walking_pair_iso (X : ulift.{u} limits.walking_pair → Profinite.{u}) :
  sigma X ≅ (X ⟨limits.walking_pair.left⟩).sum (X ⟨limits.walking_pair.right⟩) :=
{ hom := sigma.desc _ $ λ a,
  match a with
  | ⟨a⟩ := limits.walking_pair.rec_on a (sum.inl _ _) (sum.inr _ _)
  end,
  inv := sum.desc _ _ (sigma.ι X (ulift.up _)) (sigma.ι X (ulift.up _)),
  hom_inv_id' := begin
    apply sigma.hom_ext,
    rintros (⟨a⟩|⟨b⟩),
    all_goals { dsimp, simp only [sigma.ι_desc_assoc, category.comp_id],
      dsimp [sigma_walking_pair_iso._match_1],
      simp only [sum.inl_desc, sum.inr_desc] },
  end,
  inv_hom_id' := begin
    apply sum.hom_ext,
    all_goals { dsimp, simpa only [sum.inl_desc_assoc, sigma.ι_desc, category.comp_id] },
  end }

--TODO: Finish off the api for the explicit pullback

def equalizer {X Y : Profinite.{u}} (f g : X ⟶ Y) : Profinite :=
{ to_CompHaus :=
  { to_Top := Top.of { x | f x = g x },
    is_compact := begin
      erw ← is_compact_iff_compact_space,
      apply is_closed.is_compact,
      apply is_closed_eq,
      exact f.continuous,
      exact g.continuous
    end,
    is_hausdorff := begin
      change t2_space { x | f x = g x },
      apply_instance
    end },
  is_totally_disconnected := subtype.totally_disconnected_space }

def equalizer.ι {X Y : Profinite.{u}} (f g : X ⟶ Y) : equalizer f g ⟶ X := { to_fun := λ x, x.1 }

def equalizer.lift {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e : W ⟶ X) (w : e ≫ f = e ≫ g) :
  W ⟶ equalizer f g :=
{ to_fun := λ t, ⟨e t, by { apply_fun (λ ee, ee t) at w, exact w }⟩ }

@[simp, reassoc]
lemma equalizer.lift_ι {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e : W ⟶ X)
  (w : e ≫ f = e ≫ g) : equalizer.lift f g e w ≫ equalizer.ι f g = e := by { ext, refl }

lemma equalizer.hom_ext {W X Y : Profinite.{u}} (f g : X ⟶ Y) (e₁ e₂ : W ⟶ equalizer f g)
  (w : e₁ ≫ equalizer.ι f g = e₂ ≫ equalizer.ι f g) : e₁ = e₂ :=
begin
  ext t,
  apply_fun (λ ee, ee t) at w,
  exact w,
end

/-- Descend a morphism along a surjective morphism. -/
noncomputable
def descend {X B Y : Profinite} (π : X ⟶ B) (t : X ⟶ Y) (hπ : function.surjective π)
  (w : pullback.fst π π ≫ t = pullback.snd π π ≫ t) : B ⟶ Y :=
{ to_fun := (λ i, quotient.lift_on' i t begin
    rintros a b (h : π _ = π _),
    apply_fun (λ e, e ⟨(a,b),h⟩) at w,
    exact w,
  end : quotient (setoid.ker π) → Y) ∘ (Profinite.quotient_map π hπ).homeomorph.symm,
  continuous_to_fun := begin
    apply continuous.comp,
    { apply continuous_quot_lift, exact t.continuous },
    { exact (quotient_map π hπ).homeomorph.symm.continuous }
  end }

-- TODO: Define `foo_to_Top` analogues for the colimit-like constructions above.
noncomputable
def descend_to_Top {X B : Profinite} {Y : Top} (π : X ⟶ B) (t : Profinite.to_Top.obj X ⟶ Y)
  (hπ : function.surjective π)
  (w : Profinite.to_Top.map (pullback.fst π π) ≫ t =
    Profinite.to_Top.map (pullback.snd π π) ≫ t) : Profinite.to_Top.obj B ⟶ Y :=
{ to_fun := (λ i, quotient.lift_on' i t begin
    rintros a b (h : π _ = π _),
    apply_fun (λ e, e ⟨(a,b),h⟩) at w,
    exact w,
  end : quotient (setoid.ker π) → Y) ∘ (Profinite.quotient_map π hπ).homeomorph.symm,
  continuous_to_fun := begin
    apply continuous.comp,
    { apply continuous_quot_lift, exact t.continuous },
    { exact (quotient_map π hπ).homeomorph.symm.continuous }
  end }

@[simp]
lemma π_descend {X B Y : Profinite} (π : X ⟶ B) (t : X ⟶ Y) (hπ : function.surjective π)
  (w : pullback.fst π π ≫ t = pullback.snd π π ≫ t) :
  π ≫ descend π t hπ w = t :=
begin
  ext i,
  dsimp [descend, setoid.quotient_ker_equiv_of_surjective,
    setoid.quotient_ker_equiv_of_right_inverse, quotient_map.homeomorph],
  let c : pullback π π := ⟨(function.surj_inv hπ (π i), i), function.surj_inv_eq hπ (π i)⟩,
  apply_fun (λ e, e c) at w,
  exact w,
end

lemma π_descend_to_Top {X B : Profinite} {Y : Top} (π : X ⟶ B) (t : Profinite.to_Top.obj X ⟶ Y)
  (hπ : function.surjective π)
  (w : Profinite.to_Top.map (pullback.fst π π) ≫ t =
    Profinite.to_Top.map (pullback.snd π π) ≫ t) :
  Profinite.to_Top.map π ≫ descend_to_Top π t hπ w = t :=
begin
  ext i,
  dsimp [descend_to_Top, setoid.quotient_ker_equiv_of_surjective,
    setoid.quotient_ker_equiv_of_right_inverse, quotient_map.homeomorph],
  let c : pullback π π := ⟨(function.surj_inv hπ (π i), i), function.surj_inv_eq hπ (π i)⟩,
  apply_fun (λ e, e c) at w,
  exact w,
end

def product {α : Type} (X : α → Profinite.{u}) : Profinite :=
  Profinite.of $ Π a, X a

def product.π {α : Type} (X : α → Profinite.{u}) (a : α) :
  product X ⟶ X a := ⟨λ t, t a, continuous_apply _⟩

def product.lift {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f : Π a, Y ⟶ X a) : Y ⟶ product X :=
⟨λ y a, f a y, begin
  apply continuous_pi,
  intros i,
  exact (f i).2,
end⟩

@[simp, reassoc]
lemma product.lift_π {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f : Π a, Y ⟶ X a) (a) : product.lift X f ≫ product.π X a = f _ := by { ext, refl }

lemma product.hom_ext {α : Type} {Y : Profinite.{u}} (X : α → Profinite.{u})
  (f g : Y ⟶ product X) (h : ∀ a, f ≫ product.π X a = g ≫ product.π X a) : f = g :=
begin
  ext y a,
  specialize h a,
  apply_fun (λ e, e y) at h,
  exact h,
end

def punit : Profinite.{u} := Profinite.of punit

def punit.elim (X : Profinite.{u}) : X ⟶ punit :=
⟨λ x, punit.star, by tidy⟩

lemma punit.hom_ext (X : Profinite.{u}) (f g : X ⟶ punit) : f = g :=
by ext

def from_punit {X : Profinite.{u}} (x : X) : punit ⟶ X :=
⟨λ _, x, by tidy⟩

def pow (X : Profinite.{u}) (n : ℕ) : Profinite.{u} :=
Profinite.product (λ i : fin n, X)

def map_pow {X Y : Profinite.{u}} (f : X ⟶ Y) (n : ℕ) :
  X.pow n ⟶ Y.pow n :=
Profinite.product.lift _ $ λ n, Profinite.product.π _ n ≫ f

end Profinite


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.instances.ennreal
import Mathlib.PostPort

universes u u_1 u_2 u_3

namespace Mathlib

/-!
# Probability mass functions

This file is about probability mass functions or discrete probability measures:
a function `α → ℝ≥0` such that the values have (infinite) sum `1`.

This file features the monadic structure of `pmf` and the Bernoulli distribution

## Implementation Notes

This file is not yet connected to the `measure_theory` library in any way.
At some point we need to define a `measure` from a `pmf` and prove the appropriate lemmas about
that.

## Tags

probability mass function, discrete probability measure, bernoulli distribution
-/

/-- A probability mass function, or discrete probability measures is a function `α → ℝ≥0` such that
  the values have (infinite) sum `1`. -/
def pmf (α : Type u) := Subtype fun (f : α → nnreal) => has_sum f 1

namespace pmf

protected instance has_coe_to_fun {α : Type u_1} : has_coe_to_fun (pmf α) :=
  has_coe_to_fun.mk (fun (p : pmf α) => α → nnreal) fun (p : pmf α) (a : α) => subtype.val p a

protected theorem ext {α : Type u_1} {p : pmf α} {q : pmf α} :
    (∀ (a : α), coe_fn p a = coe_fn q a) → p = q :=
  sorry

theorem has_sum_coe_one {α : Type u_1} (p : pmf α) : has_sum (⇑p) 1 := subtype.property p

theorem summable_coe {α : Type u_1} (p : pmf α) : summable ⇑p :=
  has_sum.summable (has_sum_coe_one p)

@[simp] theorem tsum_coe {α : Type u_1} (p : pmf α) : (tsum fun (a : α) => coe_fn p a) = 1 :=
  has_sum.tsum_eq (has_sum_coe_one p)

/-- The support of a `pmf` is the set where it is nonzero. -/
def support {α : Type u_1} (p : pmf α) : set α := set_of fun (a : α) => subtype.val p a ≠ 0

/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
def pure {α : Type u_1} (a : α) : pmf α :=
  { val := fun (a' : α) => ite (a' = a) 1 0, property := sorry }

@[simp] theorem pure_apply {α : Type u_1} (a : α) (a' : α) :
    coe_fn (pure a) a' = ite (a' = a) 1 0 :=
  rfl

protected instance inhabited {α : Type u_1} [Inhabited α] : Inhabited (pmf α) :=
  { default := pure Inhabited.default }

theorem coe_le_one {α : Type u_1} (p : pmf α) (a : α) : coe_fn p a ≤ 1 := sorry

protected theorem bind.summable {α : Type u_1} {β : Type u_2} (p : pmf α) (f : α → pmf β) (b : β) :
    summable fun (a : α) => coe_fn p a * coe_fn (f a) b :=
  sorry

/-- The monadic bind operation for `pmf`. -/
def bind {α : Type u_1} {β : Type u_2} (p : pmf α) (f : α → pmf β) : pmf β :=
  { val := fun (b : β) => tsum fun (a : α) => coe_fn p a * coe_fn (f a) b, property := sorry }

@[simp] theorem bind_apply {α : Type u_1} {β : Type u_2} (p : pmf α) (f : α → pmf β) (b : β) :
    coe_fn (bind p f) b = tsum fun (a : α) => coe_fn p a * coe_fn (f a) b :=
  rfl

theorem coe_bind_apply {α : Type u_1} {β : Type u_2} (p : pmf α) (f : α → pmf β) (b : β) :
    ↑(coe_fn (bind p f) b) = tsum fun (a : α) => ↑(coe_fn p a) * ↑(coe_fn (f a) b) :=
  sorry

@[simp] theorem pure_bind {α : Type u_1} {β : Type u_2} (a : α) (f : α → pmf β) :
    bind (pure a) f = f a :=
  sorry

@[simp] theorem bind_pure {α : Type u_1} (p : pmf α) : bind p pure = p := sorry

@[simp] theorem bind_bind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (p : pmf α) (f : α → pmf β)
    (g : β → pmf γ) : bind (bind p f) g = bind p fun (a : α) => bind (f a) g :=
  sorry

theorem bind_comm {α : Type u_1} {β : Type u_2} {γ : Type u_3} (p : pmf α) (q : pmf β)
    (f : α → β → pmf γ) :
    (bind p fun (a : α) => bind q (f a)) = bind q fun (b : β) => bind p fun (a : α) => f a b :=
  sorry

/-- The functorial action of a function on a `pmf`. -/
def map {α : Type u_1} {β : Type u_2} (f : α → β) (p : pmf α) : pmf β := bind p (pure ∘ f)

theorem bind_pure_comp {α : Type u_1} {β : Type u_2} (f : α → β) (p : pmf α) :
    bind p (pure ∘ f) = map f p :=
  rfl

theorem map_id {α : Type u_1} (p : pmf α) : map id p = p := sorry

theorem map_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (p : pmf α) (f : α → β) (g : β → γ) :
    map g (map f p) = map (g ∘ f) p :=
  sorry

theorem pure_map {α : Type u_1} {β : Type u_2} (a : α) (f : α → β) : map f (pure a) = pure (f a) :=
  sorry

/-- The monadic sequencing operation for `pmf`. -/
def seq {α : Type u_1} {β : Type u_2} (f : pmf (α → β)) (p : pmf α) : pmf β :=
  bind f fun (m : α → β) => bind p fun (a : α) => pure (m a)

/-- Given a non-empty multiset `s` we construct the `pmf` which sends `a` to the fraction of
  elements in `s` that are `a`. -/
def of_multiset {α : Type u_1} (s : multiset α) (hs : s ≠ 0) : pmf α :=
  { val := fun (a : α) => ↑(multiset.count a s) / ↑(coe_fn multiset.card s), property := sorry }

/-- Given a finite type `α` and a function `f : α → ℝ≥0` with sum 1, we get a `pmf`. -/
def of_fintype {α : Type u_1} [fintype α] (f : α → nnreal)
    (h : (finset.sum finset.univ fun (x : α) => f x) = 1) : pmf α :=
  { val := f, property := sorry }

/-- A `pmf` which assigns probability `p` to `tt` and `1 - p` to `ff`. -/
def bernoulli (p : nnreal) (h : p ≤ 1) : pmf Bool :=
  of_fintype (fun (b : Bool) => cond b p (1 - p)) sorry

end Mathlib


import Std.Data.AssocList
import Std.Data.List.Lemmas

namespace MWE5

abbrev Strings := List String
abbrev Sups := Std.AssocList String Strings
instance : Repr Sups where reprPrec s n := s.toList.repr n

structure State where
  declarations: Std.AssocList String Strings := .nil
  deriving Repr

def State.empty: State := {}

-- all declaration values must be declaration keys
def State.wff: State → Bool :=
  fun s => s.declarations.all
    fun (_ sups) => sups.all
      fun sup => s.declarations.contains sup

def State.withDeclaration (s: State) (d: String) : State :=
  match s.declarations.contains d with
  | true => s
  | false => { s with declarations := s.declarations.cons d .nil }

theorem State.withDeclaration.noChange (s: State) (d: String) (h: s.declarations.contains d)
: s = s.withDeclaration d
:= by rw [State.withDeclaration, h]

theorem State.withDeclaration.added1 (s: State) (d: String) (h: !s.declarations.contains d)
: (s.withDeclaration d).declarations.contains d
:= by
  rw [State.withDeclaration] at *
  simp_all

theorem State.withDeclaration.added2 (s: State) (d: String) (h: !s.declarations.contains d)
: (s.withDeclaration d).declarations.find? d = some []
:= by
  rw [State.withDeclaration] at *
  simp_all

theorem State.withDeclaration.added3 (s: State) (d: String)
: (s.withDeclaration d).declarations.contains d
:= by
  simp [State.withDeclaration]
  split <;> simp
  next x heq => simp_all

theorem State.withDeclaration.wff (s: State) (d: String) (h: s.wff)
: (s.withDeclaration d).wff
:= by
  simp [State.wff, State.withDeclaration] at h ⊢
  intro (s1, ss)
  split <;> simp
  . apply h
  · rintro (⟨rfl, rfl⟩ | h' )
    . intro.
    . exact fun x hs => .inr (h _ h' x hs)

def addBoth : (Std.AssocList String Strings) → String → String → (Std.AssocList String Strings)
| .nil, sub, sup            => .cons sup [] (.cons sub [sup] .nil)
| .cons a as tail, sub, sup => bif a == sub then .cons sub (as.insert sup) tail else .cons a as (addBoth tail sub sup)

theorem addBoth.nil (sub: String) (sup: String)
: (addBoth .nil sub sup).contains sub && (addBoth .nil sub sup).contains sup
:= by simp [addBoth]

--set_option pp.explicit true
theorem addBoth.added (ss: Std.AssocList String Strings) (sub: String) (sup: String)
: (addBoth ss sub sup).contains sub && (addBoth ss sub sup).contains sup
:= by {
  induction ss
  case nil => {
    simp [addBoth]
  }
  case cons key value tail tail_ih => {
    simp [Std.AssocList.contains] at *
    induction tail
    case nil =>
      simp [addBoth]
      apply And.intro <;>simp_all
    case cons =>
      apply And.intro
      case left => {
        simp [addBoth]
        simp_all
        simp [*]

      }
      case right => {
        induction tail <;> simp [addBoth]

      }
  }
  done
}

theorem addBoth.sub.more (ss: Std.AssocList String Strings) (sub: String) (sup: String) (key: String) (value: Strings)
: (addBoth ss sub sup).contains sub → (addBoth (ss.cons key value) sub sup).contains sub
:= by {
  simp [Std.AssocList.contains, addBoth]
  intro x h fst
  apply Exists.elim
  --induction ss

}

theorem addBoth.sub (ss: Std.AssocList String Strings) (sub: String) (sup: String)
: (addBoth ss sub sup).contains sub
:= by {
  simp [Std.AssocList.contains]
  induction ss
  case nil =>
    simp [addBoth]
  case cons key value tail tail_ih =>
    simp [addBoth]

}

def State.withSpecialization (s: State) (sub: String) (sup: String): State :=
  { declarations := addBoth s.declarations sub sup }

--set_option pp.explicit true

theorem State.withSpecialization.added1 (s: State) (sub: String) (sup: String)
: (s.withSpecialization sub sup).declarations.contains sub && (s.withSpecialization sub sup).declarations.contains sup
:= by {
  have h := s.withSpecialization sub sup
  simp [State.withSpecialization]
  apply And.intro
  case left => {

  }
  case right => {

  }
}

theorem State.withSpecialization.noChange (s: State) (sub: String) (sup: String)
(h1: s.declarations.contains sub)
(h2: s.declarations.contains sup)
(h3: (s.declarations.find? sub).all (fun sups => sups.contains sup))
: s = s.withSpecialization sub sup
:= by
  --unfold State.withSpecialization State.withDeclaration at *
  simp [State.withSpecialization, State.withDeclaration] at *
  simp_all
  apply h3
  sorry

theorem State.withSpecialization.added2 (s: State) (sub: String) (sup: String)
(h1: !s.declarations.contains sub)
(h2: !s.declarations.contains sup)
: (s.withSpecialization sub sup).declarations.contains sub &&
  (s.withSpecialization sub sup).declarations.contains sup
:= by
  simp [State.withSpecialization, State.withDeclaration] at *
  apply And.intro
  .

  simp [Std.AssocList.contains, List.any, List.replaceF] at *
  simp_all
  apply And.intro
  sorry

theorem State.withSpecialization.wff (s: State) (sub: String) (sup: String)
: s.wff → (s.withSpecialization sub sup).wff
:= by
  simp [State.wff, State.withSpecialization, State.withDeclaration] at *
  intro h
  simp [*] at *
  sorry

def s0 : State := State.empty |>.withSpecialization "a" "b"
#eval s0

end MWE5


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pi
import Mathlib.tactic.pi_instances
import Mathlib.algebra.group.defs
import Mathlib.algebra.group.hom
import Mathlib.PostPort

universes u v u_1 u_2 u_3

namespace Mathlib

/-!
# Pi instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on Pi types.
-/

namespace pi

protected instance semigroup {I : Type u} {f : I → Type v} [(i : I) → semigroup (f i)] :
    semigroup ((i : I) → f i) :=
  semigroup.mk Mul.mul sorry

protected instance add_comm_semigroup {I : Type u} {f : I → Type v}
    [(i : I) → add_comm_semigroup (f i)] : add_comm_semigroup ((i : I) → f i) :=
  add_comm_semigroup.mk Add.add sorry sorry

protected instance monoid {I : Type u} {f : I → Type v} [(i : I) → monoid (f i)] :
    monoid ((i : I) → f i) :=
  monoid.mk Mul.mul sorry 1 sorry sorry

protected instance add_comm_monoid {I : Type u} {f : I → Type v} [(i : I) → add_comm_monoid (f i)] :
    add_comm_monoid ((i : I) → f i) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance sub_neg_add_monoid {I : Type u} {f : I → Type v}
    [(i : I) → sub_neg_monoid (f i)] : sub_neg_monoid ((i : I) → f i) :=
  sub_neg_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry Neg.neg Sub.sub

protected instance group {I : Type u} {f : I → Type v} [(i : I) → group (f i)] :
    group ((i : I) → f i) :=
  group.mk Mul.mul sorry 1 sorry sorry has_inv.inv Div.div sorry

protected instance comm_group {I : Type u} {f : I → Type v} [(i : I) → comm_group (f i)] :
    comm_group ((i : I) → f i) :=
  comm_group.mk Mul.mul sorry 1 sorry sorry has_inv.inv Div.div sorry sorry

protected instance left_cancel_semigroup {I : Type u} {f : I → Type v}
    [(i : I) → left_cancel_semigroup (f i)] : left_cancel_semigroup ((i : I) → f i) :=
  left_cancel_semigroup.mk Mul.mul sorry sorry

protected instance right_cancel_semigroup {I : Type u} {f : I → Type v}
    [(i : I) → right_cancel_semigroup (f i)] : right_cancel_semigroup ((i : I) → f i) :=
  right_cancel_semigroup.mk Mul.mul sorry sorry

protected instance mul_zero_class {I : Type u} {f : I → Type v} [(i : I) → mul_zero_class (f i)] :
    mul_zero_class ((i : I) → f i) :=
  mul_zero_class.mk Mul.mul 0 sorry sorry

protected instance comm_monoid_with_zero {I : Type u} {f : I → Type v}
    [(i : I) → comm_monoid_with_zero (f i)] : comm_monoid_with_zero ((i : I) → f i) :=
  comm_monoid_with_zero.mk Mul.mul sorry 1 sorry sorry sorry 0 sorry sorry

@[simp] theorem const_zero {α : Type u_1} {β : Type u_2} [HasZero β] : function.const α 0 = 0 := rfl

@[simp] theorem comp_one {α : Type u_1} {β : Type u_2} {γ : Type u_3} [HasOne β] {f : β → γ} :
    f ∘ 1 = function.const α (f 1) :=
  rfl

@[simp] theorem one_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [HasOne γ] {f : α → β} :
    1 ∘ f = 1 :=
  rfl

end pi

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism. -/
def add_monoid_hom.apply {I : Type u} (f : I → Type v) [(i : I) → add_monoid (f i)] (i : I) :
    ((i : I) → f i) →+ f i :=
  add_monoid_hom.mk (fun (g : (i : I) → f i) => g i) sorry sorry

@[simp] theorem add_monoid_hom.apply_apply {I : Type u} (f : I → Type v)
    [(i : I) → add_monoid (f i)] (i : I) (g : (i : I) → f i) :
    coe_fn (add_monoid_hom.apply f i) g = g i :=
  rfl

/-- Coercion of a `monoid_hom` into a function is itself a `monoid_hom`.

See also `monoid_hom.eval`. -/
@[simp] theorem monoid_hom.coe_fn_apply (α : Type u_1) (β : Type u_2) [monoid α] [comm_monoid β]
    (g : α →* β) : ∀ (ᾰ : α), coe_fn (monoid_hom.coe_fn α β) g ᾰ = coe_fn g ᾰ :=
  fun (ᾰ : α) => Eq.refl (coe_fn (monoid_hom.coe_fn α β) g ᾰ)

/-- The additive monoid homomorphism including a single additive monoid
into a dependent family of additive monoids, as functions supported at a point. -/
def add_monoid_hom.single {I : Type u} (f : I → Type v) [DecidableEq I] [(i : I) → add_monoid (f i)]
    (i : I) : f i →+ (i : I) → f i :=
  add_monoid_hom.mk (fun (x : f i) => pi.single i x) sorry sorry

@[simp] theorem add_monoid_hom.single_apply {I : Type u} (f : I → Type v) [DecidableEq I]
    [(i : I) → add_monoid (f i)] {i : I} (x : f i) :
    coe_fn (add_monoid_hom.single f i) x = pi.single i x :=
  rfl

end Mathlib


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

! This file was ported from Lean 3 source module data.set.Union_lift
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Lattice
import Mathbin.Order.Directed

/-!
# Union lift

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
This file defines `set.Union_lift` to glue together functions defined on each of a collection of
sets to make a function on the Union of those sets.

## Main definitions

* `set.Union_lift` -  Given a Union of sets `Union S`, define a function on any subset of the Union
  by defining it on each component, and proving that it agrees on the intersections.
* `set.lift_cover` - Version of `set.Union_lift` for the special case that the sets cover the
  entire type.

## Main statements

There are proofs of the obvious properties of `Union_lift`, i.e. what it does to elements of
each of the sets in the `Union`, stated in different ways.

There are also three lemmas about `Union_lift` intended to aid with proving that `Union_lift` is a
homomorphism when defined on a Union of substructures. There is one lemma each to show that
constants, unary functions, or binary functions are preserved. These lemmas are:

*`set.Union_lift_const`
*`set.Union_lift_unary`
*`set.Union_lift_binary`

## Tags

directed union, directed supremum, glue, gluing
-/

variable {α ι β : Type _}

namespace Set

section UnionLift

#print Set.unionᵢLift /-
/- The unused argument `hf` is left in the definition so that the `simp` lemmas
`Union_lift_inclusion` will work without the user having to provide `hf` explicitly to
simplify terms involving `Union_lift`. -/
/-- Given a Union of sets `Union S`, define a function on the Union by defining
it on each component, and proving that it agrees on the intersections. -/
@[nolint unused_arguments]
noncomputable def unionᵢLift (S : ι → Set α) (f : ∀ (i) (x : S i), β)
    (hf : ∀ (i j) (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), f i ⟨x, hxi⟩ = f j ⟨x, hxj⟩) (T : Set α)
    (hT : T ⊆ unionᵢ S) (x : T) : β :=
  let i := Classical.indefiniteDescription _ (mem_unionᵢ.1 (hT x.Prop))
  f i ⟨x, i.Prop⟩
#align set.Union_lift Set.unionᵢLift
-/

variable {S : ι → Set α} {f : ∀ (i) (x : S i), β}
  {hf : ∀ (i j) (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), f i ⟨x, hxi⟩ = f j ⟨x, hxj⟩} {T : Set α}
  {hT : T ⊆ unionᵢ S} (hT' : T = unionᵢ S)

/- warning: set.Union_lift_mk -> Set.unionᵢLift_mk is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} {hT : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)} {i : ι} (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) (hx : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)))))) x) T), Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T hT (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x T) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)))))) x) hx)) (f i x)
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u1} α ι S)} {i : ι} (x : Set.Elem.{u3} α (S i)) (hx : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x) T), Eq.{succ u2} β (Set.unionᵢLift.{u3, u1, u2} α ι β S f hf T hT (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x T) (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x) hx)) (f i x)
Case conversion may be inaccurate. Consider using '#align set.Union_lift_mk Set.unionᵢLift_mkₓ'. -/
@[simp]
theorem unionᵢLift_mk {i : ι} (x : S i) (hx : (x : α) ∈ T) :
    unionᵢLift S f hf T hT ⟨x, hx⟩ = f i x :=
  by
  let j := Classical.indefiniteDescription _ (mem_unionᵢ.1 (hT hx))
  cases' x with x hx <;> exact hf j i x j.2 _
#align set.Union_lift_mk Set.unionᵢLift_mk

/- warning: set.Union_lift_inclusion -> Set.unionᵢLift_inclusion is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} {hT : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)} {i : ι} (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) (h : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T), Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T hT (Set.inclusion.{u1} α (S i) T h x)) (f i x)
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u1} α ι S)} {i : ι} (x : Set.Elem.{u3} α (S i)) (h : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S i) T), Eq.{succ u2} β (Set.unionᵢLift.{u3, u1, u2} α ι β S f hf T hT (Set.inclusion.{u3} α (S i) T h x)) (f i x)
Case conversion may be inaccurate. Consider using '#align set.Union_lift_inclusion Set.unionᵢLift_inclusionₓ'. -/
@[simp]
theorem unionᵢLift_inclusion {i : ι} (x : S i) (h : S i ⊆ T) :
    unionᵢLift S f hf T hT (Set.inclusion h x) = f i x :=
  unionᵢLift_mk x _
#align set.Union_lift_inclusion Set.unionᵢLift_inclusion

/- warning: set.Union_lift_of_mem -> Set.unionᵢLift_of_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} {hT : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)} (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) {i : ι} (hx : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x T))))) x) (S i)), Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T hT x) (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x T))))) x) hx))
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u1} α ι S)} (x : Set.Elem.{u3} α T) {i : ι} (hx : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x T) x) (S i)), Eq.{succ u2} β (Set.unionᵢLift.{u3, u1, u2} α ι β S f hf T hT x) (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x T) x) hx))
Case conversion may be inaccurate. Consider using '#align set.Union_lift_of_mem Set.unionᵢLift_of_memₓ'. -/
theorem unionᵢLift_of_mem (x : T) {i : ι} (hx : (x : α) ∈ S i) :
    unionᵢLift S f hf T hT x = f i ⟨x, hx⟩ := by cases' x with x hx <;> exact hf _ _ _ _ _
#align set.Union_lift_of_mem Set.unionᵢLift_of_mem

/- warning: set.Union_lift_const -> Set.unionᵢLift_const is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} {hT : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)} (c : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) (ci : forall (i : ι), coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), (forall (i : ι), Eq.{succ u1} α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)))))) (ci i)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x T))))) c)) -> (forall (cβ : β), (forall (i : ι), Eq.{succ u3} β (f i (ci i)) cβ) -> (Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T hT c) cβ))
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u1} α ι S)} (c : Set.Elem.{u3} α T) (ci : forall (i : ι), Set.Elem.{u3} α (S i)), (forall (i : ι), Eq.{succ u3} α (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (ci i)) (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x T) c)) -> (forall (cβ : β), (forall (i : ι), Eq.{succ u2} β (f i (ci i)) cβ) -> (Eq.{succ u2} β (Set.unionᵢLift.{u3, u1, u2} α ι β S f hf T hT c) cβ))
Case conversion may be inaccurate. Consider using '#align set.Union_lift_const Set.unionᵢLift_constₓ'. -/
/-- `Union_lift_const` is useful for proving that `Union_lift` is a homomorphism
  of algebraic structures when defined on the Union of algebraic subobjects.
  For example, it could be used to prove that the lift of a collection
  of group homomorphisms on a union of subgroups preserves `1`. -/
theorem unionᵢLift_const (c : T) (ci : ∀ i, S i) (hci : ∀ i, (ci i : α) = c) (cβ : β)
    (h : ∀ i, f i (ci i) = cβ) : unionᵢLift S f hf T hT c = cβ :=
  by
  let ⟨i, hi⟩ := Set.mem_unionᵢ.1 (hT c.Prop)
  have : ci i = ⟨c, hi⟩ := Subtype.ext (hci i)
  rw [Union_lift_of_mem _ hi, ← this, h]
#align set.Union_lift_const Set.unionᵢLift_const

/- warning: set.Union_lift_unary -> Set.unionᵢLift_unary is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} (hT' : Eq.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)) (u : (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T)) (ui : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i))), (forall (i : ι) (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), Eq.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) (u (Set.inclusion.{u1} α (S i) T ((fun (this : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T) => this) (Eq.subst.{succ u1} (Set.{u1} α) (fun (_x : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) _x) (Set.unionᵢ.{u1, succ u2} α ι S) T (Eq.symm.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (Set.subset_unionᵢ.{u1, succ u2} α ι S i))) x)) (Set.inclusion.{u1} α (S i) T ((fun (this : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T) => this) (Eq.subst.{succ u1} (Set.{u1} α) (fun (_x : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) _x) (Set.unionᵢ.{u1, succ u2} α ι S) T (Eq.symm.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (Set.subset_unionᵢ.{u1, succ u2} α ι S i))) (ui i x))) -> (forall (uβ : β -> β), (forall (i : ι) (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), Eq.{succ u3} β (f i (ui i x)) (uβ (f i x))) -> (forall (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T), Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T (le_of_eq.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (u x)) (uβ (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T (le_of_eq.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') x))))
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u2}} {β : Type.{u1}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u1} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT' : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S)} (u : Eq.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S)) (ui : (Set.Elem.{u3} α T) -> (Set.Elem.{u3} α T)) (hui : forall (i : ι), (Set.Elem.{u3} α (S i)) -> (Set.Elem.{u3} α (S i))), (forall (ᾰ : ι) (x : Set.Elem.{u3} α (S ᾰ)), Eq.{succ u3} (Set.Elem.{u3} α T) (ui (Set.inclusion.{u3} α (S ᾰ) T ([mdata let_fun:1 (fun (this : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) T) => this) (Eq.rec.{0, succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.995 : Set.{u3} α) (h._@.Mathlib.Data.Set.UnionLift._hyg.996 : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) x._@.Mathlib.Data.Set.UnionLift._hyg.995) => HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) x._@.Mathlib.Data.Set.UnionLift._hyg.995) (Set.subset_unionᵢ.{succ u2, u3} α ι S ᾰ) T (Eq.symm.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S) u))]) x)) (Set.inclusion.{u3} α (S ᾰ) T ([mdata let_fun:1 (fun (this : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) T) => this) (Eq.rec.{0, succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.1019 : Set.{u3} α) (h._@.Mathlib.Data.Set.UnionLift._hyg.1020 : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) x._@.Mathlib.Data.Set.UnionLift._hyg.1019) => HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) x._@.Mathlib.Data.Set.UnionLift._hyg.1019) (Set.subset_unionᵢ.{succ u2, u3} α ι S ᾰ) T (Eq.symm.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S) u))]) (hui ᾰ x))) -> (forall (h : β -> β), (forall (i : ι) (x : Set.Elem.{u3} α (S i)), Eq.{succ u1} β (f i (hui i x)) (h (f i x))) -> (forall (x : Set.Elem.{u3} α T), Eq.{succ u1} β (Set.unionᵢLift.{u3, u2, u1} α ι β S f hf T (le_of_eq.{u3} (Set.{u3} α) (PartialOrder.toPreorder.{u3} (Set.{u3} α) (CompleteSemilatticeInf.toPartialOrder.{u3} (Set.{u3} α) (CompleteLattice.toCompleteSemilatticeInf.{u3} (Set.{u3} α) (Order.Coframe.toCompleteLattice.{u3} (Set.{u3} α) (CompleteDistribLattice.toCoframe.{u3} (Set.{u3} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u3} (Set.{u3} α) (Set.instCompleteBooleanAlgebraSet.{u3} α))))))) T (Set.unionᵢ.{u3, succ u2} α ι S) u) (ui x)) (h (Set.unionᵢLift.{u3, u2, u1} α ι β S f hf T (le_of_eq.{u3} (Set.{u3} α) (PartialOrder.toPreorder.{u3} (Set.{u3} α) (CompleteSemilatticeInf.toPartialOrder.{u3} (Set.{u3} α) (CompleteLattice.toCompleteSemilatticeInf.{u3} (Set.{u3} α) (Order.Coframe.toCompleteLattice.{u3} (Set.{u3} α) (CompleteDistribLattice.toCoframe.{u3} (Set.{u3} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u3} (Set.{u3} α) (Set.instCompleteBooleanAlgebraSet.{u3} α))))))) T (Set.unionᵢ.{u3, succ u2} α ι S) u) x))))
Case conversion may be inaccurate. Consider using '#align set.Union_lift_unary Set.unionᵢLift_unaryₓ'. -/
/-- `Union_lift_unary` is useful for proving that `Union_lift` is a homomorphism
  of algebraic structures when defined on the Union of algebraic subobjects.
  For example, it could be used to prove that the lift of a collection
  of linear_maps on a union of submodules preserves scalar multiplication. -/
theorem unionᵢLift_unary (u : T → T) (ui : ∀ i, S i → S i)
    (hui :
      ∀ (i) (x : S i),
        u (Set.inclusion (show S i ⊆ T from hT'.symm ▸ Set.subset_unionᵢ S i) x) =
          Set.inclusion (show S i ⊆ T from hT'.symm ▸ Set.subset_unionᵢ S i) (ui i x))
    (uβ : β → β) (h : ∀ (i) (x : S i), f i (ui i x) = uβ (f i x)) (x : T) :
    unionᵢLift S f hf T (le_of_eq hT') (u x) = uβ (unionᵢLift S f hf T (le_of_eq hT') x) :=
  by
  subst hT'
  cases' Set.mem_unionᵢ.1 x.prop with i hi
  rw [Union_lift_of_mem x hi, ← h i]
  have : x = Set.inclusion (Set.subset_unionᵢ S i) ⟨x, hi⟩ :=
    by
    cases x
    rfl
  have hx' : (Set.inclusion (Set.subset_unionᵢ S i) (ui i ⟨x, hi⟩) : α) ∈ S i := (ui i ⟨x, hi⟩).Prop
  conv_lhs => rw [this, hui, Union_lift_inclusion]
#align set.Union_lift_unary Set.unionᵢLift_unary

/- warning: set.Union_lift_binary -> Set.unionᵢLift_binary is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {T : Set.{u1} α} (hT' : Eq.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S)), (Directed.{u1, succ u2} (Set.{u1} α) ι (LE.le.{u1} (Set.{u1} α) (Set.hasLe.{u1} α)) S) -> (forall (op : (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T)) (opi : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i))), (forall (i : ι) (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) (y : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), Eq.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) (Set.inclusion.{u1} α (S i) T ((fun (this : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T) => this) (Eq.subst.{succ u1} (Set.{u1} α) (fun (_x : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) _x) (Set.unionᵢ.{u1, succ u2} α ι S) T (Eq.symm.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (Set.subset_unionᵢ.{u1, succ u2} α ι S i))) (opi i x y)) (op (Set.inclusion.{u1} α (S i) T ((fun (this : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T) => this) (Eq.subst.{succ u1} (Set.{u1} α) (fun (_x : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) _x) (Set.unionᵢ.{u1, succ u2} α ι S) T (Eq.symm.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (Set.subset_unionᵢ.{u1, succ u2} α ι S i))) x) (Set.inclusion.{u1} α (S i) T ((fun (this : HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) T) => this) (Eq.subst.{succ u1} (Set.{u1} α) (fun (_x : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (S i) _x) (Set.unionᵢ.{u1, succ u2} α ι S) T (Eq.symm.{succ u1} (Set.{u1} α) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (Set.subset_unionᵢ.{u1, succ u2} α ι S i))) y))) -> (forall (opβ : β -> β -> β), (forall (i : ι) (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) (y : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), Eq.{succ u3} β (f i (opi i x y)) (opβ (f i x) (f i y))) -> (forall (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T) (y : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) T), Eq.{succ u3} β (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T (le_of_eq.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') (op x y)) (opβ (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T (le_of_eq.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') x) (Set.unionᵢLift.{u1, u2, u3} α ι β S f hf T (le_of_eq.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) T (Set.unionᵢ.{u1, succ u2} α ι S) hT') y)))))
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u2}} {β : Type.{u1}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u1} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {T : Set.{u3} α} {hT' : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S)} (dir : Eq.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S)), (Directed.{u3, succ u2} (Set.{u3} α) ι (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.1261 : Set.{u3} α) (x._@.Mathlib.Data.Set.UnionLift._hyg.1263 : Set.{u3} α) => LE.le.{u3} (Set.{u3} α) (Set.instLESet.{u3} α) x._@.Mathlib.Data.Set.UnionLift._hyg.1261 x._@.Mathlib.Data.Set.UnionLift._hyg.1263) S) -> (forall (opi : (Set.Elem.{u3} α T) -> (Set.Elem.{u3} α T) -> (Set.Elem.{u3} α T)) (hopi : forall (i : ι), (Set.Elem.{u3} α (S i)) -> (Set.Elem.{u3} α (S i)) -> (Set.Elem.{u3} α (S i))), (forall (ᾰ : ι) (ᾰ_1 : Set.Elem.{u3} α (S ᾰ)) (y : Set.Elem.{u3} α (S ᾰ)), Eq.{succ u3} (Set.Elem.{u3} α T) (Set.inclusion.{u3} α (S ᾰ) T ([mdata let_fun:1 (fun (this : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) T) => this) (Eq.rec.{0, succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.1318 : Set.{u3} α) (h._@.Mathlib.Data.Set.UnionLift._hyg.1319 : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) x._@.Mathlib.Data.Set.UnionLift._hyg.1318) => HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) x._@.Mathlib.Data.Set.UnionLift._hyg.1318) (Set.subset_unionᵢ.{succ u2, u3} α ι S ᾰ) T (Eq.symm.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S) dir))]) (hopi ᾰ ᾰ_1 y)) (opi (Set.inclusion.{u3} α (S ᾰ) T ([mdata let_fun:1 (fun (this : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) T) => this) (Eq.rec.{0, succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.1350 : Set.{u3} α) (h._@.Mathlib.Data.Set.UnionLift._hyg.1351 : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) x._@.Mathlib.Data.Set.UnionLift._hyg.1350) => HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) x._@.Mathlib.Data.Set.UnionLift._hyg.1350) (Set.subset_unionᵢ.{succ u2, u3} α ι S ᾰ) T (Eq.symm.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S) dir))]) ᾰ_1) (Set.inclusion.{u3} α (S ᾰ) T ([mdata let_fun:1 (fun (this : HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) T) => this) (Eq.rec.{0, succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) (fun (x._@.Mathlib.Data.Set.UnionLift._hyg.1376 : Set.{u3} α) (h._@.Mathlib.Data.Set.UnionLift._hyg.1377 : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u2} α ι S) x._@.Mathlib.Data.Set.UnionLift._hyg.1376) => HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (S ᾰ) x._@.Mathlib.Data.Set.UnionLift._hyg.1376) (Set.subset_unionᵢ.{succ u2, u3} α ι S ᾰ) T (Eq.symm.{succ u3} (Set.{u3} α) T (Set.unionᵢ.{u3, succ u2} α ι S) dir))]) y))) -> (forall (h : β -> β -> β), (forall (i : ι) (x : Set.Elem.{u3} α (S i)) (y : Set.Elem.{u3} α (S i)), Eq.{succ u1} β (f i (hopi i x y)) (h (f i x) (f i y))) -> (forall (y : Set.Elem.{u3} α T) (y_1 : Set.Elem.{u3} α T), Eq.{succ u1} β (Set.unionᵢLift.{u3, u2, u1} α ι β S f hf T (le_of_eq.{u3} (Set.{u3} α) (PartialOrder.toPreorder.{u3} (Set.{u3} α) (CompleteSemilatticeInf.toPartialOrder.{u3} (Set.{u3} α) (CompleteLattice.toCompleteSemilatticeInf.{u3} (Set.{u3} α) (Order.Coframe.toCompleteLattice.{u3} (Set.{u3} α) (CompleteDistribLattice.toCoframe.{u3} (Set.{u3} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u3} (Set.{u3} α) (Set.instCompleteBooleanAlgebraSet.{u3} α))))))) T (Set.unionᵢ.{u3, succ u2} α ι S) dir) (opi y y_1)) (h (Set.unionᵢLift.{u3, u2, u1} α ι β S f hf T (le_of_eq.{u3} (Set.{u3} α) (PartialOrder.toPreorder.{u3} (Set.{u3} α) (CompleteSemilatticeInf.toPartialOrder.{u3} (Set.{u3} α) (CompleteLattice.toCompleteSemilatticeInf.{u3} (Set.{u3} α) (Order.Coframe.toCompleteLattice.{u3} (Set.{u3} α) (CompleteDistribLattice.toCoframe.{u3} (Set.{u3} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u3} (Set.{u3} α) (Set.instCompleteBooleanAlgebraSet.{u3} α))))))) T (Set.unionᵢ.{u3, succ u2} α ι S) dir) y) (Set.unionᵢLift.{u3, u2, u1} α ι β S f hf T (le_of_eq.{u3} (Set.{u3} α) (PartialOrder.toPreorder.{u3} (Set.{u3} α) (CompleteSemilatticeInf.toPartialOrder.{u3} (Set.{u3} α) (CompleteLattice.toCompleteSemilatticeInf.{u3} (Set.{u3} α) (Order.Coframe.toCompleteLattice.{u3} (Set.{u3} α) (CompleteDistribLattice.toCoframe.{u3} (Set.{u3} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u3} (Set.{u3} α) (Set.instCompleteBooleanAlgebraSet.{u3} α))))))) T (Set.unionᵢ.{u3, succ u2} α ι S) dir) y_1)))))
Case conversion may be inaccurate. Consider using '#align set.Union_lift_binary Set.unionᵢLift_binaryₓ'. -/
/-- `Union_lift_binary` is useful for proving that `Union_lift` is a homomorphism
  of algebraic structures when defined on the Union of algebraic subobjects.
  For example, it could be used to prove that the lift of a collection
  of group homomorphisms on a union of subgroups preserves `*`. -/
theorem unionᵢLift_binary (dir : Directed (· ≤ ·) S) (op : T → T → T) (opi : ∀ i, S i → S i → S i)
    (hopi :
      ∀ i x y,
        Set.inclusion (show S i ⊆ T from hT'.symm ▸ Set.subset_unionᵢ S i) (opi i x y) =
          op (Set.inclusion (show S i ⊆ T from hT'.symm ▸ Set.subset_unionᵢ S i) x)
            (Set.inclusion (show S i ⊆ T from hT'.symm ▸ Set.subset_unionᵢ S i) y))
    (opβ : β → β → β) (h : ∀ (i) (x y : S i), f i (opi i x y) = opβ (f i x) (f i y)) (x y : T) :
    unionᵢLift S f hf T (le_of_eq hT') (op x y) =
      opβ (unionᵢLift S f hf T (le_of_eq hT') x) (unionᵢLift S f hf T (le_of_eq hT') y) :=
  by
  subst hT'
  cases' Set.mem_unionᵢ.1 x.prop with i hi
  cases' Set.mem_unionᵢ.1 y.prop with j hj
  rcases dir i j with ⟨k, hik, hjk⟩
  rw [Union_lift_of_mem x (hik hi), Union_lift_of_mem y (hjk hj), ← h k]
  have hx : x = Set.inclusion (Set.subset_unionᵢ S k) ⟨x, hik hi⟩ :=
    by
    cases x
    rfl
  have hy : y = Set.inclusion (Set.subset_unionᵢ S k) ⟨y, hjk hj⟩ :=
    by
    cases y
    rfl
  have hxy : (Set.inclusion (Set.subset_unionᵢ S k) (opi k ⟨x, hik hi⟩ ⟨y, hjk hj⟩) : α) ∈ S k :=
    (opi k ⟨x, hik hi⟩ ⟨y, hjk hj⟩).Prop
  conv_lhs => rw [hx, hy, ← hopi, Union_lift_of_mem _ hxy]
  simp only [coe_inclusion, Subtype.coe_eta]
#align set.Union_lift_binary Set.unionᵢLift_binary

end UnionLift

variable {S : ι → Set α} {f : ∀ (i) (x : S i), β}
  {hf : ∀ (i j) (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), f i ⟨x, hxi⟩ = f j ⟨x, hxj⟩}
  {hS : unionᵢ S = univ}

#print Set.liftCover /-
/-- Glue together functions defined on each of a collection `S` of sets that cover a type. See
  also `set.Union_lift`.   -/
noncomputable def liftCover (S : ι → Set α) (f : ∀ (i) (x : S i), β)
    (hf : ∀ (i j) (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), f i ⟨x, hxi⟩ = f j ⟨x, hxj⟩)
    (hS : unionᵢ S = univ) (a : α) : β :=
  unionᵢLift S f hf univ (hS ▸ Set.Subset.refl _) ⟨a, trivial⟩
#align set.lift_cover Set.liftCover
-/

/- warning: set.lift_cover_coe -> Set.liftCover_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {hS : Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι S) (Set.univ.{u1} α)} {i : ι} (x : coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)), Eq.{succ u3} β (Set.liftCover.{u1, u2, u3} α ι β S f hf hS ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)))))) x)) (f i x)
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {hS : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u1} α ι S) (Set.univ.{u3} α)} {i : ι} (x : Set.Elem.{u3} α (S i)), Eq.{succ u2} β (Set.liftCover.{u3, u1, u2} α ι β S f hf hS (Subtype.val.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x)) (f i x)
Case conversion may be inaccurate. Consider using '#align set.lift_cover_coe Set.liftCover_coeₓ'. -/
@[simp]
theorem liftCover_coe {i : ι} (x : S i) : liftCover S f hf hS x = f i x :=
  unionᵢLift_mk x _
#align set.lift_cover_coe Set.liftCover_coe

/- warning: set.lift_cover_of_mem -> Set.liftCover_of_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} {β : Type.{u3}} {S : ι -> (Set.{u1} α)} {f : forall (i : ι), (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) (hxj : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)), Eq.{succ u3} β (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S j)) x hxj))} {hS : Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι S) (Set.univ.{u1} α)} {i : ι} {x : α} (hx : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)), Eq.{succ u3} β (Set.liftCover.{u1, u2, u3} α ι β S f hf hS x) (f i (Subtype.mk.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (S i)) x hx))
but is expected to have type
  forall {α : Type.{u3}} {ι : Type.{u1}} {β : Type.{u2}} {S : ι -> (Set.{u3} α)} {f : forall (i : ι), (Set.Elem.{u3} α (S i)) -> β} {hf : forall (i : ι) (j : ι) (x : α) (hxi : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) (hxj : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)), Eq.{succ u2} β (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hxi)) (f j (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S j)) x hxj))} {hS : Eq.{succ u3} (Set.{u3} α) (Set.unionᵢ.{u3, succ u1} α ι S) (Set.univ.{u3} α)} {i : ι} {x : α} (hx : Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)), Eq.{succ u2} β (Set.liftCover.{u3, u1, u2} α ι β S f hf hS x) (f i (Subtype.mk.{succ u3} α (fun (x : α) => Membership.mem.{u3, u3} α (Set.{u3} α) (Set.instMembershipSet.{u3} α) x (S i)) x hx))
Case conversion may be inaccurate. Consider using '#align set.lift_cover_of_mem Set.liftCover_of_memₓ'. -/
theorem liftCover_of_mem {i : ι} {x : α} (hx : (x : α) ∈ S i) :
    liftCover S f hf hS x = f i ⟨x, hx⟩ :=
  unionᵢLift_of_mem ⟨x, trivial⟩ hx
#align set.lift_cover_of_mem Set.liftCover_of_mem

end Set


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.deriv
import Mathlib.measure_theory.borel_space
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Derivative is measurable

In this file we prove that the derivative of any function with complete codomain is a measurable
function. Namely, we prove:

* `is_measurable_set_of_differentiable_at`: the set `{x | differentiable_at 𝕜 f x}` is measurable;
* `measurable_fderiv`: the function `fderiv 𝕜 f` is measurable;
* `measurable_fderiv_apply_const`: for a fixed vector `y`, the function `λ x, fderiv 𝕜 f x y`
  is measurable;
* `measurable_deriv`: the function `deriv f` is measurable (for `f : 𝕜 → F`).

## Implementation

We give a proof that avoids second-countability issues, by expressing the differentiability set
as a function of open sets in the following way. Define `A (L, r, ε)` to be the set of points
where, on a ball of radius roughly `r` around `x`, the function is uniformly approximated by the
linear map `L`, up to `ε r`. It is an open set.
Let also `B (L, r, s, ε) = A (L, r, ε) ∩ A (L, s, ε)`: we require that at two possibly different
scales `r` and `s`, the function is well approximated by the linear map `L`. It is also open.

We claim that the differentiability set of `f` is exactly
`D = ⋂ ε > 0, ⋃ δ > 0, ⋂ r, s < δ, ⋃ L, B (L, r, s, ε)`.
In other words, for any `ε > 0`, we require that there is a size `δ` such that, for any two scales
below this size, the function is well approximated by a linear map, common to the two scales.

The set `⋃ L, B (L, r, s, ε)` is open, as a union of open sets. Converting the intersections and
unions to countable ones (using real numbers of the form `2 ^ (-n)`), it follows that the
differentiability set is measurable.

To prove the claim, there are two inclusions. One is trivial: if the function is differentiable
at `x`, then `x` belongs to `D` (just take `L` to be the derivative, and use that the
differentiability exactly says that the map is well approximated by `L`). This is proved in
`mem_A_of_differentiable` and `differentiable_set_subset_D`.

For the other direction, the difficulty is that `L` in the union may depend on `ε, r, s`. The key
point is that, in fact, it doesn't depend too much on them. First, if `x` belongs both to
`A (L, r, ε)` and `A (L', r, ε)`, then `L` and `L'` have to be close on a shell, and thus
`∥L - L'∥` is bounded by `ε` (see `norm_sub_le_of_mem_A`). Assume now `x ∈ D`. If one has two maps
`L` and `L'` such that `x` belongs to `A (L, r, ε)` and to `A (L', r', ε')`, one deduces that `L` is
close to `L'` by arguing as follows. Consider another scale `s` smaller than `r` and `r'`. Take a
linear map `L₁` that approximates `f` around `x` both at scales `r` and `s` w.r.t. `ε` (it exists as
`x` belongs to `D`). Take also `L₂` that approximates `f` around `x` both at scales `r'` and `s`
w.r.t. `ε'`. Then `L₁` is close to `L` (as they are close on a shell of radius `r`), and `L₂` is
close to `L₁` (as they are close on a shell of radius `s`), and `L'` is close to `L₂` (as they are
close on a shell of radius `r'`). It follows that `L` is close to `L'`, as we claimed.

It follows that the different approximating linear maps that show up form a Cauchy sequence when
`ε` tends to `0`. When the target space is complete, this sequence converges, to a limit `f'`.
With the same kind of arguments, one checks that `f` is differentiable with derivative `f'`.

To show that the derivative itself is measurable, add in the definition of `B` and `D` a set
`K` of continuous linear maps to which `L` should belong. Then, when `K` is complete, the set `D K`
is exactly the set of points where `f` is differentiable with a derivative in `K`.

## Tags

derivative, measurable function, Borel σ-algebra
-/

namespace continuous_linear_map

protected instance measurable_space {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] : measurable_space (continuous_linear_map 𝕜 E F) :=
  borel (continuous_linear_map 𝕜 E F)

protected instance borel_space {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] : borel_space (continuous_linear_map 𝕜 E F) :=
  borel_space.mk rfl

theorem measurable_apply {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] [measurable_space F] [borel_space F] (x : E) : measurable fun (f : continuous_linear_map 𝕜 E F) => coe_fn f x :=
  continuous.measurable (continuous_linear_map.continuous (apply 𝕜 F x))

theorem measurable_apply' {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] [measurable_space E] [opens_measurable_space E] [measurable_space F] [borel_space F] : measurable fun (x : E) (f : continuous_linear_map 𝕜 E F) => coe_fn f x :=
  measurable_pi_lambda (fun (x : E) (f : continuous_linear_map 𝕜 E F) => coe_fn f x)
    fun (f : continuous_linear_map 𝕜 E F) => continuous_linear_map.measurable f

theorem measurable_apply₂ {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] [measurable_space E] [opens_measurable_space E] [topological_space.second_countable_topology E] [topological_space.second_countable_topology (continuous_linear_map 𝕜 E F)] [measurable_space F] [borel_space F] : measurable fun (p : continuous_linear_map 𝕜 E F × E) => coe_fn (prod.fst p) (prod.snd p) :=
  continuous.measurable (is_bounded_bilinear_map.continuous is_bounded_bilinear_map_apply)

theorem measurable_coe {𝕜 : Type u_1} {E : Type u_2} {F : Type u_3} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] [measurable_space F] [borel_space F] : measurable fun (f : continuous_linear_map 𝕜 E F) (x : E) => coe_fn f x :=
  measurable_pi_lambda (fun (f : continuous_linear_map 𝕜 E F) (x : E) => coe_fn f x) measurable_apply

end continuous_linear_map

namespace fderiv_measurable_aux

/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated
at scale `r` by the linear map `L`, up to an error `ε`. We tweak the definition to make sure that
this is an open set.-/
def A {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (f : E → F) (L : continuous_linear_map 𝕜 E F) (r : ℝ) (ε : ℝ) : set E :=
  set_of
    fun (x : E) =>
      ∃ (r' : ℝ),
        ∃ (H : r' ∈ set.Ioc (r / bit0 1) r),
          ∀ (y z : E), y ∈ metric.ball x r' → z ∈ metric.ball x r' → norm (f z - f y - coe_fn L (z - y)) ≤ ε * r

/-- The set `B f K r s ε` is the set of points `x` around which there exists a continuous linear map
`L` belonging to `K` (a given set of continuous linear maps) that approximates well the
function `f` (up to an error `ε`), simultaneously at scales `r` and `s`. -/
def B {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (f : E → F) (K : set (continuous_linear_map 𝕜 E F)) (r : ℝ) (s : ℝ) (ε : ℝ) : set E :=
  set.Union fun (L : continuous_linear_map 𝕜 E F) => set.Union fun (H : L ∈ K) => A f L r ε ∩ A f L s ε

/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its
main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable,
with a derivative in `K`. -/
def D {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (f : E → F) (K : set (continuous_linear_map 𝕜 E F)) : set E :=
  set.Inter
    fun (e : ℕ) =>
      set.Union
        fun (n : ℕ) =>
          set.Inter
            fun (p : ℕ) =>
              set.Inter
                fun (H : p ≥ n) =>
                  set.Inter
                    fun (q : ℕ) =>
                      set.Inter fun (H : q ≥ n) => B f K ((1 / bit0 1) ^ p) ((1 / bit0 1) ^ q) ((1 / bit0 1) ^ e)

theorem is_open_A {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} (L : continuous_linear_map 𝕜 E F) (r : ℝ) (ε : ℝ) : is_open (A f L r ε) := sorry

theorem is_open_B {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {K : set (continuous_linear_map 𝕜 E F)} {r : ℝ} {s : ℝ} {ε : ℝ} : is_open (B f K r s ε) := sorry

theorem A_mono {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} (L : continuous_linear_map 𝕜 E F) (r : ℝ) {ε : ℝ} {δ : ℝ} (h : ε ≤ δ) : A f L r ε ⊆ A f L r δ := sorry

theorem le_of_mem_A {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {r : ℝ} {ε : ℝ} {L : continuous_linear_map 𝕜 E F} {x : E} (hx : x ∈ A f L r ε) {y : E} {z : E} (hy : y ∈ metric.closed_ball x (r / bit0 1)) (hz : z ∈ metric.closed_ball x (r / bit0 1)) : norm (f z - f y - coe_fn L (z - y)) ≤ ε * r := sorry

theorem mem_A_of_differentiable {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {ε : ℝ} (hε : 0 < ε) {x : E} (hx : differentiable_at 𝕜 f x) : ∃ (R : ℝ), ∃ (H : R > 0), ∀ (r : ℝ), r ∈ set.Ioo 0 R → x ∈ A f (fderiv 𝕜 f x) r ε := sorry

theorem norm_sub_le_of_mem_A {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {c : 𝕜} (hc : 1 < norm c) {r : ℝ} {ε : ℝ} (hε : 0 < ε) (hr : 0 < r) {x : E} {L₁ : continuous_linear_map 𝕜 E F} {L₂ : continuous_linear_map 𝕜 E F} (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : norm (L₁ - L₂) ≤ bit0 (bit0 1) * norm c * ε := sorry

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
theorem differentiable_set_subset_D {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} (K : set (continuous_linear_map 𝕜 E F)) : (set_of fun (x : E) => differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K) ⊆ D f K := sorry

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

A computable model of hereditarily finite sets with atoms
(ZFA without infinity). This is useful for calculations in naive
set theory.
-/
import tactic.interactive data.list.basic

variables {α : Type*}

@[derive decidable_eq]
inductive {u} lists' (α : Type u) : bool → Type u
| atom : α → lists' ff
| nil {} : lists' tt
| cons' {b} : lists' b → lists' tt → lists' tt

def lists (α : Type*) := Σ b, lists' α b

namespace lists'

def cons : lists α → lists' α tt → lists' α tt
| ⟨b, a⟩ l := cons' a l

@[simp] def to_list : ∀ {b}, lists' α b → list (lists α)
| _ (atom a)    := []
| _ nil         := []
| _ (cons' a l) := ⟨_, a⟩ :: l.to_list

@[simp] theorem to_list_cons (a : lists α) (l) :
  to_list (cons a l) = a :: l.to_list :=
by cases a; simp [cons]

@[simp] def of_list : list (lists α) → lists' α tt
| []       := nil
| (a :: l) := cons a (of_list l)

@[simp] theorem to_of_list (l : list (lists α)) : to_list (of_list l) = l :=
by induction l; simp *

@[simp] theorem of_to_list : ∀ (l : lists' α tt), of_list (to_list l) = l :=
suffices ∀ b (h : tt = b) (l : lists' α b),
  let l' : lists' α tt := by rw h; exact l in
  of_list (to_list l') = l', from this _ rfl,
λ b h l, begin
  induction l, {cases h}, {exact rfl},
  case lists'.cons' : b a l IH₁ IH₂ {
    intro, change l' with cons' a l,
    simpa [cons] using IH₂ rfl }
end

end lists'

mutual inductive lists.equiv, lists'.subset
with lists.equiv : lists α → lists α → Prop
| refl (l) : lists.equiv l l
| antisymm {l₁ l₂ : lists' α tt} :
  lists'.subset l₁ l₂ → lists'.subset l₂ l₁ → lists.equiv ⟨_, l₁⟩ ⟨_, l₂⟩
with lists'.subset : lists' α tt → lists' α tt → Prop
| nil {l} : lists'.subset lists'.nil l
| cons {a a' l l'} : lists.equiv a a' → a' ∈ lists'.to_list l' →
  lists'.subset l l' → lists'.subset (lists'.cons a l) l'
local infix ~ := equiv

namespace lists'

instance : has_subset (lists' α tt) := ⟨lists'.subset⟩

instance {b} : has_mem (lists α) (lists' α b) :=
⟨λ a l, ∃ a' ∈ l.to_list, a ~ a'⟩

theorem mem_def {b a} {l : lists' α b} :
  a ∈ l ↔ ∃ a' ∈ l.to_list, a ~ a' := iff.rfl

@[simp] theorem mem_cons {a y l} : a ∈ @cons α y l ↔ a ~ y ∨ a ∈ l :=
by simp [mem_def, or_and_distrib_right, exists_or_distrib]

theorem cons_subset {a} {l₁ l₂ : lists' α tt} :
  lists'.cons a l₁ ⊆ l₂ ↔ a ∈ l₂ ∧ l₁ ⊆ l₂ :=
begin
  refine ⟨λ h, _, λ ⟨⟨a', m, e⟩, s⟩, subset.cons e m s⟩,
  generalize_hyp h' : lists'.cons a l₁ = l₁' at h,
  cases h with l a' a'' l l' e m s, {cases a, cases h'},
  cases a, cases a', cases h', exact ⟨⟨_, m, e⟩, s⟩
end

theorem of_list_subset {l₁ l₂ : list (lists α)} (h : l₁ ⊆ l₂) :
  lists'.of_list l₁ ⊆ lists'.of_list l₂ :=
begin
  induction l₁, {exact subset.nil},
  refine subset.cons (equiv.refl _) _ (l₁_ih (list.subset_of_cons_subset h)),
  simp at h, simp [h]
end

@[refl] theorem subset.refl {l : lists' α tt} : l ⊆ l :=
by rw ← lists'.of_to_list l; exact
   of_list_subset (list.subset.refl _)

theorem subset_nil {l : lists' α tt} :
  l ⊆ lists'.nil → l = lists'.nil :=
begin
  rw ← of_to_list l,
  induction to_list l; intro h, {refl},
  rcases cons_subset.1 h with ⟨⟨_, ⟨⟩, _⟩, _⟩
end

theorem mem_of_subset' {a} {l₁ l₂ : lists' α tt}
  (s : l₁ ⊆ l₂) (h : a ∈ l₁.to_list) : a ∈ l₂ :=
begin
  induction s with _ a a' l l' e m s IH, {cases h},
  simp at h, rcases h with rfl|h,
  exacts [⟨_, m, e⟩, IH h]
end

theorem subset_def {l₁ l₂ : lists' α tt} :
  l₁ ⊆ l₂ ↔ ∀ a ∈ l₁.to_list, a ∈ l₂ :=
⟨λ H a, mem_of_subset' H, λ H, begin
  rw ← of_to_list l₁,
  revert H, induction to_list l₁; intro,
  { exact subset.nil },
  { simp at H, exact cons_subset.2 ⟨H.1, ih H.2⟩ }
end⟩

end lists'

namespace lists

@[pattern] def atom (a : α) : lists α := ⟨_, lists'.atom a⟩

@[pattern] def of' (l : lists' α tt) : lists α := ⟨_, l⟩

@[simp] def to_list : lists α → list (lists α)
| ⟨b, l⟩ := l.to_list

def is_list (l : lists α) : Prop := l.1

def of_list (l : list (lists α)) : lists α := of' (lists'.of_list l)

theorem is_list_to_list (l : list (lists α)) : is_list (of_list l) :=
eq.refl _

theorem to_of_list (l : list (lists α)) : to_list (of_list l) = l :=
by simp [of_list, of']

theorem of_to_list : ∀ {l : lists α}, is_list l → of_list (to_list l) = l
| ⟨tt, l⟩ _ := by simp [of_list, of']

instance [decidable_eq α] : decidable_eq (lists α) :=
by unfold lists; apply_instance

instance [has_sizeof α] : has_sizeof (lists α) :=
by unfold lists; apply_instance

def induction_mut (C : lists α → Sort*) (D : lists' α tt → Sort*)
  (C0 : ∀ a, C (atom a)) (C1 : ∀ l, D l → C (of' l))
  (D0 : D lists'.nil) (D1 : ∀ a l, C a → D l → D (lists'.cons a l)) :
  pprod (∀ l, C l) (∀ l, D l) :=
begin
  suffices : ∀ {b} (l : lists' α b),
    pprod (C ⟨_, l⟩) (match b, l with
    | tt, l := D l
    | ff, l := punit
    end),
  { exact ⟨λ ⟨b, l⟩, (this _).1, λ l, (this l).2⟩ },
  intros, induction l with a b a l IH₁ IH₂,
  { exact ⟨C0 _, ⟨⟩⟩ },
  { exact ⟨C1 _ D0, D0⟩ },
  { suffices, {exact ⟨C1 _ this, this⟩},
    exact D1 ⟨_, _⟩ _ IH₁.1 IH₂.2 }
end

def mem (a : lists α) : lists α → Prop
| ⟨ff, l⟩ := false
| ⟨tt, l⟩ := a ∈ l

instance : has_mem (lists α) (lists α) := ⟨mem⟩

theorem is_list_of_mem {a : lists α} : ∀ {l : lists α}, a ∈ l → is_list l
| ⟨_, lists'.nil⟩       _ := rfl
| ⟨_, lists'.cons' _ _⟩ _ := rfl

theorem equiv.antisymm_iff {l₁ l₂ : lists' α tt} :
  of' l₁ ~ of' l₂ ↔ l₁ ⊆ l₂ ∧ l₂ ⊆ l₁ :=
begin
  refine ⟨λ h, _, λ ⟨h₁, h₂⟩, equiv.antisymm h₁ h₂⟩,
  cases h with _ _ _ h₁ h₂,
  { simp [lists'.subset.refl] }, { exact ⟨h₁, h₂⟩ }
end

attribute [refl] equiv.refl

theorem equiv_atom {a} {l : lists α} : atom a ~ l ↔ atom a = l :=
⟨λ h, by cases h; refl, λ h, h ▸ equiv.refl _⟩

theorem equiv.symm {l₁ l₂ : lists α} (h : l₁ ~ l₂) : l₂ ~ l₁ :=
by cases h with _ _ _ h₁ h₂; [refl, exact equiv.antisymm h₂ h₁]

theorem equiv.trans : ∀ {l₁ l₂ l₃ : lists α}, l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
begin
  let trans := λ (l₁ : lists α), ∀ ⦃l₂ l₃⦄, l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃,
  suffices : pprod (∀ l₁, trans l₁)
    (∀ (l : lists' α tt) (l' ∈ l.to_list), trans l'), {exact this.1},
  apply induction_mut,
  { intros a l₂ l₃ h₁ h₂,
    rwa ← equiv_atom.1 h₁ at h₂ },
  { intros l₁ IH l₂ l₃ h₁ h₂,
    cases h₁ with _ _ l₂, {exact h₂},
    cases h₂ with _ _ l₃, {exact h₁},
    cases equiv.antisymm_iff.1 h₁ with hl₁ hr₁,
    cases equiv.antisymm_iff.1 h₂ with hl₂ hr₂,
    apply equiv.antisymm_iff.2; split; apply lists'.subset_def.2,
    { intros a₁ m₁,
      rcases lists'.mem_of_subset' hl₁ m₁ with ⟨a₂, m₂, e₁₂⟩,
      rcases lists'.mem_of_subset' hl₂ m₂ with ⟨a₃, m₃, e₂₃⟩,
      exact ⟨a₃, m₃, IH _ m₁ e₁₂ e₂₃⟩ },
    { intros a₃ m₃,
      rcases lists'.mem_of_subset' hr₂ m₃ with ⟨a₂, m₂, e₃₂⟩,
      rcases lists'.mem_of_subset' hr₁ m₂ with ⟨a₁, m₁, e₂₁⟩,
      exact ⟨a₁, m₁, (IH _ m₁ e₂₁.symm e₃₂.symm).symm⟩ } },
  { rintro _ ⟨⟩ },
  { intros a l IH₁ IH₂, simpa [IH₁] using IH₂ }
end

instance : setoid (lists α) :=
⟨(~), equiv.refl, @equiv.symm _, @equiv.trans _⟩

section decidable

@[simp] def equiv.decidable_meas :
  (psum (Σ' (l₁ : lists α), lists α) $
   psum (Σ' (l₁ : lists' α tt), lists' α tt)
   Σ' (a : lists α), lists' α tt) → ℕ
| (psum.inl ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂
| (psum.inr $ psum.inl ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂
| (psum.inr $ psum.inr ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂

local attribute [-simp] add_comm add_assoc
open well_founded_tactics

theorem sizeof_pos {b} (l : lists' α b) : 0 < sizeof l :=
by cases l; {unfold_sizeof, trivial_nat_lt}

theorem lt_sizeof_cons' {b} (a : lists' α b) (l) :
  sizeof (⟨b, a⟩ : lists α) < sizeof (lists'.cons' a l) :=
by {unfold_sizeof, exact lt_add_of_pos_right _ (sizeof_pos _)}

@[instance] mutual def equiv.decidable, subset.decidable, mem.decidable [decidable_eq α]
with equiv.decidable : ∀ l₁ l₂ : lists α, decidable (l₁ ~ l₂)
| ⟨ff, l₁⟩ ⟨ff, l₂⟩ := decidable_of_iff' (l₁ = l₂) $
  by cases l₁; refine equiv_atom.trans (by simp [atom])
| ⟨ff, l₁⟩ ⟨tt, l₂⟩ := is_false $ by rintro ⟨⟩
| ⟨tt, l₁⟩ ⟨ff, l₂⟩ := is_false $ by rintro ⟨⟩
| ⟨tt, l₁⟩ ⟨tt, l₂⟩ := begin
  haveI :=
    have sizeof l₁ + sizeof l₂ <
         sizeof (⟨tt, l₁⟩ : lists α) + sizeof (⟨tt, l₂⟩ : lists α),
    by default_dec_tac,
    subset.decidable l₁ l₂,
  haveI :=
    have sizeof l₂ + sizeof l₁ <
         sizeof (⟨tt, l₁⟩ : lists α) + sizeof (⟨tt, l₂⟩ : lists α),
    by default_dec_tac,
    subset.decidable l₂ l₁,
  exact decidable_of_iff' _ equiv.antisymm_iff,
end
with subset.decidable : ∀ l₁ l₂ : lists' α tt, decidable (l₁ ⊆ l₂)
| lists'.nil l₂ := is_true subset.nil
| (@lists'.cons' _ b a l₁) l₂ := begin
  haveI :=
    have sizeof (⟨b, a⟩ : lists α) + sizeof l₂ <
         sizeof (lists'.cons' a l₁) + sizeof l₂,
    from add_lt_add_right (lt_sizeof_cons' _ _) _,
    mem.decidable ⟨b, a⟩ l₂,
  haveI :=
    have sizeof l₁ + sizeof l₂ <
         sizeof (lists'.cons' a l₁) + sizeof l₂,
    by default_dec_tac,
    subset.decidable l₁ l₂,
  exact decidable_of_iff' _ (@lists'.cons_subset _ ⟨_, _⟩ _ _)
end
with mem.decidable : ∀ (a : lists α) (l : lists' α tt), decidable (a ∈ l)
| a lists'.nil := is_false $ by rintro ⟨_, ⟨⟩, _⟩
| a (lists'.cons' b l₂) := begin
  haveI :=
    have sizeof a + sizeof (⟨_, b⟩ : lists α) <
         sizeof a + sizeof (lists'.cons' b l₂),
    from add_lt_add_left (lt_sizeof_cons' _ _) _,
    equiv.decidable a ⟨_, b⟩,
  haveI :=
    have sizeof a + sizeof l₂ <
         sizeof a + sizeof (lists'.cons' b l₂),
    by default_dec_tac,
    mem.decidable a l₂,
  refine decidable_of_iff' (a ~ ⟨_, b⟩ ∨ a ∈ l₂) _,
  rw ← lists'.mem_cons, refl
end
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf equiv.decidable_meas⟩],
  dec_tac := `[assumption] }

end decidable

end lists

namespace lists'

theorem mem_equiv_left {l : lists' α tt} :
  ∀ {a a'}, a ~ a' → (a ∈ l ↔ a' ∈ l) :=
suffices ∀ {a a'}, a ~ a' → a ∈ l → a' ∈ l,
  from λ a a' e, ⟨this e, this e.symm⟩,
λ a₁ a₂ e₁ ⟨a₃, m₃, e₂⟩, ⟨_, m₃, e₁.symm.trans e₂⟩

theorem mem_of_subset {a} {l₁ l₂ : lists' α tt}
  (s : l₁ ⊆ l₂) : a ∈ l₁ → a ∈ l₂ | ⟨a', m, e⟩ :=
(mem_equiv_left e).2 (mem_of_subset' s m)

theorem subset.trans {l₁ l₂ l₃ : lists' α tt}
  (h₁ : l₁ ⊆ l₂) (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
subset_def.2 $ λ a₁ m₁, mem_of_subset h₂ $ mem_of_subset' h₁ m₁

end lists'

def finsets (α : Type*) := quotient (@lists.setoid α)

namespace finsets

instance : has_emptyc (finsets α) := ⟨⟦lists.of' lists'.nil⟧⟩

instance [decidable_eq α] : decidable_eq (finsets α) :=
by unfold finsets; apply_instance

end finsets