How to prove propositional equality between a complicated expression and `True`? - idris

I have some code that looks like this:
allLessThan : Ord t => (v1 : Vect n t) -> (v2 : Vect n t) -> Bool
allLessThan v1 v2 = all (\(x,y) => x < y) (zip v1 v2)
unravelIndexUnsafe : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : Vect (S n) Nat) ->
Nat
unravelIndexUnsafe order shape position = ?someImplementation
unravelIndexSafe : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : Vect (S n) Nat) ->
{auto 0 prfPositionValid : (allLessThan position shape) = True} ->
Nat
unravelIndexSafe order shape position = unravelIndexUnsafe order shape position
unravelIndex : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : Vect (S n) Nat) ->
Maybe Nat
unravelIndex order shape position =
case allLessThan position shape of
True => Just $ unravelIndexSafe order shape position
False => Nothing
I omitted the implementation of unravelIndexUnsafe which I think is irrelevant to the question.
I get a type error in the definition of unravelIndex, saying that it can't find an implementation for prfPositionValid to use with unravelIndexSafe*.
This was surprising to me, because I am explicitly case splitting on allLessThan position shape, and only calling unravelIndexSafe in the True branch. I expected that Idris would be able to infer from this information that the proposition (allLessThan position shape) = True holds.
Is there a straightforward way to solve the problem? Maybe something I can explicitly construct and pass for the prfPositionValid implicit argument? Or is there an entirely different approach I should use here? Do I need to express prfPositionValid or allLessThan differently? Do I need to rewrite something?
* More precisely, it can't find an implementation for this monstrous "fully-expanded" version of prfPositionValid:
foldl (\acc, elem => acc && Delay (case block in allLessThan (S n) Nat (MkOrd (\{arg:354}, {arg:355} => compare arg arg) (\{arg:356}, {arg:357} => == (compare arg arg) LT) (\{arg:358}, {arg:359} => == (compare arg arg) GT) (\{arg:360}, {arg:361} => not (== (compare arg arg) GT)) (\{arg:362}, {arg:363} => not (== (compare arg arg) LT)) (\{arg:364}, {arg:365} => if == (compare arg arg) GT then x else y) (\{arg:366}, {arg:367} => if == (compare arg arg) LT then x else y)) shape position elem)) True (zipWith (\{__leftTupleSection:0}, {__infixTupleSection:0} => (__leftTupleSection, __infixTupleSection)) position shape) = True

