http://projecteuler.net/index.php?section=problems&id=61
Arrayで有向グラフを作る。
import Data.Array polygonal p = [ div (n * ((p - 2) * n - p + 4)) 2 | n <- [1..] ] queue_polygonal p = [ (p, n) | n <- takeWhile (< 10000) (filter (>= 1000) (polygonal p)) ] upper x = div (snd x) 100 lower x = mod (snd x) 100 distribute f [] a = a distribute f (x:xs) a = distribute f xs (a // [(m, x:(a!m))]) where m = f x set_flag f n = f + 2^n is_flag_on f n = mod (div f (2^n)) 2 == 1 is_full f = f == 504 find_loop :: (Int,Int) -> (Int,Int) -> (Int,Int) -> [Int] find_loop x y (f,s) | is_full f && x == y = [ s ] | otherwise = concat [ find_loop x z (update (f,s) z) | z <- next ] where update (f,s) (p,n) = (set_flag f p, s + n) next = filter (is_valid f) (b!lower y) is_valid f x = not (is_flag_on f (fst x)) a = [ e | p <- [3..8], e <- queue_polygonal p ] b = distribute upper a (array (0, 99) [ (n, []) | n <- [0..99] ]) c = concat [ find_loop x x (0, 0) | x <- takeWhile (\x -> (fst x) == 3) a ] main = print c