Require Import Streams.
CoFixpoint map {X Y : Type} (f : X -> Y) (s : Stream X) : Stream Y :=
Cons (f (hd s)) (map f (tl s)).
CoFixpoint interleave {X : Type} (s : Stream X * Stream X) : Stream X := Cons (hd (fst s)) (Cons (hd (snd s)) (interleave (tl (fst s), tl (snd s)))).
Lemma map_interleave : forall {X Y : Type} (f : X -> Y) (s1 s2 : Stream X), map f (interleave (s1, s2)) = interleave (map f s1, map f s2).
Proof.
Fail cofix. (* error *)
Abort.
Output:
Ltac call to "cofix" failed.
Error: All methods must construct elements in coinductive types.
I'm not sure what this means - both map and interleave are straightforward corecursive functions building values of coinductive types. What's the problem?
The problem stems from the fact that = notation stands for eq, which is an inductive type, not a coinductive one.
Instead, you can show that the streams map f (interleave (s1, s2)) and interleave (map f s1, map f s2) are extensionally equal. Here is an excerpt from the Coq reference manual (§1.3.3)
In order to prove the extensionally equality of two streams s1 and s2 we have to construct an infinite proof of equality, that is, an infinite object of type EqSt s1 s2.
After changing eq to EqSt we can prove the lemma:
Lemma map_interleave : forall {X Y : Type} (f : X -> Y) (s1 s2 : Stream X),
EqSt (map f (interleave (s1, s2))) (interleave (map f s1, map f s2)).
Proof.
cofix.
intros X Y f s1 s2.
do 2 (apply eqst; [reflexivity |]).
case s1 as [h1 s1], s2 as [h2 s2].
change (tl (tl (map f (interleave (Cons h1 s1, Cons h2 s2))))) with
(map f (interleave (s1, s2))).
change (tl (tl (interleave (map f (Cons h1 s1), map f (Cons h2 s2))))) with
(interleave (map f s1, map f s2)).
apply map_interleave.
Qed.
By the way, many tricks dealing with coinductive datatypes can be found in this CPDT chapter.
Related
I am trying to prove that given
(eqX : relation X) (Hypo : Equivalence eqX) (f : X -> {x : X | P x})
then
eqX a b -> eqX (proj1_sig (f a)) (proj1_sig (f b))
The function f get a parameter of Type X and give an existing assertion {x : X | P x}. ( for example fun (n : nat) => {m : nat | S m = n} )
In one word, I would like to show that given two parameters which are equivalent under the equivalent relation eqX, then the destruct result of existing assertion {x : X | P x} is also of the same equivalence class.
Can I prove this goal directly(which means the Specif.sig hold this property), or I should prove or claim that f satisfy some constraint and after which can I get this assertion proven.
Your claim is not directly provable; consider
X := nat
eqX a b := (a mod 2) = (b mod 2)
P a := True
f x := exist P (x / 2) I
Then we have eqX 2 4 but we don't have eqX (proj1_sig (f 2)) (proj1_sig (f 4)) because we don't have eqX 1 2.
You can either take in the theorem you are trying to prove as a hypothesis, or you can take in a hypothesis of type forall a, proj1_sig (f a) = a, or you can take in a hypothesis of type forall a, eqX (proj1_sig (f a)) a. Note that all of these are provable (by reflexivity or intros; assumption) if you have f a := exist P a (g a) for some function g.
Is this what you are trying to show?
Require Import Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.Equivalence.
Require Import Setoid.
Generalizable All Variables.
Lemma foo `{!#Equivalence A RA, #Equivalence B RB, f : #respecting A _ _ B _ _ , #equiv A _ _ a b} :
equiv (proj1_sig f a) (proj1_sig f b).
Proof.
now apply respecting_equiv.
Qed.
In Coq, I showed the associativity of append on vectors using:
Require Import Coq.Vectors.VectorDef Omega.
Program Definition t_app_assoc v p q r (a : t v p) (b : t v q) (c : t v r) :=
append (append a b) c = append a (append b c).
Next Obligation. omega. Qed.
I now want to apply this equality in a proof. Below is the easiest goal that I would expect to be provable with t_app_assoc. Of course it can be proven by simpl - this is just an example.
Goal (append (append (nil nat) (nil _)) (nil _)
= append (nil _) (append (nil _) (nil _))).
apply t_app_assoc.
This apply fails with:
Error: Unable to unify "Prop" with
"append (append (nil nat) (nil nat)) (nil nat) =
append (nil nat) (append (nil nat) (nil nat))".
How can I apply t_app_assoc? Or is there a better way to define it? I thought I needed a Program Definition, because simply using a Lemma leads to a type error because t v (p + (q + r)) and t v (p + q + r) are not the same to Coq.
Prologue
I guess what you want to to is to prove that the vector concatenation is associative and then use that fact as a lemma.
But t_app_assoc as you define it has the following type:
t_app_assoc
: forall (v : Type) (p q r : nat), t v p -> t v q -> t v r -> Prop
You basically want to use : instead of := as follows.
From Coq Require Import Vector Arith.
Import VectorNotations.
Import EqNotations. (* rew notation, see below *)
Section Append.
Variable A : Type.
Variable p q r : nat.
Variables (a : t A p) (b : t A q) (c : t A r).
Fail Lemma t_app_assoc :
append (append a b) c = append a (append b c).
Unfortunately, we cannot even state a lemma like this using the usual homogeneous equality.
The left-hand side has the following type:
Check append (append a b) c : t A (p + q + r).
whereas the right-hand side is of type
Check append a (append b c) : t A (p + (q + r)).
Since t A (p + q + r) is not the same as t A (p + (q + r)) we cannot use = to state the above lemma.
Let me describe some ways of working around this issue:
rew notation
Lemma t_app_assoc_rew :
append (append a b) c = rew (plus_assoc _ _ _) in
append a (append b c).
Admitted.
Here we just use the law of associativity of addition for natural numbers to cast the type of RHS to t A (p + q + r).
To make it work one needs to Import EqNotations. before.
cast function
This is a common problem, so the authors of the Vector library decided to provide a cast function with the following type:
cast :
forall (A : Type) (m : nat),
Vector.t A m -> forall n : nat, m = n -> Vector.t A n
Let me show how one can use it to prove the law of associativity for vectors. But let's prove the following auxiliary lemma first:
Lemma uncast {X n} {v : Vector.t X n} e :
cast v e = v.
Proof. induction v as [|??? IH]; simpl; rewrite ?IH; reflexivity. Qed.
Now we are all set:
Lemma t_app_assoc_cast (a : t A p) (b : t A q) (c : t A r) :
append (append a b) c = cast (append a (append b c)) (plus_assoc _ _ _).
Proof.
generalize (Nat.add_assoc p q r).
induction a as [|h p' a' IH]; intros e.
- now rewrite uncast.
- simpl; f_equal. apply IH.
Qed.
Heterogeneous equality (a.k.a. John Major equality)
Lemma t_app_assoc_jmeq :
append (append a b) c ~= append a (append b c).
Admitted.
End Append.
If you compare the definition of the homogeneous equality
Inductive eq (A : Type) (x : A) : A -> Prop :=
eq_refl : x = x.
and the definition of heterogeneous equality
Inductive JMeq (A : Type) (x : A) : forall B : Type, B -> Prop :=
JMeq_refl : x ~= x.
you will see that with JMeq the LHS and RHS don't have to be of the same type and this is why the statement of t_app_assoc_jmeq looks a bit simpler than the previous ones.
Other approaches to vectors
See e.g. this question
and this one;
I also find this answer
very useful too.
I have a function f returning a pair. Then I prove some results about it.
In my lemmas, my first attempt to get each component was using let (x, y) := f z in. But then, trying to use these lemmas seems cumbersome. apply does not work directly, I have to add the lemma in the hypothesis using pose proof or a variant of it and destruct f z to be able to use it. Is there a way to use let-in smoothly in lemmas ? Or is it discouraged because it is painful to use ?
To complete my question, here are the other attempts I made to write lemmas about f. I tried using fst (f z) and snd (f z) directly, but I also found it cumbersome. Finally, I started my lemmas with forall x y, (x,y) = f z ->.
Here is a concrete example.
Require Import List. Import ListNotations.
Fixpoint split {A} (l:list A) :=
match l with
| [] => ([], [])
| [a] => ([a], [])
| a::b::l => let (l1, l2) := split l in (a::l1, b::l2)
end.
Lemma split_in : forall {A} (l:list A) x,
let (l1, l2) := split l in
In x l1 \/ In x l2 <-> In x l.
Lemma split_in2 : forall {A} (l:list A) x,
In x (fst (split l)) \/ In x (snd (split l)) <-> In x l.
Lemma split_in3 : forall {A} (l:list A) x l1 l2,
(l1, l2) = split l ->
In x l1 \/ In x l2 <-> In x l.
You have found what I believe is the correct solution. let (l1, l2) := ... in ... will block reduction and break everything. Whether you use split_in2 or split_in3 depends on what your starting point is.
Note, however, that turning on Primitive Projections and redefining prod as a primitive record will make it so that split_in and split_in2 are actually the same theorem, because split l and (fst (split l), snd (split l)) are judgmentally equal. You can do this with
Set Primitive Projections.
Record prod {A B} := pair { fst : A ; snd : B }.
Arguments prod : clear implicits.
Arguments pair {A B}.
Add Printing Let prod.
Notation "x * y" := (prod x y) : type_scope.
Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
Hint Resolve pair : core.
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.
We have a function that inserts an element into a specific index of a list.
Fixpoint inject_into {A} (x : A) (l : list A) (n : nat) : option (list A) :=
match n, l with
| 0, _ => Some (x :: l)
| S k, [] => None
| S k, h :: t => let kwa := inject_into x t k
in match kwa with
| None => None
| Some l' => Some (h :: l')
end
end.
The following property of the aforementioned function is of relevance to the problem (proof omitted, straightforward induction on l with n not being fixed):
Theorem inject_correct_index : forall A x (l : list A) n,
n <= length l -> exists l', inject_into x l n = Some l'.
And we have a computational definition of permutations, with iota k being a list of nats [0...k]:
Fixpoint permute {A} (l : list A) : list (list A) :=
match l with
| [] => [[]]
| h :: t => flat_map (
fun x => map (
fun y => match inject_into h x y with
| None => []
| Some permutations => permutations
end
) (iota (length t))) (permute t)
end.
The theorem we're trying to prove:
Theorem num_permutations : forall A (l : list A) k,
length l = k -> length (permute l) = factorial k.
By induction on l we can (eventually) get to following goal: length (permute (a :: l)) = S (length l) * length (permute l). If we now simply cbn, the resulting goal is stated as follows:
length
(flat_map
(fun x : list A =>
map
(fun y : nat =>
match inject_into a x y with
| Some permutations => permutations
| None => []
end) (iota (length l))) (permute l)) =
length (permute l) + length l * length (permute l)
Here I would like to proceed by destruct (inject_into a x y), which is impossible considering x and y are lambda arguments. Please note that we will never get the None branch as a result of the lemma inject_correct_index.
How does one proceed from this proof state? (Please do note that I am not trying to simply complete the proof of the theorem, that's completely irrelevant.)
There is a way to rewrite under binders: the setoid_rewrite tactic (see §27.3.1 of the Coq Reference manual).
However, direct rewriting under lambdas is not possible without assuming an axiom as powerful as the axiom of functional extensionality (functional_extensionality).
Otherwise, we could have proved:
(* classical example *)
Goal (fun n => n + 0) = (fun n => n).
Fail setoid_rewrite <- plus_n_O.
Abort.
See here for more detail.
Nevertheless, if you are willing to accept such axiom, then you can use the approach described by Matthieu Sozeau in this Coq Club post to rewrite under lambdas like so:
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.Morphisms.
Generalizable All Variables.
Instance pointwise_eq_ext {A B : Type} `(sb : subrelation B RB eq)
: subrelation (pointwise_relation A RB) eq.
Proof. intros f g Hfg. apply functional_extensionality. intro x; apply sb, (Hfg x). Qed.
Goal (fun n => n + 0) = (fun n => n).
setoid_rewrite <- plus_n_O.
reflexivity.
Qed.