I want to define a relation over two type families in Coq and have come up with the following definition dep_rel and the identity relation dep_rel_id:
Require Import Coq.Logic.JMeq.
Require Import Coq.Program.Equality.
Require Import Classical_Prop.
Definition dep_rel (X Y: Type -> Type) :=
forall i, X i -> forall j, Y j -> Prop.
Inductive dep_rel_id {X} : dep_rel X X :=
| dep_rel_id_intro i x: dep_rel_id i x i x.
However, I got stuck when I tried to prove the following lemma:
Lemma dep_rel_id_inv {E} i x j y:
#dep_rel_id E i x j y -> existT _ i x = existT _ j y.
Proof.
intros H. inversion H. subst.
Abort.
inversion H seems to ignore the fact that the two xs in dep_rel_id i x i x are the same. I end up with the proof state:
E : Type -> Type
j : Type
x, y, x0 : E j
H2 : existT (fun x : Type => E x) j x0 = existT (fun x : Type => E x) j x
H : dep_rel_id j x j y
x1 : E j
H5 : existT (fun x : Type => E x) j x1 = existT (fun x : Type => E x) j y
x2 : E j
H4 : j = j
============================
existT E j x = existT E j x1
I don't think the goal can be proved in this way. Are there any tactics for situation like this that I'm not aware of?
By the way, I was able to prove the lemma with a somehow tweaked definition like below:
Inductive dep_rel_id' {X} : dep_rel X X :=
| dep_rel_id_intro' i x j y:
i = j -> x ~= y -> dep_rel_id' i x j y.
Lemma dep_rel_id_inv' {E} i x j y:
#dep_rel_id' E i x j y -> existT _ i x = existT _ j y.
Proof.
intros H. inversion H. subst.
apply inj_pair2 in H0.
apply inj_pair2 in H1. subst.
reflexivity.
Qed.
But I'm still curious whether this can be done in a simpler way (without using JMeq probably?). I'd be grateful for your suggestions.
Not sure what the issue is with inversion, indeed it seems like it has lost track of an important equality. However, using case H instead of inversion H seems to work just fine:
Lemma dep_rel_id_inv {E} i x j y:
#dep_rel_id E i x j y -> existT _ i x = existT _ j y.
Proof.
intros H.
case H.
reflexivity.
Qed.
But having case or destruct do the job where inversion couldn’t is very suprising to me. I suspect some kind of bug/wrong simplification by inversion, as simple inversion also gives a hypothesis from which one can prove the goal.
Related
I work on mereology and I wanted to prove that a given theorem (Extensionality) follows from the four axioms I had.
This is my code:
Require Import Classical.
Parameter Entity: Set.
Parameter P : Entity -> Entity -> Prop.
Axiom P_refl : forall x, P x x.
Axiom P_trans : forall x y z,
P x y -> P y z -> P x z.
Axiom P_antisym : forall x y,
P x y -> P y x -> x = y.
Definition PP x y := P x y /\ x <> y.
Definition O x y := exists z, P z x /\ P z y.
Axiom strong_supp : forall x y,
~ P y x -> exists z, P z y /\ ~ O z x.
And this is my proof:
Theorem extension : forall x y,
(exists z, PP z x) -> (forall z, PP z x <-> PP z y) -> x = y.
Proof.
intros x y [w PPwx] H.
apply Peirce.
intros Hcontra.
destruct (classic (P y x)) as [yesP|notP].
- pose proof (H y) as [].
destruct H0.
split; auto.
contradiction.
- pose proof (strong_supp x y notP) as [z []].
assert (y = z).
apply Peirce.
intros Hcontra'.
pose proof (H z) as [].
destruct H3.
split; auto.
destruct H1.
exists z.
split.
apply P_refl.
assumption.
rewrite <- H2 in H1.
pose proof (H w) as [].
pose proof (H3 PPwx).
destruct PPwx.
destruct H5.
destruct H1.
exists w.
split; assumption.
Qed.
I’m happy with the fact that I completed this proof. However, I find it quite messy. And I don’t know how to improve it. (The only thing I think of is to use patterns instead of destruct.) It is possible to improve this proof? If so, please do not use super complex tactics: I would like to understand the upgrades you will propose.
Here is a refactoring of your proof:
Require Import Classical.
Parameter Entity: Set.
Parameter P : Entity -> Entity -> Prop.
Axiom P_refl : forall x, P x x.
Axiom P_trans : forall x y z,
P x y -> P y z -> P x z.
Axiom P_antisym : forall x y,
P x y -> P y x -> x = y.
Definition PP x y := P x y /\ x <> y.
Definition O x y := exists z, P z x /\ P z y.
Axiom strong_supp : forall x y,
~ P y x -> exists z, P z y /\ ~ O z x.
Theorem extension : forall x y,
(exists z, PP z x) -> (forall z, PP z x <-> PP z y) -> x = y.
Proof.
intros x y [w PPwx] x_equiv_y.
apply NNPP. intros x_ne_y.
assert (~ P y x) as NPyx.
{ intros Pxy.
enough (PP y y) as [_ y_ne_y] by congruence.
rewrite <- x_equiv_y. split; congruence. }
destruct (strong_supp x y NPyx) as (z & Pzy & NOzx).
assert (y <> z) as y_ne_z.
{ intros <-. (* Substitute z right away. *)
assert (PP w y) as [Pwy NEwy] by (rewrite <- x_equiv_y; trivial).
destruct PPwx as [Pwx NEwx].
apply NOzx.
now exists w. }
assert (PP z x) as [Pzx _].
{ rewrite x_equiv_y. split; congruence. }
apply NOzx. exists z. split; trivial.
apply P_refl.
Qed.
The main changes are:
Give explicit and informative names to all the intermediate hypotheses (i.e., avoid doing destruct foo as [x []])
Use curly braces to separate the proofs of the intermediate assertions from the main proof.
Use the congruence tactic to automate some of the low-level equality reasoning. Roughly speaking, this tactic solves goals that can be established just by rewriting with equalities and pruning subgoals with contradictory statements like x <> x.
Condense trivial proof steps using the assert ... by tactic, which does not generate new subgoals.
Use the (a & b & c) destruct patterns rather than [a [b c]], which are harder to read.
Rewrite with x_equiv_y to avoid doing sequences such as specialize... destruct... apply H0 in H1
Avoid some unnecessary uses of classical reasoning.
I'm basically trying to prove
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
without assuming any axioms (e.g. proof irrelevance). In particular, I've tried to get through le_unique by induction and inversion, but it never seems to get far
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
revert p q.
induction x as [ | x rec_x]. (* induction on y similarly fruitless; induction on p, q fails *)
- destruct p as [ | y p].
+ inversion q as [ | ]. (* destruct q fails and inversion q makes no progress *)
admit.
+ admit.
- admit.
Admitted.
In the standard library, this lemma can be found as Peano_dec.le_unique in the module Coq.Arith.Peano_dec.
As for a relatively simple direct proof, I like to go by induction on p itself.
After proving by hand a few induction principles that Coq doesn't automatically generate, and remembering that proofs of equality on nat are unique, the proof is a relatively straightforward induction on p followed by cases on q, giving four cases two of which are absurd.
Below is a complete Coq file proving le_unique.
Import EqNotations.
Require Eqdep_dec PeanoNat.
Lemma nat_uip {x y : nat} (p q : x = y) : p = q.
apply Eqdep_dec.UIP_dec.
exact PeanoNat.Nat.eq_dec.
Qed.
(* Generalize le_ind to prove things about the proof *)
Lemma le_ind_dependent :
forall (n : nat) (P : forall m : nat, n <= m -> Prop),
P n (le_n n) ->
(forall (m : nat) (p : n <= m), P m p -> P (S m) (le_S n m p)) ->
forall (m : nat) (p : n <= m), P m p.
exact (fun n P Hn HS => fix ind m p : P m p := match p with
| le_n _ => Hn | le_S _ m p => HS m p (ind m p) end).
Qed.
(*
Here we give an proof-by-cases principle for <= which keeps both the left
and right hand sides fixed.
*)
Lemma le_case_remember (x y : nat) (P : x <= y -> Prop)
(IHn : forall (e : y = x), P (rew <- e in le_n x))
(IHS : forall y' (q' : x <= y') (e : y = S y'), P (rew <- e in le_S x y' q'))
: forall (p : x <= y), P p.
exact (fun p => match p with le_n _ => IHn | le_S _ y' q' => IHS y' q' end eq_refl).
Qed.
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
revert q.
induction p as [|y p IHp] using le_ind_dependent;
intro q;
case q as [e|x' q' e] using le_case_remember.
- rewrite (nat_uip e eq_refl).
reflexivity.
- (* x = S x' but x <= x', so S x' <= x', which is a contradiction *)
exfalso.
rewrite e in q'.
exact (PeanoNat.Nat.nle_succ_diag_l _ q').
- (* S y' = x but x <= y', so S y' <= y', which is a contradiction *)
exfalso; clear IHp.
rewrite <- e in p.
exact (PeanoNat.Nat.nle_succ_diag_l _ p).
- injection e as e'.
(* We now get rid of e as equal to (f_equal S e'), and then destruct e'
now that it is an equation between variables. *)
assert (f_equal S e' = e).
+ apply nat_uip.
+ destruct H.
destruct e'.
change (le_S x y p = le_S x y q').
f_equal.
apply IHp.
Qed.
Inspired by Eqdep_dec (and with a lemma from it), I've been able to cook this proof up. The idea is that x <= y can be converted to exists k, y = k + x, and roundtripping through this conversion produces a x <= y that is indeed = to the original.
(* Existing lemmas (e.g. Nat.le_exists_sub) seem unusable (declared opaque) *)
Fixpoint le_to_add {x y : nat} (prf : x <= y) : exists k, y = k + x :=
match prf in _ <= y return exists k, y = k + x with
| le_n _ => ex_intro _ 0 eq_refl
| le_S _ y prf =>
match le_to_add prf with
| ex_intro _ k rec =>
ex_intro
_ (S k)
match rec in _ = z return S y = S z with eq_refl => eq_refl end
end
end.
Fixpoint add_to_le (x k : nat) : x <= k + x :=
match k with
| O => le_n x
| S k => le_S x (k + x) (add_to_le x k)
end.
Theorem rebuild_le
{x y : nat} (prf : x <= y)
: match le_to_add prf return x <= y with
| ex_intro _ k prf =>
match prf in _ = z return x <= z -> x <= y with
| eq_refl => fun p => p
end (add_to_le x k)
end = prf.
Proof.
revert y prf.
fix rec 2. (* induction is not enough *)
destruct prf as [ | y prf].
- reflexivity.
- specialize (rec y prf).
simpl in *.
destruct (le_to_add prf) as [k ->].
subst prf.
reflexivity.
Defined.
Then, any two x <= ys will produce the same k, by injectivity of +. The decidability of = on nat tells us that the produced equalities are also equal. Thus, the x <= ys map to the same exists k, y = k + x, and mapping that equality back tells us the x <= ys were also equal.
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
rewrite <- (rebuild_le p), <- (rebuild_le q).
destruct (le_to_add p) as [k ->], (le_to_add q) as [l prf].
pose proof (f_equal (fun n => n - x) prf) as prf'.
simpl in prf'.
rewrite ?Nat.add_sub in prf'.
subst l.
apply K_dec with (p := prf).
+ decide equality.
+ reflexivity.
Defined.
I'm still hoping there's a better (i.e. shorter) proof available.
Lemma In_map_iff :
forall (A B : Type) (f : A -> B) (l : list A) (y : B),
In y (map f l) <->
exists x, f x = y /\ In x l.
Proof.
split.
- generalize dependent y.
generalize dependent f.
induction l.
+ intros. inversion H.
+ intros.
simpl.
simpl in H.
destruct H.
* exists x.
split.
apply H.
left. reflexivity.
*
1 subgoal
A : Type
B : Type
x : A
l : list A
IHl : forall (f : A -> B) (y : B),
In y (map f l) -> exists x : A, f x = y /\ In x l
f : A -> B
y : B
H : In y (map f l)
______________________________________(1/1)
exists x0 : A, f x0 = y /\ (x = x0 \/ In x0 l)
Since proving exists x0 : A, f x0 = y /\ (x = x0 \/ In x0 l) is the same as proving exists x0 : A, f x0 = y /\ In x0 l, I want to eliminate x = x0 inside the goal here so I can apply the inductive hypothesis, but I am not sure how to do this. I've tried left in (x = x0 \/ In x0 l) and various other things, but I haven't been successful in making it happen. As it turns out, defining a helper function of type forall a b c, (a /\ c) -> a /\ (b \/ c) to do the rewriting does not work for terms under an existential either.
How could this be done?
Note that the above is one of the SF book exercises.
You can get access to the components of your inductive hypothesis with any of the following:
specialize (IHl f y h); destruct IHl
destruct (IHl f y H)
edestruct IHl
You can then use exists and split to manipulate the goal into a form that is easier to work with.
As it turns out, it is necessary to define a helper.
Lemma In_map_iff_helper : forall (X : Type) (a b c : X -> Prop),
(exists q, (a q /\ c q)) -> (exists q, a q /\ (b q \/ c q)).
Proof.
intros.
destruct H.
exists x.
destruct H.
split.
apply H.
right.
apply H0.
Qed.
This does the rewriting that is needed right off the bat. I made a really dumb error thinking that I needed a tactic rather than an auxiliary lemma. I should have studied the preceding examples more closely - if I did, I'd have realized that existentials need to be accounted for.
From this example:
Example foo : forall (X : Type) (x y z : X) (l j : list X),
x :: y :: l = z :: j ->
y :: l = x :: j ->
x = y.
It can be solved just doing inversion on the second hypothesis:
Proof.
intros X x y z l j eq1 eq2. inversion eq2. reflexivity. Qed.
However, doing inversion also in the first hypothesis, yields apparently contradictory hypothesis:
Proof.
intros X x y z l j eq1 eq2. inversion eq2. inversion eq1. reflexivity. Qed.
Because, in this last proof, the generated hypothesis are:
H0 : y = x
H1 : l = j
H2 : x = z
H3 : y :: l = j
But, if I'm not missing something obvious, it is impossible for both H1 and H3 to be true at the same time.
Can someone explain me what is going on? Is it just that the example is "bad designed" (both hypothesis are contradictory) and that Coq inversion tactic just swallows them? Is it a principle of explosion based on two hypothesis considered together? If so, is it then possible to prove the example just by deriving anything from falsehood? How?
Your example is assuming contradictory hypotheses: they imply that length l + 2 is equal to length l + 1.
Require Import Coq.Lists.List.
Require Import Omega.
Example foo : forall (X : Type) (x y z : X) (l j : list X),
x :: y :: l = z :: j ->
y :: l = x :: j ->
x = y.
Proof.
intros X x y z l j eq1 eq2.
apply (f_equal (#length _)) in eq1.
apply (f_equal (#length _)) in eq2.
simpl in *.
omega.
Qed.
By the principle of explosion, it is not surprising that Coq is able to derive a contradictory context.
Besides this small oddity, there is nothing wrong with the fact that the generated hypotheses are contradictory: such contexts can arise even if the original hypotheses are consistent. Consider the following (admittedly contrived) proof:
Goal forall b c : bool, b = c -> c = b.
Proof.
intros b c e.
destruct b, c.
- reflexivity.
- discriminate.
- discriminate.
- reflexivity.
Qed.
The second and third branches have contradictory hypotheses (true = false and false = true), even if the original hypothesis, b = c, is innocuous. This example is a bit different from the original one, because the contradiction was not obtained by combining hypotheses. Instead, when we call destruct, we promise Coq to prove the conclusion by considering a few subgoals obtained by case analyses. If some of the subgoals happen to be contradictory, even better: there won't be any work to do there.
I'm new to Coq and am doing some exercises to get more familiar with it.
My understanding is that proving a proposition in Coq "really" is writing down a type in Gallina and then showing that it's inhabited using tactics to combine terms together in deterministic ways.
I'm wondering if there's a way to get a pretty-printed representation of the actual term, with all the tactics removed.
In the example below, an anonymous term of type plus_comm (x y : N) : plus x y = plus y x is ultimately produced... I think. What should I do if I want to look at it? In a certain sense, I'm curious what the tactics "desugar" to.
Here's the code in question, lifted essentially verbatim from a tutorial on YouTube https://www.youtube.com/watch?v=OaIn7g8BAIc.
Inductive N : Type :=
| O : N
| S : N -> N
.
Fixpoint plus (x y : N) : N :=
match x with
| O => y
| S x' => S (plus x' y)
end.
Lemma plus_0 (x : N) : plus x O = x.
Proof.
induction x.
- simpl. reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.
Lemma plus_S (x y : N) : plus x (S y) = S(plus x y).
Proof.
induction x.
- simpl. reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.
Lemma plus_comm (x y : N) : plus x y = plus y x.
Proof.
induction x.
- simpl. rewrite plus_0. reflexivity.
- simpl. rewrite IHx. rewrite plus_S. reflexivity.
Qed.
First of all, plus_comm is not a part of the type. You get a term named plus_comm of type forall x y : N, plus x y = plus y x. You can check it using the following command
Check plus_comm.
So, an alternative way of defining the plus_comm lemma is
Lemma plus_comm : forall x y : N, plus x y = plus y x.
As a side note: in this case you'll need to add intros x y. (or just intros.) after the Proof. part.
Tactics (and the means to glue them together) are a metalanguage called Ltac, because they are used to produce terms of another language, called Gallina, which is the specification language of Coq.
For example, forall x y : N, plus x y = plus y x is an instance of Gallina sentence as well as the body of the plus function. To obtain the term attached to plus_comm use the Print command:
Print plus_comm.
plus_comm =
fun x y : N =>
N_ind (fun x0 : N => plus x0 y = plus y x0)
(eq_ind_r (fun n : N => y = n) eq_refl (plus_0 y))
(fun (x0 : N) (IHx : plus x0 y = plus y x0) =>
eq_ind_r (fun n : N => S n = plus y (S x0))
(eq_ind_r (fun n : N => S (plus y x0) = n) eq_refl (plus_S y x0))
IHx) x
: forall x y : N, plus x y = plus y x
It is not an easy read, but with some experience you'll be able to understand it.
Incidentally, here is how we could have proved the lemma not using tactics:
Definition plus_comm : forall x y : N, plus x y = plus y x :=
fix IH (x y : N) :=
match x return plus x y = plus y x with
| O => eq_sym (plus_0 y)
| S x => eq_ind _ (fun p => S p = plus y (S x)) (eq_sym (plus_S y x)) _ (eq_sym (IH x y))
end.
To explain a few things: fix is the means of defining recursive functions, eq_sym is used to change x = y into y = x, and eq_ind corresponds to the rewrite tactic.