3 people like it.

Parallel tree processing in Hopac

This is "Parallel tree processing" example from http://tryjoinads.org/ ported straitforwardly to Hopac.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
opens

let nums = [ for i in 0L .. 1000L -> i + 5000000000000L ]

type Tree<'T> = 
  | Leaf of 'T 
  | Node of Tree<'T> * Tree<'T>

/// Creates a ballanced tree from a non-empty list
/// (odd elements are added to the left and even to the right)
let rec ballancedOfList list =
  match list with 
  | [] -> failwith "Cannot create tree of empty list"
  | [n] -> Leaf n
  | _ -> 
      // Split the elements into odd and even using their index
      let left, right =
        list |> List.mapi (fun i v -> i, v)
             |> List.partition (fun (i, v) -> i%2 = 0)
      // Create ballanced trees for both parts
      let left, right = List.map snd left, List.map snd right
      Node(ballancedOfList left, ballancedOfList right)

let isPrime num = 
  seq { 2L .. int64 (sqrt (float num)) } 
  |> Seq.forall (fun div -> num % div <> 0L)

// Create a list with large prime numbers
let primes = 
  nums |> List.map (fun v -> isPrime v, v) 
       |> List.filter fst |> List.map snd
// Create a list with some additional non-primes
let mixed = primes @ [ 2L .. 20L ]

// Created ballanced trees from both lists
let primeTree = ballancedOfList primes
let mixedTree = ballancedOfList mixed

let forall f tree =
  let rec loop tree =
    match tree with
    | Leaf v -> f v 
    | Node (left, right) ->
        // Process left and right branch
        loop left && loop right
  // Start the recursive processing & wait for the result
  loop tree

let parallelForall f tree =
  let rec loop tree = Job.delay <| fun _ ->
    match tree with
    | Leaf v -> Job.lift f v 
    | Node (left, right) ->
        // Process left and right branch in parallel
        loop left <*> loop right |>> fun (l, r) -> l && r
  // Start the recursive processing & wait for the result
  run (loop tree)

// Test processing on two sample trees
compareTwoRuntimes
    5
    "Sequential" (fun _ -> forall isPrime mixedTree)
    "Parallel" (fun _ -> parallelForall isPrime mixedTree)

// Sequential 931.4ms
// Parallel 1185.4ms
//   Ratio:  0.7857263371

compareTwoRuntimes
    5
    "Sequential" (fun _ -> forall isPrime primeTree)
    "Parallel" (fun _ -> parallelForall isPrime primeTree)

// Sequential 3974.6ms
// Parallel 1262.0ms
//   Ratio:  3.149445325
open Hopac
open Hopac.Job.Infixes
open FSharpx.TimeMeasurement
val nums : int64 list

Full name: Script.nums
val i : int64
type Tree<'T> =
  | Leaf of 'T
  | Node of Tree<'T> * Tree<'T>

Full name: Script.Tree<_>
union case Tree.Leaf: 'T -> Tree<'T>
union case Tree.Node: Tree<'T> * Tree<'T> -> Tree<'T>
val ballancedOfList : list:'a list -> Tree<'a>

Full name: Script.ballancedOfList


 Creates a ballanced tree from a non-empty list
 (odd elements are added to the left and even to the right)
Multiple items
val list : 'a list

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val n : 'a
val left : (int * 'a) list
val right : (int * 'a) list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val mapi : mapping:(int -> 'T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.mapi
val i : int
val v : 'a
val partition : predicate:('T -> bool) -> list:'T list -> 'T list * 'T list

Full name: Microsoft.FSharp.Collections.List.partition
val left : 'a list
val right : 'a list
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val isPrime : num:int64 -> bool

Full name: Script.isPrime
val num : int64
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
Multiple items
val int64 : value:'T -> int64 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int64

--------------------
type int64 = System.Int64

Full name: Microsoft.FSharp.Core.int64

--------------------
type int64<'Measure> = int64

Full name: Microsoft.FSharp.Core.int64<_>
val sqrt : value:'T -> 'U (requires member Sqrt)

Full name: Microsoft.FSharp.Core.Operators.sqrt
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
module Seq

from Microsoft.FSharp.Collections
val forall : predicate:('T -> bool) -> source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.forall
val div : int64
val primes : int64 list

Full name: Script.primes
val v : int64
val filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val mixed : int64 list

Full name: Script.mixed
val primeTree : Tree<int64>

Full name: Script.primeTree
val mixedTree : Tree<int64>

Full name: Script.mixedTree
val forall : f:('a -> bool) -> tree:Tree<'a> -> bool

Full name: Script.forall
val f : ('a -> bool)
val tree : Tree<'a>
val loop : (Tree<'a> -> bool)
val left : Tree<'a>
val right : Tree<'a>
val parallelForall : f:('a -> bool) -> tree:Tree<'a> -> bool

Full name: Script.parallelForall
val loop : (Tree<'a> -> Job<bool>)
type Job<'T> =

Full name: Hopac.Job<_>
val delay : (unit -> #Job<'x>) -> Job<'x>

Full name: Hopac.Job.delay
val lift : ('x -> 'y) -> 'x -> Job<'y>

Full name: Hopac.Job.lift
val l : bool
val r : bool
val run : Job<'x> -> 'x

Full name: Hopac.TopLevel.run
val compareTwoRuntimes : count:int -> desc1:string -> f1:(unit -> 'a) -> desc2:string -> f2:(unit -> 'b) -> unit

Full name: FSharpx.TimeMeasurement.compareTwoRuntimes
Raw view Test code New version

More information

Link:http://fssnip.net/p5
Posted:6 years ago
Author:Vasily Kirichenko
Tags: hopac , joinads