Haskell:效率迭代映射,增加了噪声

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)  

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

有什么建议？也许State Monads？

Answer 1

tl; dr:不要在不使用分析和基准测试的情况下尝试优化Haskell程序.添加随机感叹号和seqs几乎永远不会起作用.事实上,这里的一个大问题是,它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无论如何都能够优化掉无用的额外内容,因此更改代码没有任何效果.

算法的一个更严重的问题是它以非常奇怪的方式使用生成器.A 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)
  ]