Project Euler 61

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