83 lines
2.5 KiB
Text
83 lines
2.5 KiB
Text
/-
|
||
Copyright (c) 2015 Floris van Doorn. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Floris van Doorn
|
||
|
||
TODO: move
|
||
-/
|
||
|
||
import .adjoint ..yoneda
|
||
|
||
open eq functor nat_trans yoneda iso prod is_trunc
|
||
|
||
namespace category
|
||
|
||
section
|
||
universe variables u v
|
||
parameters {C D : Precategory.{u v}} {F : C ⇒ D} {G : D ⇒ C}
|
||
(θ : hom_functor D ∘f prod_functor_prod Fᵒᵖᶠ 1 ≅ hom_functor C ∘f prod_functor_prod 1 G)
|
||
include θ
|
||
/- θ : _ ⟹[Cᵒᵖ × D ⇒ set] _-/
|
||
|
||
definition adj_unit [constructor] : 1 ⟹ G ∘f F :=
|
||
begin
|
||
fapply nat_trans.mk: esimp,
|
||
{ intro c, exact natural_map (to_hom θ) (c, F c) id},
|
||
{ intro c c' f,
|
||
let H := naturality (to_hom θ) (ID c, F f),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, id_right at K, ▸*, K, respect_id, +id_right],
|
||
clear H K,
|
||
let H := naturality (to_hom θ) (f, ID (F c')),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, respect_id at K,+id_left at K, K]}
|
||
end
|
||
|
||
definition adj_counit [constructor] : F ∘f G ⟹ 1 :=
|
||
begin
|
||
fapply nat_trans.mk: esimp,
|
||
{ intro d, exact natural_map (to_inv θ) (G d, d) id, },
|
||
{ intro d d' g,
|
||
let H := naturality (to_inv θ) (Gᵒᵖᶠ g, ID d'),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, id_left at K, ▸*, K, respect_id, +id_left],
|
||
clear H K,
|
||
let H := naturality (to_inv θ) (ID (G d), g),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, respect_id at K,+id_right at K, K]}
|
||
end
|
||
|
||
theorem adj_eq_unit (c : C) (d : D) (f : F c ⟶ d)
|
||
: natural_map (to_hom θ) (c, d) f = G f ∘ adj_unit c :=
|
||
begin
|
||
esimp,
|
||
let H := naturality (to_hom θ) (ID c, f),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, id_right at K, K, respect_id, +id_right],
|
||
end
|
||
|
||
theorem adj_eq_counit (c : C) (d : D) (g : c ⟶ G d)
|
||
: natural_map (to_inv θ) (c, d) g = adj_counit d ∘ F g :=
|
||
begin
|
||
esimp,
|
||
let H := naturality (to_inv θ) (g, ID d),
|
||
let K := ap10 H id,
|
||
rewrite [▸* at K, id_left at K, K, respect_id, +id_left],
|
||
end
|
||
|
||
definition adjoint.mk' [constructor] : F ⊣ G :=
|
||
begin
|
||
fapply adjoint.mk,
|
||
{ exact adj_unit},
|
||
{ exact adj_counit},
|
||
{ intro c, esimp, refine (adj_eq_counit c (F c) (adj_unit c))⁻¹ ⬝ _,
|
||
apply ap10 (to_left_inverse (componentwise_iso θ (c, F c)))},
|
||
{ intro d, esimp, refine (adj_eq_unit (G d) d (adj_counit d))⁻¹ ⬝ _,
|
||
apply ap10 (to_right_inverse (componentwise_iso θ (G d, d)))},
|
||
end
|
||
|
||
end
|
||
|
||
|
||
|
||
end category
|