I got stuck while doing some coq proofs around the state monad. Concretely, I've simplified the situation to this proof:
Definition my_call {A B C} (f : A -> B * C) (a : A) : B * C :=
let (b, c) := f a in (b, c).
Lemma mycall_is_call : forall {A B C} (f : A -> B * C) (a : A), my_call f a = f a.
Proof.
intros A B C f a.
unfold my_call.
(* stuck! *)
Abort.
The resulting goal after invoking unfold is (let (b, c) := f a in (b, c)) = f a. If I'm not wrong, both sides of the equality should be exactly the same, but I don't know how to show it from here. Any help?
--
As a side note, I've seen that coq automatically applies the simplification when no product types are involved in the result of the function:
Definition my_call' {A B : Type} (f : A -> B) (a : A) : B :=
let b := f a in b.
Lemma my_call_is_call' : forall A B (f : A -> B) (a : A), my_call' f a = f a.
Proof.
intros A B f a.
unfold my_call'.
reflexivity.
Qed.
It's easy to see what you need to do next, once you recall that
let (b, c) := f a in (b, c)
is syntactic sugar for
match f a with (b, c) => (b, c) end
This means you need to destruct on f a to finish the proof:
Lemma mycall_is_call {A B C} (f : A -> B * C) a :
my_call f a = f a.
Proof.
unfold my_call.
now destruct (f a).
Qed.
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'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.
Is functional extensionality provable for John Major's equality (possibly relying on safe axioms)?
Goal forall A (P:A->Type) (Q:A->Type)
(f:forall a, P a) (g:forall a, Q a),
(forall a, JMeq (f a) (g a)) -> JMeq f g.
If not, is it safe to assume it as an axiom?
It's provable from usual function extensionality.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.JMeq.
Theorem jmeq_funext
A (P : A -> Type) (Q : A -> Type)
(f : forall a, P a)(g : forall a, Q a)
(h : forall a, JMeq (f a) (g a)) : JMeq f g.
Proof.
assert (pq_eq : P = Q).
apply functional_extensionality.
exact (fun a => match (h a) with JMeq_refl => eq_refl end).
induction pq_eq.
assert (fg_eq : f = g).
apply functional_extensionality_dep.
exact (fun a => JMeq_rect (fun ga => f a = ga) eq_refl (h a)).
induction fg_eq.
exact JMeq_refl.
Qed.
I am trying to prove that given
(eqX : relation X) (Hypo : Equivalence eqX) (f : X -> {x : X | P x})
then
eqX a b -> eqX (proj1_sig (f a)) (proj1_sig (f b))
The function f get a parameter of Type X and give an existing assertion {x : X | P x}. ( for example fun (n : nat) => {m : nat | S m = n} )
In one word, I would like to show that given two parameters which are equivalent under the equivalent relation eqX, then the destruct result of existing assertion {x : X | P x} is also of the same equivalence class.
Can I prove this goal directly(which means the Specif.sig hold this property), or I should prove or claim that f satisfy some constraint and after which can I get this assertion proven.
Your claim is not directly provable; consider
X := nat
eqX a b := (a mod 2) = (b mod 2)
P a := True
f x := exist P (x / 2) I
Then we have eqX 2 4 but we don't have eqX (proj1_sig (f 2)) (proj1_sig (f 4)) because we don't have eqX 1 2.
You can either take in the theorem you are trying to prove as a hypothesis, or you can take in a hypothesis of type forall a, proj1_sig (f a) = a, or you can take in a hypothesis of type forall a, eqX (proj1_sig (f a)) a. Note that all of these are provable (by reflexivity or intros; assumption) if you have f a := exist P a (g a) for some function g.
Is this what you are trying to show?
Require Import Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.Equivalence.
Require Import Setoid.
Generalizable All Variables.
Lemma foo `{!#Equivalence A RA, #Equivalence B RB, f : #respecting A _ _ B _ _ , #equiv A _ _ a b} :
equiv (proj1_sig f a) (proj1_sig f b).
Proof.
now apply respecting_equiv.
Qed.
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.