并行性能排序

Question

我尝试用多核运行一些程序，结果有点困惑。 默认情况下，在下面的程序中排序需要 20 秒，当我使用 +RTS -N2 运行它时大约需要 16 秒，但使用 +RTS -N4 需要 21 秒！

为什么会这样？并且有没有每个额外内核变得更快的程序示例？ （与教程中的其他程序有相似的结果）

以下是程序示例：

import Data.List
import Control.Parallel
import Data.Time.Clock.POSIX

qsort :: Ord a => [a] -> [a]
qsort (x:xs)
  = let a = qsort $ filter (<=x) xs
        b = qsort $ filter (>x)  xs
    in b `par` a ++ x:b
qsort [] = []


randomList :: Int -> [Int]
randomList n = take n $ tail (iterate lcg 1)
  where lcg x = (a * x + c) `rem` m
        a = 1664525
        c = 1013904223
        m = 2^32

main :: IO ()
main = do
  let randints = randomList 5000000
  t1 <- getPOSIXTime
  print . sum $ qsort randints
  t2 <- getPOSIXTime
  putStrLn $ "SORT TIME: " ++ show (t2 - t1) ++ "\n"

Answer 1

我无法复制您的结果。 （这是一件好事，因为我认为我是声称使用您发布的代码使用 -N2 和 -N4 看到性能改进的人。）

在使用 GHC 8.8.3 的 Linux 上，并使用 -O2 -threaded 编译为独立的可执行文件，我在 4 核桌面上得到以下时间：

$ stack ghc -- --version
Stack has not been tested with GHC versions above 8.6, and using 8.8.3, this may fail
Stack has not been tested with Cabal versions above 2.4, but version 3.0.1.0 was found, this may fail
The Glorious Glasgow Haskell Compilation System, version 8.8.3
$ stack ghc -- -O2 -threaded QuickSort3.hs
Stack has not been tested with GHC versions above 8.6, and using 8.8.3, this may fail
Stack has not been tested with Cabal versions above 2.4, but version 3.0.1.0 was found, this may fail
[1 of 1] Compiling Main             ( QuickSort3.hs, QuickSort3.o )
Linking QuickSort3 ...
$ ./QuickSort3 +RTS -N1
10741167410134688
SORT TIME: 7.671760902s

$ ./QuickSort3 +RTS -N2
10741167410134688
SORT TIME: 5.700858877s

$ ./QuickSort3 +RTS -N3
10741167410134688
SORT TIME: 4.88330669s

$ ./QuickSort3 +RTS -N4
10741167410134688
SORT TIME: 4.93364958s

我在 16 核 Linux 笔记本电脑上得到了类似的结果，在该笔记本电脑上运行 4 核 Windows 虚拟机（也使用 GHC 8.8.3）也得到了类似的结果。

我可以为您的结果想出一些可能的解释。

首先，我没有一台速度非常快的台式机，所以你的 20 秒时间似乎很可疑。您是否可能正在做类似的事情：

$ stack runghc QuickSort3.hs +RTS -N4

如果是这样，这会将+RTS 标志传递给stack，然后使用慢速字节码解释器以单线程模式运行Haskell 程序。在我的测试中，无论我通过什么 -Nx 标志值，排序都需要大约 30 秒。

其次，您是否有可能在内核数量有限的虚拟机上运行此程序（或非常旧的两核硬件）？如前所述，我尝试在 Windows 虚拟机下进行测试，得到的结果与使用 4 核虚拟机的 Linux 版本相似，但使用 2 核虚拟机的结果非常不稳定（例如，@987654330 的 11.4、13.0 和 51.3 秒） @、-N2 和 -N4，因此一般来说，更多内核的性能较差，而 4 内核的性能非常差）。

您可以尝试以下简单的并行求和基准，它可能会更好地扩展：

import Data.List
import Control.Parallel
import Data.Time.Clock.POSIX

randomList :: Int -> Int -> [Int]
randomList seed n = take n $ tail (iterate lcg seed)
  where lcg x = (a * x + c) `rem` m
        a = 1664525
        c = 1013904223
        m = 2^32

main :: IO ()
main = do
  t1 <- getPOSIXTime
  let n = 50000000
      a = sum $ randomList 1 n
      b = sum $ randomList 2 n
      c = sum $ randomList 3 n
      d = sum $ randomList 4 n
      e = sum $ randomList 5 n
      f = sum $ randomList 6 n
      g = sum $ randomList 7 n
      h = sum $ randomList 8 n
  print $ a `par` b `par` c `par` d `par` e `par` f `par` g `par` h `par` (a+b+c+d+e+f+g+h)
  t2 <- getPOSIXTime
  putStrLn $ "SORT TIME: " ++ show (t2 - t1) ++ "\n"