/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import for_mathlib.category_theory.functor_misc
import category_theory.localization.predicate
import for_mathlib.category_theory.morphism_property_misc

noncomputable theory

open category_theory.category category_theory

namespace category_theory

structure Comm_sq {C₁ C₂ D₁ D₂ : Type*} [category C₁] [category C₂] [category D₁] [category D₂]
  (F : C₁ ⥤ C₂) (G₁ : C₁ ⥤ D₁) (G₂ : C₂ ⥤ D₂) (F' : D₁ ⥤ D₂) :=
(iso [] : G₁ ⋙ F' ≅ F ⋙ G₂)

namespace Comm_sq

variables {C₁ C₂ C₃ C₄ D₁ D₂ D₃ D₄ : Type*}
  [category C₁] [category C₂] [category C₃] [category C₄]
  [category D₁] [category D₂] [category D₃] [category D₄]

@[simps]
def horiz_refl {C D : Type*} [category C] [category D]
  (F : C ⥤ D) : Comm_sq (𝟭 C) F F (𝟭 D) := ⟨iso.refl _⟩

def horiz_comp
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃}
  {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂} {G : C₂ ⥤ C₃} {G' : D₂ ⥤ D₃}
  (H₁₂ : Comm_sq F L₁ L₂ F') (H₂₃ : Comm_sq G L₂ L₃ G') :
  Comm_sq (F ⋙ G) L₁ L₃ (F' ⋙ G') :=
⟨calc L₁ ⋙ F' ⋙ G' ≅ (L₁ ⋙ F') ⋙ G' : (functor.associator _ _ _).symm
  ... ≅ (F ⋙ L₂) ⋙ G' : iso_whisker_right H₁₂.iso _
  ... ≅ F ⋙ (L₂ ⋙ G') : functor.associator _ _ _
  ... ≅ F ⋙ (G ⋙ L₃) : iso_whisker_left _ H₂₃.iso
  ... ≅ (F ⋙ G) ⋙ L₃ : (functor.associator _ _ _).symm⟩

@[simp]
lemma horiz_comp_iso_hom_app
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃}
  {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂} {G : C₂ ⥤ C₃} {G' : D₂ ⥤ D₃}
  (H₁₂ : Comm_sq F L₁ L₂ F') (H₂₃ : Comm_sq G L₂ L₃ G') (X₁ : C₁):
  (H₁₂.horiz_comp H₂₃).iso.hom.app X₁ =
    G'.map (H₁₂.iso.hom.app X₁) ≫ H₂₃.iso.hom.app (F.obj X₁) :=
by { dsimp [horiz_comp], simp only [id_comp, comp_id], }

@[simp]
lemma horiz_comp_iso_inv_app
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃}
  {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂} {G : C₂ ⥤ C₃} {G' : D₂ ⥤ D₃}
  (H₁₂ : Comm_sq F L₁ L₂ F') (H₂₃ : Comm_sq G L₂ L₃ G') (X₁ : C₁):
  (H₁₂.horiz_comp H₂₃).iso.inv.app X₁ =
    H₂₃.iso.inv.app (F.obj X₁) ≫ G'.map (H₁₂.iso.inv.app X₁) :=
by { dsimp [horiz_comp], simp only [comp_id, id_comp], }

@[simp]
lemma horiz_comp_refl_iso {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂}
  (H : Comm_sq F L₁ L₂ F') : (H.horiz_comp (horiz_refl L₂)).iso = H.iso :=
by { ext X, rw horiz_comp_iso_hom_app, apply comp_id, }

@[simp]
lemma refl_horiz_comp_iso {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂}
  (H : Comm_sq F L₁ L₂ F') : ((horiz_refl L₁).horiz_comp H).iso = H.iso :=
by { ext X, rw horiz_comp_iso_hom_app, dsimp, rw [F'.map_id, id_comp], }

lemma horiz_comp_assoc_iso
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃} {L₄ : C₄ ⥤ D₄}
  {F : C₁ ⥤ C₂} {F' : D₁ ⥤ D₂} {G : C₂ ⥤ C₃} {G' : D₂ ⥤ D₃} {K : C₃ ⥤ C₄} {K' : D₃ ⥤ D₄}
  (H₁₂ : Comm_sq F L₁ L₂ F') (H₂₃ : Comm_sq G L₂ L₃ G') (H₃₄ : Comm_sq K L₃ L₄ K') :
  ((H₁₂.horiz_comp H₂₃).horiz_comp H₃₄).iso = (H₁₂.horiz_comp (H₂₃.horiz_comp H₃₄)).iso :=
by { ext X, simpa only [horiz_comp_iso_hom_app, functor.map_comp, assoc, functor.comp_map], }

end Comm_sq

variables {C D : Type*} [category C] [category D]
variables (L : C ⥤ D) (W : morphism_property C)
variables (E : Type*) [category E]

namespace functor

/-class is_localization : Prop :=
(inverts : W.is_inverted_by L)
(nonempty_is_equivalence : nonempty (is_equivalence (localization.construction.lift L inverts)))

instance Q_is_localization : W.Q.is_localization W :=
{ inverts := W.Q_inverts,
  nonempty_is_equivalence := begin
    suffices : localization.construction.lift W.Q W.Q_inverts = 𝟭 _,
    { apply nonempty.intro, rw this, apply_instance, },
    apply localization.construction.uniq,
    simpa only [localization.construction.fac],
  end, }-/

end functor

namespace localization

/-structure strict_universal_property_fixed_target :=
(inverts : W.is_inverted_by L)
(lift : Π (F : C ⥤ E) (hF : W.is_inverted_by F), D ⥤ E)
(fac : Π (F : C ⥤ E) (hF : W.is_inverted_by F), L ⋙ lift F hF = F)
(uniq : Π (F₁ F₂ : D ⥤ E) (h : L ⋙ F₁ = L ⋙ F₂), F₁ = F₂)

def strict_universal_property_fixed_target.for_Q : strict_universal_property_fixed_target W.Q W E :=
{ inverts := W.Q_inverts,
  lift := construction.lift,
  fac := construction.fac,
  uniq := construction.uniq, }

def strict_universal_property_fixed_target.for_id (hW : W ⊆ morphism_property.isomorphisms C):
  strict_universal_property_fixed_target (𝟭 C) W E :=
{ inverts := λ X Y f hf, hW f hf,
  lift := λ F hF, F,
  fac := λ F hF, by { cases F, refl, },
  uniq := λ F₁ F₂ eq, by { cases F₁, cases F₂, exact eq, }, }-/

end localization

namespace functor
/-
variables (h₁ : localization.strict_universal_property_fixed_target L W D)
  (h₂ : localization.strict_universal_property_fixed_target L W W.localization)

namespace is_localization.mk'

lemma unit_eq :
  𝟭 W.localization = localization.construction.lift L h₁.inverts ⋙ h₂.lift W.Q W.Q_inverts :=
begin
  apply localization.construction.uniq,
  rw [← functor.assoc, localization.construction.fac, h₂.fac, functor.comp_id],
end

lemma counit_eq :
  h₂.lift W.Q W.Q_inverts ⋙ localization.construction.lift L h₁.inverts = 𝟭 D :=
begin
  apply h₁.uniq,
  rw [← functor.assoc, h₂.fac, localization.construction.fac, functor.comp_id],
end

def equivalence : W.localization ≌ D :=
{ functor := localization.construction.lift L h₁.inverts,
  inverse := h₂.lift W.Q W.Q_inverts,
  unit_iso := eq_to_iso (unit_eq L W h₁ h₂),
  counit_iso := eq_to_iso (counit_eq L W h₁ h₂),
  functor_unit_iso_comp' := λ X, by simpa only [eq_to_iso.hom, eq_to_hom_app, eq_to_hom_map,
    eq_to_hom_trans, eq_to_hom_refl], }

def equivalence_obj_equiv' : W.localization ≃ D :=
{ to_fun := (is_localization.mk'.equivalence L W h₁ h₂).functor.obj,
  inv_fun := (is_localization.mk'.equivalence L W h₁ h₂).inverse.obj,
  left_inv := congr_obj (unit_eq L W h₁ h₂).symm,
  right_inv := congr_obj (counit_eq L W h₁ h₂), }

lemma obj_bijective : function.bijective L.obj :=
((localization.construction.obj_equiv W).trans (equivalence_obj_equiv' L W h₁ h₂)).bijective

end is_localization.mk'

lemma is_localization.mk' :
  is_localization L W :=
{ inverts := h₁.inverts,
  nonempty_is_equivalence :=
    nonempty.intro (is_equivalence.of_equivalence (is_localization.mk'.equivalence L W h₁ h₂)), }
-/
end functor

namespace localization

variable [L.is_localization W]
include L W

/-lemma inverts : W.is_inverted_by L := (as_localization _ _).inverts-/

@[simps]
def iso_of_hom' {X Y : C} (f : X ⟶ Y) (hf : W f) : L.obj X ≅ L.obj Y :=
begin
  haveI : is_iso (L.map f) := inverts L W f hf,
  exact as_iso (L.map f),
end

/-instance : is_equivalence (localization.construction.lift L (inverts L W)) :=
(as_localization L W).nonempty_is_equivalence.some

def equivalence_from_model : W.localization ≌ D :=
(localization.construction.lift L (inverts L W)).as_equivalence

def Q_comp_equivalence_from_model_functor_iso :
  W.Q ⋙ (equivalence_from_model L W).functor ≅ L := eq_to_iso (construction.fac _ _)

def comp_equivalence_from_model_inverse_iso :
  L ⋙ (equivalence_from_model L W).inverse ≅ W.Q :=
begin
  let α := Q_comp_equivalence_from_model_functor_iso L W,
  calc L ⋙ (equivalence_from_model L W).inverse ≅ _ : iso_whisker_right α.symm _
  ... ≅ W.Q ⋙ ((equivalence_from_model L W).functor ⋙ (equivalence_from_model L W).inverse) :
    functor.associator _ _ _
  ... ≅ W.Q ⋙ 𝟭 _ : iso_whisker_left _ ((equivalence_from_model L W).unit_iso.symm)
  ... ≅ W.Q : functor.right_unitor _,
end

lemma ess_surj : ess_surj L :=
⟨λ X, ⟨(construction.obj_equiv W).inv_fun ((equivalence_from_model L W).inverse.obj X),
    nonempty.intro ((Q_comp_equivalence_from_model_functor_iso L W).symm.app _ ≪≫
    (equivalence_from_model L W).counit_iso.app X)⟩⟩

def whiskering_left_functor : (D ⥤ E) ⥤ W.functors_inverting E :=
full_subcategory.lift _ ((whiskering_left _ _ E).obj L)
  (morphism_property.is_inverted_by.of_comp W L (inverts L W ))

instance : is_equivalence (whiskering_left_functor L W E) :=
begin
  refine is_equivalence.of_iso _ (is_equivalence.of_equivalence
    ((equivalence.congr_left (equivalence_from_model L W).symm).trans
    (construction.whiskering_left_equivalence W E))),
  refine nat_iso.of_components (λ F, eq_to_iso begin
    ext,
    change (W.Q ⋙ (localization.construction.lift L (inverts L W))) ⋙ F = L ⋙ F,
    rw construction.fac,
  end)
  (λ F₁ F₂ τ, begin
    ext X,
    dsimp [equivalence_from_model, whisker_left, construction.whiskering_left_equivalence,
      construction.whiskering_left_equivalence.functor, whiskering_left_functor,
      morphism_property.Q],
    erw [nat_trans.comp_app, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_app,
      eq_to_hom_refl, eq_to_hom_refl, comp_id, id_comp],
    all_goals
    { change (W.Q ⋙ (localization.construction.lift L (inverts L W))) ⋙ _ = L ⋙ _,
      rw construction.fac, },
  end),
end

def functor_equivalence : (D ⥤ E) ≌ (W.functors_inverting E) :=
(whiskering_left_functor L W E).as_equivalence-/

section

variables (E)

--include hL
/-@[nolint unused_arguments]
def whiskering_left_functor' :
  (D ⥤ E) ⥤ (C ⥤ E) := (whiskering_left C D E).obj L

lemma whiskering_left_functor'_eq :
  whiskering_left_functor' L W E =
    localization.whiskering_left_functor L W E ⋙ induced_functor _ := rfl

variable {E}

@[simp]
def whiskering_left_functor'_obj
  (F : D ⥤ E) : (whiskering_left_functor' L W E).obj F = L ⋙ F := rfl

instance : full (whiskering_left_functor' L W E) :=
by { rw whiskering_left_functor'_eq, apply_instance, }

instance : faithful (whiskering_left_functor' L W E) :=
by { rw whiskering_left_functor'_eq, apply_instance, }

lemma nat_trans_ext {F₁ F₂ : D ⥤ E} (τ τ' : F₁ ⟶ F₂)
  (h : ∀ (X : C), τ.app (L.obj X) = τ'.app (L.obj X)) : τ = τ' :=
begin
  haveI : category_theory.ess_surj L := ess_surj L W,
  ext Y,
  rw [← cancel_epi (F₁.map (L.obj_obj_preimage_iso Y).hom), τ.naturality, τ'.naturality, h],
end

/-- When `L : C ⥤ D` is a localization functor for `W : morphism_property C` and
`F : C ⥤ E` is a functor, we shall say that `F' : D ⥤ E` lifts `F` if the obvious diagram
is commutative up to an isomorphism. -/
class lifting (F : C ⥤ E) (F' : D ⥤ E) := (iso [] : L ⋙ F' ≅ F)

section

def lift_nat_trans (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E) [lifting L W F₁ F₁']
  [h₂ : lifting L W F₂ F₂'] (τ : F₁ ⟶ F₂) : F₁' ⟶ F₂' :=
(whiskering_left_functor' L W E).preimage ((lifting.iso L W F₁ F₁').hom ≫ τ ≫ (lifting.iso L W F₂ F₂').inv)

@[simp]
lemma lift_nat_trans_app (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E) [lifting L W F₁ F₁']
  [lifting L W F₂ F₂'] (τ : F₁ ⟶ F₂) (X : C) :
  (lift_nat_trans L W F₁ F₂ F₁' F₂' τ).app (L.obj X) =
    (lifting.iso L W F₁ F₁').hom.app X ≫ τ.app X ≫ ((lifting.iso L W F₂ F₂')).inv.app X :=
congr_app (functor.image_preimage (whiskering_left_functor' L W E) _) X

@[simp, reassoc]
lemma comp_lift_nat_trans (F₁ F₂ F₃ : C ⥤ E) (F₁' F₂' F₃' : D ⥤ E)
  [h₁ : lifting L W F₁ F₁'] [h₂ : lifting L W F₂ F₂'] [h₃ : lifting L W F₃ F₃']
  (τ : F₁ ⟶ F₂) (τ' : F₂ ⟶ F₃) :
  lift_nat_trans L W F₁ F₂ F₁' F₂' τ ≫ lift_nat_trans L W F₂ F₃ F₂' F₃' τ' =
  lift_nat_trans L W F₁ F₃ F₁' F₃' (τ ≫ τ') :=
nat_trans_ext L W _ _
  (λ X, by simp only [nat_trans.comp_app, lift_nat_trans_app, assoc, iso.inv_hom_id_app_assoc])

@[simp]
lemma lift_nat_trans_id (F : C ⥤ E) (F' : D ⥤ E) [h : lifting L W F F'] :
  lift_nat_trans L W F F F' F' (𝟙 F) = 𝟙 F' :=
nat_trans_ext L W _ _
  (λ X, by simpa only [lift_nat_trans_app, nat_trans.id_app, id_comp, iso.hom_inv_id_app])

@[simps]
def lift_nat_iso (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E)
  [h₁ : lifting L W F₁ F₁'] [h₂ : lifting L W F₂ F₂']
  (e : F₁ ≅ F₂) : F₁' ≅ F₂' :=
{ hom := lift_nat_trans L W F₁ F₂ F₁' F₂' e.hom,
  inv := lift_nat_trans L W F₂ F₁ F₂' F₁' e.inv, }

end-/

variable {E}

namespace lifting

def uniq (F : C ⥤ E) (F'₁ F'₂ : D ⥤ E) [lifting L W F F'₁] [lifting L W F F'₂] :
  F'₁ ≅ F'₂ := lift_nat_iso L W F F F'₁ F'₂ (iso.refl F)

@[simp]
lemma uniq_hom_app (F : C ⥤ E) (F'₁ F'₂ : D ⥤ E) [lifting L W F F'₁] [lifting L W F F'₂]
  (X : C) : (uniq L W F F'₁ F'₂).hom.app (L.obj X) = (iso L W F F'₁).hom.app X ≫ (iso L W F F'₂).inv.app X :=
begin
  dsimp only [uniq],
  simp only [lift_nat_iso_hom, iso.refl_hom, lift_nat_trans_app, nat_trans.id_app, id_comp],
end

@[simp]
lemma uniq_inv_app (F : C ⥤ E) (F'₁ F'₂ : D ⥤ E) [lifting L W F F'₁] [lifting L W F F'₂]
  (X : C) : (uniq L W F F'₁ F'₂).inv.app (L.obj X) = (iso L W F F'₂).hom.app X ≫ (iso L W F F'₁).inv.app X :=
begin
  dsimp only [uniq],
  simp only [lift_nat_iso_inv, iso.refl_inv, lift_nat_trans_app, nat_trans.id_app, id_comp],
end

variables (L W)

/-@[simps]
instance comp_right {E' : Type*} [category E'] (F : C ⥤ E) (F' : D ⥤ E) [lifting L W F F']
  (G : E ⥤ E') : lifting L W (F ⋙ G) (F' ⋙ G) :=
⟨iso_whisker_right (iso L W F F') G⟩

@[simps]
instance id : lifting L W L (𝟭 D) :=
⟨functor.right_unitor L⟩

@[simps]
def of_isos {F₁ F₂ : C ⥤ E} {F'₁ F'₂ : D ⥤ E} (e : F₁ ≅ F₂) (e' : F'₁ ≅ F'₂)
  [lifting L W F₁ F'₁] : lifting L W F₂ F'₂ :=
⟨iso_whisker_left L e'.symm ≪≫ iso L W F₁ F'₁ ≪≫ e⟩-/

omit L

instance (F : C ⥤ D) (hF : W.is_inverted_by F) : lifting W.Q W F (construction.lift F hF) :=
⟨eq_to_iso (construction.fac F hF)⟩

end lifting

section

omit L W

variables {C₁ C₂ D₁ D₂ : Type*} [category C₁] [category C₂] [category D₁]
  [category D₂] {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {F G : C₁ ⥤ C₂} {F' G' : D₁ ⥤ D₂}
  (hF : Comm_sq F L₁ L₂ F') (hG : Comm_sq G L₁ L₂ G') (W₁ : morphism_property C₁)
  [L₁.is_localization W₁] (τ : F ⟶ G)

include hF hG W₁ τ

def lift_nat_trans' : F' ⟶ G' :=
begin
  letI : lifting L₁ W₁ (F ⋙ L₂) F' := ⟨hF.iso⟩,
  letI : lifting L₁ W₁ (G ⋙ L₂) G' := ⟨hG.iso⟩,
  exact lift_nat_trans L₁ W₁ (F ⋙ L₂) (G ⋙ L₂) F' G' (τ ◫ (𝟙 L₂)),
end

@[simp]
lemma lift_nat_trans'_app (X₁ : C₁) : (lift_nat_trans' hF hG W₁ τ).app (L₁.obj X₁) =
  hF.iso.hom.app X₁ ≫ L₂.map (τ.app X₁) ≫ hG.iso.inv.app X₁ :=
begin
  dsimp only [lift_nat_trans'],
  rw lift_nat_trans_app,
  dsimp,
  rw id_comp,
end

omit hG τ

@[simp]
lemma lift_nat_trans'_id : lift_nat_trans' hF hF W₁ (𝟙 F) = 𝟙 F' :=
nat_trans_ext L₁ W₁ _ _ (λ X, begin
  rw [lift_nat_trans'_app, nat_trans.id_app, L₂.map_id],
  dsimp,
  rw id_comp,
  apply iso.hom_inv_id_app,
end)

omit hF

@[simp, reassoc]
lemma comp_lift_nat_trans' {F₁ F₂ F₃ : C₁ ⥤ C₂} {F₁' F₂' F₃' : D₁ ⥤ D₂}
  (H₁ : Comm_sq F₁ L₁ L₂ F₁') (H₂ : Comm_sq F₂ L₁ L₂ F₂') (H₃ : Comm_sq F₃ L₁ L₂ F₃')
  (τ : F₁ ⟶ F₂) (τ' : F₂ ⟶ F₃) :
  lift_nat_trans' H₁ H₂ W₁ τ ≫ lift_nat_trans' H₂ H₃ W₁ τ' =
    lift_nat_trans' H₁ H₃ W₁ (τ ≫ τ') :=
nat_trans_ext L₁ W₁ _ _ (λ X, by simp only [nat_trans.comp_app, lift_nat_trans'_app,
  assoc, iso.inv_hom_id_app_assoc, functor.map_comp])

include hF hG

@[simps]
def lift_nat_iso' (e : F ≅ G) : F' ≅ G' :=
{ hom := lift_nat_trans' hF hG W₁ e.hom,
  inv := lift_nat_trans' hG hF W₁ e.inv, }

end

section

omit L W

variables {C₁ C₂ C₃ D₁ D₂ D₃ : Type*} [category C₁] [category C₂] [category C₃]
  [category D₁] [category D₂] [category D₃]
  {F₁ G₁ : C₁ ⥤ C₂} {F₂ G₂ : C₂ ⥤ C₃}
  {F'₁ G'₁ : D₁ ⥤ D₂} {F'₂ G'₂ : D₂ ⥤ D₃}
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃}
  (H₁₂ : Comm_sq F₁ L₁ L₂ F'₁) (H₂₃ : Comm_sq F₂ L₂ L₃ F'₂)
  (K₁₂ : Comm_sq G₁ L₁ L₂ G'₁) (K₂₃ : Comm_sq G₂ L₂ L₃ G'₂)
  (W₁ : morphism_property C₁) (W₂ : morphism_property C₂)
  [L₁.is_localization W₁] [L₂.is_localization W₂]
  (τ : F₁ ⟶ G₁) (τ' : F₂ ⟶ G₂)

lemma hcomp_lift_nat_trans' :
  lift_nat_trans' H₁₂ K₁₂ W₁ τ ◫ lift_nat_trans' H₂₃ K₂₃ W₂ τ' =
    lift_nat_trans' (H₁₂.horiz_comp H₂₃) (K₁₂.horiz_comp K₂₃) W₁ (τ ◫ τ') :=
nat_trans_ext L₁ W₁ _ _ (λ X, begin
  simp only [lift_nat_trans'_app, nat_trans.hcomp_app, assoc, G'₂.map_comp],
  rw ← nat_trans.naturality_assoc,
  erw lift_nat_trans'_app,
  simp only [assoc, Comm_sq.horiz_comp_iso_hom_app, Comm_sq.horiz_comp_iso_inv_app,
    functor.map_comp],
  erw ← K₂₃.iso.inv.naturality_assoc,
  refl,
end)

end

variables {W E}

/-def lift (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D) [hL : L.is_localization W] :
  D ⥤ E :=
(functor_equivalence L W E).inverse.obj ⟨F, hF⟩

instance lift_is_lifting (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D)
  [hL : L.is_localization W] : lifting L W F (lift F hF L) :=
⟨(induced_functor _).map_iso ((functor_equivalence L W E).counit_iso.app ⟨F, hF⟩)⟩

@[simps]
def fac (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D) [hL : L.is_localization W] :
  L ⋙ lift F hF L ≅ F :=
lifting.iso _ W _ _-/

end

section

variables {D₁ D₂ : Type*} [category D₁] [category D₂] (L₁ : C ⥤ D₁) (L₂ : C ⥤ D₂)
  [h₁ : L₁.is_localization W] [h₂ : L₂.is_localization W]

include h₁ h₂
omit L

def uniq_equivalence : D₁ ≌ D₂ :=
(equivalence_from_model L₁ W).symm.trans (equivalence_from_model L₂ W)

def comp_uniq_equivalence_functor_iso :
  L₁ ⋙ (uniq_equivalence W L₁ L₂).functor ≅ L₂ :=
calc L₁ ⋙ (uniq_equivalence W L₁ L₂).functor ≅ (L₁ ⋙
  (equivalence_from_model L₁ W).inverse) ⋙ (equivalence_from_model L₂ W).functor : by refl
... ≅ W.Q ⋙ (equivalence_from_model L₂ W).functor :
  iso_whisker_right (comp_equivalence_from_model_inverse_iso L₁ W) _
... ≅ L₂ : Q_comp_equivalence_from_model_functor_iso L₂ W

end

end localization

namespace functor

namespace is_localization

def of_equivalence {E : Type*} [category E] (L' : C ⥤ E) (eq : D ≌ E)
  [L.is_localization W] (e : L ⋙ eq.functor ≅ L') : L'.is_localization W :=
begin
  have h : W.is_inverted_by L',
  { rw ← morphism_property.is_inverted_by.iff_of_iso W e,
    exact morphism_property.is_inverted_by.of_comp W L (localization.inverts L W) eq.functor, },
  let F₁ := localization.construction.lift L (localization.inverts L W),
  let F₂ := localization.construction.lift L' h,
  letI : localization.lifting W.Q W (L ⋙ eq.functor) F₂ :=
    localization.lifting.of_isos W.Q W e.symm (iso.refl F₂),
  let e : F₁ ⋙ eq.functor ≅ F₂ := localization.lifting.uniq W.Q W (L ⋙ eq.functor) _ _,
  exact
  { inverts := h,
    nonempty_is_equivalence := nonempty.intro (is_equivalence.of_iso e infer_instance) },
end

/-def of_iso {L₁ L₂ : C ⥤ D} (e : L₁ ≅ L₂) [L₁.is_localization W] : L₂.is_localization W :=
begin
  have h : W.is_inverted_by L₂ := λ X Y f hf,
    by simpa only [is_iso_map_iff_of_nat_iso e.symm] using localization.inverts L₁ W f hf,
  let F₁ := localization.construction.lift L₁ (localization.inverts L₁ W),
  let F₂ := localization.construction.lift L₂ h,
  haveI : localization.lifting W.Q W L₁ F₂ :=
    localization.lifting.of_isos W.Q W e.symm (iso.refl F₂),
  exact
  { inverts := h,
    nonempty_is_equivalence := nonempty.intro
      (is_equivalence.of_iso (localization.lifting.uniq W.Q W L₁ F₁ F₂) infer_instance), },
end-/

end is_localization

end functor

namespace localization

lemma id_is_localization (hW : W ⊆ morphism_property.isomorphisms C):
  (𝟭 C).is_localization W :=
functor.is_localization.mk' _ _
  (strict_universal_property_fixed_target_id _ _ hW)
  (strict_universal_property_fixed_target_id _ _ hW)

instance identity_functor_is_localization' :
  (𝟭 C).is_localization (morphism_property.isomorphisms C) :=
functor.is_localization.mk' _ _
  (strict_universal_property_fixed_target_id _ _ (λ X Y f hf, hf))
  (strict_universal_property_fixed_target_id _ _ (λ X Y f hf, hf))

end localization

namespace localization

variables {C₁ C₂ C₃ D₁ D₂ D₃ : Type*} [category C₁] [category C₂] [category C₃]
  [category D₁] [category D₂] [category D₃]
  {L₁ : C₁ ⥤ D₁} {L₂ : C₂ ⥤ D₂} {L₃ : C₃ ⥤ D₃}
  {F₁₂ : C₁ ⥤ C₂} {F₂₃ : C₂ ⥤ C₃} {F'₁₂ : D₁ ⥤ D₂} {F'₂₃ : D₂ ⥤ D₃}
  {F₁₃ : C₁ ⥤ C₃} {F'₁₃ : D₁ ⥤ D₃}
  {G₁₂ : C₁ ⥤ C₂} {G₂₃ : C₂ ⥤ C₃} {G'₁₂ : D₁ ⥤ D₂} {G'₂₃ : D₂ ⥤ D₃}
  {G₁₃ : C₁ ⥤ C₃} {G'₁₃ : D₁ ⥤ D₃}
  (H₁₂ : Comm_sq F₁₂ L₁ L₂ F'₁₂) (H₂₃ : Comm_sq F₂₃ L₂ L₃ F'₂₃)
  (H₁₃ : Comm_sq F₁₃ L₁ L₃ F'₁₃)
  (K₁₂ : Comm_sq G₁₂ L₁ L₂ G'₁₂) (K₂₃ : Comm_sq G₂₃ L₂ L₃ G'₂₃)
  (K₁₃ : Comm_sq G₁₃ L₁ L₃ G'₁₃)
  (e : F₁₂ ⋙ F₂₃ ≅ F₁₃)
  (e' : G₁₂ ⋙ G₂₃ ≅ G₁₃)
  (W₁ : morphism_property C₁) (W₂ : morphism_property C₂)
  [L₁.is_localization W₁]

include H₁₂ H₂₃ H₁₃ e W₁ W₂

def lifting_comp_iso : F'₁₂ ⋙ F'₂₃ ≅ F'₁₃ :=
begin
  letI : lifting L₁ W₁ (F₁₃ ⋙ L₃) F'₁₃ := ⟨H₁₃.iso⟩,
  letI : lifting L₁ W₁ (F₁₃ ⋙ L₃) (F'₁₂ ⋙ F'₂₃) := ⟨(H₁₂.horiz_comp H₂₃).iso ≪≫ iso_whisker_right e _⟩,
  exact lifting.uniq L₁ W₁ (F₁₃ ⋙ L₃) _ _,
end

@[simp]
def lifting_comp_iso_hom : (lifting_comp_iso H₁₂ H₂₃ H₁₃ e W₁ W₂).hom =
  lift_nat_trans' (H₁₂.horiz_comp H₂₃) H₁₃ W₁ e.hom :=
begin
  apply nat_trans_ext L₁ W₁,
  intro X,
  dsimp only [lifting_comp_iso],
  simp only [lifting.uniq_hom_app, iso.trans_hom, iso_whisker_right_hom, nat_trans.comp_app,
    whisker_right_app, assoc, lift_nat_trans'_app],
end

@[simp]
def lifting_comp_iso_inv : (lifting_comp_iso H₁₂ H₂₃ H₁₃ e W₁ W₂).inv =
  lift_nat_trans' H₁₃ (H₁₂.horiz_comp H₂₃) W₁ e.inv :=
begin
  apply nat_trans_ext L₁ W₁,
  intro X,
  dsimp only [lifting_comp_iso],
  simp only [lifting.uniq_inv_app, iso.trans_inv, iso_whisker_right_inv, nat_trans.comp_app,
    whisker_right_app, lift_nat_trans'_app],
end

variables (τ₁₂ : F₁₂ ⟶ G₁₂) (τ₂₃ : F₂₃ ⟶ G₂₃) (τ₁₃ : F₁₃ ⟶ G₁₃)
  (comm_τ : (τ₁₂ ◫ τ₂₃) ≫ e'.hom = e.hom ≫ τ₁₃)

include comm_τ

lemma lifting_comp_iso_nat_trans_compatibility [L₂.is_localization W₂] :
  (lift_nat_trans' H₁₂ K₁₂ W₁ τ₁₂ ◫ lift_nat_trans' H₂₃ K₂₃ W₂ τ₂₃) ≫
    (lifting_comp_iso K₁₂ K₂₃ K₁₃ e' W₁ W₂).hom =
  (lifting_comp_iso H₁₂ H₂₃ H₁₃ e W₁ W₂).hom ≫ lift_nat_trans' H₁₃ K₁₃ W₁ τ₁₃ :=
by simp only [lifting_comp_iso_hom, comp_lift_nat_trans', hcomp_lift_nat_trans', ← comm_τ]

end localization

end category_theory


import mcl.defs
import mcl.rhl

open parlang
open mcl
open mcl.rhl
open parlang.thread_state

@[simp]
lemma store_stores {sig : signature} {dim} {idx : vector (expression sig type.int) dim} {var t} {h₁ : type_of (sig.val var) = t} {h₂}
{ts : thread_state (memory $ parlang_mcl_tlocal sig) (parlang_mcl_shared sig)} {i : mcl_address sig} :
i ∉ (thread_state.tlocal_to_shared var idx h₁ h₂ ts).stores → i ∉ ts.stores := by simp [thread_state.tlocal_to_shared, store, not_or_distrib]

@[simp]
lemma store_loads {sig : signature} {dim} {idx : vector (expression sig type.int) dim} {var t} {h₁ : type_of (sig.val var) = t} {h₂}
{ts : thread_state (memory $ parlang_mcl_tlocal sig) (parlang_mcl_shared sig)} {i : mcl_address sig} :
i ∉ (thread_state.tlocal_to_shared var idx h₁ h₂ ts).loads → i ∉ ts.loads := by simp [thread_state.tlocal_to_shared, store, not_or_distrib]

@[simp]
lemma array_hole_name_neq {sig : signature} (var₁ var₂ : string) (h : var₁ ≠ var₂) (idx : vector ℕ (((sig.val var₁).type).dim)) :
(⟨var₁, idx⟩ : mcl_address sig) ∉ @array_address_range sig var₂ := begin
    unfold array_address_range,
    intro,
    contradiction,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import representation_theory.basic
import representation_theory.Action
import algebra.category.Module.abelian
import algebra.category.Module.colimits
import algebra.category.Module.monoidal
import algebra.category.Module.adjunctions
import category_theory.closed.functor_category

/-!
# `Rep k G` is the category of `k`-linear representations of `G`.

If `V : Rep k G`, there is a coercion that allows you to treat `V` as a type,
and this type comes equipped with a `module k V` instance.
Also `V.ρ` gives the homomorphism `G →* (V →ₗ[k] V)`.

Conversely, given a homomorphism `ρ : G →* (V →ₗ[k] V)`,
you can construct the bundled representation as `Rep.of ρ`.

We construct the categorical equivalence `Rep k G ≌ Module (monoid_algebra k G)`.
We verify that `Rep k G` is a `k`-linear abelian symmetric monoidal category with all (co)limits.
-/

universes u

open category_theory
open category_theory.limits

/-- The category of `k`-linear representations of a monoid `G`. -/
@[derive [large_category, concrete_category, has_limits, has_colimits,
  preadditive, abelian]]
abbreviation Rep (k G : Type u) [ring k] [monoid G] :=
Action (Module.{u} k) (Mon.of G)

instance (k G : Type u) [comm_ring k] [monoid G] : linear k (Rep k G) :=
by apply_instance

namespace Rep
variables {k G : Type u} [comm_ring k]
section
variables [monoid G]

instance : has_coe_to_sort (Rep k G) (Type u) := concrete_category.has_coe_to_sort _

instance (V : Rep k G) : add_comm_group V :=
by { change add_comm_group ((forget₂ (Rep k G) (Module k)).obj V), apply_instance, }

instance (V : Rep k G) : module k V :=
by { change module k ((forget₂ (Rep k G) (Module k)).obj V), apply_instance, }

/--
Specialize the existing `Action.ρ`, changing the type to `representation k G V`.
-/
def ρ (V : Rep k G) : representation k G V := V.ρ

/-- Lift an unbundled representation to `Rep`. -/
def of {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) : Rep k G :=
⟨Module.of k V, ρ⟩

@[simp]
lemma coe_of {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) :
  (of ρ : Type u) = V := rfl

@[simp] lemma of_ρ {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) :
  (of ρ).ρ = ρ := rfl

@[simp] lemma Action_ρ_eq_ρ {A : Rep k G} : Action.ρ A = A.ρ := rfl

/-- Allows us to apply lemmas about the underlying `ρ`, which would take an element `g : G` rather
than `g : Mon.of G` as an argument. -/
lemma of_ρ_apply {V : Type u} [add_comm_group V] [module k V]
  (ρ : representation k G V) (g : Mon.of G) :
  (Rep.of ρ).ρ g = ρ (g : G) := rfl

variables (k G)

/-- The trivial `k`-linear `G`-representation on a `k`-module `V.` -/
def trivial (V : Type u) [add_comm_group V] [module k V] : Rep k G :=
Rep.of (@representation.trivial k G V _ _ _ _)

variables {k G}

lemma trivial_def {V : Type u} [add_comm_group V] [module k V] (g : G) (v : V) :
  (trivial k G V).ρ g v = v := rfl

-- Verify that limits are calculated correctly.
noncomputable example : preserves_limits (forget₂ (Rep k G) (Module.{u} k)) :=
by apply_instance
noncomputable example : preserves_colimits (forget₂ (Rep k G) (Module.{u} k)) :=
by apply_instance

@[simp] lemma monoidal_category.braiding_hom_apply {A B : Rep k G} (x : A) (y : B) :
  Action.hom.hom (β_ A B).hom (tensor_product.tmul k x y) = tensor_product.tmul k y x := rfl

@[simp] lemma monoidal_category.braiding_inv_apply {A B : Rep k G} (x : A) (y : B) :
  Action.hom.hom (β_ A B).inv (tensor_product.tmul k y x) = tensor_product.tmul k x y := rfl

section linearization

variables (k G)

/-- The monoidal functor sending a type `H` with a `G`-action to the induced `k`-linear
`G`-representation on `k[H].` -/
noncomputable def linearization :
  monoidal_functor (Action (Type u) (Mon.of G)) (Rep k G) :=
(Module.monoidal_free k).map_Action (Mon.of G)

variables {k G}

@[simp] lemma linearization_obj_ρ (X : Action (Type u) (Mon.of G)) (g : G) (x : X.V →₀ k) :
  ((linearization k G).obj X).ρ g x = finsupp.lmap_domain k k (X.ρ g) x := rfl

@[simp] lemma linearization_of (X : Action (Type u) (Mon.of G)) (g : G) (x : X.V) :
  ((linearization k G).obj X).ρ g (finsupp.single x (1 : k))
    = finsupp.single (X.ρ g x) (1 : k) :=
by rw [linearization_obj_ρ, finsupp.lmap_domain_apply, finsupp.map_domain_single]

variables {X Y : Action (Type u) (Mon.of G)} (f : X ⟶ Y)

@[simp] lemma linearization_map_hom :
  ((linearization k G).map f).hom = finsupp.lmap_domain k k f.hom := rfl

lemma linearization_map_hom_single (x : X.V) (r : k) :
  ((linearization k G).map f).hom (finsupp.single x r)
    = finsupp.single (f.hom x) r :=
by rw [linearization_map_hom, finsupp.lmap_domain_apply, finsupp.map_domain_single]

@[simp] lemma linearization_μ_hom (X Y : Action (Type u) (Mon.of G)) :
  ((linearization k G).μ X Y).hom = (finsupp_tensor_finsupp' k X.V Y.V).to_linear_map :=
rfl

@[simp]

@[simp] lemma linearization_ε_hom :
  (linearization k G).ε.hom = finsupp.lsingle punit.star :=
rfl

@[simp] lemma linearization_ε_inv_hom_apply (r : k) :
  (inv (linearization k G).ε).hom (finsupp.single punit.star r) = r :=
begin
  simp_rw [←Action.forget_map, functor.map_inv, Action.forget_map],
  rw [←finsupp.lsingle_apply punit.star r],
  apply is_iso.hom_inv_id_apply _ _,
end

variables (k G)

/-- The linearization of a type `X` on which `G` acts trivially is the trivial `G`-representation
on `k[X]`. -/
@[simps] noncomputable def linearization_trivial_iso (X : Type u) :
  (linearization k G).obj (Action.mk X 1) ≅ trivial k G (X →₀ k) :=
Action.mk_iso (iso.refl _) $ λ g, by { ext1, ext1, exact linearization_of _ _ _ }

variables (k G)

/-- Given a `G`-action on `H`, this is `k[H]` bundled with the natural representation
`G →* End(k[H])` as a term of type `Rep k G`. -/
noncomputable abbreviation of_mul_action (H : Type u) [mul_action G H] : Rep k G :=
of $ representation.of_mul_action k G H

/-- The `k`-linear `G`-representation on `k[G]`, induced by left multiplication. -/
noncomputable def left_regular : Rep k G :=
of_mul_action k G G

/-- The `k`-linear `G`-representation on `k[Gⁿ]`, induced by left multiplication. -/
noncomputable def diagonal (n : ℕ) : Rep k G :=
of_mul_action k G (fin n → G)

/-- The linearization of a type `H` with a `G`-action is definitionally isomorphic to the
`k`-linear `G`-representation on `k[H]` induced by the `G`-action on `H`. -/
noncomputable def linearization_of_mul_action_iso (H : Type u) [mul_action G H] :
  (linearization k G).obj (Action.of_mul_action G H)
    ≅ of_mul_action k G H := iso.refl _

variables {k G}

/-- Given an element `x : A`, there is a natural morphism of representations `k[G] ⟶ A` sending
`g ↦ A.ρ(g)(x).` -/
@[simps] noncomputable def left_regular_hom (A : Rep k G) (x : A) :
  Rep.of_mul_action k G G ⟶ A :=
{ hom := finsupp.lift _ _ _ (λ g, A.ρ g x),
  comm' := λ g,
  begin
    refine finsupp.lhom_ext' (λ y, linear_map.ext_ring _),
    simpa only [linear_map.comp_apply, Module.comp_def, finsupp.lsingle_apply,
      finsupp.lift_apply, Action_ρ_eq_ρ, of_ρ_apply, representation.of_mul_action_single,
      finsupp.sum_single_index, zero_smul, one_smul, smul_eq_mul, A.ρ.map_mul],
  end }

lemma left_regular_hom_apply {A : Rep k G} (x : A) :
  (left_regular_hom A x).hom (finsupp.single 1 1) = x :=
begin
  simpa only [left_regular_hom_hom, finsupp.lift_apply, finsupp.sum_single_index, one_smul,
    A.ρ.map_one, zero_smul],
end

/-- Given a `k`-linear `G`-representation `A`, there is a `k`-linear isomorphism between
representation morphisms `Hom(k[G], A)` and `A`. -/
@[simps] noncomputable def left_regular_hom_equiv (A : Rep k G) :
  (Rep.of_mul_action k G G ⟶ A) ≃ₗ[k] A :=
{ to_fun := λ f, f.hom (finsupp.single 1 1),
  map_add' := λ x y, rfl,
  map_smul' := λ r x, rfl,
  inv_fun := λ x, left_regular_hom A x,
  left_inv := λ f,
  begin
    refine Action.hom.ext _ _ (finsupp.lhom_ext' (λ (x : G), linear_map.ext_ring _)),
    have : f.hom (((of_mul_action k G G).ρ) x (finsupp.single (1 : G) (1 : k)))
      = A.ρ x (f.hom (finsupp.single (1 : G) (1 : k))) :=
      linear_map.ext_iff.1 (f.comm x) (finsupp.single 1 1),
    simp only [linear_map.comp_apply, finsupp.lsingle_apply,
      left_regular_hom_hom, finsupp.lift_apply, finsupp.sum_single_index, one_smul, ←this,
      zero_smul, of_ρ_apply, representation.of_mul_action_single x (1 : G) (1 : k), smul_eq_mul,
      mul_one],
  end,
  right_inv := λ x, left_regular_hom_apply x }

lemma left_regular_hom_equiv_symm_single {A : Rep k G} (x : A) (g : G) :
  ((left_regular_hom_equiv A).symm x).hom (finsupp.single g 1) = A.ρ g x :=
begin
  simp only [left_regular_hom_equiv_symm_apply, left_regular_hom_hom,
    finsupp.lift_apply, finsupp.sum_single_index, zero_smul, one_smul],
end

end linearization
end
section
open Action
variables [group G] (A B C : Rep k G)

noncomputable instance : monoidal_closed (Rep k G) :=
monoidal_closed.of_equiv (functor_category_monoidal_equivalence _ _)

/-- Explicit description of the 'internal Hom' `iHom(A, B)` of two representations `A, B`:
this is `F⁻¹(iHom(F(A), F(B)))`, where `F` is an equivalence
`Rep k G ≌ (single_obj G ⥤ Module k)`. Just used to prove `Rep.ihom_obj_ρ`. -/
lemma ihom_obj_ρ_def :
  ((ihom A).obj B).ρ = (functor_category_equivalence.inverse.obj
  ((functor_category_equivalence.functor.obj A).closed_ihom.obj
  (functor_category_equivalence.functor.obj B))).ρ := rfl

/-- Given `k`-linear `G`-representations `(A, ρ₁), (B, ρ₂)`, the 'internal Hom' is the
representation on `Homₖ(A, B)` sending `g : G` and `f : A →ₗ[k] B` to `(ρ₂ g) ∘ₗ f ∘ₗ (ρ₁ g⁻¹)`. -/
@[simp] lemma ihom_obj_ρ :
  ((ihom A).obj B).ρ = A.ρ.lin_hom B.ρ :=
begin
  refine monoid_hom.ext (λ g, _),
  simpa only [ihom_obj_ρ_def, functor_category_equivalence.inverse_obj_ρ_apply,
    functor.closed_ihom_obj_map, ←functor.map_inv, single_obj.inv_as_inv],
end

@[simp] lemma ihom_map_hom {B C : Rep k G} (f : B ⟶ C) :
  ((ihom A).map f).hom = linear_map.llcomp k A B C f.hom :=
rfl

/-- Unfolds the unit in the adjunction `A ⊗ - ⊣ iHom(A, -)`; just used to prove
`Rep.ihom_coev_app_hom`. -/
lemma ihom_coev_app_def :
  (ihom.coev A).app B = functor_category_equivalence.unit_iso.hom.app B ≫
  functor_category_equivalence.inverse.map
  ((functor_category_equivalence.functor.obj A).closed_unit.app _ ≫
  (functor_category_equivalence.functor.obj A).closed_ihom.map
  ((functor_category_monoidal_equivalence (Module.{u} k) (Mon.of G)).μ A B)) :=
rfl

/-- Describes the unit in the adjunction `A ⊗ - ⊣ iHom(A, -)`; given another `k`-linear
`G`-representation `B,` the `k`-linear map underlying the resulting map `B ⟶ iHom(A, A ⊗ B)` is
given by flipping the arguments in the natural `k`-bilinear map `A →ₗ[k] B →ₗ[k] A ⊗ B`. -/
@[simp] lemma ihom_coev_app_hom :
  Action.hom.hom ((ihom.coev A).app B) = (tensor_product.mk _ _ _).flip :=
begin
  refine linear_map.ext (λ x, linear_map.ext (λ y, _)),
  simpa only [ihom_coev_app_def, functor.map_comp, comp_hom,
    functor_category_equivalence.inverse_map_hom, functor.closed_ihom_map_app,
    functor_category_monoidal_equivalence.μ_app],
end

variables {A B C}

/-- Given a `k`-linear `G`-representation `A`, the adjunction `A ⊗ - ⊣ iHom(A, -)` defines a
bijection `Hom(A ⊗ B, C) ≃ Hom(B, iHom(A, C))` for all `B, C`. Given `f : A ⊗ B ⟶ C`, this lemma
describes the `k`-linear map underlying `f`'s image under the bijection. It is given by currying the
`k`-linear map underlying `f`, giving a map `A →ₗ[k] B →ₗ[k] C`, then flipping the arguments. -/
@[simp] lemma monoidal_closed_curry_hom (f : A ⊗ B ⟶ C) :
  (monoidal_closed.curry f).hom = (tensor_product.curry f.hom).flip :=
begin
  rw [monoidal_closed.curry_eq, comp_hom, ihom_coev_app_hom],
  refl,
end

/-- Given a `k`-linear `G`-representation `A`, the adjunction `A ⊗ - ⊣ iHom(A, -)` defines a
bijection `Hom(A ⊗ B, C) ≃ Hom(B, iHom(A, C))` for all `B, C`. Given `f : B ⟶ iHom(A, C)`, this
lemma describes the `k`-linear map underlying `f`'s image under the bijection. It is given by
flipping the arguments of the `k`-linear map underlying `f`, giving a map `A →ₗ[k] B →ₗ[k] C`, then
uncurrying. -/
@[simp] lemma monoidal_closed_uncurry_hom (f : B ⟶ (ihom A).obj C) :
  (monoidal_closed.uncurry f).hom = tensor_product.uncurry _ _ _ _ f.hom.flip :=
begin
  simp only [monoidal_closed.of_equiv_uncurry_def, comp_inv_iso_inv_app,
    monoidal_functor.comm_tensor_left_inv_app, comp_hom,
    functor_category_monoidal_equivalence.inverse_map, functor_category_equivalence.inverse_map_hom,
    functor_category_monoidal_equivalence.μ_iso_inv_app],
  ext,
  refl,
end

/-- Describes the counit in the adjunction `A ⊗ - ⊣ iHom(A, -)`; given another `k`-linear
`G`-representation `B,` the `k`-linear map underlying the resulting morphism `A ⊗ iHom(A, B) ⟶ B`
is given by uncurrying the map `A →ₗ[k] (A →ₗ[k] B) →ₗ[k] B` defined by flipping the arguments in
the identity map on `Homₖ(A, B).` -/
@[simp] lemma ihom_ev_app_hom : Action.hom.hom ((ihom.ev A).app B) =
  tensor_product.uncurry _ _ _ _ linear_map.id.flip :=
monoidal_closed_uncurry_hom _

variables (A B C)

/-- There is a `k`-linear isomorphism between the sets of representation morphisms`Hom(A ⊗ B, C)`
and `Hom(B, Homₖ(A, C))`. -/
noncomputable def monoidal_closed.linear_hom_equiv :
  (A ⊗ B ⟶ C) ≃ₗ[k] (B ⟶ (A ⟶[Rep k G] C)) :=
{ map_add' := λ f g, rfl,
  map_smul' := λ r f, rfl, ..(ihom.adjunction A).hom_equiv _ _ }

/-- There is a `k`-linear isomorphism between the sets of representation morphisms`Hom(A ⊗ B, C)`
and `Hom(A, Homₖ(B, C))`. -/
noncomputable def monoidal_closed.linear_hom_equiv_comm :
  (A ⊗ B ⟶ C) ≃ₗ[k] (A ⟶ (B ⟶[Rep k G] C)) :=
(linear.hom_congr k (β_ A B) (iso.refl _)) ≪≫ₗ
  monoidal_closed.linear_hom_equiv _ _ _

variables {A B C}

lemma monoidal_closed.linear_hom_equiv_hom (f : A ⊗ B ⟶ C) :
  (monoidal_closed.linear_hom_equiv A B C f).hom =
  (tensor_product.curry f.hom).flip :=
monoidal_closed_curry_hom _

lemma monoidal_closed.linear_hom_equiv_comm_hom (f : A ⊗ B ⟶ C) :
  (monoidal_closed.linear_hom_equiv_comm A B C f).hom =
 tensor_product.curry f.hom :=
begin
  dunfold monoidal_closed.linear_hom_equiv_comm,
  refine linear_map.ext (λ x, linear_map.ext (λ y, _)),
  simp only [linear_equiv.trans_apply, monoidal_closed.linear_hom_equiv_hom,
    linear.hom_congr_apply, iso.refl_hom, iso.symm_hom, linear_map.to_fun_eq_coe,
    linear_map.coe_comp, function.comp_app, linear.left_comp_apply, linear.right_comp_apply,
    category.comp_id, Action.comp_hom, linear_map.flip_apply, tensor_product.curry_apply,
    Module.coe_comp, function.comp_app, monoidal_category.braiding_inv_apply],
end

lemma monoidal_closed.linear_hom_equiv_symm_hom (f : B ⟶ (A ⟶[Rep k G] C)) :
  ((monoidal_closed.linear_hom_equiv A B C).symm f).hom =
  tensor_product.uncurry k A B C f.hom.flip :=
monoidal_closed_uncurry_hom _

lemma monoidal_closed.linear_hom_equiv_comm_symm_hom (f : A ⟶ (B ⟶[Rep k G] C)) :
  ((monoidal_closed.linear_hom_equiv_comm A B C).symm f).hom =
  tensor_product.uncurry k A B C f.hom :=
begin
  dunfold monoidal_closed.linear_hom_equiv_comm,
  refine tensor_product.algebra_tensor_module.curry_injective
    (linear_map.ext (λ x, linear_map.ext (λ y, _))),
  simp only [linear_equiv.trans_symm, linear_equiv.trans_apply, linear.hom_congr_symm_apply,
    iso.refl_inv, linear_map.coe_comp, function.comp_app, category.comp_id, Action.comp_hom,
    monoidal_closed.linear_hom_equiv_symm_hom, tensor_product.algebra_tensor_module.curry_apply,
    linear_map.coe_restrict_scalars, linear_map.to_fun_eq_coe, linear_map.flip_apply,
    tensor_product.curry_apply, Module.coe_comp, function.comp_app,
    monoidal_category.braiding_hom_apply, tensor_product.uncurry_apply],
end

end
end Rep
namespace representation
variables {k G : Type u} [comm_ring k] [monoid G] {V W : Type u}
  [add_comm_group V] [add_comm_group W] [module k V] [module k W]
  (ρ : representation k G V) (τ : representation k G W)

/-- Tautological isomorphism to help Lean in typechecking. -/
def Rep_of_tprod_iso : Rep.of (ρ.tprod τ) ≅ Rep.of ρ ⊗ Rep.of τ := iso.refl _

lemma Rep_of_tprod_iso_apply (x : tensor_product k V W) :
  (Rep_of_tprod_iso ρ τ).hom.hom x = x := rfl

lemma Rep_of_tprod_iso_inv_apply (x : tensor_product k V W) :
  (Rep_of_tprod_iso ρ τ).inv.hom x = x := rfl

end representation
/-!
# The categorical equivalence `Rep k G ≌ Module.{u} (monoid_algebra k G)`.
-/
namespace Rep
variables {k G : Type u} [comm_ring k] [monoid G]

-- Verify that the symmetric monoidal structure is available.
example : symmetric_category (Rep k G) := by apply_instance
example : monoidal_preadditive (Rep k G) := by apply_instance
example : monoidal_linear k (Rep k G) := by apply_instance

noncomputable theory

/-- Auxilliary lemma for `to_Module_monoid_algebra`. -/
lemma to_Module_monoid_algebra_map_aux {k G : Type*} [comm_ring k] [monoid G]
  (V W : Type*) [add_comm_group V] [add_comm_group W] [module k V] [module k W]
  (ρ : G →* V →ₗ[k] V) (σ : G →* W →ₗ[k] W)
  (f : V →ₗ[k] W) (w : ∀ (g : G), f.comp (ρ g) = (σ g).comp f)
  (r : monoid_algebra k G) (x : V) :
  f ((((monoid_algebra.lift k G (V →ₗ[k] V)) ρ) r) x) =
    (((monoid_algebra.lift k G (W →ₗ[k] W)) σ) r) (f x) :=
begin
  apply monoid_algebra.induction_on r,
  { intro g,
    simp only [one_smul, monoid_algebra.lift_single, monoid_algebra.of_apply],
    exact linear_map.congr_fun (w g) x, },
  { intros g h gw hw, simp only [map_add, add_left_inj, linear_map.add_apply, hw, gw], },
  { intros r g w,
    simp only [alg_hom.map_smul, w, ring_hom.id_apply,
      linear_map.smul_apply, linear_map.map_smulₛₗ], }
end

/-- Auxilliary definition for `to_Module_monoid_algebra`. -/
def to_Module_monoid_algebra_map {V W : Rep k G} (f : V ⟶ W) :
  Module.of (monoid_algebra k G) V.ρ.as_module ⟶ Module.of (monoid_algebra k G) W.ρ.as_module :=
{ map_smul' := λ r x, to_Module_monoid_algebra_map_aux V.V W.V V.ρ W.ρ f.hom f.comm r x,
  ..f.hom, }

/-- Functorially convert a representation of `G` into a module over `monoid_algebra k G`. -/
def to_Module_monoid_algebra : Rep k G ⥤ Module.{u} (monoid_algebra k G) :=
{ obj := λ V, Module.of _ V.ρ.as_module ,
  map := λ V W f, to_Module_monoid_algebra_map f, }

/-- Functorially convert a module over `monoid_algebra k G` into a representation of `G`. -/
def of_Module_monoid_algebra : Module.{u} (monoid_algebra k G) ⥤ Rep k G :=
{ obj := λ M, Rep.of (representation.of_module k G M),
  map := λ M N f,
  { hom :=
    { map_smul' := λ r x, f.map_smul (algebra_map k _ r) x,
      ..f },
    comm' := λ g, by { ext, apply f.map_smul, }, }, }.

lemma of_Module_monoid_algebra_obj_coe (M : Module.{u} (monoid_algebra k G)) :
  (of_Module_monoid_algebra.obj M : Type u) = restrict_scalars k (monoid_algebra k G) M := rfl

lemma of_Module_monoid_algebra_obj_ρ (M : Module.{u} (monoid_algebra k G)) :
  (of_Module_monoid_algebra.obj M).ρ = representation.of_module k G M := rfl

/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
def counit_iso_add_equiv {M : Module.{u} (monoid_algebra k G)} :
  ((of_Module_monoid_algebra ⋙ to_Module_monoid_algebra).obj M) ≃+ M :=
begin
  dsimp [of_Module_monoid_algebra, to_Module_monoid_algebra],
  refine (representation.of_module k G ↥M).as_module_equiv.trans (restrict_scalars.add_equiv _ _ _),
end

/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
def unit_iso_add_equiv {V : Rep k G} :
  V ≃+ ((to_Module_monoid_algebra ⋙ of_Module_monoid_algebra).obj V) :=
begin
  dsimp [of_Module_monoid_algebra, to_Module_monoid_algebra],
  refine V.ρ.as_module_equiv.symm.trans _,
  exact (restrict_scalars.add_equiv _ _ _).symm,
end

/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
def counit_iso (M : Module.{u} (monoid_algebra k G)) :
  (of_Module_monoid_algebra ⋙ to_Module_monoid_algebra).obj M ≅ M :=
linear_equiv.to_Module_iso'
{ map_smul' := λ r x, begin
    dsimp [counit_iso_add_equiv],
    simp,
  end,
  ..counit_iso_add_equiv, }

lemma unit_iso_comm (V : Rep k G) (g : G) (x : V) :
  unit_iso_add_equiv (((V.ρ) g).to_fun x) =
    (((of_Module_monoid_algebra.obj (to_Module_monoid_algebra.obj V)).ρ) g).to_fun
      (unit_iso_add_equiv x) :=
begin
  dsimp [unit_iso_add_equiv, of_Module_monoid_algebra, to_Module_monoid_algebra],
  simp only [add_equiv.apply_eq_iff_eq, add_equiv.apply_symm_apply,
    representation.as_module_equiv_symm_map_rho, representation.of_module_as_module_act],
end

/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
def unit_iso (V : Rep k G) :
  V ≅ ((to_Module_monoid_algebra ⋙ of_Module_monoid_algebra).obj V) :=
Action.mk_iso (linear_equiv.to_Module_iso'
{ map_smul' := λ r x, begin
    dsimp [unit_iso_add_equiv],
    simp only [representation.as_module_equiv_symm_map_smul,
      restrict_scalars.add_equiv_symm_map_algebra_map_smul],
  end,
  ..unit_iso_add_equiv, })
  (λ g, by { ext, apply unit_iso_comm, })

/-- The categorical equivalence `Rep k G ≌ Module (monoid_algebra k G)`. -/
def equivalence_Module_monoid_algebra : Rep k G ≌ Module.{u} (monoid_algebra k G) :=
{ functor := to_Module_monoid_algebra,
  inverse := of_Module_monoid_algebra,
  unit_iso := nat_iso.of_components (λ V, unit_iso V) (by tidy),
  counit_iso := nat_iso.of_components (λ M, counit_iso M) (by tidy), }

-- TODO Verify that the equivalence with `Module (monoid_algebra k G)` is a monoidal functor.

end Rep


-- Deadlocks: var/Microban_155_l16/deadlocks
-- Levelset: data/Large Test Suite Sets/Microban_155.xsb
-- Level: 16

import .deadlocks

def Microban_155_l16 := sokolevel.from_string "
 ####
 #  ####
 #     ##
## ##   #
#. .# @$##
#   # $$ #
#  .#    #
##########
"

namespace Microban_155_l16
open deadlocks

@[reducible]
def deadlock_local (dl : boxint) : Prop := deadlock Microban_155_l16.avail Microban_155_l16.goal dl
def deadlocks_local (dls : list boxint) : Prop
:= dls.pall (λ dl, deadlock_local dl)
def generate_local : list (ℕ × ℕ) → list (ℕ × ℕ) → ℕ × ℕ → boxint
:= boxint.generate_from_list Microban_155_l16.avail

def dl0 := generate_local [(8,7)] [] (2,2)

theorem dl0_dl : deadlock_local dl0
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl0_dl.to_html

def dl1 := generate_local [(7,4), (8,6), (7,7)] [] (2,2)

theorem dl1_dl : deadlock_local dl1
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl0_dl, -- (7,7) right
end

#html dl1_dl.to_html

def dl2 := generate_local [(5,7)] [] (2,2)

theorem dl2_dl : deadlock_local dl2
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl2_dl.to_html

def dl3 := generate_local [(6,7)] [] (2,2)
def dl4 := generate_local [(7,7)] [] (2,2)
def dls3_4 := [dl3, dl4]

theorem dls3_4_dl : deadlocks_local dls3_4
:=
begin
  refine list.pall_iff.mpr (new_deadlocks _),
  rcases list.pall_in dls3_4 with ⟨dl3_in, dl4_in, irrelevant⟩,
  refine list.pall_iff.mp ⟨_, _, trivial⟩,
  {
    analyze_deadlock,
    deadlocked_step dl2_dl, -- (6,7) left
    deadlocked_step dl4_in, -- (6,7) right
  }, {
    analyze_deadlock,
    deadlocked_step dl3_in, -- (7,7) left
    deadlocked_step dl0_dl, -- (7,7) right
  },
end

theorem dl3_dl : deadlock_local dl3
:= dls3_4_dl.1
theorem dl4_dl : deadlock_local dl4
:= dls3_4_dl.2.1

#html dl3_dl.to_html
#html dl4_dl.to_html

def dl5 := generate_local [(8,6)] [] (2,2)

theorem dl5_dl : deadlock_local dl5
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl5_dl.to_html

def dl6 := generate_local [(6,3)] [] (2,2)

theorem dl6_dl : deadlock_local dl6
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl6_dl.to_html

def dl7 := generate_local [(7,4)] [] (2,2)

theorem dl7_dl : deadlock_local dl7
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl7_dl.to_html

def dl8 := generate_local [(5,3), (6,4), (7,5)] [] (5,4)

theorem dl8_dl : deadlock_local dl8
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl6_dl, -- (6,4) up
  deadlocked_step dl7_dl, -- (6,4) right
  deadlocked_step dl7_dl, -- (7,5) up
end

#html dl8_dl.to_html

#check dl8_dl

def dl9 := generate_local [(5,4), (6,4), (7,5)] [] (5,5)

theorem dl9_dl : deadlock_local dl9
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl8_dl, -- (5,4) up
  deadlocked_step dl6_dl, -- (6,4) up
  deadlocked_step dl7_dl, -- (7,5) up
end

#html dl9_dl.to_html

def dl10 := generate_local [(6,4), (5,5), (7,5)] [] (6,5)

theorem dl10_dl : deadlock_local dl10
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl6_dl, -- (6,4) up
  deadlocked_step dl9_dl, -- (5,5) up
  deadlocked_step dl7_dl, -- (7,5) up
end

#html dl10_dl.to_html

def dl11 := generate_local [(1,5), (3,7)] [(3,5)] (2,2)

theorem dl11_dl : deadlock_local dl11
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl11_dl.to_html

def dl12 := generate_local [(3,5), (2,6), (3,7)] [] (2,2)
def dl13 := generate_local [(3,5), (3,7)] [(1,5), (2,5), (1,6), (2,6)] (2,2)
def dl14 := generate_local [(2,5), (3,5), (3,7)] [] (2,2)
def dl15 := generate_local [(2,5), (3,5), (3,7)] [] (1,5)
def dls12_15 := [dl12, dl13, dl14, dl15]

theorem dls12_15_dl : deadlocks_local dls12_15
:=
begin
  refine list.pall_iff.mpr (new_deadlocks _),
  rcases list.pall_in dls12_15 with ⟨dl12_in, dl13_in, dl14_in, dl15_in, irrelevant⟩,
  refine list.pall_iff.mp ⟨_, _, _, _, trivial⟩,
  {
    analyze_deadlock,
    deadlocked_step dl15_in, -- (2,6) up
    deadlocked_step dl13_in, -- (2,6) down
    deadlocked_step dl13_in, -- (2,6) right
  }, {
    analyze_deadlock,
    deadlocked_step dl14_in, -- (2,4) down
  }, {
    analyze_deadlock,
    deadlocked_step dl12_in, -- (2,5) down
  }, {
    analyze_deadlock,
    deadlocked_step dl13_in, -- (2,5) up
  },
end

theorem dl12_dl : deadlock_local dl12
:= dls12_15_dl.1
theorem dl13_dl : deadlock_local dl13
:= dls12_15_dl.2.1
theorem dl14_dl : deadlock_local dl14
:= dls12_15_dl.2.2.1
theorem dl15_dl : deadlock_local dl15
:= dls12_15_dl.2.2.2.1

#html dl12_dl.to_html
#html dl13_dl.to_html
#html dl14_dl.to_html
#html dl15_dl.to_html

def dl16 := generate_local [(2,5), (2,6)] [] (2,2)

theorem dl16_dl : deadlock_local dl16
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl16_dl.to_html

def dl17 := generate_local [(1,7)] [] (2,2)

theorem dl17_dl : deadlock_local dl17
:=
begin
  apply new_deadlock,
  analyze_deadlock,
end

#html dl17_dl.to_html

def dl18 := generate_local [(1,6), (2,7)] [] (2,2)

theorem dl18_dl : deadlock_local dl18
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl17_dl, -- (1,6) down
  deadlocked_step dl17_dl, -- (2,7) left
end

#html dl18_dl.to_html

def dl19 := generate_local [(3,5), (2,6), (2,7)] [] (3,6)

theorem dl19_dl : deadlock_local dl19
:=
begin
  apply new_deadlock,
  analyze_deadlock,
  deadlocked_step dl18_dl, -- (2,6) left
  deadlocked_step dl17_dl, -- (2,7) left
end

#html dl19_dl.to_html

def dl20 := generate_local [(2,5), (3,5), (2,7)] [] (2,2)
def dl21 := generate_local [(3,5), (2,7)] [(1,5), (2,5), (1,6), (2,6)] (2,2)
def dl22 := generate_local [(3,5), (2,6), (2,7)] [] (2,2)
def dls20_22 := [dl20, dl21, dl22]

theorem dls20_22_dl : deadlocks_local dls20_22
:=
begin
  refine list.pall_iff.mpr (new_deadlocks _),
  rcases list.pall_in dls20_22 with ⟨dl20_in, dl21_in, dl22_in, irrelevant⟩,
  refine list.pall_iff.mp ⟨_, _, _, trivial⟩,
  {
    analyze_deadlock,
    deadlocked_step dl22_in, -- (2,5) down
  }, {
    analyze_deadlock,
    deadlocked_step dl17_dl, -- (2,7) left
    deadlocked_step dl13_dl, -- (2,7) right
    deadlocked_step dl20_in, -- (2,4) down
  }, {
    analyze_deadlock,
    deadlocked_step dl21_in, -- (2,6) right
    deadlocked_step dl12_dl, -- (2,7) right
  },
end

#check dls20_22_dl

theorem dl20_dl : deadlock_local dl20
:= dls20_22_dl.1
theorem dl21_dl : deadlock_local dl21
:= dls20_22_dl.2.1
theorem dl22_dl : deadlock_local dl22
:= dls20_22_dl.2.2.1

#html dl20_dl.to_html
#html dl21_dl.to_html
#html dl22_dl.to_html

def dl23 := generate_local [(2,6), (3,7)] [(1,5), (2,5), (3,5), (1,6)] (2,2)
def dl24 := generate_local [(2,5), (2,7)] [(1,5), (3,5), (1,6), (2,6)] (2,2)
def dl25 := generate_local [(1,6), (3,7)] [(1,5), (2,5), (3,5), (2,6)] (2,2)
def dl26 := generate_local [(3,7)] [(1,5), (2,5), (3,5), (1,6), (2,6)] (2,2)
def dl27 := generate_local [(1,6), (2,6), (3,7)] [] (2,2)
def dl28 := generate_local [(2,6), (2,7)] [(1,5), (2,5), (3,5), (1,6)] (2,2)
def dl29 := generate_local [(2,5), (3,7)] [(1,5), (3,5), (1,6), (2,6)] (2,2)
def dl30 := generate_local [(2,5), (3,7)] [(1,5), (3,5), (1,6), (2,6)] (1,5)
def dl31 := generate_local [(2,5), (1,6), (3,7)] [] (2,2)
def dl32 := generate_local [(2,7)] [(1,5), (2,5), (3,5), (1,6), (2,6)] (2,2)
def dls23_32 := [dl23, dl24, dl25, dl26, dl27, dl28, dl29, dl30, dl31, dl32]

theorem dls23_32_dl : deadlocks_local dls23_32
:=
begin
  refine list.pall_iff.mpr (new_deadlocks _),
  rcases list.pall_in dls23_32 with ⟨dl23_in, dl24_in, dl25_in, dl26_in, dl27_in, dl28_in, dl29_in, dl30_in, dl31_in, dl32_in, irrelevant⟩,
  refine list.pall_iff.mp ⟨_, _, _, _, _, _, _, _, _, _, trivial⟩,
  {
    analyze_deadlock,
    deadlocked_step dl30_in, -- (2,6) up
    deadlocked_step dl32_in, -- (2,6) down
    deadlocked_step dl25_in, -- (2,6) left
    deadlocked_step dl26_in, -- (2,6) right
    deadlocked_step dl16_dl, -- (2,4) down
  }, {
    analyze_deadlock,
    deadlocked_step dl28_in, -- (2,5) down
  }, {
    analyze_deadlock,
    deadlocked_step dl11_dl, -- (1,6) up
    deadlocked_step dl26_in, -- (1,6) down
    deadlocked_step dl31_in, -- (2,4) down
  }, {
    analyze_deadlock,
    deadlocked_step dl29_in, -- (2,4) down
  }, {
    analyze_deadlock,
    deadlocked_step dl23_in, -- (1,6) down
    deadlocked_step dl25_in, -- (2,6) down
  }, {
    analyze_deadlock,
    deadlocked_step dl18_dl, -- (2,6) left
    deadlocked_step dl32_in, -- (2,6) right
    deadlocked_step dl17_dl, -- (2,7) left
    deadlocked_step dl23_in, -- (2,7) right
    deadlocked_step dl16_dl, -- (2,4) down
    deadlocked_step dl19_dl, -- (3,6) up
  }, {
    analyze_deadlock,
    deadlocked_step dl23_in, -- (2,5) down
  }, {
    analyze_deadlock,
    deadlocked_step dl26_in, -- (2,5) up
    deadlocked_step dl11_dl, -- (2,5) left
    deadlocked_step dl13_dl, -- (2,5) right
  }, {
    analyze_deadlock,
    deadlocked_step dl27_in, -- (2,5) down
  }, {
    analyze_deadlock,
    deadlocked_step dl17_dl, -- (2,7) left
    deadlocked_step dl26_in, -- (2,7) right
    deadlocked_step dl24_in, -- (2,4) down
    deadlocked_step dl21_dl, -- (3,6) up
  },
end

theorem dl23_dl : deadlock_local dl23
:= dls23_32_dl.1
theorem dl24_dl : deadlock_local dl24
:= dls23_32_dl.2.1
theorem dl25_dl : deadlock_local dl25
:= dls23_32_dl.2.2.1
theorem dl26_dl : deadlock_local dl26
:= dls23_32_dl.2.2.2.1
theorem dl27_dl : deadlock_local dl27
:= dls23_32_dl.2.2.2.2.1
theorem dl28_dl : deadlock_local dl28
:= dls23_32_dl.2.2.2.2.2.1
theorem dl29_dl : deadlock_local dl29
:= dls23_32_dl.2.2.2.2.2.2.1
theorem dl30_dl : deadlock_local dl30
:= dls23_32_dl.2.2.2.2.2.2.2.1
theorem dl31_dl : deadlock_local dl31
:= dls23_32_dl.2.2.2.2.2.2.2.2.1
theorem dl32_dl : deadlock_local dl32
:= dls23_32_dl.2.2.2.2.2.2.2.2.2.1

#html dl23_dl.to_html
#html dl24_dl.to_html
#html dl25_dl.to_html
#html dl26_dl.to_html
#html dl27_dl.to_html
#html dl28_dl.to_html
#html dl29_dl.to_html
#html dl30_dl.to_html
#html dl31_dl.to_html
#html dl32_dl.to_html

end Microban_155_l16


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.measure_space
import Mathlib.PostPort

universes u_1 u_2 u_4

namespace Mathlib

/-!
# Sequence of measurable functions associated to a sequence of a.e.-measurable functions

We define here tools to prove statements about limits (infi, supr...) of sequences of
`ae_measurable` functions.
Given a sequence of a.e.-measurable functions `f : ι → α → β` with hypothesis
`hf : ∀ i, ae_measurable (f i) μ`, and a pointwise property `p : α → (ι → β) → Prop` such that we
have `hp : ∀ᵐ x ∂μ, p x (λ n, f n x)`, we define a sequence of measurable functions `ae_seq hf p`
and a measurable set `ae_seq_set hf p`, such that
* `μ (ae_seq_set hf p)ᶜ = 0`
* `x ∈ ae_seq_set hf p → ∀ i : ι, ae_seq hf hp i x = f i x`
* `x ∈ ae_seq_set hf p → p x (λ n, f n x)`
-/

/-- If we have the additional hypothesis `∀ᵐ x ∂μ, p x (λ n, f n x)`, this is a measurable set
whose complement has measure 0 such that for all `x ∈ ae_seq_set`, `f i x` is equal to
`(hf i).mk (f i) x` for all `i` and we have the pointwise property `p x (λ n, f n x)`. -/
def ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    (hf : ∀ (i : ι), ae_measurable (f i)) (p : α → (ι → β) → Prop) : set α :=
  measure_theory.to_measurable μ
      ((set_of
          fun (x : α) =>
            (∀ (i : ι), f i x = ae_measurable.mk (f i) (hf i) x) ∧ p x fun (n : ι) => f n x)ᶜ)ᶜ

/-- A sequence of measurable functions that are equal to `f` and verify property `p` on the
measurable set `ae_seq_set hf p`. -/
def ae_seq {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α] [measurable_space β]
    {f : ι → α → β} {μ : measure_theory.measure α} (hf : ∀ (i : ι), ae_measurable (f i))
    (p : α → (ι → β) → Prop) : ι → α → β :=
  fun (i : ι) (x : α) =>
    ite (x ∈ ae_seq_set hf p) (ae_measurable.mk (f i) (hf i) x) (nonempty.some sorry)

namespace ae_seq

theorem mk_eq_fun_of_mem_ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4}
    [measurable_space α] [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    {p : α → (ι → β) → Prop} (hf : ∀ (i : ι), ae_measurable (f i)) {x : α}
    (hx : x ∈ ae_seq_set hf p) (i : ι) : ae_measurable.mk (f i) (hf i) x = f i x :=
  sorry

theorem ae_seq_eq_mk_of_mem_ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4}
    [measurable_space α] [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    {p : α → (ι → β) → Prop} (hf : ∀ (i : ι), ae_measurable (f i)) {x : α}
    (hx : x ∈ ae_seq_set hf p) (i : ι) : ae_seq hf p i x = ae_measurable.mk (f i) (hf i) x :=
  sorry

theorem ae_seq_eq_fun_of_mem_ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4}
    [measurable_space α] [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    {p : α → (ι → β) → Prop} (hf : ∀ (i : ι), ae_measurable (f i)) {x : α}
    (hx : x ∈ ae_seq_set hf p) (i : ι) : ae_seq hf p i x = f i x :=
  sorry

theorem prop_of_mem_ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    (hf : ∀ (i : ι), ae_measurable (f i)) {x : α} (hx : x ∈ ae_seq_set hf p) :
    p x fun (n : ι) => ae_seq hf p n x :=
  sorry

theorem fun_prop_of_mem_ae_seq_set {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    (hf : ∀ (i : ι), ae_measurable (f i)) {x : α} (hx : x ∈ ae_seq_set hf p) :
    p x fun (n : ι) => f n x :=
  sorry

theorem ae_seq_set_is_measurable {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    {hf : ∀ (i : ι), ae_measurable (f i)} : is_measurable (ae_seq_set hf p) :=
  sorry

theorem measurable {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    (hf : ∀ (i : ι), ae_measurable (f i)) (p : α → (ι → β) → Prop) (i : ι) :
    measurable (ae_seq hf p i) :=
  measurable.ite ae_seq_set_is_measurable (ae_measurable.measurable_mk (hf i))
    (dite (Nonempty α) (fun (hα : Nonempty α) => measurable_const)
      fun (hα : ¬Nonempty α) =>
        measurable_of_not_nonempty hα fun (x : α) => nonempty.some (_proof_1 i x))

theorem measure_compl_ae_seq_set_eq_zero {α : Type u_1} {β : Type u_2} {ι : Type u_4}
    [measurable_space α] [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α}
    {p : α → (ι → β) → Prop} [encodable ι] (hf : ∀ (i : ι), ae_measurable (f i))
    (hp :
      filter.eventually (fun (x : α) => p x fun (n : ι) => f n x) (measure_theory.measure.ae μ)) :
    coe_fn μ (ae_seq_set hf pᶜ) = 0 :=
  sorry

theorem ae_seq_eq_mk_ae {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    [encodable ι] (hf : ∀ (i : ι), ae_measurable (f i))
    (hp :
      filter.eventually (fun (x : α) => p x fun (n : ι) => f n x) (measure_theory.measure.ae μ)) :
    filter.eventually (fun (a : α) => ∀ (i : ι), ae_seq hf p i a = ae_measurable.mk (f i) (hf i) a)
        (measure_theory.measure.ae μ) :=
  sorry

theorem ae_seq_eq_fun_ae {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    [encodable ι] (hf : ∀ (i : ι), ae_measurable (f i))
    (hp :
      filter.eventually (fun (x : α) => p x fun (n : ι) => f n x) (measure_theory.measure.ae μ)) :
    filter.eventually (fun (a : α) => ∀ (i : ι), ae_seq hf p i a = f i a)
        (measure_theory.measure.ae μ) :=
  measure_theory.measure_mono_null
    (fun (x : α) =>
      mt fun (hx : x ∈ ae_seq_set hf p) (i : ι) => ae_seq_eq_fun_of_mem_ae_seq_set hf hx i)
    (measure_compl_ae_seq_set_eq_zero hf hp)

theorem ae_seq_n_eq_fun_n_ae {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α]
    [measurable_space β] {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop}
    [encodable ι] (hf : ∀ (i : ι), ae_measurable (f i))
    (hp : filter.eventually (fun (x : α) => p x fun (n : ι) => f n x) (measure_theory.measure.ae μ))
    (n : ι) : filter.eventually_eq (measure_theory.measure.ae μ) (ae_seq hf p n) (f n) :=
  iff.mp measure_theory.ae_all_iff (ae_seq_eq_fun_ae hf hp) n

theorem supr {α : Type u_1} {β : Type u_2} {ι : Type u_4} [measurable_space α] [measurable_space β]
    {f : ι → α → β} {μ : measure_theory.measure α} {p : α → (ι → β) → Prop} [complete_lattice β]
    [encodable ι] (hf : ∀ (i : ι), ae_measurable (f i))
    (hp :
      filter.eventually (fun (x : α) => p x fun (n : ι) => f n x) (measure_theory.measure.ae μ)) :
    filter.eventually_eq (measure_theory.measure.ae μ) (supr fun (n : ι) => ae_seq hf p n)
        (supr fun (i : ι) => f i) :=
  sorry

end Mathlib


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import tactic.ext
import tactic.lint

/-!
# Functors

This module provides additional lemmas, definitions, and instances for `functor`s.

## Main definitions

* `const α` is the functor that sends all types to `α`.
* `add_const α` is `const α` but for when `α` has an additive structure.
* `comp F G` for functors `F` and `G` is the functor composition of `F` and `G`.
* `liftp` and `liftr` respectively lift predicates and relations on a type `α`
  to `F α`.  Terms of `F α` are considered to, in some sense, contain values of type `α`.

## Tags

functor, applicative
-/

attribute [functor_norm] seq_assoc pure_seq_eq_map map_pure seq_map_assoc map_seq

universe variables u v w

section functor

variables {F : Type u → Type v}
variables {α β γ : Type u}
variables [functor F] [is_lawful_functor F]

lemma functor.map_id : (<$>) id = (id : F α → F α) :=
by apply funext; apply id_map

lemma functor.map_comp_map (f : α → β) (g : β → γ) :
  ((<$>) g ∘ (<$>) f : F α → F γ) = (<$>) (g ∘ f) :=
by apply funext; intro; rw comp_map

theorem functor.ext {F} : ∀ {F1 : functor F} {F2 : functor F}
  [@is_lawful_functor F F1] [@is_lawful_functor F F2]
  (H : ∀ α β (f : α → β) (x : F α),
    @functor.map _ F1 _ _ f x = @functor.map _ F2 _ _ f x),
  F1 = F2
| ⟨m, mc⟩ ⟨m', mc'⟩ H1 H2 H :=
begin
  cases show @m = @m', by funext α β f x; apply H,
  congr, funext α β,
  have E1 := @map_const_eq _ ⟨@m, @mc⟩ H1,
  have E2 := @map_const_eq _ ⟨@m, @mc'⟩ H2,
  exact E1.trans E2.symm
end

end functor

/-- Introduce the `id` functor. Incidentally, this is `pure` for
`id` as a `monad` and as an `applicative` functor. -/
def id.mk {α : Sort u} : α → id α := id

namespace functor

/-- `const α` is the constant functor, mapping every type to `α`. When
`α` has a monoid structure, `const α` has an `applicative` instance.
(If `α` has an additive monoid structure, see `functor.add_const`.) -/
@[nolint unused_arguments]
def const (α : Type*) (β : Type*) := α

/-- `const.mk` is the canonical map `α → const α β` (the identity), and
it can be used as a pattern to extract this value. -/
@[pattern] def const.mk {α β} (x : α) : const α β := x

/-- `const.mk'` is `const.mk` but specialized to map `α` to
`const α punit`, where `punit` is the terminal object in `Type*`. -/
def const.mk' {α} (x : α) : const α punit := x

/-- Extract the element of `α` from the `const` functor. -/
def const.run {α β} (x : const α β) : α := x

namespace const

protected lemma ext {α β} {x y : const α β} (h : x.run = y.run) : x = y := h

/-- The map operation of the `const γ` functor. -/
@[nolint unused_arguments]
protected def map {γ α β} (f : α → β) (x : const γ β) : const γ α := x

instance {γ} : functor (const γ) :=
{ map := @const.map γ }

instance {γ} : is_lawful_functor (const γ) :=
by constructor; intros; refl

instance {α β} [inhabited α] : inhabited (const α β) :=
⟨(default _ : α)⟩

end const

/-- `add_const α` is a synonym for constant functor `const α`, mapping
every type to `α`. When `α` has a additive monoid structure,
`add_const α` has an `applicative` instance. (If `α` has a
multiplicative monoid structure, see `functor.const`.) -/
def add_const (α : Type*) := const α

/-- `add_const.mk` is the canonical map `α → add_const α β`, which is the identity,
where `add_const α β = const α β`. It can be used as a pattern to extract this value. -/
@[pattern]
def add_const.mk {α β} (x : α) : add_const α β := x

/-- Extract the element of `α` from the constant functor. -/
def add_const.run {α β} : add_const α β → α := id

instance add_const.functor {γ} : functor (add_const γ) :=
@const.functor γ

instance add_const.is_lawful_functor {γ} : is_lawful_functor (add_const γ) :=
@const.is_lawful_functor γ

instance {α β} [inhabited α] : inhabited (add_const α β) :=
⟨(default _ : α)⟩

/-- `functor.comp` is a wrapper around `function.comp` for types.
    It prevents Lean's type class resolution mechanism from trying
    a `functor (comp F id)` when `functor F` would do. -/
def comp (F : Type u → Type w) (G : Type v → Type u) (α : Type v) : Type w :=
F $ G α

/-- Construct a term of `comp F G α` from a term of `F (G α)`, which is the same type.
Can be used as a pattern to extract a term of `F (G α)`. -/
@[pattern] def comp.mk {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : F (G α)) : comp F G α := x

/-- Extract a term of `F (G α)` from a term of `comp F G α`, which is the same type. -/
def comp.run {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : comp F G α) : F (G α) := x

namespace comp

variables {F : Type u → Type w} {G : Type v → Type u}

protected lemma ext
  {α} {x y : comp F G α} : x.run = y.run → x = y := id

instance {α} [inhabited (F (G α))] : inhabited (comp F G α) :=
⟨(default _ : F (G α))⟩

variables [functor F] [functor G]

/-- The map operation for the composition `comp F G` of functors `F` and `G`. -/
protected def map {α β : Type v} (h : α → β) : comp F G α → comp F G β
| (comp.mk x) := comp.mk ((<$>) h <$> x)

instance : functor (comp F G) := { map := @comp.map F G _ _ }

@[functor_norm] lemma map_mk {α β} (h : α → β) (x : F (G α)) :
  h <$> comp.mk x = comp.mk ((<$>) h <$> x) := rfl

@[simp] protected lemma run_map {α β} (h : α → β) (x : comp F G α) :
  (h <$> x).run = (<$>) h <$> x.run := rfl

variables [is_lawful_functor F] [is_lawful_functor G]
variables {α β γ : Type v}

protected lemma id_map : ∀ (x : comp F G α), comp.map id x = x
| (comp.mk x) := by simp [comp.map, functor.map_id]

protected lemma comp_map (g' : α → β) (h : β → γ) : ∀ (x : comp F G α),
           comp.map (h ∘ g') x = comp.map h (comp.map g' x)
| (comp.mk x) := by simp [comp.map, functor.map_comp_map g' h] with functor_norm

instance : is_lawful_functor (comp F G) :=
{ id_map := @comp.id_map F G _ _ _ _,
  comp_map := @comp.comp_map F G _ _ _ _ }

theorem functor_comp_id {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor F id _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor F id _ _ _ _) _ (λ α β f x, rfl)

theorem functor_id_comp {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor id F _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor id F _ _ _ _) _ (λ α β f x, rfl)

end comp

namespace comp

open function (hiding comp)
open functor

variables {F : Type u → Type w} {G : Type v → Type u}

variables [applicative F] [applicative G]

/-- The `<*>` operation for the composition of applicative functors. -/
protected def seq {α β : Type v} : comp F G (α → β) → comp F G α → comp F G β
| (comp.mk f) (comp.mk x) := comp.mk $ (<*>) <$> f <*> x

instance : has_pure (comp F G) :=
⟨λ _ x, comp.mk $ pure $ pure x⟩

instance : has_seq (comp F G) :=
⟨λ _ _ f x, comp.seq f x⟩

@[simp] protected lemma run_pure {α : Type v} :
  ∀ x : α, (pure x : comp F G α).run = pure (pure x)
| _ := rfl

@[simp] protected lemma run_seq {α β : Type v} (f : comp F G (α → β)) (x : comp F G α) :
  (f <*> x).run = (<*>) <$> f.run <*> x.run := rfl

instance : applicative (comp F G) :=
{ map := @comp.map F G _ _,
  seq := @comp.seq F G _ _,
  ..comp.has_pure }

end comp

variables {F : Type u → Type u} [functor F]

/-- If we consider `x : F α` to, in some sense, contain values of type `α`,
predicate `liftp p x` holds iff every value contained by `x` satisfies `p`. -/
def liftp {α : Type u} (p : α → Prop) (x : F α) : Prop :=
∃ u : F (subtype p), subtype.val <$> u = x

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`liftr r x y` relates `x` and `y` iff (1) `x` and `y` have the same shape and
(2) we can pair values `a` from `x` and `b` from `y` so that `r a b` holds. -/
def liftr {α : Type u} (r : α → α → Prop) (x y : F α) : Prop :=
∃ u : F {p : α × α // r p.fst p.snd},
  (λ t : {p : α × α // r p.fst p.snd}, t.val.fst) <$> u = x ∧
  (λ t : {p : α × α // r p.fst p.snd}, t.val.snd) <$> u = y

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`supp x` is the set of values of type `α` that `x` contains. -/
def supp {α : Type u} (x : F α) : set α := { y : α | ∀ ⦃p⦄, liftp p x → p y }

theorem of_mem_supp {α : Type u} {x : F α} {p : α → Prop} (h : liftp p x) :
  ∀ y ∈ supp x, p y :=
λ y hy, hy h

end functor

namespace ulift

instance : functor ulift :=
{ map := λ α β f, up ∘ f ∘ down }

end ulift


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open A,
  assume hA2 : is_covering A,

  have h1 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A ∧ x ∈ a) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ a : euclidean_space ℝ (fin n), a ∈ A
end --Needs more than 2000 tokens!

/- 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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  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
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = 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
  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⁻¹],

  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],

  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`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import Lean

def checkWithMkMatcherInput (matcher : Lean.Name) : Lean.MetaM Unit :=
  Lean.Meta.Match.withMkMatcherInput matcher fun input => do
  let res ← Lean.Meta.Match.mkMatcher input
  let origMatcher ← Lean.getConstInfo matcher
  if not <| input.matcherName == matcher then
    throwError "matcher name not reconstructed correctly: {matcher} ≟ {input.matcherName}"

  let lCtx ← Lean.getLCtx
  let fvars := Lean.collectFVars {} res.matcher
  let closure := Lean.Meta.Closure.mkLambda (fvars.fvarSet.toList.toArray.map lCtx.get!) res.matcher

  let origTy := origMatcher.value!
  let newTy := closure
  if not <| ←Lean.Meta.isDefEq origTy newTy then
    throwError "matcher {matcher} does not round-trip correctly:\n{origTy} ≟ {newTy}"

set_option smartUnfolding false

def f (xs : List Nat) : List Bool :=
xs.map fun
  | 0 => true
  | _ => false
#eval checkWithMkMatcherInput ``f.match_1

#eval f [1, 2, 0, 2]

theorem ex1 : f [1, 0, 2] = [false, true, false] :=
rfl

#check f

set_option pp.raw true
set_option pp.raw.maxDepth 10
set_option trace.Elab.step true in
def g (xs : List Nat) : List Bool :=
xs.map <| by {
  intro
    | 0 => exact true
    | _ => exact false
}

theorem ex2 : g [1, 0, 2] = [false, true, false] :=
rfl

theorem ex3 {p q r : Prop} : p ∨ q → r → (q ∧ r) ∨ (p ∧ r) :=
by intro
 | Or.inl hp, h => { apply Or.inr; apply And.intro; assumption; assumption }
 | Or.inr hq, h => { apply Or.inl; exact ⟨hq, h⟩ }
#eval checkWithMkMatcherInput ``ex3.match_1

inductive C
| mk₁ : Nat → C
| mk₂ : Nat → Nat → C

def C.x : C → Nat
| C.mk₁ x   => x
| C.mk₂ x _ => x
#eval checkWithMkMatcherInput ``C.x.match_1

def head : {α : Type} → List α → Option α
| _, a::as => some a
| _, _     => none
#eval checkWithMkMatcherInput ``head.match_1

theorem ex4 : head [1, 2] = some 1 :=
rfl

def head2 : {α : Type} → List α → Option α :=
@fun
  | _, a::as => some a
  | _, _     => none

theorem ex5 : head2 [1, 2] = some 1 :=
rfl

def head3 {α : Type} (xs : List α) : Option α :=
let rec aux : {α : Type} → List α → Option α
  | _, a::as => some a
  | _, _     => none;
aux xs

theorem ex6 : head3 [1, 2] = some 1 :=
rfl

inductive Vec.{u} (α : Type u) : Nat → Type u
| nil : Vec α 0
| cons {n} (head : α) (tail : Vec α n) : Vec α (n+1)

def Vec.mapHead1 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
| _,   nil,       nil,       f => none
| _, cons a as, cons b bs,   f => some (f a b)
#eval checkWithMkMatcherInput ``Vec.mapHead1.match_1

def Vec.mapHead2 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
| _, nil,            nil,         f => none
| _, @cons _ n a as, cons b bs,   f => some (f a b)
#eval checkWithMkMatcherInput ``Vec.mapHead2.match_1

def Vec.mapHead3 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
| _, nil,            nil,         f => none
| _, cons (tail := as) (head := a), cons b bs,   f => some (f a b)

inductive Foo
| mk₁ (x y z w : Nat)
| mk₂ (x y z w : Nat)

def Foo.z : Foo → Nat
| mk₁ (z := z) .. => z
| mk₂ (z := z) .. => z
#eval checkWithMkMatcherInput ``Foo.z.match_1

#eval (Foo.mk₁ 10 20 30 40).z

theorem ex7 : (Foo.mk₁ 10 20 30 40).z = 30 :=
rfl

def Foo.addY? : Foo × Foo → Option Nat
| (mk₁ (y := y₁) .., mk₁ (y := y₂) ..) => some (y₁ + y₂)
| _ => none
#eval checkWithMkMatcherInput ``Foo.addY?.match_1

#eval Foo.addY? (Foo.mk₁ 1 2 3 4, Foo.mk₁ 10 20 30 40)

theorem ex8 : Foo.addY? (Foo.mk₁ 1 2 3 4, Foo.mk₁ 10 20 30 40) = some 22 :=
rfl

instance {α} : Inhabited (Sigma fun m => Vec α m) :=
⟨⟨0, Vec.nil⟩⟩

partial def filter {α} (p : α → Bool) : {n : Nat} → Vec α n → Sigma fun m => Vec α m
| _, Vec.nil        => ⟨0, Vec.nil⟩
| _, Vec.cons x xs  => match p x, filter p xs with
  | true,  ⟨_, ys⟩ => ⟨_, Vec.cons x ys⟩
  | false, ys      => ys
#eval checkWithMkMatcherInput ``filter.match_1

inductive Bla
| ofNat  (x : Nat)
| ofBool (x : Bool)

def Bla.optional? : Bla → Option Nat
| ofNat x  => some x
| ofBool _ => none
#eval checkWithMkMatcherInput ``Bla.optional?.match_1

def Bla.isNat? (b : Bla) : Option { x : Nat // optional? b = some x } :=
match b.optional? with
| some y => some ⟨y, rfl⟩
| none   => none
#eval checkWithMkMatcherInput ``Bla.isNat?.match_1

def foo (b : Bla) : Option Nat := b.optional?
theorem fooEq (b : Bla) : foo b = b.optional? :=
rfl

def Bla.isNat2? (b : Bla) : Option { x : Nat // optional? b = some x } :=
match h:foo b with
| some y => some ⟨y, Eq.trans (fooEq b).symm h⟩
| none   => none
#eval checkWithMkMatcherInput ``Bla.isNat2?.match_1

def foo2 (x : Nat) : Nat :=
match x, rfl : (y : Nat) → x = y → Nat with
| 0,   h => 0
| x+1, h => 1
#eval checkWithMkMatcherInput ``foo2.match_1


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import algebra.homology.exact
import category_theory.limits.shapes.biproducts
import category_theory.adjunction.limits
import category_theory.limits.preserves.finite

/-!
# Projective objects and categories with enough projectives

An object `P` is called projective if every morphism out of `P` factors through every epimorphism.

A category `C` has enough projectives if every object admits an epimorphism from some
projective object.

`projective.over X` picks an arbitrary such projective object,
and `projective.π X : projective.over X ⟶ X` is the corresponding epimorphism.

Given a morphism `f : X ⟶ Y`, `projective.left f` is a projective object over `kernel f`,
and `projective.d f : projective.left f ⟶ X` is the morphism `π (kernel f) ≫ kernel.ι f`.
-/

noncomputable theory

open category_theory
open category_theory.limits
open opposite

universes v u

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

/--
An object `P` is called projective if every morphism out of `P` factors through every epimorphism.
-/
class projective (P : C) : Prop :=
(factors : ∀ {E X : C} (f : P ⟶ X) (e : E ⟶ X) [epi e], ∃ f', f' ≫ e = f)

section

/--
A projective presentation of an object `X` consists of an epimorphism `f : P ⟶ X`
from some projective object `P`.
-/
@[nolint has_nonempty_instance]
structure projective_presentation (X : C) :=
(P : C)
(projective : projective P . tactic.apply_instance)
(f : P ⟶ X)
(epi : epi f . tactic.apply_instance)

attribute [instance] projective_presentation.projective projective_presentation.epi

variables (C)

/-- A category "has enough projectives" if for every object `X` there is a projective object `P` and
    an epimorphism `P ↠ X`. -/
class enough_projectives : Prop :=
(presentation : ∀ (X : C), nonempty (projective_presentation X))

end

namespace projective

/--
An arbitrarily chosen factorisation of a morphism out of a projective object through an epimorphism.
-/
def factor_thru {P X E : C} [projective P] (f : P ⟶ X) (e : E ⟶ X) [epi e] : P ⟶ E :=
(projective.factors f e).some

@[simp] lemma factor_thru_comp {P X E : C} [projective P] (f : P ⟶ X) (e : E ⟶ X) [epi e] :
  factor_thru f e ≫ e = f :=
(projective.factors f e).some_spec

section
open_locale zero_object

instance zero_projective [has_zero_object C] [has_zero_morphisms C] : projective (0 : C) :=
{ factors := λ E X f e epi, by { use 0, ext, }}

end

lemma of_iso {P Q : C} (i : P ≅ Q) (hP : projective P) : projective Q :=
begin
  fsplit,
  introsI E X f e e_epi,
  obtain ⟨f', hf'⟩ := projective.factors (i.hom ≫ f) e,
  exact ⟨i.inv ≫ f', by simp [hf']⟩
end

lemma iso_iff {P Q : C} (i : P ≅ Q) : projective P ↔ projective Q :=
⟨of_iso i, of_iso i.symm⟩

/-- The axiom of choice says that every type is a projective object in `Type`. -/
instance (X : Type u) : projective X :=
{ factors := λ E X' f e epi,
  ⟨λ x, ((epi_iff_surjective _).mp epi (f x)).some,
  by { ext x, exact ((epi_iff_surjective _).mp epi (f x)).some_spec, }⟩ }

instance Type.enough_projectives : enough_projectives (Type u) :=
{ presentation := λ X, ⟨{ P := X, f := 𝟙 X, }⟩, }

instance {P Q : C} [has_binary_coproduct P Q] [projective P] [projective Q] :
  projective (P ⨿ Q) :=
{ factors := λ E X' f e epi, by exactI
  ⟨coprod.desc (factor_thru (coprod.inl ≫ f) e) (factor_thru (coprod.inr ≫ f) e), by tidy⟩, }

section
local attribute [tidy] tactic.discrete_cases

instance {β : Type v} (g : β → C) [has_coproduct g] [∀ b, projective (g b)] :
  projective (∐ g) :=
{ factors := λ E X' f e epi, by exactI
  ⟨sigma.desc (λ b, factor_thru (sigma.ι g b ≫ f) e), by tidy⟩, }

end

instance {P Q : C} [has_zero_morphisms C] [has_binary_biproduct P Q]
  [projective P] [projective Q] :
  projective (P ⊞ Q) :=
{ factors := λ E X' f e epi, by exactI
  ⟨biprod.desc (factor_thru (biprod.inl ≫ f) e) (factor_thru (biprod.inr ≫ f) e), by tidy⟩, }

instance {β : Type v} (g : β → C) [has_zero_morphisms C] [has_biproduct g]
  [∀ b, projective (g b)] : projective (⨁ g) :=
{ factors := λ E X' f e epi, by exactI
  ⟨biproduct.desc (λ b, factor_thru (biproduct.ι g b ≫ f) e), by tidy⟩, }

lemma projective_iff_preserves_epimorphisms_coyoneda_obj (P : C) :
  projective P ↔ (coyoneda.obj (op P)).preserves_epimorphisms :=
⟨λ hP, ⟨λ X Y f hf, (epi_iff_surjective _).2 $ λ g, have projective (unop (op P)), from hP,
  by exactI ⟨factor_thru g f, factor_thru_comp _ _⟩⟩,
 λ h, ⟨λ E X f e he, by exactI (epi_iff_surjective _).1
  (infer_instance : epi ((coyoneda.obj (op P)).map e)) f⟩⟩

section enough_projectives
variables [enough_projectives C]

/--
`projective.over X` provides an arbitrarily chosen projective object equipped with
an epimorphism `projective.π : projective.over X ⟶ X`.
-/
def over (X : C) : C :=
(enough_projectives.presentation X).some.P

instance projective_over (X : C) : projective (over X) :=
(enough_projectives.presentation X).some.projective

/--
The epimorphism `projective.π : projective.over X ⟶ X`
from the arbitrarily chosen projective object over `X`.
-/
def π (X : C) : over X ⟶ X :=
(enough_projectives.presentation X).some.f

instance π_epi (X : C) : epi (π X) :=
(enough_projectives.presentation X).some.epi

section
variables [has_zero_morphisms C] {X Y : C} (f : X ⟶ Y) [has_kernel f]

/--
When `C` has enough projectives, the object `projective.syzygies f` is
an arbitrarily chosen projective object over `kernel f`.
-/
@[derive projective]
def syzygies : C := over (kernel f)

/--
When `C` has enough projectives,
`projective.d f : projective.syzygies f ⟶ X` is the composition
`π (kernel f) ≫ kernel.ι f`.

(When `C` is abelian, we have `exact (projective.d f) f`.)
-/
abbreviation d : syzygies f ⟶ X :=
π (kernel f) ≫ kernel.ι f

end

end enough_projectives

end projective
namespace adjunction

variables {D : Type*} [category D] {F : C ⥤ D} {G : D ⥤ C}

lemma map_projective (adj : F ⊣ G) [G.preserves_epimorphisms] (P : C) (hP : projective P) :
  projective (F.obj P) :=
⟨λ X Y f g, begin
  introI,
  rcases hP.factors (adj.unit.app P ≫ G.map f) (G.map g),
  use F.map w ≫ adj.counit.app X,
  rw [category.assoc, ←adjunction.counit_naturality, ←category.assoc, ←F.map_comp, h],
  simp,
end⟩

lemma projective_of_map_projective (adj : F ⊣ G) [full F] [faithful F] (P : C)
  (hP : projective (F.obj P)) : projective P :=
⟨λ X Y f g, begin
  introI,
  haveI := adj.left_adjoint_preserves_colimits,
  rcases @hP.1 (F.map f) (F.map g),
  use adj.unit.app _ ≫ G.map w ≫ (inv $ adj.unit.app _),
  refine faithful.map_injective F _,
  simpa
end⟩

/-- Given an adjunction `F ⊣ G` such that `G` preserves epis, `F` maps a projective presentation of
`X` to a projective presentation of `F(X)`. -/
def map_projective_presentation (adj : F ⊣ G) [G.preserves_epimorphisms] (X : C)
  (Y : projective_presentation X) : projective_presentation (F.obj X) :=
{ P := F.obj Y.P,
  projective := adj.map_projective _ Y.projective,
  f := F.map Y.f,
  epi := by haveI := adj.left_adjoint_preserves_colimits; apply_instance }

end adjunction
namespace equivalence

variables {D : Type*} [category D] (F : C ≌ D)

/-- Given an equivalence of categories `F`, a projective presentation of `F(X)` induces a
projective presentation of `X.` -/
def projective_presentation_of_map_projective_presentation
  (X : C) (Y : projective_presentation (F.functor.obj X)) : projective_presentation X :=
{ P := F.inverse.obj Y.P,
  projective := adjunction.map_projective F.symm.to_adjunction Y.P Y.projective,
  f := F.inverse.map Y.f ≫ F.unit_inv.app _,
  epi := epi_comp _ _ }

lemma enough_projectives_iff (F : C ≌ D) :
  enough_projectives C ↔ enough_projectives D :=
begin
  split,
  all_goals { intro H, constructor, intro X, constructor },
  { exact F.symm.projective_presentation_of_map_projective_presentation _
      (nonempty.some (H.presentation (F.inverse.obj X))) },
  { exact F.projective_presentation_of_map_projective_presentation X
      (nonempty.some (H.presentation (F.functor.obj X))) },
end

end equivalence
open projective
section
variables [has_zero_morphisms C] [has_equalizers C] [has_images C]

/--
Given a projective object `P` mapping via `h` into
the middle object `R` of a pair of exact morphisms `f : Q ⟶ R` and `g : R ⟶ S`,
such that `h ≫ g = 0`, there is a lift of `h` to `Q`.
-/
def exact.lift {P Q R S : C} [projective P] (h : P ⟶ R) (f : Q ⟶ R) (g : R ⟶ S)
  (hfg : exact f g) (w : h ≫ g = 0) : P ⟶ Q :=
factor_thru
  (factor_thru
    (factor_thru_kernel_subobject g h w)
    (image_to_kernel f g hfg.w))
  (factor_thru_image_subobject f)

@[simp] lemma exact.lift_comp {P Q R S : C} [projective P] (h : P ⟶ R) (f : Q ⟶ R) (g : R ⟶ S)
  (hfg : exact f g) (w : h ≫ g = 0) : exact.lift h f g hfg w ≫ f = h :=
begin
  simp [exact.lift],
  conv_lhs { congr, skip, rw ← image_subobject_arrow_comp f, },
  rw [←category.assoc, factor_thru_comp, ←image_to_kernel_arrow,
    ←category.assoc, category_theory.projective.factor_thru_comp,
    factor_thru_kernel_subobject_comp_arrow],
end

end

end category_theory