Problem 12

uniqueCount :: (Eq a) => [a] -> [(a,Int)]
uniqueCount [] = []
uniqueCount [x] = [(x,1)]
uniqueCount all@(x:xs) = (x, length left) : uniqueCount right
  where (left, right) = break (\a -> a /= x) all

product $ map (\x -> product (replicate (fromInteger $ snd x) (fst x))) $ head $ filter (\p -> 500 < (product $ map (+1) $ map snd p)) $ map (uniqueCount . factor) $ map (\x -> sum [0..x]) [1..]

別解

計算量のオーダーが変わってないけどすこし速くなった。

cnt :: Int -> Int
cnt 0 = 0
cnt n = _cnt n 1
  where _cnt n i
          | i*i <= n = (if n `mod` i == 0
                        then (2 + if i*i == n then (0 - 1) else 0)
                        else 0) + _cnt n (1+i)
          | otherwise = 0

head $ dropWhile (\pair -> (snd pair) < 500 ) $ map (\n -> (n , cnt n)) $ map (\x -> sum [0..x]) [1..]