早期中止的Haskell并行搜索

时间:2017-06-18 13:25:26

标签: haskell search parallel-processing

我想搜索一个列表,测试属性X的每个元素,然后在找到具有属性X的元素时返回。

此列表非常大并且可以从并行性中受益,但是相对于计算时间,火花的成本相当高。 parListChunk会很棒,但它必须搜索整个列表。

我是否有某种方式可以写出像parListChunk这样的东西,但早期中止?

这是天真的搜索代码:

hasPropertyX :: Object -> Bool

anyObjectHasPropertyX :: [Object] -> Bool
anyObjectHasPropertyX [] = False
anyObjectHasPropertyX l
| hasPropertyX (head l) == True = True
| otherwise = anyObjectHasPropertyX (tail l)

这是我对并行性的第一次尝试:

anyObjectHasPropertyXPar [] = False
anyObjectHasPropertyXPar [a] = hasPropertyX a
anyObjectHasPropertyXPar (a:b:rest) = runEval $ do c1 <- rpar (force (hasPropertyX a))
                                                   c2 <- rpar (force (hasPropertyX b))
                                                   rseq c1
                                                   rseq c2
                                                   if (c1 == True) || (c2 == True) then return True else return (anyObjectHasPropertyXPar rest)

这确实比原始代码稍微快一点(即使用-N1,奇怪的是),但不是很多(通过扩展并行计算的数量有点帮助)。我相信它并没有太大的好处,因为它必须为列表中的每个元素激发一个线程。

是否存在类似于parListChunk的方法,只会引发n个线程并允许早期中止?

编辑:我在思考这个问题时遇到了问题,因为我似乎需要监视所有线程的返回值。如果我省略rseq并且有类似

的内容
if (c1 == True) || (c2 == True) then ...

运行时环境是否足够智能以监视两个线程并在其中任何一个返回时继续?

1 个答案:

答案 0 :(得分:2)

我不认为你使用Control.Parallel.Strategies会有太多运气。该模块的一个关键特性是它表达“确定性并行性”,使得程序的结果不受并行评估的影响。你所描述的问题基本上是不确定的,因为线程正在竞相找到第一个匹配。

更新:我现在看到,如果找到该元素,您只返回True,因此所需的行为 在技术上是确定的。所以,也许有一种方法可以欺骗Strategies模块。不过,下面的实现似乎符合要求。

这是一个并行查找parFind的实现,它使用Control.Concurrent原语在IO monad中运行,似乎可以做你想要的。使用了两个MVarsrunningV计算仍在运行的线程数以允许最后一个线程站点检测搜索失败;并且resultV用于返回Just结果,或Nothing当最后一个帖子检测到搜索失败时。请注意,它不太可能比单线程实现更好,除非测试(上面的hasPropertyX)比列表遍历要多得多,不像这个玩具示例。

import Control.Monad
import Control.Concurrent
import Data.List
import System.Environment

-- Thin a list to every `n`th element starting with index `i`
thin :: Int -> Int -> [a] -> [a]
thin i n = unfoldr step . drop i
  where step [] = Nothing
        step (y:ys) = Just (y, drop (n-1) ys)

-- Use `n` parallel threads to find first element of `xs` satisfying `f`
parFind :: Int -> (a -> Bool) -> [a] -> IO (Maybe a)
parFind n f xs = do
  resultV <- newEmptyMVar
  runningV <- newMVar n
  comparisonsV <- newMVar 0
  threads <- forM [0..n-1] $ \i -> forkIO $ do
    case find f (thin i n xs) of
      Just x -> void (tryPutMVar resultV (Just x))
      Nothing -> do m <- takeMVar runningV
                    if m == 1
                      then void (tryPutMVar resultV Nothing)
                      else putMVar runningV (m-1)
  result <- readMVar resultV
  mapM_ killThread threads
  return result

myList :: [Int]
myList = [1..1000000000]

-- Use `n` threads to find first element equal to `y` in `myList`
run :: Int -> Int -> IO ()
run n y = do x <- parFind n (== y) myList
             print x

-- e.g.,  stack ghc -- -O2 -threaded SearchList.hs
--        time ./SearchList +RTS -N4 -RTS 4 12345  # find 12345 using 4 threads -> 0.018s
--        time ./SearchList +RTS -N4 -RTS 4 -1     # full search w/o match -> 6.7s
main :: IO ()
main = do [n,y] <- getArgs
          run (read n) (read y)

另请注意,此版本在交错的子列表上运行线程,而不是将主列表分成连续的块。我是这样做的,因为(1)更容易证明“早期”元素很快被发现; (2)我的巨大列表意味着如果整个列表需要保存在内存中,内存使用可能会爆炸。

事实上,这个例子是一个性能定时炸弹 - 它的内存使用是不确定的,如果一个线程落后,可能会爆炸,以便整个列表的大部分需要保存在内存中。 / p>

在一个真实的例子中,整个列表 可能保存在内存中并且属性测试很昂贵,你可能会发现将列表分成块更快。