Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- open System
- open System.Diagnostics
- open System.Linq
- open System.Threading
- open System.Threading.Tasks
- open FSharp.Collections.ParallelSeq
- let stopWatch =
- let sw = Stopwatch ()
- sw.Start ()
- sw
- // --+++---
- let total = 100000000
- let outer = 100
- let inner = total / outer
- let timeIt (name : string) (a : unit -> 'T) : 'T*int64 =
- let t = stopWatch.ElapsedMilliseconds
- let v = a ()
- for i = 2 to outer do
- a () |> ignore
- let d = stopWatch.ElapsedMilliseconds - t
- v, d
- let parallelism () =
- let proc = Process.GetCurrentProcess ()
- let pa = uint64 proc.ProcessorAffinity
- let rec loop c m =
- if m = 0UL then c
- else loop (c + 1) (m >>> 1)
- loop 0 pa
- let numbers = [| for i in 0..(inner - 1) -> int64 i |]
- let naiveFor () =
- let mutable x = 0L
- for v in numbers do
- x <- x + v
- x
- let arraySum () =
- numbers |> Array.sum
- let linqSum () =
- numbers.Sum ()
- let seqSum () =
- numbers |> Seq.sum
- let pseqSum () =
- numbers |> PSeq.sum
- let naiveParallelForSum () =
- let sum = ref 0L
- let localInit = Func<int64> (fun () -> 0L)
- let body = Func<int, ParallelLoopState, int64, int64> (fun i pls s -> s + numbers.[i])
- let localFinally = Action<int64> (fun s -> Interlocked.Add (sum, s) |> ignore)
- let options = ParallelOptions ()
- let result = Parallel.For (0, inner, localInit, body, localFinally)
- !sum
- let batchedParallelForSum () =
- let size = 100
- let batches = inner / size
- if (inner % size) <> 0 then failwithf "%d can't be batched evenly with batch size %d" inner size
- let sum = ref 0L
- let localInit = Func<int64> (fun () -> 0L)
- let body = Func<int, ParallelLoopState, int64, int64> (fun i pls s ->
- let mutable s = s
- let b = i * size
- let e = b + size
- for j = b to (e - 1) do
- s <- s + numbers.[j]
- s)
- let localFinally = Action<int64> (fun s -> Interlocked.Add (sum, s) |> ignore)
- let options = ParallelOptions ()
- let result = Parallel.For (0, batches, localInit, body, localFinally)
- !sum
- let taskSum () =
- let batches = 10
- let size = inner / batches
- if (inner % batches) <> 0 then failwithf "%d can't be batched over %d batches" inner batches
- let task i = Func<int64> (fun () ->
- let mutable s = 0L
- let b = i * size
- let e = b + size
- for j = b to (e - 1) do
- s <- s + numbers.[j]
- s)
- let options = TaskCreationOptions.LongRunning
- let tasks =
- [|
- for i in 0..(batches - 1) -> Task.Factory.StartNew (task i, options)
- |]
- Task.WaitAll (tasks |> Array.map (fun t -> t :> Task))
- tasks |> Array.sumBy (fun t -> t.Result)
- [<EntryPoint>]
- let main argv =
- let testCases =
- [|
- "naiveFor" , false , naiveFor
- "arraySum" , false , arraySum
- "linqSum" , false , linqSum
- "seqSum" , false , seqSum
- "pseqSum" , true , pseqSum
- "naiveParallelForSum" , true , naiveParallelForSum
- "batchedParallelForSum" , true , batchedParallelForSum
- "taskSum" , true , taskSum
- |]
- let parallelism = parallelism ()
- let runTestCases () =
- [|
- for name, isParallel, action in testCases do
- printfn " Running test case %s" name
- yield name, isParallel, timeIt name action
- |]
- printfn "Running all test cases with default parallelism: %dX" parallelism
- let parallelResults = runTestCases ()
- let proc = Process.GetCurrentProcess ()
- proc.ProcessorAffinity <- nativeint 0x1
- Thread.Sleep 100
- printfn "Running all test cases with no parallelism"
- let sequentialResults = runTestCases ()
- if parallelResults.Length <> sequentialResults.Length then
- failwith "parallelResults & sequentialResults must have the same length"
- printfn "Results, sequential results are presented in parantheses"
- for i = 0 to (parallelResults.Length - 1) do
- let pname, pp, (pv, pt) = parallelResults.[i]
- let sname, sp, (sv, st) = sequentialResults.[i]
- if pname <> sname then
- failwithf "parallelResults & sequentialResults must have the same name@%d" i
- if pp then
- let speedup = float st / float pt
- let efficiency = float st / (float pt * float parallelism)
- printfn
- " %s result: %A (%A), took %d (%d) ms, parallel speedup %f, parallel efficiency: %f"
- pname
- pv
- sv
- pt
- st
- speedup
- efficiency
- if sv <> pv then
- printfn " ERROR: Sequntial and parallel results differs"
- else
- printfn
- " %s result: %A (%A), took %d (%d) ms"
- pname
- pv
- sv
- pt
- st
- if sv <> pv then
- printfn " ERROR: Sequntial and parallel results differs"
- 0
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement