Haskell 并行Repa代码不'；不要制造火花

我正在编写代码来生成一个子集产品：它包含一个元素列表和一个指示符变量列表（长度相同）。乘积是在树中计算的，这对我们的应用程序至关重要。每个产品都很昂贵，所以我的目标是并行计算树的每个级别，按顺序评估连续的级别。因此，不存在任何嵌套并行

我只在一个函数中有repa代码，接近我的总体代码的顶层。注意subsetProd不是一元的

步骤如下：

将列表分组成对（无并行性）

压缩分块列表（无并行性）

将产品功能映射到此列表（使用Repa映射），创建延迟数组

调用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 7.6.2 x64上

我使用

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

那么，为什么Repa没有产生任何火花呢？我的产品树有64个叶子，所以即使Repa为每个内部节点产生火花，也应该有~63个火花。我觉得这可能与我使用封装并行性的ST monad有关，尽管我不太清楚为什么这会引起问题。也许火花只能在IO单子中产生

如果是这种情况，是否有人知道我如何执行这个树产品，其中每个级别都是并行完成的（而不会导致嵌套并行，这对我的任务来说似乎是不必要的）。一般来说，也许有更好的方法来并行化树产品或更好地利用Repa

解释为什么运行时会随着-N参数的增加而增加，即使没有创建火花，这也有好处

编辑 我将上面的代码示例更改为问题的编译示例。程序流程几乎完全符合我的真实代码：我随机选择一些输入，然后对它们进行子集积。我现在正在使用。我已经尝试过对代码进行很多小的修改：是否内联、是否使用bang模式、使用两个Repa列表和一个Repa zipWith与按顺序压缩列表和使用Repa映射等，这些都没有任何帮助

即使我在示例代码中遇到问题，我的实际程序也要大得多。

为什么没有并行性？ 没有并行性的主要原因（至少对于您现在已经简化且正在运行的程序而言）是您在

V

表示的数组上使用

computeP

，并且法向量的元素类型并不严格。所以你实际上并没有同时做任何真正的工作。最简单的修复方法是通过将

force

更改为以下定义，使用未绑定的

U

数组作为结果：

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

我记得，在您的原始代码中，您声称您正在处理一个复杂的数据类型，而该数据类型并没有解除绑定。但这真的不可能吗？也许您可以将实际需要的数据提取到某种不可伸缩的表示形式中？或者将该类型作为

Unbox

类的实例？如果没有，则还可以使用适用于

V

-阵列的

force

的以下变体：

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

import Control.DeepSeq（NFData（..）
...
力：：（形状sh，NFData e）=>阵列D sh e->阵列V sh e
强制a=runIdentity$do
r
g
定义在哪里？为了对性能问题进行更详细的分析，对代码进行精简但可编译的版本确实会有所帮助。一些小评论：我不确定是否值得先构建清单数组
对。这也可能被推迟。为什么使用长度
2
的列表而不是成对的？结果数组可以取消绑定，因为它包含
Int
。您应该尝试生成一个事件日志并运行threadscope，以查看程序的某些阶段是否出现并行。哦，我现在才看到
subsetProd
是递归的。您确定要将数组转换为列表，只是为了在每个步骤中从中重新计算数组吗？@JohnL这只是一个大得多的程序的片段。上面的代码中有几个“外部”调用，但它们都是纯的、顺序的（昂贵的）函数。@kosmikus清单数组不应该被延迟，对吗？我想这就是重点。我之所以使用列表，是因为有一个很好的函数（在Data.List.Split中）可以为我进行分块。正如我在问题中所说，在执行的最后一毫秒之前，Threadscope在程序代码中显示出绝对零的并行性。GC在所有四个线程上运行。我可以举一个小例子，做一个整数子集积之类的东西，但恐怕它太快了，无法实现任何并行化。我很震惊地发现，使用非固定数组可以实现并行化。我肯定会花更多的精力来解开我的类型，但这可能会很困难。至于我为什么不首先使用数组，请参阅我对原始问题的评论，即不能像处理列表一样处理数组。谢谢你的帮助@Eric将数组分块非常简单。例如，您可以创建如下延迟数组：
fromFunction（Z:.len）$\（Z:.i）->（vals！（Z:.2*i），vals！（Z:.2*i+1））
@Eric我已经再次编辑了答案，因为Ben Lippmeier向我解释了如何使其工作
force :: (Shape sh, Unbox e) => Array D sh e -> Array U sh e
force a = runIdentity (computeP a) 

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