Question

我对基于异步的程序中的堆栈溢出感到惊讶。我怀疑主要问题是使用以下函数，它应该组成两个异步计算并行执行并等待两者完成：

let ( <|> ) (a: Async<unit>) (b: Async<unit>) =
    async {
        let! x = Async.StartChild a
        let! y = Async.StartChild b
        do! x
        do! y
    }

通过这个定义，我有以下mapReduce程序试图在map和reduce部分中利用并行性。非正式地，我们的想法是使用共享通道激发N映射器和N-1缩减器，等待它们完成，并从通道读取结果。我有自己的Channel实现，此处用ConcurrentBag替换为更短的代码（问题影响两者）：

let mapReduce (map    : 'T1 -> Async<'T2>)
              (reduce : 'T2 -> 'T2 -> Async<'T2>)
              (input  : seq<'T1>) : Async<'T2> =
    let bag = System.Collections.Concurrent.ConcurrentBag()

    let rec read () =
        async {
            match bag.TryTake() with
            | true, value -> return value
            | _           -> do! Async.Sleep 100
                             return! read ()
        }

    let write x =
        bag.Add x
        async.Return ()

    let reducer =
        async {
            let! x = read ()
            let! y = read ()
            let! r = reduce x y
            return bag.Add r
        }

    let work =
        input
        |> Seq.map (fun x -> async.Bind(map x, write))
        |> Seq.reduce (fun m1 m2 -> m1 <|> m2 <|> reducer)

    async {
        do! work
        return! read ()
    }

现在，以下基本测试开始在n = 10000上抛出StackOverflowException：

let test n  =
    let map x      = async.Return x
    let reduce x y = async.Return (x + y)
    mapReduce map reduce [0..n]
    |> Async.RunSynchronously

编辑：<|>组合子的替代实现使测试在N = 10000时成功：

let ( <|> ) (a: Async<unit>) (b: Async<unit>) =
  Async.FromContinuations(fun (ok, _, _) ->
    let count = ref 0
    let ok () =
        lock count (fun () ->
            match !count with
            | 0 -> incr count
            | _ -> ok ())
    Async.Start <|
        async {
            do! a
            return ok ()
        }
    Async.Start <|
        async {
            do! b
            return ok ()
        })

这对我来说真的很令人惊讶，因为这是我假设的Async.StartChild正在做的事情。关于哪种解决方案最佳的想法？

Answer 1

我认为在启动使用<|>运算符创建的异步工作流时会发生堆栈溢出异常。对Async.StartChild的调用会启动第一个工作流程，该工作流程使用<|>进行合并，因此会再次调用Async.StartChild等。

一种简单的方法是将工作流安排在计时器的处理程序中（以便它不会添加到当前堆栈中）。类似的东西：

let ( <|> ) (a: Async<unit>) (b: Async<unit>) =
    async {
        do! Async.Sleep 1
        let! x = Async.StartChild a
        let! y = Async.StartChild b
        do! x
        do! y }

更好的解决方法是创建自己的Seq.reduce - 当前实现将它逐个折叠，这样你就可以得到一个深度为10000的树，它只包含一个工作项右边以及左边的所有其他工作项。如果你创建了一个平衡的工作项二叉树，那么它不应该堆栈溢出，因为高度只有15左右。

编辑尝试使用以下功能替换Seq.reduce：

module Seq = 
  let reduceBallanced f input =
    let arr = input |> Array.ofSeq
    let rec reduce s t =
      if s + 1 >= t then arr.[s]
      else 
        let m = (s + t) / 2
        f (reduce s m) (reduce m t)
    reduce 0 arr.Length

Answer 2

我相信托马斯在答案中得到了正确的答案，但在花了相当多的时间来解决这个问题之后，这是我自己的话和更多的细节。

问题是由于过度同步，上述代码未实现预期的mapReduce算法。特别是，a <|> b <|> c在c和a完成之前无法启动b，因此实际上<|>对于具有两次以上计算的并行性无用。
第二个问题是async.Return x与Async.FromContinuations(fun (ok, _, _) -> ok x)同构。事实上，这个例子在单个线程上按顺序执行，并且分配的闭包会炸掉堆栈。

对于好奇的读者来说，下面是我设计这个算法的第二次尝试，它看起来好一点（在n=100000上约1秒，在n=100000上使用map和reduce函数约21秒延伸到Async.Sleep 1000，我有Core i3）。

let mapReduce (map    : 'T1 -> Async<'T2>)
              (reduce : 'T2 -> 'T2 -> Async<'T2>)
              (input  : seq<'T1>) : Async<'T2> =
    let run (a: Async<'T>) (k: 'T -> unit) =
        Async.StartWithContinuations(a, k, ignore, ignore)
    Async.FromContinuations <| fun (ok, _, _) ->
        let k = ref 0
        let agent =
            new MailboxProcessor<_>(fun chan ->
                async {
                    for i in 2 .. k.Value do
                        let! x = chan.Receive()
                        let! y = chan.Receive()
                        return run (reduce x y) chan.Post
                    let! r = chan.Receive()
                    return ok r
                })
        k :=
            (0, input)
            ||> Seq.fold (fun count x ->
                run (map x) agent.Post
                count + 1)
        agent.Start()

Answer 3

非常有趣的讨论！我和Async.Parallel有类似的问题

let (<||>) first second = async { let! results = Async.Parallel([|first; second|]) in return   (results.[0], results.[1]) } 

let test = async { do! Async.Sleep 100 } 
(test, [1..10000]) 
||> List.fold (fun state value -> (test <||> state) |> Async.Ignore) 
|> Async.RunSynchronously // stackoverflow

我非常沮丧......所以我通过创建自己的并行组合器来解决它。

let parallel<'T>(computations : Async<'T> []) : Async<'T []> =
  Async.FromContinuations (fun (cont, exnCont, _) ->
    let count = ref computations.Length
    let results : 'T [] = Array.zeroCreate computations.Length
    computations 
        |> Array.iteri (fun i computation ->
            Async.Start <|
                async { 
                    try
                        let! res = computation
                        results.[i] <- res 
                    with ex -> exnCont ex

                    let n = System.Threading.Interlocked.Decrement(count)
                    if n = 0 then 
                        results |> cont 
                }))

最后受到讨论的启发，我实现了以下mapReduce函数

// (|f ,⊗|)

let mapReduce (mapF : 'T -> Async<'R>) (reduceF : 'R -> 'R -> Async<'R>) (input : 'T []) : Async<'R> = 
let rec mapReduce' s e =
    async { 
        if s + 1 >= e then return! mapF input.[s]
        else 
            let m = (s + e) / 2
            let! (left, right) =  mapReduce' s m <||> mapReduce' m e
            return! reduceF left right
    }
mapReduce' 0 input.Length

Answer 4

另一个简单的实现可能是：

let mapReduce' (map    : 'T1 -> Async<'T2>)
              (reduce : 'T2 -> 'T2 -> Async<'T2>)
              (input  : seq<'T1>) : Async<'T2> = 
        async {
            let! r = input |> Seq.map map |> Async.Parallel
            return r |> Array.toSeq 
                   |> Seq.reduce (fun a b -> reduce a b |> Async.RunSynchronously)

        }

在此，地图阶段以并行方式执行，然后减少阶段是连续的，因为它对先前计算的值具有数据依赖性。

F＃异步堆栈溢出

4 个答案: