Playing with Hanson's Logarithmic Scoring Rule (LMSR) Market Maker. Created as an agent because I wanted to simulate market behaviour with large numbers of agents and watch how price changes.

MarketMaker.fsx

(*

From http://blog.oddhead.com/2006/10/30/implementing-hansons-market-maker/

*)

open System

// ---------------------------------------------------
// first off some helper functionality to report messages as events, copied straight off Don Syme's blog: http://blogs.msdn.com/b/dsyme/archive/2010/01/10/async-and-parallel-design-patterns-in-f-reporting-progress-with-events-plus-twitter-sample.aspx
open System.Threading

type SynchronizationContext with
    /// A standard helper extension method to raise an event on the GUI thread
    member syncContext.RaiseEvent (event: Event<_>) args =
        syncContext.Post((fun _ -> event.Trigger args),state=null)
 
    /// A standard helper extension method to capture the current synchronization context.
    /// If none is present, use a context that executes work in the thread pool.
    static member CaptureCurrent () =
        match SynchronizationContext.Current with
        | null -> new SynchronizationContext()
        | ctxt -> ctxt

type AsyncWorker<'T>(jobs: seq<Async<'T>>) =  
    // This declares an F# event that we can raise
    let jobCompleted  = new Event<int * 'T>()
    /// Start an instance of the work
    member x.Start()    =
        // Capture the synchronization context to allow us to raise events back on the GUI thread
        let syncContext = SynchronizationContext.CaptureCurrent()
 
        // Mark up the jobs with numbers
        let jobs = jobs |> Seq.mapi (fun i job -> (job,i+1)) 
        let work = 
            Async.Parallel
               [ for (job,jobNumber) in jobs ->
                   async { let! result = job
                           syncContext.RaiseEvent jobCompleted (jobNumber,result)
                           return result } ]
 
        Async.Start(work |> Async.Ignore)
    /// Raised when a particular job completes
    member x.JobCompleted  = jobCompleted.Publish
// ---------------------------------------------------


// in our auctions we'll deal with just two outcomes, so you can go for outcome 1 which we'll treat this as going long, or for outcome 2 which is analogous to going short
type Outcome = Outcome1 | Outcome2
type Auction = { mutable sharesOn1 : int ; mutable sharesOn2 : int }

// we'll start with one prediction market for testing, then later create a collection of predictions

// agents send in instructions to long or short shares of a named auction
(*
type Result<'T> =   | Success of 'T
                    | Failure of Exception
*)

type BidValue =
    | Buy of int
    | Sell of int

type Bid = { outcome : Outcome;  bidValue : BidValue}

type AuctionMessage = 
    | PlaceABid of Bid
    | Fetch of AsyncReplyChannel<Auction>

// Hanson's LMSR equation
let MAXEXPOSURE = 100.
let cost q1 q2 = MAXEXPOSURE * log(exp(q1/MAXEXPOSURE) + exp(q2/MAXEXPOSURE))

let sample = Event<string>()
let syncContext = SynchronizationContext.Current

let Auctioneer = MailboxProcessor.Start( fun agent ->

    let rec loop (auction : Auction) = async {
        let! msg = agent.Receive()
        match msg with
        // first approach could be to split out all the separate possible cases
        | PlaceABid { outcome  = Outcome1;  bidValue = (Buy amt)} -> 
            let purchaseCost = cost (Convert.ToDouble(auction.sharesOn1 + amt)) (Convert.ToDouble(auction.sharesOn2)) - 
                                cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2) )
            auction.sharesOn1 <- auction.sharesOn1 + amt
            printfn "Purchase cost: %A" purchaseCost
            return! loop auction
        | PlaceABid { outcome  = Outcome2;  bidValue = (Buy amt)} ->
            let purchaseCost = cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2 + amt)) - 
                                cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2) )
            auction.sharesOn2 <- auction.sharesOn2 + amt
            printfn "Purchase cost: %A" purchaseCost
            return! loop auction
        | PlaceABid { outcome  = Outcome1;  bidValue = (Sell amt)} ->
            let purchaseCost = cost (Convert.ToDouble(auction.sharesOn1 - amt)) (Convert.ToDouble(auction.sharesOn2)) - 
                                cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2) )
            auction.sharesOn1 <- auction.sharesOn1 - amt
            printfn "Purchase cost: %A" purchaseCost
            return! loop auction
        | PlaceABid { outcome  = Outcome2;  bidValue = (Sell amt)} ->
            let purchaseCost = cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2 - amt)) - 
                                cost (Convert.ToDouble(auction.sharesOn1)) (Convert.ToDouble(auction.sharesOn2) )
            auction.sharesOn2 <- auction.sharesOn2 - amt
            printfn "Purchase cost: %A" purchaseCost
            return! loop auction
        | Fetch(replyChannel) -> 
            printfn "Shares on Outcome 1 %i, Shares on Outcome 2 %i" auction.sharesOn1 auction.sharesOn2
            syncContext.RaiseEvent sample "ho ho ho"
            replyChannel.Reply(auction)
            return! loop auction
    }
    loop {sharesOn1 = 0; sharesOn2 = 0}
)

// let's try this out...
Auctioneer.Post (PlaceABid {outcome=Outcome1; bidValue = Buy 100})
Auctioneer.Post (PlaceABid {outcome=Outcome1; bidValue = Buy 50})
Auctioneer.Post (PlaceABid {outcome=Outcome1; bidValue = Sell 10})
Auctioneer.Post (PlaceABid {outcome=Outcome2; bidValue = Buy 90})
Auctioneer.Post (PlaceABid {outcome=Outcome2; bidValue = Sell 20})
Auctioneer.PostAndReply (fun replyChannel -> Fetch replyChannel )