Monty-Hall with Probability-Monad in F#

MontyHall.fs

type Probability = double
type Distribution<'a> = ('a * Probability) list
type Event<'a> = 'a -> bool

let printDistribution (v : Distribution<'a>) =
    let negate x = -x
    v |> List.sortBy (snd >> negate) |> List.iter (fun (a,p) -> printfn "%A: %.2f%%" a (p * 100.0))

let sure (a : 'a) : Distribution<'a> =
    [a, 1.0]

let uniformDist (ls : 'a list) = 
    let ws = 1.0 / float (List.length ls)
    List.map (fun l -> (l, ws)) ls

let eventProbability (e : Event<'a>) (vs : Distribution<'a>) : Probability =
    vs |> List.filter (fst >> e)
        |> List.sumBy snd

let (>?) a b = eventProbability b a

[<AutoOpen>]
module internal Operations =

    let normalize (v : Distribution<'a>) =
        let dict = new System.Collections.Generic.Dictionary<_,_>()
        let get a = if dict.ContainsKey a then dict.[a] else 0.0
        let add (a,p) = dict.[a] <- get a + p
        v |> List.iter add
        dict |> Seq.map (fun kvp -> (kvp.Key, kvp.Value)) 
                |> List.ofSeq

[<AutoOpen>]
module Monad =
    let returnM (a : 'a) : Distribution<'a> =
        sure a

    let bind (v : Distribution<'a>) (f : 'a -> Distribution<'b>) : Distribution<'b> =
        [ for (a,p) in v do
            for (b,p') in f a do
            yield (b, p*p')
        ] |> normalize

    let (>>=) f m =
        bind f m

    type VertBuilder internal () =
        member x.Bind(m, f) = m >>= f
        member x.Return(v) = returnM v
        member x.ReturnFrom(v) = v
        member x.Delay(f) = f ()

let vert = Monad.VertBuilder()    

let montyHall =
    vert {
        let! gate = uniformDist [1..3]
        let! guess = uniformDist [1..3]
        let opened = Set.ofList [1..3] |> Set.remove gate |> Set.remove guess |> Set.minElement
        let switched = Set.ofList [1..3] |> Set.remove opened |> Set.remove guess |> Set.minElement
        return (if gate = guess then "stick with it" elif switched = gate then "better switch" else "wtf?")
    }
        
printDistribution montyHall