When I was trying to prove if two functions are equivalent and come to the step:
I : f(S a') b = S (f a' b)
f (S a') (S b) = S (f a' (S b))
I am wondering whether it's possible to use exact(I) to prove it, namely, to replace (S b) by b, since that's the only difference.
The inference from the premise to the conclusion is generally false for an arbitrary function f: consider the function f a b such that f a 0 := a and f a (S b) := S b, you can prove the premise and contradict the conclusion.
You could substitute b in I only if it was quantified universally in that hypotesis: I : forall b, f (S a') b = S (f a' b) ; in that case substituting would amount to application of I to S b.
If it's not possible to strenghten your hypothesis, you need to use something specific to the function f to conclude.
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.
Given the definition:
Definition cast (a b:Type) (p:a = b) (x:a) : b :=
match p with
| eq_refl _ => x
end.
I was hoping that the following lemma would be provable:
Lemma cast_cast_is_id : forall (a b:Type) (x:a) (p:a = b) (q:b = a),
cast b a q (cast a b p x) = x.
However, I do not seem to be able to carry out a proof for this. I can destruct p successfully, but cannot destruct q after that. Replacing the lemma's statement with eq_sym p instead of arbitrary q does not help me either it seems.
I fear I have unwittingly stumbled into some subtle point of HoTT.
Can anyone prove this lemma or is it known to be unprovable without further axioms?
I am not completely sure, but it seems to me that what you are trying to prove is no different from forall a (p:a=a), p = eq_refl. If so, you cannot prove it in Coq, unless you know something about a, e.g., decidable equality. In that case, you can use the results on UIP (unicity of identity proofs) from the standard library.
I'm working towards formalising Free Selective Applicative Functors in Coq, but struggling with proofs by induction for inductive data types with non-uniform type parameters.
Let me give a bit of an introduction on the datatype I'm dealing with.
In Haskell, we encode Free Selective Functors as a GADT:
data Select f a where
Pure :: a -> Select f a
Select :: Select f (Either a b) -> f (a -> b) -> Select f b
The crucial thing here is the existential type variable b in the second data constructor.
We can translate this definition to Coq:
Inductive Select (F : Type -> Type) (A : Set) : Set :=
Pure : A -> Select F A
| MkSelect : forall (B : Set), Select F (B + A) -> F (B -> A) -> Select F A.
As a side note, I use the -impredicative-set option to encode it.
Coq generates the following induction principle for this datatype:
Select_ind :
forall (F : Type -> Type) (P : forall A : Set, Select F A -> Prop),
(forall (A : Set) (a : A), P A (Pure a)) ->
(forall (A B : Set) (s : Select F (B + A)), P (B + A)%type s ->
forall f0 : F (B -> A), P A (MkSelect s f0)) ->
forall (A : Set) (s : Select F A), P A s
Here, the interesting bit is the predicate P : forall A : Set, Select F A -> Prop which is parametrised not only in the expression, but also in the expressions type parameter. As I understand, the induction principle has this particular form because of the first argument of the MkSelect constructor of type Select F (B + A).
Now, I would like to prove statements like the third Applicative law for the defined datatype:
Theorem Select_Applicative_law3
`{FunctorLaws F} :
forall (A B : Set) (u : Select F (A -> B)) (y : A),
u <*> pure y = pure (fun f => f y) <*> u.
Which involve values of type Select F (A -> B), i.e. expressions containing functions. However,
calling induction on variables of such types produces ill-typed terms. Consider an oversimplified example of an equality that can be trivially proved by reflexivity, but can't be proved using induction:
Lemma Select_induction_fail `{Functor F} :
forall (A B : Set) (a : A) (x : Select F (A -> B)),
Select_map (fun f => f a) x = Select_map (fun f => f a) x.
Proof.
induction x.
Coq complains with the error:
Error: Abstracting over the terms "P" and "x" leads to a term
fun (P0 : Set) (x0 : Select F P0) =>
Select_map (fun f : P0 => f a) x0 = Select_map (fun f : P0 => f a) x0
which is ill-typed.
Reason is: Illegal application (Non-functional construction):
The expression "f" of type "P0" cannot be applied to the term
"a" : "A"
Here, Coq can't construct the predicate abstracted over the type variable because the reversed function application from the statement becomes ill-typed.
My question is, how do I use induction on my datatype? I can't see a way how to modify the induction principle in such a way so the predicate would not abstract the type. I tried to use dependent induction, but it has been producing inductive hypothesis constrained by equalities similar to (A -> B -> C) = (X + (A -> B -> C)) which I think would not be possible to instantiate.
Please see the complete example on GitHub: https://github.com/tuura/selective-theory-coq/blob/impredicative-set/src/Control/Selective/RigidImpredSetMinimal.v
UPDATE:
Following the discussio in the gist I have tried to carry out proofs by induction on depth of expression. Unfortunately, this path was not very fruitful since the induction hypothesis I get in theorems similar to Select_Applicative_law3 appear to be unusable. I will leave this problem for now and will give it a try later.
Li-yao, many thanks again for helping me to improve my understanding!
Proofs by induction are motivated by recursive definitions. So to know what to apply induction to, look for Fixpoints.
Your Fixpoints most likely work on terms indexed by single type variables Select F A, that's exactly where you want to use induction, not at the toplevel of the goal.
A Fixpoint on terms indexed by function types A -> B is useless since no subterms of any Select term are indexed by function types. For the same reason, induction is useless on such terms.
Here I think the strong type discipline actually forces you to work everything out on paper before trying to do anything in Coq (which is a good thing in my opinion). Try to do the proof on paper, without even worrying about types; explicitly write down the predicate(s) you want to prove by induction. Here's a template to see what I mean:
By induction on u, we will show
u <*> pure x = pure (fun f => f x) <*> u
(* Dummy induction predicate for the sake of example. *)
(* Find the right one. *)
(* It may use quantifiers... *)
Base case (set u = Pure f). Prove:
Pure f <*> pure x = pure (fun f => f x) <*> Pure f
Induction step (set u = MkSelect v h). Prove:
MkSelect v h <*> pure x = pure (fun f => f x) <*> MkSelect v h
assuming the induction hypothesis for the subterm v (set u = v):
v <*> pure x = pure (fun f => f x) <*> v
Notice in particular that the last equation is ill-typed, but you can still run along with it to do equational reasoning. Regardless, it will likely turn out that there is no way to apply that hypothesis after simplifying the goal.
If you really need to use Coq to do some exploration, there is a trick, consisting in erasing the problematic type parameter (and all terms that depend on it). Depending on your familiarity with Coq, this tip may turn out to be more confusing than anything. So be careful.
The terms will still have the same recursive structure. Keep in mind that the proof should also follow the same structure, because the point is to add more types on top afterwards, so you should avoid shortcuts that rely on the lack of types if you can.
(* Replace all A and B by unit. *)
Inductive Select_ (F : unit -> Type) : Set :=
| Pure_ : unit -> Select_ F
| MkSelect_ : Select_ F -> F tt -> Select_ F
.
Arguments Pure_ {F}.
Arguments MkSelect_ {F}.
(* Example translating Select_map. The Functor f constraint gets replaced with a dummy function argument. *)
(* forall A B, (A -> B) -> (F A -> F B) *)
Fixpoint Select_map_ {F : unit -> Type} (fmap : forall t, unit -> (F t -> F t)) (f : unit -> unit) (v : Select_ F) : Select_ F :=
match v with
| Pure_ a => Pure_ (f a)
| MkSelect_ w h => MkSelect_ (Select_map_ fmap f w) (fmap _ tt h)
end.
With that, you can try to prove this trimmed down version of the functor laws for example:
Select_map_ fmap f (Select_map_ fmap g v) = Select_map_ fmap (fun x => f (g x)) v
(* Original theorem:
Select_map f (Select_map g v) = Select_map (fun x => f (g x)) v
*)
The point is that removing the parameter avoids the associated typing problems, so you can try to use induction naively to see how things (don't) work out.
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.
Suppose we're trying to formalize some (semi)group-theoretic properties, like this:
Section Group.
Variable A: Type.
Variable op: A -> A -> A.
Definition is_left_neutral (e: A) := forall x: A, (op e x) = x.
Definition is_right_neutral (e: A) := forall x: A, x = (op x e).
Lemma uniqueness_of_neutral:
forall a b: A, (is_left_neutral a) -> (is_right_neutral b) -> (a = b).
Proof.
intro; intro.
intros lna rnb.
elim lna with b; elim rnb with a.
reflexivity.
Qed.
End Group.
It works just fine, but, if we reverse the equation in either of the above definitions, i.e. replace the definitions with
Definition is_left_neutral (e: A) := forall x: A, x = (op e x).
and
Definition is_right_neutral (e: A) := forall x: A, (op x e) = x.
respectively, the proof fails at reflexivity, since one or both of the elim applications do nothing.
Sure there is a workaround for it, based on assert, but that's... too much effort and simply annoying...
Is there a reason why the involved Coq tactics (elim, case, etc.) are so much sensitive to the order? I suppose, it shouldn't slow down the tactics any noticeably (<< 2 times).
Is there a way to make them apply symmetry automatically, where needed, without bothering me about it every time? Couldn't find any mention of this issue in the manual.
First, using elim to manipulate equality is cumbersome. Here is how I would write your proof, using rewrite, and changing the definition of is_left_neutral.
Section Group.
Variable A: Type.
Variable op: A -> A -> A.
Definition is_left_neutral (e: A) := forall x: A, op e x = x.
Definition is_right_neutral (e: A) := forall x: A, op x e = x.
Lemma uniqueness_of_neutral:
forall a b: A, is_left_neutral a -> is_right_neutral b -> a = b.
Proof.
intros a b lna rnb.
now rewrite <- (lna b), rnb.
Qed.
End Group.
Notice the <- in the first rewrite: it tells Coq to rewrite from right-to-left insead of left-to-right. When you use elim, you can essentially only rewrite in one direction (right-to-left), which leads to the behavior that you saw.
I can't think right now of a reason for only trying one direction in the rewrite tactic, but I do not think it is for performance reasons. In any case, you can define your own variant of rewrite, which tries to rewrite left-to-right, and then right-to-left, if that does not work:
Section Group.
Variable A: Type.
Variable op: A -> A -> A.
Definition is_left_neutral (e: A) := forall x: A, op e x = x.
Definition is_right_neutral (e: A) := forall x: A, op x e = x.
Ltac my_rewrite t :=
first [ rewrite t | rewrite <- t ].
Lemma uniqueness_of_neutral:
forall a b: A, is_left_neutral a -> is_right_neutral b -> a = b.
Proof.
intros a b lna rnb.
now my_rewrite (lna b); my_rewrite rnb.
Qed.
End Group.