I have read the very helpful (Dafny: What does no terms found to trigger on mean?) but can any one tell me how to prove the two assertions marked with /**/.
Not even sure if they can be proven. The logically equivalent assertions with the defined function inters are proven and may be that is as far as you can go. Any insight greatly appreciated.
function inters(a:set<int>, b:set<int>): set<int> {a*b}
method pingo(a:set<int>, b:set<int>)
{
assert (forall x:int :: (x !in inters(a , b) ) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in a*b) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in inters(a , b) )) <==>
(forall x:int :: (x in a ==> x!in b ));
/**/ assert (forall x:int :: (x !in a*b)) <==>
(forall x:int :: (x in a ==> x!in b ));
assert ((a*b) == {}) <==> (forall x:int ::(x in a ==> x!in b )) ;
assert ((a*b) == {}) ==> (forall x:int :: (x !in inters(a , b) ));
/**/ assert ((a*b) == {}) ==> (forall x:int :: (x !in a*b )) ;
}
I know this answer comes a bit later and indeed does not offer anything new, but I coded the original problem (the same code as David Streader but where all the
inters(a,b) have been substituted by a*b) and the solution (all the a*b replaced by inters(a,b)). Just if someone wants to play:
Original problem (full of warnings):
function inters(a:set<int>, b:set<int>): set<int> {a*b}
method pingo(a:set<int>, b:set<int>)
{
assert (forall x:int :: (x !in (a*b) ) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in a*b) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in a*b )) <==>
(forall x:int :: (x in a ==> x!in b ));
assert (forall x:int :: (x !in a*b)) <==>
(forall x:int :: (x in a ==> x!in b ));
assert ((a*b) == {}) <==> (forall x:int ::(x in a ==> x!in b )) ;
assert ((a*b) == {}) ==> (forall x:int :: (x !in a*b ));
assert ((a*b) == {}) ==> (forall x:int :: (x !in a*b )) ;
}
Solution (no warnings):
function inters(a:set<int>, b:set<int>): set<int> {a*b}
method pingo(a:set<int>, b:set<int>)
{
assert (forall x:int :: (x !in inters(a , b) ) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in inters(a , b) ) <==> (x in a ==> x!in b ));
assert (forall x:int :: (x !in inters(a , b) )) <==>
(forall x:int :: (x in a ==> x!in b ));
assert (forall x:int :: (x !in inters(a , b) )) <==>
(forall x:int :: (x in a ==> x!in b ));
assert ((a*b) == {}) <==> (forall x:int ::(x in a ==> x!in b )) ;
assert ((a*b) == {}) ==> (forall x:int :: (x !in inters(a , b) ));
assert ((a*b) == {}) ==> (forall x:int :: (x !in inters(a , b) )) ;
}
//
So in this case, if we take James Wilcox's answer, only the first suggestion can be used (wrap the forall... in a function). That's because here is no case where we can apply the ‘expansion’, because there are only cases like x!in ..., and x!in inters(a,b) is not the same as x!in (a) && x!in(b).
Related
My task is to implement an instance of equality type for the seq datatype. To do this I need to create a comparison function and a proof that this function is correct:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Fixpoint eq_seq {T: eqType} (x y: seq T) : bool :=
match x, y with
| [::],[::] => true
| cons x' xs, [::] => false
| [::], cons y' ys => false
| cons x' xs, cons y' ys => (x' == y') && eq_seq xs ys
end.
Arguments eq_seq T x y : simpl nomatch.
Lemma eq_seq_correct : forall T: eqType, Equality.axiom (#eq_seq T).
Proof.
move=> T x. elim: x=> [|x' xs].
- move=> y. case: y=> //=; by constructor.
- move=> IH y. case: y=> [| y' ys].
+ rewrite /(eq_seq (x' :: xs) [::]). constructor. done.
+ move=> /=. case E: (x' == y').
* move: E. case: eqP=> E _ //=. rewrite <- E.
Result:
2 subgoals (ID 290)
T : eqType
x' : T
xs : seq T
IH : forall y : seq T, reflect (xs = y) (eq_seq xs y)
y' : T
ys : seq T
E : x' = y'
============================
reflect (x' :: xs = x' :: ys) (eq_seq xs ys)
subgoal 2 (ID 199) is:
reflect (x' :: xs = y' :: ys) (false && eq_seq xs ys)
How to get rid of x' in both sides of equality: (x' :: xs = x' :: ys)?
I tried case: (x' :: xs = x' :: ys), but it didn't help.
(Just in case you are not aware, this lemma is already proved in the seq library. Look for eqseqP.)
The key step in completing the proof is the iffP lemma:
iffP : forall P Q b, reflect P b -> (P -> Q) -> (Q -> P) -> reflect Q b.
Thus, by calling apply/(iffP (IH ys)), we reduce the current goal to proving that xs = ys -> x' :: xs = x' :: ys and x' :: xs = x' :: ys -> xs = ys. You can discharge both subgoals by applying the congruence tactic.
I'm trying to define a non-dependent list type in Coq, but I cannot figure out a way to do that. I managed to define ndList axiomatically, modifying Coq's list definition. Here's my work so far:
Axiom ndList : forall C: Type, Type.
Axiom nil : forall C, ndList C.
Axiom cons : forall C, forall (c: C) (l: ndList C), ndList C.
Arguments nil {_}.
Arguments cons {_} _ _.
Axiom el : forall (C L: Type), forall (a: L) (s: ndList C)
(l: forall (x: C) (z: L), L), L.
Axiom c1 : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L),
el C L a nil l = a.
Axiom c2 : forall (C L: Type), forall (s: ndList C) (c: C) (a: L)
(l: forall (x: C) (z: L), L),
el C L a (cons c s) l = l c (el C L a s l).
Axiom c_eta : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L)
(t: forall y: ndList C, L) (s: ndList C) (eq1: t nil = a)
(eq2: forall (x: C) (z: ndList C), t (cons x z) = l x (t z)),
el C L a s l = t s.
Is there a way to define ndList as an Inductive type?
Thanks for helping.
Your "non-dependent" list type is provably isomorphic to Coq's list type:
Axiom ndList : forall C: Type, Type.
Axiom nil : forall C, ndList C.
Axiom cons : forall C, forall (c: C) (l: ndList C), ndList C.
Arguments nil {_}.
Arguments cons {_} _ _.
Axiom el : forall (C L: Type), forall (a: L) (s: ndList C)
(l: forall (x: C) (z: L), L), L.
Axiom c1 : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L),
el C L a nil l = a.
Axiom c2 : forall (C L: Type), forall (s: ndList C) (c: C) (a: L)
(l: forall (x: C) (z: L), L),
el C L a (cons c s) l = l c (el C L a s l).
Axiom c_eta : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L)
(t: forall y: ndList C, L) (s: ndList C) (eq1: t nil = a)
(eq2: forall (x: C) (z: ndList C), t (cons x z) = l x (t z)),
el C L a s l = t s.
Section iso.
Context {A : Type}.
Definition list_to_ndList : list A -> ndList A
:= list_rect (fun _ => ndList A)
nil
(fun x _ xs => cons x xs).
Definition ndList_to_list (ls : ndList A) : list A
:= el A (list A)
Datatypes.nil
ls
Datatypes.cons.
Lemma list_eq (ls : list A) : ndList_to_list (list_to_ndList ls) = ls.
Proof.
unfold ndList_to_list, list_to_ndList.
induction ls as [|x xs IHxs];
repeat first [ progress simpl
| progress rewrite ?c1, ?c2
| congruence ].
Qed.
Lemma ndList_eq (ls : ndList A) : list_to_ndList (ndList_to_list ls) = ls.
Proof.
unfold ndList_to_list, list_to_ndList.
transitivity (el A (ndList A) nil ls cons); [ symmetry | ]; revert ls;
match goal with
| [ |- forall ls, #?LHS ls = #?RHS ls ]
=> intro ls; apply (c_eta _ _ _ _ RHS ls)
end;
repeat first [ progress simpl
| progress intros
| progress rewrite ?c1, ?c2
| congruence ].
Qed.
End iso.
You can also easily get your el about lists, automatically, even:
Scheme el := Minimality for list Sort Type.
Check el. (* forall A P : Type, P -> (A -> list A -> P -> P) -> list A -> P *)
Does this suffice for your purposes, or are you wanting more?
I defined a Boole inductive type based on the disjoint sum's definition:
Inductive Boole :=
| inlb (a: unit)
| inrb (b: unit).
Given two types A and B I'm trying to prove the ismorphism between
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))
and
A + B
I managed to prove one side of the isomorphism
Definition sum_to_sigT {A} {B} (z: A + B) :
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B)).
Proof.
case z.
move=> a.
exists (inrb tt).
rewrite //=.
move=> b.
exists (inlb tt).
rewrite //=.
Defined.
Lemma eq_inla_inltt (a: unit) : eq (inlb a) (inlb tt).
Proof.
by case a.
Qed.
Lemma eq_inra_inrtt (a: unit) : eq (inrb a) (inrb tt).
Proof.
by case a.
Qed.
Definition sigT_to_sum {A} {B}
(w: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) :
A + B.
Proof.
destruct w.
destruct p.
destruct x.
apply (inr (b (eq_inla_inltt a0))).
apply (inl (a (eq_inra_inrtt b0))).
Defined.
Definition eq_sum_sigT {A} {B} (x: A + B):
eq x (sigT_to_sum (sum_to_sigT x)).
Proof.
by case x.
Defined.
But I'm in trouble in proving the other side, basically because I don't manage to establish equality between the different x and p involved in the following proof:
Definition eq_sigT_sum {A} {B}
(y: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) : eq y (sum_to_sigT (sigT_to_sum y)).
Proof.
case: (sum_to_sigT (sigT_to_sum y)).
move=> x p.
destruct y.
destruct x.
destruct p.
Defined.
Does anyone know how I can prove the latter lemma?
Thanks for the help.
As bizarre as this sounds, you cannot prove this result in Coq's theory.
Let's call the type sigT (fun x => prod (eq x (inrb tt) -> A) (eq x (inlb tt) -> B)) simply T. Any element of T has the form existT x (pair f g), where x : Boole, f : eq x (inrb tt) -> A, and g : eq x (inlb tt) -> B. To show your result, you need to argue that two expressions of type T are equal, which will require at some point proving that two terms f1 and f2 of type eq x (inrb tt) -> A are equal.
The problem is that elements of eq x (inrb tt) -> A are functions: they take as input a proof that x and inrb tt are equal, and produce a term of type A as a result. And sadly, the notion of equality for functions in Coq is too weak to be useful in most cases. Normally in math, we would argue that two functions are equal by showing that they produce the same results, that is:
forall f g : A -> B,
(forall x : A, f x = g x) -> f = g.
This principle, usually known as functional extensionality, is not available in Coq by default. Fortunately, the theory allows us to safely add it as an axiom without compromising the soundness of the theory. It is even available to us in the standard library. I've included here a proof of a slightly modified version of your result. (I've taken the liberty of using the ssreflect library, since I saw you were using it too.)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Require Import Coq.Logic.FunctionalExtensionality.
Section Iso.
Variables A B : Type.
Inductive sum' :=
| Sum' x of x = true -> A & x = false -> B.
Definition sum'_of_sum (x : A + B) :=
match x with
| inl a =>
Sum' true
(fun _ => a)
(fun e : true = false =>
match e in _ = c return if c then A else B with
| erefl => a
end)
| inr b =>
Sum' false
(fun e =>
match e in _ = c return if c then A else B with
| erefl => b
end)
(fun _ => b)
end.
Definition sum_of_sum' (x : sum') : A + B :=
let: Sum' b f g := x in
match b return (b = true -> A) -> (b = false -> B) -> A + B with
| true => fun f _ => inl (f erefl)
| false => fun _ g => inr (g erefl)
end f g.
Lemma sum_of_sum'K : cancel sum_of_sum' sum'_of_sum.
Proof.
case=> [[]] /= f g; congr Sum'; apply: functional_extensionality => x //;
by rewrite (eq_axiomK x).
Qed.
End Iso.
I have a lemma such as the following, with a higher-order parameter:
Require Import Coq.Lists.List.
Lemma map_fst_combine:
forall A B C (f : A -> C) (xs : list A) (ys : list B),
length xs = length ys ->
map (fun p => f (fst p)) (combine xs ys) = map f xs.
Proof.
induction xs; intros.
* destruct ys; try inversion H.
simpl. auto.
* destruct ys; try inversion H.
simpl. rewrite IHxs; auto.
Qed.
I would like to use this as with rewrite. It works if I specify f directly:
Parameter list_fun : forall {A}, list A -> list A.
Parameter length_list_fun : forall A (xs : list A), length (list_fun xs) = length xs.
Lemma this_works:
forall (xs : list bool),
map (fun p => negb (negb (fst p))) (combine xs (list_fun xs)) = xs.
Proof.
intros.
rewrite map_fst_combine with (f := fun x => negb (negb x))
by (symmetry; apply length_list_fun).
Admitted.
but I would really like not having to do that (in my case, I would like to use this lemma as part of a autorewrite set). But
Lemma this_does_not:
forall (xs : list bool),
map (fun p => negb (negb (fst p))) (combine xs (list_fun xs)) = xs.
Proof.
intros.
rewrite map_fst_combine.
fails with
(*
Error:
Found no subterm matching "map (fun p : ?M928 * ?M929 => ?M931 (fst p))
(combine ?M932 ?M933)" in the current goal.
*)
Am I expecting too much here, or is there a way to make this work?
Let's define the composition operator (or you might want to reuse the one defined in Coq.Program.Basics):
Definition comp {A B C} (g : B -> C) (f : A -> B) :=
fun x : A => g (f x).
Infix "∘" := comp (at level 90, right associativity).
Now, let's formulate the map_fst_combine lemma in terms of composition:
Lemma map_fst_combine:
forall A B C (f : A -> C) (xs : list A) (ys : list B),
length xs = length ys ->
map (f ∘ fst) (combine xs ys) = map f xs.
Admitted. (* the proof remains the same *)
Now we need some helper lemmas for autorewrite:
Lemma map_comp_lassoc A B C D xs (f : A -> B) (g : B -> C) (h : C -> D) :
map (fun x => h (g (f x))) xs = map ((h ∘ g) ∘ f) xs.
Proof. reflexivity. Qed.
Lemma map_comp_lassoc' A B C D E xs (f : A -> B) (g : B -> C) (h : C -> D) (i : D -> E) :
map (i ∘ (fun x => h (g (f x)))) xs = map ((i ∘ h) ∘ (fun x => g (f x))) xs.
Proof. reflexivity. Qed.
With the following hints
Hint Rewrite map_comp_lassoc map_comp_lassoc' map_fst_combine : mapdb.
we are able to do automatic rewrites and get rid of fst and combine:
Lemma autorewrite_works xs :
map (fun p => negb (negb (fst p))) (combine xs (list_fun xs)) = xs.
Proof.
autorewrite with mapdb.
(* 1st subgoal: map (negb ∘ negb) xs = xs *)
Admitted.
Lemma autorewrite_works' xs :
map (fun p => negb (negb (negb (negb (fst p))))) (combine xs (list_fun xs)) = xs.
Proof.
autorewrite with mapdb.
(* 1st subgoal: map (((negb ∘ negb) ∘ negb) ∘ negb) xs = xs *)
Admitted.
I am trying to make the following work:
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match (f t) with
| None => None
| Some t' => Vnth x (ibound t t' _)
end.
In place of last "_" I need an evidence that "f t" is equals to "Some t'". I could not figure out how to get it from the match. Vnth is defined as:
Vnth
: ∀ (A : Type) (n : nat), vector A n → ∀ i : nat, i < n → A
Writing this function requires an instance of what is known as the convoy pattern (see here). I believe the following should work, although I can't test it, since I don't have the rest of your definitions.
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match f t as x return f t = x -> option A with
| None => fun _ => None
| Some t' => fun p => Vnth x (ibound t t' p)
end (eq_refl (f t)).