Coq: Ltac for transitivity of implication (a.k.a. hypothetical syllogism) - match

This question is about a project that I am doing, namely, to code Principia Mathematica in Coq. Principia has derived rules of inference, one of which is Syll:
∀ P Q R : Prop,
P→Q, Q→R : P→R
I am trying to create an Ltac script that codifies the Syll inference form. The following MP tactic from (Chlipala 2019) works perfectly:
Ltac MP H1 H2 :=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?P |- _ ] => specialize (H1 H2)
end.
Here I take it that the tactic on the right of "=>" specializes the application of H1 to H2. Now the correlated Syll tactic does not work:
Ltac Syll H1 H2 :=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?Q -> ?R |- _ ] =>
specialize Syll2_06 with ?P ?Q ?R;
intros Syll2_06;
apply Syll2_06;
apply H1;
apply H2
end.
The error that I get in applying it (in the example below) is:
No matching clauses for match.
I am not sure why this is the resulting error. Classical logic was imported, and I proved as a theorem Syll2_06, i.e., (P→Q)→((Q→R)→(P→R)). In fact, what is basically the Syll Ltac was applied in the proof of theorem Trans2_16 (see below). So I am unsure why turning the code into an Ltac script is not working.
Perhaps I am misunderstanding what Ltac match is doing, and what the tactic to the right of "=>" should be. But based on looking at the Coq manual, it may be that the left side of the tactic is the problem, perhaps because H1 isn't applicable to H2.
Further suggestions, particularly one that explains Ltac and/or my error in how I am thinking about it, would be very much appreciated.
Theorem Syll2_06 : ∀ P Q R : Prop,
(P → Q) → ((Q → R) → (P → R)).
Ltac Syll H1 H2 :=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?Q -> ?R |- _ ] =>
specialize Syll2_06 with ?P ?Q ?R;
intros Syll2_06;
apply Syll2_06;
apply H1;
apply H2
end.
Ltac MP H1 H2 :=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?P |- _ ] => specialize (H1 H2)
end.
Theorem Trans2_16 : forall P Q : Prop,
(P → Q) → (~Q → ~P).
Proof. intros P Q.
specialize n2_12 with Q. intros n2_12a.
specialize Syll2_05 with P Q (~~Q). intros Syll2_05a.
specialize n2_03 with P (~Q). intros n2_03a.
MP n2_12a Syll2_05a.
specialize Syll2_06 with (P→Q) (P→~~Q) (~Q→~P). intros Syll2_06a.
apply Syll2_06a.
apply Syll2_05a.
apply n2_03a.
Qed.
Theorem Trans2_17 : forall P Q : Prop,
(~Q -> ~P) -> (P -> Q).
Proof. intros P Q.
specialize n2_03 with (~Q) P. intros n2_03a.
specialize n2_14 with Q. intros n2_14a.
specialize Syll2_05 with P (~~Q) Q. intros Syll2_05a.
MP n2_14a Syll2_05a.
Syll 2_03a Syll2_05a.
Qed.

I am not certain how you want the tactic to work. If we start like this:
Variables P Q R S : Prop.
Goal (P -> Q) -> (S -> Q) -> (Q -> R) -> P -> R.
intros A B C.
then the goal is:
A : P -> Q
B : S -> Q
C : Q -> R
============================
P -> R
What do you want Syll A C to do?
Should it solve the goal? Should it modify C to be R? Should it add a new term (i.e. named D) of type P -> R to the context?
For example, if you want a tactic to solve the goal, you can use apply:
Ltac Syll H1 H2 :=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?Q -> ?R |- ?P -> ?R ] =>
intros p; apply (H2 (H1 p))
end.
If you want to add a new term to the context, you can construct it i.e. with assert:
Ltac Syll H1 H2 N:=
match goal with
| [ H1 : ?P -> ?Q, H2 : ?Q -> ?R |- ?P -> ?R ] =>
assert (N: P -> R) by (intros p; apply (H2 (H1 p)))
end.
Also note that if Syll doesn't take H1 and H2 as arguments, Coq will by itself find which assumptions to use to construct the proof.

Related

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. *)

Is there any thing like apply lem in *?

