I try to prove the following theorem in Coq:
Theorem simple :
forall (n b:nat) (input output: list nat) , short (n::b::input) true (n::output) = None
-> short (b::input) false output = None.
with short as follows :
Fixpoint short (input: list nat) (starting : bool) (output: list nat) : option (list nat) :=
match input with
| nil => match output with
| nil => Some nil
| y::r => None
end
| x::rest => match output with
| nil => ...
| y::r => if ( beq_nat x y ) then match (short rest false r) with
| None => if (starting) then match (short rest starting output) with
| Some pp => Some (0 :: pp)
| None => None
end
else None
| Some pp => Some (x :: pp)
end
else ...
end.
The proof would be simple if I could control the conversion steps to start with
short (n::b::input) true (n::output)
and end up with something like:
match (short (b::input) false output) with
| None => match (short rest starting output) with
| Some pp => Some (0 :: pp)
| None => None
end
| Some pp => Some (x :: pp)
end
I've tried this :
Proof.
intros.
cbv delta in H.
cbv fix in H.
cbv beta in H.
cbv match in H.
rewrite Nat.eqb_refl in H.
...
but it seems that rewrite if doing more than a rewrite and performs a conversion I can't fold again to the desired form...
Any idea how this conversion can be done ?
Thank you !!
The cbn tactic looks like it does a decent job here:
Theorem simple :
forall (n b:nat) (input output: list nat) , short (n::b::input) true (n::output) = None
-> short (b::input) false output = None.
Proof.
intros.
cbn in *.
rewrite Nat.eqb_refl in H.
match goal with | |- ?t = _ => set (x := t) in * end.
destruct x.
all: congruence.
Qed.
In general, I would advise against cbv unless you want to really get eg a boolean. But if you want to do "just a bit of unfolding" cbn or simpl are usually better behaved.
Related
I'm trying to prove a theorem involving a function that uses a destructuring let expression, and am trying to use the match goal tactic to destruct the right hand side, but for some reason the pattern doesn't match like I'd expect it to:
match goal with
(* why doesn't this match? *)
| [ |- context[let _ := ?X in _] ] => destruct X
end.
Here's a code snippet that should be runnable, if you have Cpdt from Certified Programming with Dependent Types (I'm a huge convert to his style of automation).
I have found a proof, but I'm planning on proving many more theorems with a similar shape, and I'd like to have an automated tactic capable of proving many of them.
Set Implicit Arguments. Set Asymmetric Patterns.
Require Import List Cpdt.CpdtTactics.
Import ListNotations.
Section PairList.
Variable K V: Set.
Variable K_eq_dec: forall x y: K, {x = y} + {x <> y}.
Variable V_eq_dec: forall x y: V, {x = y} + {x <> y}.
Definition Pair: Type := (K * V).
Definition PairList := list Pair.
(* ... *)
Fixpoint set (l: PairList) (key: K) (value: V): PairList :=
match l with
| [] => [(key, value)]
| pr::l' => let (k, _) := pr in
if K_eq_dec key k then (key, value)::l' else pr::(set l' key value)
end.
Theorem set_NotEmpty: forall (before after: PairList) key value,
after = set before key value -> after <> [].
Proof.
intros before after. induction before.
- crush.
- intros. rewrite -> H. simpl.
(* the context at this step:
1 subgoal
K, V : Set
K_eq_dec : ...
V_eq_dec : ...
a : Pair
before : list Pair
after : PairList
IHbefore: ...
key : K
value : V
H : ...
============================
(let (k, _) := a in
if K_eq_dec key k
then (key, value) :: before
else
a :: set before key value) <> []
*)
(* a successful proof
destruct a.
destruct (K_eq_dec key k); crush.
*)
match goal with
(* why doesn't this match? *)
| [ |- context[let _ := ?X in _] ] => destruct X
| [ |- context[(() <> [])] ] => idtac X
end.
(* the above command prints this:
(let (k, _) := a in
if K_eq_dec key k
then (key, value) :: before
else
a :: set before key value)
*)
Qed.
End PairList.
Destructuring lets are actually matches, so you need to look for a match. When a tactic doesn't match, you can see all expressions in your goal desugared with Set Printing All.
match goal with
| [ |- context[let _ := ?X in _] ] => destruct X
(* ADD THIS LINE *)
| [ |- context[match ?X with _ => _ end]] => destruct X
| [ |- context[(() <> [])] ] => idtac X
end.
I'm having a great difficulty trying to prove even very simple lemmas about a function I defined. This is my definition:
Require Import List.
Require Export Omega.
Require Export FunInd.
Require Export Recdef.
Notation "A :: B" := (cons A B).
Notation "[]" := nil.
Notation "[[ A ]]" := (A :: nil).
Inductive tm :=
| E: nat -> tm
| L: list tm -> tm.
Definition T := list tm.
Fixpoint add_list (l: list nat) : nat :=
match l with
| [] => 0
| n :: l' => n + (add_list l')
end.
Fixpoint depth (t: tm) : nat :=
match t with
| E _ => 1
| L l => 1 + (add_list (map depth l))
end.
Definition sum_depth (l: T) := add_list (map depth l).
Function sum_total (l: T) {measure sum_depth l} : nat :=
match l with
| [] => 0
| [[E n]] => n
| [[L li]] => sum_total li
| E n :: l' => n + (sum_total l')
| L li :: l' => (sum_total li) + (sum_total l')
end.
Proof.
- auto.
- intros; unfold sum_depth; subst. simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
- intros; subst; unfold sum_depth; simpl; omega.
Defined.
The inductive type can't be changed.
I can prove simple propositions like Lemma test : forall n, sum_total [[E n]] = n. using the compute tactic, but another trivial lemma like Lemma test2 : forall l, sum_total [[L l]] = sum_total l. hangs.
First, it seems OK that the compute tactic "hangs" on the goal you mention (because when using the Function … Proof. … Defined. definition methodology, your function sum_total incorporates some proof terms, which are not intended to be computed − all the more on an arbitrary argument l; maybe a tactic such as simpl or cbn would be more suitable in this context).
Independently of my comment on list notations, I had a closer look on your formalization and it seems the Function command is unneeded in your case, because sum_total is essentially structural, so you could use a mere Fixpoint, provided the inductive type you are looking at is slightly rephrased to be defined in one go as a mutually-defined inductive type (see the corresponding doc of the Inductive command in Coq's refman which gives a similar, typical example of "tree / forest").
To elaborate on your example, you may want to adapt your definition (if it is possible for your use case) like this:
Inductive tm :=
| E: nat -> tm
| L: T -> tm
with T :=
Nil : T
| Cons : forall (e : tm) (l : T), T.
Notation "[[ A ]]" := (Cons A Nil).
Fixpoint sum_total (l: T) {struct l} : nat :=
match l with
| Nil => 0
| [[E n]] => n
| [[L li]] => sum_total li
| Cons (E n) l' => n + (sum_total l')
| Cons (L li) l' => (sum_total li) + (sum_total l')
end.
(* and the lemma you were talking about is immediate *)
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
reflexivity.
Qed.
Otherwise (if you cannot rephrase your tm inductive like this), another solution would be to use another strategy than Function to define your sum_total function, e.g. Program Fixpoint, or the Equations plugin (which are much more flexible and robust than Function when dealing with non-structural recursion / dependently-typed pattern matching).
Edit: as the OP mentions the inductive type itself can't be changed, there is a direct solution, even when using the mere Function machinery: relying on the "equation lemma" that is automatically generated by the definition.
To be more precise, if you take your script as is, then you get the following lemma "for free":
Search sum_total "equation".
(*
sum_total_equation:
forall l : T,
sum_total l =
match l with
| [] => 0
| [[E n]] => n
| E n :: (_ :: _) as l' => n + sum_total l'
| [[L li]] => sum_total li
| L li :: (_ :: _) as l' => sum_total li + sum_total l'
end
*)
So you could easily state and prove the lemma you are interested in by doing:
Lemma test2 : forall l, sum_total [[L l]] = sum_total l.
intros l.
rewrite sum_total_equation.
reflexivity.
Qed.
Here is an answer that doesn't require changing the inductive type.
There is a simple definition of sum_total that is both comparatively easy to understand and gives (almost) the lemma you are looking for by compute.
Fixpoint sum_tm (t : tm) : nat :=
match t with
| E n => n
| L li => list_sum (map sum_tm li)
end.
Definition sum_total (l : T) : nat := list_sum (map sum_tm l).
Lemma test2 : forall l, sum_total [[L l]] = sum_total l + 0.
reflexivity.
Qed.
(list_sum comes from the List module.)
Notice how the definition of sum_tm and sum_total exactly follows the structure of the definition of term and T, with list_sum (composed with map) corresponding to the use of list. This pattern is in general effective for these problems with nested inductives.
If you want to get rid of the + 0, you can define a different version of list_sum that includes a case for the singleton list (and you can fuse this with map if you want, though it is not necessary).
That would look like replacing list_sum with list_sum_alt defined as
Fixpoint list_sum_alt (l : list nat) : nat :=
match l with
| [] => 0
| [[n]] => n
| n :: li => n + list_sum_alt li
end.
With this definition, test2 holds by compute.
I want to declare a function that yeilds the element (b, n) that the b is equal to true.
Require Export List.
Import Coq.Lists.List.ListNotations.
Definition lstest := list (bool * nat).
Fixpoint existbool (l : lstest) : option (bool * nat) :=
match l with
| [] => None
| (b, n) :: l' => if b then Some (b, n) else existbool l'
end.
The function always get the first element satisfyting b = true. I want to express that there exists an element satisfyting b = true and returns the element. How can I define such a function?
In the following function the type of existbool_ex tells you that we output a pair contained in the list with its first element true (assuming we output a Some).
(* These are all from the standard library *)
Locate "{ _ : _ | _ }".
Print sig.
Print In.
Print fst.
(* Defining Property here to shorten code for exist *)
Definition P l (x : bool * nat) := fst x = true /\ In x l.
Fixpoint existbool_ex (l : list (bool * nat)) :
option {x : bool * nat | fst x = true /\ In x l} :=
match l return option {x : bool * nat | P l x} with
| [] => None
| x' :: l' =>
match x' with
| (true,n) as ans =>
Some (exist (P (ans :: l')) ans (conj eq_refl (or_introl eq_refl)))
| (false,n) =>
match existbool_ex l' with
| None => None
| Some (exist _ x a) =>
match a with
| conj Heq Hin =>
Some (exist (P ((false, n) :: l')) x (conj Heq (or_intror Hin)))
end
end
end
end.
(* Note the as pattern got desugared into a let binding. *)
Print existbool_ex.
(* However we have a somewhat sane extraction, (tail recursive) *)
Require Extraction.
Extraction existbool_ex.
You could write a function get_number that requires a proof that the list has a true value somewhere.
Definition has_true (l : lstest):= exists n, In (true, n) l.
get_number is defined with the help of refine which lets us leave 'holes' (written _) in the proof term to fill in later. Here we have two holes; one for the absurd case when the list is [], and one where we construct the proof term for the recursive call.
Fixpoint get_number (l:lstest) (H: has_true l) : nat.
refine (
match l as l' return l' = _ -> nat with
| (true, n)::_ => fun L => n
| (false, _)::l' => fun L => get_number l' _
| [] => fun L => _
end eq_refl).
now exfalso; subst l; inversion H.
now subst l; inversion H; inversion H0;
[congruence | eexists; eauto].
Defined.
The function uses the convoy pattern so that the match statement does not forget the shape of l in the different branches.
If you want to, you can prove rewriting lemmas to make it easier to use.
Lemma get_number_false l m H: exists H', get_number ((false, m)::l) H = get_number l H'.
Proof. eexists; reflexivity. Qed.
Lemma get_number_true l m H: get_number ((true, m)::l) H = m.
Proof. reflexivity. Qed.
Lemma get_number_nil H m: get_number [] H <> m.
Proof. now inversion H. Qed.
Lemma get_number_proof_irrel l H1 H2: get_number l H1 = get_number l H2.
Proof. induction l as [ | [[|] ?] l']; eauto; now inversion H1. Qed.
It looks definitely simple task until I actually try to work on it. My method is to use twin pointers to avoid asking the length of the list ahead of time, but the difficulties come from the implication that I know for sure one list is "no emptier" than another. Specifically, in pseudo-coq:
Definition twin_ptr (heads, tail, rem : list nat) :=
match tail, rem with
| _, [] => (rev heads, tail)
| _, [_] => (rev heads, tail)
| t :: tl, _ :: _ :: rm => twin_ptr (t :: heads) tl rm
end.
Definition split (l : list nat) := twin_ptr [] l l
But definitely it's not going to compile because the match cases are incomplete. However, the missing case by construction doesn't exist.
What's your way of implementing it?
I you are not afraid of dependent types, you can add a proof that rem is shorter than tail as an argument of twin_ptr. Using Program to help manage these dependent types, this could give the following.
Require Import List. Import ListNotations.
Require Import Program.
Require Import Arith.
Require Import Omega.
Program Fixpoint twin_ptr
(heads tail rem : list nat)
(H:List.length rem <= List.length tail) :=
match tail, rem with
| a1, [] => (rev heads, tail)
| a2, [a3] => (rev heads, tail)
| t :: tl, _ :: _ :: rm => twin_ptr (t :: heads) tl rm _
| [], _::_::_ => !
end.
Next Obligation.
simpl in H. omega.
Qed.
Next Obligation.
simpl in H. omega.
Qed.
Definition split (l : list nat) := twin_ptr [] l l (le_n _).
The exclamation mark means that a branch is unreachable.
You can then prove lemmas about twin_ptr and deduce the properties of split from them. For example,
Lemma twin_ptr_correct : forall head tail rem H h t,
twin_ptr head tail rem H = (h, t) ->
h ++ t = rev head ++ tail.
Proof.
Admitted.
Lemma split_correct : forall l h t,
split l = (h, t) ->
h ++ t = l.
Proof.
intros. apply twin_ptr_correct in H. assumption.
Qed.
Personally, I dislike to use dependent types in functions, as resulting objects are more difficult to manipulate. Instead, I prefer defining total functions and give them the right hypotheses in the lemmas.
You do not need to maintain the invariant that the second list is bigger than the third. Here is a possible solution:
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Div2.
Require Import Coq.Lists.List.
Import ListNotations.
Section Split.
Variable A : Type.
Fixpoint split_aux (hs ts l : list A) {struct l} : list A * list A :=
match l with
| [] => (rev hs, ts)
| [_] => (rev hs, ts)
| _ :: _ :: l' =>
match ts with
| [] => (rev hs, [])
| h :: ts => split_aux (h :: hs) ts l'
end
end.
Lemma split_aux_spec hs ts l n :
n = div2 (length l) ->
split_aux hs ts l = (rev (rev (firstn n ts) ++ hs), skipn n ts).
Proof.
revert hs ts l.
induction n as [|n IH].
- intros hs ts [|x [|y l]]; easy.
- intros hs ts [|x [|y l]]; simpl; try easy.
intros Hn.
destruct ts as [|h ts]; try easy.
rewrite IH; try congruence.
now simpl; rewrite <- app_assoc.
Qed.
Definition split l := split_aux [] l l.
Lemma split_spec l :
split l = (firstn (div2 (length l)) l, skipn (div2 (length l)) l).
Proof.
unfold split.
rewrite (split_aux_spec [] l l (div2 (length l))); trivial.
now rewrite app_nil_r, rev_involutive.
Qed.
End Split.
May I suggest going via a more precise type? The main idea is to define a function splitting a Vector.t whose nat index has the shape m + n into a Vector.t of size m and one of size n.
Require Import Vector.
Definition split_vector : forall a m n,
Vector.t a (m + n) -> (Vector.t a m * Vector.t a n).
Proof.
intros a m n; induction m; intro v.
- firstorder; constructor.
- destruct (IHm (tl v)) as [xs ys].
firstorder; constructor; [exact (hd v)|assumption].
Defined.
Once you have this, you've reduced your problem to defining the floor and ceil of n / 2 and proving that they sum to n.
Fixpoint div2_floor_ceil (n : nat) : (nat * nat) := match n with
| O => (O , O)
| S O => (O , S O)
| S (S n') => let (p , q) := div2_floor_ceil n'
in (S p, S q)
end.
Definition div2_floor (n : nat) := fst (div2_floor_ceil n).
Definition div2_ceil (n : nat) := snd (div2_floor_ceil n).
Lemma plus_div2_floor_ceil : forall n, div2_floor n + div2_ceil n = n.
Proof.
refine
(fix ih n := match n with
| O => _
| S O => _
| S (S n') => _
end); try reflexivity.
unfold div2_floor, div2_ceil in *; simpl.
destruct (div2_floor_ceil n') as [p q] eqn: eq.
simpl.
replace p with (div2_floor n') by (unfold div2_floor ; rewrite eq ; auto).
replace q with (div2_ceil n') by (unfold div2_ceil ; rewrite eq ; auto).
rewrite <- plus_n_Sm; do 2 f_equal.
apply ih.
Qed.
Indeed, you can then convert length xs into ceil (length xs / 2) + floor (length xs / 2) and use split_vector to get each part.
Definition split_list a (xs : list a) : (list a * list a).
Proof.
refine
(let v := of_list xs in
let (p , q) := split_vector a (div2_floor _) (div2_ceil _) _ in
(to_list p, to_list q)).
rewrite plus_div2_floor_ceil; exact v.
Defined.
I'm new to Coq and have a quick question about the destruct tactic. Suppose I have a count function that counts the number of occurrences of a given natural number in a list of natural numbers:
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v xs
| false => count v xs
end
end.
I'd like to prove the following theorem:
Theorem count_cons : forall (n y : nat) (xs : natlist),
count n (y :: xs) = count n xs + count n [y].
If I were proving the analogous theorem for n = 0, I could simply destruct y to 0 or S y'. For the general case, what I'd like to do is destruct (beq_nat n y) to true or false, but I can't seem to get that to work--I'm missing some piece of Coq syntax.
Any ideas?
Your code is broken
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v xs (*will not compile since "count v xs" is not simply recursive*)
| false => count v xs
end
end.
you probably meant
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v t
| false => count v t
end
end.
Using destruct is then a perfectly good way to get your solution. But, you need to keep a few things in mind
destruct is syntactic, that is it replaces terms that are expressed in your goal/assumptions. So, you normally need something like simpl (works here) or unfold first.
the order of terms matters. destruct (beq_nat n y) is not the same thing as destruct (beq_nat y n). In this case you want the second of those
Generally the problem is destruct is dumb, so you have to do the smarts yourself.
Anyways, start your proof
intros n y xs. simpl. destruct (beq_nat y n).
And all will be good.