我有一个看似微不足道的并行快速排序实现,代码如下:
import System.Random
import Control.Parallel
import Data.List
quicksort :: Ord a => [a] -> [a]
quicksort xs = pQuicksort 16 xs -- 16 is the number of sparks used to sort
-- pQuicksort, parallelQuicksort
-- As long as n > 0 evaluates the lower and upper part of the list in parallel,
-- when we have recursed deep enough, n==0, this turns into a serial quicksort.
pQuicksort :: Ord a => Int -> [a] -> [a]
pQuicksort _ [] = []
pQuicksort 0 (x:xs) =
let (lower, upper) = partition (< x) xs
in pQuicksort 0 lower ++ [x] ++ pQuicksort 0 upper
pQuicksort n (x:xs) =
let (lower, upper) = partition (< x) xs
l = pQuicksort (n `div` 2) lower
u = [x] ++ pQuicksort (n `div` 2) upper
in (par u l) ++ u
main :: IO ()
main = do
gen <- getStdGen
let randints = (take 5000000) $ randoms gen :: [Int]
putStrLn . show . sum $ (quicksort randints)
我使用以下编译器
ghc --make -threaded -O2 quicksort.hs
并且跑步
./quicksort +RTS -N16 -RTS
无论我做什么,都不能使这个程序在多个CPU上运行得比在单个CPU上运行的简单顺序实现快。
- 能否解释一下为什么这个程序在多个CPU上运行得比单个CPU上慢那么多?
- 是否有可能通过某些技巧使其至少与CPU数量呈次线性缩放?
编辑:@tempestadept暗示快速排序本身就是问题所在。为了验证这一点,我按照上面的示例实现了一个简单的归并排序。它具有相同的行为,添加的处理能力越多,性能表现越差。
import System.Random
import Control.Parallel
splitList :: [a] -> ([a], [a])
splitList = helper True [] []
where helper _ left right [] = (left, right)
helper True left right (x:xs) = helper False (x:left) right xs
helper False left right (x:xs) = helper True left (x:right) xs
merge :: (Ord a) => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) = case x<y of
True -> x : merge xs (y:ys)
False -> y : merge (x:xs) ys
mergeSort :: (Ord a) => [a] -> [a]
mergeSort xs = pMergeSort 16 xs -- we use 16 sparks
-- pMergeSort, parallel merge sort. Takes an extra argument
-- telling how many sparks to create. In our simple test it is
-- set to 16
pMergeSort :: (Ord a) => Int -> [a] -> [a]
pMergeSort _ [] = []
pMergeSort _ [a] = [a]
pMergeSort 0 xs =
let (left, right) = splitList xs
in merge (pMergeSort 0 left) (pMergeSort 0 right)
pMergeSort n xs =
let (left, right) = splitList xs
l = pMergeSort (n `div` 2) left
r = pMergeSort (n `div` 2) right
in (r `par` l) `pseq` (merge l r)
ris :: Int -> IO [Int]
ris n = do
gen <- getStdGen
return . (take n) $ randoms gen
main = do
r <- ris 100000
putStrLn . show . sum $ mergeSort r
pseq
来使其表现更好,即使使用sum
清除了任何可能的thunks。也许涉及到完全不同的问题。 ——由于我已经删除了我的答案,所以在这里再次作为评论:1.将该函数命名为quicksort
可能会引起混淆,因为您不会期望这样的函数接受额外的并行性参数;2.对于顶级函数,始终使用类型签名,尤其是当它们的工作方式略有不同于名称所示时;3.如果可能,请使用库函数,例如partition
。 ——顺便说一句,这是一个很好的问题。 - leftaroundaboutl `par` u `pseq`(u ++ l)
。(2) 虽然你在并行运行子计算,但它们直到需要时才真正被评估。因此,你应该强制每个子列表到 NF(或至少其完整结构),类似于forceList l `par` forceList u `pseq` (u ++ l)
,其中forceList
是(你自己的)强制评估列表的函数。另外,为了进行适当的基准测试,我建议使用criterion。 - Petr