Question

我在F＃中编写了一系列图搜索算法，并认为利用并行化会很好。我想并行执行多个线程，并完成第一个线程的结果。我有一个实现，但它不漂亮。

两个问题：这种功能有标准名称吗？不是Join或JoinAll，而是JoinFirst？第二，有没有更惯用的方法呢？

//implementation
let makeAsync (locker:obj) (shared:'a option ref) (f:unit->'a) =
    async {
        let result = f()
        Monitor.Enter locker
        shared := Some result
        Monitor.Pulse locker
        Monitor.Exit locker
    }

let firstFinished test work =
    let result = ref Option.None
    let locker = new obj()
    let cancel = new CancellationTokenSource()    
    work |> List.map (makeAsync locker result) |> List.map (fun a-> Async.StartAsTask(a, TaskCreationOptions.None, cancel.Token)) |> ignore
    Monitor.Enter locker
    while (result.Value.IsNone || (not <| test result.Value.Value)) do
        Monitor.Wait locker |> ignore
    Monitor.Exit locker
    cancel.Cancel()
    match result.Value with
    | Some x-> x
    | None -> failwith "Don't pass in an empty list"
//end implentation

//testing
let delayReturn (ms:int) value = 
    fun ()->
        Thread.Sleep ms
        value

let test () =
    let work = [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
    let result = firstFinished (fun _->true) work
    printfn "%s" result

Answer 1

是否可以将CancellationTokenSource和test传递给每个异步并让第一个计算有效结果取消其他异步？

let makeAsync (cancel:CancellationTokenSource) test f =
  let rec loop() =
    async {
      if cancel.IsCancellationRequested then 
        return None
      else
        let result = f()
        if test result then
          cancel.Cancel()
          return Some result
        else return! loop()
    }
  loop()

let firstFinished test work =
  match work with
  | [] -> invalidArg "work" "Don't pass in an empty list"
  | _ ->
    let cancel = new CancellationTokenSource()    
    work
    |> Seq.map (makeAsync cancel test) 
    |> Seq.toArray
    |> Async.Parallel
    |> Async.RunSynchronously
    |> Array.pick id

这种方法做了一些改进：1）它只使用async（它不与Task混合使用，这是做同样事情的另一种选择 - async更具惯用性F＃）; 2）除了CancellationTokenSource之外，没有为此目的而设计的共享状态; 3）干净的函数链方法可以很容易地向管道添加额外的逻辑/转换，包括平凡启用/禁用并行性。

Answer 2

如果您可以在项目中使用“Reactive extensions（Rx）”，则joinFirst方法可以实现为：

let joinFirst (f : (unit->'a) list) = 
    let c = new CancellationTokenSource()
    let o = f |> List.map (fun i ->
                    let j = fun() -> Async.RunSynchronously (async {return i() },-1,c.Token)
                    Observable.Defer(fun() -> Observable.Start(j))
                    )
            |> Observable.Amb
    let r = o.First()
    c.Cancel()
    r

使用示例：

[20..30] |> List.map (fun i -> fun() -> Thread.Sleep(i*100); printfn "%d" i; i)
|> joinFirst |> printfn "Done %A"
Console.Read() |> ignore

<强>更新

使用邮箱处理器：

type WorkMessage<'a> = 
      Done of 'a
    | GetFirstDone of AsyncReplyChannel<'a>

let joinFirst (f : (unit->'a) list) = 
    let c = new CancellationTokenSource()
    let m = MailboxProcessor<WorkMessage<'a>>.Start(
              fun mbox -> async { 
                let afterDone a m = 
                    match m with
                    | GetFirstDone rc -> 
                        rc.Reply(a);
                        Some(async {return ()})
                    | _ -> None
                let getDone m = 
                    match m with
                    |Done a -> 
                        c.Cancel()
                        Some (async {
                                do! mbox.Scan(afterDone a)
                                })  
                    |_ -> None
                do! mbox.Scan(getDone)
                return ()
             } )
    f 
    |> List.iter(fun t -> try 
                            Async.RunSynchronously (async {let out = t()
                                                           m.Post(Done out)
                                                           return ()},-1,c.Token)
                          with
                          _ -> ())
    m.PostAndReply(fun rc -> GetFirstDone rc)

Answer 3

不幸的是，Async没有内置的操作，但我仍然使用F＃asyncs，因为它们直接支持取消。当您使用Async.Start启动工作流程时，您可以向其传递取消令牌，如果令牌被取消，工作流程将自动停止。

这意味着您必须明确启动工作流程（而不是使用Async.Parallel），因此必须手动编写同步。以下是Async.Choice方法的简单版本（目前，它不处理异常）：

open System.Threading

type Microsoft.FSharp.Control.Async with
  /// Takes several asynchronous workflows and returns 
  /// the result of the first workflow that successfuly completes
  static member Choice(workflows) = 
    Async.FromContinuations(fun (cont, _, _) ->
      let cts = new CancellationTokenSource()
      let completed = ref false
      let lockObj = new obj()
      let synchronized f = lock lockObj f

      /// Called when a result is available - the function uses locks
      /// to make sure that it calls the continuation only once
      let completeOnce res =
        let run =
          synchronized(fun () ->
            if completed.Value then false
            else completed := true; true)
        if run then cont res

      /// Workflow that will be started for each argument - run the 
      /// operation, cancel pending workflows and then return result
      let runWorkflow workflow = async {
        let! res = workflow
        cts.Cancel()
        completeOnce res }

      // Start all workflows using cancellation token
      for work in workflows do
        Async.Start(runWorkflow work, cts.Token) )

一旦我们编写了这个操作（这有点复杂，但只需要编写一次），解决问题就很容易了。您可以将操作编写为异步工作流，并在第一个完成时自动取消：

let delayReturn n s = async {
  do! Async.Sleep(n) 
  printfn "returning %s" s
  return s }

Async.Choice [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
|> Async.RunSynchronously

当你运行它时，它只打印“返回第一个！”因为第二个工作流程将被取消。

Answer 4

使用.NET 4中的任务并行库，这称为WaitAny。例如，以下代码段创建10个任务并等待其中任何一个完成：

open System.Threading

Array.init 10 (fun _ ->
  Tasks.Task.Factory.StartNew(fun () ->
    Thread.Sleep 1000))
|> Tasks.Task.WaitAny

加入第一个完成的线程？

4 个答案: