Personal tools

Shootout/Nsieve Bits

From HaskellWiki

< Shootout(Difference between revisions)
Jump to: navigation, search
(moved)
 
((Proposed) Fast 3 entry)
 
Line 23: Line 23:
   
   
== (Proposed) Fast 3 entry ==
+
== New entry ==
  +
  +
rules changed to allow test-and-set. Update to ST array.
  +
  +
<haskell>
  +
{-# OPTIONS -O2 -optc-O -fbang-patterns #-}
  +
--
  +
-- The Computer Language Shootout
  +
-- http://shootout.alioth.debian.org/
  +
--
  +
-- Contributed by Don Stewart
  +
-- nsieve over an ST monad Bool array
  +
--
  +
  +
import Control.Monad.ST
  +
import Data.Array.ST
  +
import Data.Array.Base
  +
import System
  +
import Control.Monad
  +
import Data.Bits
  +
import Text.Printf
  +
  +
main = do
  +
n <- getArgs >>= readIO . head :: IO Int
  +
mapM_ (sieve . (10000 *) . (2 ^)) [n, n-1, n-2]
  +
  +
sieve n = do
  +
let r = runST (do a <- newArray (2,n) True :: ST s (STUArray s Int Bool)
  +
go a n 2 0)
  +
printf "Primes up to %8d %8d\n" (n::Int) (r::Int) :: IO ()
  +
  +
go !a !m !n !c
  +
| n == m = return c
  +
| otherwise = do
  +
e <- unsafeRead a n
  +
if e then let loop !j
  +
| j < m = do
  +
x <- unsafeRead a j
  +
when x $ unsafeWrite a j False
  +
loop (j+n)
  +
  +
| otherwise = go a m (n+1) (c+1)
  +
in loop (n `shiftL` 1)
  +
else go a m (n+1) c
  +
  +
</haskell>
  +
  +
  +
== Old entry ==
   
 
Careful attention to strictness ensures all args are unboxed (taking the
 
Careful attention to strictness ensures all args are unboxed (taking the

Latest revision as of 15:43, 15 July 2007

A ShootoutEntry for the nsieve-bits problem.

Each program should count the prime numbers from 2 to M, using the same na�ve Sieve of Eratosthenes algorithm:

  • create an array of M bit flags
  • for each index number
    • if the flag value at that index is true

j** set all the flag values at multiples of that index false

      • increment the count

Calculate 3 prime counts, for M = 2N � 10000, 2N-1 � 10000, and 2N-2 � 10000.

Contents

[edit] 1 Benchmarks

Linux/x86, N=10

|| Entry || Time || || Fast 3 || 0.656 || || Fast 2 || 0.720 || || Fast 1 || 1.028 || || Original|| 1.031 ||


[edit] 2 New entry

rules changed to allow test-and-set. Update to ST array.

{-# OPTIONS -O2 -optc-O -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
-- nsieve over an ST monad Bool array
--
 
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Base
import System
import Control.Monad
import Data.Bits
import Text.Printf
 
main = do
    n <- getArgs >>= readIO . head :: IO Int
    mapM_ (sieve . (10000 *) . (2 ^)) [n, n-1, n-2]
 
sieve n = do
   let r = runST (do a <- newArray (2,n) True :: ST s (STUArray s Int Bool)
                     go a n 2 0)
   printf "Primes up to %8d %8d\n" (n::Int) (r::Int) :: IO ()
 
go !a !m !n !c
    | n == m    = return c
    | otherwise = do
          e <- unsafeRead a n
          if e then let loop !j
                          | j < m     = do
                              x <- unsafeRead a j
                              when x $ unsafeWrite a j False
                              loop (j+n)
 
                          | otherwise = go a m (n+1) (c+1)
                    in loop (n `shiftL` 1)
               else go a m (n+1) c


[edit] 3 Old entry

Careful attention to strictness ensures all args are unboxed (taking the idea from the NsieveEntry). Squeezes another 10%. This should be the 2nd or 3rd fastest entry overall -- finally beating OCaml, D and SML :)

--
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Haskell Shootout entries - http://haskell.org/hawiki/ShootoutEntry
-- Contributed by (c) Simon Marlow 2005
-- Modified by Don Stewart
--
 
import Data.Bits; import Data.Array.IO; import Data.Array.Base
import System; import IO; import Text.Printf
 
main = (\n -> mapM_ (sieve . shiftL 10000 . (-) n) [0..2]) . read . head =<< getArgs
 
sieve m = do r <- newArray (0,m) False >>= \(a::IOUArray Int Bool) -> for a m 2 0
             printf "Primes up to %8d %8d\n" (m::Int) (r::Int)
 
for arr m i c | arr `seq` m `seq` i `seq` c `seq` False = undefined -- strict
for arr m i c = if i > m then return c else do
    x <- unsafeRead arr i
    if x then for arr m (i+1) c
         else let for' j | j > m     = for arr m (i+1) (c+1)
                         | otherwise = unsafeWrite arr j True >> for' (j+i)
              in for' (i*2)

[edit] 4 Fast 2 entry

Short, and uses unsafe reads for realistic speed Use -O2 -optc-O3.

--
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by (c) Simon Marlow 2005
-- Modified by Don Stewart
--
 
import Data.Bits; import Data.Array.IO; import Data.Array.Base
import System; import IO; import Text.Printf
 
main = (\n -> mapM_ (sieve.(10000 *).shiftL 1) [n,n-1,n-2]) . read . head =<< getArgs
 
sieve m = do
  arr <- newArray (0,m) False :: IO (IOUArray Int Bool)
  let for i c
        | c `seq` False = undefined -- strictness hack
        | otherwise = if i > m then return c else do
                x <- unsafeRead arr i
                if x then for (i+1) c
                     else let for' j | j > m = for (i+1) (c+1)
                                     | otherwise = unsafeWrite arr j True >> for' (j+i)
                          in for' (i*2)
  r <- for 2 0
  printf "Primes up to %8d %8d\n" (m::Int) (r::Int) :: IO ()

[edit] 5 Fast 1 entry

Shorter, might be slightly faster too.

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by (c) Simon Marlow 2005
-- Modified by Don Stewart
 
import Data.Bits; import Data.Array.IO; import System; import IO; import Text.Printf
 
main = (\n -> mapM_ (sieve.(10000 *).shiftL 1) [n,n-1,n-2]) . read . head =<< getArgs
 
sieve m = do
  arr <- newArray (0,m) False :: IO (IOUArray Int Bool)
  let for i c
        | c `seq` False = undefined -- strictness hack
        | otherwise = if i > m then return c else do
                x <- readArray arr i
                if x then for (i+1) c
                     else let for' j | j > m = for (i+1) (c+1)
                                     | otherwise = writeArray arr j True >> for' (j+i)
                          in for' (i*2)
  r <- for 2 0
  printf "Primes up to %8d %8d\n" (m::Int) (r::Int) :: IO ()

[edit] 6 Original entry

{-# OPTIONS -O2 -optc-O3 #-}
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by (c) Simon Marlow 2005
 
import Data.Array.IO
import System
import IO
import Monad
import Data.Bits
import Text.Printf
 
main = do
  as <- getArgs
  case as of
    [m] -> do let n = read m :: Int
              test n
              when (n >= 1) $ test (n-1)
              when (n >= 2) $ test (n-2)
    _   -> do hPutStrLn stderr "usage: nsieve-bits M"
              exitWith (ExitFailure 1)
 
test :: Int -> IO ()
test n = do
  let m = (1 `shiftL` n) * 10000
  arr <- newArray (0,m) False :: IO (IOUArray Int Bool)
  let for i count
        | count `seq` False = undefined -- strictness hack
        | i > m = return count
        | otherwise = do
                x <- readArray arr i
                if x
                  then for (i+1) count
                  else let for' j | j > m = for (i+1) (count+1)
                                  | otherwise = do
                                        writeArray arr j True
                                        for' (j + i)
                       in for' (i*2)
  r <- for 2 0
  printf "Primes up to %8d %8d\n" (m::Int) (r::Int)