EOPL - 1.2.4 - Exercise 1.17, sorting

Another exercise. This one involves binary trees and sorting. For the bintrees and finding a path through them to an element, we define two types:

type BinTree = Empty | Node of int * BinTree * BinTree
type direction = Left | Right

Then we can define function path, returning a list of directions:

let rec path n bst = 
    match bst with
      Empty -> failwith ("number " + (string_of_int n) + " not found in tree")
    | (Node (x, left, right)) when n = x -> []
    | (Node (x, left, right)) when n < x -> Left :: path n left
    | (Node (_, left, right)) -> Right :: path n right

For sorting, I chose to implement a rudimentary quicksort (with the first element as pivot). As with previous functions, beware of the value restriction.

let rec sort lst = 
    let left_part x (lp, rp) = (x :: lp, rp) in
    let right_part x (lp, rp) = (lp, x :: rp) in
    let rec partition p lst = 
        match lst with 
          [] -> ([], [])
        | (x :: rlst) when x < p -> left_part x (partition p rlst)
        | (x :: rlst) when x > p -> right_part x (partition p rlst)
        | (x :: rlst) -> partition p rlst in
    match lst with
      [] -> []
    | (x :: rlst) -> let lp, rp = partition x lst in 
                     (sort lp) @ [x] @ (sort rp)

I wrote the internal function partition because it was part of the exercise, but it is already there in the standard library. Using this fact, we can get a much shorter version of quicksort:

let rec sort lst = 
    match lst with
      [] -> []
    | (x :: rlst) -> let lp, rp = List.partition (fun n -> n < x) rlst in 
                     (sort lp) @ [x] @ (sort rp)

To sort with a different predicate is a straightforward change in either version. Here is the longer version working with a predicate:

let rec sort pred lst = 
    let left_part x (lp, rp) = (x :: lp, rp) in
    let right_part x (lp, rp) = (lp, x :: rp) in
    let rec partition p lst = 
        match lst with 
          [] -> ([], [])
        | (x :: rlst) when x = p -> partition p rlst
        | (x :: rlst) when (pred x p) -> left_part x (partition p rlst)
        | (x :: rlst) -> right_part x (partition p rlst) in
    match lst with
      [] -> []
    | (x :: rlst) -> let lp, rp = partition x lst in 
                     (sort pred lp) @ [x] @ (sort pred rp)

Finally, just for fun, I wrote a merge sort function too.

let rec merge_sort (lst:'a list) =  
    let merge_pairs (ll1, rl1) (ll2, rl2) = 
        (ll1 @ ll2, rl1 @ rl2) in
    let split_pairs i x = 
        if i < (lst.Length / 2) then ([x], []) else ([], [x]) in
    let split l = 
        List.fold_right merge_pairs (List.mapi split_pairs l) ([], []) in
    let rec merge lon1 lon2 = 
        match (lon1, lon2) with
          ([], _) -> lon2
        | (_, []) -> lon1
        | (x :: rlon1, y :: rlon2) when x <= y -> x :: (merge rlon1 lon2)
        | (x :: rlon1, y :: rlon2) -> y :: (merge lon1 rlon2) in
    match lst with
      [] -> []
    | [x] -> [x]
    | _ -> let l, r = split lst in merge (merge_sort l) (merge_sort r)

It's quite long, but I didn't bother trying to get a shorter version.