[Haskell-cafe]Prime Generator time limit exceeded

Spencer Janssen sjanssen at cse.unl.edu
Wed Nov 1 23:58:58 EST 2006


The problem with your approach is the gratuitous use of division,  
which tends to be very slow.

In my solution, I first generate a list of "seed primes", all primes  
less than sqrt 1000000000.  Then, for each input m and n, I generate  
all multiples of the seed primes between m and n.  I then output each  
number that isn't a multiple of a seed prime.

Tips:
  - Haskell will infer the Integer type by default, an unbounded  
type.  Operations on Integer are often considerably slower than Int,  
the corresponding bounded type.
  - The accumArray function is a handy way to collect all the  
generated multiples.  For maximum speed, use a UArray Int Bool.
  - gcd is a particularly expensive function to use here, perhaps you  
can use the mod function instead?
  - here is a handy function to generate your seed primes:
	sieve [] = []
	sieve (x:xs) = x : [y | y <- xs, y `mod` x /= 0]


Spencer Janssen

On Nov 1, 2006, at 10:49 AM, 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



More information about the Haskell-Cafe mailing list