Luca Bolognese's WebLog : F#

LAgent: an agent framework in F# – Part X – ActiveObject

lucabol — Thu, 10 Dec 2009 18:09:14 GMT

Download framework here.

All posts are here:

If you stare long enough at agents, you start to realize that they are just ‘glorified locks’. They are a convenient programming model to protect a resource from concurrent access. The programming model is convenient because both the client and the server can write their code without worrying about concurrency problems, and yet the program runs in parallel. Protecting a resource sounds a lot like state encapsulation and the concept of state encapsulation is what object orientation is all about.

So you start thinking if there is a way to enhance vanilla objects to make them agents. You want to reuse all the concepts that you are familiar with (i.e. inheritance, visibility rules, etc…) and you want your clients to call agents as if they were calling normal objects. Obviously, under the cover, the method calls won’t execute immediately, but they would be queued. Let’s look at an example.

This is our simple counter agent:

type CounterMessage =
| Add of int
| Print

let counterF = fun msg count ->
    match msg with
    | Add(i)    -> count + i
    | Print     -> printfn "The value is %i" count; count
    
let c1 = spawnAgent counterF 0
c1 <-- Add(3)
c1 <—Print

As nice as this looks, there are unfamiliar things in this model:

The communication is through messages. This requires packing and unpacking which, albeit easy in F#, is unfamiliar and feels like machinery that we’d like to get rid off.
The management of state is bizarre, it gets passed into the lambda and returned from it instead of being represented as fields and properties on the agent

My best attempt at creating an object-like syntax follows:

type Counter() =
    let w = new WorkQueue()
    let mutable count = 0
    member c.Add x = w.Queue (fun () -> 
        count <- count + x
        )
    member c.Print () = w.Queue (fun () -> 
        printfn "The value is %i" count
        )

let c = new Counter()
c.Add 3
c.Print

With this syntax, you write your agents like you write your vanilla classes except:

You need a private field of type WorkQueue
You need to write your methods as lambdas passed to the WorkQueue.Queue function
Your methods cannot return values

The most worrisome of these constraints is 2. because you can easily forget about it. If you do forget, then everything compiles just fine, but it doesn’t do what you expect. That’s pure badness. I haven’t found a way to enforce it. This is a place where the language could help me. Other than that, the whole model works rather nicely.

Regarding the third point, you can concoct a programming model that allows you to return values from your methods. Here it is:

member c.CountTask = w.QueueWithTask(fun () ->
    count
    )
member c.CountAsync = w.QueueWithAsync(fun () ->
    count
    )

printfn "The count using Task is %i" (c.CountTask.Result)

The first method returns a Task; the second method returns an AsyncResultCell. Both are ways to represent a promise. The latter allows a natural integration with the async block in F# as in the following code:

Async.RunSynchronously (
            async {
                let! count = c.CountAsync
                printfn "The countusing Async is %i" count
            })

As for myself, I don’t like methods returning values. Every time I use them, I end up going back and thinking about my problem in a traditional way, aka as method calls that return results, instead of thinking about it in a more actor oriented fashion. I end up waiting for these promises to be materialized and, by doing so, I limit the amount of parallelism that I unleash. As a matter of fact, the whole business of hiding the message passing nature of the programming model is dubious. It makes for a nicer syntax, but you need to make an extra effort in your mind to translate it to what it really is: just message passing with a nice syntactical veneer. I haven’t decided yet which model I like the most.

You should have a sense of what WorkQueue is. In essence, it is a Mailbox of lambdas (look at the red bold code below).

type WorkQueue() =
    let workQueue = spawnWorker (fun f -> f())
    member w.Queue (f) = workQueue <-- f
    member w.QueueWithTask f : Task<'T> =
        let source = new TaskCompletionSource<_>()
        workQueue <-- (fun () -> f() |> source.SetResult)
        source.Task
    member w.QueueWithAsync (f:unit -> 'T) : Async<'T> =
        let result = new AsyncResultCell<'T>()
        workQueue <-- (fun () -> f() |> result.RegisterResult )
        result.AsyncWaitResult
    member w.Restart () = workQueue <-! Restart
    member w.Stop () = workQueue <-! Stop
    member w.SetErrorHandler(h) =
        let managerF = fun (_, name:string, ex:Exception, _, _, _) -> h name ex                             
        let manager = spawnWorker managerF
        workQueue <-! SetManager manager
    member w.SetName(name) = workQueue <-! SetName(name)
    member w.SetQueueHandler(g) = workQueue <-! SetWorkerHandler(g)
    member w.SetTimeoutHandler(timeout, f) = workQueue <-! SetTimeoutHandler(timeout, f)

I implemented all the services that are in the message passing model. The two are equivalent as expressing power goes. In case you wonder how a real piece of code looks like using this model, here is an ActiveObject version of the map reduce algorithm. One of these days, I will gather the strength to go trough this code and explain what it does, but not today :-)

#load "AgentSystem.fs"
open AgentSystem.LAgent
open System
open System.Collections
open System.Collections.Generic
open System.Threading

type IOutput<'out_key, 'out_value> =
    abstract Reduced: 'out_key -> seq<'out_value> -> unit
    abstract MapReduceDone: unit -> unit
    
type Mapper<'in_key, 'in_value, 'my_out_key, 'out_value when 'my_out_key : comparison>
                                                      (map:'in_key -> 'in_value -> seq<'my_out_key * 'out_value>, i, partitionF) =
    let w = new WorkQueue()
    let mutable reducerTracker: BitArray = null
    let mutable controller = Unchecked.defaultof<Controller<'in_key, 'in_value, 'my_out_key, 'out_value>>
    let mutable reducers = Unchecked.defaultof<Reducer<'in_key, 'in_value, 'my_out_key, 'out_value> array>
    member m.Init c reds =
        w.Queue (fun () ->
            controller <- c
            reducers <- reds
            reducerTracker <- new BitArray(reducers.Length, false))
    member m.Process inKey inValue =
        w.Queue (fun () ->
            let outKeyValues = map inKey inValue
            outKeyValues |> Seq.iter (fun (outKey, outValue) ->
                                        let reducerUsed = partitionF outKey (reducers.Length)
                                        reducerTracker.Set(reducerUsed, true)
                                        reducers.[reducerUsed].Add(outKey, outValue)))
    member m.Done () =
        w.Queue (fun () ->
            controller.MapDone i reducerTracker)
    member m.Stop () = w.Stop ()            
    
