Параллелизм в алгоритме «разделяй и властвуй» - PullRequest
Новая
       19

Параллелизм в алгоритме «разделяй и властвуй»

5 голосов
/ 07 февраля 2011

У меня проблемы с параллельной работой моего кода.Это 3D генератор Делоне, использующий алгоритм «разделяй и властвуй» с именем 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

Монады состояний и ввода-вывода используются для передачи состояния и генерации UID для каждого тетраэдра, найденного с использованием MVar.Моей первой попыткой было добавить 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.В другой (старой) версии без монады ввода-вывода, только монады состояний, параллельное выполнение выполняется с '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

Облако, кто-то объясняет это?

Ответы [ 3 ]

3 голосов
/ 07 февраля 2011

Использование par и pseq должно происходить по «пути выполнения», то есть не внутри локального let. Попробуйте это (измените свой последний фрагмент) 

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

A case заставляет оценку своего аргумента перейти к нормальной форме слабой головы (WHNF), прежде чем продолжить в одной из своих ветвей. WHNF означает, что аргумент оценивается до тех пор, пока внешний конструктор не станет видимым. Поля все еще могут быть не оценены.

Для принудительной полной оценки аргумента используйте deepseq. Однако будьте осторожны с этим, потому что deepseq может иногда замедлять работу, выполняя слишком много работы.

Более легкий подход к добавлению строгости состоит в том, чтобы сделать поля строгими: 

data Foo = Foo !Int String

Теперь, когда значение типа Foo оценивается как WHNF, так же как и его первый аргумент (но не второй).

2 голосов
/ 10 февраля 2011

Самый простой способ сделать эту работу - использовать что-то вроде: 

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, который, как я думал, также будет полезен здесь)

Редактировать: удалены ненужные оценки.

1 голос
/ 07 февраля 2011

Если вы хотите придерживаться явных потоков, а не 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.
...