Performance d'une boucle sur un tableau Unboxed en Haskell

Question

Tout d'abord, c'est génial. Cependant, j'ai rencontré une situation où mes benchmarks ont donné des résultats bizarres. Je suis nouveau en Haskell, et c'est la première fois que je me salis les mains avec des tableaux mutables et des Monads. Le code ci-dessous est basé sur cet exemple .

J'ai écrit un monadique générique for qui prend des nombres et une fonction d'échelon plutôt qu'une plage (comme forM_ fait). J'ai comparé en utilisant mon for (boucle A) contre l'intégration d'une fonction récursive équivalente (boucle B). La boucle A est nettement plus rapide que la boucle B. Plus étrange encore, la combinaison des boucles A et B est plus rapide que la boucle B seule (mais légèrement plus lente que la boucle A seule).

Je pense à quelques explications possibles pour ces divergences. Notez qu'il ne s'agit que de suppositions :

• Quelque chose que je n'ai pas encore appris sur la façon dont Haskell extrait les résultats des fonctions monadiques.
• La boucle B défaille le tableau d'une manière moins efficace en termes de cache que la boucle A. Pourquoi ?
• J'ai fait une erreur stupide ; la boucle A et la boucle B sont en fait différentes.
  • Notez que dans les trois cas de boucles A et B, le programme produit la même sortie.

Voici le code. Je l'ai testé avec ghc -O2 for.hs en utilisant GHC version 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

Answer 1

Peut-être faut-il comparer avec le programme Shootout nsieve ? Quoi qu'il en soit, la seule façon de savoir ce qui se passe réellement est de le faire. regardez le noyau (par exemple avec l'outil 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

Answer 2

Je viens d'essayer de faire une analyse comparative avec Critère et GHC 6.12.1, et la boucle A ne me semble que légèrement plus rapide. Je n'ai absolument pas l'effet bizarre "les deux ensemble sont plus rapides que B seul".

De même, si votre fonction pas à pas n'est qu'une fonction pas à pas et ne fait rien de bizarre avec son argument, la version suivante de for semble un peu plus rapide, surtout pour les petits tableaux :

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

Voici les résultats de Criterion, où loopA' est votre boucle A en utilisant mon for' et où loopC est à la fois A et 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<

Et voici le code :

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 ]