/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Andrew Yang
-/
import category_theory.monoidal.functor

/-!
# Endofunctors as a monoidal category.

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

We give the monoidal category structure on `C ⥤ C`,
and show that when `C` itself is monoidal, it embeds via a monoidal functor into `C ⥤ C`.

## TODO

Can we use this to show coherence results, e.g. a cheap proof that `λ_ (𝟙_ C) = ρ_ (𝟙_ C)`?
I suspect this is harder than is usually made out.
-/

universes v u

namespace category_theory

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

/--
The category of endofunctors of any category is a monoidal category,
with tensor product given by composition of functors
(and horizontal composition of natural transformations).
-/
def endofunctor_monoidal_category : monoidal_category (C ⥤ C) :=
{ tensor_obj   := λ F G, F ⋙ G,
  tensor_hom   := λ F G F' G' α β, α ◫ β,
  tensor_unit  := 𝟭 C,
  associator   := λ F G H, functor.associator F G H,
  left_unitor  := λ F, functor.left_unitor F,
  right_unitor := λ F, functor.right_unitor F, }.

open category_theory.monoidal_category

local attribute [instance] endofunctor_monoidal_category
local attribute [reducible] endofunctor_monoidal_category

/--
Tensoring on the right gives a monoidal functor from `C` into endofunctors of `C`.
-/
@[simps]
def tensoring_right_monoidal [monoidal_category.{v} C] : monoidal_functor C (C ⥤ C) :=
{ ε := (right_unitor_nat_iso C).inv,
  μ := λ X Y,
  { app := λ Z, (α_ Z X Y).hom,
    naturality' := λ Z Z' f, by { dsimp, rw associator_naturality, simp, } },
  μ_natural' := λ X Y X' Y' f g, by { ext Z, dsimp,
    simp only [←id_tensor_comp_tensor_id g f, id_tensor_comp, ←tensor_id, category.assoc,
      associator_naturality, associator_naturality_assoc], },
  associativity' := λ X Y Z, by { ext W, dsimp, simp [pentagon], },
  left_unitality' := λ X, by { ext Y, dsimp, rw [category.id_comp, triangle, ←tensor_comp], simp, },
  right_unitality' := λ X,
  begin
    ext Y, dsimp,
    rw [tensor_id, category.comp_id, right_unitor_tensor_inv, category.assoc, iso.inv_hom_id_assoc,
      ←id_tensor_comp, iso.inv_hom_id, tensor_id],
  end,
  ε_is_iso := by apply_instance,
  μ_is_iso := λ X Y,
    -- We could avoid needing to do this explicitly by
    -- constructing a partially applied analogue of `associator_nat_iso`.
  ⟨⟨{ app := λ Z, (α_ Z X Y).inv,
      naturality' := λ Z Z' f, by { dsimp, rw ←associator_inv_naturality, simp, } },
    by tidy⟩⟩,
  ..tensoring_right C }.

variable {C}
variables {M : Type*} [category M] [monoidal_category M] (F : monoidal_functor M (C ⥤ C))

@[simp, reassoc]
lemma μ_hom_inv_app (i j : M) (X : C) :
  (F.μ i j).app X ≫ (F.μ_iso i j).inv.app X = 𝟙 _ := (F.μ_iso i j).hom_inv_id_app X

@[simp, reassoc]
lemma μ_inv_hom_app (i j : M) (X : C) :
   (F.μ_iso i j).inv.app X ≫ (F.μ i j).app X = 𝟙 _ := (F.μ_iso i j).inv_hom_id_app X

@[simp, reassoc]
lemma ε_hom_inv_app (X : C) :
  F.ε.app X ≫ F.ε_iso.inv.app X = 𝟙 _ := F.ε_iso.hom_inv_id_app X

@[simp, reassoc]
lemma ε_inv_hom_app (X : C) :
  F.ε_iso.inv.app X ≫ F.ε.app X = 𝟙 _ := F.ε_iso.inv_hom_id_app X

@[simp, reassoc]
lemma ε_naturality {X Y : C} (f : X ⟶ Y) :
  F.ε.app X ≫ (F.obj (𝟙_M)).map f = f ≫ F.ε.app Y := (F.ε.naturality f).symm

@[simp, reassoc]
lemma ε_inv_naturality {X Y : C} (f : X ⟶ Y) :
  (F.obj (𝟙_M)).map f ≫ F.ε_iso.inv.app Y = F.ε_iso.inv.app X ≫ f :=
F.ε_iso.inv.naturality f

@[simp, reassoc]
lemma μ_naturality {m n : M} {X Y : C} (f : X ⟶ Y) :
  (F.obj n).map ((F.obj m).map f) ≫ (F.μ m n).app Y = (F.μ m n).app X ≫ (F.obj _).map f :=
(F.to_lax_monoidal_functor.μ m n).naturality f

-- This is a simp lemma in the reverse direction via `nat_trans.naturality`.
@[reassoc]
lemma μ_inv_naturality {m n : M} {X Y : C} (f : X ⟶ Y) :
  (F.μ_iso m n).inv.app X ≫ (F.obj n).map ((F.obj m).map f) =
    (F.obj _).map f ≫ (F.μ_iso m n).inv.app Y :=
((F.μ_iso m n).inv.naturality f).symm

