Question

在阅读Stack Overflow问题 Using vectors for performance improvement in Haskell 描述Haskell中的快速就地quicksort后，我为自己设定了两个目标：

实现中位数为3的相同算法，以避免对预先排序的向量产生不良影响;
制作并行版本。

结果如下（为简单起见，我们留下了一些小部件）：

import qualified Data.Vector.Unboxed.Mutable as MV
import qualified Data.Vector.Generic.Mutable as GM

type Vector = MV.IOVector Int
type Sort = Vector -> IO ()

medianofthreepartition :: Vector -> Int -> IO Int
medianofthreepartition uv li = do
    p1 <- MV.unsafeRead uv li
    p2 <- MV.unsafeRead uv $ li `div` 2
    p3 <- MV.unsafeRead uv 0
    let p = median p1 p2 p3
    GM.unstablePartition (< p) uv

vquicksort :: Sort
vquicksort uv = do
    let li = MV.length uv - 1
    j <- medianofthreepartition uv li
    when (j > 1) (vquicksort (MV.unsafeSlice 0 j uv))
    when (j + 1 < li) (vquicksort (MV.unsafeSlice (j+1) (li-j) uv))

vparquicksort :: Sort
vparquicksort uv = do
    let li = MV.length uv - 1
    j <- medianofthreepartition uv li
    t1 <- tryfork (j > 1) (vparquicksort (MV.unsafeSlice 0 j uv))
    t2 <- tryfork (j + 1 < li) (vparquicksort (MV.unsafeSlice (j+1) (li-j) uv))
    wait t1
    wait t2

tryfork :: Bool -> IO () -> IO (Maybe (MVar ()))
tryfork False _ = return Nothing
tryfork True action = do
  done <- newEmptyMVar :: IO (MVar ())
  _ <- forkFinally action (\_ -> putMVar done ())
  return $ Just done

wait :: Maybe (MVar ()) -> IO ()
wait Nothing = return ()
wait (Just done) = swapMVar done ()

median :: Int -> Int -> Int -> Int
median a b c
        | a > b =
                if b > c then b
                        else if a > c then c
                                else a
        | otherwise =
                if a > c then a
                        else if b > c then c
                                else b

对于具有1,000,000个元素的载体，我得到以下结果：

"Number of threads: 4"

"**** Parallel ****"
"Testing sort with length: 1000000"
"Creating vector"
"Printing vector"
"Sorting random vector"
CPU time:  12.30 s
"Sorting ordered vector"
CPU time:   9.44 s

"**** Single thread ****"
"Testing sort with length: 1000000"
"Creating vector"
"Printing vector"
"Sorting random vector"
CPU time:   0.27 s
"Sorting ordered vector"
CPU time:   0.39 s

我的问题是：

为什么表演仍然会因预先排序的矢量而减少？
为什么使用forkIO和四个线程无法提高性能？

Answer 1

更好的想法是使用Control.Parallel.Strategies来并行化快速排序。使用这种方法，您不会为可以并行执行的每个代码创建昂贵的线程。您也可以创建纯计算而不是IO。

然后你必须根据你拥有的核心数进行编译： http://www.haskell.org/ghc/docs/latest/html/users_guide/using-concurrent.html

举个例子，看看Jim Apple编写的这个简单的快速排序：

import Data.HashTable as H
import Data.Array.IO
import Control.Parallel.Strategies
import Control.Monad
import System

exch a i r =
    do tmpi <- readArray a i
       tmpr <- readArray a r
       writeArray a i tmpr
       writeArray a i tmpi

bool a b c = if c then a else b

quicksort arr l r =
  if r <= l then return () else do
    i <- loop (l-1) r =<< readArray arr r
    exch arr i r
    withStrategy rpar $ quicksort arr l (i-1)
    quicksort arr (i+1) r
  where
    loop i j v = do
      (i', j') <- liftM2 (,) (find (>=v) (+1) (i+1)) (find (<=v) (subtract 1) (j-1))
      if (i' < j') then exch arr i' j' >> loop i' j' v
                   else return i'
    find p f i = if i == l then return i
                 else bool (return i) (find p f (f i)) . p =<< readArray arr i

main = 
    do [testSize] <- fmap (fmap read) getArgs
       arr <- testPar testSize
       ans <- readArray arr  (testSize `div` 2)
       print ans

testPar testSize =
    do x <- testArray testSize
       quicksort x 0 (testSize - 1)
       return x

testArray :: Int -> IO (IOArray Int Double)
testArray testSize = 
    do ans <- newListArray (0,testSize-1) [fromIntegral $ H.hashString $ show i | i <- [1..testSize]]
       return ans

在Haskell中快速排序

1 个答案: