Applying a Program Definition fails with "unable to unify Prop with [goal]" - coq

In Coq, I showed the associativity of append on vectors using:
Require Import Coq.Vectors.VectorDef Omega.
Program Definition t_app_assoc v p q r (a : t v p) (b : t v q) (c : t v r) :=
append (append a b) c = append a (append b c).
Next Obligation. omega. Qed.
I now want to apply this equality in a proof. Below is the easiest goal that I would expect to be provable with t_app_assoc. Of course it can be proven by simpl - this is just an example.
Goal (append (append (nil nat) (nil _)) (nil _)
= append (nil _) (append (nil _) (nil _))).
apply t_app_assoc.
This apply fails with:
Error: Unable to unify "Prop" with
"append (append (nil nat) (nil nat)) (nil nat) =
append (nil nat) (append (nil nat) (nil nat))".
How can I apply t_app_assoc? Or is there a better way to define it? I thought I needed a Program Definition, because simply using a Lemma leads to a type error because t v (p + (q + r)) and t v (p + q + r) are not the same to Coq.

Prologue
I guess what you want to to is to prove that the vector concatenation is associative and then use that fact as a lemma.
But t_app_assoc as you define it has the following type:
t_app_assoc
: forall (v : Type) (p q r : nat), t v p -> t v q -> t v r -> Prop
You basically want to use : instead of := as follows.
From Coq Require Import Vector Arith.
Import VectorNotations.
Import EqNotations. (* rew notation, see below *)
Section Append.
Variable A : Type.
Variable p q r : nat.
Variables (a : t A p) (b : t A q) (c : t A r).
Fail Lemma t_app_assoc :
append (append a b) c = append a (append b c).
Unfortunately, we cannot even state a lemma like this using the usual homogeneous equality.
The left-hand side has the following type:
Check append (append a b) c : t A (p + q + r).
whereas the right-hand side is of type
Check append a (append b c) : t A (p + (q + r)).
Since t A (p + q + r) is not the same as t A (p + (q + r)) we cannot use = to state the above lemma.
Let me describe some ways of working around this issue:
rew notation
Lemma t_app_assoc_rew :
append (append a b) c = rew (plus_assoc _ _ _) in
append a (append b c).
Admitted.
Here we just use the law of associativity of addition for natural numbers to cast the type of RHS to t A (p + q + r).
To make it work one needs to Import EqNotations. before.
cast function
This is a common problem, so the authors of the Vector library decided to provide a cast function with the following type:
cast :
forall (A : Type) (m : nat),
Vector.t A m -> forall n : nat, m = n -> Vector.t A n
Let me show how one can use it to prove the law of associativity for vectors. But let's prove the following auxiliary lemma first:
Lemma uncast {X n} {v : Vector.t X n} e :
cast v e = v.
Proof. induction v as [|??? IH]; simpl; rewrite ?IH; reflexivity. Qed.
Now we are all set:
Lemma t_app_assoc_cast (a : t A p) (b : t A q) (c : t A r) :
append (append a b) c = cast (append a (append b c)) (plus_assoc _ _ _).
Proof.
generalize (Nat.add_assoc p q r).
induction a as [|h p' a' IH]; intros e.
- now rewrite uncast.
- simpl; f_equal. apply IH.
Qed.
Heterogeneous equality (a.k.a. John Major equality)
Lemma t_app_assoc_jmeq :
append (append a b) c ~= append a (append b c).
Admitted.
End Append.
If you compare the definition of the homogeneous equality
Inductive eq (A : Type) (x : A) : A -> Prop :=
eq_refl : x = x.
and the definition of heterogeneous equality
Inductive JMeq (A : Type) (x : A) : forall B : Type, B -> Prop :=
JMeq_refl : x ~= x.
you will see that with JMeq the LHS and RHS don't have to be of the same type and this is why the statement of t_app_assoc_jmeq looks a bit simpler than the previous ones.
Other approaches to vectors
See e.g. this question
and this one;
I also find this answer
very useful too.

Related

How to do induction on the end of a list in Coq

In the standart way I have induction for list like this
Approval is performed for lst
Proving for x::lst
But I want:
Approval is performed for lst
Proving for lst ++ x::nil
For me, the place of x in the list is important.
I tried to write something like this, but not successful.
In such case, you need to prove your own induction principle. But here you're lucky because what you need is already in the standard library of Coq:
Require Import List.
Check rev_ind.
(*
rev_ind
: forall (A : Type) (P : list A -> Prop),
P nil ->
(forall (x : A) (l : list A), P l -> P (l ++ x :: nil)) ->
forall l : list A, P l
*)

