Dynamic Programming with Memoizing
Lajos Nagy
lnagy at fit.edu
Thu Apr 27 18:57:38 EDT 2006
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
More information about the Glasgow-haskell-users
mailing list