Showing (head . init ) = head in Agda - theorem-proving

I'm trying to prove a simple lemma in Agda, which I think is true.
If a vector has more than two elements, taking its head following taking the init is the same as taking its head immediately.
I have formulated it as follows:
lem-headInit : ∀{l} (xs : Vec ℕ (suc (suc l)))
-> head (init xs) ≡ head xs
lem-headInit (x ∷ xs) = ?
Which gives me;
.l : ℕ
x : ℕ
xs : Vec ℕ (suc .l)
------------------------------
Goal: head (init (x ∷ xs) | (initLast (x ∷ xs) | initLast xs)) ≡ x
as a response.
I do not entirely understand how to read the (init (x ∷ xs) | (initLast (x ∷ xs) | initLast xs)) component. I suppose my questions are; is it possible, how and what does that term mean.
Many thanks.

I do not entirely understand how to
read the (init (x ∷ xs) | (initLast (x
∷ xs) | initLast xs)) component. I
suppose my questions are; is it
possible, how and what does that term
mean.
This tells you that the value init (x ∷ xs) depends on the value of everything to the right of the |. When you prove something about in a function in Agda your proof will have to have the structure of the original definition.
In this case you have to case on the result of initLast because the definition of initLast does this before producing any results.
init : ∀ {a n} {A : Set a} → Vec A (1 + n) → Vec A n
init xs with initLast xs
-- ⇧ The first thing this definition does is case on this value
init .(ys ∷ʳ y) | (ys , y , refl) = ys
So here is how we write the lemma.
module inithead where
open import Data.Nat
open import Data.Product
open import Data.Vec
open import Relation.Binary.PropositionalEquality
lem-headInit : {A : Set} {n : ℕ} (xs : Vec A (2 + n))
→ head (init xs) ≡ head xs
lem-headInit (x ∷ xs) with initLast xs
lem-headInit (x ∷ .(ys ∷ʳ y)) | ys , y , refl = refl
I took the liberty of generalizing your lemma to Vec A since the lemma doesn't depend on the contents of the vector.

Ok. I've got this one by cheating and I'm hoping somebody has a better solution. I threw away all the extra information you get from init being defined in terms of initLast and created my own naive version.
initLazy : ∀{A l} → Vec A (suc l) → Vec A l
initLazy (x ∷ []) = []
initLazy (x ∷ (y ∷ ys)) = x ∷ (initLazy (y ∷ ys))
Now the lemma is trivial.
Any other offers?

Related

Coq: Comparing an Int to a Nat in Separation Logic Foundations

Going through Separation Logic Foundations and I'm stuck on the exercise triple_mlength in Repr.v. I think my current problem is that I don't know how to handle ints and nats in Coq.
Lemma triple_mlength: forall (L: list val) (p:loc),
triple (mlength p)
(MList L p)
(fun r => \[r = val_int (length L)] \* (MList L p))
Check (fun L => val_int (length L)) doesn't throw an error, so that means length is capable of being an int. However, length is opaque and I can't unfold it.
My current context and goal:
x : val
p : loc
C : p <> null
x0 : loc
H : p <> null
xs : list val
IH : forall y : list val,
list_sub y (x :: xs) ->
forall p, triple (mlength p)
(MList y p)
(fun r:val => \[r = length y] \* MList y p)
______________________________________________________________
length xs + 1 = length (x :: xs)
Unsetting print notation the goal transforms into:
eq (Z.add (length xs) (Zpos xH)) (length (cons x xs))
which I think is trying to add (1:Z) to (length xs: nat), then compare it to (length (cons x xs) : nat)
Types:
Inductive nat : Set := O : nat
| S : nat -> nat
Inductive Z : Set := Z0 : int
| Zpos : positive -> int
| Zneg : positive -> int
list: forall A, list A -> nat
length: forall A, list A -> nat
val_int: int -> val
Coq version is 8.12.2
There is a coercion nat_to_Z : nat -> int in scope that is converting length xs : nat and length (x :: xs) : nat to ints. This is separate from the notation mechanism and thus you don't see it when you only ask Coq to show notations. However, it is there and you need to handle it in your proofs. There are a bunch of lemmas floating around that prove equivalence between nat operations and Z/int operations.
Having loaded your file and looked around a bit (Search is your friend!), it appears the reason you cannot simplify length (x :: xs) = S (length xs) is because there is a lemma length_cons which gives length (x :: xs) = (1 + length xs)%nat, instead. I suppose the authors of this book thought that would be a good idea for some reason, so they disabled the usual simplification. Do note that "normally" length is transparent and simpl would work on this goal.
After using length_cons, you can use plus_nat_eq_plus_int to push the coercion down under the +, and then Z.add_comm finishes. This line should satisfy the goal.
now rewrite length_cons, plus_nat_eq_plus_int, Z.add_comm.

Call a theorem using let-in

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.

Second order unification with rewrite

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.

Ltac call to "cofix" failed. Error: All methods must construct elements in coinductive types

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.

Coq rewriting using lambda arguments

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.