Proving another property of finding same elements in lists - coq

Following my question here, I have a function findshare which finds the same elements in two lists. Actually, keepnotEmpty is the lemma I need in my program after applying some changes to the initial version of lemma sameElements. Lemma keepnotEmpty proves if the result of function findshare on the concatenation of two lists is not empty then the concatenation of the results of the function applied to each one of them is not empty as well. I'm confused how to prove lemma keepnotEmpty. Thank you.
Require Import List .
Import ListNotations.
Fixpoint findshare(s1 s2: list nat): list nat:=
match s1 with
| nil => nil
| v :: tl =>
if ( existsb (Nat.eqb v) s2)
then v :: findshare tl s2
else findshare tl s2
end.
Lemma sameElements l1 l2 tl :
(findshare(l1++l2) tl) =
(findshare l1 tl) ++ (findshare l2 tl ).
Proof.
Admitted.
Lemma keepnotEmpty l1 l2 tl :
(findshare tl (l1++l2)) <> nil -> (findshare tl (l1) ++ (findshare tl (l2))<>nil).
Proof.

You need induction on tl and the property oneNotEmpty of lists to prove lemmakeepnotEmpty.
Lemma oneNotEmpty (l1 l2:list nat):
l1<>nil -> (l2++l1)<>nil.
Proof.
Admitted.
Lemma keepnotEmpty l1 l2 tl :
(findshare tl (l1++l2))<> nil -> (findshare tl (l1) ++ (findshare tl (l2))<>nil).
Proof.
induction tl. simpl; intro. congruence.
simpl.
rewrite existsb_app.
destruct_with_eqn(existsb (Nat.eqb a) l1).
destruct_with_eqn(existsb (Nat.eqb a) l2);
simpl; intros H1 H2; congruence.
destruct_with_eqn(existsb (Nat.eqb a) l2).
simpl. intros. apply (oneNotEmpty);
intro. inversion H0.
simpl; assumption.
Qed.

Related

Proving equivalence of two rev_append implementations

Disclaimer: This is not a homework question.
I am trying to implement my own version of rev_append in Coq, and then to prove that it is equivalent to the built in version. The following is my implementation.
Fixpoint my_rev_append (l1 l2 : list nat) : (list nat) * (list nat) :=
match l1 with
| nil => (l1, l2)
| hd :: tl => my_rev_append tl (hd :: l2)
end.
Then I tried to prove that it is equivalent to rev_append
Theorem my_rev_append_correct : forall (l1 l2 : list nat),
my_rev_append l1 l2 = (nil, (rev_append l1 l2)).
Proof.
intros l1 l2.
induction l1.
reflexivity.
And then I hit the following goal, which I do not see a way to move forward.
IHl1 : my_rev_append l1 l2 = (nil, rev_append l1 l2)
============================
my_rev_append (a :: l1) l2 = (nil, rev_append (a :: l1) l2)
It is not possible to use IHl1, because the RHS of the current subgoal is (nil, rev_append (a :: l1) l2), which does not contain (nil, rev_append l1 l2). I tried to run simpl tactic on it, but it didn't work, as IHl1 is still not applicable.
I totally understand that I can prove this by changing the | nil => (l1, l2) line in my_rev_append into | nil => l2. However, are there any possibility to prove this theorem without changing the definition of my_rev_append?
Your definition has l2 varying through the induction. Therefore, the proof of the theorem should also have l2 varying through the induction. To do this, do not introduce l2 before starting the induction, leaving it in the goal. The inductive hypothesis, whose type is modeled on this goal, then allows you to pass a different value for it in the recursive case.
Theorem my_rev_append_correct : forall (l1 l2 : list nat), my_rev_append l1 l2 = (nil, rev_append l1 l2).
Proof.
induction l1 as [ | x l1 rec]; intros l2.
- reflexivity.
- apply rec.
Qed.

How to prove that the subsequence of an empty list is empty?

I'm new in coq. i am trying to prove that the subsequence of an empty list is empty
This is the lemma i'm working on:
Lemma sub_nil : forall l , subseq l nil <-> l=nil.
i tried to split so i can have
subseq l nil -> l = nil
and
l = nil -> subseq l nil
to prove the first one i tried an induction on l but i blocked when it comes to prove that
subseq (a :: l) nil -> a :: l = nil
thanks.
The tactic to use here is inversion. Paraphrasing the coq documentation for inversion! :
Given an inductive hypothesis (H:I t), then inversion applied to H derives for each possible constructor c i of (I t), all the necessary conditions that should hold for the instance (I t) to be proved by c i.
Assuming the subseq predicate is given as follows:
Inductive subseq {A:Type} : list A -> list A -> Prop :=
| SubNil : forall (l:list A), subseq nil l
| SubCons1 : forall (s l:list A) (x:A), subseq s l -> subseq s (x::l)
| SubCons2 : forall (s l: list A) (x:A), subseq s l -> subseq (x::s) (x::l).
The proof would be stuck here(exactly at the place you specified):
Lemma sub_nil2 : forall (A:Type) (l: list A) , subseq l nil <-> l=nil.
Proof.
split.
- destruct l eqn:E; intros.
* reflexivity.
(*Now unable to prove a::l0 = [] because the hypothesis: subseq (a :: l0) [] is absurd.*)
* inversion H.(*Coq reasons that this hypothesis is not possible and discharges the proof trivially*)
- intros. subst. apply SubNil.
Qed.
Note that I used the destruct tactic but the issue remains even with induction tactic.
The entire proof can be written cleanly as below:
Lemma sub_nil : forall (A:Type) (l: list A) , subseq l nil <-> l=nil.
Proof.
split; intros.
- inversion H. reflexivity.
- subst. apply SubNil.
Qed.

