我有一个程序我正在尝试并行化(使用可运行代码here完全粘贴)。
我已经进行过分析,发现大部分时间花费在findNearest
上,这对于大foldr
来说基本上是一个简单的Data.Map
。
findNearest :: RGB -> M.Map k RGB -> (k, Word32)
findNearest rgb m0 =
M.foldrWithKey' minDistance (k0, distance rgb r0) m0
where (k0, r0) = M.findMin m0
minDistance k r x@(_, d1) =
-- Euclidean distance in RGB-space
let d0 = distance rgb r
in if d0 < d1 then (k, d0) else x
parFindNearest
应该在较大findNearest
的子树上并行执行Map
。
parFindNearest :: NFData k => RGB -> M.Map k RGB -> (k, Word32)
parFindNearest rgb = minimumBy (comparing snd)
. parMap rdeepseq (findNearest rgb)
. M.splitRoot
不幸的是GHC GC在转换为有用的并行性之前是我的最大火花。
以下是使用ghc -O2 -threaded
进行编译并使用+RTS -s -N2
839,892,616 bytes allocated in the heap
123,999,464 bytes copied during GC
5,320,184 bytes maximum residency (19 sample(s))
3,214,200 bytes maximum slop
16 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 1550 colls, 1550 par 0.23s 0.11s 0.0001s 0.0004s
Gen 1 19 colls, 18 par 0.11s 0.06s 0.0030s 0.0052s
Parallel GC work balance: 16.48% (serial 0%, perfect 100%)
TASKS: 6 (1 bound, 5 peak workers (5 total), using -N2)
SPARKS: 215623 (1318 converted, 0 overflowed, 0 dud, 198111 GC'd, 16194 fizzled)
INIT time 0.00s ( 0.00s elapsed)
MUT time 3.72s ( 3.66s elapsed)
GC time 0.34s ( 0.17s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 4.07s ( 3.84s elapsed)
Alloc rate 225,726,318 bytes per MUT second
Productivity 91.6% of total user, 97.1% of total elapsed
gc_alloc_block_sync: 9862
whitehole_spin: 0
gen[0].sync: 0
gen[1].sync: 2103
正如您所看到的,大多数火花在转换前都是GC或fizzle。我尝试过不同的严格性,让findNearest
返回自定义严格对数据类型而不是元组
,或者使用Control.Parallel.Strategies
中的rdeepseq,但我的火花仍然是GC。
我想知道
答案 0 :(得分:4)
我不是并行策略方面的专家,所以我可能完全错了。但是:
如果您通过设置足够大的分配区域(例如,使用-A20M
运行时选项)来禁用GC,您会发现大多数火花都会失败,而不是GC&#39; d。这意味着它们在相应的火花结束之前通过普通程序流程进行评估。
minimumBy
立即强制parMap
结果,开始评估它们。与此同时,火花被安排和执行,但为时已晚。当spark完成时,该值已由主线程评估。没有-A20M
,火花就是GC,因为即使在计划火花之前,也会对价值进行评估并确定GC。
这是一个简化的测试用例:
import Control.Parallel.Strategies
f :: Integer -> Integer
f 0 = 1
f n = n * f (n - 1)
main :: IO ()
main = do
let l = [n..n+10]
n = 1
res = parMap rdeepseq f l
print res
在这种情况下,所有的火花都会失败:
SPARKS: 11 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 11 fizzled)
(有时候他们是GC&#39; d)
但是如果我在打印结果之前产生主线程,
import Control.Parallel.Strategies
import Control.Concurrent
f :: Integer -> Integer
f 0 = 1
f n = n * f (n - 1)
main :: IO ()
main = do
let l = [n..n+10]
n = 1
res = parMap rdeepseq f l
res `seq` threadDelay 1
print res
然后所有的火花都被转换了:
SPARKS: 11 (11 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
所以,看起来你没有足够的火花(尝试在我的例子中设置l = [n..n+1000]
),并且它们不够重(尝试在我的例子中设置n = 1000
)。