-- This is not a simp lemma since it could be proved by the lemmas later.
@[reassoc]
lemma μ_naturality₂ {m n m' n' : M} (f : m ⟶ m') (g : n ⟶ n') (X : C) :
  (F.map g).app ((F.obj m).obj X) ≫ (F.obj n').map ((F.map f).app X) ≫ (F.μ m' n').app X =
    (F.μ m n).app X ≫ (F.map (f ⊗ g)).app X :=
begin
  have := congr_app (F.to_lax_monoidal_functor.μ_natural f g) X,
  dsimp at this,
  simpa using this,
end

@[simp, reassoc]
lemma μ_naturalityₗ {m n m' : M} (f : m ⟶ m') (X : C) :
  (F.obj n).map ((F.map f).app X) ≫ (F.μ m' n).app X =
    (F.μ m n).app X ≫ (F.map (f ⊗ 𝟙 n)).app X :=
begin
  rw ← μ_naturality₂ F f (𝟙 n) X,
  simp,
end

@[simp, reassoc]
lemma μ_naturalityᵣ {m n n' : M} (g : n ⟶ n') (X : C) :
  (F.map g).app ((F.obj m).obj X) ≫ (F.μ m n').app X =
    (F.μ m n).app X ≫ (F.map (𝟙 m ⊗ g)).app X :=
begin
  rw ← μ_naturality₂ F (𝟙 m) g X,
  simp,
end

@[simp, reassoc]
lemma μ_inv_naturalityₗ {m n m' : M} (f : m ⟶ m') (X : C) :
  (F.μ_iso m n).inv.app X ≫ (F.obj n).map ((F.map f).app X) =
    (F.map (f ⊗ 𝟙 n)).app X ≫ (F.μ_iso m' n).inv.app X :=
begin
  rw [← is_iso.comp_inv_eq, category.assoc, ← is_iso.eq_inv_comp],
  simp,
end

@[simp, reassoc]
lemma μ_inv_naturalityᵣ {m n n' : M} (g : n ⟶ n') (X : C) :
  (F.μ_iso m n).inv.app X ≫ (F.map g).app ((F.obj m).obj X) =
    (F.map (𝟙 m ⊗ g)).app X ≫ (F.μ_iso m n').inv.app X :=
begin
  rw [← is_iso.comp_inv_eq, category.assoc, ← is_iso.eq_inv_comp],
  simp,
end

@[reassoc]
lemma left_unitality_app (n : M) (X : C) :
  (F.obj n).map (F.ε.app X) ≫ (F.μ (𝟙_M) n).app X
    ≫ (F.map (λ_ n).hom).app X = 𝟙 _ :=
begin
  have := congr_app (F.to_lax_monoidal_functor.left_unitality n) X,
  dsimp at this,
  simpa using this.symm,
end

@[reassoc, simp]
lemma obj_ε_app (n : M) (X : C) :
  (F.obj n).map (F.ε.app X) =
    (F.map (λ_ n).inv).app X ≫ (F.μ_iso (𝟙_M) n).inv.app X :=
begin
  refine eq.trans _ (category.id_comp _),
  rw [← category.assoc, ← is_iso.comp_inv_eq, ← is_iso.comp_inv_eq, category.assoc],
  convert left_unitality_app F n X,
  { simp },
  { ext, simpa }
end

@[reassoc, simp]

@[reassoc]
lemma right_unitality_app (n : M) (X : C) :
  F.ε.app ((F.obj n).obj X) ≫ (F.μ n (𝟙_M)).app X ≫ (F.map (ρ_ n).hom).app X = 𝟙 _ :=
begin
  have := congr_app (F.to_lax_monoidal_functor.right_unitality n) X,
  dsimp at this,
  simpa using this.symm,
end

@[simp]
lemma ε_app_obj (n : M) (X : C) :
  F.ε.app ((F.obj n).obj X) =
    (F.map (ρ_ n).inv).app X ≫ (F.μ_iso n (𝟙_M)).inv.app X :=
begin
  refine eq.trans _ (category.id_comp _),
  rw [← category.assoc, ← is_iso.comp_inv_eq, ← is_iso.comp_inv_eq, category.assoc],
  convert right_unitality_app F n X,
  { simp },
  { ext, simpa }
end

@[simp]
lemma ε_inv_app_obj (n : M) (X : C) :
  F.ε_iso.inv.app ((F.obj n).obj X) =
    (F.μ n (𝟙_M)).app X ≫ (F.map (ρ_ n).hom).app X :=
begin
  rw [← cancel_mono (F.ε.app ((F.obj n).obj X)), ε_inv_hom_app],
  simpa
end

@[reassoc]
lemma associativity_app (m₁ m₂ m₃: M) (X : C) :
  (F.obj m₃).map ((F.μ m₁ m₂).app X) ≫ (F.μ (m₁ ⊗ m₂) m₃).app X ≫
    (F.map (α_ m₁ m₂ m₃).hom).app X =
  (F.μ m₂ m₃).app ((F.obj m₁).obj X) ≫ (F.μ m₁ (m₂ ⊗ m₃)).app X :=
begin
  have := congr_app (F.to_lax_monoidal_functor.associativity m₁ m₂ m₃) X,
  dsimp at this,
  simpa using this,
end

@[reassoc, simp]
lemma obj_μ_app (m₁ m₂ m₃ : M) (X : C) :
  (F.obj m₃).map ((F.μ m₁ m₂).app X) =
  (F.μ m₂ m₃).app ((F.obj m₁).obj X) ≫ (F.μ m₁ (m₂ ⊗ m₃)).app X ≫
    (F.map (α_ m₁ m₂ m₃).inv).app X ≫ (F.μ_iso (m₁ ⊗ m₂) m₃).inv.app X :=
begin
  rw [← associativity_app_assoc],
  dsimp,
  simp,
  dsimp,
  simp,
end

@[reassoc, simp]
lemma obj_μ_inv_app (m₁ m₂ m₃ : M) (X : C) :
  (F.obj m₃).map ((F.μ_iso m₁ m₂).inv.app X) =
  (F.μ (m₁ ⊗ m₂) m₃).app X ≫ (F.map (α_ m₁ m₂ m₃).hom).app X ≫
  (F.μ_iso m₁ (m₂ ⊗ m₃)).inv.app X ≫
  (F.μ_iso m₂ m₃).inv.app ((F.obj m₁).obj X) :=
begin
  rw ← is_iso.inv_eq_inv,
  convert obj_μ_app F m₁ m₂ m₃ X using 1,
  { ext, rw ← functor.map_comp, simp },
  { simp only [monoidal_functor.μ_iso_hom, category.assoc, nat_iso.inv_inv_app, is_iso.inv_comp],
    congr,
    { ext, simp },
    { ext, simpa } }
end

@[simp, reassoc]
lemma obj_zero_map_μ_app {m : M} {X Y : C} (f : X ⟶ (F.obj m).obj Y) :
  (F.obj (𝟙_M)).map f ≫ (F.μ m (𝟙_M)).app _ =
    F.ε_iso.inv.app _ ≫ f ≫ (F.map (ρ_ m).inv).app _ :=
begin
  rw [← is_iso.inv_comp_eq, ← is_iso.comp_inv_eq],
  simp,
end

@[simp]
lemma obj_μ_zero_app (m₁ m₂ : M) (X : C) :
  (F.obj m₂).map ((F.μ m₁ (𝟙_M)).app X) =
  (F.μ (𝟙_M) m₂).app ((F.obj m₁).obj X) ≫ (F.map (λ_ m₂).hom).app ((F.obj m₁).obj X) ≫
    (F.obj m₂).map ((F.map (ρ_ m₁).inv).app X) :=
begin
  rw [← obj_ε_inv_app_assoc, ← functor.map_comp],
  congr, simp,
end

/-- If `m ⊗ n ≅ 𝟙_M`, then `F.obj m` is a left inverse of `F.obj n`. -/
@[simps] noncomputable
def unit_of_tensor_iso_unit (m n : M) (h : m ⊗ n ≅ 𝟙_M) : F.obj m ⋙ F.obj n ≅ 𝟭 C :=
F.μ_iso m n ≪≫ F.to_functor.map_iso h ≪≫ F.ε_iso.symm

/-- If `m ⊗ n ≅ 𝟙_M` and `n ⊗ m ≅ 𝟙_M` (subject to some commuting constraints),
  then `F.obj m` and `F.obj n` forms a self-equivalence of `C`. -/
@[simps] noncomputable
def equiv_of_tensor_iso_unit (m n : M) (h₁ : m ⊗ n ≅ 𝟙_M) (h₂ : n ⊗ m ≅ 𝟙_M)
  (H : (h₁.hom ⊗ 𝟙 m) ≫ (λ_ m).hom = (α_ m n m).hom ≫ (𝟙 m ⊗ h₂.hom) ≫ (ρ_ m).hom) : C ≌ C :=
{ functor := F.obj m,
  inverse := F.obj n,
  unit_iso := (unit_of_tensor_iso_unit F m n h₁).symm,
  counit_iso := unit_of_tensor_iso_unit F n m h₂,
  functor_unit_iso_comp' :=
  begin
    intro X,
    dsimp,
    simp only [μ_naturalityᵣ_assoc, μ_naturalityₗ_assoc, ε_inv_app_obj, category.assoc,
      obj_μ_inv_app, functor.map_comp, μ_inv_hom_app_assoc, obj_ε_app,
      unit_of_tensor_iso_unit_inv_app],
    simp [← nat_trans.comp_app, ← F.to_functor.map_comp, ← H, - functor.map_comp]
  end }

end category_theory


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.comma

/-!
# The category of arrows

The category of arrows, with morphisms commutative squares.
We set this up as a specialization of the comma category `comma L R`,
where `L` and `R` are both the identity functor.

We also define the typeclass `has_lift`, representing a choice of a lift
of a commutative square (that is, a diagonal morphism making the two triangles commute).

## Tags

comma, arrow
-/

namespace category_theory

universes v u -- morphism levels before object levels. See note [category_theory universes].
variables {T : Type u} [category.{v} T]

section
variables (T)

/-- The arrow category of `T` has as objects all morphisms in `T` and as morphisms commutative
     squares in `T`. -/
@[derive category]
def arrow := comma.{v v v} (𝟭 T) (𝟭 T)

-- Satisfying the inhabited linter
instance arrow.inhabited [inhabited T] : inhabited (arrow T) :=
{ default := show comma (𝟭 T) (𝟭 T), from default }

end

namespace arrow

@[simp] lemma id_left (f : arrow T) : comma_morphism.left (𝟙 f) = 𝟙 (f.left) := rfl
@[simp] lemma id_right (f : arrow T) : comma_morphism.right (𝟙 f) = 𝟙 (f.right) := rfl

/-- An object in the arrow category is simply a morphism in `T`. -/
@[simps]
def mk {X Y : T} (f : X ⟶ Y) : arrow T :=
{ left := X,
  right := Y,
  hom := f }

theorem mk_injective (A B : T) :
  function.injective (arrow.mk : (A ⟶ B) → arrow T) :=
λ f g h, by { cases h, refl }

theorem mk_inj (A B : T) {f g : A ⟶ B} : arrow.mk f = arrow.mk g ↔ f = g :=
(mk_injective A B).eq_iff
instance {X Y : T} : has_coe (X ⟶ Y) (arrow T) := ⟨mk⟩

/-- A morphism in the arrow category is a commutative square connecting two objects of the arrow
    category. -/
@[simps]
def hom_mk {f g : arrow T} {u : f.left ⟶ g.left} {v : f.right ⟶ g.right}
  (w : u ≫ g.hom = f.hom ≫ v) : f ⟶ g :=
{ left := u,
  right := v,
  w' := w }

/-- We can also build a morphism in the arrow category out of any commutative square in `T`. -/
@[simps]
def hom_mk' {X Y : T} {f : X ⟶ Y} {P Q : T} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q}
  (w : u ≫ g = f ≫ v) : arrow.mk f ⟶ arrow.mk g :=
{ left := u,
  right := v,
  w' := w }

@[simp, reassoc] lemma w {f g : arrow T} (sq : f ⟶ g) : sq.left ≫ g.hom = f.hom ≫ sq.right := sq.w

-- `w_mk_left` is not needed, as it is a consequence of `w` and `mk_hom`.
@[simp, reassoc] lemma w_mk_right {f : arrow T} {X Y : T} {g : X ⟶ Y} (sq : f ⟶ mk g) :
  sq.left ≫ g = f.hom ≫ sq.right :=
sq.w

lemma is_iso_of_iso_left_of_is_iso_right
  {f g : arrow T} (ff : f ⟶ g) [is_iso ff.left] [is_iso ff.right] : is_iso ff :=
{ out := ⟨⟨inv ff.left, inv ff.right⟩,
          by { ext; dsimp; simp only [is_iso.hom_inv_id] },
          by { ext; dsimp; simp only [is_iso.inv_hom_id] }⟩ }

/-- Create an isomorphism between arrows,
by providing isomorphisms between the domains and codomains,
and a proof that the square commutes. -/
@[simps] def iso_mk {f g : arrow T}
  (l : f.left ≅ g.left) (r : f.right ≅ g.right) (h : l.hom ≫ g.hom = f.hom ≫ r.hom) :
  f ≅ g :=
comma.iso_mk l r h

section

variables {f g : arrow T} (sq : f ⟶ g)

instance is_iso_left [is_iso sq] : is_iso sq.left :=
{ out := ⟨(inv sq).left, by simp only [← comma.comp_left, is_iso.hom_inv_id, is_iso.inv_hom_id,
    arrow.id_left, eq_self_iff_true, and_self]⟩ }

instance is_iso_right [is_iso sq] : is_iso sq.right :=
{ out := ⟨(inv sq).right, by simp only [← comma.comp_right, is_iso.hom_inv_id, is_iso.inv_hom_id,
    arrow.id_right, eq_self_iff_true, and_self]⟩ }

@[simp] lemma inv_left [is_iso sq] : (inv sq).left = inv sq.left :=
is_iso.eq_inv_of_hom_inv_id $ by rw [← comma.comp_left, is_iso.hom_inv_id, id_left]

@[simp] lemma inv_right [is_iso sq] : (inv sq).right = inv sq.right :=
is_iso.eq_inv_of_hom_inv_id $ by rw [← comma.comp_right, is_iso.hom_inv_id, id_right]

@[simp] lemma left_hom_inv_right [is_iso sq] : sq.left ≫ g.hom ≫ inv sq.right = f.hom :=
by simp only [← category.assoc, is_iso.comp_inv_eq, w]

-- simp proves this
lemma inv_left_hom_right [is_iso sq] : inv sq.left ≫ f.hom ≫ sq.right = g.hom :=
by simp only [w, is_iso.inv_comp_eq]

instance mono_left [mono sq] : mono sq.left :=
{ right_cancellation := λ Z φ ψ h, begin
    let aux : (Z ⟶ f.left) → (arrow.mk (𝟙 Z) ⟶ f) := λ φ, { left := φ, right := φ ≫ f.hom },
    show (aux φ).left = (aux ψ).left,
    congr' 1,
    rw ← cancel_mono sq,
    ext,
    { exact h },
    { simp only [comma.comp_right, category.assoc, ← arrow.w],
      simp only [← category.assoc, h], },
  end }

instance epi_right [epi sq] : epi sq.right :=
{ left_cancellation := λ Z φ ψ h, begin
    let aux : (g.right ⟶ Z) → (g ⟶ arrow.mk (𝟙 Z)) := λ φ, { right := φ, left := g.hom ≫ φ },
    show (aux φ).right = (aux ψ).right,
    congr' 1,
    rw ← cancel_epi sq,
    ext,
    { simp only [comma.comp_left, category.assoc, arrow.w_assoc, h], },
    { exact h },
  end }

end

/-- Given a square from an arrow `i` to an isomorphism `p`, express the source part of `sq`
in terms of the inverse of `p`. -/
@[simp] lemma square_to_iso_invert (i : arrow T) {X Y : T} (p : X ≅ Y) (sq : i ⟶ arrow.mk p.hom) :
  i.hom ≫ sq.right ≫ p.inv = sq.left :=
by simpa only [category.assoc] using (iso.comp_inv_eq p).mpr ((arrow.w_mk_right sq).symm)

/-- Given a square from an isomorphism `i` to an arrow `p`, express the target part of `sq`
in terms of the inverse of `i`. -/
lemma square_from_iso_invert {X Y : T} (i : X ≅ Y) (p : arrow T) (sq : arrow.mk i.hom ⟶ p) :
  i.inv ≫ sq.left ≫ p.hom = sq.right :=
by simp only [iso.inv_hom_id_assoc, arrow.w, arrow.mk_hom]

/-- A lift of a commutative square is a diagonal morphism making the two triangles commute. -/
@[ext] structure lift_struct {f g : arrow T} (sq : f ⟶ g) :=
(lift : f.right ⟶ g.left)
(fac_left' : f.hom ≫ lift = sq.left . obviously)
(fac_right' : lift ≫ g.hom = sq.right . obviously)

restate_axiom lift_struct.fac_left'
restate_axiom lift_struct.fac_right'

instance lift_struct_inhabited {X : T} : inhabited (lift_struct (𝟙 (arrow.mk (𝟙 X)))) :=
⟨⟨𝟙 _, category.id_comp _, category.comp_id _⟩⟩

/-- `has_lift sq` says that there is some `lift_struct sq`, i.e., that it is possible to find a
    diagonal morphism making the two triangles commute. -/
class has_lift {f g : arrow T} (sq : f ⟶ g) : Prop :=
mk' :: (exists_lift : nonempty (lift_struct sq))

lemma has_lift.mk {f g : arrow T} {sq : f ⟶ g} (s : lift_struct sq) : has_lift sq :=
⟨nonempty.intro s⟩

attribute [simp, reassoc] lift_struct.fac_left lift_struct.fac_right

/-- Given `has_lift sq`, obtain a lift. -/
noncomputable def has_lift.struct {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : lift_struct sq :=
classical.choice has_lift.exists_lift

/-- If there is a lift of a commutative square `sq`, we can access it by saying `lift sq`. -/
noncomputable abbreviation lift {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : f.right ⟶ g.left :=
(has_lift.struct sq).lift

lemma lift.fac_left {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : f.hom ≫ lift sq = sq.left :=
by simp

lemma lift.fac_right {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : lift sq ≫ g.hom = sq.right :=
by simp

@[simp, reassoc]
lemma lift.fac_right_of_to_mk {X Y : T} {f : arrow T} {g : X ⟶ Y} (sq : f ⟶ mk g) [has_lift sq] :
  lift sq ≫ g = sq.right :=
by simp only [←mk_hom g, lift.fac_right]

@[simp, reassoc]
lemma lift.fac_left_of_from_mk {X Y : T} {f : X ⟶ Y} {g : arrow T} (sq : mk f ⟶ g) [has_lift sq] :
  f ≫ lift sq = sq.left :=
by simp only [←mk_hom f, lift.fac_left]

@[simp, reassoc]
lemma lift_mk'_left {X Y P Q : T} {f : X ⟶ Y} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q}
  (h : u ≫ g = f ≫ v) [has_lift $ arrow.hom_mk' h] : f ≫ lift (arrow.hom_mk' h) = u :=
by simp only [←arrow.mk_hom f, lift.fac_left, arrow.hom_mk'_left]

@[simp, reassoc]
lemma lift_mk'_right {X Y P Q : T} {f : X ⟶ Y} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q}
  (h : u ≫ g = f ≫ v) [has_lift $ arrow.hom_mk' h] : lift (arrow.hom_mk' h) ≫ g = v :=
by simp only [←arrow.mk_hom g, lift.fac_right, arrow.hom_mk'_right]

section

instance subsingleton_lift_struct_of_epi {f g : arrow T} (sq : f ⟶ g) [epi f.hom] :
  subsingleton (lift_struct sq) :=
subsingleton.intro $ λ a b, lift_struct.ext a b $ (cancel_epi f.hom).1 $ by simp

instance subsingleton_lift_struct_of_mono {f g : arrow T} (sq : f ⟶ g) [mono g.hom] :
  subsingleton (lift_struct sq) :=
subsingleton.intro $ λ a b, lift_struct.ext a b $ (cancel_mono g.hom).1 $ by simp

end

variables {C : Type u} [category.{v} C]
/-- A helper construction: given a square between `i` and `f ≫ g`, produce a square between
`i` and `g`, whose top leg uses `f`:
A  → X
     ↓f
↓i   Y             --> A → Y
     ↓g                ↓i  ↓g
B  → Z                 B → Z
 -/
@[simps] def square_to_snd {X Y Z: C} {i : arrow C} {f : X ⟶ Y} {g : Y ⟶ Z}
  (sq : i ⟶ arrow.mk (f ≫ g)) :
  i ⟶ arrow.mk g :=
{ left := sq.left ≫ f,
  right := sq.right }

/-- The functor sending an arrow to its source. -/
@[simps] def left_func : arrow C ⥤ C := comma.fst _ _

/-- The functor sending an arrow to its target. -/
@[simps] def right_func : arrow C ⥤ C := comma.snd _ _

/-- The natural transformation from `left_func` to `right_func`, given by the arrow itself. -/
@[simps]
def left_to_right : (left_func : arrow C ⥤ C) ⟶ right_func :=
{ app := λ f, f.hom }

end arrow

namespace functor

universes v₁ v₂ u₁ u₂

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

/-- A functor `C ⥤ D` induces a functor between the corresponding arrow categories. -/
@[simps]
def map_arrow (F : C ⥤ D) : arrow C ⥤ arrow D :=
{ obj := λ a,
  { left := F.obj a.left,
    right := F.obj a.right,
    hom := F.map a.hom, },
  map := λ a b f,
  { left := F.map f.left,
    right := F.map f.right,
    w' := by { have w := f.w, simp only [id_map] at w, dsimp, simp only [←F.map_comp, w], } } }

end functor

end category_theory


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

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Independence of sets of sets and measure spaces (σ-algebras)

* A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if for
  any finite set of indices `s = {i_1, ..., i_n}`, for any sets `f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`,
  `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. It will be used for families of π-systems.
* A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
  measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
  define is independent. I.e., `m : ι → measurable_space α` is independent with respect to a
  measure `μ` if for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
  `f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i)`.
* Independence of sets (or events in probabilistic parlance) is defined as independence of the
  measurable space structures they generate: a set `s` generates the measurable space structure with
  measurable sets `∅, s, sᶜ, univ`.
* Independence of functions (or random variables) is also defined as independence of the measurable
  space structures they generate: a function `f` for which we have a measurable space `m` on the
  codomain generates `measurable_space.comap f m`.

## Main statements

* TODO: `Indep_of_Indep_sets`: if π-systems are independent as sets of sets, then the
measurable space structures they generate are independent.
* `indep_of_indep_sets`: variant with two π-systems.

## Implementation notes

We provide one main definition of independence:
* `Indep_sets`: independence of a family of sets of sets `pi : ι → set (set α)`.
Three other independence notions are defined using `Indep_sets`:
* `Indep`: independence of a family of measurable space structures `m : ι → measurable_space α`,
* `Indep_set`: independence of a family of sets `s : ι → set α`,
* `Indep_fun`: independence of a family of functions. For measurable spaces
  `m : Π (i : ι), measurable_space (β i)`, we consider functions `f : Π (i : ι), α → β i`.

Additionally, we provide four corresponding statements for two measurable space structures (resp.
sets of sets, sets, functions) instead of a family. These properties are denoted by the same names
as for a family, but without a capital letter, for example `indep_fun` is the version of `Indep_fun`
for two functions.

The definition of independence for `Indep_sets` uses finite sets (`finset`). An alternative and
equivalent way of defining independence would have been to use countable sets.
TODO: prove that equivalence.

Most of the definitions and lemma in this file list all variables instead of using the `variables`
keyword at the beginning of a section, for example
`lemma indep.symm {α} {m₁ m₂ : measurable_space α} [measurable_space α] {μ : measure α} ...` .
This is intentional, to be able to control the order of the `measurable_space` variables. Indeed
when defining `μ` in the example above, the measurable space used is the last one defined, here
`[measurable_space α]`, and not `m₁` or `m₂`.

## References

* Williams, David. Probability with martingales. Cambridge university press, 1991.
Part A, Chapter 4.
-/

namespace probability_theory

/-- A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if
for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
`f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `.
It will be used for families of pi_systems. -/
def Indep_sets {α : Type u_1} {ι : Type u_2} [measurable_space α] (π : ι → set (set α)) (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  ∀ (s : finset ι) {f : ι → set α} (H : ∀ (i : ι), i ∈ s → f i ∈ π i),
    coe_fn μ (set.Inter fun (i : ι) => set.Inter fun (H : i ∈ s) => f i) = finset.prod s fun (i : ι) => coe_fn μ (f i)

/-- Two sets of sets `s₁, s₂` are independent with respect to a measure `μ` if for any sets
`t₁ ∈ p₁, t₂ ∈ s₂`, then `μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
def indep_sets {α : Type u_1} [measurable_space α] (s1 : set (set α)) (s2 : set (set α)) (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  ∀ (t1 t2 : set α), t1 ∈ s1 → t2 ∈ s2 → coe_fn μ (t1 ∩ t2) = coe_fn μ t1 * coe_fn μ t2

/-- A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
define is independent. `m : ι → measurable_space α` is independent with respect to measure `μ` if
for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
`f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. -/
def Indep {α : Type u_1} {ι : Type u_2} (m : ι → measurable_space α) [measurable_space α] (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  Indep_sets fun (x : ι) => measurable_space.is_measurable' (m x)

/-- Two measurable space structures (or σ-algebras) `m₁, m₂` are independent with respect to a
measure `μ` (defined on a third σ-algebra) if for any sets `t₁ ∈ m₁, t₂ ∈ m₂`,
`μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
def indep {α : Type u_1} (m₁ : measurable_space α) (m₂ : measurable_space α) [measurable_space α] (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  indep_sets (measurable_space.is_measurable' m₁) (measurable_space.is_measurable' m₂)

/-- A family of sets is independent if the family of measurable space structures they generate is
independent. For a set `s`, the generated measurable space has measurable sets `∅, s, sᶜ, univ`. -/
def Indep_set {α : Type u_1} {ι : Type u_2} [measurable_space α] (s : ι → set α) (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  Indep fun (i : ι) => measurable_space.generate_from (singleton (s i))

/-- Two sets are independent if the two measurable space structures they generate are independent.
For a set `s`, the generated measurable space structure has measurable sets `∅, s, sᶜ, univ`. -/
def indep_set {α : Type u_1} [measurable_space α] {s : set α} {t : set α} (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  indep (measurable_space.generate_from (singleton s)) (measurable_space.generate_from (singleton t))

/-- A family of functions defined on the same space `α` and taking values in possibly different
spaces, each with a measurable space structure, is independent if the family of measurable space
structures they generate on `α` is independent. For a function `g` with codomain having measurable
space structure `m`, the generated measurable space structure is `measurable_space.comap g m`. -/
def Indep_fun {α : Type u_1} {ι : Type u_2} [measurable_space α] {β : ι → Type u_3} (m : (x : ι) → measurable_space (β x)) (f : (x : ι) → α → β x) (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  Indep fun (x : ι) => measurable_space.comap (f x) (m x)

/-- Two functions are independent if the two measurable space structures they generate are
independent. For a function `f` with codomain having measurable space structure `m`, the generated
measurable space structure is `measurable_space.comap f m`. -/
def indep_fun {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] (mβ : measurable_space β) (mγ : measurable_space γ) {f : α → β} {g : α → γ} (μ : autoParam (measure_theory.measure α)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.measure_theory.volume_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "measure_theory") "volume_tac")
    [])) :=
  indep (measurable_space.comap f mβ) (measurable_space.comap g mγ)

theorem indep_sets.symm {α : Type u_1} {s₁ : set (set α)} {s₂ : set (set α)} [measurable_space α] {μ : measure_theory.measure α} (h : indep_sets s₁ s₂) : indep_sets s₂ s₁ := sorry

theorem indep.symm {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} [measurable_space α] {μ : measure_theory.measure α} (h : indep m₁ m₂) : indep m₂ m₁ :=
  indep_sets.symm h

theorem indep_sets_of_indep_sets_of_le_left {α : Type u_1} {s₁ : set (set α)} {s₂ : set (set α)} {s₃ : set (set α)} [measurable_space α] {μ : measure_theory.measure α} (h_indep : indep_sets s₁ s₂) (h31 : s₃ ⊆ s₁) : indep_sets s₃ s₂ :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ s₃) (ht2 : t2 ∈ s₂) => h_indep t1 t2 (set.mem_of_subset_of_mem h31 ht1) ht2

theorem indep_sets_of_indep_sets_of_le_right {α : Type u_1} {s₁ : set (set α)} {s₂ : set (set α)} {s₃ : set (set α)} [measurable_space α] {μ : measure_theory.measure α} (h_indep : indep_sets s₁ s₂) (h32 : s₃ ⊆ s₂) : indep_sets s₁ s₃ :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ s₁) (ht2 : t2 ∈ s₃) => h_indep t1 t2 ht1 (set.mem_of_subset_of_mem h32 ht2)

theorem indep_of_indep_of_le_left {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} {m₃ : measurable_space α} [measurable_space α] {μ : measure_theory.measure α} (h_indep : indep m₁ m₂) (h31 : m₃ ≤ m₁) : indep m₃ m₂ :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ measurable_space.is_measurable' m₃) (ht2 : t2 ∈ measurable_space.is_measurable' m₂) =>
    h_indep t1 t2 (h31 t1 ht1) ht2

theorem indep_of_indep_of_le_right {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} {m₃ : measurable_space α} [measurable_space α] {μ : measure_theory.measure α} (h_indep : indep m₁ m₂) (h32 : m₃ ≤ m₂) : indep m₁ m₃ :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ measurable_space.is_measurable' m₁) (ht2 : t2 ∈ measurable_space.is_measurable' m₃) =>
    h_indep t1 t2 ht1 (h32 t2 ht2)

theorem indep_sets.union {α : Type u_1} [measurable_space α] {s₁ : set (set α)} {s₂ : set (set α)} {s' : set (set α)} {μ : measure_theory.measure α} (h₁ : indep_sets s₁ s') (h₂ : indep_sets s₂ s') : indep_sets (s₁ ∪ s₂) s' := sorry

@[simp] theorem indep_sets.union_iff {α : Type u_1} [measurable_space α] {s₁ : set (set α)} {s₂ : set (set α)} {s' : set (set α)} {μ : measure_theory.measure α} : indep_sets (s₁ ∪ s₂) s' ↔ indep_sets s₁ s' ∧ indep_sets s₂ s' := sorry

theorem indep_sets.Union {α : Type u_1} {ι : Sort u_2} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)} {μ : measure_theory.measure α} (hyp : ∀ (n : ι), indep_sets (s n) s') : indep_sets (set.Union fun (n : ι) => s n) s' := sorry

theorem indep_sets.inter {α : Type u_1} [measurable_space α] {s₁ : set (set α)} {s' : set (set α)} (s₂ : set (set α)) {μ : measure_theory.measure α} (h₁ : indep_sets s₁ s') : indep_sets (s₁ ∩ s₂) s' :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ s₁ ∩ s₂) (ht2 : t2 ∈ s') =>
    h₁ t1 t2 (and.left (iff.mp (set.mem_inter_iff t1 s₁ s₂) ht1)) ht2

theorem indep_sets.Inter {α : Type u_1} {ι : Sort u_2} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)} {μ : measure_theory.measure α} (h : ∃ (n : ι), indep_sets (s n) s') : indep_sets (set.Inter fun (n : ι) => s n) s' :=
  id
    fun (t1 t2 : set α) (ht1 : t1 ∈ set.Inter fun (n : ι) => s n) (ht2 : t2 ∈ s') =>
      Exists.dcases_on h fun (n : ι) (h : indep_sets (s n) s') => h t1 t2 (iff.mp set.mem_Inter ht1 n) ht2

/-! ### Deducing `indep` from `Indep` -/

theorem Indep_sets.indep_sets {α : Type u_1} {ι : Type u_2} {s : ι → set (set α)} [measurable_space α] {μ : measure_theory.measure α} (h_indep : Indep_sets s) {i : ι} {j : ι} (hij : i ≠ j) : indep_sets (s i) (s j) := sorry

theorem Indep.indep {α : Type u_1} {ι : Type u_2} {m : ι → measurable_space α} [measurable_space α] {μ : measure_theory.measure α} (h_indep : Indep m) {i : ι} {j : ι} (hij : i ≠ j) : indep (m i) (m j) :=
  id (Indep_sets.indep_sets h_indep hij)

/-!
## π-system lemma

Independence of measurable spaces is equivalent to independence of generating π-systems.
-/

/-! ### Independence of measurable space structures implies independence of generating π-systems -/

theorem Indep.Indep_sets {α : Type u_1} {ι : Type u_2} [measurable_space α] {μ : measure_theory.measure α} {m : ι → measurable_space α} {s : ι → set (set α)} (hms : ∀ (n : ι), m n = measurable_space.generate_from (s n)) (h_indep : Indep m) : Indep_sets s := sorry

theorem indep.indep_sets {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {s1 : set (set α)} {s2 : set (set α)} (h_indep : indep (measurable_space.generate_from s1) (measurable_space.generate_from s2)) : indep_sets s1 s2 :=
  fun (t1 t2 : set α) (ht1 : t1 ∈ s1) (ht2 : t2 ∈ s2) =>
    h_indep t1 t2 (measurable_space.is_measurable_generate_from ht1) (measurable_space.is_measurable_generate_from ht2)

/-! ### Independence of generating π-systems implies independence of measurable space structures -/

theorem indep_sets.indep {α : Type u_1} {m1 : measurable_space α} {m2 : measurable_space α} {m : measurable_space α} {μ : measure_theory.measure α} [measure_theory.probability_measure μ] {p1 : set (set α)} {p2 : set (set α)} (h1 : m1 ≤ m) (h2 : m2 ≤ m) (hp1 : is_pi_system p1) (hp2 : is_pi_system p2) (hpm1 : m1 = measurable_space.generate_from p1) (hpm2 : m2 = measurable_space.generate_from p2) (hyp : indep_sets p1 p2) : indep m1 m2 := sorry


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import topology.separation
import topology.opens

/-!
# The Alexandroff Compactification
We construct the Alexandroff compactification of an arbitrary topological space `X` and prove
some properties inherited from `X`.

## Main defintion
* `alexandroff`: the Alexandroff compactification
* `of`: the inclusion map defined by `option.some`. This map requires the argument
        `topological_space X`
* `infty`: the extra point

## Main results
* The topological structure of `alexandroff X`
* The connectedness of `alexandroff X` for a noncompact, preconnected `X`
* `alexandroff X` is `T₁` for a T₁ space `X`
* `alexandroff X` is Hausdorff if `X` is locally compact and Hausdorff
-/

noncomputable theory
open set
open_locale classical topological_space

section basic

/-- The Alexandroff extension of an arbitrary topological space `X` -/
@[nolint unused_arguments]
def alexandroff (X : Type*) [topological_space X] := option X

variables {X : Type*} [topological_space X]

/-- The embedding of `X` to its Alexandroff extension -/
def of : X → alexandroff X := some

/-- The range of the embedding -/
def range_of (X : Type*) [topological_space X] : set (alexandroff X) := of '' (univ : set X)

lemma of_apply {x : X} : of x = some x := rfl

lemma of_injective : function.injective (@of X _) :=
option.some_injective X

/-- The point at infinity -/
def infty : alexandroff X := none
localized "notation `∞` := infty" in alexandroff

namespace alexandroff

instance : has_coe_t X (alexandroff X) := ⟨of⟩

instance : inhabited(alexandroff X) := ⟨∞⟩

@[norm_cast]
lemma coe_eq_coe {x y : X} : (x : alexandroff X) = y ↔ x = y :=
of_injective.eq_iff

@[simp] lemma coe_ne_infty (x : X) : (x : alexandroff X) ≠ ∞  .
@[simp] lemma infty_ne_coe (x : X) : ∞ ≠ (x : alexandroff X) .
@[simp] lemma of_eq_coe {x : X} : (of x : alexandroff X) = x := rfl

/-- Recursor for `alexandroff` using the preferred forms `∞` and `↑x`. -/
@[elab_as_eliminator]
def rec_infty_coe (C : alexandroff X → Sort*) (h₁ : C infty) (h₂ : Π (x : X), C x) :
  Π (z : alexandroff X), C z :=
option.rec h₁ h₂

lemma ne_infty_iff_exists {x : alexandroff X} :
  x ≠ ∞ ↔ ∃ (y : X), x = y :=
by { induction x using alexandroff.rec_infty_coe; simp }

@[simp] lemma coe_mem_range_of (x : X) : (x : alexandroff X) ∈ (range_of X) :=
by simp [range_of]

lemma union_infty_eq_univ : (range_of X ∪ {∞}) = univ :=
begin
  refine le_antisymm (subset_univ _) (λ x hx, _),
  induction x using alexandroff.rec_infty_coe; simp
end

@[simp] lemma infty_not_mem_range_of : ∞ ∉ range_of X :=
by simp [range_of]

@[simp] lemma not_mem_range_of_iff (x : alexandroff X) :
  x ∉ range_of X ↔ x = ∞ :=
by { induction x using alexandroff.rec_infty_coe; simp [infty_not_mem_range_of] }

attribute [nolint simp_nf] not_mem_range_of_iff

lemma infty_not_mem_image_of {s : set X} : ∞ ∉ of '' s :=
not_mem_subset (image_subset _ $ subset_univ _) infty_not_mem_range_of

lemma inter_infty_eq_empty : (range_of X) ∩ {∞} = ∅ :=
by { ext x, induction x using alexandroff.rec_infty_coe; simp }

lemma of_preimage_infty : (of⁻¹' {∞} : set X) = ∅ :=
by { ext, simp }

end alexandroff

end basic

open alexandroff
open_locale alexandroff

section topology

variables {X : Type*} [topological_space X]

instance : topological_space (alexandroff X) :=
{ is_open := λ s, if ∞ ∈ s then is_compact (of⁻¹' s)ᶜ ∧ is_open (of⁻¹' s)
    else is_open (of⁻¹' s),
  is_open_univ := by simp,
  is_open_inter :=
  λ s t hs ht, begin
    split_ifs at hs ht with h h' h' h' h,
    { simpa [h, h', compl_inter] using and.intro (hs.1.union ht.1) (hs.2.inter ht.2) },
    { simpa [h, h'] using hs.inter ht.2 },
    { simpa [h, h'] using hs.2.inter ht },
    { simpa [h, h'] using hs.inter ht }
  end,
  is_open_sUnion :=
  λ S ht, begin
    suffices : is_open (of⁻¹' ⋃₀S),
    { split_ifs with h,
      { obtain ⟨(a : set (alexandroff X)), ha, ha'⟩ := mem_sUnion.mp h,
        specialize ht a ha,
        rw if_pos ha' at ht,
        refine ⟨compact_of_is_closed_subset ht.left this.is_closed_compl _, this⟩,
        rw [compl_subset_compl, preimage_subset_iff],
        intros y hy,
        refine ⟨a, ha, hy⟩ },
      { exact this } },
     rw is_open_iff_forall_mem_open,
     simp only [and_imp, exists_prop, mem_Union, preimage_sUnion, mem_preimage, of_eq_coe,
                exists_imp_distrib],
     intros y s hs hy,
     refine ⟨of ⁻¹' s, subset_subset_Union _ (subset_subset_Union hs (subset.refl _)), _,
        mem_preimage.mpr hy⟩,
     specialize ht s hs,
     split_ifs at ht,
     { exact ht.right },
     { exact ht }
  end }

variables {s : set (alexandroff X)} {s' : set X}

lemma is_open_alexandroff_iff_aux :
  is_open s ↔ if ∞ ∈ s then is_compact (of⁻¹' s)ᶜ ∧ is_open (of⁻¹' s)
  else is_open (of⁻¹' s) :=
iff.rfl

lemma is_open_iff_of_mem' (h : ∞ ∈ s) :
  is_open s ↔ is_compact (of⁻¹' s)ᶜ ∧ is_open (of⁻¹' s) :=
by simp [is_open_alexandroff_iff_aux, h]

lemma is_open_iff_of_mem (h : ∞ ∈ s) :
  is_open s ↔ is_compact (of⁻¹' s)ᶜ ∧ is_closed (of⁻¹' s)ᶜ :=
by simp [is_open_alexandroff_iff_aux, h, is_closed_compl_iff]

lemma is_open_iff_of_not_mem (h : ∞ ∉ s) :
  is_open s ↔ is_open (of⁻¹' s) :=
by simp [is_open_alexandroff_iff_aux, h]

lemma is_open_of_is_open (h : is_open s) :
  is_open (of⁻¹' s) :=
begin
  by_cases H : ∞ ∈ s,
  { simpa using ((is_open_iff_of_mem H).mp h).2 },
  { exact (is_open_iff_of_not_mem H).mp h }
end

end topology

section topological_prop

variables {X : Type*} [topological_space X]

@[continuity] lemma continuous_of : continuous (@of X _) :=
continuous_def.mpr (λ s hs, is_open_of_is_open hs)

/-- An open set in `alexandroff X` constructed from a closed compact set in `X` -/
def opens_of_compl {s : set X} (h : is_compact s ∧ is_closed s) :
  topological_space.opens (alexandroff X) :=
⟨(of '' s)ᶜ, by { rw [is_open_iff_of_mem ((mem_compl_iff _ _).mpr infty_not_mem_image_of),
  preimage_compl, compl_compl, of_injective.preimage_image _], exact h }⟩

lemma infty_mem_opens_of_compl {s : set X} (h : is_compact s ∧ is_closed s) :
  ∞ ∈ (opens_of_compl h) :=
by { simp only [opens_of_compl, topological_space.opens.coe_mk],
     exact mem_compl infty_not_mem_image_of }

lemma is_open_map_of : is_open_map (@of X _) :=
λ s hs, begin
  rw [← preimage_image_eq s of_injective] at hs,
  rwa is_open_iff_of_not_mem infty_not_mem_image_of
end

lemma is_open_range_of : is_open (@range_of X _) :=
is_open_map_of _ is_open_univ

instance : compact_space (alexandroff X) :=
{ compact_univ :=
  begin
    refine is_compact_of_finite_subcover (λ ι Z h H, _),
    simp only [univ_subset_iff] at H ⊢,
    rcases Union_eq_univ_iff.mp H ∞ with ⟨K, hK⟩,
    have minor₁ : is_compact (of⁻¹' Z K)ᶜ,
    { specialize h K, rw is_open_iff_of_mem hK at h, exact h.1 },
    let p : ι → set X := λ i, of⁻¹' Z i,
    have minor₂ : ∀ i, is_open (p i) := λ i, is_open_of_is_open (h i),
    have minor₃ : (of⁻¹' Z K)ᶜ ⊆ ⋃ i, p i :=
      by simp only [p, ← preimage_Union, H, preimage_univ, subset_univ],
    rcases is_compact_iff_finite_subcover.mp minor₁ p minor₂ minor₃ with ⟨ι', H'⟩,
    refine ⟨insert K ι', _⟩,
    rw ← preimage_compl at H',
    simp only [Union_eq_univ_iff],
    intros x,
    by_cases hx : x ∈ Z K,
    { exact ⟨K, mem_Union.mpr ⟨finset.mem_insert_self _ _, hx⟩⟩ },
    { have triv₁ : x ≠ ∞ := (ne_of_mem_of_not_mem hK hx).symm,
      rcases ne_infty_iff_exists.mp triv₁ with ⟨y, hy⟩,
      have triv₂ : (y : alexandroff X) ∈ {x} := mem_singleton_of_eq hy.symm,
      rw [← mem_compl_iff, ← singleton_subset_iff] at hx,
      have : of⁻¹' {x} ⊆ of⁻¹' (Z K)ᶜ := λ y hy, hx hy,
      have key : y ∈ ⋃ (i : ι) (H : i ∈ ι'), p i := this.trans H' (mem_preimage.mpr triv₂),
      rcases mem_bUnion_iff'.mp key with ⟨i, hi, hyi⟩,
      refine ⟨i, mem_Union.mpr ⟨finset.subset_insert _ ι' hi, _⟩⟩,
      simpa [hy] using hyi }
  end }

lemma dense_range_of (h : ¬ is_compact (univ : set X)) : dense (@range_of X _) :=
begin
  refine dense_iff_inter_open.mpr (λ s hs Hs, _),
  by_cases H : ∞ ∈ s,
  { rw is_open_iff_of_mem H at hs,
    have minor₁ : s ≠ {∞},
    { by_contra w,
      rw [not_not.mp w, of_preimage_infty, compl_empty] at hs,
      exact h hs.1 },
    have minor₂ : of⁻¹' s ≠ ∅,
    { by_contra w,
      rw [not_not, eq_empty_iff_forall_not_mem] at w,
      simp only [mem_preimage] at w,
      have : ∀ z ∈ s, z = ∞ := λ z hz,
        by_contra (λ w', let ⟨x, hx⟩ := ne_infty_iff_exists.mp w' in
          by rw hx at hz; exact (w x) hz),
      exact minor₁ (eq_singleton_iff_unique_mem.mpr ⟨H, this⟩) },
    rcases ne_empty_iff_nonempty.mp minor₂ with ⟨x, hx⟩,
    exact ⟨of x, hx, x, mem_univ _, rfl⟩ },
  { rcases Hs with ⟨z, hz⟩,
    rcases ne_infty_iff_exists.mp (ne_of_mem_of_not_mem hz H) with ⟨x, hx⟩,
    rw hx at hz,
    exact ⟨of x, hz, x, mem_univ _, rfl⟩ }
end

lemma connected_space_alexandroff [preconnected_space X] (h : ¬ is_compact (univ : set X)) :
  connected_space (alexandroff X) :=
{ is_preconnected_univ :=
  begin
    rw ← dense_iff_closure_eq.mp (dense_range_of h),
    exact is_preconnected.closure
      (is_preconnected_univ.image of continuous_of.continuous_on)
  end,
  to_nonempty := ⟨∞⟩ }

instance [t1_space X] : t1_space (alexandroff X) :=
{ t1 :=
  λ z, begin
    induction z using alexandroff.rec_infty_coe,
    { rw [← is_open_compl_iff, compl_eq_univ_diff, ← union_infty_eq_univ,
          union_diff_cancel_right (subset.antisymm_iff.mp inter_infty_eq_empty).1],
      exact is_open_range_of },
    { have : ∞ ∈ ({z}ᶜ : set (alexandroff X)) :=
        mem_compl (λ w, (infty_ne_coe z) (mem_singleton_iff.mp w)),
      rw [← is_open_compl_iff, is_open_iff_of_mem this],
      rw [preimage_compl, compl_compl, ← of_eq_coe,
          ← image_singleton, of_injective.preimage_image _],
      exact ⟨is_compact_singleton, is_closed_singleton⟩ }
  end }

instance [locally_compact_space X] [t2_space X] : t2_space (alexandroff X) :=
{ t2 :=
  λ x y hxy, begin
    have key : ∀ (z : alexandroff X), z ≠ ∞ →
      ∃ (u v : set (alexandroff X)), is_open u ∧ is_open v ∧ ∞ ∈ u ∧ z ∈ v ∧ u ∩ v = ∅ :=
    λ z h, begin
      rcases ne_infty_iff_exists.mp h with ⟨y', hy'⟩,
      rcases exists_open_with_compact_closure y' with ⟨u, hu, huy', Hu⟩,
      have minor₁ : _ ∧ is_closed (closure u) := ⟨Hu, is_closed_closure⟩,
      refine ⟨opens_of_compl minor₁, of '' u, _⟩,
      refine ⟨(opens_of_compl minor₁).2, is_open_map_of _ hu,
        infty_mem_opens_of_compl minor₁, ⟨y', huy', hy'.symm⟩, _⟩,
      simp only [opens_of_compl, topological_space.opens.coe_mk],
      have minor₂ : (of '' closure u)ᶜ ∩ of '' u ⊆ (of '' u)ᶜ ∩ of '' u,
      { apply inter_subset_inter_left,
        simp only [compl_subset_compl, image_subset _ (subset_closure)] },
      rw compl_inter_self at minor₂,
      exact eq_empty_of_subset_empty minor₂
    end,
    induction x using alexandroff.rec_infty_coe; induction y using alexandroff.rec_infty_coe,
    { simpa using hxy },
    { simpa using key y hxy.symm },
    { rcases key x hxy with ⟨u, v, hu, hv, hxu, hyv, huv⟩,
      exact ⟨v, u, hv, hu, hyv, hxu, (inter_comm u v) ▸ huv⟩ },
    { have hxy' : x ≠ y := λ w, hxy (coe_eq_coe.mpr w),
      rcases t2_separation hxy' with ⟨u, v, hu, hv, hxu, hyv, huv⟩,
      refine ⟨of '' u, of '' v, is_open_map_of _ hu, is_open_map_of _ hv,
        ⟨x, hxu, rfl⟩, ⟨y, hyv, rfl⟩, _⟩,
      simp only [image_inter of_injective, huv, image_empty], }
  end }

end topological_prop

namespace alexandroff

section arithmetic

variables {X : Type*} [topological_space X]

instance [has_zero X] : has_zero (alexandroff X) := with_top.has_zero

instance [has_one X] : has_one (alexandroff X) := with_top.has_one

instance [has_add X] : has_add (alexandroff X) := with_top.has_add

@[simp] lemma coe_add [has_add X] {x y : X} : ((x + y : X) : alexandroff X) = x + y := rfl

@[simp] lemma add_infty [has_add X] {x : (alexandroff X)} : x + ∞ = ∞ :=
with_top.add_top

@[simp] lemma infty_add [has_add X] {x : (alexandroff X)} : ∞ + x = ∞ :=
with_top.top_add

end arithmetic

end alexandroff


import category_theory.equivalence

open category_theory

variables {C : Type*} [category C]
variables {D : Type*} [category D]

lemma equiv_reflects_mono {X Y : C} (f : X ⟶ Y) (e : C ≌ D)
  (hef : mono (e.functor.map f)) : mono f :=
begin
  split,
  intros Z g h w,
  -- Let's think about the maths here.
  -- We're trying to prove an equation between morphisms in `C`,
  -- but the only thing we know, namely `hef`, lives over in `D`.
  -- So lets use the injectivity of an equivalence at the level of morphisms:
  apply e.functor.map_injective,
  sorry
end


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro hp
  exact And.intro hq hp


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel

! This file was ported from Lean 3 source module category_theory.arrow
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Comma

/-!
# The category of arrows

The category of arrows, with morphisms commutative squares.
We set this up as a specialization of the comma category `Comma L R`,
where `L` and `R` are both the identity functor.

## Tags

comma, arrow
-/

namespace CategoryTheory

universe v u

-- morphism levels before object levels. See note [CategoryTheory universes].
variable {T : Type u} [Category.{v} T]

section

variable (T)

/-- The arrow category of `T` has as objects all morphisms in `T` and as morphisms commutative
     squares in `T`. -/
def Arrow :=
  Comma.{v, v, v} (𝟭 T) (𝟭 T)
#align category_theory.arrow CategoryTheory.Arrow

/- Porting note: could not derive `Category` above so this instance works in its place-/
instance : Category (Arrow T) := commaCategory

-- Satisfying the inhabited linter
instance Arrow.inhabited [Inhabited T] : Inhabited (Arrow T)
    where default := show Comma (𝟭 T) (𝟭 T) from default
#align category_theory.arrow.inhabited CategoryTheory.Arrow.inhabited

end

namespace Arrow

@[simp]
theorem id_left (f : Arrow T) : CommaMorphism.left (𝟙 f) = 𝟙 f.left :=
  rfl
#align category_theory.arrow.id_left CategoryTheory.Arrow.id_left

@[simp]
theorem id_right (f : Arrow T) : CommaMorphism.right (𝟙 f) = 𝟙 f.right :=
  rfl
#align category_theory.arrow.id_right CategoryTheory.Arrow.id_right

/-- An object in the arrow category is simply a morphism in `T`. -/
@[simps]
def mk {X Y : T} (f : X ⟶ Y) : Arrow T where
  left := X
  right := Y
  hom := f
#align category_theory.arrow.mk CategoryTheory.Arrow.mk

@[simp]
theorem mk_eq (f : Arrow T) : Arrow.mk f.hom = f := by
  cases f
  rfl
#align category_theory.arrow.mk_eq CategoryTheory.Arrow.mk_eq

theorem mk_injective (A B : T) : Function.Injective (Arrow.mk : (A ⟶ B) → Arrow T) := fun f g h =>
  by
  cases h
  rfl
#align category_theory.arrow.mk_injective CategoryTheory.Arrow.mk_injective

/- Porting note : was marked as dangerous instance so changed from `Coe` to `CoeOut` -/
instance {X Y : T} : CoeOut (X ⟶ Y) (Arrow T) where
  coe := mk

/-- A morphism in the arrow category is a commutative square connecting two objects of the arrow
    category. -/
@[simps]
def homMk {f g : Arrow T} {u : f.left ⟶ g.left} {v : f.right ⟶ g.right}
    (w : u ≫ g.hom = f.hom ≫ v) : f ⟶ g where
  left := u
  right := v
  w := w
#align category_theory.arrow.hom_mk CategoryTheory.Arrow.homMk

/-- We can also build a morphism in the arrow category out of any commutative square in `T`. -/
@[simps]
def homMk' {X Y : T} {f : X ⟶ Y} {P Q : T} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q} (w : u ≫ g = f ≫ v) :
    Arrow.mk f ⟶ Arrow.mk g where
  left := u
  right := v
  w := w
#align category_theory.arrow.hom_mk' CategoryTheory.Arrow.homMk'

/- Porting note : was warned simp could prove reassoc'd version. Found simp could not.
Added nolint. -/
@[reassoc (attr := simp, nolint simpNF)]
theorem w {f g : Arrow T} (sq : f ⟶ g) : sq.left ≫ g.hom = f.hom ≫ sq.right :=
  sq.w
#align category_theory.arrow.w CategoryTheory.Arrow.w

-- `w_mk_left` is not needed, as it is a consequence of `w` and `mk_hom`.
@[reassoc (attr := simp)]
theorem w_mk_right {f : Arrow T} {X Y : T} {g : X ⟶ Y} (sq : f ⟶ mk g) :
    sq.left ≫ g = f.hom ≫ sq.right :=
  sq.w
#align category_theory.arrow.w_mk_right CategoryTheory.Arrow.w_mk_right

theorem isIso_of_iso_left_of_isIso_right {f g : Arrow T} (ff : f ⟶ g) [IsIso ff.left]
    [IsIso ff.right] : IsIso ff where
  out := by
    let inverse : g ⟶ f := ⟨inv ff.left, inv ff.right, (by simp)⟩
    apply Exists.intro inverse
    constructor
    · apply CommaMorphism.ext
      · rw [Comma.comp_left, IsIso.hom_inv_id, ←Comma.id_left]
      · rw [Comma.comp_right, IsIso.hom_inv_id, ←Comma.id_right]
    · apply CommaMorphism.ext
      · rw [Comma.comp_left, IsIso.inv_hom_id, ←Comma.id_left]
      · rw [Comma.comp_right, IsIso.inv_hom_id, ←Comma.id_right]
#align category_theory.arrow.is_iso_of_iso_left_of_is_iso_right CategoryTheory.Arrow.isIso_of_iso_left_of_isIso_right

/-- Create an isomorphism between arrows,
by providing isomorphisms between the domains and codomains,
and a proof that the square commutes. -/
@[simps!]
def isoMk {f g : Arrow T} (l : f.left ≅ g.left) (r : f.right ≅ g.right)
    (h : l.hom ≫ g.hom = f.hom ≫ r.hom) : f ≅ g :=
  Comma.isoMk l r h
#align category_theory.arrow.iso_mk CategoryTheory.Arrow.isoMk

/-- A variant of `Arrow.isoMk` that creates an iso between two `Arrow.mk`s with a better type
signature. -/
abbrev isoMk' {W X Y Z : T} (f : W ⟶ X) (g : Y ⟶ Z) (e₁ : W ≅ Y) (e₂ : X ≅ Z)
    (h : e₁.hom ≫ g = f ≫ e₂.hom) : Arrow.mk f ≅ Arrow.mk g :=
  Arrow.isoMk e₁ e₂ h
#align category_theory.arrow.iso_mk' CategoryTheory.Arrow.isoMk'

theorem hom.congr_left {f g : Arrow T} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : φ₁.left = φ₂.left := by
  rw [h]
#align category_theory.arrow.hom.congr_left CategoryTheory.Arrow.hom.congr_left

@[simp]
theorem hom.congr_right {f g : Arrow T} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : φ₁.right = φ₂.right := by
  rw [h]
#align category_theory.arrow.hom.congr_right CategoryTheory.Arrow.hom.congr_right

theorem iso_w {f g : Arrow T} (e : f ≅ g) : g.hom = e.inv.left ≫ f.hom ≫ e.hom.right := by
  have eq := Arrow.hom.congr_right e.inv_hom_id
  dsimp at eq
  erw [Arrow.w_assoc, ←Comma.comp_right, eq, Category.comp_id]
#align category_theory.arrow.iso_w CategoryTheory.Arrow.iso_w

theorem iso_w' {W X Y Z : T} {f : W ⟶ X} {g : Y ⟶ Z} (e : Arrow.mk f ≅ Arrow.mk g) :
    g = e.inv.left ≫ f ≫ e.hom.right :=
  iso_w e
#align category_theory.arrow.iso_w' CategoryTheory.Arrow.iso_w'

section

variable {f g : Arrow T} (sq : f ⟶ g)

instance isIso_left [IsIso sq] : IsIso sq.left where
  out := by
    apply Exists.intro (inv sq).left
    simp only [← Comma.comp_left, IsIso.hom_inv_id, IsIso.inv_hom_id, Arrow.id_left,
      eq_self_iff_true, and_self_iff]
    simp
#align category_theory.arrow.is_iso_left CategoryTheory.Arrow.isIso_left

instance isIso_right [IsIso sq] : IsIso sq.right where
  out := by
    apply Exists.intro (inv sq).right
    simp only [← Comma.comp_right, IsIso.hom_inv_id, IsIso.inv_hom_id, Arrow.id_right,
      eq_self_iff_true, and_self_iff]
    simp
#align category_theory.arrow.is_iso_right CategoryTheory.Arrow.isIso_right

@[simp]
theorem inv_left [IsIso sq] : (inv sq).left = inv sq.left :=
  IsIso.eq_inv_of_hom_inv_id <| by rw [← Comma.comp_left, IsIso.hom_inv_id, id_left]
#align category_theory.arrow.inv_left CategoryTheory.Arrow.inv_left

@[simp]
theorem inv_right [IsIso sq] : (inv sq).right = inv sq.right :=
  IsIso.eq_inv_of_hom_inv_id <| by rw [← Comma.comp_right, IsIso.hom_inv_id, id_right]
#align category_theory.arrow.inv_right CategoryTheory.Arrow.inv_right

/- Porting note : simp can prove this so removed @[simp] -/
theorem left_hom_inv_right [IsIso sq] : sq.left ≫ g.hom ≫ inv sq.right = f.hom := by
  simp only [← Category.assoc, IsIso.comp_inv_eq, w]
#align category_theory.arrow.left_hom_inv_right CategoryTheory.Arrow.left_hom_inv_right

-- simp proves this
theorem inv_left_hom_right [IsIso sq] : inv sq.left ≫ f.hom ≫ sq.right = g.hom := by
  simp only [w, IsIso.inv_comp_eq]
#align category_theory.arrow.inv_left_hom_right CategoryTheory.Arrow.inv_left_hom_right

instance mono_left [Mono sq] : Mono sq.left where
  right_cancellation {Z} φ ψ h := by
    let aux : (Z ⟶ f.left) → (Arrow.mk (𝟙 Z) ⟶ f) := fun φ =>
      { left := φ
        right := φ ≫ f.hom }
    have : ∀ g, (aux g).right = g ≫ f.hom := fun g => by dsimp
    show (aux φ).left = (aux ψ).left
    congr 1
    rw [← cancel_mono sq]
    apply CommaMorphism.ext
    · exact h
    · rw [Comma.comp_right, Comma.comp_right, this, this, Category.assoc, Category.assoc]
      rw [←Arrow.w]
      simp only [← Category.assoc, h]
#align category_theory.arrow.mono_left CategoryTheory.Arrow.mono_left

instance epi_right [Epi sq] : Epi sq.right where
  left_cancellation {Z} φ ψ h := by
    let aux : (g.right ⟶ Z) → (g ⟶ Arrow.mk (𝟙 Z)) := fun φ =>
      { right := φ
        left := g.hom ≫ φ }
    show (aux φ).right = (aux ψ).right
    congr 1
    rw [← cancel_epi sq]
    apply CommaMorphism.ext
    · rw [Comma.comp_left, Comma.comp_left, Arrow.w_assoc, Arrow.w_assoc, h]
    · exact h
#align category_theory.arrow.epi_right CategoryTheory.Arrow.epi_right

end

/-- Given a square from an arrow `i` to an isomorphism `p`, express the source part of `sq`
in terms of the inverse of `p`. -/
@[simp]
theorem square_to_iso_invert (i : Arrow T) {X Y : T} (p : X ≅ Y) (sq : i ⟶ Arrow.mk p.hom) :
    i.hom ≫ sq.right ≫ p.inv = sq.left := by
  simpa only [Category.assoc] using (Iso.comp_inv_eq p).mpr (Arrow.w_mk_right sq).symm
#align category_theory.arrow.square_to_iso_invert CategoryTheory.Arrow.square_to_iso_invert

/-- Given a square from an isomorphism `i` to an arrow `p`, express the target part of `sq`
in terms of the inverse of `i`. -/
theorem square_from_iso_invert {X Y : T} (i : X ≅ Y) (p : Arrow T) (sq : Arrow.mk i.hom ⟶ p) :
    i.inv ≫ sq.left ≫ p.hom = sq.right := by simp only [Iso.inv_hom_id_assoc, Arrow.w, Arrow.mk_hom]
#align category_theory.arrow.square_from_iso_invert CategoryTheory.Arrow.square_from_iso_invert

variable {C : Type u} [Category.{v} C]

/-- A helper construction: given a square between `i` and `f ≫ g`, produce a square between
`i` and `g`, whose top leg uses `f`:
A  → X
     ↓f
↓i   Y             --> A → Y
     ↓g                ↓i  ↓g
B  → Z                 B → Z
 -/
@[simps]
def squareToSnd {X Y Z : C} {i : Arrow C} {f : X ⟶ Y} {g : Y ⟶ Z} (sq : i ⟶ Arrow.mk (f ≫ g)) :
    i ⟶ Arrow.mk g where
  left := sq.left ≫ f
  right := sq.right
#align category_theory.arrow.square_to_snd CategoryTheory.Arrow.squareToSnd

/-- The functor sending an arrow to its source. -/
@[simps!]
def leftFunc : Arrow C ⥤ C :=
  Comma.fst _ _
#align category_theory.arrow.left_func CategoryTheory.Arrow.leftFunc

/-- The functor sending an arrow to its target. -/
@[simps!]
def rightFunc : Arrow C ⥤ C :=
  Comma.snd _ _
#align category_theory.arrow.right_func CategoryTheory.Arrow.rightFunc

/-- The natural transformation from `leftFunc` to `rightFunc`, given by the arrow itself. -/
@[simps]
def leftToRight : (leftFunc : Arrow C ⥤ C) ⟶ rightFunc where app f := f.hom
#align category_theory.arrow.left_to_right CategoryTheory.Arrow.leftToRight

end Arrow

namespace Functor

universe v₁ v₂ u₁ u₂

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

/-- A functor `C ⥤ D` induces a functor between the corresponding arrow categories. -/
@[simps]
def mapArrow (F : C ⥤ D) : Arrow C ⥤ Arrow D where
  obj a :=
    { left := F.obj a.left
      right := F.obj a.right
      hom := F.map a.hom }
  map f :=
    { left := F.map f.left
      right := F.map f.right
      w := by
        let w := f.w
        simp only [id_map] at w
        dsimp
        simp only [← F.map_comp, w] }
  map_id := by aesop_cat
  map_comp := fun f g => by
    apply CommaMorphism.ext
    · dsimp; rw [Comma.comp_left,F.map_comp]; rw [Comma.comp_left]
    · dsimp; rw [Comma.comp_right,F.map_comp]; rw [Comma.comp_right]
#align category_theory.functor.map_arrow CategoryTheory.Functor.mapArrow

end Functor

/-- The images of `f : Arrow C` by two isomorphic functors `F : C ⥤ D` are
isomorphic arrows in `D`. -/
def Arrow.isoOfNatIso {C D : Type _} [Category C] [Category D] {F G : C ⥤ D} (e : F ≅ G)
    (f : Arrow C) : F.mapArrow.obj f ≅ G.mapArrow.obj f :=
  Arrow.isoMk (e.app f.left) (e.app f.right) (by simp)
#align category_theory.arrow.iso_of_nat_iso CategoryTheory.Arrow.isoOfNatIso

end CategoryTheory


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebra.category.Ring.constructions
import algebra.category.Ring.colimits
import category_theory.isomorphism
import ring_theory.localization.away
import ring_theory.is_tensor_product

/-!
# Properties of ring homomorphisms

We provide the basic framework for talking about properties of ring homomorphisms.
The following meta-properties of predicates on ring homomorphisms are defined

* `ring_hom.respects_iso`: `P` respects isomorphisms if `P f → P (e ≫ f)` and
  `P f → P (f ≫ e)`, where `e` is an isomorphism.
* `ring_hom.stable_under_composition`: `P` is stable under composition if `P f → P g → P (f ≫ g)`.
* `ring_hom.stable_under_base_change`: `P` is stable under base change if `P (S ⟶ Y)`
  implies `P (X ⟶ X ⊗[S] Y)`.

-/

universe u

open category_theory opposite category_theory.limits

namespace ring_hom

variable (P : ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S), Prop)

include P

section respects_iso

/-- A property `respects_iso` if it still holds when composed with an isomorphism -/
def respects_iso : Prop :=
(∀ {R S T : Type u} [comm_ring R] [comm_ring S] [comm_ring T], by exactI
    ∀ (f : R →+* S) (e : S ≃+* T) (hf : P f), P (e.to_ring_hom.comp f)) ∧
  (∀ {R S T : Type u} [comm_ring R] [comm_ring S] [comm_ring T], by exactI
    ∀ (f : S →+* T) (e : R ≃+* S) (hf : P f), P (f.comp e.to_ring_hom))

variable {P}

lemma respects_iso.cancel_left_is_iso (hP : respects_iso @P) {R S T : CommRing}
  (f : R ⟶ S) (g : S ⟶ T)
  [is_iso f] : P (f ≫ g) ↔ P g :=
⟨λ H, by { convert hP.2 (f ≫ g) (as_iso f).symm.CommRing_iso_to_ring_equiv H,
  exact (is_iso.inv_hom_id_assoc _ _).symm }, hP.2 g (as_iso f).CommRing_iso_to_ring_equiv⟩

lemma respects_iso.cancel_right_is_iso (hP : respects_iso @P) {R S T : CommRing}
  (f : R ⟶ S) (g : S ⟶ T)
  [is_iso g] : P (f ≫ g) ↔ P f :=
⟨λ H, by { convert hP.1 (f ≫ g) (as_iso g).symm.CommRing_iso_to_ring_equiv H,
  change f = f ≫ g ≫ (inv g), simp }, hP.1 f (as_iso g).CommRing_iso_to_ring_equiv⟩

lemma respects_iso.is_localization_away_iff (hP : ring_hom.respects_iso @P) {R S : Type*}
  (R' S' : Type*) [comm_ring R] [comm_ring S] [comm_ring R'] [comm_ring S'] [algebra R R']
  [algebra S S'] (f : R →+* S) (r : R) [is_localization.away r R'] [is_localization.away (f r) S'] :
  P (localization.away_map f r) ↔ P (is_localization.away.map R' S' f r) :=
begin
  let e₁ : R' ≃+* localization.away r :=
    (is_localization.alg_equiv (submonoid.powers r) _ _).to_ring_equiv,
  let e₂ : localization.away (f r) ≃+* S' :=
    (is_localization.alg_equiv (submonoid.powers (f r)) _ _).to_ring_equiv,
  refine (hP.cancel_left_is_iso e₁.to_CommRing_iso.hom (CommRing.of_hom _)).symm.trans _,
  refine (hP.cancel_right_is_iso (CommRing.of_hom _) e₂.to_CommRing_iso.hom).symm.trans _,
  rw ← eq_iff_iff,
  congr' 1,
  dsimp [CommRing.of_hom, CommRing.of, bundled.of],
  refine is_localization.ring_hom_ext (submonoid.powers r) _,
  ext1,
  revert e₁ e₂,
  dsimp [ring_equiv.to_ring_hom, is_localization.away.map],
  simp only [category_theory.comp_apply, ring_equiv.refl_apply, is_localization.alg_equiv_apply,
    is_localization.ring_equiv_of_ring_equiv_apply, ring_hom.coe_mk, ring_equiv.to_fun_eq_coe,
    is_localization.ring_equiv_of_ring_equiv_eq, is_localization.map_eq],
end

end respects_iso

section stable_under_composition

/-- A property is `stable_under_composition` if the composition of two such morphisms
still falls in the class. -/
def stable_under_composition : Prop :=
  ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T],
    by exactI ∀ (f : R →+* S) (g : S →+* T) (hf : P f) (hg : P g), P (g.comp f)

variable {P}

lemma stable_under_composition.respects_iso (hP : ring_hom.stable_under_composition @P)
  (hP' : ∀ {R S : Type*} [comm_ring R] [comm_ring S] (e : by exactI R ≃+* S),
    by exactI P e.to_ring_hom) : ring_hom.respects_iso @P :=
begin
  split,
  { introv H, resetI, apply hP, exacts [H, hP' e] },
  { introv H, resetI, apply hP, exacts [hP' e, H] }
end

end stable_under_composition

section stable_under_base_change

/-- A morphism property `P` is `stable_under_base_change` if `P(S →+* A)` implies
`P(B →+* A ⊗[S] B)`. -/
def stable_under_base_change : Prop :=
  ∀ (R S R' S') [comm_ring R] [comm_ring S] [comm_ring R'] [comm_ring S'],
    by exactI ∀ [algebra R S] [algebra R R'] [algebra R S'] [algebra S S'] [algebra R' S'],
    by exactI ∀ [is_scalar_tower R S S'] [is_scalar_tower R R' S'],
    by exactI ∀ [algebra.is_pushout R S R' S'], P (algebra_map R S) → P (algebra_map R' S')

lemma stable_under_base_change.mk
  (h₁ : respects_iso @P)
  (h₂ : ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T],
    by exactI ∀ [algebra R S] [algebra R T], by exactI (P (algebra_map R T) →
      P (algebra.tensor_product.include_left.to_ring_hom : S →+* tensor_product R S T))) :
  stable_under_base_change @P :=
begin
  introv R h H,
  resetI,
  let e := h.symm.1.equiv,
  let f' := algebra.tensor_product.product_map (is_scalar_tower.to_alg_hom R R' S')
    (is_scalar_tower.to_alg_hom R S S'),
  have : ∀ x, e x = f' x,
  { intro x,
    change e.to_linear_map.restrict_scalars R x = f'.to_linear_map x,
    congr' 1,
    apply tensor_product.ext',
    intros x y,
    simp [is_base_change.equiv_tmul, algebra.smul_def] },
  convert h₁.1 _ _ (h₂ H : P (_ : R' →+* _)),
  swap,
  { refine { map_mul' := λ x y, _, ..e },
    change e (x * y) = e x * e y,
    simp_rw this,
    exact map_mul f' _ _ },
  { ext,
    change _ = e (x ⊗ₜ[R] 1),
    dsimp only [e],
    rw [h.symm.1.equiv_tmul, algebra.smul_def, alg_hom.to_linear_map_apply, map_one, mul_one] }
end

omit P

local attribute [instance] algebra.tensor_product.right_algebra

lemma stable_under_base_change.pushout_inl
  (hP : ring_hom.stable_under_base_change @P) (hP' : ring_hom.respects_iso @P) {R S T : CommRing}
  (f : R ⟶ S) (g : R ⟶ T) (H : P g) : P (pushout.inl : S ⟶ pushout f g) :=
begin
  rw [← (show _ = pushout.inl, from colimit.iso_colimit_cocone_ι_inv
    ⟨_, CommRing.pushout_cocone_is_colimit f g⟩ walking_span.left), hP'.cancel_right_is_iso],
  letI := f.to_algebra,
  letI := g.to_algebra,
  dsimp only [CommRing.pushout_cocone_inl, pushout_cocone.ι_app_left],
  apply hP R T S (tensor_product R S T),
  exact H,
end

end stable_under_base_change

end ring_hom