Compare commits
361 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
|
||||||
|
|
41
BACKLOG.md
41
BACKLOG.md
|
@ -1,6 +1,43 @@
|
||||||
Backlog
|
Backlog
|
||||||
=======
|
=======
|
||||||
|
|
||||||
Prove univalence for various categories
|
Prove univalence for the category of
|
||||||
|
* functors and natural transformations
|
||||||
|
|
||||||
Prove postulates in `Cat.Wishlist`
|
In AreInverses, dont use the "point-free" version. I.e.:
|
||||||
|
|
||||||
|
`∀ 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 ✓
|
||||||
|
* Applicative Functor ✗
|
||||||
|
* Lax monoidal functor ✗
|
||||||
|
* Monoidal functor ✗
|
||||||
|
* Tensorial strength ✗
|
||||||
|
* Category ✓
|
||||||
|
* Monoidal category ✗
|
||||||
|
* Monad
|
||||||
|
* Monoidal monad ✓
|
||||||
|
* Kleisli monad ✓
|
||||||
|
* Kleisli ≃ Monoidal ✓
|
||||||
|
* Problem 2.3 in [voe] ✓
|
||||||
|
* 1st contruction ~ monoidal ✓
|
||||||
|
* 2nd contruction ~ klesli ✓
|
||||||
|
* 1st ≃ 2nd ✓
|
||||||
|
|
108
CHANGELOG.md
108
CHANGELOG.md
|
@ -1,6 +1,114 @@
|
||||||
Change log
|
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
|
||||||
|
-------------
|
||||||
|
Adds documentation to a number of modules.
|
||||||
|
|
||||||
|
Adds an "equality principle" for categories and monads.
|
||||||
|
|
||||||
|
Prove that `IsMonad` is a mere proposition.
|
||||||
|
|
||||||
|
Provides the yoneda embedding without relying on the existence of a category of
|
||||||
|
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.
|
||||||
|
|
||||||
|
Renames functors object map and arrow map to `omap` and `fmap`.
|
||||||
|
|
||||||
|
Prove that Kleisli- and monoidal- monads are equivalent!
|
||||||
|
|
||||||
|
[WIP] Started working on the proofs for univalence for the category of sets and
|
||||||
|
the category of functors.
|
||||||
|
|
||||||
|
Version 1.3.0
|
||||||
|
-------------
|
||||||
|
Removed unused modules and streamlined things more: All specific categories are
|
||||||
|
in the name space `Cat.Categories`.
|
||||||
|
|
||||||
|
Lemmas about categories are now in the appropriate record e.g. `IsCategory`.
|
||||||
|
Also changed how category reexports stuff.
|
||||||
|
|
||||||
|
Rename the module Properties to Yoneda - because that's all it talks about now.
|
||||||
|
|
||||||
|
Rename Opposite to opposite
|
||||||
|
|
||||||
|
Add documentation in Category-module
|
||||||
|
|
||||||
|
Formulation of monads in two ways; the "monoidal-" and "Kleisli-" form.
|
||||||
|
|
||||||
|
WIP: Equivalence of these two formulations
|
||||||
|
|
||||||
|
Also use hSets in a few concrete categories rather than just pure `Set`.
|
||||||
|
|
||||||
|
Version 1.2.0
|
||||||
|
-------------
|
||||||
|
This version is mainly a huge refactor.
|
||||||
|
|
||||||
|
I've renamed
|
||||||
|
|
||||||
|
* `distrib` to `isDistributive`
|
||||||
|
* `arrowIsSet` to `arrowsAreSets`
|
||||||
|
* `ident` to `isIdentity`
|
||||||
|
* `assoc` to `isAssociative`
|
||||||
|
|
||||||
|
And added "type-synonyms" for all of these. Their names should now match their
|
||||||
|
type. So e.g. `isDistributive` has type `IsDistributive`.
|
||||||
|
|
||||||
|
I've also changed how names are exported in `Functor` to be in line with
|
||||||
|
`Category`.
|
||||||
|
|
||||||
Version 1.1.0
|
Version 1.1.0
|
||||||
-------------
|
-------------
|
||||||
In this version categories have been refactored - there's now a notion of a raw
|
In this version categories have been refactored - there's now a notion of a raw
|
||||||
|
|
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
|
||||||
|
|
50
README.md
50
README.md
|
@ -7,30 +7,46 @@ This project aims to formalize some parts of category theory using cubical agda
|
||||||
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:
|
||||||
|
|
||||||
* Agda version >= `707ce6042b6a3bdb26521f3fe8dfe5d8a8470a43`.
|
* The master branch of Agda.
|
||||||
* [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/)
|
||||||
|
|
||||||
It's important to have the right version of these - but which one is the right
|
Has been tested with:
|
||||||
is in constant flux. It's most likely the newest one.
|
|
||||||
|
|
||||||
I've used git submodules to manage dependencies. Unfortunately Agda does not
|
* Agda version 2.6.0-d3efe64
|
||||||
allow specifying libraries to be used only as local dependencies. So the
|
|
||||||
submodules are mostly used for documentation.
|
|
||||||
|
|
||||||
You can let Agda know about these libraries by appending them to your global
|
Building
|
||||||
libraries file like so: (NB!: There is a good reason this is not in a
|
========
|
||||||
makefile. So please verify that you know what you are doing, you probably
|
You can build the library with
|
||||||
already have standard-library in you libraries)
|
|
||||||
|
|
||||||
AGDA_LIB=~/.agda
|
git submodule update --init
|
||||||
readlink -f libs/*/*.agda-lib | tee -a $AGDA_LIB/libraries
|
make
|
||||||
|
|
||||||
Anyways, assuming you have this set up you should be good to go.
|
The Makefile takes care of using the right dependencies.
|
||||||
|
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:
|
||||||
|
|
||||||
|
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 87d28d7d753f73abd20665d7bbb88f9d72ed88aa
|
Subproject commit ac331fc38ca05f85dfebc57eb1259ba2ea0e50d5
|
|
@ -1 +1 @@
|
||||||
Subproject commit 9bfbacbb30d4673332566f6e4a58fd04e3904106
|
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}
|
|
||||||
}
|
|
35
src/Cat.agda
35
src/Cat.agda
|
@ -1,19 +1,24 @@
|
||||||
module Cat where
|
module Cat where
|
||||||
|
|
||||||
import Cat.Category
|
open import Cat.Category
|
||||||
import Cat.CwF
|
|
||||||
|
|
||||||
import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
import Cat.Category.Exponential
|
open import Cat.Category.Exponential
|
||||||
import Cat.Category.CartesianClosed
|
open import Cat.Category.CartesianClosed
|
||||||
import Cat.Category.Pathy
|
open import Cat.Category.NaturalTransformation
|
||||||
import Cat.Category.Bij
|
open import Cat.Category.Yoneda
|
||||||
import Cat.Category.Properties
|
open import Cat.Category.Monoid
|
||||||
|
open import Cat.Category.Monad
|
||||||
|
open import Cat.Category.Monad.Monoidal
|
||||||
|
open import Cat.Category.Monad.Kleisli
|
||||||
|
open import Cat.Category.Monad.Voevodsky
|
||||||
|
|
||||||
import Cat.Categories.Sets
|
open import Cat.Categories.Opposite
|
||||||
-- import Cat.Categories.Cat
|
open import Cat.Categories.Sets
|
||||||
import Cat.Categories.Rel
|
open import Cat.Categories.Cat
|
||||||
import Cat.Categories.Free
|
open import Cat.Categories.Rel
|
||||||
import Cat.Categories.Fun
|
open import Cat.Categories.Free
|
||||||
import Cat.Categories.Cube
|
open import Cat.Categories.Fun
|
||||||
|
-- open import Cat.Categories.Cube
|
||||||
|
open import Cat.Categories.CwF
|
||||||
|
|
|
@ -3,400 +3,321 @@
|
||||||
|
|
||||||
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 Cubical
|
|
||||||
open import Function
|
|
||||||
open import Data.Product renaming (proj₁ to fst ; proj₂ to snd)
|
|
||||||
|
|
||||||
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
|
open import Cat.Category.Exponential hiding (_×_ ; product)
|
||||||
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Equality
|
open import Cat.Categories.Fun
|
||||||
open Equality.Data.Product
|
|
||||||
|
|
||||||
open Functor
|
|
||||||
open IsFunctor
|
|
||||||
open Category hiding (_∘_)
|
|
||||||
|
|
||||||
-- The category of categories
|
-- The category of categories
|
||||||
module _ (ℓ ℓ' : Level) where
|
module _ (ℓ ℓ' : Level) where
|
||||||
private
|
|
||||||
module _ {𝔸 𝔹 ℂ 𝔻 : Category ℓ ℓ'} {F : Functor 𝔸 𝔹} {G : Functor 𝔹 ℂ} {H : Functor ℂ 𝔻} where
|
|
||||||
private
|
|
||||||
eq* : func* (H ∘f (G ∘f F)) ≡ func* ((H ∘f G) ∘f F)
|
|
||||||
eq* = refl
|
|
||||||
eq→ : PathP
|
|
||||||
(λ i → {A B : Object 𝔸} → 𝔸 [ A , B ] → 𝔻 [ eq* i A , eq* i B ])
|
|
||||||
(func→ (H ∘f (G ∘f F))) (func→ ((H ∘f G) ∘f F))
|
|
||||||
eq→ = refl
|
|
||||||
postulate
|
|
||||||
eqI
|
|
||||||
: (λ i → ∀ {A : Object 𝔸} → eq→ i (𝟙 𝔸 {A}) ≡ 𝟙 𝔻 {eq* i A})
|
|
||||||
[ (H ∘f (G ∘f F)) .isFunctor .ident
|
|
||||||
≡ ((H ∘f G) ∘f F) .isFunctor .ident
|
|
||||||
]
|
|
||||||
eqD
|
|
||||||
: (λ i → ∀ {A B C} {f : 𝔸 [ A , B ]} {g : 𝔸 [ B , C ]}
|
|
||||||
→ eq→ i (𝔸 [ g ∘ f ]) ≡ 𝔻 [ eq→ i g ∘ eq→ i f ])
|
|
||||||
[ (H ∘f (G ∘f F)) .isFunctor .distrib
|
|
||||||
≡ ((H ∘f G) ∘f F) .isFunctor .distrib
|
|
||||||
]
|
|
||||||
|
|
||||||
assc : H ∘f (G ∘f F) ≡ (H ∘f G) ∘f F
|
|
||||||
assc = Functor≡ eq* eq→ (IsFunctor≡ eqI eqD)
|
|
||||||
|
|
||||||
module _ {ℂ 𝔻 : Category ℓ ℓ'} {F : Functor ℂ 𝔻} where
|
|
||||||
module _ where
|
|
||||||
private
|
|
||||||
eq* : (func* F) ∘ (func* (identity {C = ℂ})) ≡ func* F
|
|
||||||
eq* = refl
|
|
||||||
-- lemmm : func→ {C = A} {D = B} (f ∘f identity) ≡ func→ f
|
|
||||||
eq→ : PathP
|
|
||||||
(λ i →
|
|
||||||
{x y : Object ℂ} → Arrow ℂ x y → Arrow 𝔻 (func* F x) (func* F y))
|
|
||||||
(func→ (F ∘f identity)) (func→ F)
|
|
||||||
eq→ = refl
|
|
||||||
postulate
|
|
||||||
eqI-r
|
|
||||||
: (λ i → {c : Object ℂ} → (λ _ → 𝔻 [ func* F c , func* F c ])
|
|
||||||
[ func→ F (𝟙 ℂ) ≡ 𝟙 𝔻 ])
|
|
||||||
[(F ∘f identity) .isFunctor .ident ≡ F .isFunctor .ident ]
|
|
||||||
eqD-r : PathP
|
|
||||||
(λ i →
|
|
||||||
{A B C : Object ℂ} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]} →
|
|
||||||
eq→ i (ℂ [ g ∘ f ]) ≡ 𝔻 [ eq→ i g ∘ eq→ i f ])
|
|
||||||
((F ∘f identity) .isFunctor .distrib) (F .isFunctor .distrib)
|
|
||||||
ident-r : F ∘f identity ≡ F
|
|
||||||
ident-r = Functor≡ eq* eq→ (IsFunctor≡ eqI-r eqD-r)
|
|
||||||
module _ where
|
|
||||||
private
|
|
||||||
postulate
|
|
||||||
eq* : (identity ∘f F) .func* ≡ F .func*
|
|
||||||
eq→ : PathP
|
|
||||||
(λ i → {x y : Object ℂ} → ℂ [ x , y ] → 𝔻 [ eq* i x , eq* i y ])
|
|
||||||
((identity ∘f F) .func→) (F .func→)
|
|
||||||
eqI : (λ i → ∀ {A : Object ℂ} → eq→ i (𝟙 ℂ {A}) ≡ 𝟙 𝔻 {eq* i A})
|
|
||||||
[ ((identity ∘f F) .isFunctor .ident) ≡ (F .isFunctor .ident) ]
|
|
||||||
eqD : PathP (λ i → {A B C : Object ℂ} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
|
||||||
→ eq→ i (ℂ [ g ∘ f ]) ≡ 𝔻 [ eq→ i g ∘ eq→ i f ])
|
|
||||||
((identity ∘f F) .isFunctor .distrib) (F .isFunctor .distrib)
|
|
||||||
-- (λ z → eq* i z) (eq→ i)
|
|
||||||
ident-l : identity ∘f F ≡ F
|
|
||||||
ident-l = Functor≡ eq* eq→ λ i → record { ident = eqI i ; distrib = eqD i }
|
|
||||||
|
|
||||||
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_
|
|
||||||
-- What gives here? Why can I not name the variables directly?
|
|
||||||
-- ; isCategory = record
|
|
||||||
-- { assoc = λ {_ _ _ _ F G H} → assc {F = F} {G = G} {H = H}
|
|
||||||
-- ; ident = ident-r , ident-l
|
|
||||||
-- }
|
|
||||||
}
|
|
||||||
open IsCategory
|
|
||||||
instance
|
|
||||||
:isCategory: : IsCategory RawCat
|
|
||||||
assoc :isCategory: {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
|
|
||||||
ident :isCategory: = ident-r , ident-l
|
|
||||||
arrow-is-set :isCategory: = {!!}
|
|
||||||
univalent :isCategory: = {!!}
|
|
||||||
|
|
||||||
Cat : Category (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
|
||||||
raw Cat = RawCat
|
-- however, form a groupoid! Therefore there is no (1-)category of
|
||||||
|
-- categories. There does, however, exist a 2-category of 1-categories.
|
||||||
|
--
|
||||||
|
-- Because of this there is no category of categories.
|
||||||
|
Cat : (unprovable : IsCategory RawCat) → Category (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
||||||
|
Category.raw (Cat _) = RawCat
|
||||||
|
Category.isCategory (Cat unprovable) = unprovable
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} where
|
-- | In the following we will pretend there is a category of categories when
|
||||||
module _ (ℂ 𝔻 : Category ℓ ℓ') where
|
-- e.g. talking about it being cartesian closed. It still makes sense to
|
||||||
|
-- construct these things even though that category does not exist.
|
||||||
|
--
|
||||||
|
-- If the notion of a category is later generalized to work on different
|
||||||
|
-- homotopy levels, then the proof that the category of categories is cartesian
|
||||||
|
-- closed will follow immediately from these constructions.
|
||||||
|
|
||||||
|
-- | the category of categories have products.
|
||||||
|
module CatProduct {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
private
|
private
|
||||||
Catt = Cat ℓ ℓ'
|
module ℂ = Category ℂ
|
||||||
:Object: = Object ℂ × Object 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
:Arrow: : :Object: → :Object: → Set ℓ'
|
|
||||||
:Arrow: (c , d) (c' , d') = Arrow ℂ c c' × Arrow 𝔻 d d'
|
|
||||||
:𝟙: : {o : :Object:} → :Arrow: o o
|
|
||||||
:𝟙: = 𝟙 ℂ , 𝟙 𝔻
|
|
||||||
_:⊕:_ :
|
|
||||||
{a b c : :Object:} →
|
|
||||||
:Arrow: b c →
|
|
||||||
:Arrow: a b →
|
|
||||||
:Arrow: a c
|
|
||||||
_:⊕:_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
|
||||||
|
|
||||||
:rawProduct: : RawCategory ℓ ℓ'
|
module _ where
|
||||||
RawCategory.Object :rawProduct: = :Object:
|
private
|
||||||
RawCategory.Arrow :rawProduct: = :Arrow:
|
Obj = ℂ.Object × 𝔻.Object
|
||||||
RawCategory.𝟙 :rawProduct: = :𝟙:
|
Arr : Obj → Obj → Set ℓ'
|
||||||
RawCategory._∘_ :rawProduct: = _:⊕:_
|
Arr (c , d) (c' , d') = ℂ [ c , c' ] × 𝔻 [ d , d' ]
|
||||||
|
identity : {o : Obj} → Arr o o
|
||||||
|
identity = ℂ.identity , 𝔻.identity
|
||||||
|
_<<<_ :
|
||||||
|
{a b c : Obj} →
|
||||||
|
Arr b c →
|
||||||
|
Arr a b →
|
||||||
|
Arr a c
|
||||||
|
_<<<_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
||||||
|
|
||||||
module C = IsCategory (ℂ .isCategory)
|
rawProduct : RawCategory ℓ ℓ'
|
||||||
module D = IsCategory (𝔻 .isCategory)
|
RawCategory.Object rawProduct = Obj
|
||||||
postulate
|
RawCategory.Arrow rawProduct = Arr
|
||||||
issSet : {A B : RawCategory.Object :rawProduct:} → isSet (RawCategory.Arrow :rawProduct: A B)
|
RawCategory.identity rawProduct = identity
|
||||||
instance
|
RawCategory._<<<_ rawProduct = _<<<_
|
||||||
:isCategory: : IsCategory :rawProduct:
|
|
||||||
-- :isCategory: = record
|
|
||||||
-- { assoc = Σ≡ C.assoc D.assoc
|
|
||||||
-- ; ident
|
|
||||||
-- = Σ≡ (fst C.ident) (fst D.ident)
|
|
||||||
-- , Σ≡ (snd C.ident) (snd D.ident)
|
|
||||||
-- ; arrow-is-set = issSet
|
|
||||||
-- ; univalent = {!!}
|
|
||||||
-- }
|
|
||||||
IsCategory.assoc :isCategory: = Σ≡ C.assoc D.assoc
|
|
||||||
IsCategory.ident :isCategory:
|
|
||||||
= Σ≡ (fst C.ident) (fst D.ident)
|
|
||||||
, Σ≡ (snd C.ident) (snd D.ident)
|
|
||||||
IsCategory.arrow-is-set :isCategory: = issSet
|
|
||||||
IsCategory.univalent :isCategory: = {!!}
|
|
||||||
|
|
||||||
:product: : Category ℓ ℓ'
|
open RawCategory rawProduct
|
||||||
raw :product: = :rawProduct:
|
|
||||||
|
|
||||||
proj₁ : Catt [ :product: , ℂ ]
|
arrowsAreSets : ArrowsAreSets
|
||||||
proj₁ = record { func* = fst ; func→ = fst ; isFunctor = record { ident = refl ; distrib = refl } }
|
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
||||||
|
isIdentity : IsIdentity identity
|
||||||
|
isIdentity
|
||||||
|
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
||||||
|
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
||||||
|
|
||||||
proj₂ : Catt [ :product: , 𝔻 ]
|
isPreCategory : IsPreCategory rawProduct
|
||||||
proj₂ = record { func* = snd ; func→ = snd ; isFunctor = record { ident = refl ; distrib = refl } }
|
IsPreCategory.isAssociative isPreCategory = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCategory = isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
|
|
||||||
module _ {X : Object Catt} (x₁ : Catt [ X , ℂ ]) (x₂ : Catt [ X , 𝔻 ]) where
|
postulate univalent : Univalence.Univalent isIdentity
|
||||||
open Functor
|
|
||||||
|
|
||||||
postulate x : Functor X :product:
|
isCategory : IsCategory rawProduct
|
||||||
-- x = record
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
-- { func* = λ x → x₁ .func* x , x₂ .func* x
|
IsCategory.univalent isCategory = univalent
|
||||||
-- ; func→ = λ x → func→ x₁ x , func→ x₂ x
|
|
||||||
-- ; isFunctor = record
|
|
||||||
-- { ident = Σ≡ x₁.ident x₂.ident
|
|
||||||
-- ; distrib = Σ≡ x₁.distrib x₂.distrib
|
|
||||||
-- }
|
|
||||||
-- }
|
|
||||||
-- where
|
|
||||||
-- open module x₁ = IsFunctor (x₁ .isFunctor)
|
|
||||||
-- open module x₂ = IsFunctor (x₂ .isFunctor)
|
|
||||||
|
|
||||||
-- Turned into postulate after:
|
object : Category ℓ ℓ'
|
||||||
-- > commit e8215b2c051062c6301abc9b3f6ec67106259758 (HEAD -> dev, github/dev)
|
Category.raw object = rawProduct
|
||||||
-- > Author: Frederik Hanghøj Iversen <fhi.1990@gmail.com>
|
Category.isCategory object = isCategory
|
||||||
-- > Date: Mon Feb 5 14:59:53 2018 +0100
|
|
||||||
postulate isUniqL : Catt [ proj₁ ∘ x ] ≡ x₁
|
|
||||||
-- isUniqL = Functor≡ eq* eq→ {!!}
|
|
||||||
-- where
|
|
||||||
-- eq* : (Catt [ proj₁ ∘ x ]) .func* ≡ x₁ .func*
|
|
||||||
-- eq* = {!refl!}
|
|
||||||
-- eq→ : (λ i → {A : Object X} {B : Object X} → X [ A , B ] → ℂ [ eq* i A , eq* i B ])
|
|
||||||
-- [ (Catt [ proj₁ ∘ x ]) .func→ ≡ x₁ .func→ ]
|
|
||||||
-- eq→ = refl
|
|
||||||
-- postulate eqIsF : (Catt [ proj₁ ∘ x ]) .isFunctor ≡ x₁ .isFunctor
|
|
||||||
-- eqIsF = IsFunctor≡ {!refl!} {!!}
|
|
||||||
|
|
||||||
postulate isUniqR : Catt [ proj₂ ∘ x ] ≡ x₂
|
fstF : Functor object ℂ
|
||||||
-- isUniqR = Functor≡ refl refl {!!} {!!}
|
fstF = record
|
||||||
|
{ raw = record
|
||||||
|
{ omap = fst ; fmap = fst }
|
||||||
|
; isFunctor = record
|
||||||
|
{ isIdentity = refl ; isDistributive = refl }
|
||||||
|
}
|
||||||
|
|
||||||
isUniq : Catt [ proj₁ ∘ x ] ≡ x₁ × Catt [ proj₂ ∘ x ] ≡ x₂
|
sndF : Functor object 𝔻
|
||||||
|
sndF = record
|
||||||
|
{ raw = record
|
||||||
|
{ omap = snd ; fmap = snd }
|
||||||
|
; isFunctor = record
|
||||||
|
{ isIdentity = refl ; isDistributive = refl }
|
||||||
|
}
|
||||||
|
|
||||||
|
module _ {X : Category ℓ ℓ'} (x₁ : Functor X ℂ) (x₂ : Functor X 𝔻) where
|
||||||
|
private
|
||||||
|
x : Functor X object
|
||||||
|
x = record
|
||||||
|
{ raw = record
|
||||||
|
{ omap = λ x → x₁.omap x , x₂.omap x
|
||||||
|
; fmap = λ x → x₁.fmap x , x₂.fmap x
|
||||||
|
}
|
||||||
|
; isFunctor = record
|
||||||
|
{ isIdentity = Σ≡ x₁.isIdentity x₂.isIdentity
|
||||||
|
; isDistributive = Σ≡ x₁.isDistributive x₂.isDistributive
|
||||||
|
}
|
||||||
|
}
|
||||||
|
where
|
||||||
|
open module x₁ = Functor x₁
|
||||||
|
open module x₂ = Functor x₂
|
||||||
|
|
||||||
|
isUniqL : F[ fstF ∘ x ] ≡ x₁
|
||||||
|
isUniqL = Functor≡ refl
|
||||||
|
|
||||||
|
isUniqR : F[ sndF ∘ x ] ≡ x₂
|
||||||
|
isUniqR = Functor≡ refl
|
||||||
|
|
||||||
|
isUniq : F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂
|
||||||
isUniq = isUniqL , isUniqR
|
isUniq = isUniqL , isUniqR
|
||||||
|
|
||||||
uniq : ∃![ x ] (Catt [ proj₁ ∘ x ] ≡ x₁ × Catt [ proj₂ ∘ x ] ≡ x₂)
|
isProduct : ∃![ x ] (F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂)
|
||||||
uniq = 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
|
||||||
|
private
|
||||||
|
Catℓ = Cat ℓ ℓ' unprovable
|
||||||
|
|
||||||
|
module _ (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
|
private
|
||||||
|
module P = CatProduct ℂ 𝔻
|
||||||
|
|
||||||
|
rawProduct : RawProduct Catℓ ℂ 𝔻
|
||||||
|
RawProduct.object rawProduct = P.object
|
||||||
|
RawProduct.fst rawProduct = P.fstF
|
||||||
|
RawProduct.snd rawProduct = P.sndF
|
||||||
|
|
||||||
|
isProduct : IsProduct Catℓ _ _ rawProduct
|
||||||
|
IsProduct.ump isProduct = P.isProduct
|
||||||
|
|
||||||
|
product : Product Catℓ ℂ 𝔻
|
||||||
|
Product.raw product = rawProduct
|
||||||
|
Product.isProduct product = isProduct
|
||||||
|
|
||||||
instance
|
instance
|
||||||
isProduct : IsProduct (Cat ℓ ℓ') proj₁ proj₂
|
hasProducts : HasProducts Catℓ
|
||||||
isProduct = uniq
|
|
||||||
|
|
||||||
product : Product {ℂ = (Cat ℓ ℓ')} ℂ 𝔻
|
|
||||||
product = record
|
|
||||||
{ obj = :product:
|
|
||||||
; proj₁ = proj₁
|
|
||||||
; proj₂ = proj₂
|
|
||||||
}
|
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} where
|
|
||||||
instance
|
|
||||||
hasProducts : HasProducts (Cat ℓ ℓ')
|
|
||||||
hasProducts = record { product = product }
|
hasProducts = record { product = product }
|
||||||
|
|
||||||
-- Basically proves that `Cat ℓ ℓ` is cartesian closed.
|
-- | The category of categories have expoentntials - and because it has products
|
||||||
module _ (ℓ : Level) where
|
-- it is therefory also cartesian closed.
|
||||||
|
module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ 𝔻
|
||||||
|
renaming (identity to identityNT)
|
||||||
|
using ()
|
||||||
private
|
private
|
||||||
open Data.Product
|
module ℂ = Category ℂ
|
||||||
open import Cat.Categories.Fun
|
module 𝔻 = Category 𝔻
|
||||||
|
Categoryℓ = Category ℓ ℓ
|
||||||
|
open Fun ℂ 𝔻 renaming (identity to idN)
|
||||||
|
|
||||||
Catℓ : Category (lsuc (ℓ ⊔ ℓ)) (ℓ ⊔ ℓ)
|
omap : Functor ℂ 𝔻 × ℂ.Object → 𝔻.Object
|
||||||
Catℓ = Cat ℓ ℓ
|
omap (F , A) = Functor.omap F A
|
||||||
module _ (ℂ 𝔻 : Category ℓ ℓ) where
|
|
||||||
|
-- The exponential object
|
||||||
|
object : Categoryℓ
|
||||||
|
object = Fun
|
||||||
|
|
||||||
|
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
|
||||||
:obj: : Object (Cat ℓ ℓ)
|
module F = Functor F
|
||||||
:obj: = Fun {ℂ = ℂ} {𝔻 = 𝔻}
|
module G = Functor G
|
||||||
|
|
||||||
:func*: : Functor ℂ 𝔻 × Object ℂ → Object 𝔻
|
fmap : (pobj : NaturalTransformation F G × ℂ [ A , B ])
|
||||||
:func*: (F , A) = F .func* A
|
→ 𝔻 [ F.omap A , G.omap B ]
|
||||||
|
fmap ((θ , θNat) , f) = 𝔻 [ θ B ∘ F.fmap f ]
|
||||||
|
-- Alternatively:
|
||||||
|
--
|
||||||
|
-- fmap ((θ , θNat) , f) = 𝔻 [ G.fmap f ∘ θ A ]
|
||||||
|
--
|
||||||
|
-- Since they are equal by naturality of θ.
|
||||||
|
|
||||||
module _ {dom cod : Functor ℂ 𝔻 × Object ℂ} where
|
open CatProduct renaming (object to _⊗_) using ()
|
||||||
private
|
|
||||||
F : Functor ℂ 𝔻
|
|
||||||
F = proj₁ dom
|
|
||||||
A : Object ℂ
|
|
||||||
A = proj₂ dom
|
|
||||||
|
|
||||||
G : Functor ℂ 𝔻
|
module _ {c : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
G = proj₁ cod
|
open Σ c renaming (fst to F ; snd to C)
|
||||||
B : Object ℂ
|
|
||||||
B = proj₂ cod
|
|
||||||
|
|
||||||
:func→: : (pobj : NaturalTransformation F G × ℂ [ A , B ])
|
ident : fmap {c} {c} (identityNT F , ℂ.identity {A = snd c}) ≡ 𝔻.identity
|
||||||
→ 𝔻 [ F .func* A , G .func* B ]
|
ident = begin
|
||||||
:func→: ((θ , θNat) , f) = result
|
fmap {c} {c} (Category.identity (object ⊗ ℂ) {c}) ≡⟨⟩
|
||||||
|
fmap {c} {c} (idN F , ℂ.identity) ≡⟨⟩
|
||||||
|
𝔻 [ identityTrans F C ∘ F.fmap ℂ.identity ] ≡⟨⟩
|
||||||
|
𝔻 [ 𝔻.identity ∘ F.fmap ℂ.identity ] ≡⟨ 𝔻.leftIdentity ⟩
|
||||||
|
F.fmap ℂ.identity ≡⟨ F.isIdentity ⟩
|
||||||
|
𝔻.identity ∎
|
||||||
where
|
where
|
||||||
θA : 𝔻 [ F .func* A , G .func* A ]
|
module F = Functor F
|
||||||
θA = θ A
|
|
||||||
θB : 𝔻 [ F .func* B , G .func* B ]
|
|
||||||
θB = θ B
|
|
||||||
F→f : 𝔻 [ F .func* A , F .func* B ]
|
|
||||||
F→f = F .func→ f
|
|
||||||
G→f : 𝔻 [ G .func* A , G .func* B ]
|
|
||||||
G→f = G .func→ f
|
|
||||||
l : 𝔻 [ F .func* A , G .func* B ]
|
|
||||||
l = 𝔻 [ θB ∘ F→f ]
|
|
||||||
r : 𝔻 [ F .func* A , G .func* B ]
|
|
||||||
r = 𝔻 [ G→f ∘ θA ]
|
|
||||||
-- There are two choices at this point,
|
|
||||||
-- but I suppose the whole point is that
|
|
||||||
-- by `θNat f` we have `l ≡ r`
|
|
||||||
-- lem : 𝔻 [ θ B ∘ F .func→ f ] ≡ 𝔻 [ G .func→ f ∘ θ A ]
|
|
||||||
-- lem = θNat f
|
|
||||||
result : 𝔻 [ F .func* A , G .func* B ]
|
|
||||||
result = l
|
|
||||||
|
|
||||||
_×p_ = product
|
module _ {F×A G×B H×C : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
|
open Σ F×A renaming (fst to F ; snd to A)
|
||||||
module _ {c : Functor ℂ 𝔻 × Object ℂ} where
|
open Σ G×B renaming (fst to G ; snd to B)
|
||||||
|
open Σ H×C renaming (fst to H ; snd to C)
|
||||||
private
|
private
|
||||||
F : Functor ℂ 𝔻
|
module F = Functor F
|
||||||
F = proj₁ c
|
module G = Functor G
|
||||||
C : Object ℂ
|
module H = Functor H
|
||||||
C = proj₂ c
|
|
||||||
|
|
||||||
-- NaturalTransformation F G × ℂ .Arrow A B
|
|
||||||
-- :ident: : :func→: {c} {c} (identityNat F , ℂ .𝟙) ≡ 𝔻 .𝟙
|
|
||||||
-- :ident: = trans (proj₂ 𝔻.ident) (F .ident)
|
|
||||||
-- where
|
|
||||||
-- open module 𝔻 = IsCategory (𝔻 .isCategory)
|
|
||||||
-- Unfortunately the equational version has some ambigous arguments.
|
|
||||||
:ident: : :func→: {c} {c} (identityNat F , 𝟙 ℂ {o = proj₂ c}) ≡ 𝟙 𝔻
|
|
||||||
:ident: = begin
|
|
||||||
:func→: {c} {c} (𝟙 (Product.obj (:obj: ×p ℂ)) {c}) ≡⟨⟩
|
|
||||||
:func→: {c} {c} (identityNat F , 𝟙 ℂ) ≡⟨⟩
|
|
||||||
𝔻 [ identityTrans F C ∘ F .func→ (𝟙 ℂ)] ≡⟨⟩
|
|
||||||
𝔻 [ 𝟙 𝔻 ∘ F .func→ (𝟙 ℂ)] ≡⟨ proj₂ 𝔻.ident ⟩
|
|
||||||
F .func→ (𝟙 ℂ) ≡⟨ F.ident ⟩
|
|
||||||
𝟙 𝔻 ∎
|
|
||||||
where
|
|
||||||
open module 𝔻 = IsCategory (𝔻 .isCategory)
|
|
||||||
open module F = IsFunctor (F .isFunctor)
|
|
||||||
|
|
||||||
module _ {F×A G×B H×C : Functor ℂ 𝔻 × Object ℂ} where
|
|
||||||
F = F×A .proj₁
|
|
||||||
A = F×A .proj₂
|
|
||||||
G = G×B .proj₁
|
|
||||||
B = G×B .proj₂
|
|
||||||
H = H×C .proj₁
|
|
||||||
C = H×C .proj₂
|
|
||||||
-- Not entirely clear what this is at this point:
|
|
||||||
_P⊕_ = Category._∘_ (Product.obj (:obj: ×p ℂ)) {F×A} {G×B} {H×C}
|
|
||||||
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
|
isDistributive :
|
||||||
ηθNat = proj₂ ηθNT
|
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F.fmap ( ℂ [ g ∘ f ] ) ]
|
||||||
|
≡ 𝔻 [ 𝔻 [ η C ∘ G.fmap g ] ∘ 𝔻 [ θ B ∘ F.fmap f ] ]
|
||||||
:distrib: :
|
isDistributive = begin
|
||||||
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F .func→ ( ℂ [ g ∘ f ] ) ]
|
𝔻 [ (ηθ C) ∘ F.fmap (ℂ [ g ∘ f ]) ]
|
||||||
≡ 𝔻 [ 𝔻 [ η C ∘ G .func→ g ] ∘ 𝔻 [ θ B ∘ F .func→ f ] ]
|
|
||||||
:distrib: = begin
|
|
||||||
𝔻 [ (ηθ C) ∘ F .func→ (ℂ [ g ∘ f ]) ]
|
|
||||||
≡⟨ ηθNat (ℂ [ g ∘ f ]) ⟩
|
≡⟨ ηθNat (ℂ [ g ∘ f ]) ⟩
|
||||||
𝔻 [ H .func→ (ℂ [ g ∘ f ]) ∘ (ηθ A) ]
|
𝔻 [ H.fmap (ℂ [ g ∘ f ]) ∘ (ηθ A) ]
|
||||||
≡⟨ cong (λ φ → 𝔻 [ φ ∘ ηθ A ]) (H.distrib) ⟩
|
≡⟨ cong (λ φ → 𝔻 [ φ ∘ ηθ A ]) (H.isDistributive) ⟩
|
||||||
𝔻 [ 𝔻 [ H .func→ g ∘ H .func→ f ] ∘ (ηθ A) ]
|
𝔻 [ 𝔻 [ H.fmap g ∘ H.fmap f ] ∘ (ηθ A) ]
|
||||||
≡⟨ sym assoc ⟩
|
≡⟨ sym 𝔻.isAssociative ⟩
|
||||||
𝔻 [ H .func→ g ∘ 𝔻 [ H .func→ f ∘ ηθ A ] ]
|
𝔻 [ H.fmap g ∘ 𝔻 [ H.fmap f ∘ ηθ A ] ]
|
||||||
≡⟨ cong (λ φ → 𝔻 [ H .func→ g ∘ φ ]) assoc ⟩
|
≡⟨ cong (λ φ → 𝔻 [ H.fmap g ∘ φ ]) 𝔻.isAssociative ⟩
|
||||||
𝔻 [ H .func→ g ∘ 𝔻 [ 𝔻 [ H .func→ f ∘ η A ] ∘ θ A ] ]
|
𝔻 [ H.fmap g ∘ 𝔻 [ 𝔻 [ H.fmap f ∘ η A ] ∘ θ A ] ]
|
||||||
≡⟨ cong (λ φ → 𝔻 [ H .func→ g ∘ φ ]) (cong (λ φ → 𝔻 [ φ ∘ θ A ]) (sym (ηNat f))) ⟩
|
≡⟨ cong (λ φ → 𝔻 [ H.fmap g ∘ φ ]) (cong (λ φ → 𝔻 [ φ ∘ θ A ]) (sym (ηNat f))) ⟩
|
||||||
𝔻 [ H .func→ g ∘ 𝔻 [ 𝔻 [ η B ∘ G .func→ f ] ∘ θ A ] ]
|
𝔻 [ H.fmap g ∘ 𝔻 [ 𝔻 [ η B ∘ G.fmap f ] ∘ θ A ] ]
|
||||||
≡⟨ cong (λ φ → 𝔻 [ H .func→ g ∘ φ ]) (sym assoc) ⟩
|
≡⟨ cong (λ φ → 𝔻 [ H.fmap g ∘ φ ]) (sym 𝔻.isAssociative) ⟩
|
||||||
𝔻 [ H .func→ g ∘ 𝔻 [ η B ∘ 𝔻 [ G .func→ f ∘ θ A ] ] ] ≡⟨ assoc ⟩
|
𝔻 [ H.fmap g ∘ 𝔻 [ η B ∘ 𝔻 [ G.fmap f ∘ θ A ] ] ]
|
||||||
𝔻 [ 𝔻 [ H .func→ g ∘ η B ] ∘ 𝔻 [ G .func→ f ∘ θ A ] ]
|
≡⟨ 𝔻.isAssociative ⟩
|
||||||
≡⟨ cong (λ φ → 𝔻 [ φ ∘ 𝔻 [ G .func→ f ∘ θ A ] ]) (sym (ηNat g)) ⟩
|
𝔻 [ 𝔻 [ H.fmap g ∘ η B ] ∘ 𝔻 [ G.fmap f ∘ θ A ] ]
|
||||||
𝔻 [ 𝔻 [ η C ∘ G .func→ g ] ∘ 𝔻 [ G .func→ f ∘ θ A ] ]
|
≡⟨ cong (λ φ → 𝔻 [ φ ∘ 𝔻 [ G.fmap f ∘ θ A ] ]) (sym (ηNat g)) ⟩
|
||||||
≡⟨ cong (λ φ → 𝔻 [ 𝔻 [ η C ∘ G .func→ g ] ∘ φ ]) (sym (θNat f)) ⟩
|
𝔻 [ 𝔻 [ η C ∘ G.fmap g ] ∘ 𝔻 [ G.fmap f ∘ θ A ] ]
|
||||||
𝔻 [ 𝔻 [ η C ∘ G .func→ g ] ∘ 𝔻 [ θ B ∘ F .func→ f ] ] ∎
|
≡⟨ cong (λ φ → 𝔻 [ 𝔻 [ η C ∘ G.fmap g ] ∘ φ ]) (sym (θNat f)) ⟩
|
||||||
where
|
𝔻 [ 𝔻 [ η C ∘ G.fmap g ] ∘ 𝔻 [ θ B ∘ F.fmap f ] ] ∎
|
||||||
open IsCategory (𝔻 .isCategory)
|
|
||||||
open module H = IsFunctor (H .isFunctor)
|
|
||||||
|
|
||||||
:eval: : Functor ((:obj: ×p ℂ) .Product.obj) 𝔻
|
eval : Functor (CatProduct.object object ℂ) 𝔻
|
||||||
:eval: = record
|
eval = record
|
||||||
{ func* = :func*:
|
{ raw = record
|
||||||
; func→ = λ {dom} {cod} → :func→: {dom} {cod}
|
{ omap = omap
|
||||||
|
; fmap = λ {dom} {cod} → fmap {dom} {cod}
|
||||||
|
}
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ ident = λ {o} → :ident: {o}
|
{ isIdentity = λ {o} → ident {o}
|
||||||
; distrib = λ {f u n k y} → :distrib: {f} {u} {n} {k} {y}
|
; isDistributive = λ {f u n k y} → isDistributive {f} {u} {n} {k} {y}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
module _ (𝔸 : Category ℓ ℓ) (F : Functor ((𝔸 ×p ℂ) .Product.obj) 𝔻) where
|
module _ (𝔸 : Category ℓ ℓ) (F : Functor (𝔸 ⊗ ℂ) 𝔻) where
|
||||||
open HasProducts (hasProducts {ℓ} {ℓ}) renaming (_|×|_ to parallelProduct)
|
|
||||||
|
|
||||||
postulate
|
postulate
|
||||||
transpose : Functor 𝔸 :obj:
|
parallelProduct
|
||||||
eq : Catℓ [ :eval: ∘ (parallelProduct transpose (𝟙 Catℓ {o = ℂ})) ] ≡ F
|
: Functor 𝔸 object → Functor ℂ ℂ
|
||||||
-- eq : Catℓ [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (𝟙 Catℓ {o = ℂ})) ] ≡ F
|
→ Functor (𝔸 ⊗ ℂ) (object ⊗ ℂ)
|
||||||
|
transpose : Functor 𝔸 object
|
||||||
|
eq : F[ eval ∘ (parallelProduct transpose (Functors.identity {ℂ = ℂ})) ] ≡ F
|
||||||
|
-- eq : F[ :eval: ∘ {!!} ] ≡ 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
|
||||||
|
|
||||||
:isExponential: : IsExponential Catℓ ℂ 𝔻 :obj: :eval:
|
-- We don't care about filling out the holes below since they are anyways hidden
|
||||||
:isExponential: = {!catTranspose!}
|
-- behind an unprovable statement.
|
||||||
where
|
module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where
|
||||||
open HasProducts (hasProducts {ℓ} {ℓ}) using (_|×|_)
|
private
|
||||||
-- :isExponential: = λ 𝔸 F → transpose 𝔸 F , eq' 𝔸 F
|
Catℓ : Category (lsuc (ℓ ⊔ ℓ)) (ℓ ⊔ ℓ)
|
||||||
|
Catℓ = Cat ℓ ℓ unprovable
|
||||||
|
|
||||||
-- :exponent: : Exponential (Cat ℓ ℓ) A B
|
module _ (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
:exponent: : Exponential Catℓ ℂ 𝔻
|
module CatExp = CatExponential ℂ 𝔻
|
||||||
:exponent: = record
|
_⊗_ = CatProduct.object
|
||||||
{ obj = :obj:
|
|
||||||
; eval = :eval:
|
-- Filling the hole causes Agda to loop indefinitely.
|
||||||
; isExponential = :isExponential:
|
eval : Functor (CatExp.object ⊗ ℂ) 𝔻
|
||||||
|
eval = {!CatExp.eval!}
|
||||||
|
|
||||||
|
isExponential : IsExponential Catℓ ℂ 𝔻 CatExp.object eval
|
||||||
|
isExponential = {!CatExp.isExponential!}
|
||||||
|
|
||||||
|
exponent : Exponential Catℓ ℂ 𝔻
|
||||||
|
exponent = record
|
||||||
|
{ obj = CatExp.object
|
||||||
|
; eval = {!eval!}
|
||||||
|
; isExponential = {!isExponential!}
|
||||||
}
|
}
|
||||||
|
|
||||||
hasExponentials : HasExponentials (Cat ℓ ℓ)
|
hasExponentials : HasExponentials Catℓ
|
||||||
hasExponentials = record { exponent = :exponent: }
|
hasExponentials = record { exponent = exponent }
|
||||||
|
|
|
@ -1,31 +1,28 @@
|
||||||
{-# 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
|
||||||
|
private
|
||||||
-- Ns is the "namespace"
|
-- Ns is the "namespace"
|
||||||
ℓo = (suc zero ⊔ ℓ)
|
ℓo = (suc zero ⊔ ℓ)
|
||||||
|
|
||||||
|
@ -43,7 +40,6 @@ module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
||||||
𝟚 = Bool
|
𝟚 = Bool
|
||||||
|
|
||||||
module _ (I J : FiniteDecidableSubset) where
|
module _ (I J : FiniteDecidableSubset) where
|
||||||
private
|
|
||||||
Hom' : Set ℓ
|
Hom' : Set ℓ
|
||||||
Hom' = elmsof I → elmsof J ⊎ 𝟚
|
Hom' = elmsof I → elmsof J ⊎ 𝟚
|
||||||
isInl : {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} → A ⊎ B → Set
|
isInl : {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} → A ⊎ B → Set
|
||||||
|
@ -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ℂ
|
||||||
|
|
||||||
|
|
55
src/Cat/Categories/CwF.agda
Normal file
55
src/Cat/Categories/CwF.agda
Normal file
|
@ -0,0 +1,55 @@
|
||||||
|
module Cat.Categories.CwF where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor
|
||||||
|
open import Cat.Categories.Fam
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} where
|
||||||
|
record CwF : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
|
-- "A category with families consists of"
|
||||||
|
field
|
||||||
|
-- "A base category"
|
||||||
|
ℂ : Category ℓa ℓb
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
-- It's objects are called contexts
|
||||||
|
Contexts = ℂ.Object
|
||||||
|
-- It's arrows are called substitutions
|
||||||
|
Substitutions = ℂ.Arrow
|
||||||
|
field
|
||||||
|
-- A functor T
|
||||||
|
T : Functor (opposite ℂ) (Fam ℓa ℓb)
|
||||||
|
-- Empty context
|
||||||
|
[] : ℂ.Terminal
|
||||||
|
private
|
||||||
|
module T = Functor T
|
||||||
|
Type : (Γ : ℂ.Object) → Set ℓa
|
||||||
|
Type Γ = fst (fst (T.omap Γ))
|
||||||
|
|
||||||
|
module _ {Γ : ℂ.Object} {A : Type Γ} where
|
||||||
|
|
||||||
|
-- module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
||||||
|
-- k : Σ (fst (omap T B) → fst (omap T A))
|
||||||
|
-- (λ f →
|
||||||
|
-- {x : fst (omap T B)} →
|
||||||
|
-- snd (omap T B) x → snd (omap T A) (f x))
|
||||||
|
-- k = T.fmap γ
|
||||||
|
-- k₁ : fst (omap T B) → fst (omap T A)
|
||||||
|
-- k₁ = fst k
|
||||||
|
-- k₂ : ({x : fst (omap T B)} →
|
||||||
|
-- snd (omap T B) x → snd (omap T A) (k₁ x))
|
||||||
|
-- k₂ = snd k
|
||||||
|
|
||||||
|
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
||||||
|
field
|
||||||
|
Γ&A : ℂ.Object
|
||||||
|
proj1 : ℂ [ Γ&A , Γ ]
|
||||||
|
-- proj2 : ????
|
||||||
|
|
||||||
|
-- if γ : ℂ [ A , B ]
|
||||||
|
-- then T .fmap γ (written T[γ]) interpret substitutions in types and terms respectively.
|
||||||
|
-- field
|
||||||
|
-- ump : {Δ : ℂ .Object} → (γ : ℂ [ Δ , Γ ])
|
||||||
|
-- → (a : {!!}) → {!!}
|
|
@ -1,54 +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
|
|
||||||
open import Cubical
|
|
||||||
import Function
|
|
||||||
|
|
||||||
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
|
||||||
Obj' = Σ[ A ∈ Set ℓa ] (A → Set ℓb)
|
Object = Σ[ hA ∈ hSet ℓa ] (fst hA → hSet ℓb)
|
||||||
Arr : Obj' → Obj' → Set (ℓa ⊔ ℓb)
|
Arr : Object → Object → Set (ℓa ⊔ ℓb)
|
||||||
Arr (A , B) (A' , B') = Σ[ f ∈ (A → A') ] ({x : A} → B x → B' (f x))
|
Arr ((A , _) , B) ((A' , _) , B') = Σ[ f ∈ (A → A') ] ({x : A} → fst (B x) → fst (B' (f x)))
|
||||||
one : {o : Obj'} → Arr o o
|
identity : {A : Object} → Arr A A
|
||||||
proj₁ one = λ x → x
|
fst identity = λ x → x
|
||||||
proj₂ one = λ b → b
|
snd identity = λ b → b
|
||||||
_∘_ : {a b c : Obj'} → 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'
|
||||||
_⟨_∘_⟩ : {a b : Obj'} → (c : Obj') → Arr b c → Arr a b → Arr a c
|
|
||||||
c ⟨ g ∘ f ⟩ = _∘_ {c = c} g f
|
|
||||||
|
|
||||||
module _ {A B C D : Obj'} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
|
|
||||||
assoc : (D ⟨ h ∘ C ⟨ g ∘ f ⟩ ⟩) ≡ D ⟨ D ⟨ h ∘ g ⟩ ∘ f ⟩
|
|
||||||
assoc = Σ≡ refl refl
|
|
||||||
|
|
||||||
module _ {A B : Obj'} {f : Arr A B} where
|
|
||||||
ident : B ⟨ f ∘ one ⟩ ≡ f × B ⟨ one {B} ∘ f ⟩ ≡ f
|
|
||||||
ident = (Σ≡ refl refl) , Σ≡ refl refl
|
|
||||||
|
|
||||||
|
|
||||||
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||||
RawFam = record
|
RawFam = record
|
||||||
{ Object = Obj'
|
{ Object = Object
|
||||||
; Arrow = Arr
|
; Arrow = Arr
|
||||||
; 𝟙 = one
|
; identity = λ { {A} → identity {A = A}}
|
||||||
; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
|
; _<<<_ = λ {a b c} → _<<<_ {a} {b} {c}
|
||||||
}
|
}
|
||||||
|
|
||||||
instance
|
open RawCategory RawFam hiding (Object ; identity)
|
||||||
isCategory : IsCategory RawFam
|
|
||||||
isCategory = record
|
isAssociative : IsAssociative
|
||||||
{ assoc = λ {A} {B} {C} {D} {f} {g} {h} → assoc {D = D} {f} {g} {h}
|
isAssociative = Σ≡ refl refl
|
||||||
; ident = λ {A} {B} {f} → ident {A} {B} {f = f}
|
|
||||||
; arrowIsSet = {!!}
|
isIdentity : IsIdentity λ { {A} → identity {A} }
|
||||||
; univalent = {!!}
|
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
|
||||||
|
|
||||||
|
isPreCategory : IsPreCategory RawFam
|
||||||
|
IsPreCategory.isAssociative isPreCategory
|
||||||
|
{A} {B} {C} {D} {f} {g} {h} = isAssociative {A} {B} {C} {D} {f} {g} {h}
|
||||||
|
IsPreCategory.isIdentity isPreCategory
|
||||||
|
{A} {B} {f} = isIdentity {A} {B} {f = f}
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory
|
||||||
|
{(A , hA) , famA} {(B , hB) , famB}
|
||||||
|
= setSig
|
||||||
|
{sA = setPi λ _ → hB}
|
||||||
|
{sB = λ f →
|
||||||
|
let
|
||||||
|
helpr : isSet ((a : A) → fst (famA a) → fst (famB (f a)))
|
||||||
|
helpr = setPi λ a → setPi λ _ → snd (famB (f a))
|
||||||
|
-- It's almost like above, but where the first argument is
|
||||||
|
-- implicit.
|
||||||
|
res : isSet ({a : A} → fst (famA a) → fst (famB (f a)))
|
||||||
|
res = {!!}
|
||||||
|
in res
|
||||||
}
|
}
|
||||||
|
|
||||||
|
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,72 +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
|
||||||
|
|
||||||
open IsCategory
|
module _ {ℓ : Level} {A : Set ℓ} {ℓr : Level} where
|
||||||
|
data Path (R : Rel A ℓr) : (a b : A) → Set (ℓ ⊔ ℓr) where
|
||||||
-- data Path {ℓ : Level} {A : Set ℓ} : (a b : A) → Set ℓ where
|
|
||||||
-- emptyPath : {a : A} → Path a a
|
|
||||||
-- concatenate : {a b c : A} → Path a b → Path b c → Path a b
|
|
||||||
|
|
||||||
-- import Data.List
|
|
||||||
-- P : (a b : Object ℂ) → Set (ℓ ⊔ ℓ')
|
|
||||||
-- P = {!Data.List.List ?!}
|
|
||||||
-- Generalized paths:
|
|
||||||
data Path {ℓ ℓ' : Level} {A : Set ℓ} (R : A → A → Set ℓ') : (a b : A) → Set (ℓ ⊔ ℓ') where
|
|
||||||
empty : {a : A} → Path R a a
|
empty : {a : A} → Path R a a
|
||||||
cons : {a b c : A} → R b c → Path R a b → Path R a c
|
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 : {a b c : A} → Path R b c → Path R a b → Path R a c
|
||||||
concatenate empty p = p
|
concatenate empty p = p
|
||||||
concatenate (cons x q) p = cons x (concatenate q p)
|
concatenate (cons x q) p = cons x (concatenate q p)
|
||||||
_++_ = concatenate
|
_++_ : {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
|
||||||
module ℂ = Category ℂ
|
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
private
|
private
|
||||||
p-assoc : {A B C D : Object} {r : Path Arrow A B} {q : Path Arrow B C} {p : Path Arrow C D}
|
module ℂ = Category ℂ
|
||||||
|
|
||||||
|
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-assoc {r = r} {q} {empty} = refl
|
isAssociative {r = r} {q} {empty} = refl
|
||||||
p-assoc {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-assoc {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
|
||||||
{ assoc = λ { {f = f} {g} {h} → p-assoc {r = f} {g} {h}}
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
; ident = ident-r , ident-l
|
|
||||||
; arrowIsSet = {!!}
|
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,196 +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 Cubical
|
|
||||||
open import Function
|
|
||||||
open import Data.Product
|
|
||||||
import Cubical.GradLemma
|
|
||||||
module UIP = Cubical.GradLemma
|
|
||||||
open import Cubical.Sigma
|
|
||||||
open import Cubical.NType
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s)
|
|
||||||
module Nat = Data.Nat
|
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Wishlist
|
import Cat.Category.NaturalTransformation
|
||||||
|
as NaturalTransformation
|
||||||
|
open import Cat.Categories.Opposite
|
||||||
|
|
||||||
open import Cat.Equality
|
module Fun {ℓc ℓc' ℓd ℓd' : Level} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
open Equality.Data.Product
|
open NaturalTransformation ℂ 𝔻 public hiding (module Properties)
|
||||||
|
|
||||||
module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Category ℓd ℓd'} where
|
|
||||||
open Category using (Object ; 𝟙)
|
|
||||||
open Functor
|
|
||||||
|
|
||||||
module _ (F G : Functor ℂ 𝔻) where
|
|
||||||
private
|
private
|
||||||
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.func* C , G.func* C ]
|
|
||||||
|
|
||||||
Natural : Transformation → Set (ℓc ⊔ (ℓc' ⊔ ℓd'))
|
|
||||||
Natural θ
|
|
||||||
= {A B : Object ℂ}
|
|
||||||
→ (f : ℂ [ A , B ])
|
|
||||||
→ 𝔻 [ θ B ∘ F.func→ f ] ≡ 𝔻 [ G.func→ f ∘ θ A ]
|
|
||||||
|
|
||||||
-- naturalIsProp : ∀ θ → isProp (Natural θ)
|
|
||||||
-- naturalIsProp θ x y = {!funExt!}
|
|
||||||
|
|
||||||
NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd')
|
|
||||||
NaturalTransformation = Σ Transformation Natural
|
|
||||||
|
|
||||||
-- NaturalTranformation : Set (ℓc ⊔ (ℓc' ⊔ ℓd'))
|
|
||||||
-- NaturalTranformation = ∀ (θ : Transformation) {A B : ℂ .Object} → (f : ℂ .Arrow A B) → 𝔻 ._⊕_ (θ B) (F .func→ f) ≡ 𝔻 ._⊕_ (G .func→ f) (θ A)
|
|
||||||
|
|
||||||
NaturalTransformation≡ : {α β : NaturalTransformation}
|
|
||||||
→ (eq₁ : α .proj₁ ≡ β .proj₁)
|
|
||||||
→ (eq₂ : PathP
|
|
||||||
(λ i → {A B : Object ℂ} (f : ℂ [ A , B ])
|
|
||||||
→ 𝔻 [ eq₁ i B ∘ F.func→ f ]
|
|
||||||
≡ 𝔻 [ G.func→ f ∘ eq₁ i A ])
|
|
||||||
(α .proj₂) (β .proj₂))
|
|
||||||
→ α ≡ β
|
|
||||||
NaturalTransformation≡ eq₁ eq₂ i = eq₁ i , eq₂ i
|
|
||||||
|
|
||||||
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
|
||||||
identityTrans F C = 𝟙 𝔻
|
|
||||||
|
|
||||||
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
|
||||||
identityNatural F {A = A} {B = B} f = begin
|
|
||||||
𝔻 [ identityTrans F B ∘ F→ f ] ≡⟨⟩
|
|
||||||
𝔻 [ 𝟙 𝔻 ∘ F→ f ] ≡⟨ proj₂ 𝔻.ident ⟩
|
|
||||||
F→ f ≡⟨ sym (proj₁ 𝔻.ident) ⟩
|
|
||||||
𝔻 [ F→ f ∘ 𝟙 𝔻 ] ≡⟨⟩
|
|
||||||
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
|
||||||
where
|
|
||||||
module F = Functor F
|
|
||||||
F→ = F.func→
|
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
identityNat : (F : Functor ℂ 𝔻) → NaturalTransformation F F
|
module _ where
|
||||||
identityNat F = identityTrans F , identityNatural F
|
|
||||||
|
|
||||||
module _ {F G H : Functor ℂ 𝔻} where
|
|
||||||
private
|
|
||||||
module F = Functor F
|
|
||||||
module G = Functor G
|
|
||||||
module H = Functor H
|
|
||||||
_∘nt_ : Transformation G H → Transformation F G → Transformation F H
|
|
||||||
(θ ∘nt η) C = 𝔻 [ θ C ∘ η C ]
|
|
||||||
|
|
||||||
NatComp _:⊕:_ : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
|
||||||
proj₁ ((θ , _) :⊕: (η , _)) = θ ∘nt η
|
|
||||||
proj₂ ((θ , θNat) :⊕: (η , ηNat)) {A} {B} f = begin
|
|
||||||
𝔻 [ (θ ∘nt η) B ∘ F.func→ f ] ≡⟨⟩
|
|
||||||
𝔻 [ 𝔻 [ θ B ∘ η B ] ∘ F.func→ f ] ≡⟨ sym assoc ⟩
|
|
||||||
𝔻 [ θ B ∘ 𝔻 [ η B ∘ F.func→ f ] ] ≡⟨ cong (λ φ → 𝔻 [ θ B ∘ φ ]) (ηNat f) ⟩
|
|
||||||
𝔻 [ θ B ∘ 𝔻 [ G.func→ f ∘ η A ] ] ≡⟨ assoc ⟩
|
|
||||||
𝔻 [ 𝔻 [ θ B ∘ G.func→ f ] ∘ η A ] ≡⟨ cong (λ φ → 𝔻 [ φ ∘ η A ]) (θNat f) ⟩
|
|
||||||
𝔻 [ 𝔻 [ H.func→ f ∘ θ A ] ∘ η A ] ≡⟨ sym assoc ⟩
|
|
||||||
𝔻 [ H.func→ f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
|
||||||
𝔻 [ H.func→ f ∘ (θ ∘nt η) A ] ∎
|
|
||||||
where
|
|
||||||
open Category 𝔻
|
|
||||||
|
|
||||||
NatComp = _:⊕:_
|
|
||||||
|
|
||||||
private
|
|
||||||
module _ {F G : Functor ℂ 𝔻} where
|
|
||||||
module 𝔻 = Category 𝔻
|
|
||||||
|
|
||||||
transformationIsSet : isSet (Transformation F G)
|
|
||||||
transformationIsSet _ _ p q i j C = 𝔻.arrowIsSet _ _ (λ l → p l C) (λ l → q l C) i j
|
|
||||||
IsSet' : {ℓ : Level} (A : Set ℓ) → Set ℓ
|
|
||||||
IsSet' A = {x y : A} → (p q : (λ _ → A) [ x ≡ y ]) → p ≡ q
|
|
||||||
|
|
||||||
naturalIsProp : (θ : Transformation F G) → isProp (Natural F G θ)
|
|
||||||
naturalIsProp θ θNat θNat' = lem
|
|
||||||
where
|
|
||||||
lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ]
|
|
||||||
lem = λ i f → 𝔻.arrowIsSet _ _ (θNat f) (θNat' f) i
|
|
||||||
|
|
||||||
naturalTransformationIsSets : isSet (NaturalTransformation F G)
|
|
||||||
naturalTransformationIsSets = sigPresSet transformationIsSet
|
|
||||||
λ θ → ntypeCommulative
|
|
||||||
(s≤s {n = Nat.suc Nat.zero} z≤n)
|
|
||||||
(naturalIsProp θ)
|
|
||||||
|
|
||||||
module _ {A B C D : Functor ℂ 𝔻} {θ' : NaturalTransformation A B}
|
|
||||||
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
|
|
||||||
private
|
|
||||||
θ = proj₁ θ'
|
|
||||||
η = proj₁ η'
|
|
||||||
ζ = proj₁ ζ'
|
|
||||||
θNat = proj₂ θ'
|
|
||||||
ηNat = proj₂ η'
|
|
||||||
ζNat = proj₂ ζ'
|
|
||||||
L : NaturalTransformation A D
|
|
||||||
L = (_:⊕:_ {A} {C} {D} ζ' (_:⊕:_ {A} {B} {C} η' θ'))
|
|
||||||
R : NaturalTransformation A D
|
|
||||||
R = (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} ζ' η') θ')
|
|
||||||
_g⊕f_ = _:⊕:_ {A} {B} {C}
|
|
||||||
_h⊕g_ = _:⊕:_ {B} {C} {D}
|
|
||||||
:assoc: : L ≡ R
|
|
||||||
:assoc: = lemSig (naturalIsProp {F = A} {D})
|
|
||||||
L R (funExt (λ x → assoc))
|
|
||||||
where
|
|
||||||
open Category 𝔻
|
|
||||||
|
|
||||||
module _ {A B : Functor ℂ 𝔻} {f : NaturalTransformation A B} where
|
|
||||||
private
|
|
||||||
allNatural = naturalIsProp {F = A} {B}
|
|
||||||
f' = proj₁ f
|
|
||||||
module 𝔻Data = Category 𝔻
|
|
||||||
eq-r : ∀ C → (𝔻 [ f' C ∘ identityTrans A C ]) ≡ f' C
|
|
||||||
eq-r C = begin
|
|
||||||
𝔻 [ f' C ∘ identityTrans A C ] ≡⟨⟩
|
|
||||||
𝔻 [ f' C ∘ 𝔻Data.𝟙 ] ≡⟨ proj₁ (𝔻.ident {A} {B}) ⟩
|
|
||||||
f' C ∎
|
|
||||||
eq-l : ∀ C → (𝔻 [ identityTrans B C ∘ f' C ]) ≡ f' C
|
|
||||||
eq-l C = proj₂ (𝔻.ident {A} {B})
|
|
||||||
ident-r : (_:⊕:_ {A} {A} {B} f (identityNat A)) ≡ f
|
|
||||||
ident-r = lemSig allNatural _ _ (funExt eq-r)
|
|
||||||
ident-l : (_:⊕:_ {A} {B} {B} (identityNat B) f) ≡ f
|
|
||||||
ident-l = lemSig allNatural _ _ (funExt eq-l)
|
|
||||||
:ident:
|
|
||||||
: (_:⊕:_ {A} {A} {B} f (identityNat A)) ≡ f
|
|
||||||
× (_:⊕:_ {A} {B} {B} (identityNat B) f) ≡ f
|
|
||||||
:ident: = ident-r , ident-l
|
|
||||||
|
|
||||||
-- Functor categories. Objects are functors, arrows are natural transformations.
|
-- Functor categories. Objects are functors, arrows are natural transformations.
|
||||||
RawFun : RawCategory (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
raw : RawCategory (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
RawFun = record
|
RawCategory.Object raw = Functor ℂ 𝔻
|
||||||
{ Object = Functor ℂ 𝔻
|
RawCategory.Arrow raw = NaturalTransformation
|
||||||
; Arrow = NaturalTransformation
|
RawCategory.identity raw {F} = identity F
|
||||||
; 𝟙 = λ {F} → identityNat F
|
RawCategory._<<<_ raw {F} {G} {H} = NT[_∘_] {F} {G} {H}
|
||||||
; _∘_ = λ {F G H} → _:⊕:_ {F} {G} {H}
|
|
||||||
}
|
|
||||||
|
|
||||||
instance
|
module _ where
|
||||||
:isCategory: : IsCategory RawFun
|
open RawCategory raw hiding (identity)
|
||||||
:isCategory: = record
|
open NaturalTransformation.Properties ℂ 𝔻
|
||||||
{ assoc = λ {A B C D} → :assoc: {A} {B} {C} {D}
|
|
||||||
; ident = λ {A B} → :ident: {A} {B}
|
isPreCategory : IsPreCategory raw
|
||||||
; arrowIsSet = λ {F} {G} → naturalTransformationIsSets {F} {G}
|
IsPreCategory.isAssociative isPreCategory {A} {B} {C} {D} = isAssociative {A} {B} {C} {D}
|
||||||
; univalent = {!!}
|
IsPreCategory.isIdentity isPreCategory {A} {B} = isIdentity {A} {B}
|
||||||
}
|
IsPreCategory.arrowsAreSets isPreCategory {F} {G} = naturalTransformationIsSet {F} {G}
|
||||||
|
|
||||||
|
open IsPreCategory isPreCategory hiding (identity)
|
||||||
|
|
||||||
|
module _ {F G : Functor ℂ 𝔻} (p : F ≡ G) where
|
||||||
|
private
|
||||||
|
module F = Functor F
|
||||||
|
module G = Functor G
|
||||||
|
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
|
||||||
|
|
||||||
|
-- idToNatTrans : NaturalTransformation F G
|
||||||
|
-- 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 ∎
|
||||||
|
|
||||||
|
module _ {A B : Functor ℂ 𝔻} where
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
U : (F : ℂ.Object → 𝔻.Object) → Set _
|
||||||
|
U F = {A B : ℂ.Object} → ℂ [ A , B ] → 𝔻 [ F A , F B ]
|
||||||
|
|
||||||
|
-- module _
|
||||||
|
-- (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
|
||||||
|
|
||||||
|
-- fmapEq : PathP (λ i → U (omapEq i)) A.fmap B.fmap
|
||||||
|
-- fmapEq = pathJ D d B.omap omapEq B.fmap B.isFunctor iso
|
||||||
|
|
||||||
|
-- rawEq : A.raw ≡ B.raw
|
||||||
|
-- rawEq i = record { omap = omapEq i ; fmap = fmapEq i }
|
||||||
|
|
||||||
|
-- private
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
univ : (A ≡ B) ≃ (A ≊ B)
|
||||||
|
univ = fromIsomorphism _ _ iso
|
||||||
|
|
||||||
|
-- There used to be some work-in-progress on this theorem, please go back to
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
isCategory : IsCategory raw
|
||||||
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = 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
|
||||||
open import Cat.Categories.Sets
|
open import Cat.Categories.Sets
|
||||||
|
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} → identityNat F
|
; identity = λ {F} → identity F
|
||||||
; _∘_ = λ {F G H} → NatComp {F = F} {G = G} {H = H}
|
; _<<<_ = λ {F G H} → NT[_∘_] {F = F} {G = G} {H = H}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- isCategory : IsCategory raw
|
||||||
|
-- isCategory = record
|
||||||
|
-- { 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
|
||||||
|
|
||||||
|
@ -56,7 +52,6 @@ module _ {A B : Set} {S : Subset (A × B)} (ab : A × B) where
|
||||||
backwards (a' , (a=a' , a'b∈S)) = subst (sym a=a') a'b∈S
|
backwards (a' , (a=a' , a'b∈S)) = subst (sym a=a') a'b∈S
|
||||||
|
|
||||||
fwd-bwd : (x : (a , b) ∈ S) → (backwards ∘ forwards) x ≡ x
|
fwd-bwd : (x : (a , b) ∈ S) → (backwards ∘ forwards) x ≡ x
|
||||||
-- isbijective x = pathJ (λ y x₁ → (backwards ∘ forwards) x ≡ x) {!!} {!!} {!!}
|
|
||||||
fwd-bwd x = pathJprop (λ y _ → y) x
|
fwd-bwd x = pathJprop (λ y _ → y) x
|
||||||
|
|
||||||
bwd-fwd : (x : Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
bwd-fwd : (x : Σ[ a' ∈ A ] (a , a') ∈ Diag A × (a' , b) ∈ S)
|
||||||
|
@ -67,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
|
||||||
|
@ -101,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
|
||||||
|
@ -139,33 +122,28 @@ 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)
|
||||||
|
|
||||||
-- assocc : Q + (R + S) ≡ (Q + R) + S
|
-- isAssociativec : Q + (R + S) ≡ (Q + R) + S
|
||||||
is-assoc : (Σ[ 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)
|
||||||
≡ (Σ[ 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))
|
||||||
is-assoc = equivToPath equi
|
is-isAssociative = equivToPath equi
|
||||||
|
|
||||||
RawRel : RawCategory (lsuc lzero) (lsuc lzero)
|
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
|
|
||||||
{ assoc = funExt is-assoc
|
IsPreCategory.isAssociative isPreCategory = funExt is-isAssociative
|
||||||
; ident = funExt ident-l , funExt ident-r
|
IsPreCategory.isIdentity isPreCategory = funExt ident-l , funExt ident-r
|
||||||
; arrowIsSet = {!!}
|
IsPreCategory.arrowsAreSets isPreCategory = {!!}
|
||||||
; univalent = {!!}
|
|
||||||
}
|
Rel : PreCategory RawRel
|
||||||
|
PreCategory.isPreCategory Rel = isPreCategory
|
||||||
|
|
|
@ -1,35 +1,63 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
-- | The category of homotopy sets
|
||||||
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Categories.Sets where
|
module Cat.Categories.Sets where
|
||||||
|
|
||||||
open import Cubical
|
open import Cat.Prelude as P
|
||||||
open import Agda.Primitive
|
open import Cat.Equivalence
|
||||||
open import Data.Product
|
|
||||||
import Function
|
|
||||||
|
|
||||||
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.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 RawCategory
|
|
||||||
open IsCategory
|
|
||||||
open import Cubical.Univalence
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
open import Cubical.Universe
|
|
||||||
|
|
||||||
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
||||||
Object SetsRaw = Cubical.Universe.0-Set
|
RawCategory.Object SetsRaw = hSet ℓ
|
||||||
Arrow SetsRaw (T , _) (U , _) = T → U
|
RawCategory.Arrow SetsRaw (T , _) (U , _) = T → U
|
||||||
𝟙 SetsRaw = Function.id
|
RawCategory.identity SetsRaw = idFun _
|
||||||
_∘_ SetsRaw = Function._∘′_
|
RawCategory._<<<_ SetsRaw = _∘′_
|
||||||
|
|
||||||
|
module _ where
|
||||||
|
private
|
||||||
|
open RawCategory SetsRaw hiding (_<<<_)
|
||||||
|
|
||||||
|
isIdentity : IsIdentity (idFun _)
|
||||||
|
fst isIdentity = funExt λ _ → refl
|
||||||
|
snd isIdentity = funExt λ _ → refl
|
||||||
|
|
||||||
|
arrowsAreSets : ArrowsAreSets
|
||||||
|
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
|
||||||
|
open Σ hA renaming (fst to A ; snd to sA)
|
||||||
|
open Σ hB renaming (fst to B ; snd to sB)
|
||||||
|
|
||||||
|
univ≃ : (hA ≡ hB) ≃ (hA ≊ hB)
|
||||||
|
univ≃
|
||||||
|
= equivSigProp (λ A → isSetIsProp)
|
||||||
|
⊙ univalence
|
||||||
|
⊙ equivSig {P = isEquiv A B} {Q = TypeIsomorphism} (equiv≃iso sA sB)
|
||||||
|
|
||||||
|
univalent : Univalent
|
||||||
|
univalent = univalenceFrom≃ univ≃
|
||||||
|
|
||||||
SetsIsCategory : IsCategory SetsRaw
|
SetsIsCategory : IsCategory SetsRaw
|
||||||
assoc SetsIsCategory = refl
|
IsCategory.isPreCategory SetsIsCategory = isPreCat
|
||||||
proj₁ (ident SetsIsCategory) = funExt λ _ → refl
|
IsCategory.univalent SetsIsCategory = univalent
|
||||||
proj₂ (ident SetsIsCategory) = funExt λ _ → refl
|
|
||||||
arrowIsSet SetsIsCategory {B = (_ , s)} = setPi λ _ → s
|
|
||||||
univalent SetsIsCategory = {!!}
|
|
||||||
|
|
||||||
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
||||||
Category.raw 𝓢𝓮𝓽 = SetsRaw
|
Category.raw 𝓢𝓮𝓽 = SetsRaw
|
||||||
|
@ -40,82 +68,88 @@ 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
|
|
||||||
instance
|
|
||||||
isProduct : IsProduct 𝓢 {0A} {0B} {0A×0B} proj₁ proj₂
|
|
||||||
isProduct {X = X} f g = (f &&& g) , lem {0X = X} f g
|
|
||||||
|
|
||||||
product : Product {ℂ = 𝓢} 0A 0B
|
module _ (hX : Object) where
|
||||||
product = record
|
open Σ hX renaming (fst to X)
|
||||||
{ obj = 0A×0B
|
module _ (f : X → A ) (g : X → B) where
|
||||||
; proj₁ = Data.Product.proj₁
|
ump : fst ∘′ (f &&& g) ≡ f × snd ∘′ (f &&& g) ≡ g
|
||||||
; proj₂ = Data.Product.proj₂
|
fst ump = refl
|
||||||
; isProduct = λ { {X} → isProduct {X = X}}
|
snd ump = refl
|
||||||
}
|
|
||||||
|
rawProduct : RawProduct 𝓢 hA hB
|
||||||
|
RawProduct.object rawProduct = productObject
|
||||||
|
RawProduct.fst rawProduct = fst
|
||||||
|
RawProduct.snd rawProduct = snd
|
||||||
|
|
||||||
|
isProduct : IsProduct 𝓢 _ _ rawProduct
|
||||||
|
IsProduct.ump isProduct {X = hX} 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 𝓢 hA hB
|
||||||
|
Product.raw product = rawProduct
|
||||||
|
Product.isProduct product = isProduct
|
||||||
|
|
||||||
instance
|
instance
|
||||||
SetsHasProducts : HasProducts 𝓢
|
SetsHasProducts : HasProducts 𝓢
|
||||||
SetsHasProducts = record { product = product }
|
SetsHasProducts = record { product = product }
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
module _ (ℂ : 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)
|
||||||
|
|
||||||
-- Contravariant Presheaf
|
-- Contravariant Presheaf
|
||||||
Presheaf : Set (ℓa ⊔ lsuc ℓb)
|
Presheaf : Set (ℓa ⊔ lsuc ℓb)
|
||||||
Presheaf = Functor (Opposite ℂ) (𝓢𝓮𝓽 ℓb)
|
Presheaf = Functor (opposite ℂ) (𝓢𝓮𝓽 ℓb)
|
||||||
|
|
||||||
-- The "co-yoneda" embedding.
|
-- The "co-yoneda" embedding.
|
||||||
representable : {ℂ : Category ℓa ℓb} → Category.Object ℂ → Representable ℂ
|
representable : Category.Object ℂ → Representable
|
||||||
representable {ℂ = ℂ} A = record
|
representable A = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ func* = λ B → ℂ [ A , B ] , arrowIsSet
|
{ omap = λ B → ℂ [ A , B ] , arrowsAreSets
|
||||||
; func→ = ℂ [_∘_]
|
; fmap = ℂ [_∘_]
|
||||||
}
|
}
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ ident = funExt λ _ → proj₂ ident
|
{ isIdentity = funExt λ _ → leftIdentity
|
||||||
; distrib = funExt λ x → sym assoc
|
; isDistributive = funExt λ x → sym isAssociative
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
where
|
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
-- Alternate name: `yoneda`
|
-- Alternate name: `yoneda`
|
||||||
presheaf : {ℂ : Category ℓa ℓb} → Category.Object (Opposite ℂ) → Presheaf ℂ
|
presheaf : Category.Object (opposite ℂ) → Presheaf
|
||||||
presheaf {ℂ = ℂ} B = record
|
presheaf B = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ func* = λ A → ℂ [ A , B ] , arrowIsSet
|
{ omap = λ A → ℂ [ A , B ] , arrowsAreSets
|
||||||
; func→ = λ f g → ℂ [ g ∘ f ]
|
; fmap = λ f g → ℂ [ g ∘ f ]
|
||||||
}
|
}
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ ident = funExt λ x → proj₁ ident
|
{ isIdentity = funExt λ x → rightIdentity
|
||||||
; distrib = funExt λ x → assoc
|
; isDistributive = funExt λ x → isAssociative
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
where
|
|
||||||
open Category ℂ
|
|
||||||
|
|
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
|
||||||
|
}
|
|
@ -1,69 +1,94 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
-- | Univalent categories
|
||||||
|
--
|
||||||
|
-- This module defines:
|
||||||
|
--
|
||||||
|
-- Categories
|
||||||
|
-- ==========
|
||||||
|
--
|
||||||
|
-- Types
|
||||||
|
-- ------
|
||||||
|
--
|
||||||
|
-- Object, Arrow
|
||||||
|
--
|
||||||
|
-- Data
|
||||||
|
-- ----
|
||||||
|
-- identity; the identity arrow
|
||||||
|
-- _<<<_; function composition
|
||||||
|
--
|
||||||
|
-- Laws
|
||||||
|
-- ----
|
||||||
|
--
|
||||||
|
-- associativity, identity, arrows form sets, univalence.
|
||||||
|
--
|
||||||
|
-- Lemmas
|
||||||
|
-- ------
|
||||||
|
--
|
||||||
|
-- Propositionality for all laws about the category.
|
||||||
|
{-# 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 )
|
|
||||||
|
|
||||||
open import Cat.Wishlist
|
------------------
|
||||||
|
-- * Categories --
|
||||||
∃! : ∀ {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
|
|
||||||
|
|
||||||
|
-- | Raw categories
|
||||||
|
--
|
||||||
|
-- This record desribes the data that a category consist of as well as some laws
|
||||||
|
-- about these. The laws defined are the types the propositions - not the
|
||||||
|
-- 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 _>>>_
|
||||||
|
infixl 10 _<<<_ _>>>_
|
||||||
|
|
||||||
domain : { a b : Object } → Arrow a b → Object
|
-- | Reverse arrow composition
|
||||||
domain {a = a} _ = a
|
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
||||||
|
f >>> g = g <<< f
|
||||||
|
|
||||||
codomain : { a b : Object } → Arrow a b → Object
|
-- | Laws about the data
|
||||||
codomain {b = b} _ = b
|
|
||||||
|
|
||||||
|
-- FIXME It seems counter-intuitive that the normal-form is on the
|
||||||
|
-- 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 = ∀ {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)
|
||||||
|
@ -77,168 +102,524 @@ 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 {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
module Univalence (isIdentity : IsIdentity identity) where
|
||||||
open RawCategory ℂ
|
-- | The identity isomorphism
|
||||||
module _ (ident : IsIdentity 𝟙) where
|
idIso : (A : Object) → A ≊ A
|
||||||
idIso : (A : Object) → A ≅ A
|
idIso A = identity , identity , isIdentity
|
||||||
idIso A = 𝟙 , (𝟙 , ident)
|
|
||||||
|
|
||||||
-- 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)
|
||||||
|
|
||||||
-- TODO: might want to implement isEquiv
|
|
||||||
-- differently, there are 3
|
|
||||||
-- equivalent formulations in the book.
|
|
||||||
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)
|
||||||
|
|
||||||
record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc (ℓa ⊔ ℓb)) where
|
univalenceFromIsomorphism : {A B : Object}
|
||||||
open RawCategory ℂ
|
→ TypeIsomorphism (idToIso A B) → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
open Univalence ℂ public
|
univalenceFromIsomorphism = fromIso _ _
|
||||||
field
|
|
||||||
assoc : IsAssociative
|
|
||||||
ident : IsIdentity 𝟙
|
|
||||||
arrowIsSet : ∀ {A B : Object} → isSet (Arrow A B)
|
|
||||||
univalent : Univalent ident
|
|
||||||
|
|
||||||
-- `IsCategory` is a mere proposition.
|
-- A perhaps more readable version of univalence:
|
||||||
module _ {ℓa ℓb : Level} {C : RawCategory ℓa ℓb} where
|
Univalent≃ = {A B : Object} → (A ≡ B) ≃ (A ≊ B)
|
||||||
open RawCategory C
|
Univalent≅ = {A B : Object} → (A ≡ B) ≅ (A ≊ B)
|
||||||
module _ (ℂ : IsCategory C) where
|
|
||||||
open IsCategory ℂ
|
|
||||||
open import Cubical.NType
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
propIsAssociative : isProp IsAssociative
|
|
||||||
propIsAssociative x y i = arrowIsSet _ _ x y i
|
|
||||||
|
|
||||||
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
|
||||||
propIsIdentity a b i
|
|
||||||
= arrowIsSet _ _ (fst a) (fst b) i
|
|
||||||
, arrowIsSet _ _ (snd a) (snd b) i
|
|
||||||
|
|
||||||
propArrowIsSet : isProp (∀ {A B} → isSet (Arrow A B))
|
|
||||||
propArrowIsSet a b i = isSetIsProp a b i
|
|
||||||
|
|
||||||
propIsInverseOf : ∀ {A B f g} → isProp (IsInverseOf {A} {B} f g)
|
|
||||||
propIsInverseOf x y = λ i →
|
|
||||||
let
|
|
||||||
h : fst x ≡ fst y
|
|
||||||
h = arrowIsSet _ _ (fst x) (fst y)
|
|
||||||
hh : snd x ≡ snd y
|
|
||||||
hh = arrowIsSet _ _ (snd x) (snd y)
|
|
||||||
in h i , hh i
|
|
||||||
|
|
||||||
module _ {A B : Object} {f : Arrow A B} where
|
|
||||||
isoIsProp : isProp (Isomorphism f)
|
|
||||||
isoIsProp a@(g , η , ε) a'@(g' , η' , ε') =
|
|
||||||
lemSig (λ g → propIsInverseOf) a a' geq
|
|
||||||
where
|
|
||||||
open Cubical.NType.Properties
|
|
||||||
geq : g ≡ g'
|
|
||||||
geq = begin
|
|
||||||
g ≡⟨ sym (fst ident) ⟩
|
|
||||||
g ∘ 𝟙 ≡⟨ cong (λ φ → g ∘ φ) (sym ε') ⟩
|
|
||||||
g ∘ (f ∘ g') ≡⟨ assoc ⟩
|
|
||||||
(g ∘ f) ∘ g' ≡⟨ cong (λ φ → φ ∘ g') η ⟩
|
|
||||||
𝟙 ∘ g' ≡⟨ snd ident ⟩
|
|
||||||
g' ∎
|
|
||||||
|
|
||||||
propUnivalent : isProp (Univalent ident)
|
|
||||||
propUnivalent a b i = propPi (λ iso → propHasLevel ⟨-2⟩) a b i
|
|
||||||
|
|
||||||
private
|
private
|
||||||
module _ (x y : IsCategory C) where
|
-- | Equivalent formulation of univalence.
|
||||||
module IC = IsCategory
|
Univalent[Contr] : Set _
|
||||||
module X = IsCategory x
|
Univalent[Contr] = ∀ A → isContr (Σ[ X ∈ Object ] A ≊ X)
|
||||||
module Y = IsCategory y
|
|
||||||
open Univalence C
|
from[Contr] : Univalent[Contr] → Univalent
|
||||||
|
from[Contr] = ContrToUniv.lemma _ _
|
||||||
|
where
|
||||||
|
open import Cubical.Fiberwise
|
||||||
|
|
||||||
|
univalenceFrom≃ : Univalent≃ → Univalent
|
||||||
|
univalenceFrom≃ = from[Contr] ∘ step
|
||||||
|
where
|
||||||
|
module _ (f : Univalent≃) (A : Object) where
|
||||||
|
lem : Σ Object (A ≡_) ≃ Σ Object (A ≊_)
|
||||||
|
lem = equivSig λ _ → f
|
||||||
|
|
||||||
|
aux : isContr (Σ Object (A ≡_))
|
||||||
|
aux = (A , refl) , (λ y → contrSingl (snd y))
|
||||||
|
|
||||||
|
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 = propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl (λ _ → propPiImpl λ _ → arrowsAreSets _ _))))))
|
||||||
|
|
||||||
|
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
||||||
|
propIsIdentity {id} = propPiImpl (λ _ → propPiImpl λ _ → propPiImpl (λ f →
|
||||||
|
propSig (arrowsAreSets (id <<< f) f) λ _ → arrowsAreSets (f <<< id) f))
|
||||||
|
|
||||||
|
propArrowIsSet : isProp (∀ {A B} → isSet (Arrow A B))
|
||||||
|
propArrowIsSet = propPiImpl λ _ → propPiImpl (λ _ → isSetIsProp)
|
||||||
|
|
||||||
|
propIsInverseOf : ∀ {A B f g} → isProp (IsInverseOf {A} {B} f g)
|
||||||
|
propIsInverseOf = propSig (arrowsAreSets _ _) (λ _ → arrowsAreSets _ _)
|
||||||
|
|
||||||
|
module _ {A B : Object} where
|
||||||
|
propIsomorphism : (f : Arrow A B) → isProp (Isomorphism f)
|
||||||
|
propIsomorphism f a@(g , η , ε) a'@(g' , η' , ε') =
|
||||||
|
lemSig (λ g → propIsInverseOf) a a' geq
|
||||||
|
where
|
||||||
|
geq : g ≡ g'
|
||||||
|
geq = begin
|
||||||
|
g ≡⟨ sym rightIdentity ⟩
|
||||||
|
g <<< identity ≡⟨ cong (λ φ → g <<< φ) (sym ε') ⟩
|
||||||
|
g <<< (f <<< g') ≡⟨ isAssociative ⟩
|
||||||
|
(g <<< f) <<< g' ≡⟨ cong (λ φ → φ <<< g') η ⟩
|
||||||
|
identity <<< g' ≡⟨ leftIdentity ⟩
|
||||||
|
g' ∎
|
||||||
|
|
||||||
|
isoEq : {a b : A ≊ B} → fst a ≡ fst b → a ≡ b
|
||||||
|
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
|
||||||
|
module _ (x y : IsPreCategory ℂ) where
|
||||||
|
module x = IsPreCategory x
|
||||||
|
module y = IsPreCategory y
|
||||||
-- 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.
|
||||||
ident : (λ _ → IsIdentity 𝟙) [ X.ident ≡ Y.ident ]
|
-- module Prop = X.Propositionality
|
||||||
ident = propIsIdentity x X.ident Y.ident
|
|
||||||
done : x ≡ y
|
|
||||||
U : ∀ {a : IsIdentity 𝟙} → (λ _ → IsIdentity 𝟙) [ X.ident ≡ a ] → (b : Univalent a) → Set _
|
|
||||||
U eqwal bbb = (λ i → Univalent (eqwal i)) [ X.univalent ≡ bbb ]
|
|
||||||
P : (y : IsIdentity 𝟙)
|
|
||||||
→ (λ _ → IsIdentity 𝟙) [ X.ident ≡ y ] → Set _
|
|
||||||
P y eq = ∀ (b' : Univalent y) → U eq b'
|
|
||||||
helper : ∀ (b' : Univalent X.ident)
|
|
||||||
→ (λ _ → Univalent X.ident) [ X.univalent ≡ b' ]
|
|
||||||
helper univ = propUnivalent x X.univalent univ
|
|
||||||
foo = pathJ P helper Y.ident ident
|
|
||||||
eqUni : U ident Y.univalent
|
|
||||||
eqUni = foo Y.univalent
|
|
||||||
IC.assoc (done i) = propIsAssociative x X.assoc Y.assoc i
|
|
||||||
IC.ident (done i) = ident i
|
|
||||||
IC.arrowIsSet (done i) = propArrowIsSet x X.arrowIsSet Y.arrowIsSet i
|
|
||||||
IC.univalent (done i) = eqUni i
|
|
||||||
|
|
||||||
propIsCategory : isProp (IsCategory C)
|
propIsPreCategory : x ≡ y
|
||||||
|
IsPreCategory.isAssociative (propIsPreCategory i)
|
||||||
|
= x.propIsAssociative x.isAssociative y.isAssociative i
|
||||||
|
IsPreCategory.isIdentity (propIsPreCategory i)
|
||||||
|
= x.propIsIdentity x.isIdentity y.isIdentity i
|
||||||
|
IsPreCategory.arrowsAreSets (propIsPreCategory i)
|
||||||
|
= x.propArrowIsSet x.arrowsAreSets y.arrowsAreSets i
|
||||||
|
|
||||||
|
module _ (x y : IsCategory ℂ) where
|
||||||
|
module X = IsCategory x
|
||||||
|
module Y = IsCategory y
|
||||||
|
-- In a few places I use the result of propositionality of the various
|
||||||
|
-- projections of `IsCategory` - Here I arbitrarily chose to use this
|
||||||
|
-- result from `x : IsCategory C`. I don't know which (if any) possibly
|
||||||
|
-- adverse effects this may have.
|
||||||
|
|
||||||
|
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
|
||||||
|
IsCategory.isPreCategory (done i) = isPreCategory= i
|
||||||
|
IsCategory.univalent (done i) = univalent= i
|
||||||
|
|
||||||
|
propIsCategory : isProp (IsCategory ℂ)
|
||||||
propIsCategory = done
|
propIsCategory = done
|
||||||
|
|
||||||
|
|
||||||
|
-- | Univalent categories
|
||||||
|
--
|
||||||
|
-- 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
|
||||||
{{isCategory}} : IsCategory raw
|
{{isCategory}} : IsCategory raw
|
||||||
|
|
||||||
open RawCategory raw public
|
|
||||||
open IsCategory isCategory public
|
open IsCategory isCategory public
|
||||||
|
|
||||||
|
-- The fact that being a category is a mere proposition gives rise to this
|
||||||
|
-- equality principle for categories.
|
||||||
|
module _ {ℓa ℓb : Level} {ℂ 𝔻 : Category ℓa ℓb} where
|
||||||
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
|
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
||||||
|
private
|
||||||
|
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
||||||
|
isCategoryEq = lemPropF {A = RawCategory _ _} {B = IsCategory} propIsCategory rawEq
|
||||||
|
|
||||||
|
Category≡ : ℂ ≡ 𝔻
|
||||||
|
Category.raw (Category≡ i) = rawEq i
|
||||||
|
Category.isCategory (Category≡ i) = isCategoryEq i
|
||||||
|
|
||||||
|
-- | 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
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
_[_,_] : (A : Object) → (B : Object) → Set ℓb
|
_[_,_] : (A : Object) → (B : Object) → Set ℓb
|
||||||
_[_,_] = 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
|
||||||
_[_∘_] = _∘_
|
_[_∘_] = _<<<_
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
|
||||||
private
|
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
OpRaw : RawCategory ℓa ℓb
|
|
||||||
RawCategory.Object OpRaw = Object
|
|
||||||
RawCategory.Arrow OpRaw = Function.flip Arrow
|
|
||||||
RawCategory.𝟙 OpRaw = 𝟙
|
|
||||||
RawCategory._∘_ OpRaw = Function.flip _∘_
|
|
||||||
|
|
||||||
OpIsCategory : IsCategory OpRaw
|
|
||||||
IsCategory.assoc OpIsCategory = sym assoc
|
|
||||||
IsCategory.ident OpIsCategory = swap ident
|
|
||||||
IsCategory.arrowIsSet OpIsCategory = arrowIsSet
|
|
||||||
IsCategory.univalent OpIsCategory = {!!}
|
|
||||||
|
|
||||||
Opposite : Category ℓa ℓb
|
|
||||||
raw Opposite = OpRaw
|
|
||||||
Category.isCategory Opposite = OpIsCategory
|
|
||||||
|
|
||||||
-- 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 more than 20!!
|
|
||||||
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
|
||||||
private
|
|
||||||
open RawCategory
|
|
||||||
module C = Category ℂ
|
|
||||||
rawOp : Category.raw (Opposite (Opposite ℂ)) ≡ Category.raw ℂ
|
|
||||||
Object (rawOp _) = C.Object
|
|
||||||
Arrow (rawOp _) = C.Arrow
|
|
||||||
𝟙 (rawOp _) = C.𝟙
|
|
||||||
_∘_ (rawOp _) = C._∘_
|
|
||||||
open Category
|
|
||||||
open IsCategory
|
|
||||||
module IsCat = IsCategory (ℂ .isCategory)
|
|
||||||
rawIsCat : (i : I) → IsCategory (rawOp i)
|
|
||||||
assoc (rawIsCat i) = IsCat.assoc
|
|
||||||
ident (rawIsCat i) = IsCat.ident
|
|
||||||
arrowIsSet (rawIsCat i) = IsCat.arrowIsSet
|
|
||||||
univalent (rawIsCat i) = IsCat.univalent
|
|
||||||
|
|
||||||
Opposite-is-involution : Opposite (Opposite ℂ) ≡ ℂ
|
|
||||||
raw (Opposite-is-involution i) = rawOp i
|
|
||||||
isCategory (Opposite-is-involution i) = rawIsCat i
|
|
||||||
|
|
|
@ -1,46 +0,0 @@
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
|
||||||
|
|
||||||
module Cat.Category.Bij where
|
|
||||||
|
|
||||||
open import Cubical hiding ( Id )
|
|
||||||
open import Cubical.FromStdLib
|
|
||||||
|
|
||||||
module _ {A : Set} {a : A} {P : A → Set} where
|
|
||||||
Q : A → Set
|
|
||||||
Q a = A
|
|
||||||
|
|
||||||
t : Σ[ a ∈ A ] P a → Q a
|
|
||||||
t (a , Pa) = a
|
|
||||||
u : Q a → Σ[ a ∈ A ] P a
|
|
||||||
u a = a , {!!}
|
|
||||||
|
|
||||||
tu-bij : (a : Q a) → (t ∘ u) a ≡ a
|
|
||||||
tu-bij a = refl
|
|
||||||
|
|
||||||
v : P a → Q a
|
|
||||||
v x = {!!}
|
|
||||||
w : Q a → P a
|
|
||||||
w x = {!!}
|
|
||||||
|
|
||||||
vw-bij : (a : P a) → (w ∘ v) a ≡ a
|
|
||||||
vw-bij a = {!!}
|
|
||||||
-- tubij a with (t ∘ u) a
|
|
||||||
-- ... | q = {!!}
|
|
||||||
|
|
||||||
data Id {A : Set} (a : A) : Set where
|
|
||||||
id : A → Id a
|
|
||||||
|
|
||||||
data Id' {A : Set} (a : A) : Set where
|
|
||||||
id' : A → Id' a
|
|
||||||
|
|
||||||
T U : Set
|
|
||||||
T = Id a
|
|
||||||
U = Id' a
|
|
||||||
|
|
||||||
f : T → U
|
|
||||||
f (id x) = id' x
|
|
||||||
g : U → T
|
|
||||||
g (id' x) = id x
|
|
||||||
|
|
||||||
fg-bij : (x : U) → (f ∘ g) x ≡ x
|
|
||||||
fg-bij (id' x) = {!!}
|
|
|
@ -1,39 +1,42 @@
|
||||||
module Cat.Category.Exponential where
|
module Cat.Category.Exponential where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude hiding (_×_)
|
||||||
open import Data.Product
|
|
||||||
open import Cubical
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
|
|
||||||
open Category
|
|
||||||
|
|
||||||
module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where
|
module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where
|
||||||
open HasProducts hasProducts
|
open Category ℂ
|
||||||
open Product hiding (obj)
|
open HasProducts hasProducts public
|
||||||
private
|
|
||||||
_×p_ : (A B : Object ℂ) → Object ℂ
|
|
||||||
_×p_ A B = Product.obj (product A B)
|
|
||||||
|
|
||||||
module _ (B C : Object ℂ) where
|
module _ (B C : Object) where
|
||||||
IsExponential : (Cᴮ : Object ℂ) → ℂ [ Cᴮ ×p B , C ] → Set (ℓ ⊔ ℓ')
|
record IsExponential'
|
||||||
IsExponential Cᴮ eval = ∀ (A : Object ℂ) (f : ℂ [ A ×p B , C ])
|
(Cᴮ : Object)
|
||||||
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.𝟙 ℂ ] ≡ f)
|
(eval : ℂ [ Cᴮ × B , C ]) : Set (ℓ ⊔ ℓ') where
|
||||||
|
field
|
||||||
|
uniq
|
||||||
|
: ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
|
IsExponential : (Cᴮ : Object) → ℂ [ Cᴮ × B , C ] → Set (ℓ ⊔ ℓ')
|
||||||
|
IsExponential Cᴮ eval = ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
record Exponential : Set (ℓ ⊔ ℓ') where
|
record Exponential : Set (ℓ ⊔ ℓ') where
|
||||||
field
|
field
|
||||||
-- obj ≡ Cᴮ
|
-- obj ≡ Cᴮ
|
||||||
obj : Object ℂ
|
obj : Object
|
||||||
eval : ℂ [ obj ×p B , C ]
|
eval : ℂ [ obj × B , C ]
|
||||||
{{isExponential}} : IsExponential obj eval
|
{{isExponential}} : IsExponential obj eval
|
||||||
-- If I make this an instance-argument then the instance resolution
|
|
||||||
-- algorithm goes into an infinite loop. Why?
|
transpose : (A : Object) → ℂ [ A × B , C ] → ℂ [ A , obj ]
|
||||||
exponentialsHaveProducts : HasProducts ℂ
|
transpose A f = fst (isExponential A f)
|
||||||
exponentialsHaveProducts = hasProducts
|
|
||||||
transpose : (A : Object ℂ) → ℂ [ A ×p B , C ] → ℂ [ A , obj ]
|
|
||||||
transpose A f = proj₁ (isExponential A f)
|
|
||||||
|
|
||||||
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
||||||
|
open Category ℂ
|
||||||
|
open Exponential public
|
||||||
field
|
field
|
||||||
exponent : (A B : Object ℂ) → Exponential ℂ A B
|
exponent : (A B : Object) → Exponential ℂ A B
|
||||||
|
|
||||||
|
_⇑_ : (A B : Object) → Object
|
||||||
|
A ⇑ B = (exponent A B) .obj
|
||||||
|
|
|
@ -1,64 +1,92 @@
|
||||||
{-# 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)
|
|
||||||
|
|
||||||
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
|
||||||
|
Fmap : Omap → Set _
|
||||||
|
Fmap omap = ∀ {A B}
|
||||||
|
→ ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
record RawFunctor : 𝓤 where
|
record RawFunctor : 𝓤 where
|
||||||
field
|
field
|
||||||
func* : Object ℂ → Object 𝔻
|
omap : ℂ.Object → 𝔻.Object
|
||||||
func→ : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ func* A , func* B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
|
|
||||||
|
IsIdentity : Set _
|
||||||
|
IsIdentity = {A : ℂ.Object} → fmap (ℂ.identity {A}) ≡ 𝔻.identity {omap A}
|
||||||
|
|
||||||
|
IsDistributive : Set _
|
||||||
|
IsDistributive = {A B C : ℂ.Object} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
||||||
|
→ fmap (ℂ [ g ∘ f ]) ≡ 𝔻 [ fmap g ∘ fmap f ]
|
||||||
|
|
||||||
|
-- | Equality principle for raw functors
|
||||||
|
--
|
||||||
|
-- The type of `fmap` depend on the value of `omap`. We can wrap this up
|
||||||
|
-- into an equality principle for this type like is done for e.g. `Σ` using
|
||||||
|
-- `pathJ`.
|
||||||
|
module _ {x y : RawFunctor} where
|
||||||
|
open RawFunctor
|
||||||
|
private
|
||||||
|
P : (omap' : Omap) → (eq : omap x ≡ omap') → Set _
|
||||||
|
P y eq = (fmap' : Fmap y) → (λ i → Fmap (eq i))
|
||||||
|
[ fmap x ≡ fmap' ]
|
||||||
|
module _
|
||||||
|
(eq : (λ i → Omap) [ omap x ≡ omap y ])
|
||||||
|
(kk : P (omap x) refl)
|
||||||
|
where
|
||||||
|
private
|
||||||
|
p : P (omap y) eq
|
||||||
|
p = pathJ P kk (omap y) eq
|
||||||
|
eq→ : (λ i → Fmap (eq i)) [ fmap x ≡ fmap y ]
|
||||||
|
eq→ = p (fmap y)
|
||||||
|
RawFunctor≡ : x ≡ y
|
||||||
|
omap (RawFunctor≡ i) = eq i
|
||||||
|
fmap (RawFunctor≡ i) = eq→ i
|
||||||
|
|
||||||
record IsFunctor (F : RawFunctor) : 𝓤 where
|
record IsFunctor (F : RawFunctor) : 𝓤 where
|
||||||
open RawFunctor F
|
open RawFunctor F public
|
||||||
field
|
field
|
||||||
ident : {c : Object ℂ} → func→ (𝟙 ℂ {c}) ≡ 𝟙 𝔻 {func* c}
|
-- FIXME Really ought to be preserves identity or something like this.
|
||||||
distrib : {A B C : Object ℂ} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
isIdentity : IsIdentity
|
||||||
→ func→ (ℂ [ g ∘ f ]) ≡ 𝔻 [ func→ g ∘ func→ f ]
|
isDistributive : IsDistributive
|
||||||
|
|
||||||
record Functor : Set (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') where
|
record Functor : Set (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') where
|
||||||
field
|
field
|
||||||
raw : RawFunctor
|
raw : RawFunctor
|
||||||
{{isFunctor}} : IsFunctor raw
|
{{isFunctor}} : IsFunctor raw
|
||||||
|
|
||||||
private
|
open IsFunctor isFunctor public
|
||||||
module R = RawFunctor raw
|
|
||||||
|
|
||||||
func* : Object ℂ → Object 𝔻
|
EndoFunctor : ∀ {ℓa ℓb} (ℂ : Category ℓa ℓb) → Set _
|
||||||
func* = R.func*
|
EndoFunctor ℂ = Functor ℂ ℂ
|
||||||
|
|
||||||
func→ : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ func* A , func* B ]
|
|
||||||
func→ = R.func→
|
|
||||||
|
|
||||||
open IsFunctor
|
|
||||||
open 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
|
||||||
module 𝔻 = IsCategory (isCategory 𝔻)
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
propIsFunctor : isProp (IsFunctor _ _ F)
|
propIsFunctor : isProp (IsFunctor _ _ F)
|
||||||
propIsFunctor isF0 isF1 i = record
|
propIsFunctor isF0 isF1 i = record
|
||||||
{ ident = 𝔻.arrowIsSet _ _ isF0.ident isF1.ident i
|
{ isIdentity = 𝔻.arrowsAreSets _ _ isF0.isIdentity isF1.isIdentity i
|
||||||
; distrib = 𝔻.arrowIsSet _ _ isF0.distrib isF1.distrib i
|
; isDistributive = 𝔻.arrowsAreSets _ _ isF0.isDistributive isF1.isDistributive i
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
module isF0 = IsFunctor isF0
|
module isF0 = IsFunctor isF0
|
||||||
|
@ -66,78 +94,107 @@ 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
|
||||||
module 𝔻 = IsCategory (isCategory 𝔻)
|
module 𝔻 = Category 𝔻
|
||||||
IsProp' : {ℓ : Level} (A : I → Set ℓ) → Set ℓ
|
IsProp' : {ℓ : Level} (A : I → Set ℓ) → Set ℓ
|
||||||
IsProp' A = (a0 : A i0) (a1 : A i1) → A [ a0 ≡ a1 ]
|
IsProp' A = (a0 : A i0) (a1 : A i1) → A [ a0 ≡ a1 ]
|
||||||
|
|
||||||
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 = 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 ℂ 𝔻}
|
||||||
→ (eq* : func* F ≡ func* G)
|
→ Functor.raw F ≡ Functor.raw G
|
||||||
→ (eq→ : (λ i → ∀ {x y} → ℂ [ x , y ] → 𝔻 [ eq* i x , eq* i y ])
|
|
||||||
[ func→ F ≡ func→ G ])
|
|
||||||
→ F ≡ G
|
→ F ≡ G
|
||||||
Functor≡ {F} {G} eq* eq→ i = record
|
Functor.raw (Functor≡ eq i) = eq i
|
||||||
{ raw = eqR i
|
Functor.isFunctor (Functor≡ {F} {G} eq i)
|
||||||
; isFunctor = eqIsF i
|
= res i
|
||||||
}
|
|
||||||
where
|
where
|
||||||
eqR : raw F ≡ raw G
|
res : (λ i → IsFunctor ℂ 𝔻 (eq i)) [ isFunctor F ≡ isFunctor G ]
|
||||||
eqR i = record { func* = eq* i ; func→ = eq→ i }
|
res = IsFunctorIsProp' (isFunctor F) (isFunctor G)
|
||||||
eqIsF : (λ i → IsFunctor ℂ 𝔻 (eqR i)) [ isFunctor F ≡ isFunctor G ]
|
|
||||||
eqIsF = 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* = func* F
|
module A = Category A
|
||||||
F→ = func→ F
|
module B = Category B
|
||||||
G* = func* G
|
module C = Category C
|
||||||
G→ = func→ 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→ (G .isFunctor .distrib)⟩
|
≡⟨ refl ⟩
|
||||||
F→ (B [ G→ α1 ∘ G→ α0 ]) ≡⟨ F .isFunctor .distrib ⟩
|
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.func* _∘fr_ = F* ∘ G*
|
RawFunctor.omap raw = F.omap ∘ G.omap
|
||||||
RawFunctor.func→ _∘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
|
||||||
{ ident = begin
|
{ isIdentity = begin
|
||||||
(F→ ∘ G→) (𝟙 A) ≡⟨ refl ⟩
|
(F.fmap ∘ G.fmap) A.identity ≡⟨ refl ⟩
|
||||||
F→ (G→ (𝟙 A)) ≡⟨ cong F→ (G .isFunctor .ident)⟩
|
F.fmap (G.fmap A.identity) ≡⟨ cong F.fmap (G.isIdentity)⟩
|
||||||
F→ (𝟙 B) ≡⟨ F .isFunctor .ident ⟩
|
F.fmap B.identity ≡⟨ F.isIdentity ⟩
|
||||||
𝟙 C ∎
|
C.identity ∎
|
||||||
; distrib = 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
|
||||||
{ func* = λ x → x
|
raw : RawFunctor ℂ ℂ
|
||||||
; func→ = λ x → x
|
RawFunctor.omap raw = idFun _
|
||||||
}
|
RawFunctor.fmap raw = idFun _
|
||||||
; isFunctor = record
|
|
||||||
{ ident = refl
|
isFunctor : IsFunctor ℂ ℂ raw
|
||||||
; distrib = 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
|
||||||
|
|
240
src/Cat/Category/Monad.agda
Normal file
240
src/Cat/Category/Monad.agda
Normal file
|
@ -0,0 +1,240 @@
|
||||||
|
{---
|
||||||
|
Monads
|
||||||
|
|
||||||
|
This module presents two formulations of monads:
|
||||||
|
|
||||||
|
* The standard monoidal presentation
|
||||||
|
* Kleisli's presentation
|
||||||
|
|
||||||
|
The first one defines a monad in terms of an endofunctor and two natural
|
||||||
|
transformations. The second defines it in terms of a function on objects and a
|
||||||
|
pair of arrows.
|
||||||
|
|
||||||
|
These two formulations are proven to be equivalent:
|
||||||
|
|
||||||
|
Monoidal.Monad ≃ Kleisli.Monad
|
||||||
|
|
||||||
|
The monoidal representation is exposed by default from this module.
|
||||||
|
---}
|
||||||
|
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
module Cat.Category.Monad where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor as F
|
||||||
|
import Cat.Category.NaturalTransformation
|
||||||
|
import Cat.Category.Monad.Monoidal
|
||||||
|
import Cat.Category.Monad.Kleisli
|
||||||
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
|
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ using (NaturalTransformation ; propIsNatural)
|
||||||
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
open ℂ using (Object ; Arrow ; identity ; _<<<_ ; _>>>_)
|
||||||
|
|
||||||
|
module Monoidal = Cat.Category.Monad.Monoidal ℂ
|
||||||
|
module Kleisli = Cat.Category.Monad.Kleisli ℂ
|
||||||
|
|
||||||
|
module _ (m : Monoidal.RawMonad) where
|
||||||
|
open Monoidal.RawMonad m
|
||||||
|
|
||||||
|
toKleisliRaw : Kleisli.RawMonad
|
||||||
|
Kleisli.RawMonad.omap toKleisliRaw = Romap
|
||||||
|
Kleisli.RawMonad.pure toKleisliRaw = pure
|
||||||
|
Kleisli.RawMonad.bind toKleisliRaw = bind
|
||||||
|
|
||||||
|
module _ {raw : Monoidal.RawMonad} (m : Monoidal.IsMonad raw) where
|
||||||
|
open Monoidal.IsMonad m
|
||||||
|
|
||||||
|
open Kleisli.RawMonad (toKleisliRaw raw) using (_>=>_)
|
||||||
|
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
|
||||||
|
|
||||||
|
toKleisli : Monoidal.Monad → Kleisli.Monad
|
||||||
|
Kleisli.Monad.raw (toKleisli m) = toKleisliRaw (Monoidal.Monad.raw m)
|
||||||
|
Kleisli.Monad.isMonad (toKleisli m) = toKleisliIsMonad (Monoidal.Monad.isMonad m)
|
||||||
|
|
||||||
|
module _ (m : Kleisli.Monad) where
|
||||||
|
open Kleisli.Monad m
|
||||||
|
|
||||||
|
toMonoidalRaw : Monoidal.RawMonad
|
||||||
|
Monoidal.RawMonad.R toMonoidalRaw = R
|
||||||
|
Monoidal.RawMonad.pureNT toMonoidalRaw = pureNT
|
||||||
|
Monoidal.RawMonad.joinNT toMonoidalRaw = joinNT
|
||||||
|
|
||||||
|
open Monoidal.RawMonad toMonoidalRaw renaming
|
||||||
|
( join to join*
|
||||||
|
; 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
|
||||||
|
inv-l = begin
|
||||||
|
join <<< pure ≡⟨ fst isInverse ⟩
|
||||||
|
identity ∎
|
||||||
|
inv-r = begin
|
||||||
|
join* <<< fmap* pure* ≡⟨⟩
|
||||||
|
join <<< fmap pure ≡⟨ snd isInverse ⟩
|
||||||
|
identity ∎
|
||||||
|
|
||||||
|
toMonoidal : Kleisli.Monad → Monoidal.Monad
|
||||||
|
Monoidal.Monad.raw (toMonoidal m) = toMonoidalRaw m
|
||||||
|
Monoidal.Monad.isMonad (toMonoidal m) = toMonoidalIsMonad m
|
||||||
|
|
||||||
|
module _ (m : Kleisli.Monad) where
|
||||||
|
private
|
||||||
|
open Kleisli.Monad m
|
||||||
|
bindEq : ∀ {X Y}
|
||||||
|
→ Kleisli.RawMonad.bind (toKleisliRaw (toMonoidalRaw m)) {X} {Y}
|
||||||
|
≡ bind
|
||||||
|
bindEq {X} {Y} = funExt lem
|
||||||
|
where
|
||||||
|
lem : (f : Arrow X (omap Y))
|
||||||
|
→ bind (f >>> pure) >>> bind identity
|
||||||
|
≡ bind f
|
||||||
|
lem f = begin
|
||||||
|
join <<< fmap f
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> pure) >>> bind identity
|
||||||
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
bind ((f >>> pure) >=> identity)
|
||||||
|
≡⟨⟩
|
||||||
|
bind ((f >>> pure) >>> bind identity)
|
||||||
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
|
bind (f >>> (pure >>> bind identity))
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> (pure >=> identity))
|
||||||
|
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
||||||
|
bind (f >>> identity)
|
||||||
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
|
bind f ∎
|
||||||
|
|
||||||
|
toKleisliRawEq : toKleisliRaw (toMonoidalRaw m) ≡ Kleisli.Monad.raw m
|
||||||
|
Kleisli.RawMonad.omap (toKleisliRawEq i) = (begin
|
||||||
|
Kleisli.RawMonad.omap (toKleisliRaw (toMonoidalRaw m)) ≡⟨⟩
|
||||||
|
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
|
||||||
|
|
||||||
|
toKleislieq : (m : Kleisli.Monad) → toKleisli (toMonoidal m) ≡ m
|
||||||
|
toKleislieq m = Kleisli.Monad≡ (toKleisliRawEq m)
|
||||||
|
|
||||||
|
module _ (m : Monoidal.Monad) where
|
||||||
|
private
|
||||||
|
open Monoidal.Monad 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
|
||||||
|
omapEq : omap* ≡ Romap
|
||||||
|
omapEq = refl
|
||||||
|
|
||||||
|
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → bind* f ≡ bind f
|
||||||
|
bindEq {X} {Y} {f} = begin
|
||||||
|
bind* f ≡⟨⟩
|
||||||
|
join <<< fmap f ≡⟨⟩
|
||||||
|
bind f ∎
|
||||||
|
|
||||||
|
joinEq : ∀ {X} → join* ≡ joinT X
|
||||||
|
joinEq {X} = begin
|
||||||
|
join* ≡⟨⟩
|
||||||
|
bind* identity ≡⟨⟩
|
||||||
|
bind identity ≡⟨⟩
|
||||||
|
join <<< fmap identity ≡⟨ cong (λ φ → _ <<< φ) R.isIdentity ⟩
|
||||||
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
|
join ∎
|
||||||
|
|
||||||
|
fmapEq : ∀ {A B} → fmap* {A} {B} ≡ fmap
|
||||||
|
fmapEq {A} {B} = funExt (λ f → begin
|
||||||
|
fmap* f ≡⟨⟩
|
||||||
|
bind* (f >>> pure*) ≡⟨⟩
|
||||||
|
bind (f >>> pure) ≡⟨⟩
|
||||||
|
fmap (f >>> pure) >>> join ≡⟨⟩
|
||||||
|
fmap (f >>> pure) >>> join ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
||||||
|
fmap f >>> fmap pure >>> join ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
join <<< fmap pure <<< fmap f ≡⟨ cong (λ φ → φ <<< fmap f) (snd isInverse) ⟩
|
||||||
|
identity <<< fmap f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
|
fmap f ∎
|
||||||
|
)
|
||||||
|
|
||||||
|
rawEq : Functor.raw R* ≡ Functor.raw R
|
||||||
|
RawFunctor.omap (rawEq i) = omapEq i
|
||||||
|
RawFunctor.fmap (rawEq i) = fmapEq i
|
||||||
|
|
||||||
|
Req : Monoidal.RawMonad.R (toMonoidalRaw (toKleisli m)) ≡ R
|
||||||
|
Req = Functor≡ rawEq
|
||||||
|
|
||||||
|
pureTEq : Monoidal.RawMonad.pureT (toMonoidalRaw (toKleisli m)) ≡ pureT
|
||||||
|
pureTEq = refl
|
||||||
|
|
||||||
|
pureNTEq : (λ i → NaturalTransformation Functors.identity (Req i))
|
||||||
|
[ Monoidal.RawMonad.pureNT (toMonoidalRaw (toKleisli m)) ≡ pureNT ]
|
||||||
|
pureNTEq = lemSigP (λ i → propIsNatural Functors.identity (Req i)) _ _ pureTEq
|
||||||
|
|
||||||
|
joinTEq : Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) ≡ joinT
|
||||||
|
joinTEq = funExt (λ X → begin
|
||||||
|
Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) X ≡⟨⟩
|
||||||
|
join* ≡⟨⟩
|
||||||
|
join <<< fmap identity ≡⟨ cong (λ φ → join <<< φ) R.isIdentity ⟩
|
||||||
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
|
join ∎)
|
||||||
|
|
||||||
|
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||||
|
[ Monoidal.RawMonad.joinNT (toMonoidalRaw (toKleisli m)) ≡ joinNT ]
|
||||||
|
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
||||||
|
|
||||||
|
toMonoidalRawEq : toMonoidalRaw (toKleisli m) ≡ Monoidal.Monad.raw m
|
||||||
|
Monoidal.RawMonad.R (toMonoidalRawEq i) = Req i
|
||||||
|
Monoidal.RawMonad.pureNT (toMonoidalRawEq i) = pureNTEq i
|
||||||
|
Monoidal.RawMonad.joinNT (toMonoidalRawEq i) = joinNTEq i
|
||||||
|
|
||||||
|
toMonoidaleq : (m : Monoidal.Monad) → toMonoidal (toKleisli m) ≡ m
|
||||||
|
toMonoidaleq m = Monoidal.Monad≡ (toMonoidalRawEq m)
|
||||||
|
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
|
Monoidal≊Kleisli : Monoidal.Monad ≅ Kleisli.Monad
|
||||||
|
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
|
347
src/Cat/Category/Monad/Kleisli.agda
Normal file
347
src/Cat/Category/Monad/Kleisli.agda
Normal file
|
@ -0,0 +1,347 @@
|
||||||
|
{---
|
||||||
|
The Kleisli formulation of monads
|
||||||
|
---}
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
open import Agda.Primitive
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor as F
|
||||||
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
|
-- "A monad in the Kleisli form" [voe]
|
||||||
|
module Cat.Category.Monad.Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural)
|
||||||
|
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
open ℂ using (Arrow ; identity ; Object ; _<<<_ ; _>>>_)
|
||||||
|
|
||||||
|
-- | Data for a monad.
|
||||||
|
--
|
||||||
|
-- Note that (>>=) is not expressible in a general category because objects
|
||||||
|
-- are not generally types.
|
||||||
|
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 ]
|
||||||
|
|
||||||
|
-- | functor map
|
||||||
|
--
|
||||||
|
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
||||||
|
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
||||||
|
fmap f = bind (pure <<< f)
|
||||||
|
|
||||||
|
-- | Composition of monads aka. the kleisli-arrow.
|
||||||
|
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
||||||
|
f >=> g = f >>> (bind g)
|
||||||
|
|
||||||
|
-- | Flattening nested monads.
|
||||||
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
|
join = bind identity
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- * Monad laws --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
-- There may be better names than what I've chosen here.
|
||||||
|
|
||||||
|
-- `pure` is the neutral element for `bind`
|
||||||
|
IsIdentity = {X : Object}
|
||||||
|
→ bind pure ≡ identity {omap X}
|
||||||
|
-- pure is the left-identity for the kleisli arrow.
|
||||||
|
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
||||||
|
→ pure >=> f ≡ f
|
||||||
|
-- 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)
|
||||||
|
|
||||||
|
RightIdentity = {A B : Object} {m : ℂ [ A , omap B ]}
|
||||||
|
→ m >=> pure ≡ m
|
||||||
|
|
||||||
|
-- | Functor map fusion.
|
||||||
|
--
|
||||||
|
-- This is really a functor law. Should we have a kleisli-representation of
|
||||||
|
-- functors as well and make them a super-class?
|
||||||
|
Fusion = {X Y Z : Object} {g : ℂ [ Y , Z ]} {f : ℂ [ X , Y ]}
|
||||||
|
→ fmap (g <<< f) ≡ fmap g <<< fmap f
|
||||||
|
|
||||||
|
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
|
||||||
|
IsNaturalForeign : Set _
|
||||||
|
IsNaturalForeign = {X : Object} → join {X} <<< fmap join ≡ join <<< join
|
||||||
|
|
||||||
|
IsInverse : Set _
|
||||||
|
IsInverse = {X : Object} → join {X} <<< pure ≡ identity × join {X} <<< fmap pure ≡ identity
|
||||||
|
|
||||||
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
open RawMonad raw public
|
||||||
|
field
|
||||||
|
isIdentity : IsIdentity
|
||||||
|
isNatural : IsNatural
|
||||||
|
isDistributive : IsDistributive
|
||||||
|
|
||||||
|
-- | Map fusion is admissable.
|
||||||
|
fusion : Fusion
|
||||||
|
fusion {g = g} {f} = begin
|
||||||
|
fmap (g <<< f) ≡⟨⟩
|
||||||
|
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
|
bind (f >>> (g >>> pure))
|
||||||
|
≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
||||||
|
bind (f >>> (pure >>> (bind (g >>> pure))))
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
||||||
|
bind ((fmap g <<< pure) <<< f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
||||||
|
bind (fmap g <<< (pure <<< f)) ≡⟨ sym distrib ⟩
|
||||||
|
bind (pure <<< g) <<< bind (pure <<< f)
|
||||||
|
≡⟨⟩
|
||||||
|
fmap g <<< fmap f ∎
|
||||||
|
where
|
||||||
|
distrib : fmap g <<< fmap f ≡ bind (fmap g <<< (pure <<< f))
|
||||||
|
distrib = isDistributive (pure <<< g) (pure <<< f)
|
||||||
|
|
||||||
|
-- | This formulation gives rise to the following endo-functor.
|
||||||
|
private
|
||||||
|
rawR : RawFunctor ℂ ℂ
|
||||||
|
RawFunctor.omap rawR = omap
|
||||||
|
RawFunctor.fmap rawR = fmap
|
||||||
|
|
||||||
|
isFunctorR : IsFunctor ℂ ℂ rawR
|
||||||
|
IsFunctor.isIdentity isFunctorR = begin
|
||||||
|
bind (pure <<< identity) ≡⟨ cong bind (ℂ.rightIdentity) ⟩
|
||||||
|
bind pure ≡⟨ isIdentity ⟩
|
||||||
|
identity ∎
|
||||||
|
|
||||||
|
IsFunctor.isDistributive isFunctorR {f = f} {g} = begin
|
||||||
|
bind (pure <<< (g <<< f)) ≡⟨⟩
|
||||||
|
fmap (g <<< f) ≡⟨ fusion ⟩
|
||||||
|
fmap g <<< fmap f ≡⟨⟩
|
||||||
|
bind (pure <<< g) <<< bind (pure <<< f) ∎
|
||||||
|
|
||||||
|
-- FIXME Naming!
|
||||||
|
R : EndoFunctor ℂ
|
||||||
|
Functor.raw R = rawR
|
||||||
|
Functor.isFunctor R = isFunctorR
|
||||||
|
|
||||||
|
private
|
||||||
|
R⁰ : EndoFunctor ℂ
|
||||||
|
R⁰ = Functors.identity
|
||||||
|
R² : EndoFunctor ℂ
|
||||||
|
R² = F[ R ∘ R ]
|
||||||
|
module R = Functor R
|
||||||
|
module R⁰ = Functor R⁰
|
||||||
|
module R² = Functor R²
|
||||||
|
pureT : Transformation R⁰ R
|
||||||
|
pureT A = pure
|
||||||
|
pureN : Natural R⁰ R pureT
|
||||||
|
pureN {A} {B} f = begin
|
||||||
|
pureT B <<< R⁰.fmap f ≡⟨⟩
|
||||||
|
pure <<< f ≡⟨ sym (isNatural _) ⟩
|
||||||
|
bind (pure <<< f) <<< pure ≡⟨⟩
|
||||||
|
fmap f <<< pure ≡⟨⟩
|
||||||
|
R.fmap f <<< pureT A ∎
|
||||||
|
joinT : Transformation R² R
|
||||||
|
joinT C = join
|
||||||
|
joinN : Natural R² R joinT
|
||||||
|
joinN f = begin
|
||||||
|
join <<< R².fmap f ≡⟨⟩
|
||||||
|
bind identity <<< R².fmap f ≡⟨⟩
|
||||||
|
R².fmap f >>> bind identity ≡⟨⟩
|
||||||
|
fmap (fmap f) >>> bind identity ≡⟨⟩
|
||||||
|
fmap (bind (f >>> pure)) >>> bind identity ≡⟨⟩
|
||||||
|
bind (bind (f >>> pure) >>> pure) >>> bind identity
|
||||||
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
bind ((bind (f >>> pure) >>> pure) >=> identity)
|
||||||
|
≡⟨⟩
|
||||||
|
bind ((bind (f >>> pure) >>> pure) >>> bind identity)
|
||||||
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
|
bind (bind (f >>> pure) >>> (pure >>> bind identity))
|
||||||
|
≡⟨ cong (λ φ → bind (bind (f >>> pure) >>> φ)) (isNatural _) ⟩
|
||||||
|
bind (bind (f >>> pure) >>> identity)
|
||||||
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
|
bind (bind (f >>> pure))
|
||||||
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
|
bind (identity >>> bind (f >>> pure)) ≡⟨⟩
|
||||||
|
bind (identity >=> (f >>> pure))
|
||||||
|
≡⟨ sym (isDistributive _ _) ⟩
|
||||||
|
bind identity >>> bind (f >>> pure) ≡⟨⟩
|
||||||
|
bind identity >>> fmap f ≡⟨⟩
|
||||||
|
bind identity >>> R.fmap f ≡⟨⟩
|
||||||
|
R.fmap f <<< bind identity ≡⟨⟩
|
||||||
|
R.fmap f <<< join ∎
|
||||||
|
|
||||||
|
pureNT : NaturalTransformation R⁰ R
|
||||||
|
fst pureNT = pureT
|
||||||
|
snd pureNT = pureN
|
||||||
|
|
||||||
|
joinNT : NaturalTransformation R² R
|
||||||
|
fst joinNT = joinT
|
||||||
|
snd joinNT = joinN
|
||||||
|
|
||||||
|
isNaturalForeign : IsNaturalForeign
|
||||||
|
isNaturalForeign = begin
|
||||||
|
fmap join >>> join ≡⟨⟩
|
||||||
|
bind (join >>> pure) >>> bind identity
|
||||||
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
bind ((join >>> pure) >>> bind identity)
|
||||||
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
|
bind (join >>> (pure >>> bind identity))
|
||||||
|
≡⟨ cong (λ φ → bind (join >>> φ)) (isNatural _) ⟩
|
||||||
|
bind (join >>> identity)
|
||||||
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
|
bind join ≡⟨⟩
|
||||||
|
bind (bind identity)
|
||||||
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
|
bind (identity >>> bind identity) ≡⟨⟩
|
||||||
|
bind (identity >=> identity) ≡⟨ sym (isDistributive _ _) ⟩
|
||||||
|
bind identity >>> bind identity ≡⟨⟩
|
||||||
|
join >>> join ∎
|
||||||
|
|
||||||
|
isInverse : IsInverse
|
||||||
|
isInverse = inv-l , inv-r
|
||||||
|
where
|
||||||
|
inv-l = begin
|
||||||
|
pure >>> join ≡⟨⟩
|
||||||
|
pure >>> bind identity ≡⟨ isNatural _ ⟩
|
||||||
|
identity ∎
|
||||||
|
inv-r = begin
|
||||||
|
fmap pure >>> join ≡⟨⟩
|
||||||
|
bind (pure >>> pure) >>> bind identity
|
||||||
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
bind ((pure >>> pure) >=> identity) ≡⟨⟩
|
||||||
|
bind ((pure >>> pure) >>> bind identity)
|
||||||
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
|
bind (pure >>> (pure >>> bind identity))
|
||||||
|
≡⟨ cong (λ φ → bind (pure >>> φ)) (isNatural _) ⟩
|
||||||
|
bind (pure >>> identity)
|
||||||
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
|
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
|
||||||
|
no-eta-equality
|
||||||
|
field
|
||||||
|
raw : RawMonad
|
||||||
|
isMonad : IsMonad raw
|
||||||
|
open IsMonad isMonad public
|
||||||
|
|
||||||
|
private
|
||||||
|
module _ (raw : RawMonad) where
|
||||||
|
open RawMonad raw
|
||||||
|
propIsIdentity : isProp IsIdentity
|
||||||
|
propIsIdentity x y i = ℂ.arrowsAreSets _ _ x y i
|
||||||
|
propIsNatural : isProp IsNatural
|
||||||
|
propIsNatural x y i = λ f
|
||||||
|
→ ℂ.arrowsAreSets _ _ (x f) (y f) i
|
||||||
|
propIsDistributive : isProp IsDistributive
|
||||||
|
propIsDistributive x y i = λ g f
|
||||||
|
→ ℂ.arrowsAreSets _ _ (x g f) (y g f) i
|
||||||
|
|
||||||
|
open IsMonad
|
||||||
|
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
||||||
|
IsMonad.isIdentity (propIsMonad raw x y i)
|
||||||
|
= propIsIdentity raw (isIdentity x) (isIdentity y) i
|
||||||
|
IsMonad.isNatural (propIsMonad raw x y i)
|
||||||
|
= propIsNatural raw (isNatural x) (isNatural y) i
|
||||||
|
IsMonad.isDistributive (propIsMonad raw x y i)
|
||||||
|
= propIsDistributive raw (isDistributive x) (isDistributive y) i
|
||||||
|
|
||||||
|
module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
|
||||||
|
private
|
||||||
|
eqIsMonad : (λ i → IsMonad (eq i)) [ Monad.isMonad m ≡ Monad.isMonad n ]
|
||||||
|
eqIsMonad = lemPropF propIsMonad eq
|
||||||
|
|
||||||
|
Monad≡ : m ≡ n
|
||||||
|
Monad.raw (Monad≡ i) = eq 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
|
161
src/Cat/Category/Monad/Monoidal.agda
Normal file
161
src/Cat/Category/Monad/Monoidal.agda
Normal file
|
@ -0,0 +1,161 @@
|
||||||
|
{---
|
||||||
|
Monoidal formulation of monads
|
||||||
|
---}
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
open import Agda.Primitive
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor as F
|
||||||
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
|
module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
|
-- "A monad in the monoidal form" [voe]
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
|
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
||||||
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural ; NaturalTransformation≡)
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
-- Note that `pureT` and `joinT` differs from their definition in the
|
||||||
|
-- kleisli formulation only by having an explicit parameter.
|
||||||
|
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}
|
||||||
|
-- R and join commute
|
||||||
|
→ joinT X <<< fmap join ≡ join <<< join
|
||||||
|
IsInverse : Set _
|
||||||
|
IsInverse = {X : Object}
|
||||||
|
-- Talks about R's action on objects
|
||||||
|
→ join <<< pure ≡ identity {Romap X}
|
||||||
|
-- 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))
|
||||||
|
→ join <<< fmap g <<< (join <<< fmap f)
|
||||||
|
≡ join <<< fmap (join <<< fmap g <<< f)
|
||||||
|
|
||||||
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
open RawMonad raw public
|
||||||
|
field
|
||||||
|
isAssociative : IsAssociative
|
||||||
|
isInverse : IsInverse
|
||||||
|
|
||||||
|
private
|
||||||
|
module R = Functor R
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
|
||||||
|
isNatural : IsNatural
|
||||||
|
isNatural {X} {Y} f = begin
|
||||||
|
join <<< fmap f <<< pure ≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
join <<< (fmap f <<< pure) ≡⟨ cong (λ φ → join <<< φ) (sym (pureN f)) ⟩
|
||||||
|
join <<< (pure <<< f) ≡⟨ ℂ.isAssociative ⟩
|
||||||
|
join <<< pure <<< f ≡⟨ cong (λ φ → φ <<< f) (fst isInverse) ⟩
|
||||||
|
identity <<< f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
|
f ∎
|
||||||
|
|
||||||
|
isDistributive : IsDistributive
|
||||||
|
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
|
||||||
|
module R² = Functor F[ R ∘ R ]
|
||||||
|
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 <<< R.fmap b <<< R.fmap c
|
||||||
|
distrib3 {a = a} {b} {c} = begin
|
||||||
|
R.fmap (a <<< b <<< c) ≡⟨ R.isDistributive ⟩
|
||||||
|
R.fmap (a <<< b) <<< R.fmap c ≡⟨ cong (_<<< _) R.isDistributive ⟩
|
||||||
|
R.fmap a <<< R.fmap b <<< R.fmap c ∎
|
||||||
|
|
||||||
|
record Monad : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
|
field
|
||||||
|
raw : RawMonad
|
||||||
|
isMonad : IsMonad raw
|
||||||
|
open IsMonad isMonad public
|
||||||
|
|
||||||
|
private
|
||||||
|
module _ {m : RawMonad} where
|
||||||
|
open RawMonad m
|
||||||
|
propIsAssociative : isProp IsAssociative
|
||||||
|
propIsAssociative x y i {X}
|
||||||
|
= Category.arrowsAreSets ℂ _ _ (x {X}) (y {X}) i
|
||||||
|
propIsInverse : isProp IsInverse
|
||||||
|
propIsInverse x y i {X} = e1 i , e2 i
|
||||||
|
where
|
||||||
|
xX = x {X}
|
||||||
|
yX = y {X}
|
||||||
|
e1 = Category.arrowsAreSets ℂ _ _ (fst xX) (fst yX)
|
||||||
|
e2 = Category.arrowsAreSets ℂ _ _ (snd xX) (snd yX)
|
||||||
|
|
||||||
|
open IsMonad
|
||||||
|
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
||||||
|
IsMonad.isAssociative (propIsMonad raw a b i) j
|
||||||
|
= propIsAssociative {raw}
|
||||||
|
(isAssociative a) (isAssociative b) i j
|
||||||
|
IsMonad.isInverse (propIsMonad raw a b i)
|
||||||
|
= propIsInverse {raw}
|
||||||
|
(isInverse a) (isInverse b) i
|
||||||
|
|
||||||
|
module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
|
||||||
|
private
|
||||||
|
eqIsMonad : (λ i → IsMonad (eq i)) [ Monad.isMonad m ≡ Monad.isMonad n ]
|
||||||
|
eqIsMonad = lemPropF propIsMonad eq
|
||||||
|
|
||||||
|
Monad≡ : m ≡ n
|
||||||
|
Monad.raw (Monad≡ i) = eq i
|
||||||
|
Monad.isMonad (Monad≡ i) = eqIsMonad i
|
246
src/Cat/Category/Monad/Voevodsky.agda
Normal file
246
src/Cat/Category/Monad/Voevodsky.agda
Normal file
|
@ -0,0 +1,246 @@
|
||||||
|
{-
|
||||||
|
This module provides construction 2.3 in [voe]
|
||||||
|
-}
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
module Cat.Category.Monad.Voevodsky where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor as F
|
||||||
|
import Cat.Category.NaturalTransformation
|
||||||
|
open import Cat.Category.Monad
|
||||||
|
import Cat.Category.Monad.Monoidal as Monoidal
|
||||||
|
import Cat.Category.Monad.Kleisli as Kleisli
|
||||||
|
open import Cat.Categories.Fun
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
|
module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
open ℂ using (Object ; Arrow)
|
||||||
|
module M = Monoidal ℂ
|
||||||
|
module K = Kleisli ℂ
|
||||||
|
|
||||||
|
module §2-3 (omap : Object → Object) (pure : {X : Object} → Arrow X (omap X)) where
|
||||||
|
record §1 : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
|
open M
|
||||||
|
|
||||||
|
field
|
||||||
|
fmap : Fmap ℂ ℂ omap
|
||||||
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
|
|
||||||
|
Rraw : RawFunctor ℂ ℂ
|
||||||
|
Rraw = record
|
||||||
|
{ omap = omap
|
||||||
|
; fmap = fmap
|
||||||
|
}
|
||||||
|
|
||||||
|
field
|
||||||
|
RisFunctor : IsFunctor ℂ ℂ Rraw
|
||||||
|
|
||||||
|
R : EndoFunctor ℂ
|
||||||
|
R = record
|
||||||
|
{ raw = Rraw
|
||||||
|
; isFunctor = RisFunctor
|
||||||
|
}
|
||||||
|
|
||||||
|
pureT : (X : Object) → Arrow X (omap X)
|
||||||
|
pureT X = pure {X}
|
||||||
|
|
||||||
|
field
|
||||||
|
pureN : Natural Functors.identity R pureT
|
||||||
|
|
||||||
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
|
pureNT = pureT , pureN
|
||||||
|
|
||||||
|
joinT : (A : Object) → ℂ [ omap (omap A) , omap A ]
|
||||||
|
joinT A = join {A}
|
||||||
|
|
||||||
|
field
|
||||||
|
joinN : Natural F[ R ∘ R ] R joinT
|
||||||
|
|
||||||
|
joinNT : NaturalTransformation F[ R ∘ R ] R
|
||||||
|
joinNT = joinT , joinN
|
||||||
|
|
||||||
|
rawMnd : RawMonad
|
||||||
|
rawMnd = record
|
||||||
|
{ R = R
|
||||||
|
; pureNT = pureNT
|
||||||
|
; joinNT = joinNT
|
||||||
|
}
|
||||||
|
|
||||||
|
field
|
||||||
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
|
toMonad : Monad
|
||||||
|
toMonad .Monad.raw = rawMnd
|
||||||
|
toMonad .Monad.isMonad = isMonad
|
||||||
|
|
||||||
|
record §2 : Set ℓ where
|
||||||
|
no-eta-equality
|
||||||
|
open K
|
||||||
|
|
||||||
|
field
|
||||||
|
bind : {X Y : Object} → ℂ [ X , omap Y ] → ℂ [ omap X , omap Y ]
|
||||||
|
|
||||||
|
rawMnd : RawMonad
|
||||||
|
rawMnd = record
|
||||||
|
{ omap = omap
|
||||||
|
; pure = pure
|
||||||
|
; bind = bind
|
||||||
|
}
|
||||||
|
|
||||||
|
field
|
||||||
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
|
toMonad : Monad
|
||||||
|
toMonad .Monad.raw = rawMnd
|
||||||
|
toMonad .Monad.isMonad = isMonad
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
§2-fromMonad : (m : K.Monad) → §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
|
||||||
|
§2-fromMonad m .§2-3.§2.bind = K.Monad.bind m
|
||||||
|
§2-fromMonad m .§2-3.§2.isMonad = 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
|
||||||
|
private
|
||||||
|
module E = AreInverses {f = (fst (Monoidal≊Kleisli ℂ))} {fst (snd (Monoidal≊Kleisli ℂ))}(Monoidal≊Kleisli ℂ .snd .snd)
|
||||||
|
|
||||||
|
Monoidal→Kleisli : M.Monad → K.Monad
|
||||||
|
Monoidal→Kleisli = E.obverse
|
||||||
|
|
||||||
|
Kleisli→Monoidal : K.Monad → M.Monad
|
||||||
|
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-fromMonad ∘ Monoidal→Kleisli ∘ §2-3.§1.toMonad
|
||||||
|
|
||||||
|
back : §2-3.§2 omap pure → §2-3.§1 omap pure
|
||||||
|
back = §1-fromMonad ∘ Kleisli→Monoidal ∘ §2-3.§2.toMonad
|
||||||
|
|
||||||
|
forthEq : ∀ m → (forth ∘ back) m ≡ m
|
||||||
|
forthEq m = begin
|
||||||
|
§2-fromMonad
|
||||||
|
(Monoidal→Kleisli
|
||||||
|
(§2-3.§1.toMonad
|
||||||
|
(§1-fromMonad (Kleisli→Monoidal (§2-3.§2.toMonad m)))))
|
||||||
|
≡⟨ cong-d (§2-fromMonad ∘ Monoidal→Kleisli) (lemmaz (Kleisli→Monoidal (§2-3.§2.toMonad m))) ⟩
|
||||||
|
§2-fromMonad
|
||||||
|
((Monoidal→Kleisli ∘ Kleisli→Monoidal)
|
||||||
|
(§2-3.§2.toMonad m))
|
||||||
|
-- Below is the fully normalized goal and context with
|
||||||
|
-- `funExt` made abstract.
|
||||||
|
--
|
||||||
|
-- Goal: 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))
|
||||||
|
-- Have: 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))
|
||||||
|
≡⟨ ( 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
|
||||||
|
lemma : (§2-fromMonad ∘ §2-3.§2.toMonad) m ≡ m
|
||||||
|
§2-3.§2.bind (lemma i) = §2-3.§2.bind m
|
||||||
|
§2-3.§2.isMonad (lemma i) = §2-3.§2.isMonad m
|
||||||
|
lemmaz : ∀ m → §2-3.§1.toMonad (§1-fromMonad m) ≡ m
|
||||||
|
M.Monad.raw (lemmaz m i) = M.Monad.raw m
|
||||||
|
M.Monad.isMonad (lemmaz m i) = M.Monad.isMonad m
|
||||||
|
|
||||||
|
backEq : ∀ m → (back ∘ forth) m ≡ m
|
||||||
|
backEq m = begin
|
||||||
|
§1-fromMonad
|
||||||
|
(Kleisli→Monoidal
|
||||||
|
(§2-3.§2.toMonad
|
||||||
|
(§2-fromMonad (Monoidal→Kleisli (§2-3.§1.toMonad m)))))
|
||||||
|
≡⟨ cong-d (§1-fromMonad ∘ Kleisli→Monoidal) (lemma (Monoidal→Kleisli (§2-3.§1.toMonad m))) ⟩
|
||||||
|
§1-fromMonad
|
||||||
|
((Kleisli→Monoidal ∘ Monoidal→Kleisli)
|
||||||
|
(§2-3.§1.toMonad m))
|
||||||
|
-- Below is the fully normalized `agda2-goal-and-context`
|
||||||
|
-- with `funExt` made abstract.
|
||||||
|
--
|
||||||
|
-- Goal: 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))
|
||||||
|
-- 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 ∎
|
||||||
|
where
|
||||||
|
lemmaz : §1-fromMonad (§2-3.§1.toMonad m) ≡ m
|
||||||
|
§2-3.§1.fmap (lemmaz i) = §2-3.§1.fmap m
|
||||||
|
§2-3.§1.join (lemmaz i) = §2-3.§1.join m
|
||||||
|
§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 = fromIsomorphism _ _
|
||||||
|
( forth , back
|
||||||
|
, funExt backEq , funExt forthEq
|
||||||
|
)
|
56
src/Cat/Category/Monoid.agda
Normal file
56
src/Cat/Category/Monoid.agda
Normal file
|
@ -0,0 +1,56 @@
|
||||||
|
{-# OPTIONS --allow-unsolved-metas #-}
|
||||||
|
module Cat.Category.Monoid where
|
||||||
|
|
||||||
|
open import Agda.Primitive
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Product
|
||||||
|
open import Cat.Category.Functor
|
||||||
|
import Cat.Categories.Cat as Cat
|
||||||
|
open import Cat.Prelude hiding (_×_ ; empty)
|
||||||
|
|
||||||
|
-- TODO: Incorrect!
|
||||||
|
module _ {ℓa ℓb : Level} where
|
||||||
|
private
|
||||||
|
ℓ = lsuc (ℓa ⊔ ℓb)
|
||||||
|
|
||||||
|
-- *If* the category of categories existed `_×_` would be equivalent to the
|
||||||
|
-- one brought into scope by doing:
|
||||||
|
--
|
||||||
|
-- open HasProducts (Cat.hasProducts unprovable) using (_×_)
|
||||||
|
--
|
||||||
|
-- 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
|
||||||
|
ℂ × 𝔻 = Cat.CatProduct.object ℂ 𝔻
|
||||||
|
|
||||||
|
record RawMonoidalCategory (ℂ : Category ℓa ℓb) : Set ℓ where
|
||||||
|
open Category ℂ public hiding (IsAssociative)
|
||||||
|
field
|
||||||
|
empty : Object
|
||||||
|
-- aka. tensor product, monoidal product.
|
||||||
|
append : Functor (ℂ × ℂ) ℂ
|
||||||
|
|
||||||
|
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
|
||||||
|
raw : RawMonoidalCategory ℂ
|
||||||
|
open RawMonoidalCategory raw public
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) {monoidal : MonoidalCategory ℂ} {hasProducts : HasProducts ℂ} where
|
||||||
|
private
|
||||||
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
|
open MonoidalCategory monoidal public hiding (mappend)
|
||||||
|
open HasProducts hasProducts
|
||||||
|
|
||||||
|
record MonoidalObject (M : Object) : Set ℓ where
|
||||||
|
field
|
||||||
|
mempty : Arrow empty M
|
||||||
|
mappend : Arrow (M × M) M
|
147
src/Cat/Category/NaturalTransformation.agda
Normal file
147
src/Cat/Category/NaturalTransformation.agda
Normal file
|
@ -0,0 +1,147 @@
|
||||||
|
-- This module Essentially just provides the data for natural transformations
|
||||||
|
--
|
||||||
|
-- This includes:
|
||||||
|
--
|
||||||
|
-- The types:
|
||||||
|
--
|
||||||
|
-- * Transformation - a family of functors
|
||||||
|
-- * Natural - naturality condition for transformations
|
||||||
|
-- * NaturalTransformation - both of the above
|
||||||
|
--
|
||||||
|
-- Elements of the above:
|
||||||
|
--
|
||||||
|
-- * identityTrans - the identity transformation
|
||||||
|
-- * identityNatural - naturality for the above
|
||||||
|
-- * identity - both of the above
|
||||||
|
--
|
||||||
|
-- Functions for manipulating the above:
|
||||||
|
--
|
||||||
|
-- * A composition operator.
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
open import Cat.Prelude
|
||||||
|
|
||||||
|
open import Data.Nat using (_≤′_ ; ≤′-refl ; ≤′-step)
|
||||||
|
module Nat = Data.Nat
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor
|
||||||
|
|
||||||
|
module Cat.Category.NaturalTransformation
|
||||||
|
{ℓc ℓc' ℓd ℓd' : Level}
|
||||||
|
(ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
|
|
||||||
|
open Category using (Object)
|
||||||
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
module 𝔻 = Category 𝔻
|
||||||
|
|
||||||
|
module _ (F G : Functor ℂ 𝔻) where
|
||||||
|
private
|
||||||
|
module F = Functor F
|
||||||
|
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 ]
|
||||||
|
|
||||||
|
Natural : Transformation → Set (ℓc ⊔ (ℓc' ⊔ ℓd'))
|
||||||
|
Natural θ
|
||||||
|
= {A B : Object ℂ}
|
||||||
|
→ (f : ℂ [ A , B ])
|
||||||
|
→ 𝔻 [ θ B ∘ F.fmap f ] ≡ 𝔻 [ G.fmap f ∘ θ A ]
|
||||||
|
|
||||||
|
NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
|
NaturalTransformation = Σ Transformation Natural
|
||||||
|
|
||||||
|
-- Think I need propPi and that arrows are sets
|
||||||
|
propIsNatural : (θ : _) → isProp (Natural θ)
|
||||||
|
propIsNatural θ x y i {A} {B} f = 𝔻.arrowsAreSets _ _ (x f) (y f) i
|
||||||
|
|
||||||
|
NaturalTransformation≡ : {α β : NaturalTransformation}
|
||||||
|
→ (eq₁ : α .fst ≡ β .fst)
|
||||||
|
→ α ≡ β
|
||||||
|
NaturalTransformation≡ eq = lemSig propIsNatural _ _ eq
|
||||||
|
|
||||||
|
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
||||||
|
identityTrans F C = 𝔻.identity
|
||||||
|
|
||||||
|
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
||||||
|
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
|
||||||
|
|
||||||
|
identity : (F : Functor ℂ 𝔻) → NaturalTransformation F F
|
||||||
|
identity F = identityTrans F , identityNatural F
|
||||||
|
|
||||||
|
module _ {F G H : Functor ℂ 𝔻} where
|
||||||
|
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 ]
|
||||||
|
|
||||||
|
NT[_∘_] : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
||||||
|
fst NT[ (θ , _) ∘ (η , _) ] = T[ θ ∘ η ]
|
||||||
|
snd NT[ (θ , θNat) ∘ (η , ηNat) ] {A} {B} f = begin
|
||||||
|
𝔻 [ 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
|
||||||
|
transformationIsSet : isSet (Transformation F G)
|
||||||
|
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l → p l C) (λ l → q l C) i j
|
||||||
|
|
||||||
|
naturalIsProp : (θ : Transformation F G) → isProp (Natural F G θ)
|
||||||
|
naturalIsProp θ θNat θNat' = lem
|
||||||
|
where
|
||||||
|
lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ]
|
||||||
|
lem = λ i f → 𝔻.arrowsAreSets _ _ (θNat f) (θNat' f) i
|
||||||
|
|
||||||
|
naturalIsSet : (θ : Transformation F G) → isSet (Natural F G θ)
|
||||||
|
naturalIsSet θ =
|
||||||
|
ntypeCumulative {n = 1}
|
||||||
|
(Data.Nat.≤′-step Data.Nat.≤′-refl)
|
||||||
|
(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,53 +0,0 @@
|
||||||
{-# OPTIONS --cubical #-}
|
|
||||||
|
|
||||||
module Cat.Category.Pathy where
|
|
||||||
|
|
||||||
open import Level
|
|
||||||
open import Cubical
|
|
||||||
|
|
||||||
{-
|
|
||||||
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
|
|
||||||
|
|
||||||
pathJprop' : pathJ' _ refl ≡ d
|
|
||||||
pathJprop' i
|
|
||||||
= primComp (λ _ → P x refl) i (λ {j (i = i1) → d}) d
|
|
||||||
|
|
||||||
|
|
||||||
module _ {ℓ ℓ'} {A : Set ℓ}
|
|
||||||
(P : (x y : A) → x ≡ y → Set ℓ') (d : (x : A) → P x x refl) where
|
|
||||||
pathJ'' : (x y : A) → (p : x ≡ y) → P x y p
|
|
||||||
pathJ'' _ _ p = transp (λ i →
|
|
||||||
let
|
|
||||||
P' = uncurry P
|
|
||||||
q = (contrSingl p i)
|
|
||||||
in
|
|
||||||
{!uncurry (uncurry P)!} ) d
|
|
||||||
-}
|
|
||||||
|
|
||||||
module _ {ℓ ℓ'} {A : Set ℓ}
|
|
||||||
(C : (x y : A) → x ≡ y → Set ℓ')
|
|
||||||
(c : (x : A) → C x x refl) where
|
|
||||||
|
|
||||||
=-ind : (x y : A) → (p : x ≡ y) → C x y p
|
|
||||||
=-ind x y p = pathJ (C x) (c x) y p
|
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} {A : Set ℓ} {P : A → Set ℓ} {x y : A} where
|
|
||||||
private
|
|
||||||
D : (x y : A) → (x ≡ y) → Set ℓ
|
|
||||||
D x y p = P x → P y
|
|
||||||
|
|
||||||
id : {ℓ : Level} → {A : Set ℓ} → A → A
|
|
||||||
id x = x
|
|
||||||
|
|
||||||
d : (x : A) → D x x refl
|
|
||||||
d x = id {A = P x}
|
|
||||||
|
|
||||||
-- the p refers to the third argument
|
|
||||||
liftP : x ≡ y → P x → P y
|
|
||||||
liftP p = =-ind D d x y p
|
|
||||||
|
|
||||||
-- lift' : (u : P x) → (p : x ≡ y) → (x , u) ≡ (y , liftP p u)
|
|
||||||
-- lift' u p = {!!}
|
|
|
@ -1,54 +1,190 @@
|
||||||
|
{-# 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 (_×_)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
open Category
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Category ℂ
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Object ℂ} where
|
module _ (A B : Object) where
|
||||||
IsProduct : (π₁ : ℂ [ obj , A ]) (π₂ : ℂ [ obj , B ]) → Set (ℓ ⊔ ℓ')
|
record RawProduct : Set (ℓa ⊔ ℓb) where
|
||||||
IsProduct π₁ π₂
|
-- no-eta-equality
|
||||||
= ∀ {X : Object ℂ} (x₁ : ℂ [ X , A ]) (x₂ : ℂ [ X , B ])
|
|
||||||
→ ∃![ x ] (ℂ [ π₁ ∘ x ] ≡ x₁ P.× ℂ [ π₂ ∘ x ] ≡ x₂)
|
|
||||||
|
|
||||||
-- Tip from Andrea; Consider this style for efficiency:
|
|
||||||
-- record IsProduct {ℓa ℓb : Level} (ℂ : Category ℓa ℓb)
|
|
||||||
-- {A B obj : Object ℂ} (π₁ : Arrow ℂ obj A) (π₂ : Arrow ℂ obj B) : Set (ℓa ⊔ ℓb) where
|
|
||||||
-- field
|
|
||||||
-- issProduct : ∀ {X : Object ℂ} (x₁ : ℂ [ X , A ]) (x₂ : ℂ [ X , B ])
|
|
||||||
-- → ∃![ x ] (ℂ [ π₁ ∘ x ] ≡ x₁ P.× ℂ [ π₂ ∘ x ] ≡ x₂)
|
|
||||||
|
|
||||||
-- open IsProduct
|
|
||||||
|
|
||||||
record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : Object ℂ) : Set (ℓ ⊔ ℓ') where
|
|
||||||
no-eta-equality
|
|
||||||
field
|
field
|
||||||
obj : Object ℂ
|
object : Object
|
||||||
proj₁ : ℂ [ obj , A ]
|
fst : ℂ [ object , A ]
|
||||||
proj₂ : ℂ [ obj , B ]
|
snd : ℂ [ object , B ]
|
||||||
{{isProduct}} : IsProduct ℂ proj₁ proj₂
|
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
-- | Arrow product
|
||||||
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
||||||
→ ℂ [ X , obj ]
|
→ ℂ [ X , object ]
|
||||||
_P[_×_] π₁ π₂ = proj₁ (isProduct π₁ π₂)
|
_P[_×_] π₁ π₂ = P.fst (ump π₁ π₂)
|
||||||
|
|
||||||
record HasProducts {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where
|
record Product : Set (ℓa ⊔ ℓb) where
|
||||||
field
|
field
|
||||||
product : ∀ (A B : Object ℂ) → Product {ℂ = ℂ} A B
|
raw : RawProduct
|
||||||
|
isProduct : IsProduct raw
|
||||||
|
|
||||||
open Product
|
open IsProduct isProduct public
|
||||||
|
|
||||||
_×_ : (A B : Object ℂ) → Object ℂ
|
record HasProducts : Set (ℓa ⊔ ℓb) where
|
||||||
A × B = Product.obj (product A B)
|
field
|
||||||
-- The product mentioned in awodey in Def 6.1 is not the regular product of arrows.
|
product : ∀ (A B : Object) → Product A B
|
||||||
-- It's a "parallel" product
|
|
||||||
_|×|_ : {A A' B B' : Object ℂ} → ℂ [ A , A' ] → ℂ [ B , B' ]
|
_×_ : Object → Object → Object
|
||||||
→ ℂ [ A × B , A' × B' ]
|
A × B = Product.object (product A B)
|
||||||
_|×|_ {A = A} {A' = A'} {B = B} {B' = B'} a b
|
|
||||||
= product A' B'
|
-- | Parallel product of arrows
|
||||||
P[ ℂ [ a ∘ (product A B) .proj₁ ]
|
--
|
||||||
× ℂ [ b ∘ (product A B) .proj₂ ]
|
-- The product mentioned in awodey in Def 6.1 is not the regular product of
|
||||||
|
-- arrows. It's a "parallel" product
|
||||||
|
module _ {A A' B B' : Object} where
|
||||||
|
open Product using (_P[_×_])
|
||||||
|
open Product (product A B) hiding (_P[_×_]) renaming (fst to fst ; snd to snd)
|
||||||
|
_|×|_ : ℂ [ A , A' ] → ℂ [ B , B' ] → ℂ [ A × B , A' × B' ]
|
||||||
|
f |×| g = product A' B'
|
||||||
|
P[ ℂ [ f ∘ fst ]
|
||||||
|
× ℂ [ g ∘ snd ]
|
||||||
]
|
]
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb}
|
||||||
|
(let module ℂ = Category ℂ) {𝒜 ℬ : ℂ.Object} where
|
||||||
|
private
|
||||||
|
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 x y i = record { product = productEq x y i }
|
||||||
|
|
|
@ -1,122 +0,0 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
|
||||||
|
|
||||||
module Cat.Category.Properties where
|
|
||||||
|
|
||||||
open import Agda.Primitive
|
|
||||||
open import Data.Product
|
|
||||||
open import Cubical
|
|
||||||
|
|
||||||
open import Cat.Category
|
|
||||||
open import Cat.Category.Functor
|
|
||||||
open import Cat.Categories.Sets
|
|
||||||
open import Cat.Equality
|
|
||||||
open Equality.Data.Product
|
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} { A B : Category.Object ℂ } {X : Category.Object ℂ} (f : Category.Arrow ℂ A B) where
|
|
||||||
open Category ℂ
|
|
||||||
|
|
||||||
iso-is-epi : Isomorphism f → Epimorphism {X = X} f
|
|
||||||
iso-is-epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
|
||||||
g₀ ≡⟨ sym (proj₁ ident) ⟩
|
|
||||||
g₀ ∘ 𝟙 ≡⟨ cong (_∘_ g₀) (sym right-inv) ⟩
|
|
||||||
g₀ ∘ (f ∘ f-) ≡⟨ assoc ⟩
|
|
||||||
(g₀ ∘ f) ∘ f- ≡⟨ cong (λ φ → φ ∘ f-) eq ⟩
|
|
||||||
(g₁ ∘ f) ∘ f- ≡⟨ sym assoc ⟩
|
|
||||||
g₁ ∘ (f ∘ f-) ≡⟨ cong (_∘_ g₁) right-inv ⟩
|
|
||||||
g₁ ∘ 𝟙 ≡⟨ proj₁ ident ⟩
|
|
||||||
g₁ ∎
|
|
||||||
|
|
||||||
iso-is-mono : Isomorphism f → Monomorphism {X = X} f
|
|
||||||
iso-is-mono (f- , (left-inv , right-inv)) g₀ g₁ eq =
|
|
||||||
begin
|
|
||||||
g₀ ≡⟨ sym (proj₂ ident) ⟩
|
|
||||||
𝟙 ∘ g₀ ≡⟨ cong (λ φ → φ ∘ g₀) (sym left-inv) ⟩
|
|
||||||
(f- ∘ f) ∘ g₀ ≡⟨ sym assoc ⟩
|
|
||||||
f- ∘ (f ∘ g₀) ≡⟨ cong (_∘_ f-) eq ⟩
|
|
||||||
f- ∘ (f ∘ g₁) ≡⟨ assoc ⟩
|
|
||||||
(f- ∘ f) ∘ g₁ ≡⟨ cong (λ φ → φ ∘ g₁) left-inv ⟩
|
|
||||||
𝟙 ∘ g₁ ≡⟨ proj₂ ident ⟩
|
|
||||||
g₁ ∎
|
|
||||||
|
|
||||||
iso-is-epi-mono : Isomorphism f → Epimorphism {X = X} f × Monomorphism {X = X} f
|
|
||||||
iso-is-epi-mono iso = iso-is-epi iso , iso-is-mono iso
|
|
||||||
|
|
||||||
{-
|
|
||||||
epi-mono-is-not-iso : ∀ {ℓ ℓ'} → ¬ ((ℂ : Category {ℓ} {ℓ'}) {A B X : Object ℂ} (f : Arrow ℂ A B ) → Epimorphism {ℂ = ℂ} {X = X} f → Monomorphism {ℂ = ℂ} {X = X} f → Isomorphism {ℂ = ℂ} f)
|
|
||||||
epi-mono-is-not-iso f =
|
|
||||||
let k = f {!!} {!!} {!!} {!!}
|
|
||||||
in {!!}
|
|
||||||
-}
|
|
||||||
|
|
||||||
open import Cat.Category
|
|
||||||
open Category
|
|
||||||
open Functor
|
|
||||||
|
|
||||||
-- module _ {ℓ : Level} {ℂ : Category ℓ ℓ}
|
|
||||||
-- {isSObj : isSet (ℂ .Object)}
|
|
||||||
-- {isz2 : ∀ {ℓ} → {A B : Set ℓ} → isSet (Sets [ A , B ])} where
|
|
||||||
-- -- open import Cat.Categories.Cat using (Cat)
|
|
||||||
-- open import Cat.Categories.Fun
|
|
||||||
-- open import Cat.Categories.Sets
|
|
||||||
-- -- module Cat = Cat.Categories.Cat
|
|
||||||
-- open import Cat.Category.Exponential
|
|
||||||
-- private
|
|
||||||
-- Catℓ = Cat ℓ ℓ
|
|
||||||
-- prshf = presheaf {ℂ = ℂ}
|
|
||||||
-- module ℂ = IsCategory (ℂ .isCategory)
|
|
||||||
|
|
||||||
-- -- Exp : Set (lsuc (lsuc ℓ))
|
|
||||||
-- -- Exp = Exponential (Cat (lsuc ℓ) ℓ)
|
|
||||||
-- -- Sets (Opposite ℂ)
|
|
||||||
|
|
||||||
-- _⇑_ : (A B : Catℓ .Object) → Catℓ .Object
|
|
||||||
-- A ⇑ B = (exponent A B) .obj
|
|
||||||
-- where
|
|
||||||
-- open HasExponentials (Cat.hasExponentials ℓ)
|
|
||||||
|
|
||||||
-- module _ {A B : ℂ .Object} (f : ℂ .Arrow A B) where
|
|
||||||
-- :func→: : NaturalTransformation (prshf A) (prshf B)
|
|
||||||
-- :func→: = (λ C x → ℂ [ f ∘ x ]) , λ f₁ → funExt λ _ → ℂ.assoc
|
|
||||||
|
|
||||||
-- module _ {c : ℂ .Object} where
|
|
||||||
-- eqTrans : (λ _ → Transformation (prshf c) (prshf c))
|
|
||||||
-- [ (λ _ x → ℂ [ ℂ .𝟙 ∘ x ]) ≡ identityTrans (prshf c) ]
|
|
||||||
-- eqTrans = funExt λ x → funExt λ x → ℂ.ident .proj₂
|
|
||||||
|
|
||||||
-- eqNat : (λ i → Natural (prshf c) (prshf c) (eqTrans i))
|
|
||||||
-- [(λ _ → funExt (λ _ → ℂ.assoc)) ≡ identityNatural (prshf c)]
|
|
||||||
-- eqNat = λ i {A} {B} f →
|
|
||||||
-- let
|
|
||||||
-- open IsCategory (Sets .isCategory)
|
|
||||||
-- lemm : (Sets [ eqTrans i B ∘ prshf c .func→ f ]) ≡
|
|
||||||
-- (Sets [ prshf c .func→ f ∘ eqTrans i A ])
|
|
||||||
-- lemm = {!!}
|
|
||||||
-- lem : (λ _ → Sets [ Functor.func* (prshf c) A , prshf c .func* B ])
|
|
||||||
-- [ Sets [ eqTrans i B ∘ prshf c .func→ f ]
|
|
||||||
-- ≡ Sets [ prshf c .func→ f ∘ eqTrans i A ] ]
|
|
||||||
-- lem
|
|
||||||
-- = isz2 _ _ lemm _ i
|
|
||||||
-- -- (Sets [ eqTrans i B ∘ prshf c .func→ f ])
|
|
||||||
-- -- (Sets [ prshf c .func→ f ∘ eqTrans i A ])
|
|
||||||
-- -- lemm
|
|
||||||
-- -- _ i
|
|
||||||
-- in
|
|
||||||
-- lem
|
|
||||||
-- -- eqNat = λ {A} {B} i ℂ[B,A] i' ℂ[A,c] →
|
|
||||||
-- -- let
|
|
||||||
-- -- k : ℂ [ {!!} , {!!} ]
|
|
||||||
-- -- k = ℂ[A,c]
|
|
||||||
-- -- in {!ℂ [ ? ∘ ? ]!}
|
|
||||||
|
|
||||||
-- :ident: : (:func→: (ℂ .𝟙 {c})) ≡ (Fun .𝟙 {o = prshf c})
|
|
||||||
-- :ident: = Σ≡ eqTrans eqNat
|
|
||||||
|
|
||||||
-- yoneda : Functor ℂ (Fun {ℂ = Opposite ℂ} {𝔻 = Sets {ℓ}})
|
|
||||||
-- yoneda = record
|
|
||||||
-- { func* = prshf
|
|
||||||
-- ; func→ = :func→:
|
|
||||||
-- ; isFunctor = record
|
|
||||||
-- { ident = :ident:
|
|
||||||
-- ; distrib = {!!}
|
|
||||||
-- }
|
|
||||||
-- }
|
|
84
src/Cat/Category/Yoneda.agda
Normal file
84
src/Cat/Category/Yoneda.agda
Normal file
|
@ -0,0 +1,84 @@
|
||||||
|
{-# OPTIONS --cubical #-}
|
||||||
|
|
||||||
|
module Cat.Category.Yoneda where
|
||||||
|
|
||||||
|
open import Cat.Prelude
|
||||||
|
|
||||||
|
open import Cat.Category
|
||||||
|
open import Cat.Category.Functor
|
||||||
|
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)
|
||||||
|
|
||||||
|
-- There is no (small) category of categories. So we won't use _⇑_ from
|
||||||
|
-- `HasExponential`
|
||||||
|
--
|
||||||
|
-- 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
|
||||||
|
private
|
||||||
|
𝓢 = Sets ℓ
|
||||||
|
open Fun (opposite ℂ) 𝓢
|
||||||
|
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
|
||||||
|
presheaf : ℂ.Object → Presheaf ℂ
|
||||||
|
presheaf = Cat.Categories.Sets.presheaf ℂ
|
||||||
|
|
||||||
|
module _ {A B : ℂ.Object} (f : ℂ [ A , B ]) where
|
||||||
|
fmap : Transformation (presheaf A) (presheaf B)
|
||||||
|
fmap C x = ℂ [ f ∘ x ]
|
||||||
|
|
||||||
|
fmapNatural : Natural (presheaf A) (presheaf B) fmap
|
||||||
|
fmapNatural g = funExt λ _ → ℂ.isAssociative
|
||||||
|
|
||||||
|
fmapNT : NaturalTransformation (presheaf A) (presheaf B)
|
||||||
|
fmapNT = fmap , fmapNatural
|
||||||
|
|
||||||
|
rawYoneda : RawFunctor ℂ Fun
|
||||||
|
RawFunctor.omap rawYoneda = presheaf
|
||||||
|
RawFunctor.fmap rawYoneda = fmapNT
|
||||||
|
|
||||||
|
open RawFunctor rawYoneda hiding (fmap)
|
||||||
|
|
||||||
|
isIdentity : IsIdentity
|
||||||
|
isIdentity {c} = lemSig prp _ _ eq
|
||||||
|
where
|
||||||
|
eq : (λ C x → ℂ [ ℂ.identity ∘ x ]) ≡ identityTrans (presheaf c)
|
||||||
|
eq = funExt λ A → funExt λ B → ℂ.leftIdentity
|
||||||
|
prp = F.naturalIsProp _ _ {F = presheaf c} {presheaf c}
|
||||||
|
|
||||||
|
isDistributive : IsDistributive
|
||||||
|
isDistributive {A} {B} {C} {f = f} {g}
|
||||||
|
= lemSig (propIsNatural (presheaf A) (presheaf C)) _ _ eq
|
||||||
|
where
|
||||||
|
T[_∘_]' = T[_∘_] {F = presheaf A} {presheaf B} {presheaf C}
|
||||||
|
eqq : (X : ℂ.Object) → (x : ℂ [ X , A ])
|
||||||
|
→ fmap (ℂ [ g ∘ f ]) X x ≡ T[ fmap g ∘ fmap f ]' X x
|
||||||
|
eqq X x = begin
|
||||||
|
fmap (ℂ [ g ∘ f ]) X x ≡⟨⟩
|
||||||
|
ℂ [ ℂ [ g ∘ f ] ∘ x ] ≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
ℂ [ g ∘ ℂ [ f ∘ x ] ] ≡⟨⟩
|
||||||
|
ℂ [ g ∘ fmap f X x ] ≡⟨⟩
|
||||||
|
T[ fmap g ∘ fmap f ]' X x ∎
|
||||||
|
eq : fmap (ℂ [ g ∘ f ]) ≡ T[ fmap g ∘ fmap f ]'
|
||||||
|
eq = begin
|
||||||
|
fmap (ℂ [ g ∘ f ]) ≡⟨ funExt (λ X → funExt λ α → eqq X α) ⟩
|
||||||
|
T[ fmap g ∘ fmap f ]' ∎
|
||||||
|
|
||||||
|
instance
|
||||||
|
isFunctor : IsFunctor ℂ Fun rawYoneda
|
||||||
|
IsFunctor.isIdentity isFunctor = isIdentity
|
||||||
|
IsFunctor.isDistributive isFunctor = isDistributive
|
||||||
|
|
||||||
|
yoneda : Functor ℂ Fun
|
||||||
|
Functor.raw yoneda = rawYoneda
|
||||||
|
Functor.isFunctor yoneda = isFunctor
|
|
@ -1,57 +0,0 @@
|
||||||
module Cat.CwF where
|
|
||||||
|
|
||||||
open import Agda.Primitive
|
|
||||||
open import Data.Product
|
|
||||||
|
|
||||||
open import Cat.Category
|
|
||||||
open import Cat.Category.Functor
|
|
||||||
open import Cat.Categories.Fam
|
|
||||||
|
|
||||||
open Category
|
|
||||||
open Functor
|
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} where
|
|
||||||
record CwF : Set (lsuc (ℓa ⊔ ℓb)) where
|
|
||||||
-- "A category with families consists of"
|
|
||||||
field
|
|
||||||
-- "A base category"
|
|
||||||
ℂ : Category ℓa ℓb
|
|
||||||
-- It's objects are called contexts
|
|
||||||
Contexts = Object ℂ
|
|
||||||
-- It's arrows are called substitutions
|
|
||||||
Substitutions = Arrow ℂ
|
|
||||||
field
|
|
||||||
-- A functor T
|
|
||||||
T : Functor (Opposite ℂ) (Fam ℓa ℓb)
|
|
||||||
-- Empty context
|
|
||||||
[] : Terminal ℂ
|
|
||||||
private
|
|
||||||
module T = Functor T
|
|
||||||
Type : (Γ : Object ℂ) → Set ℓa
|
|
||||||
Type Γ = proj₁ (T.func* Γ)
|
|
||||||
|
|
||||||
module _ {Γ : Object ℂ} {A : Type Γ} where
|
|
||||||
|
|
||||||
module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
|
||||||
k : Σ (proj₁ (func* T B) → proj₁ (func* T A))
|
|
||||||
(λ f →
|
|
||||||
{x : proj₁ (func* T B)} →
|
|
||||||
proj₂ (func* T B) x → proj₂ (func* T A) (f x))
|
|
||||||
k = T.func→ γ
|
|
||||||
k₁ : proj₁ (func* T B) → proj₁ (func* T A)
|
|
||||||
k₁ = proj₁ k
|
|
||||||
k₂ : ({x : proj₁ (func* T B)} →
|
|
||||||
proj₂ (func* T B) x → proj₂ (func* T A) (k₁ x))
|
|
||||||
k₂ = proj₂ k
|
|
||||||
|
|
||||||
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
|
||||||
field
|
|
||||||
Γ&A : Object ℂ
|
|
||||||
proj1 : ℂ [ Γ&A , Γ ]
|
|
||||||
-- proj2 : ????
|
|
||||||
|
|
||||||
-- if γ : ℂ [ A , B ]
|
|
||||||
-- then T .func→ γ (written T[γ]) interpret substitutions in types and terms respectively.
|
|
||||||
-- field
|
|
||||||
-- ump : {Δ : ℂ .Object} → (γ : ℂ [ Δ , Γ ])
|
|
||||||
-- → (a : {!!}) → {!!}
|
|
|
@ -1,47 +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
|
|
||||||
|
|
||||||
-- Remark 2.7.1: This theorem:
|
|
||||||
--
|
|
||||||
-- (x , u) ≡ (x , v) → u ≡ v
|
|
||||||
--
|
|
||||||
-- does *not* hold! We can only conclude that there *exists* `p : x ≡ x`
|
|
||||||
-- such that
|
|
||||||
--
|
|
||||||
-- p* u ≡ v
|
|
||||||
-- thm : isSet A → (∀ {a} → isSet (B a)) → isSet (Σ A B)
|
|
||||||
-- thm sA sB (x , y) (x' , y') p q = res
|
|
||||||
-- where
|
|
||||||
-- x≡x'0 : x ≡ x'
|
|
||||||
-- x≡x'0 = λ i → proj₁ (p i)
|
|
||||||
-- x≡x'1 : x ≡ x'
|
|
||||||
-- x≡x'1 = λ i → proj₁ (q i)
|
|
||||||
-- someP : x ≡ x'
|
|
||||||
-- someP = {!!}
|
|
||||||
-- tricky : {!y!} ≡ y'
|
|
||||||
-- tricky = {!!}
|
|
||||||
-- -- res' : (λ _ → Σ A B) [ (x , y) ≡ (x' , y') ]
|
|
||||||
-- res' : ({!!} , {!!}) ≡ ({!!} , {!!})
|
|
||||||
-- res' = {!!}
|
|
||||||
-- res : p ≡ q
|
|
||||||
-- res i = {!res'!}
|
|
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,15 +0,0 @@
|
||||||
module Cat.Wishlist where
|
|
||||||
|
|
||||||
open import Level
|
|
||||||
open import Cubical.NType
|
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s)
|
|
||||||
|
|
||||||
postulate ntypeCommulative : ∀ {ℓ n m} {A : Set ℓ} → n ≤ m → HasLevel ⟨ n ⟩₋₂ A → HasLevel ⟨ m ⟩₋₂ A
|
|
||||||
|
|
||||||
module _ {ℓ : Level} {A : Set ℓ} where
|
|
||||||
-- This is §7.1.10 in [HoTT]. Andrea says the proof is in `cubical` but I
|
|
||||||
-- can't find it.
|
|
||||||
postulate propHasLevel : ∀ n → isProp (HasLevel n A)
|
|
||||||
|
|
||||||
isSetIsProp : isProp (isSet A)
|
|
||||||
isSetIsProp = propHasLevel (S (S ⟨-2⟩))
|
|
Loading…
Reference in a new issue