Life Goes On

まあまあだけど楽しんでる方です

リストの正格評価

ひさしぶりに Project Euler を解いて、学んだことをつらつらと。
要約すると、リストの正格評価の仕方を覚えたよ、という話です。
動的計画法を使う部分和問題で、もともとのコードはこんな感じ。リストにメモ化して、foldl で 250250 段の再帰処理をするというのが主要な部分です。

add :: Integer -> Integer -> Integer
add x y = if x+y<10^16 then x+y else x+y-10^16

step :: [Integer] -> Integer -> [Integer]
step xs x = zipWith add xs $ bs++as
  where (as,bs) = splitAt (fromIntegral x) xs

euler250 :: Int -> [Integer]
euler250 n = foldl step (take 250 $ 1:repeat 0) $
  take n $ cycle $ map (`mod`250) $ zipWith (^) [1..250] [1..250]

単純に考えても 1 段 2KB くらいのメモリを喰うので、全体では 1GB 以上の領域が必要になります。もちろん遅くて、10 分以上かかる。
これをどう効率改善するかが問題なのですが、jeneshicc さんは 可変配列(STUArray)を使った ようです。王道ですね。それで何も問題はないのですが、もう少し別の方法でできないかと足掻いてみました。
で、正格評価にすれば変わるんじゃないかと考えて foldl' に。それだけだと全然正格評価になってくれないので、ここ とか ここ とか見て、いったん非ボックス型の不変配列(UArray Int Int64)に入れてみました。そうか、ふつうの不変配列はインデックスについてだけ正格なのか。
配列はあくまでも正格評価するためだけのもので、結局またリストに取り出して、ロジックを組んでいます。

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Int
import Data.List

add :: Int64 -> Int64 -> Int64
add x y = if x+y<10^16 then x+y else x+y-10^16

step :: UArray Int Int64 -> Int64 -> UArray Int Int64
step as x = listArray (1,250) $ zipWith add xs $ drop (250-fromIntegral x) $ cycle xs
  where xs = elems as

euler250 :: Int -> UArray Int Int64
euler250 n = foldl' step (listArray (1,250) $ 1:repeat 0) $
  take n $ cycle $ map (fromInteger.(`mod`250)) $ zipWith (^) [1..250] [1..250]

これは効果があって、実行時間が 1 分くらいになりました。メモリ使用量も 1MB 以下に。
でもやっぱり正格評価のためだけに配列に詰め替えるのは格好悪い。それに非ボックス型にできない場合だってあるはず。
という訳で、リストのまま正格評価する方法を探してたら、ありました。Real World Haskell に

seq による式の評価は、コンストラクタに到達すると止まる。つまり、数値のように単純な型については完全に評価される。代数的データ型については事情が異なる。(1+2):(3+4):[] という値を考えてみる。seq を適用すると (1+2) というサンクが評価される*1。最初の (:) というコンストラクタに到達して評価が止まったので、2 番目のサンクにはまったく影響がないのだ。タプルについても同様である。seq ( (1+2),(3+4) ) True を評価すると、すぐにペアを作るコンストラクタに到達するので、ペアの内部のサンクには全く影響がない。
必要であれば、一般的な関数プログラミングのテクニックで、これらの制限を回避することができる。

-- file: ch04/Fold.hs
strictPair (a,b) = a `seq` b `seq` (a,b)

strictList (x:xs) = x `seq` x : strictList xs
strictList []     = []

まさにこれですよ、これ。探していたのは。
という訳で書きなおしたコードは以下のとおり。

import Data.Int
import Data.List

strictList :: [a] -> [a]
strictList []     = []
strictList (x:xs) = x `seq` x : strictList xs

add :: Int64 -> Int64 -> Int64
add x y = if x+y<10^16 then x+y else x+y-10^16

step :: [Int64] -> Int64 -> [Int64]
step xs x = zipWith add xs' $ bs++as
  where (as,bs) = splitAt (fromIntegral x) xs'
        xs' = strictList xs

euler250 :: Int -> [Int64]
euler250 n = foldl' step (take 250 $ 1:repeat 0) $
  take n $ cycle $ map (fromInteger.(`mod`250)) $ zipWith (^) [1..250] [1..250]

リスト⇔配列の詰め替えがなくなった分、速くなって、30 秒くらい。Int64 を Integer にしても 1 分くらいと、なかなかの性能になりました。

やっぱり Real World Haskell 読書会に参加しなきゃ。

*1:ここにはコメントがついていて、タプルの場合と同様、(1+2)というサンクも評価されないはずだと書いてありました。おそらくその通りだと思います。