2016-06-17 13 views
1

私は、葉に一連の値を格納する簡単なツリーと、テストを容易にするためのいくつかの単純な関数を持っています。Haskellでこのツリーを並行してどのように減らすことができますか?

私は無制限の数のプロセッサを持ち、ツリーのバランスが取れているならば、対数的に任意のバイナリ結合演算(+、*、min、lcm)を使って木を減らすことができます。

TreeをFoldableのインスタンスにすることで、組み込み関数を使用してツリーを左から右または右から左に順番に減らすことができますが、これは線形時間を要します。

ハスケルを使ってこのようなツリーを並行して減らすにはどうすればよいですか?

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の観点で書くことができます

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

私はパラレル1はかなり単純に適応されるだろうとします

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

'Foldable'の実装をパラレルにカスタマイズすることはできませんか? – Xodarap

+1

[複数のプロセッサを持つバイナリツリートラバーサルを高速化する] Haskell(パラレル)の可能な複製(http:// stackoverflow。com/questions/27091624/speeding-up-binary-tree-traversal-with-multiple-processors-haskell-parallel) – jberryman

+0

@ Xodarapどうすればよいですか? –

答えて

2

ナイーブ倍はこのように書かれています:

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

絶対完璧です。ありがとうございました。 –

1

更新

元々は、削減操作が高価ではないという前提で質問に答えました。ここでは、n要素のチャンクで連想縮小を実行する答えを示します。パラレル評価することができます

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

:ある

は、opが連想バイナリ演算であると仮定して、あなたがfoldr1 op [1..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と並行して、リストを評価することができます。

ここに、各リーフのフィブを追加するデモコードがあります。私は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() 
関連する問題