为什么我在F#中获得较差的并行性能?

时间:2013-05-05 21:35:30

标签: .net f# parallel-processing

我正在尝试学习F#,这是我第一次尝试并行编程。我正在努力寻找通过网格的最长路径。我的寻路解决方案似乎是一个相当简单的递归算法。然后我映射/缩小它以找到所有路径并返回最长的路径。

我有一个串行实现和map / reduce部分的3个不同的并行实现。在较小的网格上,我看到并行实现的速度有一些微小的改进。在更大的网格上,并行实现实际上更慢!我做错了吗?

3个并行实现是:

以下是使用不同大小输入网格的4种实现的一些典型时序:

4x4 Grid
GetLongestPath               19.845400
GetLongestPathParallelArray  18.626200
GetLongestPathParallelFor     7.084200
GetLongestPathPSeq          163.271000

5x5 Grid
GetLongestPath              818.967500
GetLongestPathParallelArray 629.563000
GetLongestPathParallelFor   725.072500
GetLongestPathPSeq          772.961300

6x6 Grid
GetLongestPath              3941.354000
GetLongestPathParallelArray 3609.441800
GetLongestPathParallelFor   3509.890500
GetLongestPathPSeq          3295.218600

7x7 Grid
GetLongestPath              24466.655300
GetLongestPathParallelArray 32098.823200
GetLongestPathParallelFor   35274.629500
GetLongestPathPSeq          24980.553600

以下是代码:

module Pathfinder
open System
open System.Threading.Tasks
open Microsoft.FSharp.Collections

let ListContains item list = List.exists (fun x -> x = item) list
let LongestList (x:int list) (y:int list) = if x.Length >= y.Length then x else y

let GetNeighborsNotAlreadyInPath (neighborMap: Map<int, int list>) path =
    neighborMap.[List.head path]
    |> List.filter (fun item -> not (ListContains item path))

let rec GetLongestPathFromAllNeighbors neighborMap currentPath longestPath =
    let neighbors = GetNeighborsNotAlreadyInPath neighborMap currentPath
    if neighbors = [] then
        LongestList currentPath longestPath
    else
        neighbors
        |> List.map (fun neighbor -> GetLongestPathFromAllNeighbors neighborMap (neighbor::currentPath) longestPath)
        |> List.reduce LongestList

let GetLongestPathFromPosition neighborMap i =
    GetLongestPathFromAllNeighbors neighborMap [i] []

let GetLongestPath (neighborMap: Map<int, int list>) =
    [| 0..neighborMap.Count-1 |]
    |> Array.map (fun i -> GetLongestPathFromPosition neighborMap i)
    |> Array.reduce LongestList

let GetLongestPathParallelArray (neighborMap: Map<int, int list>) =
    [| 0..neighborMap.Count-1 |]
    |> Array.Parallel.map (fun i -> GetLongestPathFromPosition neighborMap i)
    |> Array.reduce LongestList

