I'm new to Coq, currently on the IndProp chapter of Software Foundations. I'm curious about learning to write my own simple tactics to automate certain kinds of reasoning, but unfortunately the official documentation is a bit impenetrable to me as a beginner.
I'd like to write a tactic that applies in the following scenario:
The current goal is False
There is a hypothesis of the form P \/ False
Based on the following lemma, we should be able to replace the current goal with ~P in this scenario:
Lemma orfalse_lemma : forall P : Prop,
P \/ False -> ~P -> False.
Proof.
intros P [H|H] HP.
- apply HP. apply H.
- apply H.
Qed.
We can use the lemma manually with the desired effect:
Example ex_orfalse_1 :
(1 <> 2) \/ False -> (False).
Proof.
intros H. apply (orfalse_lemma (1 <> 2)). apply H.
(* goal: ~ (1 <> 2) *)
Admitted.
I want to automate this, so I wrote a simple tactic to apply the lemma when the goal and context match this scenario:
Ltac orfalse :=
match goal with
| [H : ?P \/ False |- False ] => apply (orfalse_lemma P) ; [> apply H | ]
| _ => fail "expected goal to be False"
end.
It works as expected. However, when there are multiple hypotheses matching the pattern, we don't have the option to choose between them:
Example ex_orfalse_1 :
(1 <> 2) \/ False -> (False).
Proof.
intros H. orfalse.
(* goal: ~ (1 <> 2) *)
Admitted.
Example ex_orfalse_2 :
(false <> true) \/ False -> (1 <> 2) \/ False -> (False).
Proof.
intros H1 H2. orfalse.
(* goal: ~ (1 <> 2) *)
(* what if we want the goal to be ~ (false <> true) instead? *)
Admitted.
I assumed fixing this problem would be as simple as just passing the desired hypothesis to the orfalse tactic as an argument:
Ltac orfalse H :=
match goal with
| [|- False ] => match H with
| ?P \/ False => apply (orfalse_lemma ?P) ; [> apply H | ]
| _ => fail "expected disjunction with false"
end
| _ => fail "expected goal to be False"
end.
However, using it in a proof fails:
Example ex_orfalse_2 :
(false <> true) \/ False -> (1 <> 2) \/ False -> (False).
Proof.
intros H1 H2. orfalse H1.
(* Tactic failure: expected goal to be False. *)
Admitted.
If I replace the first case of the nested match with just ?P and return idtac ?P, it just prints the name of the hypothesis I pass in (e.g. H1 or H2), so my guess is that the match happens on the identifier itself and not on the hypothesis.
So, my question is: If I pass the name of a hypothesis to a tactic, how do I correctly match on the structure of that hypothesis? Thanks!
welcome to Coq!
There are two minor issues with your tactic. First you must not match the value of H - which either would be a proof term or the value of H is simply H and cannot be further evaluated - you must match the type of H. Then when using match variables, no ? is required. This works:
Lemma orfalse_lemma : forall P : Prop,
P \/ False -> ~P -> False.
Proof.
intros P [H|H] HP.
- apply HP. apply H.
- apply H.
Qed.
Ltac orfalse H :=
match goal with
| [ |- False ] => match type of H with
| ?P \/ False => apply (orfalse_lemma P) ; [> apply H | ]
| _ => fail "expected disjunction with false"
end
| _ => fail "expected goal to be False"
end.
Example ex_orfalse_2 :
(false <> true) \/ False -> (1 <> 2) \/ False -> (False).
Proof.
intros H1 H2. orfalse H1.
Admitted.
Related
I try to solve this proof but I don't find how to it.
I have two subgoals but I don't even know if it's correct.
Here the lemma that I trid to solve with this but I'm stuck :
2 subgoals
a, b : Nat
H : Equal (leB a b) True
______________________________________(1/2)
Equal match b with
| Z => False
| S m' => leB a m'
end (leB a b) / Equal (leB b (S a)) (leB a b)
______________________________________(2/2)
Equal (leB (S a) b) True / Equal (leB b (S a)) True
Inductive Bool : Type :=
True : Bool | False : Bool.
Definition Not(b : Bool) : Bool :=
Bool_rect (fun a => Bool)
False
True
b.
Lemma classic : forall b : Bool, Equal b (Not (Not b)).
Proof.
intro.
induction b.
simpl.
apply refl.
simpl.
apply refl.
Qed.
Definition Equal(T : Type)(x y : T) : Prop :=
forall P : T -> Prop, (P x) -> (P y).
Arguments Equal[T].
(* Avec certaines versions Arguments Equal[T] *)
Lemma refl : forall T : Type, forall x : T, Equal x x.
Proof.
intros.
unfold Equal.
intros.
assumption.
Qed.
Fixpoint leB n m : Bool :=
match n, m with
| Z, _ => True
| _, Z => False
| S n', S m' => leB n' m'
end.
First, don't introduce all variables in the beginning with intros. You will get a too weak induction hypothesis. Just introduce a.
Then in each branch, consider the different cases of b with the destruct tactic. It will simplify your goal and you can see if it is the left or the right side of goal that is true, and use your refl lemma to finish the goal.
The last case require that you use your induction hypothesis, and it is here that it is important that it holds for all b, not just one specific b.
Also, you didn't provide a definition for you Nat type, I guess it is something like this:
Inductive Nat := Z | S (n:Nat).
Here is a proof.
Lemma Linear : forall a b, (Equal (leB a b) True) \/ (Equal (leB b a) True).
Proof.
induction a.
- intros b. destruct b; simpl.
+ left. apply refl.
+ left. apply refl.
- intros b. destruct b; simpl.
+ right. apply refl.
+ destruct (IHa b) as [Hleft | Hright].
++ left. apply Hleft.
++ right. apply Hright.
Qed.
While it may not be as insightful, you can also use tactics that try these steps to get a shorter proof.
induction a; destruct b; firstorder.
will also prove your lemma.
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 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.
I'm trying to formalize some properties on regular expressions (REs) using Coq. But, I've got some troubles to prove a rather simple property:
For all strings s, if s is in the language of (epsilon)* RE, then s =
"", where epsilon and * denotes the empty string RE and Kleene star
operation.
This seems to be an obvious application of induction / inversion tactics, but I couldn't make it work.
The minimal working code with the problematic lemma is in the following gist.
Any tip on how should I proceed will be appreciated.
EDIT:
One of my tries was something like:
Lemma star_lemma : forall s, s <<- (#1 ^*) -> s = "".
Proof.
intros s H.
inverts* H.
inverts* H2.
inverts* H1.
inverts* H1.
inverts* H2.
simpl in *.
-- stuck here
that leave me with the following goal:
s' : string
H4 : s' <<- (#1 ^*)
============================
s' = ""
At least to me, it appears that using induction would finish the proof, since I could use H4 in induction hypothesis to finish the proof, but when I start the proof using
induction H
instead of
inverts* H
I got some (at least for me) senseless goals. In Idris / Agda, such proof just follows by pattern matching and recursion over the structure of s <<- (#1 ^*). My point is how to do such recursion in Coq.
Here is one possible solution of the original problem:
Lemma star_lemma : forall s,
s <<- (#1 ^*) -> s = "".
Proof.
refine (fix star_lemma s prf {struct prf} : s = "" := _).
inversion_clear prf; subst.
inversion_clear H; subst.
- now inversion H0.
- inversion_clear H0; subst. inversion_clear H; subst.
rewrite (star_lemma s' H1).
reflexivity.
Qed.
The main idea is to introduce a term in the context which will resemble the recursive call in a typical Idris proof. The approaches with remember and dependent induction don't work well (without modifications of in_regex) because they introduce impossible to satisfy equations as induction hypotheses' premises.
Note: it can take a while to check this lemma (around 40 seconds on my machine under Coq 8.5pl3). I think it's due to the fact that the inversion tactic tends to generate big proof terms.
This problem has obsessed me for a week, and I have finally found a solution that I find elegant.
I had already read that when an induction principle does not fit your needs, you can write and prove another one, more adapted to your problem. That is what I have done in this case. What we would want is the one obtained when using the more natural definition given in this answer. By doing this, we can keep the same definition (if changing it implies too many changes, for example) and reason about it more easily.
Here is the proof of the induction principle (I use a section to specify precisely the implicit arguments, since otherwise I observe strange behaviours with them, but the section mechanism is not necessary at all here).
Section induction_principle.
Context (P : string -> regex -> Prop)
(H_InEps : P "" #1)
(H_InChr : forall c, P (String c "") ($ c))
(H_InCat : forall {e e' s s' s1}, s <<- e -> P s e -> s' <<- e' ->
P s' e' -> s1 = s ++ s' -> P s1 (e # e'))
(H_InLeft : forall {s e e'}, s <<- e -> P s e -> P s (e :+: e'))
(H_InRight : forall {s' e e'}, s' <<- e' -> P s' e' -> P s' (e :+: e'))
(H_InStar_Eps : forall e, P "" (e ^*))
(H_InStar_Cat : forall {s1 s2 e}, s1 <<- e -> s2 <<- (e ^*) ->
P s1 e -> P s2 (e ^*) -> P (s1++s2) (e ^*)).
Arguments H_InCat {_ _ _ _ _} _ _ _ _ _.
Arguments H_InLeft {_ _ _} _ _.
Arguments H_InRight {_ _ _} _ _.
Arguments H_InStar_Cat {_ _ _} _ _ _ _.
Definition in_regex_ind2 : forall (s : string) (r : regex), s <<- r -> P s r.
Proof.
refine (fix in_regex_ind2 {s r} prf {struct prf} : P s r :=
match prf with
| InEps => H_InEps
| InChr c => H_InChr c
| InCat prf1 prf2 eq1 =>
H_InCat prf1 (in_regex_ind2 prf1) prf2 (in_regex_ind2 prf2) eq1
| InLeft _ prf => H_InLeft prf (in_regex_ind2 prf)
| InRight _ prf => H_InRight prf (in_regex_ind2 prf)
| InStar prf => _
end).
inversion prf; subst.
- inversion H1. apply H_InStar_Eps.
- inversion H1; subst.
apply H_InStar_Cat; try assumption; apply in_regex_ind2; assumption.
Qed.
End induction_principle.
And it turned out that the Qed of this proof was not instantaneous (probably due to inversion producing large terms as in this answer), but took less than 1s (maybe because the lemma is more abstract).
The star_lemma becomes nearly trivial to prove (as soon as we know the remember trick), as with the natural definition.
Lemma star_lemma : forall s, s <<- (#1 ^*) -> s = "".
Proof.
intros s H. remember (#1 ^*) as r.
induction H using in_regex_ind2; try discriminate.
- reflexivity.
- inversion Heqr; subst.
inversion H. rewrite IHin_regex2 by reflexivity. reflexivity.
Qed.
I modified a bit the definition of your in_regex predicate:
Inductive in_regex : string -> regex -> Prop :=
| InEps
: "" <<- #1
| InChr
: forall c
, (String c EmptyString) <<- ($ c)
| InCat
: forall e e' s s' s1
, s <<- e
-> s' <<- e'
-> s1 = s ++ s'
-> s1 <<- (e # e')
| InLeft
: forall s e e'
, s <<- e
-> s <<- (e :+: e')
| InRight
: forall s' e e'
, s' <<- e'
-> s' <<- (e :+: e')
| InStarLeft
: forall e
, "" <<- (e ^*)
| InStarRight
: forall s s' e
, s <<- e
-> s' <<- (e ^*)
-> (s ++ s') <<- (e ^*)
where "s '<<-' e" := (in_regex s e).
and could prove your lemma:
Lemma star_lemma : forall s, s <<- (#1 ^*) -> s = "".
Proof.
intros s H.
remember (#1 ^*) as r.
induction H; inversion Heqr; clear Heqr; trivial.
subst e.
rewrite IHin_regex2; trivial.
inversion H; trivial.
Qed.
Some explanations are necessary.
I did an induction on H. The reasoning is: if I have a proof of s <<- (#1 ^*) then this proof must have the following form...
The tactic remember create a new hypothesis Heqr which, combined with inversion will help get rid of cases which cannot possibly give this proof (in fact all the cases minus the ones where ^* is in the conclusion).
Unfortunately, this path of reasoning does not work with the definition you had for the in_regex predicate because it will create an unsatisfiable condition to the induction hypothesis. That's why I modified your inductive predicate as well.
The modified inductive tries to give a more basic definition of being in (e ^*). Semantically, I think this is equivalent.
I would be interested to read a proof on the original problem.
I have a proof state similar to what is shown below (I've simplified it some to focus on the essence of the problem I'm having). I'm almost certain that a contradiction exists in my assumptions. However, assumption H consists of a nested match that depends on the result of the expression "eq_nat_dec n n'". (I arrived at the left-hand-side of H by simplifying another function that is in terms of eq_nat_dec).
The good news is that i have an assumption (n0) that ensures that the "right" branch of the inner-most match should fire, which also ensures that the "inright" branch of the outer match should fire, resulting in the value "bad" ("good" and "bad" are two constructors of the same Inductive type, thus an assumption of good = bad would provide the necessary contradiction).
The bad news is that I don't know how to "inform" the inner match in assumption H about the assumption n0. I've tried using subst, and inversion on H, but the nested matches remain.
In conclusion: How do I force H to take the right branches of its matches using the information in n0?
n, n' : nat
H :
match
match eq_nat_dec n n' with
| left _ => inleft _
| right _ => inright _
end
with
| inleft _ => _
| inright _ => bad
end = good
n0 : n <> n'
============================
False
The only solution I know is to destruct eq_nat_dec n n' and proves that the left branch is contradictory because of n <> n'. It would give something like:
destruct (eq_nat_dec n n'); [contradiction | discriminate].
Indeed, as the previous answer said, destruct + congruence will work fine.
You could try to introduce a lemma:
Lemma eqn_rwN {x y : nat} (h : x <> y) : Nat.eq_dec x y = right h.
Proof.
destruct (Nat.eq_dec _ _); try congruence.
apply f_equal.
(* Use Eqdep_dec.eq_proofs_unicity? *)
Admitted.
so that you could rewrite the comparison, as this unicity of identity proofs should be provable given that nat has decidable equality:
Lemma u2
(n n' : nat)
(H : match (match Nat.eq_dec n n' with
| left x => inleft x
| right y => inright y
end)
with
| inleft x => true
| inright _ => false
end = true)
(hnn : n <> n') : False.
Proof. rewrite (eqn_rwN hnn) in H. congruence. Qed.
Other Coq libraries such as mathcomp take a different approach and put equality in bool, thus you can directly rewrite:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat.
Lemma u3 (n n' : nat)
(H : (if n == n' then true else false) = true)
(hnn : n != n') : False.
Proof. by rewrite (negbTE hnn) in H. Qed.
IMVHO this turns out to be more convenient if you are verifying algorithms.