Definition of Category and internal category in coq - coq

I have a two-part question.
Goal: I want to define the notion of a category internal to a given category.
I came up with the following simple code, that however produces an inexplicable error message, namely:
File "./Category.v", line 5, characters 4-5:
Syntax error: '}' expected after [record_fields] (in [constructor_list_or_record_decl]).
Record Category :=
{ Ob : Type;
Hom : Ob -> Ob -> Type;
_o_ : forall {a b c}, Hom b c -> Hom a b -> Hom a c;
1 : forall {x}, Hom x x;
Assoc : forall a b c d (f : Hom c d) (g : Hom b c) (h : Hom a b),
f o (g o h) = (f o g) o h;
LeftId : forall a b (f : Hom a b), 1 o f = f;
RightId : forall a b (f : Hom a b), f o 1 = f;
Truncated : forall a b (f g : Hom a b) (p q : f = g), p = q }.
How to "internalize" this definition? Specifically, I want to define a category internal to the above specified type Category. This means a type "internal category" such that the objects are categories, i.e. belong to the above type Category and the arrows are morphisms of the type Category. All of this assuming the relevant pullbacks exist. If this is not clear, please refer to https://ncatlab.org/nlab/show/internal+category
My guess is that the best way to pull this off is to define the internal category as a Module inheriting from the above specified type Category. The aim is to ultimately get a hierarchy of structures internal to an "ambient category". So I ultimately want to go beyond just defining a category internal to another category, but other structures as well. Any pointers are appreciated.

You are not using Agda, so _o_ does not define an infix notation. Also, you cannot have a filed named 1 either. Again, you would have to rely on the notation system.
The following is accepted.
Record Category := {
Ob : Type ;
Hom : Ob -> Ob -> Type ;
comp : forall {a b c}, Hom b c -> Hom a b -> Hom a c ;
id : forall {x}, Hom x x ;
Assoc :
forall a b c d (f : Hom c d) (g : Hom b c) (h : Hom a b),
comp f (comp g h) = comp (comp f g) h ;
LeftId : forall a b (f : Hom a b), comp id f = f ;
RightId : forall a b (f : Hom a b), comp f id = f ;
Truncated : forall a b (f g : Hom a b) (p q : f = g), p = q
}.
Then you can use notations for composition and the unit:
Arguments comp {_ _ _ _} _ _.
Notation "f ∘ g" := (comp f g) (at level 20).
Arguments id {_ _}.
Notation "1" := (id).
Check Assoc.
(* Assoc
: forall (c : Category) (a b c0 d : Ob c) (f : Hom c c0 d)
(g : Hom c b c0) (h : Hom c a b), f ∘ (g ∘ h) = (f ∘ g) ∘ h *)
Check LeftId.
(* LeftId
: forall (c : Category) (a b : Ob c) (f : Hom c a b), 1 ∘ f = f *)

