Skip to content

Instantly share code, notes, and snippets.

@CnrLwlss
Created November 23, 2014 20:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save CnrLwlss/0c0bf1940bfed59faeac to your computer and use it in GitHub Desktop.
Save CnrLwlss/0c0bf1940bfed59faeac to your computer and use it in GitHub Desktop.
import Control.Parallel (par, pseq)
import Control.DeepSeq
import System.Environment (getArgs)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
data Tree x = Empty | Node x (Tree x) (Tree x) deriving (Show, Read, Eq)
-- Create instance of NFData for Tree data type (defining "normal form")
instance NFData a => NFData (Tree a) where
rnf Empty = ()
rnf (Node x l r) = rnf x `seq` rnf l `seq` rnf r
-- Serial recursive function to build a tree
copyBox :: Integer -> Tree Integer
copyBox x
| x <= 0 = Empty
| x > 0 = Node x (copyBox (x-1)) (copyBox (x-1))
-- Recursive function to build a tree using multiple processors simultaneously
copyBoxPar :: Integer -> Tree Integer
copyBoxPar x
| x <= 0 = Empty
| x > 0 = force left `par` (force right `pseq` (Node x (left)(right)))
where
left = copyBoxPar (x-1)
right = copyBoxPar (x-1)
-- Serial recursive function to count leaves in tree
countBoxes :: Tree x -> Integer
countBoxes Empty = 0
countBoxes (Node x left right) = 1 + countBoxes (left) + countBoxes (right)
-- Recursive function to count leaves in tree using multiple processors simultaneously
countBoxesPar :: NFData x => Tree x -> Integer
countBoxesPar Empty = 0
countBoxesPar (Node x left right) = 1 + countBoxes (left) + countBoxes (right)
main = do
-- Get tree depth from command line argument if specified
args <- getArgs
let depth | null args = 5
| otherwise = read (head args) :: Integer
-- Timings for serial building and serial traversing of tree
start <- getCurrentTime
let newtree = copyBox depth
let nboxes = countBoxes newtree
putStrLn $ "Serial Result: " ++ show (nboxes)
end <- getCurrentTime
putStrLn $ "Time elapsed: "++ show (end `diffUTCTime` start)
-- Timings for parallel building and parallel traversing of tree
startp <- getCurrentTime
let newtreepar = copyBoxPar depth
let nboxespar = countBoxesPar newtreepar
end <- getCurrentTime
putStrLn $ "Parallel Result: " ++ show (nboxespar)
end <- getCurrentTime
putStrLn $ "Time elapsed: "++ show (end `diffUTCTime` startp)
-- Timings for parallel building and serial traversing of tree
startp <- getCurrentTime
let newtreepar = copyBoxPar depth
let nboxespar = countBoxes newtreepar
endp <- getCurrentTime
putStrLn $ "Parallel/Serial Result: " ++ show (nboxespar)
endp <- getCurrentTime
putStrLn $ "Time elapsed: "++ show (endp `diffUTCTime` startp)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment