[Haskell-cafe] Parallel Pi

[Daniel Fischer]

Am Mittwoch 17 März 2010 19:49:57 schrieb Artyom Kazak:
> Hello!
> I tried to implement the parallel Monte-Carlo method of computing Pi
> number, using two cores:
<move>
>
> But it uses only on core:
>
<snip>
>
> We see that our one spark is pruned. Why?
>

Well, the problem is that your tasks don't do any real work - yet.
piMonte returns a thunk pretty immediately, that thunk is then evaluated by 
show, long after your chance for parallelism is gone. You must force the 
work to be done _in_ r1 and r2, then you get parallelism:

  Generation 0:  2627 collections,  2626 parallel,  0.14s,  0.12s elapsed
  Generation 1:     1 collections,     1 parallel,  0.00s,  0.00s elapsed

  Parallel GC work balance: 1.79 (429262 / 240225, ideal 2)

                        MUT time (elapsed)       GC time  (elapsed)
  Task  0 (worker) :    0.00s    (  8.22s)       0.00s    (  0.00s)
  Task  1 (worker) :    8.16s    (  8.22s)       0.01s    (  0.01s)
  Task  2 (worker) :    8.00s    (  8.22s)       0.13s    (  0.11s)
  Task  3 (worker) :    0.00s    (  8.22s)       0.00s    (  0.00s)

  SPARKS: 1 (1 converted, 0 pruned)

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time   16.14s  (  8.22s elapsed)
  GC    time    0.14s  (  0.12s elapsed)
  EXIT  time    0.00s  (  0.00s elapsed)
  Total time   16.29s  (  8.34s elapsed)

  %GC time       0.9%  (1.4% elapsed)

  Alloc rate    163,684,377 bytes per MUT second

  Productivity  99.1% of total user, 193.5% of total elapsed

But alas, it is slower than the single-threaded calculation :(

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time    7.08s  (  7.10s elapsed)
  GC    time    0.08s  (  0.08s elapsed)
  EXIT  time    0.00s  (  0.00s elapsed)
  Total time    7.15s  (  7.18s elapsed)


> --PROGRAM
> module Main where
>
> import Random
> import Data.Ratio
> import Data.List
> import System.IO
> import GHC.Conc
>
> main = do
>   putStrLn "pi 1"
>   putStr "n: "
>   hFlush stdout
>   t <- getLine
>   piMonte (read t) >>= (putStrLn . show)
>
> piMonte n = do
>   (g1, g2) <- split `fmap` getStdGen
>   let r1 = r (n `div` 2) g1
>       r2 = r (n `div` 2 + n `mod` 2) g2 in
>     return (ratio (r1 `par` (r2 `pseq` (merge r1 r2))))
>   where
>     r n g = (length (filter id lAll), n)
thunk----------^^^^^^^^^^^^^^^^^^^^^^^

That thunk doesn't take much work to produce, only to evaluate, so you must 
force the evaluation within r, e.g. via

    r n g = ln `pseq` (ln,n)
      where
        ln = length (filter id lAll)
        ...

unfortunately, that doesn't give a speed-up, I don't know why.

>       where
>         l = take n . randomRs (0, 1)
>         inCircle :: Double -> Double -> Bool
>         inCircle a b = a*a + b*b <= 0.25
>         lAll = zipWith inCircle (l g1) (l g2)
>         (g1, g2) = split g
>     ratio :: (Int, Int) -> Double
>     ratio (a, b) = fromRational (toInteger a % toInteger b * 16)
>     merge (a, b) (c, d) = (a + c, b + d)
> --END