The following inductive definition of U is accepted by Coq because it can see that the occurrences of U in M.T U -> U are strictly positive.
Module M.
Definition T (A : Type) : Type := unit -> A.
End M.
Module N.
Inductive U : Type :=
| c : M.T U -> U.
End N.
On the other hand, the following inductive definition of U is not accepted by Coq because, depending on the definition of M.T, it might have non-strictly positive occurrences.
Module Type S.
Parameter T : Type -> Type.
End S.
Module N (M : S).
Fail Inductive U : Type :=
| c : M.T U -> U.
End N.
How can I specify in the signature S that the parameter of T should only have strictly negative occurrences? Thus preventing any non-strictly positive occurrences of U in its definition.
This U type can be seen as the least fixed point of M.T. Another common encoding is
Definition Mu (T : Type -> Type) := forall A, (T A -> A) -> A.
Definition U := Mu M.T.
Provided that T is a functor (which strict positivity would imply, maybe?):
Parameter map : forall A B, (A -> B) -> T A -> T B. (* in module M *)
we have a constructor and destructor:
Definition c : M.T U -> U := fun x A f =>
f (M.map _ _ (fun y => y _ f) x).
Definition d : U -> M.T U := fun y => y _ (fun x => M.map _ _ c x).
Showing they are inverses requires parametricity, so there is no direct way to prove it. If you don't want to axiomatize it, you can probably enrich T and U to carry evidence of parametricity.
Essentially, the requirement above that T be a functor is a semantic replacement/approximation of the strict positivity condition, which is syntactic.
It is also possible to switch off positivity checking with this new plugin:
https://github.com/SimonBoulier/TypingFlags
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 there a way to enforce that when a typeclass is used, a particular instance is immediately found?
Right, now I'm getting an existential variable when there is no instance available, but I want to get an error.
A simple example will explain much better what I'm trying to achieve. I'm trying to get a function evaluation with implicit casting for certain types. In this case I want to have only one possible implicit cast X' -> X.
Class Evaluation (A B C : Type) : Type :=
{
cast_eval : (A -> B) -> C -> B
}.
Instance DirectEvaluation (A B : Type) : Evaluation A B A :=
{
cast_eval := fun f x => f x
}.
Parameter (X X' X'' Y : Type) (f : X -> Y) (x : X) (x' : X') (x'' : X'') (x_cast : X' -> X).
Instance XDashEvaluation : Evaluation X Y X' :=
{
cast_eval := fun ff xx => f (x_cast xx)
}.
Compute (cast_eval f x). (* f x *)
Compute (cast_eval f x'). (* f (x_cast x') *)
Compute (cast_eval f x''). (* (let (cast_eval) := ?Evaluation in cast_eval) f x'' *)
Is there a way to get an error when calling (cast_eval f x'')?
One way to get an error would be make a Definition first:
Definition e := cast_eval f x''.
Compute e.
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.
Writing
Inductive Foo : Type -> Type :=
| foo : Foo Bar
with
Bar := .
gives
Error: Non strictly positive occurrence of "Bar" in "Foo Bar".
I know the standard example of why strict positivity is necessary; if I have
Inductive Fix :=
| fFix : (Fix -> Fix) -> Fix.
with an eliminator
Fix_rect : forall (P : Fix -> Type) (v : forall f, (forall x, P (f x)) -> P (fFix f)) (f : Fix), P f
then I can prove absurdity with
Fix_rect (fun _ => False) (fun f H => H (fFix id)) (fFix id) : False
(Aside: Does anything go wrong if instead the eliminator is
Fix_rect : forall (P : Fix -> Type) (v : forall f, (forall x, P x -> P (f x)) -> P (fFix f)) (f : Fix), P f
?)
However, I don't see a way to make use of occurrences that appear only in indices. Is there a way to derive a similar contradiction if non-strictly-positive occurrences are permitted in type indices?
This doesn't seem to be a positivity issue, contrary to the error message. Rather, since you have mutual indexing, this is an inductive-inductive type (a weird "large" one at that), which Coq doesn't support.
You could try defining non-indexed types, and separate recursively defined "well-formedness" relations which encode correct indexing. E. g.
Inductive PreFoo : Type :=
| foo : PreFoo.
Inductive Bar : Type :=.
Fixpoint FooWf (f : PreFoo) (t : Type) : Prop :=
match f with
| foo => (t = Bar)
end.
Definition Foo (t : Type) := sig (fun f => FooWf f t).
This is analogous to how you might have indexed intrinsic syntaxes for type theories or extrinsic presyntaxes with separate typing relations.
Suppose I want an inductive definiton of a substring (with string being just a synonym for list).
Inductive substring {A : Set} (w : string A) :
(string A) -> Prop :=
| SS_substr : forall x y z : string A,
x ++ y ++ z = w ->
substring w y.
Here I can for example prove the following:
Theorem test : substring [3;4;1] [4].
Proof.
eapply SS_substr.
cbn.
instantiate (1:=[1]).
instantiate (1:=[3]).
reflexivity.
Qed.
However, the proof is "existential" rather than "universal", in spite of the fact that the inductive definition states forall x y z and only then constrains their shapes. This seems somewhat unintuitive to me. What gives?
Also, is it possible to make an inductive definition using exists x : string A, exists y : string A, exists z : string, x ++ y ++ z = w -> substring w y?
One important thing to note is that exists is not a built-in functionality of Coq (contrary to forall). Actually, exists itself is a notation, but behind there is an inductive type named ex. The notation and the inductive type are defined in the Coq standard library. Here is the definition of ex:
Inductive ex (A:Type) (P:A -> Prop) : Prop :=
ex_intro : forall x:A, P x -> ex (A:=A) P.
It is defined using one constructor and a universal quantification, like your substring type, so it is not surprising that your susbtring type seems to be "existential" at some point.
Of course, you can define your type using exists, and you do not even need Inductive.
Definition substring' {A : Set} (w y : string A) : Prop :=
exists x z, x ++ y ++ z = w.