Monotone chain algorithm implementation in OCaml

convexhull.ml

(*
 * Implementation of the monotone chain algorithm in OCaml to compute the convex
 * hull in the plane.
 *
 *
 * Monotone chain — O(n log n)
 * Published in 1979 by A. M. Andrew. The algorithm can be seen as a variant of
 * Graham scan which sorts the points lexicographically by their coordinates.
 * When the input is already sorted, the algorithm takes O(n) time.
 * 
 * http://en.wikipedia.org/wiki/Convex_hull_algorithms#Algorithms
 *)



(* Very simple function to check if two vectors OA and OB does a clockwise or
 * counter-clockwise angle. We just use the vectorial product and compare the
 * result with 0. *)
let does_cw (o_x, o_y) (a_x, a_y) (b_x, b_y) = 
    (a_x - o_x) * (b_y - o_y) - (a_y - o_y) * (b_x - o_x) <= 0

(* And our final lexicographical insertion sorting function. *)
let lex_sort l = List.sort compare l


(* Compute the convex hull for a finite number of points using the monotone
 * chain algorithm. *)

let convex_hull points =
    (* Sort the input points *)
    let s_points = lex_sort points in
    let rs_points = List.rev s_points in
    
    (* Simple function to remove the first element of a list *)
    let remove_first l = match l with
                           | [] -> []
                           | h::t -> t
    in

    (* Clean the list of points by analyzing them three by three and checking
     * if they don't do a counter-clockwise angle. *)
    let rec clean l x =
        match l with
        | a :: (b :: _ as t) when does_cw b a x -> clean t x
        | _ -> list
    in

    (* Computing a part of the hull (either top or bottom). It just clean the
     * accumulator and add the next point from the list. *)
    let rec part_hull list = List.fold_right (fun x acc -> x :: (clean x acc)) list [] in

    (* Compute the two parts of the hull. *)
    let lower = part_hull [] s_points
    and upper = part_hull [] rs_points

    (* Return the final result. Note: the first and last points are the same,
     * because we want a closed polygon. *)
    in (List.rev (remove_first lower)) @ (List.rev upper)

drawconvexhull.ml

open Convexhull
open Graphics


(* Wait for an input to quit the program *)
let waitquit () =
    while true do 
        if key_pressed () then begin
            match read_key () with
            | 'n' -> ()
            | _ -> ()
        end
    done



let main() =
    (* Generate the random generator *)
    Random.self_init();

    (* Prepare the plotting area *)
    open_graph " 800x800";
    set_color black;
    fill_rect 0 0 800 800;
    set_color white;
    set_line_width 1;

    (* Generate a random number of random points *)
    let generate_random_points = 
        let number = (Random.int 100) + 1 in
        let rec aux num =
            if num == 0
            then []
            else ((Random.int 700)+50, (Random.int 700)+50) :: aux (num-1)
        in
        aux number
    in

    let points = generate_random_points in

    begin
        (* Plot the points *)
        plots (Array.of_list points);
        (* Compute the convex hull *)
        let polygon_vertices = convex_hull points in
        (* Draw the resulting polygon *)
        draw_poly_line (Array.of_list polygon_vertices)
    end;

    (* Stop the program so as you can admire the result *)
    waitquit ()

let _ = main ()

Makefile

RESULT = drawconvexhull
SOURCES = convexhull.ml drawconvexhull.ml
LIBS = graphics
PACKS = extlib 
THREADS = true
OCAMLLDFLAGS = -cclib "-framework Cocoa"
LDFLAGS = -arch x86_64


include OCamlMakefile

Didnt know you could have several files in a gist !

Yeah, it's pretty handy. The only thing with Gist is that it's long to load when embedded in a page using JavaScript. :/