I am new to Coq and need some help with some of trivial examples to get me started. In particular I am interested in defining some operations of vectors (fixed size lists) using dependent types. I started with Vector package and trying to implement some additional functions. For example I am having difficulty implementing trivial 'take' and 'drop' functions, which take or drop first 'p' elements from the list.
Require Import Vector.
Fixpoint take {A} {n} (p:nat) (a: t A n) : p<=n -> t A p :=
match a return ( p<=n -> t A p) with
| cons A v (S m) => cons (hd v) (take m (tl v)) m
| nil => fun pf => a
end.
The error (in case of nil) is:
The term "a" has type "t A n" while it is expected to have type "t A p".
Could somebody help me with some starting points? Thanks!
I don't understand your approach. You're always returning a non-empty vector when the argument is a non-empty vector, but take must return nil when p=0 regardless of the vector.
Here's one approach to building take. Rather than using the hypothesis p <= n, I express the length of the argument n as a sum of the number p of elements to take and the number of trailing elements m, which is possible iff p <= n. This allows for an easier recursive definition, because (S p') + m is structurally equal to S (p' + m). Note that the discrimination is on the number of elements to take: return nil if taking 0, return cons head new_tail otherwise.
This version of the take function has the desired computational behavior, so all that's left is to define one with the desired proof content. I use the Program feature to do this conveniently: fill in the computational content (trivial, I just need to say that I want to use m = n - p), then complete the proof obligations (which are simple arithmetic).
Require Import Arith.
Require Import Vector.
Fixpoint take_plus {A} {m} (p:nat) : t A (p+m) -> t A p :=
match p return t A (p+m) -> t A p with
| 0 => fun a => nil _
| S p' => fun a => cons A (hd a) _ (take_plus p' (tl a))
end.
Program Definition take A n p (a : t A n) (H : p <= n) : t A p :=
take_plus (m := n - p) p a.
Solve Obligations using auto with arith.
For your newdrop : forall A n p, t A n -> p <= n -> t A (n-p), the following approach works. You need to help Coq by telling it what p and n become in the recursive call.
Program Fixpoint newdrop {A} {n} p : t A n -> p <= n -> t A (n-p) :=
match p return t A n -> p <= n -> t A (n-p) with
| 0 => fun a H => a
| S p' => fun a H => newdrop p' (tl a) (_ : p' <= n - 1)
end.
Next Obligation.
omega.
Qed.
Next Obligation.
omega.
Qed.
Next Obligation.
omega.
Qed.
Next Obligation.
omega.
Qed.
I don't know why Solve Obligations using omega. doesn't work but solving each obligation individually works.
Related
I have a list of natural numbers, elements in the list are in descending order. I want to write lemma about the list ,that first element h is greater than all the elements of list . Let list is [h;h1;t] . 0 h1? Please guide me , how to write h is greater than all the elements in the tail of list.
You need to say
For any natural number, and any list like h::t, if the list is descending and if the number is in the tail, then it's smaller than the head.
So in Coq language you may write
Lemma head_is_max : forall n h t, desc (h::t) -> In n t -> h >= n.
if desc is a Boolean predicate you may write
Lemma head_is_max : forall n h t, desc (h::t) = true -> In n t -> h >= n.
Performing an induction on t would work for the proof.
In a more sophisticated way, you may use a predicate on list which asserts that all elements of a list have a specific property, you may define it as
Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
match l with
| [] => True
| h :: t => P h /\ All P t
end.
So All P l means P x holds for all xs in l. Now we can write the mentioned lemma as
Lemma head_is_max : forall h t, desc (h::t) -> All (fun n => h >= n) t.
To express that a given list of natural numbers is in descending order, you can use existing functions in the List module of Coq.
Require Import List Lia.
Definition desc (l : list nat) : Prop :=
forall i j, i <= j -> nth j l 0 <= nth i l 0.
What did I do? I just expressed that the value at rank i must be larger than the value at rank j for any j larger than i. This is clever in a subtle way. The expression nth j l 0 actually represents the value at rank i in l if i is smaller than the length of the list or 0 otherwise. It happens that 0 is smaller than any other natural number, so this definition does work. If instead, you had asked for a list of numbers in strictly descending order, then I would have had to write a more precise definition, involving only ranks that are smaller than the list length (you can use the function length for this). I let you do this as an exercise.
When you write a logical predicate like desc here, it is important to test this definition, to make sure you have really captured the notion you had in mind. To test my own definition, I wrote the following code:
Definition sample1 := 1 :: 2 :: 3 :: nil.
Definition sample2 := map (fun x => 10 - x) sample1.
Lemma s2_desc : desc sample2.
Proof.
intros [ | [ | [ | [ | ]]]] [ | [ | [ | [ | ]]]];
intros ilej; simpl; lia.
Qed.
Lemma s1_n_desc : ~desc sample1.
Proof.
intros abs; generalize (abs 0 1 (le_S _ _ (le_n _))).
compute; lia.
Qed.
The proof of s2_desc is a proof by brute force, it actually tries all pairs of ranks smaller than 4, and checks
that in all these cases the comparisons between natural numbers (ranks or values in the list) do give logically provable formulas.
The proof of s1_n_desc is used to check that my definition of desc really rejects a list that obviously does not satisfy the criterion. It is a good thing I wrote this proof, because it helped me discover a bug in my code of desc that was not caught by the previous proof: I had written nth 0 l i instead of nth i l 0!
Last, but not least, my solution starts with Require Import List Lia. This means that we use two existing modules of Coq. The first one provides frequently used functions about lists, the second one provides an automatic tool to perform easy proofs about comparison between numbers (natural numbers or integers, actually).
As a next step, one could also write a boolean function that computes the value true exactly when its input is in
descending order and develop proofs of tests to verify that both functions behave accordingly.
You need to define what you mean by descending and use that in your proof.
#Yves has perhaps the neatest way of doing it. Here is another definition that
is just writing down a simple inductive definition. A list is descending if the tail is descending and the first element is larger or equal to the second element.
One nice thing with inductive definitions is that you can do induction on them, which gives you a lot of information in each proof case, with very little work.
Require Import List.
Inductive descending : list nat -> Prop :=
desc_nil : descending nil
| desc_1 n : descending (cons n nil)
| desc_hd n m l :
m <= n ->
descending (cons m l) ->
descending (cons n (cons m l)).
Lemma head_gt l d:
descending l -> forall m, In m l -> m <= hd d l.
Proof.
induction 1; intros k H'.
now exfalso; apply in_nil in H'.
now replace k with n; [ | inversion H'].
now inversion H';
[ subst; apply le_n
| eapply PeanoNat.Nat.le_trans; auto].
Qed.
I'm trying to use Equations package to define a function over vectors in Coq. The minimum code that shows the problem that I will describe is available at the following gist.
My idea is to code a function that does a lookup on a "proof" that some type holds for all elements of a vector, which has a standard definition:
Inductive vec (A : Type) : nat -> Type :=
| VNil : vec A 0
| VCons : forall n, A -> vec A n -> vec A (S n).
Using the previous type, I had defined the following (also standard) lookup operation (using Equations):
Equations vlookup {A}{n}(i : fin n) (v : vec A n) : A :=
vlookup FZero (VCons x _) := x ;
vlookup (FSucc ix) (VCons _ xs) := vlookup ix xs.
Now, the trouble begins. I want to define the type of "proofs" that some
property holds for all elements in a vector. The following inductive type does this job:
Inductive vforall {A : Type}(P : A -> Type) : forall n, vec A n -> Type :=
| VFNil : vforall P _ VNil
| VFCons : forall n x xs,
P x -> vforall P n xs -> vforall P (S n) (VCons x xs).
Finally, the function that I want to define is
Equations vforall_lookup
{n}
{A : Type}
{P : A -> Type}
{xs : vec A n}
(idx : fin n) :
vforall P xs -> P (vlookup idx xs) :=
vforall_lookup FZero (VFCons _ _ pf _) := pf ;
vforall_lookup (FSucc ix) (VFCons _ _ _ ps) := vforall_lookup ix ps.
At leas to me, this definition make sense and it should type check. But, Equations had showed the following warning and left me with a proof obligation in which I had no idea on how to finish it.
The message presented after the definition of the previous function is:
Warning:
In environment
eos : end_of_section
fix_0 : forall (n : nat) (A : Type) (P : A -> Type) (xs : vec A n)
(idx : fin n) (v : vforall P xs),
vforall_lookup_ind n A P xs idx v (vforall_lookup idx v)
A : Type
P : A -> Type
n0 : nat
x : A
xs0 : vec A n0
idx : fin n0
p : P x
v : vforall P xs0
Unable to unify "VFCons P n0 x xs0 p v" with "v".
The obligation left is
Obligation 1 of vforall_lookup_ind_fun:
(forall (n : nat) (A : Type) (P : A -> Type) (xs : vec A n)
(idx : fin n) (v : vforall P xs),
vforall_lookup_ind n A P xs idx v (vforall_lookup idx v)).
Later, after looking at a similar definition in Agda standard library, I realised that the previous function definition is missing a case for the empty vector:
lookup : ∀ {a p} {A : Set a} {P : A → Set p} {k} {xs : Vec A k} →
(i : Fin k) → All P xs → P (Vec.lookup i xs)
lookup () []
lookup zero (px ∷ pxs) = px
lookup (suc i) (px ∷ pxs) = lookup i pxs
My question is, how can I specify that, for the empty vector case, the right hand side should be empty, i.e. a contradiction? The Equations manual shows an example for equality but I could adapt it to this case. Any idea on what am I doing wrong?
I think I finally understood what is going on in this example by looking closely at the obligation generated.
The definition is correct, and it is accepted (you can use vforall_lookup without solving the obligation). What fails to be generated is the induction principle associated to the function.
More precisely, Equations generates the right induction principle in three steps (this is detailed in the reference manual) in section "Elimination principle":
it generates the graph of the function (in my version of Equations it is called vforall_lookup_graph, in previous versions it was called vforall_lookup_ind). I am not sure that I fully understand what it is. Intuitively, it reflects the structure of the body of the function. In any case, it is a key component to generate the induction principle.
it proves that the function respects this graph (in a lemma called vforall_lookup_graph_correct or vforall_lookup_ind_fun);
it combines the last two results to generate the induction principle associated to the function (this lemma is called vforall_lookup_elim in all versions).
In your case, the graph was correctly generated but Equations was not able to prove automatically that the function respects its graph (step 2), so it is left to you.
Let's give it a try!
Next Obligation.
induction v.
- inversion idx.
- dependent elimination idx.
(* a powerful destruct provided by Equations
that correctly working with dependent types
*)
+ constructor.
+ constructor.
Coq rejects the last call to constructor with the error
Unable to unify "VFCons P n1 x xs p v" with "v".
This really looks like the error obtained in the first place, so I think the automatic resolution reached this same point and failed. Does this mean that we took a wrong path? Let's look closer at the goal before the second constructor.
We have to prove
vforall_lookup_graph (S n1) A P (VCons x xs) (FSucc f) (VFCons P n1 x xs p v) (vforall_lookup (FSucc f) (VFCons P n1 x xs p v))
while the type of vforall_lookup_graph_equation_2, the second constructor of vforall_lookup_graph_equation is
forall (n : nat) (A : Type) (P : A -> Type) (x : A) (xs0 : vec A n) (f : fin n) (p : P x) (v : vforall P xs0),
vforall_lookup_graph n A P xs0 f v (vforall_lookup f v) -> vforall_lookup_graph (S n) A P (VCons x xs0) (FSucc f) (VFCons P n x xs0 p v) (vforall_lookup f v)
The difference lies in the calls to vforall_lookup. In the first case, we have
vforall_lookup (FSucc f) (VFCons P n1 x xs p v)
and in the second case
vforall_lookup f v
But these are identical by definition of vforall_lookup! But by default the unification fails to recognize that. We need to help it a bit. We can either give the value of some argument, e.g.
apply (vforall_lookup_graph_equation_2 n0).
or we can use exact or refine that unify more aggressively than apply since they are given the whole term and not only its head
refine (vforall_lookup_graph_equation_2 _ _ _ _ _ _ _ _ _).
We can conclude easily by the induction hypothesis. This gives the following proof
Next Obligation.
induction v.
- inversion idx.
- dependent elimination idx.
+ constructor.
+ (* IHv is the induction hypothesis *)
exact (vforall_lookup_graph_equation_2 _ _ _ _ _ _ _ _ (IHv _)).
Defined.
Since I like doing proofs with dependent types by hand, I can't help giving a proof that does not use dependent elimination.
Next Obligation.
induction v.
- inversion idx.
- revert dependent xs.
refine (
match idx as id in fin k return
match k return fin k -> Type with
| 0 => fun _ => IDProp
| S n => fun _ => _
end id
with
| FZero => _
| FSucc f => _
end); intros.
+ constructor.
+ exact (vforall_lookup_graph_equation_2 _ _ _ _ _ _ _ _ (IHv _)).
Defined.
Suppose I write a Fixpoint algorithm in Coq that sums up all the "halves" of a number:
Fixpoint sum_of_halves (a : nat) : nat :=
match a with
| 0 => 0
| 2 * k => a + (sum_of_halves k)
| S (2 * k) => a + (sum_of_halves k)
end.
Trying to evaluate the algorithm would get: Error: Invalid notation for pattern.
How can I get Coq to recognize that a is either an even or an odd number, and match it with either 2 * k or S (2 * k)?
Coq can only match on constructors. nat has two constructors, O and S, so you cannot match on 2 * k. You will have to use a non-match construct or a non-nat type or a different algorithm.
You need to prove that there are only three cases for a given natural number a. Either a is 0, either a is the double of another number k and k < a, or a is the double k + 1 and k < a, that the three cases are exclusive (this is important, otherwise making pattern matching possible would lead to an inconistency).
Fortunately, all this can be done. It is a bit advanced Coq programming, but it is somehow already done in ZArith. Here is a solution.
First note that the other number is already provided by one of the functions in the Coq library, div2.
Require Import Arith Nat.
Definition cases_div2 (a : nat) :
{k : nat | a = 2 * k /\ k < a}+{k : nat | a = S (2 * k) /\ k < a}+{a=0}.
destruct a as [ | a'].
right; reflexivity.
case_eq (odd (S a')); intros odd_a.
left; right; exists (div2 (S a')); rewrite (div2_odd (S a')) at 1.
split.
rewrite odd_a; simpl b2n; ring.
apply lt_div2; auto with arith.
left; left; exists (div2 (S a')); rewrite (div2_odd (S a')) at 1.
split.
rewrite odd_a; simpl b2n; ring.
apply lt_div2; auto with arith.
Defined.
Now, you can pattern match on your number a using cases_div2, but it is still not enough to define your function, because recursion using Fixpoint relies on recursive calls happening on the predecessor, and here k cannot be written as a predecessor pattern that will work for any input a. You need a stronger kind of recursion. I usually rely on Function or Fix for this kind of strong recursion. Here is an example with Fix
Definition sum_of_halves : nat -> nat :=
Fix Arith.Wf_nat.lt_wf (fun _ => nat)
(fun a (sum_of_halves' : forall y, y < a -> nat) =>
match cases_div2 a with
| inright h => 0
| inleft (inl (exist _ k (conj keq klt))) =>
a + sum_of_halves' k klt
| inleft (inr (exist _ k (conj keq klt))) =>
a + sum_of_halves' k klt
end).
Then to reason about sum_of_halves you will need to reason by well founded induction and use Fix_eq.
This is one possibility.
I am trying to define a relatively simple function on Coq:
(* Preliminaries *)
Require Import Vector.
Definition Vnth {A:Type} {n} (v : Vector.t A n) : forall i, i < n -> A. admit. Defined.
(* Problematic definition below *)
Definition VnthIndexMapped {A:Type}
{i o:nat}
(x: Vector.t (option A) i)
(f': nat -> option nat)
(f'_spec: forall x, x<o ->
(forall z,(((f' x) = Some z) -> z < i)) \/
(f' x = None))
(n:nat) (np: n<o)
: option A
:=
match (f' n) as fn, (f'_spec n np) return f' n = fn -> option A with
| None, _ => fun _ => None
| Some z, or_introl zc1 => fun p => Vnth x z (zc1 z p)
| Some z, or_intror _ => fun _ => None (* impossible case *)
end.
And getting the following error:
Error:
Incorrect elimination of "f'_spec n np" in the inductive type "or":
the return type has sort "Type" while it should be "Prop".
Elimination of an inductive object of sort Prop
is not allowed on a predicate in sort Type
because proofs can be eliminated only to build proofs.
I think I understand the reason for this limitation, but I am having difficulty coming up with a workaround. How something like this could be implemented? Basically I have a function f' for which I have a separate proof that values less than 'o' it either returns None or a (Some z) where z is less than i and I am trying to use it in my definition.
There are two approaches to a problem like this: the easy way and the hard way.
The easy way is to think whether you're doing anything more complicated than you have to. In this case, if you look carefully, you will see that your f'_spec is equivalent to the following statement, which avoids \/:
Lemma f'_spec_equiv i o (f': nat -> option nat) :
(forall x, x<o ->
(forall z,(((f' x) = Some z) -> z < i)) \/
(f' x = None))
<-> (forall x, x<o -> forall z,(((f' x) = Some z) -> z < i)).
Proof.
split.
- intros f'_spec x Hx z Hf.
destruct (f'_spec _ Hx); eauto; congruence.
- intros f'_spec x Hx.
left. eauto.
Qed.
Thus, you could have rephrased the type of f'_spec in VnthIndexedMapped and used the proof directly.
Of course, sometimes there's no way of making things simpler. Then you need to follow the hard way, and try to understand the nitty-gritty details of Coq to make it accept what you want.
As Vinz pointed out, you usually (there are exceptions) can't eliminate the proof of proposition to construct something computational. However, you can eliminate a proof to construct another proof, and maybe that proof gives you what need. For instance, you can write this:
Definition VnthIndexMapped {A:Type}
{i o:nat}
(x: Vector.t (option A) i)
(f': nat -> option nat)
(f'_spec: forall x, x<o ->
(forall z,(((f' x) = Some z) -> z < i)) \/
(f' x = None))
(n:nat) (np: n<o)
: option A
:=
match (f' n) as fn return f' n = fn -> option A with
| None => fun _ => None
| Some z => fun p =>
let p' := proj1 (f'_spec_equiv i o f') f'_spec n np z p in
Vnth x z p'
end eq_refl.
This definition uses the proof that both formulations of f'_spec are equivalent, but the same idea would apply if they weren't, and you had some lemma allowing you to go from one to the other.
I personally don't like this style very much, as it is hard to use and lends itself to programs that are complicated to read. But it can have its uses...
The issue is that you want to build a term by inspecting the content of f'_spec. This disjunction lives in Prop, so it can only build other Prop. You want to build more, something in Type. Therefore you need a version of disjunction that lives at least in Set (more generally in Type). I advise you replace your Foo \/ Bar statement with the usage of sumbool, which uses the notation {Foo}+{Bar}.
In Coq, I'm having problems with applying the rewrite tactic in the following situation:
Section Test.
Hypothesis s t : nat -> nat.
Hypothesis s_ext_eq_t : forall (x : nat), s x = t x.
Definition dummy_s : nat -> nat :=
fun n => match n with
| O => 42
| S np => s np
end.
Definition dummy_t : nat -> nat :=
fun n => match n with
| O => 42
| S np => t np
end.
Goal forall (n : nat), dummy_s n = dummy_t n.
Proof.
intro n. unfold dummy_s. unfold dummy_t.
At that stage, the local context and current goal look as follows:
1 subgoals, subgoal 1 (ID 6)
s : nat -> nat
t : nat -> nat
s_ext_eq_t : forall x : nat, s x = t x
n : nat
============================
match n with
| 0 => 42
| S np => s np
end = match n with
| 0 => 42
| S np => t np
end
Now it should be possible to apply the rewrite tactic to replace the occurence of s np in the goal by t np, thereby making it possible to solve the goal using reflexivity. However,
rewrite s_ext_eq_t.
gives
Toplevel input, characters 0-18:
Error: Found no subterm matching "s ?190" in the current goal.
What am I doing wrong? One can get into a situation where rewrite is applicable via
destruct n.
(* n = 0 *)
reflexivity.
(* n > 0 *)
rewrite s_ext_eq_t.
reflexivity.
Qed.
but in the actual situation I am facing, several such destructs would be necessary, and I wonder whether rewrite or a variant of it is able to do this automatically.
Addendum The above situation naturally occurs when proving that a function defined via well-founded recursion has the desired fixed point property:
Suppose A: Type and that R: A -> A -> Prop is a well-founded relation, i.e. we have Rwf: well_founded R. Then, given a type family P: A -> Type we may construct a section
Fix : forall (x : A), P a
through recursion over R, with the recursion step given as a function
F : forall x:A, (forall y:A, R y x -> P y) -> P x
See https://coq.inria.fr/library/Coq.Init.Wf.html However, to show that Fix indeed has the fixed point property
forall (x : A), Fix x = F (fun (y:A) _ => Fix y)`
we need to provide a witness
F_ext : forall (x:A) (f g:forall y:A, R y x -> P y),
(forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.
i.e. we have to show that F does not use anything else from the given f: forall y:A, R y x -> P y but its values. Of course, in any concrete situation, this should be trivial to verify, but when one tries to prove it, one runs into a situation a minimal example of which I have presented above: One is facing a huge equality of two copies of the code for the recursion step, one time with f and another time with g. Your assumption tells that f and g are extensionally equal, so one should be able to rewrite them. However, in the code for the recursion step, there might be a large number of pattern matchings and new variables that doesn't make sense in the local context, hence it would be (unnecessarily?) quite tedious to destruct dozens of times before being allowed to apply rewrite.
As mentioned in a comment above, it is not possible to perform the rewrite directly on the branch of the match statement, because np is not in scope in the top-level environment. As far as Coq's theory is concerned, a proof of your statement will have to destruct n at some point.
Although I am not aware of any tactics for automating this kind of problem, it is not too hard to come up with some custom ltac code for solving your problem without too much pain:
Ltac solve_eq :=
try reflexivity;
match goal with
| |- match ?x with _ => _ end
= match ?x with _ => _ end =>
destruct x; auto
end.
Goal forall (n : nat), dummy_s n = dummy_t n.
Proof.
intro n. unfold dummy_s. unfold dummy_t.
solve_eq.
Qed.
If your extensional equality results are hypotheses that appear in your context, then solve_eq should be able to solve many goals of this shape; if not, you might have to add extra lemmas to your hint database.