I tried to implement the following:
headEqual : DecEq a => (x : a) -> (y : a) -> Maybe (Dec (x = y))
headEqual x y = case decEq x y of
Yes Refl => Just (Yes Refl)
No contra => Nothing
vectEqual : DecEq a => (xs : Vect n a) -> (ys : Vect n a) -> Maybe (Dec (xs = ys))
vectEqual [] [] = Just (Yes Refl)
vectEqual (x :: xxs) (y :: yys) = case headEqual x y of
Just (Yes prf) => vectEqual xxs yys
No contra => Nothing
vectEqual (x :: xxs) [] = Nothing
vectEqual [] (y :: yys) = Nothing
However, it fails to compile:
*section3> :r
Type checking ./section3.idr
section3.idr:45:63-66:
When checking right hand side of Main.case block in vectEqual at section3.idr:44:40 with expected type
Maybe (Dec (x :: xxs = y :: yys))
When checking argument xs to Main.vectEqual:
Unifying len and S len would lead to infinite value
Holes: Main.y, Main.vectEqual
I don't understand this compile-time error. Can someone please explain?
For the non-empty case you need two proofs - one that the heads are equal and one for the tail. You then need to combine these proofs into one for the input vectors. In:
Just (Yes prf) => vectEqual xxs yys
you are trying to return a proof for the tail when you need a proof for the entire list. You need to check the result of the recursive call to build the proof e.g.
vectEqual : DecEq a => (xs : Vect n a) -> (ys : Vect n a) -> Maybe (Dec (xs = ys))
vectEqual [] [] = Just (Yes Refl)
vectEqual (x :: xs) (y :: ys) = case decEq x y of
Yes hd_prf => case vectEqual xs ys of
Just (Yes tl_prf) => ?combine_proofs
_ => Nothing
No contra => Nothing
If you load the above definition in the repl you will see the types of hd_prf and tl_prf:
hd_prf : x = y
tl_prf : xs = ys
you can use rewrite to construct the required proof of (x :: xs) = (y :: ys)
Just (Yes tl_prf) => rewrite hd_prf in rewrite tl_prf in Just (Yes Refl)
Note the return type of this function is a bit strange since you are using Nothing to encode the failure case which Dec already provides using the No constructor, so you never return Just (No _).
Related
I created a function which returns decidable property if the list is an ordered sequence with a step +1.
data Increasing : List Nat -> Type where
IncreasingSingle : Increasing [x]
IncreasingMany : Increasing (S k :: xs) -> Increasing (k :: S k :: xs)
emptyImpossible : Increasing [] -> Void
emptyImpossible IncreasingSingle impossible
emptyImpossible (IncreasingMany _) impossible
firstElementWrong : (contraFirst : (S x = y) -> Void) -> Increasing (x :: y :: xs) -> Void
firstElementWrong contraFirst (IncreasingMany seq) = contraFirst Refl
nextElementWrong : (contraNext : Increasing ((S x) :: xs) -> Void) -> Increasing (x :: (S x) :: xs) -> Void
nextElementWrong contraNext (IncreasingMany seq) = contraNext seq
increasing : (xs : List Nat) -> Dec (Increasing xs)
increasing [] = No emptyImpossible
increasing (x :: []) = Yes IncreasingSingle
increasing (x :: y :: xs) with ((S x) `decEq` y)
increasing (x :: y :: xs) | No contraFirst = No (firstElementWrong contraFirst)
increasing (x :: (S x) :: xs) | Yes Refl with (increasing ((S x) :: xs))
increasing (x :: (S x) :: xs) | Yes Refl | No contraNext = No (nextElementWrong contraNext)
increasing (x :: (S x) :: xs) | Yes Refl | Yes prf = Yes (IncreasingMany prf)
However increasing is not total because of:
increasing [] = No emptyImpossible
| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Main.increasing is possibly not total due to: with block in Main.increasing
Can someone explain me why it's not total and how to make it total?
I managed to get it working with case:
increasing : (xs : List Nat) -> Dec (Increasing xs)
increasing [] = No emptyImpossible
increasing (x :: []) = Yes IncreasingSingle
increasing (x :: y :: xs) = case S x `decEq` y of
Yes Refl => case increasing (S x :: xs) of
Yes p => Yes $ IncreasingMany p
No p => No $ \(IncreasingMany x) => p x
No p => No $ \(IncreasingMany x) => p Refl
I am learning Idris and I have a bit of a noob question.
I am doing exercise 2 of chapter 8.3 of the book on type driven development with Idris. The point is to implement DecEq for your own Vector. This is how far I got:
data Vect : Nat -> Type -> Type where
Nil : Vect 0 elem
(::) : elem -> Vect n elem -> Vect (S n) elem
headUnequal : {xs : Vect n a} -> {ys : Vect n a} -> (contra : (x = y) -> Void) -> ((x :: xs) = (y :: ys)) -> Void
headUnequal contra Refl = contra Refl
tailsUnequal : {xs : Vect n a} -> {ys : Vect n a} -> (contra : (xs = ys) -> Void) -> ((x :: xs) = (y :: ys)) -> Void
tailsUnequal contra Refl = contra Refl
headAndTailEq : {xs : Vect n a} -> {ys : Vect n a} -> (xEqY : x = y) -> (xsEqYs : xs = ys) -> ((x :: xs) = (y :: ys))
headAndTailEq xEqY xsEqYs = ?hole
implementation DecEq a => DecEq (Vect n a) where
decEq [] [] = Yes Refl
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes xEqY => case decEq xs ys of
No xsNeqYs => No $ tailsUnequal xsNeqYs
Yes xsEqYs => Yes $ headAndTailEq xEqY xsEqYs
How do I fill ?hole?
I've seen the solution on https://github.com/edwinb/TypeDD-Samples/blob/master/Chapter8/Exercises/ex_8_3.idr. With that knowledge I can make my solution work:
implementation DecEq a => DecEq (Vect n a) where
decEq [] [] = Yes Refl
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes Refl => case decEq xs ys of
No xsNeqYs => No $ tailsUnequal xsNeqYs
Yes Refl => Yes Refl
But honestly, why does this work? Why does the final Yes Refl only work if I don't name the proofs?
Thank you!
The important difference is the value matching in the case-blocks, not the naming of the proofs. If you inspect the first case with
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes Refl => ?hole
you will see, that the ?hole only needs Dec (x :: xs = x :: ys). In your version on the other hand, ?hole is Dec (x :: xs = y :: ys):
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes xEqY => ?hole
Here, xEqY : x = y. Idris has no special understanding of =, so this simply means, that there is a value xEqY that has the type x = y (and there is no further inspection on what xEqY could be). If you match on Refl, Idris can unify x and y, because Refl is a constructor for x = x - the values are the same. Thus you gain more information with pattern matching; instead of an opaque variable name, you get a concrete value. As a rule of thumb: always pattern match until you have enough information on the right hand side.
With this, your proof can also be implemented easily:
headAndTailEq : {xs : Vect n a} -> {ys : Vect n a} -> (xEqY : x = y) -> (xsEqYs : xs = ys) -> ((x :: xs) = (y :: ys))
headAndTailEq Refl Refl = Refl
I have a function count in idris, defined as :
count : Eq a => a -> Vect n a -> Nat
count x [] = Z
count x (y::ys) = with (x == y)
| True = S (count x ys)
| False = count x ys
And a proof of the maximum value count can return:
countLTELen : Eq a => (x : a) -> (l : Vect n a) -> LTE (count x l) n
countLTELen x [] = lteRefl
countLteLen x (y::ys) with (x == y)
| True = LTESucc (countLTELen x ys)
| False = lteSuccRight (countLTELen x ys)
which is all well and good. I now want to write a function which removes all of an element from a list, removeAll :
removeAll : Eq a => (x : a) -> (l : Vect n a) -> Vect (n - (count x l)) a
removeAll x [] = []
removeAll x (y::ys) with (x == y)
| True = removeAll x ys
| False = x :: removeAll x ys
But this definition gives an error:
|
56 | removeAll : Eq a => (x : a) -> (l : Vect n a) -> Vect (n - (count x l)) a
| ^
When checking type of Proof.removeAll:
When checking argument smaller to function Prelude.Nat.-:
Can't find a value of type
LTE (count a n constraint x l) n
How can I use my proof to inform Idris that this type signature is correct?
Right now, Idris can't find the proof {auto smaller : LTE n m} for (-).
So either you need to be explicit:
removeAll : Eq a => (x : a) -> (l : Vect n a) ->
Vect ((-) {smaller=countLTELen x l} n (count x l) ) a
Or, because smaller is an auto-argument, you can hint the compiler to your proof function. Then this function will be tried when auto-finding a value for LTE (count x l) n.
%hint
countLTELen : Eq a => (x : a) -> (l : Vect n a) -> LTE (count x l) n
Let's say we have a function merge that, well, just merges two lists:
Order : Type -> Type
Order a = a -> a -> Bool
merge : (f : Order a) -> (xs : List a) -> (ys : List a) -> List a
merge f xs [] = xs
merge f [] ys = ys
merge f (x :: xs) (y :: ys) = case x `f` y of
True => x :: merge f xs (y :: ys)
False => y :: merge f (x :: xs) ys
and we'd like to prove something clever about it, for instance, that merging two non-empty lists produces a non-empty list:
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) = ?wut
Inspecting the type of the hole wut gives us
wut : NonEmpty (case f x y of True => x :: merge f xs (y :: ys) False => y :: merge f (x :: xs) ys)
Makes sense so far! So let's proceed and case-split as this type suggests:
mergePreservesNonEmpty f (x :: xs) (y :: ys) = case x `f` y of
True => ?wut_1
False => ?wut_2
It seems reasonable to hope that the types of wut_1 and wut_2 would match the corresponding branches of merge's case expression (so wut_1 would be something like NonEmpty (x :: merge f xs (y :: ys)), which can be instantly satisfied), but our hopes fail: the types are the same as for the original wut.
Indeed, the only way seems to be to use a with-clause:
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
mergePreservesNonEmpty f (x :: xs) (y :: ys) | True = ?wut_1
mergePreservesNonEmpty f (x :: xs) (y :: ys) | False = ?wut_2
In this case the types would be as expected, but this leads to repeating the function arguments for every with branch (and things get worse once with gets nested), plus with doesn't seem to play nice with implicit arguments (but that's probably worth a question on its own).
So, why doesn't case help here, are there any reasons besides purely implementation-wise behind not matching its behaviour with that of with, and are there any other ways to write this proof?
The stuff to the left of the | is only necessary if the new information somehow propagates backwards to the arguments.
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
| True = IsNonEmpty
| False = IsNonEmpty
-- for contrast
sym' : (() -> x = y) -> y = x
sym' {x} {y} prf with (prf ())
-- matching against Refl needs x and y to be the same
-- now we need to write out the full form
sym' {x} {y=x} prf | Refl = Refl
As for why this is the case, I do believe it's just the implementation, but someone who knows better may dispute that.
There's an issue about proving things with case: https://github.com/idris-lang/Idris-dev/issues/4001
Because of this, in idris-bi we ultimately had to remove all cases in such functions and define separate top-level helpers that match on the case condition, e.g., like here.
Let's consider a predicate showing that the elements in the list are in increasing order (and for simplicity let's only deal with non-empty lists):
mutual
data Increasing : List a -> Type where
SingleIncreasing : (x : a) -> Increasing [x]
RecIncreasing : Ord a => (x : a) ->
(rest : Increasing xs) ->
(let prf = increasingIsNonEmpty rest
in x <= head xs = True) ->
Increasing (x :: xs)
%name Increasing xsi, ysi, zsi
increasingIsNonEmpty : Increasing xs -> NonEmpty xs
increasingIsNonEmpty (SingleIncreasing y) = IsNonEmpty
increasingIsNonEmpty (RecIncreasing x rest prf) = IsNonEmpty
Now let's try to write some useful lemmas with this predicate. Let's start with showing that concatenating two increasing lists produces an increasing list, given that the last element of the first list is not greater than the first element of the second list. The type of this lemma would be:
appendIncreasing : Ord a => {xs : List a} ->
(xsi : Increasing xs) ->
(ysi : Increasing ys) ->
{auto leq : let xprf = increasingIsNonEmpty xsi
yprf = increasingIsNonEmpty ysi
in last xs <= head ys = True} ->
Increasing (xs ++ ys)
Let's now try to implement it! A reasonable way seems to be case-splitting on xsi. The base case where xsi is a single element is trivial:
appendIncreasing {leq} (SingleIncreasing x) ysi = RecIncreasing x ysi leq
The other case is more complicated. Given
appendIncreasing {leq} (RecIncreasing x rest prf) ysi = ?wut
it seems reasonable to proceed by recursively proving this for the result of joining rest and ysi by relying on leq and then prepending x using the prf. At this point the leq is actually a proof of last (x :: xs) <= head ys = True, and the recursive call to appendIncreasing would need to have a proof of last xs <= head ys = True. I don't see a good way to directly prove that the former implies the latter, so let's fall back to rewriting and first write a lemma showing that the last element of a list isn't changed by prepending to the front:
lastIsLast : (x : a) -> (xs : List a) -> {auto ok : NonEmpty xs} -> last xs = last (x :: xs)
lastIsLast x' [x] = Refl
lastIsLast x' (x :: y :: xs) = lastIsLast x' (y :: xs)
Now I would expect to be able to write
appendIncreasing {xs = x :: xs} {leq} (RecIncreasing x rest prf) ysi =
let rest' = appendIncreasing {leq = rewrite lastIsLast x xs in leq} rest ysi
in ?wut
but I fail:
When checking right hand side of appendIncreasing with expected type
Increasing ((x :: xs) ++ ys)
When checking argument leq to Sort.appendIncreasing:
rewriting last xs to last (x :: xs) did not change type last xs <= head ys = True
How can I fix this?
And, perhaps, my proof design is suboptimal. Is there a way to express this predicate in a more useful manner?
If rewrite doesn't find the right predicate, try to be explicit with replace.
appendIncreasing {a} {xs = x :: xs} {ys} (RecIncreasing x rest prf) ysi leq =
let rekPrf = replace (sym $ lastIsLast x xs) leq
{P=\T => (T <= (head ys {ok=increasingIsNonEmpty ysi})) = True} in
let rek = appendIncreasing rest ysi rekPrf in
let appPrf = headIsHead xs ys {q = increasingIsNonEmpty rek} in
let extPrf = replace appPrf prf {P=\T => x <= T = True} in
RecIncreasing x rek extPrf
with
headIsHead : (xs : List a) -> (ys : List a) ->
{auto p : NonEmpty xs} -> {auto q : NonEmpty (xs ++ ys)} ->
head xs = head (xs ++ ys)
headIsHead (x :: xs) ys = Refl
Some suggestions:
Use Data.So x instead of x = True, makes run-time functions
easier to write.
Lift Ord a from the constructor to the type, making it
more clear which ordering is used (and you don't have to match on
{a} at appendIncreasing, I guess).
Don't forget that you can
match on variables in constructors, so instead of repeating that Increasing xs has
NonEmpty xs, just use Increasing (x :: xs).
Leading to:
data Increasing : Ord a -> List a -> Type where
SingleIncreasing : (x : a) -> Increasing ord [x]
RecIncreasing : (x : a) -> Increasing ord (y :: ys) ->
So (x <= y) ->
Increasing ord (x :: y :: ys)
appendIncreasing : {ord : Ord a} ->
Increasing ord (x :: xs) -> Increasing ord (y :: ys) ->
So (last (x :: xs) <= y) ->
Increasing ord ((x :: xs) ++ (y :: ys))
Should make proving things a lot easier, especially if you want to include empty lists.