coq induction with passing in equality

I have a list with a known value and want to induct on it, keeping track of what the original list was, and referring to it by element. That is, I need to refer to it by l[i] with varying i instead of just having (a :: l).
I tried to make an induction principle to allow me to do that. Here is a program with all of the unnecessary Theorems replaced with Admitted, using a simplified example. The objective is to prove allLE_countDown using countDown_nth, and have list_nth_rect in a convenient form. (The theorem is easy to prove directly without any of those.)
Require Import Arith.
Require Import List.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Admitted.
Definition allLE := fix f l m := match l with
| nil => true
| a :: l0 => if Nat.leb a m then f l0 m else false
end.
Definition drop {A} := fix f (l : list A) n := match n with
| 0 => l
| S a => match l with
| nil => nil
| _ :: l2 => f l2 a
end
end.
Theorem list_nth_rect_aux {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s i (size : length l = i + length s) (sub : s = drop l i) : P l s i.
Admitted.
Theorem list_nth_rect {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s (leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as l.
refine (list_nth_rect (fun l s _ => l = countDown a b -> allLE s a = true) _ _ l l eq_refl Heql);
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H0.
apply leb_correct in H0.
simpl; rewrite H0; clear H0.
apply (H eq_refl).
Qed.
So, I have list_nth_rect and was able to use it with refine to prove the theorem by referring to the nth element, as desired. However, I had to construct the Proposition P myself. Normally, you'd like to use induction.
This requires distinguishing which elements are the original list l vs. the sublist s that is inducted on. So, I can use remember.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
This puts me at
a, b : nat
s, l : list nat
Heql : l = s
Heqs : l = countDown a b
============================
allLE s a = true
However, I can't seem to pass the equality as I just did above. When I try
induction l, s, Heql using list_nth_rect.
I get the error
Error: Abstracting over the terms "l", "s" and "0" leads to a term
fun (l0 : list ?X133#{__:=a; __:=b; __:=s; __:=l; __:=Heql; __:=Heqs})
(s0 : list ?X133#{__:=a; __:=b; __:=s; __:=l0; __:=Heql; __:=Heqs})
(_ : nat) =>
(fun (l1 l2 : list nat) (_ : l1 = l2) =>
l1 = countDown a b -> allLE l2 a = true) l0 s0 Heql
which is ill-typed.
Reason is: Illegal application:
The term
"fun (l l0 : list nat) (_ : l = l0) =>
l = countDown a b -> allLE l0 a = true" of type
"forall l l0 : list nat, l = l0 -> Prop"
cannot be applied to the terms
"l0" : "list nat"
"s0" : "list nat"
"Heql" : "l = s"
The 3rd term has type "l = s" which should be coercible to
"l0 = s0".
So, how can I change the induction principle
such that it works with the induction tactic?
It looks like it's getting confused between
the outer variables and the ones inside the
function. But, I don't have a way to talk
about the inner variables that aren't in scope.
It's very strange, since invoking it with
refine works without issues.
I know for match, there's as clauses, but
I can't figure out how to apply that here.
Or, is there a way to make list_nth_rect use
P l l 0 and still indicate which variables correspond to l and s?
First, you can prove this result much more easily by reusing more basic ones. Here's a version based on definitions of the ssreflect library:
From mathcomp
Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Definition countDown n m := rev (iota m (n - m)).
Lemma allLE_countDown n m : all (fun k => k <= n) (countDown n m).
Proof.
rewrite /countDown all_rev; apply/allP=> k; rewrite mem_iota.
have [mn|/ltnW] := leqP m n.
by rewrite subnKC //; case/andP => _; apply/leqW.
by rewrite -subn_eq0 => /eqP ->; rewrite addn0 ltnNge andbN.
Qed.
Here, iota n m is the list of m elements that counts starting from n, and all is a generic version of your allLE. Similar functions and results exist in the standard library.
Back to your original question, it is true that sometimes we need to induct on a list while remembering the entire list we started with. I don't know if there is a way to get what you want with the standard induction tactic; I didn't even know that it had a multi-argument variant. When I want to prove P l using this strategy, I usually proceed as follows:
Find a predicate Q : nat -> Prop such that Q (length l) implies P l. Typically, Q n will have the form n <= length l -> R (take n l) (drop n l), where R : list A -> list A -> Prop.
Prove Q n for all n by induction.
I do not know if this answers your question, but induction seems to accept with clauses. Thus, you can write the following.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction l, s, Heql using list_nth_rect
with (P:=fun l s _ => l = countDown a b -> allLE s a = true).
But the benefit is quite limited w.r.t. the refine version, since you need to specify manually the predicate.
Now, here is how I would have proved such a result using objects from the standard library.
Require Import List. Import ListNotations.
Require Import Omega.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown1_nth a i k d (boundi : k < i) :
nth k (countDown1 a i) d = a + i -k - 1.
Proof.
revert k boundi.
induction i; intros.
- inversion boundi.
- simpl. destruct k.
+ omega.
+ rewrite IHi; omega.
Qed.
Lemma countDown1_length a i : length (countDown1 a i) = i.
Proof.
induction i.
- reflexivity.
- simpl. rewrite IHi. reflexivity.
Qed.
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Proof.
unfold countDown in *.
rewrite countDown1_length in boundi.
rewrite countDown1_nth.
replace (b+(a-b)) with a by omega. reflexivity. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_forall. intros.
apply In_nth with (d:=0) in H.
destruct H as (n & H & H0).
rewrite countDown_nth in H0 by assumption. omega.
Qed.
EDIT:
You can state an helper lemma to make an even more concise proof.
Lemma Forall_nth : forall {A} (P:A->Prop) l,
(forall d i, i < length l -> P (nth i l d)) ->
Forall P l.
Proof.
intros. apply Forall_forall.
intros. apply In_nth with (d:=x) in H0.
destruct H0 as (n & H0 & H1).
rewrite <- H1. apply H. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_nth.
intros. rewrite countDown_nth. omega. assumption.
Qed.
The issue is that, for better or for worse, induction seems to assume that its arguments are independent. The solution, then, is to let induction automatically infer l and s from Heql:
Theorem list_nth_rect {A : Type} {l s : list A} (P : list A -> list A -> nat -> Type)
(Pnil : P l nil (length l))
(Pcons : forall i s d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
(leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction Heql using list_nth_rect;
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H.
apply leb_correct in H.
simpl; rewrite H; clear H.
assumption.
Qed.
I had to change around the type of list_nth_rect a bit; I hope I haven't made it false.

Folding back after unfolding

I have fold_length defined like this:
Inductive list (X: Type) : Type :=
| nil : list X
| cons : X -> list X -> list X.
Arguments nil {X}.
Arguments cons {X} _ _.
Notation "x :: y" := (cons x y)
(at level 60, right associativity).
Notation "[ ]" := nil.
Fixpoint fold {X Y:Type} (f: X -> Y -> Y) (l:list X) (b:Y) : Y :=
match l with
| nil => b
| h :: t => f h (fold f t b)
end.
Definition fold_length {X : Type} (l : list X) : nat :=
fold (fun _ n => S n) l 0.
I have to prove a theorem and this is my code so far:
Theorem fold_length_correct : forall X (l : list X),
fold_length l = length l.
Proof.
intros X l.
induction l as [| n l' IHl'].
- simpl.
unfold fold_length.
simpl.
reflexivity.
- simpl.
unfold fold_length.
simpl.
Right now, my goal looks like this:
X : Type
n : X
l' : list X
IHl' : fold_length l' = length l'
============================
S (fold (fun (_ : X) (n0 : nat) => S n0) l' 0) = S (length l')
Now I want to convert the expression (fold (fun (_ : X) (n0 : nat) => S n0) l' 0) to fold_length l' using the definition of fold_length. Is there a way to do that in Coq (There seems to something named fold tactic in Coq. Can that achieve this.) ?
Also, is there a way to prove the above theorem without the usage of unfold and fold tactic ?
To answer your first question, yes, the fold tactic can be used here to replace the left side of the equality with S (fold_length l'). Usually, for a function f, fold f is not powerful enough to detect what it can fold. But if you specify the whole term, like here fold (fold_length l'), it works.
Regarding your second question, note that tactics like reflexivity or assumption can conclude if the terms involved are equal up to some simplifications. Here, the base case of the induction can be just reflexivity. For the second case, assuming that fold is List.fold_right, simpl can surprisingly simplify without unfolding and you should not need unfold or fold here either.

How can I automate counting within proofs in Coq?

I have a function count that counts how many times a given predicate is provable when applied to elements of a list. It is defined as follows:
Parameter T : Type.
Parameter dec: forall (p: T -> Prop) (w: T), {p w} + {~ (p w)}.
Fixpoint count (p: T -> Prop) (l: list T) := match l with
| nil => 0
| (cons head tail) => if (dec p head) then (1 + (count p tail)) else (count p tail)
end.
I then use this function to state lemmas like the following:
Parameter a b c: T.
Parameter q: T -> Prop.
Axiom Aa: (q a).
Axiom Ab: (q b).
Axiom Ac: ~ (q c).
Lemma example: (count q (cons a (cons b (cons c nil)))) = 2.
My proofs of such lemmas tend to be quite tedious:
Lemma example: (count q (cons a (cons b (cons c nil)))) = 2.
Proof.
unfold count.
assert (q a); [apply Aa| auto].
assert (q b); [apply Ab| auto].
assert (~ (q c)); [apply Ac| auto].
destruct (dec q a); [auto | contradiction].
destruct (dec q b); [auto | contradiction].
destruct (dec q c); [contradiction | auto].
Qed.
What can I do to automate such tedious proofs that involve computation with my count function?
This is typically the kind of cases where you are better off proving things by reflection. See how things go smoothly (of course I modified a bit your example to avoid all these axioms):
Require Import List.
Import ListNotations.
Fixpoint count {T : Type} (p : T -> bool) (l : list T) :=
match l with
| [] => 0
| h :: t => if p h then S (count p t) else (count p t)
end.
Inductive T := a | b | c.
Definition q x :=
match x with
| a => true
| b => true
| c => false
end.
Lemma example: (count q [a; b; c]) = 2.
Proof.
reflexivity.
Qed.
I realize that your definition of count was taking a propositional predicate on type T (but with the assumption that all predicates on type T are decidable) and instead I propose to define count to take a boolean predicate. But you may realize that having a decidable propositional predicate or having a boolean predicate is actually equivalent.
E.g. from your axioms, I can define a function which transform any propositional predicate into a boolean one:
Parameter T : Type.
Parameter dec: forall (p: T -> Prop) (w: T), {p w} + {~ (p w)}.
Definition prop_to_bool_predicate (p : T -> Prop) (x : T) : bool :=
if dec p x then true else false.
Of course, because there are axioms involved in your example, it won't actually be possible to compute with the boolean predicate. But I'm assuming that you put all these axioms for the purpose of the example and that your actual application doesn't have them.
Answer to your comment
As I told you, as soon as you have defined some function in terms of an axiom (or of a Parameter since this is the same thing), there is no way you can compute with it anymore.
However, here is a solution where the decidability of propositional predicate p is a lemma instead. I ended the proof of the lemma with Defined instead of Qed to allow computing with it (otherwise, it wouldn't be any better than an axiom). As you can see I also redefined the count function to take a predicate and a proof of its decidability. The proof by reflection still works in that case. There is no bool but it is strictly equivalent.
Require Import List.
Import ListNotations.
Fixpoint count {T : Type}
(p : T -> Prop) (dec : forall (w: T), {p w} + {~ (p w)}) (l : list T) :=
match l with
| [] => 0
| h :: t => if dec h then S (count p dec t) else (count p dec t)
end.
Inductive T := a | b | c.
Definition p x := match x with | a => True | b => True | c => False end.
Lemma dec_p: forall (w: T), {p w} + {~ (p w)}.
Proof.
intros []; simpl; auto.
Defined.
Lemma example2: (count p dec_p [a; b; c]) = 2. Proof. reflexivity. Qed.
Let's create our custom hint database and add your axioms there:
Hint Resolve Aa : axiom_db.
Hint Resolve Ab : axiom_db.
Hint Resolve Ac : axiom_db.
Now, the firstorder tactic can make use of the hint database:
Lemma example: count q (cons a (cons b (cons c nil))) = 2.
Proof.
unfold count.
destruct (dec q a), (dec q b), (dec q c); firstorder with axiom_db.
Qed.
We can automate our solution using the following piece of Ltac:
Ltac solve_the_probem :=
match goal with
|- context [if dec ?q ?x then _ else _] =>
destruct (dec q x);
firstorder with axioms_db;
solve_the_probem
end.
Then, unfold count; solve_the_probem. will be able to prove the lemma.

Implementing safe element retrieval by index from list in Coq

I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.