Vector.hs

{-# LANGUAGE FlexibleContexts #-}

module Vector where

import Random

import System.Random.MWC
import Data.Array.Unboxed
import Data.Array.Accelerate as Acc


-- Tests
-- -----

initAcc, tailAcc :: Vector Float -> Acc (Vector Float)
initAcc = Acc.init . Acc.use
tailAcc = Acc.tail . Acc.use

takeAcc, dropAcc :: Int -> Vector Float -> Acc (Vector Float)
takeAcc n = (Acc.take $ constant n) . Acc.use
dropAcc n = (Acc.drop $ constant n) . Acc.use

slitAcc :: Int -> Int -> Vector Float -> Acc (Vector Float)
slitAcc i n = (Acc.slit (constant i) (constant n)) . Acc.use

toUA :: (IArray UArray a, IArray UArray b) => ([a] -> [b]) -> UArray Int a -> UArray Int b
toUA f xs = listArray (bounds xs) $ f (elems xs)

initRef, tailRef :: UArray Int Float -> UArray Int Float
initRef = toUA $ Prelude.init
tailRef = toUA $ Prelude.tail

takeRef, dropRef :: Int -> UArray Int Float -> UArray Int Float
takeRef n = toUA $ Prelude.take n
dropRef n = toUA $ Prelude.drop n

slitRef :: Int -> Int -> UArray Int Float -> UArray Int Float
slitRef i n = toUA $ (Prelude.take n . Prelude.drop i)


-- Main
-- ----
run :: String -> Int -> IO (() -> UArray Int Float, () -> Acc (Vector Float))
run alg n = withSystemRandom $ \gen -> do
  vec   <- randomUArrayR (-1,1) gen n
  vec'  <- convertUArray vec
  ri0   <- uniform gen  -- ri = random int
  ri1   <- uniform gen

  --
  let go f g = return (run_ref f vec, run_acc g vec')
      m   = (abs ri0) `mod` n
      len = (abs ri1) `mod` (n - m)

  case alg of
    "init"   -> go initRef initAcc
    "tail"   -> go tailRef tailAcc
    "take"   -> go (takeRef m) (takeAcc m)
    "drop"   -> go (dropRef m) (dropAcc m)
    "slit"   -> go (slitRef m len) (slitAcc m len)
    x        -> error $ "unknown variant: " ++ x

  where
    {-# NOINLINE run_ref #-}
    run_ref f xs () = f xs
    run_acc f xs () = f xs