Dynamic Programming with Memoizing

Simon Peyton-Jones simonpj at microsoft.com
Sat Apr 29 09:22:13 EDT 2006


You don't want (map q' (range dom)) to be computed for each call of q,
do you.  To make GHC realise that this expression does not depend on the
arguments, you need the "full laziness" transformation, which you get
with -0.  

GHCi doesn't use -O, though.  So do this
	ghc -c Foo.hs -O
	ghci Foo.hs
and away you go.  (p 100) is fast.

Alternatively, define (map q' (range dom)) as a top-level value; that
will work without -O.

Simon

| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org
[mailto:glasgow-haskell-users-
| bounces at haskell.org] On Behalf Of Lajos Nagy
| Sent: 27 April 2006 23:58
| To: glasgow-haskell-users at haskell.org
| Subject: Dynamic Programming with Memoizing
| 
| 
| Well, I got stuck.  I wanted to use dynamic programming to compute the
| value `p 100':
| 
| ================================
| 
| module Main where
| 
| import Data.Ratio
| import Data.Ix
| 
| n = 100
| 
| q :: (Integer, Integer) -> Rational
| q (i,k) | i == 1 && k == 2 = 1
| q (i,k) = (map q' (range dom)) !! (dom `index` (i,k))
|    where dom = ((1,1),(n,n))
|          q' (i,k) = (p i * ((n + 1 - k) % 1)) / ((n + 1 - i) % 1)
| 
| p :: Integer -> Rational
| p k | k == 1 = 1
| p k = map p' [1 .. n] !! ((1,n) `index` k)
|    where p' k = sum (map f [1 .. (k - 1)])
|            where f i = q (i,k) / ((n + 1 - i) % 1)
| 
| ======================
| 
| I used the lazy list pattern for memoizing previous values of `p' and
`q'
| as I saw it elsewhere.  Both `p k' and `q (i,k)' depend only on values
of
| `p x' and `q (y,x)' where `x < k' and `y < k'.  Nevertheless, it takes
| forever to compute even `p 20'.  What's wrong?  (I even tried using a
| strict container along the lines of `N !Rational' for storing the
results
| of `p' and `q'.  It didn't help.)
| 
| The program seems to work correctly for small values of `k', by the
way.
| 
| I used Rational because I needed the _exact_ result.
| 
| Thanks and Regards,
| 
| -- Lajos Nagy
| Computer Science Ph.D. Student,  Florida Institute of Technology
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


More information about the Glasgow-haskell-users mailing list