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.
Related
I have a pair of maps that are trivially incompatible. I'm wondering what's the graceful/automatized way to get a proof of it.
Require Import Coq.Strings.String.
(* Prelude: the total_map data structure from Software Foundations, slightly modified *)
Definition total_map := string -> nat.
Definition empty_st : total_map := (fun _ => 0).
Definition t_update (m : total_map) k v := fun k' => if string_dec k k' then v else m k'.
Notation "a '!->' x" := (t_update empty_st a x) (at level 100).
Notation "x '!->' v ';' m" := (t_update m x v) (at level 100, v at next level, right associativity).
(* The actual goal I'm trying to solve *)
Definition X: string := "X".
Definition Y: string := "Y".
Goal forall n, (X !-> n; Y !-> n) <> (X !-> 1; Y !-> 2).
Proof.
intros n contra.
remember (X !-> n; Y !-> n) as st.
remember (st X) as n1.
assert (n1 = n). { rewrite Heqn1; rewrite Heqst; cbv; reflexivity. }
assert (n1 = 1). { rewrite Heqn1; rewrite contra; cbv; reflexivity. }
remember (st Y) as n2.
assert (n2 = n). { rewrite Heqn2; rewrite Heqst; cbv; reflexivity. }
assert (n2 = 2). { rewrite Heqn2; rewrite contra; cbv; reflexivity. }
congruence.
Qed.
In order to automate this, you need to have a precise description of your proof strategy. Here is one possible proof strategy:
To prove an inequality of total_maps:
First introduce the equality hypothesis.
Then, for every key that's been added to either map, add the hypothesis that the value associated to that key is the same in both maps.
Then simplify all such equality hypotheses by unfolding t_update, using that string_dec x x is true, and seeing if any other string_decs compute down.
Finally, solve the goal by congruence.
We can automate each of these steps. Altogether, it becomes:
Require Import Coq.Strings.String.
(* Prelude: the total_map data structure from Software Foundations, slightly modified *)
Definition total_map := string -> nat.
Definition empty_st : total_map := (fun _ => 0).
Definition t_update (m : total_map) k v := fun k' => if string_dec k k' then v else m k'.
Notation "a '!->' x" := (t_update empty_st a x) (at level 100).
Notation "x '!->' v ';' m" := (t_update m x v) (at level 100, v at next level, right associativity).
(* Automation *)
(* 1. First introduce the equality hypothesis. *)
Ltac start_proving_inequality H :=
intro H.
(* 2. Then, for every key that's been added to either map, add the hypothesis that the value associated to that key is the same in both maps. *)
(* To do this, we need a tactic that will pose a proof only if it does not already exist. *)
Ltac unique_pose_proof lem :=
let T := type of lem in
lazymatch goal with
| [ H : T |- _ ] => fail 0 "A hypothesis of type" T "already exists"
| _ => pose proof lem
end.
(* Maybe move this elsewhere? *)
Definition t_get (m : total_map) k := m k.
Ltac saturate_with_keys H :=
repeat match type of H with
| context[t_update _ ?k ?v]
=> unique_pose_proof (f_equal (fun m => t_get m k) H)
end.
(* 3. Then simplify all such equality hypotheses by unfolding `t_update`, using that `string_dec x x` is true, and seeing if any other `string_dec`s compute down. *)
Require Import Coq.Logic.Eqdep_dec.
Lemma string_dec_refl x : string_dec x x = left eq_refl.
Proof.
destruct (string_dec x x); [ apply f_equal | congruence ].
apply UIP_dec, string_dec.
Qed.
(* N.B. You can add more cases here to deal with other sorts of ways you might reduce [t_get] here *)
Ltac simplify_t_get_t_update_in H :=
repeat first [ progress cbv [t_get t_update empty_st] in H
| match type of H with
| context[string_dec ?x ?x] => rewrite (string_dec_refl x) in H
| context[string_dec ?x ?y]
=> let v := (eval cbv in (string_dec x y)) in
(* check that it fully reduces *)
lazymatch v with left _ => idtac | right _ => idtac end;
progress change (string_dec x y) with v in H
end ].
Ltac simplify_t_get_t_update :=
(* first we must change hypotheses of the form [(fun m => t_get m k) m = (fun m => t_get m k) m'] into [t_get _ _ = t_get _ _] *)
cbv beta in *;
repeat match goal with
| [ H : t_get _ _ = t_get _ _ |- _ ] => progress simplify_t_get_t_update_in H
end.
(* 4. Finally, solve the goal by `congruence`. *)
Ltac finish_proving_inequality := congruence.
(* Now we put it all together *)
Ltac prove_total_map_inequality :=
let H := fresh in
start_proving_inequality H;
saturate_with_keys H;
simplify_t_get_t_update;
finish_proving_inequality.
(* The actual goal I'm trying to solve *)
Definition X: string := "X".
Definition Y: string := "Y".
Goal forall n, (X !-> n; Y !-> n) <> (X !-> 1; Y !-> 2).
intros.
prove_total_map_inequality.
Qed.
Based on Jason Gross's answer and the fact that total_map is a decidable type, I've put together a bit of automation to deal with this. Note that this problem would probably be a very good fit for small-scale reflection.
(* TODO: don't bring trivial (n = n) or duplicated hypotheses into scope *)
(* Given two maps left and right, plus a lemma that they are equal, plus some key: assert that the values of the maps agree at the specified key *)
Ltac invert_total_map_equality_for_id lemma left right id :=
let H := fresh "H" in
assert (left id = right id) as H by (rewrite lemma; reflexivity);
cbv in H.
(* Recurse on the LHS map, extracting keys *)
Ltac invert_total_map_equality_left lemma left right left_remaining :=
match left_remaining with
| t_update ?left_remaining' ?id _ =>
invert_total_map_equality_for_id lemma left right id;
invert_total_map_equality_left lemma left right left_remaining'
| _ => idtac
end.
(* Recurse on the RHS map, extracting keys; move on to LHS once we've done all RHS keys *)
Ltac invert_total_map_equality_right lemma left right right_remaining :=
match right_remaining with
| t_update ?right_remaining' ?id _ =>
invert_total_map_equality_for_id lemma left right id;
invert_total_map_equality_right lemma left right right_remaining'
| _ => invert_total_map_equality_left lemma left right left
end.
(* Given a lemma that two total maps are equal, assert that their values agree at each defined key *)
Ltac invert_total_map_equality lem :=
let T := type of lem in
match T with
| ?left = ?right =>
match type of left with
| string -> nat =>
match type of right with
| string -> nat =>
invert_total_map_equality_right lem left right right
end
end
end.
Goal forall n, (X !-> n; Y !-> n) <> (X !-> 1; Y !-> 2).
Proof.
unfold not; intros.
invert_total_map_equality H.
congruence.
Qed.
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.
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.
I am writing a small program so that I can work some proofs of deMorgans laws using the type introduction/elimination rules from the HoTT book (et. al.). My model/example code is all here, https://mdnahas.github.io/doc/Reading_HoTT_in_Coq.pdf. So far I have,
Definition idmap {A:Type} (x:A) : A := x.
Inductive prod (A B:Type) : Type := pair : A -> B -> #prod A B.
Notation "x * y" := (prod x y) : type_scope.
Notation "x , y" := (pair _ _ x y) (at level 10).
Section projections.
Context {A : Type} {B : Type}.
Definition fst (p: A * B ) :=
match p with
| (x , y) => x
end.
Definition snd (p:A * B ) :=
match p with
| (x , y) => y
end.
End projections.
Inductive sum (A B : Type ) : Type :=
| inl : A -> sum A B
| inr : B -> sum A B.
Arguments inl {A B} _ , [A] B _.
Arguments inr {A B} _ , A [B].
Notation "x + y" := (sum x y) : type_scope.
Inductive Empty_set:Set :=.
Inductive unit:Set := tt:unit.
Definition Empty := Empty_set.
Definition Unit := unit.
Definition not (A:Type) : Type := A -> Empty.
Notation "~ x" := (not x) : type_scope.
Variables X:Type.
Variables Y:Type.
Goal (X * Y) -> (not X + not Y).
intro h. fst h.
Now I don't really know what the problem is. I've examples of people using definitions, but they always involve "Compute" commands, and I want to apply the rule fst to h to get x:X, so they are not helpful.
I tried "apply fst." which got me
Error: Cannot infer the implicit parameter B of fst whose type is
"Type" in environment:
h : A * B
In a proof context, Coq expects to get tactics to execute, not expressions to evaluate. Since fst is not defined as a tactic, it will give Error: The reference fst was not found in the current environment.
One possible tactic to execute along the lines of what you seem to be trying to do is set:
set (x := fst h).
I want to apply the rule fst to h to get x:X
I believe you can do
apply fst in h.
If you just write apply fst, Coq will apply the fst rule to the goal, rather than to h. If you write fst h, as Daniel says in his answer, Coq will attempt to run the fst tactic, which does not exist. In addition to Daniel's set solution, which will change the goal if fst h appears in it (and this may or may not be what you want), the following also work:
pose (fst h) as x. (* adds x := fst h to the context *)
pose proof (fst h) as x. (* adds opaque x : X to the context, justified by the term fst h *)
destruct h as [x y]. (* adds x : X and y : Y to the context, and replaces h with pair x y everywhere *)