Stuck proving lemma with unprovable subgoals - coq

I'm trying to prove a lemma that's based on the following definitions.
Section lemma.
Variable A : Type.
Variable P : A -> Prop.
Variable P_dec : forall x, {P x}+{~P x}.
Inductive vector : nat -> Type :=
| Vnil : vector O
| Vcons : forall {n}, A -> vector n -> vector (S n).
Arguments Vcons {_} _ _.
Fixpoint countPV {n: nat} (v : vector n): nat :=
match v with
| Vnil => O
| Vcons x v' => if P_dec x then S (countPV v') else countPV v'
end.
The lemma I'm trying to prove is as follows
Lemma lem: forall (n:nat) (a:A) (v:vector n),
S n = countPV (Vcons a v) -> (P a /\ n = countPV v).
I've tried a lot of things and currently I'm at this point.
Proof.
intros n a v.
unfold not in P_dec.
simpl.
destruct P_dec.
- intros.
split.
* exact p.
* apply eq_add_S.
exact H.
- intros.
split.
The context at this point:
2 subgoals
A : Type
P : A -> Prop
P_dec : forall x : A, {P x} + {P x -> False}
n : nat
a : A
v : vector n
f : P a -> False
H : S n = countPV v
______________________________________(1/2)
P a
______________________________________(2/2)
n = countPV v
My issue is that I seem to be stuck with two subgoals that I can not prove and the available context does not seem to be helpful. Can anyone provide me with some pointers to move on?
EDIT:
I've proven the lemma by contradicting H:
assert (countPV v <= n).
* apply countNotBiggerThanConstructor.
* omega.
Qed.
where countNotBiggerThanConstructor is:
Lemma countNotBiggerThanConstructor: forall {n : nat} (v: vector n), countPV v <= n.
Proof.
intros n v.
induction v.
- reflexivity.
- simpl.
destruct P_dec.
+ apply le_n_S in IHv.
assumption.
+ apply le_S.
assumption.
Qed.

