[Haskell-cafe] In-place modification

Donald Bruce Stewart dons at cse.unsw.edu.au
Sun Jul 15 06:18:05 EDT 2007


hughperkins:
> 
>    Sebastian,
>    Why would I write a slow, complicated algorithm in C#?
>    I'm not making these comparisons for some academic paper,
>    I'm trying to get a feel for how the languages run in
>    practice.
>    And really in practice, I'm never going to write a prime
>    algorithm using merge and so on, I'd just use the original
>    naive Haskell algorithm, that runs 500 times slower (at
>    least) than my naive C# algo.  I'm just allowing you guys to
>    optimize to see how close you can get.
>    Note that the C# algo is not something created by C#
>    experts, it's just something I hacked together in like 2
>    minutes.

For fast, mutable prime sieves, see the shootout:

    http://shootout.alioth.debian.org/gp4/benchmark.php?test=nsievebits&lang=ghc&id=4

(a bit sieve) is pretty fast, 1.8x highly optimised C, and also
readable, for what it does:

    import Data.Array.IO
    import Data.Array.Base
    import System
    import Text.Printf

    main = do
        n <- getArgs >>= readIO . head :: IO Int
        mapM_ (sieve . (10000 *) . (2 ^)) [n, n-1, n-2]

    sieve n = do
        a <- newArray (2,n) True :: IO (IOUArray Int Bool) -- an array of Bool
        r <- 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    = unsafeWrite a j False >> loop (j+n)
                                | otherwise = go a m (n+1) (c+1)
                         in loop (n+n)
                    else go a m (n+1) c

So perhaps just code up a mutable array version the same as for C# ?

-- Don


More information about the Haskell-Cafe mailing list