Coq: Rewriting between two equivalent setoids - coq

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.

Related

Coinductive principle for streams

I am trying to prove the following principle for stream predicates (defined in the standard library).
From Coq Require Import Streams.
Lemma mystream_ind :
forall A (P : Stream A -> Prop),
(forall s, ForAll P (tl s) -> ForAll P s) ->
forall s, ForAll P s.
Proof.
intros A P H.
cofix Cof.
destruct s as [a s].
constructor; auto.
destruct (H (Cons a s) (Cof s)); auto.
Fail Guarded.
Abort.
From my understanding of the syntactical guard conditions imposed by cofix, I will never be able to complete the proof this way because in the proof term, Cof s must appear under H, which is not a constructor nor a match, etc.
Is there another way to do it in Coq? I defined ForAll as an explicit fixpoint with paco and tried to prove the principle, without success (I couldn't instantiate H at all).
EDIT: this lemma is not provable as False can be derived from it by taking P := fun s => False (thank you Maƫlan).

How to prove forall (p q:Prop), ~p->~((p ->q) ->p). using coq

I am completely new to coq programming and unable to prove below theorem. I need help on steps how to solve below construct?
Theorem PeirceContra: forall (p q:Prop), ~p->~((p ->q) ->p).
I tried the proof below way.
Given axiom as Axiom classic : forall P:Prop, P \/ ~ P.
Theorem PeirceContra: forall (p q:Prop), ~ p -> ~((p -> q) -> p).
Proof.
unfold not.
intros.
apply H.
destruct (classic p) as [ p_true | p_not_true].
- apply p_true.
- elimtype False. apply H.
Qed.
Getting subgoal after using elimtype and apply H as
1 subgoal
p, q : Prop
H : p -> False
H0 : (p -> q) -> p
p_not_true : ~ p
______________________________________(1/1)
p
But now I am stuck here because I am unable to prove P using p_not_true construct of given axiom......Please suggest some help......
I am not clear how to use the given axiom to prove logic................
This lemma can be proved constructively. If you think about what can be done at each step to make progress the lemma proves itself:
Lemma PeirceContra :
forall P Q, ~P -> ~((P -> Q) -> P).
Proof.
intros P Q np.
unfold "~".
intros pq_p.
apply np. (* this is pretty much the only thing we can do at this point *)
apply pq_p. (* this is almost inevitable too *)
(* the rest should be easy *)
(* Qed. *)

How to do induction on the length of a list in Coq?

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.

Proving equality on coinductive lazy lists in Coq

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.

Why can't inversion be used on a universally qualified hypothesis in Coq?

I've been going through the Software Foundations course and found the following proof (source link).
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
unfold not. intros.
unfold excluded_middle in H.
assert ((P x) \/ ((P x) -> False)) as HP.
apply H with (P:=(P x)).
inversion HP.
apply H1.
apply ex_falso_quodlibet. apply H0. exists x. apply H1.
Qed.
I'm curious, why is there an assertion saying (P x) \/ ((P x) -> False), when if I unfold excluded_middle in H and unfold not in H, I'll get the exact same H : forall P : Prop, P \/ (P -> False) as the assertion, only that there's a universal quantifier.
This is even more obvious as the assertion can be proved just by doing apply H, and the whole reason for this step is to do inversion HP on the newly asserted hypothsesis.
The question is, why isn't it possible to do inversion H at the beginning directly, and spare the extra step of defining an assertion, which just copies one of the assumptions? Is there a better way to do this?
inversion only works on things of inductive type, such as or. forall is not an inductive type constructor, hence one cannot perform inversion on it. One could maybe extend inversion to behave like (e)destruct: if you give it something that is universally quantified, it'll generate additional existentials and proof obligations that you need to fulfill to fill in the missing spots, as well as destructing the conclusion. However, this is not how it works right now...
One could do a more direct proof by just applying H and destructing it directly:
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
intros.
destruct (H (P x)).
apply H1.
exfalso. apply H0. exists x. apply H1.
Qed.