/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import category_theory.limits.shapes.products
import category_theory.limits.shapes.equalizers
import category_theory.limits.cone_category
import category_theory.adjunction

/-!

# Multi-(co)equalizers

A *multiequalizer* is an equalizer of two morphisms between two products.
Since both products and equalizers are limits, such an object is again a limit.
This file provides the diagram whose limit is indeed such an object.
In fact, it is well-known that any limit can be obtained as a multiequalizer.
The dual construction (multicoequalizers) is also provided.

## Projects

Prove that a multiequalizer can be identified with
an equalizer between products (and analogously for multicoequalizers).

Prove that the limit of any diagram is a multiequalizer (and similarly for colimits).

-/

namespace category_theory.limits

open category_theory

universes v u

/-- The type underlying the multiequalizer diagram. -/
@[nolint unused_arguments]
inductive walking_multicospan {L R : Type v} (fst snd : R → L) : Type v
| left : L → walking_multicospan
| right : R → walking_multicospan

/-- The type underlying the multiecoqualizer diagram. -/
@[nolint unused_arguments]
inductive walking_multispan {L R : Type v} (fst snd : L → R) : Type v
| left : L → walking_multispan
| right : R → walking_multispan

namespace walking_multicospan

variables {L R : Type v} {fst snd : R → L}

instance [inhabited L] : inhabited (walking_multicospan fst snd) :=
⟨left default⟩

/-- Morphisms for `walking_multicospan`. -/
inductive hom : Π (a b : walking_multicospan fst snd), Type v
| id (A)  : hom A A
| fst (b) : hom (left (fst b)) (right b)
| snd (b) : hom (left (snd b)) (right b)

instance {a : walking_multicospan fst snd} : inhabited (hom a a) :=
⟨hom.id _⟩

/-- Composition of morphisms for `walking_multicospan`. -/
def hom.comp : Π {A B C : walking_multicospan fst snd} (f : hom A B) (g : hom B C),
  hom A C
| _ _ _ (hom.id X) f := f
| _ _ _ (hom.fst b) (hom.id X) := hom.fst b
| _ _ _ (hom.snd b) (hom.id X) := hom.snd b

instance : small_category (walking_multicospan fst snd) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z, hom.comp,
  id_comp' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  comp_id' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  assoc' := by { rintro (_|_) (_|_) (_|_) (_|_) (_|_|_) (_|_|_) (_|_|_), tidy } }

end walking_multicospan

namespace walking_multispan

variables {L R : Type v} {fst snd : L → R}

instance [inhabited L] : inhabited (walking_multispan fst snd) :=
⟨left default⟩

/-- Morphisms for `walking_multispan`. -/
inductive hom : Π (a b : walking_multispan fst snd), Type v
| id (A)  : hom A A
| fst (a) : hom (left a) (right (fst a))
| snd (a) : hom (left a) (right (snd a))

instance {a : walking_multispan fst snd} : inhabited (hom a a) :=
⟨hom.id _⟩

/-- Composition of morphisms for `walking_multispan`. -/
def hom.comp : Π {A B C : walking_multispan fst snd} (f : hom A B) (g : hom B C),
  hom A C
| _ _ _ (hom.id X) f := f
| _ _ _ (hom.fst a) (hom.id X) := hom.fst a
| _ _ _ (hom.snd a) (hom.id X) := hom.snd a

instance : small_category (walking_multispan fst snd) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z, hom.comp,
  id_comp' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  comp_id' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  assoc' := by { rintro (_|_) (_|_) (_|_) (_|_) (_|_|_) (_|_|_) (_|_|_), tidy } }

end walking_multispan

/-- This is a structure encapsulating the data necessary to define a `multicospan`. -/
@[nolint has_inhabited_instance]
structure multicospan_index (C : Type u) [category.{v} C] :=
(L R : Type v)
(fst_to snd_to : R → L)
(left : L → C)
(right : R → C)
(fst : Π b, left (fst_to b) ⟶ right b)
(snd : Π b, left (snd_to b) ⟶ right b)

/-- This is a structure encapsulating the data necessary to define a `multispan`. -/
@[nolint has_inhabited_instance]
structure multispan_index (C : Type u) [category.{v} C] :=
(L R : Type v)
(fst_from snd_from : L → R)
(left : L → C)
(right : R → C)
(fst : Π a, left a ⟶ right (fst_from a))
(snd : Π a, left a ⟶ right (snd_from a))

namespace multicospan_index

variables {C : Type u} [category.{v} C] (I : multicospan_index C)

