haskell - 在构建昂贵键的映射时正确利用并行性？

Question

我正在编写 rainbow table 的玩具实现在 haskell 。主要数据结构是严格的 Map h c ，包含大量对，由随机值 c 生成:

import qualified Data.Map as M
import System.Random

table :: (RandomGen g, Random c) => Int -> g -> Map h c
table n = M.fromList . map (\c -> (chain c, c)) . take n . randoms

在哪里 chain计算起来非常昂贵。支配计算时间的部分是令人尴尬的并行，所以如果它并行运行，我希望在内核数量上获得准线性加速。

但是，我希望将计算的对立即添加到表中，而不是累积在内存中的列表中。需要注意的是，可能会发生冲突，在这种情况下，应该尽快丢弃冗余链。堆分析证实了这种情况。

我找到了 parMap来自 Control.Parallel.Strategies ，并尝试将其应用于我的建表功能:

table n = M.fromList . parMap (evalTuple2 rseq rseq) (\c -> (chain c, c)) . take n . randoms

但是，使用 -N 运行，我充其量达到 1.3 核心使用率。堆分析至少表明中间列表不驻留在内存中，但“-s”还报告创建了 0 个 Spark 。我使用 parMap 怎么可能？ ?这样做的正确方法是什么？

编辑: chain定义为:

chain :: (c -> h) -> [h -> c] -> c -> h
chain h = h . flip (foldl' (flip (.h)))

在哪里 (c -> h)是目标散列函数，从明文到散列，
和 [h -> c]是一个 reducer 函数族。我希望实现在 c 上保持通用和 h ，但对于基准测试，我对两者都使用严格的字节串。

Answer 1

这是我想出的。让我知道基准测试的结果:

#!/usr/bin/env stack
{- stack --resolver lts-14.1 script --optimize
  --package scheduler
  --package containers
  --package random
  --package splitmix
  --package deepseq
-}
{-# LANGUAGE BangPatterns #-}

import Control.DeepSeq
import Control.Scheduler
import Data.Foldable as F
import Data.IORef
import Data.List (unfoldr)
import Data.Map.Strict as M
import System.Environment (getArgs)
import System.Random as R
import System.Random.SplitMix


-- for simplicity
chain :: Show a => a -> String
chain = show

makeTable :: Int -> SMGen -> (SMGen, M.Map String Int)
makeTable = go M.empty
  where go !acc i gen
          | i > 0 =
            let (c, gen') = R.random gen
            in go (M.insert (chain c) c acc) (i - 1) gen'
          | otherwise = (gen,  acc)

makeTablePar :: Int -> SMGen -> IO (M.Map String Int)
makeTablePar n0 gen0 = do
  let gens = unfoldr (Just . splitSMGen) gen0
  gensState <- initWorkerStates Par (\(WorkerId wid) -> newIORef (gens !! wid))
  tables <-
    withSchedulerWS gensState $ \scheduler -> do
      let k = numWorkers (unwrapSchedulerWS scheduler)
          (q, r) = n0 `quotRem` k
      forM_ ((if r == 0 then [] else [r]) ++ replicate k q) $ \n ->
        scheduleWorkState scheduler $ \genRef -> do
          gen <- readIORef genRef
          let (gen', table) = makeTable n gen
          writeIORef genRef gen'
          table `deepseq` pure table
  pure $ F.foldl' M.union M.empty tables

main :: IO ()
main = do
  [n] <- fmap read <$> getArgs
  gen <- initSMGen
  print =<< makeTablePar n gen

关于实现的几点说明:

不要使用来自 random 的生成器，它很慢，splitmix是 x200 更快

在 makeTable ，如果您想立即丢弃重复的结果，则需要手动循环或展开。但是由于我们需要返回生成器，所以我选择了手动循环。

为了最大限度地减少线程之间的同步，每个线程将建立独立的映射，并在最后将结果映射合并在一起时删除重复的映射。