2008/07/23

Monad Transformer

繼續 Haskell 效能測試,想試試看 memoisation 能不能進一步加快執行速度,但這麼一來就需要結合兩個 State monads ─ 於是就輪到「魔那變形金剛」上場啦!

 1: import Control.Monad.Identity
 2: import Control.Monad.State
 3: import qualified Data.IntMap as IM
 4: 
 5: cycleLength :: Monad m => Int -> StateT (IM.IntMap Int) m Int
 6: cycleLength 1 = return 1
 7: cycleLength n =
 8:   do calculated <- gets (IM.member n)
 9:      if calculated
10:         then do x <- gets (IM.lookup n)
11:                 return (runIdentity x)
12:         else do x <- if even n then cycleLength (n `div` 2)
13:                                else cycleLength (3 * n + 1)
14:                 modify (IM.insert n (x + 1))
15:                 return (x + 1)
16: 
17: maxCycleLength :: Monad m => [Int] -> StateT (IM.IntMap Int) m Int
18: maxCycleLength [] = return 0
19: maxCycleLength (x : xs) = do a <- cycleLength x
20:                              b <- maxCycleLength xs
21:                              return (max a b)
22: 
23: driver :: StateT (IM.IntMap Int) (State [Int]) [Int]
24: driver =
25:   do eof <- lift $ gets null
26:      if eof
27:         then return []
28:         else do i <- lift $ gets head
29:                 lift $ modify tail
30:                 j <- lift $ gets head
31:                 lift $ modify tail
32:                 x <- maxCycleLength [min i j .. max i j]
33:                 xs <- driver
34:                 return (x : xs)
35:                           
36: main = getContents >>= foldr ((>>) . print) (return ()) .
37:                        evalState (evalStateT driver IM.empty) .
38:                        map read . words
寫得已經很像 imperative code 了。可惜這個版本遇上測資 "1 100000" 的時候會 stack overflow XD。

--
是沒辦法做最佳化的關係嗎?

Labels: