haskell - Haskell 中的朴素合并排序并行化没有加速

Question

注:此帖于 2011-06-10 完全改写；感谢彼得帮助我。另外，如果我不接受一个答案，请不要生气，因为这个问题似乎相当开放。 (但是，如果你解决了它，你当然会得到复选标记)。

另一位用户发布了一个关于并行化合并排序的问题。我以为我会写一个简单的解决方案，但可惜它并不比顺序版本快多少。

问题陈述

合并排序是一种分治算法，其中计算的叶子可以并行化。



代码工作如下:将列表转换为树，表示计算节点。然后，合并步骤为每个节点返回一个列表。从理论上讲，我们应该看到一些显着的性能提升，因为我们正在从 O(n log n) 算法转变为具有无限处理器的 O(n) 算法。

当下面的参数 l(级别)大于零时，计算的第一步是并行化的。这是通过[通过变量strat]选择rpar策略来完成的，这将使子计算mergeSort'x与mergeSort'y并行发生。然后，我们合并结果，并使用 rdeepseq 强制对其进行评估。

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)

instance NFData a => NFData (Tree a) where
    rnf (Leaf v) = deepseq v ()
    rnf (Node x y) = deepseq (x, y) ()

listToTree [] = error "listToTree -- empty list"
listToTree [x] = Leaf x
listToTree xs = uncurry Node $ listToTree *** listToTree $
    splitAt (length xs `div` 2) xs

-- mergeSort' :: Ord a => Tree a -> Eval [a]
mergeSort' l (Leaf v) = return [v]
mergeSort' l (Node x y) = do
    xr <- strat $ runEval $ mergeSort' (l - 1) x
    yr <- rseq $ runEval $ mergeSort' (l - 1) y
    rdeepseq (merge xr yr)
    where
        merge [] y = y
        merge x [] = x
        merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys)
                            | otherwise = y : merge (x:xs) ys
        strat | l > 0 = rpar
              | otherwise = rseq

mergeSort = runEval . mergeSort' 10

通过只评估几个级别的计算，我们也应该有相当好的并行通信复杂度——n的一些常数因子阶。

结果

在此处获取第 4 版源代码 [ http://pastebin.com/DxYneAaC ]，并使用以下命令运行它以检查线程使用情况，或用于基准测试的后续命令行，

rm -f ParallelMergeSort; ghc -O2 -O3 -optc-O3 -optc-ffast-math -eventlog --make -rtsopts -threaded ParallelMergeSort.hs
./ParallelMergeSort +RTS -H512m -K512m -ls -N
threadscope ParallelMergeSort.eventlog

24 核 X5680 @ 3.33GHz 的结果显示几乎没有改进

> ./ParallelMergeSort 
initialization: 10.461204s sec.
sorting: 6.383197s sec.
> ./ParallelMergeSort +RTS -H512m -K512m -N
initialization: 27.94877s sec.
sorting: 5.228463s sec.

在我自己的机器上，四核 Phenom II，

> ./ParallelMergeSort 
initialization: 18.943919s sec.
sorting: 10.465077s sec.
> ./ParallelMergeSort +RTS -H512m -K512m -ls -N
initialization: 22.92075s sec.
sorting: 7.431716s sec.

在 threadscope 中检查结果显示对少量数据的良好利用。 (但遗憾的是，没有明显的加速)。但是，当我尝试在更大的列表上运行它时，就像上面一样，它使用大约 2 个 cpu 的时间。似乎有很多 Spark 正在被修剪。它对内存参数也很敏感，其中 256mb 是最佳位置，128mb 是 9 秒，512 是 8.4，1024 是 12.3!

我正在寻找的解决方案

最后，如果有人知道一些强大的工具可以解决这个问题，我将不胜感激。 (伊甸园？)。我对 Haskell 并行性的主要兴趣是能够为研究项目编写小型支持工具，我可以将其放在我们实验室集群中的 24 或 80 核服务器上。由于它们不是我们小组研究的重点，我不想花太多时间在并行化效率上。所以，对我来说，越简单越好，即使我最终只获得了 20% 的使用率。

进一步讨论

我注意到 threadscope 中的第二个栏有时是绿色的(参见它的 homepage，其中第二个栏似乎总是垃圾收集)。这是什么意思？

有没有办法回避垃圾收集？似乎要花很多时间。例如，为什么不能对子计算进行 fork ，在共享内存中返回结果，然后死掉？

有没有更好的方法(箭头，应用)来表达并行性？

Answer 1

答案很简单:因为您根本没有引入并行性。 Eval只是一个命令计算的单子(monad)，你必须要求手动并行执行的事情。你可能想要的是:

do xr <- rpar $ runEval $ mergeSort' x
   yr <- rseq $ runEval $ mergeSort' y
   rseq (merge xr yr)

这将使 Haskell 实际上为第一次计算创建一个 Spark ，而不是试图在现场进行评估。

标准提示也适用:

应该对结果进行深入评估(例如，使用 evalTraversable rseq )。否则，您将只强制树的头部，并且大部分数据将未经评估而返回。

只是激发一切很可能会吞噬任何 yield 。引入一个在较低递归级别停止触发的参数将是一个好主意。

编辑:在问题编辑 之后，以下内容实际上不再适用

但最糟糕的部分在最后:您所说的算法存在很大缺陷。您的顶级 seq只强制列表的第一个 cons-cell，这使得 GHC 可以很好地使用惰性。它永远不会真正构建结果列表，只是在搜索最小元素时遍历所有这些元素(这甚至不是严格需要的，但 GHC 仅在知道最小值后才生成单元格)。

因此，当您在假设您在程序中的某个时刻需要整个列表的情况下开始引入并行性时，当性能实际上急剧下降时，请不要感到惊讶......

编辑 2:对编辑的更多回答

您的程序最大的问题可能是它使用了列表。如果您想制作的不仅仅是一个玩具示例，请考虑至少使用(未打包的)数组。如果您想进行认真的数字运算，可以考虑使用专门的库，例如 repa .

关于“进一步讨论”:

颜色代表不同的 GC 状态，我不记得是哪个。尝试查看相关事件的事件日志。

“回避”垃圾收集的方法是首先不要产生这么多垃圾，例如通过使用更好的数据结构。

好吧，如果您正在寻找有关稳健并行化的灵感，可能值得一看 monad-par ，这是相对较新的，但(我觉得)它的并行行为不那么“令人惊讶”。

使用 monad-par，您的示例可能会变成这样:

  do xr <- spawn $ mergeSort' x
     yr <- spawn $ mergeSort' y
     merge <$> get xr <*> get yr

所以这里是 get实际上强制您指定连接点 - 库执行所需的 deepseq自动在幕后。