-----------------------------------------------------------------------------
-- |
-- 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 (Vector a -> Vector a -> Bool
(Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool) -> Eq (Vector a)
forall a. Eq a => Vector a -> Vector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector a -> Vector a -> Bool
$c/= :: forall a. Eq a => Vector a -> Vector a -> Bool
== :: Vector a -> Vector a -> Bool
$c== :: forall a. Eq a => Vector a -> Vector a -> Bool
Eq)

instance (Show a) => Show (Vector a) where
  showsPrec :: Int -> Vector a -> ShowS
showsPrec Int
p Vector a
NullV = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (String -> ShowS
showString String
"<>")
  showsPrec Int
p Vector a
xs    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Char -> ShowS
showChar Char
'<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> ShowS
forall a. Show a => Vector a -> ShowS
showVector1 Vector a
xs)
    where
      showVector1 :: Vector a -> ShowS
showVector1 Vector a
NullV = Char -> ShowS
showChar Char
'>'            
      showVector1 (a
y:>Vector a
NullV) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'
      showVector1 (a
y:>Vector a
ys) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' 
                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> ShowS
showVector1 Vector a
ys

instance Read a => Read (Vector a) where
   readsPrec :: Int -> ReadS (Vector a)
readsPrec Int
_ String
s = ReadS (Vector a)
forall a. Read a => ReadS (Vector a)
readsVector String
s

readsVector :: (Read a) => ReadS (Vector a)
readsVector :: ReadS (Vector a)
readsVector String
s = [((a
xa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
forall a. Vector a
NullV), String
rest) | (String
"<", String
r2) <- ReadS String
lex String
s,
            (a
x, String
r3)   <- ReadS a
forall a. Read a => ReadS a
reads String
r2,
            (String
">", String
rest) <- ReadS String
lex String
r3]
       [(Vector a, String)]
-> [(Vector a, String)] -> [(Vector a, String)]
forall a. [a] -> [a] -> [a]
++
      [(Vector a
forall a. Vector a
NullV, String
r4)    | (String
"<", String
r5) <- ReadS String
lex String
s,
            (String
">", String
r4) <- ReadS String
lex String
r5]
       [(Vector a, String)]
-> [(Vector a, String)] -> [(Vector a, String)]
forall a. [a] -> [a] -> [a]
++
      [((a
xa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
xs), String
r6)  | (String
"<", String
r7) <- ReadS String
lex String
s,
            (a
x, String
r8)   <- ReadS a
forall a. Read a => ReadS a
reads String
r7,
            (String
",", String
r9) <- ReadS String
lex String
r8,
            (Vector a
xs, String
r6) <- ReadS (Vector a)
forall a. Read a => ReadS (Vector a)
readsValues String
r9]

readsValues :: (Read a) => ReadS (Vector a)
readsValues :: ReadS (Vector a)
readsValues String
s = [((a
xa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
forall a. Vector a
NullV), String
r1) | (a
x, String
r2)   <- ReadS a
forall a. Read a => ReadS a
reads String
s,
              (String
">", String
r1) <- ReadS String
lex String
r2]
      [(Vector a, String)]
-> [(Vector a, String)] -> [(Vector a, String)]
forall a. [a] -> [a] -> [a]
++
      [((a
xa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
xs), String
r3)    | (a
x, String
r4)   <- ReadS a
forall a. Read a => ReadS a
reads String
s,
              (String
",", String
r5) <- ReadS String
lex String
r4,
              (Vector a
xs, String
r3)  <- ReadS (Vector a)
forall a. Read a => ReadS (Vector a)
readsValues String
r5]

-- | The operator '(<:)' appends an element at the end of a vector.
(<:)  :: Vector a  -- ^ /length/ = @la@
      -> a
      -> Vector a  -- ^ /length/ = @la + 1@
Vector a
xs <: :: Vector a -> a -> Vector a
<: a
x = Vector a
xs Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> a -> Vector a
forall a. a -> Vector a
unitV a
x     

