I want to prove the following theorem:
Theorem T14 : forall s t u,
S u s t <-> S u t s.
Where S is defined like this:
Definition S u s t := forall v,
((ObS u v) <-> (ObS v s \/ ObS v t)).
The first tactics I used are:
Proof.
intros s t u.
unfold S.
And my goal is now:
1 subgoal
s, t, u : Entity
______________________________________(1/1)
(forall v : Entity, ObS u v <-> ObS v s \/ ObS v t) <->
(forall v : Entity, ObS u v <-> ObS v t \/ ObS v s)
It feels like the proof can be finished if I use the commutativity of the OR operator, and then apply the tauto tactic. However, I don't know how to rewrite the inner bit of only the right part of the equivalence. Is it possible?
This can be done using generalized rewriting.
Require Setoid.
Use setoid_rewrite because you are rewriting under a binder (forall v). (Without binders, rewrite would be sufficient).
It works out-of-the-box in this case, but when your project gets more sophisticated, with your own combinators/logical connectives, some work will be necessary to ensure that "rewriting" is sound. The reference manual describes the set up required by generalized rewriting.
(* 1 *)
Require Import Setoid.
Parameter T : Type.
Parameter ObS : T -> T -> Prop.
Definition S u s t := forall v,
((ObS u v) <-> (ObS v s \/ ObS v t)).
Theorem T14 : forall s t u,
S u s t <-> S u t s.
Proof.
intros s t u.
unfold S.
(* 2 *)
setoid_rewrite (or_comm (ObS _ s)).
reflexivity.
Qed.
Related
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).
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.
How to project (with proj1 or proj2) a universally quantified biconditional (iff) such as in the following example?
Parameter T : Set.
Parameter P Q R: T -> Prop.
Parameter H : forall (t : T), P t <-> Q t.
When I try to use proj1 H, it fails with the following error:
Error: The term "H" has type "forall t : T, P t <-> Q t" while it is
expected to have type "?A /\ ?B".
While I would like to get forall (t : T), P t -> Q t.
Edit
Using the suggested solution, I have now two ways to project the biconditional:
Theorem proj1' : (forall t, P t <-> Q t) -> forall t, P t -> Q t.
Proof.
intros H t.
exact (proj1 (H t)).
Qed.
Theorem foo : forall (t1 t2 : T),
(R t1 -> P t1) ->
(R t2 -> P t2) ->
R t1 /\ R t2 -> Q t1 /\ Q t2.
Proof.
intros t1 t2 H1 H2 [H3 H4].
(* Does not solve the goal, as expected. *)
auto using H.
(* Solves the goal, but is unnecessary explicit. *)
(* auto using (proj1 (H t1)), (proj1 (H t2)). *)
(* Solves the goal and instanciations are infered. *)
auto using (proj1' H).
Qed.
Now, a function such as proj1' seems to be quite useful. If it is not offered in the standard library, is it because such situations are actually not happening often enough to justify it, or is it simply an historical accident?
I do realize that a distinct function would be require for two, three, etc. universal quantification (e.g. proj1'' : (forall t u, P t u <-> Q t u) -> forall t u, P t u -> Q t u). But wouldn't functions for up to three or four arguments be enough for most cases?
Related
How does `auto` interract with biconditional (iff)
Since a term of type forall (t : T), P t <-> Q t is a function, you need to apply it to a t of type T to get access to the body, which is a pair of proofs:
Goal (forall t, P t <-> Q t) -> forall t, P t -> Q t.
Proof.
intros H t.
exact (proj1 (H t)).
Qed.
The above is like the following (modulo transparency):
Definition proj1' : (forall t, P t <-> Q t) -> forall t, P t -> Q t :=
fun H t => proj1 (H t).
Respond to Edit
One can suggest many proofs of the foo theorem. I wouldn't use proj1' in any of them:
Theorem foo t1 t2 : (R t1 -> P t1) -> (R t2 -> P t2) ->
P t1 /\ P t2 -> Q t1 /\ Q t2.
Solution 1
apply is one smart tactic, it can handle biconditionals:
Proof. now split; apply H. Qed.
Solution 2
intros can apply lemmas when moving stuff to the context:
Proof. now intros _ _ [H3%H H4%H]. Qed.
It's like SSReflects's by move=> _ _ [/H H3 /H H4].
Solution 3
Coq can use biconditionals to do rewrites if you Require Import Setoid. first:
Proof. now rewrite !H. Qed.
! in front of a term means "rewrite as many times as you can, but at least once".
With a sig type defintion like:
Inductive A: Set := mkA : nat-> A.
Function getId (a: A) : nat := match a with mkA n => n end.
Function filter (a: A) : bool := if (beq_nat (getId a) 0) then true else false.
Coercion is_true : bool >-> Sortclass.
Definition subsetA : Set := { a : A | filter a }.
I try to prove its projection is injective:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
destruct t1.
destruct t2.
simpl.
intros.
rewrite -> H. (* <- stuck here *)
Abort.
At this point, Coq knows:
x : A
i : is_true (filter x)
x0 : A
i0 : is_true (filter x0)
H : x = x0
I tried some rewrite without success. For example, why can't I rewrite of i and H to give Coq a i0? May I ask what did I miss here? Thanks.
At the point where you got stuck, your goal looked roughly like this:
exist x i = exist x0 i0
If the rewrite you typed were to succeed, you would have obtained the following goal:
exist x0 i = exist x0 i0
Here, you can see why Coq is complaining: rewriting would have yielded an ill-typed term. The problem is that the subterm exist x0 i is using i as a term of type filter x0, when it really has type filter x. To convince Coq that this is not a problem, you need to massage your goal a little bit before rewriting:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
destruct t1.
destruct t2.
simpl.
intros.
revert i. (* <- this is new *)
rewrite -> H. (* and now the tactic succeeds *)
intros i.
Abort.
Alternatively, you could use the subst tactic, which tries to remove all redundant variables in the context. Here is a more compact version of the above script:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
intros [x1 i1] [x2 i2]; simpl; intros e.
subst.
Abort.
You might run into another issue afterwards: showing that any two terms of type filter x0 are equal. In general, you would need the axiom of proof irrelevance to be able to show this; however, since filter is defined as an equality between two terms of a type with decidable equality, you can prove this property as a theorem (which the Coq standard library already does for you).
As a side note, the mathcomp library already has a generic lemma that subsumes your property, called val_inj. Just to give you an example, this is how one might use it:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Inductive A: Set := mkA : nat-> A.
Function getId (a: A) : nat := match a with mkA n => n end.
Function filter (a: A) : bool := if (Nat.eqb (getId a) 0) then true else false.
Definition subsetA : Set := { a : A | filter a }.
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
intros t1 t2.
apply val_inj.
Qed.
Suppose I have two functions f and g and I know f = g. Is there a forward reasoning 'function application' tactic that will allow me to add f a = g a to the context for some a in their common domain? In this contrived example, I could use assert (f a = g a) followed by f_equal. But I want to do something like this in more complex situations; e.g.,
Lemma fapp : forall (A B : Type) (P Q : A -> B) (a : A),
(fun (a : A) => P a) = (fun (a : A) => Q a) ->
P a = Q a.
I think I can't correctly infer the general problem that you have, given your description and example.
If you already know H : f = g, you can use that to rewrite H wherever you want to show something about f and g, or just elim H to rewrite everything at once. You don't need to assert a helper theorem and if you do, you'll obviously need something like assert or pose proof.
If that equality is hidden underneath some eta-expansion, like in your example, remove that layer and then proceed as above. Here are two (out of many) possible ways of doing that:
intros A B P Q a H. assert (P = Q) as H0 by apply H. rewrite H0; reflexivity.
This solves your example proof by asserting the equality, then rewriting. Another possibility is to define eta reduction helpers (haven't found predefined ones) and using these. That will be more verbose, but might work in more complex cases.
If you define
Lemma eta_reduce : forall (A B : Type) (f : A -> B),
(fun x => f x) = f.
intros. reflexivity.
Defined.
Tactic Notation "eta" constr(f) "in" ident(H) :=
pattern (fun x => f x) in H;
rewrite -> eta_reduce in H.
you can do the following:
intros A B P Q a H. eta P in H. eta Q in H. rewrite H; reflexivity.
(That notation is a bit of a loose cannon and might rewrite in the wrong places. Don't rely on it and in case of anomalies do the pattern and rewrite manually.)
I don't have a lot of experience with Coq or its tactics, but why not just use an auxiliary theorem?
Theorem fapp': forall (t0 t1: Type) (f0 f1: t0 -> t1),
f0 = f1 -> forall (x0: t0), f0 x0 = f1 x0.
Proof.
intros.
rewrite H.
trivial.
Qed.
Lemma fapp : forall (A B : Type) (P Q : A -> B) (a : A),
(fun (a : A) => P a) = (fun (a : A) => Q a) ->
P a = Q a.
Proof.
intros.
apply fapp' with (x0 := a) in H.
trivial.
Qed.