I have been trying to learn how to do subtyping using ssreflect, http://ssr.msr-inria.inria.fr/~jenkins/current/mathcomp.ssreflect.eqtype.html as my main reference, but have been running into problems. What I'm trying to do is from a type T with three terms, create a subtype T' with two terms a,b.
(1) what is the difference between {x:T | P x} and subType P?
(2) From my code below, I have Sub a Pa to be a term of T', is it possible to have a general proof that applies for both a, b? I'm confused here as from eqType.v it feels as though insub is the one to be used to project from a type into its subtype.
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Inductive T : Set := a | b | c.
Definition P := fun (x:T) =>
match x with
| a => true
| b => true
| c => false
end.
Definition T' := {x:T | P x}.
Definition T'' := subType P.
Definition cast (x: T) : option T'.
destruct (P x) eqn:prf.
- exact (Some (exist _ x prf)).
- exact None.
Defined.
Definition Pa : is_true (P a).
destruct (P a) eqn:prf.
exact. simpl in prf. unfold is_true. symmetry. apply prf. Defined.
Check (Sub a Pa) : T'.
Check val (Sub a Pa) : T.
Check insub (val (Sub a Pa)) : option T'.
Definition Px :forall x : T, is_true (P x).
intros x. destruct (P x) eqn:prf.
- unfold is_true. reflexivity.
- unfold is_true.
Abort.
(1) what is the difference between {x:T | P x} and subType P?
subType P is a record containing all the relevant proofs for P to establish a subType of some types val : U -> T.
{x : T | P x} is a regular sigma type, and if P is a boolean predicate math-comp has declared a canonical way of building the subType P record for that type.
(2) From my code below, I have Sub a Pa to be a term of T', is it possible to
have a general proof that applies for both a, b? I'm confused here as
from eqType.v it feels as though insub is the one to be used to
project from a type into its subtype.
I am unsure about what you mean. insub does not "project" but tries to embed [which is not always possible]. In your case, the proof is easy enough, and you don't have to complicate things so much:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Inductive T : Set := a | b | c.
Definition is_ab (x:T) : bool := match x with
| a | b => true
| c => false
end.
Definition abT := { x : T | is_ab x }.
Lemma abT_is_ab (x : abT) : is_ab (val x).
Proof. exact: valP. Qed.
Related
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.
Consider the definition of find in the standard library, which as the type find: forall A : Type, (A -> bool) -> list A -> option A.
Of course, find has to return an option A and not an A because we don't know wether there is a "valid" element in the list.
Now, say I find this definition of find painful, because we have to deal with the option, even when we are sure that such an element exists in the list.
Hence, I'd like to define myFind which additionnaly takes a proof that there is such an element in the list. It would be something like:
Variable A: Type.
Fixpoint myFind
(f: A -> bool)
(l: list A)
(H: exists a, In a l /\ f a = true): A :=
...
If I am not mistaken, such a signature informally says: "Give me a function, a list, and a proof that you have a "valid" element in the list".
My question is: how can I use the hypothesis provided and define my fixpoint ?
What I have in mind is something like:
match l with
| nil => (* Use H to prove this case is not possible *)
| hd :: tl =>
if f hd
then hd
else
(* Use H and the fact that f hd = false
to prove H': exists a, In a tl /\ f a = true *)
myFind f tl H'
end.
An bonus point would be to know whether I can embbed a property about the result directly within the type, for instance in our case, a proof that the return value r is indeed such that f r = true.
We can implement this myFind function by structural recursion over the input list. In the case of empty list the False_rect inductive principle is our friend because it lets us switch from the logical world to the world of computations. In general we cannot destruct proofs of propositions if the type of the term under construction lives in Type, but if we have an inconsistency the system lets us.
We can handle the case of the non-empty input list by using the convoy pattern (there is a number of great answers on Stackoverflow explaining this pattern) and an auxiliary lemma find_not_head.
It might be useful to add that I use the convoy pattern twice in the implementation below: the one on the top level is used to let Coq know the input list is empty in the first match-branch -- observe that the type of H is different in both branches.
From Coq Require Import List.
Import ListNotations.
Set Implicit Arguments.
(* so we can write `f a` instead of `f a = true` *)
Coercion is_true : bool >-> Sortclass.
Section Find.
Variables (A : Type) (f : A -> bool).
(* auxiliary lemma *)
Fact find_not_head h l : f h = false ->
(exists a, In a (h :: l) /\ f a) ->
exists a, In a l /\ f a.
Proof. intros E [a [[contra | H] fa_true]]; [congruence | now exists a]. Qed.
Fixpoint myFind (l : list A) (H : exists a : A, In a l /\ f a) : {r : A | f r} :=
match l with
| [] => fun H : exists a : A, In a [] /\ f a =>
False_rect {r : A | f r}
match H with
| ex_intro _ _ (conj contra _) =>
match contra with end
end
| h :: l => fun H : exists a : A, In a (h :: l) /\ f a =>
(if f h as b return (f h = b -> {r : A | f r})
then fun Efh => exist _ h Efh
else fun Efh => myFind l (find_not_head Efh H)) eq_refl
end H.
End Find.
Here is a simplistic test:
From Coq Require Import Arith.
Section FindTest.
Notation l := [1; 2; 0; 9].
Notation f := (fun n => n =? 0).
Fact H : exists a, In a l /\ f a.
Proof. exists 0; intuition. Qed.
Compute myFind f l H.
(*
= exist (fun r : nat => f r) 0 eq_refl
: {r : nat | f r}
*)
End FindTest.
You can also use Program to help you construct the proof arguments interactively. You fill in as much as you can in the program body and leave _ blanks that you get to fill in later with proof tactics.
Require Import List Program.
Section Find.
Variable A : Type.
Variable test : A -> bool.
Program Fixpoint FIND l (H:exists a, test a = true /\ In a l) : {r | test r = true} :=
match l with
| [] => match (_:False) with end
| a::l' => if dec (test a) then a else FIND l' _
end.
Next Obligation.
firstorder; congruence.
Defined.
End Find.
Program is a little better at not forgetting information when you do case analysis (it knows the convoy pattern) but it is not perfect, hence the use of dec in the if statement.
(Notice how Coq was able to handle the first obligation, to construct a term of type False, all by itself!)
I'd like to define a predicate for list uniqueness and its decidability function in Coq. My first try was:
Section UNIQUE.
Variable A : Type.
Variable P : A -> Prop.
Variable PDec : forall (x : A), {P x} + {~ P x}.
Definition Unique (xs : list A) := exists! x, In x xs /\ P x.
Here I just have specified that predicate Unique xs will hold if there's just one value x in list xs such that P x holds. Now, comes the problem. When I've tried to define its Unique decidability:
Definition Unique_dec : forall xs, {Unique xs} + {~ Unique xs}.
induction xs ; unfold Unique in *.
+
right ; intro ; unfold unique in * ; simpl in * ; crush.
+
destruct IHxs ; destruct (PDec a).
destruct e as [y [Hiy HPy]].
...
I've got the following nasty error message:
Error: Case analysis on sort Set is not allowed for inductive definition ex.
I've googled this message and seen several similar problems in different contexts. At least to me, it seems that such problem is related to some restrictions on Coq pattern matching, right?
Now that the problem is settled, my questions:
1) All I want is to define a decidability for a uniqueness test based on a decidable predicate. In the standard library, there are similar tests for existencial and universal quantifiers. Both can be defined as inductive predicates. Is there a way to define "exists unique" as an inductive predicate on lists?
2) It is possible to define such predicate in order to it match the standard logic meaning of exists unique? Like exists! x, P x = exists x, P x /\ forall y, P y -> x = y?
What you're running into is that you can't pattern match on ex (the underlying inductive for both exists and exists!) in order to produce a value of type sumbool (the type for the {_} + {_} notation), which is a Type and not a Prop. The "nasty error message" isn't terribly helpful in figuring this out; see this bug report for a proposed fix.
To avoid this issue, I think you should prove a stronger version of Unique that produces something in Type (a sig) rather than Prop:
Definition Unique (xs : list A) := exists! x, In x xs /\ P x.
Definition UniqueT (xs : list A) := {x | unique (fun x => In x xs /\ P x) x}.
Theorem UniqueT_to_Unique : forall xs,
UniqueT xs -> Unique xs.
Proof.
unfold UniqueT, Unique; intros.
destruct X as [x H].
exists x; eauto.
Qed.
You can then prove decidability for this definition in Type, and from there prove your original statement if you want:
Definition UniqueT_dec : forall xs, UniqueT xs + (UniqueT xs -> False).
As mentioned in Anton's answer, this proof will require decidable equality for A, also in Type, namely forall (x y:A), {x=y} + {x<>y}.
Let me provide only a partial answer (it's too large for a comment).
If we go with this definition of uniqueness which admits multiple copies (as mentioned by Arthur), then Unique_dec implies decidability of equality for type A (as mentioned by #ejgallego).
Assuming we have
Unique_dec
: forall (A : Type) (P : A -> Prop),
(forall x : A, {P x} + {~ P x}) ->
forall xs : list A, {Unique P xs} + {~ Unique P xs}
We can show the following:
Lemma dec_eq A (a b : A) : a = b \/ a <> b.
Proof.
pose proof (Unique_dec (fun (_ : A) => True) (fun _ => left I) [a;b]) as U.
unfold Unique in U; destruct U as [u | nu].
- destruct u as (x & [I _] & U).
destruct I as [<- | [<- | contra]];
[specialize (U b) | specialize (U a) |]; firstorder.
- right; intros ->; apply nu; firstorder.
Qed.
Assuming we have an inductive data structure and some predicate over it:
Inductive A : EClass :=
X | Y .
Definition P (a: A) : bool :=
match a with
X => true
| Y => false
end.
Then, I formulate a theorem to say there exists an element a such that P a returns true:
Theorem test :
exists a: A, P a.
There are probably various ways of doing it, I am thinking how to use case analysis to prove it, in my mind, it works something like this:
remember there are 2 ways A can be constructed
try each way one by one, stop if we find a witness such that P a holds.
My Coq code looks like:
evar (a: A). (* introduce a candidate to manipulate *)
destruct a eqn: case_A. (* case analysis *)
- (* case where a = X *)
exists a.
rewrite case_A.
done.
- (* case where a = Y *)
(* stuck *)
My question is that,
is my prove strategy logically flawed?
if not, my Coq is the problem, how can I convey to Coq that my job is done is I find one witness? might be I should not destruct?
Thanks!
Yes, your proof is flawed! All that you need is to provide the witness first:
Inductive A := X | Y .
Definition P (a: A) : bool := match a with X => true | Y => false end.
Theorem test : exists a: A, P a = true.
Proof. now exists X. Qed.
If you do case analysis first, you'll get into a dead-end.
Here is a rough framework that demonstrates how you might program a Coq tactic to try all elements of a finite type as witnesses.
(* Typeclass to register an enumeration of elements of a type. *)
Class Enumeration (A:Type) :=
enumerate : list A.
Arguments enumerate A [Enumeration].
(* Typeclass to register decision procedures to determine whether
a given proposition is true or false. *)
Class Decision (P:Prop) :=
decide : {P} + {~P}.
Arguments decide P [Decision].
(* Given a Coq list l, execute tactic t on every element of
l until we get a success. *)
Ltac try_list l t :=
match (eval hnf in l) with
| #cons _ ?hd ?tl => (t hd || try_list tl t)
end.
(* Tactic for "proof by reflection": use a decision procedure, and
if it returns "true", then extract the proof from the result. *)
Ltac by_decision :=
match goal with
|- ?P => let res := (eval hnf in (decide P)) in
match res with
| left ?p => exact p
end
end.
(* Combination to try to prove an (exists x:A, P) goal by trying
to prove P by reflection for each element in an enumeration of A. *)
Ltac try_enumerate :=
match goal with
|- #ex ?A ?P =>
try_list (enumerate A)
ltac:(fun x => exists x; by_decision)
end.
(* Demonstration on your example *)
Inductive A := X | Y.
Instance A_enum : Enumeration A :=
cons X (cons Y nil).
Instance bool_eq_dec : forall x y:bool,
Decision (x = y).
Proof.
intros. red. decide equality.
Defined.
Definition P (a:A) : bool :=
match a with
| X => true
| Y => false
end.
Goal exists a:A, P a = true.
Proof.
try_enumerate.
Qed.
I am trying to proof that the application of an empty Substitution on a term is equal to the given term.
Here is the code:
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import Coq.Arith.EqNat.
Require Import Recdef.
Require Import Omega.
Import ListNotations.
Set Implicit Arguments.
Inductive Term : Type :=
| Var : nat -> Term
| Fun : string -> list Term -> Term.
Definition Subst : Type := list (nat*Term).
Definition maybe{X Y: Type} (x : X) (f : Y -> X) (o : option Y): X :=
match o with
|None => x
|Some a => f a
end.
Fixpoint lookup {A B : Type} (eqA : A -> A -> bool) (kvs : list (A * B)) (k : A) : option B :=
match kvs with
|[] => None
|(x,y) :: xs => if eqA k x then Some y else lookup eqA xs k
end.
I am trying to proof some properties of this function.
Fixpoint apply (s : Subst) (t : Term) : Term :=
match t with
| Var x => maybe (Var x) id (lookup beq_nat s x )
| Fun f ts => Fun f (map (apply s ) ts)
end.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t.
reflexivity.
I am stuck after the reflexivity. I wanted to do induction on the list build in a term but if i do so i'ĺl get stuck in a loop.
i will appreciate any help.
The problem is that the automatically generated inductive principle for the Term type is too weak, because it has another inductive type list inside it (specifically, list is applied to the very type being constructed). Adam Chlipala's CPDT gives a good explanation of what's going on, as well as an example of how to manually build a better inductive principle for such types in the inductive types chapter. I've adapted his example nat_tree_ind' principle for your Term inductive, using the builtin Forall rather than a custom definition. With it, your theorem becomes easy to prove:
Section Term_ind'.
Variable P : Term -> Prop.
Hypothesis Var_case : forall (n:nat), P (Var n).
Hypothesis Fun_case : forall (s : string) (ls : list Term),
Forall P ls -> P (Fun s ls).
Fixpoint Term_ind' (tr : Term) : P tr :=
match tr with
| Var n => Var_case n
| Fun s ls =>
Fun_case s
((fix list_Term_ind (ls : list Term) : Forall P ls :=
match ls with
| [] => Forall_nil _
| tr'::rest => Forall_cons tr' (Term_ind' tr') (list_Term_ind rest)
end) ls)
end.
End Term_ind'.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t using Term_ind'; simpl; auto.
f_equal.
induction H; simpl; auto.
congruence.
Qed.
This is a typical trap for beginners. The problem is that your definition of Term has a recursive occurrence inside another inductive type -- in this case, list. Coq does not generate a useful inductive principle for such types, unfortunately; you have to program your own. Adam Chlipala's CDPT has a chapter on inductive types that describes the problem. Just look for "nested inductive types".