import linear_algebra.eigenspace

import to_mathlib_maybe.Hilbert_space
import to_mathlib_maybe.pTrace

import to_qShannon_theory_maybe.state
import to_qShannon_theory_maybe.entropy

open_locale tensor_product big_operators

notation `Trₑ ` ρ := bipartite.Tr₂ ρ

variables
{ℋₛ : Type} [complex_hilbert_space ℋₛ]
{ℋₑ : Type} [complex_hilbert_space ℋₑ]
{ℋₛₑ : Type} [complex_hilbert_space ℋₛₑ]
-- talk about relation between ℋₛₑ and the other two
-- to make progress with the error below (no guarantees).

/-
The people said: Hey, suppose you have two quantum states.
-/

variables
(ρₛ : module.End ℂ ℋₛ) [quantum_state ρₛ]
(ρₛ': module.End ℂ ℋₛ) [quantum_state ρₛ']

/-
Can we find a condition on the states
-/

def some_condition (ρₛ) (ρₛ') := sorry

/-
such that the theorem below is provable?
-/

example :
some_condition ρₛ ρₛ'
↔
∃ (U : module.End ℂ ℋₛₑ) [unitary U],
∃ (σₑ : module.End ℂ ℋₑ) [quantum_state σₑ],
U ∘ (ρₛ ⊗ σₑ) ∘ U† = ρₛ' ⊗ σₑ :=
begin
  sorry
end

/-
The paper says: I can prove something close.
-/

def condition := H(ρₛ) ≤ H(ρₛ')

example :
condition ρₛ ρₛ'
↔
∀ ε > 0,
∃ (U : module.End ℂ ℋₛₑ) [unitary U],
∃ (σₑ : module.End ℂ ℋₑ) [quantum_state σₑ],
Trₛ (U ∘ (ρₛ ⊗ σₑ) ∘ U†) = σₑ
∧
D(Trₑ (U ∘ (ρₛ ⊗ σₑ) ∘ U†), ρₛ') ≤ ε :=
begin
  sorry
end


structure A where
  a : Nat

structure B where
  a : Nat := 1
  b : Nat

structure C extends A, B

def f (b : Nat) : C :=
  { b }

theorem ex (b : Nat) : (f b).a = 1 :=
  rfl


import linear_algebra.finite_dimensional
import linear_algebra.basic

variables {K V : Type*} [field K] [add_comm_group V] [module K V]

open submodule finite_dimensional

lemma submodule.mkq_comp_sup_mod_surjective (S T : submodule K V) :
  function.surjective ((T.comap (T ⊔ S).subtype).mkq.comp
    (submodule.of_le (le_sup_right : _ ≤ T ⊔ S))) :=
begin
  rintro ⟨t,ht⟩, rw submodule.mem_sup at ht,
  obtain ⟨y,hy,z,hz,rfl⟩ := ht,
  use [z,hz],
  simp only [linear_map.coe_comp, function.comp_app, mkq_apply, quotient.quot_mk_eq_mk],
  rw [← sub_eq_zero, ← submodule.mkq_apply, ← submodule.mkq_apply,
    ← linear_map.map_sub, submodule.mkq_apply, submodule.quotient.mk_eq_zero],
  simp only [mem_comap, submodule.coe_subtype, add_subgroup_class.coe_sub, coe_of_le, coe_mk],
  convert (T.neg_mem hy), abel,
end

lemma submodule.finrank_le_one_of_not_linear_independent_aux (T : submodule K V)
  (S : set V) (v : V) (hv : v ∈ S) (hv' : v ∉ T)
  (h : ∀ (a : V) (ha : a ∈ S), ¬ linear_independent K ![T.mkq a, T.mkq v])
  (z : V) (hz : z ∈ span K S) :
  ∃ (c : K) (t : V) (ht : t ∈ T), z = c • v + t :=
begin
  apply span_induction hz,
  { intros x hx,
    specialize h x hx,
    rw fintype.not_linear_independent_iff at h,
    obtain ⟨g,h1,i,h2⟩ := h,
    simp only [fin.sum_univ_two, matrix.cons_val_zero, matrix.cons_val_one, matrix.head_cons] at h1,
    have hg0 : g 0 ≠ 0,
    { intro c, simp only [c, zero_smul, zero_add, smul_eq_zero] at h1,
      cases h1, fin_cases i; contradiction, apply hv', simpa using h1 },
    apply_fun (λ e, (g 0)⁻¹ • e) at h1,
    simp only [smul_add, ← mul_smul, inv_mul_cancel hg0, one_smul, smul_zero,
      ← linear_map.map_smul, ← linear_map.map_add] at h1,
    rw [submodule.mkq_apply, submodule.quotient.mk_eq_zero] at h1,
    refine ⟨-((g 0)⁻¹ * g 1), x + ((g 0)⁻¹ * g 1) • v, h1,_⟩,
    simp only [neg_smul], abel },
  { use [0,0,T.zero_mem, by simp] },
  { rintros u v ⟨c,t,ht,rfl⟩ ⟨d,s,hs,rfl⟩,
    use [(c + d),(t + s), T.add_mem ht hs],
    simp only [add_smul], abel },
  { rintros a v ⟨c,t,ht,rfl⟩, use [a * c, a • t, T.smul_mem a ht],
    simp only [mul_smul, smul_add] }
end

lemma submodule.surjective_of_not_linear_independent (T : submodule K V)
  (S : set V) (v : V) (hv : v ∈ S) (hv' : v ∉ T)
  (h : ∀ (a : V) (ha : a ∈ S), ¬ linear_independent K ![T.mkq a, T.mkq v]) :
let e1 : span K ({v} : set V) →ₗ[K] span K S := of_le (span_mono $ by simpa),
    e2 : (span K S) →ₗ[K] ↥(T ⊔ span K S) := of_le le_sup_right,
    e3 : ↥(T ⊔ span K S) →ₗ[K] (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) :=
      submodule.mkq _ in
function.surjective ((e3.comp e2).comp e1) :=
begin
  dsimp, rintros ⟨x,hx⟩,
  rw submodule.mem_sup at hx,
  obtain ⟨y,hy,z,hz,rfl⟩ := hx,
  obtain ⟨c,t,ht,rfl⟩ := T.finrank_le_one_of_not_linear_independent_aux S v hv hv' h z hz,
  dsimp,
  refine ⟨⟨c • v, _⟩, _⟩,
  { rw submodule.mem_span_singleton,
    refine ⟨c,rfl⟩ },
  rw [← sub_eq_zero, ← submodule.mkq_apply, ← submodule.mkq_apply, ← linear_map.map_sub,
    submodule.mkq_apply, submodule.quotient.mk_eq_zero],
  simp only [mem_comap, submodule.coe_subtype, add_subgroup_class.coe_sub, coe_of_le, coe_mk],
  convert T.add_mem (T.neg_mem ht) (T.neg_mem hy),
  abel,
end

lemma submodule.finite_dimensional_of_not_linear_independent (T : submodule K V)
  (S : set V) (v : V) (hv : v ∈ S) (hv' : v ∉ T)
  (h : ∀ (a : V) (ha : a ∈ S), ¬ linear_independent K ![T.mkq a, T.mkq v]) :
  finite_dimensional K (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) :=
begin
  let e1 : span K ({v} : set V) →ₗ[K] span K S := of_le (span_mono $ by simpa),
  let e2 : (span K S) →ₗ[K] ↥(T ⊔ span K S) := of_le le_sup_right,
  let e3 : ↥(T ⊔ span K S) →ₗ[K] (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) :=
    submodule.mkq _,
  let e := (e3.comp e2).comp e1,
  apply e.finite_dimensional_of_surjective,
  rw linear_map.range_eq_top,
  apply T.surjective_of_not_linear_independent,
  assumption',
end

lemma submodule.finrank_le_one_of_not_linear_independent (T : submodule K V)
  (S : set V) (v : V) (hv : v ∈ S) (hv' : v ∉ T)
  (h : ∀ (a : V) (ha : a ∈ S), ¬ linear_independent K ![T.mkq a, T.mkq v]) :
  finrank K (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) ≤ 1 :=
begin
  haveI : finite_dimensional K (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) :=
    T.finite_dimensional_of_not_linear_independent S v hv hv' h,
  rw finrank_le_one_iff,
  let e1 : span K ({v} : set V) →ₗ[K] span K S := of_le (span_mono $ by simpa),
  let e2 : (span K S) →ₗ[K] ↥(T ⊔ span K S) := of_le le_sup_right,
  let e3 : ↥(T ⊔ span K S) →ₗ[K] (↥(T ⊔ span K S) ⧸ T.comap (T ⊔ span K S).subtype) :=
    submodule.mkq _,
  let e := e3.comp e2,
  let v' : span K S := ⟨v, subset_span hv⟩,
  use e v',
  rintros ⟨w,hw⟩, rw submodule.mem_sup at hw, obtain ⟨y,hy,z,hz,rfl⟩ := hw,
  dsimp,
  dsimp only [← submodule.mkq_apply],
  let y' : ↥(T ⊔ span K S) := ⟨y,_⟩,
  let z' : ↥(T ⊔ span K S) := ⟨z,_⟩,
  change ∃ c, _ = submodule.mkq _ (y' + z'),
  have : (T.comap (T ⊔ span K S).subtype).mkq y' = 0,
  { simpa },
  simp only [linear_map.map_add, this, zero_add],
  obtain ⟨c,t,ht,hh⟩ :=
    submodule.finrank_le_one_of_not_linear_independent_aux T S v hv hv' h z hz,
  use c,
  dsimp,
  dsimp only [← submodule.mkq_apply],
  rw [← linear_map.map_smul, ← sub_eq_zero, ← linear_map.map_sub,
    submodule.mkq_apply, submodule.quotient.mk_eq_zero],
  simp only [mem_comap, submodule.coe_subtype, add_subgroup_class.coe_sub,
    coe_smul_of_tower, coe_of_le, subtype.coe_mk],
  rw hh, simpa,
  exact mem_sup_right hz,
  exact mem_sup_left hy,
end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.category.Top.open_nhds
import Mathlib.topology.sheaves.presheaf
import Mathlib.category_theory.limits.limits
import Mathlib.category_theory.limits.types
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

namespace Top.presheaf

/-- Stalks are functorial with respect to morphisms of presheaves over a fixed `X`. -/
def stalk_functor (C : Type u) [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (x : ↥X) : presheaf C X ⥤ C :=
  category_theory.functor.obj
      (category_theory.whiskering_left (topological_space.open_nhds xᵒᵖ) (topological_space.opens ↥Xᵒᵖ) C)
      (category_theory.functor.op (topological_space.open_nhds.inclusion x)) ⋙
    category_theory.limits.colim

/--
The stalk of a presheaf `F` at a point `x` is calculated as the colimit of the functor
nbhds x ⥤ opens F.X ⥤ C
-/
def stalk {C : Type u} [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (ℱ : presheaf C X) (x : ↥X) : C :=
  category_theory.functor.obj (stalk_functor C x) ℱ

@[simp] theorem stalk_functor_obj {C : Type u} [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (ℱ : presheaf C X) (x : ↥X) : category_theory.functor.obj (stalk_functor C x) ℱ = stalk ℱ x :=
  rfl

/--
The germ of a section of a presheaf over an open at a point of that open.
-/
def germ {C : Type u} [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (F : presheaf C X) {U : topological_space.opens ↥X} (x : ↥U) : category_theory.functor.obj F (opposite.op U) ⟶ stalk F ↑x :=
  category_theory.limits.colimit.ι
    (category_theory.functor.op (topological_space.open_nhds.inclusion (subtype.val x)) ⋙ F)
    (opposite.op { val := U, property := sorry })

/-- For a `Type` valued presheaf, every point in a stalk is a germ. -/
theorem germ_exist {X : Top} (F : presheaf (Type v) X) (x : ↥X) (t : stalk F x) : ∃ (U : topological_space.opens ↥X),
  ∃ (m : x ∈ U), ∃ (s : category_theory.functor.obj F (opposite.op U)), germ F { val := x, property := m } s = t := sorry

theorem germ_eq {X : Top} (F : presheaf (Type v) X) {U : topological_space.opens ↥X} {V : topological_space.opens ↥X} (x : ↥X) (mU : x ∈ U) (mV : x ∈ V) (s : category_theory.functor.obj F (opposite.op U)) (t : category_theory.functor.obj F (opposite.op V)) (h : germ F { val := x, property := mU } s = germ F { val := x, property := mV } t) : ∃ (W : topological_space.opens ↥X),
  ∃ (m : x ∈ W),
    ∃ (iU : W ⟶ U),
      ∃ (iV : W ⟶ V),
        category_theory.functor.map F (category_theory.has_hom.hom.op iU) s =
          category_theory.functor.map F (category_theory.has_hom.hom.op iV) t := sorry

@[simp] theorem germ_res {C : Type u} [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (F : presheaf C X) {U : topological_space.opens ↥X} {V : topological_space.opens ↥X} (i : U ⟶ V) (x : ↥U) : category_theory.functor.map F (category_theory.has_hom.hom.op i) ≫ germ F x = germ F (coe_fn i x) := sorry

@[simp] theorem germ_res_apply {X : Top} (F : presheaf (Type v) X) {U : topological_space.opens ↥X} {V : topological_space.opens ↥X} (i : U ⟶ V) (x : ↥U) (f : category_theory.functor.obj F (opposite.op V)) : germ F x (category_theory.functor.map F (category_theory.has_hom.hom.op i) f) = germ F (coe_fn i x) f := sorry

/-- A variant when the open sets are written in `(opens X)ᵒᵖ`. -/
@[simp] theorem germ_res_apply' {X : Top} (F : presheaf (Type v) X) {U : topological_space.opens ↥Xᵒᵖ} {V : topological_space.opens ↥Xᵒᵖ} (i : V ⟶ U) (x : ↥(opposite.unop U)) (f : category_theory.functor.obj F V) : germ F x (category_theory.functor.map F i f) = germ F (coe_fn (category_theory.has_hom.hom.unop i) x) f := sorry

theorem germ_ext {X : Top} {D : Type u} [category_theory.category D] [category_theory.concrete_category D] [category_theory.limits.has_colimits D] (F : presheaf D X) {U : topological_space.opens ↥X} {V : topological_space.opens ↥X} {x : ↥X} {hxU : x ∈ U} {hxV : x ∈ V} (W : topological_space.opens ↥X) (hxW : x ∈ W) (iWU : W ⟶ U) (iWV : W ⟶ V) {sU : ↥(category_theory.functor.obj F (opposite.op U))} {sV : ↥(category_theory.functor.obj F (opposite.op V))} (ih : coe_fn (category_theory.functor.map F (category_theory.has_hom.hom.op iWU)) sU =
  coe_fn (category_theory.functor.map F (category_theory.has_hom.hom.op iWV)) sV) : coe_fn (germ F { val := x, property := hxU }) sU = coe_fn (germ F { val := x, property := hxV }) sV := sorry

theorem stalk_hom_ext {C : Type u} [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (F : presheaf C X) {x : ↥X} {Y : C} {f₁ : stalk F x ⟶ Y} {f₂ : stalk F x ⟶ Y} (ih : ∀ (U : topological_space.opens ↥X) (hxU : x ∈ U),
  germ F { val := x, property := hxU } ≫ f₁ = germ F { val := x, property := hxU } ≫ f₂) : f₁ = f₂ := sorry

def stalk_pushforward (C : Type u) [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} {Y : Top} (f : X ⟶ Y) (ℱ : presheaf C X) (x : ↥X) : stalk (f _* ℱ) (coe_fn f x) ⟶ stalk ℱ x :=
  category_theory.functor.map category_theory.limits.colim
      (category_theory.whisker_right
        (category_theory.nat_trans.op (category_theory.iso.inv (topological_space.open_nhds.inclusion_map_iso f x))) ℱ) ≫
    category_theory.limits.colimit.pre
      (category_theory.functor.obj
        (category_theory.functor.obj
          (category_theory.whiskering_left (topological_space.open_nhds xᵒᵖ) (topological_space.opens ↥Xᵒᵖ) C)
          (category_theory.functor.op (topological_space.open_nhds.inclusion x)))
        ℱ)
      (category_theory.functor.op (topological_space.open_nhds.map f x))

-- Here are two other potential solutions, suggested by @fpvandoorn at

-- <https://github.com/leanprover-community/mathlib/pull/1018#discussion_r283978240>

-- However, I can't get the subsequent two proofs to work with either one.

-- def stalk_pushforward (f : X ⟶ Y) (ℱ : X.presheaf C) (x : X) : (f _* ℱ).stalk (f x) ⟶ ℱ.stalk x :=

-- colim.map ((functor.associator _ _ _).inv ≫

--   whisker_right (nat_trans.op (open_nhds.inclusion_map_iso f x).inv) ℱ) ≫

-- colimit.pre ((open_nhds.inclusion x).op ⋙ ℱ) (open_nhds.map f x).op

-- def stalk_pushforward (f : X ⟶ Y) (ℱ : X.presheaf C) (x : X) : (f _* ℱ).stalk (f x) ⟶ ℱ.stalk x :=

-- (colim.map (whisker_right (nat_trans.op (open_nhds.inclusion_map_iso f x).inv) ℱ) :

--   colim.obj ((open_nhds.inclusion (f x) ⋙ opens.map f).op ⋙ ℱ) ⟶ _) ≫

-- colimit.pre ((open_nhds.inclusion x).op ⋙ ℱ) (open_nhds.map f x).op

namespace stalk_pushforward

@[simp] theorem id (C : Type u) [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} (ℱ : presheaf C X) (x : ↥X) : stalk_pushforward C 𝟙 ℱ x = category_theory.functor.map (stalk_functor C x) (category_theory.iso.hom (pushforward.id ℱ)) := sorry

-- This proof is sadly not at all robust:

-- having to use `erw` at all is a bad sign.

@[simp] theorem comp (C : Type u) [category_theory.category C] [category_theory.limits.has_colimits C] {X : Top} {Y : Top} {Z : Top} (ℱ : presheaf C X) (f : X ⟶ Y) (g : Y ⟶ Z) (x : ↥X) : stalk_pushforward C (f ≫ g) ℱ x = stalk_pushforward C g (f _* ℱ) (coe_fn f x) ≫ stalk_pushforward C f ℱ x := sorry


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.defs
import Mathlib.group_theory.group_action.group
import Mathlib.group_theory.coset
import Mathlib.PostPort

universes u v u_1 w

namespace Mathlib

/-!
# Basic properties of group actions
-/

namespace mul_action

/-- The orbit of an element under an action. -/
def orbit (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) : set β :=
  set.range fun (x : α) => x • b

theorem mem_orbit_iff {α : Type u} {β : Type v} [monoid α] [mul_action α β] {b₁ : β} {b₂ : β} : b₂ ∈ orbit α b₁ ↔ ∃ (x : α), x • b₁ = b₂ :=
  iff.rfl

@[simp] theorem mem_orbit {α : Type u} {β : Type v} [monoid α] [mul_action α β] (b : β) (x : α) : x • b ∈ orbit α b :=
  Exists.intro x rfl

@[simp] theorem mem_orbit_self {α : Type u} {β : Type v} [monoid α] [mul_action α β] (b : β) : b ∈ orbit α b := sorry

/-- The stabilizer of an element under an action, i.e. what sends the element to itself. Note
that this is a set: for the group stabilizer see `stabilizer`. -/
def stabilizer_carrier (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) : set α :=
  set_of fun (x : α) => x • b = b

@[simp] theorem mem_stabilizer_iff {α : Type u} {β : Type v} [monoid α] [mul_action α β] {b : β} {x : α} : x ∈ stabilizer_carrier α b ↔ x • b = b :=
  iff.rfl

/-- The set of elements fixed under the whole action. -/
def fixed_points (α : Type u) (β : Type v) [monoid α] [mul_action α β] : set β :=
  set_of fun (b : β) => ∀ (x : α), x • b = b

/-- `fixed_by g` is the subfield of elements fixed by `g`. -/
def fixed_by (α : Type u) (β : Type v) [monoid α] [mul_action α β] (g : α) : set β :=
  set_of fun (x : β) => g • x = x

theorem fixed_eq_Inter_fixed_by (α : Type u) (β : Type v) [monoid α] [mul_action α β] : fixed_points α β = set.Inter fun (g : α) => fixed_by α β g := sorry

@[simp] theorem mem_fixed_points {α : Type u} (β : Type v) [monoid α] [mul_action α β] {b : β} : b ∈ fixed_points α β ↔ ∀ (x : α), x • b = b :=
  iff.rfl

@[simp] theorem mem_fixed_by {α : Type u} (β : Type v) [monoid α] [mul_action α β] {g : α} {b : β} : b ∈ fixed_by α β g ↔ g • b = b :=
  iff.rfl

theorem mem_fixed_points' {α : Type u} (β : Type v) [monoid α] [mul_action α β] {b : β} : b ∈ fixed_points α β ↔ ∀ (b' : β), b' ∈ orbit α b → b' = b := sorry

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
def stabilizer.submonoid (α : Type u) {β : Type v} [monoid α] [mul_action α β] (b : β) : submonoid α :=
  submonoid.mk (stabilizer_carrier α b) (one_smul α b) sorry

end mul_action

namespace mul_action

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
def stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) : subgroup α :=
  subgroup.mk (submonoid.carrier sorry) sorry sorry sorry

theorem orbit_eq_iff {α : Type u} {β : Type v} [group α] [mul_action α β] {a : β} {b : β} : orbit α a = orbit α b ↔ a ∈ orbit α b := sorry

/-- The stabilizer of a point `b` as a subgroup of `α`. -/
def stabilizer.subgroup (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) : subgroup α :=
  subgroup.mk (submonoid.carrier (stabilizer.submonoid α b)) sorry sorry sorry

@[simp] theorem mem_orbit_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (g : α) (a : β) : a ∈ orbit α (g • a) := sorry

@[simp] theorem smul_mem_orbit_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (g : α) (h : α) (a : β) : g • a ∈ orbit α (h • a) := sorry

/-- The relation "in the same orbit". -/
def orbit_rel (α : Type u) (β : Type v) [group α] [mul_action α β] : setoid β :=
  setoid.mk (fun (a b : β) => a ∈ orbit α b) sorry

/-- Action on left cosets. -/
def mul_left_cosets {α : Type u} [group α] (H : subgroup α) (x : α) (y : quotient_group.quotient H) : quotient_group.quotient H :=
  quotient.lift_on' y (fun (y : α) => quotient_group.mk (x * y)) sorry

protected instance quotient {α : Type u} [group α] (H : subgroup α) : mul_action α (quotient_group.quotient H) :=
  mk sorry sorry

@[simp] theorem quotient.smul_mk {α : Type u} [group α] (H : subgroup α) (a : α) (x : α) : a • quotient_group.mk x = quotient_group.mk (a * x) :=
  rfl

@[simp] theorem quotient.smul_coe {α : Type u_1} [comm_group α] (H : subgroup α) (a : α) (x : α) : a • ↑x = ↑(a * x) :=
  rfl

protected instance mul_left_cosets_comp_subtype_val {α : Type u} [group α] (H : subgroup α) (I : subgroup α) : mul_action (↥I) (quotient_group.quotient H) :=
  comp_hom (quotient_group.quotient H) (subgroup.subtype I)

/-- The canonical map from the quotient of the stabilizer to the set. -/
def of_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β) (g : quotient_group.quotient (stabilizer α x)) : β :=
  quotient.lift_on' g (fun (_x : α) => _x • x) sorry

@[simp] theorem of_quotient_stabilizer_mk (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β) (g : α) : of_quotient_stabilizer α x (quotient_group.mk g) = g • x :=
  rfl

theorem of_quotient_stabilizer_mem_orbit (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β) (g : quotient_group.quotient (stabilizer α x)) : of_quotient_stabilizer α x g ∈ orbit α x :=
  quotient.induction_on' g fun (g : α) => Exists.intro g rfl

theorem of_quotient_stabilizer_smul (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β) (g : α) (g' : quotient_group.quotient (stabilizer α x)) : of_quotient_stabilizer α x (g • g') = g • of_quotient_stabilizer α x g' :=
  quotient.induction_on' g' fun (_x : α) => mul_smul g _x x

theorem injective_of_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (x : β) : function.injective (of_quotient_stabilizer α x) := sorry

/-- Orbit-stabilizer theorem. -/
def orbit_equiv_quotient_stabilizer (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) : ↥(orbit α b) ≃ quotient_group.quotient (stabilizer α b) :=
  equiv.symm
    (equiv.of_bijective
      (fun (g : quotient_group.quotient (stabilizer α b)) =>
        { val := of_quotient_stabilizer α b g, property := of_quotient_stabilizer_mem_orbit α b g })
      sorry)

@[simp] theorem orbit_equiv_quotient_stabilizer_symm_apply (α : Type u) {β : Type v} [group α] [mul_action α β] (b : β) (a : α) : ↑(coe_fn (equiv.symm (orbit_equiv_quotient_stabilizer α b)) ↑a) = a • b :=
  rfl

end mul_action

theorem list.smul_sum {α : Type u} {β : Type v} [monoid α] [add_monoid β] [distrib_mul_action α β] {r : α} {l : List β} : r • list.sum l = list.sum (list.map (has_scalar.smul r) l) :=
  add_monoid_hom.map_list_sum (const_smul_hom β r) l

theorem multiset.smul_sum {α : Type u} {β : Type v} [monoid α] [add_comm_monoid β] [distrib_mul_action α β] {r : α} {s : multiset β} : r • multiset.sum s = multiset.sum (multiset.map (has_scalar.smul r) s) :=
  add_monoid_hom.map_multiset_sum (const_smul_hom β r) s

theorem finset.smul_sum {α : Type u} {β : Type v} {γ : Type w} [monoid α] [add_comm_monoid β] [distrib_mul_action α β] {r : α} {f : γ → β} {s : finset γ} : (r • finset.sum s fun (x : γ) => f x) = finset.sum s fun (x : γ) => r • f x :=
  add_monoid_hom.map_sum (const_smul_hom β r) f s


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.meta_defs
import Mathlib.tactic.norm_num
import Mathlib.data.tree
import Mathlib.meta.expr
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# A tactic for canceling numeric denominators

This file defines tactics that cancel numeric denominators from field expressions.

As an example, we want to transform a comparison `5*(a/3 + b/4) < c/3` into the equivalent
`5*(4*a + 3*b) < 4*c`.

## Implementation notes

The tooling here was originally written for `linarith`, not intended as an interactive tactic.
The interactive version has been split off because it is sometimes convenient to use on its own.
There are likely some rough edges to it.

Improving this tactic would be a good project for someone interested in learning tactic programming.
-/

namespace cancel_factors

/-! ### Lemmas used in the procedure -/

theorem mul_subst {α : Type u_1} [comm_ring α] {n1 : α} {n2 : α} {k : α} {e1 : α} {e2 : α} {t1 : α}
    {t2 : α} (h1 : n1 * e1 = t1) (h2 : n2 * e2 = t2) (h3 : n1 * n2 = k) : k * (e1 * e2) = t1 * t2 :=
  sorry

theorem div_subst {α : Type u_1} [field α] {n1 : α} {n2 : α} {k : α} {e1 : α} {e2 : α} {t1 : α}
    (h1 : n1 * e1 = t1) (h2 : n2 / e2 = 1) (h3 : n1 * n2 = k) : k * (e1 / e2) = t1 :=
  sorry

theorem cancel_factors_eq_div {α : Type u_1} [field α] {n : α} {e : α} {e' : α} (h : n * e = e')
    (h2 : n ≠ 0) : e = e' / n :=
  eq_div_of_mul_eq h2 (eq.mp (Eq._oldrec (Eq.refl (n * e = e')) (mul_comm n e)) h)

theorem add_subst {α : Type u_1} [ring α] {n : α} {e1 : α} {e2 : α} {t1 : α} {t2 : α}
    (h1 : n * e1 = t1) (h2 : n * e2 = t2) : n * (e1 + e2) = t1 + t2 :=
  sorry

theorem sub_subst {α : Type u_1} [ring α] {n : α} {e1 : α} {e2 : α} {t1 : α} {t2 : α}
    (h1 : n * e1 = t1) (h2 : n * e2 = t2) : n * (e1 - e2) = t1 - t2 :=
  sorry

theorem neg_subst {α : Type u_1} [ring α] {n : α} {e : α} {t : α} (h1 : n * e = t) : n * -e = -t :=
  sorry

theorem cancel_factors_lt {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α}
    {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd)
    (hgcd : 0 < gcd) : a < b = (1 / gcd * (bd * a') < 1 / gcd * (ad * b')) :=
  sorry

theorem cancel_factors_le {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α}
    {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd)
    (hgcd : 0 < gcd) : a ≤ b = (1 / gcd * (bd * a') ≤ 1 / gcd * (ad * b')) :=
  sorry

theorem cancel_factors_eq {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α}
    {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd)
    (hgcd : 0 < gcd) : a = b = (1 / gcd * (bd * a') = 1 / gcd * (ad * b')) :=
  sorry

/-! ### Computing cancelation factors -/

/--
`find_cancel_factor e` produces a natural number `n`, such that multiplying `e` by `n` will
be able to cancel all the numeric denominators in `e`. The returned `tree` describes how to
distribute the value `n` over products inside `e`.
-/
/--
`mk_prod_prf n tr e` produces a proof of `n*e = e'`, where numeric denominators have been
canceled in `e'`, distributing `n` proportionally according to `tr`.
-/
/--
Given `e`, a term with rational division, produces a natural number `n` and a proof of `n*e = e'`,
where `e'` has no division. Assumes "well-behaved" division.
-/
/--
Given `e`, a term with rational divison, produces a natural number `n` and a proof of `e = e' / n`,
where `e'` has no divison. Assumes "well-behaved" division.
-/
/--
`find_comp_lemma e` arranges `e` in the form `lhs R rhs`, where `R ∈ {<, ≤, =}`, and returns
`lhs`, `rhs`, and the `cancel_factors` lemma corresponding to `R`.
-/
/--
`cancel_denominators_in_type h` assumes that `h` is of the form `lhs R rhs`,
where `R ∈ {<, ≤, =, ≥, >}`.
It produces an expression `h'` of the form `lhs' R rhs'` and a proof that `h = h'`.
Numeric denominators have been canceled in `lhs'` and `rhs'`.
-/
end cancel_factors

/-! ### Interactive version -/

/--
`cancel_denoms` attempts to remove numerals from the denominators of fractions.
It works on propositions that are field-valued inequalities.

```lean
variables {α : Type} [linear_ordered_field α] (a b c : α)

example (h : a / 5 + b / 4 < c) : 4*a + 5*b < 20*c :=
begin
  cancel_denoms at h,
  exact h
end

example (h : a > 0) : a / 5 > 0 :=
begin
  cancel_denoms,
  exact h
end
```
-/
end Mathlib


import M4R.Algebra.Ring.Ring

namespace M4R

  class NCField (α : Type _) extends NonTrivialNCRing α where
    inv     : ∀ {a : α}, a ≠ 0 → α
    mul_inv : ∀ {a : α}, (h : a ≠ 0) → a * (inv h) = 1
    inv_mul : ∀ {a : α}, (h : a ≠ 0) → (inv h) * a = 1

  class Field (α : Type _) extends NCField α, Ring α

  class NCIntegralDomain (α : Type _) extends NonTrivialNCRing α where
    integral : ∀ {a b : α}, a ≠ 0 → b ≠ 0 → a * b ≠ 0

  class IntegralDomain (α : Type _) extends NCIntegralDomain α, Ring α

  namespace NCField
    open NCSemiring NonTrivial

    instance toNonTrivialRing (α : Type _) [Field α] : NonTrivialRing α where
      toNonTrivial := Field.toNCField.toNonTrivial

    theorem inv_nonzero [NCField α] : ∀ {a : α}, (h : a ≠ 0) → inv h ≠ 0 := by
      intro a h hi
      have := mul_inv h
      rw [hi, mul_zero] at this
      exact one_neq_zero this.symm

    theorem mul_right_cancel [NCField α] {a b c : α} (h : c ≠ 0) : a * c = b * c ↔ a = b :=
      ⟨fun hab => by rw [←mul_one a, ←mul_one b, ←mul_inv h, ←mul_assoc, ←mul_assoc, hab],
        fun hab => by rw [hab]⟩

    theorem inv_inv [NCField α] : ∀ {a : α}, (h : a ≠ 0) → inv (inv_nonzero h) = a :=
      fun h => by rw [←mul_right_cancel (inv_nonzero h), inv_mul, mul_inv]

    theorem integral [NCField α] : ∀ {a b : α}, a ≠ 0 → b ≠ 0 → a * b ≠ 0 := by
      intro a b ha hb hab
      rw [←zero_mul b, mul_right_cancel hb] at hab
      exact ha hab

    theorem inv_of_mul [NCField α] {a b : α} (ha : a ≠ 0) (hb : b ≠ 0) :
      inv (integral ha hb) = (inv hb) * (inv ha) := by
        rw [←mul_right_cancel ha, mul_assoc, inv_mul, mul_one, ←mul_right_cancel hb, inv_mul, mul_assoc]
        exact inv_mul (integral ha hb)

  end NCField

  namespace Field
    open NCField Semiring

    theorem nonzero_unit [Field α] {a : α} (ha : a ≠ 0) : isUnit a := ⟨inv ha, mul_inv ha⟩

  end Field

  namespace NCIntegralDomain

    theorem integral' [NCIntegralDomain α] {a b : α} (h : a * b = 0) : a = 0 ∨ b = 0 := by
      byCases ha : a = 0
      { exact Or.inl ha }
      { byCases hb : b = 0;
        { exact Or.inr hb }
        { exact absurd h (integral ha hb) } }

  end NCIntegralDomain

  open NonTrivial NCField

  def Ring.is_Field (α : Type _) [Ring α] : Prop := is_NonTrivial α ∧ ∀ {a : α}, (h : a ≠ 0) → ∃ b, a * b = 1
  noncomputable def Ring.is_Field.toField [Ring α] (h : is_Field α) : Field α where
    toNonTrivial.one_neq_zero := h.left
    mul_comm := mul_comm
    inv := fun ha => Classical.choose (h.right ha)
    mul_inv := fun ha => Classical.choose_spec (h.right ha)
    inv_mul := fun ha => by rw [mul_comm]; exact Classical.choose_spec (h.right ha)
  theorem Field.to_is_Field [Field α] : Ring.is_Field α :=
    ⟨one_neq_zero, fun ha => ⟨inv ha, mul_inv ha⟩⟩

  def Ring.is_IntegralDomain (α : Type _) [Ring α] : Prop := is_NonTrivial α ∧ ∀ {a b : α}, a ≠ 0 → b ≠ 0 → a * b ≠ 0
  def Ring.is_IntegralDomain.toIntegralDomain [Ring α] (h : is_IntegralDomain α) : IntegralDomain α where
    toNonTrivial.one_neq_zero := h.left
    mul_comm := mul_comm
    integral := h.right
  theorem IntegralDomain.to_is_IntegralDomain [i : IntegralDomain α] : Ring.is_IntegralDomain α :=
    ⟨i.toNonTrivial.one_neq_zero, i.integral⟩

  instance IntegralDomain.toNonTrivialRing (α : Type _) [IntegralDomain α] : NonTrivialRing α where
      toNonTrivial := IntegralDomain.toNCIntegralDomain.toNonTrivial
  instance NCField.toNCIntegralDomain (α : Type _) [NCField α] : NCIntegralDomain α where
    integral := NCField.integral
  def Field.to_is_IntegralDomain (α : Type _) [Field α] : Ring.is_IntegralDomain α :=
    ⟨one_neq_zero, integral⟩
  instance Field.toIntegralDomain (α : Type _) [Field α] : IntegralDomain α :=
    (to_is_IntegralDomain α).toIntegralDomain

end M4R


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.suggest
import data.nat.basic

namespace test.library_search

/- Turn off trace messages so they don't pollute the test build: -/
set_option trace.silence_library_search true
/- For debugging purposes, we can display the list of lemmas: -/
-- set_option trace.suggest true

def lt_one (n : ℕ) := n < 1
lemma zero_lt_one (n : ℕ) (h : n = 0) : lt_one n := by subst h; dsimp [lt_one]; simp

-- Verify that calls to solve_by_elim to discharge subgoals use `rfl`
example : lt_one 0 :=
by library_search

example {n m : ℕ} (h : m < n) : m ≤ n - 1 :=
by library_search -- says: `exact nat.le_pred_of_lt h`

example (a b : ℕ) : 0 < a → 0 < b → 0 < a + b :=
by library_search -- says: `exact add_pos`

section synonym

-- Synonym `>` for `<` in the goal
example (a b : ℕ) : 0 < a → 0 < b → a + b > 0 :=
by library_search -- says: `exact add_pos`

-- Synonym `>` for `<` in another part of the goal
example (a b : ℕ) : a > 0 → 0 < b → 0 < a + b :=
by library_search -- says: `exact add_pos`

end synonym

example {a b c : ℕ} (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c :=
by library_search -- exact mul_dvd_mul_left a w

-- We have control of how `library_search` uses `solve_by_elim`.

-- In particular, we can add extra lemmas to the `solve_by_elim` step
-- (i.e. for `library_search` to use to attempt to discharge subgoals
-- after successfully applying a lemma from the library.)
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search [add_lt_add], -- Says: `exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end

-- We can also use attributes:
meta def ex_attr : user_attribute := {
  name := `ex,
  descr := "A lemma that should be applied by `library_search` when discharging subgoals."
}

run_cmd attribute.register ``ex_attr

attribute [ex] add_lt_add

example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search with ex, -- Says: `exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end

example (a b : ℕ) (h : 0 < b) : (a * b) / b = a :=
by library_search -- Says: `exact nat.mul_div_left a h`

example (a b : ℕ) (h : b ≠ 0) : (a * b) / b = a :=
begin
  success_if_fail { library_search },
  library_search [pos_iff_ne_zero.mpr],
end

end test.library_search


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u_1

namespace Mathlib

theorem punit_eq (a : PUnit) (b : PUnit) : a = b := punit.rec_on a (punit.rec_on b rfl)

theorem punit_eq_star (a : PUnit) : a = PUnit.unit := punit_eq a PUnit.unit

protected instance punit.subsingleton : subsingleton PUnit := subsingleton.intro punit_eq

protected instance punit.inhabited : Inhabited PUnit := { default := PUnit.unit }

protected instance punit.decidable_eq : DecidableEq PUnit :=
  fun (a b : PUnit) => is_true (punit_eq a b)

end Mathlib


import topology.connected
import topology.separation

universe u

def I_type (α : Type u) [topological_space α] :=
  {fI : α → bool // continuous fI}

def map_to_I (α : Type u) [topological_space α] : α → (Π (i : {fI : α → bool // continuous fI}), (function.const {fI : α → bool // continuous fI} bool) i) :=
  λ a i, ((coe : {fI : α → bool // continuous fI} → (α → bool)) i) a

def map_to_I' (α : Type u) [topological_space α] : α → ({fI : α → bool // continuous fI} → bool) :=
  λ a i, ((coe : {fI : α → bool // continuous fI} → (α → bool)) i) a

lemma inj_to_prod' (α : Type u) [topological_space α] [totally_separated_space α] :
  continuous (map_to_I' α) ∧ function.injective (map_to_I' α) :=
begin
  let I := {fI : α → bool // continuous fI},
  let f : α → (I → bool) := map_to_I' α,
  have hf : f = map_to_I' α := by triv,
  split,
  { refine continuous_pi _,
    intros i,
    cases i, assumption, },
  { rw ← hf,
    intros a b hab,
    let s : set α := {a, b},
    have h : ∀ fi : α → bool, continuous fi → ∀ x ∈ s, ∀ y ∈ s, fi x = fi y,
    { intros fi hfi x hx y hy,
      cases hx, cases hy, work_on_goal 1 { induction hy, induction hx, refl }, work_on_goal 1 { induction hy, induction hx, dsimp at * }, work_on_goal 2 { induction hx, cases hy, work_on_goal 1 { induction hy, dsimp at * }, work_on_goal 2 { induction hy, refl } },
      { let fi' : I := ⟨fi, hfi⟩,
        have hab' : f x fi' = f y fi' := by { rw hab },
        exact hab' },
      { let fi' : I := ⟨fi, hfi⟩,
        have hab' : f y fi' = f x fi' := by { rw hab },
        exact hab'.symm } },
    by_contra',
    have h' := exists_clopen_of_totally_separated this,
    obtain ⟨U, hU, h₁⟩ := h',
    let fi := set.bool_indicator U,
    specialize h (set.bool_indicator U) _ a _ b _,
    { exact (continuous_bool_indicator_iff_clopen U).mpr hU },
    { exact set.mem_insert a {b} },
    { exact set.mem_insert_of_mem a rfl },
    apply h₁.2,
    cases h₁, cases hU,
    rw (set.mem_iff_bool_indicator U a) at h₁_left,
    rw h₁_left at h,
    rw set.mem_iff_bool_indicator U b,
    exact h.symm, },
end

lemma inj_to_prod (α : Type u) [topological_space α] [totally_separated_space α] :
  ∃ (I : Type u), ∃ (f : α → (Π (i : I), (function.const I bool) i)), continuous f ∧
  function.injective f :=
begin
  let I := {fI : α → bool // continuous fI},
  use I,
  let f : α → (Π (i : I), (function.const I bool) i) := λ a i, ((coe : I → (α → bool)) i) a,
  use f,
  split,
  { refine continuous_pi _,
    intros i,
    cases i, assumption, },
  { intros a b hab,
    let s : set α := {a, b},
    have h : ∀ fi : α → bool, continuous fi → ∀ x ∈ s, ∀ y ∈ s, fi x = fi y,
    { intros fi hfi x hx y hy,
      cases hx, cases hy, work_on_goal 1 { induction hy, induction hx, refl }, work_on_goal 1 { induction hy, induction hx, dsimp at * }, work_on_goal 2 { induction hx, cases hy, work_on_goal 1 { induction hy, dsimp at * }, work_on_goal 2 { induction hy, refl } },
      { let fi' : I := ⟨fi, hfi⟩,
        have hab' : f x fi' = f y fi' := by { rw hab },
        exact hab' },
      { let fi' : I := ⟨fi, hfi⟩,
        have hab' : f y fi' = f x fi' := by { rw hab },
        exact hab'.symm } },
    by_contra',
    have h' := exists_clopen_of_totally_separated this,
    obtain ⟨U, hU, h₁⟩ := h',
    let fi := set.bool_indicator U,
    specialize h (set.bool_indicator U) _ a _ b _,
    { exact (continuous_bool_indicator_iff_clopen U).mpr hU },
    { exact set.mem_insert a {b} },
    { exact set.mem_insert_of_mem a rfl },
    apply h₁.2,
    cases h₁, cases hU,
    rw (set.mem_iff_bool_indicator U a) at h₁_left,
    rw h₁_left at h,
    rw set.mem_iff_bool_indicator U b,
    exact h.symm, },
end

lemma compact_finite_intersection {α S : Type*} {U : set α} [topological_space α] [compact_space α]
  (hU : is_open U) {F : S → set α} (hF : ∀ s : S, is_closed (F s)) (hFi : (⋂ s : S, F s) ⊆ U) :
  ∃ S₀ : finset S, (⋂ s ∈ S₀, (F s)) ⊆ U :=
begin
  have hUc : is_compact Uᶜ := is_closed.is_compact (is_closed_compl_iff.mpr hU),
  let UF : S → set α := λ s, (F s)ᶜ,
  have hUo : ∀ s : S, is_open (UF s) := λ s, is_open_compl_iff.mpr (hF s),
  have hsU : Uᶜ ⊆ ⋃ s : S, UF s,
  { rw set.Union_eq_compl_Inter_compl,
    rw set.compl_subset_compl,
    dsimp only [UF],
    intros x hx,
    simp at hx,
    apply hFi,
    exact set.mem_Inter.mpr hx },
  { obtain ⟨S₀, h⟩ := is_compact.elim_finite_subcover hUc UF hUo hsU,
    use S₀,
    rw ← set.compl_subset_compl,
    rw set.Inter_eq_compl_Union_compl,
    simp only [set.compl_Inter, set.compl_Union],
    simp only [UF] at h,
    intros u hu,
    obtain ⟨t, i, hi⟩ := h hu,
    use t,
    split,
    cases i,
    use i_w,
    simp only [compl_compl, set.Union_congr_Prop],
    exact i_h,
    exact hi, },
end

def quasicomponent {α : Type*} (x : α) [topological_space α] : set α :=
  ⋂ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, Z

lemma quasicomponent_eq_component_of_compact_space {α : Type*} (x : α) [topological_space α]
  [compact_space α] [t2_space α] : connected_component x = quasicomponent x :=
begin
  haveI h_normal : normal_space α := normal_of_compact_t2,
  haveI hQclosed : is_closed (quasicomponent x),
        { refine is_closed_Inter _,
          intros i,
          cases i,
          exact i_property.1.2 },
  haveI hQinQ : quasicomponent x ⊆ quasicomponent x := by tauto,
  haveI h' : x ∈ quasicomponent x,
      { unfold quasicomponent,
        refine set.mem_Inter.mpr _,
        intros i,
        cases i,
        exact i_property.2}, -- TODO: golf
  ext y,
  split,
  { intros hy,
    apply connected_component_subset_Inter_clopen,
    exact hy },
  { suffices h : is_preconnected (quasicomponent x),
    { unfold connected_component,
      intros hy,
      use quasicomponent x,
      split, split, exact h, exact h', exact hy},
    { rw is_preconnected_iff_subset_of_fully_disjoint_closed hQclosed,
      intros X₁ X₂ hX₁ hX₂ hX₁uX₂ hX₁nX₂,
      obtain ⟨U, V, h⟩ := normal_separation hX₁ hX₂ hX₁nX₂,
      have hUVc : closure U ⊆ Vᶜ,
      { rw is_closed.closure_subset_iff (is_closed_compl_iff.mpr h.2.1),
        exact disjoint.subset_compl_right h.2.2.2.2, },
      have hVUc : closure V ⊆ Uᶜ,
      { rw is_closed.closure_subset_iff (is_closed_compl_iff.mpr h.1),
        exact disjoint.subset_compl_right (h.2.2.2.2).symm, },
      -- let S := {s : set α // is_clopen s ∧ quasicomponent x ⊆ s ∧ s ⊆ U ∪ V},
      let S := {s : set α // is_clopen s ∧ x ∈ s},
      let F : S → set α := λ s, s,
      have hF : ∀ s : S, is_closed (F s),
      { intros s, cases s, exact s_property.1.2, },
      have hUV : is_open (U ∪ V) := is_open.union h.1 h.2.1,
      have h_inter : (⋂ (s : S), F s) ⊆ U ∪ V := λ a ha, set.union_subset_union h.2.2.1 h.2.2.2.1 (hX₁uX₂ ha),
      obtain ⟨S₀, hS₀⟩ := compact_finite_intersection hUV hF h_inter,
      let F' := (⋂ (s : S) (H : s ∈ S₀), (λ (s : S), F s) s),
      have hx : x ∈ X₁ ∪ X₂ := hX₁uX₂ h',
      cases hx,
      { left,
        have hFclopen : is_clopen F',
        { refine is_clopen_bInter_finset _,
          intros i hi,
          simp only [],
          cases i,
          exact i_property.1 },
        have hFU : is_clopen (U ∩ F'),
        { split, { exact is_open.inter h.1 (is_clopen.is_open hFclopen) },
          refine is_closed_of_closure_subset _,
          intros a ha,
          have hUVF : (U ∪ V) ∩ F' = F',
          { ext, split,
            exact λ hx1, (set.inter_subset_right (U ∪ V) F') hx1,
            intros hx1,
            split, exact hS₀ hx1, exact hx1 },
          have hUUV : (closure U) ∩ (U ∪ V) = U,
          { ext, split,
            { intros hx1,
              cases hx1.2, { exact h_1 },
              exfalso,
              exact hUVc hx1.1 h_1, },
            { intros hx1,
              split,
              exact subset_closure hx1,
              left,
              exact hx1 } },
          rw ← hUUV,
          rw set.inter_assoc,
          rw hUVF,
          rw ← is_closed.closure_eq hFclopen.2,
          exact closure_inter_subset_inter_closure U F' ha },
        have hQUF : quasicomponent x ⊆ U ∩ F',
        { have hxUF : x ∈ U ∩ F',
          { split,
            { exact h.2.2.1 hx },
            { simp only [set.mem_Inter, subtype.forall],
              intros a b hab,
              -- exact b.2.1 h'
              exact b.2 } },
          have hUF : U ∩ F' ∈ {Z : set α | is_clopen Z ∧ x ∈ Z} := ⟨hFU, hxUF⟩,
          unfold quasicomponent,
          intros x1 hx1,
          rw set.mem_Inter at hx1,
          exact hx1 ⟨(U ∩ F'), hUF⟩ },
        have hXQ : X₂ ∩ (quasicomponent x) = ∅,
        { apply set.eq_empty_of_subset_empty,
          intros a ha,
          have ha' := set.inter_subset_inter_right X₂ hQUF ha,
          have ha'' := set.inter_subset_inter_left (U ∩ F') h.2.2.2.1 ha',
          rw ← set.inter_assoc at ha'',
          rw set.inter_comm V U at ha'',
          rw (set.disjoint_iff_inter_eq_empty.mp h.2.2.2.2) at ha'',
          exact ha''.1 },
        intros a ha,
        cases hX₁uX₂ ha, { exact h_1 },
        exfalso,
        exact (set.ext_iff.mp hXQ a).mp ⟨h_1, ha⟩, },
      { right,
        have hFclopen : is_clopen F',
        { refine is_clopen_bInter_finset _,
          intros i hi,
          simp only [],
          cases i,
          exact i_property.1 },
        have hFU : is_clopen (V ∩ F'),
        { split, { exact is_open.inter h.2.1 (is_clopen.is_open hFclopen) },
          refine is_closed_of_closure_subset _,
          intros a ha,
          have hUVF : (U ∪ V) ∩ F' = F',
          { ext, split,
            exact λ hx1, (set.inter_subset_right (U ∪ V) F') hx1,
            intros hx1,
            split, exact hS₀ hx1, exact hx1 },
          have hUUV : (closure V) ∩ (U ∪ V) = V,
          { ext, split,
            { intros hx1,
              cases hx1.2, swap, { exact h_1 },
              exfalso,
              exact hVUc hx1.1 h_1, },
            { intros hx1,
              split,
              exact subset_closure hx1,
              right,
              exact hx1 } },
          rw ← hUUV,
          rw set.inter_assoc,
          rw hUVF,
          rw ← is_closed.closure_eq hFclopen.2,
          exact closure_inter_subset_inter_closure V F' ha },
        have hQUF : quasicomponent x ⊆ V ∩ F',
        { have hxUF : x ∈ V ∩ F',
          { split,
            { exact h.2.2.2.1 hx },
            { simp only [set.mem_Inter, subtype.forall],
              intros a b hab,
              -- exact b.2.1 h'
              exact b.2 } },
          have hUF : V ∩ F' ∈ {Z : set α | is_clopen Z ∧ x ∈ Z} := ⟨hFU, hxUF⟩,
          unfold quasicomponent,
          intros x1 hx1,
          rw set.mem_Inter at hx1,
          exact hx1 ⟨(V ∩ F'), hUF⟩ },
        have hXQ : X₁ ∩ (quasicomponent x) = ∅,
        { apply set.eq_empty_of_subset_empty,
          intros a ha,
          have ha' := set.inter_subset_inter_right X₁ hQUF ha,
          have ha'' := set.inter_subset_inter_left (V ∩ F') h.2.2.1 ha',
          rw ← set.inter_assoc at ha'',
          rw (set.disjoint_iff_inter_eq_empty.mp h.2.2.2.2) at ha'',
          exact ha''.1 },
        intros a ha,
        cases hX₁uX₂ ha, swap, { exact h_1 },
        exfalso,
        exact (set.ext_iff.mp hXQ a).mp ⟨h_1, ha⟩ } } },
end

instance totally_separated_of_totally_disconnected_compact_hausdorff (α : Type*)
  [topological_space α] [hc : compact_space α] [htd :totally_disconnected_space α] [hh : t2_space α] :
  totally_separated_space α :=
begin
  fconstructor,
  intros x hx y hy hxy,
  have hcompx : connected_component x = {x} :=
    totally_disconnected_space_iff_connected_component_singleton.mp htd x,
  have hcqx : connected_component x = quasicomponent x :=
    quasicomponent_eq_component_of_compact_space x,
  rw hcompx at hcqx,
  obtain ⟨V, Y, h⟩ := t2_separation hxy,
  let S := {s : set α // is_clopen s ∧ x ∈ s},
  let F : S → set α := λ s, s,
  have hF : ∀ s : S, is_closed (F s),
  { intros s, cases s, exact s_property.1.2, },
  have h_inter : (⋂ (s : S), F s) ⊆ V :=
    λ a ha, (set.singleton_subset_iff.mpr h.2.2.1) ((set.ext_iff.mp hcqx a).mpr ha),
  obtain ⟨S₀, hS₀⟩ := compact_finite_intersection h.1 hF h_inter,
  let U := (⋂ (s : S) (H : s ∈ S₀), (λ (s : S), F s) s),
  have hU : is_clopen U,
  { refine is_clopen_bInter_finset _,
    intros i hi,
    cases i,
    exact i_property.1 },
  have hxU : x ∈ U,
  { simp only [set.mem_Inter, subtype.forall],
    intros a b hab,
    exact b.2 },
  have hyUc : y ∈ Uᶜ, -- := λ hyU, h.2.2.2.2 ⟨(hS₀ hyU), h.2.2.2.1⟩,
  { intros hyU,
    have hy₁ := hS₀ hyU,
    have hy₂ := h.2.2.2.1,
    have : V ∩ Y ⊆ ∅ := set.subset_empty_iff.mpr (set.disjoint_iff_inter_eq_empty.mp h.2.2.2.2),
    exact this ⟨hy₁, hy₂⟩, },
  have huniv : set.univ ⊆ U ∪ Uᶜ := (set.subset.antisymm_iff.mp (set.union_compl_self U)).2,
  have hdisjoint : disjoint U Uᶜ := set.disjoint_iff_inter_eq_empty.mpr (set.inter_compl_self U),
  use U,
  use Uᶜ,
  exact ⟨hU.1, is_open_compl_iff.mpr hU.2, hxU, hyUc, huniv, hdisjoint⟩,
end


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Rémy Degenne
-/
import measure_theory.function.conditional_expectation.real

/-!
# Filtrations

This file defines filtrations of a measurable space and σ-finite filtrations.

## Main definitions

* `measure_theory.filtration`: a filtration on a measurable space. That is, a monotone sequence of
  sub-σ-algebras.
* `measure_theory.sigma_finite_filtration`: a filtration `f` is σ-finite with respect to a measure
  `μ` if for all `i`, `μ.trim (f.le i)` is σ-finite.
* `measure_theory.filtration.natural`: the smallest filtration that makes a process adapted. That
  notion `adapted` is not defined yet in this file. See `measure_theory.adapted`.

## Main results

* `measure_theory.filtration.complete_lattice`: filtrations are a complete lattice.

## Tags

filtration, stochastic process

-/

open filter order topological_space
open_locale classical measure_theory nnreal ennreal topology big_operators

namespace measure_theory

/-- A `filtration` on a measurable space `Ω` with σ-algebra `m` is a monotone
sequence of sub-σ-algebras of `m`. -/
structure filtration {Ω : Type*} (ι : Type*) [preorder ι] (m : measurable_space Ω) :=
(seq   : ι → measurable_space Ω)
(mono' : monotone seq)
(le'   : ∀ i : ι, seq i ≤ m)

variables {Ω β ι : Type*} {m : measurable_space Ω}

instance [preorder ι] : has_coe_to_fun (filtration ι m) (λ _, ι → measurable_space Ω) :=
⟨λ f, f.seq⟩

namespace filtration
variables [preorder ι]

protected lemma mono {i j : ι} (f : filtration ι m) (hij : i ≤ j) : f i ≤ f j := f.mono' hij

protected lemma le (f : filtration ι m) (i : ι) : f i ≤ m := f.le' i

@[ext] protected lemma ext {f g : filtration ι m} (h : (f : ι → measurable_space Ω) = g) : f = g :=
by { cases f, cases g, simp only, exact h, }

variable (ι)
/-- The constant filtration which is equal to `m` for all `i : ι`. -/
def const (m' : measurable_space Ω) (hm' : m' ≤ m) : filtration ι m :=
⟨λ _, m', monotone_const, λ _, hm'⟩
variable {ι}

@[simp]
lemma const_apply {m' : measurable_space Ω} {hm' : m' ≤ m} (i : ι) : const ι m' hm' i = m' := rfl

instance : inhabited (filtration ι m) := ⟨const ι m le_rfl⟩

instance : has_le (filtration ι m) := ⟨λ f g, ∀ i, f i ≤ g i⟩

instance : has_bot (filtration ι m) := ⟨const ι ⊥ bot_le⟩

instance : has_top (filtration ι m) := ⟨const ι m le_rfl⟩

instance : has_sup (filtration ι m) := ⟨λ f g,
{ seq   := λ i, f i ⊔ g i,
  mono' := λ i j hij, sup_le ((f.mono hij).trans le_sup_left) ((g.mono hij).trans le_sup_right),
  le'   := λ i, sup_le (f.le i) (g.le i) }⟩

@[norm_cast] lemma coe_fn_sup {f g : filtration ι m} : ⇑(f ⊔ g) = f ⊔ g := rfl

instance : has_inf (filtration ι m) := ⟨λ f g,
{ seq   := λ i, f i ⊓ g i,
  mono' := λ i j hij, le_inf (inf_le_left.trans (f.mono hij)) (inf_le_right.trans (g.mono hij)),
  le'   := λ i, inf_le_left.trans (f.le i) }⟩

@[norm_cast] lemma coe_fn_inf {f g : filtration ι m} : ⇑(f ⊓ g) = f ⊓ g := rfl

instance : has_Sup (filtration ι m) := ⟨λ s,
{ seq   := λ i, Sup ((λ f : filtration ι m, f i) '' s),
  mono' := λ i j hij,
  begin
    refine Sup_le (λ m' hm', _),
    rw [set.mem_image] at hm',
    obtain ⟨f, hf_mem, hfm'⟩ := hm',
    rw ← hfm',
    refine (f.mono hij).trans _,
    have hfj_mem : f j ∈ ((λ g : filtration ι m, g j) '' s), from ⟨f, hf_mem, rfl⟩,
    exact le_Sup hfj_mem,
  end,
  le'   := λ i,
  begin
    refine Sup_le (λ m' hm', _),
    rw [set.mem_image] at hm',
    obtain ⟨f, hf_mem, hfm'⟩ := hm',
    rw ← hfm',
    exact f.le i,
  end, }⟩

lemma Sup_def (s : set (filtration ι m)) (i : ι) :
  Sup s i = Sup ((λ f : filtration ι m, f i) '' s) :=
rfl

noncomputable
instance : has_Inf (filtration ι m) := ⟨λ s,
{ seq   := λ i, if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m,
  mono' := λ i j hij,
  begin
    by_cases h_nonempty : set.nonempty s,
    swap, { simp only [h_nonempty, set.nonempty_image_iff, if_false, le_refl], },
    simp only [h_nonempty, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
      forall_apply_eq_imp_iff₂],
    refine λ f hf_mem, le_trans _ (f.mono hij),
    have hfi_mem : f i ∈ ((λ g : filtration ι m, g i) '' s), from ⟨f, hf_mem, rfl⟩,
    exact Inf_le hfi_mem,
  end,
  le'   := λ i,
  begin
    by_cases h_nonempty : set.nonempty s,
    swap, { simp only [h_nonempty, if_false, le_refl], },
    simp only [h_nonempty, if_true],
    obtain ⟨f, hf_mem⟩ := h_nonempty,
    exact le_trans (Inf_le ⟨f, hf_mem, rfl⟩) (f.le i),
  end, }⟩

lemma Inf_def (s : set (filtration ι m)) (i : ι) :
  Inf s i = if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m :=
rfl

noncomputable
instance : complete_lattice (filtration ι m) :=
{ le           := (≤),
  le_refl      := λ f i, le_rfl,
  le_trans     := λ f g h h_fg h_gh i, (h_fg i).trans (h_gh i),
  le_antisymm  := λ f g h_fg h_gf, filtration.ext $ funext $ λ i, (h_fg i).antisymm (h_gf i),
  sup          := (⊔),
  le_sup_left  := λ f g i, le_sup_left,
  le_sup_right := λ f g i, le_sup_right,
  sup_le       := λ f g h h_fh h_gh i, sup_le (h_fh i) (h_gh _),
  inf          := (⊓),
  inf_le_left  := λ f g i, inf_le_left,
  inf_le_right := λ f g i, inf_le_right,
  le_inf       := λ f g h h_fg h_fh i, le_inf (h_fg i) (h_fh i),
  Sup          := Sup,
  le_Sup       := λ s f hf_mem i, le_Sup ⟨f, hf_mem, rfl⟩,
  Sup_le       := λ s f h_forall i, Sup_le $ λ m' hm',
  begin
    obtain ⟨g, hg_mem, hfm'⟩ := hm',
    rw ← hfm',
    exact h_forall g hg_mem i,
  end,
  Inf          := Inf,
  Inf_le       := λ s f hf_mem i,
  begin
    have hs : s.nonempty := ⟨f, hf_mem⟩,
    simp only [Inf_def, hs, if_true],
    exact Inf_le ⟨f, hf_mem, rfl⟩,
  end,
  le_Inf       := λ s f h_forall i,
  begin
    by_cases hs : s.nonempty,
    swap, { simp only [Inf_def, hs, if_false], exact f.le i, },
    simp only [Inf_def, hs, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
      forall_apply_eq_imp_iff₂],
    exact λ g hg_mem, h_forall g hg_mem i,
  end,
  top          := ⊤,
  bot          := ⊥,
  le_top       := λ f i, f.le' i,
  bot_le       := λ f i, bot_le, }

end filtration

lemma measurable_set_of_filtration [preorder ι] {f : filtration ι m} {s : set Ω} {i : ι}
  (hs : measurable_set[f i] s) : measurable_set[m] s :=
f.le i s hs

/-- A measure is σ-finite with respect to filtration if it is σ-finite with respect
to all the sub-σ-algebra of the filtration. -/
class sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m) : Prop :=
(sigma_finite : ∀ i : ι, sigma_finite (μ.trim (f.le i)))

instance sigma_finite_of_sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m)
  [hf : sigma_finite_filtration μ f] (i : ι) :
  sigma_finite (μ.trim (f.le i)) :=
by apply hf.sigma_finite -- can't exact here

@[priority 100]
instance is_finite_measure.sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m)
  [is_finite_measure μ] :
  sigma_finite_filtration μ f :=
⟨λ n, by apply_instance⟩

/-- Given a integrable function `g`, the conditional expectations of `g` with respect to a
filtration is uniformly integrable. -/
lemma integrable.uniform_integrable_condexp_filtration
  [preorder ι] {μ : measure Ω} [is_finite_measure μ] {f : filtration ι m}
  {g : Ω → ℝ} (hg : integrable g μ) :
  uniform_integrable (λ i, μ[g | f i]) 1 μ :=
hg.uniform_integrable_condexp f.le

section of_set

variables [preorder ι]

/-- Given a sequence of measurable sets `(sₙ)`, `filtration_of_set` is the smallest filtration
such that `sₙ` is measurable with respect to the `n`-the sub-σ-algebra in `filtration_of_set`. -/
def filtration_of_set {s : ι → set Ω} (hsm : ∀ i, measurable_set (s i)) : filtration ι m :=
{ seq := λ i, measurable_space.generate_from {t | ∃ j ≤ i, s j = t},
  mono' := λ n m hnm, measurable_space.generate_from_mono
    (λ t ⟨k, hk₁, hk₂⟩, ⟨k, hk₁.trans hnm, hk₂⟩),
  le' := λ n, measurable_space.generate_from_le (λ t ⟨k, hk₁, hk₂⟩, hk₂ ▸ hsm k) }

lemma measurable_set_filtration_of_set {s : ι → set Ω}
  (hsm : ∀ i, measurable_set[m] (s i)) (i : ι) {j : ι} (hj : j ≤ i) :
  measurable_set[filtration_of_set hsm i] (s j) :=
measurable_space.measurable_set_generate_from ⟨j, hj, rfl⟩

lemma measurable_set_filtration_of_set' {s : ι → set Ω}
  (hsm : ∀ n, measurable_set[m] (s n)) (i : ι) :
  measurable_set[filtration_of_set hsm i] (s i) :=
measurable_set_filtration_of_set hsm i le_rfl

end of_set

namespace filtration
variables [topological_space β] [metrizable_space β] [mβ : measurable_space β] [borel_space β]
  [preorder ι]

include mβ

/-- Given a sequence of functions, the natural filtration is the smallest sequence
of σ-algebras such that that sequence of functions is measurable with respect to
the filtration. -/
def natural (u : ι → Ω → β) (hum : ∀ i, strongly_measurable (u i)) : filtration ι m :=
{ seq   := λ i, ⨆ j ≤ i, measurable_space.comap (u j) mβ,
  mono' := λ i j hij, bsupr_mono $ λ k, ge_trans hij,
  le'   := λ i,
  begin
    refine supr₂_le _,
    rintros j hj s ⟨t, ht, rfl⟩,
    exact (hum j).measurable ht,
  end }

section

open measurable_space

lemma filtration_of_set_eq_natural [mul_zero_one_class β] [nontrivial β]
  {s : ι → set Ω} (hsm : ∀ i, measurable_set[m] (s i)) :
  filtration_of_set hsm = natural (λ i, (s i).indicator (λ ω, 1 : Ω → β))
    (λ i, strongly_measurable_one.indicator (hsm i)) :=
begin
  simp only [natural, filtration_of_set, measurable_space_supr_eq],
  ext1 i,
  refine le_antisymm (generate_from_le _) (generate_from_le _),
  { rintro _ ⟨j, hij, rfl⟩,
    refine measurable_set_generate_from ⟨j, measurable_set_generate_from ⟨hij, _⟩⟩,
    rw comap_eq_generate_from,
    refine measurable_set_generate_from ⟨{1}, measurable_set_singleton 1, _⟩,
    ext x,
    simp [set.indicator_const_preimage_eq_union] },
  { rintro t ⟨n, ht⟩,
    suffices : measurable_space.generate_from
      {t | ∃ (H : n ≤ i), measurable_set[(measurable_space.comap
        ((s n).indicator (λ ω, 1 : Ω → β)) mβ)] t}
      ≤ generate_from {t | ∃ (j : ι) (H : j ≤ i), s j = t},
    { exact this _ ht },
    refine generate_from_le _,
    rintro t ⟨hn, u, hu, hu'⟩,
    obtain heq | heq | heq | heq := set.indicator_const_preimage (s n) u (1 : β),
    swap 4, rw set.mem_singleton_iff at heq,
    all_goals { rw heq at hu', rw ← hu' },
    exacts [measurable_set_empty _, measurable_set.univ, measurable_set_generate_from ⟨n, hn, rfl⟩,
      measurable_set.compl (measurable_set_generate_from ⟨n, hn, rfl⟩)] }
end

end

section limit

omit mβ

variables {E : Type*} [has_zero E] [topological_space E]
  {ℱ : filtration ι m} {f : ι → Ω → E} {μ : measure Ω}

/-- Given a process `f` and a filtration `ℱ`, if `f` converges to some `g` almost everywhere and
`g` is `⨆ n, ℱ n`-measurable, then `limit_process f ℱ μ` chooses said `g`, else it returns 0.

This definition is used to phrase the a.e. martingale convergence theorem
`submartingale.ae_tendsto_limit_process` where an L¹-bounded submartingale `f` adapted to `ℱ`
converges to `limit_process f ℱ μ` `μ`-almost everywhere. -/
noncomputable
def limit_process (f : ι → Ω → E) (ℱ : filtration ι m) (μ : measure Ω . volume_tac) :=
if h : ∃ g : Ω → E, strongly_measurable[⨆ n, ℱ n] g ∧
  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 (g ω)) then classical.some h else 0

lemma strongly_measurable_limit_process :
  strongly_measurable[⨆ n, ℱ n] (limit_process f ℱ μ) :=
begin
  rw limit_process,
  split_ifs with h h,
  exacts [(classical.some_spec h).1, strongly_measurable_zero]
end

lemma strongly_measurable_limit_process' :
  strongly_measurable[m] (limit_process f ℱ μ) :=
strongly_measurable_limit_process.mono (Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _))

lemma mem_ℒp_limit_process_of_snorm_bdd {R : ℝ≥0} {p : ℝ≥0∞}
  {F : Type*} [normed_add_comm_group F] {ℱ : filtration ℕ m} {f : ℕ → Ω → F}
  (hfm : ∀ n, ae_strongly_measurable (f n) μ) (hbdd : ∀ n, snorm (f n) p μ ≤ R) :
  mem_ℒp (limit_process f ℱ μ) p μ :=
begin
  rw limit_process,
  split_ifs with h,
  { refine ⟨strongly_measurable.ae_strongly_measurable
      ((classical.some_spec h).1.mono (Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _))),
      lt_of_le_of_lt (Lp.snorm_lim_le_liminf_snorm hfm _ (classical.some_spec h).2)
        (lt_of_le_of_lt _ (ennreal.coe_lt_top : ↑R < ∞))⟩,
    simp_rw [liminf_eq, eventually_at_top],
    exact Sup_le (λ b ⟨a, ha⟩, (ha a le_rfl).trans (hbdd _)) },
  { exact zero_mem_ℒp }
end

end limit

end filtration

end measure_theory


import category_theory.isomorphism
import category_theory.category
import group_theory.category

open category_theory

universes v u

def subtype_val.group_hom {G : Group} {s : set G} [is_subgroup s]
  : Group.of s ⟶ G := ⟨subtype.val, subtype_val.is_group_hom⟩

instance is_group_hom.range_factorization {G H : Group} (φ : G → H) [is_group_hom φ]
  : is_group_hom (set.range_factorization φ) := is_group_hom.mk' $ by {
    intros x y, apply subtype.eq,
    rw subtype_val.is_group_hom.map_mul,
    transitivity φ (x * y), refl,
    transitivity φ x * φ y,
    apply is_mul_hom.map_mul, refl
  }

noncomputable
def Group.inj_im_iso {G H : Group} (φ : G ⟶ H) (h : function.injective φ)
  : G ≅ Group.of (set.range φ) := {
    hom := ⟨set.range_factorization φ, by apply_instance⟩,
    inv := ⟨λ x : Group.of (set.range φ), @function.inv_fun _ ⟨1⟩ _ φ x.val,
            is_group_hom.mk' $ λ x y, by {
              cases x with x hx, cases hx with a ha, subst ha,
              cases y with y hy, cases hy with b hb, subst hb,
              rw is_monoid_hom.map_mul subtype.val,
              simp, rw ← is_monoid_hom.map_mul φ,
              repeat { rw function.left_inverse_inv_fun },
              any_goals { assumption }, exact subtype_val.is_monoid_hom }⟩,
   hom_inv_id' := by intros; ext; apply @function.left_inverse_inv_fun; exact h,
   inv_hom_id' := by { intros, ext, unfold_coes, simp,
                       dsimp [set.range_factorization], apply subtype.eq, simp,
                       apply function.inv_fun_eq, exact x.property } }

def Group.surj_im_iso {G H : Group} (φ : G ⟶ H) (h : function.surjective φ)
  : Group.of (set.range φ) ≅ H := {
    hom := subtype_val.group_hom,
    inv := ⟨λ x, ⟨x, h x⟩, is_group_hom.mk' $ λ x y, subtype.eq $
                           by rw is_monoid_hom.map_mul subtype.val;
                              exact subtype_val.is_monoid_hom⟩ }

noncomputable
def Group.iso_of_bijective {G H : Group} (φ :  G ⟶ H) (h : function.bijective φ)
  := iso.trans (Group.inj_im_iso φ h.left) (Group.surj_im_iso φ h.right)

def Group.iso_left_inverse {G H : Group} (φ : G ≅ H)
  : function.left_inverse φ.inv φ.hom :=
  λ x, by { transitivity (φ.inv ∘ φ.hom) x, refl,
            transitivity id x, apply congr_fun,
            exact subtype.mk.inj φ.hom_inv_id, refl }

lemma Group.iso_inj {G H : Group} (φ : G ≅ H) : function.injective φ.hom :=
  function.injective_of_left_inverse (Group.iso_left_inverse φ)

def Group.iso_right_inverse {G H : Group} (φ : G ≅ H)
  : function.right_inverse φ.inv φ.hom :=
  Group.iso_left_inverse φ.symm

lemma Group.iso_surj {G H : Group} (φ : G ≅ H) : function.surjective φ.hom :=
  function.surjective_of_has_right_inverse ⟨_, Group.iso_right_inverse φ⟩

lemma Group.iso_bij  {G H : Group} (φ : G ≅ H) : function.bijective φ.hom :=
  ⟨Group.iso_inj φ, Group.iso_surj φ⟩

def Group.ker_of_inj_comp {G H H' : Group} (φ : G ⟶ H) (ψ : H ⟶ H')
  (h : function.injective ψ)
  : is_group_hom.ker (φ ≫ ψ) = is_group_hom.ker φ :=
begin
  unfold_coes, simp, dsimp [is_group_hom.ker],
  rw set.preimage_comp, congr,
  rw is_group_hom.inj_iff_trivial_ker ψ at h,
  assumption
end

def Group.ker_of_comp_inj {G H K : Group}
  (φ : G ⟶ K) (ψ : H ⟶ G) (h : function.injective ψ)
  : is_group_hom.ker (ψ ≫ φ) = ψ ⁻¹' is_group_hom.ker φ :=
  by apply set.preimage_comp

def Group.subsingleton_iso (G H : Group) [subsingleton G] [subsingleton H] : G ≅ H := {
  hom := ⟨λ x, 1, is_group_hom.mk' (λ x y, subsingleton.elim _ _)⟩,
  inv := ⟨λ x, 1, is_group_hom.mk' (λ x y, subsingleton.elim _ _)⟩
}

def pullback {A B C : Type _} (f : A → C) (g : B → C)
  := { p : A × B | f p.fst = g p.snd }

def pullback_of_inj_to_inter {A B C : Type _} {f : A → C} {g : B → C}
  (hf : function.injective f) (hg : function.injective g)
  : pullback f g → set.inter (set.range f) (set.range g) :=
  λ x, subtype.mk (f x.val.fst) $
      by { constructor, apply set.mem_range_self,
           rw (_ : f x.val.fst = g x.val.snd), apply set.mem_range_self,
           exact x.property }

lemma pullback_of_inj_to_inter_is_bijective {A B C : Type _} {f : A → C} {g : B → C}
  (hf : function.injective f) (hg : function.injective g)
  : function.bijective (pullback_of_inj_to_inter hf hg) :=
begin
  constructor,
  { intros x y hxy,
    cases x with x hx, cases x with x₁ x₂,
    cases y with y hy, cases y with y₁ y₂,
    simp, simp [pullback_of_inj_to_inter] at hxy,
    apply and.intro (hf hxy),
    apply hg, transitivity f x₁, exact hx.symm,
    rw hxy, exact hy },
  { intro y, cases y with y hy, cases hy with hy₁ hy₂,
    cases hy₁ with a ha, cases hy₂ with b hb,
    subst hb, use ⟨(a, b), ha⟩, exact subtype.eq ha }
end

noncomputable
def pullback_inj_fin {A B C : Type _} {f : A → C} {g : B → C}
  (hf : function.injective f) (hg : function.injective g) [fintype C]
  : fintype (pullback f g) :=
  fintype.of_injective (subtype.val ∘ pullback_of_inj_to_inter hf hg)
                       (function.injective_comp subtype.val_injective
                        $ and.left $ pullback_of_inj_to_inter_is_bijective hf hg)

local attribute [instance] classical.prop_decidable
lemma pullback_card_lt_of_conflict {A B C : Type _} {f : A → C} {g : B → C}
  (hf : function.injective f) (hg : function.injective g) [fintype C]
  (a : A) (hx : ∀ b : B, f a ≠ g b)
  : @fintype.card (pullback f g) (pullback_inj_fin hf hg) < fintype.card C := by {
    apply @nat.lt_of_le_of_lt _ (fintype.card (set.inter (set.range f) (set.range g))),
    apply fintype.card_le_of_injective,
    apply and.left (pullback_of_inj_to_inter_is_bijective hf hg),
    unfold_coes, rw fintype.subtype_card,
    apply finset.card_lt_card, rw finset.ssubset_iff,
    existsi f a, constructor,
    { rw finset.mem_filter, intro h, cases h,
      cases h_right, apply hx, symmetry, assumption },
    { intros x h, apply finset.mem_univ }
  }

instance {A B} [group A] [group B] : group (A × B) := {
  mul := λ p q, ⟨p.fst * q.fst, p.snd * q.snd⟩,
  one := ⟨1, 1⟩,
  inv := λ p, ⟨p.fst⁻¹, p.snd⁻¹⟩,
  mul_assoc := by { intros, simp, constructor; apply mul_assoc },
  one_mul := by intros p; apply prod.ext; apply one_mul,
  mul_one := by intros p; apply prod.ext; apply mul_one,
  mul_left_inv := by intros p; apply prod.ext; apply mul_left_inv
}

instance prod_fst.is_group_hom {α β} [group α] [group β]
  : is_group_hom (@prod.fst α β) := is_group_hom.mk' $ λ _ _, rfl
instance prod_snd.is_group_hom {α β} [group α] [group β]
  : is_group_hom (@prod.snd α β) := is_group_hom.mk' $ λ _ _, rfl

def Group.fst {A B : Group.{u}} : Group.of (A × B) ⟶ A :=
  ⟨prod.fst, by apply_instance⟩

def Group.snd {A B : Group.{u}} : Group.of (A × B) ⟶ B :=
  ⟨prod.snd, by apply_instance⟩

instance {A B C : Group} {f : A ⟶ C} {g : B ⟶ C}
   : is_subgroup (pullback f g) := {
   inv_mem := by { intros p h, cases p with x y, refine (_ : f x⁻¹ = g y⁻¹),
                   rw [is_group_hom.map_inv f, is_group_hom.map_inv g],
                   rw (_ : f x = g y), assumption },
   to_is_submonoid := {
     one_mem := eq.trans (is_monoid_hom.map_one f) $ eq.symm $ is_monoid_hom.map_one g,
     mul_mem := by { intros p q hp hq, cases p with p₁ p₂, cases q with q₁ q₂,
                     refine (_ : f (p₁ * q₁) = g (p₂ * q₂)),
                     rw [is_monoid_hom.map_mul f, is_monoid_hom.map_mul g],
                     congr; assumption } } }

def Group.pullback_of_isos_is_iso {G G' H H': Group} (iso : H ≅ H')
  (f : G ⟶ H) (f' : G' ⟶ H')
  : Group.of (pullback (f ≫ iso.hom) f') ≅ Group.of (pullback (f' ≫ iso.inv) f) := {
    hom := ⟨λ p, ⟨p.val.swap, show iso.inv (f' p.val.snd) = f (p.val.fst),
                              from eq.trans (eq.symm $ congr_arg iso.inv p.property)
                                            (Group.iso_left_inverse iso (f p.val.fst))⟩,
            is_group_hom.mk' $ λ x y, subtype.eq $ by cases x; cases x_val; cases y; cases y_val; refl⟩,
    inv := ⟨λ p, ⟨p.val.swap, show iso.hom (f p.val.snd) = f' (p.val.fst),
                              from eq.trans (eq.symm $ congr_arg iso.hom p.property)
                                            (Group.iso_left_inverse iso.symm (f' p.val.fst))⟩,
            is_group_hom.mk' $ λ x y, subtype.eq $ by cases x; cases x_val; cases y; cases y_val; refl⟩,
  }

lemma surj_im_normal {G H : Group}
  (φ : G ⟶ H) (h : function.surjective φ)
  (N : set G) [normal_subgroup N]
  : normal_subgroup (φ '' N) := normal_subgroup.mk $ by {
    intros n hn x, cases hn with y hn, cases hn with ha ha,
    subst ha, cases h x with b hb, subst hb,
    rw [← is_group_hom.map_inv φ, ← is_monoid_hom.map_mul φ, ← is_monoid_hom.map_mul φ],
    existsi b * y * b⁻¹, refine and.intro _ rfl,
    apply normal_subgroup.normal, assumption
  }

instance Group.inhabited {G} [group G] : inhabited G := ⟨1⟩

def Group.iso_restrict {G G' : Group} (iso : G ≅ G')
  (H : set G) [is_subgroup H] : Group.of H ≅ Group.of (iso.hom '' H) := {
    hom := ⟨λ x, ⟨iso.hom x.val, x.val, x.property, rfl⟩,
            is_group_hom.mk' $ by {
              intros x y, unfold_coes, apply subtype.eq, simp,
              rw [is_monoid_hom.map_mul subtype.val, is_monoid_hom.map_mul iso.hom.val],
              congr, exact subtype_val.is_monoid_hom
            }⟩,
    inv := ⟨λ x, ⟨iso.inv x.val,
                  by { cases x, cases x_property with a ha,
                       cases ha with ha ha, subst ha, simp,
                       rw Group.iso_left_inverse, assumption }⟩,
                  is_group_hom.mk' $ by {
                    intros x y, unfold_coes, apply subtype.eq, simp,
                    rw [is_monoid_hom.map_mul subtype.val, is_monoid_hom.map_mul iso.inv.val],
                    congr, exact subtype_val.is_monoid_hom
                  }⟩,
    hom_inv_id' := by {
      unfold_coes, simp, ext,
      apply subtype.eq, refine congr_fun _ x,
      funext, apply congr_fun (subtype.mk.inj iso.hom_inv_id)
    },
    inv_hom_id' := by {
      unfold_coes, simp, ext,
      apply subtype.eq, refine congr_fun _ x,
      funext, apply congr_fun (subtype.mk.inj iso.inv_hom_id)
    }
  }

lemma Group.eq_of_im_eq_and_contain_ker
  {G K : Group} (φ : G ⟶ K) {s : set G} [is_subgroup s]
  (h1 : φ '' s = set.univ) (h2 : is_group_hom.ker φ ⊆ s)
  : s = set.univ := by {
    apply set.eq_univ_of_univ_subset, intros x h, clear h,
    have : φ x ∈ set.univ := set.mem_univ _, rw ← h1 at this,
    cases this with y h,
    have := is_group_hom.inv_ker_one' _ h.right,
    rw ← is_group_hom.mem_ker φ at this, have := h2 this,
    rw (_ : x = y * (y⁻¹ * x)),
    apply is_submonoid.mul_mem, exact h.left, assumption,
    symmetry, apply mul_inv_cancel_left
  }

def Group.subgroup_eq_of_eq {G : Group} {s t : set G}
  [is_subgroup s] [is_subgroup t] (h : s = t)
  : Group.of s = Group.of t := by {
    tactic.unfreeze_local_instances, subst h,
  }

-- lemma weird {H G : Group} {s t : set G} [is_subgroup s] [is_subgroup t]
--   (h : s = t)
--   (iso : Group.of t ≅ H)
--   (x : s)
--   : iso.hom.val (@eq.rec _ _ subtype x _ h)
--   = (@eq.rec _ _ (λ K : Group, K ≅ H)
--              iso _ (Group.subroup_eq_of_eq h)
--     .symm).hom.val x :=
-- begin
--   admit
-- end

inductive Group.list_equiv : list Group → list Group → Prop
| nil : Group.list_equiv [] []
| skip : ∀ G G' {xs ys}, (G ≅ G') → Group.list_equiv xs ys → Group.list_equiv (G::xs) (G'::ys)
| swap : ∀ G G' {xs}, Group.list_equiv (G::G'::xs) (G'::G::xs)
| trans : ∀ {xs ys zs},
  Group.list_equiv xs ys
  → Group.list_equiv ys zs
  → Group.list_equiv xs zs


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

! This file was ported from Lean 3 source module category_theory.glue_data
! leanprover-community/mathlib commit 14b69e9f3c16630440a2cbd46f1ddad0d561dee7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Tactic.Elementwise
import Mathlib.CategoryTheory.Limits.Shapes.Multiequalizer
import Mathlib.CategoryTheory.Limits.Constructions.EpiMono
import Mathlib.CategoryTheory.Limits.Preserves.Limits
import Mathlib.CategoryTheory.Limits.Shapes.Types

/-!
# Gluing data

We define `GlueData` as a family of data needed to glue topological spaces, schemes, etc. We
provide the API to realize it as a multispan diagram, and also states lemmas about its
interaction with a functor that preserves certain pullbacks.

-/

noncomputable section

open CategoryTheory.Limits

namespace CategoryTheory

universe v u₁ u₂

variable (C : Type u₁) [Category.{v} C] {C' : Type u₂} [Category.{v} C']

/-- A gluing datum consists of
1. An index type `J`
2. An object `U i` for each `i : J`.
3. An object `V i j` for each `i j : J`.
4. A monomorphism `f i j : V i j ⟶ U i` for each `i j : J`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : J`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. The pullback for `f i j` and `f i k` exists.
9. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
10. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.
-/
-- Porting note: This linter does not exist yet
-- @[nolint has_nonempty_instance]
structure GlueData where
  J : Type v
  U : J → C
  V : J × J → C
  f : ∀ i j, V (i, j) ⟶ U i
  f_mono : ∀ i j, Mono (f i j) := by infer_instance
  f_hasPullback : ∀ i j k, HasPullback (f i j) (f i k) := by infer_instance
  f_id : ∀ i, IsIso (f i i) := by infer_instance
  t : ∀ i j, V (i, j) ⟶ V (j, i)
  t_id : ∀ i, t i i = 𝟙 _
  t' : ∀ i j k, pullback (f i j) (f i k) ⟶ pullback (f j k) (f j i)
  t_fac : ∀ i j k, t' i j k ≫ pullback.snd = pullback.fst ≫ t i j
  cocycle : ∀ i j k, t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _
#align category_theory.glue_data CategoryTheory.GlueData

attribute [simp] GlueData.t_id

attribute [instance] GlueData.f_id GlueData.f_mono GlueData.f_hasPullback

attribute [reassoc] GlueData.t_fac GlueData.cocycle

namespace GlueData

variable {C}
variable (D : GlueData C)

@[simp]
theorem t'_iij (i j : D.J) : D.t' i i j = (pullbackSymmetry _ _).hom := by
  have eq₁ := D.t_fac i i j
  have eq₂ := (IsIso.eq_comp_inv (D.f i i)).mpr (@pullback.condition _ _ _ _ _ _ (D.f i j) _)
  rw [D.t_id, Category.comp_id, eq₂] at eq₁
  have eq₃ := (IsIso.eq_comp_inv (D.f i i)).mp eq₁
  rw [Category.assoc, ← pullback.condition, ← Category.assoc] at eq₃
  exact
    Mono.right_cancellation _ _
      ((Mono.right_cancellation _ _ eq₃).trans (pullbackSymmetry_hom_comp_fst _ _).symm)
#align category_theory.glue_data.t'_iij CategoryTheory.GlueData.t'_iij

theorem t'_jii (i j : D.J) : D.t' j i i = pullback.fst ≫ D.t j i ≫ inv pullback.snd := by
  rw [← Category.assoc, ← D.t_fac]
  simp
#align category_theory.glue_data.t'_jii CategoryTheory.GlueData.t'_jii

theorem t'_iji (i j : D.J) : D.t' i j i = pullback.fst ≫ D.t i j ≫ inv pullback.snd := by
  rw [← Category.assoc, ← D.t_fac]
  simp
#align category_theory.glue_data.t'_iji CategoryTheory.GlueData.t'_iji

@[reassoc, elementwise (attr := simp)]
theorem t_inv (i j : D.J) : D.t i j ≫ D.t j i = 𝟙 _ := by
  have eq : (pullbackSymmetry (D.f i i) (D.f i j)).hom = pullback.snd ≫ inv pullback.fst := by simp
  have := D.cocycle i j i
  rw [D.t'_iij, D.t'_jii, D.t'_iji, fst_eq_snd_of_mono_eq, eq] at this
  simp only [Category.assoc, IsIso.inv_hom_id_assoc] at this
  rw [← IsIso.eq_inv_comp, ← Category.assoc, IsIso.comp_inv_eq] at this
  simpa using this
#align category_theory.glue_data.t_inv CategoryTheory.GlueData.t_inv

theorem t'_inv (i j k : D.J) :
    D.t' i j k ≫ (pullbackSymmetry _ _).hom ≫ D.t' j i k ≫ (pullbackSymmetry _ _).hom = 𝟙 _ := by
  rw [← cancel_mono (pullback.fst : pullback (D.f i j) (D.f i k) ⟶ _)]
  simp [t_fac, t_fac_assoc]
#align category_theory.glue_data.t'_inv CategoryTheory.GlueData.t'_inv

instance t_isIso (i j : D.J) : IsIso (D.t i j) :=
  ⟨⟨D.t j i, D.t_inv _ _, D.t_inv _ _⟩⟩
#align category_theory.glue_data.t_is_iso CategoryTheory.GlueData.t_isIso

instance t'_isIso (i j k : D.J) : IsIso (D.t' i j k) :=
  ⟨⟨D.t' j k i ≫ D.t' k i j, D.cocycle _ _ _, by simpa using D.cocycle _ _ _⟩⟩
#align category_theory.glue_data.t'_is_iso CategoryTheory.GlueData.t'_isIso

@[reassoc]
theorem t'_comp_eq_pullbackSymmetry (i j k : D.J) :
    D.t' j k i ≫ D.t' k i j =
      (pullbackSymmetry _ _).hom ≫ D.t' j i k ≫ (pullbackSymmetry _ _).hom := by
  trans inv (D.t' i j k)
  · exact IsIso.eq_inv_of_hom_inv_id (D.cocycle _ _ _)
  · rw [← cancel_mono (pullback.fst : pullback (D.f i j) (D.f i k) ⟶ _)]
    simp [t_fac, t_fac_assoc]
#align category_theory.glue_data.t'_comp_eq_pullback_symmetry CategoryTheory.GlueData.t'_comp_eq_pullbackSymmetry

/-- (Implementation) The disjoint union of `U i`. -/
def sigmaOpens [HasCoproduct D.U] : C :=
  ∐ D.U
#align category_theory.glue_data.sigma_opens CategoryTheory.GlueData.sigmaOpens

/-- (Implementation) The diagram to take colimit of. -/
def diagram : MultispanIndex C where
  L := D.J × D.J
  R := D.J
  fstFrom := _root_.Prod.fst
  sndFrom := _root_.Prod.snd
  left := D.V
  right := D.U
  fst := fun ⟨i, j⟩ => D.f i j
  snd := fun ⟨i, j⟩ => D.t i j ≫ D.f j i
#align category_theory.glue_data.diagram CategoryTheory.GlueData.diagram

@[simp]
theorem diagram_l : D.diagram.L = (D.J × D.J) :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.glue_data.diagram_L CategoryTheory.GlueData.diagram_l

@[simp]
theorem diagram_r : D.diagram.R = D.J :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.glue_data.diagram_R CategoryTheory.GlueData.diagram_r

@[simp]
theorem diagram_fstFrom (i j : D.J) : D.diagram.fstFrom ⟨i, j⟩ = i :=
  rfl
#align category_theory.glue_data.diagram_fst_from CategoryTheory.GlueData.diagram_fstFrom

@[simp]
theorem diagram_sndFrom (i j : D.J) : D.diagram.sndFrom ⟨i, j⟩ = j :=
  rfl
#align category_theory.glue_data.diagram_snd_from CategoryTheory.GlueData.diagram_sndFrom

@[simp]
theorem diagram_fst (i j : D.J) : D.diagram.fst ⟨i, j⟩ = D.f i j :=
  rfl
#align category_theory.glue_data.diagram_fst CategoryTheory.GlueData.diagram_fst

@[simp]
theorem diagram_snd (i j : D.J) : D.diagram.snd ⟨i, j⟩ = D.t i j ≫ D.f j i :=
  rfl
#align category_theory.glue_data.diagram_snd CategoryTheory.GlueData.diagram_snd

@[simp]
theorem diagram_left : D.diagram.left = D.V :=
  rfl
#align category_theory.glue_data.diagram_left CategoryTheory.GlueData.diagram_left

@[simp]
theorem diagram_right : D.diagram.right = D.U :=
  rfl
#align category_theory.glue_data.diagram_right CategoryTheory.GlueData.diagram_right

section

variable [HasMulticoequalizer D.diagram]

/-- The glued object given a family of gluing data. -/
def glued : C :=
  multicoequalizer D.diagram
#align category_theory.glue_data.glued CategoryTheory.GlueData.glued

/-- The map `D.U i ⟶ D.glued` for each `i`. -/
def ι (i : D.J) : D.U i ⟶ D.glued :=
  Multicoequalizer.π D.diagram i
#align category_theory.glue_data.ι CategoryTheory.GlueData.ι

@[elementwise (attr := simp)]
theorem glue_condition (i j : D.J) : D.t i j ≫ D.f j i ≫ D.ι j = D.f i j ≫ D.ι i :=
  (Category.assoc _ _ _).symm.trans (Multicoequalizer.condition D.diagram ⟨i, j⟩).symm
#align category_theory.glue_data.glue_condition CategoryTheory.GlueData.glue_condition

/-- The pullback cone spanned by `V i j ⟶ U i` and `V i j ⟶ U j`.
This will often be a pullback diagram. -/
def vPullbackCone (i j : D.J) : PullbackCone (D.ι i) (D.ι j) :=
  PullbackCone.mk (D.f i j) (D.t i j ≫ D.f j i) (by simp)
set_option linter.uppercaseLean3 false in
#align category_theory.glue_data.V_pullback_cone CategoryTheory.GlueData.vPullbackCone

variable [HasColimits C]

/-- The projection `∐ D.U ⟶ D.glued` given by the colimit. -/
def π : D.sigmaOpens ⟶ D.glued :=
  Multicoequalizer.sigmaπ D.diagram
#align category_theory.glue_data.π CategoryTheory.GlueData.π

instance π_epi : Epi D.π := by
  unfold π
  infer_instance
#align category_theory.glue_data.π_epi CategoryTheory.GlueData.π_epi

end

theorem types_π_surjective (D : GlueData (Type _)) : Function.Surjective D.π :=
  (epi_iff_surjective _).mp inferInstance
#align category_theory.glue_data.types_π_surjective CategoryTheory.GlueData.types_π_surjective

theorem types_ι_jointly_surjective (D : GlueData (Type _)) (x : D.glued) :
    ∃ (i : _)(y : D.U i), D.ι i y = x := by
  delta CategoryTheory.GlueData.ι
  simp_rw [← Multicoequalizer.ι_sigmaπ D.diagram]
  rcases D.types_π_surjective x with ⟨x', rfl⟩
  --have := colimit.isoColimitCocone (Types.coproductColimitCocone _)
  rw [← show (colimit.isoColimitCocone (Types.coproductColimitCocone _)).inv _ = x' from
      ConcreteCategory.congr_hom
        (colimit.isoColimitCocone (Types.coproductColimitCocone _)).hom_inv_id x']
  rcases(colimit.isoColimitCocone (Types.coproductColimitCocone _)).hom x' with ⟨i, y⟩
  exact ⟨i, y, by
    simp [← Multicoequalizer.ι_sigmaπ, -Multicoequalizer.ι_sigmaπ]
    rfl ⟩
#align category_theory.glue_data.types_ι_jointly_surjective CategoryTheory.GlueData.types_ι_jointly_surjective

variable (F : C ⥤ C') [H : ∀ i j k, PreservesLimit (cospan (D.f i j) (D.f i k)) F]

-- porting note: commented out include
-- include H

instance (i j k : D.J) : HasPullback (F.map (D.f i j)) (F.map (D.f i k)) :=
  ⟨⟨⟨_, isLimitOfHasPullbackOfPreservesLimit F (D.f i j) (D.f i k)⟩⟩⟩

/-- A functor that preserves the pullbacks of `f i j` and `f i k` can map a family of glue data. -/
@[simps]
def mapGlueData : GlueData C' where
  J := D.J
  U i := F.obj (D.U i)
  V i := F.obj (D.V i)
  f i j := F.map (D.f i j)
  f_mono i j := preserves_mono_of_preservesLimit _ _
  f_id i := inferInstance
  t i j := F.map (D.t i j)
  t_id i := by
    simp [D.t_id i]
  t' i j k :=
    (PreservesPullback.iso F (D.f i j) (D.f i k)).inv ≫
      F.map (D.t' i j k) ≫ (PreservesPullback.iso F (D.f j k) (D.f j i)).hom
  t_fac i j k := by simpa [Iso.inv_comp_eq] using congr_arg (fun f => F.map f) (D.t_fac i j k)
  cocycle i j k := by
    simp only [Category.assoc, Iso.hom_inv_id_assoc, ← Functor.map_comp_assoc, D.cocycle,
      Iso.inv_hom_id, CategoryTheory.Functor.map_id, Category.id_comp]
#align category_theory.glue_data.map_glue_data CategoryTheory.GlueData.mapGlueData

/-- The diagram of the image of a `GlueData` under a functor `F` is naturally isomorphic to the
original diagram of the `GlueData` via `F`.
-/
def diagramIso : D.diagram.multispan ⋙ F ≅ (D.mapGlueData F).diagram.multispan :=
  NatIso.ofComponents
    (fun x =>
      match x with
      | WalkingMultispan.left a => Iso.refl _
      | WalkingMultispan.right b => Iso.refl _)
    (by
      rintro (⟨_, _⟩ | _) _ (_ | _ | _)
      · erw [Category.comp_id, Category.id_comp, Functor.map_id]
        rfl
      · erw [Category.comp_id, Category.id_comp]
        rfl
      · erw [Category.comp_id, Category.id_comp, Functor.map_comp]
        rfl
      · erw [Category.comp_id, Category.id_comp, Functor.map_id]
        rfl)
#align category_theory.glue_data.diagram_iso CategoryTheory.GlueData.diagramIso

@[simp]
theorem diagramIso_app_left (i : D.J × D.J) :
    (D.diagramIso F).app (WalkingMultispan.left i) = Iso.refl _ :=
  rfl
#align category_theory.glue_data.diagram_iso_app_left CategoryTheory.GlueData.diagramIso_app_left

@[simp]
theorem diagramIso_app_right (i : D.J) :
    (D.diagramIso F).app (WalkingMultispan.right i) = Iso.refl _ :=
  rfl
#align category_theory.glue_data.diagram_iso_app_right CategoryTheory.GlueData.diagramIso_app_right

@[simp]
theorem diagramIso_hom_app_left (i : D.J × D.J) :
    (D.diagramIso F).hom.app (WalkingMultispan.left i) = 𝟙 _ :=
  rfl
#align category_theory.glue_data.diagram_iso_hom_app_left CategoryTheory.GlueData.diagramIso_hom_app_left

@[simp]
theorem diagramIso_hom_app_right (i : D.J) :
    (D.diagramIso F).hom.app (WalkingMultispan.right i) = 𝟙 _ :=
  rfl
#align category_theory.glue_data.diagram_iso_hom_app_right CategoryTheory.GlueData.diagramIso_hom_app_right

@[simp]
theorem diagramIso_inv_app_left (i : D.J × D.J) :
    (D.diagramIso F).inv.app (WalkingMultispan.left i) = 𝟙 _ :=
  rfl
#align category_theory.glue_data.diagram_iso_inv_app_left CategoryTheory.GlueData.diagramIso_inv_app_left

@[simp]
theorem diagramIso_inv_app_right (i : D.J) :
    (D.diagramIso F).inv.app (WalkingMultispan.right i) = 𝟙 _ :=
  rfl
#align category_theory.glue_data.diagram_iso_inv_app_right CategoryTheory.GlueData.diagramIso_inv_app_right

variable [HasMulticoequalizer D.diagram] [PreservesColimit D.diagram.multispan F]

-- porting note: commented out omi
-- omit H

theorem hasColimit_multispan_comp : HasColimit (D.diagram.multispan ⋙ F) :=
  ⟨⟨⟨_, PreservesColimit.preserves (colimit.isColimit _)⟩⟩⟩
#align category_theory.glue_data.has_colimit_multispan_comp CategoryTheory.GlueData.hasColimit_multispan_comp

-- porting note: commented out include
-- include H

attribute [local instance] hasColimit_multispan_comp

theorem hasColimit_mapGlueData_diagram : HasMulticoequalizer (D.mapGlueData F).diagram :=
  hasColimitOfIso (D.diagramIso F).symm
#align category_theory.glue_data.has_colimit_map_glue_data_diagram CategoryTheory.GlueData.hasColimit_mapGlueData_diagram

attribute [local instance] hasColimit_mapGlueData_diagram

/-- If `F` preserves the gluing, we obtain an iso between the glued objects. -/
def gluedIso : F.obj D.glued ≅ (D.mapGlueData F).glued :=
  haveI : HasColimit (MultispanIndex.multispan (diagram (mapGlueData D F))) := inferInstance
  preservesColimitIso F D.diagram.multispan ≪≫ Limits.HasColimit.isoOfNatIso (D.diagramIso F)
#align category_theory.glue_data.glued_iso CategoryTheory.GlueData.gluedIso

@[reassoc (attr := simp)]

@[reassoc (attr := simp)]
theorem ι_gluedIso_inv (i : D.J) : (D.mapGlueData F).ι i ≫ (D.gluedIso F).inv = F.map (D.ι i) := by
  rw [Iso.comp_inv_eq, ι_gluedIso_hom]
#align category_theory.glue_data.ι_glued_iso_inv CategoryTheory.GlueData.ι_gluedIso_inv

/-- If `F` preserves the gluing, and reflects the pullback of `U i ⟶ glued` and `U j ⟶ glued`,
then `F` reflects the fact that `V_pullback_cone` is a pullback. -/
def vPullbackConeIsLimitOfMap (i j : D.J) [ReflectsLimit (cospan (D.ι i) (D.ι j)) F]
    (hc : IsLimit ((D.mapGlueData F).vPullbackCone i j)) : IsLimit (D.vPullbackCone i j) := by
  apply isLimitOfReflects F
  apply (isLimitMapConePullbackConeEquiv _ _).symm _
  let e :
    cospan (F.map (D.ι i)) (F.map (D.ι j)) ≅
      cospan ((D.mapGlueData F).ι i) ((D.mapGlueData F).ι j)
  exact
    NatIso.ofComponents
      (fun x => by
        cases x
        exacts[D.gluedIso F, Iso.refl _])
      (by rintro (_ | _) (_ | _) (_ | _ | _) <;> simp)
  apply IsLimit.postcomposeHomEquiv e _ _
  apply hc.ofIsoLimit
  refine' Cones.ext (Iso.refl _) _
  · rintro (_ | _ | _)
    change _ = _ ≫ (_ ≫ _) ≫ _
    all_goals change _ = 𝟙 _ ≫ _ ≫ _; simp; aesop_cat
set_option linter.uppercaseLean3 false in
#align category_theory.glue_data.V_pullback_cone_is_limit_of_map CategoryTheory.GlueData.vPullbackConeIsLimitOfMap

-- porting note: commenting out omit
-- omit H

/-- If there is a forgetful functor into `Type` that preserves enough (co)limits, then `D.ι` will
be jointly surjective. -/
theorem ι_jointly_surjective (F : C ⥤ Type v) [PreservesColimit D.diagram.multispan F]
    [∀ i j k : D.J, PreservesLimit (cospan (D.f i j) (D.f i k)) F] (x : F.obj D.glued) :
    ∃ (i : _)(y : F.obj (D.U i)), F.map (D.ι i) y = x := by
  let e := D.gluedIso F
  obtain ⟨i, y, eq⟩ := (D.mapGlueData F).types_ι_jointly_surjective (e.hom x)
  replace eq := congr_arg e.inv eq
  change ((D.mapGlueData F).ι i ≫ e.inv) y = (e.hom ≫ e.inv) x at eq
  rw [e.hom_inv_id, D.ι_gluedIso_inv] at eq
  exact ⟨i, y, eq⟩
#align category_theory.glue_data.ι_jointly_surjective CategoryTheory.GlueData.ι_jointly_surjective

end GlueData

end CategoryTheory