CSE 230: Winter 2013

Parallel Programming

Ranjit Jhala, UC San Diego

Lecture based on Simon Marlowe's Excellent Tutorial

So far

FP is awesome...

So far

FP is awesome...

... but in the "multicore era" languages live or die on

But first ...

What is the difference between ...

... or are they the same thing?

Parallelism vs. Concurrency


Parallel Program


Concurrent Program

Parallelism vs. Concurrency


Different Requirements

Parallelism vs. Concurrency


Different Requirements

Haskell has different ideas for each...

Parallel Haskell

Parallel Haskell: Dream of the 70s/80s

Compiler automatically parallelize programs?

Why is Parallelizing Code Difficult?

  1. Tracking data dependencies and side effects
  1. Tradeoff between parallelism benefits vs. overheads

Why is Parallelizing Code Difficult?

  1. Tracking data dependencies and side effects
  1. Tradeoff between parallelism benefits vs. overheads

Why is Parallelizing Code Difficult?

  1. Tracking data dependencies and side effects

  2. Tradeoff between parallelism benefits vs. overheads

Haskell solves (1) but not (2)

  1. Pure FP to the rescue: all dependencies explicit
  1. You are (mostly) on your own!

Next: Parallel Haskell In Action!

  1. (Parallel) Sudoku Solver
  1. (Parallel) KMeans Clustering

A Sudoku Solver

Lets see how to parallelize a Sudoku Solver


solve :: String -> Maybe Grid

A Sudoku Solver

Lets see how to parallelize a Sudoku Solver


solve :: String -> Maybe Grid

String input problem description


let puz = ".......2143.......6........2.15..........637...........68...4.....23........7...."

A Sudoku Solver

solve :: String -> Maybe Grid

Grid output description


ghci> printGrid $ fromJust $ solve puz
 
 8  5  7 | 3  4  9 | 6  2  1 
 4  3  2 | 8  6  1 | 5  9  7 
 6  1  9 | 7  5  2 | 8  4  3 
---------+---------+---------
 2  7  1 | 5  8  3 | 9  6  4 
 9  4  5 | 1  2  6 | 3  7  8 
 3  8  6 | 4  9  7 | 2  1  5 
---------+---------+---------
 7  6  8 | 9  1  5 | 4  3  2 
 1  9  4 | 2  3  8 | 7  5  6 
 5  2  3 | 6  7  4 | 1  8  9

Solving Many Instances

import Sudoku
import Control.Exception
import System.Environment

main :: IO ()
main = do
    [f]   <- getArgs                    -- get filename containing puzzles
    grids <- fmap lines $ readFile f    -- parse file into puzzles
    mapM_ (evaluate . solve) grids      -- solve all puzzles

Brief Digression: Laziness

Brief Digression: Laziness

Lets look at an example ...


fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

Brief Digression: Laziness

fib is a really slow function


ghci> fib 35
...
9227465

Brief Digression: Laziness

fib is a really slow function


ghci> let z = fib 35
ghci> -- comes back instantly!

How does it finish so fast?

ghci> :sprint z
_

Brief Digression: Laziness

fib is a really slow function


Can force it to be computed by demanding to show it

ghci> z 
...
9227465

ghci> :sprint z
z = 9227465

Brief Digression: Laziness

Whats up with the evaluate ? ...


evaluate :: a -> IO a

Evaluate upto top-level constructor (WHNF)

evaluate forces Haskell to compute upto top-level constructor


ghci> let fib2 n = (fib n, fib (n+1))

Evaluate upto top-level constructor (WHNF)

evaluate forces Haskell to compute upto top-level constructor


ghci> let fib2 n = (fib n, fib (n+1))
ghci> let r      = fib2 35 
ghci> :sprint r
r = _

Evaluate upto top-level constructor (WHNF)

evaluate forces Haskell to compute upto top-level constructor


ghci> let fib2 n = (fib n, fib (n+1))
ghci> let r      = fib2 35 
ghci> r' <- evaluate r
ghci> :sprint r'
r' = (_,_)

Force full computation by asking for output ...


ghci> r
...
ghci> r
(9227465,14930352)

ghci> :sprint r
r = (9227465,14930352)

ghci> :sprint r' 
r' = (9227465,14930352)

Back to: Solving Many Sudoku Instances

import Sudoku
import Control.Exception
import System.Environment

main :: IO ()
main = do
    [f]   <- getArgs                    -- get filename containing puzzles
    grids <- fmap lines $ readFile f    -- parse file into puzzles
    mapM_ (evaluate . solve) grids      -- solve all puzzles

