Wie kann ich diesen Baum in Haskell parallel reduzieren?

Question

Ich habe einen einfachen Baum, der eine Reihe von Werten in seinen Blättern speichert und einige einfache Funktionen, um das Testen zu erleichtern.

Wenn ich eine unbegrenzte Anzahl von Prozessoren habe und der Baum ausgeglichen ist, sollte ich in der Lage sein, den Baum mit jeder binären assoziativen Operation (+, *, min, lcm) in logarithmischer Zeit zu reduzieren.

Indem ich Tree zu einer Instanz von Foldable mache, kann ich den Baum mit integrierten Funktionen sequentiell von links nach rechts oder von rechts nach links verkleinern, aber das benötigt lineare Zeit.

Wie kann ich Haskell verwenden, um einen solchen Baum parallel zu reduzieren?

{-# LANGUAGE DeriveFoldable #-} 

data Tree a = Leaf a | Node (Tree a) (Tree a) 
      deriving (Show, Foldable) 

toList :: Tree a -> [a] 
toList = foldr (:) [] 

range :: Int -> Int -> Tree Int 
range x y 
    | x < y  = Node (range x y') (range x' y) 
    | otherwise = Leaf x 
    where 
    y' = quot (x + y) 2 
    x' = y' + 1 

Answer 1

Die naive Falte wird auf diese Weise geschrieben:

cata fLeaf fNode = go where 
    go (Leaf z) = fLeaf z 
    go (Node l r) = fNode (go l) (go r) 

Ich nehme an, die parallel man wäre ziemlich einfach angepasst:

parCata fLeaf fNode = go where 
    go (Leaf z) = fLeaf z 
    go (Node l r) = gol `par` gor `pseq` fNode gol gor where 
     gol = go l 
     gor = go r 

Aber könnte auch in Bezug auf cata geschrieben werden:

parCata fLeaf fNode = cata fLeaf (\l r -> l `par` r `pseq` fNode l r) 

Answer 2

Update

Ursprünglich beantwortete ich die Frage unter der Annahme, dass die Reduktion nicht teuer war. Hier ist eine Antwort, die eine assoziative Reduktion in Chunks von n Elementen durchführt.

Das heißt, nehmen op eine assoziative binäre Operation ist, und Sie mögen foldr1 op [1..6] berechnen, hier ist Code, der es als auswertet:

(op (op 1 2) (op 3 4)) (op 5 6) 

, die für die parallele Auswertung ermöglicht.

import Control.Parallel.Strategies 
import System.TimeIt 
import Data.List.Split 
import Debug.Trace 

recChunk :: ([a] -> a) -> Int -> [a] -> a 
recChunk op n xs = 
    case chunksOf n xs of 
    [a] -> op a 
    cs -> recChunk op n $ parMap rseq op cs 

data N = N Int | Op [N] 
    deriving (Show) 

test1 = recChunk Op 2 $ map N [1..10] 
test2 = recChunk Op 3 $ map N [1..10] 

fib 0 = 0 
fib 1 = 1 
fib n = fib (n-1) + fib (n-2) 

fib' n | trace msg False = undefined 
    where msg = "fib called with " ++ show n 
fib' n = fib n 

sumFib :: [Int] -> Int 
sumFib xs | trace msg False = undefined 
    where msg = "sumFib: " ++ show xs 
sumFib xs = seq s (s + (mod (fib' (40 + mod s 2)) 1)) 
    where s = sum xs 

main = do 
    timeIt $ print $ recChunk sumFib 2 [1..20] 

Original-Antwort

Da Sie eine assoziative Operation haben, können Sie einfach Ihre toList Funktion verwenden und die Liste parallel zu parMap oder parList bewerten.

Hier ist ein Demo-Code, der die Fib von jedem Leaf addiert. Ich benutze parBuffer, um zu viele Funken zu vermeiden - das ist nicht nötig, wenn dein Baum kleiner ist.

Ich lade einen Baum aus einer Datei, weil GHC mit -O2 allgemeine Unterausdrücke in meinem Testbaum erkannt hat.

Passen Sie auch rseq an Ihre Bedürfnisse an - Sie benötigen möglicherweise rdeepseq, je nachdem, was Sie ansammeln.

{-# LANGUAGE DeriveFoldable #-} 

import Control.Parallel.Strategies 
import System.Environment 
import Control.DeepSeq 
import System.TimeIt 
import Debug.Trace 

fib 0 = 0 
fib 1 = 1 
fib n = fib (n-1) + fib (n-2) 

fib' n | trace msg False = undefined 
    where msg = "fib called with " ++ show n 
fib' n = fib n 

data Tree a = Leaf a | Node (Tree a) (Tree a) 
      deriving (Show, Read, Foldable) 

toList :: Tree a -> [a] 
toList = foldr (:) [] 

computeSum :: Int -> Tree Int -> Int 
computeSum k t = sum $ runEval $ parBuffer k rseq $ map fib' $ toList t 

main = do 
    tree <- fmap read $ readFile "tree.in" 
    timeIt $ print $ computeSum 4 tree 
    return()