I have
1 subgoals, subgoal 1
n : nat
b : bool
m : nat
H1: P1
H2: P2
H3: P1
H4: P2
=========
some_goal
after I run the tactic auto_group_duplicates,
it will become
1 subgoals, subgoal 1
n, m : nat
b : bool
H1, H3: P1
H2, H4: P2
=========
some_goal
Is there a tactic like this one?
I don't think that there is a tactic like this. But you can always come up with something using Ltac.
From Coq Require Import Utf8.
Definition mark {A : Type} (x : A) := x.
Ltac bar :=
match goal with
| x : ?A, y : ?A |- _ =>
lazymatch A with
| context [ mark ] => fail
| _ =>
move y after x ;
change A with (mark A) in x
end
end.
Ltac remove_marks :=
repeat match goal with
| x : mark ?A |- _ =>
change (mark A) with A in x
end.
Ltac auto_group_duplicates :=
repeat bar ; remove_marks.
Lemma foo :
∀ (n : nat) (b : bool) (m : nat) (c : bool),
n = m →
b = c →
n = m →
b = c →
n = m →
True.
Proof.
intros n b m c e1 e2 e3 e4 e5.
auto_group_duplicates.
auto_group_duplicates.
Here I have to apply the tactic twice because Ltac unifies A with mark A annoyingly.
You can manually use the move tactic (see https://coq.inria.fr/refman/proof-engine/tactics.html?highlight=top#coq:tacn.move-%E2%80%A6-after-%E2%80%A6) to rearrange hypothesis.
I doubt that there is a general automatic tactic like the one you are looking for, but one could probably cook up a fancy match-goal-based one to automate rearranging hypothesis using this tactic as a basic block, although this is out of my league.
Related
I have a dependent type which models a finite path in a transition system. The transition system has a function R that yields a proposition saying whether there's an edge between states s and s' with label a. The finite path type is:
Inductive FinPathTail (s : S i) :=
| FPTNil: FinPathTail s
| FPTCons (a : Act i) (s' : S i) : R i s a s' ->
FinPathTail s' -> FinPathTail s.
(The "tail" bit is because this actually models all but the head of a path starting at s).
I've defined a CoInductive type for a possibly infinite PathTail (I'll stick it at the bottom so as to get to the question faster) and I have a function, fpt_to_pt, to transform a FinPathTail into a PathTail. This should "obviously" be injective, so I wanted to prove a lemma of this form:
Lemma fpt_to_pt_inj {s : S i} (fpt fpt' : FinPathTail s)
: (forall s s' : S i, {s = s'} + {s <> s'}) ->
fpt_to_pt fpt = fpt_to_pt fpt' -> fpt = fpt'.
When trying to prove this by induction on fpt, I quickly get to the case where both sides are known to be conses. The goal ends up looking something like:
PTCons s a s' r (fpt_to_pt fpt) = PTCons s a2 s'2 r2 (fpt_to_pt fpt') ->
FPTCons s a s' r fpt = FPTCons s a2 s'2 r2 fpt'
that I'd like to decompose with the injection tactic. The result ends up like this:
existT (fun s'0 : S i => PathTail s'0) s' (fpt_to_pt fpt) =
existT (fun s'0 : S i => PathTail s'0) s'2 (fpt_to_pt fpt') ->
s' = s'2 -> a = a2 -> FPTCons s a s' r fpt = FPTCons s a2 s'2 r2 fpt'
and using the inversion_sigma tactic, I can transform it to:
B : s' = s'2
C : a = a2
A0 : s' = s'2
A1 : eq_rect s' (fun a : S i => PathTail a) (fpt_to_pt fpt) s'2 A0 = fpt_to_pt fpt'
I think I understand why I need decidability for the source domain, in order to use inj_pair2_eq_dec. What I don't understand is: what happened to r and r2? I understand that I don't have proof irrelevance, but doesn't that mean that they must have been equal in order for the conses to be equal? Or am I misunderstanding something fundamental about propositions?
PS: Here's the coinductive definition for PathTail:
CoInductive PathTail (s : S i) :=
| PTNil: PathTail s
| PTCons (a : Act i) (s' : S i) : R i s a s' -> PathTail s' -> PathTail s.
Apparently the injection tactic ignores equalities between proofs by default, but you can override this behavior with the Keep Proof Equalities flag:
Inductive foo : nat -> Prop :=
| Foo (n : nat) : foo n.
Inductive bar :=
| Bar (n : nat) : foo n -> bar.
Lemma test n nn m mm : Bar n nn = Bar m mm -> False.
Proof.
intros H. injection H. (* No equality generated. *)
Abort.
Set Keep Proof Equalities.
Lemma test n nn m mm : Bar n nn = Bar m mm -> False.
Proof.
intros H. injection H. (* Equality generated. *)
Abort.
I have a list with a known value and want to induct on it, keeping track of what the original list was, and referring to it by element. That is, I need to refer to it by l[i] with varying i instead of just having (a :: l).
I tried to make an induction principle to allow me to do that. Here is a program with all of the unnecessary Theorems replaced with Admitted, using a simplified example. The objective is to prove allLE_countDown using countDown_nth, and have list_nth_rect in a convenient form. (The theorem is easy to prove directly without any of those.)
Require Import Arith.
Require Import List.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Admitted.
Definition allLE := fix f l m := match l with
| nil => true
| a :: l0 => if Nat.leb a m then f l0 m else false
end.
Definition drop {A} := fix f (l : list A) n := match n with
| 0 => l
| S a => match l with
| nil => nil
| _ :: l2 => f l2 a
end
end.
Theorem list_nth_rect_aux {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s i (size : length l = i + length s) (sub : s = drop l i) : P l s i.
Admitted.
Theorem list_nth_rect {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s (leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as l.
refine (list_nth_rect (fun l s _ => l = countDown a b -> allLE s a = true) _ _ l l eq_refl Heql);
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H0.
apply leb_correct in H0.
simpl; rewrite H0; clear H0.
apply (H eq_refl).
Qed.
So, I have list_nth_rect and was able to use it with refine to prove the theorem by referring to the nth element, as desired. However, I had to construct the Proposition P myself. Normally, you'd like to use induction.
This requires distinguishing which elements are the original list l vs. the sublist s that is inducted on. So, I can use remember.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
This puts me at
a, b : nat
s, l : list nat
Heql : l = s
Heqs : l = countDown a b
============================
allLE s a = true
However, I can't seem to pass the equality as I just did above. When I try
induction l, s, Heql using list_nth_rect.
I get the error
Error: Abstracting over the terms "l", "s" and "0" leads to a term
fun (l0 : list ?X133#{__:=a; __:=b; __:=s; __:=l; __:=Heql; __:=Heqs})
(s0 : list ?X133#{__:=a; __:=b; __:=s; __:=l0; __:=Heql; __:=Heqs})
(_ : nat) =>
(fun (l1 l2 : list nat) (_ : l1 = l2) =>
l1 = countDown a b -> allLE l2 a = true) l0 s0 Heql
which is ill-typed.
Reason is: Illegal application:
The term
"fun (l l0 : list nat) (_ : l = l0) =>
l = countDown a b -> allLE l0 a = true" of type
"forall l l0 : list nat, l = l0 -> Prop"
cannot be applied to the terms
"l0" : "list nat"
"s0" : "list nat"
"Heql" : "l = s"
The 3rd term has type "l = s" which should be coercible to
"l0 = s0".
So, how can I change the induction principle
such that it works with the induction tactic?
It looks like it's getting confused between
the outer variables and the ones inside the
function. But, I don't have a way to talk
about the inner variables that aren't in scope.
It's very strange, since invoking it with
refine works without issues.
I know for match, there's as clauses, but
I can't figure out how to apply that here.
Or, is there a way to make list_nth_rect use
P l l 0 and still indicate which variables correspond to l and s?
First, you can prove this result much more easily by reusing more basic ones. Here's a version based on definitions of the ssreflect library:
From mathcomp
Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Definition countDown n m := rev (iota m (n - m)).
Lemma allLE_countDown n m : all (fun k => k <= n) (countDown n m).
Proof.
rewrite /countDown all_rev; apply/allP=> k; rewrite mem_iota.
have [mn|/ltnW] := leqP m n.
by rewrite subnKC //; case/andP => _; apply/leqW.
by rewrite -subn_eq0 => /eqP ->; rewrite addn0 ltnNge andbN.
Qed.
Here, iota n m is the list of m elements that counts starting from n, and all is a generic version of your allLE. Similar functions and results exist in the standard library.
Back to your original question, it is true that sometimes we need to induct on a list while remembering the entire list we started with. I don't know if there is a way to get what you want with the standard induction tactic; I didn't even know that it had a multi-argument variant. When I want to prove P l using this strategy, I usually proceed as follows:
Find a predicate Q : nat -> Prop such that Q (length l) implies P l. Typically, Q n will have the form n <= length l -> R (take n l) (drop n l), where R : list A -> list A -> Prop.
Prove Q n for all n by induction.
I do not know if this answers your question, but induction seems to accept with clauses. Thus, you can write the following.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction l, s, Heql using list_nth_rect
with (P:=fun l s _ => l = countDown a b -> allLE s a = true).
But the benefit is quite limited w.r.t. the refine version, since you need to specify manually the predicate.
Now, here is how I would have proved such a result using objects from the standard library.
Require Import List. Import ListNotations.
Require Import Omega.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown1_nth a i k d (boundi : k < i) :
nth k (countDown1 a i) d = a + i -k - 1.
Proof.
revert k boundi.
induction i; intros.
- inversion boundi.
- simpl. destruct k.
+ omega.
+ rewrite IHi; omega.
Qed.
Lemma countDown1_length a i : length (countDown1 a i) = i.
Proof.
induction i.
- reflexivity.
- simpl. rewrite IHi. reflexivity.
Qed.
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Proof.
unfold countDown in *.
rewrite countDown1_length in boundi.
rewrite countDown1_nth.
replace (b+(a-b)) with a by omega. reflexivity. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_forall. intros.
apply In_nth with (d:=0) in H.
destruct H as (n & H & H0).
rewrite countDown_nth in H0 by assumption. omega.
Qed.
EDIT:
You can state an helper lemma to make an even more concise proof.
Lemma Forall_nth : forall {A} (P:A->Prop) l,
(forall d i, i < length l -> P (nth i l d)) ->
Forall P l.
Proof.
intros. apply Forall_forall.
intros. apply In_nth with (d:=x) in H0.
destruct H0 as (n & H0 & H1).
rewrite <- H1. apply H. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_nth.
intros. rewrite countDown_nth. omega. assumption.
Qed.
The issue is that, for better or for worse, induction seems to assume that its arguments are independent. The solution, then, is to let induction automatically infer l and s from Heql:
Theorem list_nth_rect {A : Type} {l s : list A} (P : list A -> list A -> nat -> Type)
(Pnil : P l nil (length l))
(Pcons : forall i s d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
(leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction Heql using list_nth_rect;
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H.
apply leb_correct in H.
simpl; rewrite H; clear H.
assumption.
Qed.
I had to change around the type of list_nth_rect a bit; I hope I haven't made it false.
I'm using a couple of Inductive definitions as counter examples in some proofs. I would however like to encapsulate these definitions by enclosing them in a Section. Regular Definitions can be hidden using Let, but is this also possible for Inductive definitions? And how about Theorems?
Let me give the actual thing I'm trying to achieve, as I may be going about it totally the wrong way in the first place. I want to formalize all the proofs and exercises of the excellent book "Logics of Time and Computation" by Robert Goldblatt into Coq.
For starters we take classical logic as that is what the book does as well.
Require Import Classical_Prop.
Require Import Classical_Pred_Type.
Next we define identifiers the same way it is done in Software Foundations.
Inductive id : Type := Id : nat -> id.
Definition of the syntax.
Inductive modal : Type :=
| Bottom : modal
| V : id -> modal
| Imp : modal -> modal -> modal
| Box : modal -> modal
.
Definition Not (f : modal) : modal := Imp f Bottom.
Definition of the semantics using Kripke frames.
(* Inspired by: www.cs.vu.nl/~tcs/mt/dewind.ps.gz
*)
Record frame : Type :=
{ Worlds : Type
; WorldsExist : exists w : Worlds, True
; Rel : Worlds -> Worlds -> Prop
}.
Record kripke : Type :=
{ Frame : frame
; Label : (Worlds Frame) -> id -> Prop
}.
Fixpoint satisfies (M : kripke) (x : (Worlds (Frame M))) (f : modal) : Prop
:= match f with
| Bottom => False
| V v => (Label M x v)
| Imp f1 f2 => (satisfies M x f1) -> (satisfies M x f2)
| Box f => forall y : (Worlds (Frame M)), (Rel (Frame M) x y) -> (satisfies M y f)
end.
The first lemma relates the modal Not to the one of Coq.
Lemma satisfies_Not
: forall M x f
, satisfies M x (Not f) = ~ satisfies M x f
.
Proof. auto.
Qed.
Next we lift the semantics to complete models.
Definition M_satisfies (M : kripke) (f : modal) : Prop
:= forall w : Worlds (Frame M), satisfies M w f.
And we show what it means for the Not connective.
Lemma M_satisfies_Not : forall M f
, M_satisfies M (Not f) -> ~ M_satisfies M f
.
Proof.
unfold M_satisfies.
intros M f Hn Hcontra.
destruct (WorldsExist (Frame M)).
specialize (Hn x); clear H.
rewrite satisfies_Not in Hn.
specialize (Hcontra x). auto.
Qed.
Here comes the thing. The reverse of the above lemma does not hold and I want to show this by a counter example, exhibiting a model for which it doesn't hold.
Inductive Wcounter : Set := | x1:Wcounter | x2:Wcounter | x3:Wcounter.
Lemma Wcounter_not_empty : exists w : Wcounter, True.
Proof. exists x1. constructor. Qed.
Inductive Rcounter (x : Wcounter) (y : Wcounter) : Prop :=
| E1 : x = x1 -> y = x2 -> Rcounter x y
| E2 : x = x2 -> y = x3 -> Rcounter x y
.
Definition Lcounter : Wcounter -> id -> Prop
:= fun x i => match x with
| x1 => match i with | Id 0 => True | _ => False end
| x2 => match i with | Id 1 => True | _ => False end
| x3 => match i with | Id 0 => True | _ => False end
end.
Definition Fcounter : frame := Build_frame Wcounter Wcounter_not_empty Rcounter.
Definition Kcounter : kripke := Build_kripke Fcounter Lcounter.
Next an Ltac that relieves me from typing verbose asserts.
Ltac counter_example H Hc := match type of H with
| ?P -> ~ ?Q => assert(Hc: Q)
| ?P -> (?Q -> False) => assert(Hc: Q)
| ?P -> ?Q => assert(Hc: ~Q)
end.
Finally I use this counter example to prove the following Lemma.
Lemma M_not_satisfies_Not : ~ forall M f
, (~ M_satisfies M f) -> M_satisfies M (Not f)
.
Proof.
apply ex_not_not_all. exists Kcounter.
apply ex_not_not_all. exists (V (Id 0)).
unfold M_satisfies. simpl.
intro Hcontra. unfold not in Hcontra.
counter_example Hcontra Hn2.
apply ex_not_not_all. exists x1. simpl. auto.
apply Hn2. apply Hcontra. apply ex_not_not_all; exists x2. simpl. auto.
Qed.
Preferably I would have used the remember tactic to define the counter example inside the proof, but I don't think it can be used for the Inductive definitions. All the definitions relating to the counter example are exported as part of my theory, which I prefer not to do. It is only used in the proof of M_not_satisfies_Not. Actually I would not even want to export this Lemma either as it is not very useful. I only put it there to argue that M_satisfies_Not can not be an equivalence.
Section doesn't hide definitions, use Module instead. For example put the counter example in a module.
Module CounterExample.
Import Definitions.
Inductive Wcounter : Set := x1 | x2 | x3.
...
Lemma M_not_satisfies_Not : ...
End CounterExample.
At this stage, only CounterExample is defined at the top level.
If you don't want that either, then you could just put the definitions in one .v file and the counter example in another file that imports the definitions. Actually, the way it works is that .v files are turned into individual modules.
In coq, the destruct tactic has a variant accepting an "conjunctive disjunctive introduction pattern" that allows the user to assign names to introduced variables, even when unpacking complex inductive types.
The Ltac language in coq allows the user to write custom tactics. I'd like to write (in truth, maintain) a tactic that does something before handing control off to destruct.
I would like my custom tactic to allow (or require, whichever is easier) the user to supply an introduction pattern that my tactic can hand to destruct.
What Ltac syntax accomplishes this?
You can use tactic notations, described in the reference manual. For instance,
Tactic Notation "foo" simple_intropattern(bar) :=
match goal with
| H : ?A /\ ?B |- _ =>
destruct H as bar
end.
Goal True /\ True /\ True -> True.
intros. foo (HA & HB & HC).
The simple_intropattern directive instructs Coq to interpret bar as an intro pattern. Thus, the call to foo results in calling destruct H as (HA & HB & HC).
Here's a longer example showing a more complex introduction pattern.
Tactic Notation "my_destruct" hyp(H) "as" simple_intropattern(pattern) :=
destruct H as pattern.
Inductive wondrous : nat -> Prop :=
| one : wondrous 1
| half : forall n k : nat, n = 2 * k -> wondrous k -> wondrous n
| triple_one : forall n k : nat, 3 * n + 1 = k -> wondrous k -> wondrous n.
Lemma oneness : forall n : nat, n = 0 \/ wondrous n.
Proof.
intro n.
induction n as [ | n IH_n ].
(* n = 0 *)
left. reflexivity.
(* n <> 0 *)
right. my_destruct IH_n as
[ H_n_zero
| [
| n' k H_half H_wondrous_k
| n' k H_triple_one H_wondrous_k ] ].
Admitted.
We can inspect one of the generated goals to see how the names are being used.
oneness < Show 4.
subgoal 4 is:
n : nat
n' : nat
k : nat
H_triple_one : 3 * n' + 1 = k
H_wondrous_k : wondrous k
============================
wondrous (S n')
As a rough and untutored background, in HoTT, one deduces the heck out of the inductively defined type
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
which allows the very general construction
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
The Lemma transport would be at the heart of HoTT "replace" or "rewrite" tactics; the trick, so far as I understand it, would be, supposing a goal which you or I can abstractly recognize as
...
H : paths x y
[ Q : (G x) ]
_____________
(G y)
to figure out what is the necessary dependent type G, so that we can apply (transport G H). So far, all I've figured out is that
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b =>
match goal with
|- ?F b => apply (transport F γ)
| _ => idtac "apparently couldn't abstract" b "from the goal." end
| _ => idtac "Are you sure" γ "is a path?" end.
isn't general enough. That is, the first idtac gets used rather often.
The question is
[Is there a | what is the] Right Thing to Do?
There is a bug about using rewrite for relations in type, which would allow you to just say rewrite <- y.
In the mean time,
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b => pattern b; apply (transport _ y)
| _ => idtac "Are you sure" γ "is a path?"
end.
probably does what you want.
The feature request mentioned by Tom Prince in his answer has been granted:
Require Import Coq.Setoids.Setoid Coq.Classes.CMorphisms.
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
Global Instance paths_Reflexive {A} : Reflexive (#paths A) := idpath.
Global Instance paths_Symmetric {A} : Symmetric (#paths A).
Proof. intros ?? []; constructor. Defined.
Global Instance proper_paths {A} (x : A) : Proper paths x := idpath x.
Global Instance paths_subrelation
(A : Type) (R : crelation A)
{RR : Reflexive R}
: subrelation paths R.
Proof.
intros ?? p.
apply (transport _ p), RR.
Defined.
Global Instance reflexive_paths_dom_reflexive
{B} {R' : crelation B} {RR' : Reflexive R'}
{A : Type}
: Reflexive (#paths A ==> R')%signature.
Proof. intros ??? []; apply RR'. Defined.
Goal forall (x y : nat) G, paths x y -> G x -> G y.
intros x y G H Q.
rewrite <- H.
exact Q.
Qed.
I found the required instances by comparing the logs I got with Set Typeclasses Debug from setoid_rewrite <- H when H : paths x y and when H : eq x y.