F# strange agent re-initialisation behaviour - f#

I have an F# 3.0 agent wrapped in a class:
type AgentWrapper() =
let myAgent = Agent.Start(fun inbox ->
let rec loop (state: int) =
async {
let! (replyChannel: AsyncReplyChannel<int>) = inbox.Receive()
let newState = state + 1
replyChannel.Reply newState
return! loop newState
}
loop 0 )
member private this.agent = myAgent
member this.Send () =
this.agent.PostAndReply (fun replyChannel -> replyChannel)
When I send messages to it as follows:
let f = new AgentWrapper ()
f.Send () |> printf "Reply: %d\n"
f.Send () |> printf "Reply: %d\n"
f.Send () |> printf "Reply: %d\n"
I get the expected responses:
Reply: 1
Reply: 2
Reply: 3
However, if I remove the let binding for the agent and directly assign it to the this.agent property:
type AgentWrapper() =
member private this.agent = Agent.Start(fun inbox ->
let rec loop (state: int) =
async {
let! (replyChannel: AsyncReplyChannel<int>) = inbox.Receive()
let newState = state + 1
replyChannel.Reply newState
return! loop newState
}
loop 0 )
member this.Send () =
this.agent.PostAndReply (fun replyChannel -> replyChannel)
I then get the responses:
Reply: 1
Reply: 1
Reply: 1
I've been staring at this for hours and I can't understand why the agent is getting re-initialised every time I call AgentWrapper.Send. It feels like this.agent is getting reassigned every time I call it (i.e. acting like a method, not a property). What am I missing?

It feels like this.agent is getting reassigned every time I call it
(i.e. acting like a method, not a property). What am I missing?
This is exactly what happens, and is documented in the spec (relevant part from 18.13.1 follows)
Static and instance property members are evaluated every time the
member is invoked. For example, in the following, the body of the
member is evaluated each time C.Time is evaluated:
type C () =
static member Time = System.DateTime.Now
This is analgous to your situation

Related

Return results to the caller with a throttling queue

