Haskell: Using multiple cores to calculate a value in parallel -- fibonacci(n) + factorial(n)

FactFibSum.hs

{- For demonstration only; this is deliberately slow recursive code to highlight multicore speedup -} 
import System.Time
import Control.Concurrent
import Control.Parallel.Strategies hiding (parMap)
import System.Environment

fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

fact 0 = 1
fact 1 = 1
fact n = n * fact (n - 1)

fibs  n = map fib [1..n]
facts n = map fact [1..n] 

main :: IO ()
main = do
  -- Read n from the command line
  args <- getArgs
  let n = read (head args) :: Int
  
  -- Start the clock
  t <- getClockTime
  let fs = fibs n
      fc = facts n
  print $ zipWith (+) fs fc
  t' <- getClockTime
  
  putStrLn $ "Normal: " ++ (timeDiffToString $ diffClockTimes t' t)

FactFibSumParallel.hs

import System.Environment
import System.Time

import Control.Concurrent
import Control.Parallel.Strategies hiding (parMap)

fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

fact 0 = 1
fact 1 = 1
fact n = n * fact (n - 1)

-- Sum fib n and fact n in parallel
h n = runEval $
      do
        a <- rpar $ fib n
        b <- rpar $ fact n
        return (a+b)

parMap :: (a -> b) -> [a] -> Eval [b]
parMap f [] = return []
parMap f (a:as) = do
     b <-  rpar (f a)
     bs <- parMap f as
     return (b:bs)

main :: IO ()
main = do
  -- Read n from command line
  args <- getArgs
  let n = read (head args) :: Int
  
  -- Start the clock
  t <- getClockTime
  print $ runEval $ parMap h [1..n]
  t' <- getClockTime
  
  putStrLn $ "Parallel: " ++ (timeDiffToString $ diffClockTimes t' t)

Results.md

Benchmarks

Sum n elements of fib n and fact n

n        Standard     Parallel (8 cores)
40       5 sec        2 sec 
45       48 sec       25 sec

Speedup: 1.92x

Compile Flags

Standard             ghc -O2 file
Parallel             ghc -O2 file -threaded 
                     ./file n +RTS -N8