[Haskell-beginners] Efficient sieve of erastothenes,
for solving project euler problem #10?
David Frey
dpfrey at shaw.ca
Mon Nov 24 00:48:45 EST 2008
On 11/23/2008, "Malcolm Reynolds" <malcolm.reynolds at gmail.com> wrote:
>Hello all,
>
>I'm attempting to learn Haskell by going through the project euler
>problems. Number 10,
>http://projecteuler.net/index.php?section=problems&id=10 , involves
>summing prime numbers. It's easy in terms of coding something up that
>works, but I'm having a lot of trouble getting decent performance.
>I've learned a reasonable amount of ML at uni but Haskell is the first
>lazy language I've used.. I think the inefficiency is possibly due to
>the laziness but I'm not positive.
>
>I'd love if someone could show me how to do this in Haskell somewhere
>near as fast as C - at the moment I have a C version which runs in
>about a tenth of a second (
>http://github.com/malcster/project-euler-solutions--c-/tree/master/10.c
>). My haskell attempts are
>http://github.com/malcster/project-euler-solutions/tree/master/10better.hs
>(using the sieve) and
>http://github.com/malcster/project-euler-solutions/tree/master/10.hs
>(using possibly an even worse method, but seems to be a bit faster).
>
>If anyone could point out any neat strictness annotations or anything
>else I could put in, that would be cool.
>
>Cheers,
>
>Malcolm
Hi Malcom,
I have a solution to Project Euler problem #10 that runs in 7.3 seconds
on my computer when compiled with -O2. I am neither a math expert nor a
Haskell expert, so others may be able to offer a better solution.
module PE010 where
import ProjectEuler(primes2)
main = putStrLn output
output = show result
result = sum $ takeWhile (\x -> x < 2000000) primes2
-- This is the relevant stuff from ProjectEuler.hs
primes2 :: [Integer]
primes2 = getPrime [] primeCandidates where
getPrime :: [Integer] -> [Integer] -> [Integer]
getPrime ls (x:xs) = let maxDiv = floor $ sqrt $ fromIntegral x in
if isDivisibleByAny (takeWhile (\n -> n <= maxDiv) ls) x
then getPrime ls xs
else x : getPrime (ls ++ [x]) xs
primeCandidates = 2 : (oddsFrom 3)
oddsFrom n
| odd n = [n, n+2 ..]
| otherwise = [n+1, n+3 ..]
isDivisibleByAny ls n = or $ map (\d -> n `mod` d == 0) ls
I didn't get a chance to look at your version, but obviously, 7.3
seconds is a lot slower than the 0.1 seconds you saw with your C version.
More information about the Beginners
mailing list