1 people like it.

Erlang Ring problem

Here's an attempt at the Erlang ring problem in F#.

 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: 
open System

let start (ag : MailboxProcessor<_>) = ag.Start(); ag

type Msg =
    | Start of DateTime
    | Step
    | End of AsyncReplyChannel<float>

let lastNode =
    new MailboxProcessor<_>(fun inbox ->
        let rec run time = async {
            let! m = inbox.Receive()
            match m with
            | Start t -> do! run t
            | Step -> do! run time
            | End chan->
                chan.Reply (DateTime.Now - time).TotalSeconds
                do! run DateTime.Now
        }
        run DateTime.Now)
    |> start

let getPrevAgent (agent : MailboxProcessor<_>) =
    new MailboxProcessor<_>(fun inbox -> async {
                while true do
                    let! m = inbox.Receive()
                    agent.Post m
            })
    |> start

let firstNode = Seq.unfold (fun s -> Some(s, getPrevAgent s)) lastNode |> Seq.nth 100

let nRoundTrip n =
    firstNode.Post (Start DateTime.Now)
    for x = 1 to (n - 2) do
        firstNode.Post Step
    firstNode.PostAndReply(fun chan -> End chan);;

nRoundTrip 10000
namespace System
val start : ag:MailboxProcessor<'a> -> MailboxProcessor<'a>

Full name: Script.start
val ag : MailboxProcessor<'a>
Multiple items
type MailboxProcessor<'Msg> =
  interface IDisposable
  new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
  member Post : message:'Msg -> unit
  member PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
  member PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply
  member PostAndTryAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply option>
  member Receive : ?timeout:int -> Async<'Msg>
  member Scan : scanner:('Msg -> Async<'T> option) * ?timeout:int -> Async<'T>
  member Start : unit -> unit
  member TryPostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply option
  ...

Full name: Microsoft.FSharp.Control.MailboxProcessor<_>

--------------------
new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:Threading.CancellationToken -> MailboxProcessor<'Msg>
member MailboxProcessor.Start : unit -> unit
type Msg =
  | Start of DateTime
  | Step
  | End of AsyncReplyChannel<float>

Full name: Script.Msg
union case Msg.Start: DateTime -> Msg
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
union case Msg.Step: Msg
union case Msg.End: AsyncReplyChannel<float> -> Msg
type AsyncReplyChannel<'Reply>
member Reply : value:'Reply -> unit

Full name: Microsoft.FSharp.Control.AsyncReplyChannel<_>
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

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

Full name: Microsoft.FSharp.Core.float<_>
val lastNode : MailboxProcessor<Msg>

Full name: Script.lastNode
val inbox : MailboxProcessor<Msg>
val run : (DateTime -> Async<unit>)
val time : DateTime
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val m : Msg
member MailboxProcessor.Receive : ?timeout:int -> Async<'Msg>
val t : DateTime
val chan : AsyncReplyChannel<float>
member AsyncReplyChannel.Reply : value:'Reply -> unit
property DateTime.Now: DateTime
val getPrevAgent : agent:MailboxProcessor<'a> -> MailboxProcessor<'a>

Full name: Script.getPrevAgent
val agent : MailboxProcessor<'a>
val inbox : MailboxProcessor<'a>
val m : 'a
member MailboxProcessor.Post : message:'Msg -> unit
val firstNode : MailboxProcessor<Msg>

Full name: Script.firstNode
module Seq

from Microsoft.FSharp.Collections
val unfold : generator:('State -> ('T * 'State) option) -> state:'State -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.unfold
val s : MailboxProcessor<Msg>
union case Option.Some: Value: 'T -> Option<'T>
val nth : index:int -> source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.nth
val nRoundTrip : n:int -> float

Full name: Script.nRoundTrip
val n : int
val x : int
member MailboxProcessor.PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply

More information

Link:http://fssnip.net/6r
Posted:6 years ago
Author:David Grenier
Tags: erlang ring agent