[Haskell-cafe] memoization

[Daniel Fischer]

Am Samstag 05 September 2009 11:52:50 schrieb staafmeister:
> 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).

Not really. Though a heck of a lot easier than automatic memoisation.

> 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

completely unoptimised:

----------------------------------------------------------------------
module Main (main) where

import Text.Printf
import Data.List

out :: Integer -> String
out n = printf "%04d" (n `mod` 10000)

update :: [(String,Integer)] -> Char -> [(String,Integer)]
update ((p@((h:_),n)):tl) c
    = case update tl c of
        ((x,m):more)
            | c == h    -> p:(x,m+n):more
        other -> p:other
update xs _ = xs

solve pattern = snd . last . foldl' update (zip (tails pattern) (1:repeat 0))

solveLine :: String -> (Integer,String) -> String
solveLine pattern (i,str) = "Case# " ++ show i ++ ": " ++ out (solve pattern str)

main :: IO ()
main = interact $ unlines . map (solveLine "welcome to code jam")
                    . zip [1 .. ] . tail . lines
----------------------------------------------------------------------

./codeJam +RTS -sstderr -RTS < C-large-practice.in
<snip>
Case# 98: 4048                                                                         
Case# 99: 8125                                                                         
Case# 100: 0807                                                                        
      15,022,840 bytes allocated in the heap                                           
         789,028 bytes copied during GC                                                
         130,212 bytes maximum residency (1 sample(s))                                 
          31,972 bytes maximum slop                                                    
               1 MB total memory in use (0 MB lost due to fragmentation)               

  Generation 0:    28 collections,     0 parallel,  0.00s,  0.00s elapsed
  Generation 1:     1 collections,     0 parallel,  0.00s,  0.00s elapsed

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time    0.04s  (  0.03s elapsed)
  GC    time    0.00s  (  0.01s elapsed)
  EXIT  time    0.00s  (  0.00s elapsed)
  Total time    0.04s  (  0.04s elapsed)

  %GC time       0.0%  (13.8% elapsed)

  Alloc rate    417,277,929 bytes per MUT second

  Productivity 100.0% of total user, 98.6% of total elapsed