phân loại nhanh trong Haskell

Question

Sau khi đọc Stack Overflow câu hỏi Using vectors for performance improvement in Haskell mô tả một nhanh tại chỗ quicksort trong Haskell, tôi đặt ra cho mình hai mục tiêu:

• Thực hiện các thuật toán tương tự với một trung bình của ba để tránh xấu biểu diễn trên các véc tơ được sắp xếp trước;

• Tạo phiên bản song song.

Đây là kết quả (một số mảnh nhỏ đã bị bỏ lại vì đơn giản):

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 

Đối với vectơ với 1.000.000 yếu tố, tôi nhận được kết quả sau:

"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 

Câu hỏi của tôi là:

• Tại sao biểu diễn sti sẽ giảm với một vector được sắp xếp trước?
• Tại sao sử dụng forkIO và bốn luồng không cải thiện hiệu suất?

Answer 1

Ý tưởng tốt hơn là sử dụng Control.Parallel.Strategies để song song quicksort. Với cách tiếp cận này, bạn sẽ không tạo ra các chủ đề đắt tiền cho mỗi mã có thể được thực hiện song song. Bạn cũng có thể tạo một phép tính thuần túy thay vì một IO.

Sau đó, bạn cần phải biên dịch theo số lượng lõi bạn có: http://www.haskell.org/ghc/docs/latest/html/users_guide/using-concurrent.html

Đối với một ví dụ, nhìn vào quicksort này đơn giản trên danh sách, được viết bởi 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