http://projecteuler.net/index.php?section=problems&id=74
チェーンにパターンがあるのがややこしい。
import Data.List rep_combinations a 0 = [[]] rep_combinations [] n = [] rep_combinations (x:xs) n = [ x:e | e <- rep_combinations (x:xs) (n - 1) ] ++ (rep_combinations xs n) index [] e = -1 index (x:xs) e = if x == e then 0 else if p == -1 then -1 else p + 1 where p = index xs e digits 0 = [] digits n = (digits (div n 10)) ++ [mod n 10] replace n m [] = [] replace n m (x:xs) = (if x == n then m else x):(replace n m xs) factorial n = foldr (\x y -> x * y) 1 [1..n] to_number a = foldr (\x y -> x + y * 10) 0 a uniq [x] = [x] uniq (x:y:ys) = if x == y then xs else x:xs where xs = uniq (y:ys) normalize = to_number . sort . (replace 0 1) . digits next n = sum (map factorial (digits n)) chain_length n = search_back [] a where a = n:[ normalize (next m) | m <- a ] search_back xs (y:ys) = if p == -1 then search_back (xs++[y]) ys else (xs, y) where p = index xs y chain_type (x:xs,y) | x == y = 1 -- loop | otherwise = if next m == next n then 2 else 3 where (m,n) = f (x:xs) y -- 2 elements before y f (x:y:xs) z = if y == z then (x, g (y:xs)) else f (y:xs) z g [x,y] = x -- before last g (x:xs) = g xs count (n,t,l) | t == 1 = if l == 59 then 1 else (f n) - 1 | t == 2 = if l == 59 then 0 else f n | t == 3 = if l == 59 then f n else 0 where f = sum . (map (\a -> g a True)) . uniq . sort . permutations . digits g [] b = 1 g (x:xs) b = (if not b && x == 1 then 2 else 1) * (g xs False) a = [ to_number e | n <- [1..6], e <- rep_combinations [1..9] n ] b = filter (\x -> f x == 59 || f x == 60) (map chain_length a) where f = length . fst c = [ (x, chain_type (x:xs, y), length (x:xs)) | (x:xs, y) <- b ] main = print (sum (map count c))