Make two arbitrary variables the same in Coq - coq

I have the following coq code:
Theorem filter_exercise : forall (X : Type) (l lf : list X) (test : X -> bool)
(x : X),
filter test l = x :: lf ->
test x = true.
Proof.
intros X l lf test x eq.
induction l as [|l' l].
- inversion eq.
- inversion eq as [H].
Which gives me:
X : Type
l' : X
l, lf : list X
test : X -> bool
x : X
eq : filter test (l' :: l) = x :: lf
testEq : test x = false
IHl : filter test l = x :: lf -> false = true
============================
filter test l = (if test l' then l' :: filter test l else filter test l)
Here, if I could just say that because test x = false and both x and l' are universally quantified variables of type X, then I'd be done with the proof.
However, that's a semantic argument, and I'm not sure how to do that in Coq. Am I going down the wrong path?
EDIT
For posterity, this is the solution I ultimately obtained:
Theorem filter_exercise : forall (X : Type) (l lf : list X) (test : X -> bool)
(x : X),
filter test l = x :: lf ->
test x = true.
Proof.
intros X l lf test x eq.
induction l as [|l' l].
- inversion eq.
- simpl in eq. destruct (test l') eqn:testl'.
+ inversion eq. rewrite <- H0. apply testl'.
+ apply IHl. apply eq.
Qed.

I am not sure what you mean by "semantic argument", but this proof strategy is not correct, neither on paper nor in Coq. Consider, for instance, the following statement:
Lemma faulty : forall n m : nat, even n -> even m.
Proof. Admitted.
By your logic, if n is even, then m should also be even, since both are universally quantified variables of type nat. However, precisely because they are universally quantified, they can instantiated to different values of nat, thus yielding obviously contradictory statements. For instance, if we instantiate faulty with 2 and 1, we should be able to conclude that 1 is even, which is not true.

Your argument that test x = false -> test l' = false is not true, as both variables x and l are universally quantified, and thus can have any value. You could just have a specific relationship between both variables in your hypothesis, but here it is not the case, except the relationship filter test (l' :: l) = x :: lf, that tells you that x could be an element of l which has not been filtered by test (but it also might be l').
You should not use inversion here, as your problem is really simple. You idea to perform an induction is fine however :
Try first to simplify several hypothesis.
Then see if there are different cases to deal with, and use destruct when needed (on the value of test l' in this problem)
You should be able to solve the problem then (the most complicated tactic you might have to use is injection)

Related

List uniqueness predicate decidability

I'd like to define a predicate for list uniqueness and its decidability function in Coq. My first try was:
Section UNIQUE.
Variable A : Type.
Variable P : A -> Prop.
Variable PDec : forall (x : A), {P x} + {~ P x}.
Definition Unique (xs : list A) := exists! x, In x xs /\ P x.
Here I just have specified that predicate Unique xs will hold if there's just one value x in list xs such that P x holds. Now, comes the problem. When I've tried to define its Unique decidability:
Definition Unique_dec : forall xs, {Unique xs} + {~ Unique xs}.
induction xs ; unfold Unique in *.
+
right ; intro ; unfold unique in * ; simpl in * ; crush.
+
destruct IHxs ; destruct (PDec a).
destruct e as [y [Hiy HPy]].
...
I've got the following nasty error message:
Error: Case analysis on sort Set is not allowed for inductive definition ex.
I've googled this message and seen several similar problems in different contexts. At least to me, it seems that such problem is related to some restrictions on Coq pattern matching, right?
Now that the problem is settled, my questions:
1) All I want is to define a decidability for a uniqueness test based on a decidable predicate. In the standard library, there are similar tests for existencial and universal quantifiers. Both can be defined as inductive predicates. Is there a way to define "exists unique" as an inductive predicate on lists?
2) It is possible to define such predicate in order to it match the standard logic meaning of exists unique? Like exists! x, P x = exists x, P x /\ forall y, P y -> x = y?
What you're running into is that you can't pattern match on ex (the underlying inductive for both exists and exists!) in order to produce a value of type sumbool (the type for the {_} + {_} notation), which is a Type and not a Prop. The "nasty error message" isn't terribly helpful in figuring this out; see this bug report for a proposed fix.
To avoid this issue, I think you should prove a stronger version of Unique that produces something in Type (a sig) rather than Prop:
Definition Unique (xs : list A) := exists! x, In x xs /\ P x.
Definition UniqueT (xs : list A) := {x | unique (fun x => In x xs /\ P x) x}.
Theorem UniqueT_to_Unique : forall xs,
UniqueT xs -> Unique xs.
Proof.
unfold UniqueT, Unique; intros.
destruct X as [x H].
exists x; eauto.
Qed.
You can then prove decidability for this definition in Type, and from there prove your original statement if you want:
Definition UniqueT_dec : forall xs, UniqueT xs + (UniqueT xs -> False).
As mentioned in Anton's answer, this proof will require decidable equality for A, also in Type, namely forall (x y:A), {x=y} + {x<>y}.
Let me provide only a partial answer (it's too large for a comment).
If we go with this definition of uniqueness which admits multiple copies (as mentioned by Arthur), then Unique_dec implies decidability of equality for type A (as mentioned by #ejgallego).
Assuming we have
Unique_dec
: forall (A : Type) (P : A -> Prop),
(forall x : A, {P x} + {~ P x}) ->
forall xs : list A, {Unique P xs} + {~ Unique P xs}
We can show the following:
Lemma dec_eq A (a b : A) : a = b \/ a <> b.
Proof.
pose proof (Unique_dec (fun (_ : A) => True) (fun _ => left I) [a;b]) as U.
unfold Unique in U; destruct U as [u | nu].
- destruct u as (x & [I _] & U).
destruct I as [<- | [<- | contra]];
[specialize (U b) | specialize (U a) |]; firstorder.
- right; intros ->; apply nu; firstorder.
Qed.

Pigeonhole proof without decidable equality or excluded middle

In Software Foundations IndProp.v one is asked to prove the pigeonhole principle, and one may use excluded middle, but it is mentioned that it is not strictly necessary. I've been trying to prove it without EM, but my brain seems to be wired classically.
Q: How would one prove the theorem without using excluded middle? How should one generally approach proofs for types without decidable equality, where one can't easily reason by cases?
I'd be very happy for a complete proof to look at, but please avoid posting it "in the clear", so as to not spoil the exercise in the Software Foundations course.
The definition uses two inductive predicates, In and repeats.
Require Import Lists.List.
Import ListNotations.
Section Pigeon.
Variable (X:Type).
Implicit Type (x:X).
Fixpoint In x l : Prop := (*** In ***)
match l with
| nil => False
| (x'::l') => x' = x \/ In x l'
end.
Hypothesis in_split : forall x l, In x l -> exists l1 l2, l = l1 ++ x :: l2.
Hypothesis in_app: forall x l1 l2, In x (l1++l2) <-> In x l1 \/ In x l2.
Inductive repeats : list X -> Prop := (*** repeats ***)
repeats_hd l x : In x l -> repeats (x::l)
| repeats_tl l x : repeats l -> repeats (x::l).
Theorem pigeonhole_principle_NO_EM: (*** pigeonhole ***)
forall l1 l2,
length l2 < length l1 -> (* There are more pigeons than nests *)
(forall x, In x l1 -> In x l2) -> (* All pigeons are in some nest *)
repeats l1. (* Thus, some pigeons share nest *)
Proof.
(* ??? *)
I'll describe the thought process that led me to a solution, in case it helps. We may apply induction and it is straightforward to reduce to the case l1 = a::l1', l2 = a::l2'. Now l1' is a subset of a::l2'. My EM-trained intuition is that one of the following holds:
a is in l1'.
a is not in l1'.
In the latter case, each element of l1' is in a::l2' but differs from a, and therefore must be in l2'. Thus l1' is a subset of l2', and we can apply the inductive hypothesis.
Unfortunately if In is not decidable, the above can't be directly formalized. In particular if equality is not decidable for the given type, it's difficult to prove elements are unequal, and therefore difficult to prove a negative statement like ~(In a l1'). However, we wanted to use that negative statement to prove a positive one, namely
forall x, In x l1' -> In x l2'
By analogy, suppose we wanted to prove
P \/ Q
Q -> R
------
P \/ R
The above intuitive argument is like starting from P \/ ~P, and using ~P -> Q -> R in the second case. We can use a direct proof to avoid EM.
Quantifying over the list l1' makes this a bit more complicated, but still we can construct a direct proof using the following lemma, which can be proven by induction.
Lemma split_or {X} (l : list X) (P Q : X -> Prop) :
(forall x, In x l -> (P x \/ Q x)) ->
(exists x, In x l /\ P x) \/ (forall x, In x l -> Q x).
Finally note that the intuitive pigeonhole principle could also be formalized as the following way, which cannot be proven when the type has undecidable equality (note that it has a negative statement in the conclusion):
Definition pigeon2 {X} : Prop := forall (l1 l2 : list X),
length l2 < length l1 ->
(exists x, In x l1 /\ ~(In x l2)) \/ repeats l1.
A possible constructive proof goes like this:
We prove pigeonhole_principle_NO_EM by induction on l1. Only the non-empty case is possible because of the length constraint. So, assume l1 = x :: l1'. Now, check whether there is some element of l1' which is mapped by f : (forall x, In x l1 -> In x l2) to the same membership proof as x. If there is such an x' element, then it follows that x = x', therefore l1 repeats. If there is no such element, then we can get l2' by removing the element that x is mapped to from l2, and apply the induction hypothesis to l2' and the appropriate f' : forall x, In x l1' -> In x l2' function.
That's it, but I note that actually formalizing this proof is not easy with the definitions given, because we need to prove heterogeneous or dependent equalities, since we have to compare membership proofs for possibly different elements.
As to the question of getting the hang of constructive proofs in general, an important skill or habit is always examining what kind of data we have, not just what kind of logical facts we know. In this case, membership proofs are actually indices pointing into lists, bundled together with proofs that the pointed-to elements equal certain values. If membership proofs didn't tell where exactly elements are located then this proof would not be possible constructively.

Coq - undocumented error on induction with eqn:

Using Coq 8.4pl3, I'm getting an error on induction with the eqn: variant that is not listed under induction in the reference manual.
(* Export below requires Software Foundations 4.0. *)
Require Export Logic.
Inductive disjoint (X : Type) (l1 l2 : list X) : Prop :=
| nil1 : l1 = [] -> disjoint X l1 l2
| nil2 : l2 = [] -> disjoint X l1 l2
| bothCons : forall x:X,
In x l1 ->
not (In x l2) ->
disjoint X l1 l2.
Fixpoint head (X : Type) (l : list X) : option X :=
match l with
| [] => None
| h :: t => Some h
end.
Fixpoint tail (X : Type) (l : list X) : list X :=
match l with
| [] => []
| h :: t => t
end.
Inductive NoDup (X : Type) (l : list X) : Prop :=
| ndNil : l = [] -> NoDup X l
| ndSingle : forall x:X, l = [x] -> NoDup X l
| ndCons : forall x:X, head X l = Some x ->
not (In x (tail X l)) /\ NoDup X (tail X l) ->
NoDup X l.
Theorem disjoint__app_NoDup :
forall (X : Type) (l1 l2 : list X),
disjoint X l1 l2 /\ NoDup X l1 /\ NoDup X l2 ->
NoDup X (l1 ++ l2).
Proof.
intros. induction H eqn:caseEqn.
If I substitute just plain "induction H" for the last step, I get no error, but with the above eqn: argument, I get the error:
Error: a is used in conclusion.
(Previously there was a condition missing in the theorem statement, and the same error listed an identifier d instead.)
Ref manual lists "is used in conclusion" as an error from use of assert. It makes some kind of sense that behind the scenes, eqn: might be generating assertions, but I have no identifier a visible in the context, and I can't see what Coq is trying to automatically do with it.
Tried replacing beginning of the proof with
intros. remember H. induction H.
Now the attempt to do induction gives the same error as before, only with H instead of a. (When the theorem was missing the additional condition, Coq also explicitly added a d to the context, identical to the hypothesis H.)
How can I move forward here? I'm trying to avoid losing information from the context.
This is a minor bug; I've reported it. However, the thing you are trying to do here is not particularly sensible. Note that you are invoking induction on a conjunction (/\), and asking Coq to leave you an equation that says that the original hypothesis is equal to the conjunction of the two generated proofs. There are two issues here:
Your hypothesis is not used in a dependent fashion anywhere, so you don't need to remember it.
Your hypothesis is not recursive, so you could just as well do destruct H rather than induction H.
As for the error message, it becomes a bit more clear if you note that replacing /\ with * makes induction H eqn:caseEqn go through, and breaks your hypothesis apart into two parts named a and b. The actual issue is that the proof term constructed by induction H eqn:... is ill-typed when H's type is a Prop, because you cannot eliminate Props to get information. I suspect that the code simply tries to do something with the a that it creates in a particular way, and assumes that any failure to do that must be because a is used in the conclusion, rather than because the proof term it was creating was ill-formed.

How to introduce a new variable in Coq?

I was wondering if there is a way to introduce an entirely new variable during the proof of a theorem in Coq?
For a complete example, consider the following property from here about the evenness of the length of a list.
Inductive ev_list {X:Type}: list X -> Prop :=
| el_nil : ev_list []
| el_cc : forall x y l, ev_list l -> ev_list (x :: y :: l).
Now I want to prove that for any list l if its length is even, then ev_list l holds:
Lemma ev_length__ev_list': forall X (l : list X), ev (length l) -> ev_list l.
Proof.
intros X l H.
which gives:
1 subgoals
X : Type
l : list X
H : ev (length l)
______________________________________(1/1)
ev_list l
Now, I'd like to "define" a new free variable n and a hypothesis n = length l. In hand-written math, I think we can do this, and then do induction about n. But is there a way to do the same in Coq?
Note. the reasons I ask are that:
I don't want to introduce this n artificially into the statement of the theorem itself, as is done in the page linked earlier, which IMHO is unnatural.
I tried to induction H., but it seems not working. Coq wasn't able to do case analysis on length l's ev-ness, and no induction hypothesis (IH) was generated.
Thanks.
This is a common issue in Coq proofs. You can use the remember tactic:
remember (length l) as n.
If you're doing induction on H as well, you might also have to generalize over l beforehand, by doing
generalize dependent l.
induction H.
If you want to add a new variable only for your induction, you can use directly
induction (length l) eqn:H0
According to the Curry-Howard Isomorphism, hypothesis in your context are just variables. You can define new variables with a function. The following refine tactic extends the goal with a fresh variable n (that is set to length l) and a proof e that n = length l (that is set to eq_refl).
Lemma ev_length__ev_list': forall X (l : list X), ev (length l) -> ev_list l.
Proof.
intros X l H.
refine ((fun n (e:n = length l) => _) (length l) eq_refl).
(* proof *)
Admitted.

Rewrite tactic fails to find term occurrence within pattern matching

In Coq, I'm having problems with applying the rewrite tactic in the following situation:
Section Test.
Hypothesis s t : nat -> nat.
Hypothesis s_ext_eq_t : forall (x : nat), s x = t x.
Definition dummy_s : nat -> nat :=
fun n => match n with
| O => 42
| S np => s np
end.
Definition dummy_t : nat -> nat :=
fun n => match n with
| O => 42
| S np => t np
end.
Goal forall (n : nat), dummy_s n = dummy_t n.
Proof.
intro n. unfold dummy_s. unfold dummy_t.
At that stage, the local context and current goal look as follows:
1 subgoals, subgoal 1 (ID 6)
s : nat -> nat
t : nat -> nat
s_ext_eq_t : forall x : nat, s x = t x
n : nat
============================
match n with
| 0 => 42
| S np => s np
end = match n with
| 0 => 42
| S np => t np
end
Now it should be possible to apply the rewrite tactic to replace the occurence of s np in the goal by t np, thereby making it possible to solve the goal using reflexivity. However,
rewrite s_ext_eq_t.
gives
Toplevel input, characters 0-18:
Error: Found no subterm matching "s ?190" in the current goal.
What am I doing wrong? One can get into a situation where rewrite is applicable via
destruct n.
(* n = 0 *)
reflexivity.
(* n > 0 *)
rewrite s_ext_eq_t.
reflexivity.
Qed.
but in the actual situation I am facing, several such destructs would be necessary, and I wonder whether rewrite or a variant of it is able to do this automatically.
Addendum The above situation naturally occurs when proving that a function defined via well-founded recursion has the desired fixed point property:
Suppose A: Type and that R: A -> A -> Prop is a well-founded relation, i.e. we have Rwf: well_founded R. Then, given a type family P: A -> Type we may construct a section
Fix : forall (x : A), P a
through recursion over R, with the recursion step given as a function
F : forall x:A, (forall y:A, R y x -> P y) -> P x
See https://coq.inria.fr/library/Coq.Init.Wf.html However, to show that Fix indeed has the fixed point property
forall (x : A), Fix x = F (fun (y:A) _ => Fix y)`
we need to provide a witness
F_ext : forall (x:A) (f g:forall y:A, R y x -> P y),
(forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.
i.e. we have to show that F does not use anything else from the given f: forall y:A, R y x -> P y but its values. Of course, in any concrete situation, this should be trivial to verify, but when one tries to prove it, one runs into a situation a minimal example of which I have presented above: One is facing a huge equality of two copies of the code for the recursion step, one time with f and another time with g. Your assumption tells that f and g are extensionally equal, so one should be able to rewrite them. However, in the code for the recursion step, there might be a large number of pattern matchings and new variables that doesn't make sense in the local context, hence it would be (unnecessarily?) quite tedious to destruct dozens of times before being allowed to apply rewrite.
As mentioned in a comment above, it is not possible to perform the rewrite directly on the branch of the match statement, because np is not in scope in the top-level environment. As far as Coq's theory is concerned, a proof of your statement will have to destruct n at some point.
Although I am not aware of any tactics for automating this kind of problem, it is not too hard to come up with some custom ltac code for solving your problem without too much pain:
Ltac solve_eq :=
try reflexivity;
match goal with
| |- match ?x with _ => _ end
= match ?x with _ => _ end =>
destruct x; auto
end.
Goal forall (n : nat), dummy_s n = dummy_t n.
Proof.
intro n. unfold dummy_s. unfold dummy_t.
solve_eq.
Qed.
If your extensional equality results are hypotheses that appear in your context, then solve_eq should be able to solve many goals of this shape; if not, you might have to add extra lemmas to your hint database.