Efficient F#: tail recursive quicksort via continuation monad

Recently, I become a fan of F#. This post is basically a practice to implement the quick sort algorithm in F#. The first version coming to mind is like this:

let rec someSort list =
    match list with
    | [] -> []
    | [x] -> [x]
    | x::xs ->
        let l, r = List.partition ((>) x) xs
        let ls = someSort l
        let rs = someSort r
        ls @ (x::rs)

Since I don’t like the function interface to be a recursive one, I rewrite it like this

let someSort list =
    let rec loop list =
        match list with
        | [] -> []
        | [x] -> [x]
        | x::xs ->
            let l, r = List.partition ((>) x) xs
            let ls = loop l
            let rs = loop r
            ls @ (x::rs)
    loop list

This implementation has several problems. First, it is not tail recursive, which means potentially it can blow you call stack. We can transform this implementation into a tail recursive one using so called continuation passing style (a.k.a. CPS):

let someSortCont list =
    let rec loop list cont =
        match list with
        | [] -> cont []
        | x::[] -> cont [x]
        | x::xs ->
            let l, r = List.partition ((>) x) xs
            loop l (fun ls ->
            loop r (fun rs ->
            cont (ls @ (x::rs))))
    loop list (fun x -> x)

To make the implementation easy to read (or write), we can utilize the continuation monad, which is called computation expression or workflow in F#. We define the workflow as

type ContinuationBuilder() =
    member this.Bind (m, f) = fun c -> m (fun a -> f a c)
    member this.Return x = fun k -> k x
let cont = ContinuationBuilder()

Then, the CPS sorting function can be implemented as

let someSortMonad list =
    let rec loop list =
        cont {
            match list with
            | [] -> return []
            | x::xs ->
                let l, r = List.partition ((>) x) xs
                let! ls = loop l
                let! rs = loop r
                return (ls @ (x::rs))
    loop list (fun x -> x)

Everything looks good now, except this sorting algorithm actually is not the quick sort. The concatenation operator @ for list type is linear in its left parameter. A common optimization technique is to define functions not as returning a list but having accumulator list parameter to maintain the function result. We can apply this trick to the first version we wrote (someSort) to get a real quick sort:

let quickSort list =
    let rec loop list acc =
        match list with
        | [] -> acc
        | x::[] -> x::acc
        | x::xs ->
            let l, r = List.partition ((>) x) xs
            let rs = loop r acc
            loop l (x::rs)
    loop list []

Then, we transform it to a tail recursive one using CPS:

let quickSortCont list =
    let rec loop list acc cont =
        match list with
        | [] -> cont acc
        | x::[] -> cont (x::acc)
        | x::xs ->
            let l, r = List.partition ((>) x) xs
            loop r acc (fun rs ->
            loop l (x :: rs) cont)
    loop list [] (fun x -> x)

Finally, by utilizing the continuation monad we wrote, we further simplify the algorithm as:

let quickSortMonad list =
    let rec loop list acc=
        cont {
            match list with
                | [] -> return acc
                | x::[] -> return x::acc
                | x::xs ->
                    let l, r = List.partition ((>) x) xs
                    let! rs = loop r acc
                    let! s = loop l (x::rs)
                    return s
    loop list [] (fun x -> x)

I did some basic testing to see how fast each implementation runs. Here is the test script:

let rand = new System.Random()
let data = List.init 100000 (fun _ -> rand.NextDouble())

let test f x =
    let sw = Stopwatch()
    f x |> ignore

printf “someSort: %dms\n” (test someSort data)
printf “someSortCont: %dms\n” (test someSortCont data)
printf “someSortMonad: %dms\n” (test someSortMonad data)
printf “quickSort: %dms\n” (test quickSort data)
printf “quickSortCont: %dms\n” (test quickSortCont data)
printf “quickSortMonad: %dms\n” (test quickSortMonad data)
printf “List.sort: %dms\n” (test List.sort data)

Here is the result on my crappy laptop (Core 2 duo 2.2GHz, 4GB RAM):

someSort: 854ms
someSortCont: 918ms
someSortMonad: 896ms
quickSort: 791ms
quickSortCont: 796ms
quickSortMonad: 834ms
List.sort: 68ms
We can see that quickSort is a little faster than someSort. By adopting the CPS and the monad tricks, we slow down the algorithm a little bit, which is understandable. However, none of the above implementation can compete with the highly optimized  built-in List.sort function :(. Still it is a fun practice :).
P.S. this blog post is inspired by various online materials. I can not enumerate all of them. Many thanks to those authors.
Any suggestion for further improvement are welcome.

About statinfer

Statistical inference
This entry was posted in F# and tagged . Bookmark the permalink.

3 Responses to Efficient F#: tail recursive quicksort via continuation monad

  1. it’s interesting that the List.sort function converts the list into an array, sorts the array and converts it back

  2. Jesse says:

    What is interesting is when I used the quicksort or any of the methods you described and then call it in a C# console application, the results I get are as followed: (I’ll also show my code.

    namespace ConsoleApplication2
    class Program
    static void Main(string[] args)
    List number = new List() { 22, 99, 105, 33, 1 };
    var nums = ListModule.OfSeq(number);

    // [1; 22; 33;…] results in console window

    Granted they are sorted, but as you can see, it doesn’t show all of the items in the array. It is confusing and I would like to learn more to know why.

  3. Your otherwise neat continuation builder does not generate tail-recursive code. This is because of eager evaluation in F#.
    For example, “let! rs = loop r acc” does not result in “fun c -> (loop r acc)…” as one would expect with a lazily-evaluated language.
    What you get instead is “let temp = loop r acc in fun c -> temp …”, where the call to loop is no longer in tail position.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s