http://projecteuler.net/index.php?section=problems&id=88
雑にSetを使って。コンパイルして最適化オプションつけたら非常に速くなった。
import qualified Data.Set as S primes = 2:3:5:7:[ p + 6 | p <- tail (tail primes) ] calc_exp n p | mod n p /= 0 = (n, 0) | otherwise = (m, e + 1) where (m, e) = calc_exp (div n p) p factorize :: Int -> [Int] -> [(Int,Int)] factorize 1 ps = [] factorize n (p:ps) | e > 0 = (p,e):(factorize m ps) | p * p > n = [(n,1)] | otherwise = factorize m ps where (m, e) = calc_exp n p fact n = factorize n primes val f = foldr (\(p,e) y -> p^e * y) 1 f divisors [] = [([], [])] divisors ((p,e):fs) = [ (neg ((p,e1):a),neg ((p,e-e1):b)) | e1 <- [0..e], (a,b) <- divisors fs ] neg [] = [] neg ((p,e):a) = if e == 0 then neg a else (p,e):(neg a) divs :: Int -> [[Int]] divs n = divs2 f 2 where f = fact n divs2 f l | val f < l = [] divs2 f l | val f < l^2 = [[val f]] divs2 f l | otherwise = [val f]:(concat (map (\(f1,f2) -> map (\ns -> (val f1):ns) (divs2 f2 (val f1))) a)) where a = filter (range l) (divisors f) range l (f1,f2) = l <= val f1 && val f1 <= val f2 product_sum_length a = (product a) - (sum a) + (length a) update ((n,k):xs) sn sk | S.null sk = sum (S.toList sn) | S.member k sk = update xs (S.insert n sn) (S.delete k sk) | otherwise = update xs sn sk limit = 12000 a :: [(Int,Int)] a = [ (n, product_sum_length a) | n <- [2..], a <- divs n, length a > 1 ] main = print (update a S.empty (S.fromList [2..limit]))
