I try to prove the following simple Lemma :
Lemma wayBack :
forall (a b n:nat) (input:list nat), a <> n -> implist n (a::b::input) -> implist n input.
were implist is as follows :
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
Any idea how to do this ?
Thank you !!
Here it is:
Require Import Program.Equality.
Lemma wayBack :
forall (a b n:nat) (input:list nat), a <> n -> implist n (a::b::input) -> implist n input.
Proof.
intros.
dependent induction H0.
1: eassumption.
assert (exists l', l = a :: b :: l' /\ input = l' ++ [a0 ; b0]) as [l' [-> ->]].
{
clear - x H0 H.
change (l ++ [a0] ++ [b0]) with (l ++ [a0; b0]) in x.
remember [a0; b0] as t in *.
clear Heqt.
induction H0 in input, t, x, H |- *.
+ cbn in *.
inversion x ; subst.
now destruct H.
+ cbn in *.
inversion x ; subst ; clear x.
eexists ; split.
1: reflexivity.
reflexivity.
+ cbn in x.
rewrite <- app_assoc in x.
edestruct IHimplist as [? []] ; try eassumption.
subst.
eexists ; split.
cbn.
2: rewrite app_assoc.
all: reflexivity.
}
econstructor.
eapply IHimplist ; try eassumption.
reflexivity.
Qed.
There are two main difficulties here: the first is that you want to do an induction on you hypothesis implist n (a::b::input), but since a::b::input is not just a variable, there is a need for some fiddling, that standard induction cannot do, but dependent induction from Program can.
The second difficulty, which actually takes up most of my proof, is to be able to decompose the equality you get in the last case, that where you add values at the beginning rather than at the end of the list.
Related
I try to prove the following theorem:
Theorem implistImpliesOdd :
forall (n:nat) (l:list nat), implist n l -> Nat.Odd(length l).
where implist is as follows :
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
During the proof, I reach the following final goal :
n: nat
l: list nat
a, b: nat
H: implist n (a :: b :: l)
IHl: implist n l -> Nat.Odd (length l)
=======================================
Nat.Odd (length l)
But it seems an inversion can't do the job...
How can I prove the theorem ?
Thank you for your help !!
You can just proceed by induction on the implist predicate itself. E.g.,
From Coq Require Import List PeanoNat.
Import ListNotations.
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
Theorem implistImpliesOdd :
forall (n:nat) (l:list nat), implist n l -> Nat.Odd (length l).
Proof.
intros n l H. rewrite <- Nat.odd_spec.
induction H as [n|a b n l _ IH|a b n l _ IH].
- reflexivity.
- simpl. now rewrite Nat.odd_succ_succ.
- rewrite app_length, app_length. simpl. rewrite Nat.add_comm. simpl.
now rewrite Nat.odd_succ_succ.
Qed.
It is not necessarily the case that the assumption H : implist n (a :: b :: l) comes from a proof starting with GSPairLeft, it could as well consist of an instance of GSPairRight with l = l' ++ [c] ++ [d] and your induction hypothesis wouldn't apply. You can solve your problem using strong induction on the length of the list rather than on the list itself.
I want to prove following lemmas.
Lemma AppendAndSplit {n m}(e:Euc n) (f:Euc m): # (e +++ f) = (e, f).
Proof.
induction e.
reflexivity.
remember (r:::e).
Admitted.
Lemma SplitRule {n m}(e:Euc (n+m)) : (fst (# e)) +++ (snd (# e)) = e.
Proof.
induction n.
reflexivity.
Admitted.
# and +++ are notations of EucAppend and Split_Euc.
I can feel that these hold, but I don't know how prove them.
Please tell me some techniques.
(* There are codes needed below *)
Require Import Coq.Reals.Reals.
Inductive Euc:nat -> Type:=
|RO : Euc 0
|Rn : forall {n:nat}, R -> Euc n -> Euc (S n).
Notation "[ ]" := RO.
Notation "[ r1 , .. , r2 ]" := (Rn r1 .. ( Rn r2 RO ) .. ).
Infix ":::" := Rn (at level 60, right associativity).
Fixpoint EucAppend {n m} (e:Euc n) (f:Euc m) :Euc (n+m):=
match e with
|[] => f
|e' ::: es => e' ::: (EucAppend es f)
end.
Infix "+++" := EucAppend (at level 60, right associativity).
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n ∧ Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- inversion_clear xi.
apply split_Euc in H0 as [l r].
exact (Rn H l, r).
Defined.
Notation "# n" := (split_Euc n) (at level 60, right associativity).
The main problem you cannot solve your goals is because of the definitional problem. Split_Euc is defined to perform induction on n, and that's okay however, the definitions perform an inversion on Euc. Inversion is normally a tactic for proofs, once the tactics generate very heavy proofs terms :
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n * Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- inversion_clear xi.
Show Proof. (* let see what is actually the problem *)
...
Defined.
You'll see something like that :
eq_rec_r (fun n2 : nat => R -> Euc n2 -> Euc (S n0) * Euc m)
(fun (H6 : R) (H7 : Euc (n0 + m)) =>
?Goal#{n:=n0; H:=H6; H0:=H7}) H5) H3) H1 H H0
Notice your definition uses a proof (induction scheme of equality) term to make the join of the tuple. Proofs terms are not easily normalized and some others don't even get a normalized term (it is the case of Opaque proofs). The solution is to avoid tactics that generate heavy proofs terms and substitute for inductions schemes (like destruct, induction, case...), once they are "free" or almostt of automatic proofs.
Definition rect_euc {n : nat} (v : Euc (S n)) : forall (P : Euc (S n) -> Type) (H : forall ys a, P (a ::: ys)), P v.
refine (
match v with
|#Rn _ _ _ => _
|R0 => _
end).
exact idProp.
intros.
apply : H.
Defined.
Fixpoint split_Euc {n m : nat} (xi : Euc (n + m)) : Euc n * Euc m.
Proof.
destruct n as [ | n].
- exact (RO, xi).
- elim/#rect_euc : xi.
intros.
pose (split_Euc _ _ ys).
exact (Rn a (fst p), (snd p)).
Defined.
Now, as split_euc is defined using induction on n, you should do the same to get a straightforward proof.
Lemma AppendAndSplit {n m}(e:Euc n) (f:Euc m): # (e +++ f) = (e, f).
Proof.
induction n.
- remember 0.
destruct e.
reflexivity.
inversion Heqn.
- apply (rect_euc e).
intros.
assert (forall n (xs ys : Euc n) (x y : R), x = y -> xs = ys -> x ::: xs = y ::: ys).
intros.
rewrite H; rewrite H0; trivial.
pose (IHn ys).
apply : injective_projections.
simpl;apply : H; trivial.
exact (f_equal fst e0).
exact (f_equal snd e0).
Qed.
Lemma SplitRule {n m}(e:Euc (n+m)) : (fst (split_Euc e)) +++ (snd (split_Euc e)) = e.
YOUR_TURN. (* now it's your turn, just do the same and u will get the goal*)
Qed.
I'm trying to proof that my function nonzeros' distribute over concat of list.
I wrote nonzeros' with a filter in this way:
Definition nonzeros' (l : list nat) : list nat := filter (fun x => match x with | O => false | _ => true end) l.
I've already proofed this 2 lemmas:
Lemma nonzeros'_remove_0 :
forall (a b: list nat),
nonzeros' (0 :: b) = nonzeros' b.
Proof.
intros a b.
unfold nonzeros'.
simpl.
reflexivity.
Qed.
Lemma nonzeros'_not_remove_Sn :
forall (a b: list nat) (n : nat),
nonzeros' (S n :: b) = S n :: nonzeros' b.
Proof.
intros a b n.
unfold nonzeros'.
simpl.
reflexivity.
Qed.
Now I have to proof the distribution over concat:
Lemma nonzero'_distribution_over_concat :
forall (a b : list nat),
nonzeros' (concat a b) = concat (nonzeros' a) (nonzeros' b).
In order to proof it I do the following:
Proof.
intros a b.
induction a as [| h t IHa].
-
simpl.
reflexivity.
-
simpl.
destruct h.
+ rewrite nonzeros'_remove_0. rewrite nonzeros'_remove_0. rewrite IHa. reflexivity.
The problem is that after the tactics
rewrite nonzeros'_remove_0.
Coq create 2 subgoal:
______________________________________(1/2)
nonzeros' (concat t b) = concat (nonzeros' (0 :: t)) (nonzeros' b)
______________________________________(2/2)
list nat
The second subgoal is unexpected. Why does it appear?
The lemma has an unused parameter a : list nat:
Lemma nonzeros'_remove_0 :
forall (a b: list nat),
nonzeros' (0 :: b) = nonzeros' b.
so to apply that lemma you need to provide such a list, and there is no way to tell which list it should be, other than by asking you via an extra goal. One could also develop automation to make an arbitrary choice here, but a better fix is to remove that unused parameter from the lemma in the first place.
Lemma nonzeros'_remove_0 :
forall (b: list nat),
nonzeros' (0 :: b) = nonzeros' b.
I'm trying to learn to use the ListMap module in Coq. I'm really not sure about proving properties about the keys or values in a ListMap, when the ListMap is created by a recursive function. I feel like I do not know what tactics to use.
(* Me proving statements about maps to understand how to use maps in Coq *)
Require Import FunInd.
Require Import Coq.Lists.List.
Require Import Coq.FSets.FMapInterface.
Require Import
Coq.FSets.FMapList
Coq.Structures.OrderedTypeEx.
Module Import MNat := FMapList.Make(Nat_as_OT).
Require Import
Coq.FSets.FMapFacts.
Definition NatToNat := MNat.t nat.
Definition NatToNatEmpty : NatToNat := MNat.empty nat.
(* We wish to show that map will have only positive values *)
Function insertNats (n: nat) (mm: NatToNat) {struct n}: NatToNat :=
match n with
| O => mm
| S (next) => insertNats next (MNat.add n n mm)
end.
Definition keys (mm: NatToNat) : list nat :=
List.map fst (elements mm).
(* vvvvv How do I prove this? Intuitively it is true *)
Example keys_nonnegative: forall (n: nat),
forall (k: nat),
List.In k (keys (insertNats n NatToNatEmpty)) -> k >= 0.
Proof.
intros n k in_proof.
induction n.
simpl in in_proof. tauto.
(* ??? NOW WHAT *)
Admitted.
Informally, the argument I would use for the below program is that because n >= 0 because it is a nat, the keys inserted into the map by idMapsGo will also always be non-negative.
I need to induct on n for keys_nonnegative. On the nth step, we add a key n, which will be non-negative (due to being a nat). The base case is trivial.
However, I am unable to convert this intuition into a Coq proof :)
You want to look at elements_in_iff and elements_mapsto_iff from Coq.FSets.FMapFacts.
Useful properties on keys:
Here are two useful properties on your definition of keys that might help you simplify your proofs. The code is taken from my own project Aniceto that includes helper properties on maps.
Definition keys {elt:Type} (m:t elt) : list key := fst (split (elements m)).
Fixpoint split_alt {A:Type} {B:Type} (l:list (A*B) %type) : (list A * list B) % type:=
match l with
| nil => (nil, nil)
| (x, y) :: l => (x :: (fst (split_alt l)), y :: (snd (split_alt l)))
end.
Lemma split_alt_spec:
forall {A:Type} {B:Type} (l:list (A*B) %type),
split l = split_alt l.
Proof.
intros.
induction l.
- auto.
- simpl. intuition.
rewrite IHl.
remember (split_alt l) as l'.
destruct l' as (lhs, rhs).
auto.
Qed.
Lemma in_fst_split:
forall {A:Type} {B:Type} (l:list (A*B)%type) (lhs:A),
List.In lhs (fst (split l)) ->
exists rhs, List.In (lhs, rhs) l.
Proof.
intros.
induction l.
{ inversion H. (* absurd *) }
destruct a.
rewrite split_alt_spec in H.
simpl in H.
destruct H.
+ subst.
eauto using in_eq.
+ rewrite <- split_alt_spec in H.
apply IHl in H; clear IHl.
destruct H as (r, Hin).
eauto using in_cons.
Qed.
Lemma in_elements_to_in:
forall {elt:Type} k e (m: t elt),
List.In (k, e) (elements m) ->
In k m.
Proof.
intros.
rewrite elements_in_iff.
exists e.
apply InA_altdef.
apply Exists_exists.
exists (k,e).
intuition.
unfold eq_key_elt.
intuition.
Qed.
Lemma keys_spec_1:
forall {elt:Type} (m:t elt) (k:key),
List.In k (keys m) -> In k m.
Proof.
intros.
unfold keys in *.
apply in_fst_split in H.
destruct H as (e, H).
apply in_elements_to_in with (e0:=e).
assumption.
Qed.
Lemma keys_spec_2:
forall {elt:Type} (m:t elt) (k:key),
In k m ->
exists k', E.eq k k' /\ List.In k' (keys m).
Proof.
intros.
unfold keys in *.
destruct H as (e, H).
apply maps_to_impl_in_elements in H.
destruct H as (k', (Heq, Hin)).
apply in_split_l in Hin.
exists k'.
intuition.
Qed.
I have an inductive definition of the proposition P (or repeats l) that a lists contains repeating elements, and a functional definition of it's negation Q (or no_repeats l).
I want to show that P <-> ~ Q and ~ P <-> Q. I have been able to show three of the four implications, but ~ Q -> P seems to be different, because I'm unable to extract data from ~Q.
Require Import List.
Variable A : Type.
Inductive repeats : list A -> Prop := (* repeats *)
repeats_hd l x : In x l -> repeats (x::l)
| repeats_tl l x : repeats l -> repeats (x::l).
Fixpoint no_repeats (l: list A): Prop :=
match l with nil => True | a::l' => ~ In a l' /\ no_repeats l' end.
Lemma not_no_repeats_repeats: forall l, (~ no_repeats l) -> repeats l.
induction l; simpl. tauto. intros.
After doing induction on l, the second case is
IHl : ~ no_repeats l -> repeats l
H : ~ (~ In a l /\ no_repeats l)
============================
repeats (a :: l)
Is it possible to deduce In a l \/ ~ no_repeats l (which is sufficient) from this?
Your statement implies that equality on A supports double negation elimination:
Require Import List.
Import ListNotations.
Variable A : Type.
Inductive repeats : list A -> Prop := (* repeats *)
repeats_hd l x : In x l -> repeats (x::l)
| repeats_tl l x : repeats l -> repeats (x::l).
Fixpoint no_repeats (l: list A): Prop :=
match l with nil => True | a::l' => ~ In a l' /\ no_repeats l' end.
Hypothesis not_no_repeats_repeats: forall l, (~ no_repeats l) -> repeats l.
Lemma eq_nn_elim (a b : A) : ~ a <> b -> a = b.
Proof.
intros H.
assert (H' : ~ no_repeats [a; b]).
{ simpl. intuition. }
apply not_no_repeats_repeats in H'.
inversion H'; subst.
{ subst. simpl in *. intuition; tauto. }
inversion H1; simpl in *; subst; intuition.
inversion H2.
Qed.
Not every type supports eq_nn_elim, which means that you can only prove not_no_repeats_repeats by placing additional hypotheses on A. It should suffice to assume that A has decidable equality; that is:
Hypothesis eq_dec a b : a = b \/ a <> b.