B.hs

{-# LANGUAGE BangPatterns #-}

import Data.Time (getCurrentTime, diffUTCTime)
import           Control.Parallel.Strategies (parMap, rpar)
import qualified Data.Set as S
import Data.List.Split (chunksOf)
import Data.List (transpose)

cntSeq :: S.Set Int -> [Int] -> Int
cntSeq set xs = foldl (\ c x -> c + (mmbr set x)) 0 xs
  where
    mmbr st x | S.member x st = 1
              | otherwise = 0

cntPar :: Int -> S.Set Int -> [Int] -> Int
cntPar n set xs =
  let
    chnks = chunksOf n xs
    tr = transpose chnks
  in sum $ parMap rpar (cntSeq set) tr
  -- in sum $ map sum chnks

main :: IO ()
main = do
  t0 <- getCurrentTime
  -- Non-parallelizable segment
  let !s = (S.fromList [0, 3 .. 10^7])
  t1 <- getCurrentTime
  print (diffUTCTime t1 t0)
  print (cntPar 10000 s [0..10^6])
  t2 <- getCurrentTime
  print (diffUTCTime t2 t1)

{-

$ stack exec ghc -- -rtsopts -threaded B
[1 of 1] Compiling Main             ( B.hs, B.o )
Linking B ...

$ time ./B +RTS -N1
1.056170132s
333334
1.060999272s
./B +RTS -N1  1.98s user 0.17s system 99% cpu 2.154 total

$ time ./B +RTS -N2
0.983455879s
333334
0.794821458s
./B +RTS -N2  2.67s user 0.62s system 180% cpu 1.824 total

-}