Advertisement
Guest User

Untitled

a guest
Feb 14th, 2016
62
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.74 KB | None | 0 0
  1. open System
  2. open System.Diagnostics
  3. open System.Linq
  4. open System.Threading
  5. open System.Threading.Tasks
  6. open FSharp.Collections.ParallelSeq
  7.  
  8. let stopWatch =
  9. let sw = Stopwatch ()
  10. sw.Start ()
  11. sw
  12.  
  13. // --+++---
  14. let total = 100000000
  15. let outer = 100
  16. let inner = total / outer
  17.  
  18. let timeIt (name : string) (a : unit -> 'T) : 'T*int64 =
  19. let t = stopWatch.ElapsedMilliseconds
  20. let v = a ()
  21. for i = 2 to outer do
  22. a () |> ignore
  23. let d = stopWatch.ElapsedMilliseconds - t
  24. v, d
  25.  
  26. let parallelism () =
  27. let proc = Process.GetCurrentProcess ()
  28. let pa = uint64 proc.ProcessorAffinity
  29. let rec loop c m =
  30. if m = 0UL then c
  31. else loop (c + 1) (m >>> 1)
  32. loop 0 pa
  33.  
  34.  
  35. let numbers = [| for i in 0..(inner - 1) -> int64 i |]
  36.  
  37. let naiveFor () =
  38. let mutable x = 0L
  39. for v in numbers do
  40. x <- x + v
  41. x
  42.  
  43. let arraySum () =
  44. numbers |> Array.sum
  45.  
  46. let linqSum () =
  47. numbers.Sum ()
  48.  
  49. let seqSum () =
  50. numbers |> Seq.sum
  51.  
  52. let pseqSum () =
  53. numbers |> PSeq.sum
  54.  
  55. let naiveParallelForSum () =
  56. let sum = ref 0L
  57. let localInit = Func<int64> (fun () -> 0L)
  58. let body = Func<int, ParallelLoopState, int64, int64> (fun i pls s -> s + numbers.[i])
  59. let localFinally = Action<int64> (fun s -> Interlocked.Add (sum, s) |> ignore)
  60. let options = ParallelOptions ()
  61. let result = Parallel.For (0, inner, localInit, body, localFinally)
  62. !sum
  63.  
  64. let batchedParallelForSum () =
  65. let size = 100
  66. let batches = inner / size
  67. if (inner % size) <> 0 then failwithf "%d can't be batched evenly with batch size %d" inner size
  68. let sum = ref 0L
  69. let localInit = Func<int64> (fun () -> 0L)
  70. let body = Func<int, ParallelLoopState, int64, int64> (fun i pls s ->
  71. let mutable s = s
  72. let b = i * size
  73. let e = b + size
  74. for j = b to (e - 1) do
  75. s <- s + numbers.[j]
  76. s)
  77. let localFinally = Action<int64> (fun s -> Interlocked.Add (sum, s) |> ignore)
  78. let options = ParallelOptions ()
  79. let result = Parallel.For (0, batches, localInit, body, localFinally)
  80. !sum
  81.  
  82. let taskSum () =
  83. let batches = 10
  84. let size = inner / batches
  85. if (inner % batches) <> 0 then failwithf "%d can't be batched over %d batches" inner batches
  86. let task i = Func<int64> (fun () ->
  87. let mutable s = 0L
  88. let b = i * size
  89. let e = b + size
  90. for j = b to (e - 1) do
  91. s <- s + numbers.[j]
  92. s)
  93. let options = TaskCreationOptions.LongRunning
  94. let tasks =
  95. [|
  96. for i in 0..(batches - 1) -> Task.Factory.StartNew (task i, options)
  97. |]
  98. Task.WaitAll (tasks |> Array.map (fun t -> t :> Task))
  99. tasks |> Array.sumBy (fun t -> t.Result)
  100.  
  101.  
  102. [<EntryPoint>]
  103. let main argv =
  104. let testCases =
  105. [|
  106. "naiveFor" , false , naiveFor
  107. "arraySum" , false , arraySum
  108. "linqSum" , false , linqSum
  109. "seqSum" , false , seqSum
  110. "pseqSum" , true , pseqSum
  111. "naiveParallelForSum" , true , naiveParallelForSum
  112. "batchedParallelForSum" , true , batchedParallelForSum
  113. "taskSum" , true , taskSum
  114. |]
  115.  
  116. let parallelism = parallelism ()
  117.  
  118. let runTestCases () =
  119. [|
  120. for name, isParallel, action in testCases do
  121. printfn " Running test case %s" name
  122. yield name, isParallel, timeIt name action
  123. |]
  124.  
  125. printfn "Running all test cases with default parallelism: %dX" parallelism
  126. let parallelResults = runTestCases ()
  127.  
  128. let proc = Process.GetCurrentProcess ()
  129. proc.ProcessorAffinity <- nativeint 0x1
  130.  
  131. Thread.Sleep 100
  132.  
  133. printfn "Running all test cases with no parallelism"
  134. let sequentialResults = runTestCases ()
  135.  
  136. if parallelResults.Length <> sequentialResults.Length then
  137. failwith "parallelResults & sequentialResults must have the same length"
  138.  
  139. printfn "Results, sequential results are presented in parantheses"
  140. for i = 0 to (parallelResults.Length - 1) do
  141. let pname, pp, (pv, pt) = parallelResults.[i]
  142. let sname, sp, (sv, st) = sequentialResults.[i]
  143.  
  144. if pname <> sname then
  145. failwithf "parallelResults & sequentialResults must have the same name@%d" i
  146.  
  147. if pp then
  148. let speedup = float st / float pt
  149. let efficiency = float st / (float pt * float parallelism)
  150.  
  151. printfn
  152. " %s result: %A (%A), took %d (%d) ms, parallel speedup %f, parallel efficiency: %f"
  153. pname
  154. pv
  155. sv
  156. pt
  157. st
  158. speedup
  159. efficiency
  160. if sv <> pv then
  161. printfn " ERROR: Sequntial and parallel results differs"
  162. else
  163. printfn
  164. " %s result: %A (%A), took %d (%d) ms"
  165. pname
  166. pv
  167. sv
  168. pt
  169. st
  170. if sv <> pv then
  171. printfn " ERROR: Sequntial and parallel results differs"
  172.  
  173. 0
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement