Proving isomorphism between Martin-Lof's equality and Path Induction in Coq - equality

I am studying Coq and trying to prove the isomorphism between Martin-Lof's equality and the Path Induction's one.
I defined the two equalities as follows.
Module MartinLof.
Axiom eq : forall A, A -> A -> Prop.
Axiom refl : forall A, forall x : A, eq A x x.
Axiom el : forall (A : Type) (C : forall x y : A, eq A x y -> Prop),
(forall x : A, C x x (refl A x)) ->
forall a b : A, forall p : eq A a b, C a b p.
End MartinLof.
Module PathInduction.
Axiom eq : forall A, A -> A -> Prop.
Axiom refl : forall A, forall x : A, eq A x x.
Axiom el : forall (A : Type) (x : A) (P : forall a : A, eq A x a -> Prop),
P x (refl A x) -> forall y : A, forall p : eq A x y, P y p.
End PathInduction.
And I defined the two functions involved in the isomorphism as follows.
Definition f {A} : forall x y: A, forall m: MartinLof.eq A x y, PathInduction.eq A x y.
Proof.
apply: (MartinLof.el A (fun a b p => PathInduction.eq A a b) _ x y m).
move=> x0.
exact: PathInduction.refl A x0.
Defined.
Definition g {A} : forall x y: A, forall p: PathInduction.eq A x y, MartinLof.eq A x y.
Proof.
apply: (PathInduction.el A x (fun a p => MartinLof.eq A x a) _ y p).
exact: MartinLof.refl A x.
Defined.
Now I am trying to define the following proof-terms, but I cannot move from the initial statement because I actually don't know what tactic to apply.
Definition pf1 {A}: forall x y: A, forall m: MartinLof.eq A x y,
eq m (g x y (f x y m)).
Definition pf2 {A} : forall x y: A, forall p: PathInduction.eq A x y,
eq p (f x y (g x y p)).
I through I could simplify the expression
(g x y (f x y m))
but I don't know how to do that. Does anyone know how I can go on on this proof?
Thanks in advance.

The problem is that your definition of the identity types is incomplete, because it does not specify how el interacts with refl. Here is a complete solution.
From mathcomp Require Import ssreflect.
Module MartinLof.
Axiom eq : forall A, A -> A -> Prop.
Axiom refl : forall A, forall x : A, eq A x x.
Axiom el : forall (A : Type) (C : forall x y : A, eq A x y -> Prop),
(forall x : A, C x x (refl A x)) ->
forall a b : A, forall p : eq A a b, C a b p.
Axiom el_refl : forall (A : Type) (C : forall x y : A, eq A x y -> Prop)
(CR : forall x : A, C x x (refl A x)),
forall x : A, el A C CR x x (refl A x) = CR x.
End MartinLof.
Module PathInduction.
Axiom eq : forall A, A -> A -> Prop.
Axiom refl : forall A, forall x : A, eq A x x.
Axiom el : forall (A : Type) (x : A) (P : forall a : A, eq A x a -> Prop),
P x (refl A x) -> forall y : A, forall p : eq A x y, P y p.
Axiom el_refl : forall (A : Type) (x : A) (P : forall y : A, eq A x y -> Prop)
(PR : P x (refl A x)),
el A x P PR x (refl A x) = PR.
End PathInduction.
Definition f {A} (x y: A) (m: MartinLof.eq A x y) : PathInduction.eq A x y.
Proof.
apply: (MartinLof.el A (fun a b p => PathInduction.eq A a b) _ x y m).
move=> x0.
exact: PathInduction.refl A x0.
Defined.
Definition g {A} (x y: A) (p: PathInduction.eq A x y) : MartinLof.eq A x y.
Proof.
apply: (PathInduction.el A x (fun a p => MartinLof.eq A x a) _ y p).
exact: MartinLof.refl A x.
Defined.
Definition pf1 {A} (x y: A) (m: MartinLof.eq A x y) : eq m (g x y (f x y m)).
Proof.
apply: (MartinLof.el A (fun x y p => p = g x y (f x y p))) => x0.
by rewrite /f MartinLof.el_refl /g PathInduction.el_refl.
Qed.
Definition pf2 {A} (x y: A) (m: PathInduction.eq A x y) : eq m (f x y (g x y m)).
Proof.
apply: (PathInduction.el A x (fun y p => p = f x y (g x y p))).
by rewrite /f /g PathInduction.el_refl MartinLof.el_refl.
Qed.
Alternatively, you could have just defined the two identity types as Coq inductive types, which would have given you the same principles without the need to state separate axioms; Coq's computation behavior already yields the equations you need. I have used pattern-matching syntax, but similar definitions are possible using the standard combinators eq1_rect and eq2_rect.
Inductive eq1 (A : Type) (x : A) : A -> Type :=
| eq1_refl : eq1 A x x.
Inductive eq2 (A : Type) : A -> A -> Type :=
| eq2_refl x : eq2 A x x.
Definition f {A} {x y : A} (p : eq1 A x y) : eq2 A x y :=
match p with eq1_refl _ _ => eq2_refl A x end.
Definition g {A} {x y : A} (p : eq2 A x y) : eq1 A x y :=
match p with eq2_refl _ z => eq1_refl A z end.
Definition fg {A} (x y : A) (p : eq2 A x y) : f (g p) = p :=
match p with eq2_refl _ _ => eq_refl end.
Definition gf {A} (x y : A) (p : eq1 A x y) : g (f p) = p :=
match p with eq1_refl _ _ => eq_refl end.
Although not immediately clear, eq1 corresponds to your PathInduction.eq, and eq2 corresponds to your MartinLof.eq. You can check this by asking Coq to print the types of their recursion principles:
Check eq1_rect.
Check eq2_rect.
You may notice that I have defined the two in Type instead of Prop. I just did this to make the recursion principles generated by Coq closer to the ones you had; by default, Coq uses simpler recursion principles for things defined in Prop (though that behavior can be changed with a few commands).

Related

Applying known proofs in Idris 1 interactive elaborator

I am trying to get some familiarity with theorem proving in Idris1 by exercise and am running into trouble.
Suppose I have the following definition for naturals and the following theorems that I want to prove:
data Natural = Z | S Natural
plus : Natural -> Natural -> Natural
plus x Z = x
plus x (S y) = S (plus x y)
succBoth : {a : Natural} -> {b : Natural} -> (a = b) -> (S a = S b)
succBoth = ?succBothProof
plusZero : (y : Natural) -> plus Z y = y
plusZero = ?plusZeroProof
plusSwitch : (x : Natural) -> (y : Natural) -> plus (S x) y = S (plus x y)
plusSwitch = ?plusSwitchProof
plusComm : (x : Natural) -> (y : Natural) -> plus x y = plus y x
plusComm = ?plusCommProof
I already have written proofs for the first three. Now, when I want to prove the last theorem, I run into necessity of applying an earlier proof.
Idris> :l Peano.idr
Holes: Peano.plusCommProof
*Peano> :elab plusCommProof
-Peano.plusCommProof> intro `{{x}}
...
-Peano.plusCommProof> intro `{{y}}
...
-Peano.plusCommProof> induction (Var `{{y}})
...
-Peano.plusCommProof> compute
...
-Peano.plusCommProof> attack
---------- Other goals: ----------
{Z_103},{S_104}
---------- Assumptions: ----------
x : Natural
y : Natural
---------- Goal: ----------
{hole_7} : x = plus Z x
It would be natural to apply plusZero at this stage, but I run into issues trying to do that. I try to apply it via rewriteWith, keeping in mind that plusZero takes a Natural type argument. I try to supply it with the x variable, thinking that it will be able to infer its Natural type from assumptions, but no luck:
-Peano.plusCommProof> rewriteWith `(plusZero (Var `{{x}}))
(input):1:15-35:When checking argument y to function Peano.plusZero:
Type mismatch between
Raw (Type of Var _)
and
Natural (Expected type)
How does one "cast" the Raw variable into its type in context?
I couldn't get the Idris 1 version to work but I did install Idris 2 and wrote the proofs in its style instead.
module Peano
data Natural = Zero | Succ Natural
plus : Natural -> Natural -> Natural
plus x Zero = x
plus x (Succ y) = Succ (plus x y)
succBoth : {a : Natural} -> {b : Natural} -> (a = b) -> (Succ a = Succ b)
succBoth rfl = cong (\ a => Succ a) rfl
plusZero : (y : Natural) -> plus Zero y = y
plusZero Zero = Refl
plusZero (Succ y)
= let assumption = plusZero y in
rewrite assumption in Refl
plusSwitch : (x : Natural) -> (y : Natural) ->
plus (Succ x) y = Succ (plus x y)
plusSwitch x Zero = Refl
plusSwitch x (Succ y)
= let assumption = plusSwitch x y in
rewrite assumption in Refl
plusComm : (x : Natural) -> (y : Natural) -> plus x y = plus y x
plusComm x Zero = rewrite plusZero x in Refl
plusComm x (Succ y)
= let assumption = plusComm x y in
rewrite plusSwitch y x in
rewrite assumption in Refl
Admittedly much more compact but I prefer the Idris 1 :elab style for readability

Compiler introducing extra interface requirements when using functions returning dependent pairs

This is rather complicated. Sorry I could'n make the example simpler. I'm trying to formalize a theory and interfaces A and B represent my axioms. X and Y are some objects in the theory, mkY creates a Y from two Xs and PropA, PropY and PropYY are some statements about these objects:
interface A a where
PropA : a -> Type
interface B where
X : Type
Y : Type
PropY : Y -> Type
mkY : A X => (x, y : X) -> (z : Y ** PropY z)
PropYY : Y -> Type
mkPropY : A X => {x : X} -> {y : Y} -> PropA x -> PropY y -> PropYY y
lemma1 : (B, A X) => (x, y : X) -> PropA x -> (z : Y ** PropYY z)
lemma1 x y prop_a =
let (z ** propZ) = mkY x y in
(z ** mkPropY prop_a propZ)
Unfortunately rather obvious lemma1 does not compile:
When checking right hand side of Example.case block in lemma1 at /home/sven/code/idris/geometry/src/Euclid/Example.idr:17:9-20 with expected type
(z1 : Y ** PropYY z1)
When checking an application of function Example.mkPropY:
Type mismatch between
PropA x1 (Type of prop_a)
and
PropA x (Expected type)
It seems to me Idris refuses to unify requirement A X from the function header with that introduced by mkY function. When I replace mkPropY prop_a propZ with a hole and ask for its type, I get this:
constraint : B
z : Y
propZ : PropY z
x : X
y : X
constraint1 : A X
prop_a : PropA x
constraint2 : A X
--------------------------------------
whatIsIt : PropYY z
Here constraint1 and constraint2 are the same, and yet there's two of them, which seems to be the root cause of the problem. So why does Idris introduce this additional constraint and how do I make it work?
I'm not sure why Idris thinks with mkY there could be another constraint in play (as by the looks of it nothing in the hole is constrained by it, even with :set showimplicits). Maybe someone else can explain why, but for now it usually helps to make constraints explicit:
lemma1 : (B, a_const : A X) => (x, y : X) -> PropA x -> (z : Y ** PropYY z)
lemma1 #{a_const} x y prop_a =
let (z ** propZ) = mkY #{a_const} x y in
(z ** mkPropY prop_a propZ)
(Maybe rewriting B as interface B x y where; … would help, so the scope over X and Y is clearer, but I didn't try this.)

Problems with equational proofs and interface resolution in Idris

I'm trying to model Agda style equational reasoning proofs for Setoids (types with an equivalence relation). My setup is as follows:
infix 1 :=:
interface Equality a where
(:=:) : a -> a -> Type
interface Equality a => VerifiedEquality a where
eqRefl : {x : a} -> x :=: x
eqSym : {x, y : a} -> x :=: y -> y :=: x
eqTran : {x, y, z : a} -> x :=: y -> y :=: z -> x :=: z
Using such interfaces I could model some equational reasoning combinators like
Syntax.PreorderReasoning from Idris library.
syntax [expr] "QED" = qed expr
syntax [from] "={" [prf] "}=" [to] = step from prf to
namespace EqReasoning
using (a : Type, x : a, y : a, z : a)
qed : VerifiedEquality a => (x : a) -> x :=: x
qed x = eqRefl {x = x}
step : VerifiedEquality a => (x : a) -> x :=: y -> (y :=: z) -> x :=: z
step x prf prf1 = eqTran {x = x} prf prf1
The main difference from Idris library is just the replacement of propositional equality and their related functions to use the ones from VerifiedEquality interface.
So far, so good. But when I try to use such combinators, I run in problems that, I believe, are related to interface resolution. Since the code is part of a matrix library that I'm working on, I posted the relevant part of it in the following gist.
The error occurs in the following proof
zeroMatAddRight : ( VerifiedSemiring s
, VerifiedEquality s ) =>
{r, c : Shape} ->
(m : M s r c) ->
(m :+: (zeroMat r c)) :=: m
zeroMatAddRight {r = r}{c = c} m
= m :+: (zeroMat r c)
={ addMatComm {r = r}{c = c} m (zeroMat r c) }=
(zeroMat r c) :+: m
={ zeroMatAddLeft {r = r}{c = c} m }=
m
QED
that returns the following error message:
When checking right hand side of zeroMatAddRight with expected type
m :+: (zeroMat r c) :=: m
Can't find implementation for Semiring a
Possible cause:
./Data/Matrix/Operations/Addition.idr:112:11-118:1:When checking an application of function Algebra.Equality.EqReasoning.step:
Type mismatch between
m :=: m (Type of qed m)
and
y :=: z (Expected type)
At least to me, it appears that this error is related with interface resolution that isn't interacting well with syntax extensions.
My experience is that such strange errors can be solved by passing implicit parameters explicitly. The problem is that such solution will kill the "readability" of equational reasoning combinator proofs.
Is there a way to solve this? The relevant part for reproducing this error is available in previously linked gist.

List Equality w/ `cong`

Following my other question, I tried to implement the actual exercise in Type-Driven Development with Idris for same_cons to prove that, given two equal lists, prepending the same element to each list results in two equal lists.
Example:
prove that 1 :: [1,2,3] == 1 :: [1,2,3]
So I came up with the following code that compiles:
sameS : {xs : List a} -> {ys : List a} -> (x: a) -> xs = ys -> x :: xs = x :: ys
sameS {xs} {ys} x prf = cong prf
same_cons : {xs : List a} -> {ys : List a} -> xs = ys -> x :: xs = x :: ys
same_cons prf = sameS _ prf
I can call it via:
> same_cons {x=5} {xs = [1,2,3]} {ys = [1,2,3]} Refl
Refl : [5, 1, 2, 3] = [5, 1, 2, 3]
Regarding the cong function, my understanding is that it takes a proof, i.e. a = b, but I don't understand its second argument: f a.
> :t cong
cong : (a = b) -> f a = f b
Please explain.
If you have two values u : c and v : c, and a function f : c -> d, then if you know that u = v, it has to follow that f u = f v, following simply from referential transparency.
cong is the proof of the above statement.
In this particular use case, you are setting (via unification) c and d to List a, u to xs, v to ys, and f to (:) x, since you want to prove that xs = ys -> (:) x xs = (:) x ys.

refl in agda : explaining congruence property

With the following definition of equality, we have refl as constructor
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
and we can prove that function are congruent on equality
cong : ∀ { a b} { A : Set a } { B : Set b }
(f : A → B ) {m n} → m ≡ n → f m ≡ f n
cong f refl = refl
I am not sure I can parse what is going on exactly here.
I think we are pattern matching refl on hidden parameters : if we replace the first occurence by refl by another identifier, we get a type error.
after pattern matching, I imagine that m and n are the same by the definition of refl. then magic occurs (a definition of functionality of a relation is applied ? or is it build in ?)
Is there an intuitive description on what is going on ?
Yes, the arguments in curly braces {} are implicit and they only need to be supplied or matched if agda cannot figure them out. It is necessary to specify them, since dependent types needs to refer to the values they depend on, but dragging them around all the time would make the code rather clunky.
The expression cong f refl = refl matches the explicit arguments (A → B) and (m ≡ n). If you wanted to match the implicit arguments, you'd need to put the matching expression in {}, but here there is no need for that. Then on the right hand side it is indeed the construction of (f m ≡ f n) using refl, and it works "by magic". Agda has a built-in axiom that proves this to be true. That axiom is similar (but stronger than) J-axiom - the induction axiom: if something C : (x y : A) → (x ≡ y) → Set is true for C x x refl, then it is also true for any x y : A and p : x ≡ y.
J : forall {A : Set} {C : (x y : A) → (x ≡ y) → Set} →
(c : ∀ x → C x x refl) →
(x y : A) → (p : x ≡ y) → C x y p
-- this really is an axiom, but in Agda there is a stronger built-in,
-- which can be used to prove this
J c x .x refl = c x -- this _looks_ to only mean x ≡ x
-- but Agda's built-in extends this proof to all cases
-- for which x ≡ y can be constructed - that's the point
-- of having induction
cong : ∀ { a b} { A : Set a } { B : Set b }
(f : A → B ) {m n} → m ≡ n → f m ≡ f n
cong f {x} {y} p = J {C = \x y p → f x ≡ f y} -- the type of equality
-- of function results
(\_ → refl) -- f x ≡ f x is true indeed
x y p
(In this last line we: match explicit arguments f and p, and also the implicit arguments m=x and n=y. Then we pass to J one implicit argument, but it is not the first positional implicit, so we tell agda that it is C in the definition - without doing that, Agda won't see what type is meant by refl in \_ → refl)