Since Théo already provided a great answer to your first question, I'll focus on the second one. In principle, you can define the concept of internal category simply by translating the textbook definition in Coq. We would begin by defining what it means for something to be a pullback:
Record is_pullback {C : Category}
{X Y Z : Ob C} (f : Hom C X Z) (g : Hom C Y Z) (P : Ob C) := {
proj1 : Hom C P X;
proj2 : Hom C P Y;
pair : forall W (a : Hom C W X) (b : Hom C W Y),
f \o a = g \o b -> Hom C W P;
(* ... plus axioms saying that pairing and projections are
inverses of each other *)
}.
Then, we would define a category with pullbacks as a category with a choice of pullbacks:
Record PBCategory := {
Cat :> Category;
pb : forall X Y Z (f : Hom C X Z) (g : Hom C Y Z), Ob Cat;
pb_is_pb : forall X Y Z f g, is_pullback f g (pb X Y Z f g);
}.
(The :> is a coercion declaration. It tells Coq that every category with pullbacks can be coerced into a category via Cat.)
Finally, we would write down the definition of an internal category:
Record IntCategory (C : PBCategory) := {
ArrOb : Ob C;
ObOb : Ob C;
source : Hom C ArrOb ObOb;
dest : Hom C ArrOb ObOb;
comp : Hom C (pb _ _ _ _ source dest) ArrOb;
(* + axioms *)
}.
At this point, however, I believe that we would hit a wall. Writing down the axioms for an internal category in diagrammatic language is too cumbersome. For instance, when phrasing the associativity axiom, we would have to explicitly reason about the isomorphism
(ArrOb x_ObOb ArrOb) x_ObOb ArrOb ~ ArrOb x_ObOb (ArrOb x_ObOb ArrOb)
which is almost always ignored in a textbook presentation. Alas, it is not possible to define an internal category as a particular instance or extension of your Category type.
It might be possible to circumvent this issue by working with indexed categories instead of an internal category, since every internal category gives rise to an indexed category via the Yoneda embedding. That is, we would formalize what it means for something to be a functor of type C^op -> Cat, and then we could define an internal category as being a representable indexed category. This might simplify the definition, but I am not it would be that much easier to work with...
Edit
Here is a potential encoding, though I don't know if this would suit your application or not: https://x80.org/collacoq/urunebifup.coq. The idea is to express composition not as an arrow whose domain is a pullback, but rather as an operation on arrows (more-or-less like what you would get with the Yoneda embedding).

Related

Defining functions inside proof scope