Abstracting patterns in induction rule for inductive predicates for Coq

Consider the following proposition in Coq:
Inductive subseq : list nat -> list nat -> Prop :=
| nil_s : forall (l: list nat), subseq nil l
| cons_in l1 l2 x (H: subseq l1 l2) : subseq (x :: l1) (x :: l2)
| cons_nin l1 l2 x (H: subseq l1 l2) : subseq l1 (x :: l2)
.
Lemma subseq_remove_rewritten: forall (x:nat) (l1' l1 l2 : list nat),
subseq l1' l2 ->
l1' = (x :: l1) ->
subseq l1 l2.
Proof.
intros x l1' l1 l2 H1 H2.
induction H1.
- discriminate.
- injection H2 as H3 H4.
rewrite H4 in H1.
apply cons_nin. apply H1.
- apply IHsubseq in H2.
apply cons_nin. apply H2.
Qed.
Lemma subseq_remove: forall (x:nat) (l1 l2 : list nat),
subseq (x :: l1) l2 ->
subseq l1 l2.
Proof.
intros x l1 l2 H.
apply subseq_remove_rewritten with (x:=x) (l1':=x :: l1).
apply H.
reflexivity.
Qed.
I worked in Isabelle before Coq. There originally, the induction tactic could not solve directly this goal and the trick was to come up with a lemma like subseq_remove_rewritten and then prove the original goal. This is the situation in the manual Isabelle/HOL: A Proof Assistant for Higher-Order Logic. Later, the tactic became smarter and one can write patterns in which to abstract on. So the proof is written like this:
lemma
assumes "subseq (x # l1) l2"
shows "subseq l1 l2"
using assms
apply(induction "x # l1" "l2" rule: subseq.induct)
apply simp
apply(intro subseq.intros(3),simp)
by (intro subseq.intros(3))
I was wondering if Coq has a similar way to avoid proving a lemma like subseq_remove_rewritten and go directly to prove subseq_remove.
You can use the dependent induction tactic (documented here). For example:
Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.Program.Equality. (* Needed to use the tactic *)
Inductive subseq : list nat -> list nat -> Prop :=
| nil_s : forall (l: list nat), subseq nil l
| cons_in l1 l2 x (H: subseq l1 l2) : subseq (x :: l1) (x :: l2)
| cons_nin l1 l2 x (H: subseq l1 l2) : subseq l1 (x :: l2)
.
Lemma subseq_remove: forall (x:nat) (l1 l2 : list nat),
subseq (x :: l1) l2 ->
subseq l1 l2.
Proof.
intros x l1 l2 H.
dependent induction H generalizing x.
- now apply cons_nin.
- eauto using cons_nin.
Qed.
Unfortunately, though this tactic has been around for a while, it is still described as experimental in the reference manual, and I don't know if the Coq developers have any plans of improving it in the future. It has a few deficiencies, such as not allowing the user to name the variables and hypotheses used in the induction proof. I personally prefer to add the equality assumptions to the proof myself, as in your first attempt, or to reformulate the definition of subseq as a Fixpoint, so that you can invert the hypothesis by simplification. For example:
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint subseq (l1 l2 : list nat) : Prop :=
match l1, l2 with
| [], _ => True
| x1 :: l1, [] => False
| x1 :: l1, x2 :: l2 => x1 = x2 /\ subseq l1 l2 \/ subseq (x1 :: l1) l2
end.
Lemma subseq_nin x2 l1 l2 : subseq l1 l2 -> subseq l1 (x2 :: l2).
Proof. destruct l1 as [|x1 l1]; simpl; eauto. Qed.
Lemma subseq_remove: forall (x:nat) (l1 l2 : list nat),
subseq (x :: l1) l2 ->
subseq l1 l2.
Proof.
intros x l1 l2 H.
induction l2 as [|x2 l2 IH]; try easy.
destruct H as [[<- H]|H]; eauto using subseq_nin.
Qed.

Prove a property of finding the same elements in two lists

I'm new to Coq. I have a function findshare which finds the same elements in two lists. Lemma sameElements proves that the result of function findshare on the concatenation of two lists is equal to the concatenation of the results of the function applied to each one of them. I'm a bit stuck in proving lemma sameElements.
Require Import List .
Fixpoint findshare(s1 s2: list nat): list nat:=
match s1 with
| nil => nil
| v :: tl =>
if ( existsb (Nat.eqb v) s2)
then v :: findshare tl s2
else findshare tl s2
end.
Lemma sameElements l1 l2 tl :
(findshare tl (l1++l2)) =
(findshare tl (l1))++ (findshare tl (l2)).
Proof.
You are having trouble because the statement you have is not quite correct: it entails a contradiction. More precisely, it implies that [1; 2] = [2; 1]:
Require Import List .
Fixpoint findshare(s1 s2: list nat): list nat:=
match s1 with
| nil => nil
| v :: tl =>
if ( existsb (Nat.eqb v) s2)
then v :: findshare tl s2
else findshare tl s2
end.
Lemma sameElements l1 l2 tl :
(findshare tl (l1++l2)) =
(findshare tl (l1))++ (findshare tl (l2)).
Admitted.
Import ListNotations.
Lemma contra : False.
Proof.
pose proof (sameElements [1] [2] [2;1]).
simpl in H.
discriminate.
Qed.
You should be able to prove the lemma by swapping tl with l1, l2 and l1 ++ l2, and proceeding by induction on l1.

How can I split a list in half in coq?

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.