comparison of execution speed of array types

Hal Daume III hdaume@ISI.EDU
Mon, 22 Jul 2002 09:54:27 -0700 (PDT)


> Could you try IOUArray for completeness too?  (An IOUArray is the
> unboxed version of IOArray, it can be found in Data.Array.IO).

It fits in as the fastest:

    IOUnboxedMutArray         0.48u 0.04s 0:00.58 89.6%

> > NormalArray               1.65u 0.20s 0:01.89 97.8%
> > NormalArrayReplace        2.40u 0.08s 0:02.56 96.8%
> > UnboxedArray              0.80u 0.04s 0:00.87 96.5%
> > UnboxedArrayReplace       1.83u 0.07s 0:01.99 95.4%
> > IOMutArray                0.60u 0.03s 0:01.09 57.7%

> You could try testing DiffArray (Data.Array.Diff) which is optimised for
> in-place updates, and should show a bigger difference between the normal
> and 'replace' versions.  It might be nearly as fast as IOArray (I don't
> think we've ever benchmarked it), and it doesn't need to be in the IO
> monad.

DiffArray seems to be broken :).  Either that or I'm using it
incorrectly.  I've attached the relevant code, but when I don't reverse
the array everything works fine; when I reverse it the program doesn't
(seem to) halt.

module Main
    where

import Data.Array.IO
import Data.Array.Diff

testArray :: IOToDiffArray IOArray Int Int
testArray = array (0,50000) [(i, (19*i+23) `mod` 911) | i <- [0..50000]]

reverseArray :: IOToDiffArray IOArray Int Int -> IOToDiffArray IOArray Int
Int
reverseArray arr = 
    arr // [(50000-i, arr!i) | i <- [0..50000]]

sumArrayMod :: IOToDiffArray IOArray Int Int -> Int
sumArrayMod arr = sumArrayMod' low 0
    where sumArrayMod' pos sum 
			 | pos > high = sum
			 | otherwise  = sumArrayMod' (pos+1) ((sum +
arr!pos) `mod` 911)
	  (low,high) = bounds arr

main = print $ sumArrayMod $reverseArray testArray