Back to Questions
1.8k
views3
comments
How to make a generalised fold on a data type, parallel ?
f#parallel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

type exp = | Var of string
           | Lambda of string * exp
           | Apply of exp * exp

// Any idea on how to make this tree traversal run in parallel through the different branches,

// maybe using either PLINQ or the Asynchronous Worflows ??
let foldExpr varF lamF appF exp = 
    let rec Loop e cont = 
        match e with
        | Var x -> cont (varF x)
        | Lambda (x, body) -> Loop body (fun bodyAcc -> cont (lamF x bodyAcc))
        | Apply (l, r) -> Loop l (fun lAcc ->
                          Loop r (fun rAcc ->
                                  cont (appF lAcc rAcc)))
    Loop exp (fun x -> x)

let toString =
    foldExpr
        (fun x -> sprintf "%s" x)
        (fun x y -> sprintf "(λ%s.%s)" x y)
        (fun x y -> sprintf "(%s %s)" x y)

printf "%s" (toString (Apply(Lambda("x", Var "x"), Lambda("y", Var "y"))))
.

I confess I have not thought deeply about it, but my first instinct is below:

(EDIT: I added some testing, seems to maybe-work)

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

 

type exp = 
    | Var of string           
    | Lambda of string * exp           
    | Apply of exp * exp
    
let foldExpr varF lamF appF exp =     
    let rec Loop e cont =         
        match e with        
        | Var x -> cont (varF x)        
        | Lambda (x, body) -> Loop body (fun bodyAcc -> 
                              cont (lamF x bodyAcc))        
        | Apply (l, r) -> Loop l (fun lAcc ->                          
                          Loop r (fun rAcc ->                                  
                          cont (appF lAcc rAcc)))    
    Loop exp (fun x -> x)    

let pfoldExpr varF lamF appF exp =     
    let rec Loop e = async {
        match e with        
        | Var x -> return (varF x)        
        | Lambda (x, body) -> let! bodyAcc = Loop body
                              return (lamF x bodyAcc)       
        | Apply (l, r) -> let! [| lAcc; rAcc |] = [| Loop l; Loop r |] |> Async.Parallel 
                          return (appF lAcc rAcc) }  
    Loop exp 
let toString =    
    foldExpr        
        (fun x -> sprintf "%s" x)        
        (fun x y -> sprintf "(lam %s.%s)" x y)        
        (fun x y -> sprintf "(%s %s)" x y)   

let ptoString e =    
    pfoldExpr        
        (fun x -> sprintf "%s" x)        
        (fun x y -> sprintf "(lam %s.%s)" x y)        
        (fun x y -> sprintf "(%s %s)" x y)   
        e     
    |> Async.RunSynchronously 
    
let e = Apply(Lambda("x", Var "x"), Lambda("y", Var "y"))
let C e = Apply(e,e)
let bigE = C(C(C(C(C(C(C(C(C(C(C(C(C(e)))))))))))))

let sw1 = System.Diagnostics.Stopwatch.StartNew()
let r1 = toString bigE
printfn "Sync took %dms" sw1.ElapsedMilliseconds 

let sw2 = System.Diagnostics.Stopwatch.StartNew()
let r2 = ptoString bigE
printfn "Async took %dms" sw2.ElapsedMilliseconds
By on 9/9/2009 5:37 PM ()

Still have not thought too deeply, but consider code below. Rather than walk the tree sequentially to create an async that runs in parallel, it actually creates the async tree in parallel while running it. That is, my prior one calls "Loop l" and "Loop r" sequentially, whereas this one calls those in parallel.

1
2
3
4
5
6
7
8
9
10
11
12

let pppfoldExpr varF lamF appF exp =     
    let rec Loop e = async {
        match e with        
        | Var x -> return (varF x)        
        | Lambda (x, body) -> let! bodyAcc = Loop body 
                              return (lamF x bodyAcc)       
        | Apply (l, r) -> 
            let! [| lAcc; rAcc |] = 
                [| async {return! Loop l}; async{return! Loop r} |] 
                |> Async.Parallel 
            return (appF lAcc rAcc) }  
    Loop exp
By on 9/10/2009 8:48 AM ()

Nice :)

But there is still something not quite right. I've been doing some testing and...

On my dual core laptop the speed up is pretty much what you would expect.

But on my 8-Core (Dual Quad Core) Xeon Workstation(4GB Mem) the speed up is very poor:

1
2
3
4
5
6
7
8

foldExpr:      Sync took 2573ms
pfoldExpr:    Async took 2450ms
pppfoldExpr: Async took 1986ms

Test Data:
let e = Var "x"
let C e = Apply(e,e)
let bigE = C(C(C(C(C(C(C(C(C(C(C(C(C(C(C(C(e))))))))))))))))

Correct me if I'm wrong but because the tree is perfectly balanced, as it moves down it should be able to reach the point where is processing eight branches in parallel. I understand is not optimized to stop creating threads at a certain depth but I would still expect a better performance.

Cheers,
Edmondo

By on 9/10/2009 10:49 AM ()

    Topic tags

    IntelliFactory Offices Copyright (c) 2011-2012 IntelliFactory. All rights reserved.
    Home | Products | Consulting | Trainings | Blogs | Jobs | Contact Us | Terms of Use | Privacy Policy | Cookie Policy     		Built with WebSharper