24 June 2009

Fun with data structures, continuations and call/cc

Prompted by exercise 2.3 in Purely Functional Data Structures, by Chris Okasaki.

type Tree<'a> = Empty | Elem of 'a Tree * 'a * 'a Tree

let empty = Empty
Recursive
let rec insert x t =
    match t with
    | Empty ->  Elem(empty,x,empty)
    | Elem (left,e,right) when x < e -> Elem (insert x left,e,right)
    | Elem (left,e,right) when x > e -> Elem (left,e, insert x right)
    | Elem _ –> t
Tail Recursive
let insert' x t =
    let rec cont x t k =
        match t with
        | Empty -> k (Elem(empty,x,empty))
        | Elem (left,e,right) when x < e -> cont x left (fun t' -> k <| Elem (t',e,right))
        | Elem (left,e,right) when x > e -> cont x right (fun t' -> k <| Elem (left,e,t'))
        | Elem _ -> k t
    cont x t id
Using a continuation monad
type Cont<'a,'r> = ('a -> 'r) -> 'r

type ContBuilder() =
    member x.Return (a):Cont<'a,'r> = fun k -> k a
    member x.Bind (c:Cont<'a,'r>, f:'a -> Cont<'b,_>) =
        (fun k -> c (fun a -> f a k))
    member this.Delay(f) = f()

let cont = ContBuilder()
let insertM x t =
    let rec insertRecM x t =
        match t with
        | Empty ->  cont { return Elem(empty,x,empty) }
        | Elem (left,e,right) when x < e -> 
            cont {  let! t' = insertRecM x left
                    return Elem(t',e,right) }
        | Elem (left,e,right) when x > e -> 
            cont {  let! t' = insertRecM x right
                    return Elem(left,e,t') }
        | Elem _ -> cont { return t }
    insertRecM x t id
Using call with current continuation
let callCC (f:('a -> Cont<'b,'r>) -> Cont<'a,'r>) : Cont<'a,'r> = fun k -> f (fun a _ -> k a) k
let insertCallCC x t =
    callCC (fun alreadyExists ->
        let rec insertRecCallCC x t =
            match t with
            | Empty ->  cont { return Elem(empty,x,empty) }
            | Elem (left,e,right) when x < e -> 
                cont {  let! t' = insertRecCallCC x left
                        return Elem(t',e,right) }
            | Elem (left,e,right) when x > e -> 
                cont {  let! t' = insertRecCallCC x right
                        return Elem(left,e,t') }
            | Elem _ -> alreadyExists t
        insertRecCallCC x t
    ) id

Please note that the complexity of the last implementation is not obfuscation – it avoids recreating nodes on the path to an already existing element (exercise 2.3 actually asks to do it using exceptions, which works just as well).

Share this post : Technet! del.icio.us it! del.iri.ous! digg it! dotnetkicks it! reddit! technorati!

2 comments:

  1. Nice!

    Note that exceptions are 600× slower in F# than OCaml so you probably want to avoid them if you want vaguely decent performance.

    ReplyDelete
  2. Thanks.

    Yes, I realize that the OCaml practice of using exceptions for control flow is strongly discouraged in .NET for that reason (although some people will argue it's for "conceptual" reasons). I'm going to try running a few benchmarks with this code later on.

    ReplyDelete