Fixpoint with Prop inhabitant as argument - coq

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!)

Related

Definition by minimization in Coq

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.

How to reason with complex pattern-matchings?

Coq allows to write complex pattern-matchings, but then it decomposes them so that its kernel can handle them.
For instance, let us consider the following code.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
We pattern-match both on the list and on the second element. Printing f shows that Coq stores a more complex version of it.
Print f.
(* f = fun l : list bar => match l with
| [] => 2
| [_] => 2
| _ :: A :: _ => 1
| _ :: B :: _ => 2
| _ :: C :: _ => 2
end
: list bar -> nat
*)
The problem is that, in the proofs manipulating f, I have to deal with 5 cases instead of only 2, and 4 of them are redundant.
What is the best way to deal with this? Is there a way to reason with the pattern-matching as if it were exactly as defined?
You are correct in that Coq actually simplifies pattern-matching making a lot of redundancies appear.
There are however some ways to reason on the case analysis you meant opposed to what Coq understands.
Using Function and function induction is a way.
More recently, Equations also allows you to define pattern-matching for which it derives induction principles automatically (that you can invoke using funelim).
In order to convince coq cases can be factorised you have to use the notion of view.
They are described in the context of Equations in the examples.
I'll detail how to adapt your example to it.
From Equations Require Import Equations.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Equations discr (b : list bar) : Prop :=
discr (_ :: A :: _) := False ;
discr _ := True.
Inductive view : list bar -> Set :=
| view_foo : forall x y, view (x :: A :: y)
| view_other : forall l, discr l -> view l.
Equations viewc l : view l :=
viewc (x :: A :: y) := view_foo x y ;
viewc l := view_other l I.
Equations f (l : list bar) : nat :=
f l with viewc l := {
| view_foo _ _ => 1 ;
| view_other _ _ => 2
}.
Goal forall l, f l < 3.
Proof.
intro l.
funelim (f l).
- repeat constructor.
- repeat constructor.
Qed.
As you can see, funelim only generates two subgoals.
It can be a bit heavy so if you don't want to use Equations of Function, you might have to prove your own induction principles by hand:
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
Definition discr (l : list bar) : Prop :=
match l with
| _ :: A :: _ => False
| _ => True
end.
Lemma f_ind :
forall (P : list bar -> nat -> Prop),
(forall x y, P (x :: A :: y) 1) ->
(forall l, discr l -> P l 2) ->
forall l, P l (f l).
Proof.
intros P h1 h2 l.
destruct l as [| x [|[] l]].
3: eapply h1.
all: eapply h2.
all: exact I.
Qed.
Goal forall l, f l < 3.
Proof.
intro l.
eapply f_ind.
- intros. repeat constructor.
- intros. repeat constructor.
Qed.

Decreasing argument with dependent types

When dealing with non-dependent types, Coq (usually) infers which argument is decreasing in a fixpoint. However, it is not the case with dependent types.
For instance, consider the following example in which I have a type A_list which ensures that a property P holds for all elements (of type A) in the list:
Require Import Coq.Lists.List.
Variable A: Type.
Variable P: A -> Prop.
Definition A_list := {a: list A | Forall P a}.
Now, say I want to have a fixpoint working with such a list recursively (the 2 lemmas are not interesting here. The dummy_arg is to simulate working with multiple arguments.) :
Lemma Forall_tl: forall P (h: A) t, Forall P (h::t) -> Forall P t.
Admitted.
Lemma aux: forall (l1: list A) l2 P, l1 = l2 -> Forall P l1 -> Forall P l2.
Admitted.
Fixpoint my_fixpoint (l: A_list) (dummy_arg: A) :=
match (proj1_sig l) as x return proj1_sig l = x -> bool with
| nil => fun _ => true
| hd::tl =>
fun h =>
my_fixpoint (exist (Forall P) tl (Forall_tl P hd tl (aux _ _ _ h (proj2_sig l)))) dummy_arg
end eq_refl.
Which, as expected, returns an error "Cannot guess decreasing argument of fix." since, strictly speaking, we are not decreasing on the argument. Nonetheless, we are obviously decreasing on proj1_sig l (the list embedded in the sig).
This is probably solvable using Program Fixpoints, but since it must be a very common pattern to decrease on a projection of a dependent type, I wonder what is the "right" way to manage such cases.
You can solve this problem using one of the methods I mentioned in this answer, including Program.
If you decouple the list and the proof, then it can be done using ordinary recursion :
Fixpoint my_fixpoint (l: list A) (pf : Forall P l) (dummy_arg: A) : bool :=
match l as x return Forall P x -> bool with
| nil => fun _ => true
| hd::tl => fun h => my_fixpoint tl (Forall_tl P hd tl h) dummy_arg
end pf.

Prove existential quantifier using Coq

Assuming we have an inductive data structure and some predicate over it:
Inductive A : EClass :=
X | Y .
Definition P (a: A) : bool :=
match a with
X => true
| Y => false
end.
Then, I formulate a theorem to say there exists an element a such that P a returns true:
Theorem test :
exists a: A, P a.
There are probably various ways of doing it, I am thinking how to use case analysis to prove it, in my mind, it works something like this:
remember there are 2 ways A can be constructed
try each way one by one, stop if we find a witness such that P a holds.
My Coq code looks like:
evar (a: A). (* introduce a candidate to manipulate *)
destruct a eqn: case_A. (* case analysis *)
- (* case where a = X *)
exists a.
rewrite case_A.
done.
- (* case where a = Y *)
(* stuck *)
My question is that,
is my prove strategy logically flawed?
if not, my Coq is the problem, how can I convey to Coq that my job is done is I find one witness? might be I should not destruct?
Thanks!
Yes, your proof is flawed! All that you need is to provide the witness first:
Inductive A := X | Y .
Definition P (a: A) : bool := match a with X => true | Y => false end.
Theorem test : exists a: A, P a = true.
Proof. now exists X. Qed.
If you do case analysis first, you'll get into a dead-end.
Here is a rough framework that demonstrates how you might program a Coq tactic to try all elements of a finite type as witnesses.
(* Typeclass to register an enumeration of elements of a type. *)
Class Enumeration (A:Type) :=
enumerate : list A.
Arguments enumerate A [Enumeration].
(* Typeclass to register decision procedures to determine whether
a given proposition is true or false. *)
Class Decision (P:Prop) :=
decide : {P} + {~P}.
Arguments decide P [Decision].
(* Given a Coq list l, execute tactic t on every element of
l until we get a success. *)
Ltac try_list l t :=
match (eval hnf in l) with
| #cons _ ?hd ?tl => (t hd || try_list tl t)
end.
(* Tactic for "proof by reflection": use a decision procedure, and
if it returns "true", then extract the proof from the result. *)
Ltac by_decision :=
match goal with
|- ?P => let res := (eval hnf in (decide P)) in
match res with
| left ?p => exact p
end
end.
(* Combination to try to prove an (exists x:A, P) goal by trying
to prove P by reflection for each element in an enumeration of A. *)
Ltac try_enumerate :=
match goal with
|- #ex ?A ?P =>
try_list (enumerate A)
ltac:(fun x => exists x; by_decision)
end.
(* Demonstration on your example *)
Inductive A := X | Y.
Instance A_enum : Enumeration A :=
cons X (cons Y nil).
Instance bool_eq_dec : forall x y:bool,
Decision (x = y).
Proof.
intros. red. decide equality.
Defined.
Definition P (a:A) : bool :=
match a with
| X => true
| Y => false
end.
Goal exists a:A, P a = true.
Proof.
try_enumerate.
Qed.

Incorrect elimination of X in the inductive type "or":

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}.