Solution: use decidable equality
The answer is to use "decidable equality", because Idris is not as smart as a human.
Note that the special = syntax is equivalent to the builtin operator (===), which is equivalent to the type Equal. The constructor for Equal is Refl. In order to prove a proposition of the form Equal a b, Idris must be able to figure out that a and b are in fact the same thing (call it c). If you can invoke Refl c with type Equal a b, then you have proven Equal a b. Conversely, the only way to obtain an instance of Equal a b is by invoking Refl c.
Idris 2 cannot infer propositional equality by case-splitting. I, a human, know that we are trying to show that allLessThan position shape is propositionally equal to True. In Idris, this means we want to be able to write Refl True. Case-splitting on allLessThan position shape does result in a Bool, but this alone does not constitute an invocation of Refl True with type Equal (allLessThan position shape) True. Therefore case-splitting as in the original code is not sufficient for Idris to infer a proof of Equal (allLessThan position shape) True.
We know that allLessThan position shape is a decidable predicate, so we can use decEq to obtain the proof/implementation that we need. Therefore we can write unravelIndex as:
unravelIndex : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : Vect (S n) Nat) ->
Maybe Nat
unravelIndex order shape position =
case decEq (allLessThan position shape) True of
Yes proof => Just $ unravelIndexSafe order shape position
No contra => Nothing
The proof in Yes proof is precisely the Refl True we were looking for, which implements Equal (allLessThan position shape) True. Therefore Idris will be able to infer a value for the prfPositionValid auto-implicit, because a value of the right type is available in scope.
You could also write _ instead of proof and contra, because the proofs are not explicitly used in the code anywhere, so they don't need names.
Refactoring
Note that this allLessThan position shape is somewhat ad-hoc. In particular, stating the conditions of the property requires the programmer to memorize a specific expression. However we would like to write a tidier API, in which the programmer can invoke a function isPositionValidForShape to check validity, and use a type IndexValidForShape to represent the "valid" state.
allLessThan : Ord t => (v1 : Vect n t) -> (v2 : Vect n t) -> Bool
allLessThan v1 v2 = all (\(x,y) => x < y) (zip v1 v2)
IndexValidForShape : (shape : ArrayShape ndim) ->
(position : ArrayIndex ndim) ->
Type
IndexValidForShape shape position =
let isValid = allLessThan position shape
in Equal isValid True
isIndexValidForShape : (shape : ArrayShape (S n)) ->
(position : ArrayIndex (S n)) ->
Dec (IndexValidForShape shape position)
isIndexValidForShape shape position =
decEq (allLessThan position shape) True
unravelIndexUnsafe : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : ArrayIndex (S n)) ->
Nat
unravelIndexUnsafe order shape position =
sum $ zipWith (*) (strides order shape) position
unravelIndexSafe : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : ArrayIndex (S n)) ->
{auto 0 prfIndexValid : IndexValidForShape shape position} ->
Nat
unravelIndexSafe order shape position =
unravelIndexUnsafe order shape position
unravelIndex : (order : ArrayOrder) ->
(shape : ArrayShape (S n)) ->
(position : ArrayIndex (S n)) ->
Maybe Nat
unravelIndex order shape position =
case isIndexValidForShape shape position of
Yes _ => Just $ unravelIndexSafe order shape position
No _ => Nothing
Now, the end user don't have to know or care what exactly IndexValidForShape entails, or that you need to use allLessThan to check for it.
In fact, we can now change what it means for an index to be "valid", mostly without affecting downstream code user; maybe there are additional checks I want to put in place, that I only learn about after I find a logic bug.
Alternatively, it should be possible to re-design IndexValidForShape to be more "structural", wherein you inductively define a data type that represents the desired property. For example, refer to Data.Vect.Elem and its description in Chapter 9 of Type-Driven Development.
Glossary
decidable: "a property is decidable if you can always say whether the property holds for some specific values" (quoted from Type-Driven Development, page 245).
Dec: The type representing the validity of a decidable property. Its constructors are:
Yes : property -> Dec property - the property holds.
No : (property -> Void) -> Dec property - the property is a contradiction.
DecEq: The interface for data types for which equality can be determined as a decidable property.
decEq: The method of DecEq that determines if two things are decidably equal. Its type is DecEq t => (x1 : t) -> (x2 : t) -> Dec (Equal x1 x2).
References & Further reading
Type-Driven Development with Idris (Edwin Brady, 2017, ISBN 9781617293023), especially section 9.1.5 which covers Decidable.Equality.

Related

Interface constraints for interface instances in Idris