let GetLongestPathParallelFor (neighborMap: Map<int, int list>) =
    let inline ParallelMap (f: 'T -> 'U) (array : 'T[]) : 'U[]=
        let inputLength = array.Length
        let result = Array.zeroCreate inputLength
        Parallel.For(0, inputLength, fun i ->
            result.[i] <- f array.[i]) |> ignore
        result

    [| 0..neighborMap.Count-1 |]
    |> ParallelMap (fun i -> GetLongestPathFromPosition neighborMap i)
    |> Array.reduce LongestList

let GetLongestPathPSeq (neighborMap: Map<int, int list>) =
    [| 0..neighborMap.Count-1 |]
    |> PSeq.map (fun i -> GetLongestPathFromPosition neighborMap i)
    |> PSeq.reduce LongestList

以下是从输入网格构建地图的代码:

module Gobstoppers
open System

type GobstopperCollection = { Items: string[]; Width: int; NeighborMap: Map<int, int list> }
type Gobstopper = { Position: int; Color: string; Shape: string; }

let CreateGobstopperFromString (text:string) i =
    { Position = i; Color = text.[0].ToString(); Shape = text.[1].ToString() }

let CreateGobstopper (itemArray: string[]) i =
    CreateGobstopperFromString itemArray.[i] i

let FindNeighbors (itemArray: string[]) rowWidth i =
    let onLeft = (i % rowWidth = 0)
    let onRight = (i % rowWidth = rowWidth - 1)
    let onTop = (i < rowWidth)
    let onBottom = (i >= itemArray.Length - rowWidth)

    [(if onTop || onLeft then -1 else i - rowWidth - 1);
     (if onTop then -1 else i - rowWidth);
     (if onTop || onRight then -1 else i - rowWidth + 1);
     (if onLeft then -1 else i - 1);
     (if onRight then -1 else i + 1);
     (if onBottom || onLeft then -1 else i + rowWidth - 1);
     (if onBottom then -1 else i + rowWidth);
     (if onBottom || onRight then -1 else i + rowWidth + 1)]
    |> List.filter (fun x -> x > -1)

let FindCompatibleNeighbors itemArray rowWidth i =
    let AreCompatible (a:Gobstopper) (b:string) = a.Color = b.[0].ToString() || a.Shape = b.[1].ToString()
    FindNeighbors itemArray rowWidth i
    |> List.map (fun x -> CreateGobstopper itemArray x)
    |> List.filter (fun x -> AreCompatible x itemArray.[i])
    |> List.map (fun x -> x.Position)

let Load (text:string) =
    let itemArray =
        text.Split('|')
        |> Array.map (fun x -> x.Trim())
        |> Array.filter (fun x -> x <> "")
    let rowWidth = int (sqrt (float itemArray.Length))
    let neighborMap = 
        itemArray
        |> Array.mapi (fun i x -> i, FindCompatibleNeighbors itemArray rowWidth i)
        |> Map.ofArray

    { Items = itemArray;
      Width = rowWidth;
      NeighborMap = neighborMap }

这是测试输入:

module TestData

let testGrid3 = "|yr|rr|rs|
                 |yr|gb|rp|
                 |bs|gr|yb|"

let testGrid4 = "|yr|rr|rs|gp|
                 |yr|gb|rp|pp|
                 |bs|gr|yb|bs|
                 |br|rs|yb|bb|"

let testGrid5 = "|yr|rr|rs|gp|rb|
                 |yr|gb|rp|pp|gr|
                 |bs|gr|yb|bs|bp|
                 |br|rs|yb|bb|bc|
                 |gs|yr|yr|rp|br|"

let testGrid6 = "|yr|rr|rs|gp|rb|bc|
                 |yr|gb|rp|pp|gr|pb|
                 |bs|gr|yb|bs|bp|ps|
                 |br|rs|yb|bb|bc|rs|
                 |gs|yr|yr|rp|br|rb|
                 |pp|gr|ps|pb|pr|ps|"

let testGrid7 = "|yr|rr|rs|gp|rb|bc|rb|
                 |yr|gb|rp|pp|gr|pb|rs|
                 |bs|gr|yb|bs|bp|ps|pp|
                 |br|rs|yb|bb|bc|rs|pb|
                 |gs|yr|yr|rp|br|rb|br|
                 |pp|gr|ps|pb|pr|ps|bp|
                 |gc|rb|gs|pp|bc|gb|rp|"

let testGrid8 = "|yr|rr|rs|gp|rb|bc|rb|bp|
                 |yr|gb|rp|pp|gr|pb|rs|rp|
                 |bs|gr|yb|bs|bp|ps|pp|gb|
                 |br|rs|yb|bb|bc|rs|pb|pb|
                 |gs|yr|yr|rp|br|rb|br|pr|
                 |pp|gr|ps|pb|pr|ps|bp|rs|
                 |gc|rb|gs|pp|bc|gb|rp|pp|
                 |rp|gb|rs|ys|yc|yp|rb|bb|"

这是我的计时器控制台应用程序:

open System
open System.Diagnostics

let RunTimer runCount title testFunc =
    printfn title
    let RunTimedTest n = 
        let stopWatch = Stopwatch.StartNew()
        let result = testFunc()
        stopWatch.Stop()
        printfn "%i - %f" n stopWatch.Elapsed.TotalMilliseconds
        result

    let results = [| 1..runCount |] |> Array.map (fun x -> RunTimedTest x)
    printfn "%A" results.[0]

let runCount = 1
let gobs = Gobstoppers.Load TestData.testGrid6

RunTimer runCount "GetLongestPath" (fun _ -> Pathfinder.GetLongestPath gobs.NeighborMap)
RunTimer runCount "GetLongestPathParallelArray" (fun _ -> Pathfinder.GetLongestPathParallelArray gobs.NeighborMap)
RunTimer runCount "GetLongestPathParallelFor" (fun _ -> Pathfinder.GetLongestPathParallelFor gobs.NeighborMap)
RunTimer runCount "GetLongestPathPSeq" (fun _ -> Pathfinder.GetLongestPathPSeq gobs.NeighborMap)

let line = Console.ReadLine()

2 个答案:

答案 0 :(得分:1)

如果计划的工作不能以真正可以并行执行的方式进行分发,那么在分割工作时,所有添加的工作都是开销。

如果工作确实可以在多个核心上并行执行,或者等待/空闲时间可以用来在等待时执行任务,那就是你可能会有时间。

在这种情况下,你所做的只是计算,所以没有等待IO。这就是为什么代码只会受益于多个内核(如果你保持同步尽可能低)

尝试在更多核心上执行代码。

答案 1 :(得分:0)

在我认为匿名函数之前,我遇到了一个问题     (好玩我 - >运行一些东西)

不要将clealy并行化。我没有加速,但写了一个辅助函数

let foo i =
    run i etc

Array.parallel.map(foo)给了我一个很好的加速。其他评论也是相关的 - 真正细粒度的并行性通常不会因为开销而产生回报。你可能最好有N个工作人员和共同的事情队列