Totient-function generating sieve consuming too much memory
I have written a sieve-based generator for the list of totients, and want to take the sum up to 1000000.
applyEvery :: (a -> a) -> Int -> [a] -> [a]
applyEvery f n xs = xf ++ (\(y:ys) -> f y : applyEvery f n ys) xb
(xf, xb) = splitAt (n - 1) xs
totients :: [Int]
totients = 1 : sieve [2..] [2..]
sieve (x:xs) (y:ys)
| x == y = (y - 1) : sieve xs (propagatePrime x ys)
| otherwise = y : sieve xs ys
propagatePrime j = applyEvery (\x -> (quot x j)*(j - 1)) j
totientSum :: Int -> Int
totientSum n = sum $ take n totients
When computing totientSum n for n above 40000, ghci takes ages to evaluate and starts consuming tremendous amounts of memory. Compiling to an executable doesn't help. I assume that this has something to do with the way Haskell handles lazy evaluation.
I would like to know if it's possible to selectively apply strictness to improve memory consumption of the above functions so that I can compute the totient sum up to 1000000. I would also like to know if there's a better way to do this using lists, or if I should use a random-access data structure. If you know of a faster algorithm for computing the totient sum, please share a reference.
I thought that the definition of applyEvery might make a difference, so I tried the following other implementations, but they both seemed to consume more memory than the definition used above.
applyEvery' :: (a -> a) -> Int -> [a] -> [a]
applyEvery' f n = zipWith ($) (cycle (replicate (n - 1) id ++ [f]))
applyEvery'' :: (a -> a) -> Int -> [a] -> [a]
applyEvery'' f n xs = xf ++ (\(y:ys) -> f y : applyEvery'' f n ys) xb
xf = take (n - 1) xs
xb = drop (n - 1) xs
you can take advantage of the fact that you are calculating Euler Phi numbers for all the numbers in the range [1..n]
Doing so, you may first find all the primes in the range [1..n] and then instead of finding prime divisors of each number, find all the multiples of each prime number. Obviously, the latter can be done much more efficiently.
A possible implementation would be:
import Data.Int (Int64)
import Control.Applicative ((<$>))
import Data.Array.Unboxed (UArray, elems, accum, listArray)
primes :: Integral a => [a]
primes = 2: 3: filter pred (chain [5,11..] [7,13..])
chain (x:xs) (y:ys) = x: y: chain xs ys
pred a = all (\i -> a `mod` i /= 0) $ takeWhile (\i -> i * i <= a) primes
euler_phi :: Int64 -> [Int64]
euler_phi n = elems $ accum (\a p -> a - a `div` p) arr inc
val = takeWhile (<= n) primes
idx = map (\i -> takeWhile (<= n) [i,2 * i..]) val
inc = concat $ zipWith (\i j -> ($j) <$> (,) <$> i) idx val
arr = listArray (1, n) [1..n] :: UArray Int64 Int64
main = getLine >>= print . sum . euler_phi . read