Compare commits
210 commits
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -1 +1 @@
|
||||||
references/
|
html/
|
||||||
|
|
2
.gitmodules
vendored
2
.gitmodules
vendored
|
@ -1,6 +1,6 @@
|
||||||
[submodule "libs/cubical"]
|
[submodule "libs/cubical"]
|
||||||
path = libs/cubical
|
path = libs/cubical
|
||||||
url = git@github.com:fredefox/cubical.git
|
url = git@github.com:Saizan/cubical-demo.git
|
||||||
[submodule "libs/agda-stdlib"]
|
[submodule "libs/agda-stdlib"]
|
||||||
path = libs/agda-stdlib
|
path = libs/agda-stdlib
|
||||||
url = git@github.com:agda/agda-stdlib.git
|
url = git@github.com:agda/agda-stdlib.git
|
||||||
|
|
35
BACKLOG.md
35
BACKLOG.md
|
@ -1,18 +1,30 @@
|
||||||
Backlog
|
Backlog
|
||||||
=======
|
=======
|
||||||
|
|
||||||
Prove postulates in `Cat.Wishlist`
|
|
||||||
`ntypeCommulative` might be there as well.
|
|
||||||
|
|
||||||
Prove that the opposite category is a category.
|
|
||||||
|
|
||||||
Prove univalence for the category of
|
Prove univalence for the category of
|
||||||
* sets
|
|
||||||
* functors and natural transformations
|
* functors and natural transformations
|
||||||
|
|
||||||
Prove:
|
In AreInverses, dont use the "point-free" version. I.e.:
|
||||||
* `isProp (Product ...)`
|
|
||||||
* `isProp (HasProducts ...)`
|
`∀ x → f x ≡ g x` rather than `f ≡ g`
|
||||||
|
|
||||||
|
Ideas for future work
|
||||||
|
---------------------
|
||||||
|
|
||||||
|
It would be nice if my formulation of monads is not so "stand-alone" as it is at
|
||||||
|
the moment.
|
||||||
|
|
||||||
|
We can built up the notion of monads and related concept in multiple ways as
|
||||||
|
demonstrated in the two equivalent formulations of monads (kleisli/monoidal):
|
||||||
|
There seems to be a category-theoretic approach and an approach more in the
|
||||||
|
style of functional programming as e.g. the related typeclasses in the
|
||||||
|
standard library of Haskell.
|
||||||
|
|
||||||
|
It would be nice to build up this hierarchy in two ways: The
|
||||||
|
"category-theoretic" way and the "functional programming" way.
|
||||||
|
|
||||||
|
Here is an overview of some of the concepts that need to be developed to acheive
|
||||||
|
this:
|
||||||
|
|
||||||
* Functor ✓
|
* Functor ✓
|
||||||
* Applicative Functor ✗
|
* Applicative Functor ✗
|
||||||
|
@ -24,7 +36,8 @@ Prove:
|
||||||
* Monad
|
* Monad
|
||||||
* Monoidal monad ✓
|
* Monoidal monad ✓
|
||||||
* Kleisli monad ✓
|
* Kleisli monad ✓
|
||||||
* Problem 2.3 in voe
|
* Kleisli ≃ Monoidal ✓
|
||||||
|
* Problem 2.3 in [voe] ✓
|
||||||
* 1st contruction ~ monoidal ✓
|
* 1st contruction ~ monoidal ✓
|
||||||
* 2nd contruction ~ klesli ✓
|
* 2nd contruction ~ klesli ✓
|
||||||
* 1st ≃ 2nd ✗
|
* 1st ≃ 2nd ✓
|
||||||
|
|
62
CHANGELOG.md
62
CHANGELOG.md
|
@ -1,6 +1,58 @@
|
||||||
Changelog
|
Change log
|
||||||
=========
|
=========
|
||||||
|
|
||||||
|
Version 1.6.0
|
||||||
|
-------------
|
||||||
|
|
||||||
|
This version mainly contains changes to the report.
|
||||||
|
|
||||||
|
This is the version I submit for my MSc..
|
||||||
|
|
||||||
|
Version 1.5.0
|
||||||
|
-------------
|
||||||
|
Prove postulates in `Cat.Wishlist`:
|
||||||
|
|
||||||
|
* `ntypeCommulative : n ≤ m → HasLevel ⟨ n ⟩₋₂ A → HasLevel ⟨ m ⟩₋₂ A`
|
||||||
|
|
||||||
|
Prove that these two formulations of univalence are equivalent:
|
||||||
|
|
||||||
|
∀ A B → isEquiv (A ≡ B) (A ≅ B) (id-to-iso A B)
|
||||||
|
∀ A → isContr (Σ[ X ∈ Object ] A ≅ X)
|
||||||
|
|
||||||
|
Prove univalence for the category of...
|
||||||
|
|
||||||
|
* the opposite category
|
||||||
|
* sets
|
||||||
|
* "pair" category
|
||||||
|
|
||||||
|
Finish the proof that products are propositional:
|
||||||
|
|
||||||
|
* `isProp (Product ...)`
|
||||||
|
* `isProp (HasProducts ...)`
|
||||||
|
|
||||||
|
Remove --allow-unsolved-metas pragma from various files
|
||||||
|
|
||||||
|
Also renamed a lot of different projections. E.g. arrow-composition, etc..
|
||||||
|
|
||||||
|
Version 1.4.1
|
||||||
|
-------------
|
||||||
|
Defines a module to work with equivalence providing a way to go between
|
||||||
|
equivalences and quasi-inverses (in the parlance of HoTT).
|
||||||
|
|
||||||
|
Finishes the proof that the category of homotopy-sets are univalent.
|
||||||
|
|
||||||
|
Defines a custom "prelude" module that wraps the `cubical` library and provides
|
||||||
|
a few utilities.
|
||||||
|
|
||||||
|
Reorders Category.isIdentity such that the left projection is left identity.
|
||||||
|
|
||||||
|
Include some text for the half-time report.
|
||||||
|
|
||||||
|
Renames IsProduct.isProduct to IsProduct.ump to avoid ambiguity in some
|
||||||
|
circumstances.
|
||||||
|
|
||||||
|
[WIP]: Adds some stuff about propositionality for products.
|
||||||
|
|
||||||
Version 1.4.0
|
Version 1.4.0
|
||||||
-------------
|
-------------
|
||||||
Adds documentation to a number of modules.
|
Adds documentation to a number of modules.
|
||||||
|
@ -10,12 +62,12 @@ Adds an "equality principle" for categories and monads.
|
||||||
Prove that `IsMonad` is a mere proposition.
|
Prove that `IsMonad` is a mere proposition.
|
||||||
|
|
||||||
Provides the yoneda embedding without relying on the existence of a category of
|
Provides the yoneda embedding without relying on the existence of a category of
|
||||||
categories. This is acheived by providing some of the data needed to make a ccc
|
categories. This is achieved by providing some of the data needed to make a ccc
|
||||||
out of the category of categories without actually having such a category.
|
out of the category of categories without actually having such a category.
|
||||||
|
|
||||||
Renames functors object map and arrow map to `omap` and `fmap`.
|
Renames functors object map and arrow map to `omap` and `fmap`.
|
||||||
|
|
||||||
Prove that kleisli- and monoidal- monads are equivalent!
|
Prove that Kleisli- and monoidal- monads are equivalent!
|
||||||
|
|
||||||
[WIP] Started working on the proofs for univalence for the category of sets and
|
[WIP] Started working on the proofs for univalence for the category of sets and
|
||||||
the category of functors.
|
the category of functors.
|
||||||
|
@ -23,7 +75,7 @@ the category of functors.
|
||||||
Version 1.3.0
|
Version 1.3.0
|
||||||
-------------
|
-------------
|
||||||
Removed unused modules and streamlined things more: All specific categories are
|
Removed unused modules and streamlined things more: All specific categories are
|
||||||
in the namespace `Cat.Categories`.
|
in the name space `Cat.Categories`.
|
||||||
|
|
||||||
Lemmas about categories are now in the appropriate record e.g. `IsCategory`.
|
Lemmas about categories are now in the appropriate record e.g. `IsCategory`.
|
||||||
Also changed how category reexports stuff.
|
Also changed how category reexports stuff.
|
||||||
|
@ -34,7 +86,7 @@ Rename Opposite to opposite
|
||||||
|
|
||||||
Add documentation in Category-module
|
Add documentation in Category-module
|
||||||
|
|
||||||
Formulation of monads in two ways; the "monoidal-" and "kleisli-" form.
|
Formulation of monads in two ways; the "monoidal-" and "Kleisli-" form.
|
||||||
|
|
||||||
WIP: Equivalence of these two formulations
|
WIP: Equivalence of these two formulations
|
||||||
|
|
||||||
|
|
13
Makefile
13
Makefile
|
@ -1,2 +1,13 @@
|
||||||
build: src/**.agda
|
build: src/**.agda
|
||||||
agda src/Cat.agda
|
agda --library-file ./libraries src/Cat.agda
|
||||||
|
|
||||||
|
clean:
|
||||||
|
find src -name "*.agdai" -type f -delete
|
||||||
|
|
||||||
|
html: src/**.agda
|
||||||
|
agda --html src/Cat.agda
|
||||||
|
|
||||||
|
upload: html
|
||||||
|
scp -r html/ remote11.chalmers.se:www/cat/doc/
|
||||||
|
|
||||||
|
.PHONY: upload clean
|
||||||
|
|
56
README.md
56
README.md
|
@ -1,38 +1,52 @@
|
||||||
Description
|
Description
|
||||||
===========
|
===========
|
||||||
This project aims to formalize some parts of category theory using cubical agda
|
This project aims to formalize some parts of category theory using cubical agda
|
||||||
— an extension to agda permitting univalence. To learn more about this
|
— an extension to agda permitting univalence. To learn more about this
|
||||||
[readthedocs](https://agda.readthedocs.io/en/latest/language/cubical.html).
|
[read the docs](https://agda.readthedocs.io/en/latest/language/cubical.html).
|
||||||
|
|
||||||
This project draws a lot of inspiration from [the
|
This project draws a lot of inspiration from [the
|
||||||
HoTT-book](https://homotopytypetheory.org/book/).
|
HoTT-book](https://homotopytypetheory.org/book/).
|
||||||
|
|
||||||
Installation
|
If you want more information about this project, then you're in luck.
|
||||||
============
|
This is my masters thesis. Go ahead and read it
|
||||||
|
[here](http://web.student.chalmers.se/~hanghj/papers/univalent-categories.pdf)
|
||||||
|
or alternative like so:
|
||||||
|
|
||||||
|
cd doc/
|
||||||
|
make
|
||||||
|
|
||||||
Dependencies
|
Dependencies
|
||||||
------------
|
============
|
||||||
To succesfully compile the following is needed:
|
To successfully compile the following is needed:
|
||||||
|
|
||||||
* The Agda release candidate 2.5.4[^1]
|
* The master branch of Agda.
|
||||||
* The experimental branch of [Agda Standard Library](https://github.com/agda/agda-stdlib)
|
* [Agda Standard Library](https://github.com/agda/agda-stdlib)
|
||||||
* [Cubical](https://github.com/Saizan/cubical-demo/)
|
* [Cubical](https://github.com/Saizan/cubical-demo/)
|
||||||
|
|
||||||
[^1]: At least version >= [`707ce6042b6a3bdb26521f3fe8dfe5d8a8470a43`](https://github.com/agda/agda/commit/707ce6042b6a3bdb26521f3fe8dfe5d8a8470a43)
|
Has been tested with:
|
||||||
|
|
||||||
It's important to have the right version of these - but which one is the right
|
* Agda version 2.6.0-d3efe64
|
||||||
is in constant flux. It's most likely the newest one.
|
|
||||||
|
|
||||||
I've used git submodules to manage dependencies. Unfortunately Agda does not
|
Building
|
||||||
allow specifying libraries to be used only as local dependencies. So the
|
========
|
||||||
submodules are mostly used for documentation.
|
You can build the library with
|
||||||
|
|
||||||
You can let Agda know about these libraries by appending them to your global
|
git submodule update --init
|
||||||
libraries file like so: (NB!: There is a good reason this is not in a
|
make
|
||||||
makefile. So please verify that you know what you are doing, you probably
|
|
||||||
already have standard-library in you libraries)
|
|
||||||
|
|
||||||
AGDA_LIB=~/.agda
|
The Makefile takes care of using the right dependencies.
|
||||||
readlink -f libs/*/*.agda-lib | tee -a $AGDA_LIB/libraries
|
Unfortunately I have not found a way to automatically inform
|
||||||
|
`agda-mode` that it should use these dependencies. So what you can do
|
||||||
|
in stead is to copy these libraries to a global location and then add
|
||||||
|
them system wide:
|
||||||
|
|
||||||
Anyways, assuming you have this set up you should be good to go.
|
mkdir -p ~/.agda/libs
|
||||||
|
cd ~/.agda/libs
|
||||||
|
git clone $CAT/libs/std-lib
|
||||||
|
git clone $CAT/libs/cubical
|
||||||
|
echo << EOF | tee -a ~/.agda/libraries
|
||||||
|
$HOME/.agda/libs/agda-stdlib/standard-library.agda-lib
|
||||||
|
$HOME/.agda/libs/cubical/cubical.agda-lib
|
||||||
|
EOF
|
||||||
|
|
||||||
|
Or you could symlink them as well if you want.
|
||||||
|
|
7
proposal/.gitignore → doc/.gitignore
vendored
7
proposal/.gitignore → doc/.gitignore
vendored
|
@ -4,5 +4,12 @@
|
||||||
*.log
|
*.log
|
||||||
*.out
|
*.out
|
||||||
*.pdf
|
*.pdf
|
||||||
|
!assets/**
|
||||||
*.bbl
|
*.bbl
|
||||||
*.blg
|
*.blg
|
||||||
|
*.toc
|
||||||
|
*.idx
|
||||||
|
*.ilg
|
||||||
|
*.ind
|
||||||
|
*.nav
|
||||||
|
*.snm
|
95
doc/BACKLOG.md
Normal file
95
doc/BACKLOG.md
Normal file
|
@ -0,0 +1,95 @@
|
||||||
|
Presentation
|
||||||
|
====
|
||||||
|
Find one clear goal.
|
||||||
|
|
||||||
|
Remember crowd-control.
|
||||||
|
|
||||||
|
Leave out:
|
||||||
|
lemPropF
|
||||||
|
|
||||||
|
Outline
|
||||||
|
-------
|
||||||
|
|
||||||
|
Introduction
|
||||||
|
|
||||||
|
A formalization of Category Theory in cubical Agda.
|
||||||
|
|
||||||
|
Cubical Agda: A constructive interpretation of functional
|
||||||
|
extensionality and univalence
|
||||||
|
|
||||||
|
Talk about structure of library:
|
||||||
|
===
|
||||||
|
|
||||||
|
What can I say about reusability?
|
||||||
|
|
||||||
|
Meeting with Andrea May 18th
|
||||||
|
============================
|
||||||
|
|
||||||
|
App. 2 in HoTT gives typing rule for pathJ including a computational
|
||||||
|
rule for it.
|
||||||
|
|
||||||
|
If you have this computational rule definitionally, then you wouldn't
|
||||||
|
need to use `pathJprop`.
|
||||||
|
|
||||||
|
In discussion-section I mention HITs. I should remove this or come up
|
||||||
|
with a more elaborate example of something you could do, e.g.
|
||||||
|
something with pushouts in the category of sets.
|
||||||
|
|
||||||
|
The type Prop is a type where terms are *judgmentally* equal not just
|
||||||
|
propositionally so.
|
||||||
|
|
||||||
|
Maybe mention that Andreas Källberg is working on proving the
|
||||||
|
initiality conjecture.
|
||||||
|
|
||||||
|
Intensional Type Theory (ITT): Judgmental equality is decidable
|
||||||
|
|
||||||
|
Extensional Type Theory (ETT): Reflection is enough to make judgmental
|
||||||
|
equality undecidable.
|
||||||
|
|
||||||
|
Reflection : a ≡ b → a = b
|
||||||
|
|
||||||
|
ITT does not have reflections.
|
||||||
|
|
||||||
|
HTT ~ ITT + axiomatized univalence
|
||||||
|
Agda ~ ITT + K-rule
|
||||||
|
Coq ~ ITT (no K-rule)
|
||||||
|
Cubical Agda ~ ITT + Path + Glue
|
||||||
|
|
||||||
|
Prop is impredicative in Coq (whatever that means)
|
||||||
|
|
||||||
|
Prop ≠ hProp
|
||||||
|
|
||||||
|
Comments about abstract
|
||||||
|
-----
|
||||||
|
|
||||||
|
Pattern matching for paths (?)
|
||||||
|
|
||||||
|
Intro
|
||||||
|
-----
|
||||||
|
Main feature of judgmental equality is the conversion rule.
|
||||||
|
|
||||||
|
Conor explained: K + eliminators ≡ pat. matching
|
||||||
|
|
||||||
|
Explain jugmental equality independently of type-checking
|
||||||
|
|
||||||
|
Soundness for equality means that if `x = y` then `x` and `y` must be
|
||||||
|
equal according to the theory/model.
|
||||||
|
|
||||||
|
Decidability of `=` is a necessary condition for typechecking to be
|
||||||
|
decidable.
|
||||||
|
|
||||||
|
Canonicity is a nice-to-have though without canonicity terms can get
|
||||||
|
stuck. If we postulate results about judgmental equality. E.g. funext,
|
||||||
|
then we can construct a term of type natural number that is not a
|
||||||
|
numeral. Therefore stating canonicity with natural numbers:
|
||||||
|
|
||||||
|
∀ t . ⊢ t : N , ∃ n : N . ⊢ t = sⁿ 0 : N
|
||||||
|
|
||||||
|
is a sufficient condition to get a well-behaved equality.
|
||||||
|
|
||||||
|
Eta-equality for RawFunctor means that the associative law for
|
||||||
|
functors hold definitionally.
|
||||||
|
|
||||||
|
Computational property for funExt is only relevant in two places in my
|
||||||
|
whole formulation. Univalence and gradLemma does not influence any
|
||||||
|
proofs.
|
|
@ -3,17 +3,21 @@
|
||||||
# Originally from : http://tex.stackexchange.com/a/40759
|
# Originally from : http://tex.stackexchange.com/a/40759
|
||||||
#
|
#
|
||||||
# Change only the variable below to the name of the main tex file.
|
# Change only the variable below to the name of the main tex file.
|
||||||
PROJNAME=proposal
|
PROJNAME=univalent-categories
|
||||||
|
MAIN=main.tex
|
||||||
|
|
||||||
# You want latexmk to *always* run, because make does not have all the info.
|
# You want latexmk to *always* run, because make does not have all the info.
|
||||||
# Also, include non-file targets in .PHONY so they are run regardless of any
|
# Also, include non-file targets in .PHONY so they are run regardless of any
|
||||||
# file of the given name existing.
|
# file of the given name existing.
|
||||||
.PHONY: $(PROJNAME).pdf all clean
|
.PHONY: $(PROJNAME).pdf all clean preview
|
||||||
|
|
||||||
# The first rule in a Makefile is the one executed by default ("make"). It
|
# The first rule in a Makefile is the one executed by default ("make"). It
|
||||||
# should always be the "all" rule, so that "make" and "make all" are identical.
|
# should always be the "all" rule, so that "make" and "make all" are identical.
|
||||||
all: $(PROJNAME).pdf
|
all: $(PROJNAME).pdf
|
||||||
|
|
||||||
|
preview: $(MAIN)
|
||||||
|
latexmk -pvc -jobname=$(PROJNAME) -pdf -xelatex $<
|
||||||
|
|
||||||
# CUSTOM BUILD RULES
|
# CUSTOM BUILD RULES
|
||||||
|
|
||||||
# In case you didn't know, '$@' is a variable holding the name of the target,
|
# In case you didn't know, '$@' is a variable holding the name of the target,
|
||||||
|
@ -36,11 +40,14 @@ all: $(PROJNAME).pdf
|
||||||
# -interactive=nonstopmode keeps the pdflatex backend from stopping at a
|
# -interactive=nonstopmode keeps the pdflatex backend from stopping at a
|
||||||
# missing file reference and interactively asking you for an alternative.
|
# missing file reference and interactively asking you for an alternative.
|
||||||
|
|
||||||
$(PROJNAME).pdf: $(PROJNAME).tex
|
$(PROJNAME).pdf: $(MAIN)
|
||||||
latexmk -pdf -pdflatex="pdflatex -interactive=nonstopmode" -use-make $<
|
latexmk -jobname=$(PROJNAME) -pdf -xelatex -use-make $<
|
||||||
|
|
||||||
cleanall:
|
cleanall:
|
||||||
latexmk -C
|
latexmk -C
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
latexmk -c
|
latexmk -c
|
||||||
|
|
||||||
|
read: all
|
||||||
|
xdg-open $(PROJNAME).pdf
|
23
doc/abstract.tex
Normal file
23
doc/abstract.tex
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
\chapter*{Abstract}
|
||||||
|
The usual notion of propositional equality in intensional type-theory
|
||||||
|
is restrictive. For instance it does not admit functional
|
||||||
|
extensionality nor univalence. This poses a severe limitation on both
|
||||||
|
what is \emph{provable} and the \emph{re-usability} of proofs. Recent
|
||||||
|
developments have, however, resulted in cubical type theory, which
|
||||||
|
permits a constructive proof of univalence. The programming language
|
||||||
|
Agda has been extended with capabilities for working in such a cubical
|
||||||
|
setting. This thesis will explore the usefulness of this extension in
|
||||||
|
the context of category theory.
|
||||||
|
|
||||||
|
The thesis will motivate the need for univalence and explain why
|
||||||
|
propositional equality in cubical Agda is more expressive than in
|
||||||
|
standard Agda. Alternative approaches to Cubical Agda will be
|
||||||
|
presented and their pros and cons will be explained. As an example of
|
||||||
|
the application of univalence, two formulations of monads will be
|
||||||
|
presented: Namely monads in the monoidal form and monads in the
|
||||||
|
Kleisli form. Using univalence, it will be shown how these are equal.
|
||||||
|
|
||||||
|
Finally the thesis will explain the challenges that a developer will
|
||||||
|
face when working with cubical Agda and give some techniques to
|
||||||
|
overcome these difficulties. It will suggest how further work can
|
||||||
|
help alleviate some of these challenges.
|
13
doc/acknowledgements.tex
Normal file
13
doc/acknowledgements.tex
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
\chapter*{Acknowledgements}
|
||||||
|
I would like to thank my supervisor Thierry Coquand for giving me a
|
||||||
|
chance to work on this interesting topic. I would also like to thank
|
||||||
|
Andrea Vezzosi for some very long and very insightful meetings during
|
||||||
|
the project. It is fascinating and almost uncanny how quickly Andrea
|
||||||
|
can conjure up various proofs. I also want to recognize the support
|
||||||
|
of Knud Højgaards Fond who graciously sponsored me with a 20.000 DKK
|
||||||
|
scholarship which helped toward sponsoring the two years I have spent
|
||||||
|
studying abroad. I would also like to give a warm thanks to my fellow
|
||||||
|
students Pierre~Kraft and Nachiappan~Valliappan who have made the time
|
||||||
|
spent working on the thesis way more enjoyable. Lastly I would like to
|
||||||
|
give a special thanks to Valentina~Méndez who have been a great moral
|
||||||
|
support throughout the whole process.
|
37
doc/appendix.tex
Normal file
37
doc/appendix.tex
Normal file
|
@ -0,0 +1,37 @@
|
||||||
|
\lstset{basicstyle=\footnotesize\ttfamily,breaklines=true,breakpages=true}
|
||||||
|
\def\fileps
|
||||||
|
{ ../src/Cat.agda
|
||||||
|
, ../src/Cat/Categories/Cat.agda
|
||||||
|
, ../src/Cat/Categories/Cube.agda
|
||||||
|
, ../src/Cat/Categories/CwF.agda
|
||||||
|
, ../src/Cat/Categories/Fam.agda
|
||||||
|
, ../src/Cat/Categories/Free.agda
|
||||||
|
, ../src/Cat/Categories/Fun.agda
|
||||||
|
, ../src/Cat/Categories/Rel.agda
|
||||||
|
, ../src/Cat/Categories/Sets.agda
|
||||||
|
, ../src/Cat/Category.agda
|
||||||
|
, ../src/Cat/Category/CartesianClosed.agda
|
||||||
|
, ../src/Cat/Category/Exponential.agda
|
||||||
|
, ../src/Cat/Category/Functor.agda
|
||||||
|
, ../src/Cat/Category/Monad.agda
|
||||||
|
, ../src/Cat/Category/Monad/Kleisli.agda
|
||||||
|
, ../src/Cat/Category/Monad/Monoidal.agda
|
||||||
|
, ../src/Cat/Category/Monad/Voevodsky.agda
|
||||||
|
, ../src/Cat/Category/Monoid.agda
|
||||||
|
, ../src/Cat/Category/NaturalTransformation.agda
|
||||||
|
, ../src/Cat/Category/Product.agda
|
||||||
|
, ../src/Cat/Category/Yoneda.agda
|
||||||
|
, ../src/Cat/Equivalence.agda
|
||||||
|
, ../src/Cat/Prelude.agda
|
||||||
|
}
|
||||||
|
|
||||||
|
\foreach \filep in \fileps {
|
||||||
|
\chapter{\filep}
|
||||||
|
%% \begin{figure}[htpb]
|
||||||
|
\lstinputlisting{\filep}
|
||||||
|
%% \caption{Source code for \texttt{\filep}}
|
||||||
|
%% \label{fig:\filep}
|
||||||
|
%% \end{figure}
|
||||||
|
}
|
||||||
|
%% \lstset{framextopmargin=50pt}
|
||||||
|
%% \lstinputlisting{../../src/Cat.agda}
|
74
doc/appendix/abstract-funext.tex
Normal file
74
doc/appendix/abstract-funext.tex
Normal file
|
@ -0,0 +1,74 @@
|
||||||
|
\chapter{Non-reducing functional extensionality}
|
||||||
|
\label{app:abstract-funext}
|
||||||
|
In two places in my formalization was the computational behaviours of
|
||||||
|
functional extensionality used. The reduction behaviour can be
|
||||||
|
disabled by marking functional extensionality as abstract. Below the
|
||||||
|
fully normalized goal and context with functional extensionality
|
||||||
|
marked abstract has been shown. The excerpts are from the module
|
||||||
|
%
|
||||||
|
\begin{center}
|
||||||
|
\sourcelink{Cat.Category.Monad.Voevodsky}
|
||||||
|
\end{center}
|
||||||
|
%
|
||||||
|
where this is also written as a comment next to the proofs. When
|
||||||
|
functional extensionality is not abstract the goal and current value
|
||||||
|
are the same. It is of course necessary to show the fully normalized
|
||||||
|
goal and context otherwise the reduction behaviours is not forced.
|
||||||
|
|
||||||
|
\subsubsection*{First goal}
|
||||||
|
Goal:
|
||||||
|
\begin{verbatim}
|
||||||
|
PathP (λ _ → §2-3.§2 omap (λ {z} → pure))
|
||||||
|
(§2-fromMonad
|
||||||
|
(.Cat.Category.Monad.toKleisli ℂ
|
||||||
|
(.Cat.Category.Monad.toMonoidal ℂ (§2-3.§2.toMonad m))))
|
||||||
|
(§2-fromMonad (§2-3.§2.toMonad m))
|
||||||
|
\end{verbatim}
|
||||||
|
Have:
|
||||||
|
\begin{verbatim}
|
||||||
|
PathP
|
||||||
|
(λ i →
|
||||||
|
§2-3.§2 K.IsMonad.omap
|
||||||
|
(K.RawMonad.pure
|
||||||
|
(K.Monad.raw
|
||||||
|
(funExt (λ m₁ → K.Monad≡ (.Cat.Category.Monad.toKleisliRawEq ℂ m₁))
|
||||||
|
i (§2-3.§2.toMonad m)))))
|
||||||
|
(§2-fromMonad
|
||||||
|
(.Cat.Category.Monad.toKleisli ℂ
|
||||||
|
(.Cat.Category.Monad.toMonoidal ℂ (§2-3.§2.toMonad m))))
|
||||||
|
(§2-fromMonad (§2-3.§2.toMonad m))
|
||||||
|
\end{verbatim}
|
||||||
|
\subsubsection*{Second goal}
|
||||||
|
Goal:
|
||||||
|
\begin{verbatim}
|
||||||
|
PathP (λ _ → §2-3.§1 omap (λ {X} → pure))
|
||||||
|
(§1-fromMonad
|
||||||
|
(.Cat.Category.Monad.toMonoidal ℂ
|
||||||
|
(.Cat.Category.Monad.toKleisli ℂ (§2-3.§1.toMonad m))))
|
||||||
|
(§1-fromMonad (§2-3.§1.toMonad m))
|
||||||
|
\end{verbatim}
|
||||||
|
Have:
|
||||||
|
\begin{verbatim}
|
||||||
|
PathP
|
||||||
|
(λ i →
|
||||||
|
§2-3.§1
|
||||||
|
(RawFunctor.omap
|
||||||
|
(Functor.raw
|
||||||
|
(M.RawMonad.R
|
||||||
|
(M.Monad.raw
|
||||||
|
(funExt
|
||||||
|
(λ m₁ → M.Monad≡ (.Cat.Category.Monad.toMonoidalRawEq ℂ m₁)) i
|
||||||
|
(§2-3.§1.toMonad m))))))
|
||||||
|
(λ {X} →
|
||||||
|
fst
|
||||||
|
(M.RawMonad.pureNT
|
||||||
|
(M.Monad.raw
|
||||||
|
(funExt
|
||||||
|
(λ m₁ → M.Monad≡ (.Cat.Category.Monad.toMonoidalRawEq ℂ m₁)) i
|
||||||
|
(§2-3.§1.toMonad m))))
|
||||||
|
X))
|
||||||
|
(§1-fromMonad
|
||||||
|
(.Cat.Category.Monad.toMonoidal ℂ
|
||||||
|
(.Cat.Category.Monad.toKleisli ℂ (§2-3.§1.toMonad m))))
|
||||||
|
(§1-fromMonad (§2-3.§1.toMonad m))
|
||||||
|
\end{verbatim}
|
BIN
doc/assets/frontpage_eng.pdf
Normal file
BIN
doc/assets/frontpage_eng.pdf
Normal file
Binary file not shown.
BIN
doc/assets/frontpage_gu_eng.pdf
Normal file
BIN
doc/assets/frontpage_gu_eng.pdf
Normal file
Binary file not shown.
BIN
doc/assets/frontpage_swe.pdf
Normal file
BIN
doc/assets/frontpage_swe.pdf
Normal file
Binary file not shown.
BIN
doc/assets/isomorphism.pdf
Normal file
BIN
doc/assets/isomorphism.pdf
Normal file
Binary file not shown.
BIN
doc/assets/isomorphism.png
Normal file
BIN
doc/assets/isomorphism.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 266 KiB |
BIN
doc/assets/logo_ch_gu.pdf
Normal file
BIN
doc/assets/logo_ch_gu.pdf
Normal file
Binary file not shown.
BIN
doc/assets/logo_eng.pdf
Normal file
BIN
doc/assets/logo_eng.pdf
Normal file
Binary file not shown.
BIN
doc/assets/logo_swe.pdf
Normal file
BIN
doc/assets/logo_swe.pdf
Normal file
Binary file not shown.
140
doc/chalmerstitle.sty
Normal file
140
doc/chalmerstitle.sty
Normal file
|
@ -0,0 +1,140 @@
|
||||||
|
% Requires: hypperref
|
||||||
|
\ProvidesPackage{chalmerstitle}
|
||||||
|
|
||||||
|
%% \RequirePackage{kvoptions}
|
||||||
|
|
||||||
|
%% \SetupKeyvalOptions{
|
||||||
|
%% family=ct,
|
||||||
|
%% prefix=ct@
|
||||||
|
%% }
|
||||||
|
|
||||||
|
%% \DeclareStringOption{authoremail}
|
||||||
|
%% \DeclareStringOption{supervisor}
|
||||||
|
%% \DeclareStringOption{supervisoremail}
|
||||||
|
%% \DeclareStringOption{supervisordepartment}
|
||||||
|
%% \DeclareStringOption{cosupervisor}
|
||||||
|
%% \DeclareStringOption{cosupervisoremail}
|
||||||
|
%% \DeclareStringOption{cosupervisordepartment}
|
||||||
|
%% \DeclareStringOption{examiner}
|
||||||
|
%% \DeclareStringOption{examineremail}
|
||||||
|
%% \DeclareStringOption{examinerdepartment}
|
||||||
|
%% \DeclareStringOption{institution}
|
||||||
|
%% \DeclareStringOption{department}
|
||||||
|
%% \DeclareStringOption{researchgroup}
|
||||||
|
%% \DeclareStringOption{subtitle}
|
||||||
|
%% \ProcessKeyvalOptions*
|
||||||
|
|
||||||
|
\newcommand*{\authoremail}[1]{\gdef\@authoremail{#1}}
|
||||||
|
\newcommand*{\supervisor}[1]{\gdef\@supervisor{#1}}
|
||||||
|
\newcommand*{\supervisoremail}[1]{\gdef\@supervisoremail{#1}}
|
||||||
|
\newcommand*{\supervisordepartment}[1]{\gdef\@supervisordepartment{#1}}
|
||||||
|
\newcommand*{\cosupervisor}[1]{\gdef\@cosupervisor{#1}}
|
||||||
|
\newcommand*{\cosupervisoremail}[1]{\gdef\@cosupervisoremail{#1}}
|
||||||
|
\newcommand*{\cosupervisordepartment}[1]{\gdef\@cosupervisordepartment{#1}}
|
||||||
|
\newcommand*{\examiner}[1]{\gdef\@examiner{#1}}
|
||||||
|
\newcommand*{\examineremail}[1]{\gdef\@examineremail{#1}}
|
||||||
|
\newcommand*{\examinerdepartment}[1]{\gdef\@examinerdepartment{#1}}
|
||||||
|
\newcommand*{\institution}[1]{\gdef\@institution{#1}}
|
||||||
|
\newcommand*{\department}[1]{\gdef\@department{#1}}
|
||||||
|
\newcommand*{\researchgroup}[1]{\gdef\@researchgroup{#1}}
|
||||||
|
\newcommand*{\subtitle}[1]{\gdef\@subtitle{#1}}
|
||||||
|
%% FRONTMATTER
|
||||||
|
\newcommand*{\myfrontmatter}{%
|
||||||
|
%% \newgeometry{top=3cm, bottom=3cm,left=2.25 cm, right=2.25cm}
|
||||||
|
\AddToShipoutPicture*{\backgroundpic{-4}{56.7}{assets/frontpage_gu_eng.pdf}}
|
||||||
|
\ClearShipoutPicture
|
||||||
|
\addtolength{\voffset}{2cm}
|
||||||
|
\begingroup
|
||||||
|
\thispagestyle{empty}
|
||||||
|
{\Huge\@title}\\[.5cm]
|
||||||
|
{\Large A formalization of category theory in Cubical Agda}\\[6cm]
|
||||||
|
\begin{center}
|
||||||
|
\includegraphics[width=\linewidth,keepaspectratio]{assets/isomorphism.pdf}
|
||||||
|
%% \includepdf{isomorphism.pdf}
|
||||||
|
\end{center}
|
||||||
|
% Cover text
|
||||||
|
\vfill
|
||||||
|
%% \renewcommand{\familydefault}{\sfdefault} \normalfont % Set cover page font
|
||||||
|
{\Large\@author}\\[.5cm]
|
||||||
|
Master's thesis in Computer Science
|
||||||
|
\endgroup
|
||||||
|
%% \end{titlepage}
|
||||||
|
|
||||||
|
|
||||||
|
% BACK OF COVER PAGE (BLANK PAGE)
|
||||||
|
\newpage
|
||||||
|
%% \newgeometry{a4paper} % Temporarily change margins
|
||||||
|
\restoregeometry
|
||||||
|
\thispagestyle{empty}
|
||||||
|
\null
|
||||||
|
}
|
||||||
|
|
||||||
|
\renewcommand*{\maketitle}{%
|
||||||
|
%% \begin{titlepage}
|
||||||
|
|
||||||
|
% TITLE PAGE
|
||||||
|
\newpage
|
||||||
|
\thispagestyle{empty}
|
||||||
|
\begin{center}
|
||||||
|
\textsc{\LARGE Master's thesis \the\year}\\[4cm] % Report number is currently not in use
|
||||||
|
\textbf{\LARGE \@title} \\[1cm]
|
||||||
|
{\large \@subtitle}\\[1cm]
|
||||||
|
{\large \@author}
|
||||||
|
|
||||||
|
\vfill
|
||||||
|
\centering
|
||||||
|
\includegraphics[width=0.2\pdfpagewidth]{assets/logo_eng.pdf}
|
||||||
|
\vspace{5mm}
|
||||||
|
|
||||||
|
\textsc{Department of Computer Science and Engineering}\\
|
||||||
|
\textsc{{\@researchgroup}}\\
|
||||||
|
%Name of research group (if applicable)\\
|
||||||
|
\textsc{\@institution} \\
|
||||||
|
\textsc{Gothenburg, Sweden \the\year}\\
|
||||||
|
\end{center}
|
||||||
|
|
||||||
|
|
||||||
|
% IMPRINT PAGE (BACK OF TITLE PAGE)
|
||||||
|
\newpage
|
||||||
|
\thispagestyle{plain}
|
||||||
|
\textit{\@title}\\
|
||||||
|
\@subtitle\\
|
||||||
|
\copyright\ \the\year ~ \textsc{\@author}
|
||||||
|
\vspace{4.5cm}
|
||||||
|
|
||||||
|
\setlength{\parskip}{0.5cm}
|
||||||
|
\textbf{Author:}\\
|
||||||
|
\@author\\
|
||||||
|
\href{mailto:\@authoremail>}{\texttt{<\@authoremail>}}
|
||||||
|
|
||||||
|
\textbf{Supervisor:}\\
|
||||||
|
\@supervisor\\
|
||||||
|
\href{mailto:\@supervisoremail>}{\texttt{<\@supervisoremail>}}\\
|
||||||
|
\@supervisordepartment
|
||||||
|
|
||||||
|
\textbf{Co-supervisor:}\\
|
||||||
|
\@cosupervisor\\
|
||||||
|
\href{mailto:\@cosupervisoremail>}{\texttt{<\@cosupervisoremail>}}\\
|
||||||
|
\@cosupervisordepartment
|
||||||
|
|
||||||
|
\textbf{Examiner:}\\
|
||||||
|
\@examiner\\
|
||||||
|
\href{mailto:\@examineremail>}{\texttt{<\@examineremail>}}\\
|
||||||
|
\@examinerdepartment
|
||||||
|
|
||||||
|
\vfill
|
||||||
|
Master's Thesis \the\year\\ % Report number currently not in use
|
||||||
|
\@department\\
|
||||||
|
%Division of Division name\\
|
||||||
|
%Name of research group (if applicable)\\
|
||||||
|
\@institution\\
|
||||||
|
SE-412 96 Gothenburg\\
|
||||||
|
Telephone +46 31 772 1000 \setlength{\parskip}{0.5cm}\\
|
||||||
|
% Caption for cover page figure if used, possibly with reference to further information in the report
|
||||||
|
%% Cover: Wind visualization constructed in Matlab showing a surface of constant wind speed along with streamlines of the flow. \setlength{\parskip}{0.5cm}
|
||||||
|
%Printed by [Name of printing company]\\
|
||||||
|
Gothenburg, Sweden \the\year
|
||||||
|
|
||||||
|
%% \restoregeometry
|
||||||
|
%% \end{titlepage}
|
||||||
|
}
|
63
doc/conclusion.tex
Normal file
63
doc/conclusion.tex
Normal file
|
@ -0,0 +1,63 @@
|
||||||
|
\chapter{Conclusion}
|
||||||
|
This thesis highlighted some issues with the standard inductive
|
||||||
|
definition of propositional equality used in Agda. Functional
|
||||||
|
extensionality and univalence are examples of two propositions not
|
||||||
|
admissible in Intensional Type Theory (ITT). This has a big impact on
|
||||||
|
what is provable and the reusability of proofs. This issue is
|
||||||
|
overcome with an extension to Agda's type system called Cubical Agda.
|
||||||
|
With Cubical Agda both functional extensionality and univalence are
|
||||||
|
admissible. Cubical Agda is more expressive, but there are certain
|
||||||
|
issues that arise that are not present in standard Agda. For one
|
||||||
|
thing Agda enjoys Uniqueness of Identity Proofs (UIP) though a flag
|
||||||
|
exists to turn this off. This feature is not present in Cubical Agda.
|
||||||
|
Rather than having unique identity proofs cubical Agda gives rise to a
|
||||||
|
hierarchy of types with increasing \nomen{homotopical
|
||||||
|
structure}{homotopy levels}. It turns out to be useful to build the
|
||||||
|
formalization with this hierarchy in mind as it can simplify proofs
|
||||||
|
considerably. Another issue one must overcome in Cubical Agda is when
|
||||||
|
a type has a field whose type depends on a previous field. In this
|
||||||
|
case paths between such types will be heterogeneous paths. In
|
||||||
|
practice it turns out to be considerably more difficult to work with
|
||||||
|
heterogeneous paths than with homogeneous paths. This thesis
|
||||||
|
demonstrated the application of some techniques to overcome these
|
||||||
|
difficulties, such as based path induction.
|
||||||
|
|
||||||
|
This thesis formalizes some of the core concepts from category theory
|
||||||
|
including: categories, functors, products, exponentials, Cartesian
|
||||||
|
closed categories, natural transformations, the yoneda embedding,
|
||||||
|
monads and more. Category theory is an interesting case study for the
|
||||||
|
application of cubical Agda for two reasons in particular. One reason
|
||||||
|
is because category theory is the study of abstract algebra of
|
||||||
|
functions, meaning that functional extensionality is particularly
|
||||||
|
relevant. Another reason is that in category theory it is commonplace
|
||||||
|
to identify isomorphic structures. Univalence allows for making this
|
||||||
|
notion precise. This thesis also demonstrated another technique that
|
||||||
|
is common in category theory; namely to define categories to prove
|
||||||
|
properties of other structures. Specifically a category was defined
|
||||||
|
to demonstrate that any two product objects in a category are
|
||||||
|
isomorphic. Furthermore the thesis showed two formulations of monads
|
||||||
|
and proved that they indeed are equivalent: Namely monads in the
|
||||||
|
monoidal- and Kleisli- form. The monoidal formulation is more typical
|
||||||
|
to category theoretic formulations and the Kleisli formulation will be
|
||||||
|
more familiar to functional programmers. It would have been very
|
||||||
|
difficult to make a similar proof with setoids and the proof would be
|
||||||
|
very difficult to read. In the formulation we also saw how paths can
|
||||||
|
be used to extract functions. A path between two types induce an
|
||||||
|
isomorphism between the two types. This e.g.\ permits developers to
|
||||||
|
write a monad instance for a given type using the Kleisli formulation.
|
||||||
|
By transporting along the path between the monoidal- and Kleisli-
|
||||||
|
formulation one can reuse all the operations and results shown for
|
||||||
|
monoidal- monads in the context of kleisli monads.
|
||||||
|
%%
|
||||||
|
%% problem with inductive type
|
||||||
|
%% overcome with cubical
|
||||||
|
%% the path type
|
||||||
|
%% homotopy levels
|
||||||
|
%% depdendent paths
|
||||||
|
%%
|
||||||
|
%% category theory
|
||||||
|
%% algebra of functions ~ funExt
|
||||||
|
%% identify isomorphic types ~ univalence
|
||||||
|
%% using categories to prove properties
|
||||||
|
%% computational properties
|
||||||
|
%% reusability, compositional
|
428
doc/cubical.tex
Normal file
428
doc/cubical.tex
Normal file
|
@ -0,0 +1,428 @@
|
||||||
|
\chapter{Cubical Agda}
|
||||||
|
\section{Propositional equality}
|
||||||
|
Judgmental equality in Agda is a feature of the type system. It is
|
||||||
|
something that can be checked automatically by the type checker: In
|
||||||
|
the example from the introduction $n + 0$ can be judged to be equal to
|
||||||
|
$n$ simply by expanding the definition of $+$.
|
||||||
|
|
||||||
|
On the other hand, propositional equality is something defined within
|
||||||
|
the language itself. Propositional equality cannot be derived
|
||||||
|
automatically. The normal definition of propositional equality is an
|
||||||
|
inductive data type. Cubical Agda discards this type in favor of some
|
||||||
|
new primitives.
|
||||||
|
|
||||||
|
Most of the source code related with this section is implemented in
|
||||||
|
\cite{cubical-demo} it can be browsed in hyperlinked and syntax
|
||||||
|
highlighted HTML online. The links can be found in the beginning of
|
||||||
|
section \S\ref{ch:implementation}.
|
||||||
|
|
||||||
|
\subsection{The equality type}
|
||||||
|
The usual notion of judgmental equality says that given a type $A \tp
|
||||||
|
\MCU$ and two points hereof $a_0, a_1 \tp A$ we can form the type:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
a_0 \equiv a_1 \tp \MCU
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
In Agda this is defined as an inductive data type with the single
|
||||||
|
constructor $\refl$ that for any $a \tp A$ gives:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
\refl \tp a \equiv a
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
There also exist a related notion of \emph{heterogeneous} equality which allows
|
||||||
|
for equating points of different types. In this case given two types $A, B \tp
|
||||||
|
\MCU$ and two points $a \tp A$, $b \tp B$ we can construct the type:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
a \cong b \tp \MCU
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
This likewise has the single constructor $\refl$ that for any $a \tp
|
||||||
|
A$ gives:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
\refl \tp a \cong a
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
In Cubical Agda these two notions are paralleled with homogeneous- and
|
||||||
|
heterogeneous paths respectively.
|
||||||
|
%
|
||||||
|
\subsection{The path type}
|
||||||
|
Judgmental equality in Cubical Agda is encapsulated with the type:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\Path \tp (P \tp \I → \MCU) → P\ 0 → P\ 1 → \MCU
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
The special type $\I$ is called the index set. The index set can be
|
||||||
|
thought of simply as the interval on the real numbers from $0$ to $1$
|
||||||
|
(both inclusive). The family $P$ over $\I$ will be referred to as the
|
||||||
|
\nomenindex{path space} given some path $p \tp \Path\ P\ a\ b$. By
|
||||||
|
that token $P\ 0$ corresponds to the type at the left endpoint of $p$.
|
||||||
|
Likewise $P\ 1$ is the type at the right endpoint. The type is called
|
||||||
|
$\Path$ because the idea has roots in homotopy theory. The intuition
|
||||||
|
is that $\Path$ describes\linebreak[1] paths in $\MCU$. I.e.\ paths
|
||||||
|
between types. For a path $p$ the expression $p\ i$ can be thought of
|
||||||
|
as a \emph{point} on this path. The index $i$ describes how far along
|
||||||
|
the path one has moved. An inhabitant of $\Path\ P\ a_0\ a_1$ is a
|
||||||
|
(dependent) function from the index set to the path space:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p \tp \prod_{i \tp \I} P\ i
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
This function must satisfy being judgmentally equal to $a_0$ at the
|
||||||
|
left endpoint and equal to $a_1$ at the other end. I.e.:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
p\ 0 & = a_0 \\
|
||||||
|
p\ 1 & = a_1
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The notion of \nomenindex{homogeneous equalities} is recovered when $P$ does not
|
||||||
|
depend on its argument. That is for $A \tp \MCU$ and $a_0, a_1 \tp A$ the
|
||||||
|
homogenous equality between $a_0$ and $a_1$ is the type:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
a_0 \equiv a_1 \defeq \Path\ (\lambda\;i \to A)\ a_0\ a_1
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
I will generally prefer to use the notation $a \equiv b$ when talking
|
||||||
|
about non-dependent paths and use the notation $\Path\ (\lambda\; i
|
||||||
|
\to P\ i)\ a\ b$ when the path space is of particular interest.
|
||||||
|
|
||||||
|
With this definition we can recover reflexivity. That is, for any $A
|
||||||
|
\tp \MCU$ and $a \tp A$:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
\refl & \tp a \equiv a \\
|
||||||
|
\refl & \defeq \lambda\; i \to a
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
Here the path space is $P \defeq \lambda\; i \to A$ and it satsifies
|
||||||
|
$P\ i = A$ definitionally. So to inhabit it, is to give a path $\I \to
|
||||||
|
A$ that is judgmentally $a$ at either endpoint. This is satisfied by
|
||||||
|
the constant path; i.e.\ the path that is constantly $a$ at any index
|
||||||
|
$i \tp \I$.
|
||||||
|
|
||||||
|
It is also surprisingly easy to show functional extensionality.
|
||||||
|
Functional extensionality is the proposition that given a type $A \tp
|
||||||
|
\MCU$, a family of types $B \tp A \to \MCU$ and functions $f, g \tp
|
||||||
|
\prod_{a \tp A} B\ a$ gives:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\label{eq:funExt}
|
||||||
|
\funExt \tp \left(\prod_{a \tp A} f\ a \equiv g\ a \right) \to f \equiv g
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
%% p = λ\; i a → p a i
|
||||||
|
So given $η \tp \prod_{a \tp A} f\ a \equiv g\ a$ we must give a path
|
||||||
|
$f \equiv g$. That is a function $\I \to \prod_{a \tp A} B\ a$. So let
|
||||||
|
$i \tp \I$ be given. We must now give an expression $\phi \tp
|
||||||
|
\prod_{a \tp A} B\ a$ satisfying $\phi\ 0 \equiv f\ a$ and $\phi\ 1
|
||||||
|
\equiv g\ a$. This neccesitates that the expression must be a lambda
|
||||||
|
abstraction, so let $a \tp A$ be given. We can now apply $a$ to $η$
|
||||||
|
and get the path $η\ a \tp f\ a \equiv g\ a$. This exactly
|
||||||
|
satisfies the conditions for $\phi$. In conclusion \ref{eq:funExt} is
|
||||||
|
inhabited by the term:
|
||||||
|
%
|
||||||
|
\begin{equation*}
|
||||||
|
\funExt\ η \defeq λ\; i\ a → η\ a\ i
|
||||||
|
\end{equation*}
|
||||||
|
%
|
||||||
|
With $\funExt$ in place we can now construct a path between
|
||||||
|
$\var{zeroLeft}$ and $\var{zeroRight}$ -- the functions defined in the
|
||||||
|
introduction \S\ref{sec:functional-extensionality}:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
p & \tp \var{zeroLeft} \equiv \var{zeroRight} \\
|
||||||
|
p & \defeq \funExt\ \var{zrn}
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Here $\var{zrn}$ is the proof from \ref{eq:zrn}.
|
||||||
|
%
|
||||||
|
\section{Homotopy levels}
|
||||||
|
In ITT all equality proofs are identical (in a closed context). This
|
||||||
|
means that, in some sense, any two inhabitants of $a \equiv b$ are
|
||||||
|
``equally good''. They do not have any interesting structure. This is
|
||||||
|
referred to as Uniqueness of Identity Proofs (UIP). Unfortunately it
|
||||||
|
is not possible to have a type theory with both univalence and UIP.
|
||||||
|
Instead in cubical Agda we have a hierarchy of types with an
|
||||||
|
increasing amount of homotopic structure. At the bottom of this
|
||||||
|
hierarchy is the set of contractible types:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
%% \begin{split}
|
||||||
|
& \isContr && \tp \MCU \to \MCU \\
|
||||||
|
& \isContr\ A && \defeq \sum_{c \tp A} \prod_{a \tp A} a \equiv c
|
||||||
|
%% \end{split}
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
The first component of $\isContr\ A$ is called ``the center of contraction''.
|
||||||
|
Under the propositions-as-types interpretation of type theory $\isContr\ A$ can
|
||||||
|
be thought of as ``the true proposition $A$''. And indeed $\top$ is
|
||||||
|
contractible:
|
||||||
|
%
|
||||||
|
\begin{equation*}
|
||||||
|
(\var{tt} , \lambda\; x \to \refl) \tp \isContr\ \top
|
||||||
|
\end{equation*}
|
||||||
|
%
|
||||||
|
It is a theorem that if a type is contractible, then it is isomorphic to the
|
||||||
|
unit-type.
|
||||||
|
|
||||||
|
The next step in the hierarchy is the set of mere propositions:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
& \isProp && \tp \MCU \to \MCU \\
|
||||||
|
& \isProp\ A && \defeq \prod_{a_0, a_1 \tp A} a_0 \equiv a_1
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
One can think of $\isProp\ A$ as the set of true and false propositions. And
|
||||||
|
indeed both $\top$ and $\bot$ are propositions:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
(λ\; \var{tt}, \var{tt} → refl) & \tp \isProp\ ⊤ \\
|
||||||
|
λ\;\varnothing\ \varnothing & \tp \isProp\ ⊥
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The term $\varnothing$ is used here to denote an impossible pattern. It is a
|
||||||
|
theorem that if a mere proposition $A$ is inhabited, then so is it contractible.
|
||||||
|
If it is not inhabited it is equivalent to the empty-type (or false
|
||||||
|
proposition).
|
||||||
|
|
||||||
|
I will refer to a type $A \tp \MCU$ as a \emph{mere proposition} if I want to
|
||||||
|
stress that we have $\isProp\ A$.
|
||||||
|
|
||||||
|
The next step in the hierarchy is the set of homotopical sets:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
& \isSet && \tp \MCU \to \MCU \\
|
||||||
|
& \isSet\ A && \defeq \prod_{a_0, a_1 \tp A} \isProp\ (a_0 \equiv a_1)
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
I will not give an example of a set at this point. It turns out that
|
||||||
|
proving e.g.\ $\isProp\ \bN$ directly is not so straightforward (see
|
||||||
|
\cite[\S3.1.4]{hott-2013}). Hedberg's theorem states that any type
|
||||||
|
with decidable equality is a set. There will be examples of sets later
|
||||||
|
in this report. At this point it should be noted that the term ``set''
|
||||||
|
is somewhat conflated; there is the notion of sets from set theory.
|
||||||
|
In Agda types are denoted \texttt{Set}. I will use it consistently to
|
||||||
|
refer to a type $A$ as a set exactly if $\isSet\ A$ is a proposition.
|
||||||
|
|
||||||
|
As the reader may have guessed the next step in the hierarchy is the type:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
& \isGroupoid && \tp \MCU \to \MCU \\
|
||||||
|
& \isGroupoid\ A && \defeq \prod_{a_0, a_1 \tp A} \isSet\ (a_0 \equiv a_1)
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
So it continues. In fact we can generalize this family of types by
|
||||||
|
indexing them with a natural number. For historical reasons, though,
|
||||||
|
the bottom of the hierarchy, the contractible types, is said to be a
|
||||||
|
\nomen{-2-type}{homotopy levels}, propositions are
|
||||||
|
\nomen{-1-types}{homotopy levels}, (homotopical) sets are
|
||||||
|
\nomen{0-types}{homotopy levels} and so on\ldots
|
||||||
|
|
||||||
|
Just as with paths, homotopical sets are not at the center of focus for this
|
||||||
|
thesis. But I mention here some properties that will be relevant for this
|
||||||
|
exposition:
|
||||||
|
|
||||||
|
Proposition: Homotopy levels are cumulative. That is, if $A \tp \MCU$ has
|
||||||
|
homotopy level $n$ then so does it have $n + 1$.
|
||||||
|
|
||||||
|
For any level $n$ it is the case that to be of level $n$ is a mere proposition.
|
||||||
|
%
|
||||||
|
\section{A few lemmas}
|
||||||
|
Rather than getting into the nitty-gritty details of Agda I venture to
|
||||||
|
take a more ``combinator-based'' approach. That is I will use
|
||||||
|
theorems about paths that have already been formalized.
|
||||||
|
Specifically the results come from the Agda library \texttt{cubical}
|
||||||
|
(\cite{cubical-demo}). I have used a handful of results from this
|
||||||
|
library as well as contributed a few lemmas myself%
|
||||||
|
\footnote{The module \texttt{Cat.Prelude} lists the upstream
|
||||||
|
dependencies. My contribution to \texttt{cubical} can as well be
|
||||||
|
found in the git logs which are available at
|
||||||
|
\hrefsymb{https://github.com/Saizan/cubical-demo}{\texttt{https://github.com/Saizan/cubical-demo}}.
|
||||||
|
}.
|
||||||
|
|
||||||
|
These theorems are all purely related to homotopy type theory and as
|
||||||
|
such not specific to the formalization of Category Theory. I will
|
||||||
|
present a few of these theorems here as they will be used throughout
|
||||||
|
chapter \ref{ch:implementation}. They should also give the reader some
|
||||||
|
intuition about the path type.
|
||||||
|
|
||||||
|
\subsection{Path induction}
|
||||||
|
\label{sec:pathJ}
|
||||||
|
The induction principle for paths intuitively gives us a way to reason
|
||||||
|
about a type family indexed by a path by only considering if said path
|
||||||
|
is $\refl$ (the \nomen{base case}{path induction}). For \emph{based
|
||||||
|
path induction}, that equality is \emph{based} at some element $a
|
||||||
|
\tp A$.
|
||||||
|
|
||||||
|
\pagebreak[3]
|
||||||
|
\begin{samepage}
|
||||||
|
Let a type $A \tp \MCU$ and an element of the type $a \tp A$ be
|
||||||
|
given. $a$ is said to be the base of the induction.\linebreak[3] Given
|
||||||
|
a family of types:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
D \tp \prod_{b \tp A} \prod_{p \tp a ≡ b} \MCU
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
and an inhabitant of $D$ at $\refl$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
d \tp D\ a\ \refl
|
||||||
|
$$
|
||||||
|
We have the function:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\pathJ\ D\ d \tp \prod_{b \tp A} \prod_{p \tp a ≡ b} D\ b\ p
|
||||||
|
\end{equation}
|
||||||
|
\end{samepage}%
|
||||||
|
|
||||||
|
A simple application of $\pathJ$ is for proving that $\var{sym}$ is an
|
||||||
|
involution. Namely for any set $A \tp \MCU$, points $a, b \tp A$ and a path
|
||||||
|
between them $p \tp a \equiv b$:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\label{eq:sym-invol}
|
||||||
|
\var{sym}\ (\var{sym}\ p) ≡ p
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
The proof will be by induction on $p$ and will be based at $a$. That
|
||||||
|
is $D$ will be the family:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
D & \tp \prod_{b' \tp A} \prod_{p \tp a ≡ b'} \MCU \\
|
||||||
|
D\ b'\ p' & \defeq \var{sym}\ (\var{sym}\ p') ≡ p'
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The base case will then be:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
d & \tp \var{sym}\ (\var{sym}\ \refl) ≡ \refl \\
|
||||||
|
d & \defeq \refl
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The reason $\refl$ proves this is that $\var{sym}\ \refl = \refl$ holds
|
||||||
|
definitionally. In summary \ref{eq:sym-invol} is inhabited by the term:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\pathJ\ D\ d\ b\ p
|
||||||
|
\tp
|
||||||
|
\var{sym}\ (\var{sym}\ p) ≡ p
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Another application of $\pathJ$ is for proving associativity of $\trans$. That
|
||||||
|
is, given a type $A \tp \MCU$, elements of $A$, $a, b, c, d \tp A$ and paths
|
||||||
|
between them $p \tp a \equiv b$, $q \tp b \equiv c$ and $r \tp c \equiv d$ we
|
||||||
|
have the following:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\label{eq:cum-trans}
|
||||||
|
\trans\ p\ (\trans\ q\ r) ≡ \trans\ (\trans\ p\ q)\ r
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
In this case the induction will be based at $c$ (the left-endpoint of $r$) and
|
||||||
|
over the family:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
T & \tp \prod_{d' \tp A} \prod_{r' \tp c ≡ d'} \MCU \\
|
||||||
|
T\ d'\ r' & \defeq \trans\ p\ (\trans\ q\ r') ≡ \trans\ (\trans\ p\ q)\ r'
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The base case is proven with $t$ which is defined as:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\trans\ p\ (\trans\ q\ \refl) & ≡
|
||||||
|
\trans\ p\ q \\
|
||||||
|
& ≡
|
||||||
|
\trans\ (\trans\ p\ q)\ \refl
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Here we have used the proposition $\trans\ p\ \refl \equiv p$ without proof. In
|
||||||
|
conclusion \ref{eq:cum-trans} is inhabited by the term:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\pathJ\ T\ t\ d\ r
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
We shall see another application of path induction in \ref{eq:pathJ-example}.
|
||||||
|
|
||||||
|
\subsection{Paths over propositions}
|
||||||
|
\label{sec:lemPropF}
|
||||||
|
Another very useful combinator is $\lemPropF$: Given a type $A \tp
|
||||||
|
\MCU$ and a type family on $A$; $D \tp A \to \MCU$. Let $\var{propD}
|
||||||
|
\tp \prod_{x \tp A} \isProp\ (D\ x)$ be the proof that $D$ is a mere
|
||||||
|
proposition for all elements of $A$. Furthermore say we have a path
|
||||||
|
between some two elements in $A$; $p \tp a_0 \equiv a_1$ then we can
|
||||||
|
built a heterogeneous path between any two elements of $d_0 \tp
|
||||||
|
D\ a_0$ and $d_1 \tp D\ a_1$.
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\lemPropF\ \var{propD}\ p \tp \Path\ (\lambda\; i \mto D\ (p\ i))\ d_0\ d_1
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
Note that $d_0$ and $d_1$, though points of the same family, have
|
||||||
|
different types. This is quite a mouthful, so let me try to show how
|
||||||
|
this is a very general and useful result.
|
||||||
|
|
||||||
|
Often when proving equalities between elements of some dependent types
|
||||||
|
$\lemPropF$ can be used to boil this complexity down to showing that
|
||||||
|
the dependent parts of the type are mere propositions. For instance
|
||||||
|
say we have a type:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
T \defeq \sum_{a \tp A} D\ a
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
for some proposition $D \tp A \to \MCU$. That is we have $\var{propD}
|
||||||
|
\tp \prod_{a \tp A} \isProp\ (D\ a)$. If we want to prove $t_0 \equiv
|
||||||
|
t_1$ for two elements $t_0, t_1 \tp T$ then this will be a pair of
|
||||||
|
paths:
|
||||||
|
%
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
p \tp & \fst\ t_0 \equiv \fst\ t_1 \\
|
||||||
|
& \Path\ (\lambda\; i \to D\ (p\ i))\ (\snd\ t_0)\ (\snd\ t_1)
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Here $\lemPropF$ directly allow us to prove the latter of these given
|
||||||
|
that we have already provided $p$.
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\lemPropF\ \var{propD}\ p
|
||||||
|
\tp \Path\ (\lambda\; i \to D\ (p\ i))\ (\snd\ t_0)\ (\snd\ t_1)
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\subsection{Functions over propositions}
|
||||||
|
\label{sec:propPi}%
|
||||||
|
$\prod$-types preserve propositionality when the co-domain is always a
|
||||||
|
proposition.
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\mathit{propPi} \tp \left(\prod_{a \tp A} \isProp\ (P\ a)\right) \to \isProp\ \left(\prod_{a \tp A} P\ a\right)
|
||||||
|
$$
|
||||||
|
\subsection{Pairs over propositions}
|
||||||
|
\label{sec:propSig}
|
||||||
|
%
|
||||||
|
$\sum$-types preserve propositionality whenever its first component is
|
||||||
|
a proposition and its second component is a proposition for all
|
||||||
|
points of the left type.
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\mathit{propSig} \tp \isProp\ A \to \left(\prod_{a \tp A} \isProp\ (P\ a)\right) \to \isProp\ \left(\sum_{a \tp A} P\ a\right)
|
||||||
|
$$
|
139
doc/discussion.tex
Normal file
139
doc/discussion.tex
Normal file
|
@ -0,0 +1,139 @@
|
||||||
|
\chapter{Perspectives}
|
||||||
|
\section{Discussion}
|
||||||
|
In the previous chapter the practical aspects of proving things in
|
||||||
|
Cubical Agda were highlighted. I also demonstrated the usefulness of
|
||||||
|
separating ``laws'' from ``data''. One of the reasons for this is that
|
||||||
|
dependencies within types can lead to very complicated goals. One
|
||||||
|
technique for alleviating this was to prove that certain types are
|
||||||
|
mere propositions.
|
||||||
|
|
||||||
|
\subsection{Computational properties}
|
||||||
|
The new contribution of cubical Agda is that it has a constructive
|
||||||
|
proof of functional extensionality\index{functional extensionality}
|
||||||
|
and univalence\index{univalence}. This means in particular that the
|
||||||
|
type checker can reduce terms defined with these theorems. One
|
||||||
|
interesting result of this development is how much this influenced the
|
||||||
|
development. In particular having a functional extensionality that
|
||||||
|
``computes'' should simplify some proofs.
|
||||||
|
|
||||||
|
I have tested this by using a feature of Agda where one can mark
|
||||||
|
certain bindings as being \emph{abstract}. This means that the
|
||||||
|
type-checker will not try to reduce that term further during type
|
||||||
|
checking. I tried making univalence and functional extensionality
|
||||||
|
abstract. It turns out that the conversion behaviour of univalence is
|
||||||
|
not used anywhere. For functional extensionality there are two places
|
||||||
|
in the whole solution where the reduction behaviour is used to
|
||||||
|
simplify some proofs. This is in showing that the maps between the
|
||||||
|
two formulations of monads are inverses. See the notes in this
|
||||||
|
module:
|
||||||
|
%
|
||||||
|
\begin{center}
|
||||||
|
\sourcelink{Cat.Category.Monad.Voevodsky}
|
||||||
|
\end{center}
|
||||||
|
%
|
||||||
|
|
||||||
|
I will not reproduce it in full here as the type is quite involved. In
|
||||||
|
stead I have put this in a source listing in
|
||||||
|
\ref{app:abstract-funext}. The method used to find in what places the
|
||||||
|
computational behaviour of these proofs are needed has the caveat of
|
||||||
|
only working for places that directly or transitively uses these two
|
||||||
|
proofs. Fortunately though the code is structured in such a way that
|
||||||
|
this is the case. In conclusion the way I have structured these proofs
|
||||||
|
means that the computational behaviour of functional extensionality
|
||||||
|
and univalence has not been so relevant.
|
||||||
|
|
||||||
|
Barring this the computational behaviour of paths can still be useful.
|
||||||
|
E.g.\ if a programmer wants to reuse functions that operate on a
|
||||||
|
monoidal monads to work with a monad in the Kleisli form that the
|
||||||
|
programmer has specified. To make this idea concrete, say we are
|
||||||
|
given some function $f \tp \Kleisli \to T$, having a path between $p
|
||||||
|
\tp \Monoidal \equiv \Kleisli$ induces a map $\coe\ p \tp \Monoidal
|
||||||
|
\to \Kleisli$. We can compose $f$ with this map to get $f \comp
|
||||||
|
\coe\ p \tp \Monoidal \to T$. Of course, since that map was
|
||||||
|
constructed with an isomorphism, these maps already exist and could be
|
||||||
|
used directly. So this is arguably only interesting when one also
|
||||||
|
wants to prove properties of applying such functions.
|
||||||
|
|
||||||
|
\subsection{Reusability of proofs}
|
||||||
|
The previous example illustrate how univalence unifies two otherwise
|
||||||
|
disparate areas: The category-theoretic study of monads; and monads as
|
||||||
|
in functional programming. Univalence thus allows one to reuse proofs.
|
||||||
|
You could say that univalence gives the developer two proofs for the
|
||||||
|
price of one. As an illustration of this I proved that monads are
|
||||||
|
groupoids. I initially proved this for the Kleisli
|
||||||
|
formulation\footnote{Actually doing this directly turned out to be
|
||||||
|
tricky as well, so I defined an equivalent formulation which was not
|
||||||
|
formulated with a record, but purely with $\sum$-types.}. Since the
|
||||||
|
two formulations are equal under univalence, substitution directly
|
||||||
|
gives us that this also holds for the monoidal formulation. This of
|
||||||
|
course generalizes to any family $P \tp 𝒰 → 𝒰$ where $P$ is inhabited
|
||||||
|
at either formulation (i.e.\ either $P\ \Monoidal$ or $P\ \Kleisli$
|
||||||
|
holds).
|
||||||
|
|
||||||
|
The introduction (section \S\ref{sec:context}) mentioned that a
|
||||||
|
typical way of getting access to functional extensionality is to work
|
||||||
|
with setoids. Nowhere in this formalization has this been necessary,
|
||||||
|
$\Path$ has been used globally in the project for propositional
|
||||||
|
equality. One interesting place where this becomes apparent is in
|
||||||
|
interfacing with the Agda standard library. Multiple definitions in
|
||||||
|
the Agda standard library have been designed with the
|
||||||
|
setoid-interpretation in mind. E.g.\ the notion of \emph{unique
|
||||||
|
existential} is indexed by a relation that should play the role of
|
||||||
|
propositional equality. Equivalence relations are likewise indexed,
|
||||||
|
not only by the actual equivalence relation but also by another
|
||||||
|
relation that serve as propositional equality.
|
||||||
|
%% Unfortunately we cannot use the definition of equivalences found in
|
||||||
|
%% the standard library to do equational reasoning directly. The
|
||||||
|
%% reason for this is that the equivalence relation defined there must
|
||||||
|
%% be a homogenous relation, but paths are heterogeneous relations.
|
||||||
|
|
||||||
|
In the formalization at present a significant amount of energy has
|
||||||
|
been put towards proving things that would not have been needed in
|
||||||
|
classical Agda. The proofs that some given type is a proposition were
|
||||||
|
provided as a strategy to simplify some otherwise very complicated
|
||||||
|
proofs (e.g.\ \ref{eq:proof-prop-IsPreCategory}
|
||||||
|
and \ref{eq:productPath}). Often these proofs would not be this
|
||||||
|
complicated. If the J-rule holds definitionally the proof-assistant
|
||||||
|
can help simplify these goals considerably. The lack of the J-rule has
|
||||||
|
a significant impact on the complexity of these kinds of proofs.
|
||||||
|
|
||||||
|
\subsection{Motifs}
|
||||||
|
An oft-used technique in this development is using based path
|
||||||
|
induction to prove certain properties. One particular challenge that
|
||||||
|
arises when doing so is that Agda is not able to automatically infer
|
||||||
|
the family that one wants to do induction over. For instance in the
|
||||||
|
proof $\var{sym}\ (\var{sym}\ p) ≡ p$ from \ref{eq:sym-invol} the
|
||||||
|
family that we chose to do induction over was $D\ b'\ p' \defeq
|
||||||
|
\var{sym}\ (\var{sym}\ p') ≡ p'$. However, if one interactively tries
|
||||||
|
to give this hole, all the information that Agda can provide is that
|
||||||
|
one must provide an element of $𝒰$. Agda could be more helpful in this
|
||||||
|
context, perhaps even infer this family in some situations. In this
|
||||||
|
very simple example this is of course not a big problem, but there are
|
||||||
|
examples in the source code where this gets more involved.
|
||||||
|
|
||||||
|
\section{Future work}
|
||||||
|
\subsection{Compiling Cubical Agda}
|
||||||
|
\label{sec:compiling-cubical-agda}
|
||||||
|
Compilation of program written in Cubical Agda is currently not
|
||||||
|
supported. One issue here is that the backends does not provide an
|
||||||
|
implementation for the cubical primitives (such as the path-type).
|
||||||
|
This means that even though the path-type gives us a computational
|
||||||
|
interpretation of functional extensionality, univalence, transport,
|
||||||
|
etc., we do not have a way of actually using this to compile our
|
||||||
|
programs that use these primitives. It would be interesting to see
|
||||||
|
practical applications of this.
|
||||||
|
|
||||||
|
\subsection{Proving laws of programs}
|
||||||
|
Another interesting thing would be to use the Kleisli formulation of
|
||||||
|
monads to prove properties of functional programs. The existence of
|
||||||
|
univalence will make it possible to re-use proofs stated in terms of
|
||||||
|
the monoidal formulation in this setting.
|
||||||
|
|
||||||
|
%% \subsection{Higher inductive types}
|
||||||
|
%% This library has not explored the usefulness of higher inductive types
|
||||||
|
%% in the context of Category Theory.
|
||||||
|
|
||||||
|
\subsection{Initiality conjecture}
|
||||||
|
A fellow student at Chalmers, Andreas Källberg, is currently working
|
||||||
|
on proving the initiality conjecture. He will be using this library
|
||||||
|
to do so.
|
9
doc/feedback-meeting-andrea.txt
Normal file
9
doc/feedback-meeting-andrea.txt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
App. 2 in HoTT gives typing rule for pathJ including a computational
|
||||||
|
rule for it.
|
||||||
|
|
||||||
|
If you have this computational rule definitionally, then you wouldn't
|
||||||
|
need to use `pathJprop`.
|
||||||
|
|
||||||
|
In discussion-section I mention HITs. I should remove this or come up
|
||||||
|
with a more elaborate example of something you could do, e.g.
|
||||||
|
something with pushouts in the category of sets.
|
72
doc/feedback.txt
Normal file
72
doc/feedback.txt
Normal file
|
@ -0,0 +1,72 @@
|
||||||
|
Andrea Vezzosi <vezzosi@chalmers.se> Tue, Apr 24, 2018 at 2:02 PM
|
||||||
|
To: Frederik Hanghøj Iversen <fhi.1990@gmail.com>
|
||||||
|
Cc: Thierry Coquand <coquand@chalmers.se>
|
||||||
|
On Tue, Apr 24, 2018 at 12:57 PM, Frederik Hanghøj Iversen
|
||||||
|
<fhi.1990@gmail.com> wrote:
|
||||||
|
> I've written the first few sections about my implementation. I was wondering
|
||||||
|
> if you could have a quick look at it. You don't need to read it
|
||||||
|
> word-for-word but I would like some indication from you if this is the sort
|
||||||
|
> of thing you would like to see in the final report.
|
||||||
|
|
||||||
|
Yes! I would say this very much fits the bill of what the main part of
|
||||||
|
the report should be, then you could have a discussion section where
|
||||||
|
you might put some analysis of the pros and cons of cubical, design
|
||||||
|
choices you made, and your experience overall.
|
||||||
|
|
||||||
|
I wonder if there should be some short introduction to Cubical Type
|
||||||
|
Theory before this chapter, so you can introduce the Path type by
|
||||||
|
itself and show some simple proof with it. e.g. how to get function
|
||||||
|
extensionality.
|
||||||
|
|
||||||
|
You mention a few "combinators" like propPi and lemPropF, you might
|
||||||
|
want to call them just lemmas, so it's clearer that these can be
|
||||||
|
proven in --cubical.
|
||||||
|
|
||||||
|
>
|
||||||
|
> I refer you specifically to "Chapter 2 - Implementation" on p. 6.
|
||||||
|
>
|
||||||
|
> In this chapter I plan to additionally include some text about the proof we
|
||||||
|
> did that products are mere propositions and the proof about the two
|
||||||
|
> equivalent notions of a monad.
|
||||||
|
|
||||||
|
I've read the chapter up until 2.3 and skimmed the rest for now, but I
|
||||||
|
accumulated some editing suggestions I copy here.
|
||||||
|
Remember to look for things like these when you proof-read the rest :)
|
||||||
|
|
||||||
|
|
||||||
|
You should be careful to properly introduce things before you use
|
||||||
|
them, like IsPreCategory (I'd prefer if it took the raw category as
|
||||||
|
argument btw) and its fields isIdentity, isAssociative, .. come up a
|
||||||
|
bit out of the blue from the end of page 8.
|
||||||
|
Maybe the easiest is to show the definition of IsPreCategory.
|
||||||
|
|
||||||
|
Maybe give a type for propIsIdentity and mention the other prop* are similar.
|
||||||
|
|
||||||
|
Also the notation "isIdentity_a" to apply projections is a bit unusual
|
||||||
|
so it needs to be introduced as well.
|
||||||
|
To be fair it would be simpler to stick to function application
|
||||||
|
(though I see that it would introduce more parentheses),
|
||||||
|
|
||||||
|
"The situation is a bit more complicated when we have a dependent
|
||||||
|
type" could be more clear by being more specific:
|
||||||
|
"The situation is a bit more complicated when the type of a field
|
||||||
|
depends on a previous field"
|
||||||
|
|
||||||
|
Here too it might be more concrete if you also give the code for IsCategory.
|
||||||
|
|
||||||
|
In Path ( λ i → Univalent_{p i} ) isPreCategory_a isPreCategory_b
|
||||||
|
I suggest parentheses around (p i), but also you should be consistent
|
||||||
|
on whether you want to call the proof "p" or "p_{isPreCategory}",
|
||||||
|
finally i'm guessing the two fields should be "isUnivalent" rather
|
||||||
|
than "isPreCategory".
|
||||||
|
|
||||||
|
You can cite the book on the specific definition of isEquiv,
|
||||||
|
"contractible fibers" in section 4.4, the grad lemma is also from
|
||||||
|
somewhere but I don't remember off-hand.
|
||||||
|
|
||||||
|
You have not defined what you mean by _\~=_ and isomorphism.
|
||||||
|
|
||||||
|
|
||||||
|
Cheers,
|
||||||
|
Andrea
|
||||||
|
[Quoted text hidden]
|
259
doc/halftime.tex
Normal file
259
doc/halftime.tex
Normal file
|
@ -0,0 +1,259 @@
|
||||||
|
\chapter{Halftime report}
|
||||||
|
I've written this as an appendix because 1) the aim of the thesis changed
|
||||||
|
drastically from the planning report/proposal 2) partly I'm not sure how to
|
||||||
|
structure my thesis.
|
||||||
|
|
||||||
|
My work so far has very much focused on the formalization, i.e.\ coding. It's
|
||||||
|
unclear to me at this point what I should have in the final report. Here I will
|
||||||
|
describe what I have managed to formalize so far and what outstanding challenges
|
||||||
|
I'm facing.
|
||||||
|
|
||||||
|
\section{Implementation overview}
|
||||||
|
The overall structure of my project is as follows:
|
||||||
|
|
||||||
|
\begin{itemize}
|
||||||
|
\item Core categorical concepts
|
||||||
|
\subitem Categories
|
||||||
|
\subitem Functors
|
||||||
|
\subitem Products
|
||||||
|
\subitem Exponentials
|
||||||
|
\subitem Cartesian closed categories
|
||||||
|
\subitem Natural transformations
|
||||||
|
\subitem Yoneda embedding
|
||||||
|
\subitem Monads
|
||||||
|
\subsubitem Monoidal monads
|
||||||
|
\subsubitem Kleisli monads
|
||||||
|
\subsubitem Voevodsky's construction
|
||||||
|
\item Category of \ldots
|
||||||
|
\subitem Homotopy sets
|
||||||
|
\subitem Categories
|
||||||
|
\subitem Relations
|
||||||
|
\subitem Functors
|
||||||
|
\subitem Free category
|
||||||
|
\end{itemize}
|
||||||
|
|
||||||
|
I also started work on the category with families as well as the cubical
|
||||||
|
category as per the original goal of the thesis. However I have not gotten so
|
||||||
|
far with this.
|
||||||
|
|
||||||
|
In the following I will give an overview of overall results in each of these
|
||||||
|
categories (no pun).
|
||||||
|
|
||||||
|
As an overall design-guideline I've defined concepts in a such a way that the
|
||||||
|
``data'' and the ``laws'' about that data is split up in seperate modules. As an
|
||||||
|
example a category is defined to have two members: `raw` which is a collection
|
||||||
|
of the data and `isCategory` which asserts some laws about that data.
|
||||||
|
|
||||||
|
This allows me to reason about things in a more mathematical way, where one can
|
||||||
|
reason about two categories by simply focusing on the data. This is acheived by
|
||||||
|
creating a function embodying the ``equality principle'' for a given record. In
|
||||||
|
the case of monads, to prove two categories propositionally equal it enough to
|
||||||
|
provide a proof that their data is equal.
|
||||||
|
|
||||||
|
\subsection{Categories}
|
||||||
|
Defines the basic notion of a category. This definition closely follows that of
|
||||||
|
[HoTT]: That is, the standard definition of a category (data; objects, arrows,
|
||||||
|
composition and identity, laws; preservation of identity and composition) plus
|
||||||
|
the extra condition that it is univalent - namely that you can get an equality
|
||||||
|
of two objects from an isomorphism.
|
||||||
|
|
||||||
|
I make no distinction between a pre category and a real category (as in the
|
||||||
|
[HoTT]-sense). A pre category in my implementation would be a category sans the
|
||||||
|
witness to univalence.
|
||||||
|
|
||||||
|
I also prove that being a category is a proposition. This gives rise to an
|
||||||
|
equality principle for monads that focuses on the data-part.
|
||||||
|
|
||||||
|
I also show that the opposite category is indeed a category. (\WIP{} I have not
|
||||||
|
shown that univalence holds for such a construction)
|
||||||
|
|
||||||
|
I also show that taking the opposite is an involution.
|
||||||
|
|
||||||
|
\subsection{Functors}
|
||||||
|
Defines the notion of a functor - also split up into data and laws.
|
||||||
|
|
||||||
|
Propositionality for being a functor.
|
||||||
|
|
||||||
|
Composition of functors and the identity functor.
|
||||||
|
|
||||||
|
\subsection{Products}
|
||||||
|
Definition of what it means for an object to be a product in a given category.
|
||||||
|
|
||||||
|
Definition of what it means for a category to have all products.
|
||||||
|
|
||||||
|
\WIP{} Prove propositionality for being a product and having products.
|
||||||
|
|
||||||
|
\subsection{Exponentials}
|
||||||
|
Definition of what it means to be an exponential object.
|
||||||
|
|
||||||
|
Definition of what it means for a category to have all exponential objects.
|
||||||
|
|
||||||
|
\subsection{Cartesian closed categories}
|
||||||
|
Definition of what it means for a category to be cartesian closed; namely that
|
||||||
|
it has all products and all exponentials.
|
||||||
|
|
||||||
|
\subsection{Natural transformations}
|
||||||
|
Definition of transformations\footnote{Maybe this is a name I made up for a
|
||||||
|
family of morphisms} and the naturality condition for these.
|
||||||
|
|
||||||
|
Proof that naturality is a mere proposition and the accompanying equality
|
||||||
|
principle. Proof that natural transformations are homotopic sets.
|
||||||
|
|
||||||
|
The identity natural transformation.
|
||||||
|
|
||||||
|
\subsection{Yoneda embedding}
|
||||||
|
|
||||||
|
The yoneda embedding is typically presented in terms of the category of
|
||||||
|
categories (cf. Awodey) \emph however this is not stricly needed - all we need
|
||||||
|
is what would be the exponential object in that category - this happens to be
|
||||||
|
functors and so this is how we define the yoneda embedding.
|
||||||
|
|
||||||
|
\subsection{Monads}
|
||||||
|
|
||||||
|
Defines an equivalence between these two formulations of a monad:
|
||||||
|
|
||||||
|
\subsubsection{Monoidal monads}
|
||||||
|
|
||||||
|
Defines the standard monoidal representation of a monad:
|
||||||
|
|
||||||
|
An endofunctor with two natural transformations (called ``pure'' and ``join'')
|
||||||
|
and some laws about these natural transformations.
|
||||||
|
|
||||||
|
Propositionality proofs and equality principle is provided.
|
||||||
|
|
||||||
|
\subsubsection{Kleisli monads}
|
||||||
|
|
||||||
|
A presentation of monads perhaps more familiar to a functional programer:
|
||||||
|
|
||||||
|
A map on objects and two maps on morphisms (called ``pure'' and ``bind'') and
|
||||||
|
some laws about these maps.
|
||||||
|
|
||||||
|
Propositionality proofs and equality principle is provided.
|
||||||
|
|
||||||
|
\subsubsection{Voevodsky's construction}
|
||||||
|
|
||||||
|
Provides construction 2.3 as presented in an unpublished paper by Vladimir
|
||||||
|
Voevodsky. This construction is similiar to the equivalence provided for the two
|
||||||
|
preceding formulations
|
||||||
|
\footnote{ TODO: I would like to include in the thesis some motivation for why
|
||||||
|
this construction is particularly interesting.}
|
||||||
|
|
||||||
|
\subsection{Homotopy sets}
|
||||||
|
The typical category of sets where the objects are modelled by an Agda set
|
||||||
|
(henceforth ``$\Type$'') at a given level is not a valid category in this cubical
|
||||||
|
settings, we need to restrict the types to be those that are homotopy sets. Thus
|
||||||
|
the objects of this category are:
|
||||||
|
%
|
||||||
|
$$\hSet_\ell \defeq \sum_{A \tp \MCU_\ell} \isSet\ A$$
|
||||||
|
%
|
||||||
|
The definition of univalence for categories I have defined is:
|
||||||
|
%
|
||||||
|
$$\isEquiv\ (\hA \equiv \hB)\ (\hA \cong \hB)\ \idToIso$$
|
||||||
|
%
|
||||||
|
Where $\hA and \hB$ denote objects in the category. Note that this is stronger
|
||||||
|
than
|
||||||
|
%
|
||||||
|
$$(\hA \equiv \hB) \simeq (\hA \cong \hB)$$
|
||||||
|
%
|
||||||
|
Because we require that the equivalence is constructed from the witness to:
|
||||||
|
%
|
||||||
|
$$\id \comp f \equiv f \x f \comp \id \equiv f$$
|
||||||
|
%
|
||||||
|
And indeed univalence does not follow immediately from univalence for types:
|
||||||
|
%
|
||||||
|
$$(A \equiv B) \simeq (A \simeq B)$$
|
||||||
|
%
|
||||||
|
Because $A\ B \tp \Type$ whereas $\hA\ \hB \tp \hSet$.
|
||||||
|
|
||||||
|
For this reason I have shown that this category satisfies the following
|
||||||
|
equivalent formulation of being univalent:
|
||||||
|
%
|
||||||
|
$$\prod_{A \tp hSet} \isContr \left( \sum_{X \tp hSet} A \cong X \right)$$
|
||||||
|
%
|
||||||
|
But I have not shown that it is indeed equivalent to my former definition.
|
||||||
|
\subsection{Categories}
|
||||||
|
Note that this category does in fact not exist. In stead I provide the
|
||||||
|
definition of the ``raw'' category as well as some of the laws.
|
||||||
|
|
||||||
|
Furthermore I provide some helpful lemmas about this raw category. For instance
|
||||||
|
I have shown what would be the exponential object in such a category.
|
||||||
|
|
||||||
|
These lemmas can be used to provide the actual exponential object in a context
|
||||||
|
where we have a witness to this being a category. This is useful if this library
|
||||||
|
is later extended to talk about higher categories.
|
||||||
|
|
||||||
|
\subsection{Functors}
|
||||||
|
The category of functors and natural transformations. An immediate corrolary is
|
||||||
|
the set of presheaf categories.
|
||||||
|
|
||||||
|
\WIP{} I have not shown that the category of functors is univalent.
|
||||||
|
|
||||||
|
\subsection{Relations}
|
||||||
|
The category of relations. \WIP{} I have not shown that this category is
|
||||||
|
univalent. Not sure I intend to do so either.
|
||||||
|
|
||||||
|
\subsection{Free category}
|
||||||
|
The free category of a category. \WIP{} I have not shown that this category is
|
||||||
|
univalent.
|
||||||
|
|
||||||
|
\section{Current Challenges}
|
||||||
|
Besides the items marked \WIP{} above I still feel a bit unsure about what to
|
||||||
|
include in my report. Most of my work so far has been specifically about
|
||||||
|
developing this library. Some ideas:
|
||||||
|
%
|
||||||
|
\begin{itemize}
|
||||||
|
\item
|
||||||
|
Modularity properties
|
||||||
|
\item
|
||||||
|
Compare with setoid-approach to solve similiar problems.
|
||||||
|
\item
|
||||||
|
How to structure an implementation to best deal with types that have no
|
||||||
|
structure (propositions) and those that do (sets and everything above)
|
||||||
|
\end{itemize}
|
||||||
|
%
|
||||||
|
\section{Ideas for future developments}
|
||||||
|
\subsection{Higher categories}
|
||||||
|
I only have a notion of (1-)categories. Perhaps it would be nice to also
|
||||||
|
formalize higher categories.
|
||||||
|
|
||||||
|
\subsection{Hierarchy of concepts related to monads}
|
||||||
|
In Haskell the type-class Monad sits in a hierarchy atop the notion of a functor
|
||||||
|
and applicative functors. There's probably a similiar notion in the
|
||||||
|
category-theoretic approach to developing this.
|
||||||
|
|
||||||
|
As I have already defined monads from these two perspectives, it would be
|
||||||
|
interesting to take this idea even further and actually show how monads are
|
||||||
|
related to applicative functors and functors. I'm not entirely sure how this
|
||||||
|
would look in Agda though.
|
||||||
|
|
||||||
|
\subsection{Use formulation on the standard library}
|
||||||
|
I also thought it would be interesting to use this library to show certain
|
||||||
|
properties about functors, applicative functors and monads used in the Agda
|
||||||
|
Standard library. So I went ahead and tried to show that agda's standard
|
||||||
|
library's notion of a functor (along with suitable laws) is equivalent to my
|
||||||
|
formulation (in the category of homotopic sets). I ran into two problems here,
|
||||||
|
however; the first one is that the standard library's notion of a functor is
|
||||||
|
indexed by the object map:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\Functor \tp (\Type \to \Type) \to \Type
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
Where $\Functor\ F$ has the member:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\fmap \tp (A \to B) \to F A \to F B
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
Whereas the object map in my definition is existentially quantified:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\Functor \tp \Type
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
And $\Functor$ has these members:
|
||||||
|
\begin{align*}
|
||||||
|
F & \tp \Type \to \Type \\
|
||||||
|
\fmap & \tp (A \to B) \to F A \to F B\}
|
||||||
|
\end{align*}
|
||||||
|
%
|
1688
doc/implementation.tex
Normal file
1688
doc/implementation.tex
Normal file
File diff suppressed because it is too large
Load diff
266
doc/introduction.tex
Normal file
266
doc/introduction.tex
Normal file
|
@ -0,0 +1,266 @@
|
||||||
|
\chapter{Introduction}
|
||||||
|
This thesis is a case study in the application of cubical Agda to the
|
||||||
|
formalization of category theory. At the center of this is the notion
|
||||||
|
of \nomenindex{equality}. There are two pervasive notions of equality
|
||||||
|
in type theory: \nomenindex{judgmental equality} and
|
||||||
|
\nomenindex{propositional equality}. Judgmental equality is a property
|
||||||
|
of the type system. Propositional equality on the other hand is
|
||||||
|
usually defined \emph{within} the system. When introducing
|
||||||
|
definitions this report will use the symbol $\defeq$. Judgmental
|
||||||
|
equalities will be denoted with $=$ and for propositional equalities
|
||||||
|
the notation $\equiv$ is used.
|
||||||
|
|
||||||
|
The rules of judgmental equality are related with $β$- and
|
||||||
|
$η$-reduction, which gives a notion of computation in a given type
|
||||||
|
theory.
|
||||||
|
%
|
||||||
|
There are some properties that one usually want judgmental equality to
|
||||||
|
satisfy. It must be \nomenindex{sound}, enjoy \nomenindex{canonicity}
|
||||||
|
and be a \nomenindex{congruence relation}. Soundness means that things
|
||||||
|
judged to be equal are equal with respects to the \nomenindex{model}
|
||||||
|
of the theory or the \emph{meta theory}. It must be a congruence
|
||||||
|
relation, because otherwise the relation certainly does not adhere to
|
||||||
|
our notion of equality. E.g.\ One would be able to conclude things
|
||||||
|
like: $x \equiv y \rightarrow f\ x \nequiv f\ y$. Canonicity means
|
||||||
|
that any well typed term evaluates to a \emph{canonical} form. For
|
||||||
|
example, for a closed term $e \tp \bN$, it will be the case that $e$
|
||||||
|
reduces to $n$ applications of $\mathit{suc}$ to $0$ for some $n$;
|
||||||
|
i.e.\ $e = \mathit{suc}^n\ 0$. Without canonicity terms in the
|
||||||
|
language can get ``stuck'', meaning that they do not reduce to a
|
||||||
|
canonical form.
|
||||||
|
|
||||||
|
For a system to work as a programming languages it is necessary for
|
||||||
|
judgmental equality to be \nomenindex{decidable}. Being decidable
|
||||||
|
simply means that that an algorithm exists to decide whether two terms
|
||||||
|
are equal. For any practical implementation, the decidability must
|
||||||
|
also be effectively computable.
|
||||||
|
|
||||||
|
For propositional equality the decidability requirement is relaxed. It
|
||||||
|
is not in general possible to decide the correctness of logical
|
||||||
|
propositions (cf.\ Hilbert's \emph{entscheidigungsproblem}).
|
||||||
|
|
||||||
|
There are two flavors of type-theory. \emph{Intensional-} and
|
||||||
|
\emph{extensional-} type theory (ITT and ETT respectively). Identity
|
||||||
|
types in extensional type theory are required to be
|
||||||
|
\nomen{propositions}{proposition}. That is, a type with at most one
|
||||||
|
inhabitant. In extensional type theory the principle of reflection
|
||||||
|
%
|
||||||
|
$$a ≡ b → a = b$$
|
||||||
|
%
|
||||||
|
is enough to make type checking undecidable. This report focuses on
|
||||||
|
Agda, which at a glance can be thought of as a version of intensional
|
||||||
|
type theory. Pattern-matching in regular Agda lets one prove
|
||||||
|
\nomenindex{Uniqueness of Identity Proofs} (UIP). UIP states that any
|
||||||
|
two identity proofs are propositionally identical.
|
||||||
|
|
||||||
|
The usual notion of propositional equality in ITT is quite
|
||||||
|
restrictive. In the next section a few motivating examples will be
|
||||||
|
presented that highlight. There exist techniques to circumvent these
|
||||||
|
problems, as we shall see. This thesis will explore an extension to
|
||||||
|
Agda that redefines the notion of propositional equality and as such
|
||||||
|
is an alternative to these other techniques. The extension is called
|
||||||
|
cubical Agda. Cubical Agda drops UIP, as it does not permit
|
||||||
|
\nomenindex{functional extensionality} nor \nomenindex{univalence}.
|
||||||
|
What makes cubical Agda particularly interesting is that it gives a
|
||||||
|
\emph{constructive} interpretation of univalence. What all this means
|
||||||
|
will be elaborated in the following sections.
|
||||||
|
%
|
||||||
|
\section{Motivating examples}
|
||||||
|
%
|
||||||
|
In the following two sections I present two examples that illustrate
|
||||||
|
some limitations inherent in ITT and, by extension, Agda.
|
||||||
|
%
|
||||||
|
\subsection{Functional extensionality}
|
||||||
|
\label{sec:functional-extensionality}%
|
||||||
|
Consider the functions:
|
||||||
|
%
|
||||||
|
\begin{align*}%
|
||||||
|
\var{zeroLeft} & \defeq λ\; (n \tp \bN) \to (0 + n \tp \bN) \\
|
||||||
|
\var{zeroRight} & \defeq λ\; (n \tp \bN) \to (n + 0 \tp \bN)
|
||||||
|
\end{align*}%
|
||||||
|
%
|
||||||
|
The term $n + 0$ is \nomenindex{definitionally} equal to $n$, which we
|
||||||
|
write as $n + 0 = n$. This is also called \nomenindex{judgmental
|
||||||
|
equality}. We call it definitional equality because the
|
||||||
|
\emph{equality} arises from the \emph{definition} of $+$, which is:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
+ & \tp \bN \to \bN \to \bN \\
|
||||||
|
n + 0 & \defeq n \\
|
||||||
|
n + (\suc{m}) & \defeq \suc{(n + m)}
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Note that $0 + n$ is \emph{not} definitionally equal to $n$. This is
|
||||||
|
because $0 + n$ is in normal form. I.e.\ there is no rule for $+$
|
||||||
|
whose left hand side matches this expression. We do, however, have that
|
||||||
|
they are \nomen{propositionally}{propositional equality} equal, which
|
||||||
|
we write as $n \equiv n + 0$. Propositional equality means that there
|
||||||
|
is a proof that exhibits this relation. We can do induction over $n$
|
||||||
|
to prove this:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
\label{eq:zrn}
|
||||||
|
\begin{split}
|
||||||
|
\var{zrn}\ & \tp ∀ n → n ≡ \var{zeroRight}\ n \\
|
||||||
|
\var{zrn}\ \var{zero} & \defeq \var{refl} \\
|
||||||
|
\var{zrn}\ (\var{suc}\ n) & \defeq \var{cong}\ \var{suc}\ (\var{zrn}\ n)
|
||||||
|
\end{split}
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
This show that zero is a right neutral element (hence the name
|
||||||
|
$\var{zrn}$). Since equality is a transitive relation we have that
|
||||||
|
$\forall n \to \var{zeroLeft}\ n \equiv \var{zeroRight}\ n$.
|
||||||
|
Unfortunately we don't have $\var{zeroLeft} \equiv \var{zeroRight}$.
|
||||||
|
There is no way to construct a proof asserting the obvious equivalence
|
||||||
|
of $\var{zeroLeft}$ and $\var{zeroRight}$. Actually showing this is
|
||||||
|
outside the scope of this text. It would essentially involve giving a
|
||||||
|
model for our type theory that validates all our axioms but where
|
||||||
|
$\var{zeroLeft} \equiv \var{zeroRight}$ is not true. We cannot show
|
||||||
|
that they are equal even though we can prove them equal for all
|
||||||
|
points. This is exactly the notion of equality that we are interested
|
||||||
|
in for functions: Functions are considered equal when they are equal
|
||||||
|
for all inputs. This is called \nomenindex{pointwise equality} where
|
||||||
|
\emph{points} of a function refer to its arguments.
|
||||||
|
%
|
||||||
|
\subsection{Equality of isomorphic types}
|
||||||
|
%
|
||||||
|
Let $\top$ denote the unit type -- a type with a single constructor.
|
||||||
|
In the propositions as types interpretation of type theory $\top$ is
|
||||||
|
the proposition that is always true. The type $A \x \top$ and $A$ has
|
||||||
|
an element for each $a \tp A$. So in a sense they have the same shape
|
||||||
|
(Greek; \nomenindex{isomorphic}). The second element of the pair does
|
||||||
|
not add any ``interesting information''. It can be useful to identify
|
||||||
|
such types. In fact it is quite commonplace in mathematics. Say we
|
||||||
|
look at a set $\{x \mid \phi\ x \land \psi\ x\}$ and somehow conclude
|
||||||
|
that $\psi\ x \equiv \top$ for all $x$. A mathematician would
|
||||||
|
immediately conclude $\{x \mid \phi\ x \land \psi\ x\} \equiv \{x \mid
|
||||||
|
\phi\ x\}$ without thinking twice. Unfortunately such an
|
||||||
|
identification can not be performed in ITT.
|
||||||
|
|
||||||
|
More specifically what we are interested in is a way of identifying
|
||||||
|
\nomenindex{equivalent} types. I will return to the definition of
|
||||||
|
equivalence later in section \S\ref{sec:equiv}, but for now it is
|
||||||
|
sufficient to think of an equivalence as a one-to-one correspondence.
|
||||||
|
We write $A \simeq B$ to assert that $A$ and $B$ are equivalent types.
|
||||||
|
The principle of univalence says that:
|
||||||
|
%
|
||||||
|
$$\mathit{univalence} \tp (A \simeq B) \simeq (A \equiv B)$$
|
||||||
|
%
|
||||||
|
In particular this allows us to construct an equality from an equivalence
|
||||||
|
%
|
||||||
|
$$\mathit{ua} \tp (A \simeq B) \to (A \equiv B)$$
|
||||||
|
%
|
||||||
|
and vice versa.
|
||||||
|
|
||||||
|
\section{Formalizing Category Theory}
|
||||||
|
%
|
||||||
|
The above examples serve to illustrate a limitation of ITT. One case
|
||||||
|
where these limitations are particularly prohibitive is in the study
|
||||||
|
of Category Theory. At a glance category theory can be described as
|
||||||
|
``the mathematical study of (abstract) algebras of functions''
|
||||||
|
(\cite{awodey-2006}). By that token functional extensionality is
|
||||||
|
particularly useful for formulating Category Theory. In Category
|
||||||
|
theory it is also commonplace to identify isomorphic structures.
|
||||||
|
Univalence gives us a way to make this notion precise. In fact we can
|
||||||
|
formulate this requirement within our formulation of categories by
|
||||||
|
requiring the \emph{categories} themselves to be univalent as we shall
|
||||||
|
see in section \S\ref{sec:univalence}.
|
||||||
|
|
||||||
|
\section{Context}
|
||||||
|
\label{sec:context}
|
||||||
|
%
|
||||||
|
The idea of formalizing Category Theory in proof assistants is not new. There
|
||||||
|
are a multitude of these available online. Notably:
|
||||||
|
%
|
||||||
|
\begin{itemize}
|
||||||
|
\item
|
||||||
|
A formalization in Agda using the setoid approach:
|
||||||
|
\url{https://github.com/copumpkin/categories}
|
||||||
|
\item
|
||||||
|
A formalization in Agda with univalence and functional
|
||||||
|
extensionality as postulates:
|
||||||
|
\url{https://github.com/pcapriotti/agda-categories}
|
||||||
|
\item
|
||||||
|
A formalization in Coq in the homotopic setting:
|
||||||
|
\url{https://github.com/HoTT/HoTT/tree/master/theories/Categories}
|
||||||
|
\item
|
||||||
|
A formalization in \emph{CubicalTT} -- a language designed for
|
||||||
|
cubical type theory. Formalizes many different things, but only a
|
||||||
|
few concepts from category theory:
|
||||||
|
\url{https://github.com/mortberg/cubicaltt}
|
||||||
|
\end{itemize}
|
||||||
|
%
|
||||||
|
The contribution of this thesis is to explore how working in a cubical
|
||||||
|
setting will make it possible to prove more things, to reuse proofs
|
||||||
|
and to compare some aspects of this formalization with the existing
|
||||||
|
ones.
|
||||||
|
|
||||||
|
There are alternative approaches to working in a cubical setting where
|
||||||
|
one can still have univalence and functional extensionality. One
|
||||||
|
option is to postulate these as axioms. This approach, however, has
|
||||||
|
other shortcomings, e.g.\ you lose \nomenindex{canonicity}
|
||||||
|
(\cite[p.\ 3]{huber-2016}).
|
||||||
|
|
||||||
|
Another approach is to use the \emph{setoid interpretation} of type
|
||||||
|
theory (\cite{hofmann-1995,huber-2016}). With this approach one works
|
||||||
|
with \nomenindex{extensional sets} $(X, \sim)$. That is a type $X \tp
|
||||||
|
\MCU$ and an equivalence relation $\sim\ \tp X \to X \to \MCU$ on that
|
||||||
|
type. Under the setoid interpretation the equivalence relation serve
|
||||||
|
as a sort of ``local'' propositional equality. Since the developer
|
||||||
|
gets to pick this relation, it is not a~priori a congruence
|
||||||
|
relation. It must be manually verified by the developer. Furthermore,
|
||||||
|
functions between different setoids must be shown to be setoid
|
||||||
|
homomorphism, that is; they preserve the relation.
|
||||||
|
|
||||||
|
This approach has other drawbacks: It does not satisfy all
|
||||||
|
propositional equalities of type theory a~priori. That is, the
|
||||||
|
developer must manually show that e.g.\ the relation is a congruence.
|
||||||
|
Equational proofs $a \sim_{X} b$ are in some sense `local' to the
|
||||||
|
extensional set $(X , \sim)$. To e.g.\ prove that $x ∼ y → f\ x ∼
|
||||||
|
f\ y$ for some function $f \tp A → B$ between two extensional sets $A$
|
||||||
|
and $B$ it must be shown that $f$ is a groupoid homomorphism. This
|
||||||
|
makes it very cumbersome to work with in practice (\cite[p.
|
||||||
|
4]{huber-2016}).
|
||||||
|
|
||||||
|
\section{Conventions}
|
||||||
|
In the remainder of this thesis I will use the term \nomenindex{Type}
|
||||||
|
to describe -- well -- types; thereby departing from the notation in
|
||||||
|
Agda where the keyword \texttt{Set} refers to types.
|
||||||
|
\nomenindex{Set}, on the other hand, shall refer to the homotopical
|
||||||
|
notion of a set. I will also leave all universe levels implicit. This
|
||||||
|
of course does not mean that a statement such as $\MCU \tp \MCU$ means
|
||||||
|
that we have type-in-type but rather that the arguments to the
|
||||||
|
universes are implicit.
|
||||||
|
|
||||||
|
I use the term \nomenindex{arrow} to refer to morphisms in a category,
|
||||||
|
whereas the terms \nomenindex{morphism}, \nomenindex{map} or
|
||||||
|
\nomenindex{function} shall be reserved for talking about type
|
||||||
|
theoretic functions; i.e.\ functions in Agda.
|
||||||
|
|
||||||
|
As already noted $\defeq$ will be used for introducing definitions $=$
|
||||||
|
will be used to for judgmental equality and $\equiv$ will be used for
|
||||||
|
propositional equality.
|
||||||
|
|
||||||
|
All this is summarized in the following table:
|
||||||
|
%
|
||||||
|
\begin{samepage}
|
||||||
|
\begin{center}
|
||||||
|
\begin{tabular}{ c c c }
|
||||||
|
Name & Agda & Notation \\
|
||||||
|
\hline
|
||||||
|
|
||||||
|
\varindex{Type} & \texttt{Set} & $\Type$ \\
|
||||||
|
|
||||||
|
\varindex{Set} & \texttt{Σ Set IsSet} & $\Set$ \\
|
||||||
|
Function, morphism, map & \texttt{A → B} & $A → B$ \\
|
||||||
|
Dependent- ditto & \texttt{(a : A) → B} & $∏_{a \tp A} B$ \\
|
||||||
|
|
||||||
|
\varindex{Arrow} & \texttt{Arrow A B} & $\Arrow\ A\ B$ \\
|
||||||
|
|
||||||
|
\varindex{Object} & \texttt{C.Object} & $̱ℂ.Object$ \\
|
||||||
|
Definition & \texttt{=} & $̱\defeq$ \\
|
||||||
|
Judgmental equality & \null & $̱=$ \\
|
||||||
|
Propositional equality & \null & $̱\equiv$
|
||||||
|
\end{tabular}
|
||||||
|
\end{center}
|
||||||
|
\end{samepage}
|
147
doc/macros.tex
Normal file
147
doc/macros.tex
Normal file
|
@ -0,0 +1,147 @@
|
||||||
|
\newcommand{\subsubsubsection}[1]{\textbf{#1}}
|
||||||
|
\newcommand{\WIP}{\textbf{WIP}}
|
||||||
|
|
||||||
|
\newcommand{\coloneqq}{\mathrel{\vcenter{\baselineskip0.5ex \lineskiplimit0pt
|
||||||
|
\hbox{\scriptsize.}\hbox{\scriptsize.}}}%
|
||||||
|
=}
|
||||||
|
|
||||||
|
\newcommand{\defeq}{\mathrel{\triangleq}}
|
||||||
|
%% Alternatively:
|
||||||
|
%% \newcommand{\defeq}{≔}
|
||||||
|
\newcommand{\bN}{\mathbb{N}}
|
||||||
|
\newcommand{\bC}{ℂ}
|
||||||
|
\newcommand{\bD}{𝔻}
|
||||||
|
\newcommand{\bX}{𝕏}
|
||||||
|
% \newcommand{\to}{\rightarrow}
|
||||||
|
%% \newcommand{\mto}{\mapsto}
|
||||||
|
\newcommand{\mto}{\rightarrow}
|
||||||
|
\newcommand{\UU}{\ensuremath{\mathcal{U}}\xspace}
|
||||||
|
\let\type\UU
|
||||||
|
\newcommand{\MCU}{\UU}
|
||||||
|
\newcommand{\todo}[1]{\textit{#1}}
|
||||||
|
\newcommand{\comp}{\circ}
|
||||||
|
\newcommand{\x}{\times}
|
||||||
|
\newcommand\inv[1]{#1\raisebox{1.15ex}{$\scriptscriptstyle-\!1$}}
|
||||||
|
\newcommand{\tp}{\mathrel{:}}
|
||||||
|
\newcommand{\Type}{\mathcal{U}}
|
||||||
|
|
||||||
|
\usepackage{graphicx}
|
||||||
|
\makeatletter
|
||||||
|
\newcommand{\shorteq}{%
|
||||||
|
\settowidth{\@tempdima}{-}% Width of hyphen
|
||||||
|
\resizebox{\@tempdima}{\height}{=}%
|
||||||
|
}
|
||||||
|
\makeatother
|
||||||
|
\newcommand{\var}[1]{\ensuremath{\mathit{#1}}}
|
||||||
|
\newcommand{\varindex}[1]{\ensuremath{\var{#1}}\index{$\var{#1}$}}
|
||||||
|
\newcommand{\nomen}[2]{\emph{#1}\index{#2}}
|
||||||
|
\newcommand{\nomenindex}[1]{\nomen{#1}{#1}}
|
||||||
|
|
||||||
|
\newcommand{\Hom}{\varindex{Hom}}
|
||||||
|
\newcommand{\fmap}{\varindex{fmap}}
|
||||||
|
\newcommand{\bind}{\varindex{bind}}
|
||||||
|
\newcommand{\join}{\varindex{join}}
|
||||||
|
\newcommand{\omap}{\varindex{omap}}
|
||||||
|
\newcommand{\pure}{\varindex{pure}}
|
||||||
|
\newcommand{\idFun}{\varindex{id}}
|
||||||
|
\newcommand{\Sets}{\varindex{Sets}}
|
||||||
|
\newcommand{\Set}{\varindex{Set}}
|
||||||
|
\newcommand{\hSet}{\varindex{hSet}}
|
||||||
|
\newcommand{\id}{\varindex{id}}
|
||||||
|
\newcommand{\isEquiv}{\varindex{isEquiv}}
|
||||||
|
\newcommand{\idToIso}{\varindex{idToIso}}
|
||||||
|
\newcommand{\idIso}{\varindex{idIso}}
|
||||||
|
\newcommand{\isSet}{\varindex{isSet}}
|
||||||
|
\newcommand{\isContr}{\varindex{isContr}}
|
||||||
|
\newcommand{\isGroupoid}{\varindex{isGroupoid}}
|
||||||
|
\newcommand{\pathJ}{\varindex{pathJ}}
|
||||||
|
\newcommand\Object{\varindex{Object}}
|
||||||
|
\newcommand\Functor{\varindex{Functor}}
|
||||||
|
\newcommand\isProp{\varindex{isProp}}
|
||||||
|
\newcommand\propPi{\varindex{propPi}}
|
||||||
|
\newcommand\propSig{\varindex{propSig}}
|
||||||
|
\newcommand\PreCategory{\varindex{PreCategory}}
|
||||||
|
\newcommand\IsPreCategory{\varindex{IsPreCategory}}
|
||||||
|
\newcommand\isIdentity{\varindex{isIdentity}}
|
||||||
|
\newcommand\propIsIdentity{\varindex{propIsIdentity}}
|
||||||
|
\newcommand\IsCategory{\varindex{IsCategory}}
|
||||||
|
\newcommand\Gl{\varindex{\lambda}}
|
||||||
|
\newcommand\lemPropF{\varindex{lemPropF}}
|
||||||
|
\newcommand\isPreCategory{\varindex{isPreCategory}}
|
||||||
|
\newcommand\congruence{\varindex{cong}}
|
||||||
|
\newcommand\identity{\varindex{identity}}
|
||||||
|
\newcommand\isequiv{\varindex{isequiv}}
|
||||||
|
\newcommand\qinv{\varindex{qinv}}
|
||||||
|
\newcommand\fiber{\varindex{fiber}}
|
||||||
|
\newcommand\shufflef{\varindex{shuffle}}
|
||||||
|
\newcommand\Univalent{\varindex{Univalent}}
|
||||||
|
\newcommand\refl{\varindex{refl}}
|
||||||
|
\newcommand\isoToId{\varindex{isoToId}}
|
||||||
|
\newcommand\Isomorphism{\varindex{Isomorphism}}
|
||||||
|
\newcommand\rrr{\ggg}
|
||||||
|
%% \newcommand\fish{\mathbin{↣}}
|
||||||
|
%% \newcommand\fish{\mathbin{⤅}}
|
||||||
|
\newcommand\fish{\mathbin{⤇}}
|
||||||
|
%% \newcommand\fish{\mathbin{⤜}}
|
||||||
|
%% \newcommand\fish{\mathrel{\wideoverbar{\rrr}}}
|
||||||
|
\newcommand\fst{\varindex{fst}}
|
||||||
|
\newcommand\snd{\varindex{snd}}
|
||||||
|
\newcommand\Path{\varindex{Path}}
|
||||||
|
\newcommand\Category{\varindex{Category}}
|
||||||
|
\newcommand\TODO[1]{TODO: \emph{#1}}
|
||||||
|
\newcommand*{\QED}{\hfill\ensuremath{\square}}%
|
||||||
|
\newcommand\uexists{\exists!}
|
||||||
|
\newcommand\Arrow{\varindex{Arrow}}
|
||||||
|
\newcommand\embellish[1]{\widehat{#1}}
|
||||||
|
\newcommand\nattrans[1]{\embellish{#1}}
|
||||||
|
\newcommand\functor[1]{\embellish{#1}}
|
||||||
|
\newcommand\NTsym{\varindex{NT}}
|
||||||
|
\newcommand\NT[2]{\NTsym\ #1\ #2}
|
||||||
|
\newcommand\Endo[1]{\varindex{Endo}\ #1}
|
||||||
|
\newcommand\EndoR{\functor{\mathcal{R}}}
|
||||||
|
\newcommand\omapR{\mathcal{R}}
|
||||||
|
\newcommand\omapF{\mathcal{F}}
|
||||||
|
\newcommand\omapG{\mathcal{G}}
|
||||||
|
\newcommand\FunF{\functor{\omapF}}
|
||||||
|
\newcommand\FunG{\functor{\omapG}}
|
||||||
|
\newcommand\funExt{\varindex{funExt}}
|
||||||
|
\newcommand{\suc}[1]{\varindex{suc}\ #1}
|
||||||
|
\newcommand{\trans}{\varindex{trans}}
|
||||||
|
\newcommand{\toKleisli}{\varindex{toKleisli}}
|
||||||
|
\newcommand{\toMonoidal}{\varindex{toMonoidal}}
|
||||||
|
\newcommand\pairA{\mathcal{A}}
|
||||||
|
\newcommand\pairB{\mathcal{B}}
|
||||||
|
\newcommand{\joinNT}{\functor{\varindex{join}}}
|
||||||
|
\newcommand{\pureNT}{\functor{\varindex{pure}}}
|
||||||
|
\newcommand{\hrefsymb}[2]{\href{#1}{#2 \ExternalLink}}
|
||||||
|
\newcommand{\sourcebasepath}{http://web.student.chalmers.se/\textasciitilde hanghj/cat/doc/html/}
|
||||||
|
\newcommand{\docbasepath}{https://github.com/fredefox/cat/}
|
||||||
|
\newcommand{\sourcelink}[1]{\hrefsymb
|
||||||
|
{\sourcebasepath#1.html}
|
||||||
|
{\texttt{#1}}
|
||||||
|
}
|
||||||
|
\newcommand{\gitlink}{\hrefsymb{\docbasepath}{\texttt{\docbasepath}}}
|
||||||
|
\newcommand{\doclink}{\hrefsymb{\sourcebasepath}{\texttt{\sourcebasepath}}}
|
||||||
|
\newcommand{\clll}{\mathrel{\bC.\mathord{\lll}}}
|
||||||
|
\newcommand{\dlll}{\mathrel{\bD.\mathord{\lll}}}
|
||||||
|
\newcommand\coe{\varindex{coe}}
|
||||||
|
\newcommand\Monoidal{\varindex{Monoidal}}
|
||||||
|
\newcommand\Kleisli{\varindex{Kleisli}}
|
||||||
|
\newcommand\I{\mathds{I}}
|
||||||
|
|
||||||
|
\makeatletter
|
||||||
|
\DeclareRobustCommand\bigop[1]{%
|
||||||
|
\mathop{\vphantom{\sum}\mathpalette\bigop@{#1}}\slimits@
|
||||||
|
}
|
||||||
|
\newcommand{\bigop@}[2]{%
|
||||||
|
\vcenter{%
|
||||||
|
\sbox\z@{$#1\sum$}%
|
||||||
|
\hbox{\resizebox{\ifx#1\displaystyle.7\fi\dimexpr\ht\z@+\dp\z@}{!}{$\m@th#2$}}%
|
||||||
|
}%
|
||||||
|
}
|
||||||
|
\makeatother
|
||||||
|
|
||||||
|
\renewcommand{\llll}{\mathbin{\bigop{\lll}}}
|
||||||
|
\renewcommand{\rrrr}{\mathbin{\bigop{\rrr}}}
|
||||||
|
%% \newcommand{\llll}{lll}
|
||||||
|
%% \newcommand{\rrrr}{rrr}
|
76
doc/main.tex
Normal file
76
doc/main.tex
Normal file
|
@ -0,0 +1,76 @@
|
||||||
|
\documentclass[a4paper]{report}
|
||||||
|
%% \documentclass[tightpage]{preview}
|
||||||
|
%% \documentclass[compact,a4paper]{article}
|
||||||
|
|
||||||
|
\input{packages.tex}
|
||||||
|
\input{macros.tex}
|
||||||
|
|
||||||
|
\title{Univalent Categories}
|
||||||
|
\author{Frederik Hanghøj Iversen}
|
||||||
|
|
||||||
|
%% \usepackage[
|
||||||
|
%% subtitle=foo,
|
||||||
|
%% author=Frederik Hanghøj Iversen,
|
||||||
|
%% authoremail=hanghj@student.chalmers.se,
|
||||||
|
%% newcommand=chalmers,=Chalmers University of Technology,
|
||||||
|
%% supervisor=Thierry Coquand,
|
||||||
|
%% supervisoremail=coquand@chalmers.se,
|
||||||
|
%% supervisordepartment=chalmers,
|
||||||
|
%% cosupervisor=Andrea Vezzosi,
|
||||||
|
%% cosupervisoremail=vezzosi@chalmers.se,
|
||||||
|
%% cosupervisordepartment=chalmers,
|
||||||
|
%% examiner=Andreas Abel,
|
||||||
|
%% examineremail=abela@chalmers.se,
|
||||||
|
%% examinerdepartment=chalmers,
|
||||||
|
%% institution=chalmers,
|
||||||
|
%% department=Department of Computer Science and Engineering,
|
||||||
|
%% researchgroup=Programming Logic Group
|
||||||
|
%% ]{chalmerstitle}
|
||||||
|
|
||||||
|
\usepackage{chalmerstitle}
|
||||||
|
\subtitle{A formalization of category theory in Cubical Agda}
|
||||||
|
\authoremail{hanghj@student.chalmers.se}
|
||||||
|
\newcommand{\chalmers}{Chalmers University of Technology and University of Gothenburg}
|
||||||
|
\supervisor{Thierry Coquand}
|
||||||
|
\supervisoremail{coquand@chalmers.se}
|
||||||
|
\supervisordepartment{\chalmers}
|
||||||
|
\cosupervisor{Andrea Vezzosi}
|
||||||
|
\cosupervisoremail{vezzosi@chalmers.se}
|
||||||
|
\cosupervisordepartment{\chalmers}
|
||||||
|
\examiner{Andreas Abel}
|
||||||
|
\examineremail{abela@chalmers.se}
|
||||||
|
\examinerdepartment{\chalmers}
|
||||||
|
\institution{\chalmers}
|
||||||
|
\department{Department of Computer Science and Engineering}
|
||||||
|
\researchgroup{Programming Logic Group}
|
||||||
|
|
||||||
|
\begin{document}
|
||||||
|
|
||||||
|
\frontmatter
|
||||||
|
\myfrontmatter
|
||||||
|
\maketitle
|
||||||
|
\input{abstract.tex}
|
||||||
|
\input{acknowledgements.tex}
|
||||||
|
\tableofcontents
|
||||||
|
\mainmatter
|
||||||
|
%
|
||||||
|
\input{introduction.tex}
|
||||||
|
\input{cubical.tex}
|
||||||
|
\input{implementation.tex}
|
||||||
|
\input{discussion.tex}
|
||||||
|
\input{conclusion.tex}
|
||||||
|
|
||||||
|
\nocite{cubical-demo}
|
||||||
|
\nocite{coquand-2013}
|
||||||
|
|
||||||
|
\bibliography{refs}
|
||||||
|
\begin{appendices}
|
||||||
|
\setcounter{page}{1}
|
||||||
|
\pagenumbering{roman}
|
||||||
|
\input{appendix/abstract-funext.tex}
|
||||||
|
%% \input{sources.tex}
|
||||||
|
%% \input{planning.tex}
|
||||||
|
%% \input{halftime.tex}
|
||||||
|
\end{appendices}
|
||||||
|
\printindex
|
||||||
|
\end{document}
|
151
doc/packages.tex
Normal file
151
doc/packages.tex
Normal file
|
@ -0,0 +1,151 @@
|
||||||
|
\usepackage[utf8]{inputenc}
|
||||||
|
|
||||||
|
\usepackage{natbib}
|
||||||
|
\bibliographystyle{plain}
|
||||||
|
|
||||||
|
\usepackage{xcolor}
|
||||||
|
%% \mode<report>{
|
||||||
|
\usepackage[
|
||||||
|
%% hidelinks,
|
||||||
|
pdfusetitle,
|
||||||
|
pdfsubject={category theory},
|
||||||
|
pdfkeywords={type theory, homotopy theory, category theory, agda}]
|
||||||
|
{hyperref}
|
||||||
|
%% }
|
||||||
|
%% \definecolor{darkorange}{HTML}{ff8c00}
|
||||||
|
%% \hypersetup{allbordercolors={darkorange}}
|
||||||
|
\hypersetup{hidelinks}
|
||||||
|
\usepackage{graphicx}
|
||||||
|
%% \usepackage[active,tightpage]{preview}
|
||||||
|
|
||||||
|
\usepackage{parskip}
|
||||||
|
\usepackage{multicol}
|
||||||
|
\usepackage{amssymb,amsmath,amsthm,stmaryrd,mathrsfs,wasysym}
|
||||||
|
\usepackage[toc,page]{appendix}
|
||||||
|
\usepackage{xspace}
|
||||||
|
\usepackage[paper=a4paper,top=3cm,bottom=3cm]{geometry}
|
||||||
|
\usepackage{makeidx}
|
||||||
|
\makeindex
|
||||||
|
% \setlength{\parskip}{10pt}
|
||||||
|
|
||||||
|
% \usepackage{tikz}
|
||||||
|
% \usetikzlibrary{arrows, decorations.markings}
|
||||||
|
|
||||||
|
% \usepackage{chngcntr}
|
||||||
|
% \counterwithout{figure}{section}
|
||||||
|
\numberwithin{equation}{section}
|
||||||
|
|
||||||
|
\usepackage{listings}
|
||||||
|
\usepackage{fancyvrb}
|
||||||
|
|
||||||
|
\usepackage{mathpazo}
|
||||||
|
\usepackage[scaled=0.95]{helvet}
|
||||||
|
\usepackage{courier}
|
||||||
|
\linespread{1.05} % Palatino looks better with this
|
||||||
|
|
||||||
|
\usepackage{lmodern}
|
||||||
|
|
||||||
|
\usepackage{enumerate}
|
||||||
|
\usepackage{verbatim}
|
||||||
|
|
||||||
|
\usepackage{fontspec}
|
||||||
|
\usepackage[light]{sourcecodepro}
|
||||||
|
%% \setmonofont{Latin Modern Mono}
|
||||||
|
%% \setmonofont[Mapping=tex-text]{FreeMono.otf}
|
||||||
|
%% \setmonofont{FreeMono.otf}
|
||||||
|
|
||||||
|
|
||||||
|
%% \pagestyle{fancyplain}
|
||||||
|
\setlength{\headheight}{15pt}
|
||||||
|
\renewcommand{\chaptermark}[1]{\markboth{\textsc{Chapter \thechapter. #1}}{}}
|
||||||
|
\renewcommand{\sectionmark}[1]{\markright{\textsc{\thesection\ #1}}}
|
||||||
|
|
||||||
|
% Allows for the use of unicode-letters:
|
||||||
|
\usepackage{unicode-math}
|
||||||
|
|
||||||
|
%% \RequirePackage{kvoptions}
|
||||||
|
|
||||||
|
\usepackage{pgffor}
|
||||||
|
\lstset
|
||||||
|
{basicstyle=\ttfamily
|
||||||
|
,columns=fullflexible
|
||||||
|
,breaklines=true
|
||||||
|
,inputencoding=utf8
|
||||||
|
,extendedchars=true
|
||||||
|
%% ,literate={á}{{\'a}}1 {ã}{{\~a}}1 {é}{{\'e}}1
|
||||||
|
}
|
||||||
|
|
||||||
|
\usepackage{newunicodechar}
|
||||||
|
|
||||||
|
%% \setmainfont{PT Serif}
|
||||||
|
\newfontfamily{\fallbackfont}{FreeMono.otf}[Scale=MatchLowercase]
|
||||||
|
%% \setmonofont[Mapping=tex-text]{FreeMono.otf}
|
||||||
|
\DeclareTextFontCommand{\textfallback}{\fallbackfont}
|
||||||
|
\newunicodechar{∨}{\textfallback{∨}}
|
||||||
|
\newunicodechar{∧}{\textfallback{∧}}
|
||||||
|
\newunicodechar{⊔}{\textfallback{⊔}}
|
||||||
|
%% \newunicodechar{≊}{\textfallback{≊}}
|
||||||
|
\newunicodechar{∈}{\textfallback{∈}}
|
||||||
|
\newunicodechar{ℂ}{\textfallback{ℂ}}
|
||||||
|
\newunicodechar{∘}{\textfallback{∘}}
|
||||||
|
\newunicodechar{⟨}{\textfallback{⟨}}
|
||||||
|
\newunicodechar{⟩}{\textfallback{⟩}}
|
||||||
|
\newunicodechar{∎}{\textfallback{∎}}
|
||||||
|
%% \newunicodechar{𝒜}{\textfallback{𝒜}}
|
||||||
|
%% \newunicodechar{ℬ}{\textfallback{ℬ}}
|
||||||
|
%% \newunicodechar{≊}{\textfallback{≊}}
|
||||||
|
\makeatletter
|
||||||
|
\newcommand*{\rom}[1]{\expandafter\@slowroman\romannumeral #1@}
|
||||||
|
\makeatother
|
||||||
|
\makeatletter
|
||||||
|
|
||||||
|
\newcommand\frontmatter{%
|
||||||
|
\cleardoublepage
|
||||||
|
%\@mainmatterfalse
|
||||||
|
\pagenumbering{roman}}
|
||||||
|
|
||||||
|
\newcommand\mainmatter{%
|
||||||
|
\cleardoublepage
|
||||||
|
% \@mainmattertrue
|
||||||
|
\pagenumbering{arabic}}
|
||||||
|
|
||||||
|
\newcommand\backmatter{%
|
||||||
|
\if@openright
|
||||||
|
\cleardoublepage
|
||||||
|
\else
|
||||||
|
\clearpage
|
||||||
|
\fi
|
||||||
|
% \@mainmatterfalse
|
||||||
|
}
|
||||||
|
|
||||||
|
\makeatother
|
||||||
|
\usepackage{xspace}
|
||||||
|
\usepackage{tikz}
|
||||||
|
\newcommand{\ExternalLink}{%
|
||||||
|
\tikz[x=1.2ex, y=1.2ex, baseline=-0.05ex]{%
|
||||||
|
\begin{scope}[x=1ex, y=1ex]
|
||||||
|
\clip (-0.1,-0.1)
|
||||||
|
--++ (-0, 1.2)
|
||||||
|
--++ (0.6, 0)
|
||||||
|
--++ (0, -0.6)
|
||||||
|
--++ (0.6, 0)
|
||||||
|
--++ (0, -1);
|
||||||
|
\path[draw,
|
||||||
|
line width = 0.5,
|
||||||
|
rounded corners=0.5]
|
||||||
|
(0,0) rectangle (1,1);
|
||||||
|
\end{scope}
|
||||||
|
\path[draw, line width = 0.5] (0.5, 0.5)
|
||||||
|
-- (1, 1);
|
||||||
|
\path[draw, line width = 0.5] (0.6, 1)
|
||||||
|
-- (1, 1) -- (1, 0.6);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\usepackage{ dsfont }
|
||||||
|
|
||||||
|
\usepackage{eso-pic}
|
||||||
|
\newcommand{\backgroundpic}[3]{
|
||||||
|
\put(#1,#2){
|
||||||
|
\parbox[b][\paperheight]{\paperwidth}{
|
||||||
|
\centering
|
||||||
|
\includegraphics[width=\paperwidth,height=\paperheight,keepaspectratio]{#3}}}}
|
|
@ -1,4 +1,4 @@
|
||||||
\section{Planning report}
|
\chapter{Planning report}
|
||||||
%
|
%
|
||||||
I have already implemented multiple essential building blocks for a
|
I have already implemented multiple essential building blocks for a
|
||||||
formalization of core-category theory. These concepts include:
|
formalization of core-category theory. These concepts include:
|
492
doc/presentation.tex
Normal file
492
doc/presentation.tex
Normal file
|
@ -0,0 +1,492 @@
|
||||||
|
\documentclass[a4paper]{beamer}
|
||||||
|
%% \documentclass[a4paper,handout]{beamer}
|
||||||
|
%% \usecolortheme[named=seagull]{structure}
|
||||||
|
|
||||||
|
\input{packages.tex}
|
||||||
|
|
||||||
|
\input{macros.tex}
|
||||||
|
|
||||||
|
\title{Univalent Categories}
|
||||||
|
\subtitle{A formalization of category theory in Cubical Agda}
|
||||||
|
|
||||||
|
\newcommand{\myname}{Frederik Hangh{\o}j Iversen}
|
||||||
|
\author[\myname]{
|
||||||
|
\myname\\
|
||||||
|
\footnotesize Supervisors: Thierry Coquand, Andrea Vezzosi\\
|
||||||
|
Examiner: Andreas Abel
|
||||||
|
}
|
||||||
|
\institute{Chalmers University of Technology}
|
||||||
|
|
||||||
|
\begin{document}
|
||||||
|
|
||||||
|
\frame{\titlepage}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Introduction}
|
||||||
|
Category Theory: The study of abstract functions. Slogan: ``It's the
|
||||||
|
arrows that matter''\pause
|
||||||
|
|
||||||
|
Objects are equal ``up to isomorphism''. Univalence makes this notion
|
||||||
|
precise.\pause
|
||||||
|
|
||||||
|
Agda does not permit proofs of univalence. Cubical Agda admits
|
||||||
|
this.\pause
|
||||||
|
|
||||||
|
Goal: Construct a category whose terminal objects are (equivalent to)
|
||||||
|
products. Use this to conclude that products are propositions, not a
|
||||||
|
structure on a category.
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Outline}
|
||||||
|
The path type
|
||||||
|
|
||||||
|
Definition of a (pre-) category
|
||||||
|
|
||||||
|
1-categories
|
||||||
|
|
||||||
|
Univalent (proper) categories
|
||||||
|
|
||||||
|
The category of spans
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\section{Paths}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Paths}
|
||||||
|
\framesubtitle{Definition}
|
||||||
|
Heterogeneous paths
|
||||||
|
\begin{equation*}
|
||||||
|
\Path \tp (P \tp \I → \MCU) → P\ 0 → P\ 1 → \MCU
|
||||||
|
\end{equation*}
|
||||||
|
\pause
|
||||||
|
For $P \tp \I → \MCU$ and $a_0 \tp P\ 0$, $a_1 \tp P\ 1$
|
||||||
|
inhabitants of $\Path\ P\ a_0\ a_1$ are like functions
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p \tp ∏_{i \tp \I} P\ i
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
Which satisfy $p\ 0 & = a_0$ and $p\ 1 & = a_1$
|
||||||
|
\pause
|
||||||
|
|
||||||
|
Homogenous paths
|
||||||
|
$$
|
||||||
|
a_0 ≡ a_1 ≜ \Path\ (\var{const}\ A)\ a_0\ a_1
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Pre categories}
|
||||||
|
\framesubtitle{Definition}
|
||||||
|
Data:
|
||||||
|
\begin{align*}
|
||||||
|
\Object & \tp \Type \\
|
||||||
|
\Arrow & \tp \Object → \Object → \Type \\
|
||||||
|
\identity & \tp \Arrow\ A\ A \\
|
||||||
|
\llll & \tp \Arrow\ B\ C → \Arrow\ A\ B → \Arrow\ A\ C
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
Laws:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\var{isAssociative} & \tp
|
||||||
|
h \llll (g \llll f) ≡ (h \llll g) \llll f \\
|
||||||
|
\var{isIdentity} & \tp
|
||||||
|
(\identity \llll f ≡ f)
|
||||||
|
×
|
||||||
|
(f \llll \identity ≡ f)
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Pre categories}
|
||||||
|
\framesubtitle{1-categories}
|
||||||
|
Cubical Agda does not admit \emph{Uniqueness of Identity Proofs}
|
||||||
|
(UIP). Rather there is a hierarchy of \emph{Homotopy Types}:
|
||||||
|
Contractible types, mere propositions, sets, groupoids, \dots
|
||||||
|
|
||||||
|
\pause
|
||||||
|
1-categories:
|
||||||
|
$$
|
||||||
|
\isSet\ (\Arrow\ A\ B)
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
\begin{align*}
|
||||||
|
\isSet & \tp \MCU → \MCU \\
|
||||||
|
\isSet\ A & ≜ ∏_{a_0, a_1 \tp A} \isProp\ (a_0 ≡ a_1)
|
||||||
|
\end{align*}
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Outline}
|
||||||
|
The path type \ensuremath{\checkmark}
|
||||||
|
|
||||||
|
Definition of a (pre-) category \ensuremath{\checkmark}
|
||||||
|
|
||||||
|
1-categories \ensuremath{\checkmark}
|
||||||
|
|
||||||
|
Univalent (proper) categories
|
||||||
|
|
||||||
|
The category of spans
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Categories}
|
||||||
|
\framesubtitle{Univalence}
|
||||||
|
Let $\approxeq$ denote isomorphism of objects. We can then construct
|
||||||
|
the identity isomorphism in any category:
|
||||||
|
$$
|
||||||
|
(\identity , \identity , \var{isIdentity}) \tp A \approxeq A
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
Likewise since paths are substitutive we can promote a path to an isomorphism:
|
||||||
|
$$
|
||||||
|
\idToIso \tp A ≡ B → A ≊ B
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
For a category to be univalent we require this to be an equivalence:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\isEquiv\ (A ≡ B)\ (A \approxeq B)\ \idToIso
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Categories}
|
||||||
|
\framesubtitle{Univalence, cont'd}
|
||||||
|
$$\isEquiv\ (A ≡ B)\ (A \approxeq B)\ \idToIso$$
|
||||||
|
\pause%
|
||||||
|
$$(A ≡ B) ≃ (A \approxeq B)$$
|
||||||
|
\pause%
|
||||||
|
$$(A ≡ B) ≅ (A \approxeq B)$$
|
||||||
|
\pause%
|
||||||
|
Name the inverse of $\idToIso$:
|
||||||
|
$$\isoToId \tp (A \approxeq B) → (A ≡ B)$$
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Propositionality of products}
|
||||||
|
Construct a category for which it is the case that the terminal
|
||||||
|
objects are equivalent to products:
|
||||||
|
\begin{align*}
|
||||||
|
\var{Terminal} ≃ \var{Product}\ ℂ\ 𝒜\ ℬ
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
\pause
|
||||||
|
And since equivalences preserve homotopy levels we get:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\isProp\ \left(\var{Product}\ \bC\ 𝒜\ ℬ\right)
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Categories}
|
||||||
|
\framesubtitle{A theorem}
|
||||||
|
%
|
||||||
|
Let the isomorphism $(ι, \inv{ι}, \var{inv}) \tp A \approxeq B$.
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
The isomorphism induces the path
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p ≜ \isoToId\ (\iota, \inv{\iota}, \var{inv}) \tp A ≡ B
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
and consequently a path on arrows:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p_{\var{dom}} ≜ \congruence\ (λ x → \Arrow\ x\ X)\ p
|
||||||
|
\tp
|
||||||
|
\Arrow\ A\ X ≡ \Arrow\ B\ X
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
The proposition is:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
\label{eq:coeDom}
|
||||||
|
\tag{$\var{coeDom}$}
|
||||||
|
∏_{f \tp A → X}
|
||||||
|
\var{coe}\ p_{\var{dom}}\ f ≡ f \llll \inv{\iota}
|
||||||
|
\end{align}
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Categories}
|
||||||
|
\framesubtitle{A theorem, proof}
|
||||||
|
\begin{align*}
|
||||||
|
\var{coe}\ p_{\var{dom}}\ f
|
||||||
|
& ≡ f \llll (\idToIso\ p)_1 && \text{By path-induction} \\
|
||||||
|
& ≡ f \llll \inv{\iota}
|
||||||
|
&& \text{$\idToIso$ and $\isoToId$ are inverses}\\
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
Induction will be based at $A$. Let $\widetilde{B}$ and $\widetilde{p}
|
||||||
|
\tp A ≡ \widetilde{B}$ be given.
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
Define the family:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
D\ \widetilde{B}\ \widetilde{p} ≜
|
||||||
|
\var{coe}\ \widetilde{p}_{\var{dom}}\ f
|
||||||
|
≡
|
||||||
|
f \llll \inv{(\idToIso\ \widetilde{p})}
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
The base-case becomes:
|
||||||
|
$$
|
||||||
|
d \tp D\ A\ \refl =
|
||||||
|
\left(\var{coe}\ \refl_{\var{dom}}\ f ≡ f \llll \inv{(\idToIso\ \refl)}\right)
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Categories}
|
||||||
|
\framesubtitle{A theorem, proof, cont'd}
|
||||||
|
$$
|
||||||
|
d \tp
|
||||||
|
\var{coe}\ \refl_{\var{dom}}\ f ≡ f \llll \inv{(\idToIso\ \refl)}
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
\begin{align*}
|
||||||
|
\var{coe}\ \refl_{\var{dom}}\ f
|
||||||
|
& =
|
||||||
|
\var{coe}\ \refl\ f \\
|
||||||
|
& ≡ f
|
||||||
|
&& \text{neutral element for $\var{coe}$}\\
|
||||||
|
& ≡ f \llll \identity \\
|
||||||
|
& ≡ f \llll \var{subst}\ \refl\ \identity
|
||||||
|
&& \text{neutral element for $\var{subst}$}\\
|
||||||
|
& ≡ f \llll \inv{(\idToIso\ \refl)}
|
||||||
|
&& \text{By definition of $\idToIso$}\\
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
In conclusion, the theorem is inhabited by:
|
||||||
|
$$
|
||||||
|
\var{pathInd}\ D\ d\ B\ p
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Span category} \framesubtitle{Definition} Given a base
|
||||||
|
category $\bC$ and two objects in this category $\pairA$ and $\pairB$
|
||||||
|
we can construct the \nomenindex{span category}:
|
||||||
|
%
|
||||||
|
\pause
|
||||||
|
Objects:
|
||||||
|
$$
|
||||||
|
∑_{X \tp Object} (\Arrow\ X\ \pairA) × (\Arrow\ X\ \pairB)
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
Arrows between objects $(A , a_{\pairA} , a_{\pairB})$ and
|
||||||
|
$(B , b_{\pairA} , b_{\pairB})$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
∑_{f \tp \Arrow\ A\ B}
|
||||||
|
(b_{\pairA} \llll f ≡ a_{\pairA}) ×
|
||||||
|
(b_{\pairB} \llll f ≡ a_{\pairB})
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Span category}
|
||||||
|
\framesubtitle{Univalence}
|
||||||
|
\begin{align*}
|
||||||
|
(X , x_{𝒜} , x_{ℬ}) ≡ (Y , y_{𝒜} , y_{ℬ})
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
\begin{split}
|
||||||
|
p \tp & X ≡ Y \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (p\ i)\ 𝒜)\ x_{𝒜}\ y_{𝒜} \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (p\ i)\ ℬ)\ x_{ℬ}\ y_{ℬ}
|
||||||
|
\end{split}
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
\begin{split}
|
||||||
|
\var{iso} \tp & X \approxeq Y \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (\widetilde{p}\ i)\ 𝒜)\ x_{𝒜}\ y_{𝒜} \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (\widetilde{p}\ i)\ ℬ)\ x_{ℬ}\ y_{ℬ}
|
||||||
|
\end{split}
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
(X , x_{𝒜} , x_{ℬ}) ≊ (Y , y_{𝒜} , y_{ℬ})
|
||||||
|
\end{align*}
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Span category}
|
||||||
|
\framesubtitle{Univalence, proof}
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
%% (f, \inv{f}, \var{inv}_f, \var{inv}_{\inv{f}})
|
||||||
|
%% \tp
|
||||||
|
(X, x_{𝒜}, x_{ℬ}) \approxeq (Y, y_{𝒜}, y_{ℬ})
|
||||||
|
\to
|
||||||
|
\begin{split}
|
||||||
|
\var{iso} \tp & X \approxeq Y \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (\widetilde{p}\ i)\ 𝒜)\ x_{𝒜}\ y_{𝒜} \\
|
||||||
|
& \Path\ (λ i → \Arrow\ (\widetilde{p}\ i)\ ℬ)\ x_{ℬ}\ y_{ℬ}
|
||||||
|
\end{split}
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
Let $(f, \inv{f}, \var{inv}_f, \var{inv}_{\inv{f}})$ be an inhabitant
|
||||||
|
of the antecedent.\pause
|
||||||
|
|
||||||
|
Projecting out the first component gives us the isomorphism
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
(\fst\ f, \fst\ \inv{f}
|
||||||
|
, \congruence\ \fst\ \var{inv}_f
|
||||||
|
, \congruence\ \fst\ \var{inv}_{\inv{f}}
|
||||||
|
)
|
||||||
|
\tp X \approxeq Y
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
This gives rise to the following paths:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\begin{split}
|
||||||
|
\widetilde{p} & \tp X ≡ Y \\
|
||||||
|
\widetilde{p}_{𝒜} & \tp \Arrow\ X\ 𝒜 ≡ \Arrow\ Y\ 𝒜 \\
|
||||||
|
\end{split}
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Span category}
|
||||||
|
\framesubtitle{Univalence, proof, cont'd}
|
||||||
|
It remains to construct:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\begin{split}
|
||||||
|
& \Path\ (λ i → \widetilde{p}_{𝒜}\ i)\ x_{𝒜}\ y_{𝒜}
|
||||||
|
\end{split}
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
This is achieved with the following lemma:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
∏_{q \tp A ≡ B} \var{coe}\ q\ x_{𝒜} ≡ y_{𝒜}
|
||||||
|
→
|
||||||
|
\Path\ (λ i → q\ i)\ x_{𝒜}\ y_{𝒜}
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Which is used without proof.\pause
|
||||||
|
|
||||||
|
So the construction reduces to:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\var{coe}\ \widetilde{p}_{𝒜}\ x_{𝒜} ≡ y_{𝒜}
|
||||||
|
\end{align*}%
|
||||||
|
\pause%
|
||||||
|
This is proven with:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\var{coe}\ \widetilde{p}_{𝒜}\ x_{𝒜}
|
||||||
|
& ≡ x_{𝒜} \llll \fst\ \inv{f} && \text{\ref{eq:coeDom}} \\
|
||||||
|
& ≡ y_{𝒜} && \text{Property of span category}
|
||||||
|
\end{align*}
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Propositionality of products}
|
||||||
|
We have
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\isProp\ \var{Terminal}
|
||||||
|
$$\pause
|
||||||
|
%
|
||||||
|
We can show:
|
||||||
|
\begin{align*}
|
||||||
|
\var{Terminal} ≃ \var{Product}\ ℂ\ 𝒜\ ℬ
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
And since equivalences preserve homotopy levels we get:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\isProp\ \left(\var{Product}\ \bC\ 𝒜\ ℬ\right)
|
||||||
|
$$
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Monads}
|
||||||
|
\framesubtitle{Monoidal form}
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\EndoR & \tp \Functor\ ℂ\ ℂ \\
|
||||||
|
\pureNT
|
||||||
|
& \tp \NT{\widehat{\identity}}{\EndoR} \\
|
||||||
|
\joinNT
|
||||||
|
& \tp \NT{(\EndoR \oplus \EndoR)}{\EndoR}
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
Let $\fmap$ be the map on arrows of $\EndoR$.
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\join \llll \fmap\ \join
|
||||||
|
& ≡ \join \llll \join \\
|
||||||
|
\join \llll \pure\ & ≡ \identity \\
|
||||||
|
\join \llll \fmap\ \pure & ≡ \identity
|
||||||
|
\end{align*}
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Monads}
|
||||||
|
\framesubtitle{Kleisli form}
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\omapR & \tp \Object → \Object \\
|
||||||
|
\pure & \tp % ∏_{X \tp Object}
|
||||||
|
\Arrow\ X\ (\omapR\ X) \\
|
||||||
|
\bind & \tp
|
||||||
|
\Arrow\ X\ (\omapR\ Y)
|
||||||
|
\to
|
||||||
|
\Arrow\ (\omapR\ X)\ (\omapR\ Y)
|
||||||
|
\end{align*}\pause
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\fish & \tp
|
||||||
|
\Arrow\ A\ (\omapR\ B)
|
||||||
|
→
|
||||||
|
\Arrow\ B\ (\omapR\ C)
|
||||||
|
→
|
||||||
|
\Arrow\ A\ (\omapR\ C) \\
|
||||||
|
f \fish g & ≜ f \rrrr (\bind\ g)
|
||||||
|
\end{align*}
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
\bind\ \pure & ≡ \identity_{\omapR\ X} \\
|
||||||
|
\pure \fish f & ≡ f \\
|
||||||
|
(\bind\ f) \rrrr (\bind\ g) & ≡ \bind\ (f \fish g)
|
||||||
|
\end{align*}
|
||||||
|
\end{frame}
|
||||||
|
\begin{frame}
|
||||||
|
\frametitle{Monads}
|
||||||
|
\framesubtitle{Equivalence}
|
||||||
|
In the monoidal formulation we can define $\bind$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\bind\ f ≜ \join \llll \fmap\ f
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
%
|
||||||
|
And likewise in the Kleisli formulation we can define $\join$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\join ≜ \bind\ \identity
|
||||||
|
$$
|
||||||
|
\pause
|
||||||
|
The laws are logically equivalent. Since logical equivalence is
|
||||||
|
enough for as an equivalence of types for propositions we get:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\var{Monoidal} ≃ \var{Kleisli}
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\end{frame}
|
||||||
|
\end{document}
|
|
@ -106,9 +106,15 @@
|
||||||
@MISC{mo-formalizations,
|
@MISC{mo-formalizations,
|
||||||
TITLE = {Formalizations of category theory in proof assistants},
|
TITLE = {Formalizations of category theory in proof assistants},
|
||||||
AUTHOR = {Jason Gross},
|
AUTHOR = {Jason Gross},
|
||||||
HOWPUBLISHED = {MathOverflow},
|
|
||||||
NOTE = {Version: 2014-01-19},
|
NOTE = {Version: 2014-01-19},
|
||||||
year={2014},
|
year={2014},
|
||||||
EPRINT = {\url{https://mathoverflow.net/q/152497}},
|
EPRINT = {\url{https://mathoverflow.net/q/152497}},
|
||||||
URL = {https://mathoverflow.net/q/152497}
|
url = {https://mathoverflow.net/q/152497},
|
||||||
|
howpublished = {MathOverflow: \url{https://mathoverflow.net/q/152497}}
|
||||||
|
}
|
||||||
|
@Misc{UniMath,
|
||||||
|
author = {Voevodsky, Vladimir and Ahrens, Benedikt and Grayson, Daniel and others},
|
||||||
|
title = {{UniMath --- a computer-checked library of univalent mathematics}},
|
||||||
|
url = {https://github.com/UniMath/UniMath},
|
||||||
|
howpublished = {{available} at \url{https://github.com/UniMath/UniMath}}
|
||||||
}
|
}
|
429
doc/sources.tex
Normal file
429
doc/sources.tex
Normal file
|
@ -0,0 +1,429 @@
|
||||||
|
\chapter{Source code excerpts}
|
||||||
|
\label{ch:app-sources}
|
||||||
|
In the following a few of the definitions mentioned in the report are included.
|
||||||
|
The following is \emph{not} a verbatim copy of individual modules from the
|
||||||
|
implementation. Rather, this is a redacted and pre-formatted designed for
|
||||||
|
presentation purposes. Its provided here as a convenience. The actual sources
|
||||||
|
are the only authoritative source. Is something is not clear, please refer to
|
||||||
|
those.
|
||||||
|
\section{Cubical}
|
||||||
|
\label{sec:app-cubical}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\label{fig:path}
|
||||||
|
\begin{Verbatim}
|
||||||
|
postulate
|
||||||
|
PathP : ∀ {ℓ} (A : I → Set ℓ) → A i0 → A i1 → Set ℓ
|
||||||
|
|
||||||
|
module _ {ℓ} {A : Set ℓ} where
|
||||||
|
_≡_ : A → A → Set ℓ
|
||||||
|
_≡_ {A = A} = PathP (λ _ → A)
|
||||||
|
|
||||||
|
refl : {x : A} → x ≡ x
|
||||||
|
refl {x = x} = λ _ → x
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from the cubical library. Definition of the path-type.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {ℓ : Level} (A : Set ℓ) where
|
||||||
|
isContr : Set ℓ
|
||||||
|
isContr = Σ[ x ∈ A ] (∀ y → x ≡ y)
|
||||||
|
|
||||||
|
isProp : Set ℓ
|
||||||
|
isProp = (x y : A) → x ≡ y
|
||||||
|
|
||||||
|
isSet : Set ℓ
|
||||||
|
isSet = (x y : A) → (p q : x ≡ y) → p ≡ q
|
||||||
|
|
||||||
|
isGrpd : Set ℓ
|
||||||
|
isGrpd = (x y : A) → (p q : x ≡ y) → (a b : p ≡ q) → a ≡ b
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from the cubical library. Definition of the first few
|
||||||
|
homotopy-levels.}
|
||||||
|
\end{figure}
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {ℓ ℓ'} {A : Set ℓ} {x : A}
|
||||||
|
(P : ∀ y → x ≡ y → Set ℓ') (d : P x ((λ i → x))) where
|
||||||
|
pathJ : (y : A) → (p : x ≡ y) → P y p
|
||||||
|
pathJ _ p = transp (λ i → uncurry P (contrSingl p i)) d
|
||||||
|
\end{Verbatim}
|
||||||
|
\clearpage
|
||||||
|
\caption{Excerpt from the cubical library. Definition of based path-induction.}
|
||||||
|
\end{figure}
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {ℓ ℓ'} {A : Set ℓ} {B : A → Set ℓ'} where
|
||||||
|
propPi : (h : (x : A) → isProp (B x)) → isProp ((x : A) → B x)
|
||||||
|
propPi h f0 f1 = λ i → λ x → (h x (f0 x) (f1 x)) i
|
||||||
|
|
||||||
|
lemPropF : (P : (x : A) → isProp (B x)) {a0 a1 : A}
|
||||||
|
(p : a0 ≡ a1) {b0 : B a0} {b1 : B a1} → PathP (λ i → B (p i)) b0 b1
|
||||||
|
lemPropF P p {b0} {b1} = λ i → P (p i)
|
||||||
|
(primComp (λ j → B (p (i ∧ j)) ) (~ i) (λ _ → λ { (i = i0) → b0 }) b0)
|
||||||
|
(primComp (λ j → B (p (i ∨ ~ j)) ) (i) (λ _ → λ{ (i = i1) → b1 }) b1) i
|
||||||
|
|
||||||
|
lemSig : (pB : (x : A) → isProp (B x))
|
||||||
|
(u v : Σ A B) (p : fst u ≡ fst v) → u ≡ v
|
||||||
|
lemSig pB u v p = λ i → (p i) , ((lemPropF pB p) {snd u} {snd v} i)
|
||||||
|
|
||||||
|
propSig : (pA : isProp A) (pB : (x : A) → isProp (B x)) → isProp (Σ A B)
|
||||||
|
propSig pA pB t u = lemSig pB t u (pA (fst t) (fst u))
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from the cubical library. A few combinators.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
\section{Categories}
|
||||||
|
\label{sec:app-categories}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
Object : Set ℓa
|
||||||
|
Arrow : Object → Object → Set ℓb
|
||||||
|
identity : {A : Object} → Arrow A A
|
||||||
|
_<<<_ : {A B C : Object} → Arrow B C → Arrow A B → Arrow A C
|
||||||
|
|
||||||
|
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
||||||
|
f >>> g = g <<< f
|
||||||
|
|
||||||
|
IsAssociative : Set (ℓa ⊔ ℓb)
|
||||||
|
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
||||||
|
→ h <<< (g <<< f) ≡ (h <<< g) <<< f
|
||||||
|
|
||||||
|
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
||||||
|
IsIdentity id = {A B : Object} {f : Arrow A B}
|
||||||
|
→ id <<< f ≡ f × f <<< id ≡ f
|
||||||
|
|
||||||
|
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
||||||
|
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
||||||
|
|
||||||
|
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
||||||
|
IsInverseOf = λ f g → g <<< f ≡ identity × f <<< g ≡ identity
|
||||||
|
|
||||||
|
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
||||||
|
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
||||||
|
|
||||||
|
_≊_ : (A B : Object) → Set ℓb
|
||||||
|
_≊_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
||||||
|
|
||||||
|
IsTerminal : Object → Set (ℓa ⊔ ℓb)
|
||||||
|
IsTerminal T = {X : Object} → isContr (Arrow X T)
|
||||||
|
|
||||||
|
Terminal : Set (ℓa ⊔ ℓb)
|
||||||
|
Terminal = Σ Object IsTerminal
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category}. The definition of a category.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module Univalence (isIdentity : IsIdentity identity) where
|
||||||
|
idIso : (A : Object) → A ≊ A
|
||||||
|
idIso A = identity , identity , isIdentity
|
||||||
|
|
||||||
|
idToIso : (A B : Object) → A ≡ B → A ≊ B
|
||||||
|
idToIso A B eq = subst eq (idIso A)
|
||||||
|
|
||||||
|
Univalent : Set (ℓa ⊔ ℓb)
|
||||||
|
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category}. Continued from previous. Definition of univalence.}
|
||||||
|
\end{figure}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
|
record IsPreCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
open RawCategory ℂ public
|
||||||
|
field
|
||||||
|
isAssociative : IsAssociative
|
||||||
|
isIdentity : IsIdentity identity
|
||||||
|
arrowsAreSets : ArrowsAreSets
|
||||||
|
open Univalence isIdentity public
|
||||||
|
|
||||||
|
record PreCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
isPreCategory : IsPreCategory
|
||||||
|
open IsPreCategory isPreCategory public
|
||||||
|
|
||||||
|
record IsCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
isPreCategory : IsPreCategory
|
||||||
|
open IsPreCategory isPreCategory public
|
||||||
|
field
|
||||||
|
univalent : Univalent
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category}. Records with inhabitants for
|
||||||
|
the laws defined in the previous listings.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module Opposite {ℓa ℓb : Level} where
|
||||||
|
module _ (ℂ : Category ℓa ℓb) where
|
||||||
|
private
|
||||||
|
module _ where
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
opRaw : RawCategory ℓa ℓb
|
||||||
|
RawCategory.Object opRaw = ℂ.Object
|
||||||
|
RawCategory.Arrow opRaw = flip ℂ.Arrow
|
||||||
|
RawCategory.identity opRaw = ℂ.identity
|
||||||
|
RawCategory._<<<_ opRaw = ℂ._>>>_
|
||||||
|
|
||||||
|
open RawCategory opRaw
|
||||||
|
|
||||||
|
isPreCategory : IsPreCategory opRaw
|
||||||
|
IsPreCategory.isAssociative isPreCategory = sym ℂ.isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCategory = swap ℂ.isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = ℂ.arrowsAreSets
|
||||||
|
|
||||||
|
open IsPreCategory isPreCategory
|
||||||
|
|
||||||
|
----------------------------
|
||||||
|
-- NEXT LISTING GOES HERE --
|
||||||
|
----------------------------
|
||||||
|
|
||||||
|
isCategory : IsCategory opRaw
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory
|
||||||
|
= univalenceFromIsomorphism (isoToId* , inv)
|
||||||
|
|
||||||
|
opposite : Category ℓa ℓb
|
||||||
|
Category.raw opposite = opRaw
|
||||||
|
Category.isCategory opposite = isCategory
|
||||||
|
|
||||||
|
module _ {ℂ : Category ℓa ℓb} where
|
||||||
|
open Category ℂ
|
||||||
|
private
|
||||||
|
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
||||||
|
RawCategory.Object (rawInv _) = Object
|
||||||
|
RawCategory.Arrow (rawInv _) = Arrow
|
||||||
|
RawCategory.identity (rawInv _) = identity
|
||||||
|
RawCategory._<<<_ (rawInv _) = _<<<_
|
||||||
|
|
||||||
|
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
||||||
|
oppositeIsInvolution = Category≡ rawInv
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category}. Showing that the opposite
|
||||||
|
category is a category. Part of this listing has been cut out and placed in
|
||||||
|
the next listing.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
For reasons of formatting the following listing is continued from the above with
|
||||||
|
fewer levels of indentation.
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {A B : ℂ.Object} where
|
||||||
|
open Σ (toIso _ _ (ℂ.univalent {A} {B}))
|
||||||
|
renaming (fst to idToIso* ; snd to inv*)
|
||||||
|
open AreInverses {f = ℂ.idToIso A B} {idToIso*} inv*
|
||||||
|
|
||||||
|
shuffle : A ≊ B → A ℂ.≊ B
|
||||||
|
shuffle (f , g , inv) = g , f , inv
|
||||||
|
|
||||||
|
shuffle~ : A ℂ.≊ B → A ≊ B
|
||||||
|
shuffle~ (f , g , inv) = g , f , inv
|
||||||
|
|
||||||
|
isoToId* : A ≊ B → A ≡ B
|
||||||
|
isoToId* = idToIso* ∘ shuffle
|
||||||
|
|
||||||
|
inv : AreInverses (idToIso A B) isoToId*
|
||||||
|
inv =
|
||||||
|
( funExt (λ x → begin
|
||||||
|
(isoToId* ∘ idToIso A B) x
|
||||||
|
≡⟨⟩
|
||||||
|
(idToIso* ∘ shuffle ∘ idToIso A B) x
|
||||||
|
≡⟨ cong (λ φ → φ x)
|
||||||
|
(cong (λ φ → idToIso* ∘ shuffle ∘ φ) (funExt (isoEq refl))) ⟩
|
||||||
|
(idToIso* ∘ shuffle ∘ shuffle~ ∘ ℂ.idToIso A B) x
|
||||||
|
≡⟨⟩
|
||||||
|
(idToIso* ∘ ℂ.idToIso A B) x
|
||||||
|
≡⟨ (λ i → verso-recto i x) ⟩
|
||||||
|
x ∎)
|
||||||
|
, funExt (λ x → begin
|
||||||
|
(idToIso A B ∘ idToIso* ∘ shuffle) x
|
||||||
|
≡⟨ cong (λ φ → φ x)
|
||||||
|
(cong (λ φ → φ ∘ idToIso* ∘ shuffle) (funExt (isoEq refl))) ⟩
|
||||||
|
(shuffle~ ∘ ℂ.idToIso A B ∘ idToIso* ∘ shuffle) x
|
||||||
|
≡⟨ cong (λ φ → φ x)
|
||||||
|
(cong (λ φ → shuffle~ ∘ φ ∘ shuffle) recto-verso) ⟩
|
||||||
|
(shuffle~ ∘ shuffle) x
|
||||||
|
≡⟨⟩
|
||||||
|
x ∎)
|
||||||
|
)
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category}. Proving univalence for the opposite category.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
\section{Products}
|
||||||
|
\label{sec:app-products}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Category ℂ
|
||||||
|
|
||||||
|
module _ (A B : Object) where
|
||||||
|
record RawProduct : Set (ℓa ⊔ ℓb) where
|
||||||
|
no-eta-equality
|
||||||
|
field
|
||||||
|
object : Object
|
||||||
|
fst : ℂ [ object , A ]
|
||||||
|
snd : ℂ [ object , B ]
|
||||||
|
|
||||||
|
record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
|
||||||
|
open RawProduct raw public
|
||||||
|
field
|
||||||
|
ump : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
|
||||||
|
→ ∃![ f×g ] (ℂ [ fst ∘ f×g ] ≡ f P.× ℂ [ snd ∘ f×g ] ≡ g)
|
||||||
|
|
||||||
|
record Product : Set (ℓa ⊔ ℓb) where
|
||||||
|
field
|
||||||
|
raw : RawProduct
|
||||||
|
isProduct : IsProduct raw
|
||||||
|
|
||||||
|
open IsProduct isProduct public
|
||||||
|
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category.Product}. Definition of products.}
|
||||||
|
\end{figure}
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module _{ℓa ℓb : Level} {ℂ : Category ℓa ℓb}
|
||||||
|
(let module ℂ = Category ℂ) {A* B* : ℂ.Object} where
|
||||||
|
|
||||||
|
module _ where
|
||||||
|
raw : RawCategory _ _
|
||||||
|
raw = record
|
||||||
|
{ Object = Σ[ X ∈ ℂ.Object ] ℂ.Arrow X A* × ℂ.Arrow X B*
|
||||||
|
; Arrow = λ{ (A , a0 , a1) (B , b0 , b1)
|
||||||
|
→ Σ[ f ∈ ℂ.Arrow A B ]
|
||||||
|
ℂ [ b0 ∘ f ] ≡ a0
|
||||||
|
× ℂ [ b1 ∘ f ] ≡ a1
|
||||||
|
}
|
||||||
|
; identity = λ{ {X , f , g}
|
||||||
|
→ ℂ.identity {X} , ℂ.rightIdentity , ℂ.rightIdentity
|
||||||
|
}
|
||||||
|
; _<<<_ = λ { {_ , a0 , a1} {_ , b0 , b1} {_ , c0 , c1}
|
||||||
|
(f , f0 , f1) (g , g0 , g1)
|
||||||
|
→ (f ℂ.<<< g)
|
||||||
|
, (begin
|
||||||
|
ℂ [ c0 ∘ ℂ [ f ∘ g ] ] ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
ℂ [ ℂ [ c0 ∘ f ] ∘ g ] ≡⟨ cong (λ φ → ℂ [ φ ∘ g ]) f0 ⟩
|
||||||
|
ℂ [ b0 ∘ g ] ≡⟨ g0 ⟩
|
||||||
|
a0 ∎
|
||||||
|
)
|
||||||
|
, (begin
|
||||||
|
ℂ [ c1 ∘ ℂ [ f ∘ g ] ] ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
ℂ [ ℂ [ c1 ∘ f ] ∘ g ] ≡⟨ cong (λ φ → ℂ [ φ ∘ g ]) f1 ⟩
|
||||||
|
ℂ [ b1 ∘ g ] ≡⟨ g1 ⟩
|
||||||
|
a1 ∎
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category.Product}. Definition of ``pair category''.}
|
||||||
|
\end{figure}
|
||||||
|
\clearpage
|
||||||
|
\section{Monads}
|
||||||
|
\label{sec:app-monads}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module Cat.Category.Monad.Kleisli
|
||||||
|
{ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
|
record RawMonad : Set ℓ where
|
||||||
|
field
|
||||||
|
omap : Object → Object
|
||||||
|
pure : {X : Object} → ℂ [ X , omap X ]
|
||||||
|
bind : {X Y : Object} → ℂ [ X , omap Y ] → ℂ [ omap X , omap Y ]
|
||||||
|
|
||||||
|
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
||||||
|
fmap f = bind (pure <<< f)
|
||||||
|
|
||||||
|
_>=>_ : {A B C : Object}
|
||||||
|
→ ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
||||||
|
f >=> g = f >>> (bind g)
|
||||||
|
|
||||||
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
|
join = bind identity
|
||||||
|
|
||||||
|
IsIdentity = {X : Object}
|
||||||
|
→ bind pure ≡ identity {omap X}
|
||||||
|
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
||||||
|
→ pure >=> f ≡ f
|
||||||
|
IsDistributive = {X Y Z : Object}
|
||||||
|
(g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
||||||
|
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
||||||
|
|
||||||
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
open RawMonad raw public
|
||||||
|
field
|
||||||
|
isIdentity : IsIdentity
|
||||||
|
isNatural : IsNatural
|
||||||
|
isDistributive : IsDistributive
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category.Monad.Kleisli}. Definition of
|
||||||
|
Kleisli monads.}
|
||||||
|
\end{figure}
|
||||||
|
%
|
||||||
|
\begin{figure}[h]
|
||||||
|
\begin{Verbatim}
|
||||||
|
module Cat.Category.Monad.Monoidal
|
||||||
|
{ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
|
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
||||||
|
|
||||||
|
record RawMonad : Set ℓ where
|
||||||
|
field
|
||||||
|
R : EndoFunctor ℂ
|
||||||
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
|
joinNT : NaturalTransformation F[ R ∘ R ] R
|
||||||
|
|
||||||
|
Romap = Functor.omap R
|
||||||
|
fmap = Functor.fmap R
|
||||||
|
|
||||||
|
pureT : Transformation Functors.identity R
|
||||||
|
pureT = fst pureNT
|
||||||
|
|
||||||
|
pure : {X : Object} → ℂ [ X , Romap X ]
|
||||||
|
pure = pureT _
|
||||||
|
|
||||||
|
pureN : Natural Functors.identity R pureT
|
||||||
|
pureN = snd pureNT
|
||||||
|
|
||||||
|
joinT : Transformation F[ R ∘ R ] R
|
||||||
|
joinT = fst joinNT
|
||||||
|
join : {X : Object} → ℂ [ Romap (Romap X) , Romap X ]
|
||||||
|
join = joinT _
|
||||||
|
joinN : Natural F[ R ∘ R ] R joinT
|
||||||
|
joinN = snd joinNT
|
||||||
|
|
||||||
|
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
||||||
|
bind {X} {Y} f = join <<< fmap f
|
||||||
|
|
||||||
|
IsAssociative : Set _
|
||||||
|
IsAssociative = {X : Object}
|
||||||
|
→ joinT X <<< fmap join ≡ join <<< join
|
||||||
|
IsInverse : Set _
|
||||||
|
IsInverse = {X : Object}
|
||||||
|
→ join <<< pure ≡ identity {Romap X}
|
||||||
|
× join <<< fmap pure ≡ identity {Romap X}
|
||||||
|
|
||||||
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
open RawMonad raw public
|
||||||
|
field
|
||||||
|
isAssociative : IsAssociative
|
||||||
|
isInverse : IsInverse
|
||||||
|
\end{Verbatim}
|
||||||
|
\caption{Excerpt from module \texttt{Cat.Category.Monad.Monoidal}. Definition of
|
||||||
|
Monoidal monads.}
|
||||||
|
\end{figure}
|
95
doc/title.tex
Normal file
95
doc/title.tex
Normal file
|
@ -0,0 +1,95 @@
|
||||||
|
%% FRONTMATTER
|
||||||
|
\frontmatter
|
||||||
|
%% \newgeometry{top=3cm, bottom=3cm,left=2.25 cm, right=2.25cm}
|
||||||
|
\begingroup
|
||||||
|
\thispagestyle{empty}
|
||||||
|
{\Huge\thetitle}\\[.5cm]
|
||||||
|
{\Large A formalization of category theory in Cubical Agda}\\[6cm]
|
||||||
|
\begin{center}
|
||||||
|
\includegraphics[width=\linewidth,keepaspectratio]{isomorphism.png}
|
||||||
|
\end{center}
|
||||||
|
% Cover text
|
||||||
|
\vfill
|
||||||
|
%% \renewcommand{\familydefault}{\sfdefault} \normalfont % Set cover page font
|
||||||
|
{\Large\theauthor}\\[.5cm]
|
||||||
|
Master's thesis in Computer Science
|
||||||
|
\endgroup
|
||||||
|
%% \end{titlepage}
|
||||||
|
|
||||||
|
|
||||||
|
% BACK OF COVER PAGE (BLANK PAGE)
|
||||||
|
\newpage
|
||||||
|
%% \newgeometry{a4paper} % Temporarily change margins
|
||||||
|
%% \restoregeometry
|
||||||
|
\thispagestyle{empty}
|
||||||
|
\null
|
||||||
|
|
||||||
|
%% \begin{titlepage}
|
||||||
|
|
||||||
|
% TITLE PAGE
|
||||||
|
\newpage
|
||||||
|
\thispagestyle{empty}
|
||||||
|
\begin{center}
|
||||||
|
\textsc{\LARGE Master's thesis \the\year}\\[4cm] % Report number is currently not in use
|
||||||
|
\textbf{\LARGE \thetitle} \\[1cm]
|
||||||
|
{\large \subtitle}\\[1cm]
|
||||||
|
{\large \theauthor}
|
||||||
|
|
||||||
|
\vfill
|
||||||
|
\centering
|
||||||
|
\includegraphics[width=0.2\pdfpagewidth]{assets/logo_eng.pdf}
|
||||||
|
\vspace{5mm}
|
||||||
|
|
||||||
|
\textsc{Department of Computer Science and Engineering}\\
|
||||||
|
\textsc{{\researchgroup}}\\
|
||||||
|
%Name of research group (if applicable)\\
|
||||||
|
\textsc{\institution} \\
|
||||||
|
\textsc{Gothenburg, Sweden \the\year}\\
|
||||||
|
\end{center}
|
||||||
|
|
||||||
|
|
||||||
|
% IMPRINT PAGE (BACK OF TITLE PAGE)
|
||||||
|
\newpage
|
||||||
|
\thispagestyle{plain}
|
||||||
|
\textit{\thetitle}\\
|
||||||
|
\subtitle\\
|
||||||
|
\copyright\ \the\year ~ \textsc{\theauthor}
|
||||||
|
\vspace{4.5cm}
|
||||||
|
|
||||||
|
\setlength{\parskip}{0.5cm}
|
||||||
|
\textbf{Author:}\\
|
||||||
|
\theauthor\\
|
||||||
|
\href{mailto:\authoremail>}{\texttt{<\authoremail>}}
|
||||||
|
|
||||||
|
\textbf{Supervisor:}\\
|
||||||
|
\supervisor\\
|
||||||
|
\href{mailto:\supervisoremail>}{\texttt{<\supervisoremail>}}\\
|
||||||
|
\supervisordepartment
|
||||||
|
|
||||||
|
\textbf{Co-supervisor:}\\
|
||||||
|
\cosupervisor\\
|
||||||
|
\href{mailto:\cosupervisoremail>}{\texttt{<\cosupervisoremail>}}\\
|
||||||
|
\cosupervisordepartment
|
||||||
|
|
||||||
|
\textbf{Examiner:}\\
|
||||||
|
\examiner\\
|
||||||
|
\href{mailto:\examineremail>}{\texttt{<\examineremail>}}\\
|
||||||
|
\examinerdepartment
|
||||||
|
|
||||||
|
\vfill
|
||||||
|
Master's Thesis \the\year\\ % Report number currently not in use
|
||||||
|
\department\\
|
||||||
|
%Division of Division name\\
|
||||||
|
%Name of research group (if applicable)\\
|
||||||
|
\institution\\
|
||||||
|
SE-412 96 Gothenburg\\
|
||||||
|
Telephone +46 31 772 1000 \setlength{\parskip}{0.5cm}\\
|
||||||
|
% Caption for cover page figure if used, possibly with reference to further information in the report
|
||||||
|
%% Cover: Wind visualization constructed in Matlab showing a surface of constant wind speed along with streamlines of the flow. \setlength{\parskip}{0.5cm}
|
||||||
|
%Printed by [Name of printing company]\\
|
||||||
|
Gothenburg, Sweden \the\year
|
||||||
|
|
||||||
|
%% \restoregeometry
|
||||||
|
%% \end{titlepage}
|
||||||
|
|
||||||
|
\tableofcontents
|
|
@ -1 +1 @@
|
||||||
Subproject commit fbd8ba7ea84c4b643fd08797b4031b18a59f561d
|
Subproject commit ac331fc38ca05f85dfebc57eb1259ba2ea0e50d5
|
|
@ -1 +1 @@
|
||||||
Subproject commit 5b35333dbbd8fa523e478c1cfe60657321ca38fe
|
Subproject commit b112c292ded61b02fa32a1b65cac77314a1e9698
|
|
@ -1,56 +0,0 @@
|
||||||
% Requires: hypperref
|
|
||||||
\ProvidesPackage{chalmerstitle}
|
|
||||||
|
|
||||||
\newcommand*{\authoremail}[1]{\gdef\@authoremail{#1}}
|
|
||||||
\newcommand*{\supervisor}[1]{\gdef\@supervisor{#1}}
|
|
||||||
\newcommand*{\supervisoremail}[1]{\gdef\@supervisoremail{#1}}
|
|
||||||
\newcommand*{\cosupervisor}[1]{\gdef\@cosupervisor{#1}}
|
|
||||||
\newcommand*{\cosupervisoremail}[1]{\gdef\@cosupervisoremail{#1}}
|
|
||||||
\newcommand*{\institution}[1]{\gdef\@institution{#1}}
|
|
||||||
|
|
||||||
\renewcommand*{\maketitle}{%
|
|
||||||
\begin{titlepage}
|
|
||||||
|
|
||||||
|
|
||||||
\begin{center}
|
|
||||||
|
|
||||||
|
|
||||||
{\scshape\LARGE Master thesis project proposal\\}
|
|
||||||
|
|
||||||
\vspace{0.5cm}
|
|
||||||
|
|
||||||
{\LARGE\bfseries \@title\\}
|
|
||||||
|
|
||||||
\vspace{2cm}
|
|
||||||
|
|
||||||
{\Large \@author\\ \href{mailto:\@authoremail>}{\texttt{<\@authoremail>}} \\}
|
|
||||||
|
|
||||||
% \vspace{0.2cm}
|
|
||||||
%
|
|
||||||
% {\Large name and email adress of student 2\\}
|
|
||||||
|
|
||||||
\vspace{1.0cm}
|
|
||||||
|
|
||||||
{\large Supervisor: \@supervisor\\ \href{mailto:\@supervisoremail>}{\texttt{<\@supervisoremail>}}\\}
|
|
||||||
|
|
||||||
\vspace{0.2cm}
|
|
||||||
|
|
||||||
{\large Co-supervisor: \@cosupervisor\\ \href{mailto:\@cosupervisoremail>}{\texttt{<\@cosupervisoremail>}}\\}
|
|
||||||
|
|
||||||
\vspace{1.5cm}
|
|
||||||
|
|
||||||
{\large Relevant completed courses:\par}
|
|
||||||
{\itshape
|
|
||||||
Logic in Computer Science -- DAT060\\
|
|
||||||
Models of Computation -- TDA184\\
|
|
||||||
Research topic in Computer Science -- DAT235\\
|
|
||||||
Types for programs and proofs -- DAT140
|
|
||||||
}
|
|
||||||
|
|
||||||
\vfill
|
|
||||||
|
|
||||||
{\large \@institution\\\today\\}
|
|
||||||
|
|
||||||
\end{center}
|
|
||||||
\end{titlepage}
|
|
||||||
}
|
|
|
@ -1,20 +0,0 @@
|
||||||
\newcommand{\coloneqq}{\mathrel{\vcenter{\baselineskip0.5ex \lineskiplimit0pt
|
|
||||||
\hbox{\scriptsize.}\hbox{\scriptsize.}}}%
|
|
||||||
=}
|
|
||||||
|
|
||||||
\newcommand{\defeq}{\coloneqq}
|
|
||||||
\newcommand{\bN}{\mathbb{N}}
|
|
||||||
\newcommand{\bC}{\mathbb{C}}
|
|
||||||
\newcommand{\bX}{\mathbb{X}}
|
|
||||||
% \newcommand{\to}{\rightarrow}
|
|
||||||
\newcommand{\mto}{\mapsto}
|
|
||||||
\newcommand{\UU}{\ensuremath{\mathcal{U}}\xspace}
|
|
||||||
\let\type\UU
|
|
||||||
\newcommand{\nomen}[1]{\emph{#1}}
|
|
||||||
\newcommand{\todo}[1]{\textit{#1}}
|
|
||||||
\newcommand{\comp}{\circ}
|
|
||||||
\newcommand{\x}{\times}
|
|
||||||
\newcommand{\Hom}{\mathit{Hom}}
|
|
||||||
\newcommand{\fmap}{\mathit{fmap}}
|
|
||||||
\newcommand{\idFun}{\mathit{id}}
|
|
||||||
\newcommand{\Sets}{\mathit{Sets}}
|
|
|
@ -1,286 +0,0 @@
|
||||||
\documentclass{article}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\usepackage[utf8]{inputenc}
|
|
||||||
|
|
||||||
\usepackage{natbib}
|
|
||||||
\usepackage[hidelinks]{hyperref}
|
|
||||||
|
|
||||||
\usepackage{graphicx}
|
|
||||||
|
|
||||||
\usepackage{parskip}
|
|
||||||
\usepackage{multicol}
|
|
||||||
\usepackage{amsmath,amssymb}
|
|
||||||
\usepackage[toc,page]{appendix}
|
|
||||||
% \setlength{\parskip}{10pt}
|
|
||||||
|
|
||||||
% \usepackage{tikz}
|
|
||||||
% \usetikzlibrary{arrows, decorations.markings}
|
|
||||||
|
|
||||||
% \usepackage{chngcntr}
|
|
||||||
% \counterwithout{figure}{section}
|
|
||||||
|
|
||||||
\usepackage{chalmerstitle}
|
|
||||||
\input{macros.tex}
|
|
||||||
|
|
||||||
\title{Category Theory and Cubical Type Theory}
|
|
||||||
\author{Frederik Hanghøj Iversen}
|
|
||||||
\authoremail{hanghj@student.chalmers.se}
|
|
||||||
\supervisor{Thierry Coquand}
|
|
||||||
\supervisoremail{coquand@chalmers.se}
|
|
||||||
\cosupervisor{Andrea Vezzosi}
|
|
||||||
\cosupervisoremail{vezzosi@chalmers.se}
|
|
||||||
\institution{Chalmers University of Technology}
|
|
||||||
|
|
||||||
\begin{document}
|
|
||||||
|
|
||||||
\maketitle
|
|
||||||
%
|
|
||||||
\section{Introduction}
|
|
||||||
%
|
|
||||||
Functional extensionality and univalence is not expressible in
|
|
||||||
\nomen{Intensional Martin Löf Type Theory} (ITT). This poses a severe limitation
|
|
||||||
on both 1) what is \emph{provable} and 2) the \emph{reusability} of proofs.
|
|
||||||
Recent developments have, however, resulted in \nomen{Cubical Type Theory} (CTT)
|
|
||||||
which permits a constructive proof of these two important notions.
|
|
||||||
|
|
||||||
Furthermore an extension has been implemented for the proof assistant Agda
|
|
||||||
(\cite{agda}) that allows us to work in such a ``cubical setting''. This project
|
|
||||||
will be concerned with exploring the usefulness of this extension. As a
|
|
||||||
case-study I will consider \nomen{category theory}. This will serve a dual
|
|
||||||
purpose: First off category theory is a field where the notion of functional
|
|
||||||
extensionality and univalence wil be particularly useful. Secondly, Category
|
|
||||||
Theory gives rise to a \nomen{model} for CTT.
|
|
||||||
|
|
||||||
The project will consist of two parts: The first part will be concerned with
|
|
||||||
formalizing concepts from category theory. The focus will be on formalizing
|
|
||||||
parts that will be useful in the second part of the project: Showing that
|
|
||||||
\nomen{Cubical Sets} give rise to a model of CTT.
|
|
||||||
%
|
|
||||||
\section{Problem}
|
|
||||||
%
|
|
||||||
In the following two subsections I present two examples that illustrate the
|
|
||||||
limitation inherent in ITT and by extension to the expressiveness of Agda.
|
|
||||||
%
|
|
||||||
\subsection{Functional extensionality}
|
|
||||||
Consider the functions:
|
|
||||||
%
|
|
||||||
\begin{multicols}{2}
|
|
||||||
$f \defeq (n : \bN) \mapsto (0 + n : \bN)$
|
|
||||||
|
|
||||||
$g \defeq (n : \bN) \mapsto (n + 0 : \bN)$
|
|
||||||
\end{multicols}
|
|
||||||
%
|
|
||||||
$n + 0$ is definitionally equal to $n$. We call this \nomen{definitional
|
|
||||||
equality} and write $n + 0 = n$ to assert this fact. We call it definitional
|
|
||||||
equality because the \emph{equality} arises from the \emph{definition} of $+$
|
|
||||||
which is:
|
|
||||||
%
|
|
||||||
\newcommand{\suc}[1]{\mathit{suc}\ #1}
|
|
||||||
\begin{align*}
|
|
||||||
+ & : \bN \to \bN \\
|
|
||||||
n + 0 & \defeq n \\
|
|
||||||
n + (\suc{m}) & \defeq \suc{(n + m)}
|
|
||||||
\end{align*}
|
|
||||||
%
|
|
||||||
Note that $0 + n$ is \emph{not} definitionally equal to $n$. $0 + n$ is in
|
|
||||||
normal form. I.e.; there is no rule for $+$ whose left-hand-side matches this
|
|
||||||
expression. We \emph{do}, however, have that they are \nomen{propositionally}
|
|
||||||
equal. We write $n + 0 \equiv n$ to assert this fact. Propositional equality
|
|
||||||
means that there is a proof that exhibits this relation. Since equality is a
|
|
||||||
transitive relation we have that $n + 0 \equiv 0 + n$.
|
|
||||||
|
|
||||||
Unfortunately we don't have $f \equiv g$.\footnote{Actually showing this is
|
|
||||||
outside the scope of this text. Essentially it would involve giving a model
|
|
||||||
for our type theory that validates all our axioms but where $f \equiv g$ is
|
|
||||||
not true.} There is no way to construct a proof asserting the obvious
|
|
||||||
equivalence of $f$ and $g$ -- even though we can prove them equal for all
|
|
||||||
points. This is exactly the notion of equality of functions that we are
|
|
||||||
interested in; that they are equal for all inputs. We call this
|
|
||||||
\nomen{pointwise equality}, where the \emph{points} of a function refers
|
|
||||||
to it's arguments.
|
|
||||||
|
|
||||||
In the context of category theory the principle of functional extensionality is
|
|
||||||
for instance useful in the context of showing that representable functors are
|
|
||||||
indeed functors. The representable functor for a category $\bC$ and a fixed
|
|
||||||
object in $A \in \bC$ is defined to be:
|
|
||||||
%
|
|
||||||
\begin{align*}
|
|
||||||
\fmap \defeq X \mapsto \Hom_{\bC}(A, X)
|
|
||||||
\end{align*}
|
|
||||||
%
|
|
||||||
The proof obligation that this satisfies the identity law of functors
|
|
||||||
($\fmap\ \idFun \equiv \idFun$) becomes:
|
|
||||||
%
|
|
||||||
\begin{align*}
|
|
||||||
\Hom(A, \idFun_{\bX}) = (g \mapsto \idFun \comp g) \equiv \idFun_{\Sets}
|
|
||||||
\end{align*}
|
|
||||||
%
|
|
||||||
One needs functional extensionality to ``go under'' the function arrow and apply
|
|
||||||
the (left) identity law of the underlying category to proove $\idFun \comp g
|
|
||||||
\equiv g$ and thus closing the above proof.
|
|
||||||
%
|
|
||||||
\iffalse
|
|
||||||
I also want to talk about:
|
|
||||||
\begin{itemize}
|
|
||||||
\item
|
|
||||||
Foundational systems
|
|
||||||
\item
|
|
||||||
Theory vs. metatheory
|
|
||||||
\item
|
|
||||||
Internal type theory
|
|
||||||
\end{itemize}
|
|
||||||
\fi
|
|
||||||
\subsection{Equality of isomorphic types}
|
|
||||||
%
|
|
||||||
Let $\top$ denote the unit type -- a type with a single constructor. In the
|
|
||||||
propositions-as-types interpretation of type theory $\top$ is the proposition
|
|
||||||
that is always true. The type $A \x \top$ and $A$ has an element for each $a :
|
|
||||||
A$. So in a sense they are the same. The second element of the pair does not add
|
|
||||||
any ``interesting information''. It can be useful to identify such types. In
|
|
||||||
fact, it is quite commonplace in mathematics. Say we look at a set $\{x \mid
|
|
||||||
\phi\ x \land \psi\ x\}$ and somehow conclude that $\psi\ x \equiv \top$ for all
|
|
||||||
$x$. A mathematician would immediately conclude $\{x \mid \phi\ x \land
|
|
||||||
\psi\ x\} \equiv \{x \mid \phi\ x\}$ without thinking twice. Unfortunately such
|
|
||||||
an identification can not be performed in ITT.
|
|
||||||
|
|
||||||
More specifically; what we are interested in is a way of identifying types that
|
|
||||||
are in a one-to-one correspondence. We say that such types are
|
|
||||||
\nomen{isomorphic} and write $A \cong B$ to assert this.
|
|
||||||
|
|
||||||
To prove two types isomorphic is to give an \nomen{isomorphism} between them.
|
|
||||||
That is, a function $f : A \to B$ with an inverse $f^{-1} : B \to A$, i.e.:
|
|
||||||
$f^{-1} \comp f \equiv id_A$. If such a function exist we say that $A$ and $B$
|
|
||||||
are isomorphic and write $A \cong B$.
|
|
||||||
|
|
||||||
Furthermore we want to \emph{identify} such isomorphic types. This, we get from
|
|
||||||
the principle of univalence:\footnote{It's often referred to as the univalence
|
|
||||||
axiom, but since it is not an axiom in this setting but rather a theorem I
|
|
||||||
refer to this just as a `principle'.}
|
|
||||||
%
|
|
||||||
$$(A \cong B) \cong (A \equiv B)$$
|
|
||||||
%
|
|
||||||
\subsection{Formalizing Category Theory}
|
|
||||||
%
|
|
||||||
The above examples serve to illustrate the limitation of Agda. One case where
|
|
||||||
these limitations are particularly prohibitive is in the study of Category
|
|
||||||
Theory. At a glance category theory can be described as ``the mathematical study
|
|
||||||
of (abstract) algebras of functions'' (\cite{awodey-2006}). So by that token
|
|
||||||
functional extensionality is particularly useful for formulating Category
|
|
||||||
Theory. In Category theory it is also common to identify isomorphic structures
|
|
||||||
and this is exactly what we get from univalence.
|
|
||||||
|
|
||||||
\subsection{Cubical model for Cubical Type Theory}
|
|
||||||
%
|
|
||||||
A model is a way of giving meaning to a formal system in a \emph{meta-theory}. A
|
|
||||||
typical example of a model is that of sets as models for predicate logic. Thus
|
|
||||||
set-theory becomes the meta-theory of the formal language of predicate logic.
|
|
||||||
|
|
||||||
In the context of a given type theory and restricting ourselves to
|
|
||||||
\emph{categorical} models a model will consist of mapping `things' from the
|
|
||||||
type-theory (types, terms, contexts, context morphisms) to `things' in the
|
|
||||||
meta-theory (objects, morphisms) in such a way that the axioms of the
|
|
||||||
type-theory (typing-rules) are validated in the meta-theory. In
|
|
||||||
\cite{dybjer-1995} the author describes a way of constructing such models for
|
|
||||||
dependent type theory called \emph{Categories with Families} (CwFs).
|
|
||||||
|
|
||||||
In \cite{bezem-2014} the authors devise a CwF for Cubical Type Theory. This
|
|
||||||
project will study and formalize this model. Note that I will \emph{not} aim to
|
|
||||||
formalize CTT itself and therefore also not give the formal translation between
|
|
||||||
the type theory and the meta-theory. Instead the translation will be accounted
|
|
||||||
for informally.
|
|
||||||
|
|
||||||
The project will formalize CwF's. It will also define what pieces of data are
|
|
||||||
needed for a model of CTT (without explicitly showing that it does in fact model
|
|
||||||
CTT). It will then show that a CwF gives rise to such a model. Furthermore I
|
|
||||||
will show that cubical sets are presheaf categories and that any presheaf
|
|
||||||
category is itself a CwF. This is the precise way by which the project aims to
|
|
||||||
provide a model of CTT. Note that this formalization specifcally does not
|
|
||||||
mention the language of CTT itself. Only be referencing this previous work do we
|
|
||||||
arrive at a model of CTT.
|
|
||||||
%
|
|
||||||
\section{Context}
|
|
||||||
%
|
|
||||||
In \cite{bezem-2014} a categorical model for cubical type theory is presented.
|
|
||||||
In \cite{cohen-2016} a type-theory where univalence is expressible is presented.
|
|
||||||
The categorical model in the previous reference serve as a model of this type
|
|
||||||
theory. So these two ideas are closely related. Cubical type theory arose out of
|
|
||||||
\nomen{Homotopy Type Theory} (\cite{hott-2013}) and is also of interest as a
|
|
||||||
foundation of mathematics (\cite{voevodsky-2011}).
|
|
||||||
|
|
||||||
An implementation of cubical type theory can be found as an extension to Agda.
|
|
||||||
This is due to \citeauthor{cubical-agda}. This, of course, will be central to
|
|
||||||
this thesis.
|
|
||||||
|
|
||||||
The idea of formalizing Category Theory in proof assistants is not a new
|
|
||||||
idea\footnote{There are a multitude of these available online. Just as first
|
|
||||||
reference see this question on Math Overflow: \cite{mo-formalizations}}. The
|
|
||||||
contribution of this thesis is to explore how working in a cubical setting will
|
|
||||||
make it possible to prove more things and to reuse proofs.
|
|
||||||
|
|
||||||
There are alternative approaches to working in a cubical setting where one can
|
|
||||||
still have univalence and functional extensionality. One option is to postulate
|
|
||||||
these as axioms. This approach, however, has other shortcomings, e.g.; you lose
|
|
||||||
\nomen{canonicity} (\cite{huber-2016}). Canonicity means that any well-type
|
|
||||||
term will (under evaluation) reduce to a \emph{canonical} form. For example for
|
|
||||||
an integer $e : \bN$ it will be the case that $e$ is definitionally equal to $n$
|
|
||||||
applications of $\mathit{suc}$ to $0$ for some $n$; $e = \mathit{suc}^n\ 0$.
|
|
||||||
Without canonicity terms in the language can get ``stuck'' when they are
|
|
||||||
evaluated.
|
|
||||||
|
|
||||||
Another approach is to use the \emph{setoid interpretation} of type theory
|
|
||||||
(\cite{hofmann-1995,huber-2016}). Types should additionally `carry around' an
|
|
||||||
equivalence relation that should serve as propositional equality. This approach
|
|
||||||
has other drawbacks; it does not satisfy all judgemental equalites of type
|
|
||||||
theory and is cumbersome to work with in practice (\cite[p. 4]{huber-2016}).
|
|
||||||
%
|
|
||||||
\section{Goals and Challenges}
|
|
||||||
%
|
|
||||||
In summary, the aim of the project is to:
|
|
||||||
%
|
|
||||||
\begin{itemize}
|
|
||||||
\item
|
|
||||||
Formalize Category Theory in Cubical Agda
|
|
||||||
\item
|
|
||||||
Formalize Cubical Sets in Agda
|
|
||||||
% \item
|
|
||||||
% Formalize Cubical Type Theory in Agda
|
|
||||||
\item
|
|
||||||
Show that Cubical Sets are a model for Cubical Type Theory
|
|
||||||
\end{itemize}
|
|
||||||
%
|
|
||||||
The formalization of category theory will focus on extracting the elements from
|
|
||||||
Category Theory that we need in the latter part of the project. In doing so I'll
|
|
||||||
be gaining experience with working with Cubical Agda. Equality proofs using
|
|
||||||
cubical Agda can be tricky, so working with that will be a challenge in itself.
|
|
||||||
Most of the proofs in the context of cubical models I will formalize are based
|
|
||||||
on previous work. Those proofs, however, are not formalized in a proof
|
|
||||||
assistant.
|
|
||||||
|
|
||||||
One particular challenge in this context is that in a cubical setting there can
|
|
||||||
be multiple distinct terms that inhabit a given equality proof.\footnote{This is
|
|
||||||
in contrast with ITT where one \emph{can} have \nomen{Uniqueness of identity proofs}
|
|
||||||
(\cite[p. 4]{huber-2016}).} This means that the choice for a given equality
|
|
||||||
proof can influence later proofs that refer back to said proof. This is new and
|
|
||||||
relatively unexplored territory.
|
|
||||||
|
|
||||||
Another challenge is that Category Theory is something that I only know the
|
|
||||||
basics of. So learning the necessary concepts from Category Theory will also be
|
|
||||||
a goal and a challenge in itself.
|
|
||||||
|
|
||||||
After this has been implemented it would also be possible to formalize Cubical
|
|
||||||
Type Theory and formally show that Cubical Sets are a model of this. I do not
|
|
||||||
intend to formally implement the language of dependent type theory in this
|
|
||||||
project.
|
|
||||||
|
|
||||||
The thesis shall conclude with a discussion about the benefits of Cubical Agda.
|
|
||||||
%
|
|
||||||
\bibliographystyle{plainnat}
|
|
||||||
\nocite{cubical-demo}
|
|
||||||
\nocite{coquand-2013}
|
|
||||||
\bibliography{refs}
|
|
||||||
\begin{appendices}
|
|
||||||
\input{planning.tex}
|
|
||||||
\end{appendices}
|
|
||||||
\end{document}
|
|
1
report/.gitignore
vendored
1
report/.gitignore
vendored
|
@ -1 +0,0 @@
|
||||||
cat.pdf
|
|
|
@ -1,40 +0,0 @@
|
||||||
PROJECT = cat
|
|
||||||
PDF = $(PROJECT).pdf
|
|
||||||
NOTES = $(PROJECT).md
|
|
||||||
|
|
||||||
preview: report
|
|
||||||
xdg-open $(PDF)
|
|
||||||
|
|
||||||
report: $(PDF)
|
|
||||||
|
|
||||||
$(PDF): $(NOTES)
|
|
||||||
pandoc $(NOTES) \
|
|
||||||
-o $(PDF) \
|
|
||||||
--latex-engine=xelatex \
|
|
||||||
--variable urlcolor=cyan \
|
|
||||||
-V papersize:a4 \
|
|
||||||
-V geometry:margin=1.5in \
|
|
||||||
--filter pandoc-citeproc
|
|
||||||
|
|
||||||
github: README.md
|
|
||||||
|
|
||||||
README.md: $(NOTES)
|
|
||||||
pandoc $(NOTES) \
|
|
||||||
-o README.md
|
|
||||||
|
|
||||||
run:
|
|
||||||
stack exec lab4
|
|
||||||
|
|
||||||
build:
|
|
||||||
stack build
|
|
||||||
|
|
||||||
dist: report
|
|
||||||
tar \
|
|
||||||
--transform "s/^/$(PROJECT)\//" \
|
|
||||||
-zcvf $(PROJECT).tar.gz \
|
|
||||||
$(SOURCE) \
|
|
||||||
LICENSE \
|
|
||||||
stack.yaml \
|
|
||||||
lab4.cabal \
|
|
||||||
Makefile \
|
|
||||||
$(PDF)
|
|
|
@ -1,90 +0,0 @@
|
||||||
---
|
|
||||||
title: Formalizing category theory in Agda - Project description
|
|
||||||
date: May 27th 2017
|
|
||||||
author: Frederik Hanghøj Iversen `<hanghj@student.chalmers.se>`
|
|
||||||
bibliography: refs.bib
|
|
||||||
---
|
|
||||||
|
|
||||||
Background
|
|
||||||
==========
|
|
||||||
|
|
||||||
Functional extensionality gives rise to a notion of equality of functions not
|
|
||||||
present in intensional dependent type theory. A type-system called cubical
|
|
||||||
type-theory is outlined in [@cohen-2016] that recovers the computational
|
|
||||||
interprtation of the univalence theorem.
|
|
||||||
|
|
||||||
Keywords: The category of sets, limits, colimits, functors, natural
|
|
||||||
transformations, kleisly category, yoneda lemma, closed cartesian categories,
|
|
||||||
propositional logic.
|
|
||||||
|
|
||||||
<!--
|
|
||||||
"[...] These foundations promise to resolve several seemingly unconnected
|
|
||||||
problems-provide a support for categorical and higher categorical arguments
|
|
||||||
directly on the level of the language, make formalizations of usual mathematics
|
|
||||||
much more concise and much better adapted to the use with existing proof
|
|
||||||
assistants such as Coq [...]"
|
|
||||||
|
|
||||||
From "Univalent Foundations of Mathematics" by "Voevodsky".
|
|
||||||
|
|
||||||
-->
|
|
||||||
|
|
||||||
Aim
|
|
||||||
===
|
|
||||||
|
|
||||||
The aim of the project is two-fold. The first part of the project will be
|
|
||||||
concerned with formalizing some concepts from category theory in Agda's
|
|
||||||
type-system. This formalization should aim to incorporate definitions and
|
|
||||||
theorems that allow us to express the correpondence in the second part: Namely
|
|
||||||
showing the correpondence between well-typed terms in cubical type theory as
|
|
||||||
presented in Huber and Thierry's paper and with that of some concepts from Category Theory.
|
|
||||||
|
|
||||||
This latter part is not entirely clear for me yet, I know that all these are relevant keywords:
|
|
||||||
|
|
||||||
* The category, C, of names and substitutions
|
|
||||||
* Cubical Sets, i.e.: Functors from C to Set (the category of sets)
|
|
||||||
* Presheaves
|
|
||||||
* Fibers and fibrations
|
|
||||||
|
|
||||||
These are all formulated in the language of Category Theory. The purpose it to
|
|
||||||
show what they correspond to in the in Cubical Type Theory. As I understand it
|
|
||||||
at least the last buzzword on this list corresponds to Type Families.
|
|
||||||
|
|
||||||
I'm not sure how I'll go about expressing this in Agda. I suspect it might
|
|
||||||
be a matter of demostrating that these two formulations are isomorphic.
|
|
||||||
|
|
||||||
So far I have some experience with at least expressing some categorical
|
|
||||||
concepts in Agda using this new notion of equality. That is, equaility is in
|
|
||||||
some sense a continuuous path from a point of some type to another. So at the
|
|
||||||
moment, my understanding of cubical type theory is just that it has another
|
|
||||||
notion of equality but is otherwise pretty much the same.
|
|
||||||
|
|
||||||
Timeplan
|
|
||||||
========
|
|
||||||
|
|
||||||
The first part of the project will focus on studying and understanding the
|
|
||||||
foundations for this project namely; familiarizing myself with basic concepts
|
|
||||||
from category theory, understanding how cubical type theory gives rise to
|
|
||||||
expressing functional extensionality and the univalence theorem.
|
|
||||||
|
|
||||||
After I have understood these fundamental concepts I will use them in the
|
|
||||||
formalization of functors, applicative functors, monads, etc.. in Agda. This
|
|
||||||
should be done before the end of the first semester of the school-year
|
|
||||||
2017/2018.
|
|
||||||
|
|
||||||
At this point I will also have settled on a direction for the rest of the
|
|
||||||
project and developed a time-plan for the second phase of the project. But
|
|
||||||
cerainly it will involve applying the result of phase 1 in some context as
|
|
||||||
mentioned in [the project aim][aim].
|
|
||||||
|
|
||||||
Resources
|
|
||||||
=========
|
|
||||||
|
|
||||||
* Cubical demo by Andrea Vezossi: [@cubical-demo]
|
|
||||||
* Paper on cubical type theory [@cohen-2016]
|
|
||||||
* Book on homotopy type theory: [@hott-2013]
|
|
||||||
* Book on category theory: [@awodey-2006]
|
|
||||||
* Modal logic - Modal type theory,
|
|
||||||
see [ncatlab](https://ncatlab.org/nlab/show/modal+type+theory).
|
|
||||||
|
|
||||||
References
|
|
||||||
==========
|
|
|
@ -1,42 +0,0 @@
|
||||||
@article{cohen-2016,
|
|
||||||
author = {Cyril Cohen and
|
|
||||||
Thierry Coquand and
|
|
||||||
Simon Huber and
|
|
||||||
Anders M{\"{o}}rtberg},
|
|
||||||
title =
|
|
||||||
{ Cubical Type Theory:
|
|
||||||
a constructive interpretation of the univalence axiom
|
|
||||||
},
|
|
||||||
journal = {CoRR},
|
|
||||||
volume = {abs/1611.02108},
|
|
||||||
year = {2016},
|
|
||||||
url = {http://arxiv.org/abs/1611.02108},
|
|
||||||
timestamp = {Thu, 01 Dec 2016 19:32:08 +0100},
|
|
||||||
biburl = {http://dblp.uni-trier.de/rec/bib/journals/corr/CohenCHM16},
|
|
||||||
bibsource = {dblp computer science bibliography, http://dblp.org}
|
|
||||||
}
|
|
||||||
@book{hott-2013,
|
|
||||||
author = {The {Univalent Foundations Program}},
|
|
||||||
title = {Homotopy Type Theory: Univalent Foundations of Mathematics},
|
|
||||||
publisher = {\url{https://homotopytypetheory.org/book}},
|
|
||||||
address = {Institute for Advanced Study},
|
|
||||||
year = 2013
|
|
||||||
}
|
|
||||||
@book{awodey-2006,
|
|
||||||
title={Category Theory},
|
|
||||||
author={Awodey, S.},
|
|
||||||
isbn={9780191513824},
|
|
||||||
series={Oxford Logic Guides},
|
|
||||||
url={https://books.google.se/books?id=IK\_sIDI2TCwC},
|
|
||||||
year={2006},
|
|
||||||
publisher={Ebsco Publishing}
|
|
||||||
}
|
|
||||||
@misc{cubical-demo,
|
|
||||||
author = {Andrea Vezzosi},
|
|
||||||
title = {Cubical Type Theory Demo},
|
|
||||||
year = {2017},
|
|
||||||
publisher = {GitHub},
|
|
||||||
journal = {GitHub repository},
|
|
||||||
howpublished = {\url{https://github.com/Saizan/cubical-demo}},
|
|
||||||
commit = {a51d5654c439111110d5b6df3605b0043b10b753}
|
|
||||||
}
|
|
|
@ -8,13 +8,17 @@ open import Cat.Category.Exponential
|
||||||
open import Cat.Category.CartesianClosed
|
open import Cat.Category.CartesianClosed
|
||||||
open import Cat.Category.NaturalTransformation
|
open import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Yoneda
|
open import Cat.Category.Yoneda
|
||||||
|
open import Cat.Category.Monoid
|
||||||
open import Cat.Category.Monad
|
open import Cat.Category.Monad
|
||||||
|
open import Cat.Category.Monad.Monoidal
|
||||||
|
open import Cat.Category.Monad.Kleisli
|
||||||
open import Cat.Category.Monad.Voevodsky
|
open import Cat.Category.Monad.Voevodsky
|
||||||
|
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
open import Cat.Categories.Sets
|
open import Cat.Categories.Sets
|
||||||
open import Cat.Categories.Cat
|
open import Cat.Categories.Cat
|
||||||
open import Cat.Categories.Rel
|
open import Cat.Categories.Rel
|
||||||
open import Cat.Categories.Free
|
open import Cat.Categories.Free
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
open import Cat.Categories.Cube
|
-- open import Cat.Categories.Cube
|
||||||
open import Cat.Categories.CwF
|
open import Cat.Categories.CwF
|
||||||
|
|
|
@ -3,51 +3,22 @@
|
||||||
|
|
||||||
module Cat.Categories.Cat where
|
module Cat.Categories.Cat where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude renaming (fst to fst ; snd to snd)
|
||||||
open import Data.Product renaming (proj₁ to fst ; proj₂ to snd)
|
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.Sigma
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
open import Cat.Category.Exponential hiding (_×_ ; product)
|
open import Cat.Category.Exponential hiding (_×_ ; product)
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
|
open import Cat.Categories.Fun
|
||||||
open import Cat.Equality
|
|
||||||
open Equality.Data.Product
|
|
||||||
|
|
||||||
open Category using (Object ; 𝟙)
|
|
||||||
|
|
||||||
-- The category of categories
|
-- The category of categories
|
||||||
module _ (ℓ ℓ' : Level) where
|
module _ (ℓ ℓ' : Level) where
|
||||||
private
|
|
||||||
module _ {𝔸 𝔹 ℂ 𝔻 : Category ℓ ℓ'} {F : Functor 𝔸 𝔹} {G : Functor 𝔹 ℂ} {H : Functor ℂ 𝔻} where
|
|
||||||
assc : F[ H ∘ F[ G ∘ F ] ] ≡ F[ F[ H ∘ G ] ∘ F ]
|
|
||||||
assc = Functor≡ refl
|
|
||||||
|
|
||||||
module _ {ℂ 𝔻 : Category ℓ ℓ'} {F : Functor ℂ 𝔻} where
|
|
||||||
ident-r : F[ F ∘ identity ] ≡ F
|
|
||||||
ident-r = Functor≡ refl
|
|
||||||
|
|
||||||
ident-l : F[ identity ∘ F ] ≡ F
|
|
||||||
ident-l = Functor≡ refl
|
|
||||||
|
|
||||||
RawCat : RawCategory (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
RawCat : RawCategory (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
||||||
RawCat =
|
RawCategory.Object RawCat = Category ℓ ℓ'
|
||||||
record
|
RawCategory.Arrow RawCat = Functor
|
||||||
{ Object = Category ℓ ℓ'
|
RawCategory.identity RawCat = Functors.identity
|
||||||
; Arrow = Functor
|
RawCategory._<<<_ RawCat = F[_∘_]
|
||||||
; 𝟙 = identity
|
|
||||||
; _∘_ = F[_∘_]
|
|
||||||
}
|
|
||||||
private
|
|
||||||
open RawCategory RawCat
|
|
||||||
isAssociative : IsAssociative
|
|
||||||
isAssociative {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
|
|
||||||
ident : IsIdentity identity
|
|
||||||
ident = ident-r , ident-l
|
|
||||||
|
|
||||||
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
|
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
|
||||||
-- however, form a groupoid! Therefore there is no (1-)category of
|
-- however, form a groupoid! Therefore there is no (1-)category of
|
||||||
|
@ -55,7 +26,7 @@ module _ (ℓ ℓ' : Level) where
|
||||||
--
|
--
|
||||||
-- Because of this there is no category of categories.
|
-- Because of this there is no category of categories.
|
||||||
Cat : (unprovable : IsCategory RawCat) → Category (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
Cat : (unprovable : IsCategory RawCat) → Category (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
||||||
Category.raw (Cat _) = RawCat
|
Category.raw (Cat _) = RawCat
|
||||||
Category.isCategory (Cat unprovable) = unprovable
|
Category.isCategory (Cat unprovable) = unprovable
|
||||||
|
|
||||||
-- | In the following we will pretend there is a category of categories when
|
-- | In the following we will pretend there is a category of categories when
|
||||||
|
@ -72,52 +43,60 @@ module CatProduct {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
Obj = Object ℂ × Object 𝔻
|
module _ where
|
||||||
Arr : Obj → Obj → Set ℓ'
|
private
|
||||||
Arr (c , d) (c' , d') = ℂ [ c , c' ] × 𝔻 [ d , d' ]
|
Obj = ℂ.Object × 𝔻.Object
|
||||||
𝟙' : {o : Obj} → Arr o o
|
Arr : Obj → Obj → Set ℓ'
|
||||||
𝟙' = 𝟙 ℂ , 𝟙 𝔻
|
Arr (c , d) (c' , d') = ℂ [ c , c' ] × 𝔻 [ d , d' ]
|
||||||
_∘_ :
|
identity : {o : Obj} → Arr o o
|
||||||
{a b c : Obj} →
|
identity = ℂ.identity , 𝔻.identity
|
||||||
Arr b c →
|
_<<<_ :
|
||||||
Arr a b →
|
{a b c : Obj} →
|
||||||
Arr a c
|
Arr b c →
|
||||||
_∘_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
Arr a b →
|
||||||
|
Arr a c
|
||||||
|
_<<<_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
||||||
|
|
||||||
rawProduct : RawCategory ℓ ℓ'
|
rawProduct : RawCategory ℓ ℓ'
|
||||||
RawCategory.Object rawProduct = Obj
|
RawCategory.Object rawProduct = Obj
|
||||||
RawCategory.Arrow rawProduct = Arr
|
RawCategory.Arrow rawProduct = Arr
|
||||||
RawCategory.𝟙 rawProduct = 𝟙'
|
RawCategory.identity rawProduct = identity
|
||||||
RawCategory._∘_ rawProduct = _∘_
|
RawCategory._<<<_ rawProduct = _<<<_
|
||||||
open RawCategory rawProduct
|
|
||||||
|
open RawCategory rawProduct
|
||||||
|
|
||||||
arrowsAreSets : ArrowsAreSets
|
arrowsAreSets : ArrowsAreSets
|
||||||
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
||||||
isIdentity : IsIdentity 𝟙'
|
isIdentity : IsIdentity identity
|
||||||
isIdentity
|
isIdentity
|
||||||
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
||||||
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
||||||
postulate univalent : Univalence.Univalent rawProduct isIdentity
|
|
||||||
instance
|
isPreCategory : IsPreCategory rawProduct
|
||||||
isCategory : IsCategory rawProduct
|
IsPreCategory.isAssociative isPreCategory = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
||||||
IsCategory.isAssociative isCategory = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
IsPreCategory.isIdentity isPreCategory = isIdentity
|
||||||
IsCategory.isIdentity isCategory = isIdentity
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
IsCategory.arrowsAreSets isCategory = arrowsAreSets
|
|
||||||
IsCategory.univalent isCategory = univalent
|
postulate univalent : Univalence.Univalent isIdentity
|
||||||
|
|
||||||
|
isCategory : IsCategory rawProduct
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = univalent
|
||||||
|
|
||||||
object : Category ℓ ℓ'
|
object : Category ℓ ℓ'
|
||||||
Category.raw object = rawProduct
|
Category.raw object = rawProduct
|
||||||
|
Category.isCategory object = isCategory
|
||||||
|
|
||||||
proj₁ : Functor object ℂ
|
fstF : Functor object ℂ
|
||||||
proj₁ = record
|
fstF = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ omap = fst ; fmap = fst }
|
{ omap = fst ; fmap = fst }
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ isIdentity = refl ; isDistributive = refl }
|
{ isIdentity = refl ; isDistributive = refl }
|
||||||
}
|
}
|
||||||
|
|
||||||
proj₂ : Functor object 𝔻
|
sndF : Functor object 𝔻
|
||||||
proj₂ = record
|
sndF = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ omap = snd ; fmap = snd }
|
{ omap = snd ; fmap = snd }
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
|
@ -141,17 +120,27 @@ module CatProduct {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
open module x₁ = Functor x₁
|
open module x₁ = Functor x₁
|
||||||
open module x₂ = Functor x₂
|
open module x₂ = Functor x₂
|
||||||
|
|
||||||
isUniqL : F[ proj₁ ∘ x ] ≡ x₁
|
isUniqL : F[ fstF ∘ x ] ≡ x₁
|
||||||
isUniqL = Functor≡ refl
|
isUniqL = Functor≡ refl
|
||||||
|
|
||||||
isUniqR : F[ proj₂ ∘ x ] ≡ x₂
|
isUniqR : F[ sndF ∘ x ] ≡ x₂
|
||||||
isUniqR = Functor≡ refl
|
isUniqR = Functor≡ refl
|
||||||
|
|
||||||
isUniq : F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂
|
isUniq : F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂
|
||||||
isUniq = isUniqL , isUniqR
|
isUniq = isUniqL , isUniqR
|
||||||
|
|
||||||
isProduct : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂)
|
isProduct : ∃![ x ] (F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂)
|
||||||
isProduct = x , isUniq
|
isProduct = x , isUniq , uq
|
||||||
|
where
|
||||||
|
module _ {y : Functor X object} (eq : F[ fstF ∘ y ] ≡ x₁ × F[ sndF ∘ y ] ≡ x₂) where
|
||||||
|
omapEq : Functor.omap x ≡ Functor.omap y
|
||||||
|
omapEq = {!!}
|
||||||
|
-- fmapEq : (λ i → {!{A B : ?} → Arrow A B → 𝔻 [ ? A , ? B ]!}) [ Functor.fmap x ≡ Functor.fmap y ]
|
||||||
|
-- fmapEq = {!!}
|
||||||
|
rawEq : Functor.raw x ≡ Functor.raw y
|
||||||
|
rawEq = {!!}
|
||||||
|
uq : x ≡ y
|
||||||
|
uq = Functor≡ rawEq
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
private
|
private
|
||||||
|
@ -163,11 +152,11 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
|
|
||||||
rawProduct : RawProduct Catℓ ℂ 𝔻
|
rawProduct : RawProduct Catℓ ℂ 𝔻
|
||||||
RawProduct.object rawProduct = P.object
|
RawProduct.object rawProduct = P.object
|
||||||
RawProduct.proj₁ rawProduct = P.proj₁
|
RawProduct.fst rawProduct = P.fstF
|
||||||
RawProduct.proj₂ rawProduct = P.proj₂
|
RawProduct.snd rawProduct = P.sndF
|
||||||
|
|
||||||
isProduct : IsProduct Catℓ _ _ rawProduct
|
isProduct : IsProduct Catℓ _ _ rawProduct
|
||||||
IsProduct.isProduct isProduct = P.isProduct
|
IsProduct.ump isProduct = P.isProduct
|
||||||
|
|
||||||
product : Product Catℓ ℂ 𝔻
|
product : Product Catℓ ℂ 𝔻
|
||||||
Product.raw product = rawProduct
|
Product.raw product = rawProduct
|
||||||
|
@ -180,110 +169,74 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
-- | The category of categories have expoentntials - and because it has products
|
-- | The category of categories have expoentntials - and because it has products
|
||||||
-- it is therefory also cartesian closed.
|
-- it is therefory also cartesian closed.
|
||||||
module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ 𝔻
|
||||||
|
renaming (identity to identityNT)
|
||||||
|
using ()
|
||||||
private
|
private
|
||||||
open Data.Product
|
|
||||||
open import Cat.Categories.Fun
|
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
Categoryℓ = Category ℓ ℓ
|
Categoryℓ = Category ℓ ℓ
|
||||||
open Fun ℂ 𝔻 renaming (identity to idN)
|
open Fun ℂ 𝔻 renaming (identity to idN)
|
||||||
|
|
||||||
omap : Functor ℂ 𝔻 × Object ℂ → Object 𝔻
|
omap : Functor ℂ 𝔻 × ℂ.Object → 𝔻.Object
|
||||||
omap (F , A) = Functor.omap F A
|
omap (F , A) = Functor.omap F A
|
||||||
|
|
||||||
-- The exponential object
|
-- The exponential object
|
||||||
object : Categoryℓ
|
object : Categoryℓ
|
||||||
object = Fun
|
object = Fun
|
||||||
|
|
||||||
module _ {dom cod : Functor ℂ 𝔻 × Object ℂ} where
|
module _ {dom cod : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
|
open Σ dom renaming (fst to F ; snd to A)
|
||||||
|
open Σ cod renaming (fst to G ; snd to B)
|
||||||
private
|
private
|
||||||
F : Functor ℂ 𝔻
|
|
||||||
F = proj₁ dom
|
|
||||||
A : Object ℂ
|
|
||||||
A = proj₂ dom
|
|
||||||
|
|
||||||
G : Functor ℂ 𝔻
|
|
||||||
G = proj₁ cod
|
|
||||||
B : Object ℂ
|
|
||||||
B = proj₂ cod
|
|
||||||
|
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
module G = Functor G
|
module G = Functor G
|
||||||
|
|
||||||
fmap : (pobj : NaturalTransformation F G × ℂ [ A , B ])
|
fmap : (pobj : NaturalTransformation F G × ℂ [ A , B ])
|
||||||
→ 𝔻 [ F.omap A , G.omap B ]
|
→ 𝔻 [ F.omap A , G.omap B ]
|
||||||
fmap ((θ , θNat) , f) = result
|
fmap ((θ , θNat) , f) = 𝔻 [ θ B ∘ F.fmap f ]
|
||||||
where
|
-- Alternatively:
|
||||||
θA : 𝔻 [ F.omap A , G.omap A ]
|
--
|
||||||
θA = θ A
|
-- fmap ((θ , θNat) , f) = 𝔻 [ G.fmap f ∘ θ A ]
|
||||||
θB : 𝔻 [ F.omap B , G.omap B ]
|
--
|
||||||
θB = θ B
|
-- Since they are equal by naturality of θ.
|
||||||
F→f : 𝔻 [ F.omap A , F.omap B ]
|
|
||||||
F→f = F.fmap f
|
|
||||||
G→f : 𝔻 [ G.omap A , G.omap B ]
|
|
||||||
G→f = G.fmap f
|
|
||||||
l : 𝔻 [ F.omap A , G.omap B ]
|
|
||||||
l = 𝔻 [ θB ∘ F.fmap f ]
|
|
||||||
r : 𝔻 [ F.omap A , G.omap B ]
|
|
||||||
r = 𝔻 [ G.fmap f ∘ θA ]
|
|
||||||
result : 𝔻 [ F.omap A , G.omap B ]
|
|
||||||
result = l
|
|
||||||
|
|
||||||
open CatProduct renaming (object to _⊗_) using ()
|
open CatProduct renaming (object to _⊗_) using ()
|
||||||
|
|
||||||
module _ {c : Functor ℂ 𝔻 × Object ℂ} where
|
module _ {c : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
private
|
open Σ c renaming (fst to F ; snd to C)
|
||||||
F : Functor ℂ 𝔻
|
|
||||||
F = proj₁ c
|
|
||||||
C : Object ℂ
|
|
||||||
C = proj₂ c
|
|
||||||
|
|
||||||
ident : fmap {c} {c} (NT.identity F , 𝟙 ℂ {A = proj₂ c}) ≡ 𝟙 𝔻
|
ident : fmap {c} {c} (identityNT F , ℂ.identity {A = snd c}) ≡ 𝔻.identity
|
||||||
ident = begin
|
ident = begin
|
||||||
fmap {c} {c} (𝟙 (object ⊗ ℂ) {c}) ≡⟨⟩
|
fmap {c} {c} (Category.identity (object ⊗ ℂ) {c}) ≡⟨⟩
|
||||||
fmap {c} {c} (idN F , 𝟙 ℂ) ≡⟨⟩
|
fmap {c} {c} (idN F , ℂ.identity) ≡⟨⟩
|
||||||
𝔻 [ identityTrans F C ∘ F.fmap (𝟙 ℂ)] ≡⟨⟩
|
𝔻 [ identityTrans F C ∘ F.fmap ℂ.identity ] ≡⟨⟩
|
||||||
𝔻 [ 𝟙 𝔻 ∘ F.fmap (𝟙 ℂ)] ≡⟨ proj₂ 𝔻.isIdentity ⟩
|
𝔻 [ 𝔻.identity ∘ F.fmap ℂ.identity ] ≡⟨ 𝔻.leftIdentity ⟩
|
||||||
F.fmap (𝟙 ℂ) ≡⟨ F.isIdentity ⟩
|
F.fmap ℂ.identity ≡⟨ F.isIdentity ⟩
|
||||||
𝟙 𝔻 ∎
|
𝔻.identity ∎
|
||||||
where
|
where
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
|
|
||||||
module _ {F×A G×B H×C : Functor ℂ 𝔻 × Object ℂ} where
|
module _ {F×A G×B H×C : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
|
open Σ F×A renaming (fst to F ; snd to A)
|
||||||
|
open Σ G×B renaming (fst to G ; snd to B)
|
||||||
|
open Σ H×C renaming (fst to H ; snd to C)
|
||||||
private
|
private
|
||||||
F = F×A .proj₁
|
|
||||||
A = F×A .proj₂
|
|
||||||
G = G×B .proj₁
|
|
||||||
B = G×B .proj₂
|
|
||||||
H = H×C .proj₁
|
|
||||||
C = H×C .proj₂
|
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
module G = Functor G
|
module G = Functor G
|
||||||
module H = Functor H
|
module H = Functor H
|
||||||
|
|
||||||
module _
|
module _
|
||||||
-- NaturalTransformation F G × ℂ .Arrow A B
|
|
||||||
{θ×f : NaturalTransformation F G × ℂ [ A , B ]}
|
{θ×f : NaturalTransformation F G × ℂ [ A , B ]}
|
||||||
{η×g : NaturalTransformation G H × ℂ [ B , C ]} where
|
{η×g : NaturalTransformation G H × ℂ [ B , C ]} where
|
||||||
|
open Σ θ×f renaming (fst to θNT ; snd to f)
|
||||||
|
open Σ θNT renaming (fst to θ ; snd to θNat)
|
||||||
|
open Σ η×g renaming (fst to ηNT ; snd to g)
|
||||||
|
open Σ ηNT renaming (fst to η ; snd to ηNat)
|
||||||
private
|
private
|
||||||
θ : Transformation F G
|
|
||||||
θ = proj₁ (proj₁ θ×f)
|
|
||||||
θNat : Natural F G θ
|
|
||||||
θNat = proj₂ (proj₁ θ×f)
|
|
||||||
f : ℂ [ A , B ]
|
|
||||||
f = proj₂ θ×f
|
|
||||||
η : Transformation G H
|
|
||||||
η = proj₁ (proj₁ η×g)
|
|
||||||
ηNat : Natural G H η
|
|
||||||
ηNat = proj₂ (proj₁ η×g)
|
|
||||||
g : ℂ [ B , C ]
|
|
||||||
g = proj₂ η×g
|
|
||||||
|
|
||||||
ηθNT : NaturalTransformation F H
|
ηθNT : NaturalTransformation F H
|
||||||
ηθNT = Category._∘_ Fun {F} {G} {H} (η , ηNat) (θ , θNat)
|
ηθNT = NT[_∘_] {F} {G} {H} ηNT θNT
|
||||||
|
open Σ ηθNT renaming (fst to ηθ ; snd to ηθNat)
|
||||||
ηθ = proj₁ ηθNT
|
|
||||||
ηθNat = proj₂ ηθNT
|
|
||||||
|
|
||||||
isDistributive :
|
isDistributive :
|
||||||
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F.fmap ( ℂ [ g ∘ f ] ) ]
|
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F.fmap ( ℂ [ g ∘ f ] ) ]
|
||||||
|
@ -327,18 +280,18 @@ module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
: Functor 𝔸 object → Functor ℂ ℂ
|
: Functor 𝔸 object → Functor ℂ ℂ
|
||||||
→ Functor (𝔸 ⊗ ℂ) (object ⊗ ℂ)
|
→ Functor (𝔸 ⊗ ℂ) (object ⊗ ℂ)
|
||||||
transpose : Functor 𝔸 object
|
transpose : Functor 𝔸 object
|
||||||
eq : F[ eval ∘ (parallelProduct transpose (identity {C = ℂ})) ] ≡ F
|
eq : F[ eval ∘ (parallelProduct transpose (Functors.identity {ℂ = ℂ})) ] ≡ F
|
||||||
-- eq : F[ :eval: ∘ {!!} ] ≡ F
|
-- eq : F[ :eval: ∘ {!!} ] ≡ F
|
||||||
-- eq : Catℓ [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (𝟙 Catℓ {o = ℂ})) ] ≡ F
|
-- eq : Catℓ [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (identity Catℓ {o = ℂ})) ] ≡ F
|
||||||
-- eq' : (Catℓ [ :eval: ∘
|
-- eq' : (Catℓ [ :eval: ∘
|
||||||
-- (record { product = product } HasProducts.|×| transpose)
|
-- (record { product = product } HasProducts.|×| transpose)
|
||||||
-- (𝟙 Catℓ)
|
-- (identity Catℓ)
|
||||||
-- ])
|
-- ])
|
||||||
-- ≡ F
|
-- ≡ F
|
||||||
|
|
||||||
-- For some reason after `e8215b2c051062c6301abc9b3f6ec67106259758`
|
-- For some reason after `e8215b2c051062c6301abc9b3f6ec67106259758`
|
||||||
-- `catTranspose` makes Agda hang. catTranspose : ∃![ F~ ] (Catℓ [
|
-- `catTranspose` makes Agda hang. catTranspose : ∃![ F~ ] (Catℓ [
|
||||||
-- :eval: ∘ (parallelProduct F~ (𝟙 Catℓ {o = ℂ}))] ≡ F) catTranspose =
|
-- :eval: ∘ (parallelProduct F~ (identity Catℓ {o = ℂ}))] ≡ F) catTranspose =
|
||||||
-- transpose , eq
|
-- transpose , eq
|
||||||
|
|
||||||
-- We don't care about filling out the holes below since they are anyways hidden
|
-- We don't care about filling out the holes below since they are anyways hidden
|
||||||
|
@ -362,8 +315,8 @@ module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where
|
||||||
exponent : Exponential Catℓ ℂ 𝔻
|
exponent : Exponential Catℓ ℂ 𝔻
|
||||||
exponent = record
|
exponent = record
|
||||||
{ obj = CatExp.object
|
{ obj = CatExp.object
|
||||||
; eval = eval
|
; eval = {!eval!}
|
||||||
; isExponential = isExponential
|
; isExponential = {!isExponential!}
|
||||||
}
|
}
|
||||||
|
|
||||||
hasExponentials : HasExponentials Catℓ
|
hasExponentials : HasExponentials Catℓ
|
||||||
|
|
|
@ -1,28 +1,24 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --allow-unsolved-metas #-}
|
||||||
module Cat.Categories.Cube where
|
module Cat.Categories.Cube where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
open import Level
|
open import Level
|
||||||
open import Data.Bool hiding (T)
|
open import Data.Bool hiding (T)
|
||||||
open import Data.Sum hiding ([_,_])
|
open import Data.Sum hiding ([_,_])
|
||||||
open import Data.Unit
|
open import Data.Unit
|
||||||
open import Data.Empty
|
open import Data.Empty
|
||||||
open import Data.Product
|
|
||||||
open import Cubical
|
|
||||||
open import Function
|
|
||||||
open import Relation.Nullary
|
open import Relation.Nullary
|
||||||
open import Relation.Nullary.Decidable
|
open import Relation.Nullary.Decidable
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Equality
|
|
||||||
open Equality.Data.Product
|
|
||||||
|
|
||||||
-- See chapter 1 for a discussion on how presheaf categories are CwF's.
|
-- See chapter 1 for a discussion on how presheaf categories are CwF's.
|
||||||
|
|
||||||
-- See section 6.8 in Huber's thesis for details on how to implement the
|
-- See section 6.8 in Huber's thesis for details on how to implement the
|
||||||
-- categorical version of CTT
|
-- categorical version of CTT
|
||||||
|
|
||||||
open Category hiding (_∘_)
|
open Category hiding (_<<<_)
|
||||||
open Functor
|
open Functor
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
||||||
|
@ -58,9 +54,9 @@ module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
||||||
→ case (f i) of λ
|
→ case (f i) of λ
|
||||||
{ (inj₁ (fi , _)) → case (f j) of λ
|
{ (inj₁ (fi , _)) → case (f j) of λ
|
||||||
{ (inj₁ (fj , _)) → fi ≡ fj → i ≡ j
|
{ (inj₁ (fj , _)) → fi ≡ fj → i ≡ j
|
||||||
; (inj₂ _) → Lift ⊤
|
; (inj₂ _) → Lift _ ⊤
|
||||||
}
|
}
|
||||||
; (inj₂ _) → Lift ⊤
|
; (inj₂ _) → Lift _ ⊤
|
||||||
}
|
}
|
||||||
|
|
||||||
Hom = Σ Hom' rules
|
Hom = Σ Hom' rules
|
||||||
|
@ -70,8 +66,8 @@ module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
||||||
Rawℂ : RawCategory ℓ ℓ -- ℓo (lsuc lzero ⊔ ℓo)
|
Rawℂ : RawCategory ℓ ℓ -- ℓo (lsuc lzero ⊔ ℓo)
|
||||||
Raw.Object Rawℂ = FiniteDecidableSubset
|
Raw.Object Rawℂ = FiniteDecidableSubset
|
||||||
Raw.Arrow Rawℂ = Hom
|
Raw.Arrow Rawℂ = Hom
|
||||||
Raw.𝟙 Rawℂ {o} = inj₁ , λ { (i , ii) (j , jj) eq → Σ≡ eq {!refl!} }
|
Raw.identity Rawℂ {o} = inj₁ , λ { (i , ii) (j , jj) eq → Σ≡ eq {!refl!} }
|
||||||
Raw._∘_ Rawℂ = {!!}
|
Raw._<<<_ Rawℂ = {!!}
|
||||||
|
|
||||||
postulate IsCategoryℂ : IsCategory Rawℂ
|
postulate IsCategoryℂ : IsCategory Rawℂ
|
||||||
|
|
||||||
|
|
|
@ -1,14 +1,11 @@
|
||||||
module Cat.Categories.CwF where
|
module Cat.Categories.CwF where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Categories.Fam
|
open import Cat.Categories.Fam
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
open Category
|
|
||||||
open Functor
|
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} where
|
module _ {ℓa ℓb : Level} where
|
||||||
record CwF : Set (lsuc (ℓa ⊔ ℓb)) where
|
record CwF : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
@ -16,37 +13,38 @@ module _ {ℓa ℓb : Level} where
|
||||||
field
|
field
|
||||||
-- "A base category"
|
-- "A base category"
|
||||||
ℂ : Category ℓa ℓb
|
ℂ : Category ℓa ℓb
|
||||||
|
module ℂ = Category ℂ
|
||||||
-- It's objects are called contexts
|
-- It's objects are called contexts
|
||||||
Contexts = Object ℂ
|
Contexts = ℂ.Object
|
||||||
-- It's arrows are called substitutions
|
-- It's arrows are called substitutions
|
||||||
Substitutions = Arrow ℂ
|
Substitutions = ℂ.Arrow
|
||||||
field
|
field
|
||||||
-- A functor T
|
-- A functor T
|
||||||
T : Functor (opposite ℂ) (Fam ℓa ℓb)
|
T : Functor (opposite ℂ) (Fam ℓa ℓb)
|
||||||
-- Empty context
|
-- Empty context
|
||||||
[] : Terminal ℂ
|
[] : ℂ.Terminal
|
||||||
private
|
private
|
||||||
module T = Functor T
|
module T = Functor T
|
||||||
Type : (Γ : Object ℂ) → Set ℓa
|
Type : (Γ : ℂ.Object) → Set ℓa
|
||||||
Type Γ = proj₁ (proj₁ (T.omap Γ))
|
Type Γ = fst (fst (T.omap Γ))
|
||||||
|
|
||||||
module _ {Γ : Object ℂ} {A : Type Γ} where
|
module _ {Γ : ℂ.Object} {A : Type Γ} where
|
||||||
|
|
||||||
-- module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
-- module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
||||||
-- k : Σ (proj₁ (omap T B) → proj₁ (omap T A))
|
-- k : Σ (fst (omap T B) → fst (omap T A))
|
||||||
-- (λ f →
|
-- (λ f →
|
||||||
-- {x : proj₁ (omap T B)} →
|
-- {x : fst (omap T B)} →
|
||||||
-- proj₂ (omap T B) x → proj₂ (omap T A) (f x))
|
-- snd (omap T B) x → snd (omap T A) (f x))
|
||||||
-- k = T.fmap γ
|
-- k = T.fmap γ
|
||||||
-- k₁ : proj₁ (omap T B) → proj₁ (omap T A)
|
-- k₁ : fst (omap T B) → fst (omap T A)
|
||||||
-- k₁ = proj₁ k
|
-- k₁ = fst k
|
||||||
-- k₂ : ({x : proj₁ (omap T B)} →
|
-- k₂ : ({x : fst (omap T B)} →
|
||||||
-- proj₂ (omap T B) x → proj₂ (omap T A) (k₁ x))
|
-- snd (omap T B) x → snd (omap T A) (k₁ x))
|
||||||
-- k₂ = proj₂ k
|
-- k₂ = snd k
|
||||||
|
|
||||||
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
||||||
field
|
field
|
||||||
Γ&A : Object ℂ
|
Γ&A : ℂ.Object
|
||||||
proj1 : ℂ [ Γ&A , Γ ]
|
proj1 : ℂ [ Γ&A , Γ ]
|
||||||
-- proj2 : ????
|
-- proj2 : ????
|
||||||
|
|
||||||
|
|
|
@ -1,70 +1,61 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --allow-unsolved-metas #-}
|
||||||
module Cat.Categories.Fam where
|
module Cat.Categories.Fam where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
open import Data.Product
|
|
||||||
import Function
|
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.Universe
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Equality
|
|
||||||
|
|
||||||
open Equality.Data.Product
|
|
||||||
|
|
||||||
module _ (ℓa ℓb : Level) where
|
module _ (ℓa ℓb : Level) where
|
||||||
private
|
private
|
||||||
Object = Σ[ hA ∈ hSet {ℓa} ] (proj₁ hA → hSet {ℓb})
|
Object = Σ[ hA ∈ hSet ℓa ] (fst hA → hSet ℓb)
|
||||||
Arr : Object → Object → Set (ℓa ⊔ ℓb)
|
Arr : Object → Object → Set (ℓa ⊔ ℓb)
|
||||||
Arr ((A , _) , B) ((A' , _) , B') = Σ[ f ∈ (A → A') ] ({x : A} → proj₁ (B x) → proj₁ (B' (f x)))
|
Arr ((A , _) , B) ((A' , _) , B') = Σ[ f ∈ (A → A') ] ({x : A} → fst (B x) → fst (B' (f x)))
|
||||||
𝟙 : {A : Object} → Arr A A
|
identity : {A : Object} → Arr A A
|
||||||
proj₁ 𝟙 = λ x → x
|
fst identity = λ x → x
|
||||||
proj₂ 𝟙 = λ b → b
|
snd identity = λ b → b
|
||||||
_∘_ : {a b c : Object} → Arr b c → Arr a b → Arr a c
|
_<<<_ : {a b c : Object} → Arr b c → Arr a b → Arr a c
|
||||||
(g , g') ∘ (f , f') = g Function.∘ f , g' Function.∘ f'
|
(g , g') <<< (f , f') = g ∘ f , g' ∘ f'
|
||||||
|
|
||||||
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||||
RawFam = record
|
RawFam = record
|
||||||
{ Object = Object
|
{ Object = Object
|
||||||
; Arrow = Arr
|
; Arrow = Arr
|
||||||
; 𝟙 = λ { {A} → 𝟙 {A = A}}
|
; identity = λ { {A} → identity {A = A}}
|
||||||
; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
|
; _<<<_ = λ {a b c} → _<<<_ {a} {b} {c}
|
||||||
}
|
}
|
||||||
|
|
||||||
open RawCategory RawFam hiding (Object ; 𝟙)
|
open RawCategory RawFam hiding (Object ; identity)
|
||||||
|
|
||||||
isAssociative : IsAssociative
|
isAssociative : IsAssociative
|
||||||
isAssociative = Σ≡ refl refl
|
isAssociative = Σ≡ refl refl
|
||||||
|
|
||||||
isIdentity : IsIdentity λ { {A} → 𝟙 {A} }
|
isIdentity : IsIdentity λ { {A} → identity {A} }
|
||||||
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
|
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
|
||||||
|
|
||||||
open import Cubical.NType.Properties
|
isPreCategory : IsPreCategory RawFam
|
||||||
open import Cubical.Sigma
|
IsPreCategory.isAssociative isPreCategory
|
||||||
instance
|
{A} {B} {C} {D} {f} {g} {h} = isAssociative {A} {B} {C} {D} {f} {g} {h}
|
||||||
isCategory : IsCategory RawFam
|
IsPreCategory.isIdentity isPreCategory
|
||||||
isCategory = record
|
{A} {B} {f} = isIdentity {A} {B} {f = f}
|
||||||
{ isAssociative = λ {A} {B} {C} {D} {f} {g} {h} → isAssociative {A} {B} {C} {D} {f} {g} {h}
|
IsPreCategory.arrowsAreSets isPreCategory
|
||||||
; isIdentity = λ {A} {B} {f} → isIdentity {A} {B} {f = f}
|
{(A , hA) , famA} {(B , hB) , famB}
|
||||||
; arrowsAreSets = λ {
|
= setSig
|
||||||
{((A , hA) , famA)}
|
{sA = setPi λ _ → hB}
|
||||||
{((B , hB) , famB)}
|
{sB = λ f →
|
||||||
→ setSig
|
let
|
||||||
{sA = setPi λ _ → hB}
|
helpr : isSet ((a : A) → fst (famA a) → fst (famB (f a)))
|
||||||
{sB = λ f →
|
helpr = setPi λ a → setPi λ _ → snd (famB (f a))
|
||||||
let
|
-- It's almost like above, but where the first argument is
|
||||||
helpr : isSet ((a : A) → proj₁ (famA a) → proj₁ (famB (f a)))
|
-- implicit.
|
||||||
helpr = setPi λ a → setPi λ _ → proj₂ (famB (f a))
|
res : isSet ({a : A} → fst (famA a) → fst (famB (f a)))
|
||||||
-- It's almost like above, but where the first argument is
|
res = {!!}
|
||||||
-- implicit.
|
in res
|
||||||
res : isSet ({a : A} → proj₁ (famA a) → proj₁ (famB (f a)))
|
|
||||||
res = {!!}
|
|
||||||
in res
|
|
||||||
}
|
|
||||||
}
|
|
||||||
; univalent = {!!}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
isCategory : IsCategory RawFam
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = {!!}
|
||||||
|
|
||||||
Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||||
Category.raw Fam = RawFam
|
Category.raw Fam = RawFam
|
||||||
|
Category.isCategory Fam = isCategory
|
||||||
|
|
|
@ -1,62 +1,81 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
||||||
module Cat.Categories.Free where
|
module Cat.Categories.Free where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude hiding (Path ; empty)
|
||||||
open import Cubical hiding (Path ; isSet ; empty)
|
|
||||||
open import Data.Product
|
open import Relation.Binary
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
data Path {ℓ ℓ' : Level} {A : Set ℓ} (R : A → A → Set ℓ') : (a b : A) → Set (ℓ ⊔ ℓ') where
|
module _ {ℓ : Level} {A : Set ℓ} {ℓr : Level} where
|
||||||
empty : {a : A} → Path R a a
|
data Path (R : Rel A ℓr) : (a b : A) → Set (ℓ ⊔ ℓr) where
|
||||||
cons : {a b c : A} → R b c → Path R a b → Path R a c
|
empty : {a : A} → Path R a a
|
||||||
|
cons : {a b c : A} → R b c → Path R a b → Path R a c
|
||||||
|
|
||||||
concatenate _++_ : ∀ {ℓ ℓ'} {A : Set ℓ} {a b c : A} {R : A → A → Set ℓ'} → Path R b c → Path R a b → Path R a c
|
module _ {R : Rel A ℓr} where
|
||||||
concatenate empty p = p
|
concatenate : {a b c : A} → Path R b c → Path R a b → Path R a c
|
||||||
concatenate (cons x q) p = cons x (concatenate q p)
|
concatenate empty p = p
|
||||||
_++_ = concatenate
|
concatenate (cons x q) p = cons x (concatenate q p)
|
||||||
|
_++_ : {a b c : A} → Path R b c → Path R a b → Path R a c
|
||||||
|
a ++ b = concatenate a b
|
||||||
|
|
||||||
singleton : ∀ {ℓ} {𝓤 : Set ℓ} {ℓr} {R : 𝓤 → 𝓤 → Set ℓr} {A B : 𝓤} → R A B → Path R A B
|
singleton : {a b : A} → R a b → Path R a b
|
||||||
singleton f = cons f empty
|
singleton f = cons f empty
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
p-isAssociative : {A B C D : Object} {r : Path Arrow A B} {q : Path Arrow B C} {p : Path Arrow C D}
|
RawFree : RawCategory ℓa (ℓa ⊔ ℓb)
|
||||||
|
RawCategory.Object RawFree = ℂ.Object
|
||||||
|
RawCategory.Arrow RawFree = Path ℂ.Arrow
|
||||||
|
RawCategory.identity RawFree = empty
|
||||||
|
RawCategory._<<<_ RawFree = concatenate
|
||||||
|
|
||||||
|
open RawCategory RawFree
|
||||||
|
|
||||||
|
isAssociative : {A B C D : ℂ.Object} {r : Path ℂ.Arrow A B} {q : Path ℂ.Arrow B C} {p : Path ℂ.Arrow C D}
|
||||||
→ p ++ (q ++ r) ≡ (p ++ q) ++ r
|
→ p ++ (q ++ r) ≡ (p ++ q) ++ r
|
||||||
p-isAssociative {r = r} {q} {empty} = refl
|
isAssociative {r = r} {q} {empty} = refl
|
||||||
p-isAssociative {A} {B} {C} {D} {r = r} {q} {cons x p} = begin
|
isAssociative {A} {B} {C} {D} {r = r} {q} {cons x p} = begin
|
||||||
cons x p ++ (q ++ r) ≡⟨ cong (cons x) lem ⟩
|
cons x p ++ (q ++ r) ≡⟨ cong (cons x) lem ⟩
|
||||||
cons x ((p ++ q) ++ r) ≡⟨⟩
|
cons x ((p ++ q) ++ r) ≡⟨⟩
|
||||||
(cons x p ++ q) ++ r ∎
|
(cons x p ++ q) ++ r ∎
|
||||||
where
|
where
|
||||||
lem : p ++ (q ++ r) ≡ ((p ++ q) ++ r)
|
lem : p ++ (q ++ r) ≡ ((p ++ q) ++ r)
|
||||||
lem = p-isAssociative {r = r} {q} {p}
|
lem = isAssociative {r = r} {q} {p}
|
||||||
|
|
||||||
ident-r : ∀ {A} {B} {p : Path Arrow A B} → concatenate p empty ≡ p
|
ident-r : ∀ {A} {B} {p : Path ℂ.Arrow A B} → concatenate p empty ≡ p
|
||||||
ident-r {p = empty} = refl
|
ident-r {p = empty} = refl
|
||||||
ident-r {p = cons x p} = cong (cons x) ident-r
|
ident-r {p = cons x p} = cong (cons x) ident-r
|
||||||
|
|
||||||
ident-l : ∀ {A} {B} {p : Path Arrow A B} → concatenate empty p ≡ p
|
ident-l : ∀ {A} {B} {p : Path ℂ.Arrow A B} → concatenate empty p ≡ p
|
||||||
ident-l = refl
|
ident-l = refl
|
||||||
|
|
||||||
module _ {A B : Object} where
|
isIdentity : IsIdentity identity
|
||||||
isSet : Cubical.isSet (Path Arrow A B)
|
isIdentity = ident-l , ident-r
|
||||||
isSet a b p q = {!!}
|
|
||||||
|
|
||||||
RawFree : RawCategory ℓ (ℓ ⊔ ℓ')
|
open Univalence isIdentity
|
||||||
RawFree = record
|
|
||||||
{ Object = Object
|
module _ {A B : ℂ.Object} where
|
||||||
; Arrow = Path Arrow
|
arrowsAreSets : isSet (Path ℂ.Arrow A B)
|
||||||
; 𝟙 = empty
|
arrowsAreSets a b p q = {!!}
|
||||||
; _∘_ = concatenate
|
|
||||||
}
|
isPreCategory : IsPreCategory RawFree
|
||||||
RawIsCategoryFree : IsCategory RawFree
|
IsPreCategory.isAssociative isPreCategory {f = f} {g} {h} = isAssociative {r = f} {g} {h}
|
||||||
RawIsCategoryFree = record
|
IsPreCategory.isIdentity isPreCategory = isIdentity
|
||||||
{ isAssociative = λ { {f = f} {g} {h} → p-isAssociative {r = f} {g} {h}}
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
; isIdentity = ident-r , ident-l
|
|
||||||
; arrowsAreSets = {!!}
|
module _ {A B : ℂ.Object} where
|
||||||
; univalent = {!!}
|
eqv : isEquiv (A ≡ B) (A ≊ B) (Univalence.idToIso isIdentity A B)
|
||||||
}
|
eqv = {!!}
|
||||||
|
|
||||||
|
univalent : Univalent
|
||||||
|
univalent = eqv
|
||||||
|
|
||||||
|
isCategory : IsCategory RawFree
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = univalent
|
||||||
|
|
||||||
|
Free : Category _ _
|
||||||
|
Free = record { raw = RawFree ; isCategory = isCategory }
|
||||||
|
|
|
@ -1,185 +1,219 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --allow-unsolved-metas --cubical --caching #-}
|
||||||
module Cat.Categories.Fun where
|
module Cat.Categories.Fun where
|
||||||
|
|
||||||
open import Agda.Primitive
|
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.GradLemma
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor hiding (identity)
|
open import Cat.Category.Functor
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
|
as NaturalTransformation
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
|
|
||||||
module Fun {ℓc ℓc' ℓd ℓd' : Level} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
module Fun {ℓc ℓc' ℓd ℓd' : Level} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
module NT = NaturalTransformation ℂ 𝔻
|
open NaturalTransformation ℂ 𝔻 public hiding (module Properties)
|
||||||
open NT public
|
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
private
|
|
||||||
module _ {A B C D : Functor ℂ 𝔻} {θ' : NaturalTransformation A B}
|
|
||||||
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
|
|
||||||
θ = proj₁ θ'
|
|
||||||
η = proj₁ η'
|
|
||||||
ζ = proj₁ ζ'
|
|
||||||
θNat = proj₂ θ'
|
|
||||||
ηNat = proj₂ η'
|
|
||||||
ζNat = proj₂ ζ'
|
|
||||||
L : NaturalTransformation A D
|
|
||||||
L = (NT[_∘_] {A} {C} {D} ζ' (NT[_∘_] {A} {B} {C} η' θ'))
|
|
||||||
R : NaturalTransformation A D
|
|
||||||
R = (NT[_∘_] {A} {B} {D} (NT[_∘_] {B} {C} {D} ζ' η') θ')
|
|
||||||
_g⊕f_ = NT[_∘_] {A} {B} {C}
|
|
||||||
_h⊕g_ = NT[_∘_] {B} {C} {D}
|
|
||||||
isAssociative : L ≡ R
|
|
||||||
isAssociative = lemSig (naturalIsProp {F = A} {D})
|
|
||||||
L R (funExt (λ x → 𝔻.isAssociative))
|
|
||||||
|
|
||||||
private
|
module _ where
|
||||||
module _ {A B : Functor ℂ 𝔻} {f : NaturalTransformation A B} where
|
-- Functor categories. Objects are functors, arrows are natural transformations.
|
||||||
allNatural = naturalIsProp {F = A} {B}
|
raw : RawCategory (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
f' = proj₁ f
|
RawCategory.Object raw = Functor ℂ 𝔻
|
||||||
eq-r : ∀ C → (𝔻 [ f' C ∘ identityTrans A C ]) ≡ f' C
|
RawCategory.Arrow raw = NaturalTransformation
|
||||||
eq-r C = begin
|
RawCategory.identity raw {F} = identity F
|
||||||
𝔻 [ f' C ∘ identityTrans A C ] ≡⟨⟩
|
RawCategory._<<<_ raw {F} {G} {H} = NT[_∘_] {F} {G} {H}
|
||||||
𝔻 [ f' C ∘ 𝔻.𝟙 ] ≡⟨ proj₁ 𝔻.isIdentity ⟩
|
|
||||||
f' C ∎
|
|
||||||
eq-l : ∀ C → (𝔻 [ identityTrans B C ∘ f' C ]) ≡ f' C
|
|
||||||
eq-l C = proj₂ 𝔻.isIdentity
|
|
||||||
ident-r : (NT[_∘_] {A} {A} {B} f (NT.identity A)) ≡ f
|
|
||||||
ident-r = lemSig allNatural _ _ (funExt eq-r)
|
|
||||||
ident-l : (NT[_∘_] {A} {B} {B} (NT.identity B) f) ≡ f
|
|
||||||
ident-l = lemSig allNatural _ _ (funExt eq-l)
|
|
||||||
isIdentity
|
|
||||||
: (NT[_∘_] {A} {A} {B} f (NT.identity A)) ≡ f
|
|
||||||
× (NT[_∘_] {A} {B} {B} (NT.identity B) f) ≡ f
|
|
||||||
isIdentity = ident-r , ident-l
|
|
||||||
-- Functor categories. Objects are functors, arrows are natural transformations.
|
|
||||||
RawFun : RawCategory (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
|
||||||
RawFun = record
|
|
||||||
{ Object = Functor ℂ 𝔻
|
|
||||||
; Arrow = NaturalTransformation
|
|
||||||
; 𝟙 = λ {F} → NT.identity F
|
|
||||||
; _∘_ = λ {F G H} → NT[_∘_] {F} {G} {H}
|
|
||||||
}
|
|
||||||
|
|
||||||
open RawCategory RawFun
|
module _ where
|
||||||
open Univalence RawFun
|
open RawCategory raw hiding (identity)
|
||||||
module _ {A B : Functor ℂ 𝔻} where
|
open NaturalTransformation.Properties ℂ 𝔻
|
||||||
module A = Functor A
|
|
||||||
module B = Functor B
|
|
||||||
module _ (p : A ≡ B) where
|
|
||||||
omapP : A.omap ≡ B.omap
|
|
||||||
omapP i = Functor.omap (p i)
|
|
||||||
|
|
||||||
coerceAB : ∀ {X} → 𝔻 [ A.omap X , A.omap X ] ≡ 𝔻 [ A.omap X , B.omap X ]
|
isPreCategory : IsPreCategory raw
|
||||||
coerceAB {X} = cong (λ φ → 𝔻 [ A.omap X , φ X ]) omapP
|
IsPreCategory.isAssociative isPreCategory {A} {B} {C} {D} = isAssociative {A} {B} {C} {D}
|
||||||
|
IsPreCategory.isIdentity isPreCategory {A} {B} = isIdentity {A} {B}
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory {F} {G} = naturalTransformationIsSet {F} {G}
|
||||||
|
|
||||||
-- The transformation will be the identity on 𝔻. Such an arrow has the
|
open IsPreCategory isPreCategory hiding (identity)
|
||||||
-- type `A.omap A → A.omap A`. Which we can coerce to have the type
|
|
||||||
-- `A.omap → B.omap` since `A` and `B` are equal.
|
|
||||||
coe𝟙 : Transformation A B
|
|
||||||
coe𝟙 X = coe coerceAB 𝔻.𝟙
|
|
||||||
|
|
||||||
module _ {a b : ℂ.Object} (f : ℂ [ a , b ]) where
|
module _ {F G : Functor ℂ 𝔻} (p : F ≡ G) where
|
||||||
nat' : 𝔻 [ coe𝟙 b ∘ A.fmap f ] ≡ 𝔻 [ B.fmap f ∘ coe𝟙 a ]
|
private
|
||||||
nat' = begin
|
module F = Functor F
|
||||||
(𝔻 [ coe𝟙 b ∘ A.fmap f ]) ≡⟨ {!!} ⟩
|
module G = Functor G
|
||||||
(𝔻 [ B.fmap f ∘ coe𝟙 a ]) ∎
|
p-omap : F.omap ≡ G.omap
|
||||||
|
p-omap = cong Functor.omap p
|
||||||
|
pp : {C : ℂ.Object} → 𝔻 [ Functor.omap F C , Functor.omap F C ] ≡ 𝔻 [ Functor.omap F C , Functor.omap G C ]
|
||||||
|
pp {C} = cong (λ f → 𝔻 [ Functor.omap F C , f C ]) p-omap
|
||||||
|
module _ {C : ℂ.Object} where
|
||||||
|
p* : F.omap C ≡ G.omap C
|
||||||
|
p* = cong (_$ C) p-omap
|
||||||
|
iso : F.omap C 𝔻.≊ G.omap C
|
||||||
|
iso = 𝔻.idToIso _ _ p*
|
||||||
|
open Σ iso renaming (fst to f→g) public
|
||||||
|
open Σ (snd iso) renaming (fst to g→f ; snd to inv) public
|
||||||
|
lem : coe (pp {C}) 𝔻.identity ≡ f→g
|
||||||
|
lem = trans (𝔻.9-1-9-right {b = Functor.omap F C} 𝔻.identity p*) 𝔻.rightIdentity
|
||||||
|
|
||||||
transs : (i : I) → Transformation A (p i)
|
-- idToNatTrans : NaturalTransformation F G
|
||||||
transs = {!!}
|
-- idToNatTrans = (λ C → coe pp 𝔻.identity) , λ f → begin
|
||||||
|
-- coe pp 𝔻.identity 𝔻.<<< F.fmap f ≡⟨ cong (𝔻._<<< F.fmap f) lem ⟩
|
||||||
|
-- -- Just need to show that f→g is a natural transformation
|
||||||
|
-- -- I know that it has an inverse; g→f
|
||||||
|
-- f→g 𝔻.<<< F.fmap f ≡⟨ {!lem!} ⟩
|
||||||
|
-- G.fmap f 𝔻.<<< f→g ≡⟨ cong (G.fmap f 𝔻.<<<_) (sym lem) ⟩
|
||||||
|
-- G.fmap f 𝔻.<<< coe pp 𝔻.identity ∎
|
||||||
|
|
||||||
natt : (i : I) → Natural A (p i) {!!}
|
module _ {A B : Functor ℂ 𝔻} where
|
||||||
natt = {!!}
|
module A = Functor A
|
||||||
|
module B = Functor B
|
||||||
|
module _ (iso : A ≊ B) where
|
||||||
|
omapEq : A.omap ≡ B.omap
|
||||||
|
omapEq = funExt eq
|
||||||
|
where
|
||||||
|
module _ (C : ℂ.Object) where
|
||||||
|
f : 𝔻.Arrow (A.omap C) (B.omap C)
|
||||||
|
f = fst (fst iso) C
|
||||||
|
g : 𝔻.Arrow (B.omap C) (A.omap C)
|
||||||
|
g = fst (fst (snd iso)) C
|
||||||
|
inv : 𝔻.IsInverseOf f g
|
||||||
|
inv
|
||||||
|
= ( begin
|
||||||
|
g 𝔻.<<< f ≡⟨ cong (λ x → fst x $ C) (fst (snd (snd iso))) ⟩
|
||||||
|
𝔻.identity ∎
|
||||||
|
)
|
||||||
|
, ( begin
|
||||||
|
f 𝔻.<<< g ≡⟨ cong (λ x → fst x $ C) (snd (snd (snd iso))) ⟩
|
||||||
|
𝔻.identity ∎
|
||||||
|
)
|
||||||
|
isoC : A.omap C 𝔻.≊ B.omap C
|
||||||
|
isoC = f , g , inv
|
||||||
|
eq : A.omap C ≡ B.omap C
|
||||||
|
eq = 𝔻.isoToId isoC
|
||||||
|
|
||||||
t : Natural A B coe𝟙
|
|
||||||
t = coe c (identityNatural A)
|
|
||||||
where
|
|
||||||
c : Natural A A (identityTrans A) ≡ Natural A B coe𝟙
|
|
||||||
c = begin
|
|
||||||
Natural A A (identityTrans A) ≡⟨ (λ x → {!natt ?!}) ⟩
|
|
||||||
Natural A B coe𝟙 ∎
|
|
||||||
-- cong (λ φ → {!Natural A A (identityTrans A)!}) {!!}
|
|
||||||
|
|
||||||
k : Natural A A (identityTrans A) → Natural A B coe𝟙
|
U : (F : ℂ.Object → 𝔻.Object) → Set _
|
||||||
k n {a} {b} f = res
|
U F = {A B : ℂ.Object} → ℂ [ A , B ] → 𝔻 [ F A , F B ]
|
||||||
where
|
|
||||||
res : (𝔻 [ coe𝟙 b ∘ A.fmap f ]) ≡ (𝔻 [ B.fmap f ∘ coe𝟙 a ])
|
|
||||||
res = {!!}
|
|
||||||
|
|
||||||
nat : Natural A B coe𝟙
|
-- module _
|
||||||
nat = nat'
|
-- (omap : ℂ.Object → 𝔻.Object)
|
||||||
|
-- (p : A.omap ≡ omap)
|
||||||
|
-- where
|
||||||
|
-- D : Set _
|
||||||
|
-- D = ( fmap : U omap)
|
||||||
|
-- → ( let
|
||||||
|
-- raw-B : RawFunctor ℂ 𝔻
|
||||||
|
-- raw-B = record { omap = omap ; fmap = fmap }
|
||||||
|
-- )
|
||||||
|
-- → (isF-B' : IsFunctor ℂ 𝔻 raw-B)
|
||||||
|
-- → ( let
|
||||||
|
-- B' : Functor ℂ 𝔻
|
||||||
|
-- B' = record { raw = raw-B ; isFunctor = isF-B' }
|
||||||
|
-- )
|
||||||
|
-- → (iso' : A ≊ B') → PathP (λ i → U (p i)) A.fmap fmap
|
||||||
|
-- -- D : Set _
|
||||||
|
-- -- D = PathP (λ i → U (p i)) A.fmap fmap
|
||||||
|
-- -- eeq : (λ f → A.fmap f) ≡ fmap
|
||||||
|
-- -- eeq = funExtImp (λ A → funExtImp (λ B → funExt (λ f → isofmap {A} {B} f)))
|
||||||
|
-- -- where
|
||||||
|
-- -- module _ {X : ℂ.Object} {Y : ℂ.Object} (f : ℂ [ X , Y ]) where
|
||||||
|
-- -- isofmap : A.fmap f ≡ fmap f
|
||||||
|
-- -- isofmap = {!ap!}
|
||||||
|
-- d : D A.omap refl
|
||||||
|
-- d = res
|
||||||
|
-- where
|
||||||
|
-- module _
|
||||||
|
-- ( fmap : U A.omap )
|
||||||
|
-- ( let
|
||||||
|
-- raw-B : RawFunctor ℂ 𝔻
|
||||||
|
-- raw-B = record { omap = A.omap ; fmap = fmap }
|
||||||
|
-- )
|
||||||
|
-- ( isF-B' : IsFunctor ℂ 𝔻 raw-B )
|
||||||
|
-- ( let
|
||||||
|
-- B' : Functor ℂ 𝔻
|
||||||
|
-- B' = record { raw = raw-B ; isFunctor = isF-B' }
|
||||||
|
-- )
|
||||||
|
-- ( iso' : A ≊ B' )
|
||||||
|
-- where
|
||||||
|
-- module _ {X Y : ℂ.Object} (f : ℂ [ X , Y ]) where
|
||||||
|
-- step : {!!} 𝔻.≊ {!!}
|
||||||
|
-- step = {!!}
|
||||||
|
-- resres : A.fmap {X} {Y} f ≡ fmap {X} {Y} f
|
||||||
|
-- resres = {!!}
|
||||||
|
-- res : PathP (λ i → U A.omap) A.fmap fmap
|
||||||
|
-- res i {X} {Y} f = resres f i
|
||||||
|
|
||||||
fromEq : NaturalTransformation A B
|
-- fmapEq : PathP (λ i → U (omapEq i)) A.fmap B.fmap
|
||||||
fromEq = coe𝟙 , nat
|
-- fmapEq = pathJ D d B.omap omapEq B.fmap B.isFunctor iso
|
||||||
|
|
||||||
module _ {A B : Functor ℂ 𝔻} where
|
-- rawEq : A.raw ≡ B.raw
|
||||||
obverse : A ≡ B → A ≅ B
|
-- rawEq i = record { omap = omapEq i ; fmap = fmapEq i }
|
||||||
obverse p = res
|
|
||||||
where
|
|
||||||
ob : Arrow A B
|
|
||||||
ob = fromEq p
|
|
||||||
re : Arrow B A
|
|
||||||
re = fromEq (sym p)
|
|
||||||
vr : _∘_ {A = A} {B} {A} re ob ≡ 𝟙 {A}
|
|
||||||
vr = {!!}
|
|
||||||
rv : _∘_ {A = B} {A} {B} ob re ≡ 𝟙 {B}
|
|
||||||
rv = {!!}
|
|
||||||
isInverse : IsInverseOf {A} {B} ob re
|
|
||||||
isInverse = vr , rv
|
|
||||||
iso : Isomorphism {A} {B} ob
|
|
||||||
iso = re , isInverse
|
|
||||||
res : A ≅ B
|
|
||||||
res = ob , iso
|
|
||||||
|
|
||||||
reverse : A ≅ B → A ≡ B
|
-- private
|
||||||
reverse iso = {!!}
|
-- f : (A ≡ B) → (A ≊ B)
|
||||||
|
-- f p = idToNatTrans p , idToNatTrans (sym p) , NaturalTransformation≡ A A (funExt (λ C → {!!})) , {!!}
|
||||||
|
-- g : (A ≊ B) → (A ≡ B)
|
||||||
|
-- g = Functor≡ ∘ rawEq
|
||||||
|
-- inv : AreInverses f g
|
||||||
|
-- inv = {!funExt λ p → ?!} , {!!}
|
||||||
|
postulate
|
||||||
|
iso : (A ≡ B) ≅ (A ≊ B)
|
||||||
|
-- iso = f , g , inv
|
||||||
|
|
||||||
ve-re : (y : A ≅ B) → obverse (reverse y) ≡ y
|
univ : (A ≡ B) ≃ (A ≊ B)
|
||||||
ve-re = {!!}
|
univ = fromIsomorphism _ _ iso
|
||||||
|
|
||||||
re-ve : (x : A ≡ B) → reverse (obverse x) ≡ x
|
-- There used to be some work-in-progress on this theorem, please go back to
|
||||||
re-ve = {!!}
|
-- this point in time to see it:
|
||||||
|
--
|
||||||
|
-- commit 6b7d66b7fc936fe3674b2fd9fa790bd0e3fec12f
|
||||||
|
-- Author: Frederik Hanghøj Iversen <fhi.1990@gmail.com>
|
||||||
|
-- Date: Fri Apr 13 15:26:46 2018 +0200
|
||||||
|
univalent : Univalent
|
||||||
|
univalent = univalenceFrom≃ univ
|
||||||
|
|
||||||
done : isEquiv (A ≡ B) (A ≅ B) (id-to-iso (λ { {A} {B} → isIdentity {A} {B}}) A B)
|
isCategory : IsCategory raw
|
||||||
done = {!gradLemma obverse reverse ve-re re-ve!}
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = univalent
|
||||||
univalent : Univalent (λ{ {A} {B} → isIdentity {A} {B}})
|
|
||||||
univalent = done
|
|
||||||
|
|
||||||
instance
|
|
||||||
isCategory : IsCategory RawFun
|
|
||||||
isCategory = record
|
|
||||||
{ isAssociative = λ {A B C D} → isAssociative {A} {B} {C} {D}
|
|
||||||
; isIdentity = λ {A B} → isIdentity {A} {B}
|
|
||||||
; arrowsAreSets = λ {F} {G} → naturalTransformationIsSet {F} {G}
|
|
||||||
; univalent = univalent
|
|
||||||
}
|
|
||||||
|
|
||||||
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
Category.raw Fun = RawFun
|
Category.raw Fun = raw
|
||||||
|
Category.isCategory Fun = isCategory
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
||||||
private
|
private
|
||||||
open import Cat.Categories.Sets
|
open import Cat.Categories.Sets
|
||||||
open NaturalTransformation (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
open NaturalTransformation (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
||||||
|
module K = Fun (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
||||||
|
module F = Category K.Fun
|
||||||
|
|
||||||
-- Restrict the functors to Presheafs.
|
-- Restrict the functors to Presheafs.
|
||||||
rawPresh : RawCategory (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
raw : RawCategory (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||||
rawPresh = record
|
raw = record
|
||||||
{ Object = Presheaf ℂ
|
{ Object = Presheaf ℂ
|
||||||
; Arrow = NaturalTransformation
|
; Arrow = NaturalTransformation
|
||||||
; 𝟙 = λ {F} → identity F
|
; identity = λ {F} → identity F
|
||||||
; _∘_ = λ {F G H} → NT[_∘_] {F = F} {G = G} {H = H}
|
; _<<<_ = λ {F G H} → NT[_∘_] {F = F} {G = G} {H = H}
|
||||||
}
|
}
|
||||||
instance
|
|
||||||
isCategory : IsCategory rawPresh
|
|
||||||
isCategory = Fun.isCategory _ _
|
|
||||||
|
|
||||||
Presh : Category (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
-- isCategory : IsCategory raw
|
||||||
Category.raw Presh = rawPresh
|
-- isCategory = record
|
||||||
Category.isCategory Presh = isCategory
|
-- { isAssociative =
|
||||||
|
-- λ{ {A} {B} {C} {D} {f} {g} {h}
|
||||||
|
-- → F.isAssociative {A} {B} {C} {D} {f} {g} {h}
|
||||||
|
-- }
|
||||||
|
-- ; isIdentity =
|
||||||
|
-- λ{ {A} {B} {f}
|
||||||
|
-- → F.isIdentity {A} {B} {f}
|
||||||
|
-- }
|
||||||
|
-- ; arrowsAreSets =
|
||||||
|
-- λ{ {A} {B}
|
||||||
|
-- → F.arrowsAreSets {A} {B}
|
||||||
|
-- }
|
||||||
|
-- ; univalent =
|
||||||
|
-- λ{ {A} {B}
|
||||||
|
-- → F.univalent {A} {B}
|
||||||
|
-- }
|
||||||
|
-- }
|
||||||
|
|
||||||
|
-- Presh : Category (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||||
|
-- Category.raw Presh = raw
|
||||||
|
-- Category.isCategory Presh = isCategory
|
||||||
|
|
96
src/Cat/Categories/Opposite.agda
Normal file
96
src/Cat/Categories/Opposite.agda
Normal file
|
@ -0,0 +1,96 @@
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
module Cat.Categories.Opposite where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
|
open import Cat.Category
|
||||||
|
|
||||||
|
-- | The opposite category
|
||||||
|
--
|
||||||
|
-- The opposite category is the category where the direction of the arrows are
|
||||||
|
-- flipped.
|
||||||
|
module _ {ℓa ℓb : Level} where
|
||||||
|
module _ (ℂ : Category ℓa ℓb) where
|
||||||
|
private
|
||||||
|
module _ where
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
opRaw : RawCategory ℓa ℓb
|
||||||
|
RawCategory.Object opRaw = ℂ.Object
|
||||||
|
RawCategory.Arrow opRaw = flip ℂ.Arrow
|
||||||
|
RawCategory.identity opRaw = ℂ.identity
|
||||||
|
RawCategory._<<<_ opRaw = ℂ._>>>_
|
||||||
|
|
||||||
|
open RawCategory opRaw
|
||||||
|
|
||||||
|
isPreCategory : IsPreCategory opRaw
|
||||||
|
IsPreCategory.isAssociative isPreCategory = sym ℂ.isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCategory = swap ℂ.isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = ℂ.arrowsAreSets
|
||||||
|
|
||||||
|
open IsPreCategory isPreCategory
|
||||||
|
|
||||||
|
module _ {A B : ℂ.Object} where
|
||||||
|
open Σ (toIso _ _ (ℂ.univalent {A} {B}))
|
||||||
|
renaming (fst to idToIso* ; snd to inv*)
|
||||||
|
open AreInverses {f = ℂ.idToIso A B} {idToIso*} inv*
|
||||||
|
|
||||||
|
shuffle : A ≊ B → A ℂ.≊ B
|
||||||
|
shuffle (f , g , inv) = g , f , inv
|
||||||
|
|
||||||
|
shuffle~ : A ℂ.≊ B → A ≊ B
|
||||||
|
shuffle~ (f , g , inv) = g , f , inv
|
||||||
|
|
||||||
|
lem : (p : A ≡ B) → idToIso A B p ≡ shuffle~ (ℂ.idToIso A B p)
|
||||||
|
lem p = isoEq refl
|
||||||
|
|
||||||
|
isoToId* : A ≊ B → A ≡ B
|
||||||
|
isoToId* = idToIso* ∘ shuffle
|
||||||
|
|
||||||
|
inv : AreInverses (idToIso A B) isoToId*
|
||||||
|
inv =
|
||||||
|
( funExt (λ x → begin
|
||||||
|
(isoToId* ∘ idToIso A B) x
|
||||||
|
≡⟨⟩
|
||||||
|
(idToIso* ∘ shuffle ∘ idToIso A B) x
|
||||||
|
≡⟨ cong (λ φ → φ x) (cong (λ φ → idToIso* ∘ shuffle ∘ φ) (funExt lem)) ⟩
|
||||||
|
(idToIso* ∘ shuffle ∘ shuffle~ ∘ ℂ.idToIso A B) x
|
||||||
|
≡⟨⟩
|
||||||
|
(idToIso* ∘ ℂ.idToIso A B) x
|
||||||
|
≡⟨ (λ i → verso-recto i x) ⟩
|
||||||
|
x ∎)
|
||||||
|
, funExt (λ x → begin
|
||||||
|
(idToIso A B ∘ idToIso* ∘ shuffle) x
|
||||||
|
≡⟨ cong (λ φ → φ x) (cong (λ φ → φ ∘ idToIso* ∘ shuffle) (funExt lem)) ⟩
|
||||||
|
(shuffle~ ∘ ℂ.idToIso A B ∘ idToIso* ∘ shuffle) x
|
||||||
|
≡⟨ cong (λ φ → φ x) (cong (λ φ → shuffle~ ∘ φ ∘ shuffle) recto-verso) ⟩
|
||||||
|
(shuffle~ ∘ shuffle) x
|
||||||
|
≡⟨⟩
|
||||||
|
x ∎)
|
||||||
|
)
|
||||||
|
|
||||||
|
isCategory : IsCategory opRaw
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory
|
||||||
|
= univalenceFromIsomorphism (isoToId* , inv)
|
||||||
|
|
||||||
|
opposite : Category ℓa ℓb
|
||||||
|
Category.raw opposite = opRaw
|
||||||
|
Category.isCategory opposite = isCategory
|
||||||
|
|
||||||
|
-- As demonstrated here a side-effect of having no-eta-equality on constructors
|
||||||
|
-- means that we need to pick things apart to show that things are indeed
|
||||||
|
-- definitionally equal. I.e; a thing that would normally be provable in one
|
||||||
|
-- line now takes 13!! Admittedly it's a simple proof.
|
||||||
|
module _ {ℂ : Category ℓa ℓb} where
|
||||||
|
open Category ℂ
|
||||||
|
private
|
||||||
|
-- Since they really are definitionally equal we just need to pick apart
|
||||||
|
-- the data-type.
|
||||||
|
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
||||||
|
RawCategory.Object (rawInv _) = Object
|
||||||
|
RawCategory.Arrow (rawInv _) = Arrow
|
||||||
|
RawCategory.identity (rawInv _) = identity
|
||||||
|
RawCategory._<<<_ (rawInv _) = _<<<_
|
||||||
|
|
||||||
|
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
||||||
|
oppositeIsInvolution = Category≡ rawInv
|
|
@ -1,12 +1,8 @@
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
||||||
module Cat.Categories.Rel where
|
module Cat.Categories.Rel where
|
||||||
|
|
||||||
open import Cubical
|
open import Cat.Prelude hiding (Rel)
|
||||||
open import Cubical.GradLemma
|
open import Cat.Equivalence
|
||||||
open import Agda.Primitive
|
|
||||||
open import Data.Product renaming (proj₁ to fst ; proj₂ to snd)
|
|
||||||
open import Function
|
|
||||||
import Cubical.FromStdLib
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
|
@ -66,19 +62,13 @@ module _ {A B : Set} {S : Subset (A × B)} (ab : A × B) where
|
||||||
lem0 = (λ a'' a≡a'' → ∀ a''b∈S → (forwards ∘ backwards) (a'' , a≡a'' , a''b∈S) ≡ (a'' , a≡a'' , a''b∈S))
|
lem0 = (λ a'' a≡a'' → ∀ a''b∈S → (forwards ∘ backwards) (a'' , a≡a'' , a''b∈S) ≡ (a'' , a≡a'' , a''b∈S))
|
||||||
lem1 = (λ z₁ → cong (\ z → a , refl , z) (pathJprop (\ y _ → y) z₁))
|
lem1 = (λ z₁ → cong (\ z → a , refl , z) (pathJprop (\ y _ → y) z₁))
|
||||||
|
|
||||||
isequiv : isEquiv
|
|
||||||
(Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
|
||||||
((a , b) ∈ S)
|
|
||||||
backwards
|
|
||||||
isequiv y = gradLemma backwards forwards fwd-bwd bwd-fwd y
|
|
||||||
|
|
||||||
equi : (Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
equi : (Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
||||||
≃ (a , b) ∈ S
|
≃ (a , b) ∈ S
|
||||||
equi = backwards Cubical.FromStdLib., isequiv
|
equi = fromIsomorphism _ _ (backwards , forwards , funExt bwd-fwd , funExt fwd-bwd)
|
||||||
|
|
||||||
ident-l : (Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
ident-r : (Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
||||||
≡ (a , b) ∈ S
|
≡ (a , b) ∈ S
|
||||||
ident-l = equivToPath equi
|
ident-r = equivToPath equi
|
||||||
|
|
||||||
module _ where
|
module _ where
|
||||||
private
|
private
|
||||||
|
@ -100,19 +90,13 @@ module _ {A B : Set} {S : Subset (A × B)} (ab : A × B) where
|
||||||
lem0 = (λ b'' b≡b'' → (ab''∈S : (a , b'') ∈ S) → (forwards ∘ backwards) (b'' , ab''∈S , sym b≡b'') ≡ (b'' , ab''∈S , sym b≡b''))
|
lem0 = (λ b'' b≡b'' → (ab''∈S : (a , b'') ∈ S) → (forwards ∘ backwards) (b'' , ab''∈S , sym b≡b'') ≡ (b'' , ab''∈S , sym b≡b''))
|
||||||
lem1 = (λ ab''∈S → cong (λ φ → b , φ , refl) (pathJprop (λ y _ → y) ab''∈S))
|
lem1 = (λ ab''∈S → cong (λ φ → b , φ , refl) (pathJprop (λ y _ → y) ab''∈S))
|
||||||
|
|
||||||
isequiv : isEquiv
|
|
||||||
(Σ[ b' ∈ B ] (a , b') ∈ S × (b' , b) ∈ Diag B)
|
|
||||||
((a , b) ∈ S)
|
|
||||||
backwards
|
|
||||||
isequiv ab∈S = gradLemma backwards forwards bwd-fwd fwd-bwd ab∈S
|
|
||||||
|
|
||||||
equi : (Σ[ b' ∈ B ] (a , b') ∈ S × (b' , b) ∈ Diag B)
|
equi : (Σ[ b' ∈ B ] (a , b') ∈ S × (b' , b) ∈ Diag B)
|
||||||
≃ ab ∈ S
|
≃ ab ∈ S
|
||||||
equi = backwards Cubical.FromStdLib., isequiv
|
equi = fromIsomorphism _ _ (backwards , (forwards , funExt fwd-bwd , funExt bwd-fwd))
|
||||||
|
|
||||||
ident-r : (Σ[ b' ∈ B ] (a , b') ∈ S × (b' , b) ∈ Diag B)
|
ident-l : (Σ[ b' ∈ B ] (a , b') ∈ S × (b' , b) ∈ Diag B)
|
||||||
≡ ab ∈ S
|
≡ ab ∈ S
|
||||||
ident-r = equivToPath equi
|
ident-l = equivToPath equi
|
||||||
|
|
||||||
module _ {A B C D : Set} {S : Subset (A × B)} {R : Subset (B × C)} {Q : Subset (C × D)} (ad : A × D) where
|
module _ {A B C D : Set} {S : Subset (A × B)} {R : Subset (B × C)} {Q : Subset (C × D)} (ad : A × D) where
|
||||||
private
|
private
|
||||||
|
@ -138,15 +122,9 @@ module _ {A B C D : Set} {S : Subset (A × B)} {R : Subset (B × C)} {Q : Subset
|
||||||
bwd-fwd : (x : Q⊕⟨R⊕S⟩) → (bwd ∘ fwd) x ≡ x
|
bwd-fwd : (x : Q⊕⟨R⊕S⟩) → (bwd ∘ fwd) x ≡ x
|
||||||
bwd-fwd x = refl
|
bwd-fwd x = refl
|
||||||
|
|
||||||
isequiv : isEquiv
|
|
||||||
(Σ[ c ∈ C ] (Σ[ b ∈ B ] (a , b) ∈ S × (b , c) ∈ R) × (c , d) ∈ Q)
|
|
||||||
(Σ[ b ∈ B ] (a , b) ∈ S × (Σ[ c ∈ C ] (b , c) ∈ R × (c , d) ∈ Q))
|
|
||||||
fwd
|
|
||||||
isequiv = gradLemma fwd bwd fwd-bwd bwd-fwd
|
|
||||||
|
|
||||||
equi : (Σ[ c ∈ C ] (Σ[ b ∈ B ] (a , b) ∈ S × (b , c) ∈ R) × (c , d) ∈ Q)
|
equi : (Σ[ c ∈ C ] (Σ[ b ∈ B ] (a , b) ∈ S × (b , c) ∈ R) × (c , d) ∈ Q)
|
||||||
≃ (Σ[ b ∈ B ] (a , b) ∈ S × (Σ[ c ∈ C ] (b , c) ∈ R × (c , d) ∈ Q))
|
≃ (Σ[ b ∈ B ] (a , b) ∈ S × (Σ[ c ∈ C ] (b , c) ∈ R × (c , d) ∈ Q))
|
||||||
equi = fwd Cubical.FromStdLib., isequiv
|
equi = fromIsomorphism _ _ (fwd , bwd , funExt bwd-fwd , funExt fwd-bwd)
|
||||||
|
|
||||||
-- isAssociativec : Q + (R + S) ≡ (Q + R) + S
|
-- isAssociativec : Q + (R + S) ≡ (Q + R) + S
|
||||||
is-isAssociative : (Σ[ c ∈ C ] (Σ[ b ∈ B ] (a , b) ∈ S × (b , c) ∈ R) × (c , d) ∈ Q)
|
is-isAssociative : (Σ[ c ∈ C ] (Σ[ b ∈ B ] (a , b) ∈ S × (b , c) ∈ R) × (c , d) ∈ Q)
|
||||||
|
@ -157,14 +135,15 @@ RawRel : RawCategory (lsuc lzero) (lsuc lzero)
|
||||||
RawRel = record
|
RawRel = record
|
||||||
{ Object = Set
|
{ Object = Set
|
||||||
; Arrow = λ S R → Subset (S × R)
|
; Arrow = λ S R → Subset (S × R)
|
||||||
; 𝟙 = λ {S} → Diag S
|
; identity = λ {S} → Diag S
|
||||||
; _∘_ = λ {A B C} S R → λ {( a , c ) → Σ[ b ∈ B ] ( (a , b) ∈ R × (b , c) ∈ S )}
|
; _<<<_ = λ {A B C} S R → λ {( a , c ) → Σ[ b ∈ B ] ( (a , b) ∈ R × (b , c) ∈ S )}
|
||||||
}
|
}
|
||||||
|
|
||||||
RawIsCategoryRel : IsCategory RawRel
|
isPreCategory : IsPreCategory RawRel
|
||||||
RawIsCategoryRel = record
|
|
||||||
{ isAssociative = funExt is-isAssociative
|
IsPreCategory.isAssociative isPreCategory = funExt is-isAssociative
|
||||||
; isIdentity = funExt ident-l , funExt ident-r
|
IsPreCategory.isIdentity isPreCategory = funExt ident-l , funExt ident-r
|
||||||
; arrowsAreSets = {!!}
|
IsPreCategory.arrowsAreSets isPreCategory = {!!}
|
||||||
; univalent = {!!}
|
|
||||||
}
|
Rel : PreCategory RawRel
|
||||||
|
PreCategory.isPreCategory Rel = isPreCategory
|
||||||
|
|
|
@ -1,171 +1,62 @@
|
||||||
-- | The category of homotopy sets
|
-- | The category of homotopy sets
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Categories.Sets where
|
module Cat.Categories.Sets where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude as P
|
||||||
open import Data.Product
|
open import Cat.Equivalence
|
||||||
open import Function using (_∘_)
|
|
||||||
|
|
||||||
open import Cubical hiding (_≃_ ; inverse)
|
|
||||||
open import Cubical.Equivalence
|
|
||||||
renaming
|
|
||||||
( _≅_ to _A≅_ )
|
|
||||||
using
|
|
||||||
(_≃_ ; con ; AreInverses)
|
|
||||||
open import Cubical.Univalence
|
|
||||||
open import Cubical.GradLemma
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
open import Cat.Wishlist
|
open import Cat.Categories.Opposite
|
||||||
|
|
||||||
|
_⊙_ : {ℓa ℓb ℓc : Level} {A : Set ℓa} {B : Set ℓb} {C : Set ℓc} → (A ≃ B) → (B ≃ C) → A ≃ C
|
||||||
|
eqA ⊙ eqB = Equivalence.compose eqA eqB
|
||||||
|
|
||||||
|
sym≃ : ∀ {ℓa ℓb} {A : Set ℓa} {B : Set ℓb} → A ≃ B → B ≃ A
|
||||||
|
sym≃ = Equivalence.symmetry
|
||||||
|
|
||||||
|
infixl 10 _⊙_
|
||||||
|
|
||||||
module _ (ℓ : Level) where
|
module _ (ℓ : Level) where
|
||||||
private
|
private
|
||||||
open import Cubical.Univalence
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
open import Cubical.Universe
|
|
||||||
|
|
||||||
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
||||||
RawCategory.Object SetsRaw = hSet
|
RawCategory.Object SetsRaw = hSet ℓ
|
||||||
RawCategory.Arrow SetsRaw (T , _) (U , _) = T → U
|
RawCategory.Arrow SetsRaw (T , _) (U , _) = T → U
|
||||||
RawCategory.𝟙 SetsRaw = Function.id
|
RawCategory.identity SetsRaw = idFun _
|
||||||
RawCategory._∘_ SetsRaw = Function._∘′_
|
RawCategory._<<<_ SetsRaw = _∘′_
|
||||||
|
|
||||||
open RawCategory SetsRaw hiding (_∘_)
|
module _ where
|
||||||
open Univalence SetsRaw
|
private
|
||||||
|
open RawCategory SetsRaw hiding (_<<<_)
|
||||||
|
|
||||||
isIdentity : IsIdentity Function.id
|
isIdentity : IsIdentity (idFun _)
|
||||||
proj₁ isIdentity = funExt λ _ → refl
|
fst isIdentity = funExt λ _ → refl
|
||||||
proj₂ isIdentity = funExt λ _ → refl
|
snd isIdentity = funExt λ _ → refl
|
||||||
|
|
||||||
arrowsAreSets : ArrowsAreSets
|
arrowsAreSets : ArrowsAreSets
|
||||||
arrowsAreSets {B = (_ , s)} = setPi λ _ → s
|
arrowsAreSets {B = (_ , s)} = setPi λ _ → s
|
||||||
|
|
||||||
|
isPreCat : IsPreCategory SetsRaw
|
||||||
|
IsPreCategory.isAssociative isPreCat = refl
|
||||||
|
IsPreCategory.isIdentity isPreCat {A} {B} = isIdentity {A} {B}
|
||||||
|
IsPreCategory.arrowsAreSets isPreCat {A} {B} = arrowsAreSets {A} {B}
|
||||||
|
|
||||||
|
open IsPreCategory isPreCat
|
||||||
module _ {hA hB : Object} where
|
module _ {hA hB : Object} where
|
||||||
private
|
open Σ hA renaming (fst to A ; snd to sA)
|
||||||
A = proj₁ hA
|
open Σ hB renaming (fst to B ; snd to sB)
|
||||||
isSetA : isSet A
|
|
||||||
isSetA = proj₂ hA
|
|
||||||
B = proj₁ hB
|
|
||||||
isSetB : isSet B
|
|
||||||
isSetB = proj₂ hB
|
|
||||||
|
|
||||||
toIsomorphism : A ≃ B → hA ≅ hB
|
univ≃ : (hA ≡ hB) ≃ (hA ≊ hB)
|
||||||
toIsomorphism e = obverse , inverse , verso-recto , recto-verso
|
univ≃
|
||||||
where
|
= equivSigProp (λ A → isSetIsProp)
|
||||||
open _≃_ e
|
⊙ univalence
|
||||||
|
⊙ equivSig {P = isEquiv A B} {Q = TypeIsomorphism} (equiv≃iso sA sB)
|
||||||
|
|
||||||
fromIsomorphism : hA ≅ hB → A ≃ B
|
univalent : Univalent
|
||||||
fromIsomorphism iso = con obverse (gradLemma obverse inverse recto-verso verso-recto)
|
univalent = univalenceFrom≃ univ≃
|
||||||
where
|
|
||||||
obverse : A → B
|
|
||||||
obverse = proj₁ iso
|
|
||||||
inverse : B → A
|
|
||||||
inverse = proj₁ (proj₂ iso)
|
|
||||||
-- FIXME IsInverseOf should change name to AreInverses and the
|
|
||||||
-- ordering should be swapped.
|
|
||||||
areInverses : IsInverseOf {A = hA} {hB} obverse inverse
|
|
||||||
areInverses = proj₂ (proj₂ iso)
|
|
||||||
verso-recto : ∀ a → (inverse ∘ obverse) a ≡ a
|
|
||||||
verso-recto a i = proj₁ areInverses i a
|
|
||||||
recto-verso : ∀ b → (obverse Function.∘ inverse) b ≡ b
|
|
||||||
recto-verso b i = proj₂ areInverses i b
|
|
||||||
|
|
||||||
private
|
|
||||||
univIso : (A ≡ B) A≅ (A ≃ B)
|
|
||||||
univIso = _≃_.toIsomorphism univalence
|
|
||||||
obverse' : A ≡ B → A ≃ B
|
|
||||||
obverse' = proj₁ univIso
|
|
||||||
inverse' : A ≃ B → A ≡ B
|
|
||||||
inverse' = proj₁ (proj₂ univIso)
|
|
||||||
-- Drop proof of being a set from both sides of an equality.
|
|
||||||
dropP : hA ≡ hB → A ≡ B
|
|
||||||
dropP eq i = proj₁ (eq i)
|
|
||||||
-- Add proof of being a set to both sides of a set-theoretic equivalence
|
|
||||||
-- returning a category-theoretic equivalence.
|
|
||||||
addE : A A≅ B → hA ≅ hB
|
|
||||||
addE eqv = proj₁ eqv , (proj₁ (proj₂ eqv)) , asPair
|
|
||||||
where
|
|
||||||
areeqv = proj₂ (proj₂ eqv)
|
|
||||||
asPair =
|
|
||||||
let module Inv = AreInverses areeqv
|
|
||||||
in Inv.verso-recto , Inv.recto-verso
|
|
||||||
|
|
||||||
obverse : hA ≡ hB → hA ≅ hB
|
|
||||||
obverse = addE ∘ _≃_.toIsomorphism ∘ obverse' ∘ dropP
|
|
||||||
|
|
||||||
-- Drop proof of being a set form both sides of a category-theoretic
|
|
||||||
-- equivalence returning a set-theoretic equivalence.
|
|
||||||
dropE : hA ≅ hB → A A≅ B
|
|
||||||
dropE eqv = obv , inv , asAreInverses
|
|
||||||
where
|
|
||||||
obv = proj₁ eqv
|
|
||||||
inv = proj₁ (proj₂ eqv)
|
|
||||||
areEq = proj₂ (proj₂ eqv)
|
|
||||||
asAreInverses : AreInverses A B obv inv
|
|
||||||
asAreInverses = record { verso-recto = proj₁ areEq ; recto-verso = proj₂ areEq }
|
|
||||||
|
|
||||||
-- Dunno if this is a thing.
|
|
||||||
isoToEquiv : A A≅ B → A ≃ B
|
|
||||||
isoToEquiv = {!!}
|
|
||||||
-- Add proof of being a set to both sides of an equality.
|
|
||||||
addP : A ≡ B → hA ≡ hB
|
|
||||||
addP p = lemSig (λ X → propPi λ x → propPi (λ y → propIsProp)) hA hB p
|
|
||||||
inverse : hA ≅ hB → hA ≡ hB
|
|
||||||
inverse = addP ∘ inverse' ∘ isoToEquiv ∘ dropE
|
|
||||||
|
|
||||||
-- open AreInverses (proj₂ (proj₂ univIso)) renaming
|
|
||||||
-- ( verso-recto to verso-recto'
|
|
||||||
-- ; recto-verso to recto-verso'
|
|
||||||
-- )
|
|
||||||
-- I can just open them but I wanna be able to see the type annotations.
|
|
||||||
verso-recto' : inverse' ∘ obverse' ≡ Function.id
|
|
||||||
verso-recto' = AreInverses.verso-recto (proj₂ (proj₂ univIso))
|
|
||||||
recto-verso' : obverse' ∘ inverse' ≡ Function.id
|
|
||||||
recto-verso' = AreInverses.recto-verso (proj₂ (proj₂ univIso))
|
|
||||||
verso-recto : (iso : hA ≅ hB) → obverse (inverse iso) ≡ iso
|
|
||||||
verso-recto iso = begin
|
|
||||||
obverse (inverse iso) ≡⟨⟩
|
|
||||||
( addE ∘ _≃_.toIsomorphism
|
|
||||||
∘ obverse' ∘ dropP ∘ addP
|
|
||||||
∘ inverse' ∘ isoToEquiv
|
|
||||||
∘ dropE) iso
|
|
||||||
≡⟨⟩
|
|
||||||
( addE ∘ _≃_.toIsomorphism
|
|
||||||
∘ obverse'
|
|
||||||
∘ inverse' ∘ isoToEquiv
|
|
||||||
∘ dropE) iso
|
|
||||||
≡⟨ {!!} ⟩ -- obverse' inverse' are inverses
|
|
||||||
( addE ∘ _≃_.toIsomorphism ∘ isoToEquiv ∘ dropE) iso
|
|
||||||
≡⟨ {!!} ⟩ -- should be easy to prove
|
|
||||||
-- _≃_.toIsomorphism ∘ isoToEquiv ≡ id
|
|
||||||
(addE ∘ dropE) iso
|
|
||||||
≡⟨⟩
|
|
||||||
iso ∎
|
|
||||||
|
|
||||||
-- Similar to above.
|
|
||||||
recto-verso : (eq : hA ≡ hB) → inverse (obverse eq) ≡ eq
|
|
||||||
recto-verso eq = begin
|
|
||||||
inverse (obverse eq) ≡⟨ {!!} ⟩
|
|
||||||
eq ∎
|
|
||||||
|
|
||||||
-- Use the fact that being an h-level is a mere proposition.
|
|
||||||
-- This is almost provable using `Wishlist.isSetIsProp` - although
|
|
||||||
-- this creates homogenous paths.
|
|
||||||
isSetEq : (p : A ≡ B) → (λ i → isSet (p i)) [ isSetA ≡ isSetB ]
|
|
||||||
isSetEq = {!!}
|
|
||||||
|
|
||||||
res : hA ≡ hB
|
|
||||||
proj₁ (res i) = {!!}
|
|
||||||
proj₂ (res i) = isSetEq {!!} i
|
|
||||||
univalent : isEquiv (hA ≡ hB) (hA ≅ hB) (id-to-iso (λ {A} {B} → isIdentity {A} {B}) hA hB)
|
|
||||||
univalent = {!gradLemma obverse inverse verso-recto recto-verso!}
|
|
||||||
|
|
||||||
SetsIsCategory : IsCategory SetsRaw
|
SetsIsCategory : IsCategory SetsRaw
|
||||||
IsCategory.isAssociative SetsIsCategory = refl
|
IsCategory.isPreCategory SetsIsCategory = isPreCat
|
||||||
IsCategory.isIdentity SetsIsCategory {A} {B} = isIdentity {A} {B}
|
|
||||||
IsCategory.arrowsAreSets SetsIsCategory {A} {B} = arrowsAreSets {A} {B}
|
|
||||||
IsCategory.univalent SetsIsCategory = univalent
|
IsCategory.univalent SetsIsCategory = univalent
|
||||||
|
|
||||||
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
||||||
|
@ -177,41 +68,48 @@ module _ {ℓ : Level} where
|
||||||
private
|
private
|
||||||
𝓢 = 𝓢𝓮𝓽 ℓ
|
𝓢 = 𝓢𝓮𝓽 ℓ
|
||||||
open Category 𝓢
|
open Category 𝓢
|
||||||
open import Cubical.Sigma
|
|
||||||
|
|
||||||
module _ (0A 0B : Object) where
|
module _ (hA hB : Object) where
|
||||||
|
open Σ hA renaming (fst to A ; snd to sA)
|
||||||
|
open Σ hB renaming (fst to B ; snd to sB)
|
||||||
|
|
||||||
private
|
private
|
||||||
A : Set ℓ
|
productObject : Object
|
||||||
A = proj₁ 0A
|
productObject = (A × B) , sigPresSet sA λ _ → sB
|
||||||
sA : isSet A
|
|
||||||
sA = proj₂ 0A
|
|
||||||
B : Set ℓ
|
|
||||||
B = proj₁ 0B
|
|
||||||
sB : isSet B
|
|
||||||
sB = proj₂ 0B
|
|
||||||
0A×0B : Object
|
|
||||||
0A×0B = (A × B) , sigPresSet sA λ _ → sB
|
|
||||||
|
|
||||||
module _ {X A B : Set ℓ} (f : X → A) (g : X → B) where
|
module _ {X A B : Set ℓ} (f : X → A) (g : X → B) where
|
||||||
_&&&_ : (X → A × B)
|
_&&&_ : (X → A × B)
|
||||||
_&&&_ x = f x , g x
|
_&&&_ x = f x , g x
|
||||||
module _ {0X : Object} where
|
|
||||||
X = proj₁ 0X
|
|
||||||
module _ (f : X → A ) (g : X → B) where
|
|
||||||
lem : proj₁ Function.∘′ (f &&& g) ≡ f × proj₂ Function.∘′ (f &&& g) ≡ g
|
|
||||||
proj₁ lem = refl
|
|
||||||
proj₂ lem = refl
|
|
||||||
|
|
||||||
rawProduct : RawProduct 𝓢 0A 0B
|
module _ (hX : Object) where
|
||||||
RawProduct.object rawProduct = 0A×0B
|
open Σ hX renaming (fst to X)
|
||||||
RawProduct.proj₁ rawProduct = Data.Product.proj₁
|
module _ (f : X → A ) (g : X → B) where
|
||||||
RawProduct.proj₂ rawProduct = Data.Product.proj₂
|
ump : fst ∘′ (f &&& g) ≡ f × snd ∘′ (f &&& g) ≡ g
|
||||||
|
fst ump = refl
|
||||||
|
snd ump = refl
|
||||||
|
|
||||||
|
rawProduct : RawProduct 𝓢 hA hB
|
||||||
|
RawProduct.object rawProduct = productObject
|
||||||
|
RawProduct.fst rawProduct = fst
|
||||||
|
RawProduct.snd rawProduct = snd
|
||||||
|
|
||||||
isProduct : IsProduct 𝓢 _ _ rawProduct
|
isProduct : IsProduct 𝓢 _ _ rawProduct
|
||||||
IsProduct.isProduct isProduct {X = X} f g
|
IsProduct.ump isProduct {X = hX} f g
|
||||||
= (f &&& g) , lem {0X = X} f g
|
= f &&& g , ump hX f g , λ eq → funExt (umpUniq eq)
|
||||||
|
where
|
||||||
|
open Σ hX renaming (fst to X) using ()
|
||||||
|
module _ {y : X → A × B} (eq : fst ∘′ y ≡ f × snd ∘′ y ≡ g) (x : X) where
|
||||||
|
p1 : fst ((f &&& g) x) ≡ fst (y x)
|
||||||
|
p1 = begin
|
||||||
|
fst ((f &&& g) x) ≡⟨⟩
|
||||||
|
f x ≡⟨ (λ i → sym (fst eq) i x) ⟩
|
||||||
|
fst (y x) ∎
|
||||||
|
p2 : snd ((f &&& g) x) ≡ snd (y x)
|
||||||
|
p2 = λ i → sym (snd eq) i x
|
||||||
|
umpUniq : (f &&& g) x ≡ y x
|
||||||
|
umpUniq i = p1 i , p2 i
|
||||||
|
|
||||||
product : Product 𝓢 0A 0B
|
product : Product 𝓢 hA hB
|
||||||
Product.raw product = rawProduct
|
Product.raw product = rawProduct
|
||||||
Product.isProduct product = isProduct
|
Product.isProduct product = isProduct
|
||||||
|
|
||||||
|
@ -220,6 +118,8 @@ module _ {ℓ : Level} where
|
||||||
SetsHasProducts = record { product = product }
|
SetsHasProducts = record { product = product }
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Category ℂ
|
||||||
|
|
||||||
-- Covariant Presheaf
|
-- Covariant Presheaf
|
||||||
Representable : Set (ℓa ⊔ lsuc ℓb)
|
Representable : Set (ℓa ⊔ lsuc ℓb)
|
||||||
Representable = Functor ℂ (𝓢𝓮𝓽 ℓb)
|
Representable = Functor ℂ (𝓢𝓮𝓽 ℓb)
|
||||||
|
@ -228,8 +128,6 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
Presheaf : Set (ℓa ⊔ lsuc ℓb)
|
Presheaf : Set (ℓa ⊔ lsuc ℓb)
|
||||||
Presheaf = Functor (opposite ℂ) (𝓢𝓮𝓽 ℓb)
|
Presheaf = Functor (opposite ℂ) (𝓢𝓮𝓽 ℓb)
|
||||||
|
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
-- The "co-yoneda" embedding.
|
-- The "co-yoneda" embedding.
|
||||||
representable : Category.Object ℂ → Representable
|
representable : Category.Object ℂ → Representable
|
||||||
representable A = record
|
representable A = record
|
||||||
|
@ -238,7 +136,7 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
; fmap = ℂ [_∘_]
|
; fmap = ℂ [_∘_]
|
||||||
}
|
}
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ isIdentity = funExt λ _ → proj₂ isIdentity
|
{ isIdentity = funExt λ _ → leftIdentity
|
||||||
; isDistributive = funExt λ x → sym isAssociative
|
; isDistributive = funExt λ x → sym isAssociative
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -251,7 +149,7 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
; fmap = λ f g → ℂ [ g ∘ f ]
|
; fmap = λ f g → ℂ [ g ∘ f ]
|
||||||
}
|
}
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ isIdentity = funExt λ x → proj₁ isIdentity
|
{ isIdentity = funExt λ x → rightIdentity
|
||||||
; isDistributive = funExt λ x → isAssociative
|
; isDistributive = funExt λ x → isAssociative
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
170
src/Cat/Categories/Span.agda
Normal file
170
src/Cat/Categories/Span.agda
Normal file
|
@ -0,0 +1,170 @@
|
||||||
|
{-# OPTIONS --cubical --caching #-}
|
||||||
|
module Cat.Categories.Span where
|
||||||
|
|
||||||
|
open import Cat.Prelude as P hiding (_×_ ; fst ; snd)
|
||||||
|
open import Cat.Equivalence
|
||||||
|
open import Cat.Category
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb)
|
||||||
|
(let module ℂ = Category ℂ) (𝒜 ℬ : ℂ.Object) where
|
||||||
|
|
||||||
|
open P
|
||||||
|
|
||||||
|
private
|
||||||
|
module _ where
|
||||||
|
raw : RawCategory _ _
|
||||||
|
raw = record
|
||||||
|
{ Object = Σ[ X ∈ ℂ.Object ] ℂ.Arrow X 𝒜 × ℂ.Arrow X ℬ
|
||||||
|
; Arrow = λ{ (A , a0 , a1) (B , b0 , b1)
|
||||||
|
→ Σ[ f ∈ ℂ.Arrow A B ]
|
||||||
|
ℂ [ b0 ∘ f ] ≡ a0
|
||||||
|
× ℂ [ b1 ∘ f ] ≡ a1
|
||||||
|
}
|
||||||
|
; identity = λ{ {X , f , g} → ℂ.identity {X} , ℂ.rightIdentity , ℂ.rightIdentity}
|
||||||
|
; _<<<_ = λ { {_ , a0 , a1} {_ , b0 , b1} {_ , c0 , c1} (f , f0 , f1) (g , g0 , g1)
|
||||||
|
→ (f ℂ.<<< g)
|
||||||
|
, (begin
|
||||||
|
ℂ [ c0 ∘ ℂ [ f ∘ g ] ] ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
ℂ [ ℂ [ c0 ∘ f ] ∘ g ] ≡⟨ cong (λ φ → ℂ [ φ ∘ g ]) f0 ⟩
|
||||||
|
ℂ [ b0 ∘ g ] ≡⟨ g0 ⟩
|
||||||
|
a0 ∎
|
||||||
|
)
|
||||||
|
, (begin
|
||||||
|
ℂ [ c1 ∘ ℂ [ f ∘ g ] ] ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
ℂ [ ℂ [ c1 ∘ f ] ∘ g ] ≡⟨ cong (λ φ → ℂ [ φ ∘ g ]) f1 ⟩
|
||||||
|
ℂ [ b1 ∘ g ] ≡⟨ g1 ⟩
|
||||||
|
a1 ∎
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
module _ where
|
||||||
|
open RawCategory raw
|
||||||
|
|
||||||
|
propEqs : ∀ {X' : Object}{Y' : Object} (let X , xa , xb = X') (let Y , ya , yb = Y')
|
||||||
|
→ (xy : ℂ.Arrow X Y) → isProp (ℂ [ ya ∘ xy ] ≡ xa × ℂ [ yb ∘ xy ] ≡ xb)
|
||||||
|
propEqs xs = propSig (ℂ.arrowsAreSets _ _) (\ _ → ℂ.arrowsAreSets _ _)
|
||||||
|
|
||||||
|
arrowEq : {X Y : Object} {f g : Arrow X Y} → fst f ≡ fst g → f ≡ g
|
||||||
|
arrowEq {X} {Y} {f} {g} p = λ i → p i , lemPropF propEqs p {snd f} {snd g} i
|
||||||
|
|
||||||
|
isAssociative : IsAssociative
|
||||||
|
isAssociative {f = f , f0 , f1} {g , g0 , g1} {h , h0 , h1} = arrowEq ℂ.isAssociative
|
||||||
|
|
||||||
|
isIdentity : IsIdentity identity
|
||||||
|
isIdentity {AA@(A , a0 , a1)} {BB@(B , b0 , b1)} {f , f0 , f1} = arrowEq ℂ.leftIdentity , arrowEq ℂ.rightIdentity
|
||||||
|
|
||||||
|
arrowsAreSets : ArrowsAreSets
|
||||||
|
arrowsAreSets {X , x0 , x1} {Y , y0 , y1}
|
||||||
|
= sigPresSet ℂ.arrowsAreSets λ a → propSet (propEqs _)
|
||||||
|
|
||||||
|
isPreCat : IsPreCategory raw
|
||||||
|
IsPreCategory.isAssociative isPreCat = isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCat = isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCat = arrowsAreSets
|
||||||
|
|
||||||
|
open IsPreCategory isPreCat
|
||||||
|
|
||||||
|
module _ {𝕏 𝕐 : Object} where
|
||||||
|
open Σ 𝕏 renaming (fst to X ; snd to x)
|
||||||
|
open Σ x renaming (fst to xa ; snd to xb)
|
||||||
|
open Σ 𝕐 renaming (fst to Y ; snd to y)
|
||||||
|
open Σ y renaming (fst to ya ; snd to yb)
|
||||||
|
open import Cat.Equivalence using (composeIso) renaming (_≅_ to _≅_)
|
||||||
|
|
||||||
|
-- The proof will be a sequence of isomorphisms between the
|
||||||
|
-- following 4 types:
|
||||||
|
T0 = ((X , xa , xb) ≡ (Y , ya , yb))
|
||||||
|
T1 = (Σ[ p ∈ (X ≡ Y) ] (PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya) × (PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb))
|
||||||
|
T2 = Σ (X ℂ.≊ Y) (λ iso
|
||||||
|
→ let p = ℂ.isoToId iso
|
||||||
|
in
|
||||||
|
( PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya)
|
||||||
|
× PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb
|
||||||
|
)
|
||||||
|
T3 = ((X , xa , xb) ≊ (Y , ya , yb))
|
||||||
|
|
||||||
|
step0 : T0 ≅ T1
|
||||||
|
step0
|
||||||
|
= (λ p → cong fst p , cong-d (fst ∘ snd) p , cong-d (snd ∘ snd) p)
|
||||||
|
-- , (λ x → λ i → fst x i , (fst (snd x) i) , (snd (snd x) i))
|
||||||
|
, (λ{ (p , q , r) → Σ≡ p λ i → q i , r i})
|
||||||
|
, funExt (λ{ p → refl})
|
||||||
|
, funExt (λ{ (p , q , r) → refl})
|
||||||
|
|
||||||
|
step1 : T1 ≅ T2
|
||||||
|
step1
|
||||||
|
= symIso
|
||||||
|
(isoSigFst
|
||||||
|
{A = (X ℂ.≊ Y)}
|
||||||
|
{B = (X ≡ Y)}
|
||||||
|
(ℂ.groupoidObject _ _)
|
||||||
|
{Q = \ p → (PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya) × (PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb)}
|
||||||
|
ℂ.isoToId
|
||||||
|
(symIso (_ , ℂ.asTypeIso {X} {Y}) .snd)
|
||||||
|
)
|
||||||
|
|
||||||
|
step2 : T2 ≅ T3
|
||||||
|
step2
|
||||||
|
= ( λ{ (iso@(f , f~ , inv-f) , p , q)
|
||||||
|
→ ( f , sym (ℂ.domain-twist-sym iso p) , sym (ℂ.domain-twist-sym iso q))
|
||||||
|
, ( f~ , sym (ℂ.domain-twist iso p) , sym (ℂ.domain-twist iso q))
|
||||||
|
, arrowEq (fst inv-f)
|
||||||
|
, arrowEq (snd inv-f)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, (λ{ (f , f~ , inv-f , inv-f~) →
|
||||||
|
let
|
||||||
|
iso : X ℂ.≊ Y
|
||||||
|
iso = fst f , fst f~ , cong fst inv-f , cong fst inv-f~
|
||||||
|
p : X ≡ Y
|
||||||
|
p = ℂ.isoToId iso
|
||||||
|
pA : ℂ.Arrow X 𝒜 ≡ ℂ.Arrow Y 𝒜
|
||||||
|
pA = cong (λ x → ℂ.Arrow x 𝒜) p
|
||||||
|
pB : ℂ.Arrow X ℬ ≡ ℂ.Arrow Y ℬ
|
||||||
|
pB = cong (λ x → ℂ.Arrow x ℬ) p
|
||||||
|
k0 = begin
|
||||||
|
coe pB xb ≡⟨ ℂ.coe-dom iso ⟩
|
||||||
|
xb ℂ.<<< fst f~ ≡⟨ snd (snd f~) ⟩
|
||||||
|
yb ∎
|
||||||
|
k1 = begin
|
||||||
|
coe pA xa ≡⟨ ℂ.coe-dom iso ⟩
|
||||||
|
xa ℂ.<<< fst f~ ≡⟨ fst (snd f~) ⟩
|
||||||
|
ya ∎
|
||||||
|
in iso , coe-lem-inv k1 , coe-lem-inv k0})
|
||||||
|
, funExt (λ x → lemSig
|
||||||
|
(λ x → propSig prop0 (λ _ → prop1))
|
||||||
|
_ _
|
||||||
|
(Σ≡ refl (ℂ.propIsomorphism _ _ _)))
|
||||||
|
, funExt (λ{ (f , _) → lemSig propIsomorphism _ _ (Σ≡ refl (propEqs _ _ _))})
|
||||||
|
where
|
||||||
|
prop0 : ∀ {x} → isProp (PathP (λ i → ℂ.Arrow (ℂ.isoToId x i) 𝒜) xa ya)
|
||||||
|
prop0 {x} = pathJ (λ y p → ∀ x → isProp (PathP (λ i → ℂ.Arrow (p i) 𝒜) xa x)) (λ x → ℂ.arrowsAreSets _ _) Y (ℂ.isoToId x) ya
|
||||||
|
prop1 : ∀ {x} → isProp (PathP (λ i → ℂ.Arrow (ℂ.isoToId x i) ℬ) xb yb)
|
||||||
|
prop1 {x} = pathJ (λ y p → ∀ x → isProp (PathP (λ i → ℂ.Arrow (p i) ℬ) xb x)) (λ x → ℂ.arrowsAreSets _ _) Y (ℂ.isoToId x) yb
|
||||||
|
-- One thing to watch out for here is that the isomorphisms going forwards
|
||||||
|
-- must compose to give idToIso
|
||||||
|
iso
|
||||||
|
: ((X , xa , xb) ≡ (Y , ya , yb))
|
||||||
|
≅ ((X , xa , xb) ≊ (Y , ya , yb))
|
||||||
|
iso = step0 ⊙ step1 ⊙ step2
|
||||||
|
where
|
||||||
|
infixl 5 _⊙_
|
||||||
|
_⊙_ = composeIso
|
||||||
|
equiv1
|
||||||
|
: ((X , xa , xb) ≡ (Y , ya , yb))
|
||||||
|
≃ ((X , xa , xb) ≊ (Y , ya , yb))
|
||||||
|
equiv1 = _ , fromIso _ _ (snd iso)
|
||||||
|
|
||||||
|
univalent : Univalent
|
||||||
|
univalent = univalenceFrom≃ equiv1
|
||||||
|
|
||||||
|
isCat : IsCategory raw
|
||||||
|
IsCategory.isPreCategory isCat = isPreCat
|
||||||
|
IsCategory.univalent isCat = univalent
|
||||||
|
|
||||||
|
span : Category _ _
|
||||||
|
span = record
|
||||||
|
{ raw = raw
|
||||||
|
; isCategory = isCat
|
||||||
|
}
|
|
@ -12,8 +12,8 @@
|
||||||
--
|
--
|
||||||
-- Data
|
-- Data
|
||||||
-- ----
|
-- ----
|
||||||
-- 𝟙; the identity arrow
|
-- identity; the identity arrow
|
||||||
-- _∘_; function composition
|
-- _<<<_; function composition
|
||||||
--
|
--
|
||||||
-- Laws
|
-- Laws
|
||||||
-- ----
|
-- ----
|
||||||
|
@ -24,41 +24,19 @@
|
||||||
-- ------
|
-- ------
|
||||||
--
|
--
|
||||||
-- Propositionality for all laws about the category.
|
-- Propositionality for all laws about the category.
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
|
|
||||||
module Cat.Category where
|
module Cat.Category where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
open import Data.Unit.Base
|
import Cat.Equivalence
|
||||||
open import Data.Product renaming
|
open Cat.Equivalence public using () renaming (Isomorphism to TypeIsomorphism)
|
||||||
( proj₁ to fst
|
open Cat.Equivalence
|
||||||
; proj₂ to snd
|
hiding (preorder≅ ; Isomorphism)
|
||||||
; ∃! to ∃!≈
|
|
||||||
)
|
|
||||||
open import Data.Empty
|
|
||||||
import Function
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties using ( propIsEquiv ; lemPropF )
|
|
||||||
|
|
||||||
open import Cat.Wishlist
|
------------------
|
||||||
|
|
||||||
-----------------
|
|
||||||
-- * Utilities --
|
|
||||||
-----------------
|
|
||||||
|
|
||||||
-- | Unique existensials.
|
|
||||||
∃! : ∀ {a b} {A : Set a}
|
|
||||||
→ (A → Set b) → Set (a ⊔ b)
|
|
||||||
∃! = ∃!≈ _≡_
|
|
||||||
|
|
||||||
∃!-syntax : ∀ {a b} {A : Set a} → (A → Set b) → Set (a ⊔ b)
|
|
||||||
∃!-syntax = ∃
|
|
||||||
|
|
||||||
syntax ∃!-syntax (λ x → B) = ∃![ x ] B
|
|
||||||
|
|
||||||
-----------------
|
|
||||||
-- * Categories --
|
-- * Categories --
|
||||||
-----------------
|
------------------
|
||||||
|
|
||||||
-- | Raw categories
|
-- | Raw categories
|
||||||
--
|
--
|
||||||
|
@ -66,25 +44,20 @@ syntax ∃!-syntax (λ x → B) = ∃![ x ] B
|
||||||
-- about these. The laws defined are the types the propositions - not the
|
-- about these. The laws defined are the types the propositions - not the
|
||||||
-- witnesses to them!
|
-- witnesses to them!
|
||||||
record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
no-eta-equality
|
-- no-eta-equality
|
||||||
field
|
field
|
||||||
Object : Set ℓa
|
Object : Set ℓa
|
||||||
Arrow : Object → Object → Set ℓb
|
Arrow : Object → Object → Set ℓb
|
||||||
𝟙 : {A : Object} → Arrow A A
|
identity : {A : Object} → Arrow A A
|
||||||
_∘_ : {A B C : Object} → Arrow B C → Arrow A B → Arrow A C
|
_<<<_ : {A B C : Object} → Arrow B C → Arrow A B → Arrow A C
|
||||||
|
|
||||||
infixl 10 _∘_ _>>>_
|
-- infixr 8 _<<<_
|
||||||
|
-- infixl 8 _>>>_
|
||||||
-- | Operations on data
|
infixl 10 _<<<_ _>>>_
|
||||||
|
|
||||||
domain : { a b : Object } → Arrow a b → Object
|
|
||||||
domain {a = a} _ = a
|
|
||||||
|
|
||||||
codomain : { a b : Object } → Arrow a b → Object
|
|
||||||
codomain {b = b} _ = b
|
|
||||||
|
|
||||||
|
-- | Reverse arrow composition
|
||||||
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
||||||
f >>> g = g ∘ f
|
f >>> g = g <<< f
|
||||||
|
|
||||||
-- | Laws about the data
|
-- | Laws about the data
|
||||||
|
|
||||||
|
@ -92,30 +65,30 @@ record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
-- right-hand-side.
|
-- right-hand-side.
|
||||||
IsAssociative : Set (ℓa ⊔ ℓb)
|
IsAssociative : Set (ℓa ⊔ ℓb)
|
||||||
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
||||||
→ h ∘ (g ∘ f) ≡ (h ∘ g) ∘ f
|
→ h <<< (g <<< f) ≡ (h <<< g) <<< f
|
||||||
|
|
||||||
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
||||||
IsIdentity id = {A B : Object} {f : Arrow A B}
|
IsIdentity id = {A B : Object} {f : Arrow A B}
|
||||||
→ f ∘ id ≡ f × id ∘ f ≡ f
|
→ id <<< f ≡ f × f <<< id ≡ f
|
||||||
|
|
||||||
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
||||||
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
||||||
|
|
||||||
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
||||||
IsInverseOf = λ f g → g ∘ f ≡ 𝟙 × f ∘ g ≡ 𝟙
|
IsInverseOf = λ f g → g <<< f ≡ identity × f <<< g ≡ identity
|
||||||
|
|
||||||
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
||||||
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
||||||
|
|
||||||
_≅_ : (A B : Object) → Set ℓb
|
_≊_ : (A B : Object) → Set ℓb
|
||||||
_≅_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
_≊_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
||||||
|
|
||||||
module _ {A B : Object} where
|
module _ {A B : Object} where
|
||||||
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓb
|
Epimorphism : (f : Arrow A B) → Set _
|
||||||
Epimorphism {X} f = ( g₀ g₁ : Arrow B X ) → g₀ ∘ f ≡ g₁ ∘ f → g₀ ≡ g₁
|
Epimorphism f = ∀ {X} → (g₀ g₁ : Arrow B X) → g₀ <<< f ≡ g₁ <<< f → g₀ ≡ g₁
|
||||||
|
|
||||||
Monomorphism : {X : Object} → (f : Arrow A B) → Set ℓb
|
Monomorphism : (f : Arrow A B) → Set _
|
||||||
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) → f ∘ g₀ ≡ f ∘ g₁ → g₀ ≡ g₁
|
Monomorphism f = ∀ {X} → (g₀ g₁ : Arrow X A) → f <<< g₀ ≡ f <<< g₁ → g₀ ≡ g₁
|
||||||
|
|
||||||
IsInitial : Object → Set (ℓa ⊔ ℓb)
|
IsInitial : Object → Set (ℓa ⊔ ℓb)
|
||||||
IsInitial I = {X : Object} → isContr (Arrow I X)
|
IsInitial I = {X : Object} → isContr (Arrow I X)
|
||||||
|
@ -129,158 +102,496 @@ record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
Terminal : Set (ℓa ⊔ ℓb)
|
Terminal : Set (ℓa ⊔ ℓb)
|
||||||
Terminal = Σ Object IsTerminal
|
Terminal = Σ Object IsTerminal
|
||||||
|
|
||||||
-- | Univalence is indexed by a raw category as well as an identity proof.
|
-- | Univalence is indexed by a raw category as well as an identity proof.
|
||||||
--
|
module Univalence (isIdentity : IsIdentity identity) where
|
||||||
-- FIXME Put this in `RawCategory` and index it on the witness to `isIdentity`.
|
-- | The identity isomorphism
|
||||||
module Univalence {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
idIso : (A : Object) → A ≊ A
|
||||||
open RawCategory ℂ
|
idIso A = identity , identity , isIdentity
|
||||||
module _ (isIdentity : IsIdentity 𝟙) where
|
|
||||||
idIso : (A : Object) → A ≅ A
|
|
||||||
idIso A = 𝟙 , (𝟙 , isIdentity)
|
|
||||||
|
|
||||||
-- Lemma 9.1.4 in [HoTT]
|
-- | Extract an isomorphism from an equality
|
||||||
id-to-iso : (A B : Object) → A ≡ B → A ≅ B
|
--
|
||||||
id-to-iso A B eq = transp (\ i → A ≅ eq i) (idIso A)
|
-- [HoTT §9.1.4]
|
||||||
|
idToIso : (A B : Object) → A ≡ B → A ≊ B
|
||||||
|
idToIso A B eq = subst {P = λ X → A ≊ X} eq (idIso A)
|
||||||
|
|
||||||
Univalent : Set (ℓa ⊔ ℓb)
|
Univalent : Set (ℓa ⊔ ℓb)
|
||||||
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≅ B) (id-to-iso A B)
|
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
|
|
||||||
-- | The mere proposition of being a category.
|
univalenceFromIsomorphism : {A B : Object}
|
||||||
--
|
→ TypeIsomorphism (idToIso A B) → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
-- Also defines a few lemmas:
|
univalenceFromIsomorphism = fromIso _ _
|
||||||
--
|
|
||||||
-- iso-is-epi : Isomorphism f → Epimorphism {X = X} f
|
|
||||||
-- iso-is-mono : Isomorphism f → Monomorphism {X = X} f
|
|
||||||
--
|
|
||||||
-- Sans `univalent` this would be what is referred to as a pre-category in
|
|
||||||
-- [HoTT].
|
|
||||||
record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc (ℓa ⊔ ℓb)) where
|
|
||||||
open RawCategory ℂ public
|
|
||||||
open Univalence ℂ public
|
|
||||||
field
|
|
||||||
isAssociative : IsAssociative
|
|
||||||
isIdentity : IsIdentity 𝟙
|
|
||||||
arrowsAreSets : ArrowsAreSets
|
|
||||||
univalent : Univalent isIdentity
|
|
||||||
|
|
||||||
-- Some common lemmas about categories.
|
-- A perhaps more readable version of univalence:
|
||||||
module _ {A B : Object} {X : Object} (f : Arrow A B) where
|
Univalent≃ = {A B : Object} → (A ≡ B) ≃ (A ≊ B)
|
||||||
iso-is-epi : Isomorphism f → Epimorphism {X = X} f
|
Univalent≅ = {A B : Object} → (A ≡ B) ≅ (A ≊ B)
|
||||||
iso-is-epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
|
||||||
g₀ ≡⟨ sym (fst isIdentity) ⟩
|
|
||||||
g₀ ∘ 𝟙 ≡⟨ cong (_∘_ g₀) (sym right-inv) ⟩
|
|
||||||
g₀ ∘ (f ∘ f-) ≡⟨ isAssociative ⟩
|
|
||||||
(g₀ ∘ f) ∘ f- ≡⟨ cong (λ φ → φ ∘ f-) eq ⟩
|
|
||||||
(g₁ ∘ f) ∘ f- ≡⟨ sym isAssociative ⟩
|
|
||||||
g₁ ∘ (f ∘ f-) ≡⟨ cong (_∘_ g₁) right-inv ⟩
|
|
||||||
g₁ ∘ 𝟙 ≡⟨ fst isIdentity ⟩
|
|
||||||
g₁ ∎
|
|
||||||
|
|
||||||
iso-is-mono : Isomorphism f → Monomorphism {X = X} f
|
private
|
||||||
iso-is-mono (f- , (left-inv , right-inv)) g₀ g₁ eq =
|
-- | Equivalent formulation of univalence.
|
||||||
begin
|
Univalent[Contr] : Set _
|
||||||
g₀ ≡⟨ sym (snd isIdentity) ⟩
|
Univalent[Contr] = ∀ A → isContr (Σ[ X ∈ Object ] A ≊ X)
|
||||||
𝟙 ∘ g₀ ≡⟨ cong (λ φ → φ ∘ g₀) (sym left-inv) ⟩
|
|
||||||
(f- ∘ f) ∘ g₀ ≡⟨ sym isAssociative ⟩
|
|
||||||
f- ∘ (f ∘ g₀) ≡⟨ cong (_∘_ f-) eq ⟩
|
|
||||||
f- ∘ (f ∘ g₁) ≡⟨ isAssociative ⟩
|
|
||||||
(f- ∘ f) ∘ g₁ ≡⟨ cong (λ φ → φ ∘ g₁) left-inv ⟩
|
|
||||||
𝟙 ∘ g₁ ≡⟨ snd isIdentity ⟩
|
|
||||||
g₁ ∎
|
|
||||||
|
|
||||||
iso-is-epi-mono : Isomorphism f → Epimorphism {X = X} f × Monomorphism {X = X} f
|
from[Contr] : Univalent[Contr] → Univalent
|
||||||
iso-is-epi-mono iso = iso-is-epi iso , iso-is-mono iso
|
from[Contr] = ContrToUniv.lemma _ _
|
||||||
|
where
|
||||||
|
open import Cubical.Fiberwise
|
||||||
|
|
||||||
-- | Propositionality of being a category
|
univalenceFrom≃ : Univalent≃ → Univalent
|
||||||
--
|
univalenceFrom≃ = from[Contr] ∘ step
|
||||||
-- Proves that all projections of `IsCategory` are mere propositions as well as
|
where
|
||||||
-- `IsCategory` itself being a mere proposition.
|
module _ (f : Univalent≃) (A : Object) where
|
||||||
module Propositionality {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
lem : Σ Object (A ≡_) ≃ Σ Object (A ≊_)
|
||||||
open RawCategory ℂ
|
lem = equivSig λ _ → f
|
||||||
module _ (ℂ : IsCategory ℂ) where
|
|
||||||
open IsCategory ℂ using (isAssociative ; arrowsAreSets ; isIdentity ; Univalent)
|
aux : isContr (Σ Object (A ≡_))
|
||||||
open import Cubical.NType
|
aux = (A , refl) , (λ y → contrSingl (snd y))
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
step : isContr (Σ Object (A ≊_))
|
||||||
|
step = equivPreservesNType {n = ⟨-2⟩} lem aux
|
||||||
|
|
||||||
|
univalenceFrom≅ : Univalent≅ → Univalent
|
||||||
|
univalenceFrom≅ x = univalenceFrom≃ $ fromIsomorphism _ _ x
|
||||||
|
|
||||||
|
propUnivalent : isProp Univalent
|
||||||
|
propUnivalent a b i .equiv-proof = propPi (λ iso → propIsContr) (a .equiv-proof) (b .equiv-proof) i
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
|
record IsPreCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
open RawCategory ℂ public
|
||||||
|
field
|
||||||
|
isAssociative : IsAssociative
|
||||||
|
isIdentity : IsIdentity identity
|
||||||
|
arrowsAreSets : ArrowsAreSets
|
||||||
|
open Univalence isIdentity public
|
||||||
|
|
||||||
|
leftIdentity : {A B : Object} {f : Arrow A B} → identity <<< f ≡ f
|
||||||
|
leftIdentity {A} {B} {f} = fst (isIdentity {A = A} {B} {f})
|
||||||
|
|
||||||
|
rightIdentity : {A B : Object} {f : Arrow A B} → f <<< identity ≡ f
|
||||||
|
rightIdentity {A} {B} {f} = snd (isIdentity {A = A} {B} {f})
|
||||||
|
|
||||||
|
------------
|
||||||
|
-- Lemmas --
|
||||||
|
------------
|
||||||
|
|
||||||
|
-- | Relation between iso- epi- and mono- morphisms.
|
||||||
|
module _ {A B : Object} {X : Object} (f : Arrow A B) where
|
||||||
|
iso→epi : Isomorphism f → Epimorphism f
|
||||||
|
iso→epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
||||||
|
g₀ ≡⟨ sym rightIdentity ⟩
|
||||||
|
g₀ <<< identity ≡⟨ cong (_<<<_ g₀) (sym right-inv) ⟩
|
||||||
|
g₀ <<< (f <<< f-) ≡⟨ isAssociative ⟩
|
||||||
|
(g₀ <<< f) <<< f- ≡⟨ cong (λ φ → φ <<< f-) eq ⟩
|
||||||
|
(g₁ <<< f) <<< f- ≡⟨ sym isAssociative ⟩
|
||||||
|
g₁ <<< (f <<< f-) ≡⟨ cong (_<<<_ g₁) right-inv ⟩
|
||||||
|
g₁ <<< identity ≡⟨ rightIdentity ⟩
|
||||||
|
g₁ ∎
|
||||||
|
|
||||||
|
iso→mono : Isomorphism f → Monomorphism f
|
||||||
|
iso→mono (f- , left-inv , right-inv) g₀ g₁ eq =
|
||||||
|
begin
|
||||||
|
g₀ ≡⟨ sym leftIdentity ⟩
|
||||||
|
identity <<< g₀ ≡⟨ cong (λ φ → φ <<< g₀) (sym left-inv) ⟩
|
||||||
|
(f- <<< f) <<< g₀ ≡⟨ sym isAssociative ⟩
|
||||||
|
f- <<< (f <<< g₀) ≡⟨ cong (_<<<_ f-) eq ⟩
|
||||||
|
f- <<< (f <<< g₁) ≡⟨ isAssociative ⟩
|
||||||
|
(f- <<< f) <<< g₁ ≡⟨ cong (λ φ → φ <<< g₁) left-inv ⟩
|
||||||
|
identity <<< g₁ ≡⟨ leftIdentity ⟩
|
||||||
|
g₁ ∎
|
||||||
|
|
||||||
|
iso→epi×mono : Isomorphism f → Epimorphism f × Monomorphism f
|
||||||
|
iso→epi×mono iso = iso→epi iso , iso→mono iso
|
||||||
|
|
||||||
propIsAssociative : isProp IsAssociative
|
propIsAssociative : isProp IsAssociative
|
||||||
propIsAssociative x y i = arrowsAreSets _ _ x y i
|
propIsAssociative = propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl λ _ → arrowsAreSets _ _))))))
|
||||||
|
|
||||||
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
||||||
propIsIdentity a b i
|
propIsIdentity {id} = propPiImpl (λ _ → propPiImpl λ _ → propPiImpl (λ f →
|
||||||
= arrowsAreSets _ _ (fst a) (fst b) i
|
propSig (arrowsAreSets (id <<< f) f) λ _ → arrowsAreSets (f <<< id) f))
|
||||||
, arrowsAreSets _ _ (snd a) (snd b) i
|
|
||||||
|
|
||||||
propArrowIsSet : isProp (∀ {A B} → isSet (Arrow A B))
|
propArrowIsSet : isProp (∀ {A B} → isSet (Arrow A B))
|
||||||
propArrowIsSet a b i = isSetIsProp a b i
|
propArrowIsSet = propPiImpl λ _ → propPiImpl (λ _ → isSetIsProp)
|
||||||
|
|
||||||
propIsInverseOf : ∀ {A B f g} → isProp (IsInverseOf {A} {B} f g)
|
propIsInverseOf : ∀ {A B f g} → isProp (IsInverseOf {A} {B} f g)
|
||||||
propIsInverseOf x y = λ i →
|
propIsInverseOf = propSig (arrowsAreSets _ _) (λ _ → arrowsAreSets _ _)
|
||||||
let
|
|
||||||
h : fst x ≡ fst y
|
|
||||||
h = arrowsAreSets _ _ (fst x) (fst y)
|
|
||||||
hh : snd x ≡ snd y
|
|
||||||
hh = arrowsAreSets _ _ (snd x) (snd y)
|
|
||||||
in h i , hh i
|
|
||||||
|
|
||||||
module _ {A B : Object} {f : Arrow A B} where
|
module _ {A B : Object} where
|
||||||
isoIsProp : isProp (Isomorphism f)
|
propIsomorphism : (f : Arrow A B) → isProp (Isomorphism f)
|
||||||
isoIsProp a@(g , η , ε) a'@(g' , η' , ε') =
|
propIsomorphism f a@(g , η , ε) a'@(g' , η' , ε') =
|
||||||
lemSig (λ g → propIsInverseOf) a a' geq
|
lemSig (λ g → propIsInverseOf) a a' geq
|
||||||
where
|
where
|
||||||
open Cubical.NType.Properties
|
|
||||||
geq : g ≡ g'
|
geq : g ≡ g'
|
||||||
geq = begin
|
geq = begin
|
||||||
g ≡⟨ sym (fst isIdentity) ⟩
|
g ≡⟨ sym rightIdentity ⟩
|
||||||
g ∘ 𝟙 ≡⟨ cong (λ φ → g ∘ φ) (sym ε') ⟩
|
g <<< identity ≡⟨ cong (λ φ → g <<< φ) (sym ε') ⟩
|
||||||
g ∘ (f ∘ g') ≡⟨ isAssociative ⟩
|
g <<< (f <<< g') ≡⟨ isAssociative ⟩
|
||||||
(g ∘ f) ∘ g' ≡⟨ cong (λ φ → φ ∘ g') η ⟩
|
(g <<< f) <<< g' ≡⟨ cong (λ φ → φ <<< g') η ⟩
|
||||||
𝟙 ∘ g' ≡⟨ snd isIdentity ⟩
|
identity <<< g' ≡⟨ leftIdentity ⟩
|
||||||
g' ∎
|
g' ∎
|
||||||
|
|
||||||
propUnivalent : isProp (Univalent isIdentity)
|
isoEq : {a b : A ≊ B} → fst a ≡ fst b → a ≡ b
|
||||||
propUnivalent a b i = propPi (λ iso → propHasLevel ⟨-2⟩) a b i
|
isoEq = lemSig propIsomorphism _ _
|
||||||
|
|
||||||
|
propIsInitial : ∀ I → isProp (IsInitial I)
|
||||||
|
propIsInitial I x y i {X} = res X i
|
||||||
|
where
|
||||||
|
module _ (X : Object) where
|
||||||
|
open Σ (x {X}) renaming (fst to fx ; snd to cx)
|
||||||
|
open Σ (y {X}) renaming (fst to fy ; snd to cy)
|
||||||
|
fp : fx ≡ fy
|
||||||
|
fp = cx fy
|
||||||
|
prop : (x : Arrow I X) → isProp (∀ f → x ≡ f)
|
||||||
|
prop x = propPi (λ y → arrowsAreSets x y)
|
||||||
|
cp : (λ i → ∀ f → fp i ≡ f) [ cx ≡ cy ]
|
||||||
|
cp = lemPropF prop fp
|
||||||
|
res : (fx , cx) ≡ (fy , cy)
|
||||||
|
res i = fp i , cp i
|
||||||
|
|
||||||
|
propIsTerminal : ∀ T → isProp (IsTerminal T)
|
||||||
|
propIsTerminal T x y i {X} = res X i
|
||||||
|
where
|
||||||
|
module _ (X : Object) where
|
||||||
|
open Σ (x {X}) renaming (fst to fx ; snd to cx)
|
||||||
|
open Σ (y {X}) renaming (fst to fy ; snd to cy)
|
||||||
|
fp : fx ≡ fy
|
||||||
|
fp = cx fy
|
||||||
|
prop : (x : Arrow X T) → isProp (∀ f → x ≡ f)
|
||||||
|
prop x = propPi (λ y → arrowsAreSets x y)
|
||||||
|
cp : (λ i → ∀ f → fp i ≡ f) [ cx ≡ cy ]
|
||||||
|
cp = lemPropF prop fp
|
||||||
|
res : (fx , cx) ≡ (fy , cy)
|
||||||
|
res i = fp i , cp i
|
||||||
|
|
||||||
|
module _ where
|
||||||
|
private
|
||||||
|
trans≊ : Transitive _≊_
|
||||||
|
trans≊ (f , f~ , f-inv) (g , g~ , g-inv)
|
||||||
|
= g <<< f
|
||||||
|
, f~ <<< g~
|
||||||
|
, ( begin
|
||||||
|
(f~ <<< g~) <<< (g <<< f) ≡⟨ isAssociative ⟩
|
||||||
|
(f~ <<< g~) <<< g <<< f ≡⟨ cong (λ φ → φ <<< f) (sym isAssociative) ⟩
|
||||||
|
f~ <<< (g~ <<< g) <<< f ≡⟨ cong (λ φ → f~ <<< φ <<< f) (fst g-inv) ⟩
|
||||||
|
f~ <<< identity <<< f ≡⟨ cong (λ φ → φ <<< f) rightIdentity ⟩
|
||||||
|
f~ <<< f ≡⟨ fst f-inv ⟩
|
||||||
|
identity ∎
|
||||||
|
)
|
||||||
|
, ( begin
|
||||||
|
g <<< f <<< (f~ <<< g~) ≡⟨ isAssociative ⟩
|
||||||
|
g <<< f <<< f~ <<< g~ ≡⟨ cong (λ φ → φ <<< g~) (sym isAssociative) ⟩
|
||||||
|
g <<< (f <<< f~) <<< g~ ≡⟨ cong (λ φ → g <<< φ <<< g~) (snd f-inv) ⟩
|
||||||
|
g <<< identity <<< g~ ≡⟨ cong (λ φ → φ <<< g~) rightIdentity ⟩
|
||||||
|
g <<< g~ ≡⟨ snd g-inv ⟩
|
||||||
|
identity ∎
|
||||||
|
)
|
||||||
|
isPreorder : IsPreorder _≊_
|
||||||
|
isPreorder = record { isEquivalence = equalityIsEquivalence ; reflexive = idToIso _ _ ; trans = trans≊ }
|
||||||
|
|
||||||
|
preorder≊ : Preorder _ _ _
|
||||||
|
preorder≊ = record { Carrier = Object ; _≈_ = _≡_ ; _∼_ = _≊_ ; isPreorder = isPreorder }
|
||||||
|
|
||||||
|
record PreCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
isPreCategory : IsPreCategory
|
||||||
|
open IsPreCategory isPreCategory public
|
||||||
|
|
||||||
|
-- Definition 9.6.1 in [HoTT]
|
||||||
|
record StrictCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
preCategory : PreCategory
|
||||||
|
open PreCategory preCategory
|
||||||
|
field
|
||||||
|
objectsAreSets : isSet Object
|
||||||
|
|
||||||
|
record IsCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
field
|
||||||
|
isPreCategory : IsPreCategory
|
||||||
|
open IsPreCategory isPreCategory public
|
||||||
|
field
|
||||||
|
univalent : Univalent
|
||||||
|
|
||||||
|
-- | The formulation of univalence expressed with _≃_ is trivially admissable -
|
||||||
|
-- just "forget" the equivalence.
|
||||||
|
univalent≃ : Univalent≃
|
||||||
|
univalent≃ = _ , univalent
|
||||||
|
|
||||||
|
module _ {A B : Object} where
|
||||||
|
private
|
||||||
|
iso : TypeIsomorphism (idToIso A B)
|
||||||
|
iso = toIso _ _ univalent
|
||||||
|
|
||||||
|
isoToId : (A ≊ B) → (A ≡ B)
|
||||||
|
isoToId = fst iso
|
||||||
|
|
||||||
|
asTypeIso : TypeIsomorphism (idToIso A B)
|
||||||
|
asTypeIso = toIso _ _ univalent
|
||||||
|
|
||||||
|
-- FIXME Rename
|
||||||
|
inverse-from-to-iso' : AreInverses (idToIso A B) isoToId
|
||||||
|
inverse-from-to-iso' = snd iso
|
||||||
|
|
||||||
|
module _ {a b : Object} (f : Arrow a b) where
|
||||||
|
module _ {a' : Object} (p : a ≡ a') where
|
||||||
|
private
|
||||||
|
p~ : Arrow a' a
|
||||||
|
p~ = fst (snd (idToIso _ _ p))
|
||||||
|
|
||||||
|
D : ∀ a'' → a ≡ a'' → Set _
|
||||||
|
D a'' p' = coe (cong (λ x → Arrow x b) p') f ≡ f <<< (fst (snd (idToIso _ _ p')))
|
||||||
|
|
||||||
|
9-1-9-left : coe (cong (λ x → Arrow x b) p) f ≡ f <<< p~
|
||||||
|
9-1-9-left = pathJ D (begin
|
||||||
|
coe refl f ≡⟨ id-coe ⟩
|
||||||
|
f ≡⟨ sym rightIdentity ⟩
|
||||||
|
f <<< identity ≡⟨ cong (f <<<_) (sym subst-neutral) ⟩
|
||||||
|
f <<< _ ≡⟨⟩ _ ∎) a' p
|
||||||
|
|
||||||
|
module _ {b' : Object} (p : b ≡ b') where
|
||||||
|
private
|
||||||
|
p* : Arrow b b'
|
||||||
|
p* = fst (idToIso _ _ p)
|
||||||
|
|
||||||
|
D : ∀ b'' → b ≡ b'' → Set _
|
||||||
|
D b'' p' = coe (cong (λ x → Arrow a x) p') f ≡ fst (idToIso _ _ p') <<< f
|
||||||
|
|
||||||
|
9-1-9-right : coe (cong (λ x → Arrow a x) p) f ≡ p* <<< f
|
||||||
|
9-1-9-right = pathJ D (begin
|
||||||
|
coe refl f ≡⟨ id-coe ⟩
|
||||||
|
f ≡⟨ sym leftIdentity ⟩
|
||||||
|
identity <<< f ≡⟨ cong (_<<< f) (sym subst-neutral) ⟩
|
||||||
|
_ <<< f ∎) b' p
|
||||||
|
|
||||||
|
-- lemma 9.1.9 in hott
|
||||||
|
module _ {a a' b b' : Object}
|
||||||
|
(p : a ≡ a') (q : b ≡ b') (f : Arrow a b)
|
||||||
|
where
|
||||||
|
private
|
||||||
|
q* : Arrow b b'
|
||||||
|
q* = fst (idToIso _ _ q)
|
||||||
|
q~ : Arrow b' b
|
||||||
|
q~ = fst (snd (idToIso _ _ q))
|
||||||
|
p* : Arrow a a'
|
||||||
|
p* = fst (idToIso _ _ p)
|
||||||
|
p~ : Arrow a' a
|
||||||
|
p~ = fst (snd (idToIso _ _ p))
|
||||||
|
pq : Arrow a b ≡ Arrow a' b'
|
||||||
|
pq i = Arrow (p i) (q i)
|
||||||
|
|
||||||
|
U : ∀ b'' → b ≡ b'' → Set _
|
||||||
|
U b'' q' = coe (λ i → Arrow a (q' i)) f ≡ fst (idToIso _ _ q') <<< f <<< (fst (snd (idToIso _ _ refl)))
|
||||||
|
u : coe (λ i → Arrow a b) f ≡ fst (idToIso _ _ refl) <<< f <<< (fst (snd (idToIso _ _ refl)))
|
||||||
|
u = begin
|
||||||
|
coe refl f ≡⟨ id-coe ⟩
|
||||||
|
f ≡⟨ sym leftIdentity ⟩
|
||||||
|
identity <<< f ≡⟨ sym rightIdentity ⟩
|
||||||
|
identity <<< f <<< identity ≡⟨ cong (λ φ → identity <<< f <<< φ) lem ⟩
|
||||||
|
identity <<< f <<< (fst (snd (idToIso _ _ refl))) ≡⟨ cong (λ φ → φ <<< f <<< (fst (snd (idToIso _ _ refl)))) lem ⟩
|
||||||
|
fst (idToIso _ _ refl) <<< f <<< (fst (snd (idToIso _ _ refl))) ∎
|
||||||
|
where
|
||||||
|
lem : ∀ {x} → PathP (λ _ → Arrow x x) identity (fst (idToIso x x refl))
|
||||||
|
lem = sym subst-neutral
|
||||||
|
|
||||||
|
D : ∀ a'' → a ≡ a'' → Set _
|
||||||
|
D a'' p' = coe (λ i → Arrow (p' i) (q i)) f ≡ fst (idToIso b b' q) <<< f <<< (fst (snd (idToIso _ _ p')))
|
||||||
|
|
||||||
|
d : coe (λ i → Arrow a (q i)) f ≡ fst (idToIso b b' q) <<< f <<< (fst (snd (idToIso _ _ refl)))
|
||||||
|
d = pathJ U u b' q
|
||||||
|
|
||||||
|
9-1-9 : coe pq f ≡ q* <<< f <<< p~
|
||||||
|
9-1-9 = pathJ D d a' p
|
||||||
|
|
||||||
|
9-1-9' : coe pq f <<< p* ≡ q* <<< f
|
||||||
|
9-1-9' = begin
|
||||||
|
coe pq f <<< p* ≡⟨ cong (_<<< p*) 9-1-9 ⟩
|
||||||
|
q* <<< f <<< p~ <<< p* ≡⟨ sym isAssociative ⟩
|
||||||
|
q* <<< f <<< (p~ <<< p*) ≡⟨ cong (λ φ → q* <<< f <<< φ) lem ⟩
|
||||||
|
q* <<< f <<< identity ≡⟨ rightIdentity ⟩
|
||||||
|
q* <<< f ∎
|
||||||
|
where
|
||||||
|
lem : p~ <<< p* ≡ identity
|
||||||
|
lem = fst (snd (snd (idToIso _ _ p)))
|
||||||
|
|
||||||
|
module _ {A B X : Object} (iso : A ≊ B) where
|
||||||
|
private
|
||||||
|
p : A ≡ B
|
||||||
|
p = isoToId iso
|
||||||
|
p-dom : Arrow A X ≡ Arrow B X
|
||||||
|
p-dom = cong (λ x → Arrow x X) p
|
||||||
|
p-cod : Arrow X A ≡ Arrow X B
|
||||||
|
p-cod = cong (λ x → Arrow X x) p
|
||||||
|
lem : ∀ {A B} {x : A ≊ B} → idToIso A B (isoToId x) ≡ x
|
||||||
|
lem {x = x} i = snd inverse-from-to-iso' i x
|
||||||
|
|
||||||
|
open Σ iso renaming (fst to ι) using ()
|
||||||
|
open Σ (snd iso) renaming (fst to ι~ ; snd to inv)
|
||||||
|
|
||||||
|
coe-dom : {f : Arrow A X} → coe p-dom f ≡ f <<< ι~
|
||||||
|
coe-dom {f} = begin
|
||||||
|
coe p-dom f ≡⟨ 9-1-9-left f p ⟩
|
||||||
|
f <<< fst (snd (idToIso _ _ (isoToId iso))) ≡⟨⟩
|
||||||
|
f <<< fst (snd (idToIso _ _ p)) ≡⟨ cong (f <<<_) (cong (fst ∘ snd) lem) ⟩
|
||||||
|
f <<< ι~ ∎
|
||||||
|
|
||||||
|
coe-cod : {f : Arrow X A} → coe p-cod f ≡ ι <<< f
|
||||||
|
coe-cod {f} = begin
|
||||||
|
coe p-cod f
|
||||||
|
≡⟨ 9-1-9-right f p ⟩
|
||||||
|
fst (idToIso _ _ p) <<< f
|
||||||
|
≡⟨ cong (λ φ → φ <<< f) (cong fst lem) ⟩
|
||||||
|
ι <<< f ∎
|
||||||
|
|
||||||
|
module _ {f : Arrow A X} {g : Arrow B X} (q : PathP (λ i → p-dom i) f g) where
|
||||||
|
domain-twist : g ≡ f <<< ι~
|
||||||
|
domain-twist = begin
|
||||||
|
g ≡⟨ sym (coe-lem q) ⟩
|
||||||
|
coe p-dom f ≡⟨ coe-dom ⟩
|
||||||
|
f <<< ι~ ∎
|
||||||
|
|
||||||
|
-- This can probably also just be obtained from the above my taking the
|
||||||
|
-- symmetric isomorphism.
|
||||||
|
domain-twist-sym : f ≡ g <<< ι
|
||||||
|
domain-twist-sym = begin
|
||||||
|
f ≡⟨ sym rightIdentity ⟩
|
||||||
|
f <<< identity ≡⟨ cong (f <<<_) (sym (fst inv)) ⟩
|
||||||
|
f <<< (ι~ <<< ι) ≡⟨ isAssociative ⟩
|
||||||
|
f <<< ι~ <<< ι ≡⟨ cong (_<<< ι) (sym domain-twist) ⟩
|
||||||
|
g <<< ι ∎
|
||||||
|
|
||||||
|
-- | All projections are propositions.
|
||||||
|
module Propositionality where
|
||||||
|
-- | Terminal objects are propositional - a.k.a uniqueness of terminal
|
||||||
|
-- | objects.
|
||||||
|
--
|
||||||
|
-- Having two terminal objects induces an isomorphism between them - and
|
||||||
|
-- because of univalence this is equivalent to equality.
|
||||||
|
propTerminal : isProp Terminal
|
||||||
|
propTerminal Xt Yt = res
|
||||||
|
where
|
||||||
|
open Σ Xt renaming (fst to X ; snd to Xit)
|
||||||
|
open Σ Yt renaming (fst to Y ; snd to Yit)
|
||||||
|
open Σ (Xit {Y}) renaming (fst to Y→X) using ()
|
||||||
|
open Σ (Yit {X}) renaming (fst to X→Y) using ()
|
||||||
|
-- Need to show `left` and `right`, what we know is that the arrows are
|
||||||
|
-- unique. Well, I know that if I compose these two arrows they must give
|
||||||
|
-- the identity, since also the identity is the unique such arrow (by X
|
||||||
|
-- and Y both being terminal objects.)
|
||||||
|
Xprop : isProp (Arrow X X)
|
||||||
|
Xprop f g = trans (sym (snd Xit f)) (snd Xit g)
|
||||||
|
Yprop : isProp (Arrow Y Y)
|
||||||
|
Yprop f g = trans (sym (snd Yit f)) (snd Yit g)
|
||||||
|
left : Y→X <<< X→Y ≡ identity
|
||||||
|
left = Xprop _ _
|
||||||
|
right : X→Y <<< Y→X ≡ identity
|
||||||
|
right = Yprop _ _
|
||||||
|
iso : X ≊ Y
|
||||||
|
iso = X→Y , Y→X , left , right
|
||||||
|
p0 : X ≡ Y
|
||||||
|
p0 = isoToId iso
|
||||||
|
p1 : (λ i → IsTerminal (p0 i)) [ Xit ≡ Yit ]
|
||||||
|
p1 = lemPropF propIsTerminal p0
|
||||||
|
res : Xt ≡ Yt
|
||||||
|
res i = p0 i , p1 i
|
||||||
|
|
||||||
|
-- Merely the dual of the above statement.
|
||||||
|
|
||||||
|
propInitial : isProp Initial
|
||||||
|
propInitial Xi Yi = res
|
||||||
|
where
|
||||||
|
open Σ Xi renaming (fst to X ; snd to Xii)
|
||||||
|
open Σ Yi renaming (fst to Y ; snd to Yii)
|
||||||
|
open Σ (Xii {Y}) renaming (fst to Y→X) using ()
|
||||||
|
open Σ (Yii {X}) renaming (fst to X→Y) using ()
|
||||||
|
-- Need to show `left` and `right`, what we know is that the arrows are
|
||||||
|
-- unique. Well, I know that if I compose these two arrows they must give
|
||||||
|
-- the identity, since also the identity is the unique such arrow (by X
|
||||||
|
-- and Y both being terminal objects.)
|
||||||
|
Xprop : isProp (Arrow X X)
|
||||||
|
Xprop f g = trans (sym (snd Xii f)) (snd Xii g)
|
||||||
|
Yprop : isProp (Arrow Y Y)
|
||||||
|
Yprop f g = trans (sym (snd Yii f)) (snd Yii g)
|
||||||
|
left : Y→X <<< X→Y ≡ identity
|
||||||
|
left = Yprop _ _
|
||||||
|
right : X→Y <<< Y→X ≡ identity
|
||||||
|
right = Xprop _ _
|
||||||
|
iso : X ≊ Y
|
||||||
|
iso = Y→X , X→Y , right , left
|
||||||
|
res : Xi ≡ Yi
|
||||||
|
res = lemSig propIsInitial _ _ (isoToId iso)
|
||||||
|
|
||||||
|
groupoidObject : isGrpd Object
|
||||||
|
groupoidObject A B = res
|
||||||
|
where
|
||||||
|
open import Data.Nat using (_≤_ ; ≤′-refl ; ≤′-step)
|
||||||
|
setIso : ∀ x → isSet (Isomorphism x)
|
||||||
|
setIso x = ntypeCumulative {n = 1} (≤′-step ≤′-refl) (propIsomorphism x)
|
||||||
|
step : isSet (A ≊ B)
|
||||||
|
step = setSig {sA = arrowsAreSets} {sB = setIso}
|
||||||
|
res : isSet (A ≡ B)
|
||||||
|
res = equivPreservesNType
|
||||||
|
{A = A ≊ B} {B = A ≡ B} {n = ⟨0⟩}
|
||||||
|
(Equivalence.symmetry (univalent≃ {A = A} {B}))
|
||||||
|
step
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
|
open RawCategory ℂ
|
||||||
|
open Univalence
|
||||||
private
|
private
|
||||||
module _ (x y : IsCategory ℂ) where
|
module _ (x y : IsPreCategory ℂ) where
|
||||||
module IC = IsCategory
|
module x = IsPreCategory x
|
||||||
module X = IsCategory x
|
module y = IsPreCategory y
|
||||||
module Y = IsCategory y
|
|
||||||
open Univalence ℂ
|
|
||||||
-- In a few places I use the result of propositionality of the various
|
-- In a few places I use the result of propositionality of the various
|
||||||
-- projections of `IsCategory` - I've arbitrarily chosed to use this
|
-- projections of `IsCategory` - Here I arbitrarily chose to use this
|
||||||
-- result from `x : IsCategory C`. I don't know which (if any) possibly
|
-- result from `x : IsCategory C`. I don't know which (if any) possibly
|
||||||
-- adverse effects this may have.
|
-- adverse effects this may have.
|
||||||
isIdentity : (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ Y.isIdentity ]
|
-- module Prop = X.Propositionality
|
||||||
isIdentity = propIsIdentity x X.isIdentity Y.isIdentity
|
|
||||||
U : ∀ {a : IsIdentity 𝟙}
|
propIsPreCategory : x ≡ y
|
||||||
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ a ]
|
IsPreCategory.isAssociative (propIsPreCategory i)
|
||||||
→ (b : Univalent a)
|
= x.propIsAssociative x.isAssociative y.isAssociative i
|
||||||
→ Set _
|
IsPreCategory.isIdentity (propIsPreCategory i)
|
||||||
U eqwal univ =
|
= x.propIsIdentity x.isIdentity y.isIdentity i
|
||||||
(λ i → Univalent (eqwal i))
|
IsPreCategory.arrowsAreSets (propIsPreCategory i)
|
||||||
[ X.univalent ≡ univ ]
|
= x.propArrowIsSet x.arrowsAreSets y.arrowsAreSets i
|
||||||
P : (y : IsIdentity 𝟙)
|
|
||||||
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ y ] → Set _
|
module _ (x y : IsCategory ℂ) where
|
||||||
P y eq = ∀ (univ : Univalent y) → U eq univ
|
module X = IsCategory x
|
||||||
p : ∀ (b' : Univalent X.isIdentity)
|
module Y = IsCategory y
|
||||||
→ (λ _ → Univalent X.isIdentity) [ X.univalent ≡ b' ]
|
-- In a few places I use the result of propositionality of the various
|
||||||
p univ = propUnivalent x X.univalent univ
|
-- projections of `IsCategory` - Here I arbitrarily chose to use this
|
||||||
helper : P Y.isIdentity isIdentity
|
-- result from `x : IsCategory C`. I don't know which (if any) possibly
|
||||||
helper = pathJ P p Y.isIdentity isIdentity
|
-- adverse effects this may have.
|
||||||
eqUni : U isIdentity Y.univalent
|
|
||||||
eqUni = helper Y.univalent
|
isIdentity= : (λ _ → IsIdentity identity) [ X.isIdentity ≡ Y.isIdentity ]
|
||||||
|
isIdentity= = X.propIsIdentity X.isIdentity Y.isIdentity
|
||||||
|
|
||||||
|
isPreCategory= : X.isPreCategory ≡ Y.isPreCategory
|
||||||
|
isPreCategory= = propIsPreCategory X.isPreCategory Y.isPreCategory
|
||||||
|
|
||||||
|
private
|
||||||
|
p = cong IsPreCategory.isIdentity isPreCategory=
|
||||||
|
|
||||||
|
univalent= : (λ i → Univalent (p i))
|
||||||
|
[ X.univalent ≡ Y.univalent ]
|
||||||
|
univalent= = lemPropF
|
||||||
|
{A = IsIdentity identity}
|
||||||
|
{B = Univalent}
|
||||||
|
propUnivalent
|
||||||
|
{a0 = X.isIdentity}
|
||||||
|
{a1 = Y.isIdentity}
|
||||||
|
p
|
||||||
|
|
||||||
done : x ≡ y
|
done : x ≡ y
|
||||||
IC.isAssociative (done i) = propIsAssociative x X.isAssociative Y.isAssociative i
|
IsCategory.isPreCategory (done i) = isPreCategory= i
|
||||||
IC.isIdentity (done i) = isIdentity i
|
IsCategory.univalent (done i) = univalent= i
|
||||||
IC.arrowsAreSets (done i) = propArrowIsSet x X.arrowsAreSets Y.arrowsAreSets i
|
|
||||||
IC.univalent (done i) = eqUni i
|
|
||||||
|
|
||||||
propIsCategory : isProp (IsCategory ℂ)
|
propIsCategory : isProp (IsCategory ℂ)
|
||||||
propIsCategory = done
|
propIsCategory = done
|
||||||
|
|
||||||
|
|
||||||
-- | Univalent categories
|
-- | Univalent categories
|
||||||
--
|
--
|
||||||
-- Just bundles up the data with witnesses inhabiting the propositions.
|
-- Just bundles up the data with witnesses inhabiting the propositions.
|
||||||
|
|
||||||
|
-- Question: Should I remove the type `Category`?
|
||||||
record Category (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
record Category (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
field
|
field
|
||||||
raw : RawCategory ℓa ℓb
|
raw : RawCategory ℓa ℓb
|
||||||
|
@ -298,13 +609,11 @@ module _ {ℓa ℓb : Level} {ℂ 𝔻 : Category ℓa ℓb} where
|
||||||
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
||||||
private
|
private
|
||||||
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
||||||
isCategoryEq = lemPropF Propositionality.propIsCategory rawEq
|
isCategoryEq = lemPropF {A = RawCategory _ _} {B = IsCategory} propIsCategory rawEq
|
||||||
|
|
||||||
Category≡ : ℂ ≡ 𝔻
|
Category≡ : ℂ ≡ 𝔻
|
||||||
Category≡ i = record
|
Category.raw (Category≡ i) = rawEq i
|
||||||
{ raw = rawEq i
|
Category.isCategory (Category≡ i) = isCategoryEq i
|
||||||
; isCategory = isCategoryEq i
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Syntax for arrows- and composition in a given category.
|
-- | Syntax for arrows- and composition in a given category.
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
@ -313,67 +622,4 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
_[_,_] = Arrow
|
_[_,_] = Arrow
|
||||||
|
|
||||||
_[_∘_] : {A B C : Object} → (g : Arrow B C) → (f : Arrow A B) → Arrow A C
|
_[_∘_] : {A B C : Object} → (g : Arrow B C) → (f : Arrow A B) → Arrow A C
|
||||||
_[_∘_] = _∘_
|
_[_∘_] = _<<<_
|
||||||
|
|
||||||
-- | The opposite category
|
|
||||||
--
|
|
||||||
-- The opposite category is the category where the direction of the arrows are
|
|
||||||
-- flipped.
|
|
||||||
module Opposite {ℓa ℓb : Level} where
|
|
||||||
module _ (ℂ : Category ℓa ℓb) where
|
|
||||||
private
|
|
||||||
module ℂ = Category ℂ
|
|
||||||
opRaw : RawCategory ℓa ℓb
|
|
||||||
RawCategory.Object opRaw = ℂ.Object
|
|
||||||
RawCategory.Arrow opRaw = Function.flip ℂ.Arrow
|
|
||||||
RawCategory.𝟙 opRaw = ℂ.𝟙
|
|
||||||
RawCategory._∘_ opRaw = Function.flip ℂ._∘_
|
|
||||||
|
|
||||||
open RawCategory opRaw
|
|
||||||
open Univalence opRaw
|
|
||||||
|
|
||||||
isIdentity : IsIdentity 𝟙
|
|
||||||
isIdentity = swap ℂ.isIdentity
|
|
||||||
|
|
||||||
module _ {A B : ℂ.Object} where
|
|
||||||
univalent : isEquiv (A ≡ B) (A ≅ B)
|
|
||||||
(id-to-iso (swap ℂ.isIdentity) A B)
|
|
||||||
fst (univalent iso) = flipFiber (fst (ℂ.univalent (flipIso iso)))
|
|
||||||
where
|
|
||||||
flipIso : A ≅ B → B ℂ.≅ A
|
|
||||||
flipIso (f , f~ , iso) = f , f~ , swap iso
|
|
||||||
flipFiber
|
|
||||||
: fiber (ℂ.id-to-iso ℂ.isIdentity B A) (flipIso iso)
|
|
||||||
→ fiber ( id-to-iso isIdentity A B) iso
|
|
||||||
flipFiber (eq , eqIso) = sym eq , {!!}
|
|
||||||
snd (univalent iso) = {!!}
|
|
||||||
|
|
||||||
isCategory : IsCategory opRaw
|
|
||||||
IsCategory.isAssociative isCategory = sym ℂ.isAssociative
|
|
||||||
IsCategory.isIdentity isCategory = isIdentity
|
|
||||||
IsCategory.arrowsAreSets isCategory = ℂ.arrowsAreSets
|
|
||||||
IsCategory.univalent isCategory = univalent
|
|
||||||
|
|
||||||
opposite : Category ℓa ℓb
|
|
||||||
Category.raw opposite = opRaw
|
|
||||||
Category.isCategory opposite = isCategory
|
|
||||||
|
|
||||||
-- As demonstrated here a side-effect of having no-eta-equality on constructors
|
|
||||||
-- means that we need to pick things apart to show that things are indeed
|
|
||||||
-- definitionally equal. I.e; a thing that would normally be provable in one
|
|
||||||
-- line now takes 13!! Admittedly it's a simple proof.
|
|
||||||
module _ {ℂ : Category ℓa ℓb} where
|
|
||||||
open Category ℂ
|
|
||||||
private
|
|
||||||
-- Since they really are definitionally equal we just need to pick apart
|
|
||||||
-- the data-type.
|
|
||||||
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
|
||||||
RawCategory.Object (rawInv _) = Object
|
|
||||||
RawCategory.Arrow (rawInv _) = Arrow
|
|
||||||
RawCategory.𝟙 (rawInv _) = 𝟙
|
|
||||||
RawCategory._∘_ (rawInv _) = _∘_
|
|
||||||
|
|
||||||
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
|
||||||
oppositeIsInvolution = Category≡ rawInv
|
|
||||||
|
|
||||||
open Opposite public
|
|
||||||
|
|
|
@ -1,8 +1,6 @@
|
||||||
module Cat.Category.Exponential where
|
module Cat.Category.Exponential where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude hiding (_×_)
|
||||||
open import Data.Product hiding (_×_)
|
|
||||||
open import Cubical
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
|
@ -18,11 +16,11 @@ module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}}
|
||||||
field
|
field
|
||||||
uniq
|
uniq
|
||||||
: ∀ (A : Object) (f : ℂ [ A × B , C ])
|
: ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.𝟙 ℂ ] ≡ f)
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
IsExponential : (Cᴮ : Object) → ℂ [ Cᴮ × B , C ] → Set (ℓ ⊔ ℓ')
|
IsExponential : (Cᴮ : Object) → ℂ [ Cᴮ × B , C ] → Set (ℓ ⊔ ℓ')
|
||||||
IsExponential Cᴮ eval = ∀ (A : Object) (f : ℂ [ A × B , C ])
|
IsExponential Cᴮ eval = ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.𝟙 ℂ ] ≡ f)
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
record Exponential : Set (ℓ ⊔ ℓ') where
|
record Exponential : Set (ℓ ⊔ ℓ') where
|
||||||
field
|
field
|
||||||
|
@ -32,7 +30,7 @@ module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}}
|
||||||
{{isExponential}} : IsExponential obj eval
|
{{isExponential}} : IsExponential obj eval
|
||||||
|
|
||||||
transpose : (A : Object) → ℂ [ A × B , C ] → ℂ [ A , obj ]
|
transpose : (A : Object) → ℂ [ A × B , C ] → ℂ [ A , obj ]
|
||||||
transpose A f = proj₁ (isExponential A f)
|
transpose A f = fst (isExponential A f)
|
||||||
|
|
||||||
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
|
|
|
@ -1,37 +1,37 @@
|
||||||
{-# OPTIONS --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.Functor where
|
module Cat.Category.Functor where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Cubical
|
open import Cubical
|
||||||
open import Function
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
open Category hiding (_∘_ ; raw ; IsIdentity)
|
|
||||||
|
|
||||||
module _ {ℓc ℓc' ℓd ℓd'}
|
module _ {ℓc ℓc' ℓd ℓd'}
|
||||||
(ℂ : Category ℓc ℓc')
|
(ℂ : Category ℓc ℓc')
|
||||||
(𝔻 : Category ℓd ℓd')
|
(𝔻 : Category ℓd ℓd')
|
||||||
where
|
where
|
||||||
|
|
||||||
private
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
module 𝔻 = Category 𝔻
|
||||||
ℓ = ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd'
|
ℓ = ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd'
|
||||||
𝓤 = Set ℓ
|
𝓤 = Set ℓ
|
||||||
|
|
||||||
Omap = Object ℂ → Object 𝔻
|
Omap = ℂ.Object → 𝔻.Object
|
||||||
Fmap : Omap → Set _
|
Fmap : Omap → Set _
|
||||||
Fmap omap = ∀ {A B}
|
Fmap omap = ∀ {A B}
|
||||||
→ ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
→ ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
record RawFunctor : 𝓤 where
|
record RawFunctor : 𝓤 where
|
||||||
field
|
field
|
||||||
omap : Object ℂ → Object 𝔻
|
omap : ℂ.Object → 𝔻.Object
|
||||||
fmap : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
|
|
||||||
IsIdentity : Set _
|
IsIdentity : Set _
|
||||||
IsIdentity = {A : Object ℂ} → fmap (𝟙 ℂ {A}) ≡ 𝟙 𝔻 {omap A}
|
IsIdentity = {A : ℂ.Object} → fmap (ℂ.identity {A}) ≡ 𝔻.identity {omap A}
|
||||||
|
|
||||||
IsDistributive : Set _
|
IsDistributive : Set _
|
||||||
IsDistributive = {A B C : Object ℂ} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
IsDistributive = {A B C : ℂ.Object} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
||||||
→ fmap (ℂ [ g ∘ f ]) ≡ 𝔻 [ fmap g ∘ fmap f ]
|
→ fmap (ℂ [ g ∘ f ]) ≡ 𝔻 [ fmap g ∘ fmap f ]
|
||||||
|
|
||||||
-- | Equality principle for raw functors
|
-- | Equality principle for raw functors
|
||||||
|
@ -72,14 +72,12 @@ module _ {ℓc ℓc' ℓd ℓd'}
|
||||||
|
|
||||||
open IsFunctor isFunctor public
|
open IsFunctor isFunctor public
|
||||||
|
|
||||||
open Functor
|
|
||||||
|
|
||||||
EndoFunctor : ∀ {ℓa ℓb} (ℂ : Category ℓa ℓb) → Set _
|
EndoFunctor : ∀ {ℓa ℓb} (ℂ : Category ℓa ℓb) → Set _
|
||||||
EndoFunctor ℂ = Functor ℂ ℂ
|
EndoFunctor ℂ = Functor ℂ ℂ
|
||||||
|
|
||||||
module _
|
module _
|
||||||
{ℓa ℓb : Level}
|
{ℓc ℓc' ℓd ℓd' : Level}
|
||||||
{ℂ 𝔻 : Category ℓa ℓb}
|
{ℂ : Category ℓc ℓc'} {𝔻 : Category ℓd ℓd'}
|
||||||
(F : RawFunctor ℂ 𝔻)
|
(F : RawFunctor ℂ 𝔻)
|
||||||
where
|
where
|
||||||
private
|
private
|
||||||
|
@ -87,7 +85,7 @@ module _
|
||||||
|
|
||||||
propIsFunctor : isProp (IsFunctor _ _ F)
|
propIsFunctor : isProp (IsFunctor _ _ F)
|
||||||
propIsFunctor isF0 isF1 i = record
|
propIsFunctor isF0 isF1 i = record
|
||||||
{ isIdentity = 𝔻.arrowsAreSets _ _ isF0.isIdentity isF1.isIdentity i
|
{ isIdentity = 𝔻.arrowsAreSets _ _ isF0.isIdentity isF1.isIdentity i
|
||||||
; isDistributive = 𝔻.arrowsAreSets _ _ isF0.isDistributive isF1.isDistributive i
|
; isDistributive = 𝔻.arrowsAreSets _ _ isF0.isDistributive isF1.isDistributive i
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
|
@ -96,8 +94,7 @@ module _
|
||||||
|
|
||||||
-- Alternate version of above where `F` is indexed by an interval
|
-- Alternate version of above where `F` is indexed by an interval
|
||||||
module _
|
module _
|
||||||
{ℓa ℓb : Level}
|
{ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Category ℓd ℓd'}
|
||||||
{ℂ 𝔻 : Category ℓa ℓb}
|
|
||||||
{F : I → RawFunctor ℂ 𝔻}
|
{F : I → RawFunctor ℂ 𝔻}
|
||||||
where
|
where
|
||||||
private
|
private
|
||||||
|
@ -108,61 +105,96 @@ module _
|
||||||
IsFunctorIsProp' : IsProp' λ i → IsFunctor _ _ (F i)
|
IsFunctorIsProp' : IsProp' λ i → IsFunctor _ _ (F i)
|
||||||
IsFunctorIsProp' isF0 isF1 = lemPropF {B = IsFunctor ℂ 𝔻}
|
IsFunctorIsProp' isF0 isF1 = lemPropF {B = IsFunctor ℂ 𝔻}
|
||||||
(\ F → propIsFunctor F) (\ i → F i)
|
(\ F → propIsFunctor F) (\ i → F i)
|
||||||
where
|
|
||||||
open import Cubical.NType.Properties using (lemPropF)
|
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} {ℂ 𝔻 : Category ℓ ℓ'} where
|
module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Category ℓd ℓd'} where
|
||||||
|
open Functor
|
||||||
Functor≡ : {F G : Functor ℂ 𝔻}
|
Functor≡ : {F G : Functor ℂ 𝔻}
|
||||||
→ raw F ≡ raw G
|
→ Functor.raw F ≡ Functor.raw G
|
||||||
→ F ≡ G
|
→ F ≡ G
|
||||||
raw (Functor≡ eq i) = eq i
|
Functor.raw (Functor≡ eq i) = eq i
|
||||||
isFunctor (Functor≡ {F} {G} eq i)
|
Functor.isFunctor (Functor≡ {F} {G} eq i)
|
||||||
= res i
|
= res i
|
||||||
where
|
where
|
||||||
res : (λ i → IsFunctor ℂ 𝔻 (eq i)) [ isFunctor F ≡ isFunctor G ]
|
res : (λ i → IsFunctor ℂ 𝔻 (eq i)) [ isFunctor F ≡ isFunctor G ]
|
||||||
res = IsFunctorIsProp' (isFunctor F) (isFunctor G)
|
res = IsFunctorIsProp' (isFunctor F) (isFunctor G)
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} {A B C : Category ℓ ℓ'} (F : Functor B C) (G : Functor A B) where
|
module _ {ℓ0 ℓ1 ℓ2 ℓ3 ℓ4 ℓ5 : Level}
|
||||||
|
{A : Category ℓ0 ℓ1}
|
||||||
|
{B : Category ℓ2 ℓ3}
|
||||||
|
{C : Category ℓ4 ℓ5}
|
||||||
|
(F : Functor B C) (G : Functor A B) where
|
||||||
private
|
private
|
||||||
F* = omap F
|
module A = Category A
|
||||||
F→ = fmap F
|
module B = Category B
|
||||||
G* = omap G
|
module C = Category C
|
||||||
G→ = fmap G
|
module F = Functor F
|
||||||
module _ {a0 a1 a2 : Object A} {α0 : A [ a0 , a1 ]} {α1 : A [ a1 , a2 ]} where
|
module G = Functor G
|
||||||
|
module _ {a0 a1 a2 : A.Object} {α0 : A [ a0 , a1 ]} {α1 : A [ a1 , a2 ]} where
|
||||||
dist : (F→ ∘ G→) (A [ α1 ∘ α0 ]) ≡ C [ (F→ ∘ G→) α1 ∘ (F→ ∘ G→) α0 ]
|
dist : (F.fmap ∘ G.fmap) (A [ α1 ∘ α0 ]) ≡ C [ (F.fmap ∘ G.fmap) α1 ∘ (F.fmap ∘ G.fmap) α0 ]
|
||||||
dist = begin
|
dist = begin
|
||||||
(F→ ∘ G→) (A [ α1 ∘ α0 ]) ≡⟨ refl ⟩
|
(F.fmap ∘ G.fmap) (A [ α1 ∘ α0 ])
|
||||||
F→ (G→ (A [ α1 ∘ α0 ])) ≡⟨ cong F→ (isDistributive G) ⟩
|
≡⟨ refl ⟩
|
||||||
F→ (B [ G→ α1 ∘ G→ α0 ]) ≡⟨ isDistributive F ⟩
|
F.fmap (G.fmap (A [ α1 ∘ α0 ]))
|
||||||
C [ (F→ ∘ G→) α1 ∘ (F→ ∘ G→) α0 ] ∎
|
≡⟨ cong F.fmap G.isDistributive ⟩
|
||||||
|
F.fmap (B [ G.fmap α1 ∘ G.fmap α0 ])
|
||||||
|
≡⟨ F.isDistributive ⟩
|
||||||
|
C [ (F.fmap ∘ G.fmap) α1 ∘ (F.fmap ∘ G.fmap) α0 ]
|
||||||
|
∎
|
||||||
|
|
||||||
_∘fr_ : RawFunctor A C
|
raw : RawFunctor A C
|
||||||
RawFunctor.omap _∘fr_ = F* ∘ G*
|
RawFunctor.omap raw = F.omap ∘ G.omap
|
||||||
RawFunctor.fmap _∘fr_ = F→ ∘ G→
|
RawFunctor.fmap raw = F.fmap ∘ G.fmap
|
||||||
instance
|
|
||||||
isFunctor' : IsFunctor A C _∘fr_
|
isFunctor : IsFunctor A C raw
|
||||||
isFunctor' = record
|
isFunctor = record
|
||||||
{ isIdentity = begin
|
{ isIdentity = begin
|
||||||
(F→ ∘ G→) (𝟙 A) ≡⟨ refl ⟩
|
(F.fmap ∘ G.fmap) A.identity ≡⟨ refl ⟩
|
||||||
F→ (G→ (𝟙 A)) ≡⟨ cong F→ (isIdentity G)⟩
|
F.fmap (G.fmap A.identity) ≡⟨ cong F.fmap (G.isIdentity)⟩
|
||||||
F→ (𝟙 B) ≡⟨ isIdentity F ⟩
|
F.fmap B.identity ≡⟨ F.isIdentity ⟩
|
||||||
𝟙 C ∎
|
C.identity ∎
|
||||||
; isDistributive = dist
|
; isDistributive = dist
|
||||||
}
|
}
|
||||||
|
|
||||||
F[_∘_] : Functor A C
|
F[_∘_] : Functor A C
|
||||||
raw F[_∘_] = _∘fr_
|
Functor.raw F[_∘_] = raw
|
||||||
|
Functor.isFunctor F[_∘_] = isFunctor
|
||||||
|
|
||||||
-- The identity functor
|
-- | The identity functor
|
||||||
identity : ∀ {ℓ ℓ'} → {C : Category ℓ ℓ'} → Functor C C
|
module Functors where
|
||||||
identity = record
|
module _ {ℓc ℓcc : Level} {ℂ : Category ℓc ℓcc} where
|
||||||
{ raw = record
|
private
|
||||||
{ omap = λ x → x
|
raw : RawFunctor ℂ ℂ
|
||||||
; fmap = λ x → x
|
RawFunctor.omap raw = idFun _
|
||||||
}
|
RawFunctor.fmap raw = idFun _
|
||||||
; isFunctor = record
|
|
||||||
{ isIdentity = refl
|
isFunctor : IsFunctor ℂ ℂ raw
|
||||||
; isDistributive = refl
|
IsFunctor.isIdentity isFunctor = refl
|
||||||
}
|
IsFunctor.isDistributive isFunctor = refl
|
||||||
}
|
|
||||||
|
identity : Functor ℂ ℂ
|
||||||
|
Functor.raw identity = raw
|
||||||
|
Functor.isFunctor identity = isFunctor
|
||||||
|
|
||||||
|
module _
|
||||||
|
{ℓa ℓaa ℓb ℓbb ℓc ℓcc ℓd ℓdd : Level}
|
||||||
|
{𝔸 : Category ℓa ℓaa}
|
||||||
|
{𝔹 : Category ℓb ℓbb}
|
||||||
|
{ℂ : Category ℓc ℓcc}
|
||||||
|
{𝔻 : Category ℓd ℓdd}
|
||||||
|
{F : Functor 𝔸 𝔹} {G : Functor 𝔹 ℂ} {H : Functor ℂ 𝔻} where
|
||||||
|
isAssociative : F[ H ∘ F[ G ∘ F ] ] ≡ F[ F[ H ∘ G ] ∘ F ]
|
||||||
|
isAssociative = Functor≡ refl
|
||||||
|
|
||||||
|
module _
|
||||||
|
{ℓc ℓcc ℓd ℓdd : Level}
|
||||||
|
{ℂ : Category ℓc ℓcc}
|
||||||
|
{𝔻 : Category ℓd ℓdd}
|
||||||
|
{F : Functor ℂ 𝔻} where
|
||||||
|
leftIdentity : F[ identity ∘ F ] ≡ F
|
||||||
|
leftIdentity = Functor≡ refl
|
||||||
|
|
||||||
|
rightIdentity : F[ F ∘ identity ] ≡ F
|
||||||
|
rightIdentity = Functor≡ refl
|
||||||
|
|
||||||
|
isIdentity : F[ identity ∘ F ] ≡ F × F[ F ∘ identity ] ≡ F
|
||||||
|
isIdentity = leftIdentity , rightIdentity
|
||||||
|
|
|
@ -17,195 +17,224 @@ These two formulations are proven to be equivalent:
|
||||||
The monoidal representation is exposed by default from this module.
|
The monoidal representation is exposed by default from this module.
|
||||||
---}
|
---}
|
||||||
|
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.Monad where
|
module Cat.Category.Monad where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties using (lemPropF ; lemSig ; lemSigP)
|
|
||||||
open import Cubical.GradLemma using (gradLemma)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Monad.Monoidal as Monoidal public
|
import Cat.Category.Monad.Monoidal
|
||||||
open import Cat.Category.Monad.Kleisli as Kleisli
|
import Cat.Category.Monad.Kleisli
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
||||||
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ using (NaturalTransformation ; propIsNatural)
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Object ; Arrow ; 𝟙 ; _∘_ ; _>>>_)
|
open ℂ using (Object ; Arrow ; identity ; _<<<_ ; _>>>_)
|
||||||
module M = Monoidal ℂ
|
|
||||||
module K = Kleisli ℂ
|
|
||||||
|
|
||||||
module _ (m : M.RawMonad) where
|
module Monoidal = Cat.Category.Monad.Monoidal ℂ
|
||||||
open M.RawMonad m
|
module Kleisli = Cat.Category.Monad.Kleisli ℂ
|
||||||
|
|
||||||
forthRaw : K.RawMonad
|
module _ (m : Monoidal.RawMonad) where
|
||||||
K.RawMonad.omap forthRaw = Romap
|
open Monoidal.RawMonad m
|
||||||
K.RawMonad.pure forthRaw = pureT _
|
|
||||||
K.RawMonad.bind forthRaw = bind
|
|
||||||
|
|
||||||
module _ {raw : M.RawMonad} (m : M.IsMonad raw) where
|
toKleisliRaw : Kleisli.RawMonad
|
||||||
private
|
Kleisli.RawMonad.omap toKleisliRaw = Romap
|
||||||
module MI = M.IsMonad m
|
Kleisli.RawMonad.pure toKleisliRaw = pure
|
||||||
forthIsMonad : K.IsMonad (forthRaw raw)
|
Kleisli.RawMonad.bind toKleisliRaw = bind
|
||||||
K.IsMonad.isIdentity forthIsMonad = proj₂ MI.isInverse
|
|
||||||
K.IsMonad.isNatural forthIsMonad = MI.isNatural
|
|
||||||
K.IsMonad.isDistributive forthIsMonad = MI.isDistributive
|
|
||||||
|
|
||||||
forth : M.Monad → K.Monad
|
module _ {raw : Monoidal.RawMonad} (m : Monoidal.IsMonad raw) where
|
||||||
Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m)
|
open Monoidal.IsMonad m
|
||||||
Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m)
|
|
||||||
|
|
||||||
module _ (m : K.Monad) where
|
open Kleisli.RawMonad (toKleisliRaw raw) using (_>=>_)
|
||||||
open K.Monad m
|
toKleisliIsMonad : Kleisli.IsMonad (toKleisliRaw raw)
|
||||||
|
Kleisli.IsMonad.isIdentity toKleisliIsMonad = begin
|
||||||
|
bind pure ≡⟨⟩
|
||||||
|
join <<< (fmap pure) ≡⟨ snd isInverse ⟩
|
||||||
|
identity ∎
|
||||||
|
Kleisli.IsMonad.isNatural toKleisliIsMonad f = begin
|
||||||
|
pure >=> f ≡⟨⟩
|
||||||
|
pure >>> bind f ≡⟨⟩
|
||||||
|
bind f <<< pure ≡⟨⟩
|
||||||
|
(join <<< fmap f) <<< pure ≡⟨ isNatural f ⟩
|
||||||
|
f ∎
|
||||||
|
Kleisli.IsMonad.isDistributive toKleisliIsMonad f g = begin
|
||||||
|
bind g >>> bind f ≡⟨⟩
|
||||||
|
(join <<< fmap f) <<< (join <<< fmap g) ≡⟨ isDistributive f g ⟩
|
||||||
|
join <<< fmap (join <<< fmap f <<< g) ≡⟨⟩
|
||||||
|
bind (g >=> f) ∎
|
||||||
|
-- Kleisli.IsMonad.isDistributive toKleisliIsMonad = isDistributive
|
||||||
|
|
||||||
backRaw : M.RawMonad
|
toKleisli : Monoidal.Monad → Kleisli.Monad
|
||||||
M.RawMonad.R backRaw = R
|
Kleisli.Monad.raw (toKleisli m) = toKleisliRaw (Monoidal.Monad.raw m)
|
||||||
M.RawMonad.pureNT backRaw = pureNT
|
Kleisli.Monad.isMonad (toKleisli m) = toKleisliIsMonad (Monoidal.Monad.isMonad m)
|
||||||
M.RawMonad.joinNT backRaw = joinNT
|
|
||||||
|
|
||||||
private
|
module _ (m : Kleisli.Monad) where
|
||||||
open M.RawMonad backRaw
|
open Kleisli.Monad m
|
||||||
module R = Functor (M.RawMonad.R backRaw)
|
|
||||||
|
|
||||||
backIsMonad : M.IsMonad backRaw
|
toMonoidalRaw : Monoidal.RawMonad
|
||||||
M.IsMonad.isAssociative backIsMonad {X} = begin
|
Monoidal.RawMonad.R toMonoidalRaw = R
|
||||||
joinT X ∘ R.fmap (joinT X) ≡⟨⟩
|
Monoidal.RawMonad.pureNT toMonoidalRaw = pureNT
|
||||||
join ∘ fmap (joinT X) ≡⟨⟩
|
Monoidal.RawMonad.joinNT toMonoidalRaw = joinNT
|
||||||
join ∘ fmap join ≡⟨ isNaturalForeign ⟩
|
|
||||||
join ∘ join ≡⟨⟩
|
open Monoidal.RawMonad toMonoidalRaw renaming
|
||||||
joinT X ∘ joinT (R.omap X) ∎
|
( join to join*
|
||||||
M.IsMonad.isInverse backIsMonad {X} = inv-l , inv-r
|
; pure to pure*
|
||||||
|
; bind to bind*
|
||||||
|
; fmap to fmap*
|
||||||
|
) using ()
|
||||||
|
|
||||||
|
toMonoidalIsMonad : Monoidal.IsMonad toMonoidalRaw
|
||||||
|
Monoidal.IsMonad.isAssociative toMonoidalIsMonad = begin
|
||||||
|
join* <<< fmap join* ≡⟨⟩
|
||||||
|
join <<< fmap join ≡⟨ isNaturalForeign ⟩
|
||||||
|
join <<< join ∎
|
||||||
|
Monoidal.IsMonad.isInverse toMonoidalIsMonad {X} = inv-l , inv-r
|
||||||
where
|
where
|
||||||
inv-l = begin
|
inv-l = begin
|
||||||
joinT X ∘ pureT (R.omap X) ≡⟨⟩
|
join <<< pure ≡⟨ fst isInverse ⟩
|
||||||
join ∘ pure ≡⟨ proj₁ isInverse ⟩
|
identity ∎
|
||||||
𝟙 ∎
|
|
||||||
inv-r = begin
|
inv-r = begin
|
||||||
joinT X ∘ R.fmap (pureT X) ≡⟨⟩
|
join* <<< fmap* pure* ≡⟨⟩
|
||||||
join ∘ fmap pure ≡⟨ proj₂ isInverse ⟩
|
join <<< fmap pure ≡⟨ snd isInverse ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
back : K.Monad → M.Monad
|
toMonoidal : Kleisli.Monad → Monoidal.Monad
|
||||||
Monoidal.Monad.raw (back m) = backRaw m
|
Monoidal.Monad.raw (toMonoidal m) = toMonoidalRaw m
|
||||||
Monoidal.Monad.isMonad (back m) = backIsMonad m
|
Monoidal.Monad.isMonad (toMonoidal m) = toMonoidalIsMonad m
|
||||||
|
|
||||||
module _ (m : K.Monad) where
|
module _ (m : Kleisli.Monad) where
|
||||||
private
|
private
|
||||||
open K.Monad m
|
open Kleisli.Monad m
|
||||||
bindEq : ∀ {X Y}
|
bindEq : ∀ {X Y}
|
||||||
→ K.RawMonad.bind (forthRaw (backRaw m)) {X} {Y}
|
→ Kleisli.RawMonad.bind (toKleisliRaw (toMonoidalRaw m)) {X} {Y}
|
||||||
≡ K.RawMonad.bind (K.Monad.raw m)
|
≡ bind
|
||||||
bindEq {X} {Y} = begin
|
bindEq {X} {Y} = funExt lem
|
||||||
K.RawMonad.bind (forthRaw (backRaw m)) ≡⟨⟩
|
|
||||||
(λ f → join ∘ fmap f) ≡⟨⟩
|
|
||||||
(λ f → bind (f >>> pure) >>> bind 𝟙) ≡⟨ funExt lem ⟩
|
|
||||||
(λ f → bind f) ≡⟨⟩
|
|
||||||
bind ∎
|
|
||||||
where
|
where
|
||||||
lem : (f : Arrow X (omap Y))
|
lem : (f : Arrow X (omap Y))
|
||||||
→ bind (f >>> pure) >>> bind 𝟙
|
→ bind (f >>> pure) >>> bind identity
|
||||||
≡ bind f
|
≡ bind f
|
||||||
lem f = begin
|
lem f = begin
|
||||||
bind (f >>> pure) >>> bind 𝟙
|
join <<< fmap f
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((f >>> pure) >>> bind 𝟙)
|
bind ((f >>> pure) >=> identity)
|
||||||
|
≡⟨⟩
|
||||||
|
bind ((f >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (pure >>> bind 𝟙))
|
bind (f >>> (pure >>> bind identity))
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> (pure >=> identity))
|
||||||
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
||||||
bind (f >>> 𝟙)
|
bind (f >>> identity)
|
||||||
≡⟨ cong bind (proj₂ ℂ.isIdentity) ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
forthRawEq : forthRaw (backRaw m) ≡ K.Monad.raw m
|
toKleisliRawEq : toKleisliRaw (toMonoidalRaw m) ≡ Kleisli.Monad.raw m
|
||||||
K.RawMonad.omap (forthRawEq _) = omap
|
Kleisli.RawMonad.omap (toKleisliRawEq i) = (begin
|
||||||
K.RawMonad.pure (forthRawEq _) = pure
|
Kleisli.RawMonad.omap (toKleisliRaw (toMonoidalRaw m)) ≡⟨⟩
|
||||||
K.RawMonad.bind (forthRawEq i) = bindEq i
|
Monoidal.RawMonad.Romap (toMonoidalRaw m) ≡⟨⟩
|
||||||
|
omap ∎
|
||||||
|
) i
|
||||||
|
Kleisli.RawMonad.pure (toKleisliRawEq i) = (begin
|
||||||
|
Kleisli.RawMonad.pure (toKleisliRaw (toMonoidalRaw m)) ≡⟨⟩
|
||||||
|
Monoidal.RawMonad.pure (toMonoidalRaw m) ≡⟨⟩
|
||||||
|
pure ∎
|
||||||
|
) i
|
||||||
|
Kleisli.RawMonad.bind (toKleisliRawEq i) = bindEq i
|
||||||
|
|
||||||
fortheq : (m : K.Monad) → forth (back m) ≡ m
|
toKleislieq : (m : Kleisli.Monad) → toKleisli (toMonoidal m) ≡ m
|
||||||
fortheq m = K.Monad≡ (forthRawEq m)
|
toKleislieq m = Kleisli.Monad≡ (toKleisliRawEq m)
|
||||||
|
|
||||||
module _ (m : M.Monad) where
|
module _ (m : Monoidal.Monad) where
|
||||||
private
|
private
|
||||||
open M.Monad m
|
open Monoidal.Monad m
|
||||||
module KM = K.Monad (forth m)
|
-- module KM = Kleisli.Monad (toKleisli m)
|
||||||
|
open Kleisli.Monad (toKleisli m) renaming
|
||||||
|
( bind to bind* ; omap to omap* ; join to join*
|
||||||
|
; fmap to fmap* ; pure to pure* ; R to R*)
|
||||||
|
using ()
|
||||||
module R = Functor R
|
module R = Functor R
|
||||||
omapEq : KM.omap ≡ Romap
|
omapEq : omap* ≡ Romap
|
||||||
omapEq = refl
|
omapEq = refl
|
||||||
|
|
||||||
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → KM.bind f ≡ bind f
|
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → bind* f ≡ bind f
|
||||||
bindEq {X} {Y} {f} = begin
|
bindEq {X} {Y} {f} = begin
|
||||||
KM.bind f ≡⟨⟩
|
bind* f ≡⟨⟩
|
||||||
joinT Y ∘ Rfmap f ≡⟨⟩
|
join <<< fmap f ≡⟨⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
joinEq : ∀ {X} → KM.join ≡ joinT X
|
joinEq : ∀ {X} → join* ≡ joinT X
|
||||||
joinEq {X} = begin
|
joinEq {X} = begin
|
||||||
KM.join ≡⟨⟩
|
join* ≡⟨⟩
|
||||||
KM.bind 𝟙 ≡⟨⟩
|
bind* identity ≡⟨⟩
|
||||||
bind 𝟙 ≡⟨⟩
|
bind identity ≡⟨⟩
|
||||||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → _ ∘ φ) R.isIdentity ⟩
|
join <<< fmap identity ≡⟨ cong (λ φ → _ <<< φ) R.isIdentity ⟩
|
||||||
joinT X ∘ 𝟙 ≡⟨ proj₁ ℂ.isIdentity ⟩
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎
|
join ∎
|
||||||
|
|
||||||
fmapEq : ∀ {A B} → KM.fmap {A} {B} ≡ Rfmap
|
fmapEq : ∀ {A B} → fmap* {A} {B} ≡ fmap
|
||||||
fmapEq {A} {B} = funExt (λ f → begin
|
fmapEq {A} {B} = funExt (λ f → begin
|
||||||
KM.fmap f ≡⟨⟩
|
fmap* f ≡⟨⟩
|
||||||
KM.bind (f >>> KM.pure) ≡⟨⟩
|
bind* (f >>> pure*) ≡⟨⟩
|
||||||
bind (f >>> pureT _) ≡⟨⟩
|
bind (f >>> pure) ≡⟨⟩
|
||||||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨⟩
|
fmap (f >>> pure) >>> join ≡⟨⟩
|
||||||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
fmap (f >>> pure) >>> join ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
||||||
Rfmap f >>> Rfmap (pureT B) >>> joinT B ≡⟨ ℂ.isAssociative ⟩
|
fmap f >>> fmap pure >>> join ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT B ∘ Rfmap (pureT B) ∘ Rfmap f ≡⟨ cong (λ φ → φ ∘ Rfmap f) (proj₂ isInverse) ⟩
|
join <<< fmap pure <<< fmap f ≡⟨ cong (λ φ → φ <<< fmap f) (snd isInverse) ⟩
|
||||||
𝟙 ∘ Rfmap f ≡⟨ proj₂ ℂ.isIdentity ⟩
|
identity <<< fmap f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
Rfmap f ∎
|
fmap f ∎
|
||||||
)
|
)
|
||||||
|
|
||||||
rawEq : Functor.raw KM.R ≡ Functor.raw R
|
rawEq : Functor.raw R* ≡ Functor.raw R
|
||||||
RawFunctor.omap (rawEq i) = omapEq i
|
RawFunctor.omap (rawEq i) = omapEq i
|
||||||
RawFunctor.fmap (rawEq i) = fmapEq i
|
RawFunctor.fmap (rawEq i) = fmapEq i
|
||||||
|
|
||||||
Req : M.RawMonad.R (backRaw (forth m)) ≡ R
|
Req : Monoidal.RawMonad.R (toMonoidalRaw (toKleisli m)) ≡ R
|
||||||
Req = Functor≡ rawEq
|
Req = Functor≡ rawEq
|
||||||
|
|
||||||
open NaturalTransformation ℂ ℂ
|
pureTEq : Monoidal.RawMonad.pureT (toMonoidalRaw (toKleisli m)) ≡ pureT
|
||||||
|
pureTEq = refl
|
||||||
|
|
||||||
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
pureNTEq : (λ i → NaturalTransformation Functors.identity (Req i))
|
||||||
pureTEq = funExt (λ X → refl)
|
[ Monoidal.RawMonad.pureNT (toMonoidalRaw (toKleisli m)) ≡ pureNT ]
|
||||||
|
pureNTEq = lemSigP (λ i → propIsNatural Functors.identity (Req i)) _ _ pureTEq
|
||||||
|
|
||||||
pureNTEq : (λ i → NaturalTransformation F.identity (Req i))
|
joinTEq : Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) ≡ joinT
|
||||||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
|
||||||
pureNTEq = lemSigP (λ i → propIsNatural F.identity (Req i)) _ _ pureTEq
|
|
||||||
|
|
||||||
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
|
||||||
joinTEq = funExt (λ X → begin
|
joinTEq = funExt (λ X → begin
|
||||||
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) X ≡⟨⟩
|
||||||
KM.join ≡⟨⟩
|
join* ≡⟨⟩
|
||||||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → joinT X ∘ φ) R.isIdentity ⟩
|
join <<< fmap identity ≡⟨ cong (λ φ → join <<< φ) R.isIdentity ⟩
|
||||||
joinT X ∘ 𝟙 ≡⟨ proj₁ ℂ.isIdentity ⟩
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎)
|
join ∎)
|
||||||
|
|
||||||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||||
[ M.RawMonad.joinNT (backRaw (forth m)) ≡ joinNT ]
|
[ Monoidal.RawMonad.joinNT (toMonoidalRaw (toKleisli m)) ≡ joinNT ]
|
||||||
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
||||||
|
|
||||||
backRawEq : backRaw (forth m) ≡ M.Monad.raw m
|
toMonoidalRawEq : toMonoidalRaw (toKleisli m) ≡ Monoidal.Monad.raw m
|
||||||
M.RawMonad.R (backRawEq i) = Req i
|
Monoidal.RawMonad.R (toMonoidalRawEq i) = Req i
|
||||||
M.RawMonad.pureNT (backRawEq i) = pureNTEq i
|
Monoidal.RawMonad.pureNT (toMonoidalRawEq i) = pureNTEq i
|
||||||
M.RawMonad.joinNT (backRawEq i) = joinNTEq i
|
Monoidal.RawMonad.joinNT (toMonoidalRawEq i) = joinNTEq i
|
||||||
|
|
||||||
backeq : (m : M.Monad) → back (forth m) ≡ m
|
toMonoidaleq : (m : Monoidal.Monad) → toMonoidal (toKleisli m) ≡ m
|
||||||
backeq m = M.Monad≡ (backRawEq m)
|
toMonoidaleq m = Monoidal.Monad≡ (toMonoidalRawEq m)
|
||||||
|
|
||||||
eqv : isEquiv M.Monad K.Monad forth
|
open import Cat.Equivalence
|
||||||
eqv = gradLemma forth back fortheq backeq
|
|
||||||
|
|
||||||
Monoidal≃Kleisli : M.Monad ≃ K.Monad
|
Monoidal≊Kleisli : Monoidal.Monad ≅ Kleisli.Monad
|
||||||
Monoidal≃Kleisli = forth , eqv
|
Monoidal≊Kleisli = toKleisli , toMonoidal , funExt toMonoidaleq , funExt toKleislieq
|
||||||
|
|
||||||
|
Monoidal≡Kleisli : Monoidal.Monad ≡ Kleisli.Monad
|
||||||
|
Monoidal≡Kleisli = isoToPath Monoidal≊Kleisli
|
||||||
|
|
||||||
|
grpdKleisli : isGrpd Kleisli.Monad
|
||||||
|
grpdKleisli = Kleisli.grpdMonad
|
||||||
|
|
||||||
|
grpdMonoidal : isGrpd Monoidal.Monad
|
||||||
|
grpdMonoidal = subst {P = isGrpd}
|
||||||
|
(sym Monoidal≡Kleisli) grpdKleisli
|
||||||
|
|
|
@ -1,26 +1,25 @@
|
||||||
{---
|
{---
|
||||||
The Kleisli formulation of monads
|
The Kleisli formulation of monads
|
||||||
---}
|
---}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
|
||||||
open import Data.Product
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties using (lemPropF ; lemSig ; lemSigP)
|
|
||||||
open import Cubical.GradLemma using (gradLemma)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
-- "A monad in the Kleisli form" [voe]
|
-- "A monad in the Kleisli form" [voe]
|
||||||
module Cat.Category.Monad.Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module Cat.Category.Monad.Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural)
|
||||||
|
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Arrow ; 𝟙 ; Object ; _∘_ ; _>>>_)
|
open ℂ using (Arrow ; identity ; Object ; _<<<_ ; _>>>_)
|
||||||
|
|
||||||
-- | Data for a monad.
|
-- | Data for a monad.
|
||||||
--
|
--
|
||||||
|
@ -36,7 +35,7 @@ record RawMonad : Set ℓ where
|
||||||
--
|
--
|
||||||
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
||||||
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
||||||
fmap f = bind (pure ∘ f)
|
fmap f = bind (pure <<< f)
|
||||||
|
|
||||||
-- | Composition of monads aka. the kleisli-arrow.
|
-- | Composition of monads aka. the kleisli-arrow.
|
||||||
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
||||||
|
@ -44,7 +43,7 @@ record RawMonad : Set ℓ where
|
||||||
|
|
||||||
-- | Flattening nested monads.
|
-- | Flattening nested monads.
|
||||||
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
join = bind 𝟙
|
join = bind identity
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
-- * Monad laws --
|
-- * Monad laws --
|
||||||
|
@ -52,26 +51,33 @@ record RawMonad : Set ℓ where
|
||||||
|
|
||||||
-- There may be better names than what I've chosen here.
|
-- There may be better names than what I've chosen here.
|
||||||
|
|
||||||
|
-- `pure` is the neutral element for `bind`
|
||||||
IsIdentity = {X : Object}
|
IsIdentity = {X : Object}
|
||||||
→ bind pure ≡ 𝟙 {omap X}
|
→ bind pure ≡ identity {omap X}
|
||||||
|
-- pure is the left-identity for the kleisli arrow.
|
||||||
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
||||||
→ pure >>> (bind f) ≡ f
|
→ pure >=> f ≡ f
|
||||||
IsDistributive = {X Y Z : Object} (g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
-- Composition interacts with bind in the following way.
|
||||||
|
IsDistributive = {X Y Z : Object}
|
||||||
|
(g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
||||||
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
||||||
|
|
||||||
|
RightIdentity = {A B : Object} {m : ℂ [ A , omap B ]}
|
||||||
|
→ m >=> pure ≡ m
|
||||||
|
|
||||||
-- | Functor map fusion.
|
-- | Functor map fusion.
|
||||||
--
|
--
|
||||||
-- This is really a functor law. Should we have a kleisli-representation of
|
-- This is really a functor law. Should we have a kleisli-representation of
|
||||||
-- functors as well and make them a super-class?
|
-- functors as well and make them a super-class?
|
||||||
Fusion = {X Y Z : Object} {g : ℂ [ Y , Z ]} {f : ℂ [ X , Y ]}
|
Fusion = {X Y Z : Object} {g : ℂ [ Y , Z ]} {f : ℂ [ X , Y ]}
|
||||||
→ fmap (g ∘ f) ≡ fmap g ∘ fmap f
|
→ fmap (g <<< f) ≡ fmap g <<< fmap f
|
||||||
|
|
||||||
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
|
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
|
||||||
IsNaturalForeign : Set _
|
IsNaturalForeign : Set _
|
||||||
IsNaturalForeign = {X : Object} → join {X} ∘ fmap join ≡ join ∘ join
|
IsNaturalForeign = {X : Object} → join {X} <<< fmap join ≡ join <<< join
|
||||||
|
|
||||||
IsInverse : Set _
|
IsInverse : Set _
|
||||||
IsInverse = {X : Object} → join {X} ∘ pure ≡ 𝟙 × join {X} ∘ fmap pure ≡ 𝟙
|
IsInverse = {X : Object} → join {X} <<< pure ≡ identity × join {X} <<< fmap pure ≡ identity
|
||||||
|
|
||||||
record IsMonad (raw : RawMonad) : Set ℓ where
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
open RawMonad raw public
|
open RawMonad raw public
|
||||||
|
@ -83,18 +89,21 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
-- | Map fusion is admissable.
|
-- | Map fusion is admissable.
|
||||||
fusion : Fusion
|
fusion : Fusion
|
||||||
fusion {g = g} {f} = begin
|
fusion {g = g} {f} = begin
|
||||||
fmap (g ∘ f) ≡⟨⟩
|
fmap (g <<< f) ≡⟨⟩
|
||||||
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (g >>> pure)) ≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
bind (f >>> (g >>> pure))
|
||||||
bind (f >>> (pure >>> (bind (g >>> pure)))) ≡⟨⟩
|
≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
||||||
|
bind (f >>> (pure >>> (bind (g >>> pure))))
|
||||||
|
≡⟨⟩
|
||||||
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
||||||
bind ((fmap g ∘ pure) ∘ f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
bind ((fmap g <<< pure) <<< f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
||||||
bind (fmap g ∘ (pure ∘ f)) ≡⟨ sym distrib ⟩
|
bind (fmap g <<< (pure <<< f)) ≡⟨ sym distrib ⟩
|
||||||
bind (pure ∘ g) ∘ bind (pure ∘ f) ≡⟨⟩
|
bind (pure <<< g) <<< bind (pure <<< f)
|
||||||
fmap g ∘ fmap f ∎
|
≡⟨⟩
|
||||||
|
fmap g <<< fmap f ∎
|
||||||
where
|
where
|
||||||
distrib : fmap g ∘ fmap f ≡ bind (fmap g ∘ (pure ∘ f))
|
distrib : fmap g <<< fmap f ≡ bind (fmap g <<< (pure <<< f))
|
||||||
distrib = isDistributive (pure ∘ g) (pure ∘ f)
|
distrib = isDistributive (pure <<< g) (pure <<< f)
|
||||||
|
|
||||||
-- | This formulation gives rise to the following endo-functor.
|
-- | This formulation gives rise to the following endo-functor.
|
||||||
private
|
private
|
||||||
|
@ -104,15 +113,15 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
|
||||||
isFunctorR : IsFunctor ℂ ℂ rawR
|
isFunctorR : IsFunctor ℂ ℂ rawR
|
||||||
IsFunctor.isIdentity isFunctorR = begin
|
IsFunctor.isIdentity isFunctorR = begin
|
||||||
bind (pure ∘ 𝟙) ≡⟨ cong bind (proj₁ ℂ.isIdentity) ⟩
|
bind (pure <<< identity) ≡⟨ cong bind (ℂ.rightIdentity) ⟩
|
||||||
bind pure ≡⟨ isIdentity ⟩
|
bind pure ≡⟨ isIdentity ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
IsFunctor.isDistributive isFunctorR {f = f} {g} = begin
|
IsFunctor.isDistributive isFunctorR {f = f} {g} = begin
|
||||||
bind (pure ∘ (g ∘ f)) ≡⟨⟩
|
bind (pure <<< (g <<< f)) ≡⟨⟩
|
||||||
fmap (g ∘ f) ≡⟨ fusion ⟩
|
fmap (g <<< f) ≡⟨ fusion ⟩
|
||||||
fmap g ∘ fmap f ≡⟨⟩
|
fmap g <<< fmap f ≡⟨⟩
|
||||||
bind (pure ∘ g) ∘ bind (pure ∘ f) ∎
|
bind (pure <<< g) <<< bind (pure <<< f) ∎
|
||||||
|
|
||||||
-- FIXME Naming!
|
-- FIXME Naming!
|
||||||
R : EndoFunctor ℂ
|
R : EndoFunctor ℂ
|
||||||
|
@ -120,10 +129,8 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
Functor.isFunctor R = isFunctorR
|
Functor.isFunctor R = isFunctorR
|
||||||
|
|
||||||
private
|
private
|
||||||
open NaturalTransformation ℂ ℂ
|
|
||||||
|
|
||||||
R⁰ : EndoFunctor ℂ
|
R⁰ : EndoFunctor ℂ
|
||||||
R⁰ = F.identity
|
R⁰ = Functors.identity
|
||||||
R² : EndoFunctor ℂ
|
R² : EndoFunctor ℂ
|
||||||
R² = F[ R ∘ R ]
|
R² = F[ R ∘ R ]
|
||||||
module R = Functor R
|
module R = Functor R
|
||||||
|
@ -133,66 +140,66 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
pureT A = pure
|
pureT A = pure
|
||||||
pureN : Natural R⁰ R pureT
|
pureN : Natural R⁰ R pureT
|
||||||
pureN {A} {B} f = begin
|
pureN {A} {B} f = begin
|
||||||
pureT B ∘ R⁰.fmap f ≡⟨⟩
|
pureT B <<< R⁰.fmap f ≡⟨⟩
|
||||||
pure ∘ f ≡⟨ sym (isNatural _) ⟩
|
pure <<< f ≡⟨ sym (isNatural _) ⟩
|
||||||
bind (pure ∘ f) ∘ pure ≡⟨⟩
|
bind (pure <<< f) <<< pure ≡⟨⟩
|
||||||
fmap f ∘ pure ≡⟨⟩
|
fmap f <<< pure ≡⟨⟩
|
||||||
R.fmap f ∘ pureT A ∎
|
R.fmap f <<< pureT A ∎
|
||||||
joinT : Transformation R² R
|
joinT : Transformation R² R
|
||||||
joinT C = join
|
joinT C = join
|
||||||
joinN : Natural R² R joinT
|
joinN : Natural R² R joinT
|
||||||
joinN f = begin
|
joinN f = begin
|
||||||
join ∘ R².fmap f ≡⟨⟩
|
join <<< R².fmap f ≡⟨⟩
|
||||||
bind 𝟙 ∘ R².fmap f ≡⟨⟩
|
bind identity <<< R².fmap f ≡⟨⟩
|
||||||
R².fmap f >>> bind 𝟙 ≡⟨⟩
|
R².fmap f >>> bind identity ≡⟨⟩
|
||||||
fmap (fmap f) >>> bind 𝟙 ≡⟨⟩
|
fmap (fmap f) >>> bind identity ≡⟨⟩
|
||||||
fmap (bind (f >>> pure)) >>> bind 𝟙 ≡⟨⟩
|
fmap (bind (f >>> pure)) >>> bind identity ≡⟨⟩
|
||||||
bind (bind (f >>> pure) >>> pure) >>> bind 𝟙
|
bind (bind (f >>> pure) >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((bind (f >>> pure) >>> pure) >=> 𝟙)
|
bind ((bind (f >>> pure) >>> pure) >=> identity)
|
||||||
≡⟨⟩
|
≡⟨⟩
|
||||||
bind ((bind (f >>> pure) >>> pure) >>> bind 𝟙)
|
bind ((bind (f >>> pure) >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (bind (f >>> pure) >>> (pure >>> bind 𝟙))
|
bind (bind (f >>> pure) >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (bind (f >>> pure) >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (bind (f >>> pure) >>> φ)) (isNatural _) ⟩
|
||||||
bind (bind (f >>> pure) >>> 𝟙)
|
bind (bind (f >>> pure) >>> identity)
|
||||||
≡⟨ cong bind (proj₂ ℂ.isIdentity) ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind (bind (f >>> pure))
|
bind (bind (f >>> pure))
|
||||||
≡⟨ cong bind (sym (proj₁ ℂ.isIdentity)) ⟩
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
bind (𝟙 >>> bind (f >>> pure)) ≡⟨⟩
|
bind (identity >>> bind (f >>> pure)) ≡⟨⟩
|
||||||
bind (𝟙 >=> (f >>> pure))
|
bind (identity >=> (f >>> pure))
|
||||||
≡⟨ sym (isDistributive _ _) ⟩
|
≡⟨ sym (isDistributive _ _) ⟩
|
||||||
bind 𝟙 >>> bind (f >>> pure) ≡⟨⟩
|
bind identity >>> bind (f >>> pure) ≡⟨⟩
|
||||||
bind 𝟙 >>> fmap f ≡⟨⟩
|
bind identity >>> fmap f ≡⟨⟩
|
||||||
bind 𝟙 >>> R.fmap f ≡⟨⟩
|
bind identity >>> R.fmap f ≡⟨⟩
|
||||||
R.fmap f ∘ bind 𝟙 ≡⟨⟩
|
R.fmap f <<< bind identity ≡⟨⟩
|
||||||
R.fmap f ∘ join ∎
|
R.fmap f <<< join ∎
|
||||||
|
|
||||||
pureNT : NaturalTransformation R⁰ R
|
pureNT : NaturalTransformation R⁰ R
|
||||||
proj₁ pureNT = pureT
|
fst pureNT = pureT
|
||||||
proj₂ pureNT = pureN
|
snd pureNT = pureN
|
||||||
|
|
||||||
joinNT : NaturalTransformation R² R
|
joinNT : NaturalTransformation R² R
|
||||||
proj₁ joinNT = joinT
|
fst joinNT = joinT
|
||||||
proj₂ joinNT = joinN
|
snd joinNT = joinN
|
||||||
|
|
||||||
isNaturalForeign : IsNaturalForeign
|
isNaturalForeign : IsNaturalForeign
|
||||||
isNaturalForeign = begin
|
isNaturalForeign = begin
|
||||||
fmap join >>> join ≡⟨⟩
|
fmap join >>> join ≡⟨⟩
|
||||||
bind (join >>> pure) >>> bind 𝟙
|
bind (join >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((join >>> pure) >>> bind 𝟙)
|
bind ((join >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (join >>> (pure >>> bind 𝟙))
|
bind (join >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (join >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (join >>> φ)) (isNatural _) ⟩
|
||||||
bind (join >>> 𝟙)
|
bind (join >>> identity)
|
||||||
≡⟨ cong bind (proj₂ ℂ.isIdentity) ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind join ≡⟨⟩
|
bind join ≡⟨⟩
|
||||||
bind (bind 𝟙)
|
bind (bind identity)
|
||||||
≡⟨ cong bind (sym (proj₁ ℂ.isIdentity)) ⟩
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
bind (𝟙 >>> bind 𝟙) ≡⟨⟩
|
bind (identity >>> bind identity) ≡⟨⟩
|
||||||
bind (𝟙 >=> 𝟙) ≡⟨ sym (isDistributive _ _) ⟩
|
bind (identity >=> identity) ≡⟨ sym (isDistributive _ _) ⟩
|
||||||
bind 𝟙 >>> bind 𝟙 ≡⟨⟩
|
bind identity >>> bind identity ≡⟨⟩
|
||||||
join >>> join ∎
|
join >>> join ∎
|
||||||
|
|
||||||
isInverse : IsInverse
|
isInverse : IsInverse
|
||||||
|
@ -200,23 +207,31 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
where
|
where
|
||||||
inv-l = begin
|
inv-l = begin
|
||||||
pure >>> join ≡⟨⟩
|
pure >>> join ≡⟨⟩
|
||||||
pure >>> bind 𝟙 ≡⟨ isNatural _ ⟩
|
pure >>> bind identity ≡⟨ isNatural _ ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
inv-r = begin
|
inv-r = begin
|
||||||
fmap pure >>> join ≡⟨⟩
|
fmap pure >>> join ≡⟨⟩
|
||||||
bind (pure >>> pure) >>> bind 𝟙
|
bind (pure >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((pure >>> pure) >=> 𝟙) ≡⟨⟩
|
bind ((pure >>> pure) >=> identity) ≡⟨⟩
|
||||||
bind ((pure >>> pure) >>> bind 𝟙)
|
bind ((pure >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (pure >>> (pure >>> bind 𝟙))
|
bind (pure >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (pure >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (pure >>> φ)) (isNatural _) ⟩
|
||||||
bind (pure >>> 𝟙)
|
bind (pure >>> identity)
|
||||||
≡⟨ cong bind (proj₂ ℂ.isIdentity) ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind pure ≡⟨ isIdentity ⟩
|
bind pure ≡⟨ isIdentity ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
|
rightIdentity : RightIdentity
|
||||||
|
rightIdentity {m = m} = begin
|
||||||
|
m >=> pure ≡⟨⟩
|
||||||
|
m >>> bind pure ≡⟨ cong (m >>>_) isIdentity ⟩
|
||||||
|
m >>> identity ≡⟨ ℂ.leftIdentity ⟩
|
||||||
|
m ∎
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
field
|
field
|
||||||
raw : RawMonad
|
raw : RawMonad
|
||||||
isMonad : IsMonad raw
|
isMonad : IsMonad raw
|
||||||
|
@ -251,3 +266,82 @@ module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
|
||||||
Monad≡ : m ≡ n
|
Monad≡ : m ≡ n
|
||||||
Monad.raw (Monad≡ i) = eq i
|
Monad.raw (Monad≡ i) = eq i
|
||||||
Monad.isMonad (Monad≡ i) = eqIsMonad i
|
Monad.isMonad (Monad≡ i) = eqIsMonad i
|
||||||
|
|
||||||
|
module _ where
|
||||||
|
private
|
||||||
|
module _ (x y : RawMonad) (p q : x ≡ y) (a b : p ≡ q) where
|
||||||
|
eq0-helper : isGrpd (Object → Object)
|
||||||
|
eq0-helper = grpdPi (λ a → ℂ.groupoidObject)
|
||||||
|
|
||||||
|
eq0 : cong (cong RawMonad.omap) a ≡ cong (cong RawMonad.omap) b
|
||||||
|
eq0 = eq0-helper
|
||||||
|
(RawMonad.omap x) (RawMonad.omap y)
|
||||||
|
(cong RawMonad.omap p) (cong RawMonad.omap q)
|
||||||
|
(cong (cong RawMonad.omap) a) (cong (cong RawMonad.omap) b)
|
||||||
|
|
||||||
|
eq1-helper : (omap : Object → Object) → isGrpd ({X : Object} → ℂ [ X , omap X ])
|
||||||
|
eq1-helper f = grpdPiImpl (setGrpd ℂ.arrowsAreSets)
|
||||||
|
|
||||||
|
postulate
|
||||||
|
eq1 : PathP (λ i → PathP
|
||||||
|
(λ j →
|
||||||
|
PathP (λ k → {X : Object} → ℂ [ X , eq0 i j k X ])
|
||||||
|
(RawMonad.pure x) (RawMonad.pure y))
|
||||||
|
(λ i → RawMonad.pure (p i)) (λ i → RawMonad.pure (q i)))
|
||||||
|
(cong-d (cong-d RawMonad.pure) a) (cong-d (cong-d RawMonad.pure) b)
|
||||||
|
|
||||||
|
|
||||||
|
RawMonad' : Set _
|
||||||
|
RawMonad' = Σ (Object → Object) (λ omap
|
||||||
|
→ ({X : Object} → ℂ [ X , omap X ])
|
||||||
|
× ({X Y : Object} → ℂ [ X , omap Y ] → ℂ [ omap X , omap Y ])
|
||||||
|
)
|
||||||
|
grpdRawMonad' : isGrpd RawMonad'
|
||||||
|
grpdRawMonad' = grpdSig (grpdPi (λ _ → ℂ.groupoidObject)) λ _ → grpdSig (grpdPiImpl (setGrpd ℂ.arrowsAreSets)) (λ _ → grpdPiImpl (grpdPiImpl (grpdPi (λ _ → setGrpd ℂ.arrowsAreSets))))
|
||||||
|
toRawMonad : RawMonad' → RawMonad
|
||||||
|
RawMonad.omap (toRawMonad (a , b , c)) = a
|
||||||
|
RawMonad.pure (toRawMonad (a , b , c)) = b
|
||||||
|
RawMonad.bind (toRawMonad (a , b , c)) = c
|
||||||
|
|
||||||
|
IsMonad' : RawMonad' → Set _
|
||||||
|
IsMonad' raw = M.IsIdentity × M.IsNatural × M.IsDistributive
|
||||||
|
where
|
||||||
|
module M = RawMonad (toRawMonad raw)
|
||||||
|
|
||||||
|
grpdIsMonad' : (m : RawMonad') → isGrpd (IsMonad' m)
|
||||||
|
grpdIsMonad' m = grpdSig (propGrpd (propIsIdentity (toRawMonad m)))
|
||||||
|
λ _ → grpdSig (propGrpd (propIsNatural (toRawMonad m)))
|
||||||
|
λ _ → propGrpd (propIsDistributive (toRawMonad m))
|
||||||
|
|
||||||
|
Monad' = Σ RawMonad' IsMonad'
|
||||||
|
grpdMonad' = grpdSig grpdRawMonad' grpdIsMonad'
|
||||||
|
|
||||||
|
toMonad : Monad' → Monad
|
||||||
|
Monad.raw (toMonad x) = toRawMonad (fst x)
|
||||||
|
isIdentity (Monad.isMonad (toMonad x)) = fst (snd x)
|
||||||
|
isNatural (Monad.isMonad (toMonad x)) = fst (snd (snd x))
|
||||||
|
isDistributive (Monad.isMonad (toMonad x)) = snd (snd (snd x))
|
||||||
|
|
||||||
|
fromMonad : Monad → Monad'
|
||||||
|
fromMonad m = (M.omap , M.pure , M.bind)
|
||||||
|
, M.isIdentity , M.isNatural , M.isDistributive
|
||||||
|
where
|
||||||
|
module M = Monad m
|
||||||
|
|
||||||
|
e : Monad' ≃ Monad
|
||||||
|
e = fromIsomorphism _ _ (toMonad , fromMonad , (funExt λ _ → refl) , funExt eta-refl)
|
||||||
|
where
|
||||||
|
-- Monads don't have eta-equality
|
||||||
|
eta-refl : (x : Monad) → toMonad (fromMonad x) ≡ x
|
||||||
|
eta-refl =
|
||||||
|
(λ x → λ
|
||||||
|
{ i .Monad.raw → Monad.raw x
|
||||||
|
; i .Monad.isMonad → Monad.isMonad x}
|
||||||
|
)
|
||||||
|
|
||||||
|
grpdMonad : isGrpd Monad
|
||||||
|
grpdMonad = equivPreservesNType
|
||||||
|
{n = (S (S (S ⟨-2⟩)))}
|
||||||
|
e grpdMonad'
|
||||||
|
where
|
||||||
|
open import Cubical.NType
|
||||||
|
|
|
@ -1,18 +1,13 @@
|
||||||
{---
|
{---
|
||||||
Monoidal formulation of monads
|
Monoidal formulation of monads
|
||||||
---}
|
---}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
|
||||||
open import Data.Product
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties using (lemPropF ; lemSig ; lemSigP)
|
|
||||||
open import Cubical.GradLemma using (gradLemma)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
@ -21,43 +16,55 @@ module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
open Category ℂ using (Object ; Arrow ; 𝟙 ; _∘_)
|
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
||||||
open NaturalTransformation ℂ ℂ
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural ; NaturalTransformation≡)
|
||||||
|
|
||||||
record RawMonad : Set ℓ where
|
record RawMonad : Set ℓ where
|
||||||
field
|
field
|
||||||
R : EndoFunctor ℂ
|
R : EndoFunctor ℂ
|
||||||
pureNT : NaturalTransformation F.identity R
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
joinNT : NaturalTransformation F[ R ∘ R ] R
|
joinNT : NaturalTransformation F[ R ∘ R ] R
|
||||||
|
|
||||||
|
Romap = Functor.omap R
|
||||||
|
fmap = Functor.fmap R
|
||||||
|
|
||||||
-- Note that `pureT` and `joinT` differs from their definition in the
|
-- Note that `pureT` and `joinT` differs from their definition in the
|
||||||
-- kleisli formulation only by having an explicit parameter.
|
-- kleisli formulation only by having an explicit parameter.
|
||||||
pureT : Transformation F.identity R
|
pureT : Transformation Functors.identity R
|
||||||
pureT = proj₁ pureNT
|
pureT = fst pureNT
|
||||||
pureN : Natural F.identity R pureT
|
|
||||||
pureN = proj₂ pureNT
|
pure : {X : Object} → ℂ [ X , Romap X ]
|
||||||
|
pure = pureT _
|
||||||
|
|
||||||
|
pureN : Natural Functors.identity R pureT
|
||||||
|
pureN = snd pureNT
|
||||||
|
|
||||||
joinT : Transformation F[ R ∘ R ] R
|
joinT : Transformation F[ R ∘ R ] R
|
||||||
joinT = proj₁ joinNT
|
joinT = fst joinNT
|
||||||
|
join : {X : Object} → ℂ [ Romap (Romap X) , Romap X ]
|
||||||
|
join = joinT _
|
||||||
joinN : Natural F[ R ∘ R ] R joinT
|
joinN : Natural F[ R ∘ R ] R joinT
|
||||||
joinN = proj₂ joinNT
|
joinN = snd joinNT
|
||||||
|
|
||||||
Romap = Functor.omap R
|
|
||||||
Rfmap = Functor.fmap R
|
|
||||||
|
|
||||||
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
||||||
bind {X} {Y} f = joinT Y ∘ Rfmap f
|
bind {X} {Y} f = join <<< fmap f
|
||||||
|
|
||||||
IsAssociative : Set _
|
IsAssociative : Set _
|
||||||
IsAssociative = {X : Object}
|
IsAssociative = {X : Object}
|
||||||
→ joinT X ∘ Rfmap (joinT X) ≡ joinT X ∘ joinT (Romap X)
|
-- R and join commute
|
||||||
|
→ joinT X <<< fmap join ≡ join <<< join
|
||||||
IsInverse : Set _
|
IsInverse : Set _
|
||||||
IsInverse = {X : Object}
|
IsInverse = {X : Object}
|
||||||
→ joinT X ∘ pureT (Romap X) ≡ 𝟙
|
-- Talks about R's action on objects
|
||||||
× joinT X ∘ Rfmap (pureT X) ≡ 𝟙
|
→ join <<< pure ≡ identity {Romap X}
|
||||||
IsNatural = ∀ {X Y} f → joinT Y ∘ Rfmap f ∘ pureT X ≡ f
|
-- Talks about R's action on arrows
|
||||||
|
× join <<< fmap pure ≡ identity {Romap X}
|
||||||
|
IsNatural = ∀ {X Y} (f : Arrow X (Romap Y))
|
||||||
|
→ join <<< fmap f <<< pure ≡ f
|
||||||
IsDistributive = ∀ {X Y Z} (g : Arrow Y (Romap Z)) (f : Arrow X (Romap Y))
|
IsDistributive = ∀ {X Y Z} (g : Arrow Y (Romap Z)) (f : Arrow X (Romap Y))
|
||||||
→ joinT Z ∘ Rfmap g ∘ (joinT Y ∘ Rfmap f)
|
→ join <<< fmap g <<< (join <<< fmap f)
|
||||||
≡ joinT Z ∘ Rfmap (joinT Z ∘ Rfmap g ∘ f)
|
≡ join <<< fmap (join <<< fmap g <<< f)
|
||||||
|
|
||||||
record IsMonad (raw : RawMonad) : Set ℓ where
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
open RawMonad raw public
|
open RawMonad raw public
|
||||||
|
@ -71,51 +78,51 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
|
||||||
isNatural : IsNatural
|
isNatural : IsNatural
|
||||||
isNatural {X} {Y} f = begin
|
isNatural {X} {Y} f = begin
|
||||||
joinT Y ∘ R.fmap f ∘ pureT X ≡⟨ sym ℂ.isAssociative ⟩
|
join <<< fmap f <<< pure ≡⟨ sym ℂ.isAssociative ⟩
|
||||||
joinT Y ∘ (R.fmap f ∘ pureT X) ≡⟨ cong (λ φ → joinT Y ∘ φ) (sym (pureN f)) ⟩
|
join <<< (fmap f <<< pure) ≡⟨ cong (λ φ → join <<< φ) (sym (pureN f)) ⟩
|
||||||
joinT Y ∘ (pureT (R.omap Y) ∘ f) ≡⟨ ℂ.isAssociative ⟩
|
join <<< (pure <<< f) ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT Y ∘ pureT (R.omap Y) ∘ f ≡⟨ cong (λ φ → φ ∘ f) (proj₁ isInverse) ⟩
|
join <<< pure <<< f ≡⟨ cong (λ φ → φ <<< f) (fst isInverse) ⟩
|
||||||
𝟙 ∘ f ≡⟨ proj₂ ℂ.isIdentity ⟩
|
identity <<< f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
f ∎
|
f ∎
|
||||||
|
|
||||||
isDistributive : IsDistributive
|
isDistributive : IsDistributive
|
||||||
isDistributive {X} {Y} {Z} g f = sym aux
|
isDistributive {X} {Y} {Z} g f = begin
|
||||||
|
join <<< fmap g <<< (join <<< fmap f)
|
||||||
|
≡⟨ Category.isAssociative ℂ ⟩
|
||||||
|
join <<< fmap g <<< join <<< fmap f
|
||||||
|
≡⟨ cong (_<<< fmap f) (sym ℂ.isAssociative) ⟩
|
||||||
|
(join <<< (fmap g <<< join)) <<< fmap f
|
||||||
|
≡⟨ cong (λ φ → φ <<< fmap f) (cong (_<<<_ join) (sym (joinN g))) ⟩
|
||||||
|
(join <<< (join <<< R².fmap g)) <<< fmap f
|
||||||
|
≡⟨ cong (_<<< fmap f) ℂ.isAssociative ⟩
|
||||||
|
((join <<< join) <<< R².fmap g) <<< fmap f
|
||||||
|
≡⟨⟩
|
||||||
|
join <<< join <<< R².fmap g <<< fmap f
|
||||||
|
≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
(join <<< join) <<< (R².fmap g <<< fmap f)
|
||||||
|
≡⟨ cong (λ φ → φ <<< (R².fmap g <<< fmap f)) (sym isAssociative) ⟩
|
||||||
|
(join <<< fmap join) <<< (R².fmap g <<< fmap f)
|
||||||
|
≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
join <<< (fmap join <<< (R².fmap g <<< fmap f))
|
||||||
|
≡⟨ cong (_<<<_ join) ℂ.isAssociative ⟩
|
||||||
|
join <<< (fmap join <<< R².fmap g <<< fmap f)
|
||||||
|
≡⟨⟩
|
||||||
|
join <<< (fmap join <<< fmap (fmap g) <<< fmap f)
|
||||||
|
≡⟨ cong (λ φ → join <<< φ) (sym distrib3) ⟩
|
||||||
|
join <<< fmap (join <<< fmap g <<< f)
|
||||||
|
∎
|
||||||
where
|
where
|
||||||
module R² = Functor F[ R ∘ R ]
|
module R² = Functor F[ R ∘ R ]
|
||||||
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
||||||
→ R.fmap (a ∘ b ∘ c)
|
→ R.fmap (a <<< b <<< c)
|
||||||
≡ R.fmap a ∘ R.fmap b ∘ R.fmap c
|
≡ R.fmap a <<< R.fmap b <<< R.fmap c
|
||||||
distrib3 {a = a} {b} {c} = begin
|
distrib3 {a = a} {b} {c} = begin
|
||||||
R.fmap (a ∘ b ∘ c) ≡⟨ R.isDistributive ⟩
|
R.fmap (a <<< b <<< c) ≡⟨ R.isDistributive ⟩
|
||||||
R.fmap (a ∘ b) ∘ R.fmap c ≡⟨ cong (_∘ _) R.isDistributive ⟩
|
R.fmap (a <<< b) <<< R.fmap c ≡⟨ cong (_<<< _) R.isDistributive ⟩
|
||||||
R.fmap a ∘ R.fmap b ∘ R.fmap c ∎
|
R.fmap a <<< R.fmap b <<< R.fmap c ∎
|
||||||
aux = begin
|
|
||||||
joinT Z ∘ R.fmap (joinT Z ∘ R.fmap g ∘ f)
|
|
||||||
≡⟨ cong (λ φ → joinT Z ∘ φ) distrib3 ⟩
|
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ R.fmap (R.fmap g) ∘ R.fmap f)
|
|
||||||
≡⟨⟩
|
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ R².fmap g ∘ R.fmap f)
|
|
||||||
≡⟨ cong (_∘_ (joinT Z)) (sym ℂ.isAssociative) ⟩
|
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ (R².fmap g ∘ R.fmap f))
|
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
|
||||||
(joinT Z ∘ R.fmap (joinT Z)) ∘ (R².fmap g ∘ R.fmap f)
|
|
||||||
≡⟨ cong (λ φ → φ ∘ (R².fmap g ∘ R.fmap f)) isAssociative ⟩
|
|
||||||
(joinT Z ∘ joinT (R.omap Z)) ∘ (R².fmap g ∘ R.fmap f)
|
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
|
||||||
joinT Z ∘ joinT (R.omap Z) ∘ R².fmap g ∘ R.fmap f
|
|
||||||
≡⟨⟩
|
|
||||||
((joinT Z ∘ joinT (R.omap Z)) ∘ R².fmap g) ∘ R.fmap f
|
|
||||||
≡⟨ cong (_∘ R.fmap f) (sym ℂ.isAssociative) ⟩
|
|
||||||
(joinT Z ∘ (joinT (R.omap Z) ∘ R².fmap g)) ∘ R.fmap f
|
|
||||||
≡⟨ cong (λ φ → φ ∘ R.fmap f) (cong (_∘_ (joinT Z)) (joinN g)) ⟩
|
|
||||||
(joinT Z ∘ (R.fmap g ∘ joinT Y)) ∘ R.fmap f
|
|
||||||
≡⟨ cong (_∘ R.fmap f) ℂ.isAssociative ⟩
|
|
||||||
joinT Z ∘ R.fmap g ∘ joinT Y ∘ R.fmap f
|
|
||||||
≡⟨ sym (Category.isAssociative ℂ) ⟩
|
|
||||||
joinT Z ∘ R.fmap g ∘ (joinT Y ∘ R.fmap f)
|
|
||||||
∎
|
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
field
|
field
|
||||||
raw : RawMonad
|
raw : RawMonad
|
||||||
isMonad : IsMonad raw
|
isMonad : IsMonad raw
|
||||||
|
@ -132,8 +139,8 @@ private
|
||||||
where
|
where
|
||||||
xX = x {X}
|
xX = x {X}
|
||||||
yX = y {X}
|
yX = y {X}
|
||||||
e1 = Category.arrowsAreSets ℂ _ _ (proj₁ xX) (proj₁ yX)
|
e1 = Category.arrowsAreSets ℂ _ _ (fst xX) (fst yX)
|
||||||
e2 = Category.arrowsAreSets ℂ _ _ (proj₂ xX) (proj₂ yX)
|
e2 = Category.arrowsAreSets ℂ _ _ (snd xX) (snd yX)
|
||||||
|
|
||||||
open IsMonad
|
open IsMonad
|
||||||
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
||||||
|
|
|
@ -1,37 +1,33 @@
|
||||||
{-
|
{-
|
||||||
This module provides construction 2.3 in [voe]
|
This module provides construction 2.3 in [voe]
|
||||||
-}
|
-}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.Monad.Voevodsky where
|
module Cat.Category.Monad.Voevodsky where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties using (lemPropF ; lemSig ; lemSigP)
|
|
||||||
open import Cubical.GradLemma using (gradLemma)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Monad using (Monoidal≃Kleisli)
|
open import Cat.Category.Monad
|
||||||
import Cat.Category.Monad.Monoidal as Monoidal
|
import Cat.Category.Monad.Monoidal as Monoidal
|
||||||
import Cat.Category.Monad.Kleisli as Kleisli
|
import Cat.Category.Monad.Kleisli as Kleisli
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Object ; Arrow)
|
open ℂ using (Object ; Arrow)
|
||||||
open NaturalTransformation ℂ ℂ
|
|
||||||
open import Function using (_∘_ ; _$_)
|
|
||||||
module M = Monoidal ℂ
|
module M = Monoidal ℂ
|
||||||
module K = Kleisli ℂ
|
module K = Kleisli ℂ
|
||||||
|
|
||||||
module §2-3 (omap : Omap ℂ ℂ) (pure : {X : Object} → Arrow X (omap X)) where
|
module §2-3 (omap : Object → Object) (pure : {X : Object} → Arrow X (omap X)) where
|
||||||
record §1 : Set ℓ where
|
record §1 : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
open M
|
open M
|
||||||
|
|
||||||
field
|
field
|
||||||
|
@ -57,9 +53,9 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
pureT X = pure {X}
|
pureT X = pure {X}
|
||||||
|
|
||||||
field
|
field
|
||||||
pureN : Natural F.identity R pureT
|
pureN : Natural Functors.identity R pureT
|
||||||
|
|
||||||
pureNT : NaturalTransformation F.identity R
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
pureNT = pureT , pureN
|
pureNT = pureT , pureN
|
||||||
|
|
||||||
joinT : (A : Object) → ℂ [ omap (omap A) , omap A ]
|
joinT : (A : Object) → ℂ [ omap (omap A) , omap A ]
|
||||||
|
@ -79,15 +75,14 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
}
|
}
|
||||||
|
|
||||||
field
|
field
|
||||||
isMnd : IsMonad rawMnd
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
toMonad : Monad
|
toMonad : Monad
|
||||||
toMonad = record
|
toMonad .Monad.raw = rawMnd
|
||||||
{ raw = rawMnd
|
toMonad .Monad.isMonad = isMonad
|
||||||
; isMonad = isMnd
|
|
||||||
}
|
|
||||||
|
|
||||||
record §2 : Set ℓ where
|
record §2 : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
open K
|
open K
|
||||||
|
|
||||||
field
|
field
|
||||||
|
@ -101,45 +96,45 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
}
|
}
|
||||||
|
|
||||||
field
|
field
|
||||||
isMnd : IsMonad rawMnd
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
toMonad : Monad
|
toMonad : Monad
|
||||||
toMonad = record
|
toMonad .Monad.raw = rawMnd
|
||||||
{ raw = rawMnd
|
toMonad .Monad.isMonad = isMonad
|
||||||
; isMonad = isMnd
|
|
||||||
}
|
module _ (m : M.Monad) where
|
||||||
|
open M.Monad m
|
||||||
|
|
||||||
|
§1-fromMonad : §2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
||||||
|
§1-fromMonad .§2-3.§1.fmap = Functor.fmap R
|
||||||
|
§1-fromMonad .§2-3.§1.RisFunctor = Functor.isFunctor R
|
||||||
|
§1-fromMonad .§2-3.§1.pureN = pureN
|
||||||
|
§1-fromMonad .§2-3.§1.join {X} = joinT X
|
||||||
|
§1-fromMonad .§2-3.§1.joinN = joinN
|
||||||
|
§1-fromMonad .§2-3.§1.isMonad = M.Monad.isMonad m
|
||||||
|
|
||||||
§1-fromMonad : (m : M.Monad) → §2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
|
||||||
-- voe-2-3-1-fromMonad : (m : M.Monad) → voe.§2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
|
||||||
§1-fromMonad m = record
|
|
||||||
{ fmap = Functor.fmap R
|
|
||||||
; RisFunctor = Functor.isFunctor R
|
|
||||||
; pureN = pureN
|
|
||||||
; join = λ {X} → joinT X
|
|
||||||
; joinN = joinN
|
|
||||||
; isMnd = M.Monad.isMonad m
|
|
||||||
}
|
|
||||||
where
|
|
||||||
raw = M.Monad.raw m
|
|
||||||
R = M.RawMonad.R raw
|
|
||||||
pureT = M.RawMonad.pureT raw
|
|
||||||
pureN = M.RawMonad.pureN raw
|
|
||||||
joinT = M.RawMonad.joinT raw
|
|
||||||
joinN = M.RawMonad.joinN raw
|
|
||||||
|
|
||||||
§2-fromMonad : (m : K.Monad) → §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
|
§2-fromMonad : (m : K.Monad) → §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
|
||||||
§2-fromMonad m = record
|
§2-fromMonad m .§2-3.§2.bind = K.Monad.bind m
|
||||||
{ bind = K.Monad.bind m
|
§2-fromMonad m .§2-3.§2.isMonad = K.Monad.isMonad m
|
||||||
; isMnd = K.Monad.isMonad m
|
|
||||||
}
|
|
||||||
|
|
||||||
|
-- | In the following we seek to transform the equivalence `Monoidal≃Kleisli`
|
||||||
|
-- | to talk about voevodsky's construction.
|
||||||
module _ (omap : Omap ℂ ℂ) (pure : {X : Object} → Arrow X (omap X)) where
|
module _ (omap : Omap ℂ ℂ) (pure : {X : Object} → Arrow X (omap X)) where
|
||||||
private
|
private
|
||||||
|
module E = AreInverses {f = (fst (Monoidal≊Kleisli ℂ))} {fst (snd (Monoidal≊Kleisli ℂ))}(Monoidal≊Kleisli ℂ .snd .snd)
|
||||||
|
|
||||||
Monoidal→Kleisli : M.Monad → K.Monad
|
Monoidal→Kleisli : M.Monad → K.Monad
|
||||||
Monoidal→Kleisli = proj₁ Monoidal≃Kleisli
|
Monoidal→Kleisli = E.obverse
|
||||||
|
|
||||||
Kleisli→Monoidal : K.Monad → M.Monad
|
Kleisli→Monoidal : K.Monad → M.Monad
|
||||||
Kleisli→Monoidal = inverse Monoidal≃Kleisli
|
Kleisli→Monoidal = E.reverse
|
||||||
|
|
||||||
|
ve-re : Kleisli→Monoidal ∘ Monoidal→Kleisli ≡ idFun _
|
||||||
|
ve-re = E.verso-recto
|
||||||
|
|
||||||
|
re-ve : Monoidal→Kleisli ∘ Kleisli→Monoidal ≡ idFun _
|
||||||
|
re-ve = E.recto-verso
|
||||||
|
|
||||||
forth : §2-3.§1 omap pure → §2-3.§2 omap pure
|
forth : §2-3.§1 omap pure → §2-3.§2 omap pure
|
||||||
forth = §2-fromMonad ∘ Monoidal→Kleisli ∘ §2-3.§1.toMonad
|
forth = §2-fromMonad ∘ Monoidal→Kleisli ∘ §2-3.§1.toMonad
|
||||||
|
@ -147,65 +142,105 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
back : §2-3.§2 omap pure → §2-3.§1 omap pure
|
back : §2-3.§2 omap pure → §2-3.§1 omap pure
|
||||||
back = §1-fromMonad ∘ Kleisli→Monoidal ∘ §2-3.§2.toMonad
|
back = §1-fromMonad ∘ Kleisli→Monoidal ∘ §2-3.§2.toMonad
|
||||||
|
|
||||||
forthEq : ∀ m → _ ≡ _
|
forthEq : ∀ m → (forth ∘ back) m ≡ m
|
||||||
forthEq m = begin
|
forthEq m = begin
|
||||||
(forth ∘ back) m ≡⟨⟩
|
§2-fromMonad
|
||||||
-- In full gory detail:
|
(Monoidal→Kleisli
|
||||||
( §2-fromMonad
|
(§2-3.§1.toMonad
|
||||||
∘ Monoidal→Kleisli
|
(§1-fromMonad (Kleisli→Monoidal (§2-3.§2.toMonad m)))))
|
||||||
∘ §2-3.§1.toMonad
|
≡⟨ cong-d (§2-fromMonad ∘ Monoidal→Kleisli) (lemmaz (Kleisli→Monoidal (§2-3.§2.toMonad m))) ⟩
|
||||||
∘ §1-fromMonad
|
§2-fromMonad
|
||||||
∘ Kleisli→Monoidal
|
((Monoidal→Kleisli ∘ Kleisli→Monoidal)
|
||||||
∘ §2-3.§2.toMonad
|
(§2-3.§2.toMonad m))
|
||||||
) m ≡⟨⟩ -- fromMonad and toMonad are inverses
|
-- Below is the fully normalized goal and context with
|
||||||
( §2-fromMonad
|
-- `funExt` made abstract.
|
||||||
∘ Monoidal→Kleisli
|
--
|
||||||
∘ Kleisli→Monoidal
|
-- Goal: PathP (λ _ → §2-3.§2 omap (λ {z} → pure))
|
||||||
∘ §2-3.§2.toMonad
|
-- (§2-fromMonad
|
||||||
) m ≡⟨ u ⟩
|
-- (.Cat.Category.Monad.toKleisli ℂ
|
||||||
-- Monoidal→Kleisli and Kleisli→Monoidal are inverses
|
-- (.Cat.Category.Monad.toMonoidal ℂ (§2-3.§2.toMonad m))))
|
||||||
-- I should be able to prove this using congruence and `lem` below.
|
-- (§2-fromMonad (§2-3.§2.toMonad m))
|
||||||
( §2-fromMonad
|
-- Have: PathP
|
||||||
∘ §2-3.§2.toMonad
|
-- (λ i →
|
||||||
) m ≡⟨⟩
|
-- §2-3.§2 K.IsMonad.omap
|
||||||
( §2-fromMonad
|
-- (K.RawMonad.pure
|
||||||
∘ §2-3.§2.toMonad
|
-- (K.Monad.raw
|
||||||
) m ≡⟨⟩ -- fromMonad and toMonad are inverses
|
-- (funExt (λ m₁ → K.Monad≡ (.Cat.Category.Monad.toKleisliRawEq ℂ m₁))
|
||||||
m ∎
|
-- i (§2-3.§2.toMonad m)))))
|
||||||
|
-- (§2-fromMonad
|
||||||
|
-- (.Cat.Category.Monad.toKleisli ℂ
|
||||||
|
-- (.Cat.Category.Monad.toMonoidal ℂ (§2-3.§2.toMonad m))))
|
||||||
|
-- (§2-fromMonad (§2-3.§2.toMonad m))
|
||||||
|
≡⟨ ( cong-d {x = Monoidal→Kleisli ∘ Kleisli→Monoidal} {y = idFun K.Monad} (\ φ → §2-fromMonad (φ (§2-3.§2.toMonad m))) re-ve) ⟩
|
||||||
|
(§2-fromMonad ∘ §2-3.§2.toMonad) m
|
||||||
|
≡⟨ lemma ⟩
|
||||||
|
m ∎
|
||||||
where
|
where
|
||||||
lem : Monoidal→Kleisli ∘ Kleisli→Monoidal ≡ Function.id
|
lemma : (§2-fromMonad ∘ §2-3.§2.toMonad) m ≡ m
|
||||||
lem = {!!} -- verso-recto Monoidal≃Kleisli
|
§2-3.§2.bind (lemma i) = §2-3.§2.bind m
|
||||||
t : (§2-fromMonad ∘ (Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad)
|
§2-3.§2.isMonad (lemma i) = §2-3.§2.isMonad m
|
||||||
≡ (§2-fromMonad ∘ §2-3.§2.toMonad)
|
lemmaz : ∀ m → §2-3.§1.toMonad (§1-fromMonad m) ≡ m
|
||||||
t = cong (λ φ → §2-fromMonad ∘ (λ{ {ω} → φ {{!????!}}}) ∘ §2-3.§2.toMonad) {!lem!}
|
M.Monad.raw (lemmaz m i) = M.Monad.raw m
|
||||||
u : (§2-fromMonad ∘ (Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad) m
|
M.Monad.isMonad (lemmaz m i) = M.Monad.isMonad m
|
||||||
≡ (§2-fromMonad ∘ §2-3.§2.toMonad) m
|
|
||||||
u = cong (λ φ → φ m) t
|
|
||||||
|
|
||||||
backEq : ∀ m → (back ∘ forth) m ≡ m
|
backEq : ∀ m → (back ∘ forth) m ≡ m
|
||||||
backEq m = begin
|
backEq m = begin
|
||||||
(back ∘ forth) m ≡⟨⟩
|
§1-fromMonad
|
||||||
( §1-fromMonad
|
(Kleisli→Monoidal
|
||||||
∘ Kleisli→Monoidal
|
(§2-3.§2.toMonad
|
||||||
∘ §2-3.§2.toMonad
|
(§2-fromMonad (Monoidal→Kleisli (§2-3.§1.toMonad m)))))
|
||||||
∘ §2-fromMonad
|
≡⟨ cong-d (§1-fromMonad ∘ Kleisli→Monoidal) (lemma (Monoidal→Kleisli (§2-3.§1.toMonad m))) ⟩
|
||||||
∘ Monoidal→Kleisli
|
§1-fromMonad
|
||||||
∘ §2-3.§1.toMonad
|
((Kleisli→Monoidal ∘ Monoidal→Kleisli)
|
||||||
) m ≡⟨⟩ -- fromMonad and toMonad are inverses
|
(§2-3.§1.toMonad m))
|
||||||
( §1-fromMonad
|
-- Below is the fully normalized `agda2-goal-and-context`
|
||||||
∘ Kleisli→Monoidal
|
-- with `funExt` made abstract.
|
||||||
∘ Monoidal→Kleisli
|
--
|
||||||
∘ §2-3.§1.toMonad
|
-- Goal: PathP (λ _ → §2-3.§1 omap (λ {X} → pure))
|
||||||
) m ≡⟨ cong (λ φ → φ m) t ⟩ -- Monoidal→Kleisli and Kleisli→Monoidal are inverses
|
-- (§1-fromMonad
|
||||||
( §1-fromMonad
|
-- (.Cat.Category.Monad.toMonoidal ℂ
|
||||||
∘ §2-3.§1.toMonad
|
-- (.Cat.Category.Monad.toKleisli ℂ (§2-3.§1.toMonad m))))
|
||||||
) m ≡⟨⟩ -- fromMonad and toMonad are inverses
|
-- (§1-fromMonad (§2-3.§1.toMonad m))
|
||||||
|
-- Have: PathP
|
||||||
|
-- (λ i →
|
||||||
|
-- §2-3.§1
|
||||||
|
-- (RawFunctor.omap
|
||||||
|
-- (Functor.raw
|
||||||
|
-- (M.RawMonad.R
|
||||||
|
-- (M.Monad.raw
|
||||||
|
-- (funExt
|
||||||
|
-- (λ m₁ → M.Monad≡ (.Cat.Category.Monad.toMonoidalRawEq ℂ m₁)) i
|
||||||
|
-- (§2-3.§1.toMonad m))))))
|
||||||
|
-- (λ {X} →
|
||||||
|
-- fst
|
||||||
|
-- (M.RawMonad.pureNT
|
||||||
|
-- (M.Monad.raw
|
||||||
|
-- (funExt
|
||||||
|
-- (λ m₁ → M.Monad≡ (.Cat.Category.Monad.toMonoidalRawEq ℂ m₁)) i
|
||||||
|
-- (§2-3.§1.toMonad m))))
|
||||||
|
-- X))
|
||||||
|
-- (§1-fromMonad
|
||||||
|
-- (.Cat.Category.Monad.toMonoidal ℂ
|
||||||
|
-- (.Cat.Category.Monad.toKleisli ℂ (§2-3.§1.toMonad m))))
|
||||||
|
-- (§1-fromMonad (§2-3.§1.toMonad m))
|
||||||
|
≡⟨ (cong-d (\ φ → §1-fromMonad (φ (§2-3.§1.toMonad m))) ve-re) ⟩
|
||||||
|
§1-fromMonad (§2-3.§1.toMonad m)
|
||||||
|
≡⟨ lemmaz ⟩
|
||||||
m ∎
|
m ∎
|
||||||
where
|
where
|
||||||
t = {!!} -- cong (λ φ → voe-2-3-1-fromMonad ∘ φ ∘ voe-2-3.voe-2-3-1.toMonad) (recto-verso Monoidal≃Kleisli)
|
lemmaz : §1-fromMonad (§2-3.§1.toMonad m) ≡ m
|
||||||
|
§2-3.§1.fmap (lemmaz i) = §2-3.§1.fmap m
|
||||||
voe-isEquiv : isEquiv (§2-3.§1 omap pure) (§2-3.§2 omap pure) forth
|
§2-3.§1.join (lemmaz i) = §2-3.§1.join m
|
||||||
voe-isEquiv = gradLemma forth back forthEq backEq
|
§2-3.§1.RisFunctor (lemmaz i) = §2-3.§1.RisFunctor m
|
||||||
|
§2-3.§1.pureN (lemmaz i) = §2-3.§1.pureN m
|
||||||
|
§2-3.§1.joinN (lemmaz i) = §2-3.§1.joinN m
|
||||||
|
§2-3.§1.isMonad (lemmaz i) = §2-3.§1.isMonad m
|
||||||
|
lemma : ∀ m → §2-3.§2.toMonad (§2-fromMonad m) ≡ m
|
||||||
|
K.Monad.raw (lemma m i) = K.Monad.raw m
|
||||||
|
K.Monad.isMonad (lemma m i) = K.Monad.isMonad m
|
||||||
|
|
||||||
equiv-2-3 : §2-3.§1 omap pure ≃ §2-3.§2 omap pure
|
equiv-2-3 : §2-3.§1 omap pure ≃ §2-3.§2 omap pure
|
||||||
equiv-2-3 = forth , voe-isEquiv
|
equiv-2-3 = fromIsomorphism _ _
|
||||||
|
( forth , back
|
||||||
|
, funExt backEq , funExt forthEq
|
||||||
|
)
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# OPTIONS --allow-unsolved-metas #-}
|
||||||
module Cat.Category.Monoid where
|
module Cat.Category.Monoid where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
@ -6,9 +7,10 @@ open import Cat.Category
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
import Cat.Categories.Cat as Cat
|
import Cat.Categories.Cat as Cat
|
||||||
|
open import Cat.Prelude hiding (_×_ ; empty)
|
||||||
|
|
||||||
-- TODO: Incorrect!
|
-- TODO: Incorrect!
|
||||||
module _ (ℓa ℓb : Level) where
|
module _ {ℓa ℓb : Level} where
|
||||||
private
|
private
|
||||||
ℓ = lsuc (ℓa ⊔ ℓb)
|
ℓ = lsuc (ℓa ⊔ ℓb)
|
||||||
|
|
||||||
|
@ -19,32 +21,36 @@ module _ (ℓa ℓb : Level) where
|
||||||
--
|
--
|
||||||
-- Since it doesn't we'll make the following (definitionally equivalent) ad-hoc definition.
|
-- Since it doesn't we'll make the following (definitionally equivalent) ad-hoc definition.
|
||||||
_×_ : ∀ {ℓa ℓb} → Category ℓa ℓb → Category ℓa ℓb → Category ℓa ℓb
|
_×_ : ∀ {ℓa ℓb} → Category ℓa ℓb → Category ℓa ℓb → Category ℓa ℓb
|
||||||
ℂ × 𝔻 = Cat.CatProduct.obj ℂ 𝔻
|
ℂ × 𝔻 = Cat.CatProduct.object ℂ 𝔻
|
||||||
|
|
||||||
record RawMonoidalCategory : Set ℓ where
|
record RawMonoidalCategory (ℂ : Category ℓa ℓb) : Set ℓ where
|
||||||
|
open Category ℂ public hiding (IsAssociative)
|
||||||
field
|
field
|
||||||
category : Category ℓa ℓb
|
|
||||||
open Category category public
|
|
||||||
field
|
|
||||||
{{hasProducts}} : HasProducts category
|
|
||||||
empty : Object
|
empty : Object
|
||||||
-- aka. tensor product, monoidal product.
|
-- aka. tensor product, monoidal product.
|
||||||
append : Functor (category × category) category
|
append : Functor (ℂ × ℂ) ℂ
|
||||||
open HasProducts hasProducts public
|
|
||||||
|
|
||||||
record MonoidalCategory : Set ℓ where
|
module F = Functor append
|
||||||
|
|
||||||
|
_⊗_ = append
|
||||||
|
mappend = F.fmap
|
||||||
|
|
||||||
|
IsAssociative : Set _
|
||||||
|
IsAssociative = {A B : Object} → (f g h : Arrow A A) → mappend ({!mappend!} , {!mappend!}) ≡ mappend (f , mappend (g , h))
|
||||||
|
|
||||||
|
record MonoidalCategory (ℂ : Category ℓa ℓb) : Set ℓ where
|
||||||
field
|
field
|
||||||
raw : RawMonoidalCategory
|
raw : RawMonoidalCategory ℂ
|
||||||
open RawMonoidalCategory raw public
|
open RawMonoidalCategory raw public
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : MonoidalCategory ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) {monoidal : MonoidalCategory ℂ} {hasProducts : HasProducts ℂ} where
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
open MonoidalCategory ℂ public
|
open MonoidalCategory monoidal public hiding (mappend)
|
||||||
|
open HasProducts hasProducts
|
||||||
|
|
||||||
record Monoid : Set ℓ where
|
record MonoidalObject (M : Object) : Set ℓ where
|
||||||
field
|
field
|
||||||
carrier : Object
|
mempty : Arrow empty M
|
||||||
mempty : Arrow empty carrier
|
mappend : Arrow (M × M) M
|
||||||
mappend : Arrow (carrier × carrier) carrier
|
|
||||||
|
|
|
@ -17,92 +17,88 @@
|
||||||
-- Functions for manipulating the above:
|
-- Functions for manipulating the above:
|
||||||
--
|
--
|
||||||
-- * A composition operator.
|
-- * A composition operator.
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.NaturalTransformation where
|
open import Cat.Prelude
|
||||||
open import Agda.Primitive
|
|
||||||
open import Data.Product
|
open import Data.Nat using (_≤′_ ; ≤′-refl ; ≤′-step)
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s)
|
|
||||||
module Nat = Data.Nat
|
module Nat = Data.Nat
|
||||||
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.Sigma
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor hiding (identity)
|
open import Cat.Category.Functor
|
||||||
open import Cat.Wishlist
|
|
||||||
|
|
||||||
module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
module Cat.Category.NaturalTransformation
|
||||||
|
{ℓc ℓc' ℓd ℓd' : Level}
|
||||||
(ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
(ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
|
|
||||||
open Category using (Object ; 𝟙)
|
open Category using (Object)
|
||||||
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
|
module _ (F G : Functor ℂ 𝔻) where
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module F = Functor F
|
||||||
module 𝔻 = Category 𝔻
|
module G = Functor G
|
||||||
|
-- What do you call a non-natural tranformation?
|
||||||
|
Transformation : Set (ℓc ⊔ ℓd')
|
||||||
|
Transformation = (C : Object ℂ) → 𝔻 [ F.omap C , G.omap C ]
|
||||||
|
|
||||||
module _ (F G : Functor ℂ 𝔻) where
|
Natural : Transformation → Set (ℓc ⊔ (ℓc' ⊔ ℓd'))
|
||||||
private
|
Natural θ
|
||||||
module F = Functor F
|
= {A B : Object ℂ}
|
||||||
module G = Functor G
|
→ (f : ℂ [ A , B ])
|
||||||
-- What do you call a non-natural tranformation?
|
→ 𝔻 [ θ B ∘ F.fmap f ] ≡ 𝔻 [ G.fmap f ∘ θ A ]
|
||||||
Transformation : Set (ℓc ⊔ ℓd')
|
|
||||||
Transformation = (C : Object ℂ) → 𝔻 [ F.omap C , G.omap C ]
|
|
||||||
|
|
||||||
Natural : Transformation → Set (ℓc ⊔ (ℓc' ⊔ ℓd'))
|
NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
Natural θ
|
NaturalTransformation = Σ Transformation Natural
|
||||||
= {A B : Object ℂ}
|
|
||||||
→ (f : ℂ [ A , B ])
|
|
||||||
→ 𝔻 [ θ B ∘ F.fmap f ] ≡ 𝔻 [ G.fmap f ∘ θ A ]
|
|
||||||
|
|
||||||
NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd')
|
-- Think I need propPi and that arrows are sets
|
||||||
NaturalTransformation = Σ Transformation Natural
|
propIsNatural : (θ : _) → isProp (Natural θ)
|
||||||
|
propIsNatural θ x y i {A} {B} f = 𝔻.arrowsAreSets _ _ (x f) (y f) i
|
||||||
|
|
||||||
-- Think I need propPi and that arrows are sets
|
NaturalTransformation≡ : {α β : NaturalTransformation}
|
||||||
propIsNatural : (θ : _) → isProp (Natural θ)
|
→ (eq₁ : α .fst ≡ β .fst)
|
||||||
propIsNatural θ x y i {A} {B} f = 𝔻.arrowsAreSets _ _ (x f) (y f) i
|
→ α ≡ β
|
||||||
|
NaturalTransformation≡ eq = lemSig propIsNatural _ _ eq
|
||||||
|
|
||||||
NaturalTransformation≡ : {α β : NaturalTransformation}
|
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
||||||
→ (eq₁ : α .proj₁ ≡ β .proj₁)
|
identityTrans F C = 𝔻.identity
|
||||||
→ α ≡ β
|
|
||||||
NaturalTransformation≡ eq = lemSig propIsNatural _ _ eq
|
|
||||||
|
|
||||||
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
||||||
identityTrans F C = 𝟙 𝔻
|
identityNatural F {A = A} {B = B} f = begin
|
||||||
|
𝔻 [ identityTrans F B ∘ F→ f ] ≡⟨⟩
|
||||||
|
𝔻 [ 𝔻.identity ∘ F→ f ] ≡⟨ 𝔻.leftIdentity ⟩
|
||||||
|
F→ f ≡⟨ sym 𝔻.rightIdentity ⟩
|
||||||
|
𝔻 [ F→ f ∘ 𝔻.identity ] ≡⟨⟩
|
||||||
|
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
||||||
|
where
|
||||||
|
module F = Functor F
|
||||||
|
F→ = F.fmap
|
||||||
|
|
||||||
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
identity : (F : Functor ℂ 𝔻) → NaturalTransformation F F
|
||||||
identityNatural F {A = A} {B = B} f = begin
|
identity F = identityTrans F , identityNatural F
|
||||||
𝔻 [ identityTrans F B ∘ F→ f ] ≡⟨⟩
|
|
||||||
𝔻 [ 𝟙 𝔻 ∘ F→ f ] ≡⟨ proj₂ 𝔻.isIdentity ⟩
|
|
||||||
F→ f ≡⟨ sym (proj₁ 𝔻.isIdentity) ⟩
|
|
||||||
𝔻 [ F→ f ∘ 𝟙 𝔻 ] ≡⟨⟩
|
|
||||||
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
|
||||||
where
|
|
||||||
module F = Functor F
|
|
||||||
F→ = F.fmap
|
|
||||||
|
|
||||||
identity : (F : Functor ℂ 𝔻) → NaturalTransformation F F
|
module _ {F G H : Functor ℂ 𝔻} where
|
||||||
identity F = identityTrans F , identityNatural F
|
private
|
||||||
|
module F = Functor F
|
||||||
|
module G = Functor G
|
||||||
|
module H = Functor H
|
||||||
|
T[_∘_] : Transformation G H → Transformation F G → Transformation F H
|
||||||
|
T[ θ ∘ η ] C = 𝔻 [ θ C ∘ η C ]
|
||||||
|
|
||||||
module _ {F G H : Functor ℂ 𝔻} where
|
NT[_∘_] : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
||||||
private
|
fst NT[ (θ , _) ∘ (η , _) ] = T[ θ ∘ η ]
|
||||||
module F = Functor F
|
snd NT[ (θ , θNat) ∘ (η , ηNat) ] {A} {B} f = begin
|
||||||
module G = Functor G
|
𝔻 [ T[ θ ∘ η ] B ∘ F.fmap f ] ≡⟨⟩
|
||||||
module H = Functor H
|
𝔻 [ 𝔻 [ θ B ∘ η B ] ∘ F.fmap f ] ≡⟨ sym 𝔻.isAssociative ⟩
|
||||||
T[_∘_] : Transformation G H → Transformation F G → Transformation F H
|
𝔻 [ θ B ∘ 𝔻 [ η B ∘ F.fmap f ] ] ≡⟨ cong (λ φ → 𝔻 [ θ B ∘ φ ]) (ηNat f) ⟩
|
||||||
T[ θ ∘ η ] C = 𝔻 [ θ C ∘ η C ]
|
𝔻 [ θ B ∘ 𝔻 [ G.fmap f ∘ η A ] ] ≡⟨ 𝔻.isAssociative ⟩
|
||||||
|
𝔻 [ 𝔻 [ θ B ∘ G.fmap f ] ∘ η A ] ≡⟨ cong (λ φ → 𝔻 [ φ ∘ η A ]) (θNat f) ⟩
|
||||||
NT[_∘_] : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
𝔻 [ 𝔻 [ H.fmap f ∘ θ A ] ∘ η A ] ≡⟨ sym 𝔻.isAssociative ⟩
|
||||||
proj₁ NT[ (θ , _) ∘ (η , _) ] = T[ θ ∘ η ]
|
𝔻 [ H.fmap f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
||||||
proj₂ NT[ (θ , θNat) ∘ (η , ηNat) ] {A} {B} f = begin
|
𝔻 [ H.fmap f ∘ T[ θ ∘ η ] A ] ∎
|
||||||
𝔻 [ T[ θ ∘ η ] B ∘ F.fmap f ] ≡⟨⟩
|
|
||||||
𝔻 [ 𝔻 [ θ B ∘ η B ] ∘ F.fmap f ] ≡⟨ sym 𝔻.isAssociative ⟩
|
|
||||||
𝔻 [ θ B ∘ 𝔻 [ η B ∘ F.fmap f ] ] ≡⟨ cong (λ φ → 𝔻 [ θ B ∘ φ ]) (ηNat f) ⟩
|
|
||||||
𝔻 [ θ B ∘ 𝔻 [ G.fmap f ∘ η A ] ] ≡⟨ 𝔻.isAssociative ⟩
|
|
||||||
𝔻 [ 𝔻 [ θ B ∘ G.fmap f ] ∘ η A ] ≡⟨ cong (λ φ → 𝔻 [ φ ∘ η A ]) (θNat f) ⟩
|
|
||||||
𝔻 [ 𝔻 [ H.fmap f ∘ θ A ] ∘ η A ] ≡⟨ sym 𝔻.isAssociative ⟩
|
|
||||||
𝔻 [ H.fmap f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
|
||||||
𝔻 [ H.fmap f ∘ T[ θ ∘ η ] A ] ∎
|
|
||||||
|
|
||||||
|
module Properties where
|
||||||
module _ {F G : Functor ℂ 𝔻} where
|
module _ {F G : Functor ℂ 𝔻} where
|
||||||
transformationIsSet : isSet (Transformation F G)
|
transformationIsSet : isSet (Transformation F G)
|
||||||
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l → p l C) (λ l → q l C) i j
|
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l → p l C) (λ l → q l C) i j
|
||||||
|
@ -113,8 +109,39 @@ module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
||||||
lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ]
|
lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ]
|
||||||
lem = λ i f → 𝔻.arrowsAreSets _ _ (θNat f) (θNat' f) i
|
lem = λ i f → 𝔻.arrowsAreSets _ _ (θNat f) (θNat' f) i
|
||||||
|
|
||||||
naturalTransformationIsSet : isSet (NaturalTransformation F G)
|
naturalIsSet : (θ : Transformation F G) → isSet (Natural F G θ)
|
||||||
naturalTransformationIsSet = sigPresSet transformationIsSet
|
naturalIsSet θ =
|
||||||
λ θ → ntypeCommulative
|
ntypeCumulative {n = 1}
|
||||||
(s≤s {n = Nat.suc Nat.zero} z≤n)
|
(Data.Nat.≤′-step Data.Nat.≤′-refl)
|
||||||
(naturalIsProp θ)
|
(naturalIsProp θ)
|
||||||
|
|
||||||
|
naturalTransformationIsSet : isSet (NaturalTransformation F G)
|
||||||
|
naturalTransformationIsSet = sigPresSet transformationIsSet naturalIsSet
|
||||||
|
|
||||||
|
module _
|
||||||
|
{F G H I : Functor ℂ 𝔻}
|
||||||
|
{θ : NaturalTransformation F G}
|
||||||
|
{η : NaturalTransformation G H}
|
||||||
|
{ζ : NaturalTransformation H I} where
|
||||||
|
-- isAssociative : NT[ ζ ∘ NT[ η ∘ θ ] ] ≡ NT[ NT[ ζ ∘ η ] ∘ θ ]
|
||||||
|
isAssociative
|
||||||
|
: NT[_∘_] {F} {H} {I} ζ (NT[_∘_] {F} {G} {H} η θ)
|
||||||
|
≡ NT[_∘_] {F} {G} {I} (NT[_∘_] {G} {H} {I} ζ η) θ
|
||||||
|
isAssociative
|
||||||
|
= lemSig (naturalIsProp {F = F} {I}) _ _
|
||||||
|
(funExt (λ _ → 𝔻.isAssociative))
|
||||||
|
|
||||||
|
module _ {F G : Functor ℂ 𝔻} {θNT : NaturalTransformation F G} where
|
||||||
|
private
|
||||||
|
propNat = naturalIsProp {F = F} {G}
|
||||||
|
|
||||||
|
rightIdentity : (NT[_∘_] {F} {F} {G} θNT (identity F)) ≡ θNT
|
||||||
|
rightIdentity = lemSig propNat _ _ (funExt (λ _ → 𝔻.rightIdentity))
|
||||||
|
|
||||||
|
leftIdentity : (NT[_∘_] {F} {G} {G} (identity G) θNT) ≡ θNT
|
||||||
|
leftIdentity = lemSig propNat _ _ (funExt (λ _ → 𝔻.leftIdentity))
|
||||||
|
|
||||||
|
isIdentity
|
||||||
|
: (NT[_∘_] {F} {G} {G} (identity G) θNT) ≡ θNT
|
||||||
|
× (NT[_∘_] {F} {F} {G} θNT (identity F)) ≡ θNT
|
||||||
|
isIdentity = leftIdentity , rightIdentity
|
||||||
|
|
|
@ -1,36 +1,32 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Category.Product where
|
module Cat.Category.Product where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude as P hiding (_×_ ; fst ; snd)
|
||||||
open import Cubical
|
open import Cat.Equivalence
|
||||||
open import Data.Product as P hiding (_×_ ; proj₁ ; proj₂)
|
|
||||||
|
|
||||||
open import Cat.Category hiding (module Propositionality)
|
open import Cat.Category
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
|
|
||||||
module _ (A B : Object) where
|
module _ (A B : Object) where
|
||||||
record RawProduct : Set (ℓa ⊔ ℓb) where
|
record RawProduct : Set (ℓa ⊔ ℓb) where
|
||||||
no-eta-equality
|
-- no-eta-equality
|
||||||
field
|
field
|
||||||
object : Object
|
object : Object
|
||||||
proj₁ : ℂ [ object , A ]
|
fst : ℂ [ object , A ]
|
||||||
proj₂ : ℂ [ object , B ]
|
snd : ℂ [ object , B ]
|
||||||
|
|
||||||
-- FIXME Not sure this is actually a proposition - so this name is
|
|
||||||
-- misleading.
|
|
||||||
record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
|
record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
|
||||||
open RawProduct raw public
|
open RawProduct raw public
|
||||||
field
|
field
|
||||||
isProduct : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
|
ump : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
|
||||||
→ ∃![ f×g ] (ℂ [ proj₁ ∘ f×g ] ≡ f P.× ℂ [ proj₂ ∘ f×g ] ≡ g)
|
→ ∃![ f×g ] (ℂ [ fst ∘ f×g ] ≡ f P.× ℂ [ snd ∘ f×g ] ≡ g)
|
||||||
|
|
||||||
-- | Arrow product
|
-- | Arrow product
|
||||||
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
||||||
→ ℂ [ X , object ]
|
→ ℂ [ X , object ]
|
||||||
_P[_×_] π₁ π₂ = P.proj₁ (isProduct π₁ π₂)
|
_P[_×_] π₁ π₂ = P.fst (ump π₁ π₂)
|
||||||
|
|
||||||
record Product : Set (ℓa ⊔ ℓb) where
|
record Product : Set (ℓa ⊔ ℓb) where
|
||||||
field
|
field
|
||||||
|
@ -51,18 +47,144 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
-- The product mentioned in awodey in Def 6.1 is not the regular product of
|
-- The product mentioned in awodey in Def 6.1 is not the regular product of
|
||||||
-- arrows. It's a "parallel" product
|
-- arrows. It's a "parallel" product
|
||||||
module _ {A A' B B' : Object} where
|
module _ {A A' B B' : Object} where
|
||||||
open Product
|
open Product using (_P[_×_])
|
||||||
open Product (product A B) hiding (_P[_×_]) renaming (proj₁ to fst ; proj₂ to snd)
|
open Product (product A B) hiding (_P[_×_]) renaming (fst to fst ; snd to snd)
|
||||||
_|×|_ : ℂ [ A , A' ] → ℂ [ B , B' ] → ℂ [ A × B , A' × B' ]
|
_|×|_ : ℂ [ A , A' ] → ℂ [ B , B' ] → ℂ [ A × B , A' × B' ]
|
||||||
f |×| g = product A' B'
|
f |×| g = product A' B'
|
||||||
P[ ℂ [ f ∘ fst ]
|
P[ ℂ [ f ∘ fst ]
|
||||||
× ℂ [ g ∘ snd ]
|
× ℂ [ g ∘ snd ]
|
||||||
]
|
]
|
||||||
|
|
||||||
module Propositionality {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
|
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb}
|
||||||
-- TODO I'm not sure this is actually provable. Check with Thierry.
|
(let module ℂ = Category ℂ) {𝒜 ℬ : ℂ.Object} where
|
||||||
propProduct : isProp (Product ℂ A B)
|
private
|
||||||
propProduct = {!!}
|
module _ (raw : RawProduct ℂ 𝒜 ℬ) where
|
||||||
|
private
|
||||||
|
open Category ℂ hiding (raw)
|
||||||
|
module _ (x y : IsProduct ℂ 𝒜 ℬ raw) where
|
||||||
|
private
|
||||||
|
module x = IsProduct x
|
||||||
|
module y = IsProduct y
|
||||||
|
|
||||||
|
module _ {X : Object} (f : ℂ [ X , 𝒜 ]) (g : ℂ [ X , ℬ ]) where
|
||||||
|
module _ (f×g : Arrow X y.object) where
|
||||||
|
help : isProp (∀{y} → (ℂ [ y.fst ∘ y ] ≡ f) P.× (ℂ [ y.snd ∘ y ] ≡ g) → f×g ≡ y)
|
||||||
|
help = propPiImpl (λ _ → propPi (λ _ → arrowsAreSets _ _))
|
||||||
|
|
||||||
|
res = ∃-unique (x.ump f g) (y.ump f g)
|
||||||
|
|
||||||
|
prodAux : x.ump f g ≡ y.ump f g
|
||||||
|
prodAux = lemSig ((λ f×g → propSig (propSig (arrowsAreSets _ _) λ _ → arrowsAreSets _ _) (λ _ → help f×g))) _ _ res
|
||||||
|
|
||||||
|
propIsProduct' : x ≡ y
|
||||||
|
propIsProduct' i = record { ump = λ f g → prodAux f g i }
|
||||||
|
|
||||||
|
propIsProduct : isProp (IsProduct ℂ 𝒜 ℬ raw)
|
||||||
|
propIsProduct = propIsProduct'
|
||||||
|
|
||||||
|
Product≡ : {x y : Product ℂ 𝒜 ℬ} → (Product.raw x ≡ Product.raw y) → x ≡ y
|
||||||
|
Product≡ {x} {y} p i = record { raw = p i ; isProduct = q i }
|
||||||
|
where
|
||||||
|
q : (λ i → IsProduct ℂ 𝒜 ℬ (p i)) [ Product.isProduct x ≡ Product.isProduct y ]
|
||||||
|
q = lemPropF propIsProduct p
|
||||||
|
|
||||||
|
open P
|
||||||
|
open import Cat.Categories.Span
|
||||||
|
|
||||||
|
open Category (span ℂ 𝒜 ℬ)
|
||||||
|
|
||||||
|
lemma : Terminal ≃ Product ℂ 𝒜 ℬ
|
||||||
|
lemma = fromIsomorphism Terminal (Product ℂ 𝒜 ℬ) (f , g , inv)
|
||||||
|
where
|
||||||
|
f : Terminal → Product ℂ 𝒜 ℬ
|
||||||
|
f ((X , x0 , x1) , uniq) = p
|
||||||
|
where
|
||||||
|
rawP : RawProduct ℂ 𝒜 ℬ
|
||||||
|
rawP = record
|
||||||
|
{ object = X
|
||||||
|
; fst = x0
|
||||||
|
; snd = x1
|
||||||
|
}
|
||||||
|
-- open RawProduct rawP renaming (fst to x0 ; snd to x1)
|
||||||
|
module _ {Y : ℂ.Object} (p0 : ℂ [ Y , 𝒜 ]) (p1 : ℂ [ Y , ℬ ]) where
|
||||||
|
uy : isContr (Arrow (Y , p0 , p1) (X , x0 , x1))
|
||||||
|
uy = uniq {Y , p0 , p1}
|
||||||
|
open Σ uy renaming (fst to Y→X ; snd to contractible)
|
||||||
|
open Σ Y→X renaming (fst to p0×p1 ; snd to cond)
|
||||||
|
ump : ∃![ f×g ] (ℂ [ x0 ∘ f×g ] ≡ p0 P.× ℂ [ x1 ∘ f×g ] ≡ p1)
|
||||||
|
ump = p0×p1 , cond , λ {f} cond-f → cong fst (contractible (f , cond-f))
|
||||||
|
isP : IsProduct ℂ 𝒜 ℬ rawP
|
||||||
|
isP = record { ump = ump }
|
||||||
|
p : Product ℂ 𝒜 ℬ
|
||||||
|
p = record
|
||||||
|
{ raw = rawP
|
||||||
|
; isProduct = isP
|
||||||
|
}
|
||||||
|
g : Product ℂ 𝒜 ℬ → Terminal
|
||||||
|
g p = 𝒳 , t
|
||||||
|
where
|
||||||
|
open Product p renaming (object to X ; fst to x₀ ; snd to x₁) using ()
|
||||||
|
module p = Product p
|
||||||
|
module isp = IsProduct p.isProduct
|
||||||
|
𝒳 : Object
|
||||||
|
𝒳 = X , x₀ , x₁
|
||||||
|
module _ {𝒴 : Object} where
|
||||||
|
open Σ 𝒴 renaming (fst to Y)
|
||||||
|
open Σ (snd 𝒴) renaming (fst to y₀ ; snd to y₁)
|
||||||
|
ump = p.ump y₀ y₁
|
||||||
|
open Σ ump renaming (fst to f')
|
||||||
|
open Σ (snd ump) renaming (fst to f'-cond)
|
||||||
|
𝒻 : Arrow 𝒴 𝒳
|
||||||
|
𝒻 = f' , f'-cond
|
||||||
|
contractible : (f : Arrow 𝒴 𝒳) → 𝒻 ≡ f
|
||||||
|
contractible ff@(f , f-cond) = res
|
||||||
|
where
|
||||||
|
k : f' ≡ f
|
||||||
|
k = snd (snd ump) f-cond
|
||||||
|
prp : (a : ℂ.Arrow Y X) → isProp
|
||||||
|
( (ℂ [ x₀ ∘ a ] ≡ y₀)
|
||||||
|
× (ℂ [ x₁ ∘ a ] ≡ y₁)
|
||||||
|
)
|
||||||
|
prp f f0 f1 = Σ≡
|
||||||
|
(ℂ.arrowsAreSets _ _ (fst f0) (fst f1))
|
||||||
|
(ℂ.arrowsAreSets _ _ (snd f0) (snd f1))
|
||||||
|
h :
|
||||||
|
( λ i
|
||||||
|
→ ℂ [ x₀ ∘ k i ] ≡ y₀
|
||||||
|
× ℂ [ x₁ ∘ k i ] ≡ y₁
|
||||||
|
) [ f'-cond ≡ f-cond ]
|
||||||
|
h = lemPropF prp k
|
||||||
|
res : (f' , f'-cond) ≡ (f , f-cond)
|
||||||
|
res = Σ≡ k h
|
||||||
|
t : IsTerminal 𝒳
|
||||||
|
t {𝒴} = 𝒻 , contractible
|
||||||
|
ve-re : ∀ x → g (f x) ≡ x
|
||||||
|
ve-re x = Propositionality.propTerminal _ _
|
||||||
|
re-ve : ∀ p → f (g p) ≡ p
|
||||||
|
re-ve p = Product≡ e
|
||||||
|
where
|
||||||
|
module p = Product p
|
||||||
|
-- RawProduct does not have eta-equality.
|
||||||
|
e : Product.raw (f (g p)) ≡ Product.raw p
|
||||||
|
RawProduct.object (e i) = p.object
|
||||||
|
RawProduct.fst (e i) = p.fst
|
||||||
|
RawProduct.snd (e i) = p.snd
|
||||||
|
inv : AreInverses f g
|
||||||
|
inv = funExt ve-re , funExt re-ve
|
||||||
|
|
||||||
|
propProduct : isProp (Product ℂ 𝒜 ℬ)
|
||||||
|
propProduct = equivPreservesNType {n = ⟨-1⟩} lemma Propositionality.propTerminal
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
|
||||||
|
open Category ℂ
|
||||||
|
private
|
||||||
|
module _ (x y : HasProducts ℂ) where
|
||||||
|
private
|
||||||
|
module x = HasProducts x
|
||||||
|
module y = HasProducts y
|
||||||
|
|
||||||
|
productEq : x.product ≡ y.product
|
||||||
|
productEq = funExt λ A → funExt λ B → propProduct _ _
|
||||||
|
|
||||||
propHasProducts : isProp (HasProducts ℂ)
|
propHasProducts : isProp (HasProducts ℂ)
|
||||||
propHasProducts = {!!}
|
propHasProducts x y i = record { product = productEq x y i }
|
||||||
|
|
|
@ -1,62 +1,66 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
|
|
||||||
module Cat.Category.Yoneda where
|
module Cat.Category.Yoneda where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
open import Data.Product
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Equality
|
open import Cat.Category.NaturalTransformation
|
||||||
|
renaming (module Properties to F)
|
||||||
|
using ()
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
|
open import Cat.Categories.Sets hiding (presheaf)
|
||||||
|
open import Cat.Categories.Fun using (module Fun)
|
||||||
|
|
||||||
open import Cat.Categories.Fun
|
-- There is no (small) category of categories. So we won't use _⇑_ from
|
||||||
open import Cat.Categories.Sets
|
-- `HasExponential`
|
||||||
open import Cat.Categories.Cat
|
--
|
||||||
|
-- open HasExponentials (Cat.hasExponentials ℓ unprovable) using (_⇑_)
|
||||||
|
--
|
||||||
|
-- In stead we'll use an ad-hoc definition -- which is definitionally equivalent
|
||||||
|
-- to that other one - even without mentioning the category of categories.
|
||||||
|
_⇑_ : {ℓ : Level} → Category ℓ ℓ → Category ℓ ℓ → Category ℓ ℓ
|
||||||
|
_⇑_ = Fun.Fun
|
||||||
|
|
||||||
module _ {ℓ : Level} {ℂ : Category ℓ ℓ} where
|
module _ {ℓ : Level} {ℂ : Category ℓ ℓ} where
|
||||||
private
|
private
|
||||||
𝓢 = Sets ℓ
|
𝓢 = Sets ℓ
|
||||||
open Fun (opposite ℂ) 𝓢
|
open Fun (opposite ℂ) 𝓢
|
||||||
prshf = presheaf ℂ
|
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
|
|
||||||
-- There is no (small) category of categories. So we won't use _⇑_ from
|
presheaf : ℂ.Object → Presheaf ℂ
|
||||||
-- `HasExponential`
|
presheaf = Cat.Categories.Sets.presheaf ℂ
|
||||||
--
|
|
||||||
-- open HasExponentials (Cat.hasExponentials ℓ unprovable) using (_⇑_)
|
|
||||||
--
|
|
||||||
-- In stead we'll use an ad-hoc definition -- which is definitionally
|
|
||||||
-- equivalent to that other one.
|
|
||||||
_⇑_ = CatExponential.object
|
|
||||||
|
|
||||||
module _ {A B : ℂ.Object} (f : ℂ [ A , B ]) where
|
module _ {A B : ℂ.Object} (f : ℂ [ A , B ]) where
|
||||||
fmap : Transformation (prshf A) (prshf B)
|
fmap : Transformation (presheaf A) (presheaf B)
|
||||||
fmap C x = ℂ [ f ∘ x ]
|
fmap C x = ℂ [ f ∘ x ]
|
||||||
|
|
||||||
fmapNatural : Natural (prshf A) (prshf B) fmap
|
fmapNatural : Natural (presheaf A) (presheaf B) fmap
|
||||||
fmapNatural g = funExt λ _ → ℂ.isAssociative
|
fmapNatural g = funExt λ _ → ℂ.isAssociative
|
||||||
|
|
||||||
fmapNT : NaturalTransformation (prshf A) (prshf B)
|
fmapNT : NaturalTransformation (presheaf A) (presheaf B)
|
||||||
fmapNT = fmap , fmapNatural
|
fmapNT = fmap , fmapNatural
|
||||||
|
|
||||||
rawYoneda : RawFunctor ℂ Fun
|
rawYoneda : RawFunctor ℂ Fun
|
||||||
RawFunctor.omap rawYoneda = prshf
|
RawFunctor.omap rawYoneda = presheaf
|
||||||
RawFunctor.fmap rawYoneda = fmapNT
|
RawFunctor.fmap rawYoneda = fmapNT
|
||||||
|
|
||||||
open RawFunctor rawYoneda hiding (fmap)
|
open RawFunctor rawYoneda hiding (fmap)
|
||||||
|
|
||||||
isIdentity : IsIdentity
|
isIdentity : IsIdentity
|
||||||
isIdentity {c} = lemSig (naturalIsProp {F = prshf c} {prshf c}) _ _ eq
|
isIdentity {c} = lemSig prp _ _ eq
|
||||||
where
|
where
|
||||||
eq : (λ C x → ℂ [ ℂ.𝟙 ∘ x ]) ≡ identityTrans (prshf c)
|
eq : (λ C x → ℂ [ ℂ.identity ∘ x ]) ≡ identityTrans (presheaf c)
|
||||||
eq = funExt λ A → funExt λ B → proj₂ ℂ.isIdentity
|
eq = funExt λ A → funExt λ B → ℂ.leftIdentity
|
||||||
|
prp = F.naturalIsProp _ _ {F = presheaf c} {presheaf c}
|
||||||
|
|
||||||
isDistributive : IsDistributive
|
isDistributive : IsDistributive
|
||||||
isDistributive {A} {B} {C} {f = f} {g}
|
isDistributive {A} {B} {C} {f = f} {g}
|
||||||
= lemSig (propIsNatural (prshf A) (prshf C)) _ _ eq
|
= lemSig (propIsNatural (presheaf A) (presheaf C)) _ _ eq
|
||||||
where
|
where
|
||||||
T[_∘_]' = T[_∘_] {F = prshf A} {prshf B} {prshf C}
|
T[_∘_]' = T[_∘_] {F = presheaf A} {presheaf B} {presheaf C}
|
||||||
eqq : (X : ℂ.Object) → (x : ℂ [ X , A ])
|
eqq : (X : ℂ.Object) → (x : ℂ [ X , A ])
|
||||||
→ fmap (ℂ [ g ∘ f ]) X x ≡ T[ fmap g ∘ fmap f ]' X x
|
→ fmap (ℂ [ g ∘ f ]) X x ≡ T[ fmap g ∘ fmap f ]' X x
|
||||||
eqq X x = begin
|
eqq X x = begin
|
||||||
|
@ -76,5 +80,5 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} where
|
||||||
IsFunctor.isDistributive isFunctor = isDistributive
|
IsFunctor.isDistributive isFunctor = isDistributive
|
||||||
|
|
||||||
yoneda : Functor ℂ Fun
|
yoneda : Functor ℂ Fun
|
||||||
Functor.raw yoneda = rawYoneda
|
Functor.raw yoneda = rawYoneda
|
||||||
Functor.isFunctor yoneda = isFunctor
|
Functor.isFunctor yoneda = isFunctor
|
||||||
|
|
|
@ -1,22 +0,0 @@
|
||||||
{-# OPTIONS --cubical #-}
|
|
||||||
-- Defines equality-principles for data-types from the standard library.
|
|
||||||
|
|
||||||
module Cat.Equality where
|
|
||||||
|
|
||||||
open import Level
|
|
||||||
open import Cubical
|
|
||||||
|
|
||||||
-- _[_≡_] = PathP
|
|
||||||
|
|
||||||
module Equality where
|
|
||||||
module Data where
|
|
||||||
module Product where
|
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : A → Set ℓb} {a b : Σ A B}
|
|
||||||
(proj₁≡ : (λ _ → A) [ proj₁ a ≡ proj₁ b ])
|
|
||||||
(proj₂≡ : (λ i → B (proj₁≡ i)) [ proj₂ a ≡ proj₂ b ]) where
|
|
||||||
|
|
||||||
Σ≡ : a ≡ b
|
|
||||||
proj₁ (Σ≡ i) = proj₁≡ i
|
|
||||||
proj₂ (Σ≡ i) = proj₂≡ i
|
|
544
src/Cat/Equivalence.agda
Normal file
544
src/Cat/Equivalence.agda
Normal file
|
@ -0,0 +1,544 @@
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
module Cat.Equivalence where
|
||||||
|
|
||||||
|
open import Cubical.Primitives
|
||||||
|
open import Cubical.FromStdLib renaming (ℓ-max to _⊔_)
|
||||||
|
open import Cubical.PathPrelude hiding (inverse)
|
||||||
|
open import Cubical.PathPrelude using (isEquiv ; isContr ; fiber) public
|
||||||
|
open import Cubical.GradLemma hiding (isoToPath)
|
||||||
|
|
||||||
|
open import Cat.Prelude using
|
||||||
|
( lemPropF ; setPi ; lemSig ; propSet
|
||||||
|
; Preorder ; equalityIsEquivalence ; propSig ; id-coe
|
||||||
|
; Setoid ; _$_ ; propPi )
|
||||||
|
|
||||||
|
import Cubical.Univalence as U
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A B : Set ℓ} where
|
||||||
|
open Cubical.PathPrelude
|
||||||
|
ua : A ≃ B → A ≡ B
|
||||||
|
ua (f , isEqv) = U.ua (U.con f isEqv)
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} where
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
|
module _ {A : Set ℓa} {B : Set ℓb} where
|
||||||
|
-- Quasi-inverse in [HoTT] §2.4.6
|
||||||
|
-- FIXME Maybe rename?
|
||||||
|
AreInverses : (f : A → B) (g : B → A) → Set ℓ
|
||||||
|
AreInverses f g = g ∘ f ≡ idFun A × f ∘ g ≡ idFun B
|
||||||
|
|
||||||
|
module AreInverses {f : A → B} {g : B → A}
|
||||||
|
(inv : AreInverses f g) where
|
||||||
|
open Σ inv renaming (fst to verso-recto ; snd to recto-verso) public
|
||||||
|
obverse = f
|
||||||
|
reverse = g
|
||||||
|
inverse = reverse
|
||||||
|
|
||||||
|
Isomorphism : (f : A → B) → Set _
|
||||||
|
Isomorphism f = Σ (B → A) λ g → AreInverses f g
|
||||||
|
|
||||||
|
_≅_ : Set ℓa → Set ℓb → Set _
|
||||||
|
A ≅ B = Σ (A → B) Isomorphism
|
||||||
|
|
||||||
|
symIso : ∀ {ℓa ℓb} {A : Set ℓa}{B : Set ℓb} → A ≅ B → B ≅ A
|
||||||
|
symIso (f , g , p , q)= g , f , q , p
|
||||||
|
|
||||||
|
module _ {ℓa ℓb ℓc} {A : Set ℓa} {B : Set ℓb} (sB : isSet B) {Q : B → Set ℓc} (f : A → B) where
|
||||||
|
|
||||||
|
Σ-fst-map : Σ A (\ a → Q (f a)) → Σ B Q
|
||||||
|
Σ-fst-map (x , q) = f x , q
|
||||||
|
|
||||||
|
isoSigFst : Isomorphism f → Σ A (Q ∘ f) ≅ Σ B Q
|
||||||
|
isoSigFst (g , g-f , f-g) = Σ-fst-map
|
||||||
|
, (\ { (b , q) → g b , transp (\ i → Q (f-g (~ i) b)) q })
|
||||||
|
, funExt (\ { (a , q) → Cat.Prelude.Σ≡ (\ i → g-f i a)
|
||||||
|
let r = (transp-iso' ((λ i → Q (f-g (i) (f a)))) q) in
|
||||||
|
transp (\ i → PathP (\ j → Q (sB _ _ (λ j₁ → f-g j₁ (f a)) (λ j₁ → f (g-f j₁ a)) i j)) (transp (λ i₁ → Q (f-g (~ i₁) (f a))) q) q) r })
|
||||||
|
, funExt (\ { (b , q) → Cat.Prelude.Σ≡ (\ i → f-g i b) (transp-iso' (λ i → Q (f-g i b)) q)})
|
||||||
|
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A B : Set ℓ} {f : A → B}
|
||||||
|
(g : B → A) (s : {A B : Set ℓ} → isSet (A → B)) where
|
||||||
|
|
||||||
|
propAreInverses : isProp (AreInverses {A = A} {B} f g)
|
||||||
|
propAreInverses x y i = ve-re , re-ve
|
||||||
|
where
|
||||||
|
ve-re : g ∘ f ≡ idFun A
|
||||||
|
ve-re = s (g ∘ f) (idFun A) (fst x) (fst y) i
|
||||||
|
re-ve : f ∘ g ≡ idFun B
|
||||||
|
re-ve = s (f ∘ g) (idFun B) (snd x) (snd y) i
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A B : Set ℓ} (f : A → B)
|
||||||
|
(sA : isSet A) (sB : isSet B) where
|
||||||
|
|
||||||
|
propIsIso : isProp (Isomorphism f)
|
||||||
|
propIsIso = res
|
||||||
|
where
|
||||||
|
module _ (x y : Isomorphism f) where
|
||||||
|
module x = Σ x renaming (fst to inverse ; snd to areInverses)
|
||||||
|
module y = Σ y renaming (fst to inverse ; snd to areInverses)
|
||||||
|
module xA = AreInverses {f = f} {x.inverse} x.areInverses
|
||||||
|
module yA = AreInverses {f = f} {y.inverse} y.areInverses
|
||||||
|
-- I had a lot of difficulty using the corresponding proof where
|
||||||
|
-- AreInverses is defined. This is sadly a bit anti-modular. The
|
||||||
|
-- reason for my troubles is probably related to the type of objects
|
||||||
|
-- being hSet's rather than sets.
|
||||||
|
p : ∀ {f} g → isProp (AreInverses {A = A} {B} f g)
|
||||||
|
p {f} g xx yy i = ve-re , re-ve
|
||||||
|
where
|
||||||
|
module xxA = AreInverses {f = f} {g} xx
|
||||||
|
module yyA = AreInverses {f = f} {g} yy
|
||||||
|
setPiB : ∀ {X : Set ℓ} → isSet (X → B)
|
||||||
|
setPiB = setPi (λ _ → sB)
|
||||||
|
setPiA : ∀ {X : Set ℓ} → isSet (X → A)
|
||||||
|
setPiA = setPi (λ _ → sA)
|
||||||
|
ve-re : g ∘ f ≡ idFun _
|
||||||
|
ve-re = setPiA _ _ xxA.verso-recto yyA.verso-recto i
|
||||||
|
re-ve : f ∘ g ≡ idFun _
|
||||||
|
re-ve = setPiB _ _ xxA.recto-verso yyA.recto-verso i
|
||||||
|
1eq : x.inverse ≡ y.inverse
|
||||||
|
1eq = begin
|
||||||
|
x.inverse ≡⟨⟩
|
||||||
|
x.inverse ∘ idFun _ ≡⟨ cong (λ φ → x.inverse ∘ φ) (sym yA.recto-verso) ⟩
|
||||||
|
x.inverse ∘ (f ∘ y.inverse) ≡⟨⟩
|
||||||
|
(x.inverse ∘ f) ∘ y.inverse ≡⟨ cong (λ φ → φ ∘ y.inverse) xA.verso-recto ⟩
|
||||||
|
idFun _ ∘ y.inverse ≡⟨⟩
|
||||||
|
y.inverse ∎
|
||||||
|
2eq : (λ i → AreInverses f (1eq i)) [ x.areInverses ≡ y.areInverses ]
|
||||||
|
2eq = lemPropF p 1eq
|
||||||
|
res : x ≡ y
|
||||||
|
res i = 1eq i , 2eq i
|
||||||
|
|
||||||
|
-- In HoTT they generalize an equivalence to have the following 3 properties:
|
||||||
|
module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
|
record Equiv (iseqv : (A → B) → Set ℓ) : Set (ℓa ⊔ ℓb ⊔ ℓ) where
|
||||||
|
field
|
||||||
|
fromIso : {f : A → B} → Isomorphism f → iseqv f
|
||||||
|
toIso : {f : A → B} → iseqv f → Isomorphism f
|
||||||
|
propIsEquiv : (f : A → B) → isProp (iseqv f)
|
||||||
|
|
||||||
|
-- You're alerady assuming here that we don't need eta-equality on the
|
||||||
|
-- equivalence!
|
||||||
|
_~_ : Set ℓa → Set ℓb → Set _
|
||||||
|
A ~ B = Σ _ iseqv
|
||||||
|
|
||||||
|
inverse-from-to-iso : ∀ {f} (x : _) → (fromIso {f} ∘ toIso {f}) x ≡ x
|
||||||
|
inverse-from-to-iso x = begin
|
||||||
|
(fromIso ∘ toIso) x ≡⟨⟩
|
||||||
|
fromIso (toIso x) ≡⟨ propIsEquiv _ (fromIso (toIso x)) x ⟩
|
||||||
|
x ∎
|
||||||
|
|
||||||
|
-- | The other inverse law does not hold in general, it does hold, however,
|
||||||
|
-- | if `A` and `B` are sets.
|
||||||
|
module _ (sA : isSet A) (sB : isSet B) where
|
||||||
|
module _ {f : A → B} where
|
||||||
|
module _ (iso-x iso-y : Isomorphism f) where
|
||||||
|
open Σ iso-x renaming (fst to x ; snd to inv-x)
|
||||||
|
open Σ iso-y renaming (fst to y ; snd to inv-y)
|
||||||
|
|
||||||
|
fx≡fy : x ≡ y
|
||||||
|
fx≡fy = begin
|
||||||
|
x ≡⟨ cong (λ φ → x ∘ φ) (sym (snd inv-y)) ⟩
|
||||||
|
x ∘ (f ∘ y) ≡⟨⟩
|
||||||
|
(x ∘ f) ∘ y ≡⟨ cong (λ φ → φ ∘ y) (fst inv-x) ⟩
|
||||||
|
y ∎
|
||||||
|
|
||||||
|
propInv : ∀ g → isProp (AreInverses f g)
|
||||||
|
propInv g t u = λ i → a i , b i
|
||||||
|
where
|
||||||
|
a : (fst t) ≡ (fst u)
|
||||||
|
a i = funExt hh
|
||||||
|
where
|
||||||
|
hh : ∀ a → (g ∘ f) a ≡ a
|
||||||
|
hh a = sA ((g ∘ f) a) a (λ i → (fst t) i a) (λ i → (fst u) i a) i
|
||||||
|
b : (snd t) ≡ (snd u)
|
||||||
|
b i = funExt hh
|
||||||
|
where
|
||||||
|
hh : ∀ b → (f ∘ g) b ≡ b
|
||||||
|
hh b = sB _ _ (λ i → snd t i b) (λ i → snd u i b) i
|
||||||
|
|
||||||
|
inx≡iny : (λ i → AreInverses f (fx≡fy i)) [ inv-x ≡ inv-y ]
|
||||||
|
inx≡iny = lemPropF propInv fx≡fy
|
||||||
|
|
||||||
|
propIso : iso-x ≡ iso-y
|
||||||
|
propIso i = fx≡fy i , inx≡iny i
|
||||||
|
|
||||||
|
module _ (iso : Isomorphism f) where
|
||||||
|
inverse-to-from-iso : (toIso {f} ∘ fromIso {f}) iso ≡ iso
|
||||||
|
inverse-to-from-iso = begin
|
||||||
|
(toIso ∘ fromIso) iso ≡⟨⟩
|
||||||
|
toIso (fromIso iso) ≡⟨ propIso _ _ ⟩
|
||||||
|
iso ∎
|
||||||
|
|
||||||
|
fromIsomorphism : A ≅ B → A ~ B
|
||||||
|
fromIsomorphism (f , iso) = f , fromIso iso
|
||||||
|
|
||||||
|
toIsomorphism : A ~ B → A ≅ B
|
||||||
|
toIsomorphism (f , eqv) = f , toIso eqv
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
|
-- A wrapper around PathPrelude.≃
|
||||||
|
open Cubical.PathPrelude using (_≃_)
|
||||||
|
private
|
||||||
|
module _ {obverse : A → B} (e : isEquiv A B obverse) where
|
||||||
|
inverse : B → A
|
||||||
|
inverse b = fst (fst (e .equiv-proof b))
|
||||||
|
|
||||||
|
reverse : B → A
|
||||||
|
reverse = inverse
|
||||||
|
|
||||||
|
areInverses : AreInverses obverse inverse
|
||||||
|
areInverses = funExt verso-recto , funExt recto-verso
|
||||||
|
where
|
||||||
|
recto-verso : ∀ b → (obverse ∘ inverse) b ≡ b
|
||||||
|
recto-verso b = begin
|
||||||
|
(obverse ∘ inverse) b ≡⟨ sym (μ b) ⟩
|
||||||
|
b ∎
|
||||||
|
where
|
||||||
|
μ : (b : B) → b ≡ obverse (inverse b)
|
||||||
|
μ b = snd (fst (e .equiv-proof b))
|
||||||
|
verso-recto : ∀ a → (inverse ∘ obverse) a ≡ a
|
||||||
|
verso-recto a = begin
|
||||||
|
(inverse ∘ obverse) a ≡⟨ sym h ⟩
|
||||||
|
a' ≡⟨ u' ⟩
|
||||||
|
a ∎
|
||||||
|
where
|
||||||
|
c : isContr (fiber obverse (obverse a))
|
||||||
|
c = e .equiv-proof (obverse a)
|
||||||
|
fbr : fiber obverse (obverse a)
|
||||||
|
fbr = fst c
|
||||||
|
a' : A
|
||||||
|
a' = fst fbr
|
||||||
|
allC : (y : fiber obverse (obverse a)) → fbr ≡ y
|
||||||
|
allC = snd c
|
||||||
|
k : fbr ≡ (inverse (obverse a), _)
|
||||||
|
k = allC (inverse (obverse a) , sym (recto-verso (obverse a)))
|
||||||
|
h : a' ≡ inverse (obverse a)
|
||||||
|
h i = fst (k i)
|
||||||
|
u : fbr ≡ (a , refl)
|
||||||
|
u = allC (a , refl)
|
||||||
|
u' : a' ≡ a
|
||||||
|
u' i = fst (u i)
|
||||||
|
|
||||||
|
iso : Isomorphism obverse
|
||||||
|
iso = reverse , areInverses
|
||||||
|
|
||||||
|
toIsomorphism : {f : A → B} → isEquiv A B f → Isomorphism f
|
||||||
|
toIsomorphism = iso
|
||||||
|
|
||||||
|
≃isEquiv : Equiv A B (isEquiv A B)
|
||||||
|
Equiv.fromIso ≃isEquiv {f} (f~ , iso) = gradLemma f f~ rv vr
|
||||||
|
where
|
||||||
|
rv : (b : B) → _ ≡ b
|
||||||
|
rv b i = snd iso i b
|
||||||
|
vr : (a : A) → _ ≡ a
|
||||||
|
vr a i = fst iso i a
|
||||||
|
Equiv.toIso ≃isEquiv = toIsomorphism
|
||||||
|
Equiv.propIsEquiv ≃isEquiv = P.propIsEquiv
|
||||||
|
where
|
||||||
|
import Cubical.NType.Properties as P
|
||||||
|
|
||||||
|
open Equiv ≃isEquiv public
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
||||||
|
open Cubical.PathPrelude using (_≃_)
|
||||||
|
|
||||||
|
module _ {ℓc : Level} {C : Set ℓc} {f : A → B} {g : B → C} where
|
||||||
|
|
||||||
|
composeIsomorphism : Isomorphism f → Isomorphism g → Isomorphism (g ∘ f)
|
||||||
|
composeIsomorphism a b = f~ ∘ g~ , inv
|
||||||
|
where
|
||||||
|
open Σ a renaming (fst to f~ ; snd to inv-a)
|
||||||
|
open Σ b renaming (fst to g~ ; snd to inv-b)
|
||||||
|
inv : AreInverses (g ∘ f) (f~ ∘ g~)
|
||||||
|
inv = record
|
||||||
|
{ fst = begin
|
||||||
|
(f~ ∘ g~) ∘ (g ∘ f) ≡⟨⟩
|
||||||
|
f~ ∘ (g~ ∘ g) ∘ f ≡⟨ cong (λ φ → f~ ∘ φ ∘ f) (fst inv-b) ⟩
|
||||||
|
f~ ∘ idFun _ ∘ f ≡⟨⟩
|
||||||
|
f~ ∘ f ≡⟨ (fst inv-a) ⟩
|
||||||
|
idFun A ∎
|
||||||
|
; snd = begin
|
||||||
|
(g ∘ f) ∘ (f~ ∘ g~) ≡⟨⟩
|
||||||
|
g ∘ (f ∘ f~) ∘ g~ ≡⟨ cong (λ φ → g ∘ φ ∘ g~) (snd inv-a) ⟩
|
||||||
|
g ∘ g~ ≡⟨ (snd inv-b) ⟩
|
||||||
|
idFun C ∎
|
||||||
|
}
|
||||||
|
|
||||||
|
composeIsEquiv : isEquiv A B f → isEquiv B C g → isEquiv A C (g ∘ f)
|
||||||
|
composeIsEquiv a b = fromIso A C (composeIsomorphism a' b')
|
||||||
|
where
|
||||||
|
a' = toIso A B a
|
||||||
|
b' = toIso B C b
|
||||||
|
|
||||||
|
composeIso : {ℓc : Level} {C : Set ℓc} → (A ≅ B) → (B ≅ C) → A ≅ C
|
||||||
|
composeIso {C = C} (f , iso-f) (g , iso-g) = g ∘ f , composeIsomorphism iso-f iso-g
|
||||||
|
|
||||||
|
symmetryIso : (A ≅ B) → B ≅ A
|
||||||
|
symmetryIso (inverse , obverse , verso-recto , recto-verso)
|
||||||
|
= obverse
|
||||||
|
, inverse
|
||||||
|
, recto-verso
|
||||||
|
, verso-recto
|
||||||
|
|
||||||
|
-- Gives the quasi inverse from an equivalence.
|
||||||
|
module Equivalence (e : A ≃ B) where
|
||||||
|
compose : {ℓc : Level} {C : Set ℓc} → (B ≃ C) → A ≃ C
|
||||||
|
compose e' = fromIsomorphism _ _ (composeIso (toIsomorphism _ _ e) (toIsomorphism _ _ e'))
|
||||||
|
|
||||||
|
symmetry : B ≃ A
|
||||||
|
symmetry = fromIsomorphism _ _ (symmetryIso (toIsomorphism _ _ e))
|
||||||
|
|
||||||
|
preorder≅ : (ℓ : Level) → Preorder _ _ _
|
||||||
|
preorder≅ ℓ = record
|
||||||
|
{ Carrier = Set ℓ ; _≈_ = _≡_ ; _∼_ = _≅_
|
||||||
|
; isPreorder = record
|
||||||
|
{ isEquivalence = equalityIsEquivalence
|
||||||
|
; reflexive = λ p
|
||||||
|
→ coe p
|
||||||
|
, coe (sym p)
|
||||||
|
, funExt (λ x → inv-coe p)
|
||||||
|
, funExt (λ x → inv-coe' p)
|
||||||
|
; trans = composeIso
|
||||||
|
}
|
||||||
|
}
|
||||||
|
where
|
||||||
|
module _ {ℓ : Level} {A B : Set ℓ} {a : A} where
|
||||||
|
inv-coe : (p : A ≡ B) → coe (sym p) (coe p a) ≡ a
|
||||||
|
inv-coe p =
|
||||||
|
let
|
||||||
|
D : (y : Set ℓ) → _ ≡ y → Set _
|
||||||
|
D _ q = coe (sym q) (coe q a) ≡ a
|
||||||
|
d : D A refl
|
||||||
|
d = begin
|
||||||
|
coe (sym refl) (coe refl a) ≡⟨⟩
|
||||||
|
coe refl (coe refl a) ≡⟨ id-coe ⟩
|
||||||
|
coe refl a ≡⟨ id-coe ⟩
|
||||||
|
a ∎
|
||||||
|
in pathJ D d B p
|
||||||
|
inv-coe' : (p : B ≡ A) → coe p (coe (sym p) a) ≡ a
|
||||||
|
inv-coe' p =
|
||||||
|
let
|
||||||
|
D : (y : Set ℓ) → _ ≡ y → Set _
|
||||||
|
D _ q = coe (sym q) (coe q a) ≡ a
|
||||||
|
k : coe p (coe (sym p) a) ≡ a
|
||||||
|
k = pathJ D (trans id-coe id-coe) B (sym p)
|
||||||
|
in k
|
||||||
|
|
||||||
|
setoid≅ : (ℓ : Level) → Setoid _ _
|
||||||
|
setoid≅ ℓ = record
|
||||||
|
{ Carrier = Set ℓ
|
||||||
|
; _≈_ = _≅_
|
||||||
|
; isEquivalence = record
|
||||||
|
{ refl = idFun _ , idFun _ , (funExt λ _ → refl) , (funExt λ _ → refl)
|
||||||
|
; sym = symmetryIso
|
||||||
|
; trans = composeIso
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
setoid≃ : (ℓ : Level) → Setoid _ _
|
||||||
|
setoid≃ ℓ = record
|
||||||
|
{ Carrier = Set ℓ
|
||||||
|
; _≈_ = _≃_
|
||||||
|
; isEquivalence = record
|
||||||
|
{ refl = idEquiv
|
||||||
|
; sym = Equivalence.symmetry
|
||||||
|
; trans = λ x x₁ → Equivalence.compose x x₁
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
-- If the second component of a pair is propositional, then equality of such
|
||||||
|
-- pairs is equivalent to equality of their first components.
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {P : A → Set ℓb} where
|
||||||
|
equivSigProp : ((x : A) → isProp (P x)) → {p q : Σ A P}
|
||||||
|
→ (p ≡ q) ≃ (fst p ≡ fst q)
|
||||||
|
equivSigProp pA {p} {q} = fromIsomorphism _ _ iso
|
||||||
|
where
|
||||||
|
f : ∀ {p q} → p ≡ q → fst p ≡ fst q
|
||||||
|
f = cong fst
|
||||||
|
g : ∀ {p q} → fst p ≡ fst q → p ≡ q
|
||||||
|
g = lemSig pA _ _
|
||||||
|
ve-re : (e : p ≡ q) → (g ∘ f) e ≡ e
|
||||||
|
ve-re = pathJ (\ q (e : p ≡ q) → (g ∘ f) e ≡ e)
|
||||||
|
(\ i j → p .fst , propSet (pA (p .fst)) (p .snd) (p .snd) (λ i → (g {p} {p} ∘ f) (λ i₁ → p) i .snd) (λ i → p .snd) i j ) q
|
||||||
|
re-ve : (e : fst p ≡ fst q) → (f {p} {q} ∘ g {p} {q}) e ≡ e
|
||||||
|
re-ve e = refl
|
||||||
|
inv : AreInverses (f {p} {q}) (g {p} {q})
|
||||||
|
inv = funExt ve-re , funExt re-ve
|
||||||
|
iso : (p ≡ q) ≅ (fst p ≡ fst q)
|
||||||
|
iso = f , g , inv
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A B : Set ℓ} where
|
||||||
|
isoToPath : (A ≅ B) → (A ≡ B)
|
||||||
|
isoToPath = ua ∘ fromIsomorphism _ _
|
||||||
|
|
||||||
|
univalence : (A ≡ B) ≃ (A ≃ B)
|
||||||
|
univalence = Equivalence.compose u' aux
|
||||||
|
where
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
||||||
|
deEta : A ≃ B → A U.≃ B
|
||||||
|
deEta (a , b) = U.con a b
|
||||||
|
doEta : A U.≃ B → A ≃ B
|
||||||
|
doEta (U.con eqv isEqv) = eqv , isEqv
|
||||||
|
u : (A ≡ B) U.≃ (A U.≃ B)
|
||||||
|
u = U.univalence
|
||||||
|
u' : (A ≡ B) ≃ (A U.≃ B)
|
||||||
|
u' = doEta u
|
||||||
|
aux : (A U.≃ B) ≃ (A ≃ B)
|
||||||
|
aux = fromIsomorphism _ _ (doEta , deEta , funExt (λ{ (U.con _ _) → refl}) , refl)
|
||||||
|
|
||||||
|
-- Equivalence is equivalent to isomorphism when the equivalence (resp.
|
||||||
|
-- isomorphism) acts on sets.
|
||||||
|
module _ (sA : isSet A) (sB : isSet B) where
|
||||||
|
equiv≃iso : (f : A → B) → isEquiv A B f ≃ Isomorphism f
|
||||||
|
equiv≃iso f =
|
||||||
|
let
|
||||||
|
obv : isEquiv A B f → Isomorphism f
|
||||||
|
obv = toIso A B
|
||||||
|
inv : Isomorphism f → isEquiv A B f
|
||||||
|
inv = fromIso A B
|
||||||
|
re-ve : (x : isEquiv A B f) → (inv ∘ obv) x ≡ x
|
||||||
|
re-ve = inverse-from-to-iso A B
|
||||||
|
ve-re : (x : Isomorphism f) → (obv ∘ inv) x ≡ x
|
||||||
|
ve-re = inverse-to-from-iso A B sA sB
|
||||||
|
iso : isEquiv A B f ≅ Isomorphism f
|
||||||
|
iso = obv , inv , funExt re-ve , funExt ve-re
|
||||||
|
in fromIsomorphism _ _ iso
|
||||||
|
|
||||||
|
-- A few results that I have not generalized to work with both the eta and no-eta variable of ≃
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {P : A → Set ℓb} where
|
||||||
|
-- Equality on sigma's whose second component is a proposition is equivalent
|
||||||
|
-- to equality on their first components.
|
||||||
|
equivPropSig : ((x : A) → isProp (P x)) → (p q : Σ A P)
|
||||||
|
→ (p ≡ q) ≃ (fst p ≡ fst q)
|
||||||
|
equivPropSig pA p q = fromIsomorphism _ _ iso
|
||||||
|
where
|
||||||
|
f : ∀ {p q} → p ≡ q → fst p ≡ fst q
|
||||||
|
f = cong fst
|
||||||
|
g : ∀ {p q} → fst p ≡ fst q → p ≡ q
|
||||||
|
g {p} {q} = lemSig pA p q
|
||||||
|
ve-re : (e : p ≡ q) → (g ∘ f) e ≡ e
|
||||||
|
ve-re = pathJ (\ q (e : p ≡ q) → (g ∘ f) e ≡ e)
|
||||||
|
(\ i j → p .fst , propSet (pA (p .fst)) (p .snd) (p .snd) (λ i → (g {p} {p} ∘ f) (λ i₁ → p) i .snd) (λ i → p .snd) i j ) q
|
||||||
|
re-ve : (e : fst p ≡ fst q) → (f {p} {q} ∘ g {p} {q}) e ≡ e
|
||||||
|
re-ve e = refl
|
||||||
|
inv : AreInverses (f {p} {q}) (g {p} {q})
|
||||||
|
inv = funExt ve-re , funExt re-ve
|
||||||
|
iso : (p ≡ q) ≅ (fst p ≡ fst q)
|
||||||
|
iso = f , g , inv
|
||||||
|
|
||||||
|
-- Sigma that are equivalent on all points in the second projection are
|
||||||
|
-- equivalent.
|
||||||
|
equivSigSnd : ∀ {ℓc} {Q : A → Set (ℓc ⊔ ℓb)}
|
||||||
|
→ ((a : A) → P a ≃ Q a) → Σ A P ≃ Σ A Q
|
||||||
|
equivSigSnd {Q = Q} eA = res
|
||||||
|
where
|
||||||
|
f : Σ A P → Σ A Q
|
||||||
|
f (a , pA) = a , fst (eA a) pA
|
||||||
|
g : Σ A Q → Σ A P
|
||||||
|
g (a , qA) = a , g' qA
|
||||||
|
where
|
||||||
|
k : Isomorphism _
|
||||||
|
k = toIso _ _ (snd (eA a))
|
||||||
|
open Σ k renaming (fst to g')
|
||||||
|
ve-re : (x : Σ A P) → (g ∘ f) x ≡ x
|
||||||
|
ve-re x i = fst x , eq i
|
||||||
|
where
|
||||||
|
eq : snd ((g ∘ f) x) ≡ snd x
|
||||||
|
eq = begin
|
||||||
|
snd ((g ∘ f) x) ≡⟨⟩
|
||||||
|
snd (g (f (a , pA))) ≡⟨⟩
|
||||||
|
g' (fst (eA a) pA) ≡⟨ lem ⟩
|
||||||
|
pA ∎
|
||||||
|
where
|
||||||
|
open Σ x renaming (fst to a ; snd to pA)
|
||||||
|
k : Isomorphism _
|
||||||
|
k = toIso _ _ (snd (eA a))
|
||||||
|
open Σ k renaming (fst to g' ; snd to inv)
|
||||||
|
lem : (g' ∘ (fst (eA a))) pA ≡ pA
|
||||||
|
lem i = fst inv i pA
|
||||||
|
re-ve : (x : Σ A Q) → (f ∘ g) x ≡ x
|
||||||
|
re-ve x i = fst x , eq i
|
||||||
|
where
|
||||||
|
open Σ x renaming (fst to a ; snd to qA)
|
||||||
|
eq = begin
|
||||||
|
snd ((f ∘ g) x) ≡⟨⟩
|
||||||
|
fst (eA a) (g' qA) ≡⟨ (λ i → snd inv i qA) ⟩
|
||||||
|
qA ∎
|
||||||
|
where
|
||||||
|
k : Isomorphism _
|
||||||
|
k = toIso _ _ (snd (eA a))
|
||||||
|
open Σ k renaming (fst to g' ; snd to inv)
|
||||||
|
inv : AreInverses f g
|
||||||
|
inv = funExt ve-re , funExt re-ve
|
||||||
|
iso : Σ A P ≅ Σ A Q
|
||||||
|
iso = f , g , inv
|
||||||
|
res : Σ A P ≃ Σ A Q
|
||||||
|
res = fromIsomorphism _ _ iso
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
||||||
|
-- Equivalence is equivalent to isomorphism when the domain and codomain of
|
||||||
|
-- the equivalence is a set.
|
||||||
|
equivSetIso : isSet A → isSet B → (f : A → B)
|
||||||
|
→ isEquiv A B f ≃ Isomorphism f
|
||||||
|
equivSetIso sA sB f =
|
||||||
|
let
|
||||||
|
obv : isEquiv A B f → Isomorphism f
|
||||||
|
obv = toIso A B
|
||||||
|
inv : Isomorphism f → isEquiv A B f
|
||||||
|
inv = fromIso A B
|
||||||
|
re-ve : (x : isEquiv A B f) → (inv ∘ obv) x ≡ x
|
||||||
|
re-ve = inverse-from-to-iso A B
|
||||||
|
ve-re : (x : Isomorphism f) → (obv ∘ inv) x ≡ x
|
||||||
|
ve-re = inverse-to-from-iso A B sA sB
|
||||||
|
iso : isEquiv A B f ≅ Isomorphism f
|
||||||
|
iso = obv , inv , funExt re-ve , funExt ve-re
|
||||||
|
in fromIsomorphism _ _ iso
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {P : A → Set ℓb} where
|
||||||
|
-- Equivalence of pairs whose first components are identitical can be obtained
|
||||||
|
-- from an equivalence of their seecond components.
|
||||||
|
equivSig : {ℓc : Level} {Q : A → Set ℓc}
|
||||||
|
→ ((a : A) → P a ≃ Q a) → Σ A P ≃ Σ A Q
|
||||||
|
equivSig {Q = Q} eA = res
|
||||||
|
where
|
||||||
|
P≅Q : ∀ {a} → P a ≅ Q a
|
||||||
|
P≅Q {a} = toIsomorphism _ _ (eA a)
|
||||||
|
f : Σ A P → Σ A Q
|
||||||
|
f (a , pA) = a , fst P≅Q pA
|
||||||
|
g : Σ A Q → Σ A P
|
||||||
|
g (a , qA) = a , fst (snd P≅Q) qA
|
||||||
|
ve-re : (x : Σ A P) → (g ∘ f) x ≡ x
|
||||||
|
ve-re (a , pA) i = a , eq i
|
||||||
|
where
|
||||||
|
eq : snd ((g ∘ f) (a , pA)) ≡ pA
|
||||||
|
eq = begin
|
||||||
|
snd ((g ∘ f) (a , pA)) ≡⟨⟩
|
||||||
|
snd (g (f (a , pA))) ≡⟨⟩
|
||||||
|
g' (fst (eA a) pA) ≡⟨ lem ⟩
|
||||||
|
pA ∎
|
||||||
|
where
|
||||||
|
open Σ (snd P≅Q) renaming (fst to g' ; snd to inv)
|
||||||
|
-- anti-funExt
|
||||||
|
lem : (g' ∘ (fst (eA a))) pA ≡ pA
|
||||||
|
lem = cong (_$ pA) (fst (snd (snd P≅Q)))
|
||||||
|
re-ve : (x : Σ A Q) → (f ∘ g) x ≡ x
|
||||||
|
re-ve x i = fst x , eq i
|
||||||
|
where
|
||||||
|
open Σ x renaming (fst to a ; snd to qA)
|
||||||
|
eq = begin
|
||||||
|
snd ((f ∘ g) x) ≡⟨⟩
|
||||||
|
fst (eA a) (g' qA) ≡⟨ (λ i → snd inv i qA) ⟩
|
||||||
|
qA ∎
|
||||||
|
where
|
||||||
|
k : Isomorphism _
|
||||||
|
k = toIso _ _ (snd (eA a))
|
||||||
|
open Σ k renaming (fst to g' ; snd to inv)
|
||||||
|
inv : AreInverses f g
|
||||||
|
inv = funExt ve-re , funExt re-ve
|
||||||
|
iso : Σ A P ≅ Σ A Q
|
||||||
|
iso = f , g , inv
|
||||||
|
res : Σ A P ≃ Σ A Q
|
||||||
|
res = fromIsomorphism _ _ iso
|
142
src/Cat/Prelude.agda
Normal file
142
src/Cat/Prelude.agda
Normal file
|
@ -0,0 +1,142 @@
|
||||||
|
-- | Custom prelude for this module
|
||||||
|
module Cat.Prelude where
|
||||||
|
|
||||||
|
open import Agda.Primitive public
|
||||||
|
-- FIXME Use:
|
||||||
|
open import Agda.Builtin.Sigma public
|
||||||
|
-- Rather than
|
||||||
|
open import Data.Product public
|
||||||
|
renaming (∃! to ∃!≈)
|
||||||
|
using (_×_ ; Σ-syntax ; swap)
|
||||||
|
|
||||||
|
open import Function using (_∘_ ; _∘′_ ; _$_ ; case_of_ ; flip) public
|
||||||
|
|
||||||
|
idFun : ∀ {a} (A : Set a) → A → A
|
||||||
|
idFun A a = a
|
||||||
|
|
||||||
|
open import Cubical public
|
||||||
|
-- FIXME rename `gradLemma` to `fromIsomorphism` - perhaps just use wrapper
|
||||||
|
-- module.
|
||||||
|
open import Cubical.GradLemma
|
||||||
|
using (gradLemma)
|
||||||
|
public
|
||||||
|
open import Cubical.NType
|
||||||
|
using (⟨-2⟩ ; ⟨-1⟩ ; ⟨0⟩ ; TLevel ; HasLevel ; isGrpd)
|
||||||
|
public
|
||||||
|
open import Cubical.NType.Properties
|
||||||
|
using
|
||||||
|
( lemPropF ; lemSig ; lemSigP ; isSetIsProp
|
||||||
|
; propPi ; propPiImpl ; propHasLevel ; setPi ; propSet
|
||||||
|
; propSig ; equivPreservesNType)
|
||||||
|
public
|
||||||
|
|
||||||
|
propIsContr : {ℓ : Level} → {A : Set ℓ} → isProp (isContr A)
|
||||||
|
propIsContr = propHasLevel ⟨-2⟩
|
||||||
|
|
||||||
|
open import Cubical.Sigma using (setSig ; sigPresSet ; sigPresNType) public
|
||||||
|
|
||||||
|
module _ (ℓ : Level) where
|
||||||
|
-- FIXME Ask if we can push upstream.
|
||||||
|
-- A redefinition of `Cubical.Universe` with an explicit parameter
|
||||||
|
_-type : TLevel → Set (lsuc ℓ)
|
||||||
|
n -type = Σ (Set ℓ) (HasLevel n)
|
||||||
|
|
||||||
|
hSet : Set (lsuc ℓ)
|
||||||
|
hSet = ⟨0⟩ -type
|
||||||
|
|
||||||
|
hProp : Set (lsuc ℓ)
|
||||||
|
hProp = ⟨-1⟩ -type
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
-- * Utilities --
|
||||||
|
-----------------
|
||||||
|
|
||||||
|
-- | Unique existentials.
|
||||||
|
∃! : ∀ {a b} {A : Set a}
|
||||||
|
→ (A → Set b) → Set (a ⊔ b)
|
||||||
|
∃! = ∃!≈ _≡_
|
||||||
|
|
||||||
|
∃!-syntax : ∀ {a b} {A : Set a} → (A → Set b) → Set (a ⊔ b)
|
||||||
|
∃!-syntax = ∃!
|
||||||
|
|
||||||
|
syntax ∃!-syntax (λ x → B) = ∃![ x ] B
|
||||||
|
|
||||||
|
module _ {ℓa ℓb} {A : Set ℓa} {P : A → Set ℓb} (f g : ∃! P) where
|
||||||
|
∃-unique : fst f ≡ fst g
|
||||||
|
∃-unique = (snd (snd f)) (fst (snd g))
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : A → Set ℓb} {a b : Σ A B}
|
||||||
|
(fst≡ : (λ _ → A) [ fst a ≡ fst b ])
|
||||||
|
(snd≡ : (λ i → B (fst≡ i)) [ snd a ≡ snd b ]) where
|
||||||
|
|
||||||
|
Σ≡ : a ≡ b
|
||||||
|
fst (Σ≡ i) = fst≡ i
|
||||||
|
snd (Σ≡ i) = snd≡ i
|
||||||
|
|
||||||
|
import Relation.Binary
|
||||||
|
open Relation.Binary public using
|
||||||
|
( Preorder ; Transitive ; IsEquivalence ; Rel
|
||||||
|
; Setoid )
|
||||||
|
|
||||||
|
equalityIsEquivalence : {ℓ : Level} {A : Set ℓ} → IsEquivalence {A = A} _≡_
|
||||||
|
IsEquivalence.refl equalityIsEquivalence = refl
|
||||||
|
IsEquivalence.sym equalityIsEquivalence = sym
|
||||||
|
IsEquivalence.trans equalityIsEquivalence = trans
|
||||||
|
|
||||||
|
IsPreorder
|
||||||
|
: {a ℓ : Level} {A : Set a}
|
||||||
|
→ (_∼_ : Rel A ℓ) -- The relation.
|
||||||
|
→ Set _
|
||||||
|
IsPreorder _~_ = Relation.Binary.IsPreorder _≡_ _~_
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A : Set ℓ} {a : A} where
|
||||||
|
-- FIXME rename to `coe-neutral`
|
||||||
|
id-coe : coe refl a ≡ a
|
||||||
|
id-coe = begin
|
||||||
|
coe refl a ≡⟨⟩
|
||||||
|
pathJ (λ y x → A) _ A refl ≡⟨ pathJprop {x = a} (λ y x → A) _ ⟩
|
||||||
|
_ ≡⟨ pathJprop {x = a} (λ y x → A) _ ⟩
|
||||||
|
a ∎
|
||||||
|
|
||||||
|
module _ {ℓ : Level} {A : Set ℓ} where
|
||||||
|
open import Cubical.NType
|
||||||
|
open import Data.Nat using (_≤′_ ; ≤′-refl ; ≤′-step ; zero ; suc)
|
||||||
|
open import Cubical.NType.Properties
|
||||||
|
ntypeCumulative : ∀ {n m} → n ≤′ m → HasLevel ⟨ n ⟩₋₂ A → HasLevel ⟨ m ⟩₋₂ A
|
||||||
|
ntypeCumulative {m} ≤′-refl lvl = lvl
|
||||||
|
ntypeCumulative {n} {suc m} (≤′-step le) lvl = HasLevel+1 ⟨ m ⟩₋₂ (ntypeCumulative le lvl)
|
||||||
|
|
||||||
|
grpdPi : {ℓb : Level} {B : A → Set ℓb}
|
||||||
|
→ ((a : A) → isGrpd (B a)) → isGrpd ((a : A) → (B a))
|
||||||
|
grpdPi = piPresNType (S (S (S ⟨-2⟩)))
|
||||||
|
|
||||||
|
grpdPiImpl : {ℓb : Level} {B : A → Set ℓb}
|
||||||
|
→ ({a : A} → isGrpd (B a)) → isGrpd ({a : A} → (B a))
|
||||||
|
grpdPiImpl {B = B} g = equivPreservesNType {A = Expl} {B = Impl} {n = one} e (grpdPi (λ a → g))
|
||||||
|
where
|
||||||
|
one = (S (S (S ⟨-2⟩)))
|
||||||
|
t : ({a : A} → HasLevel one (B a))
|
||||||
|
t = g
|
||||||
|
Impl = {a : A} → B a
|
||||||
|
Expl = (a : A) → B a
|
||||||
|
expl : Impl → Expl
|
||||||
|
expl f a = f {a}
|
||||||
|
impl : Expl → Impl
|
||||||
|
impl f {a} = f a
|
||||||
|
e : Expl ≃ Impl
|
||||||
|
e = impl , (gradLemma impl expl (λ f → refl) (λ f → refl))
|
||||||
|
|
||||||
|
setGrpd : isSet A → isGrpd A
|
||||||
|
setGrpd = ntypeCumulative
|
||||||
|
{suc (suc zero)} {suc (suc (suc zero))}
|
||||||
|
(≤′-step ≤′-refl)
|
||||||
|
|
||||||
|
propGrpd : isProp A → isGrpd A
|
||||||
|
propGrpd = ntypeCumulative
|
||||||
|
{suc zero} {suc (suc (suc zero))}
|
||||||
|
(≤′-step (≤′-step ≤′-refl))
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : A → Set ℓb} where
|
||||||
|
open TLevel
|
||||||
|
grpdSig : isGrpd A → (∀ a → isGrpd (B a)) → isGrpd (Σ A B)
|
||||||
|
grpdSig = sigPresNType {n = S (S (S ⟨-2⟩))}
|
|
@ -1,41 +0,0 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
|
||||||
module Cat.Wishlist where
|
|
||||||
|
|
||||||
open import Level hiding (suc)
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType
|
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s ; zero ; suc)
|
|
||||||
open import Agda.Builtin.Sigma
|
|
||||||
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
step : ∀ {ℓ} {A : Set ℓ} → isContr A → (x y : A) → isContr (x ≡ y)
|
|
||||||
step (a , contr) x y = {!p , c!}
|
|
||||||
-- where
|
|
||||||
-- p : x ≡ y
|
|
||||||
-- p = begin
|
|
||||||
-- x ≡⟨ sym (contr x) ⟩
|
|
||||||
-- a ≡⟨ contr y ⟩
|
|
||||||
-- y ∎
|
|
||||||
-- c : (q : x ≡ y) → p ≡ q
|
|
||||||
-- c q i j = contr (p {!!}) {!!}
|
|
||||||
|
|
||||||
-- Contractible types have any given homotopy level.
|
|
||||||
contrInitial : {ℓ : Level} {A : Set ℓ} → ∀ n → isContr A → HasLevel n A
|
|
||||||
contrInitial ⟨-2⟩ contr = contr
|
|
||||||
-- lem' (S ⟨-2⟩) (a , contr) = {!step!}
|
|
||||||
contrInitial (S ⟨-2⟩) (a , contr) x y = begin
|
|
||||||
x ≡⟨ sym (contr x) ⟩
|
|
||||||
a ≡⟨ contr y ⟩
|
|
||||||
y ∎
|
|
||||||
contrInitial (S (S n)) contr x y = {!lvl!} -- Why is this not well-founded?
|
|
||||||
where
|
|
||||||
c : isContr (x ≡ y)
|
|
||||||
c = step contr x y
|
|
||||||
lvl : HasLevel (S n) (x ≡ y)
|
|
||||||
lvl = contrInitial {A = x ≡ y} (S n) c
|
|
||||||
|
|
||||||
module _ {ℓ : Level} {A : Set ℓ} where
|
|
||||||
ntypeCommulative : ∀ {n m} → n ≤ m → HasLevel ⟨ n ⟩₋₂ A → HasLevel ⟨ m ⟩₋₂ A
|
|
||||||
ntypeCommulative {n = zero} {m} z≤n lvl = {!contrInitial ⟨ m ⟩₋₂ lvl!}
|
|
||||||
ntypeCommulative {n = .(suc _)} {.(suc _)} (s≤s x) lvl = {!!}
|
|
Loading…
Reference in a new issue