如何在Haskell中並行減少此樹？

Question

我有一個簡單的樹，它在其葉子中存儲一系列值和一些簡單的函數，以方便測試。

如果我有一個無限數量的處理器並且樹是平衡的，我應該能夠在對數時間內使用任何二進制關聯運算（+，*，min，lcm）來減少樹。

通過使Tree成為可折疊的實例，我可以使用內置函數從左到右或從右到左依次縮減樹，但這需要線性時間。

如何使用Haskell並行減少這樣的樹？

{-# 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

天真的折疊是這樣寫的：

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

我想平行的一個很簡單：

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

但甚至可以用cata來寫：

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

Answer 2

更新

我最初在假設減少操作並不昂貴的情況下回答了這個問題。 這是一個答案，它在n個元素的塊中執行關聯減少。

也就是說，假設op是一個關聯二進制操作，你想計算foldr1 op [1..6] ，這里的代碼將它評估為：

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

這允許並行評估。

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]

原始答案

由於您具有關聯操作，因此您可以使用toList函數並與parMap或parList並行評估列表。

這是一些演示代碼，它們將每個Leaf的fib加起來。 我使用parBuffer來避免產生太多火花 - 如果樹很小，就不需parBuffer 。

我正在從一個文件中加載一個樹，因為似乎帶有-O2的GHC在我的測試樹中檢測到了常見的子表達式。

另外，根據您的需要調整rseq - 您可能需要rdeepseq具體取決於您積累的內容。

{-# 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 ()