[Haskell-cafe]Prime Generator time limit exceeded
Dan Weston
westondan at imageworks.com
Wed Nov 1 15:58:04 EST 2006
Two more hints I used in my code:
5) Except for 2, all primes are odd. Don't bother testing the evens.
6) sqrt(n) is (a little) costly, but I used it in my first solution for
clarity. You can also create an infinite list of squares of primes, then
trim the list of primes to the length of (takeWhile (<= n)
squarePrimes). I haven't tested whether this is actually faster or
slower than using sqrt, though! Math functions take only time, but lists
require memory allocation.
Dan Weston wrote:
> I didn't see any other replies and didn't want to leave you hanging, so...
>
> Three hints:
>
> 1) you are testing every integer >= 2 as a divisor when you only need to
> test prime numbers <= floor(sqrt(n))
>
> 2) Since for all n > 2, floor(sqrt(n)) < n, you can use the very primes
> you are generating in the test part of the function itself, confident
> that you won't overtake your own function.
>
> 3) The function primeGenerator [start,end] seems more efficient that
> primeGenerator [2,end], but the latter is (almost) always faster,
> because you need those primes to test for primality. A dropWhile (<
> start) can trim off the unneeded junk when you're done.
>
> 4) It won't make your code any faster, but it maybe more elegant to
> lazily calculate an infinite list of primes, then truncate with
> takeWhile (<= end), if only for symmetry with dropWhile (< start)
>
>
> SPOILER ALERT: I have appended two of my own solutions at the end of
> this e-mail for fun (one with list comprehensions, one in point-free
> notation). Whether you scroll down to look at them is up to you of
> course... :)
>
> alaiyeshi wrote:
>> Hi
>>
>> I'm new to Haskell.
>>
>> I found this site on the Haskell wiki https://www.spoj.pl. But I got
>> some trouble on trying to solve the problem titled "Prime Generator"
>> https://www.spoj.pl/problems/PRIME1.
>>
>> The online-judge system tells me "time limit excedded"
>> Would you be so kind to tell me how to make it more faster? And any
>> other suggestion is welcome.
>> Thanks in advance.
>>
>> --------------------------------------Code
>> begin------------------------------------------------------------
>> module Main where
>>
>> import IO
>> import List
>>
>> main = do
>> input_size<-getLine
>> content<-get_contents (read input_size)
>> mapM_ (\r-> do mapM_ (print) (primeGenerator (parse r));
>> putStrLn "") content
>>
>> get_contents n | n == 0 = return []
>> | otherwise =
>> do
>> content<-getLine
>> rests<-get_contents (n-1)
>> return ([content]++rests)
>>
>> primeGenerator [start,end] =
>> [x | x<-[start..end], all (== 1) (map (gcd x)
>> [2..(x-1)]), x/=1]
>>
>> parse s =
>> unfoldr (\x-> case x of
>> [] -> Nothing
>> _ -> Just (head (reads x))) s
>>
>> -------------------------------Code
>> ends--------------------------------------------------------------------------------
>>
>>
>> (BTW: I'm new to this mailling list also, forgive my rudeness if I am,
>> and forgive my poor English)
>>
>>
>> ------------------------------------------------------------------------
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
>
>
> -- Just calculate the infinite list of primes (lazily),
> -- then trip the range to fit
> primeGenerator [start,end] = takeWhile (<= end)
> . dropWhile (< start)
> $ primes
>
> -- Pointed notation with list comprehensions
> primes = (2 : [x | x <- [3,5..], isPrime x])
>
> -- Efficient test presupposes the existence of primes
> -- This works because to determine whether p is prime you only need
> -- to know the primes strictly less than p (except for 2 of course!)
> isPrime x = null divisors
> where divisors = [y | y <- onlyUpToSqrtX primes, x `mod` y == 0]
> onlyUpToSqrtX = fst . span (<= sqrtX)
> sqrtX = floor (sqrt (fromIntegral x))
>
> -- A point-free notation, as an alternative
> primes' = (2 : filter isPrime [3,5..]) -- indivisible n > 1
> where isPrime = and -- i.e. all are
> . map (/= 0) -- not equal to 0, applied to
> . remOf -- remainders of odd ints
> -- where remOf n is when you
> remOf n = map (mod n) -- divide into n a list of
> . flip take primes' -- primes, but only
> . length -- as many as
> . takeWhile (<= n) -- are less than n, that is
> . map (^ 2) -- the square of each of the
> $ primes' -- primes
>
>
More information about the Haskell-Cafe
mailing list