分而治之算法的並行性

Question

我遇到了問題，使我的代碼並行運行。這是一個3D Delaunay生成器，使用分割&征服算法，命名爲DeWall。

主要功能是：

deWall::[SimplexPointer] -> SetSimplexFace -> Box -> StateT DeWallSets IO ([Simplex], [Edge]) 
deWall p afl box = do 
    ... 
    ... 
    get >>= recursion box1 box2 p1 p2 sigma edges 
    ... 
    ... 

它調用可以稱之爲dewall功能背面的「遞歸」功能。在這裏，平滑機會出現在這裏。以下代碼顯示了順序解決方案。

recursion::Box -> Box -> [SimplexPointer] -> [SimplexPointer] -> [Simplex] -> [Edge] -> DeWallSets -> StateT DeWallSets IO ([Simplex], [Edge])  
recursion box1 box2 p1 p2 sigma edges deWallSet 
     | null afl1 && null afl2 = return (sigma, edges) 
     | (null) afl1 = do 
      (s, e) <- deWall p2 afl2 box2 
      return (s ++ sigma, e ++ edges) 
     | (null) afl2 = do 
      (s,e) <- deWall p1 afl1 box1 
      return (s ++ sigma, e ++ edges) 
     | otherwise = do 
      x <- get 
      liftIO $ do 
       (s1, e1) <- evalStateT (deWall p1 afl1 box1) x 
       (s2, e2) <- evalStateT (deWall p2 afl2 box2) x 
       return (s1 ++ s2 ++ sigma, e1 ++ e2 ++ edges) 

     where afl1 = aflBox1 deWallSet 
       afl2 = aflBox2 deWallSet 

狀態和IO monads用於管道狀態併爲使用MVar發現的每個四面體生成UID。我的第一次嘗試是添加一個forkIO，但它不起作用。由於合併過程中缺乏控制，不會等待兩個線程完成，因此它會給出錯誤的輸出。我不知道如何讓它等待它們。

  liftIO $ do 
       let 
        s1 = evalStateT (deWall p1 afl1 box1) x 
        s2 = evalStateT (deWall p2 afl2 box2) x 
        concatThread var (a1, b1) = takeMVar var >>= \(a2, b2) -> putMVar var (a1 ++ a2, b1 ++ b2) 
       mv <- newMVar ([],[]) 
       forkIO (s1 >>= concatThread mv) 
       forkIO (s2 >>= concatThread mv) 
       takeMVar mv >>= \(s, e) -> return (s ++ sigma, e ++ edges) 

所以，我的下一個嘗試是使用一個更好的並行策略「相提並論」和「PSEQ」這給正確的結果，但根據threadScope沒有並行執行。

 liftIO $ do 
      let 
       s1 = evalStateT (deWall p1 afl1 box1) x 
       s2 = evalStateT (deWall p2 afl2 box2) x 
       conc = liftM2 (\(a1, b1) (a2, b2) -> (a1 ++ a2, b1 ++ b2)) 
      (stotal, etotal) = s1 `par` (s2 `pseq` (s1 `conc` s2)) 
      return (stotal ++ sigma, etotal ++ edges) 

我在做什麼錯？

UPDATE：不知何故，這個問題似乎與IO單子的存在有關。在沒有IO monad的其他（舊）版本中，只有狀態monad，並行執行以'par'和'pseq'運行。 GHC -sstderr給出SPARKS: 1160 (69 converted, 1069 pruned)。

recursion::Box -> Box -> [SimplexPointer] -> [SimplexPointer] -> [Simplex] -> [Edge] -> DeWallSets -> State DeWallSets ([Simplex], [Edge]) 
recursion p1 p2 sigma deWallSet 
    | null afl1 && null afl2 = return sigma 
    | (null) afl1 = do 
     s <- deWall p2 afl2 box2 
     return (s ++ sigma) 
    | (null) afl2 = do 
     s <- deWall p1 afl1 box1 
     return (s ++ sigma) 
    | otherwise = do 
        x <- get 
        let s1 = evalState (deWall p1 afl1 box1) x 
        let s2 = evalState (deWall p2 afl2 box2) x 
        return $ s1 `par` (s2 `pseq` (s1 ++ s2 ++ sigma)) 
    where afl1 = aflBox1 deWallSet 
      afl2 = aflBox2 deWallSet 

