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

Question

我正在用 Haskell 编写 rainbow table 的玩具实现。主要数据结构是严格的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 的计算成本非常高。支配计算时间的部分是令人尴尬的并行，所以如果并行运行，我希望在内核数量上获得准线性加速。

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

我从Control.Parallel.Strategies 中找到了parMap，并尝试将其应用于我的建表功能：

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

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

编辑：chain 定义为：

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

其中(c -> h)是目标哈希函数，从明文到哈希， [h -> c] 是减速器函数家族。我希望实现在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 快​​ 200 倍
• 在makeTable 中，如果您希望立即丢弃重复的结果，则需要手动循环或展开。但是由于我们需要返回生成器，所以我选择了手动循环。
• 为了最大程度地减少线程之间的同步，将为每个线程构建独立的映射，并在最后将生成的映射合并在一起时删除重复的映射。