Производительность зацикливания массива Unboxed в Haskell - PullRequest
Новая
       11

Производительность зацикливания массива Unboxed в Haskell

3 голосов
/ 12 мая 2010

Прежде всего, это здорово. Однако я столкнулся с ситуацией, когда мои тесты показали странные результаты. Я новичок в Haskell, и я впервые испачкал руки изменяемыми массивами и монадами. Код ниже основан на этом примере .

Я написал обобщенную монадическую функцию for, которая принимает числа и пошаговую функцию, а не диапазон (как forM_ делает). Я сравнил использование моей общей функции for (цикл A) с внедрением эквивалентной рекурсивной функции (цикл B). Наличие Цикла A заметно быстрее, чем Цикла B. Более странно, если оба Цикла A и B вместе быстрее, чем само Цикл B (но немного медленнее, чем Цикл A).

Некоторые возможные объяснения несоответствий. Обратите внимание, что это всего лишь догадки:

  • Что-то, что я еще не узнал о том, как Haskell извлекает результаты из монадических функций.
  • Цикл B дает сбой массива менее эффективным способом кэширования, чем цикл А. Почему?
  • Я совершил глупую ошибку; Цикл A и цикл B на самом деле разные.
    • Обратите внимание, что во всех 3 случаях наличия одного или обоих циклов A и L цикл B выдает одинаковый результат.

Вот код. Я протестировал его с 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

Ответы [ 2 ]

2 голосов
/ 14 мая 2010

Я только что попробовал сравнить это с Критерием и GHC 6.12.1, и цикл А выглядит для меня лишь немного быстрее. Я определенно не получаю странный эффект «оба вместе быстрее, чем один B».

Кроме того, если ваша пошаговая функция действительно является просто шагом и ничего не делает с ее аргументом, следующая версия 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' - ваш цикл A, использующий мои for', а loopC - это и A, и 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 ]
2 голосов
/ 12 мая 2010

Возможно сравнить и сравнить с программой 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
...