Project Euler 74

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))