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

Question

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

我只在一个函数中修复代码,接近我整个代码的顶层.请注意,subsetProd 不是 monadic .

步骤:

1. 将列表分成对(没有并行性)
2. 压缩分块列表(没有并行性)
3. 将产品功能映射到此列表(使用Repa map),创建一个Delayed数组
4. 调用computeP来并行计算地图
5. 将Repa结果转换回列表
6. 进行递归调用(在列表的一半大小的输入)

代码:

{-# 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.

我运行我的程序(Subset)

$> 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确认没有对三个HEC进行认真的工作,但垃圾收集器似乎正在使用所有4个HEC.

那么为什么不修复任何火花呢？我的产品树有64个叶子,所以即使Repa为每个内部节点制造一个火花,也应该有~63个火花.我觉得它可能与我使用封装并行性的ST monad有关,虽然我不太清楚为什么这会导致问题.也许火花只能在IO monad中创建？

如果是这种情况,是否有人知道我如何能够执行这个树产品,其中每个级别并行完成(不会导致嵌套并行性,这对我的任务来说似乎是不必要的).通常,也许有更好的方法来并行化树产品或更好地使用Repa.

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

编辑 我改变了上面的代码示例,作为我的问题的编译示例.程序流程几乎完全匹配我的实际代码:我随机选择一些输入,然后对它们做一个子集产品.我现在正在使用身份monad.我对我的代码进行了很多小改动:内联与否,是否有模式,使用两个Repa列表的修改以及使用Repa zipWith vs依次压缩列表和使用Repa map等等,这些都没有任何帮助.

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

Answer 1

为什么没有并行性？

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

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

我记得你在原始代码中声称你正在使用一个未拆箱的复杂数据类型.但这样做真的不可能吗？也许你可以将实际需要的数据提取到一些不可用的表示中？或者使类型成为Unbox类的实例？如果没有,那么你也可以使用以下款式force的作品为V-array:

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结构,然后通过映射数组来计算它U的()类型rnf.结果数组是无趣的,但是V在进程¹中将强制每个-array的元素.

这些更改中的任何一个都会在我的机器上为运行时间提供4096从~9到约3秒的问题大小-N4.

另外,我认为你在每一步中在列表和数组之间进行转换是很奇怪的.为什么不subsetProd采取两个阵列？此外,至少对于值,使用对的中间V数组似乎是不必要的,您也可以使用D数组.但在我的实验中,这些变化对运行时没有显着的有益影响.

为什么没有火花？

维修永远不会产生火花.Haskell有许多不同的并行方法,而spark是一种在运行时系统中具有特殊支持的特殊机制.但是,只有一些库,例如parallel包和包的一个特定调度monad-par程序,实际上使用了该机制.然而,修复没有.它在forkIO内部使用,即线程,但为外部提供了纯粹的接口.所以没有火花本身就无需担心.

_{我原本不知道该怎么做,所以我问维修的作者Ben Lippmeier.非常感谢Ben指出了映射rnf生成不同数组的选项,以及对我来说有一个Unbox实例的事实().}