８８問目

http://projecteuler.net/index.php?section=problems&id=88
2以上の自然数 k に対して、N = a₁ + a₂ + ... + a_k = a₁ × a₂ × ... × a_k を満たす最小の数を考える。例えば k=3 のとき、6 = 1 + 2 + 3 = 1 × 2 × 3 が最小となる。2≦k≦12 に対してこのような数の集合は {4, 6, 8, 12, 15, 16} となり、その和は 61 である。2≦k≦12000 に対して、同様に題意を満たす数の和を求める。
N に対して成立しうる k の値をリスト ks で求めています。これだけだと k に対して複数の N が得られてしまうので、最小の N だけ取り出すようにしました。
色々頑張って試してみたのですが、まだ１分を超えてしまいます。う〜ん。

import Data.List

main = print $ sum $ euler088 12000

euler088 :: Int -> [Int]
euler088 n = findIndices id $ zipWith (/=) rest (tail rest ++ [[]])
    where rest = takeWhile (/= []) $ scanl (\\) [2..n] ks

ks :: [[Int]]
ks = [] : [] : [ map (\ xs -> n - sum xs + length xs) $ init $ parts !! n | n <- [2..] ]

parts :: [[[Int]]]
parts = [] : [] : [ part n | n <- [2..] ]

part :: Int -> [[Int]]
part n = [ x : xs |
    x <- [2..root], let (q, r) = divMod n x, r == 0,
    xs <- dropWhile ((< x) . head) $ parts !! q ] ++ [[n]]
    where root = floor $ sqrt $ fromIntegral n