setoid_rewrite failed with MathClasses Coq - coq

I have been trying to solve the following for quite a moment now.
Require Import
Coq.Classes.Morphisms
MathClasses.interfaces.abstract_algebra
MathClasses.interfaces.vectorspace
MathClasses.misc.workaround_tactics
MathClasses.theory.setoids
MathClasses.theory.groups.
Lemma f_equiv' `{Equiv A} `{f : A -> A} :
f = f -> forall x y, x = y -> f x = f y.
Proof.
intros.
f_equiv.
assumption.
Qed.
Goal forall `{HVS : VectorSpace K V}, forall α : K, α · mon_unit = mon_unit.
Proof.
intros.
setoid_rewrite <- right_identity at 1.
setoid_rewrite <- right_inverse with (x := α · mon_unit) at 2 3.
setoid_rewrite associativity.
apply #f_equiv' with (f := fun v => v & - (α · mon_unit)).
{ cbv; intros ?? Hxy; now rewrite Hxy. }
setoid_rewrite <- distribute_l.
setoid_rewrite left_identity. (* Error: setoid rewrite failed *)
As written in the last line, the setoid_rewrite fails with this error message :
Error: setoid rewrite failed: Unable to satisfy the following constraints:
UNDEFINED EVARS:
?X6739==[K V Ke Kplus Kmult Kzero Kone Knegate Krecip Ve Vop Vunit Vnegate
sm HVS α |- relation V] (internal placeholder) {?r}
?X6740==[K V Ke Kplus Kmult Kzero Kone Knegate Krecip Ve Vop Vunit Vnegate
sm HVS α (do_subrelation:=do_subrelation)
|- Proper (equiv ==> ?r) (scalar_mult α)] (internal placeholder) {?p}
?X6840==[K V Ke Kplus Kmult Kzero Kone Knegate Krecip Ve Vop Vunit Vnegate
sm HVS α |- relation V] (internal placeholder) {?r0}
?X6841==[K V Ke Kplus Kmult Kzero Kone Knegate Krecip Ve Vop Vunit Vnegate
sm HVS α (do_subrelation:=do_subrelation)
|- Proper (?r ==> ?r0 ==> flip impl) equiv] (internal placeholder) {?p0}
?X6842==[K V Ke Kplus Kmult Kzero Kone Knegate Krecip Ve Vop Vunit Vnegate
sm HVS α |- ProperProxy ?r0 (α · mon_unit)] (internal placeholder) {?p1}
TYPECLASSES:?X6739 ?X6740 ?X6840 ?X6841 ?X6842
SHELF:||
FUTURE GOALS STACK:?X6842 ?X6841 ?X6840 ?X6740 ?X6739 ?X6611 ?X6610 ?X6609
?X6608 ?X6607 ?X6606 ?X6605||?X64 ?X62 ?X60 ?X58 ?X57 ?X56 ?X55 ?X54 ?X53
?X52 ?X51 ?X50 ?X49 ?X48 ?X47 ?X46 ?X45 ?X44 ?X43 ?X42
I have tried changing notations, using cbv, as suggested in this question.
How can I use the left_identity lemma without the error appearing ?

I'm not an expert in the details of how the unification with the implicit variables works, so I can't explain why the rewrite fails, but I've encountered it enough to at least give a "hack" solution.
Before the final "rewrite left_identity", do a
pose proof scalar_mult_proper.
As the context now contains a proof saying that it is ok to rewrite "under" scalar multiplication that the rewrite tactic is able to use, you can now finish the proof as expected with
rewrite left_identity.
reflexivity.
(Btw, you don't need the f_equiv' lemma, for this proof, simple rewriting is enough.)
To me the problem you encountered is a problem that I run into now and then. To me it is a usability-bug, or perhaps a bug in my expectation of how the instance resolution works, and I would also love a mechanistic explanation of this behaviour.
Some background for those who didn't paste the code into a Coq session to see what happens:
The goal just before the rewrite that fails is
α · (mon_unit & mon_unit) = α · mon_unit
Here "=" is notation for equiv which is Ve in this context (which is the equality relation for vectors), and · is notation for scalar_mult, and & is notation for the semigroup operation, i.e. vector addition in this case. And we want to rewrite one of the arguments of scalar_mult inside the equiv relation. Therefore we need instances of type Proper that enables this. These instances already exist. In particular we have
scalar_mult_proper
: Proper (equiv ==> equiv ==> equiv) sm
which I found with Search Proper scalar_mult. To use this instance we need a lot of implicit variables to be filled in. Here is the full list:
Print scalar_mult_proper.
scalar_mult_proper =
λ (R M : Type) (Re : Equiv R) (Rplus : Plus R) (Rmult : Mult R)
(Rzero : Zero R) (Rone : One R) (Rnegate : Negate R)
(Me : Equiv M) (Mop : SgOp M) (Munit : MonUnit M)
(Mnegate : Negate M) (sm : ScalarMult R M) (Module0 : Module R M),
let (_, _, _, _, _, _, scalar_mult_proper) := Module0 in scalar_mult_proper
: ∀ (R M : Type) (Re : Equiv R) (Rplus : Plus R)
(Rmult : Mult R) (Rzero : Zero R) (Rone : One R)
(Rnegate : Negate R) (Me : Equiv M) (Mop : SgOp M)
(Munit : MonUnit M) (Mnegate : Negate M)
(sm : ScalarMult R M),
Module R M → Proper (equiv ==> equiv ==> equiv) sm
Almost all of those values should be filled in automatically, but for some reason the setoid_rewrite fails to do that by itself.
However, when I just add a copy of this rule to the context with pose, then the implicit variables are filled in, and the setoid_rewrite can use the rule without getting confused about what values should be used for R M Rplus Rnegate Me Module and all the other the arguments to scalar_mult_proper.

Related

Controlling unification order in Coq

I have a function whose second argument depends on its first argument, like this:
Definition is_nice (f : Formula) (pf : FProof f) : bool := true.
And I have a unification goal, like this
is_nice (some_formula ?u) (some_proof ?u) =^= is_nice f pf
.
which fails to unify when the unification starts from left to right,
but it would be unifiable when we first unify (some_proof ?u =^= pf),
infer the value for u during this unification, and then proceed to unify
some_formula ?u =^= f with the knowledge of u.
How do I make Coq solve such unification problem? I have the following ideas:
Change is_nice so that the order of parameters is different. However, I do not know how to achieve this because of the dependency between the parameters. We would need to somehow break this dependency...
Change is_nice so that it uses some canonical structure trickery to reorder the unification problems. There is some trick like that described in the extended version of Gonthier's 'How to make ad hoc proof automation less ad hoc' paper, but it does not seem to be directly applicable.
Somehow infer ?u even before the unification of that goal starts. But again, I am not sure how.
I may use UniCoq, but it is not a requirement.
As an example, consider the following piece of code:
Inductive Formula : Set :=
| f_atomic : nat -> Formula
| f_imp : Formula -> Formula -> Formula.
Inductive FProof : Formula -> Set :=
| P1 : forall (f1 f2 : Formula), FProof (f_imp f1 (f_imp f2 f1))
| MP : forall (f1 f2 : Formula), FProof f1 -> FProof (f_imp f1 f2) -> FProof f2
.
Definition is_nice (f : Formula) (pf : FProof f) : bool := true.
Lemma impl_5_is_nice': forall (n1 : nat), is_nice _ (P1 (f_atomic (n1 + 0)) (f_atomic 5)) = true.
Proof. intros. unfold is_nice. reflexivity. Qed.
Lemma impl_3_5_is_nice: is_nice _ (P1 (f_atomic 3) (f_atomic 5) ) = true.
Proof. intros.
Fail apply impl_5_is_nice'.
apply (impl_5_is_nice' 3).
Qed.
The types Formula and FProof represent formulas and proofs in a deeply-embedded logic. The proof script of Lemma impl_3_5_is_nice demostrates the problem: the first apply does not go through, because the unification of f_atomic (?n1 + 0) with f_atomic 3 fails. However, when we manually compare the goal and Lemma impl_5_is_nice', we can realize that n1 has to be 3, and so we can specialize the lemma.
Another solution would be to inspect the goal using match goal, but then the problem is that I have quite a lot of lemmas similar impl_5_is_nice', and the tactic that would do the inspection would need to understand each one of these lemmas. Ideally, this would be unified using type classes or canonical structures, but this is really a 'backup plan'.

Why unable to perform case analysis in rather simple case

Well, the code
From mathcomp Require Import ssreflect ssrnat ssrbool eqtype.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Inductive nat_rels m n : bool -> bool -> bool -> Set :=
| CompareNatLt of m < n : nat_rels m n true false false
| CompareNatGt of m > n : nat_rels m n false true false
| CompareNatEq of m == n : nat_rels m n false false true.
Lemma natrelP m n : nat_rels m n (m < n) (m > n) (m == n).
Proof.
case (leqP m n); case (leqP n m).
move => H1 H2; move: (conj H1 H2) => {H1} {H2} /andP.
rewrite -eqn_leq => /eqP /ssrfun.esym /eqP H.
by rewrite H; constructor.
move => H. rewrite leq_eqVlt => /orP.
case.
Error is Error: Case analysis on sort Set is not allowed for inductive definition or.
The last goal before the case is
m, n : nat
H : m < n
============================
m == n \/ m < n -> nat_rels m n true false (m == n)
I've already used this construction (rewrite leq_eqVlt => /orP; case) in very similar situation and it just worked:
Lemma succ_max_distr n m : (maxn n m).+1 = maxn (n.+1) (m.+1).
Proof.
wlog : m n / m < n => H; last first.
rewrite max_l /maxn; last by exact: ltnW.
rewrite leqNgt.
have: m.+1 < n.+2 by apply: ltnW.
by move => ->.
case: (leqP n m); last by apply: H.
rewrite leq_eqVlt => /orP. case.
What is the difference between two cases?
and Why "Case analysis on sort Set is not allowed for inductive definition or"?
The difference between the two cases is the sort of the goal (Set vs Prop) when you execute the case command. In the first situation your goal is nat_rels ... and you declared that inductive in Set; in the second situation your goal is an equality that lands in Prop.
The reason why you can't do a case analysis on \/ when the goal is in Set (the first situation) is because \/ has been declared as Prop-valued. The main restriction associated to such a declaration is that you cannot use informative content from a Prop to build something in Set (or more generally Type), so that Prop is compatible with an erasure-semantic at extraction time.
In particular, doing a case analysis on \/ gives away the side of the \/ that is valid, and you can't be allowed to use that information for building some data in Set.
You have at least two solutions at your disposal:
You could move your family nat_rels from Set to Prop if that's compatible with what you want to do later on.
Or you could use the fact that the hypothesis that you want to branch on is decidable and find a way to produce some {m == n} + { m <n } out of m <= n; here the notation { _ } + { _ } is the Set-valued disjunction of proposition.

Computing with a finite subset of an infinite representation in Coq

I have a function Z -> Z -> whatever which I treat as a sort of a map from (Z, Z) to whatever, let's type it as FF.
With whatever being a simple sum constructible from nix or inj_whatever.
This map I initialize with some data, in the fashion of:
Definition i (x y : Z) (f : FF) : FF :=
fun x' y' =>
if andb (x =? x') (y =? y')
then inj_whatever
else f x y.
The =? represents boolean decidable equality on Z, from Coq's ZArith.
Now I would like to have equality on two of such FFs, I don't mind invoking functional_extensionality. What I would like to do now is to have Coq computationally decide equality of two FFs.
For example, suppose we do something along the lines of:
Definition empty : FF := fun x y => nix.
Now we add some arbitrary values to make foo and foo', those are equivalent under functional extensionality:
Definition foo := i 0 0 (i 0 (-42) (i 56 1 empty)).
Definition foo' := i 0 (-42) (i 56 1 (i 0 0 empty)).
What is a good way to automatically have Coq determine foo = foo'. Ltac level stuff? Actual terminating computation? Do I need domain restriction to a finite one?
The domain restriction is a bit of an intricate one. I manipulate the maps in a way f : FF -> FF, where f can extend the subset of Z x Z that the computation is defined on. As such, come to think of it, it can't be f : FF -> FF, but more like f : FF -> FF_1 where FF_1 is a subset of Z x Z that is extended by a small constant. As such, when one applies f n times, one ends up with FF_n which is equivalent to domain restriction of FF plus n * constant to the domain. So the function f slowly (by a constant factor) expands the domain FF is defined on.
As I said in the comment more specifics are needed in order to elaborate a satisfactory answer. See the below example --- intended for a step by step description --- on how to play with equality on restricted function ranges using mathcomp:
From mathcomp Require Import all_ssreflect all_algebra.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
(* We need this in order for the computation to work. *)
Section AllU.
Variable n : nat.
(* Bounded and unbounded fun *)
Definition FFb := {ffun 'I_n -> nat}.
Implicit Type (f : FFb).
Lemma FFP1 f1 f2 : reflect (f1 = f2) [forall x : 'I_n, f1 x == f2 x].
Proof. exact/(equivP eqfunP)/ffunP. Qed.
Lemma FFP2 f1 f2 :
[forall x : 'I_n, f1 x == f2 x] = all [fun x => f1 x == f2 x] (enum 'I_n).
Proof.
by apply/eqfunP/allP=> [eqf x he|eqf x]; apply/eqP/eqf; rewrite ?enumT.
Qed.
Definition f_inj (f : nat -> nat) : FFb := [ffun x => f (val x)].
Lemma FFP3 (f1 f2 : nat -> nat) :
all [fun x => f1 x == f2 x] (iota 0 n) -> f_inj f1 = f_inj f2.
Proof.
move/allP=> /= hb; apply/FFP1; rewrite FFP2; apply/allP=> x hx /=.
by rewrite !ffunE; apply/hb; rewrite mem_iota ?ltn_ord.
Qed.
(* Exercise, derive bounded eq from f_inj f1 = f_inj f2 *)
End AllU.
The final lemma should indeed allow you reduce equality of functions to a computational, fully runnable Gallina function.
A simpler version of the above, and likely more useful to you is:
Lemma FFP n (f1 f2 : nat -> nat) :
[forall x : 'I_n, f1 x == f2 x] = all [pred x | f1 x == f2 x] (iota 0 n).
Proof.
apply/eqfunP/allP=> eqf x; last by apply/eqP/eqf; rewrite mem_iota /=.
by rewrite mem_iota; case/andP=> ? hx; have /= -> := eqf (Ordinal hx).
Qed.
But it depends on how you (absent) condition on range restriction is specified.
After your edit, I think I should add a note on the more general topic of map equality, indeed you can define a more specific type of maps other than A -> B and then build a decision procedure.
Most typical map types [including the ones in the stdlib] will work, as long as they support the operation of "binding retrieval", so you can reduce equality to the check of finitely-many bound values.
In fact, the maps in Coq's standard library do already provide you such computational equality function.
Ok, this is a rather brutal solution which does not attempt to avoid doing the same case distinctions multiple times but it's fully automated.
We start with a tactic which inspects whether two integers are equal (using Z.eqb) and translates the results to a proposition which omega can deal with.
Ltac inspect_eq y x :=
let p := fresh "p" in
let q := fresh "q" in
let H := fresh "H" in
assert (p := proj1 (Z.eqb_eq x y));
assert (q := proj1 (Z.eqb_neq x y));
destruct (Z.eqb x y) eqn: H;
[apply (fun p => p eq_refl) in p; clear q|
apply (fun p => p eq_refl) in q; clear p].
We can then write a function which fires the first occurence of i it can find. This may introduce contradictory assumptions in the context e.g. if a previous match has revealed x = 0 but we now call inspect x 0, the second branch will have both x = 0 and x <> 0 in the context. It will be automatically dismissed by omega.
Ltac fire_i x y := match goal with
| [ |- context[i ?x' ?y' _ _] ] =>
unfold i at 1; inspect_eq x x'; inspect_eq y y'; (omega || simpl)
end.
We can then put everything together: call functional extensionality twice, repeat fire_i until there's nothing else to inspect and conclude by reflexivity (indeed all the branches with contradictions have been dismissed automatically!).
Ltac eqFF :=
let x := fresh "x" in
let y := fresh "y" in
intros;
apply functional_extensionality; intro x;
apply functional_extensionality; intro y;
repeat fire_i x y; reflexivity.
We can see that it discharges your lemma without any issue:
Lemma foo_eq : foo = foo'.
Proof.
unfold foo, foo'; eqFF.
Qed.
Here is a self-contained gist with all the imports and definitions.

Instantiating an existential with a specific proof

I'm currently trying to write a tactic that instantiates an existential quantifier using a term that can be generated easily (in this specific example, from tauto). My first attempt:
Ltac mytac :=
match goal with
| |- (exists (_ : ?X), _) => cut X;
[ let t := fresh "t" in intro t ; exists t; firstorder
| tauto ]
end.
This tactic will work on a simple problem like
Lemma obv1(X : Set) : exists f : X -> X, f = f.
mytac.
Qed.
However it won't work on a goal like
Lemma obv2(X : Set) : exists f : X -> X, forall x, f x = x.
mytac. (* goal becomes t x = x for arbitrary t,x *)
Here I would like to use this tactic, trusting that the f which tauto finds will be just fun x => x, thus subbing in the specific proof (which should be the identity function) and not just the generic t from my current script. How might I go about writing such a tactic?
It's much more common to create an existential variable and let some tactic (eauto or tauto for example) instantiate the variable by unification.
On the other hand, you can also literally use a tactic to provide the witness using tactics in terms:
Ltac mytac :=
match goal with
| [ |- exists (_:?T), _ ] =>
exists (ltac:(tauto) : T)
end.
Lemma obv1(X : Set) : exists f : X -> X, f = f.
Proof.
mytac.
auto.
Qed.
You need the type ascription : T so that the tactic-in-term ltac:(tauto) has the right goal (the type the exists expects).
I'm not sure this is all that useful (usually the type of the witness isn't very informative and you want to use the rest of the goal to choose it), but it's cool that you can do this nonetheless.
You can use eexists to introduce an existential variable, and let tauto instantiates it.
This give the following simple code.
Lemma obv2(X : Set) : exists f : X -> X, forall x, f x = x.
eexists; tauto.
Qed.

coq change premise 'negation of not equal' to 'equal'

Suppose I have a premise like this:
H2: ~ a b c <> a b c
And I wish to change it to:
a b c = a b c
Where
a is Term -> Term -> Term
b and c are both Term
How can I do it? Thanks!
If you unfold the definitions of ~ and <>, you hypothesis has the following type:
H2: (a b c = a b c -> False) -> False
Therefore, what you wish to achieve is what logicians usually call "double negation elimination". It is not an intuitionistically-provable theorem, and is therefore defined in the Classical module of Coq (see http://coq.inria.fr/distrib/V8.4/stdlib/Coq.Logic.Classical_Prop.html for details):
Classical.NNPP : forall (p : Prop), ~ ~ p -> p
I assume your actual problem is more involved than a b c = a b c, but for the sake of mentioning it, if you really care about obtaining that particular hypothesis, you can safely prove it without even looking at H2:
assert (abc_refl : a b c = a b c) by reflexivity.
If your actual example is not immediately reflexive and the equality is actually false, maybe you want to turn your goal into showing that H2 is absurd. You can do so by eliminating H2 (elim H2., which is basically doing a cut on the False type), and you will end up in the context:
H2 : ~ a b c <> a b c
EQ : a b c = a b c
=====================
False
I'm not sure whether all of this helps, but you might have oversimplified your problem so that I cannot provide more insight on what your real problem is.
Just a little thought to add to Ptival's answer - if your desired goal was not trivially solved by reflexivity, you could still make progress provided you had decidable equality on your Term, for example by applying this little lemma:
Section S.
Parameter T : Type.
Parameter T_eq_dec : forall (x y : T), {x = y} + {x <> y}.
Lemma not_ne : forall (x y : T), ~ (x <> y) -> x = y.
Proof.
intros.
destruct (T_eq_dec x y); auto.
unfold not in *.
assert False.
apply (H n).
contradiction.
Qed.
End S.