Project Euler 68

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

ライブラリのpermutationsでは降順に並べられないので、自作。
やたらにメモリを食って帰ってこなくなるので、コンパイルしたらすぐに返ってくるようになった。順列を出す途中で枝刈りしているんだろうか。

perm [] = [[]]
perm a = [ x:b | (x, ys) <- f [] a, b <- perm ys ] where
            f xs [] = []
            f xs (y:ys) = (y, (xs ++ ys)):(f (xs ++ [y]) ys)

split a = (inner_circle a, outer_circle a) where
    inner_circle (x:y:xs) = (y:(f (y:xs))) ++ [y] where
            f [x] = []
            f (x:y:xs) = [y] ++ (f xs)
    outer_circle (x:y:xs) = (x:(f xs)) where
            f [] = []
            f (x:y:xs) = [y] ++ (f xs)

join (i,[]) = []
join (i,o) = (head o):((take 2 i) ++ (join (tail i, tail o)))

is_ext_head_min (x:xs) = f x xs where
            f x [] = True
            f x (y:ys) = if x > y then False else f x ys

sum_list (a, []) = []
sum_list ((x:y:xs), (z:zs)) = [ x + y + z ]:(sum_list ((y:xs), zs))

eq [x] = True
eq (x:y:xs) = if x /= y then False else eq (y:xs)

a = [ (a, split a) | a <- perm (reverse (10:[1..9])) ]
b = filter (\(_,(_,y)) -> is_ext_head_min y) a
c = filter (\(_,y) -> eq y) [ (x, sum_list y) | (x, y) <- b ]
d = filter (\(x,y) -> elem 10 y) (map split (map fst c))
main = print (foldl (++) "" (map show (join (head d))))