Send Beginners mailing list submissions to
        [email protected]

To subscribe or unsubscribe via the World Wide Web, visit
        http://www.haskell.org/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        [email protected]

You can reach the person managing the list at
        [email protected]

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1. Re:  cmath Install troubles (Tom Murphy)
   2. Re:  cmath Install troubles (Brandon Allbery)
   3.  Performance of Prime Generator (Zhi-Qiang Lei)
   4. Re:  Performance of Prime Generator (Yucheng Zhang)
   5. Re:  Performance of Prime Generator (Ertugrul S?ylemez)


----------------------------------------------------------------------

Message: 1
Date: Fri, 20 Jan 2012 15:26:08 -0500
From: Tom Murphy <[email protected]>
Subject: Re: [Haskell-beginners] cmath Install troubles
To: Brandon Allbery <[email protected]>
Cc: beginners <[email protected]>
Message-ID:
        <CAO9Q0tXHAeDKzXR5b7b6=RBVSfdZiRnD2HMTpad9zYr=-2q...@mail.gmail.com>
Content-Type: text/plain; charset=ISO-8859-1

On 1/19/12, Brandon Allbery <[email protected]> wrote:
> On Thu, Jan 19, 2012 at 16:37, Antoine Latter <[email protected]> wrote:
>
>> On Thu, Jan 19, 2012 at 3:24 PM, Tom Murphy <[email protected]> wrote:
>> > Is it possible that I have a version of math.h which doesn't have
>> > these definitions ("gamma," "finite," "isinf," etc.) in it?
>>
>> That's a good guess based on the error messages - or math.h isn't in
>> whatever paths we're looking in.
>>

If math.h wasn't in the paths at all, wouldn't I get an error about
_every_ function being undefined?

>> What sort of system are you compiling this on?

Mac OS 10.6.7

>
> [...] My first question is whether the
> appropriate Xcode is installed, including the optional components
> (pre-Xcode 4, the "BSD" packages needed to compile most Unix software were
> optional).

I really am not sure about whether I installed the BSD packages. I'd
guess I did, but maybe not. How can I tell, and is there a simple
remedy?

> Note that Xcode 4 from the App Store actually puts an installer
> program in /Applications; that has to be run to actually install Xcode.
>

It's XCode 3.2.6.


Also, I've got 20 copies of math.h on my hard drive, at least of
couple of which feature definitions of "gamma," "isinf," etc.



Thanks for your help!
Tom



------------------------------

Message: 2
Date: Fri, 20 Jan 2012 15:50:22 -0500
From: Brandon Allbery <[email protected]>
Subject: Re: [Haskell-beginners] cmath Install troubles
To: Tom Murphy <[email protected]>
Cc: beginners <[email protected]>
Message-ID:
        <CAKFCL4XiN6WTkG=wqz9hcu-cbettjaxfd-n0td_6k4sxrdd...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

On Fri, Jan 20, 2012 at 15:26, Tom Murphy <[email protected]> wrote:

> On 1/19/12, Brandon Allbery <[email protected]> wrote:
> > On Thu, Jan 19, 2012 at 16:37, Antoine Latter <[email protected]>
> wrote:
> >> On Thu, Jan 19, 2012 at 3:24 PM, Tom Murphy <[email protected]> wrote:
> >> > Is it possible that I have a version of math.h which doesn't have
> >> > these definitions ("gamma," "finite," "isinf," etc.) in it?
> >>
> >> That's a good guess based on the error messages - or math.h isn't in
> >> whatever paths we're looking in.
>
> If math.h wasn't in the paths at all, wouldn't I get an error about
> _every_ function being undefined?
>