Solving Many Sudoku Instances

Lets compile with runtime stats ...

$ ghc -O2 sudoku1.hs -rtsopts

... and run!

$ ./sudoku1 sudoku17.1000.txt +RTS -s

Solving Many Sudoku Instances

Lets compile with runtime stats ...

$ ghc -O2 sudoku1.hs -rtsopts

... and run!

$ ./sudoku1 sudoku17.1000.txt +RTS -s

Not too shabby ... (elapsed is wall-clock time)

Total   time    2.11s  (  2.11s elapsed)

Solving Many Sudoku Instances

import Sudoku
import Control.Exception
import System.Environment

main :: IO ()
main = do
    [f]   <- getArgs                    -- get filename containing puzzles
    grids <- fmap lines $ readFile f    -- parse file into puzzles
    mapM_ (evaluate . solve) grids      -- solve all puzzles

Parallelism anyone?

Solving Many Sudoku Instances

Parallelism with the Eval Monad

There's a library for everything ... Control.Parallel.Strategies

  1. A Type for Parallel Computations Yielding a Values
data Eval a

Parallelism with the Eval Monad

There's a library for everything ... Control.Parallel.Strategies

  1. A Type for Parallel Computations Yielding a Values
data Eval a
  1. You can sequence such computations (or run in parallel) so ...
instance Monad Eval

Parallelism with the Eval Monad

There's a library for everything ... Control.Parallel.Strategies

data Eval a
instance Monad Eval

To execute a computation

runEval :: Eval a -> a

Parallelism with the Eval Monad

There's a library for everything ... Control.Parallel.Strategies

data Eval a
instance Monad Eval

runEval :: Eval a -> a
  1. To create such computations
rpar :: a -> Eval a   
rseq :: a -> Eval a

Solving Many Sudoku Instances ... in parallel!

See sudoku2.hs

main :: IO ()
main = do
    [f]   <- getArgs
    grids <- fmap lines $ readFile f

    let (as, bs) = splitAt (length grids `div` 2) grids

    evaluate $ runEval $ do
       a <- rpar (deep (map solve as))  -- spawn first half
       b <- rpar (deep (map solve bs))  -- spawn second half
       rseq a                           -- wait till done
       rseq b                           -- wait till done
       return ()

Solving Many Sudoku Instances ... in parallel!

Lets compile ...

$ ghc -O2 sudoku2.hs -rtsopts -threaded

... and run

