[Haskell-cafe] Memoization in Haskell?

Michael Mossey mpm at alumni.caltech.edu
Fri Jul 9 00:17:52 EDT 2010



Daniel Fischer wrote:
> 
> 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.

Can someone explain to a beginner like me why this calculates only the 
needed values? The list comprehension draws from 1..n so I don't 
understand why all those values wouldn't be computed.

Thanks
Mike


More information about the Haskell-Cafe mailing list