I have Coord function that transforms an n-dimensional size to the type of coordinates bounded by given size: Coord [2,3] = (Fin 2, Fin 3).
import Data.Fin
import Data.List
Size : Type
Size = List Nat
Coord : Size -> Type
Coord [] = ()
Coord s#(_ :: _) = foldr1 (,) $ map Fin s
I'd like to use show and other functions like (==) with Coord s:
foo : Coord s -> String
foo x = show x
Error: While processing right hand side of foo. Can't find an implementation for Show (Coord s).
22 | foo : Coord s -> String
23 | foo x = show x
^^^^^^
Earlier I tried to implement Show (Coord s), but looks like it's impossible. Here is linked question about it.
You can make your own list like data type:
data Coords : List Nat -> Type where
Nil : Coords []
(::) : Fin x -> Coords xs -> Coords (x :: xs)
toList : Coords xs -> List Nat
toList [] = []
toList (x::xs) = finToNat x :: toList xs
example : Coords [2, 3]
example = [1, 2]
Show (Coords xs) where
show cs = show $ toList cs
You can also try using Data.Vect.Quantifiers.All or Data.List.Quantifiers.All:
import Data.Vect
import Data.Vect.Quantifiers
example : All Fin [1, 2, 3]
example = [0, 1, 2]
-- not sure why this is isn't included with Idris
export
All (Show . p) xs => Show (All p xs) where
show pxs = "[" ++ show' "" pxs ++ "]"
where
show' : String -> All (Show . p) xs' => All p xs' -> String
show' acc #{[]} [] = acc
show' acc #{[_]} [px] = acc ++ show px
show' acc #{_ :: _} (px :: pxs) = show' (acc ++ show px ++ ", ") pxs
string : String
string = show example
Related
Faced next problem while reading great Type Driven Development book and trying to implement some small modifications of tasks in it.
module Main
import Data.Vect
%default total
data Forever = More Forever
partial
forever : Forever
forever = More forever
data StackCmd : Type -> (inputHeight : Nat) -> (outputHeight : Nat) -> Type where
Push : Integer -> StackCmd () height (S height)
Pop : StackCmd Integer (S height) height
Top : StackCmd Integer (S height) (S height)
PutStr : String -> StackCmd () h h
PutStrLn : String -> StackCmd () h h
GetStr : StackCmd String h h
Pure : a -> StackCmd a h h
(>>=) : StackCmd a h1 h2 -> (a -> StackCmd b h2 h3) -> StackCmd b h1 h3
runStack : (stck : Vect inH Integer) -> StackCmd ty inH outH -> IO (ty, Vect outH Integer)
runStack stck (Push x) = pure ((), x :: stck)
runStack (x :: xs) Pop = pure (x, xs)
runStack (x :: xs) Top = pure (x, x :: xs)
runStack xs (PutStr str) = do putStr str; pure ((), xs)
runStack xs (PutStrLn str) = do putStrLn str; pure ((), xs)
runStack xs (GetStr) = do str <- getLine; pure (str, xs)
runStack stck (Pure x) = pure (x, stck)
runStack stck (x >>= f) = do (x', stck') <- runStack stck x
runStack stck' (f x')
data StackIO : Nat -> Type where
Do : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
QuitCmd : (a : Nat) -> StackIO a
namespace StackDo
(>>=) : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
(>>=) = Do
data Input : Type where
INumber : Integer -> Input
IAdd : Input
IDuplicate : Input
IDiscard : Input
parseInput : String -> Maybe Input
parseInput str =
case str of
"" => Nothing
"add" => Just IAdd
"duplicte" => Just IDuplicate
"discard" => Just IDiscard
_ => if all isDigit $ unpack str then Just (INumber $ cast str) else Nothing
run : Forever -> Vect n Integer -> StackIO n -> IO ()
run _ _ (QuitCmd a) = pure ()
run (More far) stck (Do sa f) = do (a', stck') <- runStack stck sa
run far stck' (f a')
biOp : (Integer -> Integer -> Integer) -> StackCmd String (S (S height)) (S height)
biOp op = do a <- Pop
b <- Pop
let res = a `op` b
Push res
Pure $ show res
discardUnOp : StackCmd String (S height) height
discardUnOp = do v <- Pop
Pure $ "Discarded: " ++ show v
duplicateUnOp : StackCmd String (S height) (S (S height))
duplicateUnOp = do v <- Top
Push v
Pure $ "Duplicated: " ++ show v
mutual
tryBiOp : String -> (Integer -> Integer -> Integer) -> StackIO hin
tryBiOp _ op {hin=S (S k)} = do res <- biOp op
PutStrLn res
stackCalc
tryBiOp opName _ = do PutStrLn $
"Unable to execute operation " ++ opName ++ ": fewer then two items on stack."
stackCalc
tryUnOp : Show a => String -> StackCmd a hIn hOut -> StackIO hIn
tryUnOp _ op {hIn=S h} = do res <- op
PutStrLn $ show res
stackCalc
tryUnOp opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
stackCalc : StackIO height
stackCalc = do PutStr "> "
inp <- GetStr
case parseInput inp of
Nothing => do PutStrLn "invalid input"; stackCalc
(Just (INumber x)) => do Push x; stackCalc
(Just IAdd) => tryBiOp "add" (+)
(Just IDuplicate) => ?holedup
(Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp
partial
main : IO ()
main = run forever [] stackCalc
Code given above is mostly from TDD book. Sorry that its a bit long: it can be compiled. The code is rather straightforward: this is a stack implemented above vector. Then, user can type numbers in command prompt (one per line) and program pushes the numbers on stack. User is also able to call operations, i.e. add. add pops two elements from stack, adds them and pushes the result back on stack. So, add requires at least two numbers to be on stack when it is called.
Please take a look on tryBiOp function. It takes an Integer -> Integer -> Integer (i.e. (+) or (-)) operation as it's argument and returns sequence of StackCmd operations which implements needed action. As a result programmer can write (Just IAdd) => tryBiOp "add" (+) inside stackCalc. This is very close to what I would like to have.
Question. Next thing I would like to do is very the same wrapper (it named tryUnOp) for operations which require one element on stack. And since these operations are not on integers, but on a stack itself (i.e. "duplicate top of stack" or "discard top element") I would like to pass to wrapper the sequence of StackCmd operations instead of Integer -> Integer -> Integer. So, what I would like to gain is
(Just IDuplicate) => tryUnOp "duplicate" $
(do v <- Top
Push v
Pure $ "Duplicated: " ++ show v)
Problem. If you uncomment code in string (Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp (and remove hole), you will see that code can not be compiled. As I see problem is that when I call tryUnOp "discard" discardUnOp Idris can see that tryUnOp's hIn must be of form (S k) because it follows from discardUnOp's type. But stackCalc does not provide such guarantee.
Working solution. It works, but it is essentially the same thing for unary operation as for binary. So, it is not exactly what I would like to have. There is a function which converts name of operation to sequence of stack commands:
data UnaryOperation : Type where
UODup : UnaryOperation
UODisc : UnaryOperation
UnaryOpOutHeight : UnaryOperation -> Nat -> Nat
UnaryOpOutHeight UODup inheightBase = S (S inheightBase)
UnaryOpOutHeight UODisc inheightBase = inheightBase
unaryStackCmd : (op: UnaryOperation) -> StackCmd String (S h) (UnaryOpOutHeight op h)
unaryStackCmd UODup = duplicateUnOp
unaryStackCmd UODisc = discardUnOp
mutual
tryUnOp' : String -> UnaryOperation -> StackIO height
tryUnOp' _ op {height=S h} = do res <- unaryStackCmd op
PutStrLn res
stackCalc
tryUnOp' opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
Any ideas / comments are wellcome!!!
An example value: [[1, 2], [1]]
Here, I would know that there are 2 lists, and that the first list has length 2, while the second one has length 1. Ideally, this function would compute those types:
func : (n ** Vect n Nat) -> Type
But I don't know how to write it. I'm pretty sure it's something to do with dependent pairs, but I'm not sure how to write it.
To clarify, I know it'd be possible to simply use (n ** Vect n (p ** Vect p Double)) as the type of the example value. However, n only constrains the number of lists, not the number of their elements, because inside the list, p could be anything. I would most likely need something where the first element of the dependent pair is a vector of lengths, not just the number of lists. So something like (Vect n Nat ** Vect n (Vect m Double))--where each m is the corresponding element of the first vector.
You could define a new vector type which contains possibly differently indexed elements of an indexed type at each position:
import Prelude
import Data.Vect
-- heterogeneously indexed vector
data IVect : Vect n ix -> (ix -> Type) -> Type where
Nil : IVect Nil b
(::) : b i -> IVect is b -> IVect (i :: is) b
-- of which a special case is a vector of vectors
VVect : Vect n Nat -> Type -> Type
VVect is a = IVect is (flip Vect a)
test1 : VVect [2, 2, 2] Nat
test1 = [[1, 2], [3, 4], [5, 6]]
test2 : VVect [0, 1, 2] Bool
test2 = [[], [True], [False, True]]
Alternatively, you can define VVect using dependent pairs and map, but this is more cumbersome to use:
VVect' : Vect n Nat -> Type -> Type
VVect' {n = n} is a = (xs : Vect n (m ** Vect m a) ** (map fst xs = is))
test3 : VVect' [0, 1, 2] Bool
test3 = ([(_ ** []), (_ ** [True]), (_ ** [False, False])] ** Refl)
You have some choice though whether to use lists or vectors. With lists as the inner container, values look more compact:
VVect'' : Vect n Nat -> Type -> Type
VVect'' {n = n} is a = (xs : Vect n (List a) ** (map length xs = is))
test4 : VVect'' [0, 1, 2] Bool
test4 = ([[], [True], [False, True]] ** Refl)
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.
I defined n-dimensional vectors in Idris as follows:
import Data.Vect
NDVect : (Num t) => (rank : Nat) -> (shape : Vect rank Nat) -> (t : Type) -> Type
NDVect Z [] t = t
NDVect (S n) (x::xs) t = Vect x (NDVect n xs t)
Then I defined the following function which maps a function f to every entry in the tensor.
iterateT : (f : t -> t') -> (v : NDVect r s t) -> NDVect r s t'
iterateT {r = Z} {s = []} f v = f v
iterateT {r = S n} {s = x::xs} f v = map (iterateT f) v
But when I try to call iteratorT in the following function:
scale : Num t => (c : t) -> (v : NDVect rank shape t) -> NDVect rank shape t
scale c v = iterateT (*c) v
I get the following error message saying there is a type mismatched, which seems pretty fine to me
When checking right hand side of scale with expected type
NDVect rank shape t
When checking argument v to function Main.iterateT:
Type mismatch between
NDVect rank shape t (Type of v)
and
NDVect r s t (Expected type)
Specifically:
Type mismatch between
NDVect rank shape t
and
NDVect r s t
Specifically:
Type mismatch between
NDVect rank shape t
and
NDVect r s t
I have also been wondering how to express n-dimensional vectors (i.e. tensors) in Idris. I had a play with the type definition in the question, but encountered various issues, so I expressed the NDVect function as a data type:
data NDVect : (rank : Nat) -> (shape : Vect rank Nat) -> Type -> Type where
NDVZ : (value : t) -> NDVect Z [] t
NDV : (values : Vect n (NDVect r s t)) -> NDVect (S r) (n::s) t
And implemented map as follows:
nmap : (t -> u) -> (NDVect r s t) -> NDVect r s u
nmap f (NDVZ value) = NDVZ (f value)
nmap f (NDV values) = NDV (map (nmap f) values)
The following now works:
*Main> NDVZ 5
NDVZ 5 : NDVect 0 [] Integer
*Main> nmap (+4) (NDVZ 5)
NDVZ 9 : NDVect 0 [] Integer
*Main> NDV [NDVZ 1, NDVZ 2, NDVZ 3]
NDV [NDVZ 1, NDVZ 2, NDVZ 3] : NDVect 1 [3] Integer
*Main> nmap (+4) (NDV [NDVZ 1, NDVZ 2, NDVZ 3])
NDV [NDVZ 5, NDVZ 6, NDVZ 7] : NDVect 1 [3] Integer
Unfortunately, having all the type constructors makes things a bit ugly. I'd love to know if there's a cleaner way to solve this.
Edit:
Here's a slightly shorter type signature that doesn't explicitly encode the tensor rank in the type:
data NDVect : (shape : List Nat) -> Type -> Type where
NDVZ : (value : t) -> NDVect [] t
NDV : (values : Vect n (NDVect s t)) -> NDVect (n::s) t
nmap : (t -> u) -> (NDVect s t) -> NDVect s u
nmap f (NDVZ value) = NDVZ (f value)
nmap f (NDV values) = NDV (map (nmap f) values)
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.