How can I reorder existential variables in Coq? - coq

In some cases it is easier to instantiate the one existential term before another. In this contrived example, I wish to set c = 3 first, and from that choose, say a = 1 and b = 2.
Lemma three_nats : exists (a : nat) (b : nat) (c : nat),
a + b = c.
Proof.
eexists.
eexists.
exists 3.
(* Now what? *)
Is there a way to use just the simple exists 3 on c first?

You can use that it is enough to prove that there exists c,b,a such that a+b=c.
enough (exists c a b, a + b = c).
Now you have two goals. First, that
exists c a b, a + b = c -> exists a b c, a + b = c.
and second, that
exists c a b, a + b = c.
Btw, you can finish off the first part of the proof quickly with firstorder like this:
enough (exists c a b, a + b = c) by firstorder.
Or if you don't want to repeat the goal, just apply this lemma:
Lemma ex_swap {A B C} {P:A->B->C->Prop}:
(exists c a b, P a b c) -> exists a b c, P a b c.
Proof. firstorder. Qed.

Related

Best way to make a relation associative in Coq

I’ve a relation C that takes three parameters. It represents an operation of my theory. So C(a, b, c) represents a = b # c, however I didn’t (succeed to) define this operator in Coq, so I use only the relation C. I want this relation to be associative: (d # e) # f = d # (e # f). And I have to express it with C. I thought of two axioms, but I don’t know which one is best (if they’re are both correct).
Parameter Entity: Set.
Parameter C : Entity -> Entity -> Entity -> Prop.
Axiom asso1 : forall a c d e,
((exists b, C a b c /\ C b d e) <-> (exists f, C a d f /\ C f e c)).
Axiom asso2 : forall s t u a b c d,
(C a s t -> C b a u -> C d s c -> C c t u -> b = d).
What do you think about it?
Both axioms are equivalent if you also know that C is a functional relation (i.e., it represents a function): every input pair maps to a unique output.
(* A functional relation is one that is total and deterministic in the following sense: *)
Axiom total_C : forall a b, exists c, C c a b.
Axiom deterministic_C : forall a b c c', C c a b -> C c' a b -> c = c'.

Defining functions inside proof scope

