forsyde-shallow-3.4.0.0: src/ForSyDe/Shallow/Core/Vector.hs
-----------------------------------------------------------------------------
-- |
-- Module : ForSyDe.Shallow.Core.Vector
-- Copyright : (c) ForSyDe Group, KTH 2007-2019
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : forsyde-dev@kth.se
-- Stability : experimental
-- Portability : portable
--
-- This module defines the data type 'Vector' and the corresponding
-- functions. It is a development of the module defined by
-- <https://ptolemy.berkeley.edu/~johnr/papers/pdf/thesis.pdf Reekie>.
-- The 'Vector' data type is a shallow interpretation of arrays and is
-- used for quick prototyping of array algorithms and skeletons,
-- whereas in fact it is implemented as an infinite list itself. For a
-- type-checked fixed-size data type for representing vectors, see
-- <http://hackage.haskell.org/package/parameterized-data FSVec> or
-- <http://hackage.haskell.org/package/repa REPA>.
--
-- __OBS:__ The lengths in the API documentation for function arguments
-- are not type-safe, but rather suggestions for usage in designing
-- vector algorithms or skeletons.
-----------------------------------------------------------------------------
module ForSyDe.Shallow.Core.Vector (
Vector (..), (<+>), (<:),
-- * Queries
nullV, lengthV,
-- * Generators
vector, fromVector, unitV,
iterateV, generateV, copyV,
-- * Functional skeletons
mapV, zipWithV, zipWith3V,
reduceV, pipeV, foldlV, foldrV,
scanlV, scanrV, -- meshlV, meshrV,
-- * Selectors
atV, headV, tailV, lastV, initV, headsV, tailsV,
takeV, dropV, selectV, groupV, filterV, stencilV,
-- * Permutators
replaceV, zipV, unzipV,
concatV, reverseV, shiftlV, shiftrV, rotrV, rotlV, rotateV
) where
-----------------------------------------------------------------------------
-- CONSTRUCTORS AND INSTANCES
-----------------------------------------------------------------------------
infixr 5 :>
infixl 5 <:
infixr 5 <+>
-- | The data type 'Vector' is modeled similar to a list. It has two data type constructors. 'NullV' constructs the empty vector, while ':>' constructsa vector by adding an value to an existing vector..
--
-- 'Vector' is an instance of the classes 'Read' and 'Show'. This means that the vector
--
-- > 1:>2:>3:>NullV
--
-- is shown as
--
-- > <1,2,3>
data Vector a = NullV
| a :> (Vector a) deriving (Eq)
instance (Show a) => Show (Vector a) where
showsPrec p NullV = showParen (p > 9) (showString "<>")
showsPrec p xs = showParen (p > 9) (showChar '<' . showVector1 xs)
where
showVector1 NullV = showChar '>'
showVector1 (y:>NullV) = shows y . showChar '>'
showVector1 (y:>ys) = shows y . showChar ','
. showVector1 ys
instance Read a => Read (Vector a) where
readsPrec _ s = readsVector s
readsVector :: (Read a) => ReadS (Vector a)
readsVector s = [((x:>NullV), rest) | ("<", r2) <- lex s,
(x, r3) <- reads r2,
(">", rest) <- lex r3]
++
[(NullV, r4) | ("<", r5) <- lex s,
(">", r4) <- lex r5]
++
[((x:>xs), r6) | ("<", r7) <- lex s,
(x, r8) <- reads r7,
(",", r9) <- lex r8,
(xs, r6) <- readsValues r9]
readsValues :: (Read a) => ReadS (Vector a)
readsValues s = [((x:>NullV), r1) | (x, r2) <- reads s,
(">", r1) <- lex r2]
++
[((x:>xs), r3) | (x, r4) <- reads s,
(",", r5) <- lex r4,
(xs, r3) <- readsValues r5]
-- | The operator '(<:)' appends an element at the end of a vector.
(<:) :: Vector a -- ^ /length/ = @la@
-> a
-> Vector a -- ^ /length/ = @la + 1@
xs <: x = xs <+> unitV x
-- | The operator '<+>' concatenates two vectors.
(<+>) :: Vector a -- ^ /length/ = @la@
-> Vector a -- ^ /length/ = @lb@
-> Vector a -- ^ /length/ = @la + lb@
NullV <+> ys = ys
(x:>xs) <+> ys = x :> (xs <+> ys)
-----------------------------------------------------------------------------
-- GENERATORS
-----------------------------------------------------------------------------
-- | The function 'vector' converts a list into a vector.
vector :: [a] -> Vector a
vector [] = NullV
vector (x:xs) = x :> (vector xs)
-- | The function 'fromVector' converts a vector into a list.
fromVector :: Vector a -> [a]
fromVector NullV = []
fromVector (x:>xs) = x : fromVector xs
-- | The function 'unitV' creates a vector with one element.
unitV :: a -> Vector a -- ^ /length/ = @1@
unitV x = x :> NullV
-- | The function 'iterateV' generates a vector with a given number of
-- elements starting from an initial element using a supplied function
-- for the generation of elements.
--
-- >>> iterateV 5 (+1) 1
-- <1,2,3,4,5>
iterateV :: (Num a, Eq a)
=> a -- ^ number of elements = @n@
-> (b -> b) -- ^ generator function (@last_element -> next_element@)
-> b -- ^ initial element
-> Vector b -- ^ generated vector; /length/ = @n@
iterateV 0 _ _ = NullV
iterateV n f a = a :> iterateV (n-1) f (f a)
-- | The function 'generateV' behaves in the same way as 'iterateV',
-- but starts with the application of the supplied function to the
-- supplied value.
--
-- >>> generateV 5 (+1) 1
-- <2,3,4,5,6>
generateV :: (Num a, Eq a)
=> a -- ^ number of elements = @n@
-> (b -> b) -- ^ generator function (@last_element -> next_element@)
-> b -- ^ initial element
-> Vector b -- ^ generated vector; /length/ = @n@
generateV 0 _ _ = NullV
generateV n f a = x :> generateV (n-1) f x
where x = f a
-- | The function 'copyV' generates a vector with a given number of
-- copies of the same element.
--
-- >>> copyV 7 5
-- <5,5,5,5,5,5,5>
copyV :: (Num a, Eq a)
=> a -- ^ number of elements = @n@
-> b -- ^ element to be copied
-> Vector b -- ^ /length/ = @n@
copyV k x = iterateV k id x
-----------------------------------------------------------------------------
-- QUERIES
-----------------------------------------------------------------------------
-- | The function 'nullV' returns 'True' if a vector is empty.
nullV :: Vector a -> Bool
nullV NullV = True
nullV _ = False
-- | The function 'lengthV' returns the number of elements in a value.
lengthV :: Vector a -> Int
lengthV NullV = 0
lengthV (_:>xs) = 1 + lengthV xs
-----------------------------------------------------------------------------
-- HIGHER ORDER SKELETONS
-----------------------------------------------------------------------------
-- | The higher-order function 'mapV' applies a function on all elements of a vector.
mapV :: (a -> b)
-> Vector a -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @la@
mapV f (x:>xs) = f x :> mapV f xs
mapV _ NullV = NullV
-- | The higher-order function 'zipWithV' applies a function pairwise on two vectors.
zipWithV :: (a -> b -> c)
-> Vector a -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @lb@
-> Vector c -- ^ /length/ = @minimum [la,lb]@
zipWithV f (x:>xs) (y:>ys) = f x y :> (zipWithV f xs ys)
zipWithV _ _ _ = NullV
-- | The higher-order function 'zipWithV3' applies a function 3-tuple-wise on three vectors.
zipWith3V :: (a -> b -> c -> d)
-> Vector a -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @lb@
-> Vector c -- ^ /length/ = @lc@
-> Vector d -- ^ /length/ = @minimum [la,lb,lc]@
zipWith3V f (x:>xs) (y:>ys) (z:>zs) = f x y z :> (zipWith3V f xs ys zs)
zipWith3V _ _ _ _ = NullV
-- | The higher-order functions 'foldlV' folds a function from the
-- right to the left over a vector using an initial value.
--
-- >>> foldlV (-) 8 $ vector [4,2,1] -- is the same as (((8 - 4) - 2) - 1)
-- 1
foldlV :: (a -> b -> a) -> a -> Vector b -> a
foldlV _ a NullV = a
foldlV f a (x:>xs) = foldlV f (f a x) xs
-- | The higher-order functions 'foldrV' folds a function from the
-- left to the right over a vector using an initial value.
--
-- >>> foldrV (-) 8 $ vector [4,2,1] -- is the same as (4 - (2 - (1 - 8)))
-- -5
foldrV :: (b -> a -> a) -> a -> Vector b -> a
foldrV _ a NullV = a
foldrV f a (x:>xs) = f x (foldrV f a xs)
-- | Reduces a vector of elements to a single element based on a
-- binary function.
--
-- >>> reduceV (+) $ vector [1,2,3,4,5]
-- 15
reduceV :: (a -> a -> a) -> Vector a -> a
reduceV _ NullV = error "Cannot reduce a null vector"
reduceV _ (x:>NullV) = x
reduceV f (x:>xs) = foldlV f x xs
-- | Pipes an element through a vector of functions.
--
-- >>> vector [(*2), (+1), (/3)] `pipeV` 3 -- is the same as ((*2) . (+1) . (/3)) 3
-- 4.0
pipeV :: Vector (a -> a) -> a -> a
pipeV vf = foldrV (.) id vf
-----------------------------------------------------------------------------
-- SELECTORS
-----------------------------------------------------------------------------
-- | The function 'atV' returns the n-th element in a vector, starting
-- from zero.
--
-- >>> vector [1,2,3,4,5] `atV` 3
-- 4
atV :: (Integral a) => Vector b -> a -> b
NullV `atV` _ = error "atV: Vector has not enough elements"
(x:>_) `atV` 0 = x
(_:>xs) `atV` n = xs `atV` (n-1)
-- | The functions 'headV' returns the first element of a vector.
headV :: Vector a -> a
headV NullV = error "headV: Vector is empty"
headV (v:>_) = v
-- | The function 'lastV' returns the last element of a vector.
lastV :: Vector a -> a
lastV NullV = error "lastV: Vector is empty"
lastV (v:>NullV) = v
lastV (_:>vs) = lastV vs
-- | The functions 'tailV' returns all, but the first element of a vector.
tailV :: Vector a -- ^ /length/ = @la@
-> Vector a -- ^ /length/ = @la-1@
tailV NullV = error "tailV: Vector is empty"
tailV (_:>vs) = vs
-- | The function 'initV' returns all but the last elements of a vector.
initV :: Vector a -- ^ /length/ = @la@
-> Vector a -- ^ /length/ = @la-1@
initV NullV = error "initV: Vector is empty"
initV (_:>NullV) = NullV
initV (v:>vs) = v :> initV vs
-- | The function 'takeV' returns the first @n@ elements of a vector.
--
-- >>> takeV 2 $ vector [1,2,3,4,5]
-- <1,2>
takeV :: (Num a, Ord a)
=> a -- ^ @= n@
-> Vector b -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @minimum [n,la]@
takeV 0 _ = NullV
takeV _ NullV = NullV
takeV n (v:>vs) | n <= 0 = NullV
| otherwise = v :> takeV (n-1) vs
-- | The function 'dropV' drops the first @n@ elements of a vector.
--
-- >>> dropV 2 $ vector [1,2,3,4,5]
-- <3,4,5>
dropV :: (Num a, Ord a)
=> a -- ^ @= n@
-> Vector b -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @maximum [0,la-n]@
dropV 0 vs = vs
dropV _ NullV = NullV
dropV n (v:>vs) | n <= 0 = v :> vs
| otherwise = dropV (n-1) vs
-- | The function 'selectV' selects elements in the vector based on a
-- regular stride.
selectV :: Int -- ^ the initial element, starting from zero
-> Int -- ^ stepsize between elements
-> Int -- ^ number of elements @= n@
-> Vector a -- ^ /length/ = @la@
-> Vector a -- ^ /length/ @= n@
selectV f s n vs
| n <= 0 = NullV
| (f+s*n-1) > lengthV vs = error "selectV: Vector has not enough elements"
| otherwise = atV vs f :> selectV (f+s) s (n-1) vs
-- | The function 'groupV' groups a vector into a vector of vectors of
-- size n.
--
-- >>> groupV 3 $ vector [1,2,3,4,5,6,7,8]
-- <<1,2,3>,<4,5,6>>
groupV :: Int -- ^ @= n@
-> Vector a -- ^ /length/ = @la@
-> Vector (Vector a) -- ^ /length/ = @la `div` n@
groupV n v
| lengthV v < n = NullV
| otherwise = selectV 0 1 n v
:> groupV n (selectV n 1 (lengthV v-n) v)
-- | The higher-function 'filterV' takes a predicate function and a
-- vector and creates a new vector with the elements for which the
-- predicate is true.
--
-- >>> filterV odd $ vector [1,2,3,4,5,6,7,8]
-- <1,3,5,7>
--
-- (*) however, the length is __unknown__, because it is dependent on
-- the data contained inside the vector. Try avoiding 'filterV' in
-- designs where the size of the data is crucial.
filterV :: (a -> Bool) -- ^ predicate function
-> Vector a -- ^ /length/ = @la@
-> Vector a -- ^ /length/ @<= la@ (*)
filterV _ NullV = NullV
filterV p (v:>vs) = if (p v)
then v :> filterV p vs
else filterV p vs
-- | Returns a vector containing all the possible prefixes of an input
-- vector.
--
-- >>> let v = vector [1,2,3,4,5,6]
-- >>> headsV v
-- <<1>,<1,2>,<1,2,3>,<1,2,3,4>,<1,2,3,4,5>,<1,2,3,4,5,6>,<1,2,3,4,5,6>>
headsV :: Vector a -- ^ /length/ = @la@
-> Vector (Vector a) -- ^ /length/ = @la + 1@
headsV NullV = error "heads: null vector"
headsV v = foldrV sel (unitV NullV) $ mapV (unitV . unitV) v
where sel x y = x <+> mapV (lastV x <+>) y
-- | Returns a vector containing all the possible suffixes of an input
-- vector.
--
-- >>> let v = vector [1,2,3,4,5,6]
-- >>> tailsV v
-- <<1,2,3,4,5,6>,<2,3,4,5,6>,<3,4,5,6>,<4,5,6>,<5,6>,<6>,<>>
tailsV :: Vector a -- ^ /length/ = @la@
-> Vector (Vector a) -- ^ /length/ = @la + 1@
tailsV NullV = NullV
tailsV v = foldrV sel (unitV NullV) $ mapV (unitV . unitV) v
where sel x y = mapV (<+> headV y) x <+> y
-- | Returns a stencil of @n@ neighboring elements for each possible
-- element in a vector.
--
-- >>> stencilV 3 $ vector [1..5]
-- <<1,2,3>,<2,3,4>,<3,4,5>>
stencilV :: Int -- ^ stencil size @= n@
-> Vector a -- ^ /length/ = @la@
-> Vector (Vector a) -- ^ /length/ = @la - n + 1@
stencilV n v = mapV (takeV n) $ dropFromEnd n $ tailsV v
where dropFromEnd n = takeV (lengthV v - n + 1)
-----------------------------------------------------------------------------
-- PERMUTATORS
-----------------------------------------------------------------------------
-- | The function 'replaceV' replaces an element in a vector.
--
-- >>> replaceV (vector [1..5]) 2 100
-- <1,2,100,4,5>
replaceV :: Vector a -- ^ input vector; /length/ = @la@
-> Int -- ^ position of the element to be replaced
-> a -- ^ new element
-> Vector a -- ^ altered vector; /length/ = @la@
replaceV vs n x
| n <= lengthV vs && n >= 0 = takeV n vs <+> unitV x
<+> dropV (n+1) vs
| otherwise = vs
-- | The function 'zipV' zips two vectors into a vector of tuples.
zipV :: Vector a -- ^ /length/ = @la@
-> Vector b -- ^ /length/ = @lb@
-> Vector (a, b) -- ^ /length/ = @minimum [la,lb]@
zipV (x:>xs) (y:>ys) = (x, y) :> zipV xs ys
zipV _ _ = NullV
-- | The function 'unzipV' unzips a vector of tuples into two vectors.
unzipV :: Vector (a, b) -- ^ /length/ = @la@
-> (Vector a, Vector b) -- ^ /length/ = @la@
unzipV NullV = (NullV, NullV)
unzipV ((x, y) :> xys) = (x:>xs, y:>ys)
where (xs, ys) = unzipV xys
-- | The function 'shiftlV' shifts a value from the left into a vector.
--
-- >>> vector [1..5] `shiftlV` 100
-- <100,1,2,3,4>
shiftlV :: Vector a -> a -> Vector a
shiftlV vs v = v :> initV vs
-- | The function 'shiftrV' shifts a value from the right into a vector.
--
-- >>> vector [1..5] `shiftrV` 100
-- <2,3,4,5,100>
shiftrV :: Vector a -> a -> Vector a
shiftrV vs v = tailV vs <: v
-- | The function 'rotlV' rotates a vector to the left. Note that this
-- fuctions does not change the size of a vector.
--
-- >>> rotlV $ vector [1..5]
-- <5,1,2,3,4>
rotlV :: Vector a -> Vector a
rotrV NullV = NullV
rotrV vs = tailV vs <: headV vs
-- | The function 'rotrV' rotates a vector to the right. Note that
-- this fuction does not change the size of a vector.
--
-- >>> rotrV $ vector [1..5]
-- <2,3,4,5,1>
rotrV :: Vector a -> Vector a
rotlV NullV = NullV
rotlV vs = lastV vs :> initV vs
-- | The function 'rotateV' rotates a vector based on an index offset.
--
-- * @(> 0)@ : rotates the vector left with the corresponding number
-- of positions.
--
-- * @(= 0)@ : does not modify the vector.
--
-- * @(< 0)@ : rotates the vector right with the corresponding number
-- of positions.
rotateV :: Int -> Vector a -> Vector a
rotateV n
| n > 0 = pipeV (copyV (abs n) rotlV)
| n < 0 = pipeV (copyV (abs n) rotrV)
| otherwise = id
-- | The function 'concatV' transforms a vector of vectors to a single vector.
concatV :: Vector (Vector a) -> Vector a
concatV = foldrV (<+>) NullV
-- | The function 'reverseV' reverses the order of elements in a vector.
reverseV :: Vector a -> Vector a
reverseV NullV = NullV
reverseV (v:>vs) = reverseV vs <: v
-- | Performs the parallel prefix operation on a vector.
--
-- >>> scanlV (+) 0 $ vector [1,1,1,1,1,1]
-- <1,2,3,4,5,6>
scanlV :: (a -> b -> a) -- ^ funtion to generate next element
-> a -- ^ initial element
-> Vector b -- ^ input vector; /length/ = @l@
-> Vector a -- ^ output vector; /length/ = @l@
scanlV _ _ NullV = NullV
scanlV f a (x:>xs) = q :> scanlV f q xs
where q = f a x
-- | Performs the parallel suffix operation on a vector.
--
-- >>> scanrV (+) 0 $ vector [1,1,1,1,1,1]
-- <6,5,4,3,2,1>
scanrV :: (b -> a -> a) -- ^ funtion to generate next element
-> a -- ^ initial element
-> Vector b -- ^ input vector; /length/ = @l@
-> Vector a -- ^ output vector; /length/ = @l@
scanrV _ _ NullV = NullV
scanrV f a (x:>NullV) = f x a :> NullV
scanrV f a (x:>xs) = f x y :> ys
where ys@(y:>_) = scanrV f a xs
{-
-- | The function 'serialV' can be used to construct a serial network of processes.
--|The function \haskell{serialV} and \haskell{parallelV} can be used to construct serial and parallel networks of processes.
\begin{code}
serialV :: Vector (a -> a) -> a -> a
parallelV :: Vector (a -> b) -> Vector a -> Vector b
\end{code}
The functions \haskell{scanlV} and \haskell{scanrV} "scan" a function through a vector. The functions take an initial element apply a functions recursively first on the element and then on the result of the function application.
%
\begin{code}
scanlV :: (a -> b -> a) -> a -> Vector b -> Vector a
scanrV :: (b -> a -> a) -> a -> Vector b -> Vector a
\end{code}
\index{scanlV@\haskell{scanlV}}
\index{scanrV@\haskell{scanrV}}
Reekie also proposed the \haskell{meshlV} and \haskell{meshrV} iterators. They are like a combination of \haskell{mapV} and \haskell{scanlV} or \haskell{scanrV}. The argument function supplies a pair of values: the first is input into the next application of this function, and the second is the output value. As an example consider the expression:
%
\begin{code}
f x y = (x+y, x+y)
s1 = vector [1,2,3,4,5]
\end{code}
%
Here \haskell{meshlV} can be used to calculate the running sum.
%
\begin{verbatim}
Vector> meshlV f 0 s1
(15,<1,3,6,10,15>)
\end{verbatim}
\begin{code}
meshlV :: (a -> b -> (a, c)) -> a -> Vector b -> (a, Vector c)
meshrV :: (a -> b -> (c, b)) -> b -> Vector a -> (Vector c, b)
\end{code}
\index{meshlV@\haskell{meshlV}}
\index{meshrV@\haskell{meshrV}}
-}
{-
serialV fs x = serialV' (reverseV fs ) x
where
serialV' NullV x = x
serialV' (f:>fs) x = serialV fs (f x)
parallelV NullV NullV = NullV
parallelV _ NullV
= error "parallelV: Vectors have not the same size!"
parallelV NullV _
= error "parallelV: Vectors have not the same size!"
parallelV (f:>fs) (x:>xs) = f x :> parallelV fs xs
meshlV _ a NullV = (a, NullV)
meshlV f a (x:>xs) = (a'', y:>ys)
where (a', y) = f a x
(a'', ys) = meshlV f a' xs
meshrV _ a NullV = (NullV, a)
meshrV f a (x:>xs) = (y:>ys, a'')
where (y, a'') = f x a'
(ys, a') = meshrV f a xs
-}