115 lines
4.7 KiB
Text
115 lines
4.7 KiB
Text
-- Copyright (c) 2014 Floris van Doorn. All rights reserved.
|
|
-- Released under Apache 2.0 license as described in the file LICENSE.
|
|
-- Author: Floris van Doorn, Jakob von Raumer
|
|
|
|
import .functor hott.axioms.funext hott.types.pi hott.types.sigma
|
|
open precategory path functor truncation equiv sigma.ops sigma is_equiv function pi
|
|
|
|
inductive natural_transformation {C D : Precategory} (F G : C ⇒ D) : Type :=
|
|
mk : Π (η : Π (a : C), hom (F a) (G a))
|
|
(nat : Π {a b : C} (f : hom a b), G f ∘ η a ≈ η b ∘ F f),
|
|
natural_transformation F G
|
|
|
|
infixl `⟹`:25 := natural_transformation -- \==>
|
|
|
|
namespace natural_transformation
|
|
variables {C D : Precategory} {F G H I : functor C D}
|
|
|
|
definition natural_map [coercion] (η : F ⟹ G) : Π(a : C), F a ⟶ G a :=
|
|
rec (λ x y, x) η
|
|
|
|
theorem naturality (η : F ⟹ G) : Π⦃a b : C⦄ (f : a ⟶ b), G f ∘ η a ≈ η b ∘ F f :=
|
|
rec (λ x y, y) η
|
|
|
|
protected definition sigma_char :
|
|
(Σ (η : Π (a : C), hom (F a) (G a)), Π (a b : C) (f : hom a b), G f ∘ η a ≈ η b ∘ F f) ≃ (F ⟹ G) :=
|
|
/-equiv.mk (λ S, natural_transformation.mk S.1 S.2)
|
|
(adjointify (λ S, natural_transformation.mk S.1 S.2)
|
|
(λ H, natural_transformation.rec_on H (λ η nat, dpair η nat))
|
|
(λ H, natural_transformation.rec_on H (λ η nat, idpath (natural_transformation.mk η nat)))
|
|
(λ S, sigma.rec_on S (λ η nat, idpath (dpair η nat))))-/
|
|
|
|
/- THE FOLLLOWING CAUSES LEAN TO SEGFAULT?
|
|
begin
|
|
fapply equiv.mk,
|
|
intro S, apply natural_transformation.mk, exact (S.2),
|
|
fapply adjointify,
|
|
intro H, apply (natural_transformation.rec_on H), intros (η, natu),
|
|
exact (dpair η @natu),
|
|
intro H, apply (natural_transformation.rec_on _ _ _),
|
|
intros,
|
|
end
|
|
check sigma_char-/
|
|
sorry
|
|
|
|
protected definition compose (η : G ⟹ H) (θ : F ⟹ G) : F ⟹ H :=
|
|
natural_transformation.mk
|
|
(λ a, η a ∘ θ a)
|
|
(λ a b f,
|
|
calc
|
|
H f ∘ (η a ∘ θ a) ≈ (H f ∘ η a) ∘ θ a : assoc
|
|
... ≈(η b ∘ G f) ∘ θ a : naturality η f
|
|
... ≈ η b ∘ (G f ∘ θ a) : assoc
|
|
... ≈ η b ∘ (θ b ∘ F f) : naturality θ f
|
|
... ≈ (η b ∘ θ b) ∘ F f : assoc)
|
|
--congr_arg (λx, η b ∘ x) (naturality θ f) -- this needed to be explicit for some reason (on Oct 24)
|
|
|
|
infixr `∘n`:60 := compose
|
|
|
|
protected definition assoc (η₃ : H ⟹ I) (η₂ : G ⟹ H) (η₁ : F ⟹ G) [fext fext2 fext3 : funext] :
|
|
η₃ ∘n (η₂ ∘n η₁) ≈ (η₃ ∘n η₂) ∘n η₁ :=
|
|
-- Proof broken, universe issues?
|
|
/-have aux [visible] : is_hprop (Π (a b : C) (f : hom a b), I f ∘ (η₃ ∘n η₂) a ∘ η₁ a ≈ ((η₃ ∘n η₂) b ∘ η₁ b) ∘ F f),
|
|
begin
|
|
repeat (apply trunc_pi; intros),
|
|
apply (succ_is_trunc -1 (I a_2 ∘ (η₃ ∘n η₂) a ∘ η₁ a)),
|
|
end,
|
|
dcongr_arg2 mk (funext.path_forall _ _ (λ x, !assoc)) !is_hprop.elim-/
|
|
sorry
|
|
|
|
protected definition id {C D : Precategory} {F : functor C D} : natural_transformation F F :=
|
|
mk (λa, id) (λa b f, !id_right ⬝ (!id_left⁻¹))
|
|
protected definition ID {C D : Precategory} (F : functor C D) : natural_transformation F F := id
|
|
|
|
protected definition id_left (η : F ⟹ G) [fext : funext.{l_1 l_4}] :
|
|
id ∘n η ≈ η :=
|
|
--Proof broken like all trunc_pi proofs
|
|
/-begin
|
|
apply (rec_on η), intros (f, H),
|
|
fapply (path.dcongr_arg2 mk),
|
|
apply (funext.path_forall _ f (λa, !id_left)),
|
|
assert (H1 : is_hprop (Π {a b : C} (g : hom a b), G g ∘ f a ≈ f b ∘ F g)),
|
|
--repeat (apply trunc_pi; intros),
|
|
apply (@trunc_pi _ _ _ (-2 .+1) _),
|
|
/- apply (succ_is_trunc -1 (G a_2 ∘ f a) (f a_1 ∘ F a_2)),
|
|
apply (!is_hprop.elim),-/
|
|
end-/
|
|
sorry
|
|
|
|
protected definition id_right (η : F ⟹ G) [fext : funext.{l_1 l_4}] :
|
|
η ∘n id ≈ η :=
|
|
--Proof broken like all trunc_pi proofs
|
|
/-begin
|
|
apply (rec_on η), intros (f, H),
|
|
fapply (path.dcongr_arg2 mk),
|
|
apply (funext.path_forall _ f (λa, !id_right)),
|
|
assert (H1 : is_hprop (Π {a b : C} (g : hom a b), G g ∘ f a ≈ f b ∘ F g)),
|
|
repeat (apply trunc_pi; intros),
|
|
apply (succ_is_trunc -1 (G a_2 ∘ f a) (f a_1 ∘ F a_2)),
|
|
apply (!is_hprop.elim),
|
|
end-/
|
|
sorry
|
|
|
|
protected definition to_hset [fx : funext] : is_hset (F ⟹ G) :=
|
|
--Proof broken like all trunc_pi proofs
|
|
/-begin
|
|
apply trunc_equiv, apply (equiv.to_is_equiv sigma_char),
|
|
apply trunc_sigma,
|
|
apply trunc_pi, intro a, exact (@homH (objects D) _ (F a) (G a)),
|
|
intro η, apply trunc_pi, intro a,
|
|
apply trunc_pi, intro b, apply trunc_pi, intro f,
|
|
apply succ_is_trunc, apply trunc_succ, exact (@homH (objects D) _ (F a) (G b)),
|
|
end-/
|
|
sorry
|
|
|
|
end natural_transformation
|