[Haskell-cafe] Re: How to think about this? (profiling)
ChrisK
haskell at list.mightyreason.com
Tue Dec 16 10:23:05 EST 2008
Or if you don't want to pay for laziness at all you could build your memo array
imperatively (but purely):
> import Data.Array.IArray(elems,(!),inRange)
> import Data.Array.MArray(newArray_,writeArray,readArray)
> import Data.Array.Unboxed(UArray)
> import Data.Array.ST(runSTUArray,STUArray)
> import Control.Monad(forM_)
> import Data.List(zipWith3)
>
> ackMemoSize :: Int
> ackMemoSize = 12;
>
> ackList :: [Int]
> ackList = 0:1:2:zipWith3 (\ i j k -> i+j+k) ackList (tail ackList) (tail (tail ackList))
>
> ackMemo :: UArray Int Int
> ackMemo = runSTUArray $ do -- the $ works with ghc 6.10, hooray
> a <- newArray_ (0,ackMemoSize)
> writeArray a 0 0
> writeArray a 1 1
> writeArray a 2 2
> let op i x | i > ackMemoSize = return ()
> | otherwise = do
> writeArray a i x
> y <- readArray a (i-3)
> op (succ i) $! (2*x-y) -- could use (2*x) intead
> op 3 (0+1+2)
> return a
>
> ack :: Int -> Int
> ack i | inRange (0,ackMemoSize) i = ackMemo ! i
> | otherwise = error "outsize memorized range for ack"
>
> test = (take (succ ackMemoSize) ackList) == (elems ackMemo)
> && (ackList !! ackMemoSize) == (ack ackMemoSize)
Which should have very good performance in building ackMemo (the first time it
is used).
By changing the (2*x-y) to (2*x) I think you get the sum-of-all-previous-entries
behavior.
Cheers,
Chris
More information about the Haskell-Cafe
mailing list