Building on a snippet and answer, would it be possible to return results to the caller from the throttling queue? I've tried PostAndAsyncReply to receive reply on a channel but it's throwing an error if I pipe it with Enqueue. Here's the code.
Appreciate a F# core vanilla based solution around Queue or Mailbox design patterns.
Question
The question is to be able to call functions asynchronously based on the throttle (max 3 at a time), passing each item from the array, wait on the whole queue/array until it's finished while collecting all the results and then return the results to the caller. (Return the results to the caller is what's pending in here)
Callee Code
// Message type used by the agent - contains queueing
// of work items and notification of completion
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
/// Represents an agent that runs operations in concurrently. When the number
/// of concurrent operations exceeds 'limit', they are queued and processed later
let throttlingAgent limit =
MailboxProcessor.Start(fun inbox ->
async {
// The agent body is not executing in parallel,
// so we can safely use mutable queue & counter
let queue = System.Collections.Generic.Queue<Async<unit>>()
let running = ref 0
while true do
// Enqueue new work items or decrement the counter
// of how many tasks are running in the background
let! msg = inbox.Receive()
match msg with
| Completed -> decr running
| Enqueue w -> queue.Enqueue(w)
// If we have less than limit & there is some work to
// do, then start the work in the background!
while running.Value < limit && queue.Count > 0 do
let work = queue.Dequeue()
incr running
do! // When the work completes, send 'Completed'
// back to the agent to free a slot
async {
do! work
inbox.Post(Completed)
}
|> Async.StartChild
|> Async.Ignore
})
let requestDetailAsync (url: string) : Async<Result<string, Error>> =
async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? WebException as e ->
return Error {Code = "500"; Message = "Internal Server Error"; Status = HttpStatusCode.InternalServerError}
}
let requestMasterAsync() : Async<Result<System.Collections.Concurrent.ConcurrentBag<_>, Error>> =
async {
let urls = [|
"http://www.example.com/1";
"http://www.example.com/2";
"http://www.example.com/3";
"http://www.example.com/4";
"http://www.example.com/5";
"http://www.example.com/6";
"http://www.example.com/7";
"http://www.example.com/8";
"http://www.example.com/9";
"http://www.example.com/10";
|]
let results = System.Collections.Concurrent.ConcurrentBag<_>()
let agent = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> Enqueue
|> agent.Post
return Ok results
}
Caller Code
[<TestMethod>]
member this.TestRequestMasterAsync() =
match Entity.requestMasterAsync() |> Async.RunSynchronously with
| Ok result -> Console.WriteLine result
| Error error -> Console.WriteLine error
You could use Hopac.Streams for that. With such tool it is pretty trivial:
open Hopac
open Hopac.Stream
open System
let requestDetailAsync url = async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? Exception as e ->
return Error e
}
let requestMasterAsync() : Stream<Result<string,exn>> =
[| "http://www.example.com/1"
"http://www.example.com/2"
"http://www.example.com/3"
"http://www.example.com/4"
"http://www.example.com/5"
"http://www.example.com/6"
"http://www.example.com/7"
"http://www.example.com/8"
"http://www.example.com/9"
"http://www.example.com/10" |]
|> Stream.ofSeq
|> Stream.mapPipelinedJob 3 (requestDetailAsync >> Job.fromAsync)
requestMasterAsync()
|> Stream.iterFun (printfn "%A")
|> queue //prints all results asynchronously
let allResults : Result<string,exn> list =
requestMasterAsync()
|> Stream.foldFun (fun results cur -> cur::results ) []
|> run //fold stream into list synchronously
ADDED
In case you want to use only vanilla FSharp.Core with mailboxes only try this:
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
let inline (>>=) x f = async.Bind(x, f)
let inline (>>-) x f = async.Bind(x, f >> async.Return)
let throttlingAgent limit =
let agent = MailboxProcessor.Start(fun inbox ->
let queue = System.Collections.Generic.Queue<Async<unit>>()
let startWork work =
work
>>- fun _ -> inbox.Post Completed
|> Async.StartChild |> Async.Ignore
let rec loop curWorkers =
inbox.Receive()
>>= function
| Completed when queue.Count > 0 ->
queue.Dequeue() |> startWork
>>= fun _ -> loop curWorkers
| Completed ->
loop (curWorkers - 1)
| Enqueue w when curWorkers < limit ->
w |> startWork
>>= fun _ -> loop (curWorkers + 1)
| Enqueue w ->
queue.Enqueue w
loop curWorkers
loop 0)
Enqueue >> agent.Post
It is pretty much the same logic, but slightly optimized to not use queue if there is free worker capacity (just start job and don't bother with queue/dequeue).
throttlingAgent is a function int -> Async<unit> -> unit
Because we don't want client to bother with our internal ThrottlingAgentMessage type.
use like this:
let throttler = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> throttler

Data being lost while sending messages form one actor to another

I have created an Agent say "A", which simply sends some bulky data to Agent "B".
Agent A Code :
let largeText = "some large text (around 30kb)"
InputData_Type =
{
//some code
Body : string
}
let default_InputData =
{
//some code
Body = largeText
}
type ActorMsg =
| InItServices
| Data of InputData_Type
| UpdateList
let system = ActorSystem.Create("A")
let actRef = system.ActorSelection("akka.tcp://B#localhost:9999/user/EchoServer")
actRef.Ask(JsonConvert.SerializeObject(InItServices)).Wait()
[1..1000000]
|> List.iter(fun x ->
actRef.Tell(JsonConvert.SerializeObject(Data (default_InputData))))
let listLength = string(actRef.Ask(JsonConvert.SerializeObject(UpdateList)).Result)
printfn "length is %A" listLength
Agent "B" is stores/maintains the data he received into a database.
Agent B code :
try
let echoServer =
spawn system "EchoServer"
<| fun mailbox ->
let rec loop( cnt : int32 ) =
actor {
let! message = mailbox.Receive()
let sender = mailbox.Sender()
let deserializedEmailData = JsonConvert.DeserializeObject<ActorMsg> (message)
match deserializedEmailData with
| InItServices ->
sender <! ""
return! loop (0)
| Data (textData)->
// some logic to maintain list
let count = cnt + 1
return! loop (count)
| UpdateList ->
//some logic to store list
sender <! ("Length is " + cnt.ToString())
return! loop (0)
}
loop(0)
()
with
|exc ->
printfn "%A" exc
Agent "A" and "B" are created on same machine but are on different ports.
I have observed that, number of records received by agent B are different each time when I execute above setup.
Means say If I sent 20000 messages to Agent B, Agent B is actually receiving only say 1600(number varies) messages.
What exactly going wrong in above scenario ?

MailboxProcessor: Memory leak using return! before receive

Given the following agent, which is a simple cache mechanism:
type CacheMsg<'a,'b> = Add of 'a * 'b | ForceFlush
type CacheAgent<'a, 'b when 'a : comparison>(size:int, flushCont:Map<'a, 'b> -> unit) =
let agent = MailboxProcessor.Start(fun inbox ->
let rec loop (cache : Map<'a, 'b>) = async {
let inline flush() =
flushCont cache
loop Map.empty
if cache.Count > size then return! flush()
let! msg = inbox.Receive()
match msg with
| Add (key, value) ->
if cache.ContainsKey key then
return! loop cache
else return! loop (cache.Add(key, value))
| ForceFlush -> return! flush() }
loop Map.empty)
member x.AddIfNotExists key value = Add(key,value) |> agent.Post
member x.ForceFlush() = agent.Post ForceFlush
This agent will keep taking up memory (seems like the memory is not freed when the flushCont has been called).
Given the same code, but with a minor change:
type CacheMsg<'a,'b> = Add of 'a * 'b | ForceFlush
type CacheAgent<'a, 'b when 'a : comparison>(size:int, flushCont:Map<'a, 'b> -> unit) =
let agent = MailboxProcessor.Start(fun inbox ->
let rec loop (cache : Map<'a, 'b>) = async {
let inline flush() =
flushCont cache
loop Map.empty
let! msg = inbox.Receive()
match msg with
| Add (key, value) ->
if cache.ContainsKey key then
return! loop cache
else
let newCache = cache.Add(key, value)
if newCache.Count > size then
return! flush()
else return! loop (cache.Add(key, value))
| ForceFlush -> return! flush() }
loop Map.empty)
member x.AddIfNotExists key value = Add(key,value) |> agent.Post
member x.ForceFlush() = agent.Post ForceFlush
I have moved the expression that decides when to flush, into the union case Add. This results in the memory is freed as expected.
What's wrong about the first approach, since it leaks memory?
The first version isn't tail recursive.
It's not tail recursive, because this expression isn't the last expression in the function:
if cache.Count > size then return! flush()
After that expression, you call
let! msg = inbox.Receive()
so the flush() call isn't the last thing happening. After the recursive call implicit in flush has completed, the execution will need to return to the next expression, where you invoke inbox.Receive(). That means that the context will have to keep the previous invocation on the stack, because the recursion isn't in a tail position: there's still more work to do.
In the second example, all calls to flush and loop are in tail positions.
If you're coming from a C# background, you'd be inclined to think that return! flush() exits the function, but that's not really the case here. The only reason
if cache.Count > size then return! flush()
even compiles without a corresponding else branch is because the expression returns unit. This means that the code inside the then branch doesn't truly exit the function - it just performs the work in the branch (in this case flush()), and then continues executing the subsequent expressions.

Augmenting Observable.Create for F#

I'd like to augment
public static IObservable<TSource> Create<TSource>(
Func<IObserver<TSource>, Action> subscribe)
{...}
For use in F# so that rather than calling with a Function or Action I can just use standard F# types i.e IObserver -> (unit -> unit).
How can I accomplish this?
Edit:
Adding full example. Not sure why obsAction does not work.
open System
open System.Reactive
open System.Reactive.Disposables
open System.Reactive.Linq
type Observable with
static member Create(subscribe) =
Observable.Create(fun observer -> Action(subscribe observer))
let obsDispose (observer:IObserver<_>) =
let timer = new System.Timers.Timer()
timer.Interval <- 1000.00
let handlerTick = new Timers.ElapsedEventHandler(fun sender args -> observer.OnNext("tick"))
let handlerElapse = new Timers.ElapsedEventHandler(fun sender args -> printfn "%A" args.SignalTime)
timer.Elapsed.AddHandler(handlerTick)
timer.Elapsed.AddHandler(handlerElapse)
timer.Start()
Disposable.Empty
let obsAction (observer:IObserver<_>) =
let timer = new System.Timers.Timer()
timer.Interval <- 1000.00
let handlerTick = new Timers.ElapsedEventHandler(fun sender args -> observer.OnNext("tick"))
let handlerElapse = new Timers.ElapsedEventHandler(fun sender args -> printfn "%A" args.SignalTime)
timer.Elapsed.AddHandler(handlerTick)
timer.Elapsed.AddHandler(handlerElapse)
timer.Start()
let action() =
timer.Elapsed.RemoveHandler(handlerTick)
timer.Elapsed.RemoveHandler(handlerElapse)
timer.Dispose()
action
let obsOtherAction (observer:IObserver<_>) =
let timer = new System.Timers.Timer()
timer.Interval <- 1000.00
let handlerTick = new Timers.ElapsedEventHandler(fun sender args -> observer.OnNext("tick"))
let handlerElapse = new Timers.ElapsedEventHandler(fun sender args -> printfn "%A" args.SignalTime)
timer.Elapsed.AddHandler(handlerTick)
timer.Elapsed.AddHandler(handlerElapse)
timer.Start()
new System.Action( fun () ->
timer.Elapsed.RemoveHandler(handlerTick)
timer.Elapsed.RemoveHandler(handlerElapse)
timer.Dispose())
let worksNeverStops = obsDispose |> Observable.Create |> Observable.subscribe(fun time -> printfn "Time: %A" time)
let actionWorks = obsOtherAction |> Observable.Create |> Observable.subscribe(fun time -> printfn "Time: %A" time)
let doesNotWork = obsAction |> Observable.Create |> Observable.subscribe(fun time -> printfn "Time: %A" time)
The problem you're facing is an FP gotcha.
In,
static member Create(subscribe) =
Observable.Create(fun observer -> Action(subscribe observer))
the type of subscribe is IObserver<_> -> unit -> unit.
Now there's a subtle difference between IObserver<_> -> unit -> unit
and IObserver<_> -> Action where Action : unit -> unit. The difference is that the former is curried, and the latter isn't.
When an observer subscribes, subscribe observer returns a method in to which () can be applied to get unit - your subscribe method will never actually be called until the last () is applied - which won't be until it un-subscribes by which point it will already be detached.
You can get over it by forcing it to not be curried:
let action() = ... | let action = (subscribe observer)
Action(action)
Further:
If you check the IL, the equivalent VB (function refs are more clearer in VB) versions for the Invoke for the FastFunc generated for
static member Create(subscribe) =
Observable.Create(fun observer -> Action(subscribe observer))
is:
Friend Function Invoke(ByVal arg As IObserver(Of a)) As Action
Return New Action(AddressOf New Observable-Create-Static#27-1(Of a)(Me.subscribe, arg).Invoke)
End Function
and for:
static member Create(subscribe) =
Observable.Create(fun observer ->
let action = subscribe observer
Action(action))
is:
Friend Function Invoke(ByVal arg As IObserver(Of a)) As Action
Return New Action(AddressOf New Observable-Create-Static#28-1(Me.subscribe.Invoke(arg)).Invoke)
End Function
AddressOf New Closure(Me.subscribe, arg).Invoke -> The subscribe function won't get called until the dispose action is called.
AddressOf New Closure(Me.subscribe.Invoke(arg)).Invoke -> The subscribe function actually gets called and the resulting action is returned as expected.
I hope it is now clear why the second case works, and not the first.

Why is my MailboxProcessor hanging?

I can't work out why the following code is hanging at the call to GetTotal. I don't seem to be able to debug inside the MailboxProcessor, so it's hard to see what's going on.
module Aggregator
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore
It seems to work fine when using an identical MailboxProcessor directly, rather than wrapping in the Aggregator class.
The problem is that you did not start the agent. You can either call Start after you create the agent:
let myAgent = (...)
do myAgent.Start()
Alternatively, you can create the agent using MailboxProcessor<'T>.Start instead of calling the constructor (I usually prefer this option, because it looks more functional):
let myAgent = MailboxProcessor<Message<'T, 'TState>>.Start(fun inbox -> (...) )
I suppose that you couldn't debug the agent, because the code inside agent wasn't actually running. I tried adding printfn "Msg: %A" message right after the call to Receive inside the agent (to print incoming messages for debugging) and I noticed that, after calling Aggregate, no messages were actually received by the agent... (It only blocked after calling GetTotal, which avaits reply)
As a side-note, I would probably turn GetTotal into a method, so you'd call GetTotal(). Properties are re-evaluated each time you access them, so your code does the same thing, but best practices don't recommend using properties that do complex work.
You forgot to start the mailbox:
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
member m.Start() = myAgent.Start()
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Start()
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore

Resources