雲有人解釋說？

Answer 1

最簡單的方法，使這項工作將使用類似：

liftIO $ do 
      let 
       s1 = evalStateT (deWall p1 afl1 box1) x 
       s2 = evalStateT (deWall p2 afl2 box2) x 
      mv1 <- newMVar ([],[]) 
      mv2 <- newMVar ([],[]) 
      forkIO (s1 >>= putMVar mv1) 
      forkIO (s2 >>= putMVar mv2) 
      (a1,b1) <- takeMVar mv1 
      (a2,b2) <- takeMVar mv2 
      return (a1++a2++sigma, b1++b2++edges) 

這工作，但有一些不必要的開銷更好的方法是：

liftIO $ do 
      let 
       s1 = evalStateT (deWall p1 afl1 box1) x 
       s2 = evalStateT (deWall p2 afl2 box2) x 
      mv <- newMVar ([],[]) 
      forkIO (s2 >>= putMVar mv2) 
      (a1,b1) <- s1 
      (a2,b2) <- takeMVar mv2 
      return (a1++a2++sigma, b1++b2++edges) 

或可能的，如果這個結果不被評估，你想他們是：

liftIO $ do 
     let 
      s1 = evalStateT (deWall p1 afl1 box1) x 
      s2 = evalStateT (deWall p2 afl2 box2) x 
     mv <- newMVar ([],[]) 
     forkIO (s2 >>= evaluate >>= putMVar mv2) 
     (a1,b1) <- s1 
     (a2,b2) <- takeMVar mv2 
     return (a1++a2++sigma, b1++b2++edges) 

（這些是我給了海報的答案#haskell，我認爲在這裏也會有用）

編輯：刪除不必要的評估。

Answer 2

使用par和pseq應出現在「執行路徑」上，即不在本地let內。

let s1 = ... 
    s2 = ... 
    conc = ... 
case s1 `par` (s2 `pseq` (s1 `conc` s2)) of 
    (stotal, etotal) -> 
    return (stotal ++ sigma, etotal ++ edges) 

其參數弱頭部正常形態（WHNF）的case力評價繼續在它的一個分支之前，試試這個（修改你的最後片段）。 WHNF意味着參數被評估直到最外層的構造函數可見。字段可能仍然是未評估的。

強制對參數的完整評估使用deepseq。不過，要小心，因爲deepseq有時候做太多工作會讓事情變慢。

更輕便的方法來增加嚴格性是使字段嚴格：

data Foo = Foo !Int String 

現在，每當Foo類型的值進行評估，以WHNF，因此是其第一個參數（但不是第二個）。

Answer 3

如您所述，如果您想堅持使用顯式線程而不是pseq，則需要一些方法來等待工作線程結束。對於數量信號來說，這是一個很好的用例。在完成要完成的工作之後，讓每個工作者在終止時發出線程信號，告知信號量已經完成了多少工作。

然後等待所有工作單元完成。

http://www.haskell.org/ghc/docs/6.8.3/html/libraries/base/Control-Concurrent-QSemN.html

編輯：一些僞代碼，以幫助解釋概念

do 
let workchunks :: [(WorkChunk, Size)] 
    workchunks = dividework work 

    let totalsize = sum $ map snd workchunks 

sem <- newQSem 0 

let forkworkThread (workchunk, size) = do 
     executeWorkChunk workchunk 
     signalQSem size 

mapM_ forkWorkThread workchunks 
waitQSem totalsize 

-- now all your work is done.