I'm trying to prove that injective functions are left invertible in Coq. I've reached a point in my proof where my goal is an "exists" proposition. I want to define a function that uses terms from proof scope (types and functions I've intro'ed before) and then show the function to the "exists" goal. Here's what I wrote so far:
(* function composition *)
Definition fun_comp {A B C: Type} (f:A -> B) (g:B -> C) : A -> C :=
fun a: A => g (f a).
Notation "g .o f" := (fun_comp f g) (at level 70).
Definition nonempty (A: Type) := exists a: A, a = a.
(* identity function for any given type *)
Definition fun_id (A: Type) := fun a: A => a.
(* left invertible *)
Definition l_invertible {A B: Type} (f: A -> B) :=
exists fl:B->A, fl .o f = fun_id A.
Definition injective {A B: Type} (f: A -> B) :=
forall a a': A, f a = f a' -> a = a'.
(* is a given element in a function's image? *)
Definition elem_in_fun_image {A B: Type} (b: B) (f: A -> B) :=
exists a: A, f a = b.
Theorem injective_is_l_invertible:
forall (A B: Type) (f: A -> B), nonempty A /\ injective f -> l_invertible f.
Proof.
intros A B f H.
destruct H as [Hnempty Hinj].
unfold l_invertible.
unfold nonempty in Hnempty.
destruct Hnempty as [a0].
(* here would go my function definition and invoking "exists myfun" *)
Here's the function I'm trying to define:
Definition fL (b: B) := if elem_in_fun_image b f
then f a
else a0.
Here's what the proof window looks like:
1 subgoal
A : Type
B : Type
f : A -> B
a0 : A
H : a0 = a0
Hinj : injective f
========================= (1 / 1)
exists fl : B -> A, (fl .o f) = fun_id A
How do I do this? I'm very new to Coq so other comments and pointers are welcome.
This definition cannot be performed in the basic logic. You need to add in a few extra axioms:
(* from Coq.Logic.FunctionalExtensionality *)
functional_extensionality : forall A B (f g : A -> B),
(forall x, f x = g x) -> f = g
(* from Coq.Logic.Classical *)
classic : forall P : Prop, P \/ ~ P
(* from Coq.Logic.ClassicalChoice *)
choice : forall (A B : Type) (R : A->B->Prop),
(forall x : A, exists y : B, R x y) ->
exists f : A->B, (forall x : A, R x (f x)).
The goal is to define a relation R that characterizes the left inverse that you want to construct. The existentially quantified f will then be the inverse! You will need the classic axiom to show the precondition of choice, and you will need functional extensionality to show the equation that you want. I'll leave it as an exercise to find out what R needs to be and how to complete the proof.
Your script should start with the following line.
Require Import ClassicalChoice FunctionalEquality.
Because, as suggested by #arthur-azevedo-de-amorim, you will need these axioms.
Then, you should use choice with the relation "R y x" being
"f x = A or there is no element in A such whose image by f is y".
You will need the axiom classic to prove the existential statement that is required by choice:
assert (pointwise : forall y: B, exists x : A,
f x = y \/ (forall x : A f x <> y)).
choice will give you an existential statement for a function that returns the value you want. You only need to say that this function is the right one. You can give a name to that function by typing destruct (choice ... pointwise) (you have to fill in the ...).
You will have to prove an equality between two functions, but using the axiom functional_extensionality, you can reduce this problem to just proving that the two functions are equal on any x.
For that x, just instantiate the characteristic property of the function (as produced by destruct (choice ... pointwise) with the
value f x. There is a disjuction, but the right-hand side case is self-contradictory, because obviously f x is f x for some x.
For the left-hand side case, you will get an hypothesis of the form (I name the function produced by (choice ... pointwise) with the name it:
f (it (f x)) = f x
Here you can apply your injectivity assumption. to deduce that it (f x) = x.
This pretty much spells out the proof. In my own, experiment, I used classic, NNP, not_all_ex_not, functional_extensionality, which are lemmas coming from ClassicalChoice of FunctionalEquality.

Proving theorems about inductive types using _ind; App rule

Variables A B : Prop.
Theorem proj1 : A /\ B -> A.
In order to learn, I'm trying to prove this theorem by explicitly writing down a proof term using and_ind.
I would assume the correct proof term is
fun (H : A /\ B) => and_ind A B A (fun a _ => a) H
But this raises an error, and instead the correct term is
fun (H : A /\ B) => and_ind (fun a _ => a) H
I don't understand this. The definition of and_ind is
and_ind =
fun (A B P : Prop) (f : A -> B -> P) (a : A /\ B) => match a with
| conj x x0 => f x x0
end
: forall A B P : Prop, (A -> B -> P) -> A /\ B -> P
How can I see from that that the parameters (A B P : Prop) have to be omitted?
The "App" rule
from the Reference Manual seems to state clearly that quantified variables have to be explicitly "instantiated" using the function application syntax that I tried.
In Coq, you can declare some arguments of a function as implicit. When you call the function, you don't supply values for the implicit arguments; Coq automatically tries to infer suitable values, based on other information available during type checking. The A, B and P arguments of and_ind are all declared as implicit, and can be inferred from the type of the H argument and the result type of the function argument.
You can see what arguments are considered implicit with the About command:
About and_ind.
(* and_ind : forall A B P : Prop, (A -> B -> P) -> A /\ B -> P *)
(* Arguments A, B, P are implicit *)
(* Argument scopes are [type_scope type_scope type_scope function_scope _] *)
(* and_ind is transparent *)
(* Expands to: Constant Coq.Init.Logic.and_ind *)
You can turn off implicit arguments with an individual call with an # sign:
Check fun A B H => #and_ind A B A (fun a _ => a) H.
(* fun (A B : Prop) (H : A /\ B) => and_ind (fun (a : A) (_ : B) => a) H *)
(* : forall A B : Prop, A /\ B -> A *)
(Notice that Coq automatically omits implicit arguments when printing a term as well.)
The Coq manual has more information on that subject.

How to write an Ltac to multiply both sides of a equation by a group element in Coq

Using this definition of a group:
Structure group :=
{
G :> Set;
id : G;
op : G -> G -> G;
inv : G -> G;
op_assoc_def : forall (x y z : G), op x (op y z) = op (op x y) z;
op_inv_l : forall (x : G), id = op (inv x) x;
op_id_l : forall (x : G), x = op id x
}.
(** Set implicit arguments *)
Arguments id {g}.
Arguments op {g} _ _.
Arguments inv {g} _.
Notation "x # y" := (op x y) (at level 50, left associativity).
And having proven this theorem:
Theorem mult_both_sides (G : group) : forall (a b c : G),
a = b <-> c # a = c # b.
How do I write an Ltac that automates the process of left multiplying a given equality (either the goal itself or a hypothesis) by a given term?
Ideally, using this Ltac in a proof would look like this:
left_mult (arbitrary expression).
left_mult (arbitrary expression) in (hypothesis).
Building on the answer given by larsr, you can use Tactic Notations to write
Tactic Notation "left_mult" uconstr(arbitrary_expression) :=
apply (mult_both_sides _ _ _ arbitrary_expression).
Tactic Notation "left_mult" uconstr(arbitrary_expression) "in" hyp(hypothesis) :=
apply (mult_both_sides _ _ _ arbitrary_expression) in hypothesis.
Using uconstr says "delay typechecking of this term until we plug it into apply". (Other options include constr ("typecheck this at the call site") and open_constr ("typecheck this at the call site and fill in holes with evars").)
Do you really need a specific tactic for this? If you just use apply to this
Goal forall (G:group) (a b c: G), a = b.
intros.
apply (mult_both_sides _ _ _ c).
Now your goal is
G0 : group
a, b, c : G0
============================
c # a = c # b
If you want to modify a hypothesis H, then just do apply ... in H.

Different induction principles for Prop and Type

I noticed that Coq synthesizes different induction principles on equality for Prop and Type. Does anybody have an explanation for that?
Equality is defined as
Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x
And the associated induction principle has the following type:
eq_ind
: forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, x = y -> P y
Now let's define a Type pendant of eq:
Inductive eqT {A:Type}(x:A):A->Type:= eqT_refl: eqT x x.
The automatically generated induction principle is
eqT_ind
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Prop),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
Note: I'm going to use _rect principles everywhere instead of _ind, since _ind principles are usually implemented via the _rect ones.
Type of eqT_rect
Let's take a look at the predicate P.
When dealing with inductive families, the number of arguments of P is equal to the number of non-parametric arguments (indices) + 1.
Let me give some examples (they can be easily skipped).
Natural numbers don't have parameters at all:
Inductive nat : Set := O : nat | S : nat -> nat.
So, the predicate P will be of type nat -> Type.
Lists have one parametric argument (A):
Inductive list (A : Type) : Type :=
nil : list A | cons : A -> list A -> list A.
Again, P has only one argument: P : list A -> Type.
Vectors are a different:
Inductive vec (A : Type) : nat -> Type :=
nil : vec A 0
| cons : A -> forall n : nat, vec A n -> vec A (S n).
P has 2 arguments, because n in vec A n is a non-parameteric argument:
P : forall n : nat, vec A n -> Type
The above explains eqT_rect (and, of course, eqT_ind as a consequence), since the argument after (x : A) is non-parametric, P has 2 arguments:
P : forall a : A, eqT x a -> Type
which justifies the overall type for eqT_rect:
eqT_rect
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Type),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
The induction principle obtained in this way is called a maximal induction principle.
Type of eq_rect
The generated induction principles for inductive predicates (such as eq) are simplified to express proof irrelevance (the term for this is simplified induction principle).
When defining a predicate P, Coq simply drops the last argument of the predicate (which is the type being defined, and it lives in Prop). That's why the predicate used in eq_rect is unary. This fact shapes the type of eq_rect:
eq_rect :
forall (A : Type) (x : A) (P : A -> Type),
P x -> forall y : A, x = y -> P y
How to generate maximal induction principle
We can also make Coq generate non-simplified induction principle for eq:
Scheme eq_rect_max := Induction for eq Sort Type.
The resulting type is
eq_rect_max :
forall (A : Type) (x : A) (P : forall a : A, x = a -> Type),
P x eq_refl -> forall (y : A) (e : x = y), P y e
and it has the same structure as eqT_rect.
References
For more detailed explanation see sect. 14.1.3 ... 14.1.6 of the book "Interactive Theorem Proving and Program Development (Coq'Art: The Calculus of Inductive Constructions)" by Bertot and Castéran (2004).

Type that contains all functions of N elements in Coq

I am learning Coq and as an exercise I want to define a type FnArity (N:nat) to encode all functions of N arguments. That is:
Check FnArity 3 : (forall A B C : Set, A -> B -> C).
Should work but
Check FnArity 2 : (forall A B C D : Set, A -> B -> C -> D).
Should not work.
This is for pedagogic purposes so any relevant resources are welcome.
EDIT: From the answers so far I realize I am probably approaching this wrong so here is the proposition I am trying to prove:
Composing N composition operators is equivalent to a composition operator that composes f and g where g expects N arguments. In haskell-ish terms:
(.).(.) ... N times ... (.).(.) f g = \a1, .. aN -> f (g (a1, .. , aN))
EDIT2: In coq terms:
Definition compose { A B C : Type } (F : C -> B) (G : A -> C ) : A -> B :=
fun x => F ( G (x) ).
Definition compose2 {A1 A2 B C : Type} (F : C -> B) (G : A1 -> A2 -> C)
: A1 -> A2 -> B := fun x y => F ( G x y ).
Definition compose3 {A1 A2 A3 B C : Type} (F : C -> B) (G : A1 -> A2 -> A3 -> C)
: A1 -> A2 -> A3 -> B := fun x y z => F ( G x y z ).
(* The simplest case *)
Theorem dual_compose : forall {A B C D : Type} (f: D -> C) (g : A -> B -> D) ,
(compose compose compose) f g = compose2 f g.
Proof. reflexivity. Qed.
Theorem triple_compose : forall {A1 A2 A3 B C : Type} (f: C -> B) (g : A1 -> A2 -> A3 -> C) ,
(compose (compose (compose) compose) compose) f g =
compose3 f g.
What I want is to define the generalized theorem for composeN.
The types that you wrote down do not quite represent what you stated in your problem: forall A B C, A -> B -> C is not the type of all functions of three arguments, but the type of certain polymorphic functions of two arguments. You probably meant to write something like { A & { B & { C & A -> B -> C }}} instead, where A, B and C are existentially quantified. You probably also meant to say Compute (FnArity 3) instead of using the Check command, since the latter is the one that evaluates a term (and, as jbapple pointed out, no term can have the type that you had originally written).
Here's a piece of code that does what you want, I think. We start by writing a function FnArityAux1 : list Type -> Type -> Type, that computes a function type with arguments given on a list:
Fixpoint FnArityAux1 (args : list Type) (res : Type) : Type :=
match args with
| [] => res
| T :: args' => T -> FnArityAux1 args' res
end.
For instance, FnArityAux1 [nat; bool] bool evaluates to nat -> bool -> bool. We can then use this function to define FnArity as follows:
Fixpoint FnArityAux2 (args : list Type) (n : nat) : Type :=
match n with
| 0 => { T : Type & FnArityAux1 args T }
| S n' => { T : Type & FnArityAux2 (args ++ [T]) n' }
end.
Definition FnArity n := FnArityAux2 [] n.
In this definition, we use another auxiliary function FnArityAux2 that has an argument args whose purpose is to carry around all the existentially quantified types produced so far. For each "iteration step", it quantifies over another type T, adds that type to the list of arguments, and recurses. When the recursion is over, we use FnArityAux1 to combine all accumulated types into a single function type. Then, we can define FnArity simply by starting the process with an empty list -- that is, no quantified types at all.
No, this is not possible, since (forall A B C : Set, A -> B -> C) is uninhabited.
Goal (forall A B C : Set, A -> B -> C) -> False.
intros f.
specialize (f True True False).
apply f; trivial.
Qed.
As such, Check FnArity 3 : (forall A B C : Set, A -> B -> C). can never work.