I am just starting to learn Idris coming from Haskell, and I'm trying to write some simple linear algebra code.
I want to write a Num interface instance for Vect, but specifically for Vect n a with the constraint that a has a Num instance.
In Haskell I would write a typeclass instance like this:
instance Num a => Num (Vect n a) where
(+) a b = (+) <$> a <*> b
(*) a b = (*) <$> a <*> b
fromInteger a = a : Nil
But reading the Idris interface docs does not seem to mention constraints on interface instances.
The best I can do is the following, which predictably causes the compiler to lament about a not being a numeric type:
Num (Vect n a) where
(+) Nil Nil = Nil
(+) (x :: xs) (y :: ys) = x + y :: xs + ys
(*) Nil Nil = Nil
(*) (x :: xs) (y :: ys) = x * y :: xs * ys
fromInteger i = Vect 1 (fromInteger i)
I can work around this by creating my own vector type with a Num constraint (which isn't portable) or by overloading (+) in a namespace (which feels a little clunky):
namespace Vect
(+) : Num a => Vect n a -> Vect n a -> Vect n a
(+) xs ys = (+) <$> xs <*> ys
Is there a way to constrain interface implementations, or is there a better way to accomplish this, eg using dependent types?
In Idris, you'd do (almost) the same as haskell
Num a => Num (Vect n a) where
Like a number of things, this is in the book but not, apparently, in the docs.

Proving that concatenating two increasing lists produces an increasing list

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.

Dependent types: enforcing global properties in inductive types

I have the following inductive type MyVec:
import Data.Vect
data MyVec: {k: Nat} -> Vect k Nat -> Type where
Nil: MyVec []
(::): {k, n: Nat} -> {v: Vect k Nat} -> Vect n Nat -> MyVec v -> MyVec (n :: v)
-- example:
val: MyVec [3,2,3]
val = [[2,1,2], [0,2], [1,1,0]]
That is, the type specifies the lengths of all vectors inside a MyVec.
The problem is, val will have k = 3 (k is the number of vectors inside a MyVec), but the ctor :: does not know this fact. It will first build a MyVec with k = 1, then with 2, and finally with 3. This makes it impossible to define constraints based on the final shape of the value.
For example, I cannot constrain the values to be strictly less than k. Accepting Vects of Fin (S k) instead of Vects of Nat would rule out some valid values, because the last vectors (the first inserted by the ctor) would "know" a smaller value of k, and thus a stricter contraint.
Or, another example, I cannot enforce the following constraint: the vector at position i cannot contain the number i. Because the final position of a vector in the container is not known to the ctor (it would be automatically known if the final value of k was known).
So the question is, how can I enforce such global properties?
There are (at least) two ways to do it, both of which may require tracking additional information in order to check the property.
Enforcing properties in the data definition
Enforcing all elements < k
I cannot constrain the values to be strictly less than k. Accepting Vects of Fin (S k) instead of Vects of Nat would rule out some valid values...
You are right that simply changing the definition of MyVect to have Vect n (Fin (S k)) in it would not be correct.
However, it is not too hard to fix this by generalizing MyVect to be polymorphic, as follows.
data MyVec: (A : Type) -> {k: Nat} -> Vect k Nat -> Type where
Nil: {A : Type} -> MyVec A []
(::): {A : Type} -> {k, n: Nat} -> {v: Vect k Nat} -> Vect n A -> MyVec A v -> MyVec A (n :: v)
val : MyVec (Fin 3) [3,2,3]
val = [[2,1,2], [0,2], [1,1,0]]
The key to this solution is separating the type of the vector from k in the definition of MyVec, and then, at top level, using the "global value of k to constrain the type of vector elements.
Enforcing vector at position i does not contain i
I cannot enforce that the vector at position i cannot contain the number i because the final position of a vector in the container is not known to the constructor.
Again, the solution is to generalize the data definition to keep track of the necessary information. In this case, we'd like to keep track of what the current position in the final value will be. I call this index. I then generalize A to be passed the current index. Finally, at top level, I pass in a predicate enforcing that the value does not equal the index.
data MyVec': (A : Nat -> Type) -> (index : Nat) -> {k: Nat} -> Vect k Nat -> Type where
Nil: {A : Nat -> Type} -> {index : Nat} -> MyVec' A index []
(::): {A : Nat -> Type} -> {k, n, index: Nat} -> {v: Vect k Nat} ->
Vect n (A index) -> MyVec' A (S index) v -> MyVec' A index (n :: v)
val : MyVec' (\n => (m : Nat ** (n == m = False))) 0 [3,2,3]
val = [[(2 ** Refl),(1 ** Refl),(2 ** Refl)], [(0 ** Refl),(2 ** Refl)], [(1 ** Refl),(1 ** Refl),(0 ** Refl)]]
Enforcing properties after the fact
Another, sometimes simpler way to do it, is to not enforce the property immediately in the data definition, but to write a predicate after the fact.
Enforcing all elements < k
For example, we can write a predicate that checks whether all elements of all vectors are < k, and then assert that our value has this property.
wf : (final_length : Nat) -> {k : Nat} -> {v : Vect k Nat} -> MyVec v -> Bool
wf final_length [] = True
wf final_length (v :: mv) = isNothing (find (\x => x >= final_length) v) && wf final_length mv
val : (mv : MyVec [3,2,3] ** wf 3 mv = True)
val = ([[2,1,2], [0,2], [1,1,0]] ** Refl)
Enforcing vector at position i does not contain i
Again, we can express the property by checking it, and then asserting that the value has the property.
wf : (index : Nat) -> {k : Nat} -> {v : Vect k Nat} -> MyVec v -> Bool
wf index [] = True
wf index (v :: mv) = isNothing (find (\x => x == index) v) && wf (S index) mv
val : (mv : MyVec [3,2,3] ** wf 0 mv = True)
val = ([[2,1,2], [0,2], [1,1,0]] ** Refl)

Idris Vect.fromList usage with generated list

I am trying to feel my way into dependent types. Based on the logic of the windowl function below, I want to return a list of vectors whose length depend on the size provided.
window : (n : Nat) -> List a -> List (Vect n a)
window size = map fromList loop
where
loop xs = case splitAt size xs of
(ys, []) => if length ys == size then [ys] else []
(ys, _) => ys :: loop (drop 1 xs)
windowl : Nat -> List a -> List (List a)
windowl size = loop
where
loop xs = case List.splitAt size xs of
(ys, []) => if length ys == size then [ys] else []
(ys, _) => ys :: loop (drop 1 xs)
When I attempt to load the function into Idris, I get the following:
When checking argument func to function Prelude.Functor.map:
Type mismatch between
(l : List elem) -> Vect (length l) elem (Type of fromList)
and
a1 -> List (Vect size a) (Expected type)
Specifically:
Type mismatch between
Vect (length v0) elem
and
List (Vect size a)
When reading the documentation on fromList I notice that it says
The length of the list should be statically known.
So I assume that the type error has to do with Idris not knowing that the length of the list is corresponding to the size specified.
I am stuck because I don't even know if it is something impossible I want to do or whether I can specify that the length of the list corresponds to the length of the vector that I want to produce.
Is there a way to do that?
Since in your case it is not possible to know the length statically, we need a function which can fail at run-time:
total
fromListOfLength : (n : Nat) -> (xs : List a) -> Maybe (Vect n a)
fromListOfLength n xs with (decEq (length xs) n)
fromListOfLength n xs | (Yes prf) = rewrite (sym prf) in Just (fromList xs)
fromListOfLength n xs | (No _) = Nothing
fromListOfLength converts a list of length n into a vector of length n or fails. Now let's combine it and windowl to get to window.
total
window : (n : Nat) -> List a -> List (Vect n a)
window n = catMaybes . map (fromListOfLength n) . windowl n
Observe that the window function's type is still an underspecification of what we are doing with the input list, because nothing prevents us from always returning the empty list (this could happen if fromListOfLength returned Nothing all the time).

Why does Idris' Refl sometimes not type-check?

I'm working through the Idris book, and I'm doing the first exercises on proof.
With the exercise to prove same_lists, I'm able to implement it like this, as matching Refl forces x and y to unify:
total same_lists : {xs : List a} -> {ys : List a} ->
x = y -> xs = ys -> x :: xs = y :: ys
same_lists Refl Refl = Refl
However, when I try to prove something else in the same manner, I get mismatches. For example:
total allSame2 : (x, y : Nat) -> x = y -> S x = S y
allSame2 x y Refl = Refl
The compiler says:
Type mismatch between
y = y (Type of Refl)
and
x = y (Expected type)
If I case-match after the =, either explicitly or with a lambda, it works as expected:
total allSame2 : (x : Nat) -> (y : Nat) -> x = y -> S x = S y
allSame2 x y = \Refl => Refl
What's the difference here?
Another modification that works is making the problematic arguments implicit:
total allSame2 : {x : Nat} -> {y : Nat} -> x = y -> S x = S y
allSame2 Refl = Refl
I do not know all the details, but I can give you a rough idea. In Idris, the parameter lists of named functions are special in that it is part of dependent pattern matching. When you pattern match it also rewrites the other parameters.
same_lists x y Refl = Refl is not valid, I roughly guess, because Idris is rewriting x and y to be the same, and you are not allowed to then give different names to this single value — I hope someone can give a better explanation of this mechanism. Instead you may use same_lists x x Refl = Refl — and note that the name x is not important, just that the same name is used in both sites.
A lambda parameter is apart from the named parameter list. Therefore, since you are doing the matching in the lambda, Idris is only going to rewrite the other parameters at that point. The key is that with the first example Idris wants to do it all at once because it is part of the same parameter list.
With the final example the only change is that you did not give distinct names to the parameters. It would have also been valid to use all_same _ _ Refl = Refl. When the parameters are implicit, Idris will fill them in correctly for you.
Finally you can consider same_lists = \x, y, Refl => Refl which also works. This is because Idris does not rewrite in unnamed parameter lists (i.e. lambda parameters).