Is there any thing like apply lem in *? - coq

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.

Related

Converting an existance proof of an infinite series to a function that gives that infinite series

I'm trying to reason on a TRS, and I have ran into the following proof obligation:
infinite_sequence : forall t' : Term,
transitive_closure R t t' ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
With transitive_closure defined as follows:
Definition transitive_closure (trs : TRS) (x y : Term) :=
exists f: nat -> Term,
f 0 = x
/\
exists l: nat,
f l = y
/\
forall n: nat,
n < l
->
trs (f n) (f (n + 1))
.
So when I unfold:
infinite_sequence : forall t' : Term,
(exists f : nat -> Term,
f 0 = t /\
(exists l : nat,
f l = t' /\
(forall n : nat, n < l -> R (f n) (f (n + 1))))) ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
Is this proof obligation possible to fulfill? I am not married this exact definition of transitive_closure, so if it becomes much easier by choosing a different definition for that, I'm open to that.
Since your goal starts with exists f : nat -> Term, you have to explicitly build such a function. The easiest way to do so is to first build a function with a slightly richer return type ({ u: Term | transitive_closure R t u } instead of Term) and then to project pointwise its first component to finish the proof. This would give the following script:
simple refine (let f : nat -> { u: Term | transitive_closure R t u } := _ in _).
- fix f 1.
intros [|n].
{ exists t. exists (fun _ => t). admit. }
destruct (f n) as [t' H].
destruct (infinite_sequence t' H) as [t'' H']. (* ISSUE *)
exists t''.
destruct H as [f' [H1 [l [H2 H3]]]].
exists (fun m => if Nat.ltb m l then f' m else t'').
admit.
- exists (fun n => proj1_sig (f n)).
intros n.
rewrite Nat.add_1_r.
simpl.
destruct (f n) as [fn Hn].
now destruct infinite_sequence as [t'' H'].
The two admit are just there to keep the code simple; there is nothing difficult about them. The real issue comes from the line destruct (infinite_sequence t' H), since Coq will complain that "Case analysis on sort Set is not allowed for inductive definition ex." Indeed, infinite_sequence states that there exists t'' such that R t' t'', but it does so in a non-informative way (i.e., in Prop), while you need it to build a function that lives in the concrete world (i.e., in Set).
There are only two axiom-free solutions, but both might be incompatible with the remaining of your development. The easiest one is to put infinite_sequence in Set, which means its type is changed to forall t', transitive_closure R t t' -> { t'' | R t' t'' }.
The second solution requires R to be a decidable relation and Term to be an enumerable set. That way, you can still build a concrete t'' by enumerating all the terms until you find one that satisfies R t' t''. In that case, infinite_sequence is only used to prove that this process terminates, so it can be non-informative.

Equality between functional and inductive definitions

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.

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.

coq induction with passing in equality

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.

Implementing safe element retrieval by index from list in Coq

I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.