$ ./sudoku2 sudoku17.1000.txt +RTS -N2 -s
.
.  
  SPARKS: 2 (1 converted, 0 overflowed, 0 dud, 0 GC'd, 1 fizzled)
.
.
  Total   time    2.66s  (  1.52s elapsed)

Speedup = 2.11/1.52 = 1.38

Solving Many Sudoku Instances ... in parallel!

$ threadscope sudoku2.eventlog

Second core is idling towards the end...

Static v. Dynamic Partitions

Problem: Work is not divided evenly


Static Partitions

Dynamic Partitions

GHC's Automatic Balancing: Sparks & Work Stealing


rpar e

Spark

Work Stealing

Dynamic Partitioning


rpar e

Spark

Work Stealing

Dynamic Partitioning

Dynamic Partitioning for Sudoku Solver

How to partition dynamically ?

main :: IO ()
main = do
    [f]   <- getArgs
    grids <- fmap lines $ readFile f

    let (as, bs) = splitAt (length grids `div` 2) grids

    evaluate $ runEval $ do
       a <- rpar (deep (map solve as))  -- spawn first half
       b <- rpar (deep (map solve bs))  -- spawn second half
       rseq a                           -- wait till done
       rseq b                           -- wait till done
       return ()

Dynamic Partitioning for Sudoku Solver

How to partition dynamically ?

main :: IO ()
main = do
    [f]     <- getArgs
    grids   <- fmap lines $ readFile f
    evaluate $ runEval $ parSolve grids 
parSolve []       = return []
parSolve (x : xs) = do y  <- rpar (deep (solve x))
                       ys <- parSolve xs
                       return (y : ys)

Dynamic Partitioning With a Parallel Map

Can bottle the parallel pattern in parMap

parMap          :: (a -> b) -> [a] -> Eval [b] 
parMap f []     = return []
parMap f (x:xs) = do y  <- rpar (f x)
                     ys <- parMap xs
                     return (y:ys)

->

Dynamic Partitioning With a Parallel Map

Can release the genie to solve sudoku in parallel sudoku3.hs

main :: IO ()
main = do
    [f]     <- getArgs
    grids   <- fmap lines $ readFile f
    evaluate $ deep $ runEval $ parMap solve grids

Dynamic Partitioning With a Parallel Map

Can release the genie to solve sudoku in parallel sudoku3.hs

Compile ...

$ ghc -O2 sudoku3.hs -rtsopts -threaded

... and run

$ ./sudoku3 sudoku17.1000.txt +RTS -N2 -s
.  
  SPARKS: 1000 (1000 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
.
  Total   time    3.10s  (  1.57s elapsed)

Dynamic Partitioning With a Parallel Map

Can release the genie to solve sudoku in parallel sudoku3.hs

Not too bad, lets see if the cores are balanced...

$ threadscope sudoku3.eventlog

Dynamic Partitioning With a Parallel Map

Can release the genie to solve sudoku in parallel sudoku3.hs

Can just throw more cores at it ... 5.4 x speedup

$ ./sudoku3 sudoku17.1000.txt +RTS -N2 -s
  Total   time    3.24s  (  1.64s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N3 -s
  Total   time    3.47s  (  1.17s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N4 -s
Total   time    3.30s  (  0.84s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N6 -s
  Total   time    3.96s  (  0.67s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N8 -s
  Total   time    4.64s  (  0.61s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N10 -s
  Total   time    4.77s  (  0.50s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N12 -s
  Total   time    5.28s  (  0.47s elapsed)
$ ./sudoku3 sudoku17.1000.txt +RTS -N14 -s
  Total   time    5.68s  (  0.44s elapsed)

Dynamic Partitioning With a Parallel Map

Can release the genie to solve sudoku in parallel sudoku3.hs

Better still, can just throw more cores at it ...

... upto a point!

$ ./sudoku3 sudoku17.1000.txt +RTS -N12 -s
  Total   time    5.28s  (  0.47s elapsed)

$ ./sudoku3 sudoku17.1000.txt +RTS -N14 -s
  Total   time    5.68s  (  0.44s elapsed)

$ ./sudoku3 sudoku17.1000.txt +RTS -N16 -s
  Total   time    6.97s  (  0.48s elapsed)

$ ./sudoku3 sudoku17.1000.txt +RTS -N18 -s
  Total   time    8.42s  (  0.52s elapsed)

Co-ordinating that many cores not always worth it...

Parallel Strategies

Parallel Strategies

Parallel Strategies: Functions that Determine How To Eval


type Strategy a = a -> Eval a

Parallel Strategies


type Strategy a = a -> Eval a

Some Example Strategys ...

rpar :: a -> Eval a     -- Evaluate a in PARALLEL with current thread
rseq :: a -> Eval a     -- Evaluate a in SEQUENCE in   current thread

... and so!

rpar :: Strategy a      -- Evaluate a in PARALLEL with current thread
rseq :: Strategy a      -- Evaluate a in SEQUENCE in   current thread

Parallel Strategies

type Strategy a = a -> Eval a

Some Example Strategys

rdeepseq :: NFData a => Strategy a
rdeepseq x = rseq (deep x)

Using Strategies

using       :: a -> Strategy a -> a

x `using` s = runEval (s x)
  1. s x :: Eval a, says how to evaluate x
  1. runEval (s x), then executes the plan yielding the value x

Strategies and Lazy Evaluation

using :: a -> Strategy a -> a
x `using` s = runEval (s x)

Note That


x `using` s == x

Parallel List Strategies

Parallel List Strategies

parMap f xs = map f xs `using` strategy

Parallel List Strategies

parMap f xs = map f xs `using` strategy

What is strategy ?

parList              :: Strategy a -> Strategy [a]

parList xstrat []    = return []
parList strat (x:xs) = do x'  <- rpar (x `using` xstrat)                            -- > 
                          xs' <- parList xstrat xs
                          return (x' : xs')

Parallel List Strategies

parMap f xs = map f xs `using` parList rseq

What is strategy ?

parList              :: Strategy a -> Strategy [a]

Sudoku: Revisited With Parallel List Strategy

Lets use parList to solve sudoku in parallel sudoku4.hs

main :: IO ()
main = do
    [f]     <- getArgs
    grids   <- fmap lines $ readFile f
    evaluate $ deep $ runEval $ map solve grids `using` parList rseq

Note: Entire parallelism secret sauce reduced to using parList rseq

$ ghc -O2 sudoku4.hs -rtsopts

$ ./sudoku4 sudoku17.1000.txt +RTS -N10 -s
  SPARKS: 1000 (1000 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
  Total   time    5.16s  (  0.46s elapsed)

Next: Parallel Haskell In Action!

  1. (Parallel) Sudoku Solver
  1. (Parallel) KMeans Clustering

KMeans Clustering in Pictures

Problem: Given a set of points, group into K clusters.

KMeans: Step 0, Guess K Arbitrary Centers

Problem: Given a set of points, group into K clusters.

Centers chosen arbitrarily

KMeans: Step 1, Map each point to NEAREST Center

Problem: Given a set of points, group into K clusters.

For each point:

KMeans: Step 2, Move Centers To Cluster CENTROIDS

Problem: Given a set of points, group into K clusters.

For each clustering

KMeans: Repeat 1, 2 Until Convergence

KMeans: Code

kmeans.hs

Representing 2-D Points

data Vector = Vector Double Double

Operations on Vectors

zeroVector :: Vector 
zeroVector = Vector 0 0

addVector :: Vector -> Vector -> Vector
addVector (Vector a b) (Vector c d) = Vector (a+c) (b+d)

sqDistance :: Vector -> Vector -> Double
sqDistance (Vector x1 y1) (Vector x2 y2) = ((x1-x2)^2) + ((y1-y2)^2)

KMeans: Code

kmeans.hs

Representing Clusters

data Cluster = Cluster { clId    :: Int    -- ID     of cluster 0..K
                       , clCount :: Int    -- NUMBER of points in cluster
                       , clSum   :: Vector -- SUM    of points in cluster
                       , clCent  :: Vector -- CENTER of cluster
                       }

KMeans: Code

Operations on Clusters

makeCluster :: Int -> [Vector] -> Cluster
makeCluster clid vecs = Cluster { clId     = clid
                                , clCount  = count 
                                , clSum    = vecsum
                                , clCent   = centre }
   where 
     vecsum@(Vector a b) = foldl' addVector zeroVector vecs
     centre              = Vector (a / fromIntegral count) (b / fromIntegral count)
     count               = length vecs
  
combineClusters c1 c2 =
  Cluster {clId     = clId c1,
           clCount  = count,
           clSum    = vecsum,
           clCent   = Vector (a / fromIntegral count) (b / fromIntegral count)}
  where count = clCount c1 + clCount c2
        vecsum@(Vector a b)  = addVector (clSum c1) (clSum c2)

KMeans: Code (Sequential) Top-level Algorithm

kmeans_seq nclusters points initClusters = do
  let
      loop n clusters | n > tooMany = do printf "giving up."; return clusters
      loop n clusters = do
        let clusters' = step nclusters clusters points
        if clusters' == clusters
           then return clusters
           else loop (n+1) clusters'
  --
  loop 0 initClusters

Each step is

step :: Int -> [Cluster] -> [Vector] -> [Cluster]
step nclusters clusters points = makeNewClusters (assign nclusters clusters points)

makeNewClusters     :: Array Int [Vector] -> [Cluster]
makeNewClusters arr = [ makeCluster i ps | (i, ps) <- assocs arr, not (null ps) ]

KMeans: Code (Sequential)

Lets run it!

$ ghc -O2 -threaded -rtsopts -eventlog kmeans.hs
$ ./kmeans seq
...
Total time: 0.65

Note Program prints out its own time to ignore sequential IO

KMeans: Code (Parallel)

KMeans: Code (Parallel)

KMeans: Code (Parallel)

kmeans_strat :: Int -> Int -> [Vector] -> [Cluster] -> IO [Cluster]
kmeans_strat numChunks nclusters points clusters = do
  let chunks = split numChunks points
  let
      loop n clusters | n > tooMany = do printf "giving up."; return clusters
      loop n clusters = do
        let  new_clusterss = map (step nclusters clusters) chunks
                               `using` parList rdeepseq
             clusters'     = reduce nclusters new_clusterss
        if clusters' == clusters
           then return clusters
           else loop (n+1) clusters'
  --
  loop 0 clusters
  1. Break into chunks
  2. map the step over each chunk
  3. reduce the resulting new_clusterss from chunks into single clusters'

Note Can just drop the using and get sequential code

KMeans: Code (Parallel)

reduce cluster-lists by combine-ing clusters

reduce :: Int -> [[Cluster]] -> [Cluster]
reduce nclusters css
  = concatMap combine                        -- 4. combine all sub-clusters of each ID 
    $ elems                                  -- 3. flatten into [[Cluster]], each inner list same ID
    $ accumArray (flip (:)) [] (0,nclusters) -- 2. gather into Array ID [Cluster]
    $ [ (clId c, c) | c <- concat css]       -- 1. group all clusters by ID
 where
   combine [] = []
   combine (c:cs) = [foldr combineClusters c cs]

KMeans: Code (Parallel)

Lets run it!

$ ./kmeans seq
...
Total time: 0.65

$ ./kmeans strat 800 +RTS -N2
Total time: 0.67

$ ./kmeans strat 800 +RTS -N3
Total time: 0.34

$ ./kmeans strat 800 +RTS -N4
Total time: 0.28

$ ./kmeans strat 800 +RTS -N6
Total time: 0.16

$ ./kmeans strat 800 +RTS -N8
Total time: 0.14

KMeans: Code (Parallel)

Next: Parallel Haskell In Action!

  1. (Parallel) Sudoku Solver
  1. (Parallel) KMeans Clustering

Implicit v. Explicit Parallelism

Implicit Parallelism

Implicit v. Explicit Parallelism

Alternative: Explicit dataflow parallelism

Explicit Parallelism

The Par Monad


newtype Par a

instance Monad Par

Explicit Parallelism

Explicitly Force Task Creation


fork :: Par () -> Par ()

Explicit Parallelism


Tasks Communicate Via Shared Variables

data IVar a -- reference to `a` cell

Explicit Parallelism


Tasks Communicate Via Shared Variables

data IVar a -- reference to `a` cell

Operations on Shared Variables

new :: Par (IVar a)                         -- create
put :: NFData a => IVar a -> a -> Par ()    -- write-once
get :: IVar a -> Par a                      -- blocking read

Explicit Parallelism


To Actually Execute the Action

runPar :: Par a -> a

Sudoku Revisited

See sudoku-par2.hs

main :: IO ()
main = do
    [f]   <- getArgs
    grids <- fmap lines $ readFile f
    let (as,bs) = splitAt (length grids `div` 2) grids
    print $ length $ filter isJust $ runPar $ do
       i1 <- new                    -- (1)  
       i2 <- new                     
       fork $ put i1 (map solve as) -- (2) 
       fork $ put i2 (map solve bs) 
       as' <- get i1                -- (3)
       bs' <- get i2                 
       return (as' ++ bs')
  1. Create IVar for each half
  2. Fork task for each half
  3. Wait until each half finishes

Explicit Parallelism Patterns: spawn

spawn :: NFData a => Par a -> Par (IVar a)
spawn p = do i <- new                       -- > Create IVar 
             fork (do x <- p; put i x)      -- > Fork process to write IVar
             return i                       -- > Return IVar

Sudoku Revisited With spawn

See sudoku-par2-spawn.hs

main = do
    [f] <- getArgs
    grids <- fmap lines $ readFile f
    let (as,bs) = splitAt (length grids `div` 2) grids
    print $ length $ filter isJust $ runPar $ do
       i1  <- spawn (return (map solve as)) 
       i2  <- spawn (return (map solve bs)) 
       as' <- get i1
       bs' <- get i2
       return (as' ++ bs')

Run it! (Same as sudoku2 or sudoku-par2)

./sudoku-par2-spawn sudoku17.1000.txt +RTS -N2 -s
  Total   time    2.44s  (  1.46s elapsed)

Explicit Parallelism Patterns: parMap

How would we execute a list of tasks in parallel?

Explicit Parallelism Patterns: parMap

How would we execute a list of tasks in parallel?

Given:

f             :: (a -> b)
[x1, ..., xn] :: [a]

Explicit Parallelism Patterns: parMap

How would we execute a list of tasks in parallel?

parMap :: (NFData b) => (a -> b) -> [a] -> Par [b]
parMap f xs = do ivs <- mapM (spawn . return . f)                       -- >  
                 mapM get ivs
  1. spawn each f x in list in parallel ...
  2. wait-for each variable ...

Sudoku Revisited With parMap

See sudoku-par3.hs

main :: IO ()
main = do
    [f] <- getArgs
    grids <- fmap lines $ readFile f
    print (length (filter isJust (runPar $ parMap solve grids)))

Run it!

./sudoku-par3 sudoku17.1000.txt +RTS -N10 -s
  Total   time    3.38s  (  0.38s elapsed)

Regular vs Irregular Parallelism


So far: Regular Parallelism

Irregular Parallelism