并行修复代码不会产生火花

我正在编写代码来完成子集产品:它需要一个元素列表和一个指示器变量列表(长度相同)。 该产品在树中计算,这对我们的应用至关重要。 每个产品都很昂贵,所以我的目标是并行计算树的每个级别,按顺序评估连续级别。 因此没有任何嵌套的并行操作正在进行。

我只有一个函数中的代码,接近我的整个代码的顶层。 请注意subsetProd不是一元的。

步骤:

  • 把这些列表组合成一对(无并行)
  • 压缩分块列表(无并行)
  • 将产品功能映射到此列表(使用Repa图),创建一个Delayed数组
  • 调用computeP并行计算地图
  • 将Repa结果转换回列表
  • 进行递归调用(在列表的一半大小的输入)
  • 代码:

    {-# LANGUAGE TypeOperators, FlexibleContexts, BangPatterns #-}
    
    import System.Random
    import System.Environment (getArgs)
    import Control.Monad.State
    import Control.Monad.Identity (runIdentity)
    
    import Data.Array.Repa as Repa
    import Data.Array.Repa.Eval as Eval
    import Data.Array.Repa.Repr.Vector
    
    force :: (Shape sh) => Array D sh e -> Array V sh e
    force = runIdentity . computeP
    
    chunk :: [a] -> [(a,a)]
    chunk [] = []
    chunk (x1:x2:xs) = (x1,x2):(chunk xs)
    
    slow_fib :: Int -> Integer
    slow_fib 0 = 0
    slow_fib 1 = 1
    slow_fib n = slow_fib (n-2) + slow_fib (n-1) 
    
    testSubsetProd :: Int -> Int -> IO ()
    testSubsetProd size seed = do
        let work = do
                !flags <- replicateM size (state random)
                !values <- replicateM size (state $ randomR (1,10))
                return $ subsetProd values flags
            value = evalState work (mkStdGen seed)
        print value
    
    subsetProd :: [Int] -> [Bool] -> Int
    subsetProd [!x] _ = x
    subsetProd !vals !flags = 
        let len = (length vals) `div` 2
            !valpairs = Eval.fromList (Z :. len) $ chunk vals :: (Array V (Z :. Int) (Int, Int))
            !flagpairs = Eval.fromList (Z :. len) $ chunk flags :: (Array V (Z :. Int) (Bool, Bool))
            !prods = force $ Repa.zipWith mul valpairs flagpairs
            mul (!v0,!v1) (!f0,!f1)
                | (not f0) && (not f1) = 1
                | (not f0) = v0+1
                | (not f1) = v1+1
                | otherwise = fromInteger $ slow_fib ((v0*v1) `mod` 35)
        in subsetProd (toList prods) (Prelude.map (uncurry (||)) (toList flagpairs))
    
    main :: IO ()
    main = do
      args <- getArgs
      let [numleaves, seed] = Prelude.map read args :: [Int]
      testSubsetProd numleaves seed
    

    整个程序与编译

    ghc -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3
    

    根据这些说明,在GHC 7.6.2 x64上。

    我运行我的程序(子集)使用

    $> time ./Test 4096 4 +RTS -sstderr -N4
    

    8秒后:

    672,725,819,784 bytes allocated in the heap
     11,312,267,200 bytes copied during GC
       866,787,872 bytes maximum residency (49 sample(s))
       433,225,376 bytes maximum slop
            2360 MB total memory in use (0 MB lost due to fragmentation)
    
                                    Tot time (elapsed)  Avg pause  Max pause
    
    
      Gen  0     1284212 colls, 1284212 par   174.17s   53.20s     0.0000s    0.0116s
      Gen  1        49 colls,    48 par   13.76s    4.63s     0.0946s    0.6412s
    
      Parallel GC work balance: 16.88% (serial 0%, perfect 100%)
    
      TASKS: 6 (1 bound, 5 peak workers (5 total), using -N4)
    
      SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
    
      INIT    time    0.00s  (  0.00s elapsed)
      MUT     time  497.80s  (448.38s elapsed)
      GC      time  187.93s  ( 57.84s elapsed)
      EXIT    time    0.00s  (  0.00s elapsed)
      Total   time  685.73s  (506.21s elapsed)
    
      Alloc rate    1,351,400,138 bytes per MUT second
    
      Productivity  72.6% of total user, 98.3% of total elapsed
    
    gc_alloc_block_sync: 8670031
    whitehole_spin: 0
    gen[0].sync: 0
    gen[1].sync: 571398
    

    我的代码确实变慢了,因为我增加了-N参数(-N1为7.628秒,-N2为7.891秒,-N4为8.659秒),但我得到了0个创建的火花,这似乎是为什么我没有得到任何平行。 而且,编译整体优化有助于运行时,但不是并行性。

    Threadscope证实,没有认真的工作正在对三个HECs进行,但垃圾收集器似乎在使用所有4个HEC。

    上面的-sstderr块的threadscope

    那么为什么不能做任何火花? 我的产品树有64个叶子,因此即使Repa对每个内部节点都产生了火花,应该有〜63个火花。 我觉得它可能与我使用封装并行性的ST monad有关,尽管我不太清楚为什么这会导致问题。 也许火花只能在IO monad中创建?

    如果是这样的话,有没有人有一个想法,我可以如何执行这个树产品,每个级别并行完成(没有导致嵌套的并行性,这对我的任务似乎不必要)。 一般来说,也许有更好的方法来并行树产品或更好地使用Repa。

    用于解释为什么运行时会随着增加-N参数而增加的奖励点,即使没有创建火花。

    编辑我将上面的代码示例更改为我的问题的编译示例。 程序流几乎完全匹配我的真实代码:我随机选择一些输入,然后在它们上面做一个子集产品。 我现在使用身份monad。 我已经尝试了很多对我的代码的小改动:内嵌或不内嵌,模式与否,使用两个Repa列表的变体以及Repa zipWith与按顺序压缩列表以及使用Repa映射等,这些都没有任何帮助。

    即使我在示例代码中遇到这个问题,我的真实程序也要大得多。


    为什么没有平行性?

    主要原因(至少对于你现在简化和工作的)没有平行性的程序是你在一个V表示数组上使用computeP ,并且法向量在它们的元素类型上并不严格。 所以你实际上并没有做任何真正的工作。 最简单的解决方法是使用unboxed U数组作为结果,将force改为此定义:

    force :: (Shape sh, Unbox e) => Array D sh e -> Array U sh e
    force a = runIdentity (computeP a) 
    

    我记得在你的原始代码中你声称你正在处理一个未拆箱的复杂数据类型。 但是真的不可能做到这一点? 也许你可以将你实际需要的数据提取到一些无法显示的表示中? 或者让该类型成为Unbox类的一个实例? 如果没有,那么你也可以使用下面的变种force ,适用于V阵列:

    import Control.DeepSeq (NFData(..))
    
    ...
    
    force :: (Shape sh, NFData e) => Array D sh e -> Array V sh e
    force a = runIdentity $ do
      r  <- computeP a
      !b <- computeUnboxedP (Repa.map rnf r)
      return r
    

    这里的想法是我们首先计算V -array结构,然后通过在数组上映射rnf来从中计算()类型的U -array。 结果数组无用,但每个V数组的元素将被强制在process1中。

    这些更改中的任何一个将运行时的问题大小从-N44096降低到-N4秒,而在我的机器上用-N4

    另外,我认为你在每一步中都在列表和数组之间进行转换是很奇怪的。 为什么不使subsetProd采用两个数组? 此外,至少对于这些值,使用中间V数组看起来没有必要,您可以使用D数组。 但在我的实验中,这些更改对运行时没有显着的有益影响。

    为什么没有火花?

    维修绝不会产生火花。 Haskell有许多不同的并行方法,火花是在运行时系统中有特殊支持的一种特殊机制。 但是,只有一些库(例如monad-par软件包的parallel程序包和一个特定调度程序)实际上使用了该机制。 但是,赔偿不。 它在内部使用forkIO ,即线程,但为外部提供纯粹的接口。 所以没有火花本身就没有什么可担心的。


    1.我本来不知道该怎么做,于是我问了怀特的作者本·利普迈耶。 非常感谢Ben指出了将rnf映射到另一个阵列的选项,还有一个事实是,有一个Unbox实例用于() ,对我来说。

    链接地址: http://www.djcxy.com/p/59977.html

    上一篇: Parallel Repa code doesn't create sparks

    下一篇: Idiomatic option pricing and risk using Repa parallel arrays