Haskell：すべてのコアを使用しない並列プログラム

Question

次のコードは、-threadedでコンパイルされているかどうかにかかわらず、またはシングルスレッド方式でコードを書き込んだ場合でも同じパフォーマンスを示します。両方のブロック（parとコメント付きforkIO/forkOS/forkOnを使用）と同じパフォーマンスが得られます。実際には、並列バージョンではパフォーマンスが多少低下します（おそらく並列GCのオーバーヘッドが原因です）。 htopのようなプログラムからCPU使用率を見ると、1つのCPUしか固定されていないことがわかります。これはコードの読み方がほとんどのコアを使用する必要があるためです。

ghc/rts/posix/OSThreads.c:forkOS_createThreadからの関連セクションは、pthread_createへのコールを強制すると思われるため、forkOSがより多くのコアを使用しないという事実は特に混乱します。私.cabalファイル

ghc-options: 
    -threaded 
    -rtsopts 
    "-with-rtsopts=-N15 -qg1" 

プラットフォーム情報

$ stack --version 
Version 1.2.0, Git revision 241cd07d576d9c0c0e712e83d947e3dd64541c42 (4054 commits) x86_64 hpack-0.14.0 
$ stack exec ghc -- --version 
The Glorious Glasgow Haskell Compilation System, version 7.10.3 
$ lsb_release -a 
No LSB modules are available. 
Distributor ID: Ubuntu 
Description: Ubuntu 16.04.1 LTS 
Release: 16.04 
Codename: xenial 
$ uname -r 
4.4.0-36-generic 

から

-- (Apologies if I have missed an import or two) 

import Data.List 
import GHC.Conc 
import Control.Concurrent 
import Control.DeepSeq 
import qualified Data.HashMap.Lazy as HM 
main :: IO() 
main = do 
    let [one::Int, two] = [15, 1000000] 
{- 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 
    n <- getNumCapabilities 
    putStrLn $ "Num capabilities " <> show n 
    m <- newEmptyMVar 
    forkIO $ void $ forM [(1::Int)..one] $ \cpu -> do 
    -- forkOn cpu $ void $ do 
    forkOS $ void $ do 
    -- forkIO $ void $ do 
    -- void $ do 
     putStrLn $ "core " <> show cpu 
     s <- return $ sort $ HM.keys $ HM.fromList $ zip [cpu..two + cpu] (repeat (0::Int)) 
     putStrLn $ "core " <> show cpu <> " done " <> show (sum s) 
     putMVar m() 
    forM [1..one] $ \i -> takeMVar m 
    let s :: String = "hey!" 
    putStrLn s 
-} 
    print one 
    print two 
    let __pmap__ f xs = case xs of 
     [] -> [] 
     x:xs -> let y = f x 
        ys = __pmap__ f xs 
        in (y `par` ys) `pseq` (y: ys) 
    n <- pure $ sum . concat $ flip __pmap__ [1..one] $ \i -> 
    force $ sort $ HM.keys $ HM.fromList $ zip [i..(two + i)] (repeat (0::Int)) 
    putStrLn $ "sum " <> show n 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 

関連するセクションは、なぜ私のコードは並列化取得されていませんか？

EDIT：それはすべてで便利だ場合、-sランタイムフラグを追加すると、次のレポート

21,829,377,776 bytes allocated in the heap 
126,512,021,712 bytes copied during GC 
     86,659,312 bytes maximum residency (322 sample(s)) 
     6,958,976 bytes maximum slop 
      218 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  41944 colls,  0 par 16.268s 17.272s  0.0004s 0.0011s 
    Gen 1  322 colls, 321 par 237.056s 23.822s  0.0740s 0.2514s 

    Parallel GC work balance: 13.01% (serial 0%, perfect 100%) 

    TASKS: 32 (1 bound, 31 peak workers (31 total), using -N15) 

    SPARKS: 15 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 15 fizzled) 

    INIT time 0.004s ( 0.003s elapsed) 
    MUT  time 12.504s (13.301s elapsed) 
    GC  time 253.324s (41.094s elapsed) 
    EXIT time 0.000s ( 0.017s elapsed) 
    Total time 265.920s (54.413s elapsed) 

    Alloc rate 1,745,791,568 bytes per MUT second 

    Productivity 4.7% of total user, 23.1% of total elapsed 

gc_alloc_block_sync: 10725286 
whitehole_spin: 0 
gen[0].sync: 2171 
gen[1].sync: 1057315 

EDIT2生成：アリーナサイズをいじりをかなり役立っているようです。私は-H2G -A1GをRTSオプションに追加した。その時は43秒から5.2秒になった。完全な15倍のスピードアップを得るために状況について改善できることはありますか？

EDIT3は：フィードバック

Answer 1

問題が__pmap__の定義によって引き起こされるを与える2人が提案しpar、pseqパターンを反映するために、コードを編集しました。あなたは、これがyとy: __pmap__ f xsを並列に評価される原因となるが、これはそうではないことを期待し

let y = f x 
in y `par` (y: __pmap__ f xs) 

：具体的に次の式で問題があります。 GHCはそれらを並行して評価しようとしますが、2番目の部分式には最初の部分式であるyが含まれています。そのため、第2の部分式は第1の部分式に依存するため、並列に評価することはできません。 pseqがy : ys前に評価されるとyの評価が実行されている間ので、第二の部分式の評価を開始することができysを強制されるため、上記の式を記述するための正しい方法は

let y = f x 
    ys = __pmap__ f xs 
in y `par` (ys `pseq` (y : ys)) 

です。これに関するいくつかの議論については、threadも参照してください。

だから、一緒にすべてを入れて、我々は次を得る：私はtraceShow（Debug.Traceから）追加した

main :: IO() 
main = do 
    let [one::Int, two] = [15, 1000000] 
    print one 
    print two 
    let __pmap__ f xs = case xs of 
     [] -> [] 
     x:xs -> let y = f x 
        ys = __pmap__ f xs 
       in y `par` ys `pseq` (y : ys) 
    n <- pure $ sum . concat $ flip __pmap__ [1..one] $ \i -> 
    traceShow i $ force $ sort $ HM.keys $ HM.fromList $ zip [i..(two + i)] (repeat (0::Int)) 
    putStrLn $ "sum " <> show n 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 

注意してください。-N1をrtsoptsに実行すると、一度に1つの要素が評価されますが、-N3を使用すると、一度に3つの要素が評価されます。

話の教訓はparとpseqが誤用するのは簡単です、あなたはそれゆえparallelから（自分の__pmap__に相当する）などparMap rdeepseqのようなより高いレベルのソリューションを好むべきであるということです。