Haskell 中的简单合并排序并行化没有加速

注：这篇文章于2011-06-10完全重写；感谢彼得帮助我。另外，如果我不接受一个答案，请不要生气，因为这个问题似乎是相当开放式的。 （但是，如果你解决了它，当然你会得到复选标记）。

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

问题陈述

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

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

计算的第一步是并行的，当参数l(level) 大于零以下。这是通过 [via 变量strat] 选择rpar策略，这将使子计算合并排序'x并行发生合并排序。然后，我们合并结果，并强制其评估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.

Results

在这里获取第四版源代码[http://pastebin.com/DxYneAaC 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。似乎很多火花都被修剪掉了。它对内存参数也很敏感，其中 256mb 是最佳位置，128mb 为 9 秒，512 为 8.4，1024 为 12.3！

我正在寻找的解决方案

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

进一步讨论

• 我注意到 threadscope 中的第二个条有时是绿色的（参见其homepage http://research.microsoft.com/en-us/projects/threadscope/，其中第二个栏似乎始终是垃圾收集）。这是什么意思？
• 有什么办法可以避免垃圾收集吗？看来要花很多时间了。例如，为什么不能分叉子计算，将结果返回到共享内存中，然后死掉？
• 有没有更好的方式（箭头，应用）来表达并行性？

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

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

这将使 Haskell 实际上为第一次计算创建一个 Spark，而不是尝试当场评估它。

标准提示也适用：

1. 应深入评估结果（例如使用evalTraversable rseq）。否则，您只会强制树的头部，并且大部分数据将未经评估而返回。
2. 仅仅激发一切很可能会耗尽所有收益。引入一个在较低递归级别停止产生火花的参数是一个好主意。

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

但最糟糕的部分是：你所说的算法非常有缺陷。您的顶层seq只强制列表中的第一个 cons-cell，这使得 GHC 可以利用惰性来发挥巨大的作用。它永远不会真正构建结果列表，只是在搜索最小元素时遍历所有结果列表（这甚至不是严格需要的，但 GHC 仅在已知最小值后才生成单元格）。

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

编辑2：对编辑的更多答案

您的程序最大的问题可能是它使用列表。如果您想要制作的不仅仅是一个玩具示例，请至少考虑使用（解压缩的）数组。如果你想进行严肃的数字运算，也许可以考虑一个专门的库，比如repa http://hackage.haskell.org/package/repa.

关于“进一步讨论”：

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

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

• 好吧，如果您正在寻找强大并行化的灵感，那么可能值得一看单体 http://hackage.haskell.org/package/monad-par，这是相对较新的，但（我觉得）其并行行为不那么“令人惊讶”。

使用 monad-par，你的例子可能会变成这样：

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

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