I have a parametric relation myeq that I would like to rewrite under the predicate P whenever both are used with the same parameter. It works well if I declare the appropriate morphism:
From Coq Require Import Setoid Morphisms.
Parameter A B : Type.
Parameter myeq : A -> relation B.
Add Parametric Relation (a : A) : B (myeq a) as myeq_rel.
Parameter P : A -> B -> Prop.
Add Parametric Morphism (a : A) : (P a)
with signature (myeq a) ==> iff as P_morphism.
Admitted.
Lemma test1 b1 b2 :
(forall a, myeq a b1 b2) ->
exists a, P a b1.
Proof.
intro.
setoid_rewrite H. (* OK *)
Abort.
However it stops working when I try to apply a function, even registered as a morphism for myeq:
Parameter Op : B -> B.
Add Parametric Morphism (a : A) : Op
with signature (myeq a) ==> (myeq a) as op_morphism.
Admitted.
Lemma test2 b1 b2 :
(forall a, myeq a b1 b2) ->
exists a, P a (Op b1).
Proof.
intro.
setoid_rewrite H. (* not OK, why? *)
Abort.
Did I forget to declare something?
Related
I tried to implement the following Coq code:
Set Implicit Arguments.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof. intros H. destruct H.
But destruct H. fails with an error message:
Abstracting over the terms "A", "B" and "g" leads to a term
fun (A0 B0 : Type) (g0 : A0 -> B0) => f = g0 which is ill-typed.
Reason is: Illegal application:
The term "#eq" of type "forall A : Type, A -> A -> Prop" cannot be applied to the terms
"A0 -> B0" : "Type"
"f" : "A -> B"
"g0" : "A0 -> B0"
The 2nd term has type "A -> B" which should be coercible to
"A0 -> B0".
I think there would be two workarounds for this kind of error, neither of which worked in this case.
One is to admit the proof_irrelevance. However, it is impossible to construct an alternating proof for fun_eq f g because the argument of fun_eqrefl is what we want.
Another way is to provide an exact term using refine, but I couldn't come up with such a term. Also, if there were such a term (it would involve match statement), I suspect my previous question could be solved in a similar way.
Is it possible to prove fun_eq0? If so, how can it be done?
You can prove it using UIP (special case of proof irrelevance for eq).
The trick is to rewrite one side of the equality f to cast eq_refl f, where cast : A = B -> A -> B, and use UIP/proof irrelevance to replace eq_refl with an equality proof obtained from the H : fun_eq f g assumption. That way, when you destruct H, the type of the LHS changes simultaneously with the type of the RHS.
Set Implicit Arguments.
From Coq Require Import ProofIrrelevance.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
(* Extract the equality on types *)
Definition fun_eq_tyeq {A B C D} (f : A -> B) (g : C -> D) (H : fun_eq f g) : (A -> B) = (C -> D) :=
match H with
| fun_eqrefl _ => eq_refl
end.
Definition cast A B (e : A = B) (x : A) : B := eq_rect A (fun T => T) x B e.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof.
intros H.
change (cast eq_refl f = g).
replace eq_refl with (fun_eq_tyeq H) by apply UIP.
destruct H.
cbn.
auto.
Qed.
I want to rewrite s in the term Forall (P s) l but it fails with my current instance declarations. Did I miss something with the morphisms?
From Coq Require Import List Streams Setoid Morphisms.
Parameter T A : Type.
Parameter P : Stream T -> A -> Prop.
Add Parametric Morphism : P
with signature #EqSt T ==> #eq A ==> iff
as P_morph.
Admitted.
Add Parametric Morphism : (#Forall A)
with signature pointwise_relation A iff ==> (#eq (list A)) ==> iff
as Forall_morph.
Admitted.
Example problematic :
forall s1 s2 l,
EqSt s2 s1 ->
Forall (P s1) l ->
Forall (P s2) l.
Proof.
intros * Heq Hf.
Fail setoid_rewrite Heq.
Abort.
P's signature should also use pointwise_relation.
Add Parametric Morphism : P
with signature #EqSt T ==> pointwise_relation A iff
as P_morph.
I'm trying to prove mapCCoption. If you compare the definition of BB to CC, they are the same except in CC the named type parameters are in the constructor. This prevents me from completing the proof because when I destruct an object of type CC option a I lose any information about type option.
Inductive BB (m : Type -> Type) (a : Type) : Type :=
| bb : m a -> BB m a.
Inductive CC : (Type -> Type) -> Type -> Type :=
| cc (m : Type -> Type) (a : Type) : m a -> CC m a.
Theorem mapBBoption (a : Type) (b : Type) (f : a -> b) (x : BB option a) : BB option b.
Proof.
apply bb.
destruct x as [o].
destruct o as [a0|].
- apply (Some (f a0)).
- apply None.
Qed.
Theorem mapCCoption (a : Type) (b : Type) (f : a -> b) (x : CC option a) : CC option b.
Proof.
apply cc.
destruct x as [m1 a1 o].
???
In this case you should use inversion instead of destruct:
Theorem mapCCoption (a : Type) (b : Type) (f : a -> b) (x : CC option a) : CC option b.
Proof.
apply cc.
inversion x as [m1 a1 o].
inversion o as [a0|].
- apply (Some (f a0)).
- apply None.
Qed.
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.
The question I have is very similar to the one presented in the link below, but on a hypothesis instead of a goal.
Apply a function to both sides of an equality in Coq?
Say I have the following definition :
Definition make_couple (a:nat) (b:nat) := (a, b).
And the following lemma to prove :
a, b : nat
H : (a, b) = make_couple a b
-------------------------------
(some goal to prove)
I would like to generate the following hypothesis:
new_H : fst (a, b) = fst (make_couple a b)
One way is to write explicitly an assert, then use eapply f_equal :
assert (fst (a, b) = fst (make_couple a b)). eapply f_equal; eauto.
But I would like to avoid, if possible, to write explicitly the assert. I would like to have some tactic or equivalent that would work like this :
apply_in_hypo fst H as new_H
Is there anything in Coq that would come close to that?
Thanks for the answers.
You can use f_equal lemma to do that.
About f_equal.
f_equal : forall (A B : Type) (f : A -> B) (x y : A), x = y -> f x = f y
Arguments A, B, x, y are implicit
Argument scopes are [type_scope type_scope function_scope _ _ _]
f_equal is transparent
Expands to: Constant Coq.Init.Logic.f_equal
Here is how you can apply it to a hypothesis:
Goal forall a b : nat, (a, b) = (a, b) -> True.
intros a b H.
apply (f_equal fst) in H.
The above snippet can be rewritten in a more concise manner using intro-patterns:
Restart.
intros a b H%(f_equal fst).
Abort.