[Haskell-cafe] Memoization in Haskell?
Daniel Fischer
daniel.is.fischer at web.de
Thu Jul 8 18:10:24 EDT 2010
On Thursday 08 July 2010 23:30:05, Angel de Vicente wrote:
> Hi,
>
> I'm going through the first chapters of the Real World Haskell book,
> so I'm still a complete newbie, but today I was hoping I could solve
> the following function in Haskell, for large numbers (n > 108)
>
> f(n) = max(n,f(n/2)+f(n/3)+f(n/4))
You need some base case or you'll have infinite recursion.
>
> I've seen examples of memoization in Haskell to solve fibonacci
> numbers, which involved computing (lazily) all the fibonacci numbers
> up to the required n. But in this case, for a given n, we only need to
> compute very few intermediate results.
>
> How could one go about solving this efficiently with Haskell?
If f has the appropriate type and the base case is f 0 = 0,
module Memo where
import Data.Array
f :: (Integral a, Ord a, Ix a) => a -> a
f n = memo ! n
where
memo = array (0,n) $ (0,0) :
[(i, max i (memo!(i `quot` 2) + memo!(i `quot` 3)
+ memo!(i `quot` 4))) | i <- [1 .. n]]
is wasteful regarding space, but it calculates only the needed values and
very simple.
(to verify:
module Memo where
import Data.Array
import Debug.Trace
f :: (Integral a, Ord a, Ix a) => a -> a
f n = memo ! n
where
memo = array (0,n) $ (0,0) :
[(i, max (trace ("calc " ++ show i) i) (memo!(i `quot` 2)
+ memo!(i `quot` 3) + memo!(i `quot` 4))) | i <- [1 .. n]]
)
You can also use a library (e.g. http://hackage.haskell.org/package/data-
memocombinators) to do the memoisation for you.
Another fairly simple method to memoise is using a Map and State,
import qualified Data.Map as Map
import Control.Monad.State
f :: (Integral a) => a -> a
f n = evalState (memof n) (Map.singleton 0 0)
where
memof k = do
mb <- gets (Map.lookup k)
case mb of
Just r -> return r
Nothing -> do
vls <- mapM memof [k `quot` 2, k `quot` 3, k `quot` 4]
let vl = max k (sum vls)
modify (Map.insert k vl)
return vl
>
> Thanks in advance,
> Ángel de Vicente
More information about the Haskell-Cafe
mailing list