Is there any way to call apply lem in H for every possible H in premises, like rewrite lem in *?
Axiom P Q : nat -> Prop.
Axiom lem : forall (n : nat), P n -> Q n.
Goal P O -> P (S O) -> True.
intros. apply lem in H. apply lem in H0.
I couldn't find anything built in, but it's possible to write such a tactic with Ltac.
First, the special case.
Axiom P Q : nat -> Prop.
Axiom lem : forall (n : nat), P n -> Q n.
Goal P O -> P (S O) -> True.
intros.
repeat match goal with
x : _ |- _ => apply lem in x
end.
Abort.
Now we can generalize this
Ltac apply_in_premises t :=
repeat match goal with
x : _ |- _ => apply t in x
end.
and use it like this:
Goal P O -> P (S O) -> True.
intros.
apply_in_premises lem.
Abort.
Unfortunately, this way of doing it can cause an infinite loop if applying lem produces something else that lem can be applied to.
Axiom P : nat -> Prop.
Axiom lem : forall (n : nat), P n -> P (S n).
Ltac apply_in_premises t :=
repeat match goal with
x : _ |- _ => apply t in x
end.
Goal P O -> P (S O) -> nat -> True.
intros.
apply_in_premises lem. (* infinite loop *)
Abort.
If this is a concern for you, you can use a variant suggested by Yves in the comments. Simply changing apply t in x to apply t in x; revert x will ensure that that hypothesis won't be matched again. However, the end result will have all the hypotheses in the goal, like P -> G, instead of p: P as a premise and G as the goal.
To automatically reintroduce these hypotheses, we can keep track of how many times a hypothesis was reverted, then introduce them again.
Ltac intro_n n :=
match n with
| 0 => idtac
| S ?n' => intro; intro_n n'
end.
Ltac apply_in_premises_n t n :=
match goal with
| x : _ |- _ => apply t in x; revert x;
apply_in_premises_n t (S n)
| _ => intro_n n (* now intro all the premises that were reverted *)
end.
Tactic Notation "apply_in_premises" uconstr(t) := apply_in_premises_n t 0.
Axiom P : nat -> Prop.
Axiom lem : forall (n : nat), P n -> P (S n).
Goal P O -> P (S O) -> nat -> True.
intros.
apply_in_premises lem. (* only applies `lem` once in each of the premises *)
Abort.
Here, the tactic intro_n n applies intro n times.
I haven't tested this in general, but it works well in the case above. It might fail if a hypothesis can't be reverted (for example, if some other hypothesis depends on it). It also may reorder the hypotheses, since when a reverted hypothesis is reintroduced, it's put on the end of the hypothesis list.

How to prove that terms of a first-order language are well-founded?

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.

Rewrite hypothesis in Coq, keeping implication

I'm doing a Coq proof. I have P -> Q as a hypothesis, and (P -> Q) -> (~Q -> ~P) as a lemma. How can I transform the hypothesis into ~Q -> ~P?
When I try to apply it, I just spawn new subgoals, which isn't helpful.
Put another way, I wish to start with:
P : Prop
Q : Prop
H : P -> Q
and end up with
P : Prop
Q : Prop
H : ~Q -> ~P
given the lemma above - i.e. (P -> Q) -> (~Q -> ~P).
This is not as elegant as just an apply, but you can use pose proof (lemma _ _ H) as H0, where lemma is the name of your lemma. This will add another hypothesis with the correct type to the context, with the name H0.
This is one case where ssreflect views do help:
From Coq Require Import ssreflect.
Variable (P Q : Prop).
Axiom u : (P -> Q) -> (~Q -> ~P).
Lemma test (H : P -> Q) : False.
Proof. move/u in H. Abort.
apply u in H does also work, however it is too smart for its own good and does too much.
If I wanted to transform H in place I would go with #ejgallego's answer, since SSReflect is now (starting from Coq 8.7.0) a part of standard Coq, but here is another option:
Ltac dumb_apply_in f H := generalize (f H); clear H; intros H.
Tactic Notation "dumb" "apply" constr(f) "in" hyp(H) := dumb_apply_in f H.
A simple test:
Variable (P Q : Prop).
Axiom u : (P -> Q) -> (~Q -> ~P).
Lemma test (H : P -> Q) : False.
Proof. dumb apply u in H. Abort.

Stuck on a simple proof about regular expressions

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.