├── .gitignore
├── Adjunction
├── AFT
│ ├── AFT.v
│ ├── Commas_Complete
│ │ ├── Commas_Complete.v
│ │ ├── Commas_Equalizer.v
│ │ └── Commas_GenProd.v
│ └── Solution_Set_Cond.v
├── Adj_Cat.v
├── Adj_Facts.v
├── Adjunction.v
├── Duality.v
├── Main.v
└── Univ_Morph.v
├── Algebras
├── Algebras.v
└── Main.v
├── Archetypal
├── Discr
│ ├── Discr.v
│ ├── Main.v
│ └── NatFacts.v
├── Monoid_Cat
│ ├── List_Monoid_Cat.v
│ └── Monoid_Cat.v
└── PreOrder_Cat
│ ├── OmegaCat.v
│ └── PreOrder_Cat.v
├── Basic_Cons
├── CCC.v
├── Equalizer.v
├── Exponential.v
├── Exponential_Functor.v
├── Facts.v
├── Facts
│ ├── Adjuncts.v
│ ├── Equalizer_Monic.v
│ ├── Init_Prod.v
│ ├── Main.v
│ ├── Term_IsoCat.v
│ └── Term_Prod.v
├── LCCC.v
├── Limits.v
├── Main.v
├── Product.v
├── PullBack.v
└── Terminal.v
├── Cat
├── CCC.v
├── Cat.v
├── Cat_Iso.v
├── Exponential.v
├── Exponential_Facts.v
├── Facts.v
├── Initial.v
├── Product.v
└── Terminal.v
├── Category
├── Category.v
├── Composable_Chain.v
├── Main.v
├── Morph.v
├── Opposite.v
└── SubCategory.v
├── Coq_Cats
├── Coq_Cat.v
├── Main.v
├── Prop_Cat.v
├── Set_Cat.v
└── Type_Cat
│ ├── CCC.v
│ ├── Card_Restriction.v
│ ├── Complete.v
│ ├── Equalizer.v
│ ├── Facts.v
│ ├── GenProd.v
│ ├── GenSum.v
│ ├── Initial.v
│ ├── LCCC.v
│ ├── Morphisms.v
│ ├── PullBack.v
│ ├── SubObject_Classifier.v
│ ├── Sum.v
│ ├── Topos.v
│ └── Type_Cat.v
├── Demo
└── Demo.v
├── Essentials
├── Facts_Tactics.v
├── Notations.v
├── Quotient.v
└── Types.v
├── Ext_Cons
├── Arrow.v
├── Comma.v
├── Main.v
└── Prod_Cat
│ ├── Main.v
│ ├── Nat_Facts.v
│ ├── Operations.v
│ └── Prod_Cat.v
├── Functor
├── Const_Func.v
├── Const_Func_Functor.v
├── Functor.v
├── Functor_Extender.v
├── Functor_Image.v
├── Functor_Ops.v
├── Functor_Properties.v
├── Main.v
└── Representable
│ ├── Hom_Func.v
│ ├── Hom_Func_Prop.v
│ ├── Main.v
│ └── Representable.v
├── KanExt
├── Facts.v
├── Global.v
├── GlobalDuality.v
├── GlobalFacts.v
├── GlobaltoLocal.v
├── Local.v
├── LocalFacts
│ ├── ConesToHom.v
│ ├── From_Iso_Cat.v
│ ├── HomToCones.v
│ ├── Main.v
│ ├── NatIso.v
│ └── Uniqueness.v
├── LocaltoGlobal.v
├── Main.v
├── Pointwise.v
└── Preservation.v
├── Limits
├── Complete_Preorder.v
├── GenProd_Eq_Limits.v
├── GenProd_GenSum.v
├── Isomorphic_Cat.v
├── Limit.v
├── Main.v
└── Pointwise.v
├── Monad
├── Adj_Monad.v
├── Monad.v
└── distributive_law.v
├── NatTrans
├── Func_Cat.v
├── Main.v
├── Morphisms.v
├── NatIso.v
├── NatTrans.v
└── Operations.v
├── PreSheaf
├── CCC.v
├── Complete.v
├── Equalizer.v
├── Exponential.v
├── GenProd.v
├── GenSum.v
├── Initial.v
├── Morphisms.v
├── PreSheaf.v
├── Product.v
├── PullBack.v
├── SubObject_Classifier.v
├── Sum.v
├── Terminal.v
└── Topos.v
├── README.md
├── Topos
├── Main.v
├── SubObject_Classifier.v
└── Topos.v
├── Yoneda
└── Yoneda.v
├── _CoqProject
└── configure.sh
/.gitignore:
--------------------------------------------------------------------------------
1 | Makefile
2 | Makefile.conf
3 | .Makefile.d
4 | *~
5 | *.glob
6 | *.v.d
7 | *.vo
8 | *.aux
9 | .coq-native
10 | *.bak
11 | *#*
12 | *.vok
13 | *.vos
14 |
--------------------------------------------------------------------------------
/Adjunction/AFT/AFT.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Ext_Cons.Comma.
7 | From Categories Require Import Limits.Limit.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 | From Categories Require Import Adjunction.Adjunction Adjunction.Univ_Morph.
10 | From Categories.Adjunction.AFT Require Import Solution_Set_Cond
11 | Commas_Complete.Commas_Complete.
12 |
13 | Section AFT.
14 | Local Open Scope functor_scope.
15 |
16 | Context
17 | {C D : Category}
18 | {CC : Complete C}
19 | {G : C --> D}
20 | (GCont : Continuous CC G)
21 | (SSC : ∀ x, Solution_Set_Cond (Comma (Const_Func 1 x) G)).
22 |
23 | Program Definition Adjoint_Functor_Theorem : _ ⊣ G :=
24 | Universal_Morphism_Right_Adjonit
25 | G
26 | (fun x : D => Complete_SSC_Initial (Commas_Complete GCont x) (SSC x)).
27 |
28 | End AFT.
29 |
--------------------------------------------------------------------------------
/Adjunction/AFT/Commas_Complete/Commas_Complete.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories.Limits Require Import Limit GenProd_GenSum GenProd_Eq_Limits.
6 | From Categories.Functor Require Import Functor Const_Func Functor_Ops.
7 | From Categories Require Import NatTrans.Main.
8 | From Categories Require Import Ext_Cons.Comma.
9 |
10 | From Categories Require Import Archetypal.Discr.Discr.
11 |
12 | From Categories.Adjunction.AFT.Commas_Complete Require Import
13 | Commas_GenProd Commas_Equalizer.
14 |
15 | (** We show that if C is a complete category and G : C –≻ D preserves limits,
16 | then every comma category (Comma (Func_From_SingletonCat x) G) for (x : D) is
17 | complete. *)
18 | Section Commas_Complete.
19 | Context
20 | {C D : Category}
21 | {CC : Complete C}
22 | {G : (C --> D)%functor}
23 | (GCont : Continuous CC G)
24 | (x : D).
25 |
26 | Definition Commas_Complete : Complete (Comma (Const_Func 1 x) G)
27 | :=
28 | @GenProd_Eq_Complete
29 | (Comma (Const_Func 1 x) G)
30 | (@Comma_GenProd _ _ _ _ GCont x)
31 | (@Comma_Equalizer _ _ _ _ GCont x).
32 |
33 | End Commas_Complete.
34 |
--------------------------------------------------------------------------------
/Adjunction/Duality.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
3 | Ext_Cons.Prod_Cat.Operations.
4 | From Categories Require Import Functor.Main.
5 | From Categories Require Import Functor.Representable.Hom_Func
6 | Functor.Representable.Hom_Func_Prop.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.NatIso.
8 | From Categories Require Import Adjunction.Adjunction.
9 |
10 | Local Open Scope functor_scope.
11 |
12 | Section Hom_Adj_Duality.
13 | Context {C D : Category} {F : C --> D} {G : D --> C} (adj : F ⊣_hom G).
14 |
15 | (** Duality for hom adjunctions. *)
16 | Definition Hom_Adjunct_Duality : G^op ⊣_hom F^op :=
17 | (Prod_Func_Hom_Func (adj⁻¹)).
18 |
19 | End Hom_Adj_Duality.
20 |
21 | Section Adj_Duality.
22 | Context {C D : Category} {F : C --> D} {G : D --> C} (adj : F ⊣ G).
23 |
24 | (** Duality for adjunctions. It follows from Hom_Adjunct_Duality. *)
25 | Definition Adjunct_Duality : G^op ⊣ F^op :=
26 | (Hom_Adj_to_Adj (Hom_Adjunct_Duality (Adj_to_Hom_Adj adj))).
27 |
28 | End Adj_Duality.
29 |
--------------------------------------------------------------------------------
/Adjunction/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Adjunction.Adjunction.
2 | From Categories Require Export Adjunction.Duality.
3 | From Categories Require Export Adjunction.Adj_Cat.
4 | From Categories Require Export Adjunction.Adj_Facts.
5 |
6 |
--------------------------------------------------------------------------------
/Algebras/Algebras.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 |
7 | Local Open Scope morphism_scope.
8 |
9 | Section Algebras.
10 | Context {C : Category} (T : (C --> C)%functor).
11 |
12 | (** A T-Algebra in category C for an endo-functor T : C → C is a pair (U, h)
13 | where U is an object of C and h : T _o U → U is an arrow in C. *)
14 | Record Algebra : Type :=
15 | {
16 | Alg_Carrier : C;
17 | Constructors : (T _o Alg_Carrier)%object --> Alg_Carrier
18 | }.
19 |
20 | (** A T-Algebra homomorphism from (U, h) to (U', h') is an arrow g : U → U'
21 | such that the following diagram commutes:
22 |
23 | #
24 |
25 |
26 | T _a g
27 | T _o U ——————————————> T _o U'
28 | | |
29 | | |
30 | | |
31 | h | | h'
32 | | |
33 | | |
34 | ↓ ↓
35 | U ————–——————————————> U
36 | g
37 |
38 | #
39 | *)
40 | Record Algebra_Hom (alg alg' : Algebra) : Type :=
41 | {
42 | Alg_map : (Alg_Carrier alg) --> (Alg_Carrier alg');
43 |
44 | Alg_map_com : ((Constructors alg') ∘ (T _a Alg_map)
45 | = Alg_map ∘ (Constructors alg))%morphism
46 | }.
47 |
48 | Arguments Alg_map {_ _} _.
49 | Arguments Alg_map_com {_ _} _.
50 |
51 | (** Composition of algebra homomorphisms. The algebra maps are simply
52 | composed. *)
53 | Program Definition Algebra_Hom_compose
54 | {alg alg' alg'' : Algebra}
55 | (h : Algebra_Hom alg alg')
56 | (h' : Algebra_Hom alg' alg'')
57 | : Algebra_Hom alg alg''
58 | :=
59 | {|
60 | Alg_map := ((Alg_map h') ∘ (Alg_map h))%morphism
61 | |}.
62 |
63 | Next Obligation.
64 | Proof.
65 | destruct h as [alm almcm]; destruct h' as [alm' almcm']; cbn.
66 | rewrite F_compose.
67 | rewrite assoc_sym.
68 | rewrite almcm'.
69 | rewrite assoc.
70 | rewrite almcm.
71 | auto.
72 | Qed.
73 |
74 | (** Two algebra maps are equal if their underlying maps are. The commutative
75 | diagrams are equated with proof irrelevance. *)
76 | Lemma Algebra_Hom_eq_simplify (alg alg' : Algebra)
77 | (ah ah' : Algebra_Hom alg alg')
78 | : (Alg_map ah) = (Alg_map ah') -> ah = ah'.
79 | Proof.
80 | intros; destruct ah; destruct ah'; cbn in *.
81 | ElimEq.
82 | PIR.
83 | trivial.
84 | Qed.
85 |
86 | (** Composition of algebra homomorphisms is associative. *)
87 | Theorem Algebra_Hom_compose_assoc
88 | {alg alg' alg'' alg''' : Algebra}
89 | (f : Algebra_Hom alg alg')
90 | (g : Algebra_Hom alg' alg'')
91 | (h : Algebra_Hom alg'' alg''') :
92 | (Algebra_Hom_compose f (Algebra_Hom_compose g h))
93 | = (Algebra_Hom_compose (Algebra_Hom_compose f g) h).
94 | Proof.
95 | apply Algebra_Hom_eq_simplify; cbn; auto.
96 | Qed.
97 |
98 | (** The identity algebra homomorphism. *)
99 | Program Definition Algebra_Hom_id (alg : Algebra) : Algebra_Hom alg alg :=
100 | {|
101 | Alg_map := id
102 | |}.
103 |
104 | (** Identity algebra homomorphism is the left unit of compositon. *)
105 | Theorem Algebra_Hom_id_unit_left
106 | {alg alg' : Algebra}
107 | (f : Algebra_Hom alg alg') :
108 | (Algebra_Hom_compose f (Algebra_Hom_id alg')) = f.
109 | Proof.
110 | apply Algebra_Hom_eq_simplify; cbn; auto.
111 | Qed.
112 |
113 | (** Identity algebra homomorphism is the right unit of compositon. *)
114 | Theorem Algebra_Hom_id_unit_right
115 | {alg alg' : Algebra}
116 | (f : Algebra_Hom alg alg') :
117 | (Algebra_Hom_compose (Algebra_Hom_id alg) f) = f.
118 | Proof.
119 | apply Algebra_Hom_eq_simplify; cbn; auto.
120 | Qed.
121 |
122 | (** Algebras of an endo-functor form a category. *)
123 | Definition Algebra_Cat : Category :=
124 | {|
125 | Obj := Algebra;
126 | Hom := Algebra_Hom;
127 | compose := @Algebra_Hom_compose;
128 | assoc := @Algebra_Hom_compose_assoc;
129 | assoc_sym := fun _ _ _ _ _ _ _ =>
130 | eq_sym (@Algebra_Hom_compose_assoc _ _ _ _ _ _ _);
131 | id := Algebra_Hom_id;
132 | id_unit_left := @Algebra_Hom_id_unit_left;
133 | id_unit_right := @Algebra_Hom_id_unit_right
134 | |}.
135 |
136 | End Algebras.
137 |
138 | Arguments Alg_Carrier {_ _} _.
139 | Arguments Constructors {_ _} _.
140 | Arguments Algebra_Hom {_ _} _ _.
141 | Arguments Alg_map {_ _ _ _} _.
142 | Arguments Alg_map_com {_ _ _ _} _.
143 | Arguments Algebra_Hom_id {_ _} _.
144 |
145 | (** Coalgebras are algebras in the dual category. *)
146 | Section CoAlgebras.
147 | Context {C : Category}.
148 |
149 | Definition CoAlgebra (T : (C --> C)%functor) :=
150 | @Algebra (C^op) (T^op).
151 |
152 | Definition CoAlgebra_Hom {T : (C --> C)%functor} :=
153 | @Algebra_Hom (C^op) (T^op).
154 |
155 | Definition CoAlgebra_Hom_id {T : (C --> C)%functor} :=
156 | @Algebra_Hom_id (C^op) (T^op).
157 |
158 | Definition CoAlgebra_Cat (T : (C --> C)%functor) :=
159 | @Algebra_Cat (C^op) (T^op).
160 |
161 | End CoAlgebras.
162 |
--------------------------------------------------------------------------------
/Algebras/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Algebras.Algebras.
2 |
--------------------------------------------------------------------------------
/Archetypal/Discr/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Archetypal.Discr.Discr.
2 | From Categories Require Export Archetypal.Discr.NatFacts.
3 |
--------------------------------------------------------------------------------
/Archetypal/Discr/NatFacts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Ext_Cons.Arrow.
7 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
8 | From Categories Require Import Cat.Cat Cat.Cat_Iso.
9 | From Categories Require Import NatTrans.NatTrans NatTrans.NatIso.
10 | From Categories Require Import Archetypal.Discr.Discr.
11 |
12 | (** This module contains facts about discrete categories and discrete
13 | functors involving natural transformations. *)
14 |
15 | (** The fact that dicrete functor from (Discr_Cat A) to Cᵒᵖ is naturally
16 | isomorphic to the opposite of discrete-opposite functor
17 | from (Discr_Cat A)ᵒᵖ to C. *)
18 | Section Discr_Func_Iso.
19 | Context {C : Category} {A : Type} (Omap : A → C).
20 |
21 | Local Hint Extern 1 => apply NatTrans_eq_simplify; cbn : core.
22 |
23 | Program Definition Discr_Func_Iso :
24 | (
25 | (@Discr_Func (C^op) A Omap) ≃ ((@Discr_Func_op C A Omap)^op)%functor
26 | )%natiso
27 | :=
28 | {|
29 | iso_morphism :=
30 | {|
31 | Trans := fun _ => id
32 | |};
33 | inverse_morphism :=
34 | {|
35 | Trans := fun _ => id
36 | |}
37 | |}.
38 |
39 | End Discr_Func_Iso.
40 |
41 | (** We show that the opposite of the functor from the singleton category that
42 | maps to object x in C is naturally isomorphic to the functor from the
43 | singleton category that maps to object x in Cᵒᵖ. *)
44 | Section Func_From_SingletonCat_Opposite.
45 | Context {C : Category} (x : C).
46 |
47 | Local Hint Extern 1 => apply NatTrans_eq_simplify; cbn : core.
48 |
49 | Program Definition Func_From_SingletonCat_Opposite :
50 | (
51 | (((Const_Func 1 x)^op)
52 | ≃ (@Const_Func (1 ^op) (C^op) x))%functor
53 | )%natiso
54 | :=
55 | {|
56 | iso_morphism :=
57 | {|
58 | Trans := fun _ => id
59 | |};
60 | inverse_morphism :=
61 | {|
62 | Trans := fun _ => id
63 | |}
64 | |}.
65 |
66 | End Func_From_SingletonCat_Opposite.
67 |
68 | Section Discr_Func_Arrow_Iso.
69 | Context {C D : Category} (arrmap : (Arrow (C^op)) → D).
70 |
71 | (** Let A be the discrete categoty of morphisms of Cᵒᵖ and B be the category
72 | of morphisms of C. We show that Aᵒᵖ ≃ Bᵒᵖ. *)
73 | Definition Discr_Cat_ArrowOp_Discr_Cat_Arrow_Op :
74 | ((((Discr_Cat (Arrow (C^op)))^op)%category)
75 | ≃≃ ((Discr_Cat (Arrow C))^op)%category ::> Cat)%isomorphism
76 | :=
77 | Opposite_Cat_Iso (Discr_Cat_Iso ((Arrow_OP_Iso C)⁻¹))
78 | .
79 |
80 | Local Hint Extern 1 => apply NatTrans_eq_simplify; cbn : core.
81 |
82 | (** Let A be the discrete categoty of morphisms of Cᵒᵖ and B be the category
83 | of morphisms of C. Let, furthermore, U : B → D be a function we show that
84 | ((Discr_Func_op (fun x : B => U x^) ∘ M) ≃ (Discr_Func_op U). Where x^ is
85 | mirrored version of x (from an arrow of C to an arrow of Cᵒᵖ) and M is
86 | Discr_Cat_ArrowOp_Discr_Cat_Arrow_Op defined above.
87 | *)
88 | Program Definition Discr_Func_Arrow_Iso :
89 | (
90 | (
91 | (Discr_Func_op (fun x : Arrow C => arrmap (Arrow_to_Arrow_OP C x)))
92 | ∘ (iso_morphism Discr_Cat_ArrowOp_Discr_Cat_Arrow_Op)
93 | )%functor
94 | ≃ ((@Discr_Func_op D (Arrow (C^op)) arrmap))%functor
95 | )%natiso
96 | :=
97 | {|
98 | iso_morphism :=
99 | {|
100 | Trans := fun c => id
101 | |};
102 | inverse_morphism :=
103 | {|
104 | Trans := fun c => id
105 | |}
106 | |}.
107 |
108 | End Discr_Func_Arrow_Iso.
109 |
110 | Local Hint Extern 1 =>
111 | match goal with [z : Arrow (Discr_Cat _) |- _] => destruct z as [? ? []] end
112 | : core.
113 |
114 | (** The fact that in discrete categories object type and arrow
115 | type are isomorphic. *)
116 | Program Definition Discr_Hom_Iso (A : Type) :
117 | (A ≃≃ Arrow (Discr_Cat A) ::> Type_Cat)%isomorphism :=
118 | (Build_Isomorphism
119 | Type_Cat
120 | _
121 | _
122 | (fun a => (Build_Arrow (Discr_Cat A) _ _ (eq_refl a)))
123 | (fun a : (Arrow (Discr_Cat _)) => Orig a)
124 | _
125 | _
126 | ).
127 |
128 | Section Discretize.
129 | Context {C D : Category} {F G : (C --> D)%functor} (N : (F --> G)%nattrans).
130 |
131 | (** Discretizes a natural transformation. That is, it forgets about the
132 | arrow maps of the functors and assumes the functors are just discrete
133 | functors, retaining the object maps of the functors. *)
134 | Program Definition Discretize :
135 | ((Discr_Func (F _o)%object) --> (Discr_Func (G _o)%object))%nattrans
136 | :=
137 | {|
138 | Trans := Trans N
139 | |}.
140 |
141 | End Discretize.
142 |
--------------------------------------------------------------------------------
/Archetypal/Monoid_Cat/List_Monoid_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Archetypal.Monoid_Cat.Monoid_Cat.
3 | Require Import Coq.Lists.List.
4 |
5 | (** Lists form a monoid and thus a category. *)
6 | Section List_Monoid_Cat.
7 | Context (A : Type).
8 |
9 | Hint Resolve app_assoc app_nil_r : core.
10 |
11 | Program Definition List_Monoid : Monoid :=
12 | {|
13 | Mon_car := list A;
14 |
15 | Mon_op := fun a b => (a ++ b)%list;
16 |
17 | Mon_unit := nil
18 | |}.
19 |
20 | Definition List_Monoid_Cat := Monoid_Cat List_Monoid.
21 |
22 | End List_Monoid_Cat.
23 |
--------------------------------------------------------------------------------
/Archetypal/Monoid_Cat/Monoid_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | (** Monoids are categories. *)
7 | Record Monoid : Type :=
8 | {
9 | Mon_car : Type;
10 |
11 | Mon_op : Mon_car → Mon_car → Mon_car;
12 |
13 | Mon_assoc : ∀ a b c, Mon_op a (Mon_op b c) = Mon_op (Mon_op a b) c;
14 |
15 | Mon_unit : Mon_car;
16 |
17 | Mon_unit_left : ∀ a, Mon_op Mon_unit a = a;
18 |
19 | Mon_unit_right : ∀ a, Mon_op a Mon_unit = a
20 | }.
21 |
22 | Section Monoid_Cat.
23 | Context (M : Monoid).
24 |
25 | Hint Resolve Mon_unit_left Mon_unit_right Mon_assoc : core.
26 |
27 | Program Definition Monoid_Cat : Category :=
28 | {|
29 | Obj := unit;
30 | Hom := fun _ _ => Mon_car M;
31 | compose := fun _ _ _ => Mon_op M;
32 | id := fun a => Mon_unit M
33 | |}.
34 |
35 | End Monoid_Cat.
36 |
--------------------------------------------------------------------------------
/Archetypal/PreOrder_Cat/PreOrder_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | (** Every pre-order relation is a category. *)
7 | Record PreOrder : Type :=
8 | {
9 | PreOrder_car :> Type;
10 |
11 | PreOrder_rel :> PreOrder_car → PreOrder_car → Type
12 | where "a ≤ b" := (PreOrder_rel a b);
13 |
14 | PreOrder_rel_isProp : ∀ x y (h h' : PreOrder_rel x y), h = h';
15 |
16 | PreOrder_refl : ∀ a, a ≤ a;
17 |
18 | PreOrder_trans : ∀ a b c, a ≤ b → b ≤ c → a ≤ c
19 | }.
20 |
21 | Arguments PreOrder_rel {_} _ _.
22 | Arguments PreOrder_refl {_} _.
23 | Arguments PreOrder_trans {_ _ _ _} _ _.
24 |
25 | Notation "a ≤ b" := (PreOrder_rel a b) : preorder_scope.
26 |
27 | Section PreOrder_Cat.
28 | Context (P : PreOrder).
29 |
30 | Local Hint Resolve PreOrder_rel_isProp : core.
31 |
32 | Program Definition PreOrder_Cat : Category :=
33 | {|
34 | Obj := P;
35 | Hom := fun a b => (a ≤ b)%preorder;
36 | compose := @PreOrder_trans P;
37 | id := @PreOrder_refl P
38 | |}
39 | .
40 |
41 | End PreOrder_Cat.
42 |
--------------------------------------------------------------------------------
/Basic_Cons/CCC.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Category.Main.
3 | From Categories Require Export Basic_Cons.Terminal.
4 | From Categories Require Export Basic_Cons.Product.
5 | From Categories Require Export Basic_Cons.Exponential.
6 | From Categories Require Export Basic_Cons.Exponential_Functor.
7 |
8 | (** Cartesian Closed Category : one that has terminal element, binary products
9 | (all finite products) and exponential *)
10 | Class CCC (C : Category) : Type :=
11 | {
12 | CCC_term : (𝟙_ C)%object;
13 | CCC_HP : Has_Products C;
14 | CCC_HEXP : Has_Exponentials C
15 | }.
16 |
17 | Arguments CCC_term _ {_}, {_ _}.
18 | Arguments CCC_HP _ {_} _ _, {_ _} _ _.
19 | Arguments CCC_HEXP _ {_} _ _, {_ _} _ _.
20 |
21 | Existing Instances CCC_term CCC_HP CCC_HEXP.
22 |
23 |
24 |
--------------------------------------------------------------------------------
/Basic_Cons/Equalizer.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | Local Open Scope morphism_scope.
7 |
8 | Section Equalizer.
9 | Context {C : Category} {a b : Obj} (f g : a --> b).
10 |
11 | (** given two parallel arrows f,g : a -> b, their equalizer is an object e
12 | together with an arrow eq : e -> a such that f ∘ eq = g ∘ eq such that
13 | for any other object z and eqz : z -> a that we have f ∘ eqz = g ∘ eqz,
14 | there is a unique arrow h : z -> e that makes the following diagram
15 | commute:
16 |
17 | #
18 |
19 |
20 | eqz
21 | /—————————————————\ f
22 | | ↓ ———————>
23 | z ———–> e ——————> a b
24 | ∃!h eq ———–——–>
25 | g
26 |
27 | #
28 | *)
29 |
30 | Local Open Scope morphism_scope.
31 |
32 | Record Equalizer : Type :=
33 | {
34 | equalizer : C;
35 |
36 | equalizer_morph : equalizer --> a;
37 |
38 | equalizer_morph_com : f ∘ equalizer_morph = g ∘ equalizer_morph;
39 |
40 | equalizer_morph_ex (e' : Obj) (eqm : e' --> a) :
41 | f ∘ eqm = g ∘ eqm → e' --> equalizer;
42 |
43 | equalizer_morph_ex_com (e' : Obj) (eqm : e' --> a)
44 | (eqmc : f ∘ eqm = g ∘ eqm)
45 | : equalizer_morph ∘ (equalizer_morph_ex e' eqm eqmc) = eqm;
46 |
47 | equalizer_morph_unique (e' : Obj) (eqm : e' --> a)
48 | (com : f ∘ eqm = g ∘ eqm) (u u' : e' --> equalizer)
49 | : equalizer_morph ∘ u = eqm → equalizer_morph ∘ u' = eqm → u = u'
50 | }.
51 |
52 | Coercion equalizer : Equalizer >-> Obj.
53 |
54 | (** Equalizers are unique up to isomorphism. *)
55 | Theorem Equalizer_iso (e1 e2 : Equalizer) : (e1 ≃ e2)%isomorphism.
56 | Proof.
57 | apply (Build_Isomorphism _ _ _ (equalizer_morph_ex e2 _ (equalizer_morph e1)
58 | (equalizer_morph_com e1))
59 | ((equalizer_morph_ex e1 _ (equalizer_morph e2)
60 | (equalizer_morph_com e2))));
61 | eapply equalizer_morph_unique; [| | simpl_ids; trivial| | |simpl_ids;
62 | trivial]; try apply equalizer_morph_com;
63 | rewrite <- assoc; repeat rewrite equalizer_morph_ex_com; auto.
64 | Qed.
65 |
66 | End Equalizer.
67 |
68 | Arguments equalizer_morph {_ _ _ _ _} _.
69 | Arguments equalizer_morph_com {_ _ _ _ _} _.
70 | Arguments equalizer_morph_ex {_ _ _ _ _} _ {_ _} _.
71 | Arguments equalizer_morph_ex_com {_ _ _ _ _} _ {_ _} _.
72 | Arguments equalizer_morph_unique {_ _ _ _ _} _ {_ _ _} _ _ _ _.
73 |
74 | Arguments Equalizer _ {_ _} _ _, {_ _ _} _ _.
75 |
76 | Definition Has_Equalizers (C : Category) : Type :=
77 | ∀ (a b : C) (f g : a --> b), Equalizer f g.
78 |
79 | Existing Class Has_Equalizers.
80 |
81 | (** CoEqualizer is the dual of equalzier *)
82 | Definition CoEqualizer {C : Category} := @Equalizer (C^op).
83 |
84 | Arguments CoEqualizer _ {_ _} _ _, {_ _ _} _ _.
85 |
86 | Definition Has_CoEqualizers (C : Category) : Type := Has_Equalizers (C^op).
87 |
88 | Existing Class Has_CoEqualizers.
89 |
--------------------------------------------------------------------------------
/Basic_Cons/Exponential_Functor.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat.
6 | From Categories Require Import Functor.Main.
7 | From Categories Require Import Basic_Cons.Product.
8 | From Categories Require Import Basic_Cons.Exponential.
9 |
10 | Local Obligation Tactic := idtac.
11 | (**
12 | The exponential functor maps each pair of objects (a, b) (an object of product
13 | category Cᵒᵖ × C -> C) to the exponential bᵃ.
14 | *)
15 | Program Definition Exp_Func {C : Category}
16 | {hp : Has_Products C}
17 | (exps : ∀ a b, (a ⇑ b)%object)
18 | : ((C^op × C) --> C)%functor :=
19 | {|
20 | FO := fun x => exps (fst x) (snd x);
21 | FA := fun a b f =>
22 | Exp_morph_ex
23 | _ _
24 | ((snd f) ∘ (eval _)
25 | ∘ ((×ᶠⁿᶜ C) @_a
26 | (_, fst b) (_, fst a)
27 | (id (exps (fst a) (snd a)), fst f)))%morphism
28 | |}.
29 |
30 | Next Obligation. (* F_id *)
31 | Proof.
32 | program_simpl.
33 | eapply Exp_morph_unique.
34 | rewrite <- Exp_morph_com.
35 | reflexivity.
36 | simpl; simpl_ids; reflexivity.
37 | Qed.
38 |
39 | Next Obligation. (* F_compose *)
40 | Proof.
41 | intros.
42 | eapply Exp_morph_unique.
43 | rewrite <- Exp_morph_com; reflexivity.
44 | rewrite Prod_compose_id.
45 | rewrite F_compose.
46 | rewrite <- (assoc _ _ (eval _)).
47 | rewrite <- Exp_morph_com.
48 | repeat rewrite assoc.
49 | rewrite <- F_compose.
50 | rewrite <- Prod_cross_compose.
51 | rewrite F_compose.
52 | match goal with
53 | [|- _ = (?X ∘ ?A ∘ ?B ∘ _)%morphism] =>
54 | rewrite (assoc_sym _ _ X);
55 | rewrite (assoc_sym _ _ (X ∘ A));
56 | rewrite (assoc _ _ X)
57 | end.
58 | rewrite <- Exp_morph_com.
59 | repeat rewrite assoc.
60 | rewrite <- F_compose.
61 | cbn; auto.
62 | Qed.
63 |
64 | Arguments Exp_Func {_ _} _, {_} _ _, _ _ _.
65 |
66 | Notation "⇑ᶠⁿᶜ" := Exp_Func : functor_scope.
67 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Basic_Cons.Facts.Main.
2 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts/Equalizer_Monic.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | From Categories Require Import Basic_Cons.Equalizer.
7 |
8 | Section Equalizer_Monic.
9 | Context {C : Category} {a b} (f g : (a --> b)%morphism) {e : Equalizer f g}.
10 |
11 | Program Definition Equalizer_Monic : (e ≫–> a)%morphism :=
12 | {|
13 | mono_morphism := equalizer_morph e
14 | |}.
15 |
16 | Next Obligation. (* mono_morphism_monomorphism *)
17 | Proof.
18 | match goal with
19 | [H : ?A = ?B :> (c --> a)%morphism |- _] =>
20 | let H1 := fresh "H" in
21 | let H2 := fresh "H" in
22 | cut (f ∘ A = g ∘ A)%morphism;
23 | [intros H1;
24 | cut (f ∘ B = g ∘ B)%morphism;
25 | [intros H2 | do 2 rewrite <- assoc; rewrite equalizer_morph_com;
26 | trivial]|
27 | do 2 rewrite <- assoc; rewrite equalizer_morph_com; trivial]
28 | end.
29 | eapply equalizer_morph_unique; eauto.
30 | Qed.
31 |
32 | End Equalizer_Monic.
33 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts/Init_Prod.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 |
7 | From Categories Require Import Basic_Cons.CCC.
8 |
9 | From Categories Require Import NatTrans.NatTrans NatTrans.NatIso.
10 | From Categories Require Import Yoneda.Yoneda.
11 |
12 | (** 0 × a ≃ 0. where 0 is the initial object *)
13 | Section Init_Prod.
14 | Context {C : Category} {C_CCC : CCC C} {init : (𝟘_ C)%object}.
15 |
16 | Local Notation "0" := (terminal init) : object_scope.
17 |
18 | (* Local Notation "a × b" := (CHP a b) : object_scope. *)
19 |
20 | (** Natural transformations to be used with Yoneda. *)
21 |
22 | Program Definition Init_Prod_lr a :
23 | (((((CoYoneda C) _o) ((×ᶠⁿᶜ C) _o (0, a)))%object)
24 | --> (((CoYoneda C) _o) 0)%object)%nattrans
25 | :=
26 | {|
27 | Trans := fun b f => @t_morph _ init b
28 | |}.
29 |
30 | Next Obligation.
31 | Proof.
32 | extensionality g.
33 | apply t_morph_unique.
34 | Qed.
35 |
36 | Next Obligation.
37 | Proof.
38 | symmetry.
39 | apply Init_Prod_lr_obligation_1.
40 | Qed.
41 |
42 | Program Definition Init_Prod_rl a :
43 | (((((CoYoneda C) _o) 0)%object)
44 | --> (((CoYoneda C) _o) ((×ᶠⁿᶜ C) _o (0, a)))%object)%nattrans
45 | :=
46 | {|
47 | Trans := fun c g => compose C (Pi_1 (CCC_HP C init a)) (t_morph init c)
48 | |}.
49 |
50 | Next Obligation.
51 | Proof.
52 | extensionality g.
53 | simpl_ids.
54 | rewrite <- assoc.
55 | apply f_equal.
56 | apply (t_morph_unique init).
57 | Qed.
58 |
59 | Next Obligation.
60 | Proof.
61 | symmetry.
62 | apply Init_Prod_rl_obligation_1.
63 | Qed.
64 |
65 | Theorem Init_Prod a :
66 | (((×ᶠⁿᶜ C) _o (0, a)%object) ≃ 0)%isomorphism.
67 | Proof.
68 | apply (@CoIso (C^op)).
69 | CoYoneda.
70 | apply (NatIso _ _ (Init_Prod_lr a) (Init_Prod_rl a)).
71 | {
72 | intros c.
73 | extensionality g; simpl.
74 | apply (t_morph_unique init).
75 | }
76 | {
77 | intros c.
78 | eapply functional_extensionality; intros g; simpl; simpl_ids.
79 | match goal with
80 | [|- ?A = ?B] =>
81 | erewrite <- uncurry_curry with(f := A);
82 | erewrite <- uncurry_curry with (f := B)
83 | end.
84 | apply f_equal.
85 | apply (t_morph_unique init).
86 | }
87 | Qed.
88 |
89 | End Init_Prod.
90 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Basic_Cons.Facts.Init_Prod.
2 | From Categories Require Export Basic_Cons.Facts.Term_Prod.
3 | From Categories Require Export Basic_Cons.Facts.Equalizer_Monic.
4 | From Categories Require Export Basic_Cons.Facts.Adjuncts.
5 |
6 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts/Term_IsoCat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
6 | From Categories Require Import Basic_Cons.Terminal.
7 | From Categories Require Import Cat.Cat Cat.Cat_Iso.
8 |
9 | (** In this section we show that if a category C has a terminal object and D is
10 | a category isomorphic to C, then D also has a terminal object. *)
11 | Section Term_IsoCat.
12 | Context {C D : Category}
13 | (I : (C ≃≃ D ::> Cat)%isomorphism) (trm : (𝟙_ C)%object).
14 |
15 | Program Definition Term_IsoCat : (𝟙_ D)%object
16 | :=
17 | {|
18 | terminal := ((iso_morphism I) _o)%object trm;
19 | t_morph :=
20 | fun c =>
21 | match
22 | f_equal (fun w : (D --> D)%functor => (w _o)%object c)
23 | (right_inverse I)
24 | in _ = u return
25 | (u --> _)%morphism
26 | with
27 | eq_refl => ((iso_morphism I) _a ((t_morph
28 | trm ((I⁻¹)%morphism _o c)))
29 | )%morphism
30 | end;
31 | t_morph_unique :=
32 | fun c f g => _
33 | |}
34 | .
35 |
36 | Next Obligation.
37 | Proof.
38 | assert (H := f_equal
39 | (fun w : (C --> C)%functor => (w _o)%object (terminal trm))
40 | (left_inverse I)).
41 | cbn in H.
42 | cut (
43 | match H in _ = u return
44 | (_ --> u)%morphism
45 | with
46 | | eq_refl => ((I ⁻¹) _a f)%morphism
47 | end
48 | =
49 | match H in _ = u return
50 | (_ --> u)%morphism
51 | with
52 | | eq_refl => ((I ⁻¹) _a g)%morphism
53 | end
54 | ).
55 | {
56 | intros H2.
57 | destruct H.
58 | match type of H2 with
59 | ?A = ?B =>
60 | assert (((iso_morphism I) _a A) = ((iso_morphism I) _a B))%morphism
61 | by (rewrite H2; trivial)
62 | end.
63 | rewrite <- (Cat_Iso_conv_inv_I_inv_I (Inverse_Isomorphism I) f).
64 | rewrite <- (Cat_Iso_conv_inv_I_inv_I (Inverse_Isomorphism I) g).
65 | apply f_equal.
66 | trivial.
67 | }
68 | {
69 | apply t_morph_unique.
70 | }
71 | Qed.
72 |
73 | End Term_IsoCat.
74 |
--------------------------------------------------------------------------------
/Basic_Cons/Facts/Term_Prod.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 |
7 | From Categories Require Import Basic_Cons.Terminal.
8 | From Categories Require Import Basic_Cons.Product.
9 |
10 | From Categories Require Import NatTrans.NatTrans NatTrans.NatIso.
11 | From Categories Require Import Yoneda.Yoneda.
12 |
13 | (** 1 × a ≃ a. where 1 is the terminal object. *)
14 | Section Term_Prod.
15 | Context {C : Category} {term : (𝟙_ C)%object} {CHP : Has_Products C}.
16 |
17 | Local Notation "1" := (terminal term) : object_scope.
18 |
19 | Local Notation "a × b" := (CHP a b) : object_scope.
20 |
21 | (** Natural transformations to be used with Yoneda. *)
22 | Program Definition Term_Prod_lr (a : C) :
23 | ((((Yoneda C) _o (a × 1))%object)
24 | --> ((Yoneda C) _o a)%object)%nattrans
25 | :=
26 | {|
27 | Trans := fun b f => @compose C _ _ _ f (@Pi_1 _ _ _ (CHP a term))
28 | |}.
29 |
30 | Program Definition Term_Prod_rl (a : C) :
31 | ((((Yoneda C) _o a)%object)
32 | --> ((Yoneda C) _o (a × 1))%object)%nattrans
33 | :=
34 | {|
35 | Trans := fun b f => @Prod_morph_ex C _ _ _ _ f (@t_morph C _ b)
36 | |}.
37 |
38 | Next Obligation. (* Trans_com *)
39 | Proof.
40 | extensionality g.
41 | eapply Prod_morph_unique; simpl_ids.
42 | apply Prod_morph_com_1.
43 | apply Prod_morph_com_2.
44 | rewrite <- assoc.
45 | rewrite Prod_morph_com_1; trivial.
46 | rewrite <- assoc.
47 | rewrite Prod_morph_com_2.
48 | apply t_morph_unique.
49 | Qed.
50 |
51 | Next Obligation. (* Trans_com *)
52 | Proof.
53 | symmetry.
54 | apply Term_Prod_rl_obligation_1.
55 | Qed.
56 |
57 | Theorem Term_Prod (a : C) : (((×ᶠⁿᶜ C) _o (a, 1)%object) ≃ a)%isomorphism.
58 | Proof.
59 | Yoneda.
60 | apply (NatIso _ _ (Term_Prod_lr a) (Term_Prod_rl a)).
61 | {
62 | intros c.
63 | extensionality g; simpl.
64 | simpl_ids.
65 | apply Prod_morph_com_1.
66 | }
67 | {
68 | intros c.
69 | extensionality g; simpl.
70 | simpl_ids.
71 | eapply Prod_morph_unique.
72 | apply Prod_morph_com_1.
73 | apply Prod_morph_com_2.
74 | trivial.
75 | apply t_morph_unique.
76 | }
77 | Qed.
78 |
79 | End Term_Prod.
80 |
--------------------------------------------------------------------------------
/Basic_Cons/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Basic_Cons.CCC.
2 | From Categories Require Export Basic_Cons.Equalizer.
3 | From Categories Require Export Basic_Cons.PullBack.
4 | From Categories Require Export Basic_Cons.LCCC.
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/Basic_Cons/Product.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
6 | Ext_Cons.Prod_Cat.Operations.
7 | From Categories Require Import Functor.Main.
8 |
9 | Local Open Scope morphism_scope.
10 |
11 | (**
12 | Given two objects a and b, their product a×b is an object such that there are
13 | two projections from it to a and b:
14 |
15 | #
16 |
17 |
18 | π₁ π₂
19 | a <—–——– a×b ———–—> b
20 |
21 | #
22 | such that for any object z with two projections to a and b, there is a unique
23 | arrow h that makes the following diagram commute:
24 |
25 | #
26 |
27 | π₁ π₂
28 | a <—–——–– a×b –———–—> b
29 | ↖ ↑ ↗
30 | \ | /
31 | \ | /
32 | \ |∃!h /
33 | \ | /
34 | \ | /
35 | \ | /
36 | z
37 |
38 | #
39 | *)
40 | Record Product {C : Category} (c d : C) : Type :=
41 | {
42 | product : C;
43 |
44 | Pi_1 : product --> c;
45 |
46 | Pi_2 : product --> d;
47 |
48 | Prod_morph_ex : ∀ (p' : Obj) (r1 : p' --> c) (r2 : p' --> d), p' --> product;
49 |
50 | Prod_morph_com_1 : ∀ (p' : Obj) (r1 : p' --> c) (r2 : p' --> d),
51 | (Pi_1 ∘ (Prod_morph_ex p' r1 r2))%morphism = r1;
52 |
53 | Prod_morph_com_2 : ∀ (p' : Obj) (r1 : p' --> c) (r2 : p' --> d),
54 | (Pi_2 ∘ (Prod_morph_ex p' r1 r2))%morphism = r2;
55 |
56 | Prod_morph_unique :
57 | ∀ (p' : Obj) (r1 : p' --> c) (r2 : p' --> d) (f g : p' --> product),
58 | Pi_1 ∘ f = r1
59 | → Pi_2 ∘ f = r2
60 | → Pi_1 ∘ g = r1
61 | → Pi_2 ∘ g = r2
62 | → f = g
63 | }.
64 |
65 | Arguments Product _ _ _, {_} _ _.
66 |
67 | Arguments Pi_1 {_ _ _ _}, {_ _ _} _.
68 | Arguments Pi_2 {_ _ _ _}, {_ _ _} _.
69 | Arguments Prod_morph_ex {_ _ _} _ _ _ _.
70 | Arguments Prod_morph_com_1 {_ _ _} _ _ _ _.
71 | Arguments Prod_morph_com_2 {_ _ _} _ _ _ _.
72 | Arguments Prod_morph_unique {_ _ _} _ _ _ _ _ _ _ _ _ _.
73 |
74 | Coercion product : Product >-> Obj.
75 |
76 | Notation "a × b" := (Product a b) : object_scope.
77 |
78 | Local Open Scope object_scope.
79 |
80 | (** for any pair of objects, their product is unique up to isomorphism. *)
81 | Theorem Product_iso {C : Category} (c d : Obj) (P : c × d) (P' : c × d)
82 | : (P ≃ P')%isomorphism.
83 | Proof.
84 | eapply (Build_Isomorphism _ _ _
85 | (Prod_morph_ex P' P Pi_1 Pi_2)
86 | (Prod_morph_ex P P' Pi_1 Pi_2));
87 | eapply Prod_morph_unique; eauto;
88 | rewrite <- assoc;
89 | repeat (rewrite Prod_morph_com_1 || rewrite Prod_morph_com_2); auto.
90 | Qed.
91 |
92 | Definition Has_Products (C : Category) : Type := ∀ a b, a × b.
93 |
94 | Existing Class Has_Products.
95 |
96 | (**
97 | The product functor maps each pair of objects (an object of the product
98 | category C×C) to their product in C.
99 | *)
100 | Program Definition Prod_Func (C : Category) {HP : Has_Products C}
101 | : ((C × C) --> C)%functor :=
102 | {|
103 | FO := fun x => HP (fst x) (snd x);
104 | FA := fun a b f => Prod_morph_ex _ _ ((fst f) ∘ Pi_1) ((snd f) ∘ Pi_2)
105 | |}.
106 |
107 | Next Obligation. (* F_id *)
108 | Proof.
109 | eapply Prod_morph_unique;
110 | try reflexivity; [rewrite Prod_morph_com_1|rewrite Prod_morph_com_2]; auto.
111 | Qed.
112 | Next Obligation. (* F_compose *)
113 | Proof.
114 | eapply Prod_morph_unique;
115 | try ((rewrite Prod_morph_com_1 || rewrite Prod_morph_com_2); reflexivity);
116 | repeat rewrite <- assoc; (rewrite Prod_morph_com_1 || rewrite Prod_morph_com_2);
117 | rewrite assoc; (rewrite Prod_morph_com_1 || rewrite Prod_morph_com_2); auto.
118 | Qed.
119 |
120 | Arguments Prod_Func _ _, _ {_}.
121 |
122 | Notation "×ᶠⁿᶜ" := Prod_Func : functor_scope.
123 |
124 | (** Sum is the dual of product *)
125 | Definition Sum (C : Category) := @Product (C^op).
126 |
127 | Arguments Sum _ _ _, {_} _ _.
128 |
129 | Notation "a + b" := (Sum a b) : object_scope.
130 |
131 | Definition Has_Sums (C : Category) : Type := ∀ (a b : C), (a + b)%object.
132 |
133 | Existing Class Has_Sums.
134 |
135 | (**
136 | The sum functor maps each pair of objects (an object of the product category
137 | C×C) to their sum in C.
138 | *)
139 | Definition Sum_Func {C : Category} {HS : Has_Sums C} : ((C × C) --> C)%functor :=
140 | (×ᶠⁿᶜ (C^op) HS)^op.
141 |
142 | Arguments Sum_Func _ _, _ {_}.
143 |
144 | Notation "+ᶠⁿᶜ" := Sum_Func : functor_scope.
145 |
--------------------------------------------------------------------------------
/Basic_Cons/Terminal.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 |
7 | (** The terminal object in category C is an object t such that for any object a,
8 | there is a unique arrow ! : a -> t. *)
9 | Class Terminal (C : Category) : Type :=
10 | {
11 | terminal : C;
12 | t_morph : ∀ (d : Obj), (d --> terminal)%morphism;
13 | t_morph_unique : ∀ (d : Obj) (f g : (d --> terminal)%morphism), f = g
14 | }.
15 |
16 | Arguments terminal {_} _.
17 | Arguments t_morph {_} _ _.
18 | Arguments t_morph_unique {_} _ _ _ _.
19 |
20 | Coercion terminal : Terminal >-> Obj.
21 |
22 | Notation "𝟙_ C" := (Terminal C) (at level 75) : object_scope.
23 |
24 | (** (The) terminal object is unique up to isomorphism. *)
25 | Theorem Terminal_iso {C : Category} (T T' : (𝟙_ C)%object) :
26 | (T ≃ T')%isomorphism.
27 | Proof.
28 | apply (Build_Isomorphism _ _ _ (t_morph _ _) (t_morph _ _));
29 | apply t_morph_unique.
30 | Qed.
31 |
32 | (** The initial is the dual of the terminal object. *)
33 | Definition Initial (C : Category) := (𝟙_ (C ^op))%object.
34 | Existing Class Initial.
35 |
36 | Notation "𝟘_ C" := (Initial C) (at level 75) : object_scope.
37 |
--------------------------------------------------------------------------------
/Cat/CCC.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Category.
2 |
3 | From Categories Require Import Basic_Cons.CCC.
4 |
5 | From Categories Require Export Cat.Cat.
6 |
7 | From Categories Require Export Cat.Terminal.
8 | From Categories Require Export Cat.Product.
9 | From Categories Require Export Cat.Exponential.
10 |
11 | Program Instance Cat_CCC : CCC Cat.
12 |
13 |
14 |
--------------------------------------------------------------------------------
/Cat/Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
3 |
4 | Local Open Scope functor_scope.
5 |
6 | (** Cat, the category of (small) categories, is a category whose objects are
7 | (small) categories and morphisms are functors.
8 |
9 | In this development, the (relative) smallness/largeness is represented by
10 | universe levels and universe polymorphism of Coq.
11 | *)
12 | Definition Cat : Category :=
13 | {|
14 | Obj := Category;
15 |
16 | Hom := Functor;
17 |
18 | compose := fun C D E => Functor_compose;
19 |
20 | assoc := fun C D E F (G : C --> D) (H : D --> E) (I : E --> F) =>
21 | @Functor_assoc _ _ _ _ G H I;
22 |
23 | assoc_sym := fun C D E F (G : C --> D) (H : D --> E) (I : E --> F) =>
24 | eq_sym (@Functor_assoc _ _ _ _ G H I);
25 |
26 | id := fun C => Functor_id C;
27 |
28 | id_unit_left := fun C D => @Functor_id_unit_left C D;
29 |
30 | id_unit_right := fun C D => @Functor_id_unit_right C D
31 | |}.
32 |
--------------------------------------------------------------------------------
/Cat/Exponential.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
8 | Ext_Cons.Prod_Cat.Operations.
9 | From Categories Require Import Basic_Cons.Product.
10 | From Categories Require Import Basic_Cons.Exponential.
11 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
12 | From Categories Require Import Cat.Product.
13 |
14 | (** The exponential in cat is jsut the functor category. *)
15 |
16 | Local Open Scope functor_scope.
17 |
18 | (** Evaluation functor. *)
19 | Program Definition Exp_Cat_Eval (C C' : Category) :
20 | ((Func_Cat C C') × C) --> C' :=
21 | {|
22 | FO := fun x => ((fst x) _o (snd x))%object;
23 | FA := fun A B f => (((fst B) _a (snd f)) ∘ (@Trans _ _ _ _ (fst f) _))%morphism
24 | |}.
25 |
26 | Next Obligation. (* F_compose *)
27 | Proof.
28 | repeat rewrite F_compose.
29 | repeat rewrite assoc.
30 | match goal with
31 | [|- (?A ∘ ?B = ?A ∘ ?C)%morphism] => assert (B = C) as ->; trivial
32 | end.
33 | repeat rewrite assoc_sym.
34 | match goal with
35 | [|- (?A ∘ ?B = ?C ∘ ?B)%morphism] => assert (A = C) as ->; trivial
36 | end.
37 | rewrite Trans_com; trivial.
38 | Qed.
39 |
40 | (* Exp_Cat_Eval defined *)
41 |
42 | (** The arrow map of curry functor. *)
43 | Program Definition Exp_Cat_morph_ex_A
44 | {C C' C'' : Category} (F : (C'' × C) --> C')
45 | (a b : C'') (h : (a --> b)%morphism)
46 | :
47 | ((Fix_Bi_Func_1 a F) --> (Fix_Bi_Func_1 b F))%nattrans :=
48 | {|
49 | Trans := fun c => (F _a (h, id _ c))%morphism
50 | |}.
51 |
52 | (* Exp_Cat_morph_ex_A defined *)
53 |
54 | Local Hint Extern 1 => apply NatTrans_eq_simplify; cbn : core.
55 |
56 | (** The curry functor. *)
57 | Program Definition Exp_Cat_morph_ex
58 | {C C' C'' : Category}
59 | (F : (C'' × C) --> C')
60 | :
61 | C'' --> (Func_Cat C C') :=
62 | {|
63 | FO := fun a => Fix_Bi_Func_1 a F;
64 | FA := Exp_Cat_morph_ex_A F
65 | |}.
66 |
67 | (** Proof that currying after uncurrying gives back the same functor. *)
68 | Lemma Exp_cat_morph_ex_eval_id
69 | {C C' C'' : Category}
70 | (u : C'' --> (Func_Cat C C'))
71 | :
72 | (u =
73 | Exp_Cat_morph_ex
74 | (
75 | (Exp_Cat_Eval C C')
76 | ∘ ((×ᶠⁿᶜ _ Cat_Has_Products) @_a (_, _) (_, _) (u, id Cat C))
77 | )
78 | )%morphism.
79 | Proof.
80 | Func_eq_simpl.
81 | {
82 | extensionality a; extensionality b; extensionality h; cbn.
83 | apply NatTrans_eq_simplify.
84 | extensionality m.
85 | apply JMeq_eq.
86 | apply (@JMeq_trans _ _ _ _ (Trans (u _a h)%morphism m)).
87 | + match goal with [H : _ = _ |-_] => destruct H end; trivial.
88 | + cbn; auto.
89 | }
90 | {
91 | FunExt; cbn.
92 | Func_eq_simpl; FunExt; cbn.
93 | auto.
94 | }
95 | Qed.
96 |
97 | (** The exponential for category of categories (functor categories). *)
98 | Program Definition Cat_Exponential (C C' : Cat) : (C ⇑ C')%object :=
99 | {|
100 | exponential := Func_Cat C C';
101 | eval := Exp_Cat_Eval C C';
102 | Exp_morph_ex := fun C'' F => @Exp_Cat_morph_ex C C' C'' F
103 | |}.
104 |
105 | Next Obligation. (* Exp_morph_com *)
106 | Proof.
107 | Func_eq_simpl.
108 | FunExt; cbn.
109 | rewrite <- F_compose; cbn.
110 | auto.
111 | Qed.
112 |
113 | Local Obligation Tactic := idtac.
114 |
115 | Next Obligation. (* Exp_morph_unique *)
116 | Proof.
117 | intros C C' z f u u' H1 H2; simpl in *.
118 | match type of H1 with
119 | _ = ?A => match type of H2 with
120 | _ = ?B => assert (A = B) as H3; auto; clear H1 H2
121 | end
122 | end.
123 | assert (H4 := @f_equal _ _ Exp_Cat_morph_ex _ _ H3).
124 | etransitivity; [apply Exp_cat_morph_ex_eval_id|].
125 | etransitivity; [|symmetry; apply Exp_cat_morph_ex_eval_id].
126 | trivial.
127 | Qed.
128 |
129 | (* Cat_Exponentials defined *)
130 |
131 | Program Instance Cat_Has_Exponentials : Has_Exponentials Cat := Cat_Exponential.
132 |
--------------------------------------------------------------------------------
/Cat/Facts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Cat.Initial.
2 | From Categories Require Export Cat.Terminal.
3 | From Categories Require Export Cat.Product.
4 | From Categories Require Export Cat.Exponential.
5 | From Categories Require Export Cat.CCC.
6 |
--------------------------------------------------------------------------------
/Cat/Initial.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Category.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import Basic_Cons.Terminal.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 |
10 | (** The unique functor from the initial category to any other. *)
11 | Program Definition Functor_From_Empty_Cat (C' : Category) : (0 --> C')%functor :=
12 | {|
13 | FO := fun x => Empty_rect _ x;
14 | FA := fun a b f => match a as _ return _ with end
15 | |}.
16 |
17 | Local Hint Extern 1 => cbn in * : core.
18 |
19 | (** Empty Cat is the initial category. *)
20 | Program Instance Cat_Init : (𝟘_ Cat)%object :=
21 | {|
22 | terminal := 0%category;
23 | t_morph := fun x => Functor_From_Empty_Cat x
24 | |}.
25 |
--------------------------------------------------------------------------------
/Cat/Product.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat Ext_Cons.Prod_Cat.Operations.
8 | From Categories Require Import Basic_Cons.Product.
9 |
10 | Local Notation "A × B" := (@Product Cat A B) : object_scope.
11 |
12 | (** Product in category of categories is imply the product of actegories *)
13 | Program Definition Cat_Products (C C' : Category) : (C × C')%object :=
14 | {|
15 | product := (C × C')%category;
16 |
17 | Pi_1 := Cat_Proj1 C C';
18 |
19 | Pi_2 := Cat_Proj2 C C';
20 |
21 | Prod_morph_ex := fun P => fun F G => Functor_compose (Diag_Func P) (Prod_Functor F G)
22 | |}.
23 |
24 | Local Obligation Tactic := idtac.
25 |
26 | Next Obligation. (* Prod_morph_unique *)
27 | Proof.
28 | intros C C' p' r1 r2 f g H1 H2 H3 H4.
29 | cbn in *.
30 | transitivity (Functor_compose (Diag_Func p') (Prod_Functor r1 r2)).
31 | + symmetry.
32 | rewrite <- H1, <- H2.
33 | apply Prod_Functor_Cat_Proj.
34 | + rewrite <- H3, <- H4.
35 | apply Prod_Functor_Cat_Proj.
36 | Qed.
37 |
38 | (* Cat_Products defined *)
39 |
40 | Program Instance Cat_Has_Products : Has_Products Cat := Cat_Products.
41 |
42 |
43 |
44 |
45 |
--------------------------------------------------------------------------------
/Cat/Terminal.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import Basic_Cons.Terminal.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 | From Categories Require Import NatTrans.NatTrans NatTrans.NatIso.
10 |
11 | (** The unique functor to the terminal category. *)
12 | Program Definition Functor_To_1_Cat (C' : Category) : (C' --> 1)%functor :=
13 | {|
14 | FO := fun x => tt;
15 | FA := fun a b f => tt;
16 | F_id := fun _ => eq_refl;
17 | F_compose := fun _ _ _ _ _ => eq_refl
18 | |}.
19 |
20 | (** Terminal category. *)
21 | Program Instance Cat_Term : (𝟙_ Cat)%object :=
22 | {
23 | terminal := 1%category;
24 |
25 | t_morph := fun x => Functor_To_1_Cat x
26 | }.
27 |
28 | Next Obligation. (* t_morph_unique *)
29 | Proof.
30 | Func_eq_simpl;
31 | FunExt;
32 | match goal with
33 | [|- ?A = ?B] =>
34 | destruct A;
35 | destruct B end;
36 | trivial.
37 | Qed.
38 |
39 | (** A functor from terminal category maps all arrows (any arrow is just the
40 | identity) to the identity arrow. *)
41 | Section From_Term_Cat.
42 | Context {C : Category} (F : (1 --> C)%functor).
43 |
44 | Theorem From_Term_Cat : ∀ h, (F @_a tt tt h)%morphism = id.
45 | Proof.
46 | destruct h.
47 | change tt with (id 1 tt).
48 | apply F_id.
49 | Qed.
50 |
51 | End From_Term_Cat.
52 |
53 | (** Any two functors from a category to the terminal categoy are naturally
54 | isomorphic. *)
55 | Program Definition Functor_To_1_Cat_Iso
56 | {C : Category}
57 | (F F' : (C --> 1)%functor)
58 | : (F ≃ F')%natiso :=
59 | {|
60 | iso_morphism :=
61 | {|
62 | Trans := fun _ => tt
63 | |};
64 | inverse_morphism :=
65 | {|
66 | Trans := fun _ => tt
67 | |}
68 | |}.
69 |
--------------------------------------------------------------------------------
/Category/Composable_Chain.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Category.
5 | Local Open Scope morphism_scope.
6 |
7 | (** A composable chain in a category from a to b is a single arrow from a to b
8 | or an arrow from a to some c provided that there is a composable chain from c
9 | to b.
10 |
11 | Composable chains are used in defining images of functors.
12 | *)
13 | Inductive Composable_Chain (C : Category) (a b : C) : Type :=
14 | | Single : (a --> b) → Composable_Chain C a b
15 | | Chain : ∀ (c : Obj),
16 | (a --> c) → Composable_Chain C c b → Composable_Chain C a b.
17 |
18 | Arguments Single {_ _ _} _.
19 | Arguments Chain {_ _ _ _} _ _.
20 |
21 | (**
22 | A forall quantifier ofr arrows on a composable chain. Forall ch P is provable if
23 | P x is provable for all arrows x on the composable chain ch.
24 | *)
25 | Fixpoint Forall_Links {C : Category} {a b : C} (ch : Composable_Chain C a b)
26 | (P : ∀ {x y : Obj}, (x --> y) → Prop) : Prop :=
27 | match ch with
28 | | Single f => P f
29 | | Chain f ch' => P f ∧ Forall_Links ch' (@P)
30 | end.
31 |
32 | (**
33 | Computes the composition of a composable chain.
34 | *)
35 | Fixpoint Compose_of {C : Category} {a b : C} (ch : Composable_Chain C a b)
36 | {struct ch} : a --> b :=
37 | match ch with
38 | | Single f => f
39 | | Chain f ch' => (Compose_of ch') ∘ f
40 | end.
41 |
42 | (**
43 | Composes two composable chains (chain-composition).
44 | *)
45 | Fixpoint Chain_Compose {C : Category} {a b c : C} (ch1 : Composable_Chain C a b)
46 | (ch2 : Composable_Chain C b c) : Composable_Chain C a c :=
47 | match ch1 with
48 | | Single f => Chain f ch2
49 | | Chain f ch' => Chain f (Chain_Compose ch' ch2)
50 | end.
51 |
52 | (**
53 | It doesn't matter if we first chain-compose two composable chains and then get
54 | the compostion of the resutlting chain or if we first compose individual chains
55 | and then composte the two resulting arrows.
56 | *)
57 | Theorem Compose_of_Chain_Compose (C : Category) (a b c : C)
58 | (ch1 : Composable_Chain C a b) (ch2 : Composable_Chain C b c)
59 | : ((Compose_of ch2) ∘ (Compose_of ch1))%morphism =
60 | Compose_of (Chain_Compose ch1 ch2).
61 | Proof.
62 | induction ch1; auto.
63 | simpl.
64 | rewrite <- assoc.
65 | rewrite IHch1; trivial.
66 | Qed.
67 |
68 | (**
69 | If a property holds for all arrows of two chains, then the same property holds
70 | for all arrows in their chain-composition.
71 | *)
72 | Theorem Forall_Links_Chain_Compose (C : Category) (a b c : C)
73 | (ch1 : Composable_Chain C a b) (ch2 : Composable_Chain C b c)
74 | (P : ∀ (x y : Obj), (x --> y) → Prop) :
75 | Forall_Links ch1 P → Forall_Links ch2 P → Forall_Links (Chain_Compose ch1 ch2) P.
76 | Proof.
77 | intros H1 H2.
78 | induction ch1.
79 | simpl in *; auto.
80 | destruct H1 as [H11 H12].
81 | simpl in *; split; auto.
82 | Qed.
83 |
--------------------------------------------------------------------------------
/Category/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Category.Category.
2 | From Categories Require Export Category.Morph.
3 | From Categories Require Export Category.Opposite.
4 | From Categories Require Export Category.SubCategory.
5 | From Categories Require Export Category.Composable_Chain.
6 |
--------------------------------------------------------------------------------
/Category/Opposite.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Category.
5 |
6 | (** The oposite of a category C is a category with the same objects where the arrows are inverted.
7 | As a result, f ∘_Cᵒᵖ g is just g ∘_C f and consequently, assoc is assoc_sym (reversed with arrow
8 | arguments) and vice versa. Similarly, id_unit_left and id_unit_right are also swapped. *)
9 |
10 | Definition Opposite (C : Category) : Category :=
11 | {|
12 |
13 | Obj := Obj C;
14 |
15 | Hom := fun a b => (b --> a)%morphism;
16 |
17 | compose :=
18 | fun a b c (f : (b --> a)%morphism) (g : (c --> b)%morphism) => compose C c b a g f;
19 |
20 | id := fun c => id C c;
21 |
22 | assoc := fun _ _ _ _ f g h => assoc_sym h g f;
23 |
24 | assoc_sym := fun _ _ _ _ f g h => assoc h g f;
25 |
26 | id_unit_left := fun _ _ h => @id_unit_right C _ _ h;
27 |
28 | id_unit_right := fun _ _ h => @id_unit_left C _ _ h
29 |
30 | |}.
31 |
32 | Notation "C '^op'" := (Opposite C) : category_scope.
33 |
--------------------------------------------------------------------------------
/Category/SubCategory.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Category.
5 |
6 | (**
7 | A sub category of C is a category whose objects are a subset (here we ues
8 | subset types, i.e., sig) of objects of C and whose arrows are a subset of
9 | arrows of C.
10 |
11 | Here, we define a subcategory using two functions Obj_Cri : Obj C -> Prop
12 | which defines the objects of subcategory and
13 | Hom_Cri : ∀ (a b : Obj) -> Hom a b -> Prop
14 | which defines the arrows of subcategory.
15 | In other words, Obj_Cri and Hom_Cri are respectively cirteria for objects and
16 | arrows being in the sub category. We furthermore, require that the Hom_Cri
17 | provides that identity arrows of all objects in the subcategory are part of
18 | the arrows of the subcategory. Additionally, For ant two composable arrow that
19 | are in the subcategory, their composition must also be in the subcategory.
20 | *)
21 | Section SubCategory.
22 | Context (C : Category)
23 | (Obj_Cri : Obj → Type)
24 | (Hom_Cri : ∀ a b, (a --> b)%morphism → Prop).
25 |
26 | Arguments Hom_Cri {_ _} _.
27 |
28 | Context (Hom_Cri_id : ∀ a, Obj_Cri a → Hom_Cri (id a))
29 | (Hom_Cri_compose :
30 | ∀ a b c (f : (a --> b)%morphism)
31 | (g : (b --> c)%morphism),
32 | Hom_Cri f → Hom_Cri g → Hom_Cri (g ∘ f)).
33 |
34 | Arguments Hom_Cri_id {_} _.
35 | Arguments Hom_Cri_compose {_ _ _ _ _} _ _.
36 |
37 | Local Obligation Tactic := idtac.
38 |
39 | Program Definition SubCategory : Category :=
40 | {|
41 | Obj := sigT Obj_Cri;
42 |
43 | Hom :=
44 | fun a b =>
45 | sig (@Hom_Cri (projT1 a) (projT1 b));
46 |
47 | compose :=
48 | fun _ _ _ f g =>
49 | exist _ _
50 | (Hom_Cri_compose (proj2_sig f) (proj2_sig g));
51 |
52 | id :=
53 | fun a =>
54 | exist _ _ (Hom_Cri_id (projT2 a))
55 | |}.
56 |
57 | Next Obligation.
58 | intros.
59 | apply sig_proof_irrelevance; simpl; abstract auto.
60 | Qed.
61 |
62 | Next Obligation.
63 | symmetry.
64 | apply SubCategory_obligation_1.
65 | Qed.
66 |
67 | Local Hint Extern 3 => simpl : core.
68 |
69 | Local Obligation Tactic := basic_simpl; auto.
70 |
71 | Solve Obligations.
72 |
73 | End SubCategory.
74 |
75 |
76 | (**
77 | A wide subcategory of C is a subcategory of C that has all the objects of C but
78 | not necessarily all its arrows.
79 | *)
80 | Notation Wide_SubCategory C Hom_Cri := (SubCategory C (fun _ => True) Hom_Cri).
81 |
82 | (**
83 | A Full subcategory of C is a subcategory of C that for any pair of objects of
84 | the category that it has, it has all the arrows between them. In practice, we
85 | construct a full subcategory by only expecting an object criterion and setting
86 | the arrow criterrion to accept all arrows.
87 | *)
88 | Notation Full_SubCategory C Obj_Cri :=
89 | (SubCategory C Obj_Cri (fun _ _ _ => True) (fun _ _ => I) (fun _ _ _ _ _ _ _ => I)).
90 |
--------------------------------------------------------------------------------
/Coq_Cats/Coq_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | (** The general form a category whose objects are types (in some universe) and
7 | arrows are functions among them. *)
8 |
9 | Notation Coq_Cat U :=
10 | {|
11 | Obj := U;
12 |
13 | Hom := (fun A B => A → B);
14 |
15 | compose := fun A B C (g : A → B) (h : B → C) => fun (x : A) => h (g x);
16 |
17 | id := fun A => fun x => x
18 | |}.
19 |
20 |
--------------------------------------------------------------------------------
/Coq_Cats/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Type_Cat.Facts.
2 | From Categories Require Export Set_Cat.
3 | From Categories Require Export Prop_Cat.
4 |
5 |
6 |
--------------------------------------------------------------------------------
/Coq_Cats/Prop_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.CCC.
6 | From Categories Require Import Coq_Cats.Coq_Cat.
7 |
8 | (*
9 | **********************************************************
10 | *************** *****************
11 | *************** Prop Category *****************
12 | *************** *****************
13 | **********************************************************
14 | *)
15 |
16 |
17 | (* The category of Types in Coq's "Prop" universe (Coq's Proposits) *)
18 |
19 | Program Definition Prop_Cat : Category := Coq_Cat Prop.
20 |
21 | Local Hint Extern 1 => contradiction : core.
22 |
23 | Program Instance False_init : (𝟘_ Prop_Cat)%object := {|terminal := False|}.
24 |
25 | Local Hint Extern 1 => match goal with
26 | |- ?A = ?B :> True => destruct A; destruct B
27 | end : core.
28 |
29 | Program Instance True_term : (𝟙_ Prop_Cat)%object := {terminal := True}.
30 |
31 | Local Hint Extern 1 => match goal with
32 | |- ?A = ?B :> _ ∧ _ => destruct A; destruct B
33 | end : core.
34 |
35 | Local Hint Extern 1 => tauto : core.
36 |
37 | Section Prod.
38 | Context (P Q : Prop).
39 |
40 | Local Notation "P × Q" := (Product Prop_Cat P Q) : object_scope.
41 |
42 | Program Definition Conj_Product : (P × Q)%object := {|product := (P ∧ Q)|}.
43 |
44 | Local Obligation Tactic := idtac.
45 |
46 | Next Obligation. (* Prod_morph_unique *)
47 | Proof.
48 | intros p' r1 r2 f g H1 H2 H3 H4.
49 | rewrite <- H3 in H1.
50 | rewrite <- H4 in H2.
51 | clear H3 H4.
52 | extensionality x.
53 | apply (fun p => equal_f p x) in H1; apply (fun p => equal_f p x) in H2.
54 | cbn in H1, H2.
55 | destruct (f x); destruct (g x); cbn in *; subst; trivial.
56 | Qed.
57 |
58 | End Prod.
59 |
60 | Program Instance Prop_Cat_Has_Products : Has_Products Prop_Cat := Conj_Product.
61 |
62 | Local Hint Extern 1 => match goal with H : _ ∧ _ |- _ => destruct H end : core.
63 |
64 | Section Exp.
65 | Context (P Q : Prop_Cat).
66 |
67 | Program Definition implication_exp : (P ⇑ Q)%object
68 | :=
69 | {|
70 | exponential := (P -> Q)
71 | |}.
72 |
73 | Local Obligation Tactic := idtac.
74 |
75 | Next Obligation. (* Exp_morph_unique *)
76 | Proof.
77 | intros z f u u' H1 H2.
78 | rewrite H1 in H2; clear H1.
79 | extensionality a; extensionality x.
80 | apply (fun p => equal_f p (conj a x)) in H2.
81 | assumption.
82 | Qed.
83 |
84 | End Exp.
85 |
86 | Program Instance Prop_Cat_Has_Exponentials : Has_Exponentials Prop_Cat :=
87 | implication_exp.
88 |
89 | Program Instance Prop_Cat_CCC : CCC Prop_Cat.
90 |
91 | Local Hint Extern 1 => match goal with H : _ ∨ _ |- _ => destruct H end : core.
92 |
93 | Section Sum.
94 | Context (P Q : Prop).
95 |
96 | Local Notation "P + Q" := (Sum Prop_Cat P Q) : object_scope.
97 |
98 | Program Definition Disj_Sum : (P + Q)%object := {|product := (P ∨ Q)|}.
99 |
100 | Local Obligation Tactic := idtac.
101 |
102 | Next Obligation. (* Sum_morph_unique *)
103 | Proof.
104 | intros p' r1 r2 f g H1 H2 H3 H4.
105 | rewrite <- H3 in H1.
106 | rewrite <- H4 in H2.
107 | clear H3 H4.
108 | extensionality x.
109 | destruct x as [x1|x2].
110 | + apply (fun p => equal_f p x1) in H1; auto.
111 | + apply (fun p => equal_f p x2) in H2; auto.
112 | Qed.
113 |
114 | End Sum.
115 |
116 | Program Instance Prop_Cat_Has_Sums : Has_Sums Prop_Cat := Disj_Sum.
117 |
--------------------------------------------------------------------------------
/Coq_Cats/Set_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Coq_Cats.Coq_Cat.
3 |
4 | (*
5 | **********************************************************
6 | *************** *****************
7 | *************** Set Category *****************
8 | *************** *****************
9 | **********************************************************
10 | *)
11 |
12 |
13 | (** The category of types in Set universe (Coq's "Set")*)
14 |
15 | Program Definition Set_Cat : Category := Coq_Cat Set.
16 |
17 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/CCC.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.CCC.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 |
8 | Program Instance unit_Type_term : (𝟙_ Type_Cat)%object :=
9 | {
10 | terminal := unit;
11 | t_morph := fun _ _=> tt
12 | }.
13 |
14 | Next Obligation. (* t_morph_unique *)
15 | Proof.
16 | extensionality x.
17 | destruct (f x); destruct (g x); reflexivity.
18 | Qed.
19 |
20 |
21 | Local Notation "A × B" := (@Product Type_Cat A B) : object_scope.
22 |
23 | (** The cartesian product of types is the categorical notion of products in
24 | category of types. *)
25 | Program Definition prod_Product (A B : Type) : (A × B)%object :=
26 | {|
27 | product := (A * B)%type;
28 | Pi_1 := fst;
29 | Pi_2 := snd;
30 | Prod_morph_ex := fun p x y z => (x z, y z)
31 | |}.
32 |
33 | Next Obligation. (* Prod_morph_unique *)
34 | Proof.
35 | extensionality x.
36 | repeat
37 | match goal with
38 | [H : _ = _ |- _] =>
39 | apply (fun p => equal_f p x) in H
40 | end.
41 | basic_simpl.
42 | destruct (f x); destruct (g x); cbn in *; subst; trivial.
43 | Qed.
44 |
45 | Program Instance Type_Cat_Has_Products : Has_Products Type_Cat := prod_Product.
46 |
47 | (** The function type in coq is the categorical exponential in the category of
48 | types. *)
49 | Program Definition fun_exp (A B : Type_Cat) : (A ⇑ B)%object :=
50 | {|
51 | exponential := A -> B;
52 | eval := fun x => (fst x) (snd x);
53 | Exp_morph_ex := fun h z u v=> z (u, v)
54 | |}.
55 |
56 | Next Obligation. (* Exp_morph_unique *)
57 | Proof.
58 | extensionality a; extensionality x.
59 | repeat
60 | match goal with
61 | [H : _ = _ |- _] =>
62 | apply (fun p => equal_f p (a, x)) in H
63 | end.
64 | transitivity (f (a, x)); auto.
65 | Qed.
66 |
67 | (* fun_exp defined *)
68 |
69 | Program Instance Type_Cat_Has_Exponentials : Has_Exponentials Type_Cat := fun_exp.
70 |
71 | (* Category of Types is cartesian closed *)
72 |
73 | Program Instance Type_Cat_CCC : CCC Type_Cat.
74 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Card_Restriction.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
6 |
7 | (** A cardinality restriction for types is a property that holds for a type
8 | if and only if it holds for all types isomorphic to it. *)
9 | Record Card_Restriction : Type :=
10 | {
11 | Card_Rest : Type → Prop;
12 |
13 | Card_Rest_Respect : ∀ (A B : Type),
14 | (A ≃≃ B ::> Type_Cat)%isomorphism → Card_Rest A → Card_Rest B
15 | }.
16 |
17 | Coercion Card_Rest : Card_Restriction >-> Funclass.
18 |
19 | (** A type is finite if it is isomorphic to a subset of natural numbers
20 | less than n for soem natural number n. *)
21 | Program Definition Finite : Card_Restriction :=
22 | {|
23 | Card_Rest :=
24 | fun A => inhabited {n : nat & (A ≃≃ {x : nat | x < n} ::> Type_Cat)%isomorphism}
25 | |}.
26 |
27 | Next Obligation.
28 | Proof.
29 | destruct H as [[n I]].
30 | eexists.
31 | refine (existT _ n (I ∘ (X⁻¹)%isomorphism)%isomorphism).
32 | Qed.
33 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Complete.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
3 | From Categories Require Import Type_Cat.GenProd Type_Cat.GenSum Type_Cat.Equalizer.
4 | From Categories Require Import Limits.Limit Limits.GenProd_Eq_Limits.
5 |
6 | Instance Type_Cat_Complete : Complete Type_Cat :=
7 | @GenProd_Eq_Complete Type_Cat Type_Cat_GenProd Type_Cat_Has_Equalizers.
8 |
9 | Instance Type_Cat_CoComplete : CoComplete Type_Cat :=
10 | @GenSum_CoEq_CoComplete Type_Cat Type_Cat_GenSum Type_Cat_Has_CoEqualizers.
11 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Equalizer.v:
--------------------------------------------------------------------------------
1 | From Coq.Relations Require Import Relations Relation_Definitions.
2 | From Categories.Essentials Require Import Notations Types Facts_Tactics Quotient.
3 | From Categories Require Import Category.Main.
4 | From Categories Require Import Basic_Cons.Equalizer.
5 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
6 |
7 | Local Obligation Tactic := idtac.
8 |
9 | (** Just like in category of sets, in category of types, the equalizer is the
10 | type that reperesents the subset of the cartesian profuct of the domain of
11 | the two functions that is mapped to equal values by both functions. *)
12 | Section Equalizer.
13 | Context {A B : Type} (f g : A → B).
14 |
15 | Program Definition Type_Cat_Eq : Equalizer Type_Cat f g :=
16 | {|
17 | equalizer := {x : A | f x = g x};
18 | equalizer_morph := @proj1_sig _ _;
19 | equalizer_morph_ex :=
20 | fun T eqm H x =>
21 | exist _ (eqm x) _
22 | |}.
23 |
24 | Next Obligation.
25 | Proof.
26 | extensionality x; destruct x as [x Px]; trivial.
27 | Qed.
28 |
29 | Next Obligation.
30 | Proof.
31 | intros T eqm H x.
32 | apply (fun w => equal_f w x) in H; trivial.
33 | Qed.
34 |
35 | Next Obligation.
36 | Proof.
37 | trivial.
38 | Qed.
39 |
40 | Next Obligation.
41 | Proof.
42 | intros T eqm H1 u u' H2 H3.
43 | extensionality x.
44 | apply (fun w => equal_f w x) in H2; cbn in H2.
45 | apply (fun w => equal_f w x) in H3; cbn in H3.
46 | destruct (u x) as [ux e]; destruct (u' x) as [ux' e']; cbn in *.
47 | destruct H2; destruct H3.
48 | PIR.
49 | trivial.
50 | Qed.
51 |
52 | End Equalizer.
53 |
54 | (** Similar to the category set, in category of types, the coequalizer of two
55 | functions f,g : A -> B is quotient of B with respect to the equivalence
56 | relation ~. Here, ~ is the equivalence closure of the relation for which we have
57 |
58 | x ~ y if and only if ∃z. (f(z) = x) ∧ (g(z) = y)
59 |
60 | *)
61 |
62 |
63 | Program Instance Type_Cat_Has_Equalizers : Has_Equalizers Type_Cat :=
64 | fun _ _ => Type_Cat_Eq.
65 |
66 | Section CoEqualizer.
67 | Context {A B : Type} (f g : A → B).
68 |
69 | Local Obligation Tactic := idtac.
70 |
71 | Definition CoEq_rel_base : relation B := fun x y => exists z, f z = x ∧ g z = y.
72 |
73 | Program Definition CoEq_rel : EquiRel B :=
74 | {| EQR_rel := clos_refl_sym_trans _ CoEq_rel_base |}.
75 | Next Obligation.
76 | Proof.
77 | split.
78 | exact (equiv_refl _ _ (clos_rst_is_equiv _ CoEq_rel_base)).
79 | exact (equiv_sym _ _ (clos_rst_is_equiv _ CoEq_rel_base)).
80 | exact (equiv_trans _ _ (clos_rst_is_equiv _ CoEq_rel_base)).
81 | Qed.
82 |
83 | Program Definition Type_Cat_CoEq : CoEqualizer Type_Cat f g :=
84 | {|
85 | equalizer := quotient CoEq_rel;
86 | equalizer_morph := λ x, class_of CoEq_rel x;
87 | equalizer_morph_ex e' F H x := F (representative x)
88 | |}.
89 |
90 | Next Obligation.
91 | Proof.
92 | extensionality x; simpl.
93 | apply class_of_inj.
94 | constructor; exists x; eauto.
95 | Qed.
96 |
97 | Next Obligation.
98 | Proof.
99 | intros T eqm Hfg; simpl.
100 | extensionality x.
101 | induction (representative_of_class_of CoEq_rel x)
102 | as [? ? [w [[] []]]| | |]; auto; [].
103 | apply (equal_f Hfg).
104 | Qed.
105 |
106 | Next Obligation.
107 | Proof.
108 | intros T eqm Hfg u u' Hu <-; simpl in *.
109 | extensionality x.
110 | rewrite <- (class_of_representative CoEq_rel x).
111 | apply (equal_f Hu).
112 | Qed.
113 |
114 | End CoEqualizer.
115 |
116 | Program Instance Type_Cat_Has_CoEqualizers : Has_CoEqualizers Type_Cat :=
117 | fun _ _ => Type_Cat_CoEq.
118 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Facts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Coq_Cats.Type_Cat.Initial.
2 | From Categories Require Export Coq_Cats.Type_Cat.CCC.
3 | From Categories Require Export Coq_Cats.Type_Cat.Sum.
4 | From Categories Require Export Coq_Cats.Type_Cat.GenSum.
5 | From Categories Require Export Coq_Cats.Type_Cat.GenProd.
6 | From Categories Require Export Coq_Cats.Type_Cat.Equalizer.
7 | From Categories Require Export Coq_Cats.Type_Cat.Complete.
8 | From Categories Require Export Coq_Cats.Type_Cat.SubObject_Classifier.
9 | From Categories Require Export Coq_Cats.Type_Cat.Topos.
10 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/GenProd.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import Limits.Limit Limits.GenProd_GenSum.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 | From Categories Require Import Basic_Cons.Terminal.
10 |
11 | (** In category of types, generalized products are simply dependent prdoducts. *)
12 | Section Type_Cat_GenProd.
13 | Context (A : Type) (map : A → Type_Cat).
14 |
15 | Local Notation Fm := (Discr_Func Type_Cat map) (only parsing).
16 |
17 | Program Definition Type_Cat_GenProd_Cone : Cone Fm :=
18 | {|
19 | cone_apex :=
20 | {|FO := fun _ => ∀ x : A, (Fm _o x)%object; FA := fun _ _ _ h => h|};
21 | cone_edge := {|Trans := fun x y => y x |}
22 | |}.
23 |
24 | Program Definition Type_Cat_GenProd : (Π map)%object :=
25 | {|
26 | LRKE := Type_Cat_GenProd_Cone;
27 | LRKE_morph_ex :=
28 | fun Cn =>
29 | {|
30 | cone_morph :=
31 | {|Trans :=
32 | fun c X x =>
33 | match c as u return ((Cn _o)%object u → map x) with
34 | | tt => fun X : (Cn _o)%object tt => Trans Cn x X
35 | end X
36 | |}
37 | |}
38 | |}.
39 |
40 | Next Obligation.
41 | Proof.
42 | destruct c; destruct c'; destruct h.
43 | extensionality x; extensionality y.
44 | apply (equal_f ((@Trans_com _ _ _ _ Cn) y y eq_refl) x).
45 | Qed.
46 |
47 | Next Obligation.
48 | Proof.
49 | symmetry.
50 | apply Type_Cat_GenProd_obligation_1.
51 | Qed.
52 |
53 | Next Obligation.
54 | Proof.
55 | apply NatTrans_eq_simplify.
56 | extensionality x; extensionality y; extensionality z.
57 | destruct x.
58 | set (hc := (cone_morph_com h')).
59 | rewrite (cone_morph_com h) in hc.
60 | set (hc' := (f_equal (fun w :
61 | ((Cn ∘ (Functor_To_1_Cat (Discr_Cat A))) --> Fm)%nattrans =>
62 | Trans w z y) hc)); clearbody hc'; clear hc.
63 | trivial.
64 | Qed.
65 |
66 | End Type_Cat_GenProd.
67 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/GenSum.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import Limits.Limit Limits.GenProd_GenSum.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 | From Categories Require Import Basic_Cons.Terminal.
10 |
11 | (** In category of types, generalized sums are simply dependent sum types. *)
12 | Section Type_Cat_GenSum.
13 | Context (A : Type) (map : A → Type_Cat).
14 |
15 | Local Notation Fm := (Discr_Func_op Type_Cat map) (only parsing).
16 |
17 | (** The cocone for the colimit of generalized sum. *)
18 | Program Definition Type_Cat_GenSum_CoCone : CoCone Fm :=
19 | {|
20 | cone_apex := {|FO := fun _ => {x : A & (Fm _o x)%object};
21 | FA := fun _ _ _ h => h|};
22 | cone_edge := {|Trans := fun x => existT _ x |}
23 | |}.
24 |
25 | Program Definition Type_Cat_GenSum : (Σ map)%object :=
26 | {|
27 | LRKE := Type_Cat_GenSum_CoCone;
28 | LRKE_morph_ex :=
29 | fun Cn =>
30 | {|
31 | cone_morph :=
32 | {|Trans :=
33 | fun c h =>
34 | match c as u return ((Cn _o) u)%object with
35 | | tt => Trans Cn (projT1 h) (projT2 h)
36 | end
37 | |}
38 | |}
39 | |}.
40 | Next Obligation.
41 | Proof.
42 | extensionality x.
43 | destruct c; destruct c'; destruct h.
44 | apply (equal_f (@Trans_com _ _ _ _ Cn (projT1 x) (projT1 x) eq_refl)).
45 | Qed.
46 | Next Obligation.
47 | Proof.
48 | symmetry.
49 | apply Type_Cat_GenSum_obligation_1.
50 | Qed.
51 | Next Obligation.
52 | Proof.
53 | apply NatTrans_eq_simplify.
54 | extensionality x; extensionality y.
55 | destruct x.
56 | destruct y as [y1 y2].
57 | cbn in *.
58 | set (hc := (cone_morph_com h')).
59 | rewrite (cone_morph_com h) in hc.
60 | set (hc' := (
61 | f_equal
62 | (fun w :
63 | ((Cn ∘ (Functor_To_1_Cat (Discr_Cat A)^op) ^op)
64 | --> Fm^op)%nattrans
65 | =>
66 | Trans w y1 y2) hc
67 | )
68 | ); clearbody hc'; clear hc.
69 | cbn in *.
70 | apply hc'.
71 | Qed.
72 |
73 | End Type_Cat_GenSum.
74 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Initial.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.Terminal.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 |
8 | Local Obligation Tactic := program_simpl; auto 3.
9 |
10 | (** The empty type is the initial object of category of types. *)
11 | Program Instance Empty_init : (𝟘_ Type_Cat)%object :=
12 | {|terminal := (Empty : Type)|}.
13 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/PullBack.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.CCC Basic_Cons.PullBack.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 |
8 | (** Type_Cat has pullbacks. The pullback of two functions f : a → b and
9 | g : c → b is {(x, y) | f x = g y} *)
10 | Section PullBack.
11 | Context {A B C : Type} (f : A → C) (g : B → C).
12 |
13 | Local Hint Extern 1 =>
14 | match goal with
15 | [x : sig _ |- _ ] =>
16 | let H := fresh "H" in
17 | destruct x as [x H]
18 | end : core.
19 |
20 | Program Definition Type_Cat_PullBack : @PullBack Type_Cat _ _ _ f g :=
21 | {|
22 | pullback := {x : A * B| f (fst x) = g (snd x)};
23 | pullback_morph_1 := fun z => (fst (proj1_sig z));
24 | pullback_morph_2 := fun z => (snd (proj1_sig z));
25 | pullback_morph_ex := fun x p1 p2 H x' => (exist _ (p1 x', p2 x') _)
26 | |}.
27 |
28 | Next Obligation.
29 | Proof.
30 | match goal with
31 | [|- ?A1 (?A2 ?x) = ?B1 (?B2 ?x)] =>
32 | match goal with
33 | [H : (fun w => A1 (A2 w)) = (fun w' => B1 (B2 w')) |- _] =>
34 | apply (equal_f H)
35 | end
36 | end.
37 | Qed.
38 |
39 | Local Obligation Tactic := idtac.
40 |
41 | Next Obligation.
42 | Proof.
43 | intros X p1 p2 H u u' H1 H2 H3 H4.
44 | destruct H3; destruct H4.
45 | extensionality x.
46 | set (H1x := equal_f H1 x); clearbody H1x; clear H1.
47 | set (H2x := equal_f H2 x); clearbody H2x; clear H2.
48 | cbn in *.
49 | match goal with
50 | [|- ?A = ?B] => destruct A as [[a1 a2] Ha]; destruct B as [[b1 b2] Hb]
51 | end.
52 | cbn in *.
53 | apply sig_proof_irrelevance; cbn.
54 | rewrite H1x; rewrite H2x; trivial.
55 | Qed.
56 |
57 | End PullBack.
58 |
59 | Instance Type_Cat_Has_PullBacks : Has_PullBacks Type_Cat :=
60 | fun a b c f g => Type_Cat_PullBack f g.
61 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/SubObject_Classifier.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Topos.SubObject_Classifier.
6 | From Categories Require Import Basic_Cons.Terminal Basic_Cons.PullBack.
7 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat Coq_Cats.Type_Cat.CCC.
8 | Require Import Coq.Logic.ChoiceFacts.
9 | Require Coq.Logic.ClassicalFacts.
10 |
11 | Local Axiom PropExt : ClassicalFacts.prop_extensionality.
12 | Local Axiom ConstructiveIndefiniteDescription_Type :
13 | forall T : Type, ConstructiveIndefiniteDescription_on T.
14 |
15 | (** The type Prop is the sub-object classifier for Type_Cat. With ⊤ mapping the
16 | single element of the singleton set to (True : Prop) *)
17 | Section Type_Cat_characteristic_function_unique.
18 | Context {A B : Type} (F : @Monic Type_Cat A B) (h : B → Prop)
19 | (hpb : is_PullBack (mono_morphism F) (fun _ => tt) h (fun _ => True)).
20 |
21 | Theorem Type_Cat_characteristic_function_unique :
22 | h = fun x => (exists y : A, (mono_morphism F) y = x).
23 | Proof.
24 | extensionality x.
25 | apply PropExt; split.
26 | {
27 | intros Hx.
28 | cut ((fun _ : unit => h x) = (fun _ => True)).
29 | {
30 | intros H.
31 | set (W := equal_f (is_pullback_morph_ex_com_1
32 | hpb unit (fun _ => x) (fun _ => tt) H) tt).
33 | cbn in W.
34 | eexists; exact W.
35 | }
36 | {
37 | extensionality y; apply PropExt; split; trivial.
38 | }
39 | }
40 | {
41 | intros [y []].
42 | set (W := (equal_f (is_pullback_morph_com hpb))).
43 | cbn in W.
44 | rewrite W; trivial.
45 | }
46 | Qed.
47 |
48 | End Type_Cat_characteristic_function_unique.
49 |
50 |
51 | Local Hint Extern 1 =>
52 | match goal with
53 | [|- ?A = ?B :> unit] =>
54 | try destruct A; try destruct B; trivial; fail
55 | end : core.
56 |
57 | Program Definition Type_Cat_SubObject_Classifier : SubObject_Classifier Type_Cat :=
58 | {|
59 | SOC := Prop;
60 | SOC_morph := fun _ : unit => True;
61 | SOC_char := fun A B f x => exists y : A, (mono_morphism f) y = x;
62 | SO_pulback :=
63 | fun A B f =>
64 | {|
65 | is_pullback_morph_ex :=
66 | fun p' pm1 pm2 pmc x =>
67 | proj1_sig (ConstructiveIndefiniteDescription_Type
68 | A _
69 | match eq_sym (equal_f pmc x) in _ = y return y with
70 | eq_refl => I
71 | end)
72 | |}
73 | |}.
74 |
75 | Next Obligation.
76 | Proof.
77 | extensionality x.
78 | apply PropExt; split; intros H; auto.
79 | exists x; trivial.
80 | Qed.
81 |
82 | Next Obligation.
83 | Proof.
84 | extensionality x.
85 | match goal with
86 | [|- mono_morphism ?f (proj1_sig ?A) = _ ] => destruct A as [y Hy]
87 | end.
88 | trivial.
89 | Qed.
90 |
91 | Next Obligation.
92 | Proof.
93 | match goal with
94 | [g : (_ ≫–> _)%morphism |- _] =>
95 | match goal with
96 | [H : (fun w => (mono_morphism g) (_ w)) = (fun x => (mono_morphism g) (_ x)) |- _] =>
97 | apply (mono_morphism_monomorphic g) in H
98 | end
99 | end.
100 | auto.
101 | Qed.
102 |
103 | Next Obligation.
104 | Proof.
105 | etransitivity; [|symmetry];
106 | eapply Type_Cat_characteristic_function_unique; eassumption.
107 | Qed.
108 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Sum.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.Product.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 |
8 | Local Notation "A + B" := (@Sum Type_Cat A B) : object_scope.
9 |
10 | (** The sum of types in coq is the categorical notion of sum in category of
11 | types. *)
12 | Program Definition sum_Sum (A B : Type) : (A + B)%object :=
13 | {|
14 | product := (A + B)%type;
15 | Prod_morph_ex :=
16 | fun (p' : Type)
17 | (r1 : A → p')
18 | (r2 : B → p')
19 | (X : A + B) =>
20 | match X return p' with
21 | | inl a => r1 a
22 | | inr b => r2 b
23 | end
24 | |}.
25 |
26 | Local Obligation Tactic := idtac.
27 |
28 | Next Obligation. (* Sum_morph_unique *)
29 | Proof.
30 | intros A B p' r1 r2 f g H1 H2 H3 H4.
31 | rewrite <- H3 in H1.
32 | rewrite <- H4 in H2.
33 | clear H3 H4.
34 | extensionality x.
35 | destruct x;
36 | match goal with
37 | [|- f (?m ?y) = g (?m ?y)] =>
38 | apply (@equal_f _ _ (fun x => f (m x)) (fun x => g (m x)))
39 | end; auto.
40 | Qed.
41 |
42 | (* sum_Sum defined *)
43 |
44 | Program Instance Type_Cat_Has_Sums : Has_Sums Type_Cat := sum_Sum.
45 |
46 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Topos.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Topos.Topos.
3 | From Categories Require Import Limits.Limit.
4 | From Categories Require Import Coq_Cats.Type_Cat.Card_Restriction.
5 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
6 | From Categories Require Import Coq_Cats.Type_Cat.CCC.
7 | From Categories Require Import Coq_Cats.Type_Cat.Complete.
8 | From Categories Require Import Coq_Cats.Type_Cat.SubObject_Classifier.
9 |
10 | Instance Type_Cat_Topos : Topos :=
11 | {
12 | Topos_Cat := Type_Cat;
13 | Topos_Cat_CCC := Type_Cat_CCC;
14 | Topos_Cat_SOC := Type_Cat_SubObject_Classifier;
15 | Topos_Cat_Fin_Limit := Complete_Has_Restricted_Limits Type_Cat Finite
16 | }.
17 |
--------------------------------------------------------------------------------
/Coq_Cats/Type_Cat/Type_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Coq_Cats.Coq_Cat.
3 |
4 | (** The category of Types (Coq's "Type")*)
5 |
6 | Program Definition Type_Cat : Category := Coq_Cat Type.
7 |
--------------------------------------------------------------------------------
/Demo/Demo.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Basic_Cons.Main.
7 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
8 | From Categories Require Import Coq_Cats.Type_Cat.Facts.
9 | From Categories Require Import Algebras.Main.
10 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat.
11 | From Categories Require Import Cat.Facts.
12 |
13 |
14 | Program Definition term_id : (Type_Cat --> (Type_Cat × Type_Cat))%functor :=
15 | {|
16 | FO := fun a => (@CCC_term Type_Cat _, a);
17 | FA := fun a b f => (@id _ (@CCC_term Type_Cat _), f)
18 | |}.
19 |
20 | Definition S_nat_func : (Type_Cat --> Type_Cat)%functor :=
21 | ((+ᶠⁿᶜ Type_Cat _) ∘ term_id)%functor.
22 |
23 | (* S_nat_func defined *)
24 |
25 | Definition S_nat_alg_cat := Algebra_Cat S_nat_func.
26 |
27 | Program Definition nat_alg : Algebra S_nat_func :=
28 | {|
29 | Alg_Carrier := nat;
30 | Constructors :=
31 | fun x =>
32 | match x with
33 | | inl a => 0
34 | | inr n => S n
35 | end
36 | |}.
37 |
38 | (* morphism from nat_alg to another alg *)
39 | Program Definition nat_alg_morph alg' : Algebra_Hom nat_alg alg' :=
40 | {|
41 | Alg_map :=
42 | fun x =>
43 | (fix f (n : nat) :=
44 | match n with
45 | | O => (Constructors alg') (inl tt)
46 | | S n' => (Constructors alg') (inr (f n'))
47 | end) x
48 | |}.
49 |
50 | Next Obligation. (* alg_map_com *)
51 | Proof.
52 | extensionality x.
53 | destruct x as [|[]]; cbn; trivial.
54 | repeat apply f_equal.
55 | match goal with [A : unit |- _] => destruct A; trivial end.
56 | Qed.
57 |
58 | Program Definition nat_alg_init : (𝟘_ S_nat_alg_cat)%object :=
59 | {|
60 | terminal := nat_alg;
61 | t_morph := nat_alg_morph
62 | |}.
63 |
64 | Next Obligation.
65 | Proof.
66 | destruct d as [algc algcons].
67 | destruct f as [f_morph f_com].
68 | destruct g as [g_morph g_com].
69 | apply Algebra_Hom_eq_simplify.
70 | extensionality x.
71 | simpl.
72 | induction x.
73 | {
74 | assert(H1 := equal_f f_com (inl tt)); cbv in H1; rewrite <- H1.
75 | assert(H2 := equal_f g_com (inl tt)); cbv in H2; rewrite <- H2.
76 | trivial.
77 | }
78 | {
79 | assert(H1 := equal_f f_com (inr x)); cbv in H1; rewrite <- H1.
80 | assert(H2 := equal_f g_com (inr x)); cbv in H2; rewrite <- H2.
81 | rewrite IHx.
82 | trivial.
83 | }
84 | Qed.
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 | CoInductive CoNat : Set :=
95 | | CoO : CoNat
96 | | CoS : CoNat -> CoNat
97 | .
98 |
99 | CoInductive CoNat_eq : CoNat -> CoNat -> Prop :=
100 | | CNOeq : CoNat_eq CoO CoO
101 | | CNSeq : forall (n n' : CoNat), CoNat_eq n n' -> CoNat_eq (CoS n) (CoS n')
102 | .
103 |
104 | Axiom CoNat_eq_eq : forall (n n' : CoNat), CoNat_eq n n' -> n = n'.
105 |
106 | Definition S_nat_coalg_cat := @CoAlgebra_Cat Type_Cat S_nat_func.
107 |
108 | Program Definition CoNat_coalg : @CoAlgebra Type_Cat S_nat_func :=
109 | {|
110 | Alg_Carrier := CoNat;
111 | Constructors :=
112 | fun x : CoNat =>
113 | match x return unit + CoNat with
114 | | CoO => inl tt
115 | | CoS x' => inr x'
116 | end
117 | |}.
118 |
119 | (* morphism from another alg to CoNat_coalg *)
120 | Program Definition CoNat_coalg_morph coalg' : CoAlgebra_Hom CoNat_coalg coalg'
121 | :=
122 | {|
123 | Alg_map :=
124 | cofix f (x : Alg_Carrier coalg') : CoNat :=
125 | match Constructors coalg' x return CoNat with
126 | | inl _ => CoO
127 | | inr s => CoS (f s)
128 | end
129 | |}.
130 |
131 | Next Obligation. (* coalg_map_com *)
132 | Proof.
133 | extensionality x; cbn.
134 | destruct (Constructors coalg' x) as [x'|x']; cbn; trivial.
135 | replace x' with tt; trivial.
136 | cbn in *.
137 | match goal with [A : unit |- _] => destruct A; trivial end.
138 | Qed.
139 |
140 | (* CoNat_coalg_morph defined *)
141 |
142 | (* The following two lemmas help go around Bug 5215. *)
143 |
144 | Lemma inl_inr A B (x : A) (y : B) : inl x = inr y → False.
145 | Proof.
146 | inversion 1.
147 | Qed.
148 |
149 | Lemma inr_inl A B (x : A) (y : B) : inr x = inl y → False.
150 | Proof.
151 | inversion 1.
152 | Qed.
153 |
154 | Program Definition CoNat_alg_term : (𝟘_ S_nat_coalg_cat)%object :=
155 | {|
156 | terminal := CoNat_coalg;
157 | t_morph := CoNat_coalg_morph
158 | |}.
159 |
160 | Next Obligation.
161 | Proof.
162 | apply Algebra_Hom_eq_simplify.
163 | extensionality x; simpl.
164 | apply CoNat_eq_eq; revert x.
165 | cofix H.
166 | intros x.
167 | assert(H1 := equal_f (@Alg_map_com _ _ _ _ f) x); cbn in H1.
168 | assert(H2 := equal_f (@Alg_map_com _ _ _ _ g) x); cbn in H2.
169 | destruct (Constructors d x); destruct ((Alg_map f) x);
170 | destruct ((Alg_map g) x); try constructor;
171 | repeat match goal with
172 | H : _ = _ |- _ =>
173 | try (apply inl_inr in H || apply inr_inl in H); tauto
174 | end.
175 | inversion H1; inversion H2.
176 | trivial.
177 | Qed.
178 |
--------------------------------------------------------------------------------
/Essentials/Facts_Tactics.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 |
4 | Require Export Coq.Program.Tactics.
5 | Require Export Coq.Program.Equality.
6 | Require Export Coq.Logic.FunctionalExtensionality.
7 | Require Export Coq.Logic.ProofIrrelevance.
8 |
9 | Definition equal_f_dep :
10 | ∀ {A : Type} {B : A → Type} {f g : ∀ x, B x}, f = g → ∀ x : A, f x = g x.
11 | Proof. intros A B f g H x; destruct H; reflexivity. Defined.
12 |
13 | Definition equal_f : ∀ {A B : Type} {f g : A → B}, f = g → ∀ x : A, f x = g x.
14 | Proof. intros; apply (@equal_f_dep _ (λ _, _)); assumption. Defined.
15 |
16 | Definition f_equal : ∀ (A B : Type) (f : A → B) (x y : A), x = y → f x = f y.
17 | Proof. intros A B f x y H; destruct H; reflexivity. Defined.
18 |
19 | Arguments f_equal [_ _] _ [_ _] _.
20 |
21 | Ltac basic_simpl :=
22 | let simpl_prod _ :=
23 | match goal with
24 | [H : prod _ _ |- _] =>
25 | let H1 := fresh H "1" in
26 | let H2 := fresh H "2" in
27 | destruct H as [H1 H2]
28 | end
29 | in
30 | let simpl_sig _ :=
31 | match goal with
32 | [H : @sig _ _ |- _] =>
33 | let H1 := fresh H "1" in
34 | let H2 := fresh H "2" in
35 | destruct H as [H1 H2]
36 | end
37 | in
38 | let basic_simpl_helper _ :=
39 | cbn in *; intros;
40 | repeat simpl_prod tt;
41 | repeat simpl_sig tt
42 | in
43 | repeat basic_simpl_helper tt
44 | .
45 |
46 | Global Obligation Tactic := basic_simpl; auto.
47 |
48 | (** A tactic to apply proof irrelevance on all proofs of the same type in the
49 | context. *)
50 | Ltac PIR :=
51 | let pir_helper _ :=
52 | match goal with
53 | |[H : ?A, H' : ?A|- _] =>
54 | match type of A with
55 | | Prop =>
56 | destruct (proof_irrelevance _ H H')
57 | end
58 | end
59 | in
60 | repeat pir_helper tt
61 | .
62 |
63 | (** A tactic to eliminate equalities in the context. *)
64 | Ltac ElimEq := repeat match goal with [H : _ = _|- _] => destruct H end.
65 |
66 | Hint Extern 1 => progress ElimEq : core.
67 |
68 | (** A tactic to simplify terms before rewriting them. *)
69 |
70 | Ltac cbn_rewrite W :=
71 | let H := fresh "H" in set (H := W); cbn in H; rewrite H; clear H.
72 |
73 | Ltac cbn_rewrite_in W V :=
74 | let H := fresh "H" in set (H := W); cbn in H; rewrite H in V; clear H.
75 |
76 | Ltac cbn_rewrite_back W :=
77 | let H := fresh "H" in set (H := W); cbn in H; rewrite <- H; clear H.
78 |
79 | Ltac cbn_rewrite_back_in W V :=
80 | let H := fresh "H" in set (H := W); cbn in H; rewrite <- H in V; clear H.
81 |
82 | Tactic Notation "cbn_rewrite" constr(W) := cbn_rewrite W.
83 | Tactic Notation "cbn_rewrite" constr(W) "in" hyp_list(V) := cbn_rewrite_in W V.
84 | Tactic Notation "cbn_rewrite" "<-" constr(W) := cbn_rewrite_back W.
85 | Tactic Notation "cbn_rewrite" "<-" constr(W) "in" hyp_list(V) :=
86 | cbn_rewrite_back_in W V.
87 |
88 | (** Equality on sigma type under proof irrelevance *)
89 |
90 | Lemma sig_proof_irrelevance {A : Type} (P : A → Prop) (X Y : sig P) :
91 | proj1_sig X = proj1_sig Y → X = Y.
92 | Proof.
93 | basic_simpl; ElimEq; PIR; trivial.
94 | Qed.
95 |
96 | Hint Extern 2 (exist ?A _ _ = exist ?A _ _) =>
97 | apply sig_proof_irrelevance : core.
98 |
99 | (* Automating use of functional_extensionality *)
100 | Ltac FunExt :=
101 | progress (
102 | repeat (
103 | match goal with
104 | [|- _ = _] =>
105 | let x := fresh "x" in
106 | extensionality x
107 | end
108 | )
109 | )
110 | .
111 |
112 | Hint Extern 1 => FunExt : core.
113 |
114 | Lemma pair_eq (A B : Type) (a b : A * B) : fst a = fst b → snd a = snd b → a = b.
115 | Proof.
116 | intros H1 H2.
117 | destruct a; destruct b.
118 | cbn in *.
119 | repeat match goal with [H : _ = _|-_] => destruct H end.
120 | trivial.
121 | Qed.
122 |
123 | Hint Resolve pair_eq : core.
124 |
125 | (** Tactics to apply a tactic to all hypothesis in an efficient way.
126 | This is due to Jonathan's (jonikelee@gmail.com) message on coq-club *)
127 |
128 | Ltac revert_clearbody_all :=
129 | repeat lazymatch goal with H:_ |- _ => try clearbody H; revert H end.
130 |
131 | Ltac hyp_stack :=
132 | constr:(ltac:(revert_clearbody_all;constructor) : True).
133 |
134 | Ltac next_hyp hs step last :=
135 | lazymatch hs with (?hs' ?H) => step H hs' | _ => last end.
136 |
137 | Tactic Notation "dohyps" tactic3(tac) :=
138 | let hs := hyp_stack in
139 | let rec step H hs := tac H; next_hyp hs step idtac in
140 | next_hyp hs step idtac.
141 |
142 | Tactic Notation "dohyps" "reverse" tactic3(tac) :=
143 | let hs := hyp_stack in
144 | let rec step H hs := next_hyp hs step idtac; tac H in
145 | next_hyp hs step idtac.
146 |
147 | Tactic Notation "do1hyp" tactic3(tac) :=
148 | let hs := hyp_stack in
149 | let rec step H hs := tac H + next_hyp hs step fail in
150 | next_hyp hs step fail.
151 |
152 | Tactic Notation "do1hyp" "reverse" tactic3(tac) :=
153 | let hs := hyp_stack in
154 | let rec step H hs := next_hyp hs step fail + tac H in
155 | next_hyp hs step fail.
156 |
157 | (** End of tactics for applying a tactic to all hypothesis. *)
158 |
--------------------------------------------------------------------------------
/Essentials/Notations.v:
--------------------------------------------------------------------------------
1 | From Coq.Unicode Require Export Utf8.
2 |
3 | Reserved Notation "C '^op'" (at level 50, no associativity).
4 |
5 | Reserved Notation "a --> b" (at level 90, b at level 200, right associativity).
6 |
7 | Reserved Notation "f '⁻¹'" (at level 50, no associativity).
8 |
9 | Reserved Notation "a ≃ b" (at level 70, no associativity).
10 |
11 | Reserved Notation "a ≃≃ b ::> C" (at level 70, no associativity).
12 |
13 | Reserved Notation "f ∘ g" (at level 51, right associativity).
14 |
15 | Reserved Notation "f '∘_h' g" (at level 51, right associativity).
16 |
17 | Reserved Notation "a ≫–> b" (at level 100, no associativity).
18 |
19 | Reserved Notation "a –≫ b" (at level 100, no associativity).
20 |
21 | Reserved Notation "F '_o'" (at level 50, no associativity).
22 |
23 | Reserved Notation "F '_a'" (at level 50, no associativity).
24 |
25 | Reserved Notation "F '@_a'" (at level 50, no associativity).
26 |
27 | Reserved Notation "F ⊣ G" (at level 100, no associativity).
28 |
29 | Reserved Notation "F ⊣_hom G" (at level 100, no associativity).
30 |
31 | Reserved Notation "F ⊣_ucu G" (at level 100, no associativity).
32 |
33 | Reserved Notation "a × b" (at level 80, no associativity).
34 |
35 | Reserved Notation "a ⇑ b" (at level 79, no associativity).
36 |
37 | Reserved Notation "'Π' m" (at level 50, no associativity).
38 |
39 | Reserved Notation "'Σ' m" (at level 50, no associativity).
40 |
41 | Reserved Notation "'Π_' C ↓ m" (at level 50, no associativity).
42 |
43 | Reserved Notation "'Σ_' C ↓ m" (at level 50, no associativity).
44 |
45 | Declare Scope category_scope.
46 | Delimit Scope category_scope with category.
47 |
48 | Declare Scope morphism_scope.
49 | Delimit Scope morphism_scope with morphism.
50 |
51 | Declare Scope object_scope.
52 | Delimit Scope object_scope with object.
53 |
54 | Declare Scope functor_scope.
55 | Delimit Scope functor_scope with functor.
56 |
57 | Declare Scope nattrans_scope.
58 | Delimit Scope nattrans_scope with nattrans.
59 |
60 | Declare Scope natiso_scope.
61 | Delimit Scope natiso_scope with natiso.
62 |
63 | Declare Scope isomorphism_scope.
64 | Delimit Scope isomorphism_scope with isomorphism.
65 |
66 | Declare Scope preorder_scope.
67 | Delimit Scope preorder_scope with preorder.
68 |
--------------------------------------------------------------------------------
/Essentials/Quotient.v:
--------------------------------------------------------------------------------
1 | From Categories.Essentials Require Import Notations Facts_Tactics.
2 | From Coq.Logic Require Import ChoiceFacts ClassicalFacts.
3 |
4 | From Coq.Classes Require Import RelationClasses.
5 |
6 | Local Axiom PropExt : ClassicalFacts.prop_extensionality.
7 | Local Axiom ConstructiveIndefiniteDescription_Type :
8 | forall T : Type, ConstructiveIndefiniteDescription_on T.
9 |
10 | Record EquiRel A :=
11 | { EQR_rel :> A → A → Prop;
12 | EQR_EQ : Equivalence EQR_rel }.
13 |
14 | Existing Instances EQR_EQ.
15 |
16 | Section Quotient.
17 | Context {A : Type} (R : EquiRel A).
18 |
19 | Definition quotient : Type := {P : A → Prop | ∃ x, ∀ y, P y ↔ R x y }.
20 |
21 | Definition represents (c : quotient) (x : A) : Prop := proj1_sig c x.
22 |
23 | Lemma represented_rel c x y :
24 | represents c x → represents c y → R x y.
25 | Proof.
26 | intros Hx Hy.
27 | pose proof (proj2_sig c) as [z Hz].
28 | transitivity z; [symmetry|]; apply Hz; trivial.
29 | Qed.
30 |
31 | Lemma related_represented c x y :
32 | represents c x → R x y → represents c y.
33 | Proof.
34 | intros Hx Hxy.
35 | pose proof (proj2_sig c) as [z Hz].
36 | apply Hz.
37 | transitivity x; [|trivial].
38 | apply Hz; trivial.
39 | Qed.
40 |
41 | Lemma quotient_has_representative c : ∃ x, represents c x.
42 | Proof.
43 | destruct c as [P [y Hy]].
44 | exists y; apply Hy; reflexivity.
45 | Qed.
46 |
47 | Lemma uniquely_represented c c' x y :
48 | represents c x → represents c' y → R x y → c = c'.
49 | Proof.
50 | intros Hcx Hc'y Hxy.
51 | apply sig_proof_irrelevance.
52 | extensionality z.
53 | apply PropExt.
54 | pose proof (proj2_sig c) as [u Hu].
55 | pose proof (proj2_sig c') as [w Hw].
56 | split.
57 | - intros Hc%Hu; apply Hw.
58 | etransitivity; [|apply Hc].
59 | etransitivity; [apply (Hw y); trivial|].
60 | symmetry; etransitivity; [apply (Hu x); trivial|trivial].
61 | - intros Hc'%Hw; apply Hu.
62 | etransitivity; [|apply Hc'].
63 | etransitivity; [apply (Hu x); trivial|].
64 | symmetry; etransitivity; [apply (Hw y); trivial|symmetry; trivial].
65 | Qed.
66 |
67 | Definition representative (c : quotient) : A :=
68 | proj1_sig
69 | (ConstructiveIndefiniteDescription_Type
70 | _ _ (quotient_has_representative c)).
71 |
72 | Lemma representative_represented c : represents c (representative c).
73 | Proof.
74 | exact (proj2_sig (ConstructiveIndefiniteDescription_Type
75 | _ _ (quotient_has_representative c))).
76 | Qed.
77 |
78 | Definition class_of (x : A) : quotient :=
79 | exist _ (λ y, R x y) (ex_intro _ x (λ z, (conj (@id (R x z)) (@id (R x z))))).
80 |
81 | Lemma class_of_represents x : represents (class_of x) x.
82 | Proof. unfold represents; simpl; reflexivity. Qed.
83 |
84 | Lemma representative_of_class_of x : R (representative (class_of x)) x.
85 | Proof.
86 | eapply represented_rel; [apply representative_represented|].
87 | apply class_of_represents.
88 | Qed.
89 |
90 | Lemma class_of_inj x y : R x y → class_of x = class_of y.
91 | Proof.
92 | intros Hxy.
93 | apply (uniquely_represented _ _ x y);
94 | [apply class_of_represents|apply class_of_represents |trivial].
95 | Qed.
96 |
97 | Lemma equal_classes x y : class_of x = class_of y → R x y.
98 | Proof.
99 | intros Hxy.
100 | apply (represented_rel (class_of x));
101 | [|rewrite Hxy]; apply class_of_represents.
102 | Qed.
103 |
104 | Lemma class_of_representative c : class_of (representative c) = c.
105 | Proof.
106 | apply (uniquely_represented _ _ (representative c) (representative c));
107 | [| |reflexivity].
108 | - apply class_of_represents.
109 | - apply representative_represented.
110 | Qed.
111 |
112 | End Quotient.
113 |
114 | Arguments represents {_ _} _ _.
115 | Arguments representative {_ _} _.
116 |
--------------------------------------------------------------------------------
/Essentials/Types.v:
--------------------------------------------------------------------------------
1 | Global Set Primitive Projections.
2 |
3 | Global Set Universe Polymorphism.
4 |
5 | Global Unset Universe Minimization ToSet.
6 |
7 | Global Set Warnings "-notation-overridden".
8 |
9 | (** The Empty Type. *)
10 | Inductive Empty : Type :=.
11 |
12 | Hint Extern 1 =>
13 | let tac :=
14 | (repeat intros ?); match goal with [H : Empty |- _] => contradict H end
15 | in
16 | match goal with
17 | | [|- context[Empty]] => tac
18 | | [H : context[Empty] |- _] => tac
19 | end : core.
20 |
21 | (** The product type, defined as a record to enjoy eta rule for records. *)
22 | Record prod (A B : Type) := pair {fst : A; snd : B}.
23 |
24 | Arguments fst {_ _} _.
25 | Arguments snd {_ _} _.
26 | Arguments pair {_ _} _ _.
27 |
28 | Notation "( x , y )" := (pair x y).
29 | Notation "x * y" := (prod x y) : type_scope.
30 |
31 | Add Printing Let prod.
32 |
33 | Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
34 |
35 | Register prod as core.prod.type.
36 | Register pair as core.prod.intro.
37 | Register prod_rect as core.prod.rect.
38 |
--------------------------------------------------------------------------------
/Ext_Cons/Arrow.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
6 |
7 | Section Arrow.
8 | Local Open Scope morphism_scope.
9 |
10 | (** The type accomodating all arrows of a category C. *)
11 | Record Arrow (C : Category) :=
12 | {
13 | Orig : Obj;
14 | Targ : Obj;
15 | Arr : Orig --> Targ
16 | }.
17 |
18 | Arguments Orig {_} _.
19 | Arguments Targ {_} _.
20 | Arguments Arr {_} _.
21 |
22 | Coercion Arr : Arrow >-> Hom.
23 |
24 | (** An arrow (in the appropriate category, e.g., comma)
25 | from arrow f : a -> b to arrow g : c -> d is a pair of arrows h1 : a -> c
26 | and h2 : b -> d that makes the following diagram commute:
27 | #
28 |
29 | f
30 | a ———————————> b
31 | | |
32 | h1 | | h2
33 | | |
34 | ↓ ↓
35 | c ———————————> d
36 | g
37 |
38 | #
39 | *)
40 | Record Arrow_Hom {C : Category} (a b : Arrow C) :=
41 | {
42 | Arr_H : (Orig a) --> (Orig b);
43 | Arr_H' : (Targ a) --> (Targ b);
44 | Arr_Hom_com : Arr_H' ∘ (Arr a) = (Arr b) ∘ Arr_H
45 | }.
46 | Arguments Arr_H {_ _ _} _.
47 | Arguments Arr_H' {_ _ _} _.
48 | Arguments Arr_Hom_com {_ _ _} _.
49 |
50 | Context (C : Category).
51 |
52 | Section Arrow_Hom_eq_simplify.
53 | Context {a b : Arrow C} (f g : Arrow_Hom a b).
54 |
55 | (** Two arrow homomorphisms are equal if the arrows between theor domains
56 | and codomain are respectively equal. In other words, we don't care about
57 | the proof of the diagram commuting. *)
58 | Lemma Arrow_Hom_eq_simplify :
59 | Arr_H f = Arr_H g → Arr_H' f = Arr_H' g → f = g.
60 | Proof.
61 | destruct f; destruct g.
62 | basic_simpl.
63 | ElimEq.
64 | PIR.
65 | reflexivity.
66 | Qed.
67 |
68 | End Arrow_Hom_eq_simplify.
69 |
70 | Section Compose_id.
71 | Context {x y z} (h : Arrow_Hom x y) (h' : Arrow_Hom y z).
72 |
73 | (** Composition of arrow homomorphisms. We basicall need to show that in the
74 | following diagram, the bigger diagram commutes if the smaller ones do.
75 | #
76 |
77 | f
78 | a ———————————> b
79 | | |
80 | h1 | | h2
81 | | |
82 | ↓ ↓
83 | c ———————————> d
84 | | g |
85 | h1' | | h2'
86 | | |
87 | ↓ ↓
88 | c ———————————> d
89 | h
90 |
91 | #
92 | *)
93 | Program Definition Arrow_Hom_compose : Arrow_Hom x z :=
94 | {|
95 | Arr_H := (Arr_H h') ∘ (Arr_H h);
96 | Arr_H' := (Arr_H' h') ∘ (Arr_H' h)
97 | |}.
98 |
99 | Next Obligation. (* Arr_Hom_com *)
100 | Proof.
101 | destruct h as [hh hh' hc]; destruct h' as [h'h h'h' h'c]; cbn.
102 | rewrite assoc.
103 | rewrite hc.
104 | repeat rewrite assoc_sym.
105 | rewrite h'c.
106 | auto.
107 | Qed.
108 |
109 | (** The identity arrow morphism. We simply need to show that the following
110 | diagram commutes:
111 | #
112 |
113 | f
114 | a ———————————> b
115 | | |
116 | id | | id
117 | | |
118 | ↓ ↓
119 | a ———————————> b
120 | f
121 |
122 | #
123 | which is trivial.
124 | *)
125 | Program Definition Arrow_id : Arrow_Hom x x :=
126 | {|
127 | Arr_H := id;
128 | Arr_H' := id
129 | |}.
130 |
131 | End Compose_id.
132 |
133 | End Arrow.
134 |
135 | Hint Extern 1 (?A = ?B :> Arrow_Hom _ _) =>
136 | apply Arrow_Hom_eq_simplify; simpl : core.
137 |
138 | Arguments Orig {_} _.
139 | Arguments Targ {_} _.
140 | Arguments Arr {_} _.
141 |
142 | Arguments Arr_H {_ _ _} _.
143 | Arguments Arr_H' {_ _ _} _.
144 | Arguments Arr_Hom_com {_ _ _} _.
145 |
146 | (** an arrow in a category is also an arrow in the opposite category.
147 | The domain and codomain are simply swapped. *)
148 | Program Definition Arrow_to_Arrow_OP (C : Category) (ar : Arrow C) :
149 | Arrow (C ^op) :=
150 | {|
151 | Arr := ar
152 | |}.
153 |
154 | (** The type of arrows of a category and the type of arrows of its opposite are
155 | isomorphic. *)
156 | Program Definition Arrow_OP_Iso (C : Category) :
157 | ((Arrow C) ≃≃ (Arrow (C ^op)) ::> Type_Cat)%isomorphism :=
158 | {|
159 | iso_morphism := Arrow_to_Arrow_OP C;
160 | inverse_morphism := Arrow_to_Arrow_OP (C ^op)
161 | |}.
162 |
--------------------------------------------------------------------------------
/Ext_Cons/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Ext_Cons.Prod_Cat.Main.
2 | From Categories Require Export Ext_Cons.Arrow.
3 | From Categories Require Export Ext_Cons.Comma.
4 |
--------------------------------------------------------------------------------
/Ext_Cons/Prod_Cat/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Ext_Cons.Prod_Cat.Prod_Cat.
2 | From Categories Require Export Ext_Cons.Prod_Cat.Operations.
3 | From Categories Require Export Ext_Cons.Prod_Cat.Nat_Facts.
4 |
--------------------------------------------------------------------------------
/Ext_Cons/Prod_Cat/Operations.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat.
8 |
9 | Local Obligation Tactic := idtac.
10 |
11 | Local Open Scope functor_scope.
12 |
13 | Program Definition Prod_Functor
14 | {C1 C2 C1' C2' : Category} (F : C1 --> C2) (F' : C1' --> C2')
15 | : (C1 × C1') --> (C2 × C2') :=
16 | {|
17 | FO := fun a => (F _o (fst a), F' _o (snd a))%object;
18 | FA := fun _ _ f => (F _a (fst f), F' _a (snd f))%morphism
19 | |}.
20 |
21 | Next Obligation.
22 | intros; cbn; repeat rewrite F_id; trivial.
23 | Qed.
24 |
25 | Next Obligation.
26 | intros; cbn; repeat rewrite F_compose; trivial.
27 | Qed.
28 |
29 | Definition Bi_Func_1 {Cx C1 C1' Cy : Category} (F : Cx --> C1)
30 | (F' : (C1 × C1') --> Cy)
31 | : (Cx × C1') --> Cy :=
32 | F' ∘ (Prod_Functor F (@Functor_id C1')).
33 |
34 | Definition Bi_Func_2 {Cx C1 C1' Cy : Category} (F : Cx --> C1')
35 | (F' : (C1 × C1') --> Cy) : (C1 × Cx) --> Cy :=
36 | Functor_compose (Prod_Functor (@Functor_id C1) F) F'.
37 |
38 | Local Hint Extern 2 => cbn : Core.
39 |
40 | Local Obligation Tactic := basic_simpl; do 2 auto.
41 |
42 | Program Definition Fix_Bi_Func_1 {C1 C1' Cy : Category} (x : C1)
43 | (F : (C1 × C1') --> Cy)
44 | : C1' --> Cy :=
45 | {|
46 | FO := fun a => (F _o (x, a))%object;
47 | FA := fun _ _ f => (F @_a (_, _) (_, _) (@id _ x, f))%morphism
48 | |}.
49 |
50 | Program Definition Fix_Bi_Func_2 {C1 C1' Cy : Category} (x : C1')
51 | (F : (C1 × C1') --> Cy)
52 | : C1 --> Cy :=
53 | {|
54 | FO := fun a => (F _o (a, x))%object;
55 | FA := fun _ _ f => (F @_a (_, _) (_, _) (f, @id _ x))%morphism
56 | |}.
57 |
58 | Program Definition Diag_Func (C : Category) : C --> (C × C) :=
59 | {|
60 | FO := fun a => (a, a);
61 | FA := fun _ _ f => (f, f);
62 | F_id := fun _ => eq_refl;
63 | F_compose := fun _ _ _ _ _ => eq_refl
64 | |}.
65 |
66 | Theorem Prod_Functor_Cat_Proj {C D D' : Category} (F : C --> (D × D')) :
67 | ((Prod_Functor ((Cat_Proj1 _ _) ∘ F) ((Cat_Proj2 _ _) ∘ F))
68 | ∘ (Diag_Func C))%functor = F.
69 | Proof.
70 | Func_eq_simpl; trivial.
71 | Qed.
72 |
73 | Program Definition Twist_Func (C C' : Category) : (C × C') --> (C' × C) :=
74 | {|
75 | FO := fun a => (snd a, fst a);
76 | FA := fun _ _ f => (snd f, fst f);
77 | F_id := fun _ => eq_refl;
78 | F_compose := fun _ _ _ _ _ => eq_refl
79 | |}.
80 |
81 | Section Twist_Prod_Func_Twist.
82 | Context {C C' : Category} (F : C --> C') {D D' : Category} (G : D --> D').
83 |
84 | Theorem Twist_Prod_Func_Twist :
85 | (((Twist_Func _ _) ∘ (Prod_Functor F G)) ∘ (Twist_Func _ _))%functor =
86 | Prod_Functor G F.
87 | Proof.
88 | Func_eq_simpl; trivial.
89 | Qed.
90 |
91 | End Twist_Prod_Func_Twist.
92 |
93 | Section Prod_Functor_compose.
94 | Context {C D E: Category} (F : C --> D) (G : D --> E)
95 | {C' D' E': Category} (F' : C' --> D') (G' : D' --> E').
96 |
97 | Theorem Prod_Functor_compose :
98 | ((Prod_Functor G G') ∘ (Prod_Functor F F') =
99 | Prod_Functor (G ∘ F) (G' ∘ F'))%functor.
100 | Proof.
101 | Func_eq_simpl; trivial.
102 | Qed.
103 |
104 | End Prod_Functor_compose.
105 |
--------------------------------------------------------------------------------
/Ext_Cons/Prod_Cat/Prod_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat.
7 |
8 | (* Product Category *)
9 |
10 | (** The product of two categories has as objects pairs of objects (first
11 | component from the first category and the second component from the second
12 | category) and as arrows pairs of arrows.
13 | *)
14 |
15 | Local Open Scope morphism_scope.
16 |
17 | Local Obligation Tactic := idtac.
18 |
19 | Program Definition Prod_Cat (C C' : Category) : Category :=
20 | {|
21 | Obj := C * C';
22 |
23 | Hom :=
24 | fun a b =>
25 | (((fst a) --> (fst b)) * ((snd a) --> (snd b)))%type;
26 |
27 | compose :=
28 | fun a b c f g =>
29 | (((fst g) ∘ (fst f)), ((snd g) ∘ (snd f)))%morphism;
30 |
31 | id := fun c => (id, id)
32 | |}.
33 |
34 | Next Obligation.
35 | cbn.
36 | intros.
37 | rewrite (assoc (fst _)).
38 | rewrite assoc.
39 | trivial.
40 | Defined.
41 |
42 | Next Obligation.
43 | cbn.
44 | intros C C' a b c d f g h.
45 | rewrite (assoc_sym (fst _)).
46 | rewrite assoc_sym.
47 | trivial.
48 | Defined.
49 |
50 | Next Obligation.
51 | cbn.
52 | intros.
53 | rewrite (id_unit_left (fst _)).
54 | rewrite id_unit_left.
55 | trivial.
56 | Defined.
57 |
58 | Next Obligation.
59 | cbn.
60 | intros.
61 | rewrite (id_unit_right (fst _)).
62 | rewrite id_unit_right.
63 | trivial.
64 | Defined.
65 |
66 | Notation "C × D" := (Prod_Cat C D) : category_scope.
67 |
68 | Local Obligation Tactic := basic_simpl; auto.
69 |
70 | Theorem Prod_compose_id
71 | (C D : Category)
72 | (a b c : C) (d : D)
73 | (f : a --> b) (g : b --> c)
74 | : (g ∘ f, id d)%morphism =
75 | @compose (_ × _) (_, _) (_, _) (_, _) (f, id d) (g, id d).
76 | Proof.
77 | cbn; auto.
78 | Qed.
79 |
80 | Theorem Prod_id_compose
81 | (C D : Category)
82 | (a : C) (b c d : D)
83 | (f : b --> c) (g : c --> d)
84 | : (id a, g ∘ f)%morphism =
85 | @compose (_ × _) (_, _) (_, _) (_, _) (id a, f) (id a, g).
86 | Proof.
87 | cbn; auto.
88 | Qed.
89 |
90 | Theorem Prod_cross_compose
91 | (C D : Category)
92 | (a b : C) (c d : D)
93 | (f : a --> b) (g : c --> d)
94 | : @compose (_ × _) (_, _) (_, _) (_, _) (id a, g) (f, id d) =
95 | @compose (_ × _) (_, _) (_, _) (_, _) (f, id c) (id b, g).
96 | Proof.
97 | cbn; auto.
98 | Qed.
99 |
100 | Program Definition Cat_Proj1 (C C' : Category) : ((C × C') --> C)%functor :=
101 | {|FO := fst; FA := fun _ _ f => fst f|}.
102 |
103 | Program Definition Cat_Proj2 (C C' : Category) : ((C × C') --> C')%functor :=
104 | {|FO := snd; FA := fun _ _ f => snd f|}.
105 |
--------------------------------------------------------------------------------
/Functor/Const_Func.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor.
6 |
7 | (** A constant functor maps all objects to a single object and all
8 | arrows to identity arrow of that object. *)
9 | Section Const_Func.
10 | Context (C : Category) {D : Category} (a : @Obj D).
11 |
12 | Program Definition Const_Func : (C --> D)%functor :=
13 | {|
14 | FO := fun _ => a;
15 | FA := fun _ _ _ => id a
16 | |}.
17 |
18 | End Const_Func.
19 |
--------------------------------------------------------------------------------
/Functor/Const_Func_Functor.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Const_Func.
6 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
7 |
8 | (** The functor that maps each object c in C to the
9 | constant functor that maps each object of D to c in Func_Cat D C. *)
10 | Section Const_Func_Functor.
11 | Context (C D : Category).
12 |
13 | Program Definition Const_Func_Functor : (C --> (Func_Cat D C))%functor :=
14 | {|
15 | FO := fun c => Const_Func D c;
16 | FA := fun _ _ h => {|Trans := fun c => h|}
17 | |}.
18 |
19 | End Const_Func_Functor.
20 |
--------------------------------------------------------------------------------
/Functor/Functor.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 |
6 | (**
7 | Fro categories C and C', a functor F : C -> C' consists of an arrow map from
8 | objects of C to objects of C' and an arrow map from arrows of C to arrows of C'
9 | such that an arrow h : a -> b is mapped to (F h) : F a -> F b.
10 |
11 | Furthermore, we require functors to map identitiies to identities. Additionally,
12 | the immage of the coposition of two arrows must be the same as composition of
13 | their images.
14 | *)
15 | Record Functor (C C' : Category) : Type :=
16 | {
17 | (** Object map *)
18 | FO : C → C';
19 |
20 | (** Arrow map *)
21 | FA : ∀ {a b}, (a --> b)%morphism → ((FO a) --> (FO b))%morphism;
22 |
23 | (** Mapping of identities *)
24 | F_id : ∀ c, FA (id c) = id (FO c);
25 |
26 | (** Functor commuting with composition *)
27 | F_compose : ∀ {a b c} (f : (a --> b)%morphism) (g : (b --> c)%morphism),
28 | (FA (g ∘ f) = (FA g) ∘ (FA f))%morphism
29 |
30 | (* F_id and F_compose together state the fact that functors are morphisms of
31 | categories (preserving the structure of categories!)*)
32 | }.
33 |
34 | Arguments FO {_ _} _ _.
35 | Arguments FA {_ _} _ _ _ _.
36 | Arguments F_id {_ _} _ _.
37 | Arguments F_compose {_ _} _ {_ _ _} _ _.
38 |
39 | Notation "C --> D" := (Functor C D) : functor_scope.
40 |
41 | Bind Scope functor_scope with Functor.
42 |
43 | Notation "F '_o'" := (FO F) : object_scope.
44 |
45 | Notation "F '@_a'" := (@FA _ _ F) : morphism_scope.
46 |
47 | Notation "F '_a'" := (@FA _ _ F _ _) : morphism_scope.
48 |
49 | Hint Extern 2 => (apply F_id) : core.
50 |
51 | Local Open Scope morphism_scope.
52 | Local Open Scope object_scope.
53 |
54 | Ltac Functor_Simplify :=
55 | progress
56 | (
57 | repeat rewrite F_id;
58 | (
59 | repeat
60 | match goal with
61 | | [|- ?F _a ?A = id (?F _o ?x)] =>
62 | (rewrite <- F_id; (cbn+idtac))
63 | | [|- (id (?F _o ?x)) = ?F _a ?A] =>
64 | (rewrite <- F_id; (cbn+idtac))
65 | | [|- ?F _a ?A ∘ ?F _a ?B = ?F _a ?C ∘ ?F _a ?D] =>
66 | (repeat rewrite <- F_compose; (cbn+idtac))
67 | | [|- ?F _a ?A ∘ ?F _a ?B = ?F _a ?C] =>
68 | (rewrite <- F_compose; (cbn+idtac))
69 | | [|- ?F _a ?C = ?F _a ?A ∘ ?F _a ?B] =>
70 | (rewrite <- F_compose; (cbn+idtac))
71 | | [|- context [?F _a ?A ∘ ?F _a ?B]] =>
72 | (rewrite <- F_compose; (cbn+idtac))
73 | end
74 | )
75 | )
76 | .
77 |
78 | Hint Extern 2 => Functor_Simplify : core.
79 |
80 | Section Functor_eq_simplification.
81 |
82 | Context {C C' : Category} (F G : (C --> C')%functor).
83 |
84 | (** Two functors are equal if their object maps and arrow maps are. *)
85 | Lemma Functor_eq_simplify (Oeq : F _o = G _o) :
86 | ((fun x y =>
87 | match Oeq in _ = V return ((x --> y) → ((V x) --> (V y)))%morphism with
88 | eq_refl => F @_a x y
89 | end) = G @_a) -> F = G.
90 | Proof.
91 | destruct F; destruct G.
92 | basic_simpl.
93 | ElimEq.
94 | PIR.
95 | trivial.
96 | Qed.
97 |
98 | (** Extensionality for arrow maps of functors. *)
99 | Theorem FA_extensionality (Oeq : F _o = G _o) :
100 | (
101 | ∀ (a b : Obj)
102 | (h : (a --> b)%morphism),
103 | (
104 | fun x y =>
105 | match Oeq in _ = V return
106 | ((x --> y) → ((V x) --> (V y)))%morphism
107 | with
108 | eq_refl => F @_a x y
109 | end
110 | ) _ _ h = G _a h
111 | )
112 | →
113 | (
114 | fun x y =>
115 | match Oeq in _ = V return
116 | ((x --> y) → ((V x) --> (V y)))%morphism
117 | with
118 | eq_refl => F @_a x y
119 | end
120 | ) = G @_a.
121 | Proof.
122 | auto.
123 | Qed.
124 |
125 | (** Fucntor extensionality: two functors are equal of their object maps are
126 | equal and their arrow maps are extensionally equal. *)
127 | Lemma Functor_extensionality (Oeq : F _o = G _o) :
128 | (
129 | ∀ (a b : Obj) (h : (a --> b)%morphism),
130 | (
131 | fun x y =>
132 | match Oeq in _ = V return
133 | ((x --> y) → ((V x) --> (V y)))%morphism
134 | with
135 | eq_refl => F @_a x y
136 | end
137 | ) _ _ h = G _a h
138 | ) → F = G.
139 | Proof.
140 | intros H.
141 | apply (Functor_eq_simplify Oeq); trivial.
142 | apply FA_extensionality; trivial.
143 | Qed.
144 |
145 | End Functor_eq_simplification.
146 |
147 | Hint Extern 2 => Functor_Simplify : core.
148 |
149 | Ltac Func_eq_simpl :=
150 | match goal with
151 | [|- ?A = ?B :> Functor _ _] =>
152 | (apply (Functor_eq_simplify A B (eq_refl : A _o = B _o)%object)) +
153 | (cut (A _o = B _o)%object; [
154 | let u := fresh "H" in
155 | intros H;
156 | apply (Functor_eq_simplify A B H)
157 | |
158 | ])
159 | end.
160 |
161 | Hint Extern 3 => Func_eq_simpl : core.
162 |
163 | Section Functor_eq.
164 | Context {C C' : Category} (F G : (C --> C')%functor).
165 |
166 | Lemma Functor_eq_morph (H : F = G) :
167 | ∃ (H : ∀ x, F _o x = G _o x),
168 | ∀ x y (h : (x --> y)%morphism),
169 | match H x in _ = V return (V --> _)%morphism with
170 | eq_refl =>
171 | match H y in _ = V return (_ --> V)%morphism with
172 | eq_refl => F _a h
173 | end
174 | end = G _a h.
175 | Proof.
176 | exists (equal_f (f_equal FO H)).
177 | intros x y h.
178 | destruct H; trivial.
179 | Qed.
180 |
181 | End Functor_eq.
182 |
--------------------------------------------------------------------------------
/Functor/Functor_Extender.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
6 | From Categories Require Import NatTrans.Main.
7 |
8 | (** Local notations for readability *)
9 | Local Notation NID := NatTrans_id (only parsing).
10 |
11 | Local Hint Extern 1 =>
12 | progress (repeat (apply NatTrans_eq_simplify; FunExt); cbn in *) : core.
13 |
14 | (** for a functor p : C -> C' and a category D, the left functor extender is a
15 | functor that maps (as an object) functor F : C' -> D to F ∘ p : C -> D. *)
16 | Section Left_Functor_Extender.
17 | Context {C C' : Category} (p : (C --> C')%functor) (D : Category).
18 |
19 | Program Definition Left_Functor_Extender :
20 | ((Func_Cat C' D) --> (Func_Cat C D))%functor :=
21 | {|
22 | FO := fun F => (F ∘ p)%functor;
23 | FA := fun F F' N => (N ∘_h (NID p))%nattrans
24 | |}.
25 |
26 | End Left_Functor_Extender.
27 |
28 | (** for a functor p : C -> C' and a category D, the left functor extender is a
29 | functor that maps (as an object) functor F : D -> C to p ∘ F : D -> C'. *)
30 | Section Right_Functor_Extender.
31 | Context {C C' : Category} (p : (C --> C')%functor) (D : Category).
32 |
33 | Program Definition Right_Functor_Extender :
34 | ((Func_Cat D C) --> (Func_Cat D C'))%functor :=
35 | {|
36 | FO := fun F => (p ∘ F)%functor;
37 | FA := fun F F' N => ((NID p) ∘_h N)%nattrans
38 | |}.
39 |
40 | End Right_Functor_Extender.
41 |
42 | (** if two functors are naturally isomorphic then so are left exending with them. *)
43 | Section Left_Functor_Extender_Iso.
44 | Context {C C' : Category} {p p' : (C --> C')%functor}
45 | (N : (p ≃ p')%natiso) (D : Category).
46 |
47 | Local Hint Extern 1 => (rewrite Trans_com); trivial; fail : core.
48 | Local Hint Extern 1 => rewrite <- F_compose : core.
49 | Local Hint Extern 1 =>
50 | match goal with
51 | [w : @Obj C |- _] =>
52 | cbn_rewrite (f_equal (fun u => Trans u w) (left_inverse N))
53 | end : core.
54 | Local Hint Extern 1 =>
55 | match goal with
56 | [w : @Obj C |- _] =>
57 | cbn_rewrite (f_equal (fun u => Trans u w) (right_inverse N))
58 | end : core.
59 |
60 | Program Definition Left_Functor_Extender_Iso :
61 | ((Left_Functor_Extender p D) ≃ (Left_Functor_Extender p' D))%natiso
62 | :=
63 | {|
64 | iso_morphism :=
65 | {|
66 | Trans :=
67 | fun e =>
68 | ((NatTrans_id_Iso e) ∘_h N)%natiso
69 | |};
70 | inverse_morphism :=
71 | {|
72 | Trans :=
73 | fun e =>
74 | ((NatTrans_id_Iso e) ∘_h (N⁻¹))%natiso
75 | |}
76 | |}.
77 |
78 | End Left_Functor_Extender_Iso.
79 |
80 | (** if two functors are naturally isomorphic then so are right exending with them. *)
81 | Section Right_Functor_Extender_Iso.
82 | Context {C C' : Category} {p p' : (C --> C')%functor}
83 | (N : (p ≃ p')%natiso) (D : Category).
84 |
85 | Local Hint Extern 1 => (rewrite Trans_com); trivial; fail : core.
86 | Local Hint Extern 1 => rewrite <- F_compose : core.
87 | Local Hint Extern 1 =>
88 | match goal with
89 | [w : @Obj D, F : (D --> C)%functor |- _] =>
90 | cbn_rewrite (f_equal (fun u => Trans u (F _o w)%object) (left_inverse N))
91 | end : core.
92 | Local Hint Extern 1 =>
93 | match goal with
94 | [w : @Obj D, F : (D --> C)%functor |- _] =>
95 | cbn_rewrite (f_equal (fun u => Trans u (F _o w)%object) (right_inverse N))
96 | end : core.
97 |
98 | Program Definition Right_Functor_Extender_Iso :
99 | ((Right_Functor_Extender p D) ≃ (Right_Functor_Extender p' D))%natiso
100 | :=
101 | {|
102 | iso_morphism :=
103 | {|
104 | Trans :=
105 | fun e =>
106 | (N ∘_h (NatTrans_id_Iso e))%natiso
107 | |};
108 | inverse_morphism :=
109 | {|
110 | Trans :=
111 | fun e =>
112 | ((N⁻¹) ∘_h (NatTrans_id_Iso e))%natiso
113 | |}
114 | |}.
115 |
116 | End Right_Functor_Extender_Iso.
117 |
118 | Section Right_Left_Functor_Extension_Iso.
119 | Context {B C D E : Category} (F : (B --> C)%functor) (G : (D --> E)%functor).
120 |
121 | (** It doesn't matter if we first extend from left or right.
122 | The resulting functors are isomorphic. *)
123 | Program Definition Right_Left_Functor_Extension_Iso :
124 | (
125 | (((Right_Functor_Extender G B) ∘ (Left_Functor_Extender F D))%functor)
126 | ≃ ((Left_Functor_Extender F E) ∘ (Right_Functor_Extender G C))%functor
127 | )%natiso :=
128 | {|
129 | iso_morphism := {|Trans := fun h => NatTrans_Functor_assoc_sym F h G |};
130 | inverse_morphism := {|Trans := fun h => NatTrans_Functor_assoc F h G |}
131 | |}.
132 |
133 | End Right_Left_Functor_Extension_Iso.
134 |
--------------------------------------------------------------------------------
/Functor/Functor_Image.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Category.Composable_Chain.
6 | From Categories Require Import Functor.Functor.
7 |
8 |
9 | (** The image of a functor is not simply the image of its object and arrow maps
10 | as those may not form a category. Consider the following example.
11 |
12 | category C:
13 | #
14 |
15 | f
16 | x1 ——————–> y1
17 |
18 | x2 ——————–> y2
19 | g
20 |
21 | #
22 | category D:
23 | #
24 |
25 | h1 h2
26 | x ——————–> y ————————> z
27 |
28 | u ——————–> v
29 | m
30 |
31 | #
32 | functor F where:
33 | #
34 |
35 | F _o x1 = x
36 | F _o y1 = y
37 | F _o x2 = y
38 | F _o y2 = z
39 |
40 | F _a f = h1
41 | F _a g = h2
42 |
43 | #
44 |
45 | Here we have not drawn identity arrows and compositions of arrows in categories
46 | and their mappings by the functor as these are trivial details.
47 |
48 | In this case, the simple image of arrow map of F has only h1 and h2 but not
49 | their composition and is hence not a category.
50 |
51 | We define the image of a functor to be a sum category of the codomain category
52 | with objects the image of object map of the functor and as morphisms image of
53 | the arrow map of the functor closed under composition. That is, each morphism
54 | in the image category is a morphism that corresponds to a composable chain of
55 | morohisms in the image of the arrow map of the functor.
56 |
57 | *)
58 | Section Functor_Image.
59 | Context {C D : Category}
60 | (F : (C --> D)%functor).
61 |
62 | Local Open Scope morphism_scope.
63 |
64 | Ltac destr_exists :=
65 | progress
66 | (repeat
67 | match goal with
68 | [H : ∃ x, _ |- _] =>
69 | let x := fresh "x" in
70 | let Hx := fresh "H" x in
71 | destruct H as [x Hx]
72 | end).
73 |
74 | Program Definition Functor_Image :=
75 | SubCategory
76 | D
77 | (fun a => ∃ x, (F _o x)%object = a)
78 | (
79 | fun a b f =>
80 | ∃ (ch : Composable_Chain D a b),
81 | (Compose_of ch) = f
82 | ∧
83 | Forall_Links
84 | ch (fun x y g =>
85 | ∃ (c d : Obj) (h : c --> d)
86 | (Fca : (F _o c)%object = x)
87 | (Fdb : (F _o d)%object = y),
88 | match Fca in (_ = Z) return Z --> _ with
89 | eq_refl =>
90 | match Fdb in (_ = Y) return _ --> Y with
91 | eq_refl => (F _a h)%morphism
92 | end
93 | end = g)
94 | )
95 | _ _.
96 | Next Obligation. (* Hom_Cri_id *)
97 | Proof.
98 | destr_exists.
99 | ElimEq.
100 | exists (Single (F _a id)); simpl; split; auto.
101 | do 3 eexists; do 2 exists eq_refl; reflexivity.
102 | Qed.
103 | Next Obligation. (* Hom_Cri_compose *)
104 | Proof.
105 | destr_exists.
106 | intuition.
107 | ElimEq.
108 | match goal with
109 | [ch1 : Composable_Chain _ ?a ?b, ch2 : Composable_Chain _ ?b ?c|- _] =>
110 | exists (Chain_Compose ch1 ch2); split
111 | end.
112 | rewrite <- Compose_of_Chain_Compose; trivial.
113 | apply Forall_Links_Chain_Compose; auto.
114 | Qed.
115 |
116 | End Functor_Image.
117 |
--------------------------------------------------------------------------------
/Functor/Functor_Ops.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor.
6 |
7 | (**
8 | Opposite of a functor F : C -> D is a functor F^op : C^op -> D^op with the same
9 | object and arrow maps.
10 | *)
11 | Section Opposite_Functor.
12 | Context {C D : Category} (F : (C --> D)%functor).
13 |
14 | Local Open Scope morphism_scope.
15 | Local Open Scope object_scope.
16 |
17 | Program Definition Opposite_Functor : (C^op --> D^op)%functor :=
18 | {|
19 | FO := F _o;
20 | FA := fun _ _ h => F @_a _ _ h;
21 | F_id := fun a => F_id F a;
22 | F_compose := fun _ _ _ f g => F_compose F g f
23 | |}.
24 |
25 | End Opposite_Functor.
26 |
27 | Notation "F '^op'" := (Opposite_Functor F) : functor_scope.
28 |
29 | (* We can compose functors. The object and arrow maps are simply function
30 | compositions of object and arrow maps. *)
31 | Section Functor_Compose.
32 | Context {C C' C'' : Category} (F : (C --> C')%functor) (F' : (C' --> C'')%functor).
33 |
34 | Local Open Scope morphism_scope.
35 | Local Open Scope object_scope.
36 |
37 | Program Definition Functor_compose : (C --> C'')%functor :=
38 | {|
39 | FO := fun c => F' _o (F _o c);
40 | FA := fun c d f => F' _a (F _a f)
41 | |}.
42 |
43 | End Functor_Compose.
44 |
45 | Notation "F ∘ G" := (Functor_compose G F) : functor_scope.
46 |
47 | (** Associativity of functor composition *)
48 | Section Functor_Assoc.
49 | Context {C1 C2 C3 C4 : Category}
50 | (F : (C1 --> C2)%functor)
51 | (G : (C2 --> C3)%functor)
52 | (H : (C3 --> C4)%functor).
53 |
54 | Local Open Scope functor_scope.
55 |
56 | Theorem Functor_assoc : (H ∘ G) ∘ F = H ∘ (G ∘ F).
57 | Proof.
58 | Func_eq_simpl; trivial.
59 | Qed.
60 |
61 | End Functor_Assoc.
62 |
63 | (** The identitiy functor *)
64 |
65 | Program Definition Functor_id (C : Category) : (C --> C)%functor :=
66 | {|
67 | FO := fun x => x;
68 | FA := fun c d f => f
69 | |}.
70 |
71 | Section Functor_Identity_Unit.
72 | Context (C C' : Category) (F : (C --> C')%functor).
73 |
74 | (** Fucntor_id is the left ididntity of functor composition. *)
75 | Theorem Functor_id_unit_left : ((Functor_id C') ∘ F)%functor = F.
76 | Proof.
77 | Func_eq_simpl; trivial.
78 | Qed.
79 |
80 | (** Functor_id is the right identity of functor composition. *)
81 | Theorem Functor_id_unit_right : (Functor_compose (Functor_id _) F) = F.
82 | Proof.
83 | Func_eq_simpl; trivial.
84 | Qed.
85 |
86 | End Functor_Identity_Unit.
87 |
88 |
--------------------------------------------------------------------------------
/Functor/Functor_Properties.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor.
6 | From Categories Require Import Functor.Functor_Ops.
7 |
8 | Local Open Scope functor_scope.
9 |
10 | Section Functor_Properties.
11 | Context {C C' : Category} (F : C --> C').
12 |
13 | Local Open Scope object_scope.
14 | Local Open Scope isomorphism_scope.
15 | Local Open Scope morphism_scope.
16 |
17 | (** A functor is said to be injective if its object map is. *)
18 | Definition Injective_Func := ∀ (c c' : Obj), F _o c = F _o c' → c = c'.
19 |
20 | (** A functor is said to be essentially injective if its object map maps
21 | equal objects to isomorphic objects in the codomain category. *)
22 | Definition Essentially_Injective_Func :=
23 | ∀ (c c' : Obj), F _o c = F _o c' → c ≃ c'.
24 |
25 | (** A functor is said to be surjective if its object map is. *)
26 | Definition Surjective_Func := ∀ (c : Obj), {c' : Obj | F _o c' = c}.
27 |
28 | (** A functor is said to be essentially surjective if for each object in the
29 | codomain category there is an aobject in the domain category that is mapped
30 | to an aobject isomorphic to it. *)
31 | Definition Essentially_Surjective_Func :=
32 | ∀ (c : Obj), {c' : Obj & F _o c' ≃ c}.
33 |
34 | (** A functor is said to be faithful if its arrow map is injective. *)
35 | Definition Faithful_Func := ∀ (c c' : Obj) (h h' : (c --> c')%morphism),
36 | F _a h = F _a h' → h = h'.
37 |
38 | (** A functor is said to be full if its arrow map is surjective. *)
39 | Definition Full_Func :=
40 | ∀ (c1 c2 : Obj) (h' : ((F _o c1) --> (F _o c2))%morphism),
41 | {h : (c1 --> c2)%morphism | F _a h = h'}
42 | .
43 |
44 | Local Ltac Inv_FTH :=
45 | match goal with
46 | [fl : Full_Func |- _] =>
47 | progress (
48 | repeat
49 | match goal with
50 | [|- context [(F _a (proj1_sig (fl _ _ ?x)))]] =>
51 | rewrite (proj2_sig (fl _ _ x))
52 | end
53 | )
54 | end
55 | .
56 |
57 | Local Hint Extern 1 => Inv_FTH : core.
58 |
59 | Local Hint Extern 1 => rewrite F_compose : core.
60 |
61 | Local Hint Extern 1 =>
62 | match goal with
63 | [fth : Faithful_Func |- _ = _ ] => apply fth
64 | end : core.
65 |
66 | Local Obligation Tactic := basic_simpl; auto 6.
67 |
68 | (** Any fully-faithful functor is essentially surjective. *)
69 | Program Definition Fully_Faithful_Essentially_Injective
70 | (fth : Faithful_Func) (fl : Full_Func) : Essentially_Injective_Func
71 | :=
72 | fun c c' eq =>
73 | {|
74 | iso_morphism :=
75 | proj1_sig (
76 | fl
77 | _
78 | _
79 | match eq in _ = y return
80 | (_ --> y)%morphism
81 | with
82 | eq_refl => id (F _o c)
83 | end
84 | );
85 | inverse_morphism :=
86 | proj1_sig (
87 | fl
88 | _
89 | _
90 | match eq in _ = y return
91 | (y --> _)%morphism
92 | with
93 | eq_refl => id (F _o c)
94 | end
95 | )
96 | |}.
97 |
98 | (** Any fully-faithful functor is conservative.
99 | A conservative functor is one for which we have two objects of the domain
100 | category are isomorphic if their images are ismorphic. *)
101 | Program Definition Fully_Faithful_Conservative
102 | (fth : Faithful_Func) (fl : Full_Func)
103 | : ∀ (c c' : Obj), F _o c ≃ F _o c' → c ≃ c' :=
104 | fun c c' I =>
105 | {|
106 | iso_morphism := proj1_sig (fl _ _ I);
107 | inverse_morphism := proj1_sig (fl _ _ (I⁻¹))
108 | |}.
109 |
110 | End Functor_Properties.
111 |
112 | (** Functors Preserve Isomorphisms. *)
113 | Section Functors_Preserve_Isos.
114 | Context {C C' : Category} (F : C --> C')
115 | {a b : C} (I : (a ≃≃ b ::> C)%isomorphism).
116 |
117 | Program Definition Functors_Preserve_Isos : (F _o a ≃ F _o b)%isomorphism :=
118 | {|
119 | iso_morphism := (F _a I)%morphism;
120 | inverse_morphism := (F _a (I⁻¹))%morphism
121 | |}.
122 |
123 | End Functors_Preserve_Isos.
124 |
125 | Section Embedding.
126 | Context (C C' : Category).
127 |
128 | (**
129 | An embedding is a functor that is fully-faithful. Such a functor is
130 | necessarily essentially injective and conservative, i.e.,
131 | if F _O c ≃ F _O c' then c ≃ c'.
132 | *)
133 |
134 | Record Embedding : Type :=
135 | {
136 | Emb_Func : C --> C';
137 |
138 | Emb_Faithful : Faithful_Func Emb_Func;
139 |
140 | Emb_Full : Full_Func Emb_Func
141 | }.
142 |
143 | Coercion Emb_Func : Embedding >-> Functor.
144 |
145 | Definition Emb_Essent_Inj (E : Embedding) :=
146 | Fully_Faithful_Essentially_Injective
147 | (Emb_Func E) (Emb_Faithful E) (Emb_Full E).
148 |
149 | Definition Emb_Conservative (E : Embedding) :=
150 | Fully_Faithful_Conservative
151 | (Emb_Func E) (Emb_Faithful E) (Emb_Full E).
152 |
153 | End Embedding.
154 |
155 | Arguments Emb_Func {_ _} _.
156 | Arguments Emb_Faithful {_ _} _ {_ _} _ _ _.
157 | Arguments Emb_Full {_ _} _ {_ _} _.
158 |
--------------------------------------------------------------------------------
/Functor/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Functor.Functor.
2 | From Categories Require Export Functor.Functor_Extender.
3 | From Categories Require Export Functor.Functor_Image.
4 | From Categories Require Export Functor.Functor_Ops.
5 | From Categories Require Export Functor.Functor_Properties.
6 | From Categories Require Export Functor.Const_Func.
7 | From Categories Require Export Functor.Const_Func_Functor.
8 |
--------------------------------------------------------------------------------
/Functor/Representable/Hom_Func.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat.
8 |
9 |
10 | (** The hom-functor is a functor that maps a pair of objects (a, b)
11 | (an object of the product category Cᵒᵖ×C) to the type of arrows
12 | from a to b. *)
13 | Program Definition Hom_Func (C : Category) : ((C^op × C) --> Type_Cat)%functor :=
14 | {|
15 | FO := fun x => Hom C (fst x) (snd x);
16 | FA := fun x y f => fun g => compose C (fst f) ((@compose (C^op) _ _ _) (snd f) g)
17 | |}.
18 |
--------------------------------------------------------------------------------
/Functor/Representable/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Functor.Representable.Hom_Func.
2 | From Categories Require Export Functor.Representable.Hom_Func_Prop.
3 | From Categories Require Export Functor.Representable.Representable.
4 |
--------------------------------------------------------------------------------
/Functor/Representable/Representable.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Representable.Hom_Func.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
8 | Ext_Cons.Prod_Cat.Operations.
9 | From Categories Require Import NatTrans.NatIso.
10 |
11 | (** A functor F : C → Type_Cat is representable if F is naturaly isomorphic to
12 | Hom_C(x, -) for some x : C. In this case, we say F is represented by x. *)
13 | Section Representable.
14 | Context {C : Category} (F : (C --> Type_Cat)%functor).
15 |
16 | Record Representable : Type :=
17 | {
18 | representer : C;
19 | representation_Iso :
20 | (F ≃ @Fix_Bi_Func_1 (C^op) _ _ representer (Hom_Func C))%natiso
21 | }.
22 |
23 | End Representable.
24 |
25 | Arguments representer {_ _} _.
26 | Arguments representation_Iso {_ _} _.
27 |
28 | Definition CoRepresentable {C : Category} (F : (C^op --> Type_Cat)%functor) :=
29 | @Representable (C^op) F.
30 |
--------------------------------------------------------------------------------
/KanExt/Facts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export KanExt.GlobalFacts.
2 | From Categories Require Export KanExt.LocalFacts.Main.
3 |
--------------------------------------------------------------------------------
/KanExt/Global.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
6 | From Categories Require Import NatTrans.NatTrans NatTrans.Operations
7 | NatTrans.Func_Cat.
8 | From Categories Require Import Adjunction.Adjunction.
9 | From Categories Require Import Functor.Functor_Extender.
10 |
11 | Local Open Scope functor_scope.
12 |
13 | (**
14 | Given functor p : C -> C', we define the global kan extension along p operation.
15 |
16 | To define it, notice Left_Functor_Extender p D. It functor which maps
17 | (as objects) a functor F : C' -> D to F ∘ p : C -> D. The global
18 | left/right kan extension operation along p is simply the left/right
19 | adjoint to this functor.
20 |
21 | *)
22 | Section KanExtension.
23 | Context {C C' : Category} (p : (C --> C')%functor).
24 |
25 | Section Global.
26 | Context (D : Category).
27 |
28 | Record Left_KanExt : Type :=
29 | {
30 | left_kan_ext : (Func_Cat C D) --> (Func_Cat C' D);
31 | left_kan_ext_adj : left_kan_ext ⊣ (Left_Functor_Extender p D)
32 | }.
33 |
34 | Coercion left_kan_ext : Left_KanExt >-> Functor.
35 |
36 | Record Right_KanExt : Type :=
37 | {
38 | right_kan_ext : (Func_Cat C D) --> (Func_Cat C' D);
39 | right_kan_ext_adj : (Left_Functor_Extender p D) ⊣ right_kan_ext
40 | }.
41 |
42 | Coercion right_kan_ext : Right_KanExt >-> Functor.
43 |
44 | End Global.
45 |
46 | End KanExtension.
47 |
48 | Arguments left_kan_ext {_ _ _ _} _.
49 | Arguments left_kan_ext_adj {_ _ _ _} _.
50 |
51 | Arguments right_kan_ext {_ _ _ _} _.
52 | Arguments right_kan_ext_adj {_ _ _ _} _.
53 |
--------------------------------------------------------------------------------
/KanExt/GlobalFacts.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories.Functor Require Import Functor Functor_Ops Functor_Properties.
6 | From Categories.NatTrans Require Import NatTrans Func_Cat NatIso.
7 | From Categories Require Import Adjunction.Adjunction Adjunction.Adj_Facts.
8 | From Categories.KanExt Require Import Global LocalFacts.NatIso LocaltoGlobal
9 | GlobaltoLocal.
10 |
11 | Section Facts.
12 | Context {C C' : Category} (p : (C --> C')%functor)
13 | {D : Category}.
14 |
15 | (** Right kan extensions are unique up to natural isomorphisms. *)
16 | Section Right_KanExt_Unique.
17 | Context (rke rke' : Right_KanExt p D).
18 |
19 | Definition Right_KanExt_Unique : (rke ≃ rke')%natiso :=
20 | Adjunct_right_unique (right_kan_ext_adj rke) (right_kan_ext_adj rke').
21 |
22 | Definition Right_KanExt_Unique_points (F : (C --> D)%functor) :
23 | (rke _o F ≃ rke' _o F)%isomorphism := NatIso_Image Right_KanExt_Unique F.
24 |
25 | End Right_KanExt_Unique.
26 |
27 | (** Left kan extensions are unique up to natural isomorphisms. *)
28 | Section Left_KanExt_Unique.
29 | Context (lke lke' : Left_KanExt p D).
30 |
31 | Definition Left_KanExt_Unique : (lke ≃ lke')%natiso :=
32 | Adjunct_left_unique (left_kan_ext_adj lke) (left_kan_ext_adj lke').
33 |
34 | Definition Left_KanExt_Unique_points (F : (C --> D)%functor) :
35 | (lke _o F ≃ lke' _o F)%isomorphism := NatIso_Image Left_KanExt_Unique F.
36 |
37 | End Left_KanExt_Unique.
38 |
39 | Section Right_KanExt_Iso.
40 | Context (rke : Right_KanExt p D)
41 | {F F' : (C --> D)%functor}
42 | (I : (F ≃ F')%natiso).
43 |
44 | Definition Right_KanExt_Iso : (rke _o F ≃ rke _o F')%isomorphism :=
45 | Functors_Preserve_Isos rke I.
46 |
47 | End Right_KanExt_Iso.
48 |
49 | Section Left_KanExt_Iso.
50 | Context (lke : Left_KanExt p D)
51 | {F F' : (C --> D)%functor}
52 | (I : (F ≃ F')%natiso).
53 |
54 | Definition Left_KanExt_Iso : (lke _o F ≃ lke _o F')%isomorphism :=
55 | Functors_Preserve_Isos lke I.
56 |
57 | End Left_KanExt_Iso.
58 |
59 | Section Right_KanExt_Iso_along.
60 | Context {p' : (C --> C')%functor}
61 | (N : (p' ≃ p)%natiso)
62 | (rke : Right_KanExt p D).
63 |
64 | Definition Right_KanExt_Iso_along : Right_KanExt p' D :=
65 | Local_to_Global_Right
66 | p'
67 | D
68 | (
69 | fun F =>
70 | Local_Right_KanExt_Iso_along
71 | N
72 | (Global_to_Local_Right p D rke F)
73 | ).
74 |
75 | End Right_KanExt_Iso_along.
76 |
77 | Section Left_KanExt_Iso_along.
78 | Context {p' : (C --> C')%functor}
79 | (N : (p' ≃ p)%natiso)
80 | (lke : Left_KanExt p D).
81 |
82 | Definition Left_KanExt_Iso_along : Left_KanExt p' D :=
83 | Local_to_Global_Left
84 | p'
85 | D
86 | (
87 | fun F =>
88 | Local_Right_KanExt_Iso_along
89 | (N^op)%natiso
90 | (Global_to_Local_Left p D lke F)
91 | ).
92 |
93 | End Left_KanExt_Iso_along.
94 |
95 | End Facts.
96 |
--------------------------------------------------------------------------------
/KanExt/LocalFacts/ConesToHom.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops
6 | Functor.Representable.Hom_Func.
7 | From Categories Require Import Functor.Functor_Extender.
8 | From Categories Require Import NatTrans.NatTrans NatTrans.Operations
9 | NatTrans.Func_Cat NatTrans.NatIso.
10 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
11 | Ext_Cons.Prod_Cat.Operations Ext_Cons.Prod_Cat.Nat_Facts.
12 | From Categories Require Import Adjunction.Adjunction.
13 | From Categories Require Import KanExt.Local KanExt.LocalFacts.Uniqueness.
14 | From Categories Require Import Basic_Cons.Terminal.
15 |
16 | Local Open Scope functor_scope.
17 |
18 | (** This module contains conversion from local kan extension defiend as cones
19 | to local kan extensions defined through hom functor. *)
20 |
21 | Section Local_Right_KanExt_to_Hom_Local_Right_KanExt.
22 | Context {C C' : Category} {p : C --> C'}
23 | {D : Category} {F : C --> D}
24 | (lrke : Local_Right_KanExt p F).
25 |
26 | (** The left to right side of Hom_Local_Right_KanExt isomorphism. *)
27 | Program Definition Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_LR :
28 | (((@Fix_Bi_Func_2 _ (Func_Cat C D) _ F (Hom_Func (Func_Cat C D)))
29 | ∘ (Left_Functor_Extender p D)^op)
30 | --> (@Fix_Bi_Func_2 _ (Func_Cat C' D)
31 | _ lrke (Hom_Func (Func_Cat C' D))))%nattrans :=
32 | {|
33 | Trans := fun c h => LRKE_morph_ex lrke {|cone_apex := c; cone_edge := h|}
34 | |}.
35 |
36 | Next Obligation.
37 | Proof.
38 | extensionality x.
39 | repeat rewrite NatTrans_id_unit_left.
40 | match goal with
41 | [|- cone_morph (LRKE_morph_ex lrke ?A) = ?X] =>
42 | match X with
43 | ((cone_morph ?C) ∘ ?B)%nattrans =>
44 | change X with
45 | (cone_morph
46 | (LoKan_Cone_Morph_compose
47 | _
48 | _
49 | (Build_LoKan_Cone_Morph
50 | p F A {|cone_apex := c; cone_edge := x|} h eq_refl) C
51 | )
52 | )
53 | end
54 | end.
55 | apply LRKE_morph_unique.
56 | Qed.
57 |
58 | Next Obligation.
59 | Proof.
60 | symmetry.
61 | apply Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_LR_obligation_1.
62 | Qed.
63 |
64 | (** The right to left side of Hom_Local_Right_KanExt isomorphism. *)
65 | Program Definition Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_RL :
66 | ((@Fix_Bi_Func_2 _ (Func_Cat C' D) _ lrke (Hom_Func (Func_Cat C' D)))
67 | --> ((@Fix_Bi_Func_2 _ (Func_Cat C D) _ F (Hom_Func (Func_Cat C D)))
68 | ∘ (Left_Functor_Extender p D)^op
69 | ))%nattrans
70 | :=
71 | {|
72 | Trans := fun c h => (lrke ∘ (h ∘_h (NatTrans_id p)))%nattrans
73 | |}.
74 | Next Obligation.
75 | Proof.
76 | extensionality x.
77 | repeat rewrite NatTrans_id_unit_left.
78 | rewrite NatTrans_compose_assoc.
79 | rewrite NatTrans_comp_hor_comp.
80 | rewrite NatTrans_id_unit_right.
81 | trivial.
82 | Qed.
83 | Next Obligation.
84 | Proof.
85 | symmetry.
86 | apply Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_RL_obligation_1.
87 | Qed.
88 |
89 | (** Conversion from Local_Right_KanExt Hom_Local_Right_KanExt isomorphism. *)
90 | Program Definition Local_Right_KanExt_to_Hom_Local_Right_KanExt :
91 | Hom_Local_Right_KanExt p F :=
92 | {|
93 | HLRKE := (cone_apex (LRKE lrke));
94 | HLRKE_Iso :=
95 | {|
96 | iso_morphism := Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_LR;
97 | inverse_morphism :=
98 | Local_Right_KanExt_to_Hom_Local_Right_KanExt_Iso_RL
99 | |}
100 | |}.
101 | Next Obligation.
102 | Proof.
103 | apply NatTrans_eq_simplify.
104 | extensionality h; extensionality x.
105 | symmetry.
106 | apply (cone_morph_com
107 | (LRKE_morph_ex lrke {| cone_apex := h; cone_edge := x |})).
108 | Qed.
109 | Next Obligation.
110 | Proof.
111 | apply NatTrans_eq_simplify.
112 | extensionality h; extensionality x.
113 | cbn in *.
114 | match goal with
115 | [|- cone_morph (LRKE_morph_ex lrke ?A) = ?X] =>
116 | change X with (cone_morph (Build_LoKan_Cone_Morph p F A lrke x eq_refl));
117 | apply (LRKE_morph_unique lrke A)
118 | end.
119 | Qed.
120 |
121 | End Local_Right_KanExt_to_Hom_Local_Right_KanExt.
122 |
--------------------------------------------------------------------------------
/KanExt/LocalFacts/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export KanExt.LocalFacts.Uniqueness.
2 | From Categories Require Export KanExt.LocalFacts.HomToCones.
3 | From Categories Require Export KanExt.LocalFacts.ConesToHom.
4 | From Categories Require Export KanExt.LocalFacts.NatIso.
5 | From Categories Require Export KanExt.LocalFacts.From_Iso_Cat.
6 |
--------------------------------------------------------------------------------
/KanExt/LocalFacts/NatIso.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops
6 | Functor.Representable.Hom_Func.
7 | From Categories Require Import Functor.Functor_Extender.
8 | From Categories Require Import NatTrans.NatTrans NatTrans.Operations
9 | NatTrans.Func_Cat NatTrans.NatIso.
10 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
11 | Ext_Cons.Prod_Cat.Operations Ext_Cons.Prod_Cat.Nat_Facts.
12 | From Categories Require Import KanExt.Local
13 | KanExt.LocalFacts.HomToCones
14 | KanExt.LocalFacts.ConesToHom.
15 |
16 | Local Open Scope functor_scope.
17 |
18 | (** This module contains facts about local kan extensions involving natural
19 | isomorphism. *)
20 |
21 | (** Any two naturally isomorphic functors have the same kan extensions –
22 | stated with hom functor definition of local kan extensions. *)
23 | Section Hom_Local_Right_KanExt_Iso.
24 | Context {C C' : Category} {p : C --> C'}
25 | {D : Category} {F F' : C --> D}
26 | (N : (F' ≃ F)%natiso)
27 | (hlrke : Hom_Local_Right_KanExt p F).
28 |
29 | Definition Hom_Local_Right_KanExt_Iso : Hom_Local_Right_KanExt p F' :=
30 | {|
31 | HLRKE := hlrke;
32 | HLRKE_Iso :=
33 | (
34 | (HLRKE_Iso hlrke)
35 | ∘ (
36 | (Fix_Bi_Func_2_object_NatIso (Hom_Func (Func_Cat C D)) N)
37 | ∘_h (NatTrans_id_Iso (Left_Functor_Extender p D)^op)
38 | )
39 | )%isomorphism%natiso
40 | |}.
41 |
42 | End Hom_Local_Right_KanExt_Iso.
43 |
44 | (** Any two naturally isomorphic functors have the same kan extensions –
45 | stated with cones definition of local kan extensions. *)
46 | Section Local_Right_KanExt_Iso.
47 | Context {C C' : Category}
48 | {p : C --> C'}
49 | {D : Category}
50 | {F F' : C --> D}
51 | (N : (F' ≃ F)%natiso)
52 | (hlrke : Local_Right_KanExt p F).
53 |
54 | Definition Local_Right_KanExt_Iso : Local_Right_KanExt p F' :=
55 | Hom_Local_Right_KanExt_to_Local_Right_KanExt
56 | (Hom_Local_Right_KanExt_Iso
57 | N
58 | (Local_Right_KanExt_to_Hom_Local_Right_KanExt hlrke)
59 | ).
60 |
61 | End Local_Right_KanExt_Iso.
62 |
63 | (** If a functor is naturally isomorphic to the local right kan extension then
64 | it also is local right kan extensions *)
65 | Section Iso_Hom_Local_Right_KanExt.
66 | Context {C C' : Category}
67 | {p : C --> C'}
68 | {D : Category}
69 | {F : C --> D}
70 | {hlrke hlrke' : C' --> D}
71 | (N : (hlrke ≃ hlrke')%natiso)
72 | (ihlrke : Hom_Local_Right_KanExt_Isomorphism p F hlrke).
73 |
74 | Definition Iso_Hom_Local_Right_KanExt : Hom_Local_Right_KanExt p F :=
75 | {|
76 | HLRKE := hlrke';
77 | HLRKE_Iso :=
78 | ((Fix_Bi_Func_2_object_NatIso (Hom_Func (Func_Cat C' D)) N)
79 | ∘ ihlrke)%isomorphism
80 | |}.
81 |
82 | End Iso_Hom_Local_Right_KanExt.
83 |
84 | (** If a functor is naturally isomorphic to the local left kan extension then
85 | it also is local left kan extensions – proven using duality. *)
86 | Section Iso_Local_Right_KanExt.
87 | Context {C C' : Category}
88 | {p : C --> C'}
89 | {D : Category}
90 | {F : C --> D}
91 | {hlrke hlrke' : C' --> D}
92 | (N : (hlrke ≃ hlrke')%natiso)
93 | (ihlrke : is_Local_Right_KanExt p F hlrke).
94 |
95 | Definition Iso_Local_Right_KanExt : is_Local_Right_KanExt p F hlrke' :=
96 | Local_Right_KanExt_is_Local_Right_KanExt
97 | _
98 | _
99 | (
100 | Hom_Local_Right_KanExt_to_Local_Right_KanExt
101 | (Iso_Hom_Local_Right_KanExt
102 | N
103 | (HLRKE_Iso
104 | (Local_Right_KanExt_to_Hom_Local_Right_KanExt
105 | (is_Local_Right_KanExt_Local_Right_KanExt _ _ ihlrke)
106 | )
107 | )
108 | )
109 | ).
110 |
111 | End Iso_Local_Right_KanExt.
112 |
113 |
114 | (** Kan extension along any two naturally isomorphic functors is the same –
115 | stated with hom functor definition of local kan extensions. *)
116 | Section Hom_Local_Right_KanExt_Iso_along.
117 | Context {C C' : Category} {p p' : C --> C'}
118 | (N : (p' ≃ p )%natiso)
119 | {D : Category} {F : C --> D}
120 | (hlrke : Hom_Local_Right_KanExt p F).
121 |
122 | Program Definition Hom_Local_Right_KanExt_Iso_along
123 | : Hom_Local_Right_KanExt p' F :=
124 | {|
125 | HLRKE := hlrke;
126 | HLRKE_Iso :=
127 | (
128 | (HLRKE_Iso hlrke)
129 | ∘ (
130 | (NatTrans_id_Iso
131 | (@Fix_Bi_Func_2
132 | _ (Func_Cat C D) _ F (Hom_Func (Func_Cat C D))))
133 | ∘_h ((Left_Functor_Extender_Iso N D)^op)
134 | )
135 | )%isomorphism%natiso
136 | |}.
137 |
138 | End Hom_Local_Right_KanExt_Iso_along.
139 |
140 | (** Any two naturally isomorphic functors have the same kan extensions –
141 | stated with cones definition of local kan extensions. *)
142 | Section Local_Right_KanExt_Iso_along.
143 | Context {C C' : Category} {p p' : C --> C'}
144 | (N : (p' ≃ p)%natiso)
145 | {D : Category} {F : C --> D}
146 | (hlrke : Local_Right_KanExt p F).
147 |
148 | Definition Local_Right_KanExt_Iso_along : Local_Right_KanExt p' F :=
149 | Hom_Local_Right_KanExt_to_Local_Right_KanExt
150 | (Hom_Local_Right_KanExt_Iso_along
151 | N
152 | (Local_Right_KanExt_to_Hom_Local_Right_KanExt hlrke)
153 | ).
154 |
155 | End Local_Right_KanExt_Iso_along.
156 |
--------------------------------------------------------------------------------
/KanExt/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export KanExt.Global.
2 | From Categories Require Export KanExt.Local.
3 | From Categories Require Export KanExt.GlobaltoLocal.
4 | From Categories Require Export KanExt.LocaltoGlobal.
5 | From Categories Require Export KanExt.GlobalDuality.
6 | From Categories Require Export KanExt.Pointwise.
7 | From Categories Require Export KanExt.Preservation.
8 |
--------------------------------------------------------------------------------
/KanExt/Pointwise.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops
6 | Functor.Representable.Hom_Func
7 | Functor.Representable.Representable.
8 | From Categories Require Import Ext_Cons.Prod_Cat.Prod_Cat
9 | Ext_Cons.Prod_Cat.Operations.
10 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
11 | From Categories Require Import NatTrans.NatTrans NatTrans.Operations
12 | NatTrans.Func_Cat.
13 | From Categories Require Import KanExt.Local.
14 |
15 | Local Open Scope functor_scope.
16 |
17 | (** A local kan extension is pointwise if it is preserved by representable
18 | functors. In other words, in the following diagram,
19 |
20 | #
21 |
22 | F G
23 | C ———————–> D ——————–> Set
24 | | ↗ ↗
25 | | / /
26 | p | / R /
27 | | / / G ∘ R
28 | ↓ / /
29 | C' ———–———
30 |
31 | #
32 | where R is the left/right local kan extension of F along p, and G is a
33 | representable functor and we have (G ∘ R) is the left/right kan extension
34 | of (G ∘ F) along p.
35 | *)
36 |
37 | (** Pointwise-ness for local left kan extensions. *)
38 | Section Pointwise_LRKE.
39 | Context {C C' : Category}
40 | {p : C --> C'}
41 | {D: Category}
42 | {F : C --> D}
43 | (lrke : Local_Right_KanExt p F).
44 |
45 | Definition Pointwise_LRKE :=
46 | ∀ (G : D --> Type_Cat) (GR : Representable G),
47 | is_Local_Right_KanExt p (G ∘ F) (G ∘ lrke).
48 |
49 | End Pointwise_LRKE.
50 |
51 | (** Pointwiseness for local right kan extensions. *)
52 | Section Pointwise_LLKE.
53 | Context {C C' : Category}
54 | {p : C --> C'}
55 | {D: Category}
56 | {F : C --> D}
57 | (llke : Local_Left_KanExt p F).
58 |
59 | Definition Pointwise_LLKE :=
60 | ∀ (G : D^op --> Type_Cat) (GR : CoRepresentable G),
61 | is_Local_Right_KanExt p (G^op ∘ F) ((G ∘ llke)^op).
62 |
63 | End Pointwise_LLKE.
64 |
--------------------------------------------------------------------------------
/Limits/Complete_Preorder.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import
6 | Functor.Functor Functor.Const_Func Functor.Functor_Ops.
7 | From Categories Require Import
8 | Ext_Cons.Prod_Cat.Prod_Cat Ext_Cons.Prod_Cat.Operations.
9 | From Categories Require Import NatTrans.Operations NatTrans.NatIso.
10 | From Categories Require Import Archetypal.Discr.Discr.
11 | From Categories Require Import Limits.Limit Limits.Pointwise.
12 | From Categories Require Import Ext_Cons.Arrow.
13 | From Categories Require Import
14 | Coq_Cats.Type_Cat.Type_Cat Coq_Cats.Type_Cat.GenProd.
15 |
16 | (**
17 | This file shows that if a category is complete, then for any pair of objects
18 | x and y, we have (Arrow C) (Hom C x y) is isomorphic to
19 | Hom C x (Limit_of (Discr_Func Arr_y)).
20 | This of course would be a contradiction as soon as we have some objects c and
21 | d for which
22 | (Hom C c d) has more than one element. In other words, any complete category
23 | is a preorder category!!!
24 |
25 | The proof is precisely the proof that is given in Awodey's book
26 | "Category Theory" to show that any small and complete category is a preorder
27 | category. In deed, the constraints on universe variables generated by this
28 | proof, restricts C such that the level of its objects is less than or
29 | equal to the level of its arrows (Remember that in this development smallness
30 | and largeness is relative to universe levels).
31 | *)
32 |
33 | Section Complete_Preorder.
34 | Context (C : Category) (CC : Complete C) (x y : C).
35 |
36 | Local Definition Arr_y := (fun w : (Arrow C) => y).
37 |
38 | Local Definition LimOf_Arr_y := (LimitOf (Discr_Func Arr_y)).
39 |
40 | Local Definition GenProd_of_const_Hom_x_y :=
41 | Type_Cat_GenProd
42 | _
43 | (((@Fix_Bi_Func_1
44 | (C^op) _ _ x (Hom_Func.Hom_Func C)) ∘ (Discr_Func Arr_y)) _o)%object.
45 |
46 | Local Hint Extern 1 => cbn : core.
47 |
48 | Local Program Definition Func_Iso :
49 | (
50 | (Discr_Func
51 | (((@Fix_Bi_Func_1
52 | (C^op) _ _ x (Hom_Func.Hom_Func C))
53 | ∘ (Discr_Func Arr_y)) _o)%object
54 | )
55 | ≃ ((@Fix_Bi_Func_1
56 | (C^op) _ _ x (Hom_Func.Hom_Func C)) ∘ (Discr_Func Arr_y))%functor
57 | )%natiso
58 | :=
59 | {|
60 | iso_morphism := {|Trans := fun c h => h|};
61 | inverse_morphism := {|Trans := fun c h => h|}
62 | |}.
63 |
64 | Local Definition
65 | Local_Right_KanExt_Iso_Limits_Pointwise_LimOf_Arr_y__ISO__GenProd_of_const_Hom_x_y :
66 | (Local_Right_KanExt_Iso
67 | Func_Iso
68 | (Rep_Preserve_Limits _ x LimOf_Arr_y)
69 | ≃≃
70 | GenProd_of_const_Hom_x_y
71 | ::> LoKan_Cone_Cat _ _)%isomorphism
72 | := Local_Right_KanExt_unique _ _ _ _.
73 |
74 | Local Definition Hom_x_LimOf_Arr_y_ISO_Arrow_C_to_Hom_x_y :
75 | (((x --> ((LimOf_Arr_y _o) tt))%object%morphism)
76 | ≃≃ (Arrow C → x --> y)%morphism ::> Type_Cat)%isomorphism :=
77 | LoKan_Cone_Iso_object_Iso
78 | _
79 | _
80 | Local_Right_KanExt_Iso_Limits_Pointwise_LimOf_Arr_y__ISO__GenProd_of_const_Hom_x_y
81 | tt.
82 |
83 | End Complete_Preorder.
84 |
--------------------------------------------------------------------------------
/Limits/GenProd_GenSum.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Archetypal.Discr.Discr Archetypal.Discr.NatFacts.
7 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
8 | From Categories Require Import Cat.Cat_Iso.
9 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
10 | From Categories Require Import KanExt.LocalFacts.NatIso.
11 |
12 | From Categories Require Import Limits.Limit.
13 | From Categories Require Import Limits.Isomorphic_Cat.
14 |
15 | Section GenProd_Sum.
16 | Context {A : Type} {C : Category} (map : A → C).
17 |
18 | Definition GenProd := Limit (Discr_Func map).
19 |
20 | Identity Coercion GenProd_Limit : GenProd >-> Limit.
21 |
22 | Definition GenSum := CoLimit (Discr_Func_op map).
23 |
24 | Identity Coercion GenSum_CoLimit : GenSum >-> CoLimit.
25 |
26 | End GenProd_Sum.
27 |
28 | Arguments GenProd {_}%type {_}%category _, {_} _ _.
29 | Arguments GenSum {_}%type {_}%category _, {_} _ _.
30 |
31 | Notation "'Π' m" := (GenProd m) : object_scope.
32 |
33 | Notation "'Σ' m" := (GenSum m) : object_scope.
34 |
35 | Notation "'Π_' C ↓ m" := (GenProd C m) : object_scope.
36 |
37 | Notation "'Σ_' C ↓ m" := (GenSum C m) : object_scope.
38 |
39 | (** The fact That if a category has generalized products of some type,
40 | its dual also has generalized sums of that type. *)
41 |
42 | Section GenProd_to_GenSum.
43 | Context {A : Type} {C : Category} {map : A → C} (L : (Π map)%object).
44 |
45 | Definition GenProd_to_GenSum : (Σ_ (C^op) ↓ map)%object :=
46 | Local_Right_KanExt_Iso ((@Discr_Func_Iso (C^op) A map)⁻¹) L.
47 |
48 | End GenProd_to_GenSum.
49 |
50 | (** The fact That if a category has generalized sums of some type, its dual has
51 | generalized products of that type. *)
52 | Section GenSum_to_GenProd.
53 | Context {A : Type} {C : Category} {map : A → C} (L : (Σ map)%object).
54 |
55 | Definition GenSum_to_GenProd : (Π_ (C^op) ↓ map)%object :=
56 | Local_Right_KanExt_Iso (Discr_Func_Iso map) L.
57 |
58 | End GenSum_to_GenProd.
59 |
60 | (** If we have GenSum for all functions from a type A, where A is isomorphic
61 | to B we have all GenSum for all functions from B. We show this by showing
62 | that for the underlying functor of any GenSum from B is isomorphic to the
63 | underlying functor of some GenSum from A pre-composed with the provided
64 | isomorphism.
65 | *)
66 | Section GenSum_IsoType.
67 | Context {A B : Type} (Iso : (A ≃≃ B ::> Type_Cat)%isomorphism) {C : Category}
68 | (SM : forall f : A → C, (Σ f)%object).
69 |
70 | Program Definition GenSum_IsoType_map_Iso (map : B → C):
71 | (
72 | ((((Discr_Func_op map)^op)%functor)
73 | ≃≃ ((Discr_Func_op
74 | (fun x : A => map ((iso_morphism Iso) x))
75 | ∘ (iso_morphism (Opposite_Cat_Iso
76 | (Inverse_Isomorphism
77 | (Discr_Cat_Iso Iso)))))^op
78 | )%functor
79 | ::> Func_Cat _ _)%isomorphism
80 | )%morphism
81 | :=
82 | {|
83 | iso_morphism :=
84 | {|
85 | Trans :=
86 | Trans
87 | (iso_morphism
88 | (IsoCat_NatIso (Opposite_Cat_Iso
89 | (Discr_Cat_Iso Iso)) (Discr_Func_op map))
90 | )
91 | |};
92 | inverse_morphism :=
93 | {|
94 | Trans :=
95 | Trans
96 | (inverse_morphism
97 | (IsoCat_NatIso (Opposite_Cat_Iso
98 | (Discr_Cat_Iso Iso)) (Discr_Func_op map))
99 | )
100 | |}
101 | |}
102 | .
103 |
104 | Next Obligation.
105 | Proof.
106 | apply NatTrans_eq_simplify.
107 | apply (
108 | f_equal
109 | Trans
110 | (
111 | right_inverse
112 | (IsoCat_NatIso (Opposite_Cat_Iso
113 | (Discr_Cat_Iso Iso)) (Discr_Func_op map))
114 | )
115 | ).
116 | Qed.
117 |
118 | Next Obligation.
119 | Proof.
120 | apply NatTrans_eq_simplify.
121 | apply (
122 | f_equal
123 | Trans
124 | (
125 | left_inverse
126 | (IsoCat_NatIso (Opposite_Cat_Iso
127 | (Discr_Cat_Iso Iso)) (Discr_Func_op map))
128 | )
129 | ).
130 | Qed.
131 |
132 | Definition GenSum_IsoType (map : B → C) : (Σ map)%object :=
133 | Local_Right_KanExt_Iso
134 | (GenSum_IsoType_map_Iso map)
135 | (
136 | CoLimit_From_Isomorphic_Cat
137 | (Opposite_Cat_Iso (Inverse_Isomorphism (Discr_Cat_Iso Iso)))
138 | (SM (fun x : A => map ((iso_morphism Iso) x)))
139 | ).
140 |
141 | End GenSum_IsoType.
142 |
--------------------------------------------------------------------------------
/Limits/Isomorphic_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Cat.Cat Cat.Terminal.
7 | From Categories Require Import Limits.Limit.
8 | From Categories Require Import KanExt.LocalFacts.From_Iso_Cat.
9 | From Categories Require Import Cat.Cat_Iso.
10 |
11 | (** Given I : C ≃ D for C and D categories we have limit of (F ∘ I)
12 | if we have limit of F. *)
13 | Section Limit_From_Isomorphic_Cat.
14 | Context {C D : Category}
15 | (I : (C ≃≃ D ::> Cat)%isomorphism)
16 | {E : Category}
17 | {F : (D --> E)%functor}
18 | (L : Limit F).
19 |
20 | Definition Limit_From_Isomorphic_Cat : Limit (F ∘ (iso_morphism I)) :=
21 | Local_Right_KanExt_Iso_along
22 | (
23 | Functor_To_1_Cat_Iso
24 | (Functor_To_1_Cat C)
25 | (Functor_To_1_Cat D ∘ (iso_morphism I))
26 | )
27 | (KanExt_From_Isomorphic_Cat I (Functor_To_1_Cat D) F L).
28 |
29 | End Limit_From_Isomorphic_Cat.
30 |
31 | (** Given I : C ≃ D for C and D categories we have colimit of (F ∘ I)
32 | if we have colimit of F. *)
33 | Section CoLimit_From_Isomorphic_Cat.
34 | Context {C D : Category}
35 | (I : (C ≃≃ D ::> Cat)%isomorphism)
36 | {E : Category}
37 | {F : (D --> E)%functor}
38 | (L : CoLimit F).
39 |
40 | Definition CoLimit_From_Isomorphic_Cat : CoLimit (F ∘ (iso_morphism I)) :=
41 | Limit_From_Isomorphic_Cat (Opposite_Cat_Iso I) L.
42 |
43 | End CoLimit_From_Isomorphic_Cat.
44 |
--------------------------------------------------------------------------------
/Limits/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Limits.Limit.
2 | From Categories Require Export Limits.GenProd_GenSum.
3 | From Categories Require Export Limits.GenProd_Eq_Limits.
4 | From Categories Require Export Limits.Isomorphic_Cat.
5 | From Categories Require Export Limits.Pointwise.
6 |
--------------------------------------------------------------------------------
/Monad/Adj_Monad.v:
--------------------------------------------------------------------------------
1 | From Categories.Essentials Require Import Notations Facts_Tactics.
2 | From Categories.Category Require Import Main.
3 | From Categories.Functor Require Import Functor Functor_Ops.
4 | From Categories.NatTrans Require Import Main.
5 | From Categories.Adjunction Require Import Main.
6 | From Categories.Monad Require Import Monad.
7 |
8 | Section Adj_Monad.
9 | Context {C D : Category} {F : (C --> D)%functor} {U : (D --> C)%functor}
10 | (adj : (F ⊣ U)%functor).
11 |
12 | Let M := (U ∘ F)%functor.
13 |
14 | Program Definition adj_FU : (F ∘ U --> Functor_id D)%nattrans :=
15 | {| Trans d := adj_morph_ex adj (id ((U _o) d)%object) |}.
16 | Next Obligation.
17 | Proof.
18 | eapply (adj_morph_unique adj ((U _a)%morphism h)).
19 | - rewrite F_compose, assoc; cbn.
20 | cbn_rewrite (Trans_com_sym (adj_unit adj) (U _a h)).
21 | rewrite assoc_sym.
22 | cbn_rewrite <- (@adj_morph_com _ _ _ _ adj).
23 | rewrite id_unit_left; trivial.
24 | - rewrite F_compose, assoc; cbn.
25 | cbn_rewrite <- (@adj_morph_com _ _ _ _ adj).
26 | rewrite id_unit_right; trivial.
27 | Qed.
28 | Next Obligation.
29 | Proof.
30 | symmetry.
31 | apply adj_FU_obligation_1.
32 | Qed.
33 |
34 | Definition adj_mult : (M ∘ M --> M)%nattrans :=
35 | ((((NatTrans_id U) ∘_h
36 | ((NatTrans_from_compose_id F) ∘ adj_FU ∘_h (NatTrans_id F))) ∘
37 | ((NatTrans_id U) ∘_h (NatTrans_Functor_assoc_sym F U F))) ∘
38 | ((NatTrans_Functor_assoc (U ∘ F) F U)))%nattrans.
39 |
40 | Program Definition adj_monad : Monad M :=
41 | {| monad_unit := adj_unit adj;
42 | monad_mult := adj_mult |}.
43 | Next Obligation.
44 | Proof.
45 | apply NatTrans_eq_simplify; extensionality c; cbn.
46 | Functor_Simplify; simpl_ids.
47 | cbn_rewrite <- (@adj_morph_com _ _ _ _ adj); trivial.
48 | Qed.
49 | Next Obligation.
50 | Proof.
51 | apply NatTrans_eq_simplify; extensionality c; cbn.
52 | Functor_Simplify; simpl_ids.
53 | rewrite <- F_compose; simpl.
54 | assert (adj_morph_ex adj id ∘ (F _a)%morphism (Trans (adj_unit adj) c)
55 | = id)%morphism as Heq.
56 | - eapply (@adj_morph_unique _ _ _ _ adj);
57 | [|Functor_Simplify; simpl_ids; reflexivity].
58 | simpl.
59 | rewrite F_compose.
60 | rewrite assoc.
61 | cbn_rewrite (@Trans_com_sym _ _ _ _ (adj_unit adj)).
62 | rewrite <- assoc.
63 | cbn_rewrite_back (@adj_morph_com _ _ _ _ adj).
64 | replace (id ((U _o) ((F _o) c))) with ((U _a) ((F _a) (id c)))%morphism
65 | by (Functor_Simplify; trivial).
66 | cbn_rewrite (@Trans_com_sym _ _ _ _ (adj_unit adj)).
67 | simpl_ids; trivial.
68 | - simpl in *; rewrite Heq; Functor_Simplify; trivial.
69 | Qed.
70 | Next Obligation.
71 | Proof.
72 | apply NatTrans_eq_simplify; extensionality c; cbn.
73 | Functor_Simplify; simpl_ids.
74 | rewrite <- !F_compose.
75 | f_equal.
76 | eapply (@adj_morph_unique _ _ _ _ adj); [reflexivity|].
77 | rewrite !F_compose, !assoc.
78 | cbn_rewrite (@Trans_com_sym _ _ _ _ (adj_unit adj)).
79 | cbn_rewrite_back (@adj_morph_com _ _ _ _ adj).
80 | rewrite <- !assoc.
81 | cbn_rewrite_back (@adj_morph_com _ _ _ _ adj).
82 | simpl_ids; trivial.
83 | Qed.
84 |
85 | End Adj_Monad.
86 |
--------------------------------------------------------------------------------
/Monad/Monad.v:
--------------------------------------------------------------------------------
1 | From Categories.Essentials Require Import Notations.
2 | From Categories.Category Require Import Main.
3 | From Categories.Functor Require Import Functor Functor_Ops.
4 | From Categories.NatTrans Require Import Main.
5 |
6 | Record Monad {C : Category} (F : (C --> C)%functor) := {
7 | monad_unit : NatTrans (Functor_id C) F;
8 | monad_mult : NatTrans (Functor_compose F F) F;
9 | monad_unit_mult_left :
10 | (monad_mult ∘ (monad_unit ∘_h (NatTrans_id F))
11 | ∘ (NatTrans_to_compose_id F))%nattrans =
12 | NatTrans_id F;
13 | monad_unit_mult_right :
14 | (monad_mult ∘ ((NatTrans_id F) ∘_h monad_unit)
15 | ∘ (NatTrans_to_id_compose F))%nattrans =
16 | NatTrans_id F;
17 | monad_mult_assoc :
18 | (monad_mult ∘ (monad_mult ∘_h (NatTrans_id F)))%nattrans =
19 | (monad_mult ∘ ((NatTrans_id F) ∘_h monad_mult)
20 | ∘ (NatTrans_Functor_assoc F F F))%nattrans; }.
21 |
22 | Arguments monad_unit {_ _} _.
23 | Arguments monad_mult {_ _} _.
24 | Arguments monad_unit_mult_left {_ _} _.
25 | Arguments monad_unit_mult_right {_ _} _.
26 | Arguments monad_mult_assoc {_ _} _.
27 |
--------------------------------------------------------------------------------
/NatTrans/Func_Cat.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Operations.
8 |
9 | (** The category of functors.
10 |
11 | – Objects: functors from C to C'
12 | – Arrows: natural transformations
13 | *)
14 | Program Definition Func_Cat (C C' : Category) : Category :=
15 | {|
16 | Obj := (C --> C')%functor;
17 |
18 | Hom := NatTrans;
19 |
20 | compose := @NatTrans_compose _ _;
21 |
22 | id := @NatTrans_id _ _;
23 |
24 | assoc := fun _ _ _ _ _ _ _ => @NatTrans_compose_assoc _ _ _ _ _ _ _ _ _;
25 |
26 | assoc_sym :=
27 | fun _ _ _ _ _ _ _ => eq_sym (@NatTrans_compose_assoc _ _ _ _ _ _ _ _ _);
28 |
29 | id_unit_right := @NatTrans_id_unit_right _ _;
30 |
31 | id_unit_left := @NatTrans_id_unit_left _ _
32 | |}.
33 |
34 | Section Opposite_Func_Cat.
35 | Context (C D : Category).
36 |
37 | (** Functor from functor category to its opposite. Maps each functor
38 | to its opposite. *)
39 | Program Definition Op_Func_Cat_to_Func_Cat_Op
40 | : ((Func_Cat C D)^op --> (Func_Cat (C^op) (D^op)))%functor :=
41 | {|
42 | FO := Opposite_Functor;
43 | FA := fun _ _ => Opposite_NatTrans;
44 | F_id := fun _ => NatTrans_id_Op _;
45 | F_compose := fun _ _ _ _ _ => NatTrans_compose_Op _ _
46 | |}.
47 |
48 | (** Functor from the opposite of a functor category to it. Maps each functor
49 | to its opposite. *)
50 | Program Definition Func_Cat_Op_to_Op_Func_Cat
51 | : ((Func_Cat (C^op) (D^op)) --> (Func_Cat C D)^op)%functor :=
52 | {|
53 | FO := Opposite_Functor;
54 | FA := fun _ _ => Opposite_NatTrans;
55 | F_id := fun F => NatTrans_id_Op F;
56 | F_compose := fun _ _ _ N N' => NatTrans_compose_Op N N'
57 | |}.
58 |
59 | (** The opposite of the category of functors from C to D is naturally
60 | isomorphic to the category of functors from C^op to D^op. *)
61 | Program Definition Func_Cat_Op_Iso
62 | : ((((Func_Cat C D)^op)%category)
63 | ≃≃ (Func_Cat (C^op) (D^op)) ::> Cat) %isomorphism :=
64 | {|
65 | iso_morphism := Op_Func_Cat_to_Func_Cat_Op;
66 | inverse_morphism := Func_Cat_Op_to_Op_Func_Cat
67 | |}.
68 |
69 | End Opposite_Func_Cat.
70 |
--------------------------------------------------------------------------------
/NatTrans/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export NatTrans.NatTrans.
2 | From Categories Require Export NatTrans.Func_Cat.
3 | From Categories Require Export NatTrans.NatIso.
4 | From Categories Require Export NatTrans.Operations.
5 | From Categories Require Export NatTrans.Morphisms.
6 |
--------------------------------------------------------------------------------
/NatTrans/Morphisms.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor Functor.Functor_Ops.
6 | From Categories Require Import Cat.Cat.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 |
9 | Local Open Scope nattrans_scope.
10 |
11 | (** If all components of a natural transformation are monic then
12 | so is that natural transformation. *)
13 | Section is_Monic_components_is_Monic.
14 | Context
15 | {C D : Category}
16 | {F G : (C --> D)%functor}
17 | (N : F --> G)
18 | (H : ∀ c, is_Monic (Trans N c)).
19 |
20 | Definition is_Monic_components_is_Monic :
21 | @is_Monic (Func_Cat _ _) _ _ N.
22 | Proof.
23 | intros I g h H2.
24 | apply NatTrans_eq_simplify.
25 | extensionality x.
26 | apply H.
27 | apply (fun x => f_equal (fun w => Trans w x) H2).
28 | Qed.
29 |
30 | End is_Monic_components_is_Monic.
31 |
32 | (** If all components of a natural transformation are epic then
33 | so is that natural transformation. *)
34 | Section is_Epic_components_is_Epic.
35 | Context
36 | {C D : Category}
37 | {F G : (C --> D)%functor}
38 | (N : F --> G)
39 | (H : ∀ c, is_Epic (Trans N c)).
40 |
41 | Definition is_Epic_components_is_Epic :
42 | @is_Epic (Func_Cat _ _) _ _ N.
43 | Proof.
44 | intros I g h H2.
45 | apply NatTrans_eq_simplify.
46 | extensionality x.
47 | apply H.
48 | apply (fun x => f_equal (fun w => Trans w x) H2).
49 | Qed.
50 |
51 | End is_Epic_components_is_Epic.
52 |
--------------------------------------------------------------------------------
/NatTrans/NatTrans.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Functor.
6 | From Categories Require Import Cat.Cat.
7 |
8 | Section NatTrans.
9 | Context {C C' : Category}.
10 |
11 | (**
12 | For categories C and C' and functors F : C -> C' and F' : C -> C', a natural
13 | transformation N : F -> F' is a family of arrows 'Trans N' in the co-domain
14 | category (here C') indexed by objects of the domain category (here C),
15 | Trans N c : F _o c -> F' _o c.
16 |
17 | In addition, for all arrows h : c → c' the following diagram must
18 | commute (Trans_com):
19 |
20 | #
21 |
22 | F _a h
23 | F _o c ————————————————––> F _o c'
24 | | |
25 | | |
26 | | |
27 | | Trans N c | Trans N c'
28 | | |
29 | | |
30 | ∨ ∨
31 | F' _o c ————————————————–> F' _o c'
32 | F' _a h
33 |
34 | #
35 | Trans_com_sym is the symmetric form of Trans_com.
36 | *)
37 | Record NatTrans (F F' : (C --> C')%functor) :=
38 | {
39 | Trans (c : C) : ((F _o c) --> (F' _o c))%object%morphism;
40 | Trans_com {c c' : C} (h : (c --> c')%morphism) :
41 | ((Trans c') ∘ F _a h = F' _a h ∘ (Trans c))%morphism;
42 | Trans_com_sym {c c' : C} (h : (c --> c')%morphism) :
43 | (F' _a h ∘ (Trans c) = (Trans c') ∘ F _a h)%morphism
44 | }.
45 |
46 | Notation "F --> F'" := (NatTrans F F') : nattrans_scope.
47 |
48 | (** Two natural transformations are equal if their arrow families are.
49 | That is, commutative diagrams are assumed to be equal by
50 | proof irrelevance. *)
51 | Lemma NatTrans_eq_simplify {F F' : (C --> C')%functor}
52 | (N N' : (F --> F')%nattrans) : (@Trans _ _ N) = (@Trans _ _ N') -> N = N'.
53 | Proof.
54 | destruct N; destruct N'.
55 | basic_simpl.
56 | ElimEq.
57 | PIR; trivial.
58 | Qed.
59 |
60 | End NatTrans.
61 |
62 | Arguments Trans {_ _ _ _} _ _.
63 | Arguments Trans_com {_ _ _ _} _ {_ _} _.
64 | Arguments Trans_com_sym {_ _ _ _} _ {_ _} _.
65 |
66 | Bind Scope nattrans_scope with NatTrans.
67 |
68 | Notation "F --> F'" := (NatTrans F F') : nattrans_scope.
69 |
70 | Local Open Scope nattrans_scope.
71 |
72 | Section NatTrans_Compose.
73 | Context {C C' : Category}.
74 |
75 | (** Natural transformations are composable. The arrow family of the result is
76 | just the composition of corresponding components in each natural
77 | transformation. Graphically:
78 | #
79 |
80 | F F
81 | C ———————————————–> D C ———————————————–> D
82 | || ||
83 | ||N ||
84 | || ||
85 | \/ ||
86 | C ———————————————–> D || N' ∘ N
87 | G ||
88 | || ||
89 | ||N' ||
90 | || ||
91 | \/ \/
92 | C ———————————————–> D C ———————————————–> D
93 | H H
94 |
95 | #
96 |
97 | This kind of composition is sometimes also called vertical composition of
98 | natural transformations.
99 | *)
100 | Program Definition NatTrans_compose {F F' F'' : (C --> C')%functor}
101 | (tr : F --> F') (tr' : F' --> F'') : (F --> F'')%nattrans :=
102 | {|
103 | Trans := fun c : Obj => ((Trans tr' c) ∘ (Trans tr c)) % morphism
104 | |}.
105 |
106 | Next Obligation. (* Trans_com*)
107 | Proof.
108 | rewrite assoc.
109 | rewrite Trans_com.
110 | rewrite assoc_sym.
111 | rewrite Trans_com; auto.
112 | Qed.
113 |
114 | Next Obligation. (* Trans_com_sym *)
115 | Proof.
116 | symmetry.
117 | apply NatTrans_compose_obligation_1.
118 | Qed.
119 |
120 | End NatTrans_Compose.
121 |
122 | Notation "N ∘ N'" := (NatTrans_compose N' N) : nattrans_scope.
123 |
124 | Section NatTrans_Props.
125 | Context {C C' : Category}.
126 |
127 | (** The composition of natural transformations is associative. *)
128 | Theorem NatTrans_compose_assoc {F G H I : (C --> C')%functor} (N : F --> G)
129 | (N' : G --> H) (N'' : H --> I)
130 | : ((N'' ∘ N') ∘ N = N'' ∘ (N' ∘ N))%nattrans
131 | .
132 | Proof.
133 | apply NatTrans_eq_simplify; cbn; auto.
134 | Qed.
135 |
136 | (** The identity natural transformation. The arrow family are just
137 | all identity arrows: *)
138 | Program Definition NatTrans_id (F : (C --> C')%functor) : F --> F :=
139 | {|
140 | Trans := fun x : Obj => id
141 | |}.
142 |
143 | Theorem NatTrans_id_unit_left {F G : (C --> C')%functor} (N : F --> G)
144 | : (NatTrans_id G) ∘ N = N.
145 | Proof.
146 | apply NatTrans_eq_simplify; cbn; auto.
147 | Qed.
148 |
149 | Theorem NatTrans_id_unit_right {F G : (C --> C')%functor} (N : F --> G)
150 | : N ∘ (NatTrans_id F) = N.
151 | Proof.
152 | apply NatTrans_eq_simplify; cbn; auto.
153 | Qed.
154 |
155 | End NatTrans_Props.
156 |
157 | Hint Resolve NatTrans_eq_simplify : core.
158 |
--------------------------------------------------------------------------------
/PreSheaf/CCC.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.CCC.
6 | From Categories Require Import PreSheaf.PreSheaf.
7 | From Categories Require Export PreSheaf.Terminal.
8 | From Categories Require Export PreSheaf.Product.
9 | From Categories Require Export PreSheaf.Exponential.
10 |
11 | (** Category of presheaves over C is cartesian closed. *)
12 | Program Instance PShCat_CCC (C : Category) : CCC (PShCat C)
13 | :=
14 | {|
15 | CCC_term := PSh_Terminal C;
16 | CCC_HP := PSh_Has_Products C;
17 | CCC_HEXP := PSh_Has_Exponentials C
18 | |}.
19 |
20 |
21 |
--------------------------------------------------------------------------------
/PreSheaf/Complete.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
3 | From Categories Require Import Type_Cat.GenProd Type_Cat.GenSum Type_Cat.Equalizer.
4 | From Categories Require Import Limits.Limit Limits.GenProd_Eq_Limits.
5 | From Categories Require Import PreSheaf.PreSheaf.
6 | From Categories Require Import
7 | PreSheaf.Equalizer
8 | PreSheaf.GenProd
9 | PreSheaf.GenSum
10 | .
11 |
12 | Instance PShCat_Complete (C: Category) : Complete (PShCat C) :=
13 | @GenProd_Eq_Complete (PShCat C) (PSh_GenProd C) (@PSh_Has_Equalizers C).
14 |
15 | Instance PShCat_CoComplete (C: Category) : CoComplete (PShCat C) :=
16 | @GenSum_CoEq_CoComplete (PShCat C) (PSh_GenSum C) (@PSh_Has_CoEqualizers C).
17 |
--------------------------------------------------------------------------------
/PreSheaf/Exponential.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat Coq_Cats.Type_Cat.CCC.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 | From Categories Require Import Basic_Cons.Exponential.
9 | From Categories Require Import PreSheaf.PreSheaf PreSheaf.Product.
10 | From Categories Require Import Yoneda.Yoneda.
11 |
12 | Section Exponential.
13 | Context (C : Category) (F G : PShCat C).
14 |
15 | Local Obligation Tactic := idtac.
16 |
17 | (** The exponential in category of presheaves is the presheaf that maps each
18 | object c of C to the set of natural transformations (Y(c) × F --> G).
19 | Where Y is the Yoneda embedding, and × is the product of presheaves.
20 |
21 | This presheaf, maps an arrow h : c --> c' in C to the natural
22 | transformation ( morphisms in category of presheaves are natural
23 | transformations) that maps a natural transformation u to the natural
24 | transformation that maps an objet x of C to the function that given
25 | v : ((c' --> x : Cᵒᵖ) * F(x)) gives
26 | (Trans u x (((fst v) ∘ f)%morphism, (snd v)))
27 | *)
28 | Program Definition funspace_psh : Functor (C^op) Type_Cat :=
29 | {|
30 | FO :=
31 | fun x =>
32 | NatTrans
33 | (pointwise_product_psh _ ((Yoneda C _o) x)%object F)
34 | G;
35 | FA :=
36 | fun _ _ f u =>
37 | {|
38 | Trans :=
39 | fun x v => Trans u x (((fst v) ∘ f)%morphism, (snd v))
40 | |}
41 | |}.
42 |
43 | Next Obligation.
44 | Proof.
45 | basic_simpl.
46 | extensionality v.
47 | simpl_ids.
48 | set (W := equal_f (Trans_com u h) (f ∘ (fst v), snd v)%morphism).
49 | cbn in W.
50 | simpl_ids in W.
51 | rewrite assoc_sym.
52 | trivial.
53 | Qed.
54 |
55 | Next Obligation.
56 | Proof.
57 | symmetry.
58 | apply funspace_psh_obligation_1.
59 | Qed.
60 |
61 | Next Obligation.
62 | Proof.
63 | intros x.
64 | FunExt.
65 | apply NatTrans_eq_simplify; cbn; auto.
66 | Qed.
67 |
68 | Next Obligation.
69 | Proof.
70 | intros a b c f g.
71 | FunExt.
72 | apply NatTrans_eq_simplify; cbn.
73 | FunExt.
74 | rewrite assoc.
75 | trivial.
76 | Qed.
77 |
78 | (** The evaluation morphism (natural transformation) for exponentials of
79 | presheaves. *)
80 | Program Definition PSh_Exponential_Eval :
81 | (pointwise_product_psh C funspace_psh F --> G)%nattrans
82 | :=
83 | {|
84 | Trans := fun x u => Trans (fst u) x (id, snd u)
85 | |}.
86 |
87 | Next Obligation.
88 | Proof.
89 | basic_simpl.
90 | extensionality u.
91 | set (W := equal_f (Trans_com (fst u) h) (id, snd u)).
92 | cbn in W.
93 | auto.
94 | Qed.
95 |
96 | Next Obligation.
97 | Proof.
98 | symmetry.
99 | apply PSh_Exponential_Eval_obligation_1.
100 | Qed.
101 |
102 | (** The currying morphism (natural transformation) for exponentials of
103 | presheaves. *)
104 | Program Definition PSh_Exponential_Curry
105 | (x : (C ^op --> Type_Cat)%functor)
106 | (u : (pointwise_product_psh C x F --> G)%nattrans)
107 | :
108 | (x --> funspace_psh)%nattrans
109 | :=
110 | {|
111 | Trans :=
112 | fun v m =>
113 | {|
114 | Trans :=
115 | fun p q =>
116 | Trans u p (x _a (fst q) m, snd q)%morphism
117 | |}
118 | |}.
119 |
120 | Next Obligation.
121 | Proof.
122 | intros x u v m c c' h.
123 | cbn in *.
124 | extensionality p.
125 | simpl_ids.
126 | cbn_rewrite (F_compose x (fst p) h).
127 | set (W := equal_f (Trans_com u h) ((x _a (fst p) m)%morphism, snd p)).
128 | cbn in W.
129 | trivial.
130 | Qed.
131 |
132 | Next Obligation.
133 | Proof.
134 | symmetry; simpl.
135 | apply PSh_Exponential_Curry_obligation_1.
136 | Qed.
137 |
138 | Next Obligation.
139 | Proof.
140 | intros x u c c' h.
141 | cbn in *.
142 | extensionality v.
143 | apply NatTrans_eq_simplify.
144 | extensionality z; extensionality y.
145 | cbn in *.
146 | cbn_rewrite (F_compose x h (fst y)).
147 | trivial.
148 | Qed.
149 |
150 | Next Obligation.
151 | Proof.
152 | symmetry; simpl.
153 | apply PSh_Exponential_Curry_obligation_3.
154 | Qed.
155 |
156 | (** Exponentials of presheaves. *)
157 | Program Definition PSh_Exponential : (F ⇑ G)%object :=
158 | {|
159 | exponential := funspace_psh;
160 | eval := PSh_Exponential_Eval;
161 | Exp_morph_ex := PSh_Exponential_Curry
162 | |}.
163 |
164 | Next Obligation.
165 | Proof.
166 | intros z f.
167 | apply NatTrans_eq_simplify.
168 | extensionality x; extensionality y.
169 | cbn in *.
170 | rewrite (F_id z).
171 | trivial.
172 | Qed.
173 |
174 | Next Obligation.
175 | Proof.
176 | intros z f u u' H1 H2.
177 | rewrite H2 in H1; clear H2.
178 | assert (H1' := f_equal Trans H1); clear H1.
179 | symmetry in H1'.
180 | apply NatTrans_eq_simplify.
181 | extensionality x; extensionality y.
182 | apply NatTrans_eq_simplify.
183 | extensionality p.
184 | extensionality q.
185 | cbn in *.
186 | assert (H1 := f_equal (fun w => w p (z _a (fst q) y, snd q)%morphism) H1');
187 | clear H1'.
188 | cbn in H1.
189 | cbn_rewrite (equal_f (Trans_com u (fst q)) y) in H1.
190 | cbn_rewrite (equal_f (Trans_com u' (fst q)) y) in H1.
191 | cbn in H1.
192 | auto.
193 | Qed.
194 |
195 | End Exponential.
196 |
197 | Instance PSh_Has_Exponentials (C : Category) : Has_Exponentials (PShCat C) :=
198 | PSh_Exponential C.
199 |
--------------------------------------------------------------------------------
/PreSheaf/GenProd.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import Limits.Limit Limits.GenProd_GenSum.
8 | From Categories Require Import Archetypal.Discr.Discr.
9 | From Categories Require Import PreSheaf.PreSheaf.
10 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
11 |
12 | Section PSh_GenProd.
13 | Context (C : Category) (A : Type) (map : A → PShCat C).
14 |
15 | Local Notation Fm := (Discr_Func (PShCat C) map) (only parsing).
16 |
17 | Local Hint Extern 1 => match goal with
18 | [|- context [(?F _a id)%morphism]] => rewrite (F_id F)
19 | end : core.
20 | Local Hint Extern 1 =>
21 | match goal with
22 | [|- context [(?F _a (?f ∘ ?g))%morphism]] =>
23 | cbn_rewrite (F_compose F f g)
24 | end : core.
25 |
26 | (** The generalized product presheaf. *)
27 | Program Definition PSh_GenProd_func : PreSheaf C :=
28 | {|
29 | FO :=
30 | fun c =>
31 | ∀ x : A, ((Fm _o x) _o c)%object;
32 | FA :=
33 | fun _ _ h f x => (map x _a h (f x))%morphism
34 | |}.
35 |
36 | (** The projections of generalized product presheaf. *)
37 | Program Definition PSh_GenProd_proj (x : A) :
38 | (PSh_GenProd_func --> map x)%nattrans :=
39 | {|
40 | Trans := fun c y => y x
41 | |}.
42 |
43 | (** The cone for generalized product presheaf. *)
44 | Program Definition PSh_GenProd_Cone : Cone Fm :=
45 | {|
46 | cone_apex :=
47 | {|FO := fun _ => PSh_GenProd_func;
48 | FA :=
49 | fun _ _ h => id
50 | |};
51 | cone_edge := {|Trans := fun x => PSh_GenProd_proj x |}
52 | |}.
53 |
54 | Local Hint Extern 1 =>
55 | match goal with
56 | [|- context [Trans ?f _ ((?F _a)%morphism ?h _)]] =>
57 | cbn_rewrite (equal_f (Trans_com f h))
58 | end : core.
59 |
60 | Local Hint Extern 1 => match goal with [H : unit |- _] => destruct H end : core.
61 |
62 | Local Hint Resolve NatTrans_eq_simplify : core.
63 |
64 | Local Hint Extern 1 => rewrite From_Term_Cat : core.
65 |
66 | (** The morphism that maps to the generalized product given a map to its
67 | components. *)
68 | Program Definition PSh_GenProd_morph_ex
69 | (Cn : LoKan_Cone (Functor_To_1_Cat
70 | (Discr_Cat A)) (Discr_Func (PShCat C) map))
71 | : ((Cn _o)%object tt --> PSh_GenProd_func)%nattrans :=
72 | {|
73 | Trans := fun c y x => Trans (Trans (cone_edge Cn) x) c y
74 | |}.
75 |
76 | Local Hint Extern 1 => progress cbn : core.
77 |
78 | Local Obligation Tactic := basic_simpl; auto 10.
79 |
80 | Program Definition PSh_GenProd : (Π map)%object :=
81 | {|
82 | LRKE := PSh_GenProd_Cone;
83 | LRKE_morph_ex :=
84 | fun Cn =>
85 | {|
86 | cone_morph :=
87 | {|
88 | Trans :=
89 | fun x =>
90 | match x as u return
91 | ((Cn _o)%object u --> PSh_GenProd_func)%nattrans
92 | with
93 | tt => PSh_GenProd_morph_ex Cn
94 | end
95 | |}
96 | |}
97 | |}.
98 |
99 | Local Obligation Tactic := idtac.
100 |
101 | Next Obligation.
102 | Proof.
103 | intros Cn h h'.
104 | apply NatTrans_eq_simplify.
105 | extensionality x.
106 | apply NatTrans_eq_simplify.
107 | extensionality y.
108 | extensionality z.
109 | extensionality u.
110 | cbn in *.
111 | destruct x.
112 | cbn_rewrite
113 | <-
114 | (
115 | equal_f
116 | (
117 | f_equal
118 | (
119 | fun w : (Cn ∘ Functor_To_1_Cat
120 | (Discr_Cat A) --> Discr_Func (PShCat C) map)%nattrans
121 | => Trans (Trans w u) y
122 | )
123 | (cone_morph_com h)
124 | )
125 | z
126 | ).
127 | cbn_rewrite
128 | <-
129 | (
130 | equal_f
131 | (
132 | f_equal
133 | (
134 | fun w : (Cn ∘ Functor_To_1_Cat
135 | (Discr_Cat A) --> Discr_Func (PShCat C) map)%nattrans
136 | => Trans (Trans w u) y
137 | )
138 | (cone_morph_com h')
139 | )
140 | z
141 | ).
142 | trivial.
143 | Qed.
144 |
145 | End PSh_GenProd.
146 |
--------------------------------------------------------------------------------
/PreSheaf/Initial.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Basic_Cons.Terminal.
7 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
8 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
9 | From Categories Require Import Basic_Cons.Terminal.
10 | From Categories Require Import PreSheaf.PreSheaf.
11 |
12 | Section Initial.
13 | Context (C : Category).
14 |
15 | (** The initial element of the category of presheaves. *)
16 | Program Definition PSh_Init_Func : Functor (C^op) Type_Cat :=
17 | {|
18 | FO := fun _ => (Empty : Type)
19 | |}.
20 |
21 | Local Hint Resolve NatTrans_eq_simplify : core.
22 | Local Hint Extern 1 => progress cbn in * : core.
23 |
24 | (** The functor that maps to the empty type in coq is the terminal object of
25 | presheaves. *)
26 | Program Instance PSh_Initial : (𝟘_ (PShCat C))%object :=
27 | {|
28 | terminal := PSh_Init_Func;
29 | t_morph := fun u => {|Trans := fun x y => _ |}
30 | |}.
31 |
32 | End Initial.
33 |
--------------------------------------------------------------------------------
/PreSheaf/PreSheaf.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 |
9 | (** A presheaf on C is a functor Cᵒᵖ –≻ Type_Cat. *)
10 | Definition PreSheaf (C : Category) := Functor (C^op) Type_Cat.
11 |
12 | (** The category of presheaves. *)
13 | Definition PShCat (C : Category) := Func_Cat (C^op) Type_Cat.
14 |
--------------------------------------------------------------------------------
/PreSheaf/Product.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat Coq_Cats.Type_Cat.CCC.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 | From Categories Require Import Basic_Cons.Product.
9 | From Categories Require Import PreSheaf.PreSheaf.
10 |
11 | Section Product.
12 | Context (C : Category) (F G : PShCat C).
13 |
14 | Local Hint Extern 1 =>
15 | match goal with
16 | [F : (_ ^op --> Type_Cat)%functor |- _] => rewrite (F_id F)
17 | end : core.
18 | Local Hint Extern 1 =>
19 | match goal with
20 | [F : (_ ^op --> Type_Cat)%functor |- context [(F _a (?f ∘ ?g))%morphism]] =>
21 | cbn_rewrite (F_compose F f g)
22 | end : core.
23 |
24 | (** The pointwise product presheaf. *)
25 | Program Definition pointwise_product_psh : PShCat C :=
26 | {|
27 | FO := fun x => ((F _o x) * (G _o x))%object%type;
28 | FA := fun _ _ f u => (F _a f (fst u), G _a f (snd u))%morphism%object
29 | |}.
30 |
31 | Local Hint Extern 1 =>
32 | repeat
33 | match goal with
34 | [f : (?p --> _)%nattrans,
35 | h : (_ --> _)%morphism, c : _, x : (?p _o)%object _ |- _] =>
36 | cbn_rewrite (equal_f (Trans_com f h) x)
37 | end : core.
38 |
39 | (** The pointwise product presheaf is the product of presheaves. *)
40 | Program Definition PSh_Product : (F × G)%object :=
41 | {|
42 | product := pointwise_product_psh;
43 | Pi_1 := {| Trans := fun _ => fst |};
44 | Pi_2 := {| Trans := fun _ => snd |};
45 | Prod_morph_ex :=
46 | fun p' f g => {|Trans := fun x u => (Trans f x u, Trans g x u) |}
47 | |}.
48 |
49 | Local Obligation Tactic := idtac.
50 |
51 | Next Obligation.
52 | Proof.
53 | intros p' r1 r2 f g H1 H2 H3 H4; cbn in *.
54 | rewrite <- H3 in H1; rewrite <- H4 in H2; clear H3 H4.
55 | apply NatTrans_eq_simplify.
56 | extensionality v; extensionality z.
57 | assert (W1 := f_equal (fun w : (p' --> F)%nattrans => Trans w v z) H1).
58 | assert (W2 := f_equal (fun w : (p' --> G)%nattrans => Trans w v z) H2).
59 | cbn in W1, W2.
60 | match goal with
61 | [|- ?A = ?B] => destruct A; destruct B; cbn in *; auto
62 | end.
63 | Qed.
64 |
65 | End Product.
66 |
67 | Instance PSh_Has_Products (C : Category) : Has_Products (PShCat C) :=
68 | PSh_Product C.
69 |
--------------------------------------------------------------------------------
/PreSheaf/PullBack.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Basic_Cons.CCC Basic_Cons.PullBack.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
9 | From Categories Require Import PreSheaf.PreSheaf.
10 |
11 | Section PSh_PullBack.
12 | Context (C : Category) {F G I : PreSheaf C}
13 | (f : (F --> I)%nattrans) (g : (G --> I)%nattrans).
14 |
15 | Local Hint Extern 1 =>
16 | match goal with
17 | [x : sig _ |- _ ] =>
18 | let H := fresh "H" in
19 | destruct x as [x H]
20 | end : core.
21 |
22 | Local Hint Extern 1 => match goal with
23 | [|- context [(?F _a id)%morphism]] => rewrite (F_id F)
24 | end : core.
25 | Local Hint Extern 1 =>
26 | match goal with
27 | [|- context [(?F _a (?f ∘ ?g))%morphism]] =>
28 | cbn_rewrite (F_compose F f g)
29 | end : core.
30 |
31 | Local Hint Extern 1 =>
32 | match goal with
33 | [|- context [Trans ?f _ ((?F _a)%morphism ?h _)]] =>
34 | cbn_rewrite (equal_f (Trans_com f h))
35 | end : core.
36 |
37 | Local Hint Extern 1 => progress cbn in * : core.
38 |
39 | Local Obligation Tactic := basic_simpl; auto 10.
40 |
41 | (** The pointwise pullback presheaf. *)
42 | Program Definition PSh_PullBack_Func : PreSheaf C :=
43 | {|
44 | FO :=
45 | fun c =>
46 | {x : ((F _o c) * (G _o c))%object%type |
47 | Trans f c (fst x) = Trans g c (snd x)
48 | };
49 | FA :=
50 | fun c c' h x =>
51 | exist
52 | _
53 | ((F _a h (fst (proj1_sig x)))%morphism,
54 | (G _a h (snd (proj1_sig x)))%morphism)
55 | _
56 | |}.
57 |
58 | (** The morphism from the pullback to the domain object of the first
59 | morphism. *)
60 | Program Definition PSh_PullBack_morph_1 : (PSh_PullBack_Func --> F)%nattrans :=
61 | {|
62 | Trans := fun c x => fst (proj1_sig x)
63 | |}.
64 |
65 | (** The morphism from the pullback to the domain object of the second
66 | morphism. *)
67 | Program Definition PSh_PullBack_morph_2 : (PSh_PullBack_Func --> G)%nattrans :=
68 | {|
69 | Trans := fun c x => snd (proj1_sig x)
70 | |}.
71 |
72 | (** The morphism from the candidate pullback to the pullback. *)
73 | Program Definition PSh_PullBack_morph_ex
74 | (p' : (C ^op --> Type_Cat)%functor)
75 | (pm1 : (p' --> F)%nattrans)
76 | (pm2 : (p' --> G)%nattrans)
77 | (H : (f ∘ pm1)%nattrans = (g ∘ pm2)%nattrans)
78 | :
79 | (p' --> PSh_PullBack_Func)%nattrans
80 | :=
81 | {|
82 | Trans :=
83 | fun c x =>
84 | exist
85 | _
86 | (Trans pm1 c x, Trans pm2 c x)
87 | (f_equal (fun w : (p' --> I)%nattrans => Trans w c x) H)
88 | |}.
89 |
90 | (** The pointwise pullback presheaf is the pullback of presheaves. *)
91 | Program Definition PSh_PullBack : @PullBack (PShCat C) _ _ _ f g :=
92 | {|
93 | pullback := PSh_PullBack_Func;
94 | pullback_morph_1 := PSh_PullBack_morph_1;
95 | pullback_morph_2 := PSh_PullBack_morph_2;
96 | pullback_morph_ex := PSh_PullBack_morph_ex
97 | |}.
98 |
99 | Local Obligation Tactic := idtac.
100 |
101 | Next Obligation.
102 | Proof.
103 | intros p' pm1 pm2 H u u' H1 H2 H3 H4.
104 | rewrite <- H3 in H1; clear H3.
105 | rewrite <- H4 in H2; clear H4.
106 | apply NatTrans_eq_simplify.
107 | extensionality c.
108 | extensionality x.
109 | assert (H1' := f_equal (fun w : (p' --> F)%nattrans => Trans w c x) H1);
110 | clear H1.
111 | assert (H2' := f_equal (fun w : (p' --> G)%nattrans => Trans w c x) H2);
112 | clear H2.
113 | cbn in *.
114 | match goal with
115 | [|- ?A = ?B] => destruct A as [[? ?] ?]; destruct B as [[? ?] ?]
116 | end.
117 | apply sig_proof_irrelevance.
118 | cbn in *; subst; trivial.
119 | Qed.
120 |
121 | End PSh_PullBack.
122 |
123 | Instance PSh_Has_PullBacks (C : Category) : Has_PullBacks (PShCat C) :=
124 | @PSh_PullBack C.
125 |
--------------------------------------------------------------------------------
/PreSheaf/Sum.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
7 | From Categories Require Import Basic_Cons.Product.
8 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat.
9 | From Categories Require Import PreSheaf.PreSheaf.
10 |
11 | Section Sum.
12 | Context (C : Category) (F G : PShCat C).
13 |
14 | Local Hint Extern 1 => match goal with
15 | [H : (_ + _)%type |- _] => destruct H
16 | end : core.
17 | Local Hint Extern 1 => match goal with
18 | [|- context [(?F _a id)%morphism]] => rewrite (F_id F)
19 | end : core.
20 | Local Hint Extern 1 =>
21 | match goal with
22 | [|- context [(?F _a (?f ∘ ?g))%morphism]] =>
23 | cbn_rewrite (F_compose F f g)
24 | end : core.
25 |
26 | (** The pointwise sum of presheaves F and G. *)
27 | Program Definition PSh_Sum_Func : PShCat C :=
28 | {|
29 | FO := fun c => ((F _o c) + (G _o c))%type%object;
30 | FA :=
31 | fun c d h x =>
32 | match x return ((F _o d) + (G _o d))%type%object with
33 | | inl xl => inl (F _a h xl)%morphism
34 | | inr xr => inr (G _a h xr)%morphism
35 | end
36 | |}.
37 |
38 | (** Pointwise left injection. *)
39 | Program Definition PSh_Sum_injl : NatTrans F PSh_Sum_Func :=
40 | {|
41 | Trans := fun c x => inl x
42 | |}.
43 |
44 | (** Pointwise right injection. *)
45 | Program Definition PSh_Sum_injr : NatTrans G PSh_Sum_Func :=
46 | {|
47 | Trans := fun c x => inr x
48 | |}.
49 |
50 | Local Hint Extern 1 =>
51 | match goal with
52 | [|- context [Trans ?f _ ((?F _a)%morphism ?h _)]] =>
53 | cbn_rewrite (equal_f (Trans_com f h))
54 | end : core.
55 |
56 | (** Pointwise morphism into sum constructed out of two morphisms
57 | from summands. *)
58 | Program Definition PSh_Sum_morph_ex
59 | (H : PreSheaf C)
60 | (f : NatTrans F H)
61 | (g : NatTrans G H):
62 | NatTrans PSh_Sum_Func H :=
63 | {|
64 | Trans :=
65 | fun c x =>
66 | match x return (H _o c)%object with
67 | | inl xl => Trans f c xl
68 | | inr xr => Trans g c xr
69 | end
70 | |}.
71 |
72 | Local Notation "F + G" := (Sum (PShCat C) F G) : object_scope.
73 |
74 | (** The pointwise sum presheaf is the sum of presheaves. *)
75 | Program Definition PSh_Sum : (F + G)%object :=
76 | {|
77 | product := PSh_Sum_Func;
78 | Pi_1 := PSh_Sum_injl;
79 | Pi_2 := PSh_Sum_injr;
80 | Prod_morph_ex := PSh_Sum_morph_ex
81 | |}.
82 |
83 | Local Obligation Tactic := idtac.
84 |
85 | Next Obligation.
86 | Proof.
87 | intros p' r1 r2 f g H1 H2 H3 H4.
88 | rewrite <- H3 in H1; rewrite <- H4 in H2;
89 | clear H3 H4.
90 | apply NatTrans_eq_simplify.
91 | extensionality c; extensionality x.
92 | destruct x as [x1|x2].
93 | + apply (f_equal (fun w : (F --> p')%nattrans => Trans w c x1) H1).
94 | + apply (f_equal (fun w : (G --> p')%nattrans => Trans w c x2) H2).
95 | Qed.
96 |
97 | End Sum.
98 |
99 | Instance PSh_Has_Sums (C : Category) : Has_Sums (PShCat C) := PSh_Sum C.
100 |
--------------------------------------------------------------------------------
/PreSheaf/Terminal.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Functor.Main.
6 | From Categories Require Import Coq_Cats.Type_Cat.Type_Cat Coq_Cats.Type_Cat.CCC.
7 | From Categories Require Import NatTrans.NatTrans NatTrans.Func_Cat.
8 | From Categories Require Import Basic_Cons.Terminal.
9 | From Categories Require Import PreSheaf.PreSheaf.
10 |
11 | Section Terminal.
12 | Context (C : Category).
13 |
14 | (** The terminal element of the category of presheaves. *)
15 | Program Definition PSh_Term_PreSheaf : Functor (C^op) Type_Cat :=
16 | {|
17 | FO := fun _ => unit
18 | |}.
19 |
20 | Local Hint Resolve NatTrans_eq_simplify : core.
21 | Local Hint Extern 1 =>
22 | match goal with
23 | [|- ?A = ?B] => try destruct A; try destruct B; trivial; fail
24 | end : core.
25 |
26 | (** The functor that maps to the unit type in coq is the terminal object
27 | of presheaves. *)
28 | Program Instance PSh_Terminal : (𝟙_ (PShCat C))%object :=
29 | {
30 | terminal := PSh_Term_PreSheaf;
31 | t_morph := fun _ => {|Trans := fun _ _ => tt|}
32 | }.
33 |
34 | End Terminal.
35 |
--------------------------------------------------------------------------------
/PreSheaf/Topos.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Topos.Topos.
3 | From Categories Require Import Limits.Limit.
4 | From Categories Require Import Coq_Cats.Type_Cat.Card_Restriction.
5 | From Categories Require Import PreSheaf.PreSheaf.
6 | From Categories Require Import PreSheaf.CCC.
7 | From Categories Require Import PreSheaf.Complete.
8 | From Categories Require Import PreSheaf.SubObject_Classifier.
9 |
10 | Instance Type_Cat_Topos (C : Category) : Topos :=
11 | {
12 | Topos_Cat := PShCat C;
13 | Topos_Cat_CCC := PShCat_CCC C;
14 | Topos_Cat_SOC := PSh_SubObject_Classifier C;
15 | Topos_Cat_Fin_Limit := Complete_Has_Restricted_Limits (PShCat C) Finite
16 | }.
17 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # README #
2 |
3 | This is an implementation of category theory in Coq.
4 |
5 | ## Coq version and compilation ##
6 |
7 | * This development uses features new to Coq8.11.1
8 | * It has been tested on Debian with Coq 8.11.1
9 | * To compile simply type
10 | * ``` ./configure.sh ``` to produce the Makefile [1] and then
11 | * ``` make ``` to compile
12 |
13 | [1] you will need to have coq_makefile to be on the path
14 |
--------------------------------------------------------------------------------
/Topos/Main.v:
--------------------------------------------------------------------------------
1 | From Categories Require Export Topos.Topos.
2 | From Categories Require Export Topos.SubObject_Classifier.
3 |
--------------------------------------------------------------------------------
/Topos/SubObject_Classifier.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Essentials.Notations.
2 | From Categories Require Import Essentials.Types.
3 | From Categories Require Import Essentials.Facts_Tactics.
4 | From Categories Require Import Category.Main.
5 | From Categories Require Import Basic_Cons.PullBack Basic_Cons.Terminal.
6 |
7 | (**
8 | A subobject classifier Ω is the object that classifies subobjects of all
9 | objects.That is, There is a one to one correspondence between sub-objects
10 | of an object a i.e., monomorphisms to a, m : x ≫–> a, and morphisms from
11 | a to Ω. It is formally defined as follows:
12 |
13 | Ω together with ⊤ : 1 → Ω (1 is the terminal object) is a subobject
14 | classifier if we have for any monomorphism m : a ≫–> b there is a
15 | unique morphism χₘ : b → Ω such that the following diagram is a pullback:
16 | #
17 |
18 | !
19 | a ————————————–> 1
20 | |__| |
21 | | |
22 | m | |⊤
23 | | |
24 | ↓ ↓
25 | b ————————————–> Ω
26 | χₘ
27 |
28 | #
29 |
30 | Where ! is the unique arrow to the terminal object.
31 | *)
32 | Section SubObject_Classifier.
33 | Context (C : Category) {term : (𝟙_ C)%object}.
34 |
35 | Local Notation "1" := term.
36 |
37 | Record SubObject_Classifier : Type :=
38 | {
39 | SOC : C;
40 | SOC_morph : (1 --> SOC)%morphism;
41 | SOC_char {a b : C} (m : (a ≫–> b)%morphism) : (b --> SOC)%morphism;
42 | SO_pulback {a b : C} (m : (a ≫–> b)%morphism) :
43 | is_PullBack
44 | (mono_morphism m)
45 | (t_morph 1 a)
46 | (SOC_char m)
47 | SOC_morph;
48 | SOC_char_unique {a b : C} (m : (a ≫–> b)%morphism)
49 | (h h' : (b --> SOC)%morphism) :
50 | is_PullBack
51 | (mono_morphism m)
52 | (t_morph 1 a)
53 | h
54 | SOC_morph
55 | →
56 | is_PullBack
57 | (mono_morphism m)
58 | (t_morph 1 a)
59 | h'
60 | SOC_morph
61 | →
62 | h = h'
63 | }.
64 |
65 | End SubObject_Classifier.
66 |
--------------------------------------------------------------------------------
/Topos/Topos.v:
--------------------------------------------------------------------------------
1 | From Categories Require Import Category.Main.
2 | From Categories Require Import Limits.Limit.
3 | From Categories Require Import Coq_Cats.Type_Cat.Card_Restriction.
4 | From Categories Require Import Basic_Cons.CCC.
5 | From Categories Require Import Topos.SubObject_Classifier.
6 |
7 | Class Topos : Type :=
8 | {
9 | Topos_Cat : Category;
10 | Topos_Cat_CCC : CCC Topos_Cat;
11 | Topos_Cat_Fin_Limit : Has_Restr_Limits Topos_Cat Finite;
12 | Topos_Cat_SOC : SubObject_Classifier Topos_Cat
13 | }.
14 |
15 | Coercion Topos_Cat : Topos >-> Category.
16 |
--------------------------------------------------------------------------------
/_CoqProject:
--------------------------------------------------------------------------------
1 | #Essentials:
2 | Essentials/Notations.v
3 | Essentials/Types.v
4 | Essentials/Facts_Tactics.v
5 | Essentials/Quotient.v
6 |
7 | #Category:
8 | Category/Category.v
9 | Category/Opposite.v
10 | Category/Morph.v
11 | Category/SubCategory.v
12 | Category/Composable_Chain.v
13 | Category/Main.v
14 |
15 | #Ext_Cons:
16 | Ext_Cons/Prod_Cat/Prod_Cat.v
17 | Ext_Cons/Prod_Cat/Operations.v
18 | Ext_Cons/Prod_Cat/Nat_Facts.v
19 | Ext_Cons/Prod_Cat/Main.v
20 | Ext_Cons/Arrow.v
21 | Ext_Cons/Comma.v
22 | Ext_Cons/Main.v
23 |
24 | #Functor:
25 | Functor/Functor_Extender.v
26 | Functor/Functor.v
27 | Functor/Functor_Ops.v
28 | Functor/Functor_Properties.v
29 | Functor/Functor_Image.v
30 | Functor/Const_Func.v
31 | Functor/Const_Func_Functor.v
32 | Functor/Main.v
33 | Functor/Representable/Main.v
34 | Functor/Representable/Hom_Func.v
35 | Functor/Representable/Hom_Func_Prop.v
36 | Functor/Representable/Representable.v
37 |
38 | #Coq_Cats:
39 | Coq_Cats/Coq_Cat.v
40 | Coq_Cats/Type_Cat/Type_Cat.v
41 | Coq_Cats/Type_Cat/Initial.v
42 | Coq_Cats/Type_Cat/CCC.v
43 | Coq_Cats/Type_Cat/Sum.v
44 | Coq_Cats/Type_Cat/GenSum.v
45 | Coq_Cats/Type_Cat/GenProd.v
46 | Coq_Cats/Type_Cat/Facts.v
47 | Coq_Cats/Type_Cat/Card_Restriction.v
48 | Coq_Cats/Type_Cat/Equalizer.v
49 | Coq_Cats/Type_Cat/Complete.v
50 | Coq_Cats/Type_Cat/PullBack.v
51 | Coq_Cats/Type_Cat/LCCC.v
52 | Coq_Cats/Type_Cat/SubObject_Classifier.v
53 | Coq_Cats/Type_Cat/Topos.v
54 | Coq_Cats/Type_Cat/Morphisms.v
55 | Coq_Cats/Set_Cat.v
56 | Coq_Cats/Prop_Cat.v
57 | Coq_Cats/Main.v
58 |
59 | #Basic_Cons:
60 | Basic_Cons/Terminal.v
61 | Basic_Cons/Product.v
62 | Basic_Cons/Exponential.v
63 | Basic_Cons/Exponential_Functor.v
64 | Basic_Cons/Facts.v
65 | Basic_Cons/Facts/Init_Prod.v
66 | Basic_Cons/Facts/Term_Prod.v
67 | Basic_Cons/Facts/Main.v
68 | Basic_Cons/Facts/Equalizer_Monic.v
69 | Basic_Cons/Facts/Adjuncts.v
70 | Basic_Cons/Facts/Term_IsoCat.v
71 | Basic_Cons/Main.v
72 | Basic_Cons/CCC.v
73 | Basic_Cons/LCCC.v
74 | Basic_Cons/Equalizer.v
75 | Basic_Cons/PullBack.v
76 | Basic_Cons/Limits.v
77 |
78 | #Algebras:
79 | Algebras/Algebras.v
80 | Algebras/Main.v
81 |
82 | #Cat:
83 | Cat/Cat.v
84 | Cat/Initial.v
85 | Cat/Terminal.v
86 | Cat/Product.v
87 | Cat/Exponential.v
88 | Cat/Exponential_Facts.v
89 | Cat/CCC.v
90 | Cat/Facts.v
91 | Cat/Cat_Iso.v
92 |
93 | #NatTrans:
94 | NatTrans/NatTrans.v
95 | NatTrans/Operations.v
96 | NatTrans/NatIso.v
97 | NatTrans/Func_Cat.v
98 | NatTrans/Morphisms.v
99 | NatTrans/Main.v
100 |
101 | #Yoneda:
102 | Yoneda/Yoneda.v
103 |
104 | #Limits:
105 | Limits/Limit.v
106 | Limits/Main.v
107 | Limits/GenProd_GenSum.v
108 | Limits/GenProd_Eq_Limits.v
109 | Limits/Pointwise.v
110 | Limits/Complete_Preorder.v
111 | Limits/Isomorphic_Cat.v
112 |
113 | #Archetypal:
114 | Archetypal/Discr/Discr.v
115 | Archetypal/Discr/NatFacts.v
116 | Archetypal/Discr/Main.v
117 | Archetypal/Monoid_Cat/Monoid_Cat.v
118 | Archetypal/Monoid_Cat/List_Monoid_Cat.v
119 | Archetypal/PreOrder_Cat/PreOrder_Cat.v
120 | Archetypal/PreOrder_Cat/OmegaCat.v
121 |
122 | #Adjunction:
123 | Adjunction/Adjunction.v
124 | Adjunction/Duality.v
125 | Adjunction/Main.v
126 | Adjunction/Adj_Facts.v
127 | Adjunction/Adj_Cat.v
128 | Adjunction/Univ_Morph.v
129 | Adjunction/AFT/Solution_Set_Cond.v
130 | Adjunction/AFT/Commas_Complete/Commas_GenProd.v
131 | Adjunction/AFT/Commas_Complete/Commas_Equalizer.v
132 | Adjunction/AFT/Commas_Complete/Commas_Complete.v
133 | Adjunction/AFT/AFT.v
134 |
135 | #KanExt:
136 | KanExt/Local.v
137 | KanExt/Global.v
138 | KanExt/GlobalDuality.v
139 | KanExt/LocalFacts/Uniqueness.v
140 | KanExt/LocalFacts/ConesToHom.v
141 | KanExt/LocalFacts/HomToCones.v
142 | KanExt/LocalFacts/NatIso.v
143 | KanExt/LocalFacts/From_Iso_Cat.v
144 | KanExt/LocalFacts/Main.v
145 | KanExt/GlobalFacts.v
146 | KanExt/LocaltoGlobal.v
147 | KanExt/GlobaltoLocal.v
148 | KanExt/Preservation.v
149 | KanExt/Pointwise.v
150 | KanExt/Main.v
151 | KanExt/Facts.v
152 |
153 | #Topos:
154 | Topos/SubObject_Classifier.v
155 | Topos/Topos.v
156 | Topos/Main.v
157 |
158 | #PreSheaf:
159 | PreSheaf/PreSheaf.v
160 | PreSheaf/Terminal.v
161 | PreSheaf/Product.v
162 | PreSheaf/Exponential.v
163 | PreSheaf/Initial.v
164 | PreSheaf/Equalizer.v
165 | PreSheaf/Sum.v
166 | PreSheaf/GenProd.v
167 | PreSheaf/GenSum.v
168 | PreSheaf/Complete.v
169 | PreSheaf/PullBack.v
170 | PreSheaf/Morphisms.v
171 | PreSheaf/SubObject_Classifier.v
172 | PreSheaf/CCC.v
173 | PreSheaf/Topos.v
174 |
175 | #Monad:
176 | Monad/Monad.v
177 | Monad/Adj_Monad.v
178 | Monad/distributive_law.v
179 |
180 | #Demo:
181 | Demo/Demo.v
182 |
183 | -Q . Categories
--------------------------------------------------------------------------------
/configure.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | coq_makefile -f _CoqProject -o Makefile
4 |
--------------------------------------------------------------------------------