Functionally option pricing by binomial tree

Introduction

You may already know, there are their own implementation of option pricing codes by binomial tree model on the Web(see Reference) ,
and binomial tree method is no longer popular way to get a option price in Finance/Financial engineering world*1.

But I decided to do that because I really want to feel and enjoy the power of F#.
Because F# gives us the good way which is called "discriminated union" to express "tree structure",
we can beautifully express the tree structure of underlying assets using discriminated union.
After making the tree structure of underlying assets, we just evaluate a option recursively.
Wow, that really sounds like functional programming!!!

Calculation results

Because my implementation(and English!) is not good for F# professionals, I would like to hear from all of you how I should write to improve that.

You can get all source codes from github.

or below this article.

Anyway, calculation results are

American option price is 3.338480
European option price is 3.307364

.

Because these guys are really close to the result from WolframAlpha, I think that there are no mistakes :)

To-do

There are To-do lists for myself...

  • Tree construction is redundant(O(2^N), N is a depth of tree structure), It should be reduced to O(N) (use reference to locale on Heap memory?).
  • Payoff function in OptionType looks like redundant.

If you have any good idea to improve the above issues, please contact to me :)

Source codes

//Binary tree(used as binomial tree)
type BinaryTree = 
    | Empty
    | Node of float*BinaryTree*BinaryTree
//Option type with payoff
type OptionType =
    | American of (float -> float)
    | European of (float -> float)
    member this.Payoff = 
        match this with 
            | American payoff -> payoff
            | European payoff -> payoff
//Make binary tree
let makeTree s0 u d n=
    let rec makeTreeInner m = 
        match m with
            | 0 ->
                [| for i in 0..n -> Node(s0*(u**float(n-i))*(d**float(i)), Empty, Empty) |]
            | _ -> 
                let childs = makeTreeInner (m-1)
                [| for i in 0..(n-m) -> Node(s0*(u**float(n-m-i))*(d**float(i)), childs.[i], childs.[i+1]) |]
    (makeTreeInner n).[0]
//Option Pricer
let evalOption (option:OptionType) s0 r T vol n=
    let dt = (float T)/(float n)
    let u = exp(vol*sqrt(dt))
    let d = 1.0/u
    let tree = makeTree s0 u d n
    let p = (exp(r*dt)-d)/(u-d)
    let rec evalOptionInner (option:OptionType) tree =
        match tree with 
            | Empty -> 0.0
            | Node(value, Empty, Empty) -> option.Payoff value
            | Node(value, lNode, rNode) -> 
                let lValue = evalOptionInner option lNode                
                let rValue = evalOptionInner option rNode
                let currentValue = (exp(-r*dt)*(p*lValue+(1.0-p)*rValue))
                match option with 
                    | American payoff -> max (payoff value) currentValue
                    | European _      -> currentValue
    evalOptionInner option tree

[<EntryPoint>]
let main argv = 
    //Strike:50$, Underlying price:51$, Maturity:1 year Risk-free:1%, Volatility:20%, Tree grid:12, 
    printfn "American option price is %f" (evalOption (American (fun x -> max (50.0-x) 0.0)) 51.0 0.01 1.0 0.2 12)
    printfn "European option price is %f" (evalOption (European (fun x -> max (50.0-x) 0.0)) 51.0 0.01 1.0 0.2 12)

    0 // return an integer exit code

*1:Now, Montecarlo simulation including LSM(Least-Square Montecarlo) for American/Bermudan option pricing is so popular because we already have enough machine power to do that.