[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