[Haskell-cafe] memoization
staafmeister
g.c.stavenga at uu.nl
Sat Sep 5 05:52:50 EDT 2009
Hi,
I participating in de google code jam this year and I want to try to use
haskell. The following
simple http://code.google.com/codejam/contest/dashboard?c=90101#s=p2
problem
would have the beautiful haskell solution.
import Data.MemoTrie
import Data.Char
import Data.Word
import Text.Printf
newtype ModP = ModP Integer deriving Eq
p=10000
instance Show ModP where
show (ModP x) = printf "%04d" x
instance Num ModP where
ModP x + ModP y = ModP ((x + y) `mod` p)
fromInteger x = ModP (x `mod` p)
ModP x * ModP y = ModP ((x * y) `mod` p)
abs = undefined
signum = undefined
solve _ [] = 1::ModP
solve [] _ = 0::ModP
solve (hs:ts) t@(ht:tt) | hs==ht = solve ts tt + solve ts t
| otherwise = solve ts t
go (run, line) = "Case #"++show run++": "++show (solve line "welcome to code
jam")
main = interact $ unlines . map go . zip [1..] . tail . lines
Which is unfortunately exponential.
Now in earlier thread I argued for a compiler directive in the lines of {-#
Memoize function -#},
but this is not possible (it seems to be trivial to implement though). Now I
used memotrie which
runs hopelessly out of memory. I looked at some other haskell solutions,
which were all ugly and
more clumsy compared to simple and concise C code. So it seems to me that
haskell is very nice
and beautiful until your are solving real algorithmic problems when you want
to go back to some
imperative language.
How would experienced haskellers solve this problem?
Thanks
--
View this message in context: http://www.nabble.com/memoization-tp25306687p25306687.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
More information about the Haskell-Cafe
mailing list