Notice that H can't possibly be true. That is a good thing, if you can prove False, you can prove anything. So I would do contradict H next (and you don't need that last split).
Overall your proof seems a little messy to me. I suggest thinking about how you would prove this lemma on paper and trying to do that in Coq. I am not an expert in Coq, but I think it would also help you realize, that you need to use contradiction in this case.
(Edit: BTW other answers suggesting that this lemma does not hold are wrong, but I can't comment with my 1 reputation)

Related

Proof irrelevance for boolean equality

I'm trying to prove group axioms for Z_3 type:
Require Import Coq.Arith.PeanoNat.
Record Z_3 : Type := Z3
{
n :> nat;
proof : (Nat.ltb n 3) = true
}.
Proposition lt_0_3 : (0 <? 3) = true.
Proof.
simpl. reflexivity.
Qed.
Definition z3_0 : Z_3 := (Z3 0 lt_0_3).
Proposition lt_1_3 : (1 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_1 : Z_3 := (Z3 1 lt_1_3).
Proposition lt_2_3 : (2 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_2 : Z_3 := (Z3 2 lt_2_3).
Proposition three_ne_0 : 3 <> 0.
Proof.
discriminate.
Qed.
Lemma mod_upper_bound_bool : forall (a b : nat), (not (eq b O)) -> (Nat.ltb (a mod b) b) = true.
Proof.
intros a b H. apply (Nat.mod_upper_bound a b) in H. case Nat.ltb_spec0.
- reflexivity.
- intros Hcontr. contradiction.
Qed.
Definition Z3_op (x y: Z_3) : Z_3 :=
let a := (x + y) mod 3 in
Z3 a (mod_upper_bound_bool _ 3 three_ne_0).
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal.
We are almost done:
1 subgoal (ID 41)
n, m : nat
p, q : (m <? 3) = true
============================
p = q
What theorem should I use to prove that p = q?
Update 1
Theorem bool_dec :
(forall x y: bool, {x = y} + {x <> y}).
Proof.
intros x y. destruct x.
- destruct y.
+ left. reflexivity.
+ right. intro. discriminate H.
- destruct y.
+ right. intro. discriminate H.
+ left. reflexivity.
Qed.
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal. apply UIP_dec. apply bool_dec.
Qed.
You are probably interested in knowing that every two proofs of a decidable equality are equal. This is explained and proved here: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html
You are interested in particular in the lemma UIP_dec: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html#UIP_dec
Theorem UIP_dec :
forall (A:Type),
(forall x y:A, {x = y} + {x <> y}) ->
forall (x y:A) (p1 p2:x = y), p1 = p2.
You will have then to prove that equalities of booleans are decidable (i.e. that you can write a function which says whether two given booleans are equal or not) which you should also be able to find in the standard library but which should be easily provable by hand as well.
This is a different question but since you asked: bool_dec exists and even has that name!
The easy way to find it is to use the command
Search sumbool bool.
It will turn up several lemmata, including pretty early:
Bool.bool_dec: forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}
Why did I search sumbool? sumbool is the type which is written above:
{ A } + { B } := sumbool A B
You can find it using the very nice Locate command:
Locate "{".
will turn up
"{ A } + { B }" := sumbool A B : type_scope (default interpretation)
(and other notations involving "{").

How to proof existence in COQ?

I am quite new to Coq and I am trying to proof the following lemma (with the Reals library):
forall (An : nat -> R) (a : R), Un_cv An a -> Un_cv (fun i : nat => An i - a) 0.
Now, I get stuck when I try to find a suitable N such that for all n >= N the sequence converges. I know how to do it by hand, but I do not know how to program this into Coq.
This is my proof so far:
Proof.
intros An a A_cv.
unfold Un_cv. unfold Un_cv in A_cv.
intros eps eps_pos.
unfold R_dist. unfold R_dist in A_cv.
And I am left with:
1 subgoal
An : nat -> R
a : R
A_cv : forall eps : R,
eps > 0 -> exists N : nat, forall n : nat, (n >= N)%nat -> Rabs (An n - a) < eps
eps : R
eps_pos : eps > 0
______________________________________(1/1)
exists N : nat, forall n : nat, (n >= N)%nat -> Rabs (An n - a - 0) < eps
And the problem is that I do not know how to get rid of the "exists N".
Is this even possible? And if it is, can anyone help me?
Thanks in advance!
Generally, to eliminate exists N in coq, you need to instantiate it with a term. If you were to write this out by hand, you would probably write something like, "since An converges, there is some N such that ..." and then you would use that N in your proof.
To do this in Coq, you will need to use the destruct tactic on A_cv. Once you have this N, you can use it to instantiate and continue like you'd expect.
Full proof for reference:
Lemma some_lemma : forall (An : nat -> R) (a : R), Un_cv An a -> Un_cv (fun i : nat => An i - a) 0.
Proof.
intros An a A_cv.
unfold Un_cv. unfold Un_cv in A_cv.
intros eps eps_pos.
unfold R_dist. unfold R_dist in A_cv.
destruct (A_cv eps eps_pos) as [N HN].
exists N; intro.
rewrite Rminus_0_r.
apply HN.
Qed.

Minimum in non-empty, finite set

With the following definitions I want to prove lemma without_P
Variable n : nat.
Definition mnnat := {m : nat | m < n}.
Variable f : mnnat -> nat.
Lemma without_P : (exists x : mnnat, True) -> (exists x, forall y, f x <= f y).
Lemma without_P means: if you know (the finite) set mnnat is not empty, then there must exist an element in mnnat, that is the smallest of them all, after mapping f onto mnnat.
We know mnnat is finite, as there are n-1 numbers in it and in the context of the proof of without_P we also know mnnat is not empty, because of the premise (exists x : mnnat, True).
Now mnnat being non-empty and finite "naturally/intuitively" has some smallest element (after applying f on all its elements).
At the moment I am stuck at the point below, where I thought to proceed by induction over n, which is not allowed.
1 subgoal
n : nat
f : mnnat -> nat
x : nat
H' : x < n
______________________________________(1/1)
exists (y : nat) (H0 : y < n),
forall (y0 : nat) (H1 : y0 < n),
f (exist (fun m : nat => m < n) y H0) <= f (exist (fun m : nat => m < n) y0 H1)
My only idea here is to assert the existance of a function f' : nat -> nat like this: exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f' (exist (fun m : nat => m < n) x H0) = f x, after solving this assertion I have proven the lemma by induction over n. How can I prove this assertion?
Is there a way to prove "non-empty, finite sets (after applying f to each element) have a minimum" more directly? My current path seems too hard for my Coq-skills.
Require Import Psatz Arith. (* use lia to solve the linear integer arithmetic. *)
Variable f : nat -> nat.
This below is essentially your goal, modulo packing of the statement into some dependent type. (It doesn't say that mi < n, but you can extend the proof statement to also contain that.)
Goal forall n, exists mi, forall i, i < n -> f mi <= f i.
induction n; intros.
- now exists 0; inversion 1. (* n cant be zero *)
- destruct IHn as [mi IHn]. (* get the smallest pos mi, which is < n *)
(* Is f mi still smallest, or is f n the smallest? *)
(* If f mi < f n then mi is the position of the
smallest value, otherwise n is that position,
so consider those two cases. *)
destruct (lt_dec (f mi) (f n));
[ exists mi | exists n];
intros.
+ destruct (eq_nat_dec i n).
subst; lia.
apply IHn; lia.
+ destruct (eq_nat_dec i n).
subst; lia.
apply le_trans with(f mi).
lia.
apply IHn.
lia.
Qed.
Your problem is an specific instance of a more general result which is proven for example in math-comp. There, you even have a notation for denoting "the minimal x such that it meets P", where P must be a decidable predicate.
Without tweaking your statement too much, we get:
From mathcomp Require Import all_ssreflect.
Variable n : nat.
Variable f : 'I_n.+1 -> nat.
Lemma without_P : exists x, forall y, f x <= f y.
Proof.
have/(_ ord0)[] := arg_minP (P:=xpredT) f erefl => i _ P.
by exists i => ?; apply/P.
Qed.
I found a proof to my assertion (exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f (exist (fun m : nat => m < n) x H0) = f' x). by proving the similar assertion (exists (f' : nat -> nat), forall x : mnnat, f x = f' (proj1_sig x)). with Lemma f'exists. The first assertion then follows almost trivially.
After I proved this assertion I can do a similar proof to user larsr, to prove Lemma without_P.
I used the mod-Function to convert any nat to a nat smaller then n, apart from the base case of n = 0.
Lemma mod_mnnat : forall m,
n > 0 -> m mod n < n.
Proof.
intros.
apply PeanoNat.Nat.mod_upper_bound.
intuition.
Qed.
Lemma mod_mnnat' : forall m,
m < n -> m mod n = m.
Proof.
intros.
apply PeanoNat.Nat.mod_small.
auto.
Qed.
Lemma f_proj1_sig : forall x y,
proj1_sig x = proj1_sig y -> f x = f y.
Proof.
intros.
rewrite (sig_eta x).
rewrite (sig_eta y).
destruct x. destruct y as [y H0].
simpl in *.
subst.
assert (l = H0).
apply proof_irrelevance. (* This was tricky to find.
It means two proofs of the same thing are equal themselves.
This makes (exist a b c) (exist a b d) equal,
if c and d prove the same thing. *)
subst.
intuition.
Qed.
(* Main Lemma *)
Lemma f'exists :
exists (ff : nat -> nat), forall x : mnnat, f x = ff (proj1_sig x).
Proof.
assert (n = 0 \/ n > 0).
induction n.
auto.
intuition.
destruct H.
exists (fun m : nat => m).
intuition. destruct x. assert (l' := l). rewrite H in l'. inversion l'.
unfold mnnat in *.
(* I am using the mod-function to map (m : nat) -> {m | m < n} *)
exists (fun m : nat => f (exist (ltn n) (m mod n) (mod_mnnat m H))).
intros.
destruct x.
simpl.
unfold ltn.
assert (l' := l).
apply mod_mnnat' in l'.
assert (proj1_sig (exist (fun m : nat => m < n) x l) = proj1_sig (exist (fun m : nat => m < n) (x mod n) (mod_mnnat x H))).
simpl. rewrite l'.
auto.
apply f_proj1_sig in H0.
auto.
Qed.

How to do induction differently?

I am doing an exercise in Coq and trying to prove if a list equals to its reverse, it's a palindrome. Here is how I define palindromes:
Inductive pal {X : Type} : list X -> Prop :=
| emptypal : pal []
| singlpal : forall x, pal [x]
| inducpal : forall x l, pal l -> pal (x :: l ++ [x]).
Here is the theorem:
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.
According to my definition, I will need to do the induction my extracting the front and tail element but apparently coq won't let me do it, and if I force it to do so, it gives an induction result that definitely doesn't make any sense:
Proof.
intros X l H. remember (rev l) as rl. induction l, rl.
- apply emptypal.
- inversion H.
- inversion H.
- (* stuck *)
context:
1 subgoals
X : Type
x : X
l : list X
x0 : X
rl : list X
Heqrl : x0 :: rl = rev (x :: l)
H : x :: l = x0 :: rl
IHl : x0 :: rl = rev l -> l = x0 :: rl -> pal l
______________________________________(1/1)
pal (x :: l)
aparently the inductive context is terribly wrong. is there any way I can fix the induction?
The solution I propose here is probably not the shortest one, but I think it is rather natural.
My solution consists in defining an induction principle on list specialized to your problem.
Consider natural numbers. There is not only the standard induction nat_ind where you prove P 0 and forall n, P n -> P (S n). But there are other induction schemes, e.g., the strong induction lt_wf_ind, or the two-step induction where you prove P 0, P 1 and forall n, P n -> P (S (S n)). If the standard induction scheme is not strong enough to prove the property you want, you can try another one.
We can do the same for lists. If the standard induction scheme list_ind is not enough, we can write another one that works. In this idea, we define for lists an induction principle similar to the two-step induction on nat (and we will prove the validity of this induction scheme using the two-step induction on nat), where we need to prove three cases: P [], forall x, P [x] and forall x l x', P l -> P (x :: l ++ [x']). The proof of this scheme is the difficult part. Applying it to deduce your theorem is quite straightforward.
I don't know if the two-step induction scheme is part of the standard library, so I introduce it as an axiom.
Axiom nat_ind2 : forall P : nat -> Prop, P 0 -> P 1 ->
(forall n : nat, P n -> P (S (S n))) -> forall n : nat, P n.
Then we prove the induction scheme we want.
Lemma list_ind2 : forall {A} (P : list A -> Prop) (P_nil : P [])
(P_single : forall x, P [x])
(P_cons_snoc : forall x l x', P l -> P (x :: l ++ [x'])),
forall l, P l.
Proof.
intros. remember (length l) as n. symmetry in Heqn. revert dependent l.
induction n using nat_ind2; intros.
- apply length_zero_iff_nil in Heqn. subst l. apply P_nil.
- destruct l; [discriminate|]. simpl in Heqn. inversion Heqn; subst.
apply length_zero_iff_nil in H0. subst l. apply P_single.
- destruct l; [discriminate|]. simpl in Heqn.
inversion Heqn; subst. pose proof (rev_involutive l) as Hinv.
destruct (rev l). destruct l; discriminate. simpl in Hinv. subst l.
rewrite app_length in H0.
rewrite PeanoNat.Nat.add_comm in H0. simpl in H0. inversion H0.
apply P_cons_snoc. apply IHn. assumption.
Qed.
You should be able to conclude quite easily using this induction principle.
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.

Define an inductive dependent-type with constraints on the type-parameter

I try to define an inductive dependent-type in Coq to represent bit-vector variables in bit-vector logic.
I read this blog post by Xavier Leroy in which he defines such a structure as follow:
Require Import Vector.
Inductive bitvector : Type := Bitvector (n: nat) (v: Vector.t bool n).
Then, to test this way of doing I tried to define the bitwise negation operator as follow:
Definition bv_neg (v : bitvector) :=
match v with
Bitvector n w => Bitvector n (Vector.map negb w)
end.
And, started to prove that applying two time the negation is equivalent to the identity:
Lemma double_neg :
forall (v : bitvector), (bv_neg (bv_neg v) = v).
But, while I was trying to do the proof, I realized that having a zero-sized bit-vector make no sense and force to handle the special case n = 0 in every proof.
So, I would like to know how to force the parameter of the inductive dependent-type to be strictly positive.
Any hint is welcome !
One way to do so is to make sure that the stored Vector is of size S n.
Inductive bitvector : Type := Bitvector (n: nat) (v: Vector.t bool (S n)).
But, I don't see why you'd want to do that in this particular situation given that the lemma is perfectly provable: it is a rather simple corollary of more general lemmas you'll probably need later on.
Your definitions (without the S n alteration):
Require Import Vector.
Inductive bitvector : Type := Bitvector (n: nat) (v: Vector.t bool n).
Definition bv_neg (v : bitvector) :=
match v with
Bitvector n w => Bitvector n (Vector.map negb w)
end.
Some results on Vector.map:
Lemma map_fusion :
forall {A B C} {g : B -> C} {f : A -> B} {n : nat} (v : Vector.t A n),
Vector.map g (Vector.map f v) = Vector.map (fun x => g (f x)) v.
Proof.
intros A B C g f n v ; induction v.
- reflexivity.
- simpl; f_equal; assumption.
Qed.
Lemma map_id :
forall {A} {n : nat} (v : Vector.t A n), Vector.map (#id A) v = v.
Proof.
intros A n v ; induction v.
- reflexivity.
- simpl; f_equal; assumption.
Qed.
Lemma map_extensional :
forall {A B} {f1 f2 : A -> B}
(feq : forall a, f1 a = f2 a) {n : nat} (v : Vector.t A n),
Vector.map f1 v = Vector.map f2 v.
Proof.
intros A B f1 f2 feq n v ; induction v.
- reflexivity.
- simpl; f_equal; [apply feq | assumption].
Qed.
Finally, your result:
Lemma double_neg :
forall (v : bitvector), (bv_neg (bv_neg v) = v).
Proof.
intros (n, v).
simpl; f_equal.
rewrite map_fusion, <- map_id.
apply map_extensional.
- intros []; reflexivity.
Qed.
Just to be sure I understood well the comments of Arthur Azevedo De Amorim, I tried to rewrite my Coq module trying to remove the syntactic sugar and the unnecessary concealement of the size.
First, just by looking at the available module in Coq, one can fin the Coq.Bool.Bvector module that is quite close to what I want... But, a lot is missing (especially the modular arithmetic part) and, moreover, I disagree with a few rules such as encoding the sign or having true and false as a particular case of size = 1).
So, my module is almost a copy of the Coq.Bool.Bvector but with slight modifications to make me happy (I might be wrong, we will see it in the future).
Here is the rewritten module:
Require Import Arith Bool Vector.
(** Unsigned Bitvector type *)
Definition bitvector := Vector.t bool.
Definition nil := #Vector.nil bool.
Definition cons := #Vector.cons bool.
Definition bv_low := #Vector.hd bool.
Definition bv_high := #Vector.tl bool.
(** A bitvector is false if zero and true otherwise. *)
Definition bv_test n (v : bitvector n) := Vector.fold_left orb false v.
(** Bitwise operators *)
Definition bv_neg n (v : bitvector n) := Vector.map negb v.
Definition bv_and n (v w : bitvector n) := Vector.map2 andb v w.
Definition bv_or n (v w : bitvector n) := Vector.map2 orb v w.
Definition bv_xor n (v w : bitvector n) := Vector.map2 xorb v w.
(** Shift/Rotate operators *)
(* TODO *)
(** Arithmetic operators *)
(* TODO *)
Then, I tried to prove (again) the double negation thing with the help of the Guillaume Allais hints:
Lemma map_fusion :
forall {A B C} {g : B -> C} {f : A -> B} {n : nat} (v : Vector.t A n),
Vector.map g (Vector.map f v) = Vector.map (fun x => g (f x)) v.
Proof.
intros A B C g f n v ; induction v.
- reflexivity.
- simpl; f_equal; assumption.
Qed.
Lemma map_id :
forall {A} {n : nat} (v : Vector.t A n), Vector.map (#id A) v = v.
Proof.
intros A n v ; induction v.
- reflexivity.
- simpl; f_equal; assumption.
Qed.
Lemma map_extensional :
forall {A B} {f1 f2 : A -> B}
(feq : forall a, f1 a = f2 a) {n : nat} (v : Vector.t A n),
Vector.map f1 v = Vector.map f2 v.
Proof.
intros A B f1 f2 feq n v ; induction v.
- reflexivity.
- simpl; f_equal; [apply feq | assumption].
Qed.
Theorem double_neg :
forall (n : nat) (v : bitvector n), bv_neg n (bv_neg n v) = v.
Proof.
intros; unfold bv_neg.
rewrite map_fusion, <- map_id.
apply map_extensional.
- intros []; reflexivity.
Qed.
And, surprisingly (for me), it worked like a charm.
Thanks a lot to all, and if you have comments on this code, feel free to drop a comment. As I am very new to Coq, I really want to improve.
You can prove the theorem by induction on v.
Require Import Vector.
Definition bitvector := Vector.t bool.
Definition bv_neg n (v : bitvector n) := Vector.map negb v.
Theorem double_neg :
forall (n : nat) (v : bitvector n), bv_neg n (bv_neg n v) = v.
Proof.
induction v as [|x]; [|simpl; destruct x; rewrite IHv]; reflexivity.
Qed.