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.
Related
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.
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.
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.
Currently, I've started working on proving theorems about first-order logic in Coq(VerifiedMathFoundations). I've proved deduction theorem, but then I got stuck with lemma 1 for theorem of correctness. So I've formulated one elegant piece of the lemma compactly and I invite the community to look at it. That is an incomplete the proof of well-foundness of the terms. How to get rid of the pair of "admit"s properly?
(* PUBLIC DOMAIN *)
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (#Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Definition snglV {A} (a:A) := Vector.cons A a 0 (Vector.nil A).
Definition wfr : #well_founded Terms rela.
Proof.
clear.
unfold well_founded.
assert (H : forall (n:Terms) (a:Terms), (rela a n) -> Acc rela a).
{ fix iHn 1.
destruct n.
+ simpl. intros a b; destruct b.
+ simpl. intros a Q. destruct Q as [L|R].
* admit. (* smth like apply Acc_intro. intros m Hm. apply (iHn a). exact Hm. *)
* admit. (* like in /Arith/Wf_nat.v *)
}
intros a.
simple refine (H _ _ _).
exact (FSC (Build_FSV 0 1) (snglV a)).
simpl.
apply or_introl.
constructor.
Defined.
It is also available here: pastebin.
Update: At least transitivity is needed for well-foundness. I also started a proof, but didn't finished.
Fixpoint Tra (a b c:Terms) (Hc : rela c b) (Hb : rela b a) {struct a}: rela c a.
Proof.
destruct a.
+ simpl in * |- *.
exact Hb.
+ simpl in * |- *.
destruct Hb.
- apply or_intror.
revert f t H .
fix RECU 1.
intros f t H.
(* ... *)
Admitted.
You can do it by defining a height function on Terms, and showing that decreasing rela implies decreasing heights:
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Unset Elimination Schemes.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Set Elimination Schemes.
Definition Terms_rect (T : Terms -> Type)
(H_FVC : forall sv, T (FVC sv))
(H_FSC : forall f v, (forall n, T (Vector.nth v n)) -> T (FSC f v)) :=
fix loopt (t : Terms) : T t :=
match t with
| FVC sv => H_FVC sv
| FSC f v =>
let fix loopv s (v : Vector.t Terms s) : forall n, T (Vector.nth v n) :=
match v with
| #Vector.nil _ => Fin.case0 _
| #Vector.cons _ t _ v => fun n => Fin.caseS' n (fun n => T (Vector.nth (Vector.cons _ t _ v) n))
(loopt t)
(loopv _ v)
end in
H_FSC f v (loopv _ v)
end.
Definition Terms_ind := Terms_rect.
Fixpoint height (t : Terms) : nat :=
match t with
| FVC _ => 0
| FSC f v => S (Vector.fold_right (fun t acc => Nat.max acc (height t)) v 0)
end.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (#Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Require Import Lia.
Definition wfr : #well_founded Terms rela.
Proof.
apply (Wf_nat.well_founded_lt_compat _ height).
intros t1 t2. induction t2 as [sv2|f2 v2 IH]; simpl; try easy.
intros [t_v|t_sub]; apply Lt.le_lt_n_Sm.
{ clear IH. induction t_v; simpl; lia. }
revert v2 IH t_sub; generalize (fsv f2); clear f2.
intros k v2 IH t_sub.
enough (H : exists n, rela t1 (Vector.nth v2 n)).
{ destruct H as [n H]. apply IH in H. clear IH t_sub.
transitivity (height (Vector.nth v2 n)); try lia; clear H.
induction v2 as [|t2 m v2 IHv2].
- inversion n.
- apply (Fin.caseS' n); clear n; simpl; try lia.
intros n. specialize (IHv2 n). lia. }
clear IH.
assert (H : Vector.fold_right (fun t Q => Q \/ rela t1 t) v2 False).
{ revert t_sub; generalize False.
induction v2 as [|t2 n v2]; simpl in *; trivial.
intros P H; specialize (IHv2 _ H); clear H.
induction v2 as [|t2' n v2 IHv2']; simpl in *; tauto. }
clear t_sub.
induction v2 as [|t2 k v2 IH]; simpl in *; try easy.
destruct H as [H|H].
- apply IH in H.
destruct H as [n Hn].
now exists (Fin.FS n).
- now exists Fin.F1.
Qed.
(Note the use of the custom induction principle, which is needed because of the nested inductives.)
This style of development, however, is too complicated. Avoiding certain pitfalls would greatly simplify it:
The Coq standard vector library is too hard to use. The issue here is exacerbated because of the nested inductives. It would probably be better to use plain lists and have a separate well-formedness predicate on terms.
Defining a relation such as rela in proof mode makes it harder to read. Consider, for instance, the following simpler alternative:
Fixpoint rela x y :=
match y with
| FVC _ => False
| FSC f v =>
Vector.In x v \/
Vector.fold_right (fun z P => rela x z \/ P) v False
end.
Folding left has a poor reduction behavior, because it forces us to generalize over the accumulator argument to get the induction to go through. This is why in my proof I had to switch to a fold_right.
I have a list with a known value and want to induct on it, keeping track of what the original list was, and referring to it by element. That is, I need to refer to it by l[i] with varying i instead of just having (a :: l).
I tried to make an induction principle to allow me to do that. Here is a program with all of the unnecessary Theorems replaced with Admitted, using a simplified example. The objective is to prove allLE_countDown using countDown_nth, and have list_nth_rect in a convenient form. (The theorem is easy to prove directly without any of those.)
Require Import Arith.
Require Import List.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Admitted.
Definition allLE := fix f l m := match l with
| nil => true
| a :: l0 => if Nat.leb a m then f l0 m else false
end.
Definition drop {A} := fix f (l : list A) n := match n with
| 0 => l
| S a => match l with
| nil => nil
| _ :: l2 => f l2 a
end
end.
Theorem list_nth_rect_aux {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s i (size : length l = i + length s) (sub : s = drop l i) : P l s i.
Admitted.
Theorem list_nth_rect {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s (leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as l.
refine (list_nth_rect (fun l s _ => l = countDown a b -> allLE s a = true) _ _ l l eq_refl Heql);
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H0.
apply leb_correct in H0.
simpl; rewrite H0; clear H0.
apply (H eq_refl).
Qed.
So, I have list_nth_rect and was able to use it with refine to prove the theorem by referring to the nth element, as desired. However, I had to construct the Proposition P myself. Normally, you'd like to use induction.
This requires distinguishing which elements are the original list l vs. the sublist s that is inducted on. So, I can use remember.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
This puts me at
a, b : nat
s, l : list nat
Heql : l = s
Heqs : l = countDown a b
============================
allLE s a = true
However, I can't seem to pass the equality as I just did above. When I try
induction l, s, Heql using list_nth_rect.
I get the error
Error: Abstracting over the terms "l", "s" and "0" leads to a term
fun (l0 : list ?X133#{__:=a; __:=b; __:=s; __:=l; __:=Heql; __:=Heqs})
(s0 : list ?X133#{__:=a; __:=b; __:=s; __:=l0; __:=Heql; __:=Heqs})
(_ : nat) =>
(fun (l1 l2 : list nat) (_ : l1 = l2) =>
l1 = countDown a b -> allLE l2 a = true) l0 s0 Heql
which is ill-typed.
Reason is: Illegal application:
The term
"fun (l l0 : list nat) (_ : l = l0) =>
l = countDown a b -> allLE l0 a = true" of type
"forall l l0 : list nat, l = l0 -> Prop"
cannot be applied to the terms
"l0" : "list nat"
"s0" : "list nat"
"Heql" : "l = s"
The 3rd term has type "l = s" which should be coercible to
"l0 = s0".
So, how can I change the induction principle
such that it works with the induction tactic?
It looks like it's getting confused between
the outer variables and the ones inside the
function. But, I don't have a way to talk
about the inner variables that aren't in scope.
It's very strange, since invoking it with
refine works without issues.
I know for match, there's as clauses, but
I can't figure out how to apply that here.
Or, is there a way to make list_nth_rect use
P l l 0 and still indicate which variables correspond to l and s?
First, you can prove this result much more easily by reusing more basic ones. Here's a version based on definitions of the ssreflect library:
From mathcomp
Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Definition countDown n m := rev (iota m (n - m)).
Lemma allLE_countDown n m : all (fun k => k <= n) (countDown n m).
Proof.
rewrite /countDown all_rev; apply/allP=> k; rewrite mem_iota.
have [mn|/ltnW] := leqP m n.
by rewrite subnKC //; case/andP => _; apply/leqW.
by rewrite -subn_eq0 => /eqP ->; rewrite addn0 ltnNge andbN.
Qed.
Here, iota n m is the list of m elements that counts starting from n, and all is a generic version of your allLE. Similar functions and results exist in the standard library.
Back to your original question, it is true that sometimes we need to induct on a list while remembering the entire list we started with. I don't know if there is a way to get what you want with the standard induction tactic; I didn't even know that it had a multi-argument variant. When I want to prove P l using this strategy, I usually proceed as follows:
Find a predicate Q : nat -> Prop such that Q (length l) implies P l. Typically, Q n will have the form n <= length l -> R (take n l) (drop n l), where R : list A -> list A -> Prop.
Prove Q n for all n by induction.
I do not know if this answers your question, but induction seems to accept with clauses. Thus, you can write the following.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction l, s, Heql using list_nth_rect
with (P:=fun l s _ => l = countDown a b -> allLE s a = true).
But the benefit is quite limited w.r.t. the refine version, since you need to specify manually the predicate.
Now, here is how I would have proved such a result using objects from the standard library.
Require Import List. Import ListNotations.
Require Import Omega.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown1_nth a i k d (boundi : k < i) :
nth k (countDown1 a i) d = a + i -k - 1.
Proof.
revert k boundi.
induction i; intros.
- inversion boundi.
- simpl. destruct k.
+ omega.
+ rewrite IHi; omega.
Qed.
Lemma countDown1_length a i : length (countDown1 a i) = i.
Proof.
induction i.
- reflexivity.
- simpl. rewrite IHi. reflexivity.
Qed.
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Proof.
unfold countDown in *.
rewrite countDown1_length in boundi.
rewrite countDown1_nth.
replace (b+(a-b)) with a by omega. reflexivity. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_forall. intros.
apply In_nth with (d:=0) in H.
destruct H as (n & H & H0).
rewrite countDown_nth in H0 by assumption. omega.
Qed.
EDIT:
You can state an helper lemma to make an even more concise proof.
Lemma Forall_nth : forall {A} (P:A->Prop) l,
(forall d i, i < length l -> P (nth i l d)) ->
Forall P l.
Proof.
intros. apply Forall_forall.
intros. apply In_nth with (d:=x) in H0.
destruct H0 as (n & H0 & H1).
rewrite <- H1. apply H. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_nth.
intros. rewrite countDown_nth. omega. assumption.
Qed.
The issue is that, for better or for worse, induction seems to assume that its arguments are independent. The solution, then, is to let induction automatically infer l and s from Heql:
Theorem list_nth_rect {A : Type} {l s : list A} (P : list A -> list A -> nat -> Type)
(Pnil : P l nil (length l))
(Pcons : forall i s d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
(leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction Heql using list_nth_rect;
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H.
apply leb_correct in H.
simpl; rewrite H; clear H.
assumption.
Qed.
I had to change around the type of list_nth_rect a bit; I hope I haven't made it false.