haskell - 使用 ST monad

Question

在博客文章中，http://galvanist.com/post/83741037068/adding-badly-under-python-julia-go ，作者使用一个简单的算法来比较各种语言(包括Haskell)的性能。在Haskell的例子中，作者使用了递归函数。作为练习，我想使用 ST monad 来允许本地可变状态。这可行，但递归函数比我使用 ST monad 的函数快得多。

递归函数-

peanoAdd :: Int -> Int -> Int
peanoAdd 0 y = y
peanoAdd x y = peanoAdd (x - 1) (y + 1)

main :: IO ()
main = do
    let a = 64000000 :: Int
    let b = 64000000 :: Int
    let n = peanoAdd a b
    print n

128000000

real    0m0.583s
user    0m0.480s
sys     0m0.096s

使用 ST monad-

import Control.Monad.ST
import Data.STRef
import Control.Monad.Loops

peanoAdd :: Int -> Int -> Int
peanoAdd x y = runST $ do
    x' <- newSTRef x
    y' <- newSTRef y
    whileM_ (do x'' <- readSTRef x'
                return $ x'' /= 0)
            (do modifySTRef x' (subtract 1)
                modifySTRef y' (+1))
    readSTRef y'

main :: IO ()
main = do
    let a = 64000000 :: Int
    let b = 64000000 :: Int
    let n = peanoAdd a b
    print n

128000000

real    0m17.837s
user    0m16.412s
sys     0m1.424s

我做的事情是否明显错误，从而损害了 ST monad 示例中的性能？ (PS。我在这两个项目中都使用 Stack 和简单模板。)

Answer 1

ST 程序运行缓慢的一个原因是您正在使用 modifySTRef, which is non-strict :

Be warned that modifySTRef does not apply the function strictly. This means if the program calls modifySTRef many times, but seldomly uses the value, thunks will pile up in memory resulting in a space leak. This is a common mistake made when using an STRef as a counter. For example, the following will leak memory and likely produce a stack overflow:

print $ runST $ do
    ref <- newSTRef 0
    replicateM_ 1000000 $ modifySTRef ref (+1)
    readSTRef ref

你的x'每个循环都会被强制一次，但是y'直到print才会被强制，所以有一个巨大的链thunk 建立起来。

在我的笔记本电脑上对使用 modifySTRef' 的版本进行基准测试，显示严格性如何改善运行时间(尽管两者仍然输给递归版本)。

benchmarking rec
time                 7.896 ms   (7.602 ms .. 8.269 ms)
                     0.992 R²   (0.988 R² .. 0.997 R²)
mean                 7.842 ms   (7.724 ms .. 8.001 ms)
std dev              404.5 μs   (303.9 μs .. 523.8 μs)
variance introduced by outliers: 25% (moderately inflated)

benchmarking st
time                 18.44 ms   (17.84 ms .. 19.01 ms)
                     0.996 R²   (0.993 R² .. 0.998 R²)
mean                 18.03 ms   (17.79 ms .. 18.41 ms)
std dev              750.4 μs   (528.0 μs .. 1.110 ms)
variance introduced by outliers: 16% (moderately inflated)

benchmarking st'
time                 9.191 ms   (9.028 ms .. 9.437 ms)
                     0.996 R²   (0.992 R² .. 0.999 R²)
mean                 9.317 ms   (9.175 ms .. 9.527 ms)
std dev              475.8 μs   (311.8 μs .. 677.9 μs)
variance introduced by outliers: 25% (moderately inflated)

基准测试代码:

import Criterion.Main
import Control.Monad.ST
import Data.STRef
import Control.Monad.Loops

peanoAddST :: Int -> Int -> Int
peanoAddST x y = runST $ do
    x' <- newSTRef x
    y' <- newSTRef y
    whileM_ (do x'' <- readSTRef x'
                return $ x'' /= 0)
            (do modifySTRef x' (subtract 1)
                modifySTRef y' (+1))
    readSTRef y'

peanoAddST' :: Int -> Int -> Int
peanoAddST' x y = runST $ do
    x' <- newSTRef x
    y' <- newSTRef y
    whileM_ (do x'' <- readSTRef x'
                return $ x'' /= 0)
            (do modifySTRef' x' (subtract 1)
                modifySTRef' y' (+1))
    readSTRef y'

peanoAddRec :: Int -> Int -> Int
peanoAddRec 0 y = y
peanoAddRec x y = peanoAddRec (x - 1) (y + 1)

main =
  let n = 64000 in
  defaultMain
  [ bench "rec" $ whnf (peanoAddRec n) n
  , bench "st" $ whnf (peanoAddST n) n
  , bench "st'" $ whnf (peanoAddST' n) n
  ]