I am experimenting with Coq Coinductive types. I use the lazy list type form the Coq'Art book (sect. 13.1.4):
Set Implicit Arguments.
CoInductive LList (A:Set) : Set :=
| LNil : LList A
| LCons : A -> LList A -> LList A.
Implicit Arguments LNil [A].
CoFixpoint LAppend (A:Set) (u v:LList A) : LList A :=
match u with
| LNil => v
| LCons a u' => LCons a (LAppend u' v)
end.
In order to match the guard condition I also use the following decomposition functions form this book:
Definition LList_decomp (A:Set) (l:LList A) : LList A :=
match l with
| LNil => LNil
| LCons a l' => LCons a l'
end.
Lemma LList_decompose : forall (A:Set) (l:LList A), l = LList_decomp l.
Proof.
intros.
case l.
simpl.
reflexivity.
intros.
simpl.
reflexivity.
Qed.
The Lemma that LNil is left-neutral is easy to prove:
Lemma LAppend_LNil : forall (A:Set) (v:LList A), LAppend LNil v = v.
Proof.
intros A v.
rewrite LList_decompose with (l:= LAppend LNil v).
case v.
simpl.
reflexivity.
intros.
simpl.
reflexivity.
Qed.
But I got stuck by proving that LNil is also right-neutral:
Lemma LAppend_v_LNil : forall (A:Set) (v:LList A), LAppend v LNil = v.
After Arthur's answer, I tried with the new equality:
Lemma LAppend_v_LNil : forall (A:Set) (v:LList A), LListEq (LAppend v LNil) v.
Proof.
intros.
cofix.
destruct v.
rewrite LAppend_LNil.
apply LNilEq.
Here I'm stuck. Coq's answer is:
1 subgoal
A : Set
a : A
v : LList A
LAppend_v_LNil : LListEq (LAppend (LCons a v) LNil) (LCons a v)
______________________________________(1/1)
LListEq (LAppend (LCons a v) LNil) (LCons a v)
After Eponier's answer I want to give it the final touch by introducing an Extensionality Axiom:
Axiom LList_ext: forall (A:Set)(l1 l2: LList A), (LListEq l1 l2 ) -> l1 = l2.
With that axiom I get the final cut of the Lemma:
Lemma LAppend_v_LNil : forall (A:Set) (v:LList A), (LAppend v LNil) = v.
Proof.
intros.
apply LList_ext.
revert v.
cofix.
intros.
destruct v. Guarded. (* now we can safely destruct v *)
- rewrite LAppend_LNil.
constructor.
- rewrite (LList_decompose (LAppend _ _)).
simpl. constructor. apply LAppend_v_LNil.
Qed.
Now, here are my final questions for this thread:
Does such an axiom already exist in some Coq library?
Is that axiom consistent with Coq?
With what standard axioms of Coq (e.g. classic, UIP, fun ext, Streicher K) is that axiom inconsistent?
You guessed it right: just like for functions, Coq's generic notion of equality is too weak to be useful for most coinductive types. If you want to prove your result, you need to replace eq by a coinductive notion of equality for lists; for instance:
CoInductive LListEq (A:Set) : LList A -> LList A -> Prop :=
| LNilEq : LListEq A LNil LNil
| LConsEq x lst1 lst2 : LListEq A lst1 lst2 ->
LListEq A (LCons x lst1) (LCons x lst2).
Manipulating infinite objects is a vast topic in Coq. If you want to learn more, Adam Chlipala's CPDT has an entire chapter on coinduction.
A simple rule is to use cofix as soon as possible in your proofs.
Actually, in your proof of LAppend_v_LNil, the guarded condition is already violated at destruct v. You can check this fact using the command Guarded, which helps testing before the end of the proof if all the uses of coinduction hypotheses are legit.
Lemma LAppend_v_LNil : forall (A:Set) (v:LList A), LListEq (LAppend v LNil) v.
intros.
cofix.
destruct v. Fail Guarded.
Abort.
You should actually swap intros and cofix. From there, the proof is not difficult.
EDIT: here is the complete solution.
Lemma LAppend_v_LNil : forall (A:Set) (v:LList A), LListEq (LAppend v LNil) v.
cofix.
intros.
destruct v. Guarded. (* now we can safely destruct v *)
- rewrite LAppend_LNil.
constructor.
- rewrite (LList_decompose (LAppend _ _)).
simpl. constructor. apply LAppend_v_LNil.
Qed.
Related
I have two setoids and bisimilar:
Definition of lang_iff:
Definition lang := str -> Prop.
Definition lang_iff (s1 s2: lang): Prop :=
forall (s: str),
s \in s1 <-> s \in s2.
The setoid lang_setoid:
Add Parametric Relation: lang lang_iff
reflexivity proved by lang_iff_refl
symmetry proved by lang_iff_sym
transitivity proved by lang_iff_trans as lang_setoid.
Definition of bisimilar:
CoInductive bisimilar : lang -> lang -> Prop :=
| bisim : forall (P Q: lang),
...
-> bisimilar P Q.
The bisimilar_setoid:
Add Parametric Relation: lang bisimilar
reflexivity proved by bisimilar_refl
symmetry proved by bisimilar_sym
transitivity proved by bisimilar_trans as bisimilar_setoid.
These are proven to be equivalent:
Theorem bisimilar_is_equivalence:
forall (P Q: lang),
bisimilar P Q <-> lang_iff P Q.
I can manually rewrite between them with some acrobatics, but was wondering if there is a way to help Coq to see that it can rewrite between two setoids and make the following possible without Fail:
Example example_rewriting_using_lang_iff_in_bisimilar:
forall (P Q: lang)
(pq: lang_iff P Q),
bismilar Q P.
Proof.
intros.
Fail rewrite pq.
Fail reflexivity.
Abort.
The reason for this question is that it is useful to take some steps with coinduction in bisimilar and then resolve an equivalence with lang_iff.
A second part of this question is whether we need to preprove all the morphisms from lang_iff in bimisilar or if there is some command to reuse them?
You can register bisimilar as a morphism for lang_iff:
Add Parametric Morphism : bisimilar
with signature lang_iff ==> lang_iff ==> iff as bisimilar_lang_morphism.
Proof.
intros ?? H ?? H'.
apply bisimilar_is_equivalence in H, H'.
split; intro H0.
now rewrite <- H, H0.
now rewrite H, H'.
Qed.
And now rewriting works in your proof script:
Example example_rewriting_using_lang_iff_in_bisimilar:
forall (P Q: lang)
(pq: lang_iff P Q),
bisimilar Q P.
Proof.
intros.
rewrite pq.
reflexivity.
Qed.
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.
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.
When reasoning on paper, I often use arguments by induction on the length of some list. I want to formalized these arguments in Coq, but there doesn't seem to be any built in way to do induction on the length of a list.
How should I perform such an induction?
More concretely, I am trying to prove this theorem. On paper, I proved it by induction on the length of w. My goal is to formalize this proof in Coq.
There are many general patterns of induction like this one that can be covered
by the existing library on well founded induction. In this case, you can prove
any property P by induction on length of lists by using well_founded_induction, wf_inverse_image, and PeanoNat.Nat.lt_wf_0, as in the following comand:
induction l using (well_founded_induction
(wf_inverse_image _ nat _ (#length _)
PeanoNat.Nat.lt_wf_0)).
if you are working with lists of type T and proving a goal P l, this generates an
hypothesis of the form
H : forall y : list T, length y < length l -> P y
This will apply to any other datatype (like trees for instance) as long as you can map that other datatype to nat using any size function from that datatype to nat instead of length.
Note that you need to add Require Import Wellfounded. at the head of your development for this to work.
Here is how to prove a general list-length induction principle.
Require Import List Omega.
Section list_length_ind.
Variable A : Type.
Variable P : list A -> Prop.
Hypothesis H : forall xs, (forall l, length l < length xs -> P l) -> P xs.
Theorem list_length_ind : forall xs, P xs.
Proof.
assert (forall xs l : list A, length l <= length xs -> P l) as H_ind.
{ induction xs; intros l Hlen; apply H; intros l0 H0.
- inversion Hlen. omega.
- apply IHxs. simpl in Hlen. omega.
}
intros xs.
apply H_ind with (xs := xs).
omega.
Qed.
End list_length_ind.
You can use it like this
Theorem foo : forall l : list nat, ...
Proof.
induction l using list_length_ind.
...
That said, your concrete example example does not necessarily need induction on the length. You just need a sufficiently general induction hypothesis.
Import ListNotations.
(* ... some definitions elided here ... *)
Definition flip_state (s : state) :=
match s with
| A => B
| B => A
end.
Definition delta (s : state) (n : input) : state :=
match n with
| zero => s
| one => flip_state s
end.
(* ...some more definitions elided here ...*)
Theorem automata221: forall (w : list input),
extend_delta A w = B <-> Nat.odd (one_num w) = true.
Proof.
assert (forall w s, extend_delta s w = if Nat.odd (one_num w) then flip_state s else s).
{ induction w as [|i w]; intros s; simpl.
- reflexivity.
- rewrite IHw.
destruct i; simpl.
+ reflexivity.
+ rewrite <- Nat.negb_even, Nat.odd_succ.
destruct (Nat.even (one_num w)), s; reflexivity.
}
intros w.
rewrite H; simpl.
destruct (Nat.odd (one_num w)); intuition congruence.
Qed.
In case like this, it is often faster to generalize your lemma directly:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Section SO.
Variable T : Type.
Implicit Types (s : seq T) (P : seq T -> Prop).
Lemma test P s : P s.
Proof.
move: {2}(size _) (leqnn (size s)) => ss; elim: ss s => [|ss ihss] s hs.
Just introduce a fresh nat for the size of the list, and regular induction will work.
I have the defined inductive types:
Inductive InL (A:Type) (y:A) : list A -> Prop :=
| InHead : forall xs:list A, InL y (cons y xs)
| InTail : forall (x:A) (xs:list A), InL y xs -> InL y (cons x xs).
Inductive SubSeq (A:Type) : list A -> list A -> Prop :=
| SubNil : forall l:list A, SubSeq nil l
| SubCons1 : forall (x:A) (l1 l2:list A), SubSeq l1 l2 -> SubSeq l1 (x::l2)
| SubCons2 : forall (x:A) (l1 l2:list A), SubSeq l1 l2 -> SubSeq (x::l1) (x::l2).
Now I have to prove a series of properties of that inductive type, but I keep getting stuck.
Lemma proof1: forall (A:Type) (x:A) (l1 l2:list A), SubSeq l1 l2 -> InL x l1 -> InL x l2.
Proof.
intros.
induction l1.
induction l2.
exact H0.
Qed.
Can some one help me advance.
In fact, it is easier to do an induction on the SubSet judgment directly.
However, you need to be as general as possible, so here is my advice:
Lemma proof1: forall (A:Type) (x:A) (l1 l2:list A),
SubSeq l1 l2 -> InL x l1 -> InL x l2.
(* first introduce your hypothesis, but put back x and In foo
inside the goal, so that your induction hypothesis are correct*)
intros.
revert x H0. induction H; intros.
(* x In [] is not possible, so inversion will kill the subgoal *)
inversion H0.
(* here it is straitforward: just combine the correct hypothesis *)
apply InTail; apply IHSubSeq; trivial.
(* x0 in x::l1 has to possible sources: x0 == x or x0 in l1 *)
inversion H0; subst; clear H0.
apply InHead.
apply InTail; apply IHSubSeq; trivial.
Qed.
"inversion" is a tactic that checks an inductive term and gives you all the possible way to build such a term !!without any induction hypothesis!!
It only gives you the constructive premices.
You could have done it directly by induction on l1 then l2, but you would have to construct by hand the correct instance of inversion because your induction hypothesis would have been really weak.
Hope it helps,
V.