parallel-tree-search (empty) → 0.1

raw patch · 5 files changed

+157/−0 lines, 5 filesdep +basedep +tree-monadsetup-changed

Dependencies added: base, tree-monad

Files

• Control/Concurrent/ParallelTreeSearch.hs +103/−0
• LICENSE +15/−0
• README +6/−0
• Setup.hs +4/−0
• parallel-tree-search.cabal +29/−0

@@ -0,0 +1,103 @@+-- |+-- Module      : Control.Concurrent.ParallelTreeSearch+-- Copyright   : Fabian Reck, Sebastian Fischer+-- License     : PublicDomain+-- +-- Maintainer  : Sebastian Fischer (sebf@informatik.uni-kiel.de)+-- Stability   : experimental+-- Portability : portable+-- +-- This Haskell library provides an implementation of parallel search+-- based on the search tree provided by the package tree-monad.++module Control.Concurrent.ParallelTreeSearch ( parallelTreeSearch ) where++import Control.Monad.SearchTree+import Control.Concurrent++-- |+-- This function enumerates the results stored in a @SearchTree@ in+-- parallel. It is parameterised by the maximum number of threads to+-- use and the maximum amount of work to perform by each thread before+-- communicating the results.+--+parallelTreeSearch :: Int          -- ^ thread limit+                   -> Int          -- ^ work limit+                   -> SearchTree a -- ^ search space represented as tree+                   -> IO [a]+parallelTreeSearch tl wl t =+ do counter <- newMVar 1+    channel <- newChan+    let env = SearchEnv tl wl counter channel+    forkIO (parSearch env [] [t])+    xs <- getChanContents channel+    return (concNonEmpty xs)++-- like concat, but stops on empty list.+--+concNonEmpty :: [[a]] -> [a]+concNonEmpty []       = []+concNonEmpty ([]:_)   = []+concNonEmpty (xs:xss) = xs ++ concNonEmpty xss++-- Environment passed to the parallel search algorithm.+--+data SearchEnv a = SearchEnv { threadLimit   :: Int+                             , workLimit     :: Int+                             , threadCounter :: MVar Int+                             , results       :: Chan [a] }++-- We use a queue to represent the search. Currently, we use a stack,+-- but we could also use a fifo queue to obtain breadth-first search.+--+type Queue a = [SearchTree a]++parSearch :: SearchEnv a -> [a] -> Queue a -> IO ()+parSearch env xs [] = do writeResults env xs+                         finaliseResults env+parSearch env xs q  =+ do noMoreThreads <- threadLimitReached env+    if noMoreThreads+     then let (ys,q') = search (workLimit env) xs q+           in do writeResults env ys+                 parSearch env [] q'+     else do (ys,q') <- process env [] q+             parSearch env ys q'++-- forks a new thread if the first entry of the given queue is a+-- choice.+--+process :: SearchEnv a -> [a] -> Queue a -> IO ([a], Queue a)+process _   xs []                 = return (xs,[])+process env xs (None          :q) = process env xs q+process env xs (One x         :q) = process env (x:xs) q+process env xs (t@(Choice _ _):q) = do incThreadCounter env+                                       forkIO (parSearch env xs [t])+                                       return ([],q)++-- auxiliary functions++writeResults :: SearchEnv a -> [a] -> IO ()+writeResults _   [] = return ()+writeResults env xs = writeChan (results env) xs++incThreadCounter :: SearchEnv a -> IO ()+incThreadCounter env = modifyMVar_ (threadCounter env) (return.(+1))++threadLimitReached :: SearchEnv a -> IO Bool+threadLimitReached env = do count <- readMVar (threadCounter env)+                            return (count >= threadLimit env)++finaliseResults :: SearchEnv a -> IO ()+finaliseResults env = do count <- takeMVar (threadCounter env)+                         if count <= 1+                          then writeChan (results env) []+                          else putMVar (threadCounter env) (count-1)+++search :: Int -> [a] -> Queue a -> ([a],Queue a)+search _ xs []               = (xs,[])+search 0 xs q                = (xs,q)+search n xs (None       : q) = search (n-1) xs q+search n xs (One x      : q) = search (n-1) (x:xs) q+search n xs (Choice s t : q) = search (n-1) xs (s:t:q)

@@ -0,0 +1,15 @@+ALL PUBLIC DOMAIN MATERIAL IS OFFERED AS-IS. NO REPRESENTATIONS OR+WARRANTIES OF ANY KIND ARE MADE CONCERNING THE MATERIALS, EXPRESS,+IMPLIED, STATUTORY OR OTHERWISE, INCLUDING, WITHOUT LIMITATION,+WARRANTIES OF TITLE, MERCHANTIBILITY, FITNESS FOR A PARTICULAR+PURPOSE, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS,+ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT+DISCOVERABLE.++IN NO EVENT WILL THE AUTHOR(S), PUBLISHER(S), OR PRESENTER(S) OF ANY+PUBLIC DOMAIN MATERIAL BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY+SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES+ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF THE+AUTHOR(S), PUBLISHER(S), OR PRESENTER(S) HAVE BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.+

@@ -0,0 +1,6 @@+Parallel Tree Search+====================++This Haskell library provides an implementation of parallel search+based on the search tree provided by the package tree-monad.+

@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+

@@ -0,0 +1,29 @@+Name:          parallel-tree-search+Version:       0.1+Cabal-Version: >= 1.6+Synopsis:      Parallel Tree Search+Description:   ++  This Haskell library provides an implementation of parallel search+  based on the search tree provided by the package tree-monad.++Category:      Control, Concurrent+License:       PublicDomain+License-File:  LICENSE+Author:        Sebastian Fischer+Maintainer:    sebf@informatik.uni-kiel.de+Bug-Reports:   mailto:sebf@informatik.uni-kiel.de+Homepage:      http://github.com/sebfisch/parallel-tree-search+Build-Type:    Simple+Stability:     experimental++Extra-Source-Files: README++Library+  Build-Depends:    base, tree-monad+  Exposed-Modules:  Control.Concurrent.ParallelTreeSearch+  Ghc-Options:      -Wall++Source-Repository head+  type:     git+  location: git://github.com/sebfisch/parallel-tree-search.git