The problem isn't math.h; these are link errors, so it's
/usr/lib/libm.dylib that is somehow wrong.  I can't help with this too much
as I'm on Lion so it's a symlink to libSystem.dylib (and if that's messed
up, you don't even *boot* much less compile stuff).

-- 
brandon s allbery                                      [email protected]
wandering unix systems administrator (available)     (412) 475-9364 vm/sms
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://www.haskell.org/pipermail/beginners/attachments/20120120/ed4aef47/attachment-0001.htm>

------------------------------

Message: 3
Date: Sat, 21 Jan 2012 16:27:38 +0800
From: Zhi-Qiang Lei <[email protected]>
Subject: [Haskell-beginners] Performance of Prime Generator
To: Haskell Beginer <[email protected]>
Message-ID: <[email protected]>
Content-Type: text/plain; charset="us-ascii"

Hi,

I have bungled the Prime Generator on SPOJ for many times. Although the program 
is faster and faster on my machine, but it keeps "time limited exceeded" on 
SPOJ (6 seconds limit). Now my approach is for every number in the range, check 
if it is prime by checking if can be divided by all the primes smaller than or 
equal its square root. For the numbers between 999900000 and 1000000000, it 
take 0.64 seconds on my laptop. Could anyone give me some hints to enhance it? 
Thanks.

=== Test Data ===
1
999900000 1000000000
=== Test Data ===

=== Code ===
{-# OPTIONS_GHC -O2 -fno-cse #-}

import System.IO

data Wheel a = Wheel a [a]

roll :: Integral a => Wheel a -> [a]
roll (Wheel n rs) = [n*k+r | k <- [0..], r <- rs]

nextSize :: Integral a => Wheel a -> a -> Wheel a
nextSize (Wheel n rs) p =
  Wheel (p*n) [r' | k <- [0..(p-1)], r <- rs,
                      let r' = n*k+r, r' `mod` p /= 0]

mkWheel :: Integral a => [a] -> Wheel a
mkWheel ds = foldl nextSize (Wheel 1 [1]) ds

primes :: Integral a => [a]
primes = small ++ large where
    1:p:candidates = roll $ mkWheel small
    small          = [2,3,5,7]
    large          = p : filter isPrime candidates
    isPrime n      = all (not . divides n) 
                       $ takeWhile (\p -> p*p <= n) large

divides :: Integral a => a -> a -> Bool
divides n p = n `mod` p == 0

sqrt' :: Integral a => a -> a
sqrt' = floor . sqrt . fromIntegral

primesFromTo :: [Int] -> [Int]
primesFromTo [x, y] = filter isPrime [x..y]

isPrime :: Integral a => a -> Bool
isPrime 1 = False
isPrime 2 = True
isPrime n = all (not . divides n) $ takeWhile (<= sqrt' n) primes

main :: IO ()
main = do
    count <- fmap read getLine
    inputLines <- fmap (take count . lines) getContents
    let answers = map (primesFromTo . map read . words) inputLines
    putStr . unlines . map (unlines . map show) $ answers

=== Code ===

Best regards,
Zhi-Qiang Lei
[email protected]

-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://www.haskell.org/pipermail/beginners/attachments/20120121/110e71ec/attachment-0001.htm>

------------------------------

Message: 4
Date: Sat, 21 Jan 2012 16:50:31 +0800
From: Yucheng Zhang <[email protected]>
Subject: Re: [Haskell-beginners] Performance of Prime Generator
To: Zhi-Qiang Lei <[email protected]>
Cc: [email protected]
Message-ID:
        <cangdtohzrelt6xmn-ycvdjqxby+-ue8enxarprusq2zd2a1...@mail.gmail.com>
Content-Type: text/plain; charset=UTF-8

On Sat, Jan 21, 2012 at 4:27 PM, Zhi-Qiang Lei <[email protected]> wrote:
> Could anyone give me some hints to enhance it? Thanks.

You could use a faster primality test algorithm such as Miller-Rabin [1].

[1] http://en.wikipedia.org/wiki/Miller?Rabin_primality_test



------------------------------

Message: 5
Date: Sat, 21 Jan 2012 10:44:37 +0100
From: Ertugrul S?ylemez <[email protected]>
Subject: Re: [Haskell-beginners] Performance of Prime Generator
To: [email protected]
Message-ID: <[email protected]>
Content-Type: text/plain; charset="us-ascii"

Zhi-Qiang Lei <[email protected]> wrote:

> I have bungled the Prime Generator on SPOJ for many times. Although
> the program is faster and faster on my machine, but it keeps "time
> limited exceeded" on SPOJ (6 seconds limit). Now my approach is for
> every number in the range, check if it is prime by checking if can be
> divided by all the primes smaller than or equal its square root. For
> the numbers between 999900000 and 1000000000, it take 0.64 seconds on
> my laptop. Could anyone give me some hints to enhance it? Thanks.

Although intuitively that sounds like a great idea, in practice it's
not.  To quickly generate a large number of small primes you should
either use a sieve or use the more naive wheel trial division.  This is
for small numbers up to perhaps 2^18 or 2^20, where this method is
feasible and usually fastest.


Greets,
Ertugrul

-- 
nightmare = unsafePerformIO (getWrongWife >>= sex)
http://ertes.de/
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 836 bytes
Desc: not available
URL: 
<http://www.haskell.org/pipermail/beginners/attachments/20120121/4a1cd7be/attachment-0001.pgp>

------------------------------

_______________________________________________
Beginners mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/beginners


End of Beginners Digest, Vol 43, Issue 25
*****************************************

Reply via email to