Problem 122

http://projecteuler.net/index.php?section=problems&id=122

深さ優先。最初は幅優先でやってみたが、どう考えても葉が増えすぎる。

import qualified Data.Map as M
import Control.Monad

depth = 15
bound = 200

search ::M.Map Int Int -> [Int] -> M.Map Int Int
search map xs | length xs == depth = map
              | otherwise = foldr step map xs
    where step x m= 
               let y = head xs + x
                   Just n = M.lookup y m
                   inserted = M.insert y (length xs) m
                   m' | y > bound       = m
                      | M.notMember y m = search inserted (y:xs)
                      | n > length xs   = search inserted (y:xs)
                      | n == length xs  = search m (y:xs)
                      | n < length xs   = m
               in m'
main = print.liftM sum.mapM (flip M.lookup m) $ [1..bound]
    where m = search (M.singleton 1 0) [1]

場合わけがひどすぎる。どうにかならんものか。
なぜかArrayではなくて、Map理由は自分でも分からない。
一応、Arrayも

search' ms xs | length xs == depth = ms
              | otherwise = foldr step ms xs
    where step x m= let y = head xs + x
                        n = m!y
                        m' | y > bound = m
                           | n > length xs  = search' (m//[(y,length xs)]) (y:xs)
                           | n == length xs = search' m (y:xs)
                           | n < length xs  = m
                    in m'
initArr = listArray (1,bound)$  0: repeat maxBound :: DiffArray Int Int

main = print.sum.elems$search' initArr [1]

しかし、Arrayのほうが遅い。なぜ？