I'm trying to prove that injective functions are left invertible in Coq. I've reached a point in my proof where my goal is an "exists" proposition. I want to define a function that uses terms from proof scope (types and functions I've intro'ed before) and then show the function to the "exists" goal. Here's what I wrote so far:
(* function composition *)
Definition fun_comp {A B C: Type} (f:A -> B) (g:B -> C) : A -> C :=
fun a: A => g (f a).
Notation "g .o f" := (fun_comp f g) (at level 70).
Definition nonempty (A: Type) := exists a: A, a = a.
(* identity function for any given type *)
Definition fun_id (A: Type) := fun a: A => a.
(* left invertible *)
Definition l_invertible {A B: Type} (f: A -> B) :=
exists fl:B->A, fl .o f = fun_id A.
Definition injective {A B: Type} (f: A -> B) :=
forall a a': A, f a = f a' -> a = a'.
(* is a given element in a function's image? *)
Definition elem_in_fun_image {A B: Type} (b: B) (f: A -> B) :=
exists a: A, f a = b.
Theorem injective_is_l_invertible:
forall (A B: Type) (f: A -> B), nonempty A /\ injective f -> l_invertible f.
Proof.
intros A B f H.
destruct H as [Hnempty Hinj].
unfold l_invertible.
unfold nonempty in Hnempty.
destruct Hnempty as [a0].
(* here would go my function definition and invoking "exists myfun" *)
Here's the function I'm trying to define:
Definition fL (b: B) := if elem_in_fun_image b f
then f a
else a0.
Here's what the proof window looks like:
1 subgoal
A : Type
B : Type
f : A -> B
a0 : A
H : a0 = a0
Hinj : injective f
========================= (1 / 1)
exists fl : B -> A, (fl .o f) = fun_id A
How do I do this? I'm very new to Coq so other comments and pointers are welcome.
This definition cannot be performed in the basic logic. You need to add in a few extra axioms:
(* from Coq.Logic.FunctionalExtensionality *)
functional_extensionality : forall A B (f g : A -> B),
(forall x, f x = g x) -> f = g
(* from Coq.Logic.Classical *)
classic : forall P : Prop, P \/ ~ P
(* from Coq.Logic.ClassicalChoice *)
choice : forall (A B : Type) (R : A->B->Prop),
(forall x : A, exists y : B, R x y) ->
exists f : A->B, (forall x : A, R x (f x)).
The goal is to define a relation R that characterizes the left inverse that you want to construct. The existentially quantified f will then be the inverse! You will need the classic axiom to show the precondition of choice, and you will need functional extensionality to show the equation that you want. I'll leave it as an exercise to find out what R needs to be and how to complete the proof.
Your script should start with the following line.
Require Import ClassicalChoice FunctionalEquality.
Because, as suggested by #arthur-azevedo-de-amorim, you will need these axioms.
Then, you should use choice with the relation "R y x" being
"f x = A or there is no element in A such whose image by f is y".
You will need the axiom classic to prove the existential statement that is required by choice:
assert (pointwise : forall y: B, exists x : A,
f x = y \/ (forall x : A f x <> y)).
choice will give you an existential statement for a function that returns the value you want. You only need to say that this function is the right one. You can give a name to that function by typing destruct (choice ... pointwise) (you have to fill in the ...).
You will have to prove an equality between two functions, but using the axiom functional_extensionality, you can reduce this problem to just proving that the two functions are equal on any x.
For that x, just instantiate the characteristic property of the function (as produced by destruct (choice ... pointwise) with the
value f x. There is a disjuction, but the right-hand side case is self-contradictory, because obviously f x is f x for some x.
For the left-hand side case, you will get an hypothesis of the form (I name the function produced by (choice ... pointwise) with the name it:
f (it (f x)) = f x
Here you can apply your injectivity assumption. to deduce that it (f x) = x.
This pretty much spells out the proof. In my own, experiment, I used classic, NNP, not_all_ex_not, functional_extensionality, which are lemmas coming from ClassicalChoice of FunctionalEquality.

Can't use PeanoNat.Nat.add_assoc in proof

Require Import PeanoNat.
Check PeanoNat.Nat.add_assoc.
Output:
Nat.add_assoc
: forall n m p : nat, n + (m + p) = n + m + p
So, the theorem is defined.
But when I create a theorem and try to use it, it gives an error:
Theorem a : forall a b c d e f,
a + b + c + d + e = f.
Proof.
intros.
PeanoNat.Nat.add_assoc a (b + c) d.
Error: The reference PeanoNat.Nat.add_assoc was not found in the
current environment.
Why can't it find the theorem?
What comes after Proof. is not the proof itself. It's a series of instructions, called tactics, that tells Coq how to build a proof. add_assoc is a proof, not a tactic that builds a proof. You would use the tactic rewrite (Nat.add_assoc a (b + c) d) to rewrite (any part of) the goal according to the equality
Nat.add_assoc a (b + c) d
: a + (b + c + d) = a + (b + c) + d
However, your goal a + b + c + d + e = f does not contain either of those terms—+ is left associative and your goal is actually (((a + b) + c) + d) + e = f—so this tactic will fail. In fact, your goal is unprovable, but I assume that it's just for example. You may also be interested in the tactic apply [prf]. It takes the conclusion (thing on the right side of all the ->s and foralls) of prf, matches it against the goal, and gives you subgoals for all of its hypotheses. See also: the Coq tactic reference.

example for introduction pattern (p1 & ... & pn) does not work

I am reading the Coq (8.5p1) reference manual,
introduction via (p1 & ... & pn) is a shortcut for introduction via
(p1,(...,(...,pn)...)); it expects the hypothesis to be a sequence of
right-associative binary inductive constructors such as conj or
ex_intro; for instance, an hypothesis with type A/(exists x, B/\C/\D)
can be introduced via pattern (a & x & b & c & d);
Trying to test this out, I did:
Goal forall A B C D: Prop, A/\(exists x:nat, B/\C/\D) -> D.
intros (a & x & b & c & d).
But Coq is telling me:
Error: Not an inductive product.
And I got the same error for a few other variants, such as one without the -> D.
Can some one please explain what's the correct usage (in a hopefully useful example)?
Since your goal starts with forall A B C D: Prop, you need to introduce A B C D first:
intros A B C D (a & x & b & c & d).
I think this syntax was introduced to get rid of nested square brackets, which can be used to destructure during the introduction phase. Compare the following two proofs:
Goal forall A B C D: Prop,
A /\ (exists x:nat, B /\ C /\ D) -> D.
intros A B C D (_ & _ & _ & _ & d). assumption. Qed.
Goal forall A B C D: Prop,
A /\ (exists x:nat, B /\ C /\ D) -> D.
intros A B C D [_ [_ [_ [_ d]]]]. assumption. Qed.
I think the first one is easier on eyes.

Coq proof of forall a b c: nat, b >= c -> a + b - c = a + (b - c)

Does anybody know of a proof in any of the standard libraries of Coq of the following theorem? If there is one, I couldn´t find it.
forall a b c: nat, b >= c -> a + b - c = a + (b - c)
Thanks in advance,
Marcus.
It is unlikely that somewhat specific formulations would be in the standard library. In particular, for regular Presburger arithmetic, there is a powerful tactic that is complete, namely omega:
Require Import Omega.
Theorem t : forall a b c: nat, b >= c -> a + b - c = a + (b - c).
Proof.
intros. omega.
Qed.
There is a very similar lemma in the Coq standard library (checked with version 8.5pl3), it's called
Nat.add_sub_assoc
: forall n m p : nat, p <= m -> n + (m - p) = n + m - p
Here is how it can be used:
Require Import Coq.Arith.Arith.
Goal forall a b c: nat, b >= c -> a + b - c = a + (b - c).
intros a b c H.
apply (eq_sym (Nat.add_sub_assoc _ _ _ H)).
Qed.
You can use Coq's search facilities to discover it:
Require Import Coq.Arith.Arith.
Search (_ + _ - _).