-- | The operator '<+>' concatenates two vectors.
(<+>) :: Vector a  -- ^ /length/ = @la@
      -> Vector a  -- ^ /length/ = @lb@
      -> Vector a  -- ^ /length/ = @la + lb@
Vector a
NullV <+> :: Vector a -> Vector a -> Vector a
<+> Vector a
ys   = Vector a
ys
(a
x:>Vector a
xs) <+> Vector a
ys = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> (Vector a
xs Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> Vector a
ys) 

-----------------------------------------------------------------------------
-- GENERATORS
-----------------------------------------------------------------------------

-- | The function 'vector' converts a list into a vector.
vector        :: [a] -> Vector a
vector :: [a] -> Vector a
vector []     = Vector a
forall a. Vector a
NullV
vector (a
x:[a]
xs) = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> ([a] -> Vector a
forall a. [a] -> Vector a
vector [a]
xs)

-- | The function 'fromVector' converts a vector into a list.
fromVector         :: Vector a -> [a]
fromVector :: Vector a -> [a]
fromVector Vector a
NullV   = []
fromVector (a
x:>Vector a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Vector a -> [a]
forall a. Vector a -> [a]
fromVector Vector a
xs

-- | The function 'unitV' creates a vector with one element. 
unitV   :: a -> Vector a  -- ^ /length/ = @1@
unitV :: a -> Vector a
unitV a
x = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a
forall a. Vector a
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 :: a -> (b -> b) -> b -> Vector b
iterateV a
0 b -> b
_ b
_ = Vector b
forall a. Vector a
NullV
iterateV a
n b -> b
f b
a = b
a b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> a -> (b -> b) -> b -> Vector b
forall a b. (Num a, Eq a) => a -> (b -> b) -> b -> Vector b
iterateV (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) b -> b
f (b -> b
f b
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 :: a -> (b -> b) -> b -> Vector b
generateV a
0 b -> b
_ b
_ = Vector b
forall a. Vector a
NullV
generateV a
n b -> b
f b
a = b
x b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> a -> (b -> b) -> b -> Vector b
forall a b. (Num a, Eq a) => a -> (b -> b) -> b -> Vector b
generateV (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) b -> b
f b
x 
        where x :: b
x = b -> b
f b
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 :: a -> b -> Vector b
copyV a
k b
x = a -> (b -> b) -> b -> Vector b
forall a b. (Num a, Eq a) => a -> (b -> b) -> b -> Vector b
iterateV a
k b -> b
forall a. a -> a
id b
x 

-----------------------------------------------------------------------------
-- QUERIES
-----------------------------------------------------------------------------

-- | The function 'nullV' returns 'True' if a vector is empty. 
nullV       :: Vector a -> Bool
nullV :: Vector a -> Bool
nullV Vector a
NullV = Bool
True
nullV Vector a
_     = Bool
False

-- | The function 'lengthV' returns the number of elements in a value. 
lengthV         :: Vector a -> Int
lengthV :: Vector a -> Int
lengthV Vector a
NullV   = Int
0
lengthV (a
_:>Vector a
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
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 :: (a -> b) -> Vector a -> Vector b
mapV a -> b
f (a
x:>Vector a
xs) = a -> b
f a
x b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> (a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
mapV a -> b
f Vector a
xs
mapV a -> b
_ Vector a
NullV   = Vector b
forall a. Vector a
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 :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWithV a -> b -> c
f (a
x:>Vector a
xs) (b
y:>Vector b
ys) = a -> b -> c
f a
x b
y c -> Vector c -> Vector c
forall a. a -> Vector a -> Vector a
:> ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWithV a -> b -> c
f Vector a
xs Vector b
ys)
zipWithV a -> b -> c
_ Vector a
_ Vector b
_ = Vector c
forall a. Vector a
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 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3V a -> b -> c -> d
f (a
x:>Vector a
xs) (b
y:>Vector b
ys) (c
z:>Vector c
zs) = a -> b -> c -> d
f a
x b
y c
z d -> Vector d -> Vector d
forall a. a -> Vector a -> Vector a
:> ((a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3V a -> b -> c -> d
f Vector a
xs Vector b
ys Vector c
zs)
zipWith3V a -> b -> c -> d
_ Vector a
_ Vector b
_ Vector c
_ = Vector d
forall a. Vector a
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 -> b -> a) -> a -> Vector b -> a
foldlV a -> b -> a
_ a
a Vector b
NullV   = a
a
foldlV a -> b -> a
f a
a (b
x:>Vector b
xs) = (a -> b -> a) -> a -> Vector b -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
foldlV a -> b -> a
f (a -> b -> a
f a
a b
x) Vector b
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 :: (b -> a -> a) -> a -> Vector b -> a
foldrV b -> a -> a
_ a
a Vector b
NullV   = a
a 
foldrV b -> a -> a
f a
a (b
x:>Vector b
xs) = b -> a -> a
f b
x ((b -> a -> a) -> a -> Vector b -> a
forall b a. (b -> a -> a) -> a -> Vector b -> a
foldrV b -> a -> a
f a
a Vector b
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 :: (a -> a -> a) -> Vector a -> a
reduceV a -> a -> a
_ Vector a
NullV      = String -> a
forall a. HasCallStack => String -> a
error String
"Cannot reduce a null vector"
reduceV a -> a -> a
_ (a
x:>Vector a
NullV) = a
x
reduceV a -> a -> a
f (a
x:>Vector a
xs)    = (a -> a -> a) -> a -> Vector a -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
foldlV a -> a -> a
f a
x Vector a
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 :: Vector (a -> a) -> a -> a
pipeV Vector (a -> a)
vf = ((a -> a) -> (a -> a) -> a -> a)
-> (a -> a) -> Vector (a -> a) -> a -> a
forall b a. (b -> a -> a) -> a -> Vector b -> a
foldrV (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> a
forall a. a -> a
id Vector (a -> a)
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
Vector b
NullV   atV :: Vector b -> a -> b
`atV` a
_ = String -> b
forall a. HasCallStack => String -> a
error String
"atV: Vector has not enough elements"
(b
x:>Vector b
_)  `atV` a
0 = b
x
(b
_:>Vector b
xs) `atV` a
n = Vector b
xs Vector b -> a -> b
forall a b. Integral a => Vector b -> a -> b
`atV` (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1)

-- | The functions 'headV' returns the first element of a vector.
headV :: Vector a -> a
headV :: Vector a -> a
headV Vector a
NullV   = String -> a
forall a. HasCallStack => String -> a
error String
"headV: Vector is empty"
headV (a
v:>Vector a
_) = a
v

-- | The function 'lastV' returns the last element of a vector.
lastV :: Vector a -> a
lastV :: Vector a -> a
lastV Vector a
NullV  = String -> a
forall a. HasCallStack => String -> a
error String
"lastV: Vector is empty"
lastV (a
v:>Vector a
NullV) = a
v
lastV (a
_:>Vector a
vs)    = Vector a -> a
forall a. Vector a -> a
lastV Vector a
vs

-- | The functions 'tailV' returns all, but the first element of a vector.
tailV :: Vector a  -- ^ /length/ = @la@
      -> Vector a  -- ^ /length/ = @la-1@
tailV :: Vector a -> Vector a
tailV Vector a
NullV   = String -> Vector a
forall a. HasCallStack => String -> a
error String
"tailV: Vector is empty"
tailV (a
_:>Vector a
vs) = Vector a
vs

-- | The function 'initV' returns all but the last elements of a vector.
initV :: Vector a  -- ^ /length/ = @la@
      -> Vector a  -- ^ /length/ = @la-1@
initV :: Vector a -> Vector a
initV Vector a
NullV  = String -> Vector a
forall a. HasCallStack => String -> a
error String
"initV: Vector is empty"
initV (a
_:>Vector a
NullV) = Vector a
forall a. Vector a
NullV
initV (a
v:>Vector a
vs)    = a
v a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a -> Vector a
forall a. Vector a -> Vector a
initV Vector a
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 :: a -> Vector b -> Vector b
takeV a
0 Vector b
_       = Vector b
forall a. Vector a
NullV
takeV a
_ Vector b
NullV       = Vector b
forall a. Vector a
NullV
takeV a
n (b
v:>Vector b
vs) | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = Vector b
forall a. Vector a
NullV
                | Bool
otherwise = b
v b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> a -> Vector b -> Vector b
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
takeV (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) Vector b
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 :: a -> Vector b -> Vector b
dropV a
0 Vector b
vs      = Vector b
vs
dropV a
_ Vector b
NullV       = Vector b
forall a. Vector a
NullV
dropV a
n (b
v:>Vector b
vs) | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = b
v b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> Vector b
vs
                | Bool
otherwise = a -> Vector b -> Vector b
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
dropV (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) Vector b
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 :: Int -> Int -> Int -> Vector a -> Vector a
selectV Int
f Int
s Int
n Vector a
vs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 = Vector a
forall a. Vector a
NullV
  | (Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
vs = String -> Vector a
forall a. HasCallStack => String -> a
error String
"selectV: Vector has not enough elements"
  | Bool
otherwise              = Vector a -> Int -> a
forall a b. Integral a => Vector b -> a -> b
atV Vector a
vs Int
f a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Int -> Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Int -> Vector a -> Vector a
selectV (Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) Int
s (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Vector a
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 :: Int -> Vector a -> Vector (Vector a)
groupV Int
n Vector a
v 
  | Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Vector (Vector a)
forall a. Vector a
NullV
  | Bool
otherwise     = Int -> Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Int -> Vector a -> Vector a
selectV Int
0 Int
1 Int
n Vector a
v 
                    Vector a -> Vector (Vector a) -> Vector (Vector a)
forall a. a -> Vector a -> Vector a
:> Int -> Vector a -> Vector (Vector a)
forall a. Int -> Vector a -> Vector (Vector a)
groupV Int
n (Int -> Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Int -> Vector a -> Vector a
selectV Int
n Int
1 (Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
vInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Vector a
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 :: (a -> Bool) -> Vector a -> Vector a
filterV a -> Bool
_ Vector a
NullV   = Vector a
forall a. Vector a
NullV
filterV a -> Bool
p (a
v:>Vector a
vs) = if (a -> Bool
p a
v)
                    then a
v a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
filterV a -> Bool
p Vector a
vs
                    else (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
filterV a -> Bool
p Vector a
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 :: Vector a -> Vector (Vector a)
headsV Vector a
NullV  = String -> Vector (Vector a)
forall a. HasCallStack => String -> a
error String
"heads: null vector"
headsV Vector a
v      = (Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a))
-> Vector (Vector a)
-> Vector (Vector (Vector a))
-> Vector (Vector a)
forall b a. (b -> a -> a) -> a -> Vector b -> a
foldrV Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a.
Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
sel (Vector a -> Vector (Vector a)
forall a. a -> Vector a
unitV Vector a
forall a. Vector a
NullV) (Vector (Vector (Vector a)) -> Vector (Vector a))
-> Vector (Vector (Vector a)) -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ (a -> Vector (Vector a)) -> Vector a -> Vector (Vector (Vector a))
forall a b. (a -> b) -> Vector a -> Vector b
mapV (Vector a -> Vector (Vector a)
forall a. a -> Vector a
unitV (Vector a -> Vector (Vector a))
-> (a -> Vector a) -> a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
forall a. a -> Vector a
unitV) Vector a
v
  where sel :: Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
sel Vector (Vector a)
x Vector (Vector a)
y = Vector (Vector a)
x Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a. Vector a -> Vector a -> Vector a
<+> (Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> Vector a -> Vector b
mapV (Vector (Vector a) -> Vector a
forall a. Vector a -> a
lastV  Vector (Vector a)
x Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+>) Vector (Vector a)
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 :: Vector a -> Vector (Vector a)
tailsV Vector a
NullV = Vector (Vector a)
forall a. Vector a
NullV
tailsV Vector a
v    = (Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a))
-> Vector (Vector a)
-> Vector (Vector (Vector a))
-> Vector (Vector a)
forall b a. (b -> a -> a) -> a -> Vector b -> a
foldrV Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a.
Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
sel (Vector a -> Vector (Vector a)
forall a. a -> Vector a
unitV Vector a
forall a. Vector a
NullV) (Vector (Vector (Vector a)) -> Vector (Vector a))
-> Vector (Vector (Vector a)) -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ (a -> Vector (Vector a)) -> Vector a -> Vector (Vector (Vector a))
forall a b. (a -> b) -> Vector a -> Vector b
mapV (Vector a -> Vector (Vector a)
forall a. a -> Vector a
unitV (Vector a -> Vector (Vector a))
-> (a -> Vector a) -> a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
forall a. a -> Vector a
unitV) Vector a
v
  where sel :: Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
sel Vector (Vector a)
x Vector (Vector a)
y = (Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> Vector a -> Vector b
mapV (Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> Vector (Vector a) -> Vector a
forall a. Vector a -> a
headV Vector (Vector a)
y) Vector (Vector a)
x Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a. Vector a -> Vector a -> Vector a
<+> Vector (Vector a)
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 :: Int -> Vector a -> Vector (Vector a)
stencilV Int
n Vector a
v = (Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> Vector a -> Vector b
mapV (Int -> Vector a -> Vector a
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
takeV Int
n) (Vector (Vector a) -> Vector (Vector a))
-> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Vector a) -> Vector (Vector a)
forall b. Int -> Vector b -> Vector b
dropFromEnd Int
n (Vector (Vector a) -> Vector (Vector a))
-> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector (Vector a)
forall a. Vector a -> Vector (Vector a)
tailsV Vector a
v
  where dropFromEnd :: Int -> Vector b -> Vector b
dropFromEnd Int
n = Int -> Vector b -> Vector b
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
takeV (Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Vector a -> Int -> a -> Vector a
replaceV Vector a
vs Int
n a
x 
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector a -> Int
forall a. Vector a -> Int
lengthV Vector a
vs Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Vector a -> Vector a
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
takeV Int
n Vector a
vs Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> a -> Vector a
forall a. a -> Vector a
unitV a
x 
                                  Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> Int -> Vector a -> Vector a
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
dropV (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector a
vs
    | Bool
otherwise                 = Vector a
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 :: Vector a -> Vector b -> Vector (a, b)
zipV (a
x:>Vector a
xs) (b
y:>Vector b
ys) = (a
x, b
y) (a, b) -> Vector (a, b) -> Vector (a, b)
forall a. a -> Vector a -> Vector a
:> Vector a -> Vector b -> Vector (a, b)
forall a b. Vector a -> Vector b -> Vector (a, b)
zipV Vector a
xs Vector b
ys
zipV Vector a
_   Vector b
_   = Vector (a, b)
forall a. Vector a
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 :: Vector (a, b) -> (Vector a, Vector b)
unzipV Vector (a, b)
NullV           = (Vector a
forall a. Vector a
NullV, Vector b
forall a. Vector a
NullV)
unzipV ((a
x, b
y) :> Vector (a, b)
xys) = (a
xa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
xs, b
yb -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:>Vector b
ys) 
  where (Vector a
xs, Vector b
ys) = Vector (a, b) -> (Vector a, Vector b)
forall a b. Vector (a, b) -> (Vector a, Vector b)
unzipV Vector (a, b)
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 :: Vector a -> a -> Vector a
shiftlV Vector a
vs a
v = a
v a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a -> Vector a
forall a. Vector a -> Vector a
initV Vector a
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 :: Vector a -> a -> Vector a
shiftrV Vector a
vs a
v = Vector a -> Vector a
forall a. Vector a -> Vector a
tailV Vector a
vs Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
<: a
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 :: Vector a -> Vector a
rotrV Vector a
NullV = Vector a
forall a. Vector a
NullV
rotrV Vector a
vs    = Vector a -> Vector a
forall a. Vector a -> Vector a
tailV Vector a
vs Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
<: Vector a -> a
forall a. Vector a -> a
headV Vector a
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 :: Vector a -> Vector a
rotlV Vector a
NullV = Vector a
forall a. Vector a
NullV
rotlV Vector a
vs    = Vector a -> a
forall a. Vector a -> a
lastV Vector a
vs a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a -> Vector a
forall a. Vector a -> Vector a
initV Vector a
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 :: Int -> Vector a -> Vector a
rotateV Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Vector (Vector a -> Vector a) -> Vector a -> Vector a
forall a. Vector (a -> a) -> a -> a
pipeV (Int -> (Vector a -> Vector a) -> Vector (Vector a -> Vector a)
forall a b. (Num a, Eq a) => a -> b -> Vector b
copyV (Int -> Int
forall a. Num a => a -> a
abs Int
n) Vector a -> Vector a
forall a. Vector a -> Vector a
rotlV)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Vector (Vector a -> Vector a) -> Vector a -> Vector a
forall a. Vector (a -> a) -> a -> a
pipeV (Int -> (Vector a -> Vector a) -> Vector (Vector a -> Vector a)
forall a b. (Num a, Eq a) => a -> b -> Vector b
copyV (Int -> Int
forall a. Num a => a -> a
abs Int
n) Vector a -> Vector a
forall a. Vector a -> Vector a
rotrV)
  | Bool
otherwise = Vector a -> Vector a
forall a. a -> a
id

-- | The function 'concatV' transforms a vector of vectors to a single vector. 
concatV   :: Vector (Vector a) -> Vector a
concatV :: Vector (Vector a) -> Vector a
concatV = (Vector a -> Vector a -> Vector a)
-> Vector a -> Vector (Vector a) -> Vector a
forall b a. (b -> a -> a) -> a -> Vector b -> a
foldrV Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
(<+>) Vector a
forall a. Vector a
NullV

-- | The function 'reverseV' reverses the order of elements in a vector. 
reverseV  :: Vector a -> Vector a
reverseV :: Vector a -> Vector a
reverseV Vector a
NullV   = Vector a
forall a. Vector a
NullV
reverseV (a
v:>Vector a
vs) = Vector a -> Vector a
forall a. Vector a -> Vector a
reverseV Vector a
vs Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
<: a
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 :: (a -> b -> a) -> a -> Vector b -> Vector a
scanlV a -> b -> a
_ a
_ Vector b
NullV   = Vector a
forall a. Vector a
NullV
scanlV a -> b -> a
f a
a (b
x:>Vector b
xs) = a
q a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
scanlV a -> b -> a
f a
q Vector b
xs 
       where q :: a
q = a -> b -> a
f a
a b
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 :: (b -> a -> a) -> a -> Vector b -> Vector a
scanrV b -> a -> a
_ a
_ Vector b
NullV  = Vector a
forall a. Vector a
NullV
scanrV b -> a -> a
f a
a (b
x:>Vector b
NullV) = b -> a -> a
f b
x a
a a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a
forall a. Vector a
NullV
scanrV b -> a -> a
f a
a (b
x:>Vector b
xs)    = b -> a -> a
f b
x a
y a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a
ys 
          where ys :: Vector a
ys@(a
y:>Vector a
_) = (b -> a -> a) -> a -> Vector b -> Vector a
forall b a. (b -> a -> a) -> a -> Vector b -> Vector a
scanrV b -> a -> a
f a
a Vector b
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
-}