haskell - 分而治之算法的并行性

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 单子(monad)用于传输状态并为使用 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)

因此，我的下一次尝试是使用更好的并行策略“par”和“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)

我做错了什么？

更新:不知何故，这个问题似乎与 IO monad 的存在有关。在没有 IO monad、只有 State monad 的其他(旧)版本中，并行执行使用 'par' 和 'pseq' 运行。 GHC -sstderr 给出SPARKS:1160(69 转换，1069 修剪)。

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

par 和 pseq 的使用应该发生在“执行路径”上，即不在本地 let 内。试试这个(修改你的最后一个片段)

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

case 会强制将其参数求值为弱头范式 (WHNF)，然后再继续其分支之一。 WHNF 意味着对参数进行求值，直到最外层构造函数可见。字段可能仍处于未评估状态。

要强制对参数进行全面评估，请使用 deepseq 。但要小心这一点，因为 deepseq 有时会因为做太多工作而使速度变慢。

增加严格性的更轻量级方法是使字段严格:

data Foo = Foo !Int String

现在，每当 Foo 类型的值被评估为 WHNF 时，它的第一个参数也是如此(但不是第二个)。