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.
Related
I want to solve a lemma which relate two lists after removing a number from the list with the help of following functions. Here is code
Theorem remove_decr_count: forall (l : list nat),
leb (count 0 (remove_one 0 s)) (count 0 s) = true.
Used functions are
Fixpoint remove_one (v:nat) (l:list nat) : list nat:=
match l with
| [] => []
| h :: t => if beq_nat v h then t else h :: remove_one v t
end.
Fixpoint leb (n m:nat) : bool :=
match n, m with
| O, _ => true
| S _, O => false
| S n', S m' => leb n' m'
end.
Fixpoint count (v:nat) (l:list nat) : nat :=
match l with
| [] => 0
| h :: t => (if beq_nat h v then 1 else 0) + (count v t)
end.
One way to proceed is by induction on the list l (warning: you used s in the theorem's definition, though), and then by case, on whether the head of the list is 0 or not. Rewrites are used to guide the proof.
Using the SSReflect tactics language, the proof could proceed like this (I replaced beq_nat by ==, and added the leb1 lemma, which is also proved by induction, here on n).
From Coq Require Import Init.Prelude Unicode.Utf8.
From mathcomp Require Import all_ssreflect.
Fixpoint remove_one (v:nat) (l:list nat) : list nat:=
match l with
| nil => nil
| cons h t => if v == h then t else cons h (remove_one v t)
end.
Fixpoint count (v:nat) (l:list nat) : nat :=
match l with
| nil => 0
| cons h t => (if h == v then 1 else 0) + (count v t)
end.
Fixpoint leb (n m:nat) : bool :=
match n, m with
| O, _ => true
| S _, O => false
| S n', S m' => leb n' m'
end.
Lemma leb1 (n : nat) : leb n (S n).
Proof. by elim: n. Qed.
Theorem remove_decr_count: forall (l : list nat),
leb (count 0 (remove_one 0 l)) (count 0 l).
Proof.
elim=> [|h t IH] //=.
- have [] := boolP (h == 0) => eqh0.
by rewrite eq_sym eqh0 leb1.
- by rewrite eq_sym ifN //= ifN.
Qed.
I have function,whose output is some natural number.I have proved a lemma,that output of this function cannot be zero. It means output is equal to some natural number S m.I want to convert the above lemma.
Theorem greater:forall (m :nat)(l:list nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
The statement you entered does not type check. Regardless, I don't see how it could hold -- for instance, if by l you mean f1 : nat, then the statement would imply that 3 = 2.
Require Import Coq.Arith.Arith.
Theorem greater:forall (m :nat)(f1:nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
Admitted.
Lemma contra : False.
Proof.
pose proof (greater 1 2 eq_refl eq_refl).
easy.
Qed.
Proving that something that is not zero is a successor can be done as follows:
Require Import Coq.Arith.Arith.
Lemma not_zero_succ :
forall n, n <> 0 ->
exists m, n = S m.
Proof. destruct n as [|n]; eauto; easy. Qed.
Edit The complete statement you wrote below is also contradictory:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint lt_numb (n: nat) (l: list nat) : nat :=
match l with
| nil => 0
| h::tl =>
if h <? n then S (lt_numb n tl) else lt_numb n tl
end.
Fixpoint greatest (large: nat) (l: list nat) : nat :=
match large with
| O => 0
| S m' => (lt_numb large l) + (greatest m' l)
end.
Definition change (n: nat) (l: list nat) : list nat :=
match l with
| nil => l
| h::tl => if n <? h then l else n::tl
end.
Fixpoint g_value (elements: nat) (l: list nat) : nat :=
match l with
| nil => 0
| [n] => n
| h :: l =>
match elements with
| O => h
| S elements' => g_value elements' (change h l)
end
end.
Theorem no_elements : forall (m n z :nat)(l:list nat),
m=?0=false -> greatest(g_value (length (n :: l)) (n :: l) + m) (n :: l) = (S z).
Proof. Admitted.
Goal False.
pose proof (no_elements 1 0 1 [] eq_refl).
simpl in H.
discriminate.
Qed.
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.
We have a function that inserts an element into a specific index of a list.
Fixpoint inject_into {A} (x : A) (l : list A) (n : nat) : option (list A) :=
match n, l with
| 0, _ => Some (x :: l)
| S k, [] => None
| S k, h :: t => let kwa := inject_into x t k
in match kwa with
| None => None
| Some l' => Some (h :: l')
end
end.
The following property of the aforementioned function is of relevance to the problem (proof omitted, straightforward induction on l with n not being fixed):
Theorem inject_correct_index : forall A x (l : list A) n,
n <= length l -> exists l', inject_into x l n = Some l'.
And we have a computational definition of permutations, with iota k being a list of nats [0...k]:
Fixpoint permute {A} (l : list A) : list (list A) :=
match l with
| [] => [[]]
| h :: t => flat_map (
fun x => map (
fun y => match inject_into h x y with
| None => []
| Some permutations => permutations
end
) (iota (length t))) (permute t)
end.
The theorem we're trying to prove:
Theorem num_permutations : forall A (l : list A) k,
length l = k -> length (permute l) = factorial k.
By induction on l we can (eventually) get to following goal: length (permute (a :: l)) = S (length l) * length (permute l). If we now simply cbn, the resulting goal is stated as follows:
length
(flat_map
(fun x : list A =>
map
(fun y : nat =>
match inject_into a x y with
| Some permutations => permutations
| None => []
end) (iota (length l))) (permute l)) =
length (permute l) + length l * length (permute l)
Here I would like to proceed by destruct (inject_into a x y), which is impossible considering x and y are lambda arguments. Please note that we will never get the None branch as a result of the lemma inject_correct_index.
How does one proceed from this proof state? (Please do note that I am not trying to simply complete the proof of the theorem, that's completely irrelevant.)
There is a way to rewrite under binders: the setoid_rewrite tactic (see ยง27.3.1 of the Coq Reference manual).
However, direct rewriting under lambdas is not possible without assuming an axiom as powerful as the axiom of functional extensionality (functional_extensionality).
Otherwise, we could have proved:
(* classical example *)
Goal (fun n => n + 0) = (fun n => n).
Fail setoid_rewrite <- plus_n_O.
Abort.
See here for more detail.
Nevertheless, if you are willing to accept such axiom, then you can use the approach described by Matthieu Sozeau in this Coq Club post to rewrite under lambdas like so:
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.Morphisms.
Generalizable All Variables.
Instance pointwise_eq_ext {A B : Type} `(sb : subrelation B RB eq)
: subrelation (pointwise_relation A RB) eq.
Proof. intros f g Hfg. apply functional_extensionality. intro x; apply sb, (Hfg x). Qed.
Goal (fun n => n + 0) = (fun n => n).
setoid_rewrite <- plus_n_O.
reflexivity.
Qed.