3

首先，它很棒。但是，我遇到了一种情况，我的基准测试结果很奇怪。我是 Haskell 的新手，这是我第一次接触可变数组和 Monad。下面的代码是基于这个例子。

我写了一个通用的单子for函数，它接受数字和一个阶跃函数而不是一个范围（就像forM_那样）。我将使用我的通用for函数（循环 A）与嵌入等效递归函数（循环 B）进行了比较。拥有循环 A 明显快于拥有循环 B。更奇怪的是，同时拥有循环 A 和 B 比单独拥有循环 B 更快（但比单独拥有循环 A 稍慢）。

对于这些差异，我能想到一些可能的解释。请注意，这些只是猜测：

  • 关于 Haskell 如何从 monadic 函数中提取结果，我还没有学到一些东西。
  • 与循环 A 相比，循环 B 以较低缓存效率的方式对阵列进行故障处理。为什么？
  • 我犯了一个愚蠢的错误；Loop A 和 Loop B 实际上是不同的。
    • 请注意，在具有循环 A 和循环 B 之一或两者的所有 3 种情况下，程序产生相同的输出。

这是代码。我ghc -O2 for.hs使用 GHC 版本 6.10.4 对其进行了测试。

import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed

for :: (Num a, Ord a, Monad m) => a -> a -> (a -> a) -> (a -> m b) -> m ()
for start end step f = loop start where
    loop i
        | i <= end   = do
            f i
            loop (step i)
        | otherwise  = return ()

primesToNA :: Int -> UArray Int Bool
primesToNA n = runSTUArray $ do
    a <- newArray (2,n) True :: ST s (STUArray s Int Bool)
    let sr = floor . (sqrt::Double->Double) . fromIntegral $ n+1

    -- Loop A
    for 4 n (+ 2) $ \j -> writeArray a j False

    -- Loop B
    let f i
        | i <= n     = do
            writeArray a i False
            f (i+2)
        | otherwise  = return ()
        in f 4

    forM_ [3,5..sr] $ \i -> do
        si <- readArray a i
        when si $
            forM_ [i*i,i*i+i+i..n] $ \j -> writeArray a j False
    return a

primesTo :: Int -> [Int]
primesTo n = [i | (i,p) <- assocs . primesToNA $ n, p]

main = print $ primesTo 30000000
4

2 回答 2

2

我刚刚尝试使用Criterion和 GHC 6.12.1 对此进行基准测试，而 Loop A 对我来说看起来只是稍微快一点。我绝对不会得到奇怪的“两者一起比单独的 B 快”的效果。

此外，如果您的 step 函数真的只是一个 step 并且没有对其参数做任何古怪的事情，那么以下版本的for似乎要快一些，尤其是对于较小的数组：

for' :: (Enum a, Num a, Ord a, Monad m) => a -> a -> (a -> a) -> (a -> m b) -> m ()
for' start end step = forM_ $ enumFromThenTo start (step start) end

以下是 Criterion 的结果，loopA'使用 my 的循环 Afor'在哪里，loopCA 和 B 在哪里：

benchmarking loopA...
mean: 2.372893 s, lb 2.370982 s, ub 2.374914 s, ci 0.950
std dev: 10.06753 ms, lb 8.820194 ms, ub 11.66965 ms, ci 0.950

benchmarking loopA'...
mean: 2.368167 s, lb 2.354312 s, ub 2.381413 s, ci 0.950
std dev: 69.50334 ms, lb 65.94236 ms, ub 73.17173 ms, ci 0.950

benchmarking loopB...
mean: 2.423160 s, lb 2.419131 s, ub 2.427260 s, ci 0.950
std dev: 20.78412 ms, lb 18.06613 ms, ub 24.99021 ms, ci 0.950

benchmarking loopC...
mean: 4.308503 s, lb 4.304875 s, ub 4.312110 s, ci 0.950
std dev: 18.48732 ms, lb 16.19325 ms, ub 21.32299 ms, ci 0.950<

这是代码：

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed

import Criterion.Main

for :: (Num a, Ord a, Monad m) => a -> a -> (a -> a) -> (a -> m b) -> m ()
for start end step f = loop start where
    loop i
        | i <= end   = do
            f i
            loop (step i)
        | otherwise  = return ()

for' :: (Enum a, Num a, Ord a, Monad m) => a -> a -> (a -> a) -> (a -> m b) -> m ()
for' start end step = forM_ $ enumFromThenTo start (step start) end

loopA  arr n = for  4 n (+ 2) $ flip (writeArray arr) False
loopA' arr n = for' 4 n (+ 2) $ flip (writeArray arr) False

loopB arr n =
  let f i | i <= n     = do writeArray arr i False
                            f (i+2)
          | otherwise  = return ()
  in f 4

loopC arr n = do
  loopA arr n
  loopB arr n

runPrimes loop n = do
    let sr = floor . (sqrt::Double->Double) . fromIntegral $ n+1
    a <- newArray (2,n) True :: (ST s (STUArray s Int Bool))

    loop a n

    forM_ [3,5..sr] $ \i -> do
        si <- readArray a i
        when si $
            forM_ [i*i,i*i+i+i..n] $ \j -> writeArray a j False
    return a

primesA  n = [i | (i,p) <- assocs $ runSTUArray $ runPrimes loopA  n, p]
primesA' n = [i | (i,p) <- assocs $ runSTUArray $ runPrimes loopA' n, p]
primesB  n = [i | (i,p) <- assocs $ runSTUArray $ runPrimes loopB  n, p]
primesC  n = [i | (i,p) <- assocs $ runSTUArray $ runPrimes loopC  n, p]

main = let n = 10000000 in
  defaultMain [ bench "loopA"  $ nf primesA  n
              , bench "loopA'" $ nf primesA' n
              , bench "loopB"  $ nf primesB  n
              , bench "loopC"  $ nf primesC  n ]
于 2010-05-14T06:04:18.237 回答
2

也许可以与 Shootout nsieve 程序进行比较和对比？在任何情况下，了解实际情况的唯一方法是查看核心（例如使用ghc-core 工具）。

{-# OPTIONS -O2 -optc-O -fbang-patterns -fglasgow-exts -optc-march=pentium4 #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart 2005
-- 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_ (\i -> sieve (10000 `shiftL` (n-i))) [0, 1, 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
于 2010-05-12T03:21:41.273 回答