[Haskell-cafe] In-place modification

Hugh Perkins hughperkins at gmail.com
Sat Jul 14 20:17:58 EDT 2007


(Random observation: Hmmm, strange, in the Data.Map version of primes above,
we are missing 5 primes?)

Hi Chaddai,

Your algorithm does work significantly better than the others I've posted
here :-)

So much so, that we're going for a grid of 10000000 to get the timings in an
easy-to-measure range.  Here are the results:

J:\dev\haskell>ghc -O2 -fglasgow-exts -o PrimeChaddai.exe PrimeChaddai.hs

J:\dev\haskell>primechaddai
number of primes: 664579
30.984

J:\dev\test\testperf>csc /nologo primecs.cs

J:\dev\test\testperf>primecs
number of primes: 664579
elapsed time: 0,859375

So, only 30 times faster now, which is quite a lot better :-D

Here's the full .hs code:

module Main
    where

import IO
import Char
import GHC.Float
import List
import qualified Data.Map as Map
import Control.Monad
import System.Time
import System.Locale

merge xs@(x:xt) ys@(y:yt) = case compare x y of
   LT -> x : (merge xt ys)
   EQ -> x : (merge xt yt)
   GT -> y : (merge xs yt)

diff  xs@(x:xt) ys@(y:yt) = case compare x y of
   LT -> x : (diff xt ys)
   EQ -> diff xt yt
   GT -> diff xs yt

primes, nonprimes :: [Int]
primes    = [2,3,5] ++ (diff [7,9..] (nonprimes))
nonprimes = foldr1 f . map g $ tail (primes)
   where f (x:xt) ys = x : (merge xt ys)
         g p = [ n*p | n <- [p,p+2..]]

calculateNumberOfPrimes max = length $ takeWhile ( < max ) primes

gettime :: IO ClockTime
gettime = getClockTime

main = do starttime <- gettime
          let numberOfPrimes = (calculateNumberOfPrimes 10000000)
          putStrLn( "number of primes: " ++ show( numberOfPrimes ) )
          endtime <- gettime
          let timediff = diffClockTimes endtime starttime
          let secondsfloat = realToFrac( tdSec timediff ) +
realToFrac(tdPicosec timediff) / 1000000000000
          putStrLn( show(secondsfloat) )
          return ()


On 7/15/07, Chaddaï Fouché <chaddai.fouche at gmail.com> wrote:
>
> Or if you really want a function with your requirement, maybe you
> could take the painful steps needed to write :
> let numberOfPrimes = length $ takeWhile (< 200000) primes
> ?
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070715/9b44f62c/attachment.htm


More information about the Haskell-Cafe mailing list