Idris simple proof with lists - idris

I am trying to prove some simple things with idris but I am failing miserably. Here is my code
module MyReverse
%hide reverse
%default total
reverse : List a -> List a
reverse [] = []
reverse (x :: xs) = reverse xs ++ [x]
listEmptyAppend : (l : List a) -> [] ++ l = l
listEmptyAppend [] = Refl
listEmptyAppend (x :: xs) = Refl
listAppendEmpty : (l : List a) -> l ++ [] = l
listAppendEmpty [] = Refl
listAppendEmpty (x :: xs) = rewrite listAppendEmpty xs in Refl
list_append_eq : (l, l1, l2 : List a) -> l ++ l1 = l ++ l2 -> l1 = l2
list_append_eq l [] [] prf = Refl
list_append_eq l [] (x :: xs) prf = ?list_append_eq_rhs_1
list_append_eq l (x :: xs) [] prf = ?list_append_eq_rhs_2
list_append_eq l (x :: xs) (y :: ys) prf = ?list_append_eq_rhs_3
The goal for ?list_append_eq_rhs_1 is (after a couple of intro's)
---------- Assumptions: ----------
a : Type
l : List a
x : a
xs : List a
prf : l ++ [] = l ++ x :: xs
---------- Goal: ----------
{hole0} : [] = x :: xs
What I want to do is rewrite prf using the trivial theorems I have proved until it is exactly the goal but I don't know how to do that in idris.

First of all, we need the fact that :: is injective:
consInjective : {x : a} -> {l1, l2 : List a} -> x :: l1 = x :: l2 -> l1 = l2
consInjective Refl = Refl
Then we can use the above fact to prove list_append_eq by induction on l:
list_append_eq : (l, l1, l2 : List a) -> l ++ l1 = l ++ l2 -> l1 = l2
list_append_eq [] _ _ prf = prf
list_append_eq (x :: xs) l1 l2 prf =
list_append_eq xs l1 l2 (consInjective prf)
Here is a more concise version suggested by #András Kovács, which achieves the same result without consInjective by using the standard cong (congruence) lemma
Idris> :t cong
cong : (a = b) -> f a = f b
and the drop function:
list_append_eq : (l, l1, l2 : List a) -> l ++ l1 = l ++ l2 -> l1 = l2
list_append_eq [] _ _ prf = prf
list_append_eq (x :: xs) l1 l2 prf =
list_append_eq xs l1 l2 (cong {f = drop 1} prf)

Related

Hole with Delay in type. How to prove?

I was trying to prove that replicate1 works correctly by showing that all elements of replicate1 n x are x:
all1 : (p : a -> Bool) -> List a -> Bool
all1 p [] = True
all1 p (x :: xs) = p x && all1 p xs
replicate1 : (n: Nat) -> a -> List a
replicate1 Z x = [x]
replicate1 (S k) x = x :: replicate1 k x
all_replicate_is_x : Eq a => {x: a} -> all1 (== x) (replicate1 n x) = True
all_replicate_is_x {n = Z} = ?hole
all_replicate_is_x {n = (S k)} = ?all_replicate_is_x_rhs_2
The base case hole is
Test.hole [P]
`-- a : Type
constraint : Eq a
x : a
-----------------------------------------
Test.hole : x == x && Delay True = True
How to prove this?

How to rewrite: Vect (S (S (n + m))) a -> Vect (S (plus n (S m))) a

I am stuck with Idris (again, sigh). I am doing an exercise on merge sort from the type driven development with Idris book on chapter 10. I have this:
import Data.Vect
import Data.Vect.Views
sort2 : Ord a => (l: a) -> (r: a) -> (a, a)
sort2 l r = if l <= r then (l, r) else (r, l)
needHelp : Vect (S (S (n + m))) a -> Vect (S (plus n (S m))) a
needHelp {n=(S n)} {m=(S m)} (x :: xs) = ?help
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
needHelp (f :: s :: (vectMerge xs ys))
I have isolated the needHelp function so you can see the rewrite that I want to achieve. I tried this:
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
let tail = (rewrite plusSuccRightSucc n m in s :: vectMerge xs ys) in
f :: tail
But Idris complains:
When checking right hand side of Main.case block in vectMerge with expected type
Vect (S (plus n (S m))) a
rewriting S (plus n m) to plus n (S m) did not change type letty
I don't understand why this doesn't work. Help much appreciated.
rewrite works with respect to your current goal, not wrt to the term you are trying to use to solve the goal (I tried to illustrate it in this answer).
So, here is a possible solution:
import Data.Vect
sort2 : Ord a => (l: a) -> (r: a) -> (a, a)
sort2 l r = if l <= r then (l, r) else (r, l)
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
rewrite sym $ plusSuccRightSucc n m in
(f :: s :: (vectMerge xs ys))
sym in sym $ plusSuccRightSucc n m reverses the direction of rewrite.

Idris rewrite does not happen

import Data.Vect
import Data.Vect.Quantifiers
sameKeys : Vect n (lbl, Type) -> Vect n (lbl, Type) -> Type
sameKeys xs ys = All (uncurry (=)) (zip (map fst xs) (map fst ys))
g : {xs,ys : Vect n (lbl, Type)} -> sameKeys xs ys -> map (\b => fst b) xs = map (\b => fst b) ys
g {xs = []} {ys = []} [] = Refl
g {xs = x::xs} {ys = y::ys} (p::ps) = rewrite g ps in ?q
This is the error I see:
*main> :load main.idr
Type checking ./main.idr
main.idr:57:3:When checking right hand side of g with expected type
map (\b => fst b) (x :: xs) = map (\b6 => fst b6) (y :: ys)
rewriting
Data.Vect.Vect n implementation of Prelude.Functor.Functor, method map (\b => fst b) xs
to
Data.Vect.Vect n implementation of Prelude.Functor.Functor, method map (\b6 => fst b6) ys
did not change type
fst x :: Data.Vect.Vect n implementation of Prelude.Functor.Functor, method map (\b => fst b) xs = fst y :: Data.Vect.Vect n implementation of Prelude.Functor.Functor, method map (\b6 => fst b6) ys
Holes: Main.g
Why does it not rewrite it?
This is happening because Idris somehow fails to infer the correct implicit arguments to g, instead it introduces fresh vectors in the context.
As a workaround I can suggest to prove it as follows. First, we'll need a congruence lemma for two-argument functions:
total
cong2 : {f : a -> b -> c} -> (a1 = a2) -> (b1 = b2) -> f a1 b1 = f a2 b2
cong2 Refl Refl = Refl
Now the proof of the original lemma is trivial:
total
g : sameKeys xs ys -> map (\b => fst b) xs = map (\b => fst b) ys
g {xs = []} {ys = []} x = Refl
g {xs = x :: xs} {ys = y :: ys} (p :: ps) = cong2 p $ g ps

Understanding `decEq`

Given:
*section3> :module Data.Vect
*section3> :let e = the (Vect 0 Int) []
*section3> :let xs = the (Vect _ _) [1,2]
*section3> decEq xs e
(input):1:7:When checking argument x2 to function Decidable.Equality.decEq:
Type mismatch between
Vect 0 Int (Type of e)
and
Vect 2 Integer (Expected type)
Specifically:
Type mismatch between
0
and
2
Why must the Nat arguments equal each other for DecEq?
Note - posted in https://groups.google.com/forum/#!topic/idris-lang/qgtImCLka3I originally
decEq is for homogenous propositional equality:
||| Decision procedures for propositional equality
interface DecEq t where
||| Decide whether two elements of `t` are propositionally equal
total decEq : (x1 : t) -> (x2 : t) -> Dec (x1 = x2)
As you can see, x1 and x2 are both of type t. In your case, you have x1 : Vect 2 Integer and x2 : Vect 0 Int. These are two different types.
You can write your own heterogenous equality decider for Vectors of the same element type by first checking their lengths, then delegating to the homogenous version:
import Data.Vect
vectLength : {xs : Vect n a} -> {ys : Vect m a} -> xs = ys -> n = m
vectLength {n = n} {m = n} Refl = Refl
decEqVect : (DecEq a) => (xs : Vect n a) -> (ys : Vect m a) -> Dec (xs = ys)
decEqVect {n = n} {m = m} xs ys with (decEq n m)
decEqVect xs ys | Yes Refl = decEq xs ys
decEqVect xs ys | No notEq = No (notEq . vectLength)

List Equality w/ `cong`

Following my other question, I tried to implement the actual exercise in Type-Driven Development with Idris for same_cons to prove that, given two equal lists, prepending the same element to each list results in two equal lists.
Example:
prove that 1 :: [1,2,3] == 1 :: [1,2,3]
So I came up with the following code that compiles:
sameS : {xs : List a} -> {ys : List a} -> (x: a) -> xs = ys -> x :: xs = x :: ys
sameS {xs} {ys} x prf = cong prf
same_cons : {xs : List a} -> {ys : List a} -> xs = ys -> x :: xs = x :: ys
same_cons prf = sameS _ prf
I can call it via:
> same_cons {x=5} {xs = [1,2,3]} {ys = [1,2,3]} Refl
Refl : [5, 1, 2, 3] = [5, 1, 2, 3]
Regarding the cong function, my understanding is that it takes a proof, i.e. a = b, but I don't understand its second argument: f a.
> :t cong
cong : (a = b) -> f a = f b
Please explain.
If you have two values u : c and v : c, and a function f : c -> d, then if you know that u = v, it has to follow that f u = f v, following simply from referential transparency.
cong is the proof of the above statement.
In this particular use case, you are setting (via unification) c and d to List a, u to xs, v to ys, and f to (:) x, since you want to prove that xs = ys -> (:) x xs = (:) x ys.