and Reducer<'in_key, 'in_value, 'out_key, 'out_value when 'out_key :
                     comparison>(reduce:'out_key -> seq<'out_value> -> seq<'out_value>, i, output:IOutput<'out_key, 'out_value>) =
    let w = new WorkQueue()
    let mutable workItems = new List<'out_key * 'out_value>()
    let mutable controller = Unchecked.defaultof<Controller<'in_key, 'in_value, 'out_key, 'out_value>>
    member r.Init c =
        w.Queue (fun () ->
            controller <- c)
    member r.StartReduction () =
        w.Queue (fun () ->
            workItems
            |> Seq.groupBy fst
            |> Seq.sortBy fst
            |> Seq.map (fun (key, values) -> (key, reduce key (values |> Seq.map snd)))
            |> Seq.iter (fun (key, value) -> output.Reduced key value)
            controller.ReductionDone i) 
    member r.Add (outKey:'out_key, outValue:'out_value) : unit =
        w.Queue (fun () ->
            workItems.Add((outKey, outValue)))
    member m.Stop () = w.Stop ()            
                
and Controller<'in_key, 'in_value, 'out_key, 'out_value when 'out_key : comparison>(output:IOutput<'out_key, 'out_value>) =
    let w = new WorkQueue()
    let mutable mapperTracker: BitArray = null
    let mutable reducerUsedByMappers: BitArray = null
    let mutable reducerDone: BitArray = null
    let mutable mappers = Unchecked.defaultof<Mapper<'in_key, 'in_value, 'out_key, 'out_value> array>
    let mutable reducers = Unchecked.defaultof<Reducer<'in_key, 'in_value, 'out_key, 'out_value> array>
    let BAtoSeq (b:BitArray) = [for x in b do yield x]
    member c.Init maps reds =
        w.Queue (fun () ->
            mappers <- maps
            reducers <- reds
            mapperTracker <- new BitArray(mappers.Length, false)
            reducerUsedByMappers <- new BitArray(reducers.Length, false)
            reducerDone <- new BitArray(reducers.Length, false))
    member c.MapDone (i : int) (reducerTracker : BitArray) : unit =
        w.Queue (fun () ->
            mapperTracker.Set(i, true)
            let reducerUsedByMappers = reducerUsedByMappers.Or(reducerTracker)
            if not( BAtoSeq mapperTracker |> Seq.exists(fun bit -> bit = false)) then
                BAtoSeq reducerUsedByMappers |> Seq.iteri (fun i r -> if r = true then reducers.[i].StartReduction ())
                mappers |> Seq.iter (fun m -> m.Stop ())
              )
    member c.ReductionDone (i: int) : unit =
        w.Queue (fun () ->
            reducerDone.Set(i, true)
            if BAtoSeq reducerDone |> Seq.forall2 (fun x y -> x = y) (BAtoSeq reducerUsedByMappers) then
                output.MapReduceDone ()
                reducers |> Seq.iter (fun r -> r.Stop ())
                c.Stop()
             )         
    member m.Stop () = w.Stop ()
                
let mapReduce   (inputs:seq<'in_key * 'in_value>)
                (map:'in_key -> 'in_value -> seq<'out_key * 'out_value>)
                (reduce:'out_key -> seq<'out_value> -> seq<'out_value>)
                (output:IOutput<'out_key, 'out_value>)
                M R partitionF =
                    
    let len = inputs |> Seq.length
    let M = if len < M then len else M
    
    let mappers = Array.init M (fun i -> new Mapper<'in_key, 'in_value, 'out_key, 'out_value>(map, i, partitionF))
    let reducers = Array.init R (fun i -> new Reducer<'in_key, 'in_value, 'out_key, 'out_value>(reduce, i, output))
    let controller = new Controller<'in_key, 'in_value, 'out_key, 'out_value>(output)
    
    mappers |> Array.iter (fun m -> m.Init controller reducers)
    reducers |> Array.iter (fun r -> r. Init controller )
    controller.Init mappers reducers
    
    inputs |> Seq.iteri (fun i (inKey, inValue) -> mappers.[i % M].Process inKey inValue)
    mappers |> Seq.iter (fun m -> m.Done ())    

let partitionF = fun key M -> abs(key.GetHashCode()) % M 

let map = fun (fileName:string) (fileContent:string) ->
            let l = new List<string * int>()
            let wordDelims = [|' ';',';';';'.';':';'?';'!';'(';')';'\n';'\t';'\f';'\r';'\b'|]
            fileContent.Split(wordDelims) |> Seq.iter (fun word -> l.Add((word, 1)))
            l :> seq<string * int>
                                  
let reduce = fun key (values:seq<int>) -> [values |> Seq.sum] |> seq<int>

let printer () =
  { new IOutput<string, int> with
        member o.Reduced key values = printfn "%A %A" key values
        member o.MapReduceDone () = printfn "All done!!"}
    
let testInput =
     ["File1", "I was going to the airport when I saw someone crossing"; "File2", "I was going home when I saw you coming toward me"]   
mapReduce testInput map reduce (printer ()) 2 2 partitionF

open System.IO
open System.Text

let gatherer(step) =
  let w = new WorkQueue()
  let data = new List<string * int>()
  let counter = ref 0 
  { new IOutput<string, int> with
        member o.Reduced key values =
            w.Queue (fun () ->
                if !counter % step = 0 then
                    printfn "Processed %i words. Now processing %s" !counter key 
                data.Add((key, values |> Seq.hd))
                counter := !counter + 1)
        member o.MapReduceDone () =
            w.Queue (fun () ->
                data
                |> Seq.distinctBy (fun (key, _) -> key.ToLower())
                |> Seq.filter (fun (key, _) -> not(key = "" || key = "\"" || (fst (Double.TryParse(key)))))
                |> Seq.to_array
                |> Array.sortBy snd
                |> Array.rev
                |> Seq.take 20
                |> Seq.iter (fun (key, value) -> printfn "%A\t\t%A" key value)
                printfn "All done!!")           
        }
                        
let splitBook howManyBlocks fileName =
    let buffers = Array.init howManyBlocks (fun _ -> new StringBuilder())
    fileName
    |> File.ReadAllLines
    |> Array.iteri (fun i line -> buffers.[i % (howManyBlocks)].Append(line) |> ignore)
    buffers

let blocks1 = __SOURCE_DIRECTORY__ + "\kjv10.txt" |> splitBook 100
let blocks2 = __SOURCE_DIRECTORY__ + "\warandpeace.txt" |> splitBook 100
let input =
    blocks1
    |> Array.append blocks2
    |> Array.mapi (fun i b -> i.ToString(), b.ToString())
        
//mapReduce input map reduce (gatherer(1000)) 20 20 partitionF

type BookSplitter () =
    let blocks = new List<string * string>()
    member b.Split howManyBlocks fileName =
            let b =
                fileName
                |> splitBook howManyBlocks
                |> Array.mapi (fun i b -> i.ToString(), b.ToString())
            blocks.AddRange(b)
    member b.Blocks () =
            blocks.ToArray() :> seq<string * string>

type WordCounter () =
    let w = new WorkQueue()
    let words = new Dictionary<string,int>()
    let worker(wordCounter:WordCounter, ev:EventWaitHandle) =
          let w1 = new WorkQueue()
          { new IOutput<string, int> with
                member o.Reduced key values =
                    w1.Queue (fun() ->
                        wordCounter.AddWord key (values |> Seq.hd))
                member o.MapReduceDone () =
                    w1.Queue(fun () ->
                        ev.Set() |> ignore)
           }
    member c.AddWord word count =
            let exist, value = words.TryGetValue(word)
            if exist then
                words.[word] <- value + count
            else
                words.Add(word, count)
    member c.Add fileName =
        w.Queue (fun () ->
            let s = new BookSplitter()
            fileName |> s.Split 100
            let ev = new EventWaitHandle(false, EventResetMode.AutoReset)
            let blocks = s.Blocks ()
            mapReduce blocks map reduce (worker(c, ev)) 20 20 partitionF
            ev.WaitOne() |> ignore
            )  
    member c.Words =
        w.QueueWithAsync (fun () ->
            words |> Seq.to_array |> Array.map (fun kv -> kv.Key, kv.Value)
        )    

let wc = new WordCounter()
wc.Add (__SOURCE_DIRECTORY__ + "\kjv10.txt")
wc.Add (__SOURCE_DIRECTORY__ + "\warandpeace.txt")

let wordsToPrint = async {
                    let! words = wc.Words
                    return words
                        |> Seq.distinctBy (fun (key, _) -> key.ToLower())
                        |> Seq.filter (fun (key, _) -> not(key = "" || key = "\"" || (fst (Double.TryParse(key)))))
                        |> Seq.to_array
                        |> Array.sortBy snd
                        |> Array.rev
                        |> Seq.take 20
                        |> Seq.iter (fun (key, value) -> printfn "%A\t\t%A" key value)}


Async.RunSynchronously wordsToPrint
                        
Thread.Sleep(15000)
printfn "Closed session"

Luca at PDC 2009 next week

lucabol — Fri, 13 Nov 2009 18:49:18 GMT

I’ll be in Los Angeles next week for PDC 2009. My session is called “Future Directions for C# and Visual Basic” and it comes on Tuesday immediately after the first keynote.

I’m planning on spending the first half of the session talking about the biggest trends influencing C# and VB. The second part will be about more future looking features we are playing with these days.

My deck has just two slides, as always. It’s all about watching me typing code on stage, hoping that I make crazy errors …

There are several other interesting language related sessions at PDC. Here is a list of them (please notice that the times might change). Also feel free to drop by the languages booth and chat. My team and I will be there most of the time.

Day	Time	Title	Presenter	Room
Tues 11/17	11:00 - 12:00	Future Directions for C# and Visual Basic	Luca Bolognese	Hall F
Tues 11/17	11:00 - 12:00	Accelerated Windows Application Development with Microsoft Visual C++ 2010	Boris Jabes	408B
Tues 11/17	12:30 - 13:15	Dynamic Binding in C# 4	Mads Torgersen	Hall F
Tues 11/17	12:30 - 13:15	Using Dynamic Languages to Build Scriptable Applications	Dino Viehland	403AB
Tues 11/17	13:30 - 14:30	C++ Forever: Interactive Applications in the Age of Manycore	Rick Molloy	515B
Tues 11/17	16:30 - 17:30	Manycore and the Microsoft .NET Framework 4: A Match Made in Microsoft Visual Studio 2010	Stephen Toub	502A
Tues 11/17	16:30 - 17:30	Code Contracts and Pex: Power Charge Your Assertions and Unit Tests	Mike Barnett, Nikolai Tillmann	408A
Wed 11/18	11:30 - 12:30	Microsoft Perspectives on the Future of Programming	Panel	Petree Hall C
Wed 11/18	12:00 - 13:00	F# for Architects – Hitting the Sweet Spot	Chris Smith	VS and .NET Pavillion
Wed 11/18	13:00 - 13:45	Code Like the Wind with Microsoft Visual Basic 2010	Lucian Wischik	Petree Hall D
Wed 11/18	13:00 - 13:45	Future of Garbage Collection	Patrick Dussud	Petree Hall C
Wed 11/18	13:00 - 13:45	Microsoft Project Code Name “M”: The Data and Modeling Language	Don Box, Jeff Pinkston	408A
Thu 11/19	08:30 - 09:30	PLINQ: LINQ, but Faster!	Ed Essey, Igor Ostrovsky	515A
Thu 11/19	10:00 - 11:00	A Lap around Microsoft Visual Studio 2010 for the Visual Basic Developer	Lisa Feigenbaum	VS and .NET Pavillion
Thu 11/19	10:00 - 11:00	Axum: A .NET Language for Safe and Scalable Concurrency	Niklas Gustafsson	515A
Thu 11/19	11:30 - 12:30	F# for Parallel and Asynchronous Programming	Luke Hoban	515A
Thu 11/19	12:45 - 13:30	Microsoft Visual C# IDE Tips and Tricks	DJ Park	Petree Hall D
Thu 11/19	12:45 - 13:30	Microsoft Visual Basic IDE Tips and Tricks	Dustin Campbell	Petree Hall C

LAgent: an agent framework in F# – Part VIII - Implementing MapReduce (user model)

lucabol — Fri, 04 Sep 2009 20:57:48 GMT

Download framework here.

All posts are here:

For this post I use a newer version of the framework that I just uploaded on CodeGallery. In the process of using LAgent I grew more and more unhappy with the weakly typed way of sending messages. The code that implements that feature is nasty: full of upcasts and downcasts. I was losing faith in it. Bugs were cropping up in all sorts of scenarios (i.e. using generic union types as messages).

In the end I decided to re-architecture the framework so to make it strongly typed. In essence now each agent can just receive messages of a single type. The limitations that this design choice introduces (i.e. more limited hot swapping) are compensated by the catching of errors at compile time and the streamlining of the code. I left the old framework on the site in case you disagree with me.

In any case, today’s post is about MapReduce. It assumes that you know what it is (link to the original Google paper that served as inspiration is here: Google Research Publication- MapReduce). What would it take to implement an in-memory MapReduce using my agent framework?

Let’s start with the user model.

let mapReduce   (inputs:seq<'in_key * 'in_value>)
                (map:'in_key -> 'in_value -> seq<'out_key * 'out_value>)
                (reduce:'out_key -> seq<'out_value> -> seq<'reducedValues>)
                outputAgent
                M R partitionF =

mapReduce takes seven parameters:

inputs: a sequence of input key/value pairs.
map: this function operates on each input key/value pair. It returns a sequence of output key/value pairs. The type of the output sequence can be different from the type of the inputs.
reduce: this function operates on an output key and all the values associated with it. It returns a sequence of reduced values (i.e. the average of all the values for this key)
ouputAgent: this is the agent that gets notified every time a new output key has been reduced and at the end when all the operation ends.
M: how many mapper agents to instantiate
R: how many reducer agents to instantiate
partitionF: the partition function used to choose which of the reducers is associated with a key

Let’s look at how to use this function to find how often each word is used in a set of files. First a simple partition function can be defined as:

let partitionF = fun key M -> abs(key.GetHashCode()) % M

Given a key and some buckets, it picks one of the buckets. Its type is: ‘a –> int –> int, so it’s fairly reusable.

Let’s also create a basic agent that just prints out the reduced values:

let printer = spawnWorker (fun msg ->
                            match msg with
                            | Reduced(key, value)   -> printfn "%A %A" key value
                            | MapReduceDone         -> printfn "All done!!")

The agent gets notified whenever a new key is reduced or the algorithm ends. It is useful to be notified immediately instead of waiting for everything to be done. If I hadn’t written this code using agents I would have not realized that possibility. I would simply have framed the problem as a function that takes an input and returns an output. Agents force you to think explicitly about the parallelism in your app. That’s a good thing.

The mapping function simply split the content of a file into words and adds a word/1 pair to the list. I know that there are much better ways to do this (i.e. regular expressions for the parsing and summing words counts inside the function), but I wanted to test the basic framework capabilities and doing it this way does it better.

let map = fun (fileName:string) (fileContent:string) ->
            let l = new List<string * int>()
            let wordDelims = [|' ';',';';';'.';':';'?';'!';'(';')';'\n';'\t';'\f';'\r';'\b'|]
            fileContent.Split(wordDelims) |> Seq.iter (fun word -> l.Add((word, 1)))
            l :> seq<string * int>

The reducer function simply sums the various word statistics sent by the mappers:

let reduce = fun key (values:seq<int>) -> [values |> Seq.sum] |> seq<int>

Now we can create some fake input to check that it works:

let testInput = ["File1", "I was going to the airport when I saw someone crossing";
                               "File2", "I was going home when I saw you coming toward me"]

And execute the mapReduce:

mapReduce testInput map reduce printer 2 2 partitionF

On my machine I get the following. You might get a different order because of the async/parallel processing involved. If I wanted a stable order I would need to change the printer agent to cache results on Reduced and process them on MapReduceDone (see next post).

"I" [4]
"crossing" [1]
"going" [2]
"home" [1]
"me" [1]
"the" [1]
"toward" [1]
"airport" [1]
"coming" [1]
"saw" [2]
"someone" [1]
"to" [1]
"was" [2]
"when" [2]
"you" [1]

In the next post we’ll process some real books …

LAgent: an agent framework in F# – part VII – An auction application

lucabol — Fri, 10 Jul 2009 23:14:00 GMT

Download framework here.

All posts are here:

Here is an application that uses the framework we have been creating. It is an auction application and it is described in more detail here.

Let’s go through it.

type AuctionMessage =
  | Offer of int * AsyncAgent // Make a bid
  | Inquire of AsyncAgent     // Check the status
and AuctionReply =
  | StartBidding
  | Status of int * DateTime // Asked sum and expiration
  | BestOffer                // Ours is the best offer
  | BeatenOffer of int       // Yours is beaten by another offer
  | AuctionConcluded of      // Auction concluded
      AsyncAgent * AsyncAgent
  | AuctionFailed            // Failed without any bids
  | AuctionOver              // Bidding is closed
  
let timeToShutdown = 3000
let bidIncrement = 10

This is the format of the messages that the clients can send and the action agent can reply to. F# is really good at this sort of thing. First, we need an auction agent:

let auctionAgent seller minBid closing =
    let agent = spawnAgent (fun msg (isConcluded, maxBid, maxBidder) ->
                            match msg with
                            | Offer (_, client) when isConcluded ->
                                client <-- AuctionOver
                                (isConcluded, maxBid, maxBidder)
                            | Offer(bid, client) when not(isConcluded) ->
                                if bid >= maxBid + bidIncrement then
                                    if maxBid >= minBid then maxBidder <-- BeatenOffer bid                  
                                    client <-- BestOffer
                                    (isConcluded, bid, client)
                                else
                                    client <-- BeatenOffer maxBid
                                    (isConcluded, maxBid, maxBidder)
                            | Inquire client    ->
                                client <-- Status(maxBid, closing)
                                (isConcluded, maxBid, maxBidder))
                            (false, (minBid - bidIncrement), spawnWorker (fun _ -> ()))

Notice that, if the action is concluded, the agent replies to offers by sending an AuctionOver message. If the auction is still open, then, in case the bid is higher than the max, it sets a new max and notify the two parties involved; otherwise it notifies the bidder that the offer wasn’t successful. Also you can ask for the status of the auction.

This is what the code above says. Maybe the code is simpler than words. Anyhow, we need to treat the case where no message is received for some amount of time.

agent <-- SetTimeoutHandler
            (closing - DateTime.Now).Milliseconds
            (fun (isConcluded: bool, maxBid, maxBidder) ->
                if maxBid >= minBid then
                  let reply = AuctionConcluded(seller, maxBidder)
                  maxBidder <-- reply
                  seller <-- reply
                else seller <-- AuctionFailed
                agent <-- SetTimeoutHandler
                    timeToShutdown
                    (fun (_:bool, _:int,_:AsyncAgent) -> StopProcessing)
                ContinueProcessing (true, maxBid, maxBidder))   
agent

We start by waiting for the amount of time to the closing of the auction. If we get no messages, then two things might happen: we have an offer that is more than the minimum or we don’t. If we do, we tell everyone that it’s finished. Otherwise, we tell the seller that its item wasn’t successful. In any case, we prepare the agent to shutdown by setting its next timeout to be timeoutToShutdown.

It is interesting that we set the timeout handler inside the timeout handler. This is not a problem because of the nature of message processing (aka it processes one message at the time).

We then need a bunch of of symbols …

module Auction =
  let random = new Random()
  
  let minBid = 100
  let closing = DateTime.Now.AddMilliseconds 10000.
  
  let seller = spawnWorker (fun (msg:AuctionReply) -> ())
  let auction = auctionAgent seller minBid closing

Not a very smart seller we have here … Next up is our definition of a client.

let rec c = spawnAgent (
                fun msg (max, current) ->
                    let processBid (aMax, aCurrent) =
                        if aMax >= top then
                            log "too high for me"
                            (aMax, aCurrent)
                        elif aCurrent < aMax then
                              let aCurrent = aMax + increment
                              Thread.Sleep (1 + random.Next 1000)
                              auction <-- Offer(aCurrent, c)
                              (aMax, aCurrent)
                        else (aMax, aCurrent)                       
                    match msg with
                    | StartBidding      ->
                        auction <-- Inquire c
                        (max, current)
                    | Status(maxBid,_)  ->
                        log <| sprintf "status(%d)" maxBid
                        let s = processBid (maxBid, current)
                        c <-- SetTimeoutHandler timeToShutdown (fun _ -> StopProcessing) 
                        s
                    | BestOffer ->
                        log <| sprintf "bestOffer(%d)" current
                        processBid(max, current)
                    | BeatenOffer maxBid ->
                        log <| sprintf "beatenOffer(%d)" maxBid
                        processBid(maxBid, current)
                    | AuctionConcluded(seller, maxBidder) ->
                        log "auctionConcluded"
                        c <-- Stop
                        (max, current)
                    | AuctionOver ->
                        log "auctionOver"
                        c <-- Stop
                        (max, current))
                 (0,0)
c

Something that I like about agents is the fact that you need to understand just small snippets of code at the time. For example, you can read the processing for BestOffer and figure out if it makes sense. I have an easy time personalizing them as in : “Ok, the guy just got a notification that there has been a better offer, what is he going to do next?”.

The code should be self explanatory for the most part. In essence, if you can offer more, do it otherwise wait for the auction to end. I’m not even sure the processing is completely right. I confess I’m just trying to do the same as Matthews code from the link above.

We can then start up the whole thing and enjoy the cool output.

open Auction

(client 1 20 200) <-- StartBidding
(client 2 10 300) <-- StartBidding
(client 3 30 150) <-- StartBidding
Console.ReadLine() |> ignore

Now for the nasty part. Implementing the framework.

LAgent: an agent framework in F# – Part VI – Hot swapping of code (and something silly)

lucabol — Fri, 03 Jul 2009 22:23:00 GMT

Download framework here.

All posts are here:

Hot swapping of code

Let’s get back a couple of steps and consider what happens when you get an error. Sure, your agent will continue processing messages, but it might be doing the wrong thing. Your message handling code might be buggy.

Ideally you’d want to patch things on the fly. You’d want to replace the message processing code for an agent without stopping it.

Here is how you do it:

let counter2 = spawnAgent (fun msg state -> printfn "From %i to %i" state (state + msg);
                                                                              state + msg) 0
counter2 <-- 2
                                         
counter2 <-- SetAgentHandler(fun msg state –>
                printfn "From %i to %i via multiplication" state (state * msg); msg * state)
counter2 <-- 3

Which generates:

From 0 to 2
From 2 to 6 via multiplication

After the agent receives a SetAgentHandler message, it switch from a ‘+’ agent to a ‘*’ agent on the fly!! All the messages that come after that one gets multiplied to the state. Also, the state is preserved between changes in behavior.

It might not be immediately apparent how to load a function at runtime, but it is really simple. Imagine that I get the data on the function to load from somewhere (i.e. a management console UI).

let assemblyNameFromSomewhere, typeNameFromSomewhere, methodNameFromSomewhere = 
                                                "mscorlib.dll", "System.Console", "WriteLine"

I can then use it to dynamically load a message handler (in this case Console.Writeline).

let a = Assembly.Load(assemblyNameFromSomewhere)
let c = a.GetType(typeNameFromSomewhere)
let m = c.GetMethod(methodNameFromSomewhere, [|"".GetType()|])
let newF = fun (msg:string) (state:obj) -> m.Invoke(null, [| (msg:>obj) |])

And then it is as simple as posting a SetAgentHandler.

counter2 <-- SetAgentHandler(newF)
counter2 <-- "blah"

Now our counter2 agent has become an echo agent on the fly, having loaded Console.WriteLine dynamically. Note how the agent moved from being a ‘+’ agent taking integers to being a ‘*’ agent taking integers to being an ‘echo’ agent taking strings. And it didn’t stop processing messages for the whole time.

Obviously, you can do the same thing with workers:

echo <-- SetWorkerHandler(fun msg -> printfn "I'm an echo and I say: %s" msg)
echo <-- "Hello"

And parallelWorkers:

parallelEcho <-- SetWorkerHandler(fun msg -> tprint ("I'm new and " + msg))
messages |> Seq.iter (fun msg -> parallelEcho <-- msg)

A silly interlude

As a way to show some agents talking to each other, here is a simple program that simulates marital interactions (of the worst kind):

let rec husband = spawnWorker (fun (To, msg) -> printfn "Husband says: %s" msg; To <-- msg)
let rec wife = spawnWorker (fun msg -> printfn "Wife says: screw you and your '%s'" msg)
husband <-- (wife, "Hello")
husband <-- (wife, "But darling ...")
husband <-- (wife, "ok")

Which produces:

Husband says: Hello
Husband says: But darling ...
Wife says: screw you and your 'Hello'
Wife says: screw you and your 'But darling ...'
Husband says: ok
Wife says: screw you and your 'ok'

And yes, you cannot expect messages to be in the right sequence … Next up is an auction application.

LAgent: an agent framework in F# – Part V – Timeout management

lucabol — Fri, 26 Jun 2009 21:56:00 GMT

Download framework here.

All posts are here:

Timeout management

Timeouts are very important in message based systems. In essence, if you are not getting messages for a certain period of time, that usually means something. It might be that something crashed, that other agents think that you are not online, or any other number of things. Hence the need to set timeouts and react when they are triggered.

You do that by writing the following:

counter1 <--SetTimeoutHandler 1000 
            (fun state -> printfn "I'm still waiting for a message in state %A, come on ..." 
                                                            state; ContinueProcessing(state))

Which generates the following message every second:

I'm still waiting for a message in state 2, come on ...
I'm still waiting for a message in state 2, come on .…

The first parameter to SetTimeoutHandler is how long to wait before triggering the handler. The second parameter is the handler that gets called whenever no message is received for that amount of time. Notice that the handler takes the current state of the agent and returns ContinueProcessing(state). This tells the agent to continue processing messages and sets the current state to state.

The following code:

counter1 <-- 2

Then generates:

I'm still waiting for a message in state 4, come on ...
I'm still waiting for a message in state 4, come on ...

ContinueProcessing is just one of the three possible values of the (terribly named) AfterError:

type AfterError =
| ContinueProcessing of obj
| StopProcessing
| RestartProcessing

Let’s see what RestartProcessing does.

counter1 <-- SetTimeoutHandler 1000  (fun state -> printfn "Restart from state %A" state
                                                                        ; RestartProcessing)

Which, as expected, generates a nice stream of:

Restart from state 0
Restart from state 0

To bring things back to normal (aka no timeout) you can just pass –1 as in:

counter1 <-- SetTimeoutHandler -1  (fun state -> ContinueProcessing(state))

Also, you can stop the agent when a timeout occurs by returning the aptly named StopProcessing:

counter1 <-- SetTimeoutHandler 1000  (fun state -> printfn "Restart from state %A" state; 
                                                                             StopProcessing)

Another interesting thing you might want to do is hot swapping of code. More on that in the next part …

LAgent: an agent framework in F# – Part IV – Custom error management

lucabol — Fri, 19 Jun 2009 21:36:00 GMT

Download framework here.

All posts are here:

Custom error management

In the last part we saw what happens by default in the framework when an error occurs. But that might not be what you want. You might want to have your sophisticated error detection and recovery distributed algorithm.

To make such a thing possible each agent has a manager. The manager is an agent that gets called whenever an error occurs in the agent it is monitoring.

In code:

let manager = spawnWorker (fun (agent, name:string, ex:Exception, msg:obj,
                 state, initialState) -> printfn "%s restarting ..." name; agent <-- Restart)
counter1 <-- SetManager(manager)

Whenever an error is generated the manager receives a tuple of:

(agent, name, exception, message, currentState, inititialState)

This manager prints out something and then restarts the agent. Let’s trigger an error by posting the wrong message:

counter1 <-- "afdaf"
counter1 <-- 2

The expectation is that the counter will restart from 0 whenever an error is triggered. This is what happens:

Bob restarting ...
From 0 to 2

Which is what we expected. Obviously this is not a very sophisticated error recovery algorithm. You might want to do something more meaningful. Hopefully you have enough information to build whatever you need.

A particularly important class of unexpected event is timeouts. We’ll talk about them next.

LAgent: an agent framework in F# – Part III – Default error management

lucabol — Fri, 12 Jun 2009 21:07:00 GMT

Download framework here.

All posts are here:

Default error management

What happens when an error occurs? Well, ideally you want to notify someone and continue processing messages. By default you want to print the error and as much information as you can about it.

Let’s first see what happens if you pass the wrong message type:

counter1 <-- "fst"

Generates:

> The exception below occurred on agent Undefined at state 3 with message "fst". The agent was started with state 0.
System.InvalidCastException: Specified cast is not valid.
   at Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.UnboxGeneric[T](Object source)
   at FSI_0003.AgentSystem.f@158.Invoke(Object a, Object b)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at FSI_0003.AgentSystem.loop@20-3.Invoke(Unit unitVar)
   at Microsoft.FSharp.Control.AsyncBuilderImpl.callA@245.Invoke(AsyncParams`1 args)

You get information about the current state of the agent, the message that generated the error, the initial state of the agent and the exception that was generated. But, in a system with several agents, you’d like to know which one agent failed. Then you need to name your agent:

counter1 <-- SetName("Bob")
counter1 <-- "fadfad"

Now you get (important part in blue):

> The exception below occurred on agent Bob at state 3 with message "fadfad". The agent was started with state 0.
System.InvalidCastException: Specified cast is not valid.
   at Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.UnboxGeneric[T](Object source)
   at FSI_0003.AgentSystem.f@158.Invoke(Object a, Object b)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at FSI_0003.AgentSystem.loop@20-3.Invoke(Unit unitVar)
   at Microsoft.FSharp.Control.AsyncBuilderImpl.callA@245.Invoke(AsyncParams`1 args)

The important thing is that the agent continues running. It lives to fight another day. Hence:

counter1 <-- 3

Produces:

From 3 to 6

Which shows that the agent is running and that it has kept its current state. Also errors can occur inside the message handler with a similar result:

(spawnAgent (fun msg state -> state / msg) 100) <-- 0

Produces:

> The exception below occurred on agent Undefined at state 100 with message 0. The agent was started with state 100.
System.DivideByZeroException: Attempted to divide by zero.
   at FSI_0013.it@48-3.Invoke(Int32 msg, Int32 state)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at FSI_0003.AgentSystem.f@158.Invoke(Object a, Object b)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at Microsoft.FSharp.Core.FastFunc`2.InvokeFast[V](FastFunc`2 func, T arg1, TResult arg2)
   at FSI_0003.AgentSystem.loop@20-3.Invoke(Unit unitVar)
   at Microsoft.FSharp.Control.AsyncBuilderImpl.callA@245.Invoke(AsyncParams`1 args)

But this might not be what you want. You might want to customize what happens when an error occurs. We’ll talk about that next.

LAgent : an agent framework in F# – Part II – Agents and control messages

lucabol — Fri, 05 Jun 2009 21:03:00 GMT

Download framework here.

All posts are here:

Agents

Agents are entities that process messages and keep state between one message and the next. As such they need to be initialized with a lambda that takes a message and a state and returns a new state. In F# pseudo code: msg –> state –> newState. For example the following:

let counter = spawnAgent (fun msg state -> state + msg) 0

This is a counter that starts from 0 and gets incremented by the value of the received message. Let’s make it print something when it receives a message:

let counter1 = spawnAgent
                (fun msg state -> printfn "From %i to %i" state (state + msg); state + msg) 0
counter1 <-- 3 
counter1 <-- 4

Which produces:

From 0 to 3
From 3 to 7

There is no spawnParallelAgent, because I couldn’t figure out its usage patterns. Maybe I don’t have enough creativity. Obviously msg and state could be of whatever type (in real application they end up being tuples more often than not).

Control messages

You can do things to agents. I’m always adding to them but at this stage they are:

type Command =
| Restart
| Stop
| SetManager of AsyncAgent
| SetName of string

Plus some others. I’ll describe most of them later on, right now I want to talk about Restart and Stop. You use the former like this:

counter1 <-- Restart
counter1 <-- 3

Which produces:

From 0 to 3

This should be somehow surprising to you. You would have thought that you could just post integers to a counter. This is not the case. You can post whatever object. This is useful because it allows to have a common model for passing all sort of messages, it allows for the agent not to be parameterized by the type of the message (and of state) so that you can store them in data structures and allows advanced scenarios (i.e. hot swapping of code).

This is a debatable decision. I tried to get the best of strongly typing and dynamic typing, while keeping simplicity of usage. The implementation of this is kind of a mess though. We’ll get there.

BTW: you use Stop just by posting Stop, which stops the agent (forever).

LAgent : an agent framework in F# – Part I – Workers and ParallelWorkers

lucabol — Fri, 29 May 2009 20:26:00 GMT

Download framework here.

All posts are here:

Introduction

I like to try out different programming paradigms. I started out as an object oriented programmer. In university, I used Prolog. I then learned functional programming. I also experimented with various shared memory parallel paradigms (i.e. async, tasks and such). I now want to learn more about message based parallel programming (Erlang style). I’m convinced that doing so makes me a better programmer. Plus, I enjoy it …

My usual learning style is to build a framework that replicates a particular programming model and then write code using it. In essence, I build a very constrained environment. For example, when learning functional programming, I didn’t use any OO construct for a while even if my programming language supports them.

In this case, I built myself a little agent framework based on F# MailboxProcessors. I could have used MailboxProcessors directly, but they are too flexible for my goal. Even to write a simple one of these guys, you need to use async and recursion in a specific pattern, which I always forget. Also, there are multiple ways to to do Post. I wanted things to be as simple as possible. I was willing to sacrifice flexibility for that.

Notice that there are serious efforts in this space (as Axum). This is not one of them. It’s just a simple thing I enjoy working on between one meeting and the next.

Workers and ParallelWorkers

The two major primitives are spawning an agent and posting a message.

let echo = spawnWorker (fun msg -> printfn "%s" msg)
echo <-- "Hello guys!"

There are two kinds of agents in my system. A worker is an agent that doesn’t keep any state between consecutive messages. It is a stateless guy. Notice that the lambda that you pass to create the agent is strongly typed (aka msg is of type string). Also notice that I overloaded the <— operator to mean Post.

Given that a worker is stateless, you can create a whole bunch of them and, when a message is posted, route it to one of them transparently.

let parallelEcho = spawnParallelWorker(fun s -> printfn "%s" s) 10
parallelEcho <-- "Hello guys!”

For example, in the above code, 10 workers are created and, when a message is posted, it gets routed to one of them (using a super duper innovative dispatching algorithm I’ll describe in the implementation part). This parallelWorker guy is not really needed, you could easily built it out of the other primitives, but it is kind of cute.

To show the difference between a worker and a parallelWorker, consider this:

let tprint s = printfn "%s running on thread %i" s Thread.CurrentThread.ManagedThreadId
let echo1 = spawnWorker (fun s -> tprint s)
let parallelEcho1 = spawnParallelWorker(fun s -> tprint s) 10

let messages = ["a";"b";"c";"d";"e";"f";"g";"h";"i";"l";"m";"n";"o";"p";"q";"r";"s";"t"]
messages |> Seq.iter (fun msg -> echo1 <-- msg)
messages |> Seq.iter (fun msg -> parallelEcho1 <-- msg)

The result of the echo1 iteration is:

a running on thread 11
b running on thread 11
c running on thread 11
d running on thread 11
…

While the result of the parallelEcho1 iteration is:

a running on thread 13
c running on thread 14
b running on thread 12
o running on thread 14
m running on thread 13
…

Notice how the latter executes on multiple threads (but not in order). Next time I’ll talk about agents, control messages and error management.

Luke talks about F# on Channel9

lucabol — Wed, 27 May 2009 19:47:00 GMT

Here you go: http://channel9.msdn.com/posts/Charles/Luke-Hoban-Latest-version-of-F-Released-Whats-the-story-Whats-next/

A version of the AsyncCache found its way into the Parallel Programming samples …

lucabol — Thu, 21 May 2009 20:28:13 GMT

Go here to download them. It is in \ParallelExtensionsExtras\CoordinationDataStructures. It has a slightly different design in that it returns Tasks. I’m trying to get Stephen to blog about it so that you can compare them.

I talk about C# and VB Co-Evolution on Channel9 (and some F# …)

lucabol — Thu, 14 May 2009 20:26:18 GMT

The title says it all. If you are interested, go here.

Luca at NDC in Oslo 17 – 19 June 2009

lucabol — Tue, 24 Mar 2009 19:46:27 GMT

I’ll be speaking about the future of C# and F#. Oslo brings back so many memories …

“one of the world’s most important conferences for IT developers and leaders”

Bayesian inference in F# – Part IIb – Finding Maia underlying attitude

lucabol — Mon, 19 Jan 2009 19:48:00 GMT

Other parts:

The previous post ended on this note.

let MaiaJointProb attitude action =
    match attitude with
    | Happy     -> happyActions |> List.assoc action
    | UnHappy   -> unHappyActions |> List.assoc action
    | Quiet     -> quietActions |> List.assoc action

This is just a two by two matrix. It simply represents which probability is associated to an (attitude, action) tuple. It is useful to think about it in these terms, because it makes easier to grasp the following function:

/// Conditional probability of a mental state, given a particular observed action
let MaiaLikelihood action = fun attitude -> MaiaJointProb attitude action

This is simply a row in the matrix. It answers the question: given that I observe a particular action, what is the probability that Maia has a certain attitude?. This is called “likelihood function” in statistics. Its general form is: given that a I observe an outcome, what is the probability that it is generated by a process with a particular parameter?

A related question is then: what if I observe a sequence of independent actions? What is the probability that the baby has a certain attitude then? This is answered by the following:

/// Multiple applications of the previous conditional probabilities for a series of actions (multiplied)
let MaiaLikelihoods actions =
    let composeLikelihoods previousLikelihood action  = fun attitude -> previousLikelihood attitude * MaiaLikelihood action attitude        
    actions |> Seq.fold composeLikelihoods (fun attitude -> 1.)

It is a trivial extension of the previous function (really), once you know that to combine likelihoods you multiply them.

We now need to describe what our prior is. A prior is our preconceived notion about a particular parameter (in this case the baby’s attitude). You might be tempted to express that notion with a single value, but that would be inaccurate. You need to indicate how confident you are about it. In statistics you do that by choosing a distribution for your belief. This is one of the beauties of Bayesian statistics, everything is a probability distribution. In this case, we really don’t have any previous belief, so we pick the uniform distribution.

let MaiaUniformPrior attitude = 1. / 3.

Think of this as: you haven’t read any baby-attitude-specific study or received any external information about the likely attitude of Maia, so you cannot prefer one attitude over another.

We are almost done. Now we have to apply the Bayesian theorem and get the un-normalized posterior distribution. Forget about the un-normalized word. What is a posterior distribution? This is your output, your return value. It says: given my prior belief on the value of a parameter and given the outcomes that I observed, this is what I now believe the parameter to be. In this case it goes like: I had no opinion on Maia’s attitude to start with, but after I observed her behavior for a while, I now think she is Happy with probability X, UnHappy with probability Y and Quiet with probability Z.

/// Calculates the unNormalized posterior given prior and likelihood
let unNormalizedPosterior (prior:'a -> float) likelihood =
    fun theta -> prior theta * likelihood theta

We then need to normalize this thing (it doesn’t sum to one). The way to do it is to divide each probability by the sum of the probabilities for all the possible outcomes.

/// All possible values for the unobservable parameter (mental state)
let support = [Happy; UnHappy; Quiet]

/// Normalize the posterior (it integrates to 1.)
let posterior prior likelihood =
    let post = unNormalizedPosterior prior likelihood
    let sum = support |> List.sum_by (fun attitude -> post attitude)
    fun attitude -> post attitude / sum

We are done. Now we can now start modeling scenarios. Let’s say that you observe [Smile;Smile;Cry;Smile;LookSilly]. What could the underlying attitude of Maia be?

let maiaIsANormalBaby = posterior MaiaUniformPrior (MaiaLikelihoods [Smile;Smile;Cry;Smile;LookSilly])

We can then execute our little model:

maiaIsANormalBaby Happy
maiaIsANormalBaby UnHappy
maiaIsANormalBaby Quiet

And we get (0.5625, 0.0625, 0.375). So Maia is likely to be happy and unlikely to be unhappy. Let’s now model one extreme case:

/// Extreme cases
let maiaIsLikelyHappyDist = posterior MaiaUniformPrior (MaiaLikelihoods [Smile;Smile;Smile;Smile;Smile;Smile;Smile])

maiaIsLikelyHappyDist Happy
maiaIsLikelyHappyDist UnHappy
maiaIsLikelyHappyDist Quiet

And we get (0.944, 0.000431, 0.05). Now Maia is almost certainly Happy. Notice that I can confidently make this affirmation because my end result is exactly what I was looking for when I started my quest. Using classical statistics, that wouldn’t be the case.

A related question I might want to ask is: given the posterior distribution for attitude that I just found, what is the probability of observing a particular action? In other words, given the model that I built, what does it predict?

let posteriorPredictive jointProb posterior =
    let composeProbs previousProbs attitude = fun action -> previousProbs action + jointProb attitude action * posterior attitude  
    support |> Seq.fold composeProbs (fun action -> 0.)
    
let nextLikelyUnknownActionDist = posteriorPredictive MaiaJointProb maiaIsLikelyHappyDist

I don’t have the strength right now to explain the mathematical underpinning of this. In words, this says: considering that Maia can have one of the possible three Attitudes with the probability calculated above, what is the probability that I observe a particular action? Notice that the signature for it is: (Action –> float), which is the compiler way to say it.

Now we can run the thing.

nextLikelyUnknownActionDist Smile
nextLikelyUnknownActionDist Cry
nextLikelyUnknownActionDist LookSilly

And we get (0.588, 0.2056, 0.2055). Why is that? We’ll talk about it in the next post.