Assume P: nat -> T -> Prop is a proposition that for any given t: T,
either there exists a k: nat such that P holds for all numbers greater than or equal to k and no number less than k.
or P k t is false for all k : nat.
I want to define min_k : T -> nat + undef to be the minimum number k such that P k t holds, and undef otherwise.
Is that even possible? I tried to define something like
Definition halts (t : T) := exists k : nat, P k t.
Or maybe
Definition halts (t : T) := exists! k : nat, (~ P k t /\ P (S k) t).
and then use it like
Definition min_k (t : T) := match halts T with
| True => ??
| False => undef
end.
but I don't know how to go further from there.
Any ideas would be appreciated.
You can't match on a Prop. If you want to do case analysis then you need something in Type, typically bool or something like sumbool or sumor. In other words, you can do what you want as long as you have a pretty strong hypothesis.
Variable T : Type.
Variable P : nat -> T -> Prop.
Hypothesis PProperty : forall (t : T),
{k : nat | forall n, (k <= n -> P n t) /\ (n < k -> ~ P n t)}
+
{forall k, ~ P k t}.
Definition min_k (t : T) : option nat :=
match PProperty t with
| inleft kH => Some (proj1_sig kH)
| inright _ => None
end.
Crucially, this wouldn't have worked if PProperty was a Prop disjunction, i.e., if it was of the form _ \/ _ instead of the form _ + { _ }.
By the way, the idiomatic way of describing foo + undef in Coq is to use option foo, which is what I did above, but you can adapt it as you wish.
In addition to Ana's excellent answer, I think it is worth pointing out that option nat is essentially the same thing as {k : nat | ...} + {forall k, ~ P k t} if you erase the proofs of the latter type: in the first case (Some or inleft), you get a natural number out; in the second (None or inright) you get nothing at all.
Related
I am quite new in the world of the ATP, but definitely very motivated.
I am starting to deal with dependent types. I am involved in a project where I have defined the type for (finite and infinite) sequences.
Inductive sequence {X : Type} : Type :=
| FinSeq (x : list X)
| InfSeq (f : nat -> X).
Now I want to define the head of a non-empty sequence.
Lemma aux_hd : forall {A : Type} (l : list A),
0 < Datatypes.length l -> #hd_error A l = None -> False.
Proof. destruct l.
+ simpl. lia.
+ simpl. intros S. discriminate.
Qed.
Definition Hd {A : Type} (l : list A) : 0 < Datatypes.length l -> A :=
match (hd_error l) with
| Some a => (fun _ => a)
| None => fun pf => match (aux_hd l pf ??) with end
end.
Definition Head {A : Type} (s :sequence) (H : 0 << length s),
match s with
| FinSeq x => Hd x H
| InfSeq f => f 0 end.
My problem is in the definition of Hd: I don't know how to prove #hd_error A l = None, since we are already in such a match branch. I believe it should be really easy.
I have a similar problem in the last definition because I don't know how to transform H, for the particular case of the first match branch, where I know that length s = Datatypes.length x and, thus, 0 << length s -> 0 < Datatypes.length x.
Finally, I have omitted the details about << and length sequence, because I dont think it is relevant for the question but basically I have uplifted nat with an Inf to represent the length of the infinite sequences and << is the < for nat and num.
I have followed the course Software Foundations and I am currently studying more using "Certified Programming with Dependent Types" which is also really good.
Thanks in advance,
Miguel
When you match on something, all extra evidence must be passed as arguments to the match (this is the "convoy pattern" described in CPDT).
In Hd you want to remember that hd_error l = None, pass it as an argument. It's a little tricky because you have to explicitly annotate the match with a return clause (which in simpler cases was inferred for you):
Definition Hd {A : Type} (l : list A) : 0 < Datatypes.length l -> A :=
match (hd_error l) as X return hd_error l = X -> 0 < Datatypes.length l -> A with
| Some a => (fun _ _ => a)
| None => fun pf1 pf2 => match (aux_hd l pf2 pf1) with end
end eq_refl.
Similarly in Head, after pattern-matching on s you want to simplify 0 << length s; pass it as an argument:
Definition Head {A : Type} (s :sequence) (H : 0 << length s) :=
match s return (0 << length s) -> _ with
| FinSeq x => fun H => Hd x H
| InfSeq f => fun _ => f 0
end H.
I have following definition of list in Coq:
Variable A : Set.
Variable P : A -> Prop.
Hypothesis P_dec : forall x, {P x}+{~(P x)}.
Inductive plist : nat -> Set :=
pnil : plist O
| pcons : A -> forall n, plist n -> plist n
| pconsp : forall (a:A) n, plist n -> P a -> plist (S n)
.
It describes "list of elements of type A where at least n of them fulfill predicate P".
My task is to create function that will convert casual list into plist (with maximum possible n). My attempt was to first count all elements that match P and then set the output type according to the result:
Fixpoint pcount (l : list A) : nat :=
match l with
| nil => O
| h::t => if P_dec h then S(pcount t) else pcount t
end.
Fixpoint plistIn (l : list A) : (plist (pcount l)) :=
match l with
| nil => pnil
| h::t => match P_dec h with
| left proof => pconsp h _ (plistIn t) proof
| right _ => pcons h _ (plistIn t)
end
end.
However, I get an error in the line with left proof:
Error:
In environment
A : Set
P : A -> Prop
P_dec : forall x : A, {P x} + {~ P x}
plistIn : forall l : list A, plist (pcount l)
l : list A
h : A
t : list A
proof : P h
The term "pconsp h (pcount t) (plistIn t) proof" has type
"plist (S (pcount t))" while it is expected to have type
"plist (pcount (h :: t))".
The problem is that Coq cannot see that S (pcount t) equals pcount (h :: t) knowing that P h, which was already proven. I cannot let Coq know this truth.
How to define this function correctly? Is it even possible to do so?
You can use dependent pattern-matching, as the result type plist (pcount (h :: t)) depends on whether P_dec h is left or right.
Below, the keyword as introduces a new variable p, and return tells the type of the whole match expression, parameterized by p.
Fixpoint plistIn (l : list A) : (plist (pcount l)) :=
match l with
| nil => pnil
| h::t => match P_dec h as p return plist (if p then _ else _) with
| left proof => pconsp h (pcount t) (plistIn t) proof
| right _ => pcons h _ (plistIn t)
end
end.
The type plist (if p then _ else _) must be equal to plist (pcount (h :: t)) when substituting p := P_dec h. Then in each branch, say left proof, you need to produce plist (if left proof then _ else _) (which reduces to the left branch).
It's a bit magical that Coq can infer what goes in the underscores here, but to be safe you can always spell it out: if p then S (pcount t) else pcount t (which is meant to exactly match the definition of pcount).
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.
Consider the definition of find in the standard library, which as the type find: forall A : Type, (A -> bool) -> list A -> option A.
Of course, find has to return an option A and not an A because we don't know wether there is a "valid" element in the list.
Now, say I find this definition of find painful, because we have to deal with the option, even when we are sure that such an element exists in the list.
Hence, I'd like to define myFind which additionnaly takes a proof that there is such an element in the list. It would be something like:
Variable A: Type.
Fixpoint myFind
(f: A -> bool)
(l: list A)
(H: exists a, In a l /\ f a = true): A :=
...
If I am not mistaken, such a signature informally says: "Give me a function, a list, and a proof that you have a "valid" element in the list".
My question is: how can I use the hypothesis provided and define my fixpoint ?
What I have in mind is something like:
match l with
| nil => (* Use H to prove this case is not possible *)
| hd :: tl =>
if f hd
then hd
else
(* Use H and the fact that f hd = false
to prove H': exists a, In a tl /\ f a = true *)
myFind f tl H'
end.
An bonus point would be to know whether I can embbed a property about the result directly within the type, for instance in our case, a proof that the return value r is indeed such that f r = true.
We can implement this myFind function by structural recursion over the input list. In the case of empty list the False_rect inductive principle is our friend because it lets us switch from the logical world to the world of computations. In general we cannot destruct proofs of propositions if the type of the term under construction lives in Type, but if we have an inconsistency the system lets us.
We can handle the case of the non-empty input list by using the convoy pattern (there is a number of great answers on Stackoverflow explaining this pattern) and an auxiliary lemma find_not_head.
It might be useful to add that I use the convoy pattern twice in the implementation below: the one on the top level is used to let Coq know the input list is empty in the first match-branch -- observe that the type of H is different in both branches.
From Coq Require Import List.
Import ListNotations.
Set Implicit Arguments.
(* so we can write `f a` instead of `f a = true` *)
Coercion is_true : bool >-> Sortclass.
Section Find.
Variables (A : Type) (f : A -> bool).
(* auxiliary lemma *)
Fact find_not_head h l : f h = false ->
(exists a, In a (h :: l) /\ f a) ->
exists a, In a l /\ f a.
Proof. intros E [a [[contra | H] fa_true]]; [congruence | now exists a]. Qed.
Fixpoint myFind (l : list A) (H : exists a : A, In a l /\ f a) : {r : A | f r} :=
match l with
| [] => fun H : exists a : A, In a [] /\ f a =>
False_rect {r : A | f r}
match H with
| ex_intro _ _ (conj contra _) =>
match contra with end
end
| h :: l => fun H : exists a : A, In a (h :: l) /\ f a =>
(if f h as b return (f h = b -> {r : A | f r})
then fun Efh => exist _ h Efh
else fun Efh => myFind l (find_not_head Efh H)) eq_refl
end H.
End Find.
Here is a simplistic test:
From Coq Require Import Arith.
Section FindTest.
Notation l := [1; 2; 0; 9].
Notation f := (fun n => n =? 0).
Fact H : exists a, In a l /\ f a.
Proof. exists 0; intuition. Qed.
Compute myFind f l H.
(*
= exist (fun r : nat => f r) 0 eq_refl
: {r : nat | f r}
*)
End FindTest.
You can also use Program to help you construct the proof arguments interactively. You fill in as much as you can in the program body and leave _ blanks that you get to fill in later with proof tactics.
Require Import List Program.
Section Find.
Variable A : Type.
Variable test : A -> bool.
Program Fixpoint FIND l (H:exists a, test a = true /\ In a l) : {r | test r = true} :=
match l with
| [] => match (_:False) with end
| a::l' => if dec (test a) then a else FIND l' _
end.
Next Obligation.
firstorder; congruence.
Defined.
End Find.
Program is a little better at not forgetting information when you do case analysis (it knows the convoy pattern) but it is not perfect, hence the use of dec in the if statement.
(Notice how Coq was able to handle the first obligation, to construct a term of type False, all by itself!)
The following code (which is of course not a complete proof) tries to do pattern matching on a dependent product:
Record fail : Set :=
mkFail {
i : nat ;
f : forall x, x < i -> nat
}.
Definition failomat : forall (m : nat) (f : forall x, x < m -> nat), nat.
Proof.
intros.
apply 0.
Qed.
Function fail_hard_omat fl : nat := failomat (i fl) (f fl).
Definition failhard fl : fail_hard_omat fl = 0.
refine ((fun fl =>
match fl with
| mkFail 0 _ => _
| mkFail (S n) _ => _
end) fl).
The error I get when trying to execute this is
Toplevel input, characters 0-125:
Error: Illegal application (Type Error):
The term "mkFail" of type
"forall i : nat, (forall x : nat, x < i -> nat) -> fail"
cannot be applied to the terms
"i" : "nat"
"f0" : "forall x : nat, x < i0 -> nat"
The 2nd term has type "forall x : nat, x < i0 -> nat"
which should be coercible to "forall x : nat, x < i -> nat".
It seems that the substitution somehow does not reach the inner type parameters.
After playing with the Program command I managed to build a refine that might suites you, but I don't understand everything I did. The main idea is to help Coq with the substitution by introducing intermediate equalities that will serve as brige within the substitution
refine ((fun fl =>
match fl as fl0 return (fl0 = fl -> fail_hard_omat fl0 = 0) with
| mkFail n bar =>
match n as n0 return (forall foo: (forall x:nat, x < n0 -> nat),
mkFail n0 foo = fl -> fail_hard_omat (mkFail n0 foo) = 0) with
| O => _
| S p => _
end bar
end (eq_refl fl) ) fl).
Anyway, I don't know what your purpose here is, but I advise never write dependent match "by hand" and rely on Coq's tactics. In your case, if you define your Definition failomat with Defined. instead of Qed, you will be able to unfold it and you won't need dependent matching.
Hope it helps,
V.
Note: both occurences of bar can be replaced by an underscore.
Another, slightly less involved, alternative is to use nat and fail's induction combinators.
Print nat_rect.
Print fail_rect.
Definition failhard : forall fl, fail_hard_omat fl = 0.
Proof.
refine (fail_rect _ _). (* Performs induction (projection) on fl. *)
refine (nat_rect _ _ _). (* Performs induction on fl's first component. *)
Show Proof.