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来避免产生太多火花 - 如果你的树很小，就不需要这样做。

我正在从文件中加载一棵树，因为看起来GHC和-O2在我的测试树中检测到了常见的子表达式。

另外，根据您的需要调整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 ()

如何在Haskell中并行减少此树？

2 个答案: