Question

我想知道如何改善逻辑图上白噪声的时间性能？仅在计算值后才允许添加噪声（因为它是迭代映射）。

 module Generating

import System.Random (Random,randomR,random,mkStdGen,StdGen)
import Data.Random.Normal (mkNormals,normal)
import qualified Data.Vector.Unboxed as U 
import Control.Monad.State

genR :: (Random a, Fractional a) => Int -> (a, StdGen)
genR x = randomR (0,1.0) (mkStdGen x)


new ::Double-> Double ->Int -> (Double,Int) -> U.Vector (Double,Int)
new skal r n = U.unfoldrN n go
  where  
   go (x0,g0)  = let  !eins= (1.0-x0)
                      !x=x0 `seq` eins `seq` r*x0*eins
                      !g=g0+1
                      !noise= skal*(fst $ genR g)
             in Just ((x0+noise,g0),(x,g))

fs :: (t, t1) -> t
fs (x,y)=x

first :: U.Vector (Double,Int)->U.Vector Double
first  =U.map (\(x,y)->x)

如您所见，我实际上只想要元组的第一个值，但是生成器需要更新。

有什么建议吗？也许是单子状态？

Answer 1

tl; dr：：不要在不使用性能分析和基准测试的情况下尝试优化Haskell程序。添加随机感叹号和seq几乎是行不通的。实际上，这里的最大问题是StdGen是一个非常慢的随机数生成器，它完全控制了程序的执行时间。您需要更换它才能取得重大进展。

这是更长的答案：一个好的第一步是安装一个基准测试库，例如criterion，并编写一个测试用例：

import Criterion.Main

...your program above...

vect1 :: (Double, Int) -> U.Vector Double
vect1 = first . new 0.5 1 10000

main = defaultMain [
  bench "vect1" $ nf vect1 (0,1)
  ]

就我而言，结果如下：

benchmarking vect1
time                 8.097 ms   (8.071 ms .. 8.125 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.140 ms   (8.124 ms .. 8.162 ms)
std dev              52.90 μs   (36.32 μs .. 91.72 μs)

所以我们每次运行大约需要8毫秒才能生成10000个元素的向量。

现在，让我们摆脱为加快速度而添加的所有爆炸，seq和中间计算：

new :: Double-> Double -> Int -> (Double, Int) -> U.Vector (Double,Int)
new skal r n = U.unfoldrN n go
  where  
   go (x0,g0)  = let  x = r * x0 * (1-x0)
                      g = g0 + 1
                      noise = skal * (fst $ genR g)
                 in Just ((x0+noise, g0), (x,g))

正在运行，结果如下：

time                 8.195 ms   (8.168 ms .. 8.235 ms)

啊，所以它们根本没有效果。很高兴我们摆脱了他们。

现在，值得注意的是unfoldrN为您带来了蓄积着g的蓄能器。如果您仍然要丢弃它，那么您也不需要在结果中包括g，因此我们可以将new简化为：

new :: Double-> Double -> Int -> (Double, Int) -> U.Vector Double
new skal r n = U.unfoldrN n go
  where  
   go (x0,g0)  = let  x = r * x0 * (1-x0)
                      g = g0 + 1
                      noise = skal * (fst $ genR g)
                 in Just (x0+noise, (x,g))

并从first的定义中删除vect1调用：

vect1 :: (Double, Int) -> U.Vector Double
vect1 = new 0.5 1 10000

这给出了：

time                 8.289 ms   (8.238 ms .. 8.373 ms)

所以它并没有真正的改变。毫无疑问，编译器仍然能够优化掉无用的额外Double，因此更改代码没有任何作用。

该算法的一个更严重的问题是它以一种非常奇怪的方式使用了生成器。 StdGen应当被播种，然后被重新使用以生成多个随机数，而不是基于计数器从种子中新鲜生成。我们确实应该重写new才能正确使用生成器：

new :: Double-> Double -> Int -> (Double, Int) -> U.Vector Double
new skal r n (x0, seed) = U.unfoldrN n go (x0, g0)
  where
   g0 = mkStdGen seed  -- create initial generator from seed
   go (x0,g0)  = let  (eps, g) = randomR (0, 1.0) g0 -- use generator properly
                      x = r * x0 * (1-x0)
                      noise = skal * eps
                 in Just (x0 + noise, (x, g))

尽管如此，这与基准测试时间几乎没有区别。我承认这使我感到惊讶。我认为这会产生重大影响。我正在对这些更改进行基准测试，这是一件好事，所以我有实际客观证据证明此更改的影响（或没有影响）！

现在，似乎是时候该分析我们的程序了，看看它在花时间在做什么。

$ stack ghc -- -prof -fprof-auto -O2 Generating.hs
$ ./Generating -n 100 +RTS -p   # run 100 iterations

如果查看输出的Generating.prof文件，您会发现System.Random中花费了大部分时间，就像这样：

COST CENTRE               MODULE                            SRC                                                    %time %alloc

randomR                   System.Random                     System/Random.hs:409:3-27                               21.7   24.0
stdNext                   System.Random                     System/Random.hs:(518,1)-(528,64)                       15.4   16.6
randomIvalInteger         System.Random                     System/Random.hs:(468,1)-(489,76)                       12.2   12.0
randomIvalInteger.f       System.Random                     System/Random.hs:(486,8)-(489,76)                       11.0    4.8
randomIvalInteger.f.v'    System.Random                     System/Random.hs:489:25-76                               7.0    8.6

事实证明，Haskell的标准随机数生成器非常慢，我们需要用更快的速度替换它以取得更大的进步。

mersenne-random-pure64软件包提供了一种快速的Mersenne Twister实现，可产生高质量的随机数，我们可以重写new来使用它。请注意，randomDouble在间隔[0,1)中返回一个统一的随机数：

import System.Random.Mersenne.Pure64
new :: Double-> Double -> Int -> (Double, Int) -> U.Vector Double
new skal r n (x0, seed) = U.unfoldrN n go (x0, g0)
  where
   g0 = pureMT (fromIntegral seed)
   go (x0,g0)  = let (eps, g) = randomDouble g0
                     x = r * x0 * (1-x0)
                     noise = skal * eps
                 in Just (x0 + noise, (x, g))

重新进行基准测试（无需配置即可重新编译）会给出：

benchmarking vect1
time                 106.7 μs   (106.4 μs .. 107.0 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 107.1 μs   (106.7 μs .. 107.7 μs)
std dev              1.415 μs   (842.3 ns .. 2.377 μs)

请注意，这是107个微秒，因此快了75倍。

这就是我要停止的地方，但是如果您决定继续进行优化，请确保经常参考性能分析和基准测试结果，以确保所做的更改有效。

我强烈建议将Google搜索用于“分析haskell程序”和“标准”库，并花一些时间来学习如何使用这些工具。

供参考，最终程序是：

import Criterion.Main
import qualified Data.Vector.Unboxed as U 
import System.Random.Mersenne.Pure64

new :: Double-> Double -> Int -> (Double, Int) -> U.Vector Double
new skal r n (x0, seed) = U.unfoldrN n go (x0, g0)
  where
   g0 = pureMT (fromIntegral seed)
   go (x0,g0)  = let (eps, g) = randomDouble g0
                     x = r * x0 * (1-x0)
                     noise = skal * eps
                 in Just (x0 + noise, (x, g))

vect1 :: (Double, Int) -> U.Vector Double
vect1 = new 0.5 1 10000

main = defaultMain [
  bench "vect1" $ nf vect1 (0,1)
  ]

Haskell：具有更多噪声的效率迭代图

1 个答案: