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.
Related
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 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.
I defined a Boole inductive type based on the disjoint sum's definition:
Inductive Boole :=
| inlb (a: unit)
| inrb (b: unit).
Given two types A and B I'm trying to prove the ismorphism between
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))
and
A + B
I managed to prove one side of the isomorphism
Definition sum_to_sigT {A} {B} (z: A + B) :
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B)).
Proof.
case z.
move=> a.
exists (inrb tt).
rewrite //=.
move=> b.
exists (inlb tt).
rewrite //=.
Defined.
Lemma eq_inla_inltt (a: unit) : eq (inlb a) (inlb tt).
Proof.
by case a.
Qed.
Lemma eq_inra_inrtt (a: unit) : eq (inrb a) (inrb tt).
Proof.
by case a.
Qed.
Definition sigT_to_sum {A} {B}
(w: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) :
A + B.
Proof.
destruct w.
destruct p.
destruct x.
apply (inr (b (eq_inla_inltt a0))).
apply (inl (a (eq_inra_inrtt b0))).
Defined.
Definition eq_sum_sigT {A} {B} (x: A + B):
eq x (sigT_to_sum (sum_to_sigT x)).
Proof.
by case x.
Defined.
But I'm in trouble in proving the other side, basically because I don't manage to establish equality between the different x and p involved in the following proof:
Definition eq_sigT_sum {A} {B}
(y: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) : eq y (sum_to_sigT (sigT_to_sum y)).
Proof.
case: (sum_to_sigT (sigT_to_sum y)).
move=> x p.
destruct y.
destruct x.
destruct p.
Defined.
Does anyone know how I can prove the latter lemma?
Thanks for the help.
As bizarre as this sounds, you cannot prove this result in Coq's theory.
Let's call the type sigT (fun x => prod (eq x (inrb tt) -> A) (eq x (inlb tt) -> B)) simply T. Any element of T has the form existT x (pair f g), where x : Boole, f : eq x (inrb tt) -> A, and g : eq x (inlb tt) -> B. To show your result, you need to argue that two expressions of type T are equal, which will require at some point proving that two terms f1 and f2 of type eq x (inrb tt) -> A are equal.
The problem is that elements of eq x (inrb tt) -> A are functions: they take as input a proof that x and inrb tt are equal, and produce a term of type A as a result. And sadly, the notion of equality for functions in Coq is too weak to be useful in most cases. Normally in math, we would argue that two functions are equal by showing that they produce the same results, that is:
forall f g : A -> B,
(forall x : A, f x = g x) -> f = g.
This principle, usually known as functional extensionality, is not available in Coq by default. Fortunately, the theory allows us to safely add it as an axiom without compromising the soundness of the theory. It is even available to us in the standard library. I've included here a proof of a slightly modified version of your result. (I've taken the liberty of using the ssreflect library, since I saw you were using it too.)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Require Import Coq.Logic.FunctionalExtensionality.
Section Iso.
Variables A B : Type.
Inductive sum' :=
| Sum' x of x = true -> A & x = false -> B.
Definition sum'_of_sum (x : A + B) :=
match x with
| inl a =>
Sum' true
(fun _ => a)
(fun e : true = false =>
match e in _ = c return if c then A else B with
| erefl => a
end)
| inr b =>
Sum' false
(fun e =>
match e in _ = c return if c then A else B with
| erefl => b
end)
(fun _ => b)
end.
Definition sum_of_sum' (x : sum') : A + B :=
let: Sum' b f g := x in
match b return (b = true -> A) -> (b = false -> B) -> A + B with
| true => fun f _ => inl (f erefl)
| false => fun _ g => inr (g erefl)
end f g.
Lemma sum_of_sum'K : cancel sum_of_sum' sum'_of_sum.
Proof.
case=> [[]] /= f g; congr Sum'; apply: functional_extensionality => x //;
by rewrite (eq_axiomK x).
Qed.
End Iso.
I have a function count that counts how many times a given predicate is provable when applied to elements of a list. It is defined as follows:
Parameter T : Type.
Parameter dec: forall (p: T -> Prop) (w: T), {p w} + {~ (p w)}.
Fixpoint count (p: T -> Prop) (l: list T) := match l with
| nil => 0
| (cons head tail) => if (dec p head) then (1 + (count p tail)) else (count p tail)
end.
I then use this function to state lemmas like the following:
Parameter a b c: T.
Parameter q: T -> Prop.
Axiom Aa: (q a).
Axiom Ab: (q b).
Axiom Ac: ~ (q c).
Lemma example: (count q (cons a (cons b (cons c nil)))) = 2.
My proofs of such lemmas tend to be quite tedious:
Lemma example: (count q (cons a (cons b (cons c nil)))) = 2.
Proof.
unfold count.
assert (q a); [apply Aa| auto].
assert (q b); [apply Ab| auto].
assert (~ (q c)); [apply Ac| auto].
destruct (dec q a); [auto | contradiction].
destruct (dec q b); [auto | contradiction].
destruct (dec q c); [contradiction | auto].
Qed.
What can I do to automate such tedious proofs that involve computation with my count function?
This is typically the kind of cases where you are better off proving things by reflection. See how things go smoothly (of course I modified a bit your example to avoid all these axioms):
Require Import List.
Import ListNotations.
Fixpoint count {T : Type} (p : T -> bool) (l : list T) :=
match l with
| [] => 0
| h :: t => if p h then S (count p t) else (count p t)
end.
Inductive T := a | b | c.
Definition q x :=
match x with
| a => true
| b => true
| c => false
end.
Lemma example: (count q [a; b; c]) = 2.
Proof.
reflexivity.
Qed.
I realize that your definition of count was taking a propositional predicate on type T (but with the assumption that all predicates on type T are decidable) and instead I propose to define count to take a boolean predicate. But you may realize that having a decidable propositional predicate or having a boolean predicate is actually equivalent.
E.g. from your axioms, I can define a function which transform any propositional predicate into a boolean one:
Parameter T : Type.
Parameter dec: forall (p: T -> Prop) (w: T), {p w} + {~ (p w)}.
Definition prop_to_bool_predicate (p : T -> Prop) (x : T) : bool :=
if dec p x then true else false.
Of course, because there are axioms involved in your example, it won't actually be possible to compute with the boolean predicate. But I'm assuming that you put all these axioms for the purpose of the example and that your actual application doesn't have them.
Answer to your comment
As I told you, as soon as you have defined some function in terms of an axiom (or of a Parameter since this is the same thing), there is no way you can compute with it anymore.
However, here is a solution where the decidability of propositional predicate p is a lemma instead. I ended the proof of the lemma with Defined instead of Qed to allow computing with it (otherwise, it wouldn't be any better than an axiom). As you can see I also redefined the count function to take a predicate and a proof of its decidability. The proof by reflection still works in that case. There is no bool but it is strictly equivalent.
Require Import List.
Import ListNotations.
Fixpoint count {T : Type}
(p : T -> Prop) (dec : forall (w: T), {p w} + {~ (p w)}) (l : list T) :=
match l with
| [] => 0
| h :: t => if dec h then S (count p dec t) else (count p dec t)
end.
Inductive T := a | b | c.
Definition p x := match x with | a => True | b => True | c => False end.
Lemma dec_p: forall (w: T), {p w} + {~ (p w)}.
Proof.
intros []; simpl; auto.
Defined.
Lemma example2: (count p dec_p [a; b; c]) = 2. Proof. reflexivity. Qed.
Let's create our custom hint database and add your axioms there:
Hint Resolve Aa : axiom_db.
Hint Resolve Ab : axiom_db.
Hint Resolve Ac : axiom_db.
Now, the firstorder tactic can make use of the hint database:
Lemma example: count q (cons a (cons b (cons c nil))) = 2.
Proof.
unfold count.
destruct (dec q a), (dec q b), (dec q c); firstorder with axiom_db.
Qed.
We can automate our solution using the following piece of Ltac:
Ltac solve_the_probem :=
match goal with
|- context [if dec ?q ?x then _ else _] =>
destruct (dec q x);
firstorder with axioms_db;
solve_the_probem
end.
Then, unfold count; solve_the_probem. will be able to prove the lemma.