/-- The multicospan associated to `I : multicospan_index`. -/
def multicospan : walking_multicospan I.fst_to I.snd_to ⥤ C :=
{ obj := λ x,
  match x with
  | walking_multicospan.left a := I.left a
  | walking_multicospan.right b := I.right b
  end,
  map := λ x y f,
  match x, y, f with
  | _, _, walking_multicospan.hom.id x := 𝟙 _
  | _, _, walking_multicospan.hom.fst b := I.fst _
  | _, _, walking_multicospan.hom.snd b := I.snd _
  end,
  map_id' := by { rintros (_|_), tidy },
  map_comp' := by { rintros (_|_) (_|_) (_|_) (_|_|_) (_|_|_), tidy } }

@[simp] lemma multicospan_obj_left (a) :
  I.multicospan.obj (walking_multicospan.left a) = I.left a := rfl

@[simp] lemma multicospan_obj_right (b) :
  I.multicospan.obj (walking_multicospan.right b) = I.right b := rfl

@[simp] lemma multicospan_map_fst (b) :
  I.multicospan.map (walking_multicospan.hom.fst b) = I.fst b := rfl

@[simp] lemma multicospan_map_snd (b) :
  I.multicospan.map (walking_multicospan.hom.snd b) = I.snd b := rfl

variables [has_product I.left] [has_product I.right]

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.fst`. -/
noncomputable
def fst_pi_map : ∏ I.left ⟶ ∏ I.right := pi.lift (λ b, pi.π I.left (I.fst_to b) ≫ I.fst b)

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.snd`. -/
noncomputable
def snd_pi_map : ∏ I.left ⟶ ∏ I.right := pi.lift (λ b, pi.π I.left (I.snd_to b) ≫ I.snd b)

@[simp, reassoc]
lemma fst_pi_map_π (b) : I.fst_pi_map ≫ pi.π I.right b = pi.π I.left _ ≫ I.fst b :=
by simp [fst_pi_map]

@[simp, reassoc]
lemma snd_pi_map_π (b) : I.snd_pi_map ≫ pi.π I.right b = pi.π I.left _ ≫ I.snd b :=
by simp [snd_pi_map]

/--
Taking the multiequalizer over the multicospan index is equivalent to taking the equalizer over
the two morphsims `∏ I.left ⇉ ∏ I.right`. This is the diagram of the latter.
-/
@[simps] protected noncomputable
def parallel_pair_diagram := parallel_pair I.fst_pi_map I.snd_pi_map

end multicospan_index

namespace multispan_index

variables {C : Type u} [category.{v} C] (I : multispan_index C)

/-- The multispan associated to `I : multispan_index`. -/
def multispan : walking_multispan I.fst_from I.snd_from ⥤ C :=
{ obj := λ x,
  match x with
  | walking_multispan.left a := I.left a
  | walking_multispan.right b := I.right b
  end,
  map := λ x y f,
  match x, y, f with
  | _, _, walking_multispan.hom.id x := 𝟙 _
  | _, _, walking_multispan.hom.fst b := I.fst _
  | _, _, walking_multispan.hom.snd b := I.snd _
  end,
  map_id' := by { rintros (_|_), tidy },
  map_comp' := by { rintros (_|_) (_|_) (_|_) (_|_|_) (_|_|_), tidy } }

@[simp] lemma multispan_obj_left (a) :
  I.multispan.obj (walking_multispan.left a) = I.left a := rfl

@[simp] lemma multispan_obj_right (b) :
  I.multispan.obj (walking_multispan.right b) = I.right b := rfl

@[simp] lemma multispan_map_fst (a) :
  I.multispan.map (walking_multispan.hom.fst a) = I.fst a := rfl

@[simp] lemma multispan_map_snd (a) :
  I.multispan.map (walking_multispan.hom.snd a) = I.snd a := rfl

variables [has_coproduct I.left] [has_coproduct I.right]

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.fst`. -/
noncomputable
def fst_sigma_map : ∐ I.left ⟶ ∐ I.right := sigma.desc (λ b, I.fst b ≫ sigma.ι _ (I.fst_from b))

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.snd`. -/
noncomputable
def snd_sigma_map : ∐ I.left ⟶ ∐ I.right := sigma.desc (λ b, I.snd b ≫ sigma.ι _ (I.snd_from b))

@[simp, reassoc]
lemma ι_fst_sigma_map (b) : sigma.ι I.left b ≫ I.fst_sigma_map = I.fst b ≫ sigma.ι I.right _ :=
by simp [fst_sigma_map]

@[simp, reassoc]
lemma ι_snd_sigma_map (b) : sigma.ι I.left b ≫ I.snd_sigma_map = I.snd b ≫ sigma.ι I.right _ :=
by simp [snd_sigma_map]

/--
Taking the multicoequalizer over the multispan index is equivalent to taking the coequalizer over
the two morphsims `∐ I.left ⇉ ∐ I.right`. This is the diagram of the latter.
-/
protected noncomputable
abbreviation parallel_pair_diagram := parallel_pair I.fst_sigma_map I.snd_sigma_map

end multispan_index

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

/-- A multifork is a cone over a multicospan. -/
@[nolint has_inhabited_instance]
abbreviation multifork (I : multicospan_index C) := cone I.multicospan

/-- A multicofork is a cocone over a multispan. -/
@[nolint has_inhabited_instance]
abbreviation multicofork (I : multispan_index C) := cocone I.multispan

namespace multifork

variables {I : multicospan_index C} (K : multifork I)

/-- The maps from the cone point of a multifork to the objects on the left. -/
def ι (a : I.L) : K.X ⟶ I.left a :=
K.π.app (walking_multicospan.left _)

@[simp] lemma ι_eq_app_left (a) : K.ι a = K.π.app (walking_multicospan.left _) := rfl

@[simp] lemma app_left_fst (b) :
  K.π.app (walking_multicospan.left (I.fst_to b)) ≫ I.fst b =
    K.π.app (walking_multicospan.right b) :=
by { rw ← K.w (walking_multicospan.hom.fst b), refl }

@[simp] lemma app_left_snd (b) :
  K.π.app (walking_multicospan.left (I.snd_to b)) ≫ I.snd b =
    K.π.app (walking_multicospan.right b) :=
by { rw ← K.w (walking_multicospan.hom.snd b), refl }

/-- Construct a multifork using a collection `ι` of morphisms. -/
@[simps]
def of_ι (I : multicospan_index C) (P : C) (ι : Π a, P ⟶ I.left a)
  (w : ∀ b, ι (I.fst_to b) ≫ I.fst b = ι (I.snd_to b) ≫ I.snd b) :
  multifork I :=
{ X := P,
  π :=
  { app := λ x,
    match x with
    | walking_multicospan.left a := ι _
    | walking_multicospan.right b := ι (I.fst_to b) ≫ I.fst b
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      { dsimp, rw category.id_comp, refl },
      { dsimp, rw category.id_comp, apply w }
    end } }

@[reassoc]
lemma condition (b) :
  K.ι (I.fst_to b) ≫ I.fst b = K.ι (I.snd_to b) ≫ I.snd b := by simp

/-- This definition provides a convenient way to show that a multifork is a limit. -/
@[simps]
def is_limit.mk
  (lift : Π (E : multifork I), E.X ⟶ K.X)
  (fac : ∀ (E : multifork I) (i : I.L), lift E ≫ K.ι i = E.ι i)
  (uniq : ∀ (E : multifork I) (m : E.X ⟶ K.X),
    (∀ i : I.L, m ≫ K.ι i = E.ι i) → m = lift E) : is_limit K :=
{ lift := lift,
  fac' := begin
    rintros E (a|b),
    { apply fac },
    { rw [← E.w (walking_multicospan.hom.fst b), ← K.w (walking_multicospan.hom.fst b),
        ← category.assoc],
      congr' 1,
      apply fac }
  end,
  uniq' := begin
    rintros E m hm,
    apply uniq,
    intros i,
    apply hm,
  end }

variables [has_product I.left] [has_product I.right]

@[simp, reassoc]
lemma pi_condition :
  pi.lift K.ι ≫ I.fst_pi_map = pi.lift K.ι ≫ I.snd_pi_map := by { ext, simp }

/-- Given a multifork, we may obtain a fork over `∏ I.left ⇉ ∏ I.right`. -/
@[simps X] noncomputable
def to_pi_fork (K : multifork I) : fork I.fst_pi_map I.snd_pi_map :=
{ X := K.X,
  π :=
  { app := λ x,
    match x with
    | walking_parallel_pair.zero := pi.lift K.ι
    | walking_parallel_pair.one := pi.lift K.ι ≫ I.fst_pi_map
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      all_goals { change 𝟙 _ ≫ _ ≫ _ = pi.lift _ ≫ _, simp }
    end } }

@[simp] lemma to_pi_fork_π_app_zero :
  K.to_pi_fork.π.app walking_parallel_pair.zero = pi.lift K.ι := rfl

@[simp] lemma to_pi_fork_π_app_one :
  K.to_pi_fork.π.app walking_parallel_pair.one = pi.lift K.ι ≫ I.fst_pi_map := rfl

variable (I)

/-- Given a fork over `∏ I.left ⇉ ∏ I.right`, we may obtain a multifork. -/
@[simps X] noncomputable
def of_pi_fork (c : fork I.fst_pi_map I.snd_pi_map) : multifork I :=
{ X := c.X,
  π :=
  { app := λ x,
    match x with
    | walking_multicospan.left a := c.ι ≫ pi.π _ _
    | walking_multicospan.right b := c.ι ≫ I.fst_pi_map ≫ pi.π _ _
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      { change 𝟙 _ ≫ _ ≫ _ = (_ ≫ _) ≫ _, simp },
      { change 𝟙 _ ≫ _ ≫ _ = (_ ≫ _) ≫ _, rw c.condition_assoc, simp }
    end } }

@[simp] lemma of_pi_fork_π_app_left (c : fork I.fst_pi_map I.snd_pi_map) (a) :
  (of_pi_fork I c).π.app (walking_multicospan.left a) = c.ι ≫ pi.π _ _ := rfl

@[simp] lemma of_pi_fork_π_app_right (c : fork I.fst_pi_map I.snd_pi_map) (a) :
  (of_pi_fork I c).π.app (walking_multicospan.right a) = c.ι ≫ I.fst_pi_map ≫ pi.π _ _ := rfl

end multifork

namespace multicospan_index

variables (I : multicospan_index C) [has_product I.left] [has_product I.right]

local attribute [tidy] tactic.case_bash

/-- `multifork.to_pi_fork` is functorial. -/
@[simps] noncomputable
def to_pi_fork_functor : multifork I ⥤ fork I.fst_pi_map I.snd_pi_map :=
{ obj := multifork.to_pi_fork, map := λ K₁ K₂ f, { hom := f.hom } }

/-- `multifork.of_pi_fork` is functorial. -/
@[simps] noncomputable
def of_pi_fork_functor : fork I.fst_pi_map I.snd_pi_map ⥤ multifork I :=
{ obj := multifork.of_pi_fork I, map := λ K₁ K₂ f, { hom := f.hom, w' := by rintros (_|_); simp } }

/--
The category of multiforks is equivalent to the category of forks over `∏ I.left ⇉ ∏ I.right`.
It then follows from `category_theory.is_limit_of_preserves_cone_terminal` (or `reflects`) that it
preserves and reflects limit cones.
-/
@[simps] noncomputable
def multifork_equiv_pi_fork : multifork I ≌ fork I.fst_pi_map I.snd_pi_map :=
{ functor := to_pi_fork_functor I,
  inverse := of_pi_fork_functor I,
  unit_iso := nat_iso.of_components (λ K, cones.ext (iso.refl _) (by rintros (_|_); dsimp; simp))
    (λ K₁ K₂ f, by { ext, simp }),
  counit_iso := nat_iso.of_components (λ K, fork.ext (iso.refl _) (by { ext, dsimp, simp }))
    (λ K₁ K₂ f, by { ext, simp }) }

end multicospan_index

namespace multicofork

variables {I : multispan_index C} (K : multicofork I)

/-- The maps to the cocone point of a multicofork from the objects on the right. -/
def π (b : I.R) : I.right b ⟶ K.X :=
K.ι.app (walking_multispan.right _)

@[simp] lemma π_eq_app_right (b) : K.π b = K.ι.app (walking_multispan.right _) := rfl

@[simp] lemma fst_app_right (a) :
  I.fst a ≫ K.ι.app (walking_multispan.right (I.fst_from a)) =
    K.ι.app (walking_multispan.left a) :=
by { rw ← K.w (walking_multispan.hom.fst a), refl }

@[simp] lemma snd_app_right (a) :
  I.snd a ≫ K.ι.app (walking_multispan.right (I.snd_from a)) =
    K.ι.app (walking_multispan.left a) :=
by { rw ← K.w (walking_multispan.hom.snd a), refl }

/-- Construct a multicofork using a collection `π` of morphisms. -/
@[simps]
def of_π (I : multispan_index C) (P : C) (π : Π b, I.right b ⟶ P)
  (w : ∀ a, I.fst a ≫ π (I.fst_from a) = I.snd a ≫ π (I.snd_from a)) :
  multicofork I :=
{ X := P,
  ι :=
  { app := λ x,
    match x with
    | walking_multispan.left a := I.fst a ≫ π _
    | walking_multispan.right b := π _
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      { dsimp, rw category.comp_id, refl },
      { dsimp, rw category.comp_id, apply (w _).symm }
    end } }

@[reassoc]
lemma condition (a) :
  I.fst a ≫ K.π (I.fst_from a) = I.snd a ≫ K.π (I.snd_from a) := by simp

/-- This definition provides a convenient way to show that a multicofork is a colimit. -/
@[simps]
def is_colimit.mk
  (desc : Π (E : multicofork I), K.X ⟶ E.X)
  (fac : ∀ (E : multicofork I) (i : I.R), K.π i ≫ desc E = E.π i)
  (uniq : ∀ (E : multicofork I) (m : K.X ⟶ E.X),
    (∀ i : I.R, K.π i ≫ m = E.π i) → m = desc E) : is_colimit K :=
{ desc := desc,
  fac' := begin
    rintros S (a|b),
    { rw [← K.w (walking_multispan.hom.fst a), ← S.w (walking_multispan.hom.fst a),
        category.assoc],
      congr' 1,
      apply fac },
    { apply fac },
  end,
  uniq' := begin
    intros S m hm,
    apply uniq,
    intros i,
    apply hm
  end }

variables [has_coproduct I.left] [has_coproduct I.right]

@[simp, reassoc]
lemma sigma_condition :
  I.fst_sigma_map ≫ sigma.desc K.π = I.snd_sigma_map ≫ sigma.desc K.π := by { ext, simp }

/-- Given a multicofork, we may obtain a cofork over `∐ I.left ⇉ ∐ I.right`. -/
@[simps X] noncomputable
def to_sigma_cofork (K : multicofork I) : cofork I.fst_sigma_map I.snd_sigma_map :=
{ X := K.X,
  ι :=
  { app := λ x,
    match x with
    | walking_parallel_pair.zero := I.fst_sigma_map ≫ sigma.desc K.π
    | walking_parallel_pair.one := sigma.desc K.π
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      all_goals { change _ ≫ sigma.desc _ = (_ ≫ _) ≫ 𝟙 _, simp }
    end } }

@[simp] lemma to_sigma_cofork_ι_app_zero :
  K.to_sigma_cofork.ι.app walking_parallel_pair.zero = I.fst_sigma_map ≫ sigma.desc K.π := rfl

@[simp] lemma to_sigma_cofork_ι_app_one :
  K.to_sigma_cofork.ι.app walking_parallel_pair.one = sigma.desc K.π := rfl

variable (I)

/-- Given a cofork over `∐ I.left ⇉ ∐ I.right`, we may obtain a multicofork. -/
@[simps X] noncomputable
def of_sigma_cofork (c : cofork I.fst_sigma_map I.snd_sigma_map) : multicofork I :=
{ X := c.X,
  ι :=
  { app := λ x,
    match x with
    | walking_multispan.left a := (sigma.ι I.left a : _) ≫ I.fst_sigma_map ≫ c.π
    | walking_multispan.right b := (sigma.ι I.right b : _) ≫ c.π
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      { change _ ≫ _ ≫ _ = (_ ≫ _) ≫ _,
        dsimp, simp [←cofork.left_app_one, -cofork.left_app_one] },
      { change _ ≫ _ ≫ _ = (_ ≫ _) ≫ 𝟙 _,
        rw c.condition,
        dsimp, simp [←cofork.right_app_one, -cofork.right_app_one] }
    end } }

@[simp] lemma of_sigma_cofork_ι_app_left (c : cofork I.fst_sigma_map I.snd_sigma_map) (a) :
  (of_sigma_cofork I c).ι.app (walking_multispan.left a) =
    (sigma.ι I.left a : _) ≫ I.fst_sigma_map ≫ c.π := rfl

@[simp] lemma of_sigma_cofork_ι_app_right (c : cofork I.fst_sigma_map I.snd_sigma_map) (b) :
  (of_sigma_cofork I c).ι.app (walking_multispan.right b) = (sigma.ι I.right b : _) ≫ c.π := rfl

end multicofork

namespace multispan_index

variables (I : multispan_index C) [has_coproduct I.left] [has_coproduct I.right]

local attribute [tidy] tactic.case_bash

/-- `multicofork.to_sigma_cofork` is functorial. -/
@[simps] noncomputable
def to_sigma_cofork_functor : multicofork I ⥤ cofork I.fst_sigma_map I.snd_sigma_map :=
{ obj := multicofork.to_sigma_cofork, map := λ K₁ K₂ f, { hom := f.hom } }

/-- `multicofork.of_sigma_cofork` is functorial. -/
@[simps] noncomputable
def of_sigma_cofork_functor : cofork I.fst_sigma_map I.snd_sigma_map ⥤ multicofork I :=
{ obj := multicofork.of_sigma_cofork I,
  map := λ K₁ K₂ f, { hom := f.hom, w' := by rintros (_|_); simp } }

/--
The category of multicoforks is equivalent to the category of coforks over `∐ I.left ⇉ ∐ I.right`.
It then follows from `category_theory.is_colimit_of_preserves_cocone_initial` (or `reflects`) that
it preserves and reflects colimit cocones.
-/
@[simps] noncomputable
def multicofork_equiv_sigma_cofork : multicofork I ≌ cofork I.fst_sigma_map I.snd_sigma_map :=
{ functor := to_sigma_cofork_functor I,
  inverse := of_sigma_cofork_functor I,
  unit_iso := nat_iso.of_components (λ K, cocones.ext (iso.refl _) (by rintros (_|_); dsimp; simp))
    (λ K₁ K₂ f, by { ext, simp }),
  counit_iso := nat_iso.of_components (λ K, cofork.ext (iso.refl _) (by { ext, dsimp, simp }))
    (λ K₁ K₂ f, by { ext, dsimp, simp, }) }

end multispan_index

/-- For `I : multicospan_index C`, we say that it has a multiequalizer if the associated
  multicospan has a limit. -/
abbreviation has_multiequalizer (I : multicospan_index C) :=
  has_limit I.multicospan

noncomputable theory

/-- The multiequalizer of `I : multicospan_index C`. -/
abbreviation multiequalizer (I : multicospan_index C) [has_multiequalizer I] : C :=
  limit I.multicospan

/-- For `I : multispan_index C`, we say that it has a multicoequalizer if
  the associated multicospan has a limit. -/
abbreviation has_multicoequalizer (I : multispan_index C) :=
  has_colimit I.multispan

/-- The multiecoqualizer of `I : multispan_index C`. -/
abbreviation multicoequalizer (I : multispan_index C) [has_multicoequalizer I] : C :=
  colimit I.multispan

namespace multiequalizer

variables (I : multicospan_index C) [has_multiequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbreviation ι (a : I.L) : multiequalizer I ⟶ I.left a :=
limit.π _ (walking_multicospan.left a)

/-- The multifork associated to the multiequalizer. -/
abbreviation multifork : multifork I :=
limit.cone _

@[simp]
lemma multifork_ι (a) :
  (multiequalizer.multifork I).ι a = multiequalizer.ι I a := rfl

@[simp]
lemma multifork_π_app_left (a) :
  (multiequalizer.multifork I).π.app (walking_multicospan.left a) =
  multiequalizer.ι I a := rfl

@[reassoc]
lemma condition (b) :
  multiequalizer.ι I (I.fst_to b) ≫ I.fst b =
  multiequalizer.ι I (I.snd_to b) ≫ I.snd b :=
multifork.condition _ _

/-- Construct a morphism to the multiequalizer from its universal property. -/
abbreviation lift (W : C) (k : Π a, W ⟶ I.left a)
  (h : ∀ b, k (I.fst_to b) ≫ I.fst b = k (I.snd_to b) ≫ I.snd b) :
  W ⟶ multiequalizer I :=
limit.lift _ (multifork.of_ι I _ k h)

@[simp, reassoc]
lemma lift_ι (W : C) (k : Π a, W ⟶ I.left a)
  (h : ∀ b, k (I.fst_to b) ≫ I.fst b = k (I.snd_to b) ≫ I.snd b) (a) :
  multiequalizer.lift I _ k h ≫ multiequalizer.ι I a = k _ :=
limit.lift_π _ _

@[ext]
lemma hom_ext {W : C} (i j : W ⟶ multiequalizer I)
  (h : ∀ a, i ≫ multiequalizer.ι I a =
  j ≫ multiequalizer.ι I a) :
  i = j :=
limit.hom_ext
begin
  rintro (a|b),
  { apply h },
  simp_rw [← limit.w I.multicospan (walking_multicospan.hom.fst b),
    ← category.assoc, h],
end

variables [has_product I.left] [has_product I.right]

instance : has_equalizer I.fst_pi_map I.snd_pi_map :=
⟨⟨⟨_,is_limit.of_preserves_cone_terminal
  I.multifork_equiv_pi_fork.functor (limit.is_limit _)⟩⟩⟩

/-- The multiequalizer is isomorphic to the equalizer of `∏ I.left ⇉ ∏ I.right`. -/
def iso_equalizer : multiequalizer I ≅ equalizer I.fst_pi_map I.snd_pi_map :=
limit.iso_limit_cone ⟨_, is_limit.of_preserves_cone_terminal
  I.multifork_equiv_pi_fork.inverse (limit.is_limit _)⟩

/-- The canonical injection `multiequalizer I ⟶ ∏ I.left`. -/
def ι_pi : multiequalizer I ⟶ ∏ I.left :=
  (iso_equalizer I).hom ≫ equalizer.ι I.fst_pi_map I.snd_pi_map

@[simp, reassoc]
lemma ι_pi_π (a) : ι_pi I ≫ pi.π I.left a = ι I a :=
by { rw [ι_pi, category.assoc, ← iso.eq_inv_comp, iso_equalizer], simpa }

instance : mono (ι_pi I) := @@mono_comp _ _ _ _ equalizer.ι_mono

end multiequalizer

namespace multicoequalizer

variables (I : multispan_index C) [has_multicoequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbreviation π (b : I.R) : I.right b ⟶ multicoequalizer I :=
colimit.ι I.multispan (walking_multispan.right _)

/-- The multicofork associated to the multicoequalizer. -/
abbreviation multicofork : multicofork I :=
colimit.cocone _

@[simp]
lemma multicofork_π (b) :
  (multicoequalizer.multicofork I).π b = multicoequalizer.π I b := rfl

@[simp]
lemma multicofork_ι_app_right (b) :
  (multicoequalizer.multicofork I).ι.app (walking_multispan.right b) =
  multicoequalizer.π I b := rfl

@[reassoc]
lemma condition (a) :
  I.fst a ≫ multicoequalizer.π I (I.fst_from a) =
  I.snd a ≫ multicoequalizer.π I (I.snd_from a) :=
multicofork.condition _ _

/-- Construct a morphism from the multicoequalizer from its universal property. -/
abbreviation desc (W : C) (k : Π b, I.right b ⟶ W)
  (h : ∀ a, I.fst a ≫  k (I.fst_from a) = I.snd a ≫ k (I.snd_from a)) :
  multicoequalizer I ⟶ W :=
colimit.desc _ (multicofork.of_π I _ k h)

@[simp, reassoc]
lemma π_desc (W : C) (k : Π b, I.right b ⟶ W)
  (h : ∀ a, I.fst a ≫  k (I.fst_from a) = I.snd a ≫ k (I.snd_from a)) (b) :
  multicoequalizer.π I b ≫ multicoequalizer.desc I _ k h = k _ :=
colimit.ι_desc _ _

@[ext]
lemma hom_ext {W : C} (i j : multicoequalizer I ⟶ W)
  (h : ∀ b, multicoequalizer.π I b ≫ i = multicoequalizer.π I b ≫ j) :
  i = j :=
colimit.hom_ext
begin
  rintro (a|b),
  { simp_rw [← colimit.w I.multispan (walking_multispan.hom.fst a),
    category.assoc, h] },
  { apply h },
end

variables [has_coproduct I.left] [has_coproduct I.right]

instance : has_coequalizer I.fst_sigma_map I.snd_sigma_map :=
⟨⟨⟨_,is_colimit.of_preserves_cocone_initial
  I.multicofork_equiv_sigma_cofork.functor (colimit.is_colimit _)⟩⟩⟩

/-- The multicoequalizer is isomorphic to the coequalizer of `∐ I.left ⇉ ∐ I.right`. -/
def iso_coequalizer : multicoequalizer I ≅ coequalizer I.fst_sigma_map I.snd_sigma_map :=
colimit.iso_colimit_cocone ⟨_, is_colimit.of_preserves_cocone_initial
  I.multicofork_equiv_sigma_cofork.inverse (colimit.is_colimit _)⟩

/-- The canonical projection `∐ I.right ⟶ multicoequalizer I`. -/
def sigma_π : ∐ I.right ⟶ multicoequalizer I :=
  coequalizer.π I.fst_sigma_map I.snd_sigma_map ≫ (iso_coequalizer I).inv

@[simp, reassoc]
lemma ι_sigma_π (b) : sigma.ι I.right b ≫ sigma_π I = π I b :=
by { rw [sigma_π, ← category.assoc, iso.comp_inv_eq, iso_coequalizer], simpa }

instance : epi (sigma_π I) := @@epi_comp _ _ coequalizer.π_epi _ _

end multicoequalizer

end category_theory.limits


/-
Copyright (c) 2019 Johannes Hölzl, Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Zhouhang Zhou
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.integration
import Mathlib.order.filter.germ
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 u_6

namespace Mathlib

/-!

# Almost everywhere equal functions

Two measurable functions are treated as identical if they are almost everywhere equal. We form the
set of equivalence classes under the relation of being almost everywhere equal, which is sometimes
known as the `L⁰` space.

See `l1_space.lean` for `L¹` space.

## Notation

* `α →ₘ[μ] β` is the type of `L⁰` space, where `α` and `β` are measurable spaces and `μ`
  is a measure on `α`. `f : α →ₘ β` is a "function" in `L⁰`. In comments, `[f]` is also used
  to denote an `L⁰` function.

  `ₘ` can be typed as `\_m`. Sometimes it is shown as a box if font is missing.

## Main statements

* The linear structure of `L⁰` :
    Addition and scalar multiplication are defined on `L⁰` in the natural way, i.e.,
    `[f] + [g] := [f + g]`, `c • [f] := [c • f]`. So defined, `α →ₘ β` inherits the linear structure
    of `β`. For example, if `β` is a module, then `α →ₘ β` is a module over the same ring.

    See `mk_add_mk`,  `neg_mk`,     `mk_sub_mk`,  `smul_mk`,
        `add_to_fun`, `neg_to_fun`, `sub_to_fun`, `smul_to_fun`

* The order structure of `L⁰` :
    `≤` can be defined in a similar way: `[f] ≤ [g]` if `f a ≤ g a` for almost all `a` in domain.
    And `α →ₘ β` inherits the preorder and partial order of `β`.

    TODO: Define `sup` and `inf` on `L⁰` so that it forms a lattice. It seems that `β` must be a
    linear order, since otherwise `f ⊔ g` may not be a measurable function.

* Emetric on `L⁰` :
    If `β` is an `emetric_space`, then `L⁰` can be made into an `emetric_space`, where
    `edist [f] [g]` is defined to be `∫⁻ a, edist (f a) (g a)`.

    The integral used here is `lintegral : (α → ennreal) → ennreal`, which is defined in the file
    `integration.lean`.

    See `edist_mk_mk` and `edist_to_fun`.

## Implementation notes

* `f.to_fun`     : To find a representative of `f : α →ₘ β`, use `f.to_fun`.
                 For each operation `op` in `L⁰`, there is a lemma called `op_to_fun`,
                 characterizing, say, `(f op g).to_fun`.
* `ae_eq_fun.mk` : To constructs an `L⁰` function `α →ₘ β` from a measurable function `f : α → β`,
                 use `ae_eq_fun.mk`
* `comp`         : Use `comp g f` to get `[g ∘ f]` from `g : β → γ` and `[f] : α →ₘ γ`
* `comp₂`        : Use `comp₂ g f₁ f₂ to get `[λa, g (f₁ a) (f₂ a)]`.
                 For example, `[f + g]` is `comp₂ (+)`

## Tags

function space, almost everywhere equal, `L⁰`, ae_eq_fun

-/

namespace measure_theory

/-- The equivalence relation of being almost everywhere equal -/
def measure.ae_eq_setoid {α : Type u_1} (β : Type u_2) [measurable_space α] [measurable_space β] (μ : measure α) : setoid (Subtype fun (f : α → β) => ae_measurable f) :=
  setoid.mk (fun (f g : Subtype fun (f : α → β) => ae_measurable f) => filter.eventually_eq (measure.ae μ) ↑f ↑g) sorry

/-- The space of equivalence classes of measurable functions, where two measurable functions are
    equivalent if they agree almost everywhere, i.e., they differ on a set of measure `0`.  -/
def ae_eq_fun (α : Type u_1) (β : Type u_2) [measurable_space α] [measurable_space β] (μ : measure α) :=
  quotient (measure.ae_eq_setoid β μ)

namespace ae_eq_fun

/-- Construct the equivalence class `[f]` of an almost everywhere measurable function `f`, based
    on the equivalence relation of being almost everywhere equal. -/
def mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : α → β) (hf : ae_measurable f) : ae_eq_fun α β μ :=
  quotient.mk' { val := f, property := hf }

/-- A measurable representative of an `ae_eq_fun` [f] -/
protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] : has_coe_to_fun (ae_eq_fun α β μ) :=
  has_coe_to_fun.mk (fun (f : ae_eq_fun α β μ) => α → β)
    fun (f : ae_eq_fun α β μ) => ae_measurable.mk (subtype.val (quotient.out' f)) sorry

protected theorem measurable {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) : measurable ⇑f :=
  ae_measurable.measurable_mk (has_coe_to_fun._proof_1 f)

protected theorem ae_measurable {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) : ae_measurable ⇑f :=
  measurable.ae_measurable (ae_eq_fun.measurable f)

@[simp] theorem quot_mk_eq_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : α → β) (hf : ae_measurable f) : Quot.mk setoid.r { val := f, property := hf } = mk f hf :=
  rfl

@[simp] theorem mk_eq_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {f : α → β} {g : α → β} {hf : ae_measurable f} {hg : ae_measurable g} : mk f hf = mk g hg ↔ filter.eventually_eq (measure.ae μ) f g :=
  quotient.eq'

@[simp] theorem mk_coe_fn {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) : mk (⇑f) (ae_eq_fun.ae_measurable f) = f := sorry

theorem ext {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {f : ae_eq_fun α β μ} {g : ae_eq_fun α β μ} (h : filter.eventually_eq (measure.ae μ) ⇑f ⇑g) : f = g := sorry

theorem coe_fn_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : α → β) (hf : ae_measurable f) : filter.eventually_eq (measure.ae μ) (⇑(mk f hf)) f :=
  filter.eventually_eq.trans (filter.eventually_eq.symm (ae_measurable.ae_eq_mk (has_coe_to_fun._proof_1 (mk f hf))))
    (quotient.mk_out' { val := f, property := hf })

theorem induction_on {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) {p : ae_eq_fun α β μ → Prop} (H : ∀ (f : α → β) (hf : ae_measurable f), p (mk f hf)) : p f :=
  quotient.induction_on' f (iff.mpr subtype.forall H)

theorem induction_on₂ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {α' : Type u_3} {β' : Type u_4} [measurable_space α'] [measurable_space β'] {μ' : measure α'} (f : ae_eq_fun α β μ) (f' : ae_eq_fun α' β' μ') {p : ae_eq_fun α β μ → ae_eq_fun α' β' μ' → Prop} (H : ∀ (f : α → β) (hf : ae_measurable f) (f' : α' → β') (hf' : ae_measurable f'), p (mk f hf) (mk f' hf')) : p f f' :=
  induction_on f fun (f : α → β) (hf : ae_measurable f) => induction_on f' (H f hf)

theorem induction_on₃ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {α' : Type u_3} {β' : Type u_4} [measurable_space α'] [measurable_space β'] {μ' : measure α'} {α'' : Type u_5} {β'' : Type u_6} [measurable_space α''] [measurable_space β''] {μ'' : measure α''} (f : ae_eq_fun α β μ) (f' : ae_eq_fun α' β' μ') (f'' : ae_eq_fun α'' β'' μ'') {p : ae_eq_fun α β μ → ae_eq_fun α' β' μ' → ae_eq_fun α'' β'' μ'' → Prop} (H : ∀ (f : α → β) (hf : ae_measurable f) (f' : α' → β') (hf' : ae_measurable f') (f'' : α'' → β'')
  (hf'' : ae_measurable f''), p (mk f hf) (mk f' hf') (mk f'' hf'')) : p f f' f'' :=
  induction_on f fun (f : α → β) (hf : ae_measurable f) => induction_on₂ f' f'' (H f hf)

/-- Given a measurable function `g : β → γ`, and an almost everywhere equal function `[f] : α →ₘ β`,
    return the equivalence class of `g ∘ f`, i.e., the almost everywhere equal function
    `[g ∘ f] : α →ₘ γ`. -/
def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (g : β → γ) (hg : measurable g) (f : ae_eq_fun α β μ) : ae_eq_fun α γ μ :=
  quotient.lift_on' f (fun (f : Subtype fun (f : α → β) => ae_measurable f) => mk (g ∘ ↑f) sorry) sorry

@[simp] theorem comp_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (g : β → γ) (hg : measurable g) (f : α → β) (hf : ae_measurable f) : comp g hg (mk f hf) = mk (g ∘ f) (measurable.comp_ae_measurable hg hf) :=
  rfl

theorem comp_eq_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (g : β → γ) (hg : measurable g) (f : ae_eq_fun α β μ) : comp g hg f = mk (g ∘ ⇑f) (measurable.comp_ae_measurable hg (ae_eq_fun.ae_measurable f)) := sorry

theorem coe_fn_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (g : β → γ) (hg : measurable g) (f : ae_eq_fun α β μ) : filter.eventually_eq (measure.ae μ) (⇑(comp g hg f)) (g ∘ ⇑f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (filter.eventually_eq (measure.ae μ) (⇑(comp g hg f)) (g ∘ ⇑f))) (comp_eq_mk g hg f)))
    (coe_fn_mk (g ∘ ⇑f) (measurable.comp_ae_measurable hg (ae_eq_fun.ae_measurable f)))

/-- The class of `x ↦ (f x, g x)`. -/
def pair {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (f : ae_eq_fun α β μ) (g : ae_eq_fun α γ μ) : ae_eq_fun α (β × γ) μ :=
  quotient.lift_on₂' f g
    (fun (f : Subtype fun (f : α → β) => ae_measurable f) (g : Subtype fun (f : α → γ) => ae_measurable f) =>
      mk (fun (x : α) => (subtype.val f x, subtype.val g x)) sorry)
    sorry

@[simp] theorem pair_mk_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (f : α → β) (hf : ae_measurable f) (g : α → γ) (hg : ae_measurable g) : pair (mk f hf) (mk g hg) = mk (fun (x : α) => (f x, g x)) (ae_measurable.prod_mk hf hg) :=
  rfl

theorem pair_eq_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (f : ae_eq_fun α β μ) (g : ae_eq_fun α γ μ) : pair f g =
  mk (fun (x : α) => (coe_fn f x, coe_fn g x))
    (ae_measurable.prod_mk (ae_eq_fun.ae_measurable f) (ae_eq_fun.ae_measurable g)) := sorry

theorem coe_fn_pair {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (f : ae_eq_fun α β μ) (g : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) ⇑(pair f g) fun (x : α) => (coe_fn f x, coe_fn g x) := sorry

/-- Given a measurable function `g : β → γ → δ`, and almost everywhere equal functions
    `[f₁] : α →ₘ β` and `[f₂] : α →ₘ γ`, return the equivalence class of the function
    `λa, g (f₁ a) (f₂ a)`, i.e., the almost everywhere equal function
    `[λa, g (f₁ a) (f₂ a)] : α →ₘ γ` -/
def comp₂ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {γ : Type u_3} {δ : Type u_4} [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : ae_eq_fun α β μ) (f₂ : ae_eq_fun α γ μ) : ae_eq_fun α δ μ :=
  comp (function.uncurry g) hg (pair f₁ f₂)

@[simp] theorem comp₂_mk_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {γ : Type u_3} {δ : Type u_4} [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : α → β) (f₂ : α → γ) (hf₁ : ae_measurable f₁) (hf₂ : ae_measurable f₂) : comp₂ g hg (mk f₁ hf₁) (mk f₂ hf₂) =
  mk (fun (a : α) => g (f₁ a) (f₂ a)) (measurable.comp_ae_measurable hg (ae_measurable.prod_mk hf₁ hf₂)) :=
  rfl

theorem comp₂_eq_pair {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {γ : Type u_3} {δ : Type u_4} [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : ae_eq_fun α β μ) (f₂ : ae_eq_fun α γ μ) : comp₂ g hg f₁ f₂ = comp (function.uncurry g) hg (pair f₁ f₂) :=
  rfl

theorem comp₂_eq_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {γ : Type u_3} {δ : Type u_4} [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : ae_eq_fun α β μ) (f₂ : ae_eq_fun α γ μ) : comp₂ g hg f₁ f₂ =
  mk (fun (a : α) => g (coe_fn f₁ a) (coe_fn f₂ a))
    (measurable.comp_ae_measurable hg (ae_measurable.prod_mk (ae_eq_fun.ae_measurable f₁) (ae_eq_fun.ae_measurable f₂))) := sorry

theorem coe_fn_comp₂ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] {γ : Type u_3} {δ : Type u_4} [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : ae_eq_fun α β μ) (f₂ : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) ⇑(comp₂ g hg f₁ f₂) fun (a : α) => g (coe_fn f₁ a) (coe_fn f₂ a) := sorry

/-- Interpret `f : α →ₘ[μ] β` as a germ at `μ.ae` forgetting that `f` is almost everywhere
    measurable. -/
def to_germ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) : filter.germ (measure.ae μ) β :=
  quotient.lift_on' f (fun (f : Subtype fun (f : α → β) => ae_measurable f) => ↑↑f) sorry

@[simp] theorem mk_to_germ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : α → β) (hf : ae_measurable f) : to_germ (mk f hf) = ↑f :=
  rfl

theorem to_germ_eq {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (f : ae_eq_fun α β μ) : to_germ f = ↑⇑f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (to_germ f = ↑⇑f)) (Eq.symm (mk_to_germ (⇑f) (ae_eq_fun.ae_measurable f)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (to_germ f = to_germ (mk (⇑f) (ae_eq_fun.ae_measurable f)))) (mk_coe_fn f)))
      (Eq.refl (to_germ f)))

theorem to_germ_injective {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] : function.injective to_germ := sorry

theorem comp_to_germ {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (g : β → γ) (hg : measurable g) (f : ae_eq_fun α β μ) : to_germ (comp g hg f) = filter.germ.map g (to_germ f) := sorry

theorem comp₂_to_germ {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] [measurable_space δ] (g : β → γ → δ) (hg : measurable (function.uncurry g)) (f₁ : ae_eq_fun α β μ) (f₂ : ae_eq_fun α γ μ) : to_germ (comp₂ g hg f₁ f₂) = filter.germ.map₂ g (to_germ f₁) (to_germ f₂) := sorry

/-- Given a predicate `p` and an equivalence class `[f]`, return true if `p` holds of `f a`
    for almost all `a` -/
def lift_pred {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (p : β → Prop) (f : ae_eq_fun α β μ) :=
  filter.germ.lift_pred p (to_germ f)

/-- Given a relation `r` and equivalence class `[f]` and `[g]`, return true if `r` holds of
    `(f a, g a)` for almost all `a` -/
def lift_rel {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] (r : β → γ → Prop) (f : ae_eq_fun α β μ) (g : ae_eq_fun α γ μ) :=
  filter.germ.lift_rel r (to_germ f) (to_germ g)

theorem lift_rel_mk_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] {r : β → γ → Prop} {f : α → β} {g : α → γ} {hf : ae_measurable f} {hg : ae_measurable g} : lift_rel r (mk f hf) (mk g hg) ↔ filter.eventually (fun (a : α) => r (f a) (g a)) (measure.ae μ) :=
  iff.rfl

theorem lift_rel_iff_coe_fn {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space β] [measurable_space γ] {r : β → γ → Prop} {f : ae_eq_fun α β μ} {g : ae_eq_fun α γ μ} : lift_rel r f g ↔ filter.eventually (fun (a : α) => r (coe_fn f a) (coe_fn g a)) (measure.ae μ) := sorry

protected instance preorder {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [preorder β] : preorder (ae_eq_fun α β μ) :=
  preorder.lift to_germ

@[simp] theorem mk_le_mk {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [preorder β] {f : α → β} {g : α → β} (hf : ae_measurable f) (hg : ae_measurable g) : mk f hf ≤ mk g hg ↔ filter.eventually_le (measure.ae μ) f g :=
  iff.rfl

@[simp] theorem coe_fn_le {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [preorder β] {f : ae_eq_fun α β μ} {g : ae_eq_fun α β μ} : filter.eventually_le (measure.ae μ) ⇑f ⇑g ↔ f ≤ g :=
  iff.symm lift_rel_iff_coe_fn

protected instance partial_order {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [partial_order β] : partial_order (ae_eq_fun α β μ) :=
  partial_order.lift to_germ to_germ_injective

/- TODO: Prove `L⁰` space is a lattice if β is linear order.
         What if β is only a lattice? -/

-- instance [linear_order β] : semilattice_sup (α →ₘ β) :=

-- { sup := comp₂ (⊔) (_),

--    .. ae_eq_fun.partial_order }

/-- The equivalence class of a constant function: `[λa:α, b]`, based on the equivalence relation of
    being almost everywhere equal -/
def const (α : Type u_1) {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (b : β) : ae_eq_fun α β μ :=
  mk (fun (a : α) => b) ae_measurable_const

theorem coe_fn_const (α : Type u_1) {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] (b : β) : filter.eventually_eq (measure.ae μ) (⇑(const α b)) (function.const α b) :=
  coe_fn_mk (fun (a : α) => b) ae_measurable_const

protected instance inhabited {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [Inhabited β] : Inhabited (ae_eq_fun α β μ) :=
  { default := const α Inhabited.default }

protected instance has_zero {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [HasZero β] : HasZero (ae_eq_fun α β μ) :=
  { zero := const α 0 }

theorem one_def {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [HasOne β] : 1 = mk (fun (a : α) => 1) ae_measurable_const :=
  rfl

theorem coe_fn_one {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [HasOne β] : filter.eventually_eq (measure.ae μ) (⇑1) 1 :=
  coe_fn_const α 1

@[simp] theorem one_to_germ {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure α} [measurable_space β] [HasOne β] : to_germ 1 = 1 :=
  rfl

protected instance has_mul {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [monoid γ] [has_continuous_mul γ] : Mul (ae_eq_fun α γ μ) :=
  { mul := comp₂ Mul.mul sorry }

@[simp] theorem mk_mul_mk {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [monoid γ] [has_continuous_mul γ] (f : α → γ) (g : α → γ) (hf : ae_measurable f) (hg : ae_measurable g) : mk f hf * mk g hg = mk (f * g) (ae_measurable.mul hf hg) :=
  rfl

theorem coe_fn_mul {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [monoid γ] [has_continuous_mul γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) (⇑(f * g)) (⇑f * ⇑g) :=
  coe_fn_comp₂ Mul.mul has_mul._proof_1 f g

@[simp] theorem mul_to_germ {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [monoid γ] [has_continuous_mul γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : to_germ (f * g) = to_germ f * to_germ g :=
  comp₂_to_germ Mul.mul has_mul._proof_1 f g

protected instance add_monoid {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [add_monoid γ] [has_continuous_add γ] : add_monoid (ae_eq_fun α γ μ) :=
  function.injective.add_monoid to_germ to_germ_injective sorry add_to_germ

protected instance add_comm_monoid {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [topological_space.second_countable_topology γ] [borel_space γ] [add_comm_monoid γ] [has_continuous_add γ] : add_comm_monoid (ae_eq_fun α γ μ) :=
  function.injective.add_comm_monoid to_germ to_germ_injective sorry sorry

protected instance has_inv {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [group γ] [topological_group γ] : has_inv (ae_eq_fun α γ μ) :=
  has_inv.mk (comp has_inv.inv measurable_inv)

@[simp] theorem inv_mk {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [group γ] [topological_group γ] (f : α → γ) (hf : ae_measurable f) : mk f hf⁻¹ = mk (f⁻¹) (ae_measurable.inv hf) :=
  rfl

theorem coe_fn_neg {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [add_group γ] [topological_add_group γ] (f : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) (⇑(-f)) (-⇑f) :=
  coe_fn_comp Neg.neg measurable_neg f

theorem inv_to_germ {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [group γ] [topological_group γ] (f : ae_eq_fun α γ μ) : to_germ (f⁻¹) = (to_germ f⁻¹) :=
  comp_to_germ has_inv.inv measurable_inv f

protected instance group {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [group γ] [topological_group γ] [topological_space.second_countable_topology γ] : group (ae_eq_fun α γ μ) :=
  function.injective.group to_germ to_germ_injective sorry sorry inv_to_germ

@[simp] theorem mk_sub {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [add_group γ] [topological_add_group γ] [topological_space.second_countable_topology γ] (f : α → γ) (g : α → γ) (hf : ae_measurable fun (x : α) => f x) (hg : ae_measurable fun (x : α) => g x) : mk (f - g) (ae_measurable.sub hf hg) = mk f hf - mk g hg := sorry

theorem coe_fn_sub {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [add_group γ] [topological_add_group γ] [topological_space.second_countable_topology γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) (⇑(f - g)) (⇑f - ⇑g) := sorry

protected instance comm_group {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [borel_space γ] [comm_group γ] [topological_group γ] [topological_space.second_countable_topology γ] : comm_group (ae_eq_fun α γ μ) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

protected instance has_scalar {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [semiring 𝕜] [topological_space 𝕜] [topological_space γ] [borel_space γ] [add_comm_monoid γ] [semimodule 𝕜 γ] [topological_semimodule 𝕜 γ] : has_scalar 𝕜 (ae_eq_fun α γ μ) :=
  has_scalar.mk fun (c : 𝕜) (f : ae_eq_fun α γ μ) => comp (has_scalar.smul c) sorry f

@[simp] theorem smul_mk {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [semiring 𝕜] [topological_space 𝕜] [topological_space γ] [borel_space γ] [add_comm_monoid γ] [semimodule 𝕜 γ] [topological_semimodule 𝕜 γ] (c : 𝕜) (f : α → γ) (hf : ae_measurable f) : c • mk f hf = mk (c • f) (ae_measurable.const_smul hf c) :=
  rfl

theorem coe_fn_smul {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [semiring 𝕜] [topological_space 𝕜] [topological_space γ] [borel_space γ] [add_comm_monoid γ] [semimodule 𝕜 γ] [topological_semimodule 𝕜 γ] (c : 𝕜) (f : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) (⇑(c • f)) (c • ⇑f) :=
  coe_fn_comp (has_scalar.smul c) (has_scalar._proof_1 c) f

theorem smul_to_germ {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [semiring 𝕜] [topological_space 𝕜] [topological_space γ] [borel_space γ] [add_comm_monoid γ] [semimodule 𝕜 γ] [topological_semimodule 𝕜 γ] (c : 𝕜) (f : ae_eq_fun α γ μ) : to_germ (c • f) = c • to_germ f :=
  comp_to_germ (has_scalar.smul c) (has_scalar._proof_1 c) f

protected instance semimodule {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [semiring 𝕜] [topological_space 𝕜] [topological_space γ] [borel_space γ] [add_comm_monoid γ] [semimodule 𝕜 γ] [topological_semimodule 𝕜 γ] [topological_space.second_countable_topology γ] [has_continuous_add γ] : semimodule 𝕜 (ae_eq_fun α γ μ) :=
  function.injective.semimodule 𝕜 (add_monoid_hom.mk to_germ sorry sorry) to_germ_injective smul_to_germ

/- TODO : Prove that `L⁰` is a complete space if the codomain is complete. -/

/-- For `f : α → ennreal`, define `∫ [f]` to be `∫ f` -/
def lintegral {α : Type u_1} [measurable_space α] {μ : measure α} (f : ae_eq_fun α ennreal μ) : ennreal :=
  quotient.lift_on' f (fun (f : Subtype fun (f : α → ennreal) => ae_measurable f) => lintegral μ fun (a : α) => coe f a)
    sorry

@[simp] theorem lintegral_mk {α : Type u_1} [measurable_space α] {μ : measure α} (f : α → ennreal) (hf : ae_measurable f) : lintegral (mk f hf) = lintegral μ fun (a : α) => f a :=
  rfl

theorem lintegral_coe_fn {α : Type u_1} [measurable_space α] {μ : measure α} (f : ae_eq_fun α ennreal μ) : (lintegral μ fun (a : α) => coe_fn f a) = lintegral f := sorry

@[simp] theorem lintegral_zero {α : Type u_1} [measurable_space α] {μ : measure α} : lintegral 0 = 0 :=
  lintegral_zero

@[simp] theorem lintegral_eq_zero_iff {α : Type u_1} [measurable_space α] {μ : measure α} {f : ae_eq_fun α ennreal μ} : lintegral f = 0 ↔ f = 0 :=
  induction_on f fun (f : α → ennreal) (hf : ae_measurable f) => iff.trans (lintegral_eq_zero_iff' hf) (iff.symm mk_eq_mk)

theorem lintegral_add {α : Type u_1} [measurable_space α] {μ : measure α} (f : ae_eq_fun α ennreal μ) (g : ae_eq_fun α ennreal μ) : lintegral (f + g) = lintegral f + lintegral g := sorry

theorem lintegral_mono {α : Type u_1} [measurable_space α] {μ : measure α} {f : ae_eq_fun α ennreal μ} {g : ae_eq_fun α ennreal μ} : f ≤ g → lintegral f ≤ lintegral g :=
  induction_on₂ f g
    fun (f : α → ennreal) (hf : ae_measurable f) (g : α → ennreal) (hg : ae_measurable g) (hfg : mk f hf ≤ mk g hg) =>
      lintegral_mono_ae hfg

/-- `comp_edist [f] [g] a` will return `edist (f a) (g a)` -/
protected def edist {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : ae_eq_fun α ennreal μ :=
  comp₂ edist measurable_edist f g

protected theorem edist_comm {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : ae_eq_fun.edist f g = ae_eq_fun.edist g f :=
  induction_on₂ f g
    fun (f : α → γ) (hf : ae_measurable f) (g : α → γ) (hg : ae_measurable g) =>
      iff.mpr mk_eq_mk (filter.eventually_of_forall fun (x : α) => edist_comm (f x) (g x))

theorem coe_fn_edist {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) ⇑(ae_eq_fun.edist f g) fun (a : α) => edist (coe_fn f a) (coe_fn g a) :=
  coe_fn_comp₂ edist measurable_edist f g

protected theorem edist_self {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) : ae_eq_fun.edist f f = 0 :=
  induction_on f
    fun (f : α → γ) (hf : ae_measurable f) =>
      iff.mpr mk_eq_mk (filter.eventually_of_forall fun (x : α) => edist_self (f x))

/-- Almost everywhere equal functions form an `emetric_space`, with the emetric defined as
  `edist f g = ∫⁻ a, edist (f a) (g a)`. -/
protected instance emetric_space {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] : emetric_space (ae_eq_fun α γ μ) :=
  emetric_space.mk sorry sorry sorry sorry
    (uniform_space_of_edist (fun (f g : ae_eq_fun α γ μ) => lintegral (ae_eq_fun.edist f g)) sorry sorry sorry)

theorem edist_mk_mk {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] {f : α → γ} {g : α → γ} (hf : ae_measurable f) (hg : ae_measurable g) : edist (mk f hf) (mk g hg) = lintegral μ fun (x : α) => edist (f x) (g x) :=
  rfl

theorem edist_eq_coe {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : edist f g = lintegral μ fun (x : α) => edist (coe_fn f x) (coe_fn g x) := sorry

theorem edist_zero_eq_coe {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [emetric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] [HasZero γ] (f : ae_eq_fun α γ μ) : edist f 0 = lintegral μ fun (x : α) => edist (coe_fn f x) 0 := sorry

theorem edist_mk_mk' {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [metric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] {f : α → γ} {g : α → γ} (hf : ae_measurable f) (hg : ae_measurable g) : edist (mk f hf) (mk g hg) = lintegral μ fun (x : α) => ↑(nndist (f x) (g x)) := sorry

theorem edist_eq_coe' {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [metric_space γ] [topological_space.second_countable_topology γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) : edist f g = lintegral μ fun (x : α) => ↑(nndist (coe_fn f x) (coe_fn g x)) := sorry

theorem edist_add_right {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [normed_group γ] [topological_space.second_countable_topology γ] [borel_space γ] (f : ae_eq_fun α γ μ) (g : ae_eq_fun α γ μ) (h : ae_eq_fun α γ μ) : edist (f + h) (g + h) = edist f g := sorry

theorem edist_smul {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] {𝕜 : Type u_5} [normed_field 𝕜] [normed_group γ] [topological_space.second_countable_topology γ] [normed_space 𝕜 γ] [borel_space γ] (c : 𝕜) (f : ae_eq_fun α γ μ) : edist (c • f) 0 = ennreal.of_real (norm c) * edist f 0 := sorry

/-- Positive part of an `ae_eq_fun`. -/
def pos_part {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [linear_order γ] [order_closed_topology γ] [topological_space.second_countable_topology γ] [HasZero γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) : ae_eq_fun α γ μ :=
  comp (fun (x : γ) => max x 0) sorry f

@[simp] theorem pos_part_mk {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [linear_order γ] [order_closed_topology γ] [topological_space.second_countable_topology γ] [HasZero γ] [opens_measurable_space γ] (f : α → γ) (hf : ae_measurable f) : pos_part (mk f hf) = mk (fun (x : α) => max (f x) 0) (ae_measurable.max hf ae_measurable_const) :=
  rfl

theorem coe_fn_pos_part {α : Type u_1} {γ : Type u_3} [measurable_space α] {μ : measure α} [measurable_space γ] [topological_space γ] [linear_order γ] [order_closed_topology γ] [topological_space.second_countable_topology γ] [HasZero γ] [opens_measurable_space γ] (f : ae_eq_fun α γ μ) : filter.eventually_eq (measure.ae μ) ⇑(pos_part f) fun (a : α) => max (coe_fn f a) 0 :=
  coe_fn_comp (fun (x : γ) => max x 0) pos_part._proof_1 f


/-
Copyright (c) 2020 Bhavik Mehta, E. W. Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, E. W. Ayers
-/

import category_theory.sites.sieves
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.multiequalizer
import category_theory.category.preorder
import order.copy

/-!
# Grothendieck topologies

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

Definition and lemmas about Grothendieck topologies.
A Grothendieck topology for a category `C` is a set of sieves on each object `X` satisfying
certain closure conditions.

Alternate versions of the axioms (in arrow form) are also described.
Two explicit examples of Grothendieck topologies are given:
* The dense topology
* The atomic topology
as well as the complete lattice structure on Grothendieck topologies (which gives two additional
explicit topologies: the discrete and trivial topologies.)

A pretopology, or a basis for a topology is defined in `pretopology.lean`. The topology associated
to a topological space is defined in `spaces.lean`.

## Tags

Grothendieck topology, coverage, pretopology, site

## References

* [nLab, *Grothendieck topology*](https://ncatlab.org/nlab/show/Grothendieck+topology)
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]

## Implementation notes

We use the definition of [nlab] and [MM92][] (Chapter III, Section 2), where Grothendieck topologies
are saturated collections of morphisms, rather than the notions of the Stacks project (00VG) and
the Elephant, in which topologies are allowed to be unsaturated, and are then completed.
TODO (BM): Add the definition from Stacks, as a pretopology, and complete to a topology.

This is so that we can produce a bijective correspondence between Grothendieck topologies on a
small category and Lawvere-Tierney topologies on its presheaf topos, as well as the equivalence
between Grothendieck topoi and left exact reflective subcategories of presheaf toposes.
-/

universes w v u
namespace category_theory

open category_theory category

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

/--
The definition of a Grothendieck topology: a set of sieves `J X` on each object `X` satisfying
three axioms:
1. For every object `X`, the maximal sieve is in `J X`.
2. If `S ∈ J X` then its pullback along any `h : Y ⟶ X` is in `J Y`.
3. If `S ∈ J X` and `R` is a sieve on `X`, then provided that the pullback of `R` along any arrow
   `f : Y ⟶ X` in `S` is in `J Y`, we have that `R` itself is in `J X`.

A sieve `S` on `X` is referred to as `J`-covering, (or just covering), if `S ∈ J X`.

See <https://stacks.math.columbia.edu/tag/00Z4>, or [nlab], or [MM92][] Chapter III, Section 2,
Definition 1.
-/
structure grothendieck_topology :=
(sieves : Π (X : C), set (sieve X))
(top_mem' : ∀ X, ⊤ ∈ sieves X)
(pullback_stable' : ∀ ⦃X Y : C⦄ ⦃S : sieve X⦄ (f : Y ⟶ X), S ∈ sieves X → S.pullback f ∈ sieves Y)
(transitive' : ∀ ⦃X⦄ ⦃S : sieve X⦄ (hS : S ∈ sieves X) (R : sieve X),
              (∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → R.pullback f ∈ sieves Y) → R ∈ sieves X)

namespace grothendieck_topology

instance : has_coe_to_fun (grothendieck_topology C) (λ _, Π X : C, set (sieve X)) := ⟨sieves⟩

variables {C} {X Y : C} {S R : sieve X}
variables (J : grothendieck_topology C)

/--
An extensionality lemma in terms of the coercion to a pi-type.
We prove this explicitly rather than deriving it so that it is in terms of the coercion rather than
the projection `.sieves`.
-/
@[ext]
lemma ext {J₁ J₂ : grothendieck_topology C} (h : (J₁ : Π (X : C), set (sieve X)) = J₂) : J₁ = J₂ :=
by { cases J₁, cases J₂, congr, apply h }

@[simp] lemma mem_sieves_iff_coe : S ∈ J.sieves X ↔ S ∈ J X := iff.rfl

-- Also known as the maximality axiom.
@[simp] lemma top_mem (X : C) : ⊤ ∈ J X := J.top_mem' X
-- Also known as the stability axiom.
@[simp] lemma pullback_stable (f : Y ⟶ X) (hS : S ∈ J X) : S.pullback f ∈ J Y :=
J.pullback_stable' f hS
lemma transitive (hS : S ∈ J X) (R : sieve X)
  (h : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → R.pullback f ∈ J Y) :
  R ∈ J X :=
J.transitive' hS R h

lemma covering_of_eq_top : S = ⊤ → S ∈ J X := λ h, h.symm ▸ J.top_mem X

/--
If `S` is a subset of `R`, and `S` is covering, then `R` is covering as well.

See <https://stacks.math.columbia.edu/tag/00Z5> (2), or discussion after [MM92] Chapter III,
Section 2, Definition 1.
-/
lemma superset_covering (Hss : S ≤ R) (sjx : S ∈ J X) : R ∈ J X :=
begin
  apply J.transitive sjx R (λ Y f hf, _),
  apply covering_of_eq_top,
  rw [← top_le_iff, ← S.pullback_eq_top_of_mem hf],
  apply sieve.pullback_monotone _ Hss,
end

/--
The intersection of two covering sieves is covering.

See <https://stacks.math.columbia.edu/tag/00Z5> (1), or [MM92] Chapter III,
Section 2, Definition 1 (iv).
-/
lemma intersection_covering (rj : R ∈ J X) (sj : S ∈ J X) : R ⊓ S ∈ J X :=
begin
  apply J.transitive rj _ (λ Y f Hf, _),
  rw [sieve.pullback_inter, R.pullback_eq_top_of_mem Hf],
  simp [sj],
end

@[simp]
lemma intersection_covering_iff : R ⊓ S ∈ J X ↔ R ∈ J X ∧ S ∈ J X :=
⟨λ h, ⟨J.superset_covering inf_le_left h, J.superset_covering inf_le_right h⟩,
 λ t, intersection_covering _ t.1 t.2⟩

/--
The sieve `S` on `X` `J`-covers an arrow `f` to `X` if `S.pullback f ∈ J Y`.
This definition is an alternate way of presenting a Grothendieck topology.
-/
def covers (S : sieve X) (f : Y ⟶ X) : Prop := S.pullback f ∈ J Y

lemma covers_iff (S : sieve X) (f : Y ⟶ X) : J.covers S f ↔ S.pullback f ∈ J Y :=
iff.rfl

lemma covering_iff_covers_id (S : sieve X) : S ∈ J X ↔ J.covers S (𝟙 X) :=
by simp [covers_iff]

/-- The maximality axiom in 'arrow' form: Any arrow `f` in `S` is covered by `S`. -/
lemma arrow_max (f : Y ⟶ X) (S : sieve X) (hf : S f) : J.covers S f :=
begin
  rw [covers, (sieve.pullback_eq_top_iff_mem f).1 hf],
  apply J.top_mem,
end

/-- The stability axiom in 'arrow' form: If `S` covers `f` then `S` covers `g ≫ f` for any `g`. -/
lemma arrow_stable (f : Y ⟶ X) (S : sieve X) (h : J.covers S f) {Z : C} (g : Z ⟶ Y) :
  J.covers S (g ≫ f) :=
begin
  rw covers_iff at h ⊢,
  simp [h, sieve.pullback_comp],
end

/--
The transitivity axiom in 'arrow' form: If `S` covers `f` and every arrow in `S` is covered by
`R`, then `R` covers `f`.
-/
lemma arrow_trans (f : Y ⟶ X) (S R : sieve X) (h : J.covers S f) :
  (∀ {Z : C} (g : Z ⟶ X), S g → J.covers R g) → J.covers R f :=
begin
  intro k,
  apply J.transitive h,
  intros Z g hg,
  rw ← sieve.pullback_comp,
  apply k (g ≫ f) hg,
end

lemma arrow_intersect (f : Y ⟶ X) (S R : sieve X) (hS : J.covers S f) (hR : J.covers R f) :
  J.covers (S ⊓ R) f :=
by simpa [covers_iff] using and.intro hS hR

variable (C)
/--
The trivial Grothendieck topology, in which only the maximal sieve is covering. This topology is
also known as the indiscrete, coarse, or chaotic topology.

See [MM92] Chapter III, Section 2, example (a), or
https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies
-/
def trivial : grothendieck_topology C :=
{ sieves := λ X, {⊤},
  top_mem' := λ X, rfl,
  pullback_stable' := λ X Y S f hf,
  begin
    rw set.mem_singleton_iff at ⊢ hf,
    simp [hf],
  end,
  transitive' := λ X S hS R hR,
  begin
    rw [set.mem_singleton_iff, ← sieve.id_mem_iff_eq_top] at hS,
    simpa using hR hS,
  end }

/--
The discrete Grothendieck topology, in which every sieve is covering.

See https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies.
-/
def discrete : grothendieck_topology C :=
{ sieves := λ X, set.univ,
  top_mem' := by simp,
  pullback_stable' := λ X Y f, by simp,
  transitive' := by simp }
variable {C}

lemma trivial_covering : S ∈ trivial C X ↔ S = ⊤ := set.mem_singleton_iff

/-- See <https://stacks.math.columbia.edu/tag/00Z6> -/
instance : has_le (grothendieck_topology C) :=
{ le := λ J₁ J₂, (J₁ : Π (X : C), set (sieve X)) ≤ (J₂ : Π (X : C), set (sieve X)) }

lemma le_def {J₁ J₂ : grothendieck_topology C} :
  J₁ ≤ J₂ ↔ (J₁ : Π (X : C), set (sieve X)) ≤ J₂ := iff.rfl

/-- See <https://stacks.math.columbia.edu/tag/00Z6> -/
instance : partial_order (grothendieck_topology C) :=
{ le_refl := λ J₁, le_def.mpr le_rfl,
  le_trans := λ J₁ J₂ J₃ h₁₂ h₂₃, le_def.mpr (le_trans h₁₂ h₂₃),
  le_antisymm := λ J₁ J₂ h₁₂ h₂₁, grothendieck_topology.ext (le_antisymm h₁₂ h₂₁),
  ..grothendieck_topology.has_le }

/-- See <https://stacks.math.columbia.edu/tag/00Z7> -/
instance : has_Inf (grothendieck_topology C) :=
{ Inf := λ T,
  { sieves := Inf (sieves '' T),
    top_mem' :=
    begin
      rintro X S ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      simp,
    end,
    pullback_stable' :=
    begin
      rintro X Y S hS f _ ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      apply J.pullback_stable _ (f _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩),
    end,
    transitive' :=
    begin
      rintro X S hS R h _ ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      apply J.transitive (hS _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩) _ (λ Y f hf, h hf _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩),
    end } }

/-- See <https://stacks.math.columbia.edu/tag/00Z7> -/
lemma is_glb_Inf (s : set (grothendieck_topology C)) : is_glb s (Inf s) :=
begin
  refine @is_glb.of_image _ _ _ _ sieves _ _ _ _,
  { intros, refl },
  { exact is_glb_Inf _ },
end

/--
Construct a complete lattice from the `Inf`, but make the trivial and discrete topologies
definitionally equal to the bottom and top respectively.
-/
instance : complete_lattice (grothendieck_topology C) :=
complete_lattice.copy
(complete_lattice_of_Inf _ is_glb_Inf)
_ rfl
(discrete C)
(begin
  apply le_antisymm,
  { exact @complete_lattice.le_top _ (complete_lattice_of_Inf _ is_glb_Inf) (discrete C) },
  { intros X S hS,
    apply set.mem_univ },
end)
(trivial C)
(begin
  apply le_antisymm,
  { intros X S hS,
    rw trivial_covering at hS,
    apply covering_of_eq_top _ hS },
  { refine @complete_lattice.bot_le _ (complete_lattice_of_Inf _ is_glb_Inf) (trivial C) },
end)
_ rfl
_ rfl
_ rfl
Inf rfl

instance : inhabited (grothendieck_topology C) := ⟨⊤⟩

@[simp] lemma trivial_eq_bot : trivial C = ⊥ := rfl
@[simp] lemma discrete_eq_top : discrete C = ⊤ := rfl

@[simp] lemma bot_covering : S ∈ (⊥ : grothendieck_topology C) X ↔ S = ⊤ := trivial_covering
@[simp] lemma top_covering : S ∈ (⊤ : grothendieck_topology C) X := ⟨⟩

lemma bot_covers (S : sieve X) (f : Y ⟶ X) :
  (⊥ : grothendieck_topology C).covers S f ↔ S f :=
by rw [covers_iff, bot_covering, ← sieve.pullback_eq_top_iff_mem]

@[simp] lemma top_covers (S : sieve X) (f : Y ⟶ X) : (⊤ : grothendieck_topology C).covers S f :=
by simp [covers_iff]

/--
The dense Grothendieck topology.

See https://ncatlab.org/nlab/show/dense+topology, or [MM92] Chapter III, Section 2, example (e).
-/
def dense : grothendieck_topology C :=
{ sieves := λ X S, ∀ {Y : C} (f : Y ⟶ X), ∃ Z (g : Z ⟶ Y), S (g ≫ f),
  top_mem' := λ X Y f, ⟨Y, 𝟙 Y, ⟨⟩⟩,
  pullback_stable' :=
  begin
    intros X Y S h H Z f,
    rcases H (f ≫ h) with ⟨W, g, H'⟩,
    exact ⟨W, g, by simpa⟩,
  end,
  transitive' :=
  begin
    intros X S H₁ R H₂ Y f,
    rcases H₁ f with ⟨Z, g, H₃⟩,
    rcases H₂ H₃ (𝟙 Z) with ⟨W, h, H₄⟩,
    exact ⟨W, (h ≫ g), by simpa using H₄⟩,
  end }

lemma dense_covering : S ∈ dense X ↔ ∀ {Y} (f : Y ⟶ X), ∃ Z (g : Z ⟶ Y), S (g ≫ f) :=
iff.rfl

/--
A category satisfies the right Ore condition if any span can be completed to a commutative square.
NB. Any category with pullbacks obviously satisfies the right Ore condition, see
`right_ore_of_pullbacks`.
-/
def right_ore_condition (C : Type u) [category.{v} C] : Prop :=
∀ {X Y Z : C} (yx : Y ⟶ X) (zx : Z ⟶ X), ∃ W (wy : W ⟶ Y) (wz : W ⟶ Z), wy ≫ yx = wz ≫ zx

lemma right_ore_of_pullbacks [limits.has_pullbacks C] : right_ore_condition C :=
λ X Y Z yx zx, ⟨_, _, _, limits.pullback.condition⟩

/--
The atomic Grothendieck topology: a sieve is covering iff it is nonempty.
For the pullback stability condition, we need the right Ore condition to hold.

See https://ncatlab.org/nlab/show/atomic+site, or [MM92] Chapter III, Section 2, example (f).
-/
def atomic (hro : right_ore_condition C) : grothendieck_topology C :=
{ sieves := λ X S, ∃ Y (f : Y ⟶ X), S f,
  top_mem' := λ X, ⟨_, 𝟙 _, ⟨⟩⟩,
  pullback_stable' :=
  begin
    rintros X Y S h ⟨Z, f, hf⟩,
    rcases hro h f with ⟨W, g, k, comm⟩,
    refine ⟨_, g, _⟩,
    simp [comm, hf],
  end,
  transitive' :=
  begin
    rintros X S ⟨Y, f, hf⟩ R h,
    rcases h hf with ⟨Z, g, hg⟩,
    exact ⟨_, _, hg⟩,
  end }

/-- `J.cover X` denotes the poset of covers of `X` with respect to the
Grothendieck topology `J`. -/
@[derive preorder]
def cover (X : C) := { S : sieve X // S ∈ J X }

namespace cover

variables {J}

instance : has_coe (J.cover X) (sieve X) := ⟨λ S, S.1⟩

instance : has_coe_to_fun (J.cover X) (λ S, Π ⦃Y⦄ (f : Y ⟶ X), Prop) :=
⟨λ S Y f, (S : sieve X) f⟩

@[simp]
lemma coe_fun_coe (S : J.cover X) (f : Y ⟶ X) : (S : sieve X) f = S f := rfl

lemma condition (S : J.cover X) : (S : sieve X) ∈ J X := S.2

@[ext]
lemma ext (S T : J.cover X) (h : ∀ ⦃Y⦄ (f : Y ⟶ X), S f ↔ T f) : S = T :=
subtype.ext $ sieve.ext h

instance : order_top (J.cover X) :=
{ top := ⟨⊤, J.top_mem _⟩,
  le_top := λ S Y f h, by tauto,
  ..(infer_instance : preorder _) }

instance : semilattice_inf (J.cover X) :=
{ inf := λ S T, ⟨S ⊓ T, J.intersection_covering S.condition T.condition⟩,
  le_antisymm := λ S T h1 h2, ext _ _ $ λ Y f, ⟨h1 _, h2 _⟩,
  inf_le_left := λ S T Y f hf, hf.1,
  inf_le_right := λ S T Y f hf, hf.2,
  le_inf := λ S T W h1 h2 Y f h, ⟨h1 _ h, h2 _ h⟩,
  ..(infer_instance : preorder _) }

instance : inhabited (J.cover X) := ⟨⊤⟩

/-- An auxiliary structure, used to define `S.index` in `plus.lean`. -/
@[nolint has_nonempty_instance, ext]
structure arrow (S : J.cover X) :=
(Y : C)
(f : Y ⟶ X)
(hf : S f)

/-- An auxiliary structure, used to define `S.index` in `plus.lean`. -/
@[nolint has_nonempty_instance, ext]
structure relation (S : J.cover X) :=
(Y₁ Y₂ Z : C)
(g₁ : Z ⟶ Y₁)
(g₂ : Z ⟶ Y₂)
(f₁ : Y₁ ⟶ X)
(f₂ : Y₂ ⟶ X)
(h₁ : S f₁)
(h₂ : S f₂)
(w : g₁ ≫ f₁ = g₂ ≫ f₂)

/-- Map a `arrow` along a refinement `S ⟶ T`. -/
@[simps]
def arrow.map {S T : J.cover X} (I : S.arrow) (f : S ⟶ T) : T.arrow :=
⟨I.Y, I.f, f.le _ I.hf⟩

/-- Map a `relation` along a refinement `S ⟶ T`. -/
@[simps]
def relation.map {S T : J.cover X} (I : S.relation) (f : S ⟶ T) : T.relation :=
⟨_, _, _, I.g₁, I.g₂, I.f₁, I.f₂, f.le _ I.h₁, f.le _ I.h₂, I.w⟩

/-- The first `arrow` associated to a `relation`.
Used in defining `index` in `plus.lean`. -/
@[simps]
def relation.fst {S : J.cover X} (I : S.relation) : S.arrow :=
⟨I.Y₁, I.f₁, I.h₁⟩

/-- The second `arrow` associated to a `relation`.
Used in defining `index` in `plus.lean`. -/
@[simps]
def relation.snd {S : J.cover X} (I : S.relation) : S.arrow :=
⟨I.Y₂, I.f₂, I.h₂⟩

@[simp]
lemma relation.map_fst {S T : J.cover X} (I : S.relation) (f : S ⟶ T) :
   I.fst.map f = (I.map f).fst := rfl

@[simp]
lemma relation.map_snd {S T : J.cover X} (I : S.relation) (f : S ⟶ T) :
  I.snd.map f = (I.map f).snd := rfl

/-- Pull back a cover along a morphism. -/
def pullback (S : J.cover X) (f : Y ⟶ X) : J.cover Y :=
⟨sieve.pullback f S, J.pullback_stable _ S.condition⟩

/-- An arrow of `S.pullback f` gives rise to an arrow of `S`. -/
@[simps]
def arrow.base {f : Y ⟶ X} {S : J.cover X} (I : (S.pullback f).arrow) : S.arrow :=
⟨I.Y, I.f ≫ f, I.hf⟩

/-- A relation of `S.pullback f` gives rise to a relation of `S`. -/
@[simps]
def relation.base {f : Y ⟶ X} {S : J.cover X} (I : (S.pullback f).relation) : S.relation :=
⟨_, _, _, I.g₁, I.g₂, I.f₁ ≫ f, I.f₂≫ f, I.h₁, I.h₂, by simp [reassoc_of I.w]⟩

@[simp]
lemma relation.base_fst {f : Y ⟶ X} {S : J.cover X} (I : (S.pullback f).relation) :
 I.fst.base = I.base.fst := rfl

@[simp]
lemma relation.base_snd {f : Y ⟶ X} {S : J.cover X} (I : (S.pullback f).relation) :
 I.snd.base = I.base.snd := rfl

@[simp]
lemma coe_pullback {Z : C} (f : Y ⟶ X) (g : Z ⟶ Y) (S : J.cover X) :
  (S.pullback f) g ↔ S (g ≫ f) := iff.rfl

/-- The isomorphism between `S` and the pullback of `S` w.r.t. the identity. -/
def pullback_id (S : J.cover X) : S.pullback (𝟙 X) ≅ S :=
eq_to_iso $ cover.ext _ _ $ λ Y f, by simp

/-- Pulling back with respect to a composition is the composition of the pullbacks. -/
def pullback_comp {X Y Z : C} (S : J.cover X) (f : Z ⟶ Y) (g : Y ⟶ X) :
  S.pullback (f ≫ g) ≅ (S.pullback g).pullback f :=
eq_to_iso $ cover.ext _ _ $ λ Y f, by simp

/-- Combine a family of covers over a cover. -/
def bind {X : C} (S : J.cover X) (T : Π (I : S.arrow), J.cover I.Y) : J.cover X :=
⟨sieve.bind S (λ Y f hf, T ⟨Y, f, hf⟩), J.bind_covering S.condition (λ _ _ _, (T _).condition)⟩

/-- The canonical moprhism from `S.bind T` to `T`. -/
def bind_to_base {X : C} (S : J.cover X) (T : Π (I : S.arrow), J.cover I.Y) : S.bind T ⟶ S :=
hom_of_le $ by { rintro Y f ⟨Z,e1,e2,h1,h2,h3⟩, rw ← h3, apply sieve.downward_closed, exact h1 }

/-- An arrow in bind has the form `A ⟶ B ⟶ X` where `A ⟶ B` is an arrow in `T I` for some `I`.
 and `B ⟶ X` is an arrow of `S`. This is the object `B`. -/
noncomputable def arrow.middle {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : C :=
I.hf.some

/-- An arrow in bind has the form `A ⟶ B ⟶ X` where `A ⟶ B` is an arrow in `T I` for some `I`.
 and `B ⟶ X` is an arrow of `S`. This is the hom `A ⟶ B`. -/
noncomputable def arrow.to_middle_hom {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : I.Y ⟶ I.middle :=
I.hf.some_spec.some

/-- An arrow in bind has the form `A ⟶ B ⟶ X` where `A ⟶ B` is an arrow in `T I` for some `I`.
 and `B ⟶ X` is an arrow of `S`. This is the hom `B ⟶ X`. -/
noncomputable def arrow.from_middle_hom {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : I.middle ⟶ X :=
I.hf.some_spec.some_spec.some

lemma arrow.from_middle_condition {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : S I.from_middle_hom :=
I.hf.some_spec.some_spec.some_spec.some

/-- An arrow in bind has the form `A ⟶ B ⟶ X` where `A ⟶ B` is an arrow in `T I` for some `I`.
 and `B ⟶ X` is an arrow of `S`. This is the hom `B ⟶ X`, as an arrow. -/
noncomputable
def arrow.from_middle {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : S.arrow := ⟨_, I.from_middle_hom, I.from_middle_condition⟩

lemma arrow.to_middle_condition {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : (T I.from_middle) I.to_middle_hom :=
I.hf.some_spec.some_spec.some_spec.some_spec.1

/-- An arrow in bind has the form `A ⟶ B ⟶ X` where `A ⟶ B` is an arrow in `T I` for some `I`.
 and `B ⟶ X` is an arrow of `S`. This is the hom `A ⟶ B`, as an arrow. -/
noncomputable
def arrow.to_middle {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : (T I.from_middle).arrow := ⟨_, I.to_middle_hom, I.to_middle_condition⟩

lemma arrow.middle_spec {X : C} {S : J.cover X} {T : Π (I : S.arrow), J.cover I.Y}
  (I : (S.bind T).arrow) : I.to_middle_hom ≫ I.from_middle_hom = I.f :=
I.hf.some_spec.some_spec.some_spec.some_spec.2

-- This is used extensively in `plus.lean`, etc.
-- We place this definition here as it will be used in `sheaf.lean` as well.
/-- To every `S : J.cover X` and presheaf `P`, associate a `multicospan_index`. -/
def index {D : Type w} [category.{max v u} D] (S : J.cover X) (P : Cᵒᵖ ⥤ D) :
  limits.multicospan_index D :=
{ L := S.arrow,
  R := S.relation,
  fst_to := λ I, I.fst,
  snd_to := λ I, I.snd,
  left := λ I, P.obj (opposite.op I.Y),
  right := λ I, P.obj (opposite.op I.Z),
  fst := λ I, P.map I.g₁.op,
  snd := λ I, P.map I.g₂.op }

/-- The natural multifork associated to `S : J.cover X` for a presheaf `P`.
Saying that this multifork is a limit is essentially equivalent to the sheaf condition at the
given object for the given covering sieve. See `sheaf.lean` for an equivalent sheaf condition
using this.
-/
abbreviation multifork {D : Type w} [category.{max v u} D] (S : J.cover X) (P : Cᵒᵖ ⥤ D) :
  limits.multifork (S.index P) :=
limits.multifork.of_ι _ (P.obj (opposite.op X)) (λ I, P.map I.f.op) begin
  intros I,
  dsimp [index],
  simp only [← P.map_comp, ← op_comp, I.w]
end

/-- The canonical map from `P.obj (op X)` to the multiequalizer associated to a covering sieve,
assuming such a multiequalizer exists. This will be used in `sheaf.lean` to provide an equivalent
sheaf condition in terms of multiequalizers. -/
noncomputable
abbreviation to_multiequalizer {D : Type w} [category.{max v u} D] (S : J.cover X) (P : Cᵒᵖ ⥤ D)
  [limits.has_multiequalizer (S.index P)] :
P.obj (opposite.op X) ⟶ limits.multiequalizer (S.index P) :=
limits.multiequalizer.lift _ _ (λ I, P.map I.f.op) begin
  intros I,
  dsimp only [index, relation.fst, relation.snd],
  simp only [← P.map_comp, ← op_comp, I.w],
end

end cover

/-- Pull back a cover along a morphism. -/
@[simps obj]
def pullback (f : Y ⟶ X) : J.cover X ⥤ J.cover Y :=
{ obj := λ S, S.pullback f,
  map := λ S T f, (sieve.pullback_monotone _ f.le).hom }

/-- Pulling back along the identity is naturally isomorphic to the identity functor. -/
def pullback_id (X : C) : J.pullback (𝟙 X) ≅ 𝟭 _ :=
nat_iso.of_components (λ S, S.pullback_id) $ by tidy

/-- Pulling back along a composition is naturally isomorphic to
the composition of the pullbacks. -/
def pullback_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  J.pullback (f ≫ g) ≅ J.pullback g ⋙ J.pullback f :=
nat_iso.of_components (λ S, S.pullback_comp f g) $ by tidy

end grothendieck_topology

end category_theory


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2)
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Schur's Inequality Short Simpler
Let $x, y, z \in \R_{\ge 0}$ be positive real numbers such that $x \ge y \ge z \ge 0$.

Let $t \in \R, t > 0$ be a (strictly) positive real number.

Then:
:$x^t \paren {x - y} \paren {x - z} + y^t \paren {y - z} \paren {y - x} + z^t \paren {z - x} \paren {z - y} \ge 0$

`proof`

Consider the expression:
:$\paren {x - y} \paren {x^t \paren {x - z} - y^t \paren {y - z}} + z^t \paren {x - z} \paren {y - z}$

We see that every term in the above is non-negative. So, directly:
:$(1): \quad \paren {x - y} \paren {x^t \paren {x - z} - y^t \paren {y - z}} + z^t \paren {x - z} \paren {y - z} \ge 0$

$(1) can be rearranged to Schur's inequality.
{{qed}}
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/
--OUTPUT 1
theorem schur_inequality_short_simpler (x y z : ℝ) (h1 : x ≥ y) (h2 : y ≥ z) (h3 : z ≥ 0) (t : ℝ) (h4 : t > 0) : x^t * (x - y) * (x - z) + y^t * (y - z) * (y - x) + z^t * (z - x) * (z - y) ≥ 0 :=
begin
  -- Consider the expression:
  have h5 : (x - y) * (x^t * (x - z) - y^t * (y - z)) + z^t * (x - z) * (y - z) ≥ 0,
  {
    -- We see that every term in the above is non-negative. So, directly:
    show (x - y) * (x^t * (x - z) - y^t * (y - z)) + z^t * (x - z) * (y - z) ≥ 0, from by auto [h1, h2, h3, h4, pow_pos, mul_nonneg, sub_nonneg, sub_nonneg_of_le, mul_nonneg, mul_nonneg, add_nonneg],
  },

  -- $(1) can be rearranged to Schur's inequality.
  show x^t * (x - y) * (x - z) + y^t * (y - z) * (y - x) + z^t * (z - x) * (z - y) ≥ 0, from by auto [h1, h2, h3, h4, pow_pos, mul_nonneg, sub_nonneg, sub_nonneg_of_le, mul_nonneg, mul_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg,
end --Needs more than 2000 tokens!


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module tactic.field_simp
! leanprover-community/mathlib commit 24a09b317861fb5aa3850cfd1254acf729b0a398
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Interactive
import Mathbin.Tactic.NormNum

/-!
# `field_simp` tactic

Tactic to clear denominators in algebraic expressions, based on `simp` with a specific simpset.
-/

namespace Tactic

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Try to prove a goal of the form `x ≠ 0` by calling `assumption`, or `norm_num1` if `x` is
      a numeral. -/
    unsafe
  def
    field_simp.ne_zero
    : tactic Unit
    :=
      do
        let goal ← tactic.target
          match
            goal
            with
            | q( $ ( e ) ≠ 0 ) => assumption <|> do let n ← e sorry
              | _ => tactic.fail "goal should be of the form `x ≠ 0`"
#align tactic.field_simp.ne_zero tactic.field_simp.ne_zero

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/--
The goal of `field_simp` is to reduce an expression in a field to an expression of the form `n / d`
where neither `n` nor `d` contains any division symbol, just using the simplifier (with a carefully
crafted simpset named `field_simps`) to reduce the number of division symbols whenever possible by
iterating the following steps:

- write an inverse as a division
- in any product, move the division to the right
- if there are several divisions in a product, group them together at the end and write them as a
  single division
- reduce a sum to a common denominator

If the goal is an equality, this simpset will also clear the denominators, so that the proof
can normally be concluded by an application of `ring` or `ring_exp`.

`field_simp [hx, hy]` is a short form for
`simp [-one_div, -mul_eq_zero, hx, hy] with field_simps {discharger := tactic.field_simp.ne_zero}`

Note that this naive algorithm will not try to detect common factors in denominators to reduce the
complexity of the resulting expression. Instead, it relies on the ability of `ring` to handle
complicated expressions in the next step.

As always with the simplifier, reduction steps will only be applied if the preconditions of the
lemmas can be checked. This means that proofs that denominators are nonzero should be included. The
fact that a product is nonzero when all factors are, and that a power of a nonzero number is
nonzero, are included in the simpset, but more complicated assertions (especially dealing with sums)
should be given explicitly. If your expression is not completely reduced by the simplifier
invocation, check the denominators of the resulting expression and provide proofs that they are
nonzero to enable further progress.

To check that denominators are nonzero, `field_simp` will look for facts in the context, and
will try to apply `norm_num` to close numerical goals.

The invocation of `field_simp` removes the lemma `one_div` from the simpset, as this lemma
works against the algorithm explained above. It also removes
`mul_eq_zero : x * y = 0 ↔ x = 0 ∨ y = 0`, as `norm_num` can not work on disjunctions to
close goals of the form `24 ≠ 0`, and replaces it with `mul_ne_zero : x ≠ 0 → y ≠ 0 → x * y ≠ 0`
creating two goals instead of a disjunction.

For example,
```lean
example (a b c d x y : ℂ) (hx : x ≠ 0) (hy : y ≠ 0) :
  a + b / x + c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x + c) / x) :=
begin
  field_simp,
  ring
end
```

Moreover, the `field_simp` tactic can also take care of inverses of units in
a general (commutative) monoid/ring and partial division `/ₚ`, see `algebra.group.units`
for the definition. Analogue to the case above, the lemma `one_divp` is removed from the simpset
as this works against the algorithm. If you have objects with a `is_unit x` instance like
`(x : R) (hx : is_unit x)`, you should lift them with
`lift x to Rˣ using id hx, rw is_unit.unit_of_coe_units, clear hx`
before using `field_simp`.

See also the `cancel_denoms` tactic, which tries to do a similar simplification for expressions
that have numerals in denominators.
The tactics are not related: `cancel_denoms` will only handle numeric denominators, and will try to
entirely remove (numeric) division from the expression by multiplying by a factor.
-/
unsafe def field_simp (no_dflt : parse only_flag) (hs : parse simp_arg_list)
    (attr_names : parse with_ident_list) (locat : parse location)
    (cfg : simp_config_ext := { discharger := field_simp.ne_zero }) : tactic Unit :=
  let attr_names := `field_simps :: attr_names
  let hs :=
    simp_arg_type.except `one_div ::
      simp_arg_type.except `mul_eq_zero :: simp_arg_type.except `one_divp :: hs
  propagate_tags (simp_core cfg.toSimpConfig cfg.discharger no_dflt hs attr_names locat >> skip)
#align tactic.interactive.field_simp tactic.interactive.field_simp

add_tactic_doc
  { Name := "field_simp"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.field_simp]
    tags := ["simplification", "arithmetic"] }

end Interactive

end Tactic