[Haskell-cafe] poor perfomance of indexU in uvector package
Thomas DuBuisson
thomas.dubuisson at gmail.com
Sun Nov 15 13:11:11 EST 2009
The documentation explicitly says indexU is O(n) - no need for so much
testing to rediscover that fact. When I needed a contiguous block of
values in UArr, I just relied on sliceU to acquire the block and
performed a foldU.
Thomas
On Sun, Nov 15, 2009 at 4:00 AM, Alexey Khudyakov
<alexey.skladnoy at gmail.com> wrote:
> Hello
>
> This post meant to be literate haskell.
>
> I found that perfomace of indexU is very poor and it is not fast O(1)
> operation which is very surprising. Here is some benchmarcking I've
> done. Everything compiled with -O2
>
> Code below converts square 2D array to list of 1D arrays. Summation of
> array contents is done in force evaluation
>
>> import Control.Monad
>> import Control.Monad.ST
>> import Data.Array.Vector
>> import System
>>
>> arr :: Int -> UArr Double
>> arr n = toU $ map fromIntegral [1 .. n*n]
>>
>
> This is fastest function. It slice arrays along another direction and used
> mainly as upper bound of speed
>> sliceY :: Int -> UArr Double -> [UArr Double]
>> sliceY n a = map (\i -> sliceU a (i*n) n) [0 .. n-1]
>>
>
> Naive implementation using lists and index lookup.
> 2.15 second for 200*200 array
>> sliceXlist :: Int -> UArr Double -> [UArr Double]
>> sliceXlist n a = map mkSlice [0 .. n-1]
>> where
>> mkSlice x = toU $ map (\y -> indexU a (x + y*n)) [0 .. n-1]
>
> Similar implementation in ST monad and it uses indexU too.
> 2.14 seconds for 200*200 array
>> sliceXst :: Int -> UArr Double -> [UArr Double]
>> sliceXst n a = map mkSlice [0 .. n-1]
>> where
>> mkSlice x = runST $ do arr <- newMU n
>> forM_ [0 .. n-1] $ \y -> writeMU arr y (indexU a (y*n + x))
>> unsafeFreezeAllMU arr
>
> This implementation avoids use of indexU by copying entire
> 2D array into mutable array and using it for lookup. Surprisingly
> it outperform previsious implementations for sufficiently big n
> 1.19 seconds for 200*200 array
>> sliceXcopy :: Int -> UArr Double -> [UArr Double]
>> sliceXcopy n a = map mkSlice [0 .. n-1]
>> where
>> mkSlice x = runST $ do arr <- newMU n
>> cp <- newMU (n*n)
>> copyMU cp 0 a
>> forM_ [0 .. n-1] $ \y -> writeMU arr y =<< readMU cp (y*n + x)
>> unsafeFreezeAllMU arr
>
> This is another implementation with lists which convert whole
> array to list and picks appropriate element it. It is fastest implementation
> so far.
> 0.039 seconds for 200*200 array
>> sliceXlistfast :: Int -> UArr Double -> [UArr Double]
>> sliceXlistfast n a = map mkSlice [0 .. n-1]
>> where
>> takeEvery n [] = []
>> takeEvery n (x:xs) = x : takeEvery n (drop (n-1) xs)
>> mkSlice x = toU $ takeEvery n . drop x $ fromU a
>>
>
>
>>
>> ----------------------------------------------------------------
>> main :: IO ()
>> main = do
>> [str,a] <- getArgs
>> let n = read str
>> case a of
>> "y" -> print $ sum $ map sumU (sliceY n (arr n))
>> "list" -> print $ sum $ map sumU (sliceXlist n (arr n))
>> "lf" -> print $ sum $ map sumU (sliceXlistfast n (arr n))
>> "st" -> print $ sum $ map sumU (sliceXst n (arr n))
>> "copy" -> print $ sum $ map sumU (sliceXcopy n (arr n))
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list