Merge branch 'dev'
This commit is contained in:
commit
a181cfb63e
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -1 +0,0 @@
|
||||||
references/
|
|
||||||
15
BACKLOG.md
15
BACKLOG.md
|
|
@ -1,21 +1,12 @@
|
||||||
Backlog
|
Backlog
|
||||||
=======
|
=======
|
||||||
|
|
||||||
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
|
Prove univalence for the category of
|
||||||
* the opposite category
|
|
||||||
* functors and natural transformations
|
* functors and natural transformations
|
||||||
|
|
||||||
Prove:
|
In AreInverses, dont use the "point-free" version. I.e.:
|
||||||
* `isProp (Product ...)`
|
|
||||||
* `isProp (HasProducts ...)`
|
`∀ x → f x ≡ g x` rather than `f ≡ g`
|
||||||
|
|
||||||
Ideas for future work
|
Ideas for future work
|
||||||
---------------------
|
---------------------
|
||||||
|
|
|
||||||
32
CHANGELOG.md
32
CHANGELOG.md
|
|
@ -1,6 +1,32 @@
|
||||||
Change log
|
Change log
|
||||||
=========
|
=========
|
||||||
|
|
||||||
|
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
|
Version 1.4.1
|
||||||
-------------
|
-------------
|
||||||
Defines a module to work with equivalence providing a way to go between
|
Defines a module to work with equivalence providing a way to go between
|
||||||
|
|
@ -29,12 +55,12 @@ Adds an "equality principle" for categories and monads.
|
||||||
Prove that `IsMonad` is a mere proposition.
|
Prove that `IsMonad` is a mere proposition.
|
||||||
|
|
||||||
Provides the yoneda embedding without relying on the existence of a category of
|
Provides the yoneda embedding without relying on the existence of a category of
|
||||||
categories. This is acheived by providing some of the data needed to make a ccc
|
categories. This is achieved by providing some of the data needed to make a ccc
|
||||||
out of the category of categories without actually having such a category.
|
out of the category of categories without actually having such a category.
|
||||||
|
|
||||||
Renames functors object map and arrow map to `omap` and `fmap`.
|
Renames functors object map and arrow map to `omap` and `fmap`.
|
||||||
|
|
||||||
Prove that kleisli- and monoidal- monads are equivalent!
|
Prove that Kleisli- and monoidal- monads are equivalent!
|
||||||
|
|
||||||
[WIP] Started working on the proofs for univalence for the category of sets and
|
[WIP] Started working on the proofs for univalence for the category of sets and
|
||||||
the category of functors.
|
the category of functors.
|
||||||
|
|
@ -53,7 +79,7 @@ Rename Opposite to opposite
|
||||||
|
|
||||||
Add documentation in Category-module
|
Add documentation in Category-module
|
||||||
|
|
||||||
Formulation of monads in two ways; the "monoidal-" and "kleisli-" form.
|
Formulation of monads in two ways; the "monoidal-" and "Kleisli-" form.
|
||||||
|
|
||||||
WIP: Equivalence of these two formulations
|
WIP: Equivalence of these two formulations
|
||||||
|
|
||||||
|
|
|
||||||
1
proposal/.gitignore → doc/.gitignore
vendored
1
proposal/.gitignore → doc/.gitignore
vendored
|
|
@ -6,3 +6,4 @@
|
||||||
*.pdf
|
*.pdf
|
||||||
*.bbl
|
*.bbl
|
||||||
*.blg
|
*.blg
|
||||||
|
*.toc
|
||||||
7
doc/BACKLOG.md
Normal file
7
doc/BACKLOG.md
Normal file
|
|
@ -0,0 +1,7 @@
|
||||||
|
Talk about structure of library:
|
||||||
|
===
|
||||||
|
|
||||||
|
What can I say about reusability?
|
||||||
|
|
||||||
|
Misc
|
||||||
|
====
|
||||||
|
|
@ -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,8 +40,8 @@ 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
|
||||||
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}
|
||||||
135
doc/chalmerstitle.sty
Normal file
135
doc/chalmerstitle.sty
Normal file
|
|
@ -0,0 +1,135 @@
|
||||||
|
% 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}
|
||||||
|
\begingroup
|
||||||
|
\thispagestyle{empty}
|
||||||
|
{\Huge\@title}\\[.5cm]
|
||||||
|
{\Large A formalization of category theory in Cubical Agda}\\[2.5cm]
|
||||||
|
\begin{center}
|
||||||
|
\includegraphics[width=\linewidth,keepaspectratio]{isomorphism.png}
|
||||||
|
\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]{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}}
|
||||||
3
doc/conclusion.tex
Normal file
3
doc/conclusion.tex
Normal file
|
|
@ -0,0 +1,3 @@
|
||||||
|
\chapter{Conclusion}
|
||||||
|
|
||||||
|
\TODO{\ldots}
|
||||||
286
doc/cubical.tex
Normal file
286
doc/cubical.tex
Normal file
|
|
@ -0,0 +1,286 @@
|
||||||
|
\chapter{Cubical Agda}
|
||||||
|
\section{Propositional equality}
|
||||||
|
In Agda judgmental equality is a feature of the type-system. It's a property of
|
||||||
|
types that can be checked by computational means. In the example from the
|
||||||
|
introduction $n + 0$ can be judged to be equal to $n$ simply by expanding the
|
||||||
|
definition of $+$.
|
||||||
|
|
||||||
|
Propositional equality on the other hand is defined within the language itself.
|
||||||
|
Cubical Agda extends the underlying type system (\TODO{Cite someone smarter than
|
||||||
|
me with a good resource on this}) but introduces a data-type within the
|
||||||
|
languages.
|
||||||
|
|
||||||
|
Exceprts of the source code relevant to this section can be found in appendix
|
||||||
|
\ref{sec:app-cubical}.
|
||||||
|
|
||||||
|
\subsection{The equality type}
|
||||||
|
The usual notion of judgmental equality says that given a type $A \tp \MCU$ and
|
||||||
|
two points of $A$; $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:
|
||||||
|
%
|
||||||
|
\begin{align}
|
||||||
|
\refl \tp a \equiv a
|
||||||
|
\end{align}
|
||||||
|
%
|
||||||
|
For any $a \tp A$.
|
||||||
|
|
||||||
|
There also exist a related notion of \emph{heterogeneous} equality where 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 is likewise defined as an inductive data-type with a single constructors:
|
||||||
|
%
|
||||||
|
\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}
|
||||||
|
In Cubical Agda judgmental equality is encapsulated with the type:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\Path \tp (P \tp I → \MCU) → P\ 0 → P\ 1 → \MCU
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
$I$ is a special data-type (\TODO{that also has special computational properties
|
||||||
|
AFAIK}) called the index set. $I$ can be thought of simply as the interval on
|
||||||
|
the real numbers from $0$ to $1$. $P$ is a family of types over the index set
|
||||||
|
$I$. I will sometimes refer to $P$ as the ``path-space'' of some path $p \tp
|
||||||
|
\Path\ P\ a\ b$. By this token $P\ 0$ then corresponds to the type at the
|
||||||
|
left-endpoint and $P\ 1$ as the type at the right-endpoint. The type is called
|
||||||
|
$\Path$ because it is connected with paths in homotopy theory. The intuition
|
||||||
|
behind this is that $\Path$ describes paths in $\MCU$ -- i.e. between types. For
|
||||||
|
a path $p$ for the point $p\ i$ 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, $p$, from the index-space to the path-space:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p \tp I \to P\ i
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
Which must satisfy being judgmentally equal to $a_0$ (respectively $a_1$) at the
|
||||||
|
endpoints. I.e.:
|
||||||
|
%
|
||||||
|
\begin{align*}
|
||||||
|
p\ 0 & = a_0 \\
|
||||||
|
p\ 1 & = a_1
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
The notion of ``homogeneous equalities'' can be recovered by not letting the
|
||||||
|
path-space $P$ depend on it's argument:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
a_0 \equiv a_1 \defeq \Path\ (\lambda i \to A)\ a_0\ a_1
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
For $A \tp \MCU$, $a_0, a_1 \tp A$. I will generally prefer to use the notation
|
||||||
|
$a_0 \equiv a_1$ when talking about non-dependent paths and use the notation
|
||||||
|
$\Path\ (\lambda i \to A)\ a_0\ a_1$ when the path-space is of particular
|
||||||
|
interest.
|
||||||
|
|
||||||
|
With this definition we can also recover reflexivity. That is, for any $A \tp
|
||||||
|
\MCU$ and $a \tp A$:
|
||||||
|
%
|
||||||
|
\begin{equation}
|
||||||
|
\begin{aligned}
|
||||||
|
\refl & \tp \Path (\lambda i \to A)\ a\ a \\
|
||||||
|
\refl & \defeq \lambda i \to a
|
||||||
|
\end{aligned}
|
||||||
|
\end{equation}
|
||||||
|
%
|
||||||
|
Or, in other terms; reflexivity is the path in $A$ that is $a$ at the left
|
||||||
|
endpoint as well as at the right endpoint. It is inhabited by the path which
|
||||||
|
stays constantly at $a$ at any index $i$.
|
||||||
|
|
||||||
|
Paths have some other important properties, but they are not the focus of this
|
||||||
|
thesis. \TODO{Refer the reader somewhere for more info.}
|
||||||
|
%
|
||||||
|
\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
|
||||||
|
don't have any interesting structure. This is referred to as uniqueness of
|
||||||
|
identity proofs. Unfortunately this is orthogonal to univalence that only makes
|
||||||
|
sense in the absence of UIP.
|
||||||
|
|
||||||
|
In homotopy type theory we have a hierarchy of types based on their ``internal
|
||||||
|
structure''. At the bottom of this hierarchy we have 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$''. It is a theorem that if a type is
|
||||||
|
contractible, then it is isomorphic to the unit-type $\top$.
|
||||||
|
|
||||||
|
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}
|
||||||
|
%
|
||||||
|
$\isProp\ A$ can be thought of as the set of true and false propositions. It is
|
||||||
|
a result 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).\TODO{Cite!!}
|
||||||
|
|
||||||
|
I will refer to a type $A \tp \MCU$ as a \emph{mere} proposition if I want to
|
||||||
|
stress that we have $\isProp\ A$.
|
||||||
|
|
||||||
|
Then comes 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}
|
||||||
|
%
|
||||||
|
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 inhabited.
|
||||||
|
|
||||||
|
The next step in the hierarchy is, as the reader might've guessed, 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}
|
||||||
|
%
|
||||||
|
And 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}, propositions
|
||||||
|
are \nomen{-1-types}, (homotopical) sets are \nomen{0-types} 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$.
|
||||||
|
|
||||||
|
Let $\left\Vert A \right\Vert = n$ denote that the level of $A$ is $n$.
|
||||||
|
Proposition: For any homotopic level $n$ this 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
|
||||||
|
already that have already been formalized. Specifically the results come from
|
||||||
|
the Agda library \texttt{cubical} (\TODO{Cite}). 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. As well my contribution to \texttt{cubical} can be found in the git logs \TODO{Cite}.}
|
||||||
|
|
||||||
|
These theorems are all purely related to homotopy theory and cubical Agda 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 later in chapter
|
||||||
|
\ref{ch:implementation} throughout.
|
||||||
|
|
||||||
|
\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
|
||||||
|
``base-case''). For \emph{based path induction}, that equality is \emph{based}
|
||||||
|
at some element $a \tp A$.
|
||||||
|
|
||||||
|
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. Given a family of types:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
P \tp \prod_{a' \tp A} \prod_{p \tp a ≡ a'} \MCU
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
And an inhabitant of $P$ at $\refl$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
p \tp P\ a\ \refl
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
We have the function:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\pathJ\ P\ p \tp \prod_{a' \tp A} \prod_{p \tp a ≡ a'} P\ a\ p
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
\subsection{Paths over propositions}
|
||||||
|
\label{sec:lemPropF}
|
||||||
|
Another very useful combinator is $\lemPropF$:
|
||||||
|
|
||||||
|
To `promote' this to a dependent path we can use another useful combinator;
|
||||||
|
$\lemPropF$. Given a type $A \tp \MCU$ and a type family on $A$; $P \tp A \to
|
||||||
|
\MCU$. Let $\var{propP} \tp \prod_{x \tp A} \isProp\ (P\ x)$ be the proof that
|
||||||
|
$P$ 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 $p_0 \tp P\ a_0$ and $p_1 \tp
|
||||||
|
P\ a_1$:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\lemPropF\ \var{propP}\ p \defeq \Path\ (\lambda\; i \mto P\ (p\ i))\ p_0\ p_1
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
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, saw we have a type:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
T \defeq \sum_{a \tp A} P\ a
|
||||||
|
$$
|
||||||
|
%
|
||||||
|
For some proposition $P \tp A \to \MCU$. 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 P\ (p\ i))\ \snd\ t_0 \equiv \snd\ t_1
|
||||||
|
\end{align*}
|
||||||
|
%
|
||||||
|
Here $\lemPropF$ directly allow us to prove the latter of these:
|
||||||
|
%
|
||||||
|
$$
|
||||||
|
\lemPropF\ \var{propP}\ p
|
||||||
|
\tp \Path\ (\lambda i \to P\ (p\ i))\ \snd\ t_0 \equiv \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 it's first component is a
|
||||||
|
proposition, and it's second component is a proposition for all points of in 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)
|
||||||
|
$$
|
||||||
74
doc/discussion.tex
Normal file
74
doc/discussion.tex
Normal file
|
|
@ -0,0 +1,74 @@
|
||||||
|
\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}
|
||||||
|
Another aspect (\TODO{That I actually didn't highlight very well in the previous
|
||||||
|
chapter}) is the computational nature of paths. Say we have formalized this
|
||||||
|
common result about monads:
|
||||||
|
|
||||||
|
\TODO{Some equation\ldots}
|
||||||
|
|
||||||
|
By transporting this to the Kleisli formulation we get a result that we can use
|
||||||
|
to compute with. This is particularly useful because the Kleisli formulation
|
||||||
|
will be more familiar to programmers e.g. those coming from a background in
|
||||||
|
Haskell. Whereas the theory usually talks about monoidal monads.
|
||||||
|
|
||||||
|
\TODO{Mention that with postulates we cannot do this}
|
||||||
|
|
||||||
|
\subsection{Reusability of proofs}
|
||||||
|
The previous example also 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.
|
||||||
|
|
||||||
|
The introduction (section \ref{sec:context}) mentioned an often
|
||||||
|
employed-technique for enabling extensional equalities is to use the
|
||||||
|
setoid-interpretation. Nowhere in this formalization has this been necessary,
|
||||||
|
$\Path$ has been used globally in the project as 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 ``unique
|
||||||
|
existential'' is indexed by a relation that should play the role of
|
||||||
|
propositional equality. Likewise for equivalence relations, they are 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 \label{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.
|
||||||
|
|
||||||
|
\TODO{Universe levels.}
|
||||||
|
|
||||||
|
\section{Future work}
|
||||||
|
\subsection{Agda \texttt{Prop}}
|
||||||
|
Jesper Cockx' work extending the universe-level-laws for Agda and the
|
||||||
|
\texttt{Prop}-type.
|
||||||
|
|
||||||
|
\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. The path between monads that this library
|
||||||
|
exposes could provide one particularly interesting case-study.
|
||||||
|
|
||||||
|
\subsection{Higher inductive types}
|
||||||
|
This library has not explored the usefulness of higher inductive types in the
|
||||||
|
context of Category Theory.
|
||||||
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]
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
\section{Halftime report}
|
\chapter{Halftime report}
|
||||||
I've written this as an appendix because 1) the aim of the thesis changed
|
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
|
drastically from the planning report/proposal 2) partly I'm not sure how to
|
||||||
structure my thesis.
|
structure my thesis.
|
||||||
|
|
@ -8,7 +8,7 @@ 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
|
describe what I have managed to formalize so far and what outstanding challenges
|
||||||
I'm facing.
|
I'm facing.
|
||||||
|
|
||||||
\subsection{Implementation overview}
|
\section{Implementation overview}
|
||||||
The overall structure of my project is as follows:
|
The overall structure of my project is as follows:
|
||||||
|
|
||||||
\begin{itemize}
|
\begin{itemize}
|
||||||
|
|
@ -50,7 +50,7 @@ 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
|
the case of monads, to prove two categories propositionally equal it enough to
|
||||||
provide a proof that their data is equal.
|
provide a proof that their data is equal.
|
||||||
|
|
||||||
\subsubsection{Categories}
|
\subsection{Categories}
|
||||||
Defines the basic notion of a category. This definition closely follows that of
|
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,
|
[HoTT]: That is, the standard definition of a category (data; objects, arrows,
|
||||||
composition and identity, laws; preservation of identity and composition) plus
|
composition and identity, laws; preservation of identity and composition) plus
|
||||||
|
|
@ -69,30 +69,30 @@ shown that univalence holds for such a construction)
|
||||||
|
|
||||||
I also show that taking the opposite is an involution.
|
I also show that taking the opposite is an involution.
|
||||||
|
|
||||||
\subsubsection{Functors}
|
\subsection{Functors}
|
||||||
Defines the notion of a functor - also split up into data and laws.
|
Defines the notion of a functor - also split up into data and laws.
|
||||||
|
|
||||||
Propositionality for being a functor.
|
Propositionality for being a functor.
|
||||||
|
|
||||||
Composition of functors and the identity functor.
|
Composition of functors and the identity functor.
|
||||||
|
|
||||||
\subsubsection{Products}
|
\subsection{Products}
|
||||||
Definition of what it means for an object to be a product in a given category.
|
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.
|
Definition of what it means for a category to have all products.
|
||||||
|
|
||||||
\WIP Prove propositionality for being a product and having products.
|
\WIP{} Prove propositionality for being a product and having products.
|
||||||
|
|
||||||
\subsubsection{Exponentials}
|
\subsection{Exponentials}
|
||||||
Definition of what it means to be an exponential object.
|
Definition of what it means to be an exponential object.
|
||||||
|
|
||||||
Definition of what it means for a category to have all exponential objects.
|
Definition of what it means for a category to have all exponential objects.
|
||||||
|
|
||||||
\subsubsection{Cartesian closed categories}
|
\subsection{Cartesian closed categories}
|
||||||
Definition of what it means for a category to be cartesian closed; namely that
|
Definition of what it means for a category to be cartesian closed; namely that
|
||||||
it has all products and all exponentials.
|
it has all products and all exponentials.
|
||||||
|
|
||||||
\subsubsection{Natural transformations}
|
\subsection{Natural transformations}
|
||||||
Definition of transformations\footnote{Maybe this is a name I made up for a
|
Definition of transformations\footnote{Maybe this is a name I made up for a
|
||||||
family of morphisms} and the naturality condition for these.
|
family of morphisms} and the naturality condition for these.
|
||||||
|
|
||||||
|
|
@ -101,18 +101,18 @@ principle. Proof that natural transformations are homotopic sets.
|
||||||
|
|
||||||
The identity natural transformation.
|
The identity natural transformation.
|
||||||
|
|
||||||
\subsubsection{Yoneda embedding}
|
\subsection{Yoneda embedding}
|
||||||
|
|
||||||
The yoneda embedding is typically presented in terms of the category of
|
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
|
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
|
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.
|
functors and so this is how we define the yoneda embedding.
|
||||||
|
|
||||||
\subsubsection{Monads}
|
\subsection{Monads}
|
||||||
|
|
||||||
Defines an equivalence between these two formulations of a monad:
|
Defines an equivalence between these two formulations of a monad:
|
||||||
|
|
||||||
\subsubsubsection{Monoidal monads}
|
\subsubsection{Monoidal monads}
|
||||||
|
|
||||||
Defines the standard monoidal representation of a monad:
|
Defines the standard monoidal representation of a monad:
|
||||||
|
|
||||||
|
|
@ -121,7 +121,7 @@ and some laws about these natural transformations.
|
||||||
|
|
||||||
Propositionality proofs and equality principle is provided.
|
Propositionality proofs and equality principle is provided.
|
||||||
|
|
||||||
\subsubsubsection{Kleisli monads}
|
\subsubsection{Kleisli monads}
|
||||||
|
|
||||||
A presentation of monads perhaps more familiar to a functional programer:
|
A presentation of monads perhaps more familiar to a functional programer:
|
||||||
|
|
||||||
|
|
@ -130,28 +130,48 @@ some laws about these maps.
|
||||||
|
|
||||||
Propositionality proofs and equality principle is provided.
|
Propositionality proofs and equality principle is provided.
|
||||||
|
|
||||||
\subsubsubsection{Voevodsky's construction}
|
\subsubsection{Voevodsky's construction}
|
||||||
|
|
||||||
Provides construction 2.3 as presented in an unpublished paper by the late
|
Provides construction 2.3 as presented in an unpublished paper by Vladimir
|
||||||
Vladimir Voevodsky. This construction is similiar to the equivalence provided
|
Voevodsky. This construction is similiar to the equivalence provided for the two
|
||||||
for the two preceding formulations
|
preceding formulations
|
||||||
\footnote{ TODO: I would like to include in the thesis some motivation for why
|
\footnote{ TODO: I would like to include in the thesis some motivation for why
|
||||||
this construction is particularly interesting.}
|
this construction is particularly interesting.}
|
||||||
|
|
||||||
\subsubsection{Homotopy sets}
|
\subsection{Homotopy sets}
|
||||||
The typical category of sets where the objects are modelled by an Agda set
|
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
|
(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:
|
settings, we need to restrict the types to be those that are homotopy sets. Thus
|
||||||
|
the objects of this category are:
|
||||||
%
|
%
|
||||||
$$\Set_\ell \defeq \sum_{A \tp \MCU_\ell} \isSet\ A$$
|
$$\hSet_\ell \defeq \sum_{A \tp \MCU_\ell} \isSet\ A$$
|
||||||
%
|
%
|
||||||
\WIP{} I'm still missing a few details for the proof that this category is
|
The definition of univalence for categories I have defined is:
|
||||||
univalent. Indeed this doesn't not follow immediately from
|
|
||||||
%
|
%
|
||||||
$$\mathit{univalence} \tp (A \cong B) \simeq (A \simeq B)$$
|
$$\isEquiv\ (\hA \equiv \hB)\ (\hA \cong \hB)\ \idToIso$$
|
||||||
%
|
%
|
||||||
since $A$ and $B$ are of type $\MCU \neq \Set$.
|
Where $\hA and \hB$ denote objects in the category. Note that this is stronger
|
||||||
\subsubsection{Categories}
|
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
|
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.
|
definition of the ``raw'' category as well as some of the laws.
|
||||||
|
|
||||||
|
|
@ -162,16 +182,78 @@ 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
|
where we have a witness to this being a category. This is useful if this library
|
||||||
is later extended to talk about higher categories.
|
is later extended to talk about higher categories.
|
||||||
|
|
||||||
\subsubsection{Functors}
|
\subsection{Functors}
|
||||||
The category of functors and natural transformations. An immediate corrolary is
|
The category of functors and natural transformations. An immediate corrolary is
|
||||||
the set of presheaf categories.
|
the set of presheaf categories.
|
||||||
|
|
||||||
\WIP{} I have not shown that the category of functors is univalent.
|
\WIP{} I have not shown that the category of functors is univalent.
|
||||||
|
|
||||||
\subsubsection{Relations}
|
\subsection{Relations}
|
||||||
The category of relations. \WIP I have not shown that this category is
|
The category of relations. \WIP{} I have not shown that this category is
|
||||||
univalent. Not sure I intend to do so either.
|
univalent. Not sure I intend to do so either.
|
||||||
|
|
||||||
\subsubsection{Free category}
|
\subsection{Free category}
|
||||||
The free category of a category. \WIP I have not shown that this category is
|
The free category of a category. \WIP{} I have not shown that this category is
|
||||||
univalent.
|
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*}
|
||||||
|
%
|
||||||
1325
doc/implementation.tex
Normal file
1325
doc/implementation.tex
Normal file
File diff suppressed because it is too large
Load diff
205
doc/introduction.tex
Normal file
205
doc/introduction.tex
Normal file
|
|
@ -0,0 +1,205 @@
|
||||||
|
\chapter{Introduction}
|
||||||
|
Functional extensionality and univalence is not expressible in
|
||||||
|
\nomen{Intensional Martin Löf Type Theory} (ITT). This poses a severe limitation
|
||||||
|
on both i. what is \emph{provable} and ii. the \emph{re-usability} 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}, \cite{cubical-agda}) that allows us to work in such a ``cubical
|
||||||
|
setting''. This thesis will explore the usefulness of this extension in the
|
||||||
|
context of category theory.
|
||||||
|
%
|
||||||
|
\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}
|
||||||
|
Consider the functions:
|
||||||
|
%
|
||||||
|
\begin{multicols}{2}
|
||||||
|
\noindent
|
||||||
|
\begin{equation*}
|
||||||
|
f \defeq (n \tp \bN) \mapsto (0 + n \tp \bN)
|
||||||
|
\end{equation*}
|
||||||
|
\begin{equation*}
|
||||||
|
g \defeq (n \tp \bN) \mapsto (n + 0 \tp \bN)
|
||||||
|
\end{equation*}
|
||||||
|
\end{multicols}
|
||||||
|
%
|
||||||
|
$n + 0$ is \nomen{definitionally} equal to $n$, which we write as $n + 0 = n$.
|
||||||
|
This is also called \nomen{judgmental} equality. 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*}
|
||||||
|
+ & \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$. $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, which we write as $n + 0 \equiv n$. 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{point-wise equality}, where the \emph{points} of a function refers
|
||||||
|
to it's arguments.
|
||||||
|
|
||||||
|
In the context of category theory functional extensionality is e.g. needed to
|
||||||
|
show 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$) thus 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 prove $\idFun \comp g
|
||||||
|
\equiv g$ and thus close the goal.
|
||||||
|
%
|
||||||
|
\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 have the same shape (Greek; \nomen{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
|
||||||
|
\nomen{equivalent} types. I will return to the definition of equivalence later
|
||||||
|
in section \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 common to identify isomorphic structures
|
||||||
|
and 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.
|
||||||
|
|
||||||
|
\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. Just as a first reference see this
|
||||||
|
question on Math Overflow: \cite{mo-formalizations}. Notably these
|
||||||
|
implementations of category theory in Agda:
|
||||||
|
%
|
||||||
|
\begin{itemize}
|
||||||
|
\item
|
||||||
|
\url{https://github.com/copumpkin/categories}
|
||||||
|
|
||||||
|
A formalization in Agda using the setoid approach
|
||||||
|
\item
|
||||||
|
\url{https://github.com/pcapriotti/agda-categories}
|
||||||
|
|
||||||
|
A formalization in Agda with univalence and functional extensionality as
|
||||||
|
postulates.
|
||||||
|
\item
|
||||||
|
\url{https://github.com/HoTT/HoTT/tree/master/theories/Categories}
|
||||||
|
|
||||||
|
A formalization in Coq in the homotopic setting
|
||||||
|
\item
|
||||||
|
\url{https://github.com/mortberg/cubicaltt}
|
||||||
|
|
||||||
|
A formalization in CubicalTT - a language designed for cubical-type-theory.
|
||||||
|
Formalizes many different things, but only a few concepts from category
|
||||||
|
theory.
|
||||||
|
|
||||||
|
\end{itemize}
|
||||||
|
%
|
||||||
|
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 and to try and
|
||||||
|
compare some aspects of this formalization with the existing ones.\TODO{How can
|
||||||
|
I live up to this?}
|
||||||
|
|
||||||
|
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} (\TODO{Pageno!} \cite{huber-2016}). 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$; $e = \mathit{suc}^n\ 0$. Without canonicity
|
||||||
|
terms in the language can get ``stuck'' -- meaning that they do not reduce to a
|
||||||
|
canonical form.
|
||||||
|
|
||||||
|
Another approach is to use the \emph{setoid interpretation} of type theory
|
||||||
|
(\cite{hofmann-1995,huber-2016}). With this approach one works with
|
||||||
|
\nomen{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. This approach has other drawbacks; it does not satisfy
|
||||||
|
all propositional equalities of type theory (\TODO{Citation needed}), is
|
||||||
|
cumbersome to work with in practice (\cite[p. 4]{huber-2016}) and makes
|
||||||
|
equational proofs less reusable since equational proofs $a \sim_{X} b$ are
|
||||||
|
inherently `local' to the extensional set $(X , \sim)$.
|
||||||
|
|
||||||
|
\section{Conventions}
|
||||||
|
\TODO{Talk a bit about terminology. Find a good place to stuff this little
|
||||||
|
section.}
|
||||||
|
|
||||||
|
In the remainder of this paper I will use the term \nomen{Type} to describe --
|
||||||
|
well, types. Thereby diverging from the notation in Agda where the keyword
|
||||||
|
\texttt{Set} refers to types. \nomen{Set} on the other hand shall refer to the
|
||||||
|
homotopical notion of a set. I will also leave all universe levels implicit.
|
||||||
|
|
||||||
|
And I use the term \nomen{arrow} to refer to morphisms in a category, whereas
|
||||||
|
the terms morphism, map or function shall be reserved for talking about
|
||||||
|
type-theoretic functions; i.e. functions in Agda.
|
||||||
|
|
||||||
|
$\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{center}
|
||||||
|
\begin{tabular}{ c c c }
|
||||||
|
Name & Agda & Notation \\
|
||||||
|
\hline
|
||||||
|
\nomen{Type} & \texttt{Set} & $\Type$ \\
|
||||||
|
\nomen{Set} & \texttt{Σ Set IsSet} & $\Set$ \\
|
||||||
|
Function, morphism, map & \texttt{A → B} & $A → B$ \\
|
||||||
|
Dependent- ditto & \texttt{(a : A) → B} & $∏_{a \tp A} B$ \\
|
||||||
|
\nomen{Arrow} & \texttt{Arrow A B} & $\Arrow\ A\ B$ \\
|
||||||
|
\nomen{Object} & \texttt{C.Object} & $̱ℂ.Object$ \\
|
||||||
|
Definition & \texttt{=} & $̱\defeq$ \\
|
||||||
|
Judgmental equality & \null & $̱=$ \\
|
||||||
|
Propositional equality & \null & $̱\equiv$
|
||||||
|
\end{tabular}
|
||||||
|
\end{center}
|
||||||
BIN
doc/isomorphism.png
Normal file
BIN
doc/isomorphism.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 344 KiB |
88
doc/macros.tex
Normal file
88
doc/macros.tex
Normal file
|
|
@ -0,0 +1,88 @@
|
||||||
|
\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}{\mathbb{C}}
|
||||||
|
\newcommand{\bX}{\mathbb{X}}
|
||||||
|
% \newcommand{\to}{\rightarrow}
|
||||||
|
\newcommand{\mto}{\mapsto}
|
||||||
|
\newcommand{\UU}{\ensuremath{\mathcal{U}}\xspace}
|
||||||
|
\let\type\UU
|
||||||
|
\newcommand{\MCU}{\UU}
|
||||||
|
\newcommand{\nomen}[1]{\emph{#1}}
|
||||||
|
\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{\Hom}{\var{Hom}}
|
||||||
|
\newcommand{\fmap}{\var{fmap}}
|
||||||
|
\newcommand{\bind}{\var{bind}}
|
||||||
|
\newcommand{\join}{\var{join}}
|
||||||
|
\newcommand{\omap}{\var{omap}}
|
||||||
|
\newcommand{\pure}{\var{pure}}
|
||||||
|
\newcommand{\idFun}{\var{id}}
|
||||||
|
\newcommand{\Sets}{\var{Sets}}
|
||||||
|
\newcommand{\Set}{\var{Set}}
|
||||||
|
\newcommand{\hSet}{\var{hSet}}
|
||||||
|
\newcommand{\id}{\var{id}}
|
||||||
|
\newcommand{\isEquiv}{\var{isEquiv}}
|
||||||
|
\newcommand{\idToIso}{\var{idToIso}}
|
||||||
|
\newcommand{\isSet}{\var{isSet}}
|
||||||
|
\newcommand{\isContr}{\var{isContr}}
|
||||||
|
\newcommand{\isGroupoid}{\var{isGroupoid}}
|
||||||
|
\newcommand{\pathJ}{\var{pathJ}}
|
||||||
|
\newcommand\Object{\var{Object}}
|
||||||
|
\newcommand\Functor{\var{Functor}}
|
||||||
|
\newcommand\isProp{\var{isProp}}
|
||||||
|
\newcommand\propPi{\var{propPi}}
|
||||||
|
\newcommand\propSig{\var{propSig}}
|
||||||
|
\newcommand\PreCategory{\var{PreCategory}}
|
||||||
|
\newcommand\IsPreCategory{\var{IsPreCategory}}
|
||||||
|
\newcommand\isIdentity{\var{isIdentity}}
|
||||||
|
\newcommand\propIsIdentity{\var{propIsIdentity}}
|
||||||
|
\newcommand\IsCategory{\var{IsCategory}}
|
||||||
|
\newcommand\Gl{\var{\lambda}}
|
||||||
|
\newcommand\lemPropF{\var{lemPropF}}
|
||||||
|
\newcommand\isPreCategory{\var{isPreCategory}}
|
||||||
|
\newcommand\congruence{\var{cong}}
|
||||||
|
\newcommand\identity{\var{identity}}
|
||||||
|
\newcommand\isequiv{\var{isequiv}}
|
||||||
|
\newcommand\qinv{\var{qinv}}
|
||||||
|
\newcommand\fiber{\var{fiber}}
|
||||||
|
\newcommand\shuffle{\var{shuffle}}
|
||||||
|
\newcommand\Univalent{\var{Univalent}}
|
||||||
|
\newcommand\refl{\var{refl}}
|
||||||
|
\newcommand\isoToId{\var{isoToId}}
|
||||||
|
\newcommand\Isomorphism{\var{Isomorphism}}
|
||||||
|
\newcommand\rrr{\ggg}
|
||||||
|
\newcommand\fish{\mathrel{\wideoverbar{\rrr}}}
|
||||||
|
\newcommand\fst{\var{fst}}
|
||||||
|
\newcommand\snd{\var{snd}}
|
||||||
|
\newcommand\Path{\var{Path}}
|
||||||
|
\newcommand\Category{\var{Category}}
|
||||||
|
\newcommand\TODO[1]{TODO: \emph{#1}}
|
||||||
|
\newcommand*{\QED}{\hfill\ensuremath{\square}}%
|
||||||
|
\newcommand\uexists{\exists!}
|
||||||
|
\newcommand\Arrow{\var{Arrow}}
|
||||||
|
\newcommand\NTsym{\var{NT}}
|
||||||
|
\newcommand\NT[2]{\NTsym\ #1\ #2}
|
||||||
|
\newcommand\Endo[1]{\var{Endo}\ #1}
|
||||||
|
\newcommand\EndoR{\mathcal{R}}
|
||||||
76
doc/main.tex
Normal file
76
doc/main.tex
Normal file
|
|
@ -0,0 +1,76 @@
|
||||||
|
\documentclass[a4paper]{report}
|
||||||
|
%% \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}
|
||||||
|
\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}
|
||||||
|
\bibliographystyle{plain}
|
||||||
|
|
||||||
|
%% \newtheorem{prop}{Proposition}
|
||||||
|
\makeatletter
|
||||||
|
\newcommand*{\rom}[1]{\expandafter\@slowroman\romannumeral #1@}
|
||||||
|
\makeatother
|
||||||
|
\begin{document}
|
||||||
|
\myfrontmatter
|
||||||
|
\pagenumbering{roman}
|
||||||
|
\maketitle
|
||||||
|
\addtocontents{toc}{\protect\thispagestyle{empty}}
|
||||||
|
\tableofcontents
|
||||||
|
\pagenumbering{arabic}
|
||||||
|
%
|
||||||
|
\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{sources.tex}
|
||||||
|
%% \input{planning.tex}
|
||||||
|
%% \input{halftime.tex}
|
||||||
|
\end{appendices}
|
||||||
|
\end{document}
|
||||||
87
doc/packages.tex
Normal file
87
doc/packages.tex
Normal file
|
|
@ -0,0 +1,87 @@
|
||||||
|
\usepackage[utf8]{inputenc}
|
||||||
|
|
||||||
|
\usepackage{natbib}
|
||||||
|
\usepackage[
|
||||||
|
hidelinks,
|
||||||
|
pdfusetitle,
|
||||||
|
pdfsubject={category theory},
|
||||||
|
pdfkeywords={type theory, homotopy theory, category theory, agda}]
|
||||||
|
{hyperref}
|
||||||
|
|
||||||
|
\usepackage{graphicx}
|
||||||
|
|
||||||
|
\usepackage{parskip}
|
||||||
|
\usepackage{multicol}
|
||||||
|
\usepackage{amssymb,amsmath,amsthm,stmaryrd,mathrsfs,wasysym}
|
||||||
|
\usepackage[toc,page]{appendix}
|
||||||
|
\usepackage{xspace}
|
||||||
|
\usepackage[a4paper]{geometry}
|
||||||
|
|
||||||
|
% \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{≊}}
|
||||||
|
|
@ -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:
|
||||||
|
|
@ -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}}
|
||||||
}
|
}
|
||||||
428
doc/sources.tex
Normal file
428
doc/sources.tex
Normal file
|
|
@ -0,0 +1,428 @@
|
||||||
|
\chapter{Source code}
|
||||||
|
\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. It's provided here as a convenience. The actual sources
|
||||||
|
are the only authoritative source. Is something is not clear, please refer to
|
||||||
|
those.
|
||||||
|
\clearpage
|
||||||
|
\section{Cubical}
|
||||||
|
\label{sec:app-cubical}
|
||||||
|
\begin{figure}[h]
|
||||||
|
\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}
|
||||||
|
%
|
||||||
|
\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}
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit fbd8ba7ea84c4b643fd08797b4031b18a59f561d
|
Subproject commit 4493cf249a1648be2ad365fe94ece337bfbcb5d9
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit 5b35333dbbd8fa523e478c1cfe60657321ca38fe
|
Subproject commit 4e5d43a9c75286b3a8750567d75a930674d7720d
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
Remove stuff about models of type theory
|
|
||||||
|
|
||||||
Add references to specific (noteable) implementaitons of category theory:
|
|
||||||
* Unimath
|
|
||||||
* cubicaltt
|
|
||||||
* https://github.com/pcapriotti/agda-categories
|
|
||||||
* https://github.com/copumpkin/categories
|
|
||||||
* ...
|
|
||||||
|
|
||||||
Talk about structure of library:
|
|
||||||
===
|
|
||||||
|
|
||||||
Propositional- and non-propositional stuff split up
|
|
||||||
Providing "equiality principles"
|
|
||||||
Provide overview of what has been proven.
|
|
||||||
|
|
||||||
What can I say about reusability?
|
|
||||||
|
|
||||||
Misc
|
|
||||||
====
|
|
||||||
|
|
||||||
Propositional content
|
|
||||||
|
|
@ -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,26 +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}}
|
|
||||||
\newcommand{\Set}{\mathit{Set}}
|
|
||||||
\newcommand{\MCU}{\UU}
|
|
||||||
\newcommand{\isSet}{\mathit{isSet}}
|
|
||||||
\newcommand{\tp}{\;\mathord{:}\;}
|
|
||||||
\newcommand{\subsubsubsection}[1]{\textbf{#1}}
|
|
||||||
\newcommand{\WIP}[1]{\textbf{[WIP]}}
|
|
||||||
|
|
@ -1,289 +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}
|
|
||||||
\usepackage{xspace}
|
|
||||||
|
|
||||||
% \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}
|
|
||||||
\input{halftime.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}
|
|
||||||
}
|
|
||||||
|
|
@ -3,42 +3,22 @@
|
||||||
|
|
||||||
module Cat.Categories.Cat where
|
module Cat.Categories.Cat where
|
||||||
|
|
||||||
open import Cat.Prelude renaming (proj₁ to fst ; proj₂ to snd)
|
open import Cat.Prelude renaming (fst to fst ; snd 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 hiding (_×_ ; product)
|
open import Cat.Category.Exponential hiding (_×_ ; product)
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
-- The category of categories
|
-- The category of categories
|
||||||
module _ (ℓ ℓ' : Level) where
|
module _ (ℓ ℓ' : Level) where
|
||||||
private
|
|
||||||
module _ {𝔸 𝔹 ℂ 𝔻 : Category ℓ ℓ'} {F : Functor 𝔸 𝔹} {G : Functor 𝔹 ℂ} {H : Functor ℂ 𝔻} where
|
|
||||||
assc : F[ H ∘ F[ G ∘ F ] ] ≡ F[ F[ H ∘ G ] ∘ F ]
|
|
||||||
assc = Functor≡ refl
|
|
||||||
|
|
||||||
module _ {ℂ 𝔻 : Category ℓ ℓ'} {F : Functor ℂ 𝔻} where
|
|
||||||
ident-r : F[ F ∘ identity ] ≡ F
|
|
||||||
ident-r = Functor≡ refl
|
|
||||||
|
|
||||||
ident-l : F[ identity ∘ F ] ≡ F
|
|
||||||
ident-l = Functor≡ refl
|
|
||||||
|
|
||||||
RawCat : RawCategory (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
RawCat : RawCategory (lsuc (ℓ ⊔ ℓ')) (ℓ ⊔ ℓ')
|
||||||
RawCategory.Object RawCat = Category ℓ ℓ'
|
RawCategory.Object RawCat = Category ℓ ℓ'
|
||||||
RawCategory.Arrow RawCat = Functor
|
RawCategory.Arrow RawCat = Functor
|
||||||
RawCategory.𝟙 RawCat = identity
|
RawCategory.identity RawCat = Functors.identity
|
||||||
RawCategory._∘_ RawCat = F[_∘_]
|
RawCategory._<<<_ RawCat = F[_∘_]
|
||||||
|
|
||||||
private
|
|
||||||
open RawCategory RawCat
|
|
||||||
isAssociative : IsAssociative
|
|
||||||
isAssociative {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
|
|
||||||
|
|
||||||
isIdentity : IsIdentity identity
|
|
||||||
isIdentity = ident-l , ident-r
|
|
||||||
|
|
||||||
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
|
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
|
||||||
-- however, form a groupoid! Therefore there is no (1-)category of
|
-- however, form a groupoid! Therefore there is no (1-)category of
|
||||||
|
|
@ -68,51 +48,55 @@ module CatProduct {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
Obj = ℂ.Object × 𝔻.Object
|
Obj = ℂ.Object × 𝔻.Object
|
||||||
Arr : Obj → Obj → Set ℓ'
|
Arr : Obj → Obj → Set ℓ'
|
||||||
Arr (c , d) (c' , d') = ℂ [ c , c' ] × 𝔻 [ d , d' ]
|
Arr (c , d) (c' , d') = ℂ [ c , c' ] × 𝔻 [ d , d' ]
|
||||||
𝟙 : {o : Obj} → Arr o o
|
identity : {o : Obj} → Arr o o
|
||||||
𝟙 = ℂ.𝟙 , 𝔻.𝟙
|
identity = ℂ.identity , 𝔻.identity
|
||||||
_∘_ :
|
_<<<_ :
|
||||||
{a b c : Obj} →
|
{a b c : Obj} →
|
||||||
Arr b c →
|
Arr b c →
|
||||||
Arr a b →
|
Arr a b →
|
||||||
Arr a c
|
Arr a c
|
||||||
_∘_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
_<<<_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) → ℂ [ bc∈C ∘ ab∈C ] , 𝔻 [ bc∈D ∘ ab∈D ]}
|
||||||
|
|
||||||
rawProduct : RawCategory ℓ ℓ'
|
rawProduct : RawCategory ℓ ℓ'
|
||||||
RawCategory.Object rawProduct = Obj
|
RawCategory.Object rawProduct = Obj
|
||||||
RawCategory.Arrow rawProduct = Arr
|
RawCategory.Arrow rawProduct = Arr
|
||||||
RawCategory.𝟙 rawProduct = 𝟙
|
RawCategory.identity rawProduct = identity
|
||||||
RawCategory._∘_ rawProduct = _∘_
|
RawCategory._<<<_ rawProduct = _<<<_
|
||||||
|
|
||||||
open RawCategory rawProduct
|
open RawCategory rawProduct
|
||||||
|
|
||||||
arrowsAreSets : ArrowsAreSets
|
arrowsAreSets : ArrowsAreSets
|
||||||
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
||||||
isIdentity : IsIdentity 𝟙
|
isIdentity : IsIdentity identity
|
||||||
isIdentity
|
isIdentity
|
||||||
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
||||||
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
||||||
|
|
||||||
|
isPreCategory : IsPreCategory rawProduct
|
||||||
|
IsPreCategory.isAssociative isPreCategory = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCategory = isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
|
|
||||||
postulate univalent : Univalence.Univalent isIdentity
|
postulate univalent : Univalence.Univalent isIdentity
|
||||||
instance
|
|
||||||
isCategory : IsCategory rawProduct
|
isCategory : IsCategory rawProduct
|
||||||
IsCategory.isAssociative isCategory = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
IsCategory.isIdentity isCategory = isIdentity
|
|
||||||
IsCategory.arrowsAreSets isCategory = arrowsAreSets
|
|
||||||
IsCategory.univalent isCategory = univalent
|
IsCategory.univalent isCategory = univalent
|
||||||
|
|
||||||
object : Category ℓ ℓ'
|
object : Category ℓ ℓ'
|
||||||
Category.raw object = rawProduct
|
Category.raw object = rawProduct
|
||||||
|
Category.isCategory object = isCategory
|
||||||
|
|
||||||
proj₁ : Functor object ℂ
|
fstF : Functor object ℂ
|
||||||
proj₁ = record
|
fstF = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ omap = fst ; fmap = fst }
|
{ omap = fst ; fmap = fst }
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
{ isIdentity = refl ; isDistributive = refl }
|
{ isIdentity = refl ; isDistributive = refl }
|
||||||
}
|
}
|
||||||
|
|
||||||
proj₂ : Functor object 𝔻
|
sndF : Functor object 𝔻
|
||||||
proj₂ = record
|
sndF = record
|
||||||
{ raw = record
|
{ raw = record
|
||||||
{ omap = snd ; fmap = snd }
|
{ omap = snd ; fmap = snd }
|
||||||
; isFunctor = record
|
; isFunctor = record
|
||||||
|
|
@ -136,17 +120,27 @@ module CatProduct {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||||
open module x₁ = Functor x₁
|
open module x₁ = Functor x₁
|
||||||
open module x₂ = Functor x₂
|
open module x₂ = Functor x₂
|
||||||
|
|
||||||
isUniqL : F[ proj₁ ∘ x ] ≡ x₁
|
isUniqL : F[ fstF ∘ x ] ≡ x₁
|
||||||
isUniqL = Functor≡ refl
|
isUniqL = Functor≡ refl
|
||||||
|
|
||||||
isUniqR : F[ proj₂ ∘ x ] ≡ x₂
|
isUniqR : F[ sndF ∘ x ] ≡ x₂
|
||||||
isUniqR = Functor≡ refl
|
isUniqR = Functor≡ refl
|
||||||
|
|
||||||
isUniq : F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂
|
isUniq : F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂
|
||||||
isUniq = isUniqL , isUniqR
|
isUniq = isUniqL , isUniqR
|
||||||
|
|
||||||
isProduct : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂)
|
isProduct : ∃![ x ] (F[ fstF ∘ x ] ≡ x₁ × F[ sndF ∘ x ] ≡ x₂)
|
||||||
isProduct = x , isUniq
|
isProduct = x , isUniq , uq
|
||||||
|
where
|
||||||
|
module _ {y : Functor X object} (eq : F[ fstF ∘ y ] ≡ x₁ × F[ sndF ∘ y ] ≡ x₂) where
|
||||||
|
omapEq : Functor.omap x ≡ Functor.omap y
|
||||||
|
omapEq = {!!}
|
||||||
|
-- fmapEq : (λ i → {!{A B : ?} → Arrow A B → 𝔻 [ ? A , ? B ]!}) [ Functor.fmap x ≡ Functor.fmap y ]
|
||||||
|
-- fmapEq = {!!}
|
||||||
|
rawEq : Functor.raw x ≡ Functor.raw y
|
||||||
|
rawEq = {!!}
|
||||||
|
uq : x ≡ y
|
||||||
|
uq = Functor≡ rawEq
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
private
|
private
|
||||||
|
|
@ -158,8 +152,8 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
|
|
||||||
rawProduct : RawProduct Catℓ ℂ 𝔻
|
rawProduct : RawProduct Catℓ ℂ 𝔻
|
||||||
RawProduct.object rawProduct = P.object
|
RawProduct.object rawProduct = P.object
|
||||||
RawProduct.proj₁ rawProduct = P.proj₁
|
RawProduct.fst rawProduct = P.fstF
|
||||||
RawProduct.proj₂ rawProduct = P.proj₂
|
RawProduct.snd rawProduct = P.sndF
|
||||||
|
|
||||||
isProduct : IsProduct Catℓ _ _ rawProduct
|
isProduct : IsProduct Catℓ _ _ rawProduct
|
||||||
IsProduct.ump isProduct = P.isProduct
|
IsProduct.ump isProduct = P.isProduct
|
||||||
|
|
@ -175,6 +169,9 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||||
-- | The category of categories have expoentntials - and because it has products
|
-- | The category of categories have expoentntials - and because it has products
|
||||||
-- it is therefory also cartesian closed.
|
-- it is therefory also cartesian closed.
|
||||||
module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ 𝔻
|
||||||
|
renaming (identity to identityNT)
|
||||||
|
using ()
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
|
|
@ -189,8 +186,8 @@ module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
object = Fun
|
object = Fun
|
||||||
|
|
||||||
module _ {dom cod : Functor ℂ 𝔻 × ℂ.Object} where
|
module _ {dom cod : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
open Σ dom renaming (proj₁ to F ; proj₂ to A)
|
open Σ dom renaming (fst to F ; snd to A)
|
||||||
open Σ cod renaming (proj₁ to G ; proj₂ to B)
|
open Σ cod renaming (fst to G ; snd to B)
|
||||||
private
|
private
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
module G = Functor G
|
module G = Functor G
|
||||||
|
|
@ -207,23 +204,23 @@ module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
open CatProduct renaming (object to _⊗_) using ()
|
open CatProduct renaming (object to _⊗_) using ()
|
||||||
|
|
||||||
module _ {c : Functor ℂ 𝔻 × ℂ.Object} where
|
module _ {c : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
open Σ c renaming (proj₁ to F ; proj₂ to C)
|
open Σ c renaming (fst to F ; snd to C)
|
||||||
|
|
||||||
ident : fmap {c} {c} (NT.identity F , ℂ.𝟙 {A = snd c}) ≡ 𝔻.𝟙
|
ident : fmap {c} {c} (identityNT F , ℂ.identity {A = snd c}) ≡ 𝔻.identity
|
||||||
ident = begin
|
ident = begin
|
||||||
fmap {c} {c} (Category.𝟙 (object ⊗ ℂ) {c}) ≡⟨⟩
|
fmap {c} {c} (Category.identity (object ⊗ ℂ) {c}) ≡⟨⟩
|
||||||
fmap {c} {c} (idN F , ℂ.𝟙) ≡⟨⟩
|
fmap {c} {c} (idN F , ℂ.identity) ≡⟨⟩
|
||||||
𝔻 [ identityTrans F C ∘ F.fmap ℂ.𝟙 ] ≡⟨⟩
|
𝔻 [ identityTrans F C ∘ F.fmap ℂ.identity ] ≡⟨⟩
|
||||||
𝔻 [ 𝔻.𝟙 ∘ F.fmap ℂ.𝟙 ] ≡⟨ 𝔻.leftIdentity ⟩
|
𝔻 [ 𝔻.identity ∘ F.fmap ℂ.identity ] ≡⟨ 𝔻.leftIdentity ⟩
|
||||||
F.fmap ℂ.𝟙 ≡⟨ F.isIdentity ⟩
|
F.fmap ℂ.identity ≡⟨ F.isIdentity ⟩
|
||||||
𝔻.𝟙 ∎
|
𝔻.identity ∎
|
||||||
where
|
where
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
|
|
||||||
module _ {F×A G×B H×C : Functor ℂ 𝔻 × ℂ.Object} where
|
module _ {F×A G×B H×C : Functor ℂ 𝔻 × ℂ.Object} where
|
||||||
open Σ F×A renaming (proj₁ to F ; proj₂ to A)
|
open Σ F×A renaming (fst to F ; snd to A)
|
||||||
open Σ G×B renaming (proj₁ to G ; proj₂ to B)
|
open Σ G×B renaming (fst to G ; snd to B)
|
||||||
open Σ H×C renaming (proj₁ to H ; proj₂ to C)
|
open Σ H×C renaming (fst to H ; snd to C)
|
||||||
private
|
private
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
module G = Functor G
|
module G = Functor G
|
||||||
|
|
@ -232,14 +229,14 @@ module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
module _
|
module _
|
||||||
{θ×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 (proj₁ to θNT ; proj₂ to f)
|
open Σ θ×f renaming (fst to θNT ; snd to f)
|
||||||
open Σ θNT renaming (proj₁ to θ ; proj₂ to θNat)
|
open Σ θNT renaming (fst to θ ; snd to θNat)
|
||||||
open Σ η×g renaming (proj₁ to ηNT ; proj₂ to g)
|
open Σ η×g renaming (fst to ηNT ; snd to g)
|
||||||
open Σ ηNT renaming (proj₁ to η ; proj₂ to ηNat)
|
open Σ ηNT renaming (fst to η ; snd to ηNat)
|
||||||
private
|
private
|
||||||
ηθNT : NaturalTransformation F H
|
ηθNT : NaturalTransformation F H
|
||||||
ηθNT = NT[_∘_] {F} {G} {H} ηNT θNT
|
ηθNT = NT[_∘_] {F} {G} {H} ηNT θNT
|
||||||
open Σ ηθNT renaming (proj₁ to ηθ ; proj₂ to ηθNat)
|
open Σ ηθNT renaming (fst to ηθ ; snd to ηθNat)
|
||||||
|
|
||||||
isDistributive :
|
isDistributive :
|
||||||
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F.fmap ( ℂ [ g ∘ f ] ) ]
|
𝔻 [ 𝔻 [ η C ∘ θ C ] ∘ F.fmap ( ℂ [ g ∘ f ] ) ]
|
||||||
|
|
@ -283,18 +280,18 @@ module CatExponential {ℓ : Level} (ℂ 𝔻 : Category ℓ ℓ) where
|
||||||
: Functor 𝔸 object → Functor ℂ ℂ
|
: Functor 𝔸 object → Functor ℂ ℂ
|
||||||
→ Functor (𝔸 ⊗ ℂ) (object ⊗ ℂ)
|
→ Functor (𝔸 ⊗ ℂ) (object ⊗ ℂ)
|
||||||
transpose : Functor 𝔸 object
|
transpose : Functor 𝔸 object
|
||||||
eq : F[ eval ∘ (parallelProduct transpose (identity {C = ℂ})) ] ≡ F
|
eq : F[ eval ∘ (parallelProduct transpose (Functors.identity {ℂ = ℂ})) ] ≡ F
|
||||||
-- eq : F[ :eval: ∘ {!!} ] ≡ F
|
-- eq : F[ :eval: ∘ {!!} ] ≡ F
|
||||||
-- eq : Catℓ [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (𝟙 Catℓ {o = ℂ})) ] ≡ F
|
-- eq : Catℓ [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (identity Catℓ {o = ℂ})) ] ≡ F
|
||||||
-- eq' : (Catℓ [ :eval: ∘
|
-- eq' : (Catℓ [ :eval: ∘
|
||||||
-- (record { product = product } HasProducts.|×| transpose)
|
-- (record { product = product } HasProducts.|×| transpose)
|
||||||
-- (𝟙 Catℓ)
|
-- (identity Catℓ)
|
||||||
-- ])
|
-- ])
|
||||||
-- ≡ F
|
-- ≡ F
|
||||||
|
|
||||||
-- For some reason after `e8215b2c051062c6301abc9b3f6ec67106259758`
|
-- For some reason after `e8215b2c051062c6301abc9b3f6ec67106259758`
|
||||||
-- `catTranspose` makes Agda hang. catTranspose : ∃![ F~ ] (Catℓ [
|
-- `catTranspose` makes Agda hang. catTranspose : ∃![ F~ ] (Catℓ [
|
||||||
-- :eval: ∘ (parallelProduct F~ (𝟙 Catℓ {o = ℂ}))] ≡ F) catTranspose =
|
-- :eval: ∘ (parallelProduct F~ (identity Catℓ {o = ℂ}))] ≡ F) catTranspose =
|
||||||
-- transpose , eq
|
-- transpose , eq
|
||||||
|
|
||||||
-- We don't care about filling out the holes below since they are anyways hidden
|
-- We don't care about filling out the holes below since they are anyways hidden
|
||||||
|
|
@ -318,8 +315,8 @@ module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where
|
||||||
exponent : Exponential Catℓ ℂ 𝔻
|
exponent : Exponential Catℓ ℂ 𝔻
|
||||||
exponent = record
|
exponent = record
|
||||||
{ obj = CatExp.object
|
{ obj = CatExp.object
|
||||||
; eval = eval
|
; eval = {!eval!}
|
||||||
; isExponential = isExponential
|
; isExponential = {!isExponential!}
|
||||||
}
|
}
|
||||||
|
|
||||||
hasExponentials : HasExponentials Catℓ
|
hasExponentials : HasExponentials Catℓ
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,6 @@ 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 Function
|
|
||||||
open import Relation.Nullary
|
open import Relation.Nullary
|
||||||
open import Relation.Nullary.Decidable
|
open import Relation.Nullary.Decidable
|
||||||
|
|
||||||
|
|
@ -19,7 +18,7 @@ open import Cat.Category.Functor
|
||||||
-- 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
|
||||||
|
|
@ -67,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ℂ
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -25,21 +25,21 @@ module _ {ℓa ℓb : Level} where
|
||||||
private
|
private
|
||||||
module T = Functor T
|
module T = Functor T
|
||||||
Type : (Γ : ℂ.Object) → Set ℓa
|
Type : (Γ : ℂ.Object) → Set ℓa
|
||||||
Type Γ = proj₁ (proj₁ (T.omap Γ))
|
Type Γ = fst (fst (T.omap Γ))
|
||||||
|
|
||||||
module _ {Γ : ℂ.Object} {A : Type Γ} where
|
module _ {Γ : ℂ.Object} {A : Type Γ} where
|
||||||
|
|
||||||
-- module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
-- module _ {A B : Object ℂ} {γ : ℂ [ A , B ]} where
|
||||||
-- k : Σ (proj₁ (omap T B) → proj₁ (omap T A))
|
-- k : Σ (fst (omap T B) → fst (omap T A))
|
||||||
-- (λ f →
|
-- (λ f →
|
||||||
-- {x : proj₁ (omap T B)} →
|
-- {x : fst (omap T B)} →
|
||||||
-- proj₂ (omap T B) x → proj₂ (omap T A) (f x))
|
-- snd (omap T B) x → snd (omap T A) (f x))
|
||||||
-- k = T.fmap γ
|
-- k = T.fmap γ
|
||||||
-- k₁ : proj₁ (omap T B) → proj₁ (omap T A)
|
-- k₁ : fst (omap T B) → fst (omap T A)
|
||||||
-- k₁ = proj₁ k
|
-- k₁ = fst k
|
||||||
-- k₂ : ({x : proj₁ (omap T B)} →
|
-- k₂ : ({x : fst (omap T B)} →
|
||||||
-- proj₂ (omap T B) x → proj₂ (omap T A) (k₁ x))
|
-- snd (omap T B) x → snd (omap T A) (k₁ x))
|
||||||
-- k₂ = proj₂ k
|
-- k₂ = snd k
|
||||||
|
|
||||||
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
record ContextComprehension : Set (ℓa ⊔ ℓb) where
|
||||||
field
|
field
|
||||||
|
|
|
||||||
|
|
@ -2,62 +2,60 @@
|
||||||
module Cat.Categories.Fam where
|
module Cat.Categories.Fam where
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
import Function
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
module _ (ℓa ℓb : Level) where
|
module _ (ℓa ℓb : Level) where
|
||||||
private
|
private
|
||||||
Object = Σ[ hA ∈ hSet ℓa ] (proj₁ hA → hSet ℓb)
|
Object = Σ[ hA ∈ hSet ℓa ] (fst hA → hSet ℓb)
|
||||||
Arr : Object → Object → Set (ℓa ⊔ ℓb)
|
Arr : Object → Object → Set (ℓa ⊔ ℓb)
|
||||||
Arr ((A , _) , B) ((A' , _) , B') = Σ[ f ∈ (A → A') ] ({x : A} → proj₁ (B x) → proj₁ (B' (f x)))
|
Arr ((A , _) , B) ((A' , _) , B') = Σ[ f ∈ (A → A') ] ({x : A} → fst (B x) → fst (B' (f x)))
|
||||||
𝟙 : {A : Object} → Arr A A
|
identity : {A : Object} → Arr A A
|
||||||
proj₁ 𝟙 = λ x → x
|
fst identity = λ x → x
|
||||||
proj₂ 𝟙 = λ b → b
|
snd identity = λ b → b
|
||||||
_∘_ : {a b c : Object} → Arr b c → Arr a b → Arr a c
|
_<<<_ : {a b c : Object} → Arr b c → Arr a b → Arr a c
|
||||||
(g , g') ∘ (f , f') = g Function.∘ f , g' Function.∘ f'
|
(g , g') <<< (f , f') = g ∘ f , g' ∘ f'
|
||||||
|
|
||||||
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||||
RawFam = record
|
RawFam = record
|
||||||
{ Object = Object
|
{ Object = Object
|
||||||
; Arrow = Arr
|
; Arrow = Arr
|
||||||
; 𝟙 = λ { {A} → 𝟙 {A = A}}
|
; identity = λ { {A} → identity {A = A}}
|
||||||
; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
|
; _<<<_ = λ {a b c} → _<<<_ {a} {b} {c}
|
||||||
}
|
}
|
||||||
|
|
||||||
open RawCategory RawFam hiding (Object ; 𝟙)
|
open RawCategory RawFam hiding (Object ; identity)
|
||||||
|
|
||||||
isAssociative : IsAssociative
|
isAssociative : IsAssociative
|
||||||
isAssociative = Σ≡ refl refl
|
isAssociative = Σ≡ refl refl
|
||||||
|
|
||||||
isIdentity : IsIdentity λ { {A} → 𝟙 {A} }
|
isIdentity : IsIdentity λ { {A} → identity {A} }
|
||||||
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
|
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
|
||||||
|
|
||||||
open import Cubical.NType.Properties
|
isPreCategory : IsPreCategory RawFam
|
||||||
open import Cubical.Sigma
|
IsPreCategory.isAssociative isPreCategory
|
||||||
instance
|
{A} {B} {C} {D} {f} {g} {h} = isAssociative {A} {B} {C} {D} {f} {g} {h}
|
||||||
isCategory : IsCategory RawFam
|
IsPreCategory.isIdentity isPreCategory
|
||||||
isCategory = record
|
{A} {B} {f} = isIdentity {A} {B} {f = f}
|
||||||
{ isAssociative = λ {A} {B} {C} {D} {f} {g} {h} → isAssociative {A} {B} {C} {D} {f} {g} {h}
|
IsPreCategory.arrowsAreSets isPreCategory
|
||||||
; isIdentity = λ {A} {B} {f} → isIdentity {A} {B} {f = f}
|
{(A , hA) , famA} {(B , hB) , famB}
|
||||||
; arrowsAreSets = λ {
|
= setSig
|
||||||
{((A , hA) , famA)}
|
|
||||||
{((B , hB) , famB)}
|
|
||||||
→ setSig
|
|
||||||
{sA = setPi λ _ → hB}
|
{sA = setPi λ _ → hB}
|
||||||
{sB = λ f →
|
{sB = λ f →
|
||||||
let
|
let
|
||||||
helpr : isSet ((a : A) → proj₁ (famA a) → proj₁ (famB (f a)))
|
helpr : isSet ((a : A) → fst (famA a) → fst (famB (f a)))
|
||||||
helpr = setPi λ a → setPi λ _ → proj₂ (famB (f a))
|
helpr = setPi λ a → setPi λ _ → snd (famB (f a))
|
||||||
-- It's almost like above, but where the first argument is
|
-- It's almost like above, but where the first argument is
|
||||||
-- implicit.
|
-- implicit.
|
||||||
res : isSet ({a : A} → proj₁ (famA a) → proj₁ (famB (f a)))
|
res : isSet ({a : A} → fst (famA a) → fst (famB (f a)))
|
||||||
res = {!!}
|
res = {!!}
|
||||||
in res
|
in res
|
||||||
}
|
}
|
||||||
}
|
|
||||||
; univalent = {!!}
|
isCategory : IsCategory RawFam
|
||||||
}
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
|
IsCategory.univalent isCategory = {!!}
|
||||||
|
|
||||||
Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||||
Category.raw Fam = RawFam
|
Category.raw Fam = RawFam
|
||||||
|
Category.isCategory Fam = isCategory
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
||||||
module Cat.Categories.Free where
|
module Cat.Categories.Free where
|
||||||
|
|
||||||
open import Cat.Prelude hiding (Path ; empty)
|
open import Cat.Prelude hiding (Path ; empty)
|
||||||
|
|
@ -29,8 +29,8 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
RawFree : RawCategory ℓa (ℓa ⊔ ℓb)
|
RawFree : RawCategory ℓa (ℓa ⊔ ℓb)
|
||||||
RawCategory.Object RawFree = ℂ.Object
|
RawCategory.Object RawFree = ℂ.Object
|
||||||
RawCategory.Arrow RawFree = Path ℂ.Arrow
|
RawCategory.Arrow RawFree = Path ℂ.Arrow
|
||||||
RawCategory.𝟙 RawFree = empty
|
RawCategory.identity RawFree = empty
|
||||||
RawCategory._∘_ RawFree = concatenate
|
RawCategory._<<<_ RawFree = concatenate
|
||||||
|
|
||||||
open RawCategory RawFree
|
open RawCategory RawFree
|
||||||
|
|
||||||
|
|
@ -52,7 +52,7 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
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
|
||||||
|
|
||||||
isIdentity : IsIdentity 𝟙
|
isIdentity : IsIdentity identity
|
||||||
isIdentity = ident-l , ident-r
|
isIdentity = ident-l , ident-r
|
||||||
|
|
||||||
open Univalence isIdentity
|
open Univalence isIdentity
|
||||||
|
|
@ -61,16 +61,20 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
arrowsAreSets : isSet (Path ℂ.Arrow A B)
|
arrowsAreSets : isSet (Path ℂ.Arrow A B)
|
||||||
arrowsAreSets a b p q = {!!}
|
arrowsAreSets a b p q = {!!}
|
||||||
|
|
||||||
eqv : isEquiv (A ≡ B) (A ≅ B) (Univalence.id-to-iso isIdentity A B)
|
isPreCategory : IsPreCategory RawFree
|
||||||
|
IsPreCategory.isAssociative isPreCategory {f = f} {g} {h} = isAssociative {r = f} {g} {h}
|
||||||
|
IsPreCategory.isIdentity isPreCategory = isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets
|
||||||
|
|
||||||
|
module _ {A B : ℂ.Object} where
|
||||||
|
eqv : isEquiv (A ≡ B) (A ≊ B) (Univalence.idToIso isIdentity A B)
|
||||||
eqv = {!!}
|
eqv = {!!}
|
||||||
|
|
||||||
univalent : Univalent
|
univalent : Univalent
|
||||||
univalent = eqv
|
univalent = eqv
|
||||||
|
|
||||||
isCategory : IsCategory RawFree
|
isCategory : IsCategory RawFree
|
||||||
IsCategory.isAssociative isCategory {f = f} {g} {h} = isAssociative {r = f} {g} {h}
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
IsCategory.isIdentity isCategory = isIdentity
|
|
||||||
IsCategory.arrowsAreSets isCategory = arrowsAreSets
|
|
||||||
IsCategory.univalent isCategory = univalent
|
IsCategory.univalent isCategory = univalent
|
||||||
|
|
||||||
Free : Category _ _
|
Free : Category _ _
|
||||||
|
|
|
||||||
|
|
@ -1,181 +1,218 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --allow-unsolved-metas --cubical --caching #-}
|
||||||
module Cat.Categories.Fun where
|
module Cat.Categories.Fun where
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
|
open import Cat.Equivalence
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor hiding (identity)
|
open import Cat.Category.Functor
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
|
as NaturalTransformation
|
||||||
|
|
||||||
module Fun {ℓc ℓc' ℓd ℓd' : Level} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
module Fun {ℓc ℓc' ℓd ℓd' : Level} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
module NT = NaturalTransformation ℂ 𝔻
|
open NaturalTransformation ℂ 𝔻 public hiding (module Properties)
|
||||||
open NT public
|
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
private
|
|
||||||
module _ {A B C D : Functor ℂ 𝔻} {θ' : NaturalTransformation A B}
|
|
||||||
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
|
|
||||||
θ = proj₁ θ'
|
|
||||||
η = proj₁ η'
|
|
||||||
ζ = proj₁ ζ'
|
|
||||||
θNat = proj₂ θ'
|
|
||||||
ηNat = proj₂ η'
|
|
||||||
ζNat = proj₂ ζ'
|
|
||||||
L : NaturalTransformation A D
|
|
||||||
L = (NT[_∘_] {A} {C} {D} ζ' (NT[_∘_] {A} {B} {C} η' θ'))
|
|
||||||
R : NaturalTransformation A D
|
|
||||||
R = (NT[_∘_] {A} {B} {D} (NT[_∘_] {B} {C} {D} ζ' η') θ')
|
|
||||||
_g⊕f_ = NT[_∘_] {A} {B} {C}
|
|
||||||
_h⊕g_ = NT[_∘_] {B} {C} {D}
|
|
||||||
isAssociative : L ≡ R
|
|
||||||
isAssociative = lemSig (naturalIsProp {F = A} {D})
|
|
||||||
L R (funExt (λ x → 𝔻.isAssociative))
|
|
||||||
|
|
||||||
private
|
module _ where
|
||||||
module _ {A B : Functor ℂ 𝔻} {f : NaturalTransformation A B} where
|
|
||||||
allNatural = naturalIsProp {F = A} {B}
|
|
||||||
f' = proj₁ f
|
|
||||||
eq-r : ∀ C → (𝔻 [ f' C ∘ identityTrans A C ]) ≡ f' C
|
|
||||||
eq-r C = begin
|
|
||||||
𝔻 [ f' C ∘ identityTrans A C ] ≡⟨⟩
|
|
||||||
𝔻 [ f' C ∘ 𝔻.𝟙 ] ≡⟨ 𝔻.rightIdentity ⟩
|
|
||||||
f' C ∎
|
|
||||||
eq-l : ∀ C → (𝔻 [ identityTrans B C ∘ f' C ]) ≡ f' C
|
|
||||||
eq-l C = 𝔻.leftIdentity
|
|
||||||
ident-r : (NT[_∘_] {A} {A} {B} f (NT.identity A)) ≡ f
|
|
||||||
ident-r = lemSig allNatural _ _ (funExt eq-r)
|
|
||||||
ident-l : (NT[_∘_] {A} {B} {B} (NT.identity B) f) ≡ f
|
|
||||||
ident-l = lemSig allNatural _ _ (funExt eq-l)
|
|
||||||
isIdentity
|
|
||||||
: (NT[_∘_] {A} {B} {B} (NT.identity B) f) ≡ f
|
|
||||||
× (NT[_∘_] {A} {A} {B} f (NT.identity A)) ≡ f
|
|
||||||
isIdentity = ident-l , ident-r
|
|
||||||
-- 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} → NT.identity F
|
RawCategory._<<<_ raw {F} {G} {H} = NT[_∘_] {F} {G} {H}
|
||||||
; _∘_ = λ {F G H} → NT[_∘_] {F} {G} {H}
|
|
||||||
}
|
|
||||||
|
|
||||||
open RawCategory RawFun
|
module _ where
|
||||||
open Univalence (λ {A} {B} {f} → isIdentity {A} {B} {f})
|
open RawCategory raw hiding (identity)
|
||||||
|
open NaturalTransformation.Properties ℂ 𝔻
|
||||||
|
|
||||||
|
isPreCategory : IsPreCategory raw
|
||||||
|
IsPreCategory.isAssociative isPreCategory {A} {B} {C} {D} = isAssociative {A} {B} {C} {D}
|
||||||
|
IsPreCategory.isIdentity isPreCategory {A} {B} = isIdentity {A} {B}
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory {F} {G} = naturalTransformationIsSet {F} {G}
|
||||||
|
|
||||||
|
open IsPreCategory isPreCategory hiding (identity)
|
||||||
|
|
||||||
|
module _ {F G : Functor ℂ 𝔻} (p : F ≡ G) where
|
||||||
private
|
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 B : Functor ℂ 𝔻} where
|
||||||
module A = Functor A
|
module A = Functor A
|
||||||
module B = Functor B
|
module B = Functor B
|
||||||
module _ (p : A ≡ B) where
|
module _ (iso : A ≊ B) where
|
||||||
omapP : A.omap ≡ B.omap
|
omapEq : A.omap ≡ B.omap
|
||||||
omapP i = Functor.omap (p i)
|
omapEq = funExt eq
|
||||||
|
|
||||||
coerceAB : ∀ {X} → 𝔻 [ A.omap X , A.omap X ] ≡ 𝔻 [ A.omap X , B.omap X ]
|
|
||||||
coerceAB {X} = cong (λ φ → 𝔻 [ A.omap X , φ X ]) omapP
|
|
||||||
|
|
||||||
-- The transformation will be the identity on 𝔻. Such an arrow has the
|
|
||||||
-- type `A.omap A → A.omap A`. Which we can coerce to have the type
|
|
||||||
-- `A.omap → B.omap` since `A` and `B` are equal.
|
|
||||||
coe𝟙 : Transformation A B
|
|
||||||
coe𝟙 X = coe coerceAB 𝔻.𝟙
|
|
||||||
|
|
||||||
module _ {a b : ℂ.Object} (f : ℂ [ a , b ]) where
|
|
||||||
nat' : 𝔻 [ coe𝟙 b ∘ A.fmap f ] ≡ 𝔻 [ B.fmap f ∘ coe𝟙 a ]
|
|
||||||
nat' = begin
|
|
||||||
(𝔻 [ coe𝟙 b ∘ A.fmap f ]) ≡⟨ {!!} ⟩
|
|
||||||
(𝔻 [ B.fmap f ∘ coe𝟙 a ]) ∎
|
|
||||||
|
|
||||||
transs : (i : I) → Transformation A (p i)
|
|
||||||
transs = {!!}
|
|
||||||
|
|
||||||
natt : (i : I) → Natural A (p i) {!!}
|
|
||||||
natt = {!!}
|
|
||||||
|
|
||||||
t : Natural A B coe𝟙
|
|
||||||
t = coe c (identityNatural A)
|
|
||||||
where
|
where
|
||||||
c : Natural A A (identityTrans A) ≡ Natural A B coe𝟙
|
module _ (C : ℂ.Object) where
|
||||||
c = begin
|
f : 𝔻.Arrow (A.omap C) (B.omap C)
|
||||||
Natural A A (identityTrans A) ≡⟨ (λ x → {!natt ?!}) ⟩
|
f = fst (fst iso) C
|
||||||
Natural A B coe𝟙 ∎
|
g : 𝔻.Arrow (B.omap C) (A.omap C)
|
||||||
-- cong (λ φ → {!Natural A A (identityTrans A)!}) {!!}
|
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
|
||||||
|
|
||||||
k : Natural A A (identityTrans A) → Natural A B coe𝟙
|
|
||||||
k n {a} {b} f = res
|
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
|
where
|
||||||
res : (𝔻 [ coe𝟙 b ∘ A.fmap f ]) ≡ (𝔻 [ B.fmap f ∘ coe𝟙 a ])
|
D : Set _
|
||||||
res = {!!}
|
D = ( fmap : U omap)
|
||||||
|
→ ( let
|
||||||
nat : Natural A B coe𝟙
|
raw-B : RawFunctor ℂ 𝔻
|
||||||
nat = nat'
|
raw-B = record { omap = omap ; fmap = fmap }
|
||||||
|
)
|
||||||
fromEq : NaturalTransformation A B
|
→ (isF-B' : IsFunctor ℂ 𝔻 raw-B)
|
||||||
fromEq = coe𝟙 , nat
|
→ ( let
|
||||||
|
B' : Functor ℂ 𝔻
|
||||||
module _ {A B : Functor ℂ 𝔻} where
|
B' = record { raw = raw-B ; isFunctor = isF-B' }
|
||||||
obverse : A ≡ B → A ≅ B
|
)
|
||||||
obverse p = res
|
→ (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
|
where
|
||||||
ob : Arrow A B
|
module _
|
||||||
ob = fromEq p
|
( fmap : U A.omap )
|
||||||
re : Arrow B A
|
( let
|
||||||
re = fromEq (sym p)
|
raw-B : RawFunctor ℂ 𝔻
|
||||||
vr : _∘_ {A = A} {B} {A} re ob ≡ 𝟙 {A}
|
raw-B = record { omap = A.omap ; fmap = fmap }
|
||||||
vr = {!!}
|
)
|
||||||
rv : _∘_ {A = B} {A} {B} ob re ≡ 𝟙 {B}
|
( isF-B' : IsFunctor ℂ 𝔻 raw-B )
|
||||||
rv = {!!}
|
( let
|
||||||
isInverse : IsInverseOf {A} {B} ob re
|
B' : Functor ℂ 𝔻
|
||||||
isInverse = vr , rv
|
B' = record { raw = raw-B ; isFunctor = isF-B' }
|
||||||
iso : Isomorphism {A} {B} ob
|
)
|
||||||
iso = re , isInverse
|
( iso' : A ≊ B' )
|
||||||
res : A ≅ B
|
where
|
||||||
res = ob , iso
|
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
|
||||||
|
|
||||||
reverse : A ≅ B → A ≡ B
|
fmapEq : PathP (λ i → U (omapEq i)) A.fmap B.fmap
|
||||||
reverse iso = {!!}
|
fmapEq = pathJ D d B.omap omapEq B.fmap B.isFunctor iso
|
||||||
|
|
||||||
ve-re : (y : A ≅ B) → obverse (reverse y) ≡ y
|
rawEq : A.raw ≡ B.raw
|
||||||
ve-re = {!!}
|
rawEq i = record { omap = omapEq i ; fmap = fmapEq i }
|
||||||
|
|
||||||
re-ve : (x : A ≡ B) → reverse (obverse x) ≡ x
|
private
|
||||||
re-ve = {!!}
|
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 → ?!} , {!!}
|
||||||
|
|
||||||
done : isEquiv (A ≡ B) (A ≅ B) (Univalence.id-to-iso (λ { {A} {B} → isIdentity {A} {B}}) A B)
|
iso : (A ≡ B) ≅ (A ≊ B)
|
||||||
done = {!gradLemma obverse reverse ve-re re-ve!}
|
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 : Univalent
|
||||||
univalent = done
|
univalent = univalenceFrom≃ univ
|
||||||
|
|
||||||
instance
|
isCategory : IsCategory raw
|
||||||
isCategory : IsCategory RawFun
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
isCategory = record
|
IsCategory.univalent isCategory = univalent
|
||||||
{ isAssociative = λ {A B C D} → isAssociative {A} {B} {C} {D}
|
|
||||||
; isIdentity = λ {A B} → isIdentity {A} {B}
|
|
||||||
; arrowsAreSets = λ {F} {G} → naturalTransformationIsSet {F} {G}
|
|
||||||
; univalent = univalent
|
|
||||||
}
|
|
||||||
|
|
||||||
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||||
Category.raw Fun = RawFun
|
Category.raw Fun = raw
|
||||||
|
Category.isCategory Fun = isCategory
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
||||||
private
|
private
|
||||||
open import Cat.Categories.Sets
|
open import Cat.Categories.Sets
|
||||||
open NaturalTransformation (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
open NaturalTransformation (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
||||||
|
module K = Fun (opposite ℂ) (𝓢𝓮𝓽 ℓ')
|
||||||
|
module F = Category K.Fun
|
||||||
|
|
||||||
-- Restrict the functors to Presheafs.
|
-- Restrict the functors to Presheafs.
|
||||||
rawPresh : RawCategory (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
raw : RawCategory (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||||
rawPresh = record
|
raw = record
|
||||||
{ Object = Presheaf ℂ
|
{ Object = Presheaf ℂ
|
||||||
; Arrow = NaturalTransformation
|
; Arrow = NaturalTransformation
|
||||||
; 𝟙 = λ {F} → identity F
|
; identity = λ {F} → identity F
|
||||||
; _∘_ = λ {F G H} → NT[_∘_] {F = F} {G = G} {H = H}
|
; _<<<_ = λ {F G H} → NT[_∘_] {F = F} {G = G} {H = H}
|
||||||
}
|
}
|
||||||
instance
|
|
||||||
isCategory : IsCategory rawPresh
|
|
||||||
isCategory = Fun.isCategory _ _
|
|
||||||
|
|
||||||
Presh : Category (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
-- isCategory : IsCategory raw
|
||||||
Category.raw Presh = rawPresh
|
-- isCategory = record
|
||||||
Category.isCategory Presh = isCategory
|
-- { isAssociative =
|
||||||
|
-- λ{ {A} {B} {C} {D} {f} {g} {h}
|
||||||
|
-- → F.isAssociative {A} {B} {C} {D} {f} {g} {h}
|
||||||
|
-- }
|
||||||
|
-- ; isIdentity =
|
||||||
|
-- λ{ {A} {B} {f}
|
||||||
|
-- → F.isIdentity {A} {B} {f}
|
||||||
|
-- }
|
||||||
|
-- ; arrowsAreSets =
|
||||||
|
-- λ{ {A} {B}
|
||||||
|
-- → F.arrowsAreSets {A} {B}
|
||||||
|
-- }
|
||||||
|
-- ; univalent =
|
||||||
|
-- λ{ {A} {B}
|
||||||
|
-- → F.univalent {A} {B}
|
||||||
|
-- }
|
||||||
|
-- }
|
||||||
|
|
||||||
|
-- Presh : Category (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||||
|
-- Category.raw Presh = raw
|
||||||
|
-- Category.isCategory Presh = isCategory
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,7 @@
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
||||||
module Cat.Categories.Rel where
|
module Cat.Categories.Rel where
|
||||||
|
|
||||||
open import Cat.Prelude renaming (proj₁ to fst ; proj₂ to snd)
|
open import Cat.Prelude hiding (Rel)
|
||||||
open import Function
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
|
|
@ -153,14 +152,15 @@ RawRel : RawCategory (lsuc lzero) (lsuc lzero)
|
||||||
RawRel = record
|
RawRel = record
|
||||||
{ Object = Set
|
{ Object = Set
|
||||||
; Arrow = λ S R → Subset (S × R)
|
; Arrow = λ S R → Subset (S × R)
|
||||||
; 𝟙 = λ {S} → Diag S
|
; identity = λ {S} → Diag S
|
||||||
; _∘_ = λ {A B C} S R → λ {( a , c ) → Σ[ b ∈ B ] ( (a , b) ∈ R × (b , c) ∈ S )}
|
; _<<<_ = λ {A B C} S R → λ {( a , c ) → Σ[ b ∈ B ] ( (a , b) ∈ R × (b , c) ∈ S )}
|
||||||
}
|
}
|
||||||
|
|
||||||
RawIsCategoryRel : IsCategory RawRel
|
isPreCategory : IsPreCategory RawRel
|
||||||
RawIsCategoryRel = record
|
|
||||||
{ isAssociative = funExt is-isAssociative
|
IsPreCategory.isAssociative isPreCategory = funExt is-isAssociative
|
||||||
; isIdentity = funExt ident-l , funExt ident-r
|
IsPreCategory.isIdentity isPreCategory = funExt ident-l , funExt ident-r
|
||||||
; arrowsAreSets = {!!}
|
IsPreCategory.arrowsAreSets isPreCategory = {!!}
|
||||||
; univalent = {!!}
|
|
||||||
}
|
Rel : PreCategory RawRel
|
||||||
|
PreCategory.isPreCategory Rel = isPreCategory
|
||||||
|
|
|
||||||
|
|
@ -1,23 +1,13 @@
|
||||||
-- | The category of homotopy sets
|
-- | The category of homotopy sets
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical --caching #-}
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Categories.Sets where
|
module Cat.Categories.Sets where
|
||||||
|
|
||||||
open import Cat.Prelude hiding (_≃_)
|
open import Cat.Prelude as P
|
||||||
import Data.Product
|
|
||||||
|
|
||||||
open import Function using (_∘_ ; _∘′_)
|
|
||||||
|
|
||||||
open import Cubical.Univalence using (univalence ; con ; _≃_ ; idtoeqv ; ua)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
open import Cat.Wishlist
|
open import Cat.Equivalence
|
||||||
open import Cat.Equivalence as Eqv using (AreInverses ; module Equiv≃ ; module NoEta)
|
|
||||||
|
|
||||||
open NoEta
|
|
||||||
|
|
||||||
module Equivalence = Equivalence′
|
|
||||||
|
|
||||||
_⊙_ : {ℓa ℓb ℓc : Level} {A : Set ℓa} {B : Set ℓb} {C : Set ℓc} → (A ≃ B) → (B ≃ C) → A ≃ C
|
_⊙_ : {ℓ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
|
eqA ⊙ eqB = Equivalence.compose eqA eqB
|
||||||
|
|
@ -27,268 +17,46 @@ sym≃ = Equivalence.symmetry
|
||||||
|
|
||||||
infixl 10 _⊙_
|
infixl 10 _⊙_
|
||||||
|
|
||||||
module _ {ℓ : Level} {A : Set ℓ} {a : A} where
|
|
||||||
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 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
|
|
||||||
|
|
||||||
module _ (ℓ : Level) where
|
module _ (ℓ : Level) where
|
||||||
private
|
private
|
||||||
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
||||||
RawCategory.Object SetsRaw = hSet ℓ
|
RawCategory.Object SetsRaw = hSet ℓ
|
||||||
RawCategory.Arrow SetsRaw (T , _) (U , _) = T → U
|
RawCategory.Arrow SetsRaw (T , _) (U , _) = T → U
|
||||||
RawCategory.𝟙 SetsRaw = Function.id
|
RawCategory.identity SetsRaw = idFun _
|
||||||
RawCategory._∘_ SetsRaw = Function._∘′_
|
RawCategory._<<<_ SetsRaw = _∘′_
|
||||||
|
|
||||||
open RawCategory SetsRaw hiding (_∘_)
|
module _ where
|
||||||
|
private
|
||||||
|
open RawCategory SetsRaw hiding (_<<<_)
|
||||||
|
|
||||||
isIdentity : IsIdentity Function.id
|
isIdentity : IsIdentity (idFun _)
|
||||||
proj₁ isIdentity = funExt λ _ → refl
|
fst isIdentity = funExt λ _ → refl
|
||||||
proj₂ isIdentity = funExt λ _ → refl
|
snd isIdentity = funExt λ _ → refl
|
||||||
|
|
||||||
open Univalence (λ {A} {B} {f} → isIdentity {A} {B} {f})
|
|
||||||
|
|
||||||
arrowsAreSets : ArrowsAreSets
|
arrowsAreSets : ArrowsAreSets
|
||||||
arrowsAreSets {B = (_ , s)} = setPi λ _ → s
|
arrowsAreSets {B = (_ , s)} = setPi λ _ → s
|
||||||
|
|
||||||
isIso = Eqv.Isomorphism
|
isPreCat : IsPreCategory SetsRaw
|
||||||
module _ {hA hB : hSet ℓ} where
|
IsPreCategory.isAssociative isPreCat = refl
|
||||||
open Σ hA renaming (proj₁ to A ; proj₂ to sA)
|
IsPreCategory.isIdentity isPreCat {A} {B} = isIdentity {A} {B}
|
||||||
open Σ hB renaming (proj₁ to B ; proj₂ to sB)
|
IsPreCategory.arrowsAreSets isPreCat {A} {B} = arrowsAreSets {A} {B}
|
||||||
lem1 : (f : A → B) → isSet A → isSet B → isProp (isIso f)
|
|
||||||
lem1 f sA sB = res
|
|
||||||
where
|
|
||||||
module _ (x y : isIso f) where
|
|
||||||
module x = Σ x renaming (proj₁ to inverse ; proj₂ to areInverses)
|
|
||||||
module y = Σ y renaming (proj₁ to inverse ; proj₂ to areInverses)
|
|
||||||
module xA = AreInverses x.areInverses
|
|
||||||
module yA = AreInverses 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 = record
|
|
||||||
{ verso-recto = ve-re
|
|
||||||
; recto-verso = re-ve
|
|
||||||
}
|
|
||||||
where
|
|
||||||
module xxA = AreInverses xx
|
|
||||||
module yyA = AreInverses yy
|
|
||||||
ve-re : g ∘ f ≡ Function.id
|
|
||||||
ve-re = arrowsAreSets {A = hA} {B = hA} _ _ xxA.verso-recto yyA.verso-recto i
|
|
||||||
re-ve : f ∘ g ≡ Function.id
|
|
||||||
re-ve = arrowsAreSets {A = hB} {B = hB} _ _ xxA.recto-verso yyA.recto-verso i
|
|
||||||
1eq : x.inverse ≡ y.inverse
|
|
||||||
1eq = begin
|
|
||||||
x.inverse ≡⟨⟩
|
|
||||||
x.inverse ∘ Function.id ≡⟨ cong (λ φ → x.inverse ∘ φ) (sym yA.recto-verso) ⟩
|
|
||||||
x.inverse ∘ (f ∘ y.inverse) ≡⟨⟩
|
|
||||||
(x.inverse ∘ f) ∘ y.inverse ≡⟨ cong (λ φ → φ ∘ y.inverse) xA.verso-recto ⟩
|
|
||||||
Function.id ∘ 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
|
|
||||||
module _ {ℓa ℓb : Level} {A : Set ℓa} {P : A → Set ℓb} where
|
|
||||||
lem2 : ((x : A) → isProp (P x)) → (p q : Σ A P)
|
|
||||||
→ (p ≡ q) ≃ (proj₁ p ≡ proj₁ q)
|
|
||||||
lem2 pA p q = fromIsomorphism iso
|
|
||||||
where
|
|
||||||
f : ∀ {p q} → p ≡ q → proj₁ p ≡ proj₁ q
|
|
||||||
f e i = proj₁ (e i)
|
|
||||||
g : ∀ {p q} → proj₁ p ≡ proj₁ 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 .proj₁ , propSet (pA (p .proj₁)) (p .proj₂) (p .proj₂) (λ i → (g {p} {p} ∘ f) (λ i₁ → p) i .proj₂) (λ i → p .proj₂) i j ) q
|
|
||||||
re-ve : (e : proj₁ p ≡ proj₁ q) → (f {p} {q} ∘ g {p} {q}) e ≡ e
|
|
||||||
re-ve e = refl
|
|
||||||
inv : AreInverses (f {p} {q}) (g {p} {q})
|
|
||||||
inv = record
|
|
||||||
{ verso-recto = funExt ve-re
|
|
||||||
; recto-verso = funExt re-ve
|
|
||||||
}
|
|
||||||
iso : (p ≡ q) Eqv.≅ (proj₁ p ≡ proj₁ q)
|
|
||||||
iso = f , g , inv
|
|
||||||
|
|
||||||
lem3 : ∀ {ℓc} {Q : A → Set (ℓc ⊔ ℓb)}
|
|
||||||
→ ((a : A) → P a ≃ Q a) → Σ A P ≃ Σ A Q
|
|
||||||
lem3 {Q = Q} eA = res
|
|
||||||
where
|
|
||||||
f : Σ A P → Σ A Q
|
|
||||||
f (a , pA) = a , _≃_.eqv (eA a) pA
|
|
||||||
g : Σ A Q → Σ A P
|
|
||||||
g (a , qA) = a , g' qA
|
|
||||||
where
|
|
||||||
k : Eqv.Isomorphism _
|
|
||||||
k = Equiv≃.toIso _ _ (_≃_.isEqv (eA a))
|
|
||||||
open Σ k renaming (proj₁ to g')
|
|
||||||
ve-re : (x : Σ A P) → (g ∘ f) x ≡ x
|
|
||||||
ve-re x i = proj₁ x , eq i
|
|
||||||
where
|
|
||||||
eq : proj₂ ((g ∘ f) x) ≡ proj₂ x
|
|
||||||
eq = begin
|
|
||||||
proj₂ ((g ∘ f) x) ≡⟨⟩
|
|
||||||
proj₂ (g (f (a , pA))) ≡⟨⟩
|
|
||||||
g' (_≃_.eqv (eA a) pA) ≡⟨ lem ⟩
|
|
||||||
pA ∎
|
|
||||||
where
|
|
||||||
open Σ x renaming (proj₁ to a ; proj₂ to pA)
|
|
||||||
k : Eqv.Isomorphism _
|
|
||||||
k = Equiv≃.toIso _ _ (_≃_.isEqv (eA a))
|
|
||||||
open Σ k renaming (proj₁ to g' ; proj₂ to inv)
|
|
||||||
module A = AreInverses inv
|
|
||||||
-- anti-funExt
|
|
||||||
lem : (g' ∘ (_≃_.eqv (eA a))) pA ≡ pA
|
|
||||||
lem i = A.verso-recto i pA
|
|
||||||
re-ve : (x : Σ A Q) → (f ∘ g) x ≡ x
|
|
||||||
re-ve x i = proj₁ x , eq i
|
|
||||||
where
|
|
||||||
open Σ x renaming (proj₁ to a ; proj₂ to qA)
|
|
||||||
eq = begin
|
|
||||||
proj₂ ((f ∘ g) x) ≡⟨⟩
|
|
||||||
_≃_.eqv (eA a) (g' qA) ≡⟨ (λ i → A.recto-verso i qA) ⟩
|
|
||||||
qA ∎
|
|
||||||
where
|
|
||||||
k : Eqv.Isomorphism _
|
|
||||||
k = Equiv≃.toIso _ _ (_≃_.isEqv (eA a))
|
|
||||||
open Σ k renaming (proj₁ to g' ; proj₂ to inv)
|
|
||||||
module A = AreInverses inv
|
|
||||||
inv : AreInverses f g
|
|
||||||
inv = record
|
|
||||||
{ verso-recto = funExt ve-re
|
|
||||||
; recto-verso = funExt re-ve
|
|
||||||
}
|
|
||||||
iso : Σ A P Eqv.≅ Σ 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
|
|
||||||
lem4 : isSet A → isSet B → (f : A → B)
|
|
||||||
→ isEquiv A B f ≃ isIso f
|
|
||||||
lem4 sA sB f =
|
|
||||||
let
|
|
||||||
obv : isEquiv A B f → isIso f
|
|
||||||
obv = Equiv≃.toIso A B
|
|
||||||
inv : isIso f → isEquiv A B f
|
|
||||||
inv = Equiv≃.fromIso A B
|
|
||||||
re-ve : (x : isEquiv A B f) → (inv ∘ obv) x ≡ x
|
|
||||||
re-ve = Equiv≃.inverse-from-to-iso A B
|
|
||||||
ve-re : (x : isIso f) → (obv ∘ inv) x ≡ x
|
|
||||||
ve-re = Equiv≃.inverse-to-from-iso A B sA sB
|
|
||||||
iso : isEquiv A B f Eqv.≅ isIso f
|
|
||||||
iso = obv , inv ,
|
|
||||||
record
|
|
||||||
{ verso-recto = funExt re-ve
|
|
||||||
; recto-verso = funExt ve-re
|
|
||||||
}
|
|
||||||
in fromIsomorphism iso
|
|
||||||
|
|
||||||
|
open IsPreCategory isPreCat
|
||||||
module _ {hA hB : Object} where
|
module _ {hA hB : Object} where
|
||||||
open Σ hA renaming (proj₁ to A ; proj₂ to sA)
|
open Σ hA renaming (fst to A ; snd to sA)
|
||||||
open Σ hB renaming (proj₁ to B ; proj₂ to sB)
|
open Σ hB renaming (fst to B ; snd to sB)
|
||||||
|
|
||||||
-- lem3 and the equivalence from lem4
|
univ≃ : (hA ≡ hB) ≃ (hA ≊ hB)
|
||||||
step0 : Σ (A → B) isIso ≃ Σ (A → B) (isEquiv A B)
|
univ≃
|
||||||
step0 = lem3 {ℓc = lzero} (λ f → sym≃ (lem4 sA sB f))
|
= equivSigProp (λ A → isSetIsProp)
|
||||||
|
⊙ univalence
|
||||||
-- univalence
|
⊙ equivSig {P = isEquiv A B} {Q = TypeIsomorphism} (equiv≃iso sA sB)
|
||||||
step1 : Σ (A → B) (isEquiv A B) ≃ (A ≡ B)
|
|
||||||
step1 = hh ⊙ h
|
|
||||||
where
|
|
||||||
h : (A ≃ B) ≃ (A ≡ B)
|
|
||||||
h = sym≃ (univalence {A = A} {B})
|
|
||||||
obv : Σ (A → B) (isEquiv A B) → A ≃ B
|
|
||||||
obv = Eqv.deEta
|
|
||||||
inv : A ≃ B → Σ (A → B) (isEquiv A B)
|
|
||||||
inv = Eqv.doEta
|
|
||||||
re-ve : (x : _) → (inv ∘ obv) x ≡ x
|
|
||||||
re-ve x = refl
|
|
||||||
-- Because _≃_ does not have eta equality!
|
|
||||||
ve-re : (x : _) → (obv ∘ inv) x ≡ x
|
|
||||||
ve-re (con eqv isEqv) i = con eqv isEqv
|
|
||||||
areInv : AreInverses obv inv
|
|
||||||
areInv = record { verso-recto = funExt re-ve ; recto-verso = funExt ve-re }
|
|
||||||
eqv : Σ (A → B) (isEquiv A B) Eqv.≅ (A ≃ B)
|
|
||||||
eqv = obv , inv , areInv
|
|
||||||
hh : Σ (A → B) (isEquiv A B) ≃ (A ≃ B)
|
|
||||||
hh = fromIsomorphism eqv
|
|
||||||
|
|
||||||
-- lem2 with propIsSet
|
|
||||||
step2 : (A ≡ B) ≃ (hA ≡ hB)
|
|
||||||
step2 = sym≃ (lem2 (λ A → isSetIsProp) hA hB)
|
|
||||||
|
|
||||||
-- Go from an isomorphism on sets to an isomorphism on homotopic sets
|
|
||||||
trivial? : (hA ≅ hB) ≃ (A Eqv.≅ B)
|
|
||||||
trivial? = sym≃ (fromIsomorphism res)
|
|
||||||
where
|
|
||||||
fwd : Σ (A → B) isIso → hA ≅ hB
|
|
||||||
fwd (f , g , inv) = f , g , inv.toPair
|
|
||||||
where
|
|
||||||
module inv = AreInverses inv
|
|
||||||
bwd : hA ≅ hB → Σ (A → B) isIso
|
|
||||||
bwd (f , g , x , y) = f , g , record { verso-recto = x ; recto-verso = y }
|
|
||||||
res : Σ (A → B) isIso Eqv.≅ (hA ≅ hB)
|
|
||||||
res = fwd , bwd , record { verso-recto = refl ; recto-verso = refl }
|
|
||||||
|
|
||||||
conclusion : (hA ≅ hB) ≃ (hA ≡ hB)
|
|
||||||
conclusion = trivial? ⊙ step0 ⊙ step1 ⊙ step2
|
|
||||||
|
|
||||||
univ≃ : (hA ≅ hB) ≃ (hA ≡ hB)
|
|
||||||
univ≃ = trivial? ⊙ step0 ⊙ step1 ⊙ step2
|
|
||||||
|
|
||||||
module _ (hA : Object) where
|
|
||||||
open Σ hA renaming (proj₁ to A)
|
|
||||||
|
|
||||||
eq1 : (Σ[ hB ∈ Object ] hA ≅ hB) ≡ (Σ[ hB ∈ Object ] hA ≡ hB)
|
|
||||||
eq1 = ua (lem3 (\ hB → univ≃))
|
|
||||||
|
|
||||||
univalent[Contr] : isContr (Σ[ hB ∈ Object ] hA ≅ hB)
|
|
||||||
univalent[Contr] = subst {P = isContr} (sym eq1) tres
|
|
||||||
where
|
|
||||||
module _ (y : Σ[ hB ∈ Object ] hA ≡ hB) where
|
|
||||||
open Σ y renaming (proj₁ to hB ; proj₂ to hA≡hB)
|
|
||||||
qres : (hA , refl) ≡ (hB , hA≡hB)
|
|
||||||
qres = contrSingl hA≡hB
|
|
||||||
|
|
||||||
tres : isContr (Σ[ hB ∈ Object ] hA ≡ hB)
|
|
||||||
tres = (hA , refl) , qres
|
|
||||||
|
|
||||||
univalent : Univalent
|
univalent : Univalent
|
||||||
univalent = from[Contr] univalent[Contr]
|
univalent = univalenceFrom≃ univ≃
|
||||||
|
|
||||||
SetsIsCategory : IsCategory SetsRaw
|
SetsIsCategory : IsCategory SetsRaw
|
||||||
IsCategory.isAssociative SetsIsCategory = refl
|
IsCategory.isPreCategory SetsIsCategory = isPreCat
|
||||||
IsCategory.isIdentity SetsIsCategory {A} {B} = isIdentity {A} {B}
|
|
||||||
IsCategory.arrowsAreSets SetsIsCategory {A} {B} = arrowsAreSets {A} {B}
|
|
||||||
IsCategory.univalent SetsIsCategory = univalent
|
IsCategory.univalent SetsIsCategory = univalent
|
||||||
|
|
||||||
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
𝓢𝓮𝓽 Sets : Category (lsuc ℓ) ℓ
|
||||||
|
|
@ -300,11 +68,10 @@ module _ {ℓ : Level} where
|
||||||
private
|
private
|
||||||
𝓢 = 𝓢𝓮𝓽 ℓ
|
𝓢 = 𝓢𝓮𝓽 ℓ
|
||||||
open Category 𝓢
|
open Category 𝓢
|
||||||
open import Cubical.Sigma
|
|
||||||
|
|
||||||
module _ (hA hB : Object) where
|
module _ (hA hB : Object) where
|
||||||
open Σ hA renaming (proj₁ to A ; proj₂ to sA)
|
open Σ hA renaming (fst to A ; snd to sA)
|
||||||
open Σ hB renaming (proj₁ to B ; proj₂ to sB)
|
open Σ hB renaming (fst to B ; snd to sB)
|
||||||
|
|
||||||
private
|
private
|
||||||
productObject : Object
|
productObject : Object
|
||||||
|
|
@ -315,20 +82,32 @@ module _ {ℓ : Level} where
|
||||||
_&&&_ x = f x , g x
|
_&&&_ x = f x , g x
|
||||||
|
|
||||||
module _ (hX : Object) where
|
module _ (hX : Object) where
|
||||||
open Σ hX renaming (proj₁ to X)
|
open Σ hX renaming (fst to X)
|
||||||
module _ (f : X → A ) (g : X → B) where
|
module _ (f : X → A ) (g : X → B) where
|
||||||
ump : proj₁ Function.∘′ (f &&& g) ≡ f × proj₂ Function.∘′ (f &&& g) ≡ g
|
ump : fst ∘′ (f &&& g) ≡ f × snd ∘′ (f &&& g) ≡ g
|
||||||
proj₁ ump = refl
|
fst ump = refl
|
||||||
proj₂ ump = refl
|
snd ump = refl
|
||||||
|
|
||||||
rawProduct : RawProduct 𝓢 hA hB
|
rawProduct : RawProduct 𝓢 hA hB
|
||||||
RawProduct.object rawProduct = productObject
|
RawProduct.object rawProduct = productObject
|
||||||
RawProduct.proj₁ rawProduct = Data.Product.proj₁
|
RawProduct.fst rawProduct = fst
|
||||||
RawProduct.proj₂ rawProduct = Data.Product.proj₂
|
RawProduct.snd rawProduct = snd
|
||||||
|
|
||||||
isProduct : IsProduct 𝓢 _ _ rawProduct
|
isProduct : IsProduct 𝓢 _ _ rawProduct
|
||||||
IsProduct.ump isProduct {X = hX} f g
|
IsProduct.ump isProduct {X = hX} f g
|
||||||
= (f &&& g) , ump 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 : Product 𝓢 hA hB
|
||||||
Product.raw product = rawProduct
|
Product.raw product = rawProduct
|
||||||
|
|
|
||||||
|
|
@ -12,8 +12,8 @@
|
||||||
--
|
--
|
||||||
-- Data
|
-- Data
|
||||||
-- ----
|
-- ----
|
||||||
-- 𝟙; the identity arrow
|
-- identity; the identity arrow
|
||||||
-- _∘_; function composition
|
-- _<<<_; function composition
|
||||||
--
|
--
|
||||||
-- Laws
|
-- Laws
|
||||||
-- ----
|
-- ----
|
||||||
|
|
@ -24,17 +24,15 @@
|
||||||
-- ------
|
-- ------
|
||||||
--
|
--
|
||||||
-- Propositionality for all laws about the category.
|
-- Propositionality for all laws about the category.
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
|
|
||||||
module Cat.Category where
|
module Cat.Category where
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
renaming
|
import Cat.Equivalence
|
||||||
( proj₁ to fst
|
open Cat.Equivalence public using () renaming (Isomorphism to TypeIsomorphism)
|
||||||
; proj₂ to snd
|
open Cat.Equivalence
|
||||||
)
|
hiding (preorder≅ ; Isomorphism)
|
||||||
|
|
||||||
import Function
|
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
-- * Categories --
|
-- * Categories --
|
||||||
|
|
@ -50,21 +48,23 @@ record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
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 _<<<_ _>>>_
|
||||||
|
|
||||||
-- | Operations on data
|
-- | Operations on data
|
||||||
|
|
||||||
domain : {a b : Object} → Arrow a b → Object
|
domain : {a b : Object} → Arrow a b → Object
|
||||||
domain {a = a} _ = a
|
domain {a} _ = a
|
||||||
|
|
||||||
codomain : {a b : Object} → Arrow a b → Object
|
codomain : {a b : Object} → Arrow a b → Object
|
||||||
codomain {b = b} _ = b
|
codomain {b = b} _ = b
|
||||||
|
|
||||||
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
||||||
f >>> g = g ∘ f
|
f >>> g = g <<< f
|
||||||
|
|
||||||
-- | Laws about the data
|
-- | Laws about the data
|
||||||
|
|
||||||
|
|
@ -72,30 +72,30 @@ record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
-- right-hand-side.
|
-- right-hand-side.
|
||||||
IsAssociative : Set (ℓa ⊔ ℓb)
|
IsAssociative : Set (ℓa ⊔ ℓb)
|
||||||
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
||||||
→ h ∘ (g ∘ f) ≡ (h ∘ g) ∘ f
|
→ h <<< (g <<< f) ≡ (h <<< g) <<< f
|
||||||
|
|
||||||
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
||||||
IsIdentity id = {A B : Object} {f : Arrow A B}
|
IsIdentity id = {A B : Object} {f : Arrow A B}
|
||||||
→ id ∘ f ≡ f × f ∘ id ≡ f
|
→ id <<< f ≡ f × f <<< id ≡ f
|
||||||
|
|
||||||
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
||||||
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
||||||
|
|
||||||
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
||||||
IsInverseOf = λ f g → g ∘ f ≡ 𝟙 × f ∘ g ≡ 𝟙
|
IsInverseOf = λ f g → g <<< f ≡ identity × f <<< g ≡ identity
|
||||||
|
|
||||||
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
||||||
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
||||||
|
|
||||||
_≅_ : (A B : Object) → Set ℓb
|
_≊_ : (A B : Object) → Set ℓb
|
||||||
_≅_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
_≊_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
||||||
|
|
||||||
module _ {A B : Object} where
|
module _ {A B : Object} where
|
||||||
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓb
|
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓb
|
||||||
Epimorphism {X} f = ( g₀ g₁ : Arrow B X ) → g₀ ∘ f ≡ g₁ ∘ f → g₀ ≡ g₁
|
Epimorphism {X} f = (g₀ g₁ : Arrow B X) → g₀ <<< f ≡ g₁ <<< f → g₀ ≡ g₁
|
||||||
|
|
||||||
Monomorphism : {X : Object} → (f : Arrow A B) → Set ℓb
|
Monomorphism : {X : Object} → (f : Arrow A B) → Set ℓb
|
||||||
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) → f ∘ g₀ ≡ f ∘ g₁ → g₀ ≡ g₁
|
Monomorphism {X} f = (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)
|
||||||
|
|
@ -110,56 +110,70 @@ record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
Terminal = Σ Object IsTerminal
|
Terminal = Σ Object IsTerminal
|
||||||
|
|
||||||
-- | Univalence is indexed by a raw category as well as an identity proof.
|
-- | Univalence is indexed by a raw category as well as an identity proof.
|
||||||
module Univalence (isIdentity : IsIdentity 𝟙) where
|
module Univalence (isIdentity : IsIdentity identity) where
|
||||||
-- | The identity isomorphism
|
-- | The identity isomorphism
|
||||||
idIso : (A : Object) → A ≅ A
|
idIso : (A : Object) → A ≊ A
|
||||||
idIso A = 𝟙 , (𝟙 , isIdentity)
|
idIso A = identity , identity , isIdentity
|
||||||
|
|
||||||
-- | Extract an isomorphism from an equality
|
-- | Extract an isomorphism from an equality
|
||||||
--
|
--
|
||||||
-- [HoTT §9.1.4]
|
-- [HoTT §9.1.4]
|
||||||
id-to-iso : (A B : Object) → A ≡ B → A ≅ B
|
idToIso : (A B : Object) → A ≡ B → A ≊ B
|
||||||
id-to-iso A B eq = transp (\ i → A ≅ eq i) (idIso A)
|
idToIso A B eq = subst eq (idIso A)
|
||||||
|
|
||||||
Univalent : Set (ℓa ⊔ ℓb)
|
Univalent : Set (ℓa ⊔ ℓb)
|
||||||
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≅ B) (id-to-iso A B)
|
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
|
|
||||||
|
univalenceFromIsomorphism : {A B : Object}
|
||||||
|
→ TypeIsomorphism (idToIso A B) → isEquiv (A ≡ B) (A ≊ B) (idToIso A B)
|
||||||
|
univalenceFromIsomorphism = fromIso _ _
|
||||||
|
|
||||||
-- A perhaps more readable version of univalence:
|
-- A perhaps more readable version of univalence:
|
||||||
Univalent≃ = {A B : Object} → (A ≡ B) ≃ (A ≅ B)
|
Univalent≃ = {A B : Object} → (A ≡ B) ≃ (A ≊ B)
|
||||||
|
Univalent≅ = {A B : Object} → (A ≡ B) ≅ (A ≊ B)
|
||||||
|
|
||||||
|
private
|
||||||
-- | Equivalent formulation of univalence.
|
-- | Equivalent formulation of univalence.
|
||||||
Univalent[Contr] : Set _
|
Univalent[Contr] : Set _
|
||||||
Univalent[Contr] = ∀ A → isContr (Σ[ X ∈ Object ] A ≅ X)
|
Univalent[Contr] = ∀ A → isContr (Σ[ X ∈ Object ] A ≊ X)
|
||||||
|
|
||||||
-- From: Thierry Coquand <Thierry.Coquand@cse.gu.se>
|
from[Contr] : Univalent[Contr] → Univalent
|
||||||
-- Date: Wed, Mar 21, 2018 at 3:12 PM
|
from[Contr] = ContrToUniv.lemma _ _
|
||||||
--
|
where
|
||||||
-- This is not so straight-forward so you can assume it
|
open import Cubical.Fiberwise
|
||||||
postulate from[Contr] : Univalent[Contr] → Univalent
|
|
||||||
|
|
||||||
-- | The mere proposition of being a category.
|
univalenceFrom≃ : Univalent≃ → Univalent
|
||||||
--
|
univalenceFrom≃ = from[Contr] ∘ step
|
||||||
-- Also defines a few lemmas:
|
where
|
||||||
--
|
module _ (f : Univalent≃) (A : Object) where
|
||||||
-- iso-is-epi : Isomorphism f → Epimorphism {X = X} f
|
lem : Σ Object (A ≡_) ≃ Σ Object (A ≊_)
|
||||||
-- iso-is-mono : Isomorphism f → Monomorphism {X = X} f
|
lem = equivSig λ _ → f
|
||||||
--
|
|
||||||
-- Sans `univalent` this would be what is referred to as a pre-category in
|
aux : isContr (Σ Object (A ≡_))
|
||||||
-- [HoTT].
|
aux = (A , refl) , (λ y → contrSingl (snd y))
|
||||||
record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc (ℓa ⊔ ℓb)) where
|
|
||||||
|
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 = propPi (λ iso → propIsContr) a b i
|
||||||
|
|
||||||
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
|
record IsPreCategory : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
open RawCategory ℂ public
|
open RawCategory ℂ public
|
||||||
field
|
field
|
||||||
isAssociative : IsAssociative
|
isAssociative : IsAssociative
|
||||||
isIdentity : IsIdentity 𝟙
|
isIdentity : IsIdentity identity
|
||||||
arrowsAreSets : ArrowsAreSets
|
arrowsAreSets : ArrowsAreSets
|
||||||
open Univalence isIdentity public
|
open Univalence isIdentity public
|
||||||
field
|
|
||||||
univalent : Univalent
|
|
||||||
|
|
||||||
leftIdentity : {A B : Object} {f : Arrow A B} → 𝟙 ∘ f ≡ f
|
leftIdentity : {A B : Object} {f : Arrow A B} → identity <<< f ≡ f
|
||||||
leftIdentity {A} {B} {f} = fst (isIdentity {A = A} {B} {f})
|
leftIdentity {A} {B} {f} = fst (isIdentity {A = A} {B} {f})
|
||||||
|
|
||||||
rightIdentity : {A B : Object} {f : Arrow A B} → f ∘ 𝟙 ≡ f
|
rightIdentity : {A B : Object} {f : Arrow A B} → f <<< identity ≡ f
|
||||||
rightIdentity {A} {B} {f} = snd (isIdentity {A = A} {B} {f})
|
rightIdentity {A} {B} {f} = snd (isIdentity {A = A} {B} {f})
|
||||||
|
|
||||||
------------
|
------------
|
||||||
|
|
@ -171,78 +185,380 @@ record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc
|
||||||
iso→epi : Isomorphism f → Epimorphism {X = X} f
|
iso→epi : Isomorphism f → Epimorphism {X = X} f
|
||||||
iso→epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
iso→epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
||||||
g₀ ≡⟨ sym rightIdentity ⟩
|
g₀ ≡⟨ sym rightIdentity ⟩
|
||||||
g₀ ∘ 𝟙 ≡⟨ cong (_∘_ g₀) (sym right-inv) ⟩
|
g₀ <<< identity ≡⟨ cong (_<<<_ g₀) (sym right-inv) ⟩
|
||||||
g₀ ∘ (f ∘ f-) ≡⟨ isAssociative ⟩
|
g₀ <<< (f <<< f-) ≡⟨ isAssociative ⟩
|
||||||
(g₀ ∘ f) ∘ f- ≡⟨ cong (λ φ → φ ∘ f-) eq ⟩
|
(g₀ <<< f) <<< f- ≡⟨ cong (λ φ → φ <<< f-) eq ⟩
|
||||||
(g₁ ∘ f) ∘ f- ≡⟨ sym isAssociative ⟩
|
(g₁ <<< f) <<< f- ≡⟨ sym isAssociative ⟩
|
||||||
g₁ ∘ (f ∘ f-) ≡⟨ cong (_∘_ g₁) right-inv ⟩
|
g₁ <<< (f <<< f-) ≡⟨ cong (_<<<_ g₁) right-inv ⟩
|
||||||
g₁ ∘ 𝟙 ≡⟨ rightIdentity ⟩
|
g₁ <<< identity ≡⟨ rightIdentity ⟩
|
||||||
g₁ ∎
|
g₁ ∎
|
||||||
|
|
||||||
iso→mono : Isomorphism f → Monomorphism {X = X} f
|
iso→mono : Isomorphism f → Monomorphism {X = X} f
|
||||||
iso→mono (f- , left-inv , right-inv) g₀ g₁ eq =
|
iso→mono (f- , left-inv , right-inv) g₀ g₁ eq =
|
||||||
begin
|
begin
|
||||||
g₀ ≡⟨ sym leftIdentity ⟩
|
g₀ ≡⟨ sym leftIdentity ⟩
|
||||||
𝟙 ∘ g₀ ≡⟨ cong (λ φ → φ ∘ g₀) (sym left-inv) ⟩
|
identity <<< g₀ ≡⟨ cong (λ φ → φ <<< g₀) (sym left-inv) ⟩
|
||||||
(f- ∘ f) ∘ g₀ ≡⟨ sym isAssociative ⟩
|
(f- <<< f) <<< g₀ ≡⟨ sym isAssociative ⟩
|
||||||
f- ∘ (f ∘ g₀) ≡⟨ cong (_∘_ f-) eq ⟩
|
f- <<< (f <<< g₀) ≡⟨ cong (_<<<_ f-) eq ⟩
|
||||||
f- ∘ (f ∘ g₁) ≡⟨ isAssociative ⟩
|
f- <<< (f <<< g₁) ≡⟨ isAssociative ⟩
|
||||||
(f- ∘ f) ∘ g₁ ≡⟨ cong (λ φ → φ ∘ g₁) left-inv ⟩
|
(f- <<< f) <<< g₁ ≡⟨ cong (λ φ → φ <<< g₁) left-inv ⟩
|
||||||
𝟙 ∘ g₁ ≡⟨ leftIdentity ⟩
|
identity <<< g₁ ≡⟨ leftIdentity ⟩
|
||||||
g₁ ∎
|
g₁ ∎
|
||||||
|
|
||||||
iso→epi×mono : Isomorphism f → Epimorphism {X = X} f × Monomorphism {X = X} f
|
iso→epi×mono : Isomorphism f → Epimorphism {X = X} f × Monomorphism {X = X} f
|
||||||
iso→epi×mono iso = iso→epi iso , iso→mono iso
|
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 -
|
-- | The formulation of univalence expressed with _≃_ is trivially admissable -
|
||||||
-- just "forget" the equivalence.
|
-- just "forget" the equivalence.
|
||||||
univalent≃ : Univalent≃
|
univalent≃ : Univalent≃
|
||||||
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.
|
-- | All projections are propositions.
|
||||||
module Propositionality where
|
module Propositionality where
|
||||||
propIsAssociative : isProp IsAssociative
|
-- | Terminal objects are propositional - a.k.a uniqueness of terminal
|
||||||
propIsAssociative x y i = arrowsAreSets _ _ x y i
|
-- | objects.
|
||||||
|
--
|
||||||
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
-- Having two terminal objects induces an isomorphism between them - and
|
||||||
propIsIdentity a b i
|
-- because of univalence this is equivalent to equality.
|
||||||
= arrowsAreSets _ _ (fst a) (fst b) i
|
propTerminal : isProp Terminal
|
||||||
, arrowsAreSets _ _ (snd a) (snd b) i
|
propTerminal Xt Yt = res
|
||||||
|
|
||||||
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 = arrowsAreSets _ _ (fst x) (fst y)
|
|
||||||
hh : snd x ≡ snd y
|
|
||||||
hh = arrowsAreSets _ _ (snd x) (snd y)
|
|
||||||
in h i , hh i
|
|
||||||
|
|
||||||
module _ {A B : Object} {f : Arrow A B} where
|
|
||||||
isoIsProp : isProp (Isomorphism f)
|
|
||||||
isoIsProp a@(g , η , ε) a'@(g' , η' , ε') =
|
|
||||||
lemSig (λ g → propIsInverseOf) a a' geq
|
|
||||||
where
|
where
|
||||||
geq : g ≡ g'
|
open Σ Xt renaming (fst to X ; snd to Xit)
|
||||||
geq = begin
|
open Σ Yt renaming (fst to Y ; snd to Yit)
|
||||||
g ≡⟨ sym rightIdentity ⟩
|
open Σ (Xit {Y}) renaming (fst to Y→X) using ()
|
||||||
g ∘ 𝟙 ≡⟨ cong (λ φ → g ∘ φ) (sym ε') ⟩
|
open Σ (Yit {X}) renaming (fst to X→Y) using ()
|
||||||
g ∘ (f ∘ g') ≡⟨ isAssociative ⟩
|
-- Need to show `left` and `right`, what we know is that the arrows are
|
||||||
(g ∘ f) ∘ g' ≡⟨ cong (λ φ → φ ∘ g') η ⟩
|
-- unique. Well, I know that if I compose these two arrows they must give
|
||||||
𝟙 ∘ g' ≡⟨ leftIdentity ⟩
|
-- the identity, since also the identity is the unique such arrow (by X
|
||||||
g' ∎
|
-- 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
|
||||||
|
|
||||||
propUnivalent : isProp Univalent
|
-- Merely the dual of the above statement.
|
||||||
propUnivalent a b i = propPi (λ iso → propIsContr) a b i
|
|
||||||
|
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
|
||||||
|
|
||||||
-- | Propositionality of being a category
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
open RawCategory ℂ
|
open RawCategory ℂ
|
||||||
open Univalence
|
open Univalence
|
||||||
private
|
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
|
||||||
|
-- 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.
|
||||||
|
-- module Prop = X.Propositionality
|
||||||
|
|
||||||
|
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 y : IsCategory ℂ) where
|
||||||
module X = IsCategory x
|
module X = IsCategory x
|
||||||
module Y = IsCategory y
|
module Y = IsCategory y
|
||||||
|
|
@ -252,37 +568,38 @@ module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
||||||
-- adverse effects this may have.
|
-- adverse effects this may have.
|
||||||
module Prop = X.Propositionality
|
module Prop = X.Propositionality
|
||||||
|
|
||||||
isIdentity : (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ Y.isIdentity ]
|
isIdentity= : (λ _ → IsIdentity identity) [ X.isIdentity ≡ Y.isIdentity ]
|
||||||
isIdentity = Prop.propIsIdentity X.isIdentity Y.isIdentity
|
isIdentity= = X.propIsIdentity X.isIdentity Y.isIdentity
|
||||||
U : ∀ {a : IsIdentity 𝟙}
|
|
||||||
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ a ]
|
isPreCategory= : X.isPreCategory ≡ Y.isPreCategory
|
||||||
→ (b : Univalent a)
|
isPreCategory= = propIsPreCategory X.isPreCategory Y.isPreCategory
|
||||||
→ Set _
|
|
||||||
U eqwal univ =
|
private
|
||||||
(λ i → Univalent (eqwal i))
|
p = cong IsPreCategory.isIdentity isPreCategory=
|
||||||
[ X.univalent ≡ univ ]
|
|
||||||
P : (y : IsIdentity 𝟙)
|
univalent= : (λ i → Univalent (p i))
|
||||||
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ y ] → Set _
|
[ X.univalent ≡ Y.univalent ]
|
||||||
P y eq = ∀ (univ : Univalent y) → U eq univ
|
univalent= = lemPropF
|
||||||
p : ∀ (b' : Univalent X.isIdentity)
|
{A = IsIdentity identity}
|
||||||
→ (λ _ → Univalent X.isIdentity) [ X.univalent ≡ b' ]
|
{B = Univalent}
|
||||||
p univ = Prop.propUnivalent X.univalent univ
|
propUnivalent
|
||||||
helper : P Y.isIdentity isIdentity
|
{a0 = X.isIdentity}
|
||||||
helper = pathJ P p Y.isIdentity isIdentity
|
{a1 = Y.isIdentity}
|
||||||
eqUni : U isIdentity Y.univalent
|
p
|
||||||
eqUni = helper Y.univalent
|
|
||||||
done : x ≡ y
|
done : x ≡ y
|
||||||
IsCategory.isAssociative (done i) = Prop.propIsAssociative X.isAssociative Y.isAssociative i
|
IsCategory.isPreCategory (done i) = isPreCategory= i
|
||||||
IsCategory.isIdentity (done i) = isIdentity i
|
IsCategory.univalent (done i) = univalent= i
|
||||||
IsCategory.arrowsAreSets (done i) = Prop.propArrowIsSet X.arrowsAreSets Y.arrowsAreSets i
|
|
||||||
IsCategory.univalent (done i) = eqUni i
|
|
||||||
|
|
||||||
propIsCategory : isProp (IsCategory ℂ)
|
propIsCategory : isProp (IsCategory ℂ)
|
||||||
propIsCategory = done
|
propIsCategory = done
|
||||||
|
|
||||||
|
|
||||||
-- | Univalent categories
|
-- | Univalent categories
|
||||||
--
|
--
|
||||||
-- Just bundles up the data with witnesses inhabiting the propositions.
|
-- Just bundles up the data with witnesses inhabiting the propositions.
|
||||||
|
|
||||||
|
-- Question: Should I remove the type `Category`?
|
||||||
record Category (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
record Category (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||||
field
|
field
|
||||||
raw : RawCategory ℓa ℓb
|
raw : RawCategory ℓa ℓb
|
||||||
|
|
@ -300,13 +617,11 @@ module _ {ℓa ℓb : Level} {ℂ 𝔻 : Category ℓa ℓb} where
|
||||||
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
||||||
private
|
private
|
||||||
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
||||||
isCategoryEq = lemPropF propIsCategory rawEq
|
isCategoryEq = lemPropF {A = RawCategory _ _} {B = IsCategory} propIsCategory rawEq
|
||||||
|
|
||||||
Category≡ : ℂ ≡ 𝔻
|
Category≡ : ℂ ≡ 𝔻
|
||||||
Category≡ i = record
|
Category.raw (Category≡ i) = rawEq i
|
||||||
{ raw = rawEq i
|
Category.isCategory (Category≡ i) = isCategoryEq i
|
||||||
; isCategory = isCategoryEq i
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Syntax for arrows- and composition in a given category.
|
-- | Syntax for arrows- and composition in a given category.
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
@ -315,7 +630,7 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
_[_,_] = Arrow
|
_[_,_] = Arrow
|
||||||
|
|
||||||
_[_∘_] : {A B C : Object} → (g : Arrow B C) → (f : Arrow A B) → Arrow A C
|
_[_∘_] : {A B C : Object} → (g : Arrow B C) → (f : Arrow A B) → Arrow A C
|
||||||
_[_∘_] = _∘_
|
_[_∘_] = _<<<_
|
||||||
|
|
||||||
-- | The opposite category
|
-- | The opposite category
|
||||||
--
|
--
|
||||||
|
|
@ -324,38 +639,66 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
module Opposite {ℓa ℓb : Level} where
|
module Opposite {ℓa ℓb : Level} where
|
||||||
module _ (ℂ : Category ℓa ℓb) where
|
module _ (ℂ : Category ℓa ℓb) where
|
||||||
private
|
private
|
||||||
|
module _ where
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
opRaw : RawCategory ℓa ℓb
|
opRaw : RawCategory ℓa ℓb
|
||||||
RawCategory.Object opRaw = ℂ.Object
|
RawCategory.Object opRaw = ℂ.Object
|
||||||
RawCategory.Arrow opRaw = Function.flip ℂ.Arrow
|
RawCategory.Arrow opRaw = flip ℂ.Arrow
|
||||||
RawCategory.𝟙 opRaw = ℂ.𝟙
|
RawCategory.identity opRaw = ℂ.identity
|
||||||
RawCategory._∘_ opRaw = Function.flip ℂ._∘_
|
RawCategory._<<<_ opRaw = ℂ._>>>_
|
||||||
|
|
||||||
open RawCategory opRaw
|
open RawCategory opRaw
|
||||||
|
|
||||||
isIdentity : IsIdentity 𝟙
|
isPreCategory : IsPreCategory opRaw
|
||||||
isIdentity = swap ℂ.isIdentity
|
IsPreCategory.isAssociative isPreCategory = sym ℂ.isAssociative
|
||||||
|
IsPreCategory.isIdentity isPreCategory = swap ℂ.isIdentity
|
||||||
|
IsPreCategory.arrowsAreSets isPreCategory = ℂ.arrowsAreSets
|
||||||
|
|
||||||
open Univalence isIdentity
|
open IsPreCategory isPreCategory
|
||||||
|
|
||||||
module _ {A B : ℂ.Object} where
|
module _ {A B : ℂ.Object} where
|
||||||
univalent : isEquiv (A ≡ B) (A ≅ B)
|
open Σ (toIso _ _ (ℂ.univalent {A} {B}))
|
||||||
(Univalence.id-to-iso (swap ℂ.isIdentity) A B)
|
renaming (fst to idToIso* ; snd to inv*)
|
||||||
fst (univalent iso) = flipFiber (fst (ℂ.univalent (flipIso iso)))
|
open AreInverses {f = ℂ.idToIso A B} {idToIso*} inv*
|
||||||
where
|
|
||||||
flipIso : A ≅ B → B ℂ.≅ A
|
shuffle : A ≊ B → A ℂ.≊ B
|
||||||
flipIso (f , f~ , iso) = f , f~ , swap iso
|
shuffle (f , g , inv) = g , f , inv
|
||||||
flipFiber
|
|
||||||
: fiber (ℂ.id-to-iso B A) (flipIso iso)
|
shuffle~ : A ℂ.≊ B → A ≊ B
|
||||||
→ fiber ( id-to-iso A B) iso
|
shuffle~ (f , g , inv) = g , f , inv
|
||||||
flipFiber (eq , eqIso) = sym eq , {!!}
|
|
||||||
snd (univalent iso) = {!!}
|
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 : IsCategory opRaw
|
||||||
IsCategory.isAssociative isCategory = sym ℂ.isAssociative
|
IsCategory.isPreCategory isCategory = isPreCategory
|
||||||
IsCategory.isIdentity isCategory = isIdentity
|
IsCategory.univalent isCategory
|
||||||
IsCategory.arrowsAreSets isCategory = ℂ.arrowsAreSets
|
= univalenceFromIsomorphism (isoToId* , inv)
|
||||||
IsCategory.univalent isCategory = univalent
|
|
||||||
|
|
||||||
opposite : Category ℓa ℓb
|
opposite : Category ℓa ℓb
|
||||||
Category.raw opposite = opRaw
|
Category.raw opposite = opRaw
|
||||||
|
|
@ -373,8 +716,8 @@ module Opposite {ℓa ℓb : Level} where
|
||||||
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
||||||
RawCategory.Object (rawInv _) = Object
|
RawCategory.Object (rawInv _) = Object
|
||||||
RawCategory.Arrow (rawInv _) = Arrow
|
RawCategory.Arrow (rawInv _) = Arrow
|
||||||
RawCategory.𝟙 (rawInv _) = 𝟙
|
RawCategory.identity (rawInv _) = identity
|
||||||
RawCategory._∘_ (rawInv _) = _∘_
|
RawCategory._<<<_ (rawInv _) = _<<<_
|
||||||
|
|
||||||
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
||||||
oppositeIsInvolution = Category≡ rawInv
|
oppositeIsInvolution = Category≡ rawInv
|
||||||
|
|
|
||||||
|
|
@ -16,11 +16,11 @@ module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}}
|
||||||
field
|
field
|
||||||
uniq
|
uniq
|
||||||
: ∀ (A : Object) (f : ℂ [ A × B , C ])
|
: ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.𝟙 ℂ ] ≡ f)
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
IsExponential : (Cᴮ : Object) → ℂ [ Cᴮ × B , C ] → Set (ℓ ⊔ ℓ')
|
IsExponential : (Cᴮ : Object) → ℂ [ Cᴮ × B , C ] → Set (ℓ ⊔ ℓ')
|
||||||
IsExponential Cᴮ eval = ∀ (A : Object) (f : ℂ [ A × B , C ])
|
IsExponential Cᴮ eval = ∀ (A : Object) (f : ℂ [ A × B , C ])
|
||||||
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.𝟙 ℂ ] ≡ f)
|
→ ∃![ f~ ] (ℂ [ eval ∘ f~ |×| Category.identity ℂ ] ≡ f)
|
||||||
|
|
||||||
record Exponential : Set (ℓ ⊔ ℓ') where
|
record Exponential : Set (ℓ ⊔ ℓ') where
|
||||||
field
|
field
|
||||||
|
|
@ -30,7 +30,7 @@ module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}}
|
||||||
{{isExponential}} : IsExponential obj eval
|
{{isExponential}} : IsExponential obj eval
|
||||||
|
|
||||||
transpose : (A : Object) → ℂ [ A × B , C ] → ℂ [ A , obj ]
|
transpose : (A : Object) → ℂ [ A × B , C ] → ℂ [ A , obj ]
|
||||||
transpose A f = proj₁ (isExponential A f)
|
transpose A f = fst (isExponential A f)
|
||||||
|
|
||||||
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
|
|
|
||||||
|
|
@ -1,39 +1,37 @@
|
||||||
{-# OPTIONS --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.Functor where
|
module Cat.Category.Functor where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Cat.Prelude
|
||||||
open import Function
|
|
||||||
|
|
||||||
open import Cubical
|
open import Cubical
|
||||||
open import Cubical.NType.Properties using (lemPropF)
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
open Category hiding (_∘_ ; raw ; IsIdentity)
|
|
||||||
|
|
||||||
module _ {ℓc ℓc' ℓd ℓd'}
|
module _ {ℓc ℓc' ℓd ℓd'}
|
||||||
(ℂ : Category ℓc ℓc')
|
(ℂ : Category ℓc ℓc')
|
||||||
(𝔻 : Category ℓd ℓd')
|
(𝔻 : Category ℓd ℓd')
|
||||||
where
|
where
|
||||||
|
|
||||||
private
|
private
|
||||||
|
module ℂ = Category ℂ
|
||||||
|
module 𝔻 = Category 𝔻
|
||||||
ℓ = ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd'
|
ℓ = ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd'
|
||||||
𝓤 = Set ℓ
|
𝓤 = Set ℓ
|
||||||
|
|
||||||
Omap = Object ℂ → Object 𝔻
|
Omap = ℂ.Object → 𝔻.Object
|
||||||
Fmap : Omap → Set _
|
Fmap : Omap → Set _
|
||||||
Fmap omap = ∀ {A B}
|
Fmap omap = ∀ {A B}
|
||||||
→ ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
→ ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
record RawFunctor : 𝓤 where
|
record RawFunctor : 𝓤 where
|
||||||
field
|
field
|
||||||
omap : Object ℂ → Object 𝔻
|
omap : ℂ.Object → 𝔻.Object
|
||||||
fmap : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → 𝔻 [ omap A , omap B ]
|
||||||
|
|
||||||
IsIdentity : Set _
|
IsIdentity : Set _
|
||||||
IsIdentity = {A : Object ℂ} → fmap (𝟙 ℂ {A}) ≡ 𝟙 𝔻 {omap A}
|
IsIdentity = {A : ℂ.Object} → fmap (ℂ.identity {A}) ≡ 𝔻.identity {omap A}
|
||||||
|
|
||||||
IsDistributive : Set _
|
IsDistributive : Set _
|
||||||
IsDistributive = {A B C : Object ℂ} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
IsDistributive = {A B C : ℂ.Object} {f : ℂ [ A , B ]} {g : ℂ [ B , C ]}
|
||||||
→ fmap (ℂ [ g ∘ f ]) ≡ 𝔻 [ fmap g ∘ fmap f ]
|
→ fmap (ℂ [ g ∘ f ]) ≡ 𝔻 [ fmap g ∘ fmap f ]
|
||||||
|
|
||||||
-- | Equality principle for raw functors
|
-- | Equality principle for raw functors
|
||||||
|
|
@ -120,11 +118,18 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
|
||||||
res : (λ i → IsFunctor ℂ 𝔻 (eq i)) [ isFunctor F ≡ isFunctor G ]
|
res : (λ i → IsFunctor ℂ 𝔻 (eq i)) [ isFunctor F ≡ isFunctor G ]
|
||||||
res = IsFunctorIsProp' (isFunctor F) (isFunctor G)
|
res = IsFunctorIsProp' (isFunctor F) (isFunctor G)
|
||||||
|
|
||||||
module _ {ℓ ℓ' : Level} {A B C : Category ℓ ℓ'} (F : Functor B C) (G : Functor A B) where
|
module _ {ℓ0 ℓ1 ℓ2 ℓ3 ℓ4 ℓ5 : Level}
|
||||||
|
{A : Category ℓ0 ℓ1}
|
||||||
|
{B : Category ℓ2 ℓ3}
|
||||||
|
{C : Category ℓ4 ℓ5}
|
||||||
|
(F : Functor B C) (G : Functor A B) where
|
||||||
private
|
private
|
||||||
|
module A = Category A
|
||||||
|
module B = Category B
|
||||||
|
module C = Category C
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
module G = Functor G
|
module G = Functor G
|
||||||
module _ {a0 a1 a2 : Object A} {α0 : A [ a0 , a1 ]} {α1 : A [ a1 , a2 ]} where
|
module _ {a0 a1 a2 : A.Object} {α0 : A [ a0 , a1 ]} {α1 : A [ a1 , a2 ]} where
|
||||||
dist : (F.fmap ∘ G.fmap) (A [ α1 ∘ α0 ]) ≡ C [ (F.fmap ∘ G.fmap) α1 ∘ (F.fmap ∘ G.fmap) α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.fmap ∘ G.fmap) (A [ α1 ∘ α0 ])
|
(F.fmap ∘ G.fmap) (A [ α1 ∘ α0 ])
|
||||||
|
|
@ -143,10 +148,10 @@ module _ {ℓ ℓ' : Level} {A B C : Category ℓ ℓ'} (F : Functor B C) (G : F
|
||||||
isFunctor : IsFunctor A C raw
|
isFunctor : IsFunctor A C raw
|
||||||
isFunctor = record
|
isFunctor = record
|
||||||
{ isIdentity = begin
|
{ isIdentity = begin
|
||||||
(F.fmap ∘ G.fmap) (𝟙 A) ≡⟨ refl ⟩
|
(F.fmap ∘ G.fmap) A.identity ≡⟨ refl ⟩
|
||||||
F.fmap (G.fmap (𝟙 A)) ≡⟨ cong F.fmap (G.isIdentity)⟩
|
F.fmap (G.fmap A.identity) ≡⟨ cong F.fmap (G.isIdentity)⟩
|
||||||
F.fmap (𝟙 B) ≡⟨ F.isIdentity ⟩
|
F.fmap B.identity ≡⟨ F.isIdentity ⟩
|
||||||
𝟙 C ∎
|
C.identity ∎
|
||||||
; isDistributive = dist
|
; isDistributive = dist
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -154,15 +159,42 @@ module _ {ℓ ℓ' : Level} {A B C : Category ℓ ℓ'} (F : Functor B C) (G : F
|
||||||
Functor.raw F[_∘_] = raw
|
Functor.raw F[_∘_] = raw
|
||||||
Functor.isFunctor F[_∘_] = isFunctor
|
Functor.isFunctor F[_∘_] = isFunctor
|
||||||
|
|
||||||
-- The identity functor
|
-- | The identity functor
|
||||||
identity : ∀ {ℓ ℓ'} → {C : Category ℓ ℓ'} → Functor C C
|
module Functors where
|
||||||
identity = record
|
module _ {ℓc ℓcc : Level} {ℂ : Category ℓc ℓcc} where
|
||||||
{ raw = record
|
private
|
||||||
{ omap = λ x → x
|
raw : RawFunctor ℂ ℂ
|
||||||
; fmap = λ x → x
|
RawFunctor.omap raw = idFun _
|
||||||
}
|
RawFunctor.fmap raw = idFun _
|
||||||
; isFunctor = record
|
|
||||||
{ isIdentity = refl
|
isFunctor : IsFunctor ℂ ℂ raw
|
||||||
; isDistributive = refl
|
IsFunctor.isIdentity isFunctor = refl
|
||||||
}
|
IsFunctor.isDistributive isFunctor = refl
|
||||||
}
|
|
||||||
|
identity : Functor ℂ ℂ
|
||||||
|
Functor.raw identity = raw
|
||||||
|
Functor.isFunctor identity = isFunctor
|
||||||
|
|
||||||
|
module _
|
||||||
|
{ℓa ℓaa ℓb ℓbb ℓc ℓcc ℓd ℓdd : Level}
|
||||||
|
{𝔸 : Category ℓa ℓaa}
|
||||||
|
{𝔹 : Category ℓb ℓbb}
|
||||||
|
{ℂ : Category ℓc ℓcc}
|
||||||
|
{𝔻 : Category ℓd ℓdd}
|
||||||
|
{F : Functor 𝔸 𝔹} {G : Functor 𝔹 ℂ} {H : Functor ℂ 𝔻} where
|
||||||
|
isAssociative : F[ H ∘ F[ G ∘ F ] ] ≡ F[ F[ H ∘ G ] ∘ F ]
|
||||||
|
isAssociative = Functor≡ refl
|
||||||
|
|
||||||
|
module _
|
||||||
|
{ℓc ℓcc ℓd ℓdd : Level}
|
||||||
|
{ℂ : Category ℓc ℓcc}
|
||||||
|
{𝔻 : Category ℓd ℓdd}
|
||||||
|
{F : Functor ℂ 𝔻} where
|
||||||
|
leftIdentity : F[ identity ∘ F ] ≡ F
|
||||||
|
leftIdentity = Functor≡ refl
|
||||||
|
|
||||||
|
rightIdentity : F[ F ∘ identity ] ≡ F
|
||||||
|
rightIdentity = Functor≡ refl
|
||||||
|
|
||||||
|
isIdentity : F[ identity ∘ F ] ≡ F × F[ F ∘ identity ] ≡ F
|
||||||
|
isIdentity = leftIdentity , rightIdentity
|
||||||
|
|
|
||||||
|
|
@ -17,13 +17,13 @@ These two formulations are proven to be equivalent:
|
||||||
The monoidal representation is exposed by default from this module.
|
The monoidal representation is exposed by default from this module.
|
||||||
---}
|
---}
|
||||||
|
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.Monad where
|
module Cat.Category.Monad where
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
import Cat.Category.Monad.Monoidal
|
import Cat.Category.Monad.Monoidal
|
||||||
import Cat.Category.Monad.Kleisli
|
import Cat.Category.Monad.Kleisli
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
@ -33,9 +33,10 @@ module Kleisli = Cat.Category.Monad.Kleisli
|
||||||
|
|
||||||
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ using (NaturalTransformation ; propIsNatural)
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Object ; Arrow ; 𝟙 ; _∘_ ; _>>>_)
|
open ℂ using (Object ; Arrow ; identity ; _<<<_ ; _>>>_)
|
||||||
module M = Monoidal ℂ
|
module M = Monoidal ℂ
|
||||||
module K = Kleisli ℂ
|
module K = Kleisli ℂ
|
||||||
|
|
||||||
|
|
@ -51,7 +52,7 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
private
|
private
|
||||||
module MI = M.IsMonad m
|
module MI = M.IsMonad m
|
||||||
forthIsMonad : K.IsMonad (forthRaw raw)
|
forthIsMonad : K.IsMonad (forthRaw raw)
|
||||||
K.IsMonad.isIdentity forthIsMonad = proj₂ MI.isInverse
|
K.IsMonad.isIdentity forthIsMonad = snd MI.isInverse
|
||||||
K.IsMonad.isNatural forthIsMonad = MI.isNatural
|
K.IsMonad.isNatural forthIsMonad = MI.isNatural
|
||||||
K.IsMonad.isDistributive forthIsMonad = MI.isDistributive
|
K.IsMonad.isDistributive forthIsMonad = MI.isDistributive
|
||||||
|
|
||||||
|
|
@ -68,26 +69,28 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
M.RawMonad.joinNT backRaw = joinNT
|
M.RawMonad.joinNT backRaw = joinNT
|
||||||
|
|
||||||
private
|
private
|
||||||
open M.RawMonad backRaw
|
open M.RawMonad backRaw renaming
|
||||||
|
( join to join*
|
||||||
|
; pure to pure*
|
||||||
|
; bind to bind*
|
||||||
|
; fmap to fmap*
|
||||||
|
)
|
||||||
module R = Functor (M.RawMonad.R backRaw)
|
module R = Functor (M.RawMonad.R backRaw)
|
||||||
|
|
||||||
backIsMonad : M.IsMonad backRaw
|
backIsMonad : M.IsMonad backRaw
|
||||||
M.IsMonad.isAssociative backIsMonad {X} = begin
|
M.IsMonad.isAssociative backIsMonad = begin
|
||||||
joinT X ∘ R.fmap (joinT X) ≡⟨⟩
|
join* <<< R.fmap join* ≡⟨⟩
|
||||||
join ∘ fmap (joinT X) ≡⟨⟩
|
join <<< fmap join ≡⟨ isNaturalForeign ⟩
|
||||||
join ∘ fmap join ≡⟨ isNaturalForeign ⟩
|
join <<< join ∎
|
||||||
join ∘ join ≡⟨⟩
|
|
||||||
joinT X ∘ joinT (R.omap X) ∎
|
|
||||||
M.IsMonad.isInverse backIsMonad {X} = inv-l , inv-r
|
M.IsMonad.isInverse backIsMonad {X} = inv-l , inv-r
|
||||||
where
|
where
|
||||||
inv-l = begin
|
inv-l = begin
|
||||||
joinT X ∘ pureT (R.omap X) ≡⟨⟩
|
join <<< pure ≡⟨ fst isInverse ⟩
|
||||||
join ∘ pure ≡⟨ proj₁ isInverse ⟩
|
identity ∎
|
||||||
𝟙 ∎
|
|
||||||
inv-r = begin
|
inv-r = begin
|
||||||
joinT X ∘ R.fmap (pureT X) ≡⟨⟩
|
joinT X <<< R.fmap (pureT X) ≡⟨⟩
|
||||||
join ∘ fmap pure ≡⟨ proj₂ isInverse ⟩
|
join <<< fmap pure ≡⟨ snd isInverse ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
back : K.Monad → M.Monad
|
back : K.Monad → M.Monad
|
||||||
Monoidal.Monad.raw (back m) = backRaw m
|
Monoidal.Monad.raw (back m) = backRaw m
|
||||||
|
|
@ -101,22 +104,22 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
≡ K.RawMonad.bind (K.Monad.raw m)
|
≡ K.RawMonad.bind (K.Monad.raw m)
|
||||||
bindEq {X} {Y} = begin
|
bindEq {X} {Y} = begin
|
||||||
K.RawMonad.bind (forthRaw (backRaw m)) ≡⟨⟩
|
K.RawMonad.bind (forthRaw (backRaw m)) ≡⟨⟩
|
||||||
(λ f → join ∘ fmap f) ≡⟨⟩
|
(λ f → join <<< fmap f) ≡⟨⟩
|
||||||
(λ f → bind (f >>> pure) >>> bind 𝟙) ≡⟨ funExt lem ⟩
|
(λ f → bind (f >>> pure) >>> bind identity) ≡⟨ funExt lem ⟩
|
||||||
(λ f → bind f) ≡⟨⟩
|
(λ f → bind f) ≡⟨⟩
|
||||||
bind ∎
|
bind ∎
|
||||||
where
|
where
|
||||||
lem : (f : Arrow X (omap Y))
|
lem : (f : Arrow X (omap Y))
|
||||||
→ bind (f >>> pure) >>> bind 𝟙
|
→ bind (f >>> pure) >>> bind identity
|
||||||
≡ bind f
|
≡ bind f
|
||||||
lem f = begin
|
lem f = begin
|
||||||
bind (f >>> pure) >>> bind 𝟙
|
bind (f >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((f >>> pure) >>> bind 𝟙)
|
bind ((f >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (pure >>> bind 𝟙))
|
bind (f >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
||||||
bind (f >>> 𝟙)
|
bind (f >>> identity)
|
||||||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
|
|
@ -139,29 +142,29 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → KM.bind f ≡ bind f
|
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → KM.bind f ≡ bind f
|
||||||
bindEq {X} {Y} {f} = begin
|
bindEq {X} {Y} {f} = begin
|
||||||
KM.bind f ≡⟨⟩
|
KM.bind f ≡⟨⟩
|
||||||
joinT Y ∘ Rfmap f ≡⟨⟩
|
joinT Y <<< fmap f ≡⟨⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
joinEq : ∀ {X} → KM.join ≡ joinT X
|
joinEq : ∀ {X} → KM.join ≡ joinT X
|
||||||
joinEq {X} = begin
|
joinEq {X} = begin
|
||||||
KM.join ≡⟨⟩
|
KM.join ≡⟨⟩
|
||||||
KM.bind 𝟙 ≡⟨⟩
|
KM.bind identity ≡⟨⟩
|
||||||
bind 𝟙 ≡⟨⟩
|
bind identity ≡⟨⟩
|
||||||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → _ ∘ φ) R.isIdentity ⟩
|
joinT X <<< fmap identity ≡⟨ cong (λ φ → _ <<< φ) R.isIdentity ⟩
|
||||||
joinT X ∘ 𝟙 ≡⟨ ℂ.rightIdentity ⟩
|
joinT X <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎
|
joinT X ∎
|
||||||
|
|
||||||
fmapEq : ∀ {A B} → KM.fmap {A} {B} ≡ Rfmap
|
fmapEq : ∀ {A B} → KM.fmap {A} {B} ≡ fmap
|
||||||
fmapEq {A} {B} = funExt (λ f → begin
|
fmapEq {A} {B} = funExt (λ f → begin
|
||||||
KM.fmap f ≡⟨⟩
|
KM.fmap f ≡⟨⟩
|
||||||
KM.bind (f >>> KM.pure) ≡⟨⟩
|
KM.bind (f >>> KM.pure) ≡⟨⟩
|
||||||
bind (f >>> pureT _) ≡⟨⟩
|
bind (f >>> pureT _) ≡⟨⟩
|
||||||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨⟩
|
fmap (f >>> pureT B) >>> joinT B ≡⟨⟩
|
||||||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
fmap (f >>> pureT B) >>> joinT B ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
||||||
Rfmap f >>> Rfmap (pureT B) >>> joinT B ≡⟨ ℂ.isAssociative ⟩
|
fmap f >>> fmap (pureT B) >>> joinT B ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT B ∘ Rfmap (pureT B) ∘ Rfmap f ≡⟨ cong (λ φ → φ ∘ Rfmap f) (proj₂ isInverse) ⟩
|
joinT B <<< fmap (pureT B) <<< fmap f ≡⟨ cong (λ φ → φ <<< fmap f) (snd isInverse) ⟩
|
||||||
𝟙 ∘ Rfmap f ≡⟨ ℂ.leftIdentity ⟩
|
identity <<< fmap f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
Rfmap f ∎
|
fmap f ∎
|
||||||
)
|
)
|
||||||
|
|
||||||
rawEq : Functor.raw KM.R ≡ Functor.raw R
|
rawEq : Functor.raw KM.R ≡ Functor.raw R
|
||||||
|
|
@ -171,21 +174,19 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
Req : M.RawMonad.R (backRaw (forth m)) ≡ R
|
Req : M.RawMonad.R (backRaw (forth m)) ≡ R
|
||||||
Req = Functor≡ rawEq
|
Req = Functor≡ rawEq
|
||||||
|
|
||||||
open NaturalTransformation ℂ ℂ
|
|
||||||
|
|
||||||
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
||||||
pureTEq = funExt (λ X → refl)
|
pureTEq = funExt (λ X → refl)
|
||||||
|
|
||||||
pureNTEq : (λ i → NaturalTransformation F.identity (Req i))
|
pureNTEq : (λ i → NaturalTransformation Functors.identity (Req i))
|
||||||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
||||||
pureNTEq = lemSigP (λ i → propIsNatural F.identity (Req i)) _ _ pureTEq
|
pureNTEq = lemSigP (λ i → propIsNatural Functors.identity (Req i)) _ _ pureTEq
|
||||||
|
|
||||||
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
||||||
joinTEq = funExt (λ X → begin
|
joinTEq = funExt (λ X → begin
|
||||||
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
||||||
KM.join ≡⟨⟩
|
KM.join ≡⟨⟩
|
||||||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → joinT X ∘ φ) R.isIdentity ⟩
|
joinT X <<< fmap identity ≡⟨ cong (λ φ → joinT X <<< φ) R.isIdentity ⟩
|
||||||
joinT X ∘ 𝟙 ≡⟨ ℂ.rightIdentity ⟩
|
joinT X <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎)
|
joinT X ∎)
|
||||||
|
|
||||||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||||
|
|
@ -205,8 +206,8 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
open import Cat.Equivalence
|
open import Cat.Equivalence
|
||||||
|
|
||||||
Monoidal≅Kleisli : M.Monad ≅ K.Monad
|
Monoidal≊Kleisli : M.Monad ≅ K.Monad
|
||||||
Monoidal≅Kleisli = forth , (back , (record { verso-recto = funExt backeq ; recto-verso = funExt fortheq }))
|
Monoidal≊Kleisli = forth , back , funExt backeq , funExt fortheq
|
||||||
|
|
||||||
Monoidal≃Kleisli : M.Monad ≃ K.Monad
|
Monoidal≡Kleisli : M.Monad ≡ K.Monad
|
||||||
Monoidal≃Kleisli = forth , eqv
|
Monoidal≡Kleisli = isoToPath Monoidal≊Kleisli
|
||||||
|
|
|
||||||
|
|
@ -1,22 +1,24 @@
|
||||||
{---
|
{---
|
||||||
The Kleisli formulation of monads
|
The Kleisli formulation of monads
|
||||||
---}
|
---}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
-- "A monad in the Kleisli form" [voe]
|
-- "A monad in the Kleisli form" [voe]
|
||||||
module Cat.Category.Monad.Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module Cat.Category.Monad.Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural)
|
||||||
|
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Arrow ; 𝟙 ; Object ; _∘_ ; _>>>_)
|
open ℂ using (Arrow ; identity ; Object ; _<<<_ ; _>>>_)
|
||||||
|
|
||||||
-- | Data for a monad.
|
-- | Data for a monad.
|
||||||
--
|
--
|
||||||
|
|
@ -32,7 +34,7 @@ record RawMonad : Set ℓ where
|
||||||
--
|
--
|
||||||
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
||||||
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
||||||
fmap f = bind (pure ∘ f)
|
fmap f = bind (pure <<< f)
|
||||||
|
|
||||||
-- | Composition of monads aka. the kleisli-arrow.
|
-- | Composition of monads aka. the kleisli-arrow.
|
||||||
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
||||||
|
|
@ -40,7 +42,7 @@ record RawMonad : Set ℓ where
|
||||||
|
|
||||||
-- | Flattening nested monads.
|
-- | Flattening nested monads.
|
||||||
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
join = bind 𝟙
|
join = bind identity
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
-- * Monad laws --
|
-- * Monad laws --
|
||||||
|
|
@ -48,26 +50,33 @@ record RawMonad : Set ℓ where
|
||||||
|
|
||||||
-- There may be better names than what I've chosen here.
|
-- There may be better names than what I've chosen here.
|
||||||
|
|
||||||
|
-- `pure` is the neutral element for `bind`
|
||||||
IsIdentity = {X : Object}
|
IsIdentity = {X : Object}
|
||||||
→ bind pure ≡ 𝟙 {omap X}
|
→ bind pure ≡ identity {omap X}
|
||||||
|
-- pure is the left-identity for the kleisli arrow.
|
||||||
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
||||||
→ pure >>> (bind f) ≡ f
|
→ pure >=> f ≡ f
|
||||||
IsDistributive = {X Y Z : Object} (g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
-- Composition interacts with bind in the following way.
|
||||||
|
IsDistributive = {X Y Z : Object}
|
||||||
|
(g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
||||||
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
||||||
|
|
||||||
|
RightIdentity = {A B : Object} {m : ℂ [ A , omap B ]}
|
||||||
|
→ m >=> pure ≡ m
|
||||||
|
|
||||||
-- | Functor map fusion.
|
-- | Functor map fusion.
|
||||||
--
|
--
|
||||||
-- This is really a functor law. Should we have a kleisli-representation of
|
-- This is really a functor law. Should we have a kleisli-representation of
|
||||||
-- functors as well and make them a super-class?
|
-- functors as well and make them a super-class?
|
||||||
Fusion = {X Y Z : Object} {g : ℂ [ Y , Z ]} {f : ℂ [ X , Y ]}
|
Fusion = {X Y Z : Object} {g : ℂ [ Y , Z ]} {f : ℂ [ X , Y ]}
|
||||||
→ fmap (g ∘ f) ≡ fmap g ∘ fmap f
|
→ fmap (g <<< f) ≡ fmap g <<< fmap f
|
||||||
|
|
||||||
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
|
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
|
||||||
IsNaturalForeign : Set _
|
IsNaturalForeign : Set _
|
||||||
IsNaturalForeign = {X : Object} → join {X} ∘ fmap join ≡ join ∘ join
|
IsNaturalForeign = {X : Object} → join {X} <<< fmap join ≡ join <<< join
|
||||||
|
|
||||||
IsInverse : Set _
|
IsInverse : Set _
|
||||||
IsInverse = {X : Object} → join {X} ∘ pure ≡ 𝟙 × join {X} ∘ fmap pure ≡ 𝟙
|
IsInverse = {X : Object} → join {X} <<< pure ≡ identity × join {X} <<< fmap pure ≡ identity
|
||||||
|
|
||||||
record IsMonad (raw : RawMonad) : Set ℓ where
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
open RawMonad raw public
|
open RawMonad raw public
|
||||||
|
|
@ -79,18 +88,21 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
-- | Map fusion is admissable.
|
-- | Map fusion is admissable.
|
||||||
fusion : Fusion
|
fusion : Fusion
|
||||||
fusion {g = g} {f} = begin
|
fusion {g = g} {f} = begin
|
||||||
fmap (g ∘ f) ≡⟨⟩
|
fmap (g <<< f) ≡⟨⟩
|
||||||
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (g >>> pure)) ≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
bind (f >>> (g >>> pure))
|
||||||
bind (f >>> (pure >>> (bind (g >>> pure)))) ≡⟨⟩
|
≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
||||||
|
bind (f >>> (pure >>> (bind (g >>> pure))))
|
||||||
|
≡⟨⟩
|
||||||
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
||||||
bind ((fmap g ∘ pure) ∘ f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
bind ((fmap g <<< pure) <<< f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
||||||
bind (fmap g ∘ (pure ∘ f)) ≡⟨ sym distrib ⟩
|
bind (fmap g <<< (pure <<< f)) ≡⟨ sym distrib ⟩
|
||||||
bind (pure ∘ g) ∘ bind (pure ∘ f) ≡⟨⟩
|
bind (pure <<< g) <<< bind (pure <<< f)
|
||||||
fmap g ∘ fmap f ∎
|
≡⟨⟩
|
||||||
|
fmap g <<< fmap f ∎
|
||||||
where
|
where
|
||||||
distrib : fmap g ∘ fmap f ≡ bind (fmap g ∘ (pure ∘ f))
|
distrib : fmap g <<< fmap f ≡ bind (fmap g <<< (pure <<< f))
|
||||||
distrib = isDistributive (pure ∘ g) (pure ∘ f)
|
distrib = isDistributive (pure <<< g) (pure <<< f)
|
||||||
|
|
||||||
-- | This formulation gives rise to the following endo-functor.
|
-- | This formulation gives rise to the following endo-functor.
|
||||||
private
|
private
|
||||||
|
|
@ -100,15 +112,15 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
|
||||||
isFunctorR : IsFunctor ℂ ℂ rawR
|
isFunctorR : IsFunctor ℂ ℂ rawR
|
||||||
IsFunctor.isIdentity isFunctorR = begin
|
IsFunctor.isIdentity isFunctorR = begin
|
||||||
bind (pure ∘ 𝟙) ≡⟨ cong bind (ℂ.rightIdentity) ⟩
|
bind (pure <<< identity) ≡⟨ cong bind (ℂ.rightIdentity) ⟩
|
||||||
bind pure ≡⟨ isIdentity ⟩
|
bind pure ≡⟨ isIdentity ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
IsFunctor.isDistributive isFunctorR {f = f} {g} = begin
|
IsFunctor.isDistributive isFunctorR {f = f} {g} = begin
|
||||||
bind (pure ∘ (g ∘ f)) ≡⟨⟩
|
bind (pure <<< (g <<< f)) ≡⟨⟩
|
||||||
fmap (g ∘ f) ≡⟨ fusion ⟩
|
fmap (g <<< f) ≡⟨ fusion ⟩
|
||||||
fmap g ∘ fmap f ≡⟨⟩
|
fmap g <<< fmap f ≡⟨⟩
|
||||||
bind (pure ∘ g) ∘ bind (pure ∘ f) ∎
|
bind (pure <<< g) <<< bind (pure <<< f) ∎
|
||||||
|
|
||||||
-- FIXME Naming!
|
-- FIXME Naming!
|
||||||
R : EndoFunctor ℂ
|
R : EndoFunctor ℂ
|
||||||
|
|
@ -116,10 +128,8 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
Functor.isFunctor R = isFunctorR
|
Functor.isFunctor R = isFunctorR
|
||||||
|
|
||||||
private
|
private
|
||||||
open NaturalTransformation ℂ ℂ
|
|
||||||
|
|
||||||
R⁰ : EndoFunctor ℂ
|
R⁰ : EndoFunctor ℂ
|
||||||
R⁰ = F.identity
|
R⁰ = Functors.identity
|
||||||
R² : EndoFunctor ℂ
|
R² : EndoFunctor ℂ
|
||||||
R² = F[ R ∘ R ]
|
R² = F[ R ∘ R ]
|
||||||
module R = Functor R
|
module R = Functor R
|
||||||
|
|
@ -129,66 +139,66 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
pureT A = pure
|
pureT A = pure
|
||||||
pureN : Natural R⁰ R pureT
|
pureN : Natural R⁰ R pureT
|
||||||
pureN {A} {B} f = begin
|
pureN {A} {B} f = begin
|
||||||
pureT B ∘ R⁰.fmap f ≡⟨⟩
|
pureT B <<< R⁰.fmap f ≡⟨⟩
|
||||||
pure ∘ f ≡⟨ sym (isNatural _) ⟩
|
pure <<< f ≡⟨ sym (isNatural _) ⟩
|
||||||
bind (pure ∘ f) ∘ pure ≡⟨⟩
|
bind (pure <<< f) <<< pure ≡⟨⟩
|
||||||
fmap f ∘ pure ≡⟨⟩
|
fmap f <<< pure ≡⟨⟩
|
||||||
R.fmap f ∘ pureT A ∎
|
R.fmap f <<< pureT A ∎
|
||||||
joinT : Transformation R² R
|
joinT : Transformation R² R
|
||||||
joinT C = join
|
joinT C = join
|
||||||
joinN : Natural R² R joinT
|
joinN : Natural R² R joinT
|
||||||
joinN f = begin
|
joinN f = begin
|
||||||
join ∘ R².fmap f ≡⟨⟩
|
join <<< R².fmap f ≡⟨⟩
|
||||||
bind 𝟙 ∘ R².fmap f ≡⟨⟩
|
bind identity <<< R².fmap f ≡⟨⟩
|
||||||
R².fmap f >>> bind 𝟙 ≡⟨⟩
|
R².fmap f >>> bind identity ≡⟨⟩
|
||||||
fmap (fmap f) >>> bind 𝟙 ≡⟨⟩
|
fmap (fmap f) >>> bind identity ≡⟨⟩
|
||||||
fmap (bind (f >>> pure)) >>> bind 𝟙 ≡⟨⟩
|
fmap (bind (f >>> pure)) >>> bind identity ≡⟨⟩
|
||||||
bind (bind (f >>> pure) >>> pure) >>> bind 𝟙
|
bind (bind (f >>> pure) >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((bind (f >>> pure) >>> pure) >=> 𝟙)
|
bind ((bind (f >>> pure) >>> pure) >=> identity)
|
||||||
≡⟨⟩
|
≡⟨⟩
|
||||||
bind ((bind (f >>> pure) >>> pure) >>> bind 𝟙)
|
bind ((bind (f >>> pure) >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (bind (f >>> pure) >>> (pure >>> bind 𝟙))
|
bind (bind (f >>> pure) >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (bind (f >>> pure) >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (bind (f >>> pure) >>> φ)) (isNatural _) ⟩
|
||||||
bind (bind (f >>> pure) >>> 𝟙)
|
bind (bind (f >>> pure) >>> identity)
|
||||||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind (bind (f >>> pure))
|
bind (bind (f >>> pure))
|
||||||
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
bind (𝟙 >>> bind (f >>> pure)) ≡⟨⟩
|
bind (identity >>> bind (f >>> pure)) ≡⟨⟩
|
||||||
bind (𝟙 >=> (f >>> pure))
|
bind (identity >=> (f >>> pure))
|
||||||
≡⟨ sym (isDistributive _ _) ⟩
|
≡⟨ sym (isDistributive _ _) ⟩
|
||||||
bind 𝟙 >>> bind (f >>> pure) ≡⟨⟩
|
bind identity >>> bind (f >>> pure) ≡⟨⟩
|
||||||
bind 𝟙 >>> fmap f ≡⟨⟩
|
bind identity >>> fmap f ≡⟨⟩
|
||||||
bind 𝟙 >>> R.fmap f ≡⟨⟩
|
bind identity >>> R.fmap f ≡⟨⟩
|
||||||
R.fmap f ∘ bind 𝟙 ≡⟨⟩
|
R.fmap f <<< bind identity ≡⟨⟩
|
||||||
R.fmap f ∘ join ∎
|
R.fmap f <<< join ∎
|
||||||
|
|
||||||
pureNT : NaturalTransformation R⁰ R
|
pureNT : NaturalTransformation R⁰ R
|
||||||
proj₁ pureNT = pureT
|
fst pureNT = pureT
|
||||||
proj₂ pureNT = pureN
|
snd pureNT = pureN
|
||||||
|
|
||||||
joinNT : NaturalTransformation R² R
|
joinNT : NaturalTransformation R² R
|
||||||
proj₁ joinNT = joinT
|
fst joinNT = joinT
|
||||||
proj₂ joinNT = joinN
|
snd joinNT = joinN
|
||||||
|
|
||||||
isNaturalForeign : IsNaturalForeign
|
isNaturalForeign : IsNaturalForeign
|
||||||
isNaturalForeign = begin
|
isNaturalForeign = begin
|
||||||
fmap join >>> join ≡⟨⟩
|
fmap join >>> join ≡⟨⟩
|
||||||
bind (join >>> pure) >>> bind 𝟙
|
bind (join >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((join >>> pure) >>> bind 𝟙)
|
bind ((join >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (join >>> (pure >>> bind 𝟙))
|
bind (join >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (join >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (join >>> φ)) (isNatural _) ⟩
|
||||||
bind (join >>> 𝟙)
|
bind (join >>> identity)
|
||||||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind join ≡⟨⟩
|
bind join ≡⟨⟩
|
||||||
bind (bind 𝟙)
|
bind (bind identity)
|
||||||
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
≡⟨ cong bind (sym ℂ.rightIdentity) ⟩
|
||||||
bind (𝟙 >>> bind 𝟙) ≡⟨⟩
|
bind (identity >>> bind identity) ≡⟨⟩
|
||||||
bind (𝟙 >=> 𝟙) ≡⟨ sym (isDistributive _ _) ⟩
|
bind (identity >=> identity) ≡⟨ sym (isDistributive _ _) ⟩
|
||||||
bind 𝟙 >>> bind 𝟙 ≡⟨⟩
|
bind identity >>> bind identity ≡⟨⟩
|
||||||
join >>> join ∎
|
join >>> join ∎
|
||||||
|
|
||||||
isInverse : IsInverse
|
isInverse : IsInverse
|
||||||
|
|
@ -196,21 +206,28 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
where
|
where
|
||||||
inv-l = begin
|
inv-l = begin
|
||||||
pure >>> join ≡⟨⟩
|
pure >>> join ≡⟨⟩
|
||||||
pure >>> bind 𝟙 ≡⟨ isNatural _ ⟩
|
pure >>> bind identity ≡⟨ isNatural _ ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
inv-r = begin
|
inv-r = begin
|
||||||
fmap pure >>> join ≡⟨⟩
|
fmap pure >>> join ≡⟨⟩
|
||||||
bind (pure >>> pure) >>> bind 𝟙
|
bind (pure >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
bind ((pure >>> pure) >=> 𝟙) ≡⟨⟩
|
bind ((pure >>> pure) >=> identity) ≡⟨⟩
|
||||||
bind ((pure >>> pure) >>> bind 𝟙)
|
bind ((pure >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (pure >>> (pure >>> bind 𝟙))
|
bind (pure >>> (pure >>> bind identity))
|
||||||
≡⟨ cong (λ φ → bind (pure >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (pure >>> φ)) (isNatural _) ⟩
|
||||||
bind (pure >>> 𝟙)
|
bind (pure >>> identity)
|
||||||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind pure ≡⟨ isIdentity ⟩
|
bind pure ≡⟨ isIdentity ⟩
|
||||||
𝟙 ∎
|
identity ∎
|
||||||
|
|
||||||
|
rightIdentity : RightIdentity
|
||||||
|
rightIdentity {m = m} = begin
|
||||||
|
m >=> pure ≡⟨⟩
|
||||||
|
m >>> bind pure ≡⟨ cong (m >>>_) isIdentity ⟩
|
||||||
|
m >>> identity ≡⟨ ℂ.leftIdentity ⟩
|
||||||
|
m ∎
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
field
|
field
|
||||||
|
|
|
||||||
|
|
@ -1,14 +1,13 @@
|
||||||
{---
|
{---
|
||||||
Monoidal formulation of monads
|
Monoidal formulation of monads
|
||||||
---}
|
---}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical #-}
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
|
|
||||||
module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
@ -17,43 +16,55 @@ module Cat.Category.Monad.Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
open Category ℂ using (Object ; Arrow ; 𝟙 ; _∘_)
|
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
||||||
open NaturalTransformation ℂ ℂ
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
|
using (NaturalTransformation ; Transformation ; Natural)
|
||||||
|
|
||||||
record RawMonad : Set ℓ where
|
record RawMonad : Set ℓ where
|
||||||
field
|
field
|
||||||
R : EndoFunctor ℂ
|
R : EndoFunctor ℂ
|
||||||
pureNT : NaturalTransformation F.identity R
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
joinNT : NaturalTransformation F[ R ∘ R ] R
|
joinNT : NaturalTransformation F[ R ∘ R ] R
|
||||||
|
|
||||||
|
Romap = Functor.omap R
|
||||||
|
fmap = Functor.fmap R
|
||||||
|
|
||||||
-- Note that `pureT` and `joinT` differs from their definition in the
|
-- Note that `pureT` and `joinT` differs from their definition in the
|
||||||
-- kleisli formulation only by having an explicit parameter.
|
-- kleisli formulation only by having an explicit parameter.
|
||||||
pureT : Transformation F.identity R
|
pureT : Transformation Functors.identity R
|
||||||
pureT = proj₁ pureNT
|
pureT = fst pureNT
|
||||||
pureN : Natural F.identity R pureT
|
|
||||||
pureN = proj₂ pureNT
|
pure : {X : Object} → ℂ [ X , Romap X ]
|
||||||
|
pure = pureT _
|
||||||
|
|
||||||
|
pureN : Natural Functors.identity R pureT
|
||||||
|
pureN = snd pureNT
|
||||||
|
|
||||||
joinT : Transformation F[ R ∘ R ] R
|
joinT : Transformation F[ R ∘ R ] R
|
||||||
joinT = proj₁ joinNT
|
joinT = fst joinNT
|
||||||
|
join : {X : Object} → ℂ [ Romap (Romap X) , Romap X ]
|
||||||
|
join = joinT _
|
||||||
joinN : Natural F[ R ∘ R ] R joinT
|
joinN : Natural F[ R ∘ R ] R joinT
|
||||||
joinN = proj₂ joinNT
|
joinN = snd joinNT
|
||||||
|
|
||||||
Romap = Functor.omap R
|
|
||||||
Rfmap = Functor.fmap R
|
|
||||||
|
|
||||||
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
||||||
bind {X} {Y} f = joinT Y ∘ Rfmap f
|
bind {X} {Y} f = join <<< fmap f
|
||||||
|
|
||||||
IsAssociative : Set _
|
IsAssociative : Set _
|
||||||
IsAssociative = {X : Object}
|
IsAssociative = {X : Object}
|
||||||
→ joinT X ∘ Rfmap (joinT X) ≡ joinT X ∘ joinT (Romap X)
|
-- R and join commute
|
||||||
|
→ joinT X <<< fmap join ≡ join <<< join
|
||||||
IsInverse : Set _
|
IsInverse : Set _
|
||||||
IsInverse = {X : Object}
|
IsInverse = {X : Object}
|
||||||
→ joinT X ∘ pureT (Romap X) ≡ 𝟙
|
-- Talks about R's action on objects
|
||||||
× joinT X ∘ Rfmap (pureT X) ≡ 𝟙
|
→ join <<< pure ≡ identity {Romap X}
|
||||||
IsNatural = ∀ {X Y} f → joinT Y ∘ Rfmap f ∘ pureT X ≡ f
|
-- Talks about R's action on arrows
|
||||||
|
× join <<< fmap pure ≡ identity {Romap X}
|
||||||
|
IsNatural = ∀ {X Y} (f : Arrow X (Romap Y))
|
||||||
|
→ join <<< fmap f <<< pure ≡ f
|
||||||
IsDistributive = ∀ {X Y Z} (g : Arrow Y (Romap Z)) (f : Arrow X (Romap Y))
|
IsDistributive = ∀ {X Y Z} (g : Arrow Y (Romap Z)) (f : Arrow X (Romap Y))
|
||||||
→ joinT Z ∘ Rfmap g ∘ (joinT Y ∘ Rfmap f)
|
→ join <<< fmap g <<< (join <<< fmap f)
|
||||||
≡ joinT Z ∘ Rfmap (joinT Z ∘ Rfmap g ∘ f)
|
≡ join <<< fmap (join <<< fmap g <<< f)
|
||||||
|
|
||||||
record IsMonad (raw : RawMonad) : Set ℓ where
|
record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
open RawMonad raw public
|
open RawMonad raw public
|
||||||
|
|
@ -67,11 +78,11 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
|
||||||
isNatural : IsNatural
|
isNatural : IsNatural
|
||||||
isNatural {X} {Y} f = begin
|
isNatural {X} {Y} f = begin
|
||||||
joinT Y ∘ R.fmap f ∘ pureT X ≡⟨ sym ℂ.isAssociative ⟩
|
joinT Y <<< R.fmap f <<< pureT X ≡⟨ sym ℂ.isAssociative ⟩
|
||||||
joinT Y ∘ (R.fmap f ∘ pureT X) ≡⟨ cong (λ φ → joinT Y ∘ φ) (sym (pureN f)) ⟩
|
joinT Y <<< (R.fmap f <<< pureT X) ≡⟨ cong (λ φ → joinT Y <<< φ) (sym (pureN f)) ⟩
|
||||||
joinT Y ∘ (pureT (R.omap Y) ∘ f) ≡⟨ ℂ.isAssociative ⟩
|
joinT Y <<< (pureT (R.omap Y) <<< f) ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT Y ∘ pureT (R.omap Y) ∘ f ≡⟨ cong (λ φ → φ ∘ f) (proj₁ isInverse) ⟩
|
joinT Y <<< pureT (R.omap Y) <<< f ≡⟨ cong (λ φ → φ <<< f) (fst isInverse) ⟩
|
||||||
𝟙 ∘ f ≡⟨ ℂ.leftIdentity ⟩
|
identity <<< f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
f ∎
|
f ∎
|
||||||
|
|
||||||
isDistributive : IsDistributive
|
isDistributive : IsDistributive
|
||||||
|
|
@ -79,36 +90,36 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
where
|
where
|
||||||
module R² = Functor F[ R ∘ R ]
|
module R² = Functor F[ R ∘ R ]
|
||||||
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
||||||
→ R.fmap (a ∘ b ∘ c)
|
→ R.fmap (a <<< b <<< c)
|
||||||
≡ R.fmap a ∘ R.fmap b ∘ R.fmap c
|
≡ R.fmap a <<< R.fmap b <<< R.fmap c
|
||||||
distrib3 {a = a} {b} {c} = begin
|
distrib3 {a = a} {b} {c} = begin
|
||||||
R.fmap (a ∘ b ∘ c) ≡⟨ R.isDistributive ⟩
|
R.fmap (a <<< b <<< c) ≡⟨ R.isDistributive ⟩
|
||||||
R.fmap (a ∘ b) ∘ R.fmap c ≡⟨ cong (_∘ _) R.isDistributive ⟩
|
R.fmap (a <<< b) <<< R.fmap c ≡⟨ cong (_<<< _) R.isDistributive ⟩
|
||||||
R.fmap a ∘ R.fmap b ∘ R.fmap c ∎
|
R.fmap a <<< R.fmap b <<< R.fmap c ∎
|
||||||
aux = begin
|
aux = begin
|
||||||
joinT Z ∘ R.fmap (joinT Z ∘ R.fmap g ∘ f)
|
joinT Z <<< R.fmap (joinT Z <<< R.fmap g <<< f)
|
||||||
≡⟨ cong (λ φ → joinT Z ∘ φ) distrib3 ⟩
|
≡⟨ cong (λ φ → joinT Z <<< φ) distrib3 ⟩
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ R.fmap (R.fmap g) ∘ R.fmap f)
|
joinT Z <<< (R.fmap (joinT Z) <<< R.fmap (R.fmap g) <<< R.fmap f)
|
||||||
≡⟨⟩
|
≡⟨⟩
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ R².fmap g ∘ R.fmap f)
|
joinT Z <<< (R.fmap (joinT Z) <<< R².fmap g <<< R.fmap f)
|
||||||
≡⟨ cong (_∘_ (joinT Z)) (sym ℂ.isAssociative) ⟩
|
≡⟨ cong (_<<<_ (joinT Z)) (sym ℂ.isAssociative) ⟩
|
||||||
joinT Z ∘ (R.fmap (joinT Z) ∘ (R².fmap g ∘ R.fmap f))
|
joinT Z <<< (R.fmap (joinT Z) <<< (R².fmap g <<< R.fmap f))
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
≡⟨ ℂ.isAssociative ⟩
|
||||||
(joinT Z ∘ R.fmap (joinT Z)) ∘ (R².fmap g ∘ R.fmap f)
|
(joinT Z <<< R.fmap (joinT Z)) <<< (R².fmap g <<< R.fmap f)
|
||||||
≡⟨ cong (λ φ → φ ∘ (R².fmap g ∘ R.fmap f)) isAssociative ⟩
|
≡⟨ cong (λ φ → φ <<< (R².fmap g <<< R.fmap f)) isAssociative ⟩
|
||||||
(joinT Z ∘ joinT (R.omap Z)) ∘ (R².fmap g ∘ R.fmap f)
|
(joinT Z <<< joinT (R.omap Z)) <<< (R².fmap g <<< R.fmap f)
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT Z ∘ joinT (R.omap Z) ∘ R².fmap g ∘ R.fmap f
|
joinT Z <<< joinT (R.omap Z) <<< R².fmap g <<< R.fmap f
|
||||||
≡⟨⟩
|
≡⟨⟩
|
||||||
((joinT Z ∘ joinT (R.omap Z)) ∘ R².fmap g) ∘ R.fmap f
|
((joinT Z <<< joinT (R.omap Z)) <<< R².fmap g) <<< R.fmap f
|
||||||
≡⟨ cong (_∘ R.fmap f) (sym ℂ.isAssociative) ⟩
|
≡⟨ cong (_<<< R.fmap f) (sym ℂ.isAssociative) ⟩
|
||||||
(joinT Z ∘ (joinT (R.omap Z) ∘ R².fmap g)) ∘ R.fmap f
|
(joinT Z <<< (joinT (R.omap Z) <<< R².fmap g)) <<< R.fmap f
|
||||||
≡⟨ cong (λ φ → φ ∘ R.fmap f) (cong (_∘_ (joinT Z)) (joinN g)) ⟩
|
≡⟨ cong (λ φ → φ <<< R.fmap f) (cong (_<<<_ (joinT Z)) (joinN g)) ⟩
|
||||||
(joinT Z ∘ (R.fmap g ∘ joinT Y)) ∘ R.fmap f
|
(joinT Z <<< (R.fmap g <<< joinT Y)) <<< R.fmap f
|
||||||
≡⟨ cong (_∘ R.fmap f) ℂ.isAssociative ⟩
|
≡⟨ cong (_<<< R.fmap f) ℂ.isAssociative ⟩
|
||||||
joinT Z ∘ R.fmap g ∘ joinT Y ∘ R.fmap f
|
joinT Z <<< R.fmap g <<< joinT Y <<< R.fmap f
|
||||||
≡⟨ sym (Category.isAssociative ℂ) ⟩
|
≡⟨ sym (Category.isAssociative ℂ) ⟩
|
||||||
joinT Z ∘ R.fmap g ∘ (joinT Y ∘ R.fmap f)
|
joinT Z <<< R.fmap g <<< (joinT Y <<< R.fmap f)
|
||||||
∎
|
∎
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
|
|
@ -128,8 +139,8 @@ private
|
||||||
where
|
where
|
||||||
xX = x {X}
|
xX = x {X}
|
||||||
yX = y {X}
|
yX = y {X}
|
||||||
e1 = Category.arrowsAreSets ℂ _ _ (proj₁ xX) (proj₁ yX)
|
e1 = Category.arrowsAreSets ℂ _ _ (fst xX) (fst yX)
|
||||||
e2 = Category.arrowsAreSets ℂ _ _ (proj₂ xX) (proj₂ yX)
|
e2 = Category.arrowsAreSets ℂ _ _ (snd xX) (snd yX)
|
||||||
|
|
||||||
open IsMonad
|
open IsMonad
|
||||||
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
||||||
|
|
|
||||||
|
|
@ -1,25 +1,24 @@
|
||||||
{-
|
{-
|
||||||
This module provides construction 2.3 in [voe]
|
This module provides construction 2.3 in [voe]
|
||||||
-}
|
-}
|
||||||
{-# OPTIONS --cubical --allow-unsolved-metas --caching #-}
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Category.Monad.Voevodsky where
|
module Cat.Category.Monad.Voevodsky where
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
open import Function
|
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
open import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Monad
|
open import Cat.Category.Monad
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
open import Cat.Equivalence
|
open import Cat.Equivalence
|
||||||
|
|
||||||
module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
open Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Object ; Arrow)
|
open ℂ using (Object ; Arrow)
|
||||||
open NaturalTransformation ℂ ℂ
|
|
||||||
module M = Monoidal ℂ
|
module M = Monoidal ℂ
|
||||||
module K = Kleisli ℂ
|
module K = Kleisli ℂ
|
||||||
|
|
||||||
|
|
@ -50,9 +49,9 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
pureT X = pure {X}
|
pureT X = pure {X}
|
||||||
|
|
||||||
field
|
field
|
||||||
pureN : Natural F.identity R pureT
|
pureN : Natural Functors.identity R pureT
|
||||||
|
|
||||||
pureNT : NaturalTransformation F.identity R
|
pureNT : NaturalTransformation Functors.identity R
|
||||||
pureNT = pureT , pureN
|
pureNT = pureT , pureN
|
||||||
|
|
||||||
joinT : (A : Object) → ℂ [ omap (omap A) , omap A ]
|
joinT : (A : Object) → ℂ [ omap (omap A) , omap A ]
|
||||||
|
|
@ -72,12 +71,12 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
}
|
}
|
||||||
|
|
||||||
field
|
field
|
||||||
isMnd : IsMonad rawMnd
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
toMonad : Monad
|
toMonad : Monad
|
||||||
toMonad = record
|
toMonad = record
|
||||||
{ raw = rawMnd
|
{ raw = rawMnd
|
||||||
; isMonad = isMnd
|
; isMonad = isMonad
|
||||||
}
|
}
|
||||||
|
|
||||||
record §2 : Set ℓ where
|
record §2 : Set ℓ where
|
||||||
|
|
@ -94,43 +93,37 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
}
|
}
|
||||||
|
|
||||||
field
|
field
|
||||||
isMnd : IsMonad rawMnd
|
isMonad : IsMonad rawMnd
|
||||||
|
|
||||||
toMonad : Monad
|
toMonad : Monad
|
||||||
toMonad = record
|
toMonad = record
|
||||||
{ raw = rawMnd
|
{ raw = rawMnd
|
||||||
; isMonad = isMnd
|
; isMonad = isMonad
|
||||||
}
|
}
|
||||||
|
|
||||||
§1-fromMonad : (m : M.Monad) → §2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
§1-fromMonad : (m : M.Monad) → §2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
||||||
-- voe-2-3-1-fromMonad : (m : M.Monad) → voe.§2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
|
|
||||||
§1-fromMonad m = record
|
§1-fromMonad m = record
|
||||||
{ fmap = Functor.fmap R
|
{ fmap = Functor.fmap R
|
||||||
; RisFunctor = Functor.isFunctor R
|
; RisFunctor = Functor.isFunctor R
|
||||||
; pureN = pureN
|
; pureN = pureN
|
||||||
; join = λ {X} → joinT X
|
; join = λ {X} → joinT X
|
||||||
; joinN = joinN
|
; joinN = joinN
|
||||||
; isMnd = M.Monad.isMonad m
|
; isMonad = M.Monad.isMonad m
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
raw = M.Monad.raw m
|
open M.Monad m
|
||||||
R = M.RawMonad.R raw
|
|
||||||
pureT = M.RawMonad.pureT raw
|
|
||||||
pureN = M.RawMonad.pureN raw
|
|
||||||
joinT = M.RawMonad.joinT raw
|
|
||||||
joinN = M.RawMonad.joinN raw
|
|
||||||
|
|
||||||
§2-fromMonad : (m : K.Monad) → §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
|
§2-fromMonad : (m : K.Monad) → §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
|
||||||
§2-fromMonad m = record
|
§2-fromMonad m = record
|
||||||
{ bind = K.Monad.bind m
|
{ bind = K.Monad.bind m
|
||||||
; isMnd = K.Monad.isMonad m
|
; isMonad = K.Monad.isMonad m
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | In the following we seek to transform the equivalence `Monoidal≃Kleisli`
|
-- | In the following we seek to transform the equivalence `Monoidal≃Kleisli`
|
||||||
-- | to talk about voevodsky's construction.
|
-- | to talk about voevodsky's construction.
|
||||||
module _ (omap : Omap ℂ ℂ) (pure : {X : Object} → Arrow X (omap X)) where
|
module _ (omap : Omap ℂ ℂ) (pure : {X : Object} → Arrow X (omap X)) where
|
||||||
private
|
private
|
||||||
module E = AreInverses (Monoidal≅Kleisli ℂ .proj₂ .proj₂)
|
module E = AreInverses {f = (fst (Monoidal≊Kleisli ℂ))} {fst (snd (Monoidal≊Kleisli ℂ))}(Monoidal≊Kleisli ℂ .snd .snd)
|
||||||
|
|
||||||
Monoidal→Kleisli : M.Monad → K.Monad
|
Monoidal→Kleisli : M.Monad → K.Monad
|
||||||
Monoidal→Kleisli = E.obverse
|
Monoidal→Kleisli = E.obverse
|
||||||
|
|
@ -138,10 +131,10 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
Kleisli→Monoidal : K.Monad → M.Monad
|
Kleisli→Monoidal : K.Monad → M.Monad
|
||||||
Kleisli→Monoidal = E.reverse
|
Kleisli→Monoidal = E.reverse
|
||||||
|
|
||||||
ve-re : Kleisli→Monoidal ∘ Monoidal→Kleisli ≡ Function.id
|
ve-re : Kleisli→Monoidal ∘ Monoidal→Kleisli ≡ idFun _
|
||||||
ve-re = E.verso-recto
|
ve-re = E.verso-recto
|
||||||
|
|
||||||
re-ve : Monoidal→Kleisli ∘ Kleisli→Monoidal ≡ Function.id
|
re-ve : Monoidal→Kleisli ∘ Kleisli→Monoidal ≡ idFun _
|
||||||
re-ve = E.recto-verso
|
re-ve = E.recto-verso
|
||||||
|
|
||||||
forth : §2-3.§1 omap pure → §2-3.§2 omap pure
|
forth : §2-3.§1 omap pure → §2-3.§2 omap pure
|
||||||
|
|
@ -178,9 +171,6 @@ module voe {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
where
|
where
|
||||||
t' : ((Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad {omap} {pure})
|
t' : ((Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad {omap} {pure})
|
||||||
≡ §2-3.§2.toMonad
|
≡ §2-3.§2.toMonad
|
||||||
cong-d : ∀ {ℓ} {A : Set ℓ} {ℓ'} {B : A → Set ℓ'} {x y : A}
|
|
||||||
→ (f : (x : A) → B x) → (eq : x ≡ y) → PathP (\ i → B (eq i)) (f x) (f y)
|
|
||||||
cong-d f p = λ i → f (p i)
|
|
||||||
t' = cong (\ φ → φ ∘ §2-3.§2.toMonad) re-ve
|
t' = cong (\ φ → φ ∘ §2-3.§2.toMonad) re-ve
|
||||||
t : (§2-fromMonad ∘ (Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad {omap} {pure})
|
t : (§2-fromMonad ∘ (Monoidal→Kleisli ∘ Kleisli→Monoidal) ∘ §2-3.§2.toMonad {omap} {pure})
|
||||||
≡ (§2-fromMonad ∘ §2-3.§2.toMonad)
|
≡ (§2-fromMonad ∘ §2-3.§2.toMonad)
|
||||||
|
|
|
||||||
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# OPTIONS --allow-unsolved-metas #-}
|
||||||
module Cat.Category.Monoid where
|
module Cat.Category.Monoid where
|
||||||
|
|
||||||
open import Agda.Primitive
|
open import Agda.Primitive
|
||||||
|
|
@ -6,9 +7,10 @@ open import Cat.Category
|
||||||
open import Cat.Category.Product
|
open import Cat.Category.Product
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
import Cat.Categories.Cat as Cat
|
import Cat.Categories.Cat as Cat
|
||||||
|
open import Cat.Prelude hiding (_×_ ; empty)
|
||||||
|
|
||||||
-- TODO: Incorrect!
|
-- TODO: Incorrect!
|
||||||
module _ (ℓa ℓb : Level) where
|
module _ {ℓa ℓb : Level} where
|
||||||
private
|
private
|
||||||
ℓ = lsuc (ℓa ⊔ ℓb)
|
ℓ = lsuc (ℓa ⊔ ℓb)
|
||||||
|
|
||||||
|
|
@ -21,30 +23,34 @@ module _ (ℓa ℓb : Level) where
|
||||||
_×_ : ∀ {ℓa ℓb} → Category ℓa ℓb → Category ℓa ℓb → Category ℓa ℓb
|
_×_ : ∀ {ℓa ℓb} → Category ℓa ℓb → Category ℓa ℓb → Category ℓa ℓb
|
||||||
ℂ × 𝔻 = Cat.CatProduct.object ℂ 𝔻
|
ℂ × 𝔻 = Cat.CatProduct.object ℂ 𝔻
|
||||||
|
|
||||||
record RawMonoidalCategory : Set ℓ where
|
record RawMonoidalCategory (ℂ : Category ℓa ℓb) : Set ℓ where
|
||||||
|
open Category ℂ public hiding (IsAssociative)
|
||||||
field
|
field
|
||||||
category : Category ℓa ℓb
|
|
||||||
open Category category public
|
|
||||||
field
|
|
||||||
{{hasProducts}} : HasProducts category
|
|
||||||
empty : Object
|
empty : Object
|
||||||
-- aka. tensor product, monoidal product.
|
-- aka. tensor product, monoidal product.
|
||||||
append : Functor (category × category) category
|
append : Functor (ℂ × ℂ) ℂ
|
||||||
open HasProducts hasProducts public
|
|
||||||
|
|
||||||
record MonoidalCategory : Set ℓ where
|
module F = Functor append
|
||||||
|
|
||||||
|
_⊗_ = append
|
||||||
|
mappend = F.fmap
|
||||||
|
|
||||||
|
IsAssociative : Set _
|
||||||
|
IsAssociative = {A B : Object} → (f g h : Arrow A A) → mappend ({!mappend!} , {!mappend!}) ≡ mappend (f , mappend (g , h))
|
||||||
|
|
||||||
|
record MonoidalCategory (ℂ : Category ℓa ℓb) : Set ℓ where
|
||||||
field
|
field
|
||||||
raw : RawMonoidalCategory
|
raw : RawMonoidalCategory ℂ
|
||||||
open RawMonoidalCategory raw public
|
open RawMonoidalCategory raw public
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : MonoidalCategory ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) {monoidal : MonoidalCategory ℂ} {hasProducts : HasProducts ℂ} where
|
||||||
private
|
private
|
||||||
ℓ = ℓa ⊔ ℓb
|
ℓ = ℓa ⊔ ℓb
|
||||||
|
|
||||||
open MonoidalCategory ℂ public
|
open MonoidalCategory monoidal public hiding (mappend)
|
||||||
|
open HasProducts hasProducts
|
||||||
|
|
||||||
record Monoid : Set ℓ where
|
record MonoidalObject (M : Object) : Set ℓ where
|
||||||
field
|
field
|
||||||
carrier : Object
|
mempty : Arrow empty M
|
||||||
mempty : Arrow empty carrier
|
mappend : Arrow (M × M) M
|
||||||
mappend : Arrow (carrier × carrier) carrier
|
|
||||||
|
|
|
||||||
|
|
@ -17,22 +17,20 @@
|
||||||
-- Functions for manipulating the above:
|
-- Functions for manipulating the above:
|
||||||
--
|
--
|
||||||
-- * A composition operator.
|
-- * A composition operator.
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Category.NaturalTransformation where
|
|
||||||
|
|
||||||
open import Cat.Prelude
|
open import Cat.Prelude
|
||||||
|
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s)
|
open import Data.Nat using (_≤′_ ; ≤′-refl ; ≤′-step)
|
||||||
module Nat = Data.Nat
|
module Nat = Data.Nat
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor hiding (identity)
|
open import Cat.Category.Functor
|
||||||
open import Cat.Wishlist
|
|
||||||
|
|
||||||
module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
module Cat.Category.NaturalTransformation
|
||||||
|
{ℓc ℓc' ℓd ℓd' : Level}
|
||||||
(ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
(ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||||
|
|
||||||
open Category using (Object ; 𝟙)
|
open Category using (Object)
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
module 𝔻 = Category 𝔻
|
module 𝔻 = Category 𝔻
|
||||||
|
|
@ -59,19 +57,19 @@ module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
||||||
propIsNatural θ x y i {A} {B} f = 𝔻.arrowsAreSets _ _ (x f) (y f) i
|
propIsNatural θ x y i {A} {B} f = 𝔻.arrowsAreSets _ _ (x f) (y f) i
|
||||||
|
|
||||||
NaturalTransformation≡ : {α β : NaturalTransformation}
|
NaturalTransformation≡ : {α β : NaturalTransformation}
|
||||||
→ (eq₁ : α .proj₁ ≡ β .proj₁)
|
→ (eq₁ : α .fst ≡ β .fst)
|
||||||
→ α ≡ β
|
→ α ≡ β
|
||||||
NaturalTransformation≡ eq = lemSig propIsNatural _ _ eq
|
NaturalTransformation≡ eq = lemSig propIsNatural _ _ eq
|
||||||
|
|
||||||
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
identityTrans : (F : Functor ℂ 𝔻) → Transformation F F
|
||||||
identityTrans F C = 𝟙 𝔻
|
identityTrans F C = 𝔻.identity
|
||||||
|
|
||||||
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
identityNatural : (F : Functor ℂ 𝔻) → Natural F F (identityTrans F)
|
||||||
identityNatural F {A = A} {B = B} f = begin
|
identityNatural F {A = A} {B = B} f = begin
|
||||||
𝔻 [ identityTrans F B ∘ F→ f ] ≡⟨⟩
|
𝔻 [ identityTrans F B ∘ F→ f ] ≡⟨⟩
|
||||||
𝔻 [ 𝟙 𝔻 ∘ F→ f ] ≡⟨ 𝔻.leftIdentity ⟩
|
𝔻 [ 𝔻.identity ∘ F→ f ] ≡⟨ 𝔻.leftIdentity ⟩
|
||||||
F→ f ≡⟨ sym 𝔻.rightIdentity ⟩
|
F→ f ≡⟨ sym 𝔻.rightIdentity ⟩
|
||||||
𝔻 [ F→ f ∘ 𝟙 𝔻 ] ≡⟨⟩
|
𝔻 [ F→ f ∘ 𝔻.identity ] ≡⟨⟩
|
||||||
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
||||||
where
|
where
|
||||||
module F = Functor F
|
module F = Functor F
|
||||||
|
|
@ -89,8 +87,8 @@ module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
||||||
T[ θ ∘ η ] C = 𝔻 [ θ C ∘ η C ]
|
T[ θ ∘ η ] C = 𝔻 [ θ C ∘ η C ]
|
||||||
|
|
||||||
NT[_∘_] : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
NT[_∘_] : NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H
|
||||||
proj₁ NT[ (θ , _) ∘ (η , _) ] = T[ θ ∘ η ]
|
fst NT[ (θ , _) ∘ (η , _) ] = T[ θ ∘ η ]
|
||||||
proj₂ NT[ (θ , θNat) ∘ (η , ηNat) ] {A} {B} f = begin
|
snd NT[ (θ , θNat) ∘ (η , ηNat) ] {A} {B} f = begin
|
||||||
𝔻 [ T[ θ ∘ η ] B ∘ F.fmap f ] ≡⟨⟩
|
𝔻 [ T[ θ ∘ η ] B ∘ F.fmap f ] ≡⟨⟩
|
||||||
𝔻 [ 𝔻 [ θ B ∘ η B ] ∘ F.fmap f ] ≡⟨ sym 𝔻.isAssociative ⟩
|
𝔻 [ 𝔻 [ θ B ∘ η B ] ∘ F.fmap f ] ≡⟨ sym 𝔻.isAssociative ⟩
|
||||||
𝔻 [ θ B ∘ 𝔻 [ η B ∘ F.fmap f ] ] ≡⟨ cong (λ φ → 𝔻 [ θ B ∘ φ ]) (ηNat f) ⟩
|
𝔻 [ θ B ∘ 𝔻 [ η B ∘ F.fmap f ] ] ≡⟨ cong (λ φ → 𝔻 [ θ B ∘ φ ]) (ηNat f) ⟩
|
||||||
|
|
@ -100,6 +98,7 @@ module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
||||||
𝔻 [ H.fmap f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
𝔻 [ H.fmap f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
||||||
𝔻 [ H.fmap f ∘ T[ θ ∘ η ] A ] ∎
|
𝔻 [ H.fmap f ∘ T[ θ ∘ η ] A ] ∎
|
||||||
|
|
||||||
|
module Properties where
|
||||||
module _ {F G : Functor ℂ 𝔻} where
|
module _ {F G : Functor ℂ 𝔻} where
|
||||||
transformationIsSet : isSet (Transformation F G)
|
transformationIsSet : isSet (Transformation F G)
|
||||||
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l → p l C) (λ l → q l C) i j
|
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l → p l C) (λ l → q l C) i j
|
||||||
|
|
@ -112,9 +111,37 @@ module NaturalTransformation {ℓc ℓc' ℓd ℓd' : Level}
|
||||||
|
|
||||||
naturalIsSet : (θ : Transformation F G) → isSet (Natural F G θ)
|
naturalIsSet : (θ : Transformation F G) → isSet (Natural F G θ)
|
||||||
naturalIsSet θ =
|
naturalIsSet θ =
|
||||||
ntypeCommulative
|
ntypeCumulative {n = 1}
|
||||||
(s≤s {n = Nat.suc Nat.zero} z≤n)
|
(Data.Nat.≤′-step Data.Nat.≤′-refl)
|
||||||
(naturalIsProp θ)
|
(naturalIsProp θ)
|
||||||
|
|
||||||
naturalTransformationIsSet : isSet (NaturalTransformation F G)
|
naturalTransformationIsSet : isSet (NaturalTransformation F G)
|
||||||
naturalTransformationIsSet = sigPresSet transformationIsSet naturalIsSet
|
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,13 +1,12 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
{-# OPTIONS --cubical --caching #-}
|
||||||
module Cat.Category.Product where
|
module Cat.Category.Product where
|
||||||
|
|
||||||
open import Cat.Prelude hiding (_×_ ; proj₁ ; proj₂)
|
open import Cat.Prelude as P hiding (_×_ ; fst ; snd)
|
||||||
import Data.Product as P
|
open import Cat.Equivalence
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
|
|
||||||
module _ (A B : Object) where
|
module _ (A B : Object) where
|
||||||
|
|
@ -15,21 +14,19 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
no-eta-equality
|
no-eta-equality
|
||||||
field
|
field
|
||||||
object : Object
|
object : Object
|
||||||
proj₁ : ℂ [ object , A ]
|
fst : ℂ [ object , A ]
|
||||||
proj₂ : ℂ [ object , B ]
|
snd : ℂ [ object , B ]
|
||||||
|
|
||||||
-- FIXME Not sure this is actually a proposition - so this name is
|
|
||||||
-- misleading.
|
|
||||||
record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
|
record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
|
||||||
open RawProduct raw public
|
open RawProduct raw public
|
||||||
field
|
field
|
||||||
ump : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
|
ump : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
|
||||||
→ ∃![ f×g ] (ℂ [ proj₁ ∘ f×g ] ≡ f P.× ℂ [ proj₂ ∘ f×g ] ≡ g)
|
→ ∃![ f×g ] (ℂ [ fst ∘ f×g ] ≡ f P.× ℂ [ snd ∘ f×g ] ≡ g)
|
||||||
|
|
||||||
-- | Arrow product
|
-- | Arrow product
|
||||||
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
_P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
||||||
→ ℂ [ X , object ]
|
→ ℂ [ X , object ]
|
||||||
_P[_×_] π₁ π₂ = P.proj₁ (ump π₁ π₂)
|
_P[_×_] π₁ π₂ = P.fst (ump π₁ π₂)
|
||||||
|
|
||||||
record Product : Set (ℓa ⊔ ℓb) where
|
record Product : Set (ℓa ⊔ ℓb) where
|
||||||
field
|
field
|
||||||
|
|
@ -50,8 +47,8 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
-- The product mentioned in awodey in Def 6.1 is not the regular product of
|
-- The product mentioned in awodey in Def 6.1 is not the regular product of
|
||||||
-- arrows. It's a "parallel" product
|
-- arrows. It's a "parallel" product
|
||||||
module _ {A A' B B' : Object} where
|
module _ {A A' B B' : Object} where
|
||||||
open Product
|
open Product using (_P[_×_])
|
||||||
open Product (product A B) hiding (_P[_×_]) renaming (proj₁ to fst ; proj₂ to snd)
|
open Product (product A B) hiding (_P[_×_]) renaming (fst to fst ; snd to snd)
|
||||||
_|×|_ : ℂ [ A , A' ] → ℂ [ B , B' ] → ℂ [ A × B , A' × B' ]
|
_|×|_ : ℂ [ A , A' ] → ℂ [ B , B' ] → ℂ [ A × B , A' × B' ]
|
||||||
f |×| g = product A' B'
|
f |×| g = product A' B'
|
||||||
P[ ℂ [ f ∘ fst ]
|
P[ ℂ [ f ∘ fst ]
|
||||||
|
|
@ -68,8 +65,14 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object
|
||||||
module y = IsProduct y
|
module y = IsProduct y
|
||||||
|
|
||||||
module _ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ]) where
|
module _ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ]) 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 : x.ump f g ≡ y.ump f g
|
||||||
prodAux = {!!}
|
prodAux = lemSig ((λ f×g → propSig (propSig (arrowsAreSets _ _) λ _ → arrowsAreSets _ _) (λ _ → help f×g))) _ _ res
|
||||||
|
|
||||||
propIsProduct' : x ≡ y
|
propIsProduct' : x ≡ y
|
||||||
propIsProduct' i = record { ump = λ f g → prodAux f g i }
|
propIsProduct' i = record { ump = λ f g → prodAux f g i }
|
||||||
|
|
@ -83,6 +86,259 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object
|
||||||
q : (λ i → IsProduct ℂ A B (p i)) [ Product.isProduct x ≡ Product.isProduct y ]
|
q : (λ i → IsProduct ℂ A B (p i)) [ Product.isProduct x ≡ Product.isProduct y ]
|
||||||
q = lemPropF propIsProduct p
|
q = lemPropF propIsProduct p
|
||||||
|
|
||||||
|
module Try0 {ℓa ℓb : Level} {ℂ : Category ℓa ℓb}
|
||||||
|
(let module ℂ = Category ℂ) {𝒜 ℬ : ℂ.Object} where
|
||||||
|
|
||||||
|
open P
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
private
|
||||||
|
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 _≅_)
|
||||||
|
step0
|
||||||
|
: ((X , xa , xb) ≡ (Y , ya , yb))
|
||||||
|
≅ (Σ[ p ∈ (X ≡ Y) ] (PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya) × (PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb))
|
||||||
|
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
|
||||||
|
: (Σ[ p ∈ (X ≡ Y) ] (PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya) × (PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb))
|
||||||
|
≅ Σ (X ℂ.≊ Y) (λ iso
|
||||||
|
→ let p = ℂ.isoToId iso
|
||||||
|
in
|
||||||
|
( PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya)
|
||||||
|
× PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb
|
||||||
|
)
|
||||||
|
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
|
||||||
|
: Σ (X ℂ.≊ Y) (λ iso
|
||||||
|
→ let p = ℂ.isoToId iso
|
||||||
|
in
|
||||||
|
( PathP (λ i → ℂ.Arrow (p i) 𝒜) xa ya)
|
||||||
|
× PathP (λ i → ℂ.Arrow (p i) ℬ) xb yb
|
||||||
|
)
|
||||||
|
≅ ((X , xa , xb) ≊ (Y , ya , yb))
|
||||||
|
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
|
||||||
|
|
||||||
|
cat : Category _ _
|
||||||
|
cat = record
|
||||||
|
{ raw = raw
|
||||||
|
; isCategory = isCat
|
||||||
|
}
|
||||||
|
|
||||||
|
open Category cat
|
||||||
|
|
||||||
|
lemma : Terminal ≃ Product ℂ 𝒜 ℬ
|
||||||
|
lemma = fromIsomorphism Terminal (Product ℂ 𝒜 ℬ) (f , g , inv)
|
||||||
|
-- C-x 8 RET MATHEMATICAL BOLD SCRIPT CAPITAL A
|
||||||
|
-- 𝒜
|
||||||
|
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
|
module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
|
||||||
open Category ℂ
|
open Category ℂ
|
||||||
private
|
private
|
||||||
|
|
@ -90,31 +346,12 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object
|
||||||
private
|
private
|
||||||
module x = HasProducts x
|
module x = HasProducts x
|
||||||
module y = HasProducts y
|
module y = HasProducts y
|
||||||
module _ (A B : Object) where
|
|
||||||
module pX = Product (x.product A B)
|
|
||||||
module pY = Product (y.product A B)
|
|
||||||
objEq : pX.object ≡ pY.object
|
|
||||||
objEq = {!!}
|
|
||||||
proj₁Eq : (λ i → ℂ [ objEq i , A ]) [ pX.proj₁ ≡ pY.proj₁ ]
|
|
||||||
proj₁Eq = {!!}
|
|
||||||
proj₂Eq : (λ i → ℂ [ objEq i , B ]) [ pX.proj₂ ≡ pY.proj₂ ]
|
|
||||||
proj₂Eq = {!!}
|
|
||||||
rawEq : pX.raw ≡ pY.raw
|
|
||||||
RawProduct.object (rawEq i) = objEq i
|
|
||||||
RawProduct.proj₁ (rawEq i) = {!!}
|
|
||||||
RawProduct.proj₂ (rawEq i) = {!!}
|
|
||||||
|
|
||||||
isEq : (λ i → IsProduct ℂ A B (rawEq i)) [ pX.isProduct ≡ pY.isProduct ]
|
|
||||||
isEq = {!!}
|
|
||||||
|
|
||||||
appEq : x.product A B ≡ y.product A B
|
|
||||||
appEq = Product≡ rawEq
|
|
||||||
|
|
||||||
productEq : x.product ≡ y.product
|
productEq : x.product ≡ y.product
|
||||||
productEq i = λ A B → appEq A B i
|
productEq = funExt λ A → funExt λ B → Try0.propProduct _ _
|
||||||
|
|
||||||
propHasProducts' : x ≡ y
|
|
||||||
propHasProducts' i = record { product = productEq i }
|
|
||||||
|
|
||||||
propHasProducts : isProp (HasProducts ℂ)
|
propHasProducts : isProp (HasProducts ℂ)
|
||||||
propHasProducts = propHasProducts'
|
propHasProducts x y i = record { product = productEq x y i }
|
||||||
|
|
||||||
|
fmap≡ : {A : Set} {a0 a1 : A} {B : Set} → (f : A → B) → Path a0 a1 → Path (f a0) (f a1)
|
||||||
|
fmap≡ = cong
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
|
|
||||||
module Cat.Category.Yoneda where
|
module Cat.Category.Yoneda where
|
||||||
|
|
||||||
|
|
@ -6,8 +6,11 @@ open import Cat.Prelude
|
||||||
|
|
||||||
open import Cat.Category
|
open import Cat.Category
|
||||||
open import Cat.Category.Functor
|
open import Cat.Category.Functor
|
||||||
|
open import Cat.Category.NaturalTransformation
|
||||||
|
renaming (module Properties to F)
|
||||||
|
using ()
|
||||||
|
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun using (module Fun)
|
||||||
open import Cat.Categories.Sets hiding (presheaf)
|
open import Cat.Categories.Sets hiding (presheaf)
|
||||||
|
|
||||||
-- There is no (small) category of categories. So we won't use _⇑_ from
|
-- There is no (small) category of categories. So we won't use _⇑_ from
|
||||||
|
|
@ -47,10 +50,11 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} where
|
||||||
open RawFunctor rawYoneda hiding (fmap)
|
open RawFunctor rawYoneda hiding (fmap)
|
||||||
|
|
||||||
isIdentity : IsIdentity
|
isIdentity : IsIdentity
|
||||||
isIdentity {c} = lemSig (naturalIsProp {F = presheaf c} {presheaf c}) _ _ eq
|
isIdentity {c} = lemSig prp _ _ eq
|
||||||
where
|
where
|
||||||
eq : (λ C x → ℂ [ ℂ.𝟙 ∘ x ]) ≡ identityTrans (presheaf c)
|
eq : (λ C x → ℂ [ ℂ.identity ∘ x ]) ≡ identityTrans (presheaf c)
|
||||||
eq = funExt λ A → funExt λ B → ℂ.leftIdentity
|
eq = funExt λ A → funExt λ B → ℂ.leftIdentity
|
||||||
|
prp = F.naturalIsProp _ _ {F = presheaf c} {presheaf c}
|
||||||
|
|
||||||
isDistributive : IsDistributive
|
isDistributive : IsDistributive
|
||||||
isDistributive {A} {B} {C} {f = f} {g}
|
isDistributive {A} {B} {C} {f = f} {g}
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,23 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
{-# OPTIONS --cubical #-}
|
||||||
module Cat.Equivalence where
|
module Cat.Equivalence where
|
||||||
|
|
||||||
open import Cubical.Primitives
|
open import Cubical.Primitives
|
||||||
open import Cubical.FromStdLib renaming (ℓ-max to _⊔_)
|
open import Cubical.FromStdLib renaming (ℓ-max to _⊔_)
|
||||||
open import Cubical.PathPrelude hiding (inverse ; _≃_)
|
open import Cubical.PathPrelude hiding (inverse)
|
||||||
open import Cubical.PathPrelude using (isEquiv ; isContr ; fiber) public
|
open import Cubical.PathPrelude using (isEquiv ; isContr ; fiber) public
|
||||||
open import Cubical.GradLemma
|
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
|
module _ {ℓa ℓb : Level} where
|
||||||
private
|
private
|
||||||
|
|
@ -14,46 +26,90 @@ module _ {ℓa ℓb : Level} where
|
||||||
module _ {A : Set ℓa} {B : Set ℓb} where
|
module _ {A : Set ℓa} {B : Set ℓb} where
|
||||||
-- Quasi-inverse in [HoTT] §2.4.6
|
-- Quasi-inverse in [HoTT] §2.4.6
|
||||||
-- FIXME Maybe rename?
|
-- FIXME Maybe rename?
|
||||||
record AreInverses (f : A → B) (g : B → A) : Set ℓ where
|
AreInverses : (f : A → B) (g : B → A) → Set ℓ
|
||||||
field
|
AreInverses f g = g ∘ f ≡ idFun A × f ∘ g ≡ idFun B
|
||||||
verso-recto : g ∘ f ≡ idFun A
|
|
||||||
recto-verso : 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
|
obverse = f
|
||||||
reverse = g
|
reverse = g
|
||||||
inverse = reverse
|
inverse = reverse
|
||||||
toPair : Σ _ _
|
|
||||||
toPair = verso-recto , recto-verso
|
|
||||||
|
|
||||||
Isomorphism : (f : A → B) → Set _
|
Isomorphism : (f : A → B) → Set _
|
||||||
Isomorphism f = Σ (B → A) λ g → AreInverses f g
|
Isomorphism f = Σ (B → A) λ g → AreInverses f g
|
||||||
|
|
||||||
module _ {f : A → B} {g : B → A}
|
|
||||||
(inv : (g ∘ f) ≡ idFun A
|
|
||||||
× (f ∘ g) ≡ idFun B) where
|
|
||||||
open Σ inv renaming (fst to ve-re ; snd to re-ve)
|
|
||||||
toAreInverses : AreInverses f g
|
|
||||||
toAreInverses = record
|
|
||||||
{ verso-recto = ve-re
|
|
||||||
; recto-verso = re-ve
|
|
||||||
}
|
|
||||||
|
|
||||||
_≅_ : Set ℓa → Set ℓb → Set _
|
_≅_ : Set ℓa → Set ℓb → Set _
|
||||||
A ≅ B = Σ (A → B) Isomorphism
|
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}
|
module _ {ℓ : Level} {A B : Set ℓ} {f : A → B}
|
||||||
(g : B → A) (s : {A B : Set ℓ} → isSet (A → B)) where
|
(g : B → A) (s : {A B : Set ℓ} → isSet (A → B)) where
|
||||||
|
|
||||||
propAreInverses : isProp (AreInverses {A = A} {B} f g)
|
propAreInverses : isProp (AreInverses {A = A} {B} f g)
|
||||||
propAreInverses x y i = record
|
propAreInverses x y i = ve-re , re-ve
|
||||||
{ verso-recto = ve-re
|
|
||||||
; recto-verso = re-ve
|
|
||||||
}
|
|
||||||
where
|
where
|
||||||
open AreInverses
|
|
||||||
ve-re : g ∘ f ≡ idFun A
|
ve-re : g ∘ f ≡ idFun A
|
||||||
ve-re = s (g ∘ f) (idFun A) (verso-recto x) (verso-recto y) i
|
ve-re = s (g ∘ f) (idFun A) (fst x) (fst y) i
|
||||||
re-ve : f ∘ g ≡ idFun B
|
re-ve : f ∘ g ≡ idFun B
|
||||||
re-ve = s (f ∘ g) (idFun B) (recto-verso x) (recto-verso y) i
|
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:
|
-- In HoTT they generalize an equivalence to have the following 3 properties:
|
||||||
module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
|
|
@ -74,43 +130,34 @@ module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
fromIso (toIso x) ≡⟨ propIsEquiv _ (fromIso (toIso x)) x ⟩
|
fromIso (toIso x) ≡⟨ propIsEquiv _ (fromIso (toIso x)) x ⟩
|
||||||
x ∎
|
x ∎
|
||||||
|
|
||||||
-- `toIso` is abstract - so I probably can't close this proof.
|
-- | 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 _ (sA : isSet A) (sB : isSet B) where
|
||||||
module _ {f : A → B} (iso : Isomorphism f) where
|
module _ {f : A → B} where
|
||||||
module _ (iso-x iso-y : Isomorphism f) where
|
module _ (iso-x iso-y : Isomorphism f) where
|
||||||
open Σ iso-x renaming (fst to x ; snd to inv-x)
|
open Σ iso-x renaming (fst to x ; snd to inv-x)
|
||||||
open Σ iso-y renaming (fst to y ; snd to inv-y)
|
open Σ iso-y renaming (fst to y ; snd to inv-y)
|
||||||
module inv-x = AreInverses inv-x
|
|
||||||
module inv-y = AreInverses inv-y
|
|
||||||
|
|
||||||
fx≡fy : x ≡ y
|
fx≡fy : x ≡ y
|
||||||
fx≡fy = begin
|
fx≡fy = begin
|
||||||
x ≡⟨ cong (λ φ → x ∘ φ) (sym inv-y.recto-verso) ⟩
|
x ≡⟨ cong (λ φ → x ∘ φ) (sym (snd inv-y)) ⟩
|
||||||
x ∘ (f ∘ y) ≡⟨⟩
|
x ∘ (f ∘ y) ≡⟨⟩
|
||||||
(x ∘ f) ∘ y ≡⟨ cong (λ φ → φ ∘ y) inv-x.verso-recto ⟩
|
(x ∘ f) ∘ y ≡⟨ cong (λ φ → φ ∘ y) (fst inv-x) ⟩
|
||||||
y ∎
|
y ∎
|
||||||
|
|
||||||
open import Cat.Prelude
|
|
||||||
|
|
||||||
propInv : ∀ g → isProp (AreInverses f g)
|
propInv : ∀ g → isProp (AreInverses f g)
|
||||||
propInv g t u i = record { verso-recto = a i ; recto-verso = b i }
|
propInv g t u = λ i → a i , b i
|
||||||
where
|
where
|
||||||
module t = AreInverses t
|
a : (fst t) ≡ (fst u)
|
||||||
module u = AreInverses u
|
a i = funExt hh
|
||||||
a : t.verso-recto ≡ u.verso-recto
|
|
||||||
a i = h
|
|
||||||
where
|
where
|
||||||
hh : ∀ a → (g ∘ f) a ≡ a
|
hh : ∀ a → (g ∘ f) a ≡ a
|
||||||
hh a = sA ((g ∘ f) a) a (λ i → t.verso-recto i a) (λ i → u.verso-recto i a) i
|
hh a = sA ((g ∘ f) a) a (λ i → (fst t) i a) (λ i → (fst u) i a) i
|
||||||
h : g ∘ f ≡ idFun A
|
b : (snd t) ≡ (snd u)
|
||||||
h i a = hh a i
|
b i = funExt hh
|
||||||
b : t.recto-verso ≡ u.recto-verso
|
|
||||||
b i = h
|
|
||||||
where
|
where
|
||||||
hh : ∀ b → (f ∘ g) b ≡ b
|
hh : ∀ b → (f ∘ g) b ≡ b
|
||||||
hh b = sB _ _ (λ i → t.recto-verso i b) (λ i → u.recto-verso i b) i
|
hh b = sB _ _ (λ i → snd t i b) (λ i → snd u i b) i
|
||||||
h : f ∘ g ≡ idFun B
|
|
||||||
h i b = hh b i
|
|
||||||
|
|
||||||
inx≡iny : (λ i → AreInverses f (fx≡fy i)) [ inv-x ≡ inv-y ]
|
inx≡iny : (λ i → AreInverses f (fx≡fy i)) [ inv-x ≡ inv-y ]
|
||||||
inx≡iny = lemPropF propInv fx≡fy
|
inx≡iny = lemPropF propInv fx≡fy
|
||||||
|
|
@ -118,6 +165,7 @@ module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
propIso : iso-x ≡ iso-y
|
propIso : iso-x ≡ iso-y
|
||||||
propIso i = fx≡fy i , inx≡iny i
|
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 : (toIso {f} ∘ fromIso {f}) iso ≡ iso
|
||||||
inverse-to-from-iso = begin
|
inverse-to-from-iso = begin
|
||||||
(toIso ∘ fromIso) iso ≡⟨⟩
|
(toIso ∘ fromIso) iso ≡⟨⟩
|
||||||
|
|
@ -132,7 +180,7 @@ module _ {ℓa ℓb ℓ : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} (A : Set ℓa) (B : Set ℓb) where
|
module _ {ℓa ℓb : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
-- A wrapper around PathPrelude.≃
|
-- A wrapper around PathPrelude.≃
|
||||||
open Cubical.PathPrelude using (_≃_ ; isEquiv)
|
open Cubical.PathPrelude using (_≃_)
|
||||||
private
|
private
|
||||||
module _ {obverse : A → B} (e : isEquiv A B obverse) where
|
module _ {obverse : A → B} (e : isEquiv A B obverse) where
|
||||||
inverse : B → A
|
inverse : B → A
|
||||||
|
|
@ -142,10 +190,7 @@ module _ {ℓa ℓb : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
reverse = inverse
|
reverse = inverse
|
||||||
|
|
||||||
areInverses : AreInverses obverse inverse
|
areInverses : AreInverses obverse inverse
|
||||||
areInverses = record
|
areInverses = funExt verso-recto , funExt recto-verso
|
||||||
{ verso-recto = funExt verso-recto
|
|
||||||
; recto-verso = funExt recto-verso
|
|
||||||
}
|
|
||||||
where
|
where
|
||||||
recto-verso : ∀ b → (obverse ∘ inverse) b ≡ b
|
recto-verso : ∀ b → (obverse ∘ inverse) b ≡ b
|
||||||
recto-verso b = begin
|
recto-verso b = begin
|
||||||
|
|
@ -186,105 +231,314 @@ module _ {ℓa ℓb : Level} (A : Set ℓa) (B : Set ℓb) where
|
||||||
≃isEquiv : Equiv A B (isEquiv A B)
|
≃isEquiv : Equiv A B (isEquiv A B)
|
||||||
Equiv.fromIso ≃isEquiv {f} (f~ , iso) = gradLemma f f~ rv vr
|
Equiv.fromIso ≃isEquiv {f} (f~ , iso) = gradLemma f f~ rv vr
|
||||||
where
|
where
|
||||||
open AreInverses iso
|
|
||||||
rv : (b : B) → _ ≡ b
|
rv : (b : B) → _ ≡ b
|
||||||
rv b i = recto-verso i b
|
rv b i = snd iso i b
|
||||||
vr : (a : A) → _ ≡ a
|
vr : (a : A) → _ ≡ a
|
||||||
vr a i = verso-recto i a
|
vr a i = fst iso i a
|
||||||
Equiv.toIso ≃isEquiv = toIsomorphism
|
Equiv.toIso ≃isEquiv = toIsomorphism
|
||||||
Equiv.propIsEquiv ≃isEquiv = P.propIsEquiv
|
Equiv.propIsEquiv ≃isEquiv = P.propIsEquiv
|
||||||
where
|
where
|
||||||
import Cubical.NType.Properties as P
|
import Cubical.NType.Properties as P
|
||||||
|
|
||||||
module Equiv≃ where
|
|
||||||
open Equiv ≃isEquiv public
|
open Equiv ≃isEquiv public
|
||||||
|
|
||||||
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
||||||
open Cubical.PathPrelude using (_≃_)
|
open Cubical.PathPrelude using (_≃_)
|
||||||
|
|
||||||
-- Gives the quasi inverse from an equivalence.
|
module _ {ℓc : Level} {C : Set ℓc} {f : A → B} {g : B → C} where
|
||||||
module Equivalence (e : A ≃ B) where
|
|
||||||
open Equiv≃ A B public
|
|
||||||
private
|
|
||||||
iso : Isomorphism (fst e)
|
|
||||||
iso = snd (toIsomorphism e)
|
|
||||||
|
|
||||||
open AreInverses (snd iso) public
|
composeIsomorphism : Isomorphism f → Isomorphism g → Isomorphism (g ∘ f)
|
||||||
|
composeIsomorphism a b = f~ ∘ g~ , inv
|
||||||
composeIso : {ℓc : Level} {C : Set ℓc} → (B ≅ C) → A ≅ C
|
|
||||||
composeIso {C = C} (g , g' , iso-g) = g ∘ obverse , inverse ∘ g' , inv
|
|
||||||
where
|
where
|
||||||
module iso-g = AreInverses iso-g
|
open Σ a renaming (fst to f~ ; snd to inv-a)
|
||||||
inv : AreInverses (g ∘ obverse) (inverse ∘ g')
|
open Σ b renaming (fst to g~ ; snd to inv-b)
|
||||||
AreInverses.verso-recto inv = begin
|
inv : AreInverses (g ∘ f) (f~ ∘ g~)
|
||||||
(inverse ∘ g') ∘ (g ∘ obverse) ≡⟨⟩
|
inv = record
|
||||||
(inverse ∘ (g' ∘ g) ∘ obverse)
|
{ fst = begin
|
||||||
≡⟨ cong (λ φ → φ ∘ obverse) (cong (λ φ → inverse ∘ φ) iso-g.verso-recto) ⟩
|
(f~ ∘ g~) ∘ (g ∘ f) ≡⟨⟩
|
||||||
(inverse ∘ idFun B ∘ obverse) ≡⟨⟩
|
f~ ∘ (g~ ∘ g) ∘ f ≡⟨ cong (λ φ → f~ ∘ φ ∘ f) (fst inv-b) ⟩
|
||||||
(inverse ∘ obverse) ≡⟨ verso-recto ⟩
|
f~ ∘ idFun _ ∘ f ≡⟨⟩
|
||||||
idFun A ∎
|
f~ ∘ f ≡⟨ (fst inv-a) ⟩
|
||||||
AreInverses.recto-verso inv = begin
|
idFun A ∎
|
||||||
g ∘ obverse ∘ inverse ∘ g'
|
; snd = begin
|
||||||
≡⟨ cong (λ φ → φ ∘ g') (cong (λ φ → g ∘ φ) recto-verso) ⟩
|
(g ∘ f) ∘ (f~ ∘ g~) ≡⟨⟩
|
||||||
g ∘ idFun B ∘ g' ≡⟨⟩
|
g ∘ (f ∘ f~) ∘ g~ ≡⟨ cong (λ φ → g ∘ φ ∘ g~) (snd inv-a) ⟩
|
||||||
g ∘ g' ≡⟨ iso-g.recto-verso ⟩
|
g ∘ g~ ≡⟨ (snd inv-b) ⟩
|
||||||
idFun C ∎
|
idFun C ∎
|
||||||
|
|
||||||
compose : {ℓc : Level} {C : Set ℓc} → (B ≃ C) → A ≃ C
|
|
||||||
compose {C = C} e = A≃C.fromIsomorphism is
|
|
||||||
where
|
|
||||||
module B≃C = Equiv≃ B C
|
|
||||||
module A≃C = Equiv≃ A C
|
|
||||||
is : A ≅ C
|
|
||||||
is = composeIso (B≃C.toIsomorphism e)
|
|
||||||
|
|
||||||
symmetryIso : B ≅ A
|
|
||||||
symmetryIso
|
|
||||||
= inverse
|
|
||||||
, obverse
|
|
||||||
, record
|
|
||||||
{ verso-recto = recto-verso
|
|
||||||
; recto-verso = verso-recto
|
|
||||||
}
|
}
|
||||||
|
|
||||||
symmetry : B ≃ A
|
composeIsEquiv : isEquiv A B f → isEquiv B C g → isEquiv A C (g ∘ f)
|
||||||
symmetry = B≃A.fromIsomorphism symmetryIso
|
composeIsEquiv a b = fromIso A C (composeIsomorphism a' b')
|
||||||
where
|
where
|
||||||
module B≃A = Equiv≃ B A
|
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
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
||||||
open import Cubical.PathPrelude renaming (_≃_ to _≃η_)
|
-- Equivalence is equivalent to isomorphism when the domain and codomain of
|
||||||
open import Cubical.Univalence using (_≃_)
|
-- 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
|
||||||
|
|
||||||
doEta : A ≃ B → A ≃η B
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {P : A → Set ℓb} where
|
||||||
doEta (_≃_.con eqv isEqv) = eqv , isEqv
|
-- Equivalence of pairs whose first components are identitical can be obtained
|
||||||
|
-- from an equivalence of their seecond components.
|
||||||
deEta : A ≃η B → A ≃ B
|
equivSig : {ℓc : Level} {Q : A → Set ℓc}
|
||||||
deEta (eqv , isEqv) = _≃_.con eqv isEqv
|
→ ((a : A) → P a ≃ Q a) → Σ A P ≃ Σ A Q
|
||||||
|
equivSig {Q = Q} eA = res
|
||||||
module NoEta {ℓa ℓb : Level} {A : Set ℓa} {B : Set ℓb} where
|
where
|
||||||
open import Cubical.PathPrelude renaming (_≃_ to _≃η_)
|
P≅Q : ∀ {a} → P a ≅ Q a
|
||||||
open import Cubical.Univalence using (_≃_)
|
P≅Q {a} = toIsomorphism _ _ (eA a)
|
||||||
|
f : Σ A P → Σ A Q
|
||||||
module Equivalence′ (e : A ≃ B) where
|
f (a , pA) = a , fst P≅Q pA
|
||||||
open Equivalence (doEta e) hiding
|
g : Σ A Q → Σ A P
|
||||||
( toIsomorphism ; fromIsomorphism ; _~_
|
g (a , qA) = a , fst (snd P≅Q) qA
|
||||||
; compose ; symmetryIso ; symmetry ) public
|
ve-re : (x : Σ A P) → (g ∘ f) x ≡ x
|
||||||
|
ve-re (a , pA) i = a , eq i
|
||||||
compose : {ℓc : Level} {C : Set ℓc} → (B ≃ C) → A ≃ C
|
where
|
||||||
compose ee = deEta (Equivalence.compose (doEta e) (doEta ee))
|
eq : snd ((g ∘ f) (a , pA)) ≡ pA
|
||||||
|
eq = begin
|
||||||
symmetry : B ≃ A
|
snd ((g ∘ f) (a , pA)) ≡⟨⟩
|
||||||
symmetry = deEta (Equivalence.symmetry (doEta e))
|
snd (g (f (a , pA))) ≡⟨⟩
|
||||||
|
g' (fst (eA a) pA) ≡⟨ lem ⟩
|
||||||
-- fromIso : {f : A → B} → Isomorphism f → isEquiv f
|
pA ∎
|
||||||
-- fromIso = ?
|
where
|
||||||
|
open Σ (snd P≅Q) renaming (fst to g' ; snd to inv)
|
||||||
-- toIso : {f : A → B} → isEquiv f → Isomorphism f
|
-- anti-funExt
|
||||||
-- toIso = ?
|
lem : (g' ∘ (fst (eA a))) pA ≡ pA
|
||||||
|
lem = cong (_$ pA) (fst (snd (snd P≅Q)))
|
||||||
fromIsomorphism : A ≅ B → A ≃ B
|
re-ve : (x : Σ A Q) → (f ∘ g) x ≡ x
|
||||||
fromIsomorphism (f , iso) = _≃_.con f (Equiv≃.fromIso _ _ iso)
|
re-ve x i = fst x , eq i
|
||||||
|
where
|
||||||
toIsomorphism : A ≃ B → A ≅ B
|
open Σ x renaming (fst to a ; snd to qA)
|
||||||
toIsomorphism (_≃_.con f eqv) = f , Equiv≃.toIso _ _ eqv
|
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
|
||||||
|
|
|
||||||
|
|
@ -3,12 +3,16 @@ module Cat.Prelude where
|
||||||
|
|
||||||
open import Agda.Primitive public
|
open import Agda.Primitive public
|
||||||
-- FIXME Use:
|
-- FIXME Use:
|
||||||
-- open import Agda.Builtin.Sigma public
|
open import Agda.Builtin.Sigma public
|
||||||
-- Rather than
|
-- Rather than
|
||||||
open import Data.Product public
|
open import Data.Product public
|
||||||
renaming (∃! to ∃!≈)
|
renaming (∃! to ∃!≈)
|
||||||
|
using (_×_ ; Σ-syntax ; swap)
|
||||||
|
|
||||||
-- TODO Import Data.Function under appropriate names.
|
open import Function using (_∘_ ; _∘′_ ; _$_ ; case_of_ ; flip) public
|
||||||
|
|
||||||
|
idFun : ∀ {a} (A : Set a) → A → A
|
||||||
|
idFun A a = a
|
||||||
|
|
||||||
open import Cubical public
|
open import Cubical public
|
||||||
-- FIXME rename `gradLemma` to `fromIsomorphism` - perhaps just use wrapper
|
-- FIXME rename `gradLemma` to `fromIsomorphism` - perhaps just use wrapper
|
||||||
|
|
@ -17,18 +21,19 @@ open import Cubical.GradLemma
|
||||||
using (gradLemma)
|
using (gradLemma)
|
||||||
public
|
public
|
||||||
open import Cubical.NType
|
open import Cubical.NType
|
||||||
using (⟨-2⟩ ; ⟨-1⟩ ; ⟨0⟩ ; TLevel ; HasLevel)
|
using (⟨-2⟩ ; ⟨-1⟩ ; ⟨0⟩ ; TLevel ; HasLevel ; isGrpd)
|
||||||
public
|
public
|
||||||
open import Cubical.NType.Properties
|
open import Cubical.NType.Properties
|
||||||
using
|
using
|
||||||
( lemPropF ; lemSig ; lemSigP ; isSetIsProp
|
( lemPropF ; lemSig ; lemSigP ; isSetIsProp
|
||||||
; propPi ; propHasLevel ; setPi ; propSet)
|
; propPi ; propPiImpl ; propHasLevel ; setPi ; propSet
|
||||||
|
; propSig ; equivPreservesNType)
|
||||||
public
|
public
|
||||||
|
|
||||||
propIsContr : {ℓ : Level} → {A : Set ℓ} → isProp (isContr A)
|
propIsContr : {ℓ : Level} → {A : Set ℓ} → isProp (isContr A)
|
||||||
propIsContr = propHasLevel ⟨-2⟩
|
propIsContr = propHasLevel ⟨-2⟩
|
||||||
|
|
||||||
open import Cubical.Sigma using (setSig ; sigPresSet) public
|
open import Cubical.Sigma using (setSig ; sigPresSet ; sigPresNType) public
|
||||||
|
|
||||||
module _ (ℓ : Level) where
|
module _ (ℓ : Level) where
|
||||||
-- FIXME Ask if we can push upstream.
|
-- FIXME Ask if we can push upstream.
|
||||||
|
|
@ -46,20 +51,57 @@ module _ (ℓ : Level) where
|
||||||
-- * Utilities --
|
-- * Utilities --
|
||||||
-----------------
|
-----------------
|
||||||
|
|
||||||
-- | Unique existensials.
|
-- | Unique existentials.
|
||||||
∃! : ∀ {a b} {A : Set a}
|
∃! : ∀ {a b} {A : Set a}
|
||||||
→ (A → Set b) → Set (a ⊔ b)
|
→ (A → Set b) → Set (a ⊔ b)
|
||||||
∃! = ∃!≈ _≡_
|
∃! = ∃!≈ _≡_
|
||||||
|
|
||||||
∃!-syntax : ∀ {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 ∃!-syntax (λ x → B) = ∃![ x ] B
|
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}
|
module _ {ℓa ℓb : Level} {A : Set ℓa} {B : A → Set ℓb} {a b : Σ A B}
|
||||||
(proj₁≡ : (λ _ → A) [ proj₁ a ≡ proj₁ b ])
|
(fst≡ : (λ _ → A) [ fst a ≡ fst b ])
|
||||||
(proj₂≡ : (λ i → B (proj₁≡ i)) [ proj₂ a ≡ proj₂ b ]) where
|
(snd≡ : (λ i → B (fst≡ i)) [ snd a ≡ snd b ]) where
|
||||||
|
|
||||||
Σ≡ : a ≡ b
|
Σ≡ : a ≡ b
|
||||||
proj₁ (Σ≡ i) = proj₁≡ i
|
fst (Σ≡ i) = fst≡ i
|
||||||
proj₂ (Σ≡ i) = proj₂≡ 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)
|
||||||
|
|
|
||||||
|
|
@ -1,41 +0,0 @@
|
||||||
{-# OPTIONS --allow-unsolved-metas #-}
|
|
||||||
module Cat.Wishlist where
|
|
||||||
|
|
||||||
open import Level hiding (suc)
|
|
||||||
open import Cubical
|
|
||||||
open import Cubical.NType
|
|
||||||
open import Data.Nat using (_≤_ ; z≤n ; s≤s ; zero ; suc)
|
|
||||||
open import Agda.Builtin.Sigma
|
|
||||||
|
|
||||||
open import Cubical.NType.Properties
|
|
||||||
|
|
||||||
step : ∀ {ℓ} {A : Set ℓ} → isContr A → (x y : A) → isContr (x ≡ y)
|
|
||||||
step (a , contr) x y = {!p , c!}
|
|
||||||
-- where
|
|
||||||
-- p : x ≡ y
|
|
||||||
-- p = begin
|
|
||||||
-- x ≡⟨ sym (contr x) ⟩
|
|
||||||
-- a ≡⟨ contr y ⟩
|
|
||||||
-- y ∎
|
|
||||||
-- c : (q : x ≡ y) → p ≡ q
|
|
||||||
-- c q i j = contr (p {!!}) {!!}
|
|
||||||
|
|
||||||
-- Contractible types have any given homotopy level.
|
|
||||||
contrInitial : {ℓ : Level} {A : Set ℓ} → ∀ n → isContr A → HasLevel n A
|
|
||||||
contrInitial ⟨-2⟩ contr = contr
|
|
||||||
-- lem' (S ⟨-2⟩) (a , contr) = {!step!}
|
|
||||||
contrInitial (S ⟨-2⟩) (a , contr) x y = begin
|
|
||||||
x ≡⟨ sym (contr x) ⟩
|
|
||||||
a ≡⟨ contr y ⟩
|
|
||||||
y ∎
|
|
||||||
contrInitial (S (S n)) contr x y = {!lvl!} -- Why is this not well-founded?
|
|
||||||
where
|
|
||||||
c : isContr (x ≡ y)
|
|
||||||
c = step contr x y
|
|
||||||
lvl : HasLevel (S n) (x ≡ y)
|
|
||||||
lvl = contrInitial {A = x ≡ y} (S n) c
|
|
||||||
|
|
||||||
module _ {ℓ : Level} {A : Set ℓ} where
|
|
||||||
ntypeCommulative : ∀ {n m} → n ≤ m → HasLevel ⟨ n ⟩₋₂ A → HasLevel ⟨ m ⟩₋₂ A
|
|
||||||
ntypeCommulative {n = zero} {m} z≤n lvl = {!contrInitial ⟨ m ⟩₋₂ lvl!}
|
|
||||||
ntypeCommulative {n = .(suc _)} {.(suc _)} (s≤s x) lvl = {!!}
|
|
||||||
Loading…
Reference in a new issue