I'm trying to prove in Coq the following theorem:
Theorem slot_company:
forall s x, PPs s x -> exists t, PPs t x /\ s <> t.
My current context and goal are:
1 subgoal
s, x : Entity
Pssx : Ps s x
nFxs : ~ F x s
Sx : Entity
PsSxx : Ps Sx x
FxSx : F x Sx
______________________________________(1/1)
exists t : Entity,
PPs t x /\ s <> t
I would like to pose the hypothesis that there are no t with PPs t x /\ s <> t. By doing so, I can get that s = Sx, and then get a contradiction (I would have F x s /\ ~ F x s. This way, I will know that the goal is true.
The problem is that I don't know how to do so.
I'm skeptical that proof by contradiction is the way to go here, but it's hard to tell without seeing the definition of those relations.
Here's one way to do proof by contradiction:
From Coq Require Import Classical.
apply Peirce; intros Hcontra.
Related
I’m trying to prove a theorem in Coq. My current context is:
1 subgoal
s, x : Entity
Pssx : Ps s x
Fxs : F x s
IPssx : F x s /\ Ps s x
t : Entity
Ctss : C t s s
Pstx : Ps t x
Fxt : F x t
______________________________________(1/1)
C s s s
F, Ps and C are relations of the theory. I’ve also Axiom 4:
Axiom A4 : forall x s t,
Ps s x /\ F x s /\ Ps t x /\ F x t -> s = t.
What I want to do, is to use A4 in the proof, as it will help me to say that s and t are equals. So I’ve tested: pose proof (A4 x s t). A new hypothesis is added : H : Ps s x /\ F x s /\ Ps t x /\ F x t -> s = t. I know I can destruct the hypothesis H, prove the premisses and use the conclusion. But I also know that I can give the premisses directly in the pose proof command. I want to do something like pose proof (A4 x s t Premisses). But I don’t know what to put instead of Premisses.
I tried several solutions:
composing the hypothesis with /, such as pose proof (A4 x s t (Pssx /\ Fxs /\ Pstx /\ Fxt)). but I got the error The term "Pssx" has type "Ps s x" while it is expected to have type "Ps s x /\ F x s /\ Ps t x /\ F x t".
using the assert command and pose proof (A4 x s t H1).:
assert (H1 := (Ps s x) /\ (F x s) /\ (Ps t x) /\ (F x t)). but I got The term "H1" has type "Prop" while it is expected to have type "Ps s x /\ F x s /\ Ps t x /\ F x t".
assert (H1 := (Pssx) /\ (Fxs) /\ (Pstx) /\ (Fxt)). but I got The term "Pssx" has type "Ps s x" while it is expected to have type "Prop".
So my question is the following: what should I put instead of Premisses for my code to work? Is there a command to create new hypothesis based on other ones? I know how to destruct an hypothesis into two smaller hypothesis, but I don't know how to compose hypothesis to create bigger ones.
The standard in Coq would be to curry your A4 so that instead of receiving one large conjunction as a premise, it receives several different premises:
Axiom A4' : forall x s t,
Ps s x -> F x s -> Ps t x -> F x t -> s = t.
Then you can do:
pose proof (A4' x s t Pssx Fxs Pstx Fxt).
If you absolutely need A4 with the conjunctions, you can use conj (which you can find with Print "_ /\ _"):
pose proof (A4 x s t (conj Pssx (conj Fxs (conj Pstx Fxt)))).
I'm learning to use Coq and I try to prove the theorems of a paper I'm reading. The paper is Having a Part Twice Over of Karen Bennett, published in 2013. The paper propopes a mereological theory composed of two primitives F and Ps and defines the parthood relation P using the two primitives.
I coded it as follows:
Class Entity: Type.
(* Slot Mereology defines the parthood relation
* with the two primitives F and Ps.
* The idea is that wholes have slots
* filled by their parts.
* F x s means that x fills slot s.
* Ps s y means that s is a parthood slot of y.
* P is the parthood relation.
*)
Parameter F : Entity -> Entity -> Prop.
Parameter Ps : Entity -> Entity -> Prop.
Definition P (x y : Entity) :=
exists s, F x s /\ Ps s y.
(* Slot Inheritance *)
Axiom A5 : forall x y z1 z2 : Entity,
(Ps z1 y /\ F x z1) /\ Ps z2 x -> Ps z2 y.
(* Parthood Transitivity *)
Theorem T7 : forall x y z : Entity,
(P x y /\ P y z) -> P x z.
Proof.
intros x y z.
unfold P.
intro h.
destruct h as (EsPxy, EsPyz).
destruct EsPxy as (s1, Pxy).
destruct Pxy as (Fxs1, Pss1y).
destruct EsPyz as (s2, Pyz).
destruct Pyz as (Fys2, Pss2z).
exists s1.
split.
apply Fxs1.
apply A5 with (z1 := s2) (x := y).
split.
split.
assumption.
assumption.
assumption.
Qed.
I succeeded to prove theorem T7. I have two questions:
is my Coq code ok? (I'm not sure If the way I declared the type, the primitives and the predicate is the right way to do it.)
is there a shorter proof? (About the length of the proof, I only want to know about the number of tactics.)
Another approach, using ssreflect and its neat notation for destructuring, one can rephrase your explicit proof in a more compact way (I'm using Arthur's version).
From mathcomp Require Import all_ssreflect.
Parameter Entity: Type.
Parameter F : Entity -> Entity -> Prop.
Parameter Ps : Entity -> Entity -> Prop.
Definition P (x y : Entity) :=
exists s, F x s /\ Ps s y.
Axiom A5 : forall x y z1 z2 : Entity,
(Ps z1 y /\ F x z1) /\ Ps z2 x -> Ps z2 y.
Theorem T7 : forall x y z : Entity,
(P x y /\ P y z) -> P x z.
Proof.
move=> x y z [[s1 [Fxs1 Ps1y]] [s2 [Fys2 Ps2z]]].
by exists s1; split; [|exact: (A5 y z s2 s1)].
Qed.
Yes, your Coq code is OK. But there are shorter proofs. This theorem is simple enough that it can be solved with Coq's automation tactics. E.g.,
Parameter Entity: Type.
(* Slot Mereology defines the parthood relation
* with the two primitives F and Ps.
* The idea is that wholes have slots
* filled by their parts.
* F x s means that x fills slot s.
* Ps s y means that s is a parthood slot of y.
* P is the parthood relation.
*)
Parameter F : Entity -> Entity -> Prop.
Parameter Ps : Entity -> Entity -> Prop.
Definition P (x y : Entity) :=
exists s, F x s /\ Ps s y.
(* Slot Inheritance *)
Axiom A5 : forall x y z1 z2 : Entity,
(Ps z1 y /\ F x z1) /\ Ps z2 x -> Ps z2 y.
(* Parthood Transitivity *)
Theorem T7 : forall x y z : Entity,
(P x y /\ P y z) -> P x z.
Proof.
unfold P; firstorder; eauto 10 using A5.
Qed.
(Notice that I replaced "Class Entity" with "Parameter Entity": The first form is actually just defining a type whose elements are records with no fields, whereas the second one is postulating that the type Entity exists without placing any further constraints on it.)
John Major's equality comes with the following lemma for rewriting:
Check JMeq_ind_r.
(*
JMeq_ind_r
: forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, JMeq y x -> P y
*)
It is easy to generalize it like that:
Lemma JMeq_ind2_r
: forall (A:Type)(x:A)(P:forall C,C->Prop),
P A x -> forall (B:Type)(y:B), #JMeq B y A x -> P B y.
Proof.
intros.
destruct H0.
assumption.
Qed.
However I need something a bit different:
Lemma JMeq_ind3_r
: forall (A:Type)(x:A*A) (P:forall C,C*C->Prop),
P A x -> forall (B:Type)(y:B*B), #JMeq (B*B) y (A*A) x -> P B y.
Proof.
intros.
Fail destruct H0.
Abort.
Is JMeq_ind3_r provable?
If not:
Is it safe to assume it as an axiom?
Is it reducible to a simpler and safe axiom?
It's not provable. JMeq is essentially two equality proofs bundled together, one for the types and one for the values. In this case, we get from the hypothesis that A * A = B * B. From this, it is not provable that A = B, so we cannot convert a P A x into P B y.
If A * A = B * B implies A = B, that means that the pair type constructor is injective. Type constructor injectivity in general (i.e. for all types) is inconsistent with classical logic and also with univalence. For some type constructors, injectivity is provable, but not for pairs.
Is it safe to assume it as an axiom?
If you use classical logic or univalence then it isn't. Otherwise, it probably is, but I would instead try to rephrase the problem so that type constructor injectivity does not come up.
I am trying to prove that every group has an inverse function.
I have defined a group as follows:
Record Group:Type := {
G:Set;
mult:G->G->G;
e:G;
assoc:forall x y z:G, mult x (mult y z)=mult (mult x y) z;
neut:forall x:G, mult e x=x /\ mult x e=x;
inverse:forall x:G,exists y:G, mult x y = e
}.
I am aware that it is better to just replace the inverse axiom by inverse:forall x:G, {y: mult x y = e}., or even inverse:G->G. is_inverse:forall x:G, mult x (inverse x)=e., but I prefer my definition, mainly because I want the definition to be identical to the one given in a classroom.
So I have included a suitable version of the axiom of choice:
Axiom indefinite_description : forall (A : Type) (P: A->Prop), ex P -> sig P.
Axiom functional_choice : forall A B (R:A->B->Prop), (forall x, exists y, R x y) -> (exists f, forall x, R x (f x)).
Now I can prove my claim:
Lemma inv_func_exists(H:Group):exists inv_func:G H->G H, (forall x:G H, mult H x (inv_func(x))=e H).
generalize (inverse H).
apply functional_choice.
Qed.
Now that I have proved the existence, I would like to define an actual function. Here I feel that things start to go messy. The following definition creates an actual function, but seems to ugly and complicated:
Definition inv_func(H:Group):G H->G H.
pose (inv_func_exists H).
pose indefinite_description.
generalize e0 s.
trivial.
Qed.
Lastly, I would like to prove that inv_func is actually an inverse function:
Lemma inv_func_is_inverse:forall (H:Group), forall x:(G H), mult H x (inv_func H x)=e H.
I can see that Coq knows how inv_func was defined (e.g. Print inv_func), but I have no idea how to formally prove the lemma.
To conclude, I would appreciate suggestions as to how to prove the last lemma, and of better ways to define inv_func (but under my definition of group, without including the existence of such a function in the group definition. I believe the question could be relevant in many other situations when one can prove some correspondence for each element and needs to build this correspondence as a function).
There are quite a few questions inside your question. I'll try to address all of them:
First, there is no reason to prefer exists x, P + description over {x | P}, indeed, it seems weird you do so. {x | P} is perfectly valid as "there exists a x that can be computed" and I would rather use that definition with your groups.
Secondly, when creating definitions using tactics, you should end the proof with the command Defined. Using Qed will declare the definition "Opaque", which means it cannot be expanded, then preventing you proof.
The way to extract the witness from your definition is by using a projection. In this case, proj1_sig.
Using all the above we arrive at:
Definition inv_func' (H:Group) (x : G H) : G H.
Proof.
destruct (inverse H x) as [y _].
exact y.
Defined.
Definition inv_func (H:Group) (x : G H) : G H := proj1_sig (inverse H x).
Lemma inv_func_is_inverse (H:Group) (x: G H) : mult H x (inv_func H x) = e H.
Proof. now unfold inv_func; destruct (inverse H x). Qed.
I have the following during a proof, in which I need to replace normal_form step t with value t as there is a proven theorem that there are equivalent.
H1 : t1 ==>* t1' /\ normal_form step t1'
t2' : tm
H2 : t2 ==>* t2' /\ normal_form step t2'
______________________________________(1/1)
exists t' : tm, P t1 t2 ==>* t' /\ normal_form step t'
The equivalence theorem is:
Theorem nf_same_as_value
: forall t : tm, normal_form step t <-> value t
Now, I can use this theorem to rewrite normal_form occurrences in the hypotheses, but not in the goal. That is
rewrite nf_same_as_value in H1; rewrite nf_same_as_value in H2.
works on the hypothesis, but rewrite nf_same_as_value. on the goal gives:
Error:
Found no subterm matching "normal_form step ?4345" in the current goal.
Is the rewrite on the goal here impossible theoretically, or is it an implementation issue?
-- Edit --
My confusion here is that if we define normal_form step = value, the rewrite would have worked. If we define forall t, normal_form step t <-> value t, then the rewrite works if normal_form step is not quoted in an existential, but does not work if it is in an existential.
Adapting #Matt 's example,
Require Export Coq.Setoids.Setoid.
Inductive R1 : Prop -> Prop -> Prop :=
|T1_refl : forall P, R1 P P.
Inductive R2 : Prop -> Prop -> Prop :=
|T2_refl : forall P, R2 P P.
Theorem Requal : R1 = R2.
Admitted.
Theorem Requiv : forall x y, R1 x y <-> R2 x y.
Admitted.
Theorem test0 : forall y, R2 y y -> exists x, R1 x x.
Proof.
intros. rewrite <- Requal in H. (*works*) rewrite Requal. (*works as well*)
Theorem test2 : forall y, R2 y y -> exists x, R1 x x.
Proof.
intros. rewrite <- Requiv in H. (*works*) rewrite Requiv. (*fails*)
What confuses me is why the last step has to fail.
1 subgoal
y : Prop
H : R1 y y
______________________________________(1/1)
exists x : Prop, R1 x x
Is this failure related to functional extensionality?
The error message is particularly confusing:
Error:
Found no subterm matching "R1 ?P ?P0" in the current goal.
There is exactly one subterm matching R1 _ _, namely R1 x x.
Also, per #larsr, the rewrite works if eexists is used
Theorem test1 : forall y, R2 y y -> exists x, R1 x x.
Proof.
intros. eexists. rewrite Requiv. (*works as well*) apply H. Qed.
What did eexists add here?
The rewrite cannot go under the existential quantifier. You'll need to instantiate t' first before you can do the rewrite. Note that econstructor may be a useful tactic in this case, which can replace the existential quantifier with a unification variable.
EDIT in response to OP's comment
This will still not work for equality. As an example, try:
Inductive R1 : Prop -> Prop -> Prop :=
|T1_refl : forall P, R1 P P.
Inductive R2 : Prop -> Prop -> Prop :=
|T2_refl : forall P, R2 P P.
Theorem Req : forall x y, R1 x y = R2 x y.
Admitted.
Theorem test : forall y, R2 y y -> exists x, R1 x x.
Proof.
intros. rewrite Req. (*rewrite still fails*)
The issue is not actually about equality vs. iff, the issue relates to rewriting under a binding (in this case a lambda). The implementation of exists x : A, P is really just syntax for ex A (fun x => P x), so the rewrite is failing not because of the iff, but because the rewrite tactic does not want to go under the binding for x in (fun x => P x). It seems as though there might be a way to do this with setoid_rewrite, however, I don't have any experience with this.