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.
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 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 am trying to make a tower of Hanoi proof in Coq as a learning exercise. I am stuck with a last goal on my first proof after many hours of fruitless attempts.
Could you please explain why my program is failing, and how to correct it?
Edit: looking back at the code, it seems that I need to prove StronglySorted le (l:list nat) before I can prove ordered_stacking, isn'it?
Require Import List.
Require Import Arith.
Require Import Coq.Sorting.Sorting.
Definition stack_disk :=
fun (n:nat) (l:list nat) =>
match l with
| nil => n::nil
| n'::l' =>
if n' <? n
then n::l
else l
end.
Eval compute in (stack_disk 2 (1::0::nil)).
Eval compute in (stack_disk 2 (2::1::0::nil)).
Lemma ordered_stacking: forall (n:nat) (l:list nat),
StronglySorted le l -> StronglySorted le (stack_disk n l) -> StronglySorted le (n::l).
Proof.
intros n l H.
induction l as [|hl tl];simpl;auto.
destruct (hl <? n).
auto.
constructor.
apply H.
Output:
1 subgoal
n, hl : nat
tl : list nat
H : StronglySorted le (hl :: tl)
IHtl : StronglySorted le tl ->
StronglySorted le (stack_disk n tl) -> StronglySorted le (n :: tl)
H0 : StronglySorted le (hl :: tl)
______________________________________(1/1)
Forall (le n) (hl :: tl)
The problem is that you didn't record the fact that n <= hl after destructing that boolean. Here is a solution:
Require Import List.
Require Import Arith.
Require Import Coq.Sorting.Sorting.
Definition stack_disk :=
fun (n:nat) (l:list nat) =>
match l with
| nil => n::nil
| n'::l' =>
if n' <? n
then n::l
else l
end.
Lemma ordered_stacking: forall (n:nat) (l:list nat),
StronglySorted le l -> StronglySorted le (stack_disk n l) -> StronglySorted le (n::l).
Proof.
intros n [|m l].
- intros _ _; repeat constructor.
- simpl. intros H1 H2.
destruct (Nat.ltb_spec m n); trivial.
constructor; trivial.
apply StronglySorted_inv in H1.
destruct H1 as [_ H1].
constructor; trivial.
revert H1; apply Forall_impl.
now intros p; apply Nat.le_trans.
Qed.
I read that the induction principle for a type is just a theorem about a proposition P. So I constructed an induction principle for List based on the right (or reverse) list constructor .
Definition rcons {X:Type} (l:list X) (x:X) : list X :=
l ++ x::nil.
The induction principle itself is:
Definition true_for_nil {X:Type}(P:list X -> Prop) : Prop :=
P nil.
Definition true_for_list {X:Type} (P:list X -> Prop) : Prop :=
forall xs, P xs.
Definition preserved_by_rcons {X:Type} (P: list X -> Prop): Prop :=
forall xs' x, P xs' -> P (rcons xs' x).
Theorem list_ind_rcons:
forall {X:Type} (P:list X -> Prop),
true_for_nil P ->
preserved_by_rcons P ->
true_for_list P.
Proof. Admitted.
But now, I am having trouble using the theorem. I don't how to invoke it to achieve the same as the induction tactic.
For example, I tried:
Theorem rev_app_dist: forall {X} (l1 l2:list X), rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof. intros X l1 l2.
induction l2 using list_ind_rcons.
But in the last line, I got:
Error: Cannot recognize an induction scheme.
What are the correct steps to define and apply a custom induction principle like list_ind_rcons?
Thanks
If one would like to preserve the intermediate definitions, then one could use the Section mechanism, like so:
Require Import Coq.Lists.List. Import ListNotations.
Definition rcons {X:Type} (l:list X) (x:X) : list X :=
l ++ [x].
Section custom_induction_principle.
Variable X : Type.
Variable P : list X -> Prop.
Hypothesis true_for_nil : P nil.
Hypothesis true_for_list : forall xs, P xs.
Hypothesis preserved_by_rcons : forall xs' x, P xs' -> P (rcons xs' x).
Fixpoint list_ind_rcons (xs : list X) : P xs. Admitted.
End custom_induction_principle.
Coq substitutes the definitions and list_ind_rcons has the needed type and induction ... using ... works:
Theorem rev_app_dist: forall {X} (l1 l2:list X),
rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof. intros X l1 l2.
induction l2 using list_ind_rcons.
Abort.
By the way, this induction principle is present in the standard library (List module):
Coq < Check rev_ind.
rev_ind
: forall (A : Type) (P : list A -> Prop),
P [] ->
(forall (x : A) (l : list A), P l -> P (l ++ [x])) ->
forall l : list A, P l
What you did was mostly correct. The problem is that Coq has some trouble recognizing that what you wrote is an induction principle, because of the intermediate definitions. This, for instance, works just fine:
Theorem list_ind_rcons:
forall {X:Type} (P:list X -> Prop),
P nil ->
(forall x l, P l -> P (rcons l x)) ->
forall l, P l.
Proof. Admitted.
Theorem rev_app_dist: forall {X} (l1 l2:list X), rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof. intros X l1 l2.
induction l2 using #list_ind_rcons.
I don't know if Coq not being able to automatically unfold the intermediate definitions should be considered a bug or not, but at least there is a workaround.
I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.