Well … it seems that planet ocaml is faster then light to index new pages… I often start editing one story to publish it few days later to avoid stupid mistakes. This time I published the page by accident and I think it stayed published for less then two minutes… This is the final versions …

Today i did a small audit on my code to check which are the functions that are often used and can slow down my code. One in particular took my attention, ExtLib.List.unique . This function (below) takes quadratic time on the length of the input list. On big lists, this function is a killer. The algorithm is very simple. Since it accepts a cmp optional argument, it can be much faster if we use a monomorphic comparing function.

let rec unique ?(cmp = ( = )) l =
        let rec loop dst = function
                | [] -> ()
                | h :: t ->
                        match exists (cmp h) t with
                        | true -> loop dst t
                        | false ->
                                let r = { hd =  h; tl = [] }  in
                                dst.tl <- inj r;
                                loop r t
        in
        let dummy = dummy_node() in
        loop dummy l;
        dummy.tl

This is a small benchmark (benchmarking is addictive indeed !!) using, the polymorphic and monomorphic variant of List.unique :

open ExtLib ;;

Random.self_init ();;

let list_unique l = List.unique l ;;

let list_unique_mono l =
  let cmp (x : string) (y : string) = x = y in
  List.unique ~cmp l
;;

let run () =
  let rec gen_strings acc = function
    |0 -> acc
    |n -> gen_strings ((string_of_int(Random.int 100))::acc) (n-1)
  in
  let a = gen_strings [] 100000 in
  Benchmark.latencyN (Int64.of_int 10) [
    ("list_unique",list_unique,a);
    ("list_unique_mono",list_unique_mono,a);
    ("hash_unique",hash_unique,a);
  ]
;;
run ();;

However if you want to go even faster, you can use a stupid implementation based on hash tables.

let hash_unique l =
  let h = Hashtbl.create (List.length l) in
  let add n =
    if not(Hashtbl.mem h n) then
      Hashtbl.add h n ()
  in
  List.iter add l;
  Hashtbl.fold (fun k _ acc -> k::acc) h []

The results are quite clear…

Latencies for 10 iterations of "list_unique", "list_unique_mono", "hash_unique":
     list_unique:  5.34 WALL ( 5.24 usr +  0.06 sys =  5.30 CPU) @  1.89/s (n=10)
     list_unique_mono:  1.41 WALL ( 1.31 usr +  0.08 sys =  1.39 CPU) @  7.18/s (n=10)
     hash_unique:  0.21 WALL ( 0.18 usr +  0.03 sys =  0.21 CPU) @ 48.07/s (n=10)

In this test with a long list and many repetition, the difference is remarkable. the function hash_unique is not stable, but if you don’t care, it does the job pretty well. If you want an even faster implementation based on list that is also not stable, you can write a small function that remove duplicates on a sorted list.

Often, when I change something in my project, I wonder if my modifications had any impact on other modules. On the one hand there is correctness. If I change something I want to be confident that I didn’t break anything else in a dependent part of the code. In order to alleviate this problem, I often use a battery of unit tests that I ran before committing my changes. This does not give me a proof that I didn’t break anything, but at least some level of confidence that if I broke something, this is not something I thought of before… As ocaml library I use the excellent oUnit library.

Another hunting question is about performances. This is more difficult to test. To be sure I didn’t degrade the performances of my code, I need access performance related information of my code sometimes in the past. If you use a scm to manage your code like git, there are facilities to run this kind of tests (that of course need some heavy scripting abilities if you want to check all your functions) . Otherwise you are a bit left to your own destiny…

Starting from the Benchmark module, I cooked up a companion module ExtBenchmark to take care of time regression testing for you.

This is the .mli file that I hope somehow readable…

(* a time-stamped collection of samples *)
type benchmark

(* create a time-stamped collection of samples *)
val make_benchmark : Benchmark.samples -> benchmark

(** parse a string representing a value of type Benchmark.t
    Benchmark.to_string ~fdigits:6 (Benchmark.make (Int64.of_int 4))
    46.194004 WALL (45.626852 usr + 0.144009 sys = 45.770861 CPU) @ 0.087392/s (n=4)
 *)
val parse_test : string -> Benchmark.t

(** parse a string representing a sample of the form :
    func_name : 46.194004 WALL (45.626852 usr + 0.144009 sys = 45.770861 CPU) @ 0.087392/s (n=4)
  *)
val parse_sample : string -> string * Benchmark.t list

(** parse a benchmark file of the form :
Ex. :
date 1283531842
fname1 : 43.240758 WALL (43.222701 usr + 0.012001 sys = 43.234702 CPU) @ 0.092518/s (n=4)
fname2 : 46.194004 WALL (45.626852 usr + 0.144009 sys = 45.770861 CPU) @ 0.087392/s (n=4)
fname3 : 43.600401 WALL (43.358710 usr + 0.028002 sys = 43.386712 CPU) @ 0.092194/s (n=4)
 *)
val parse_benchmark : string -> benchmark

(** save a benchmark *)
val save_benchmark : ?dirname:string -> benchmark -> unit

(** parse all benchmarks in the benchmark's directory (.benchmark by default) *) 
val parse_benchmarks : ?days:int -> ?dirname:string -> unit -> benchmark list

(** pretty print a [Benchmark.sample] *)
val pp_benchmark : Format.formatter -> benchmark -> unit

(** pretty print a table *)
val pp_benchmarks : Format.formatter -> benchmark list -> unit

The idea of the module is pretty easy. Every time I change my code, I run my battery of tests and save them in a file on disk with the timestamp, the id of the machine and the results. Next time, these tests will be used to compare the new tests and the old ones, to check if out modifications had an impact on some part of the code. I give a small example below borrowing a bit of code from the examples of the benchmark module.

First we declare three functions that we are going to test. Then we run the tests in the function run() and in the main function we actually use the module ExtBenchmark. We execute all benchmarks and we obtain a test sample, then we save the sample on disk in a time stamped file. In the second part, we load all samples, and we print a comparison table. The printing function takes care of showing if the running time of a function increased w.r.t. the lowest running time of the same function and it is also able to print samples that contain different functions, making it easy to add tests along the way.

let rec_loop (a : float array) =
  let rec loop i =
    if i < Array.length a then begin
      a.(i) <- a.(i) +. 1.;
      loop (i + 1)
    end in
  loop 0

let rec_loop2 (a : float array) =
  let len = Array.length a in
  let rec loop i =
    if i < len then begin
      a.(i) <- a.(i) +. 1.;
      loop (i + 1)
    end in
  loop 0

let for_loop (a : float array) =
  for i = 0 to Array.length a - 1 do
    a.(i) <- a.(i) +. 1.
  done

let run () =
  let a = Array.make 10000000 1. in
  Benchmark.latencyN (Int64.of_int 100) [
    ("rec_loop",rec_loop,a);
    ("rec_loop2",rec_loop2,a);
    ("for_loop",for_loop,a)
  ]
;;

let main () =
  (* execute all benchmarcks *)
  let b = ExtBenchmark.make_benchmark (run ()) in
  (* save a timestamped representation of the current run on disk *)
  ExtBenchmark.save_benchmark b;
  (* read all benchmarks file from disk *)
  let l = ExtBenchmark.parse_benchmarks () in
  (* display a table with the current result *)
  Format.printf "%a@." ExtBenchmark.pp_benchmarks l
;;

main ();;

Notice that I run the program twice in order to generate two trace. The results by default are save in the .benchmarks directory and are in a simple textual format. To make it a bit more reliable I’ll also add a machine id in the future, so to avoid mixing benchmarks that were run on different hosts. Moreover time regressions of more then 0.001 seconds are marked with an asterisk in the table so to pinpoint possible problems. I’m aware that these results must be taken with a grain of salt. A function must be run with many repetitions to avoid false positive. I think anyway this is a good starting point to enhance the benchmark module.

$./loops.native 
Latencies for 100 iterations of "rec_loop", "rec_loop2", "for_loop":
 rec_loop:  6.62 WALL ( 6.51 usr +  0.02 sys =  6.53 CPU) @ 15.31/s (n=100)
rec_loop2:  5.99 WALL ( 5.93 usr +  0.01 sys =  5.94 CPU) @ 16.83/s (n=100)
 for_loop:  5.44 WALL ( 5.42 usr +  0.00 sys =  5.42 CPU) @ 18.44/s (n=100)

Date            for_loop rec_loop rec_loop2 
06/9/2010-10:27 0.054    0.065    0.059

$./loops.native 
Latencies for 100 iterations of "rec_loop", "rec_loop2", "for_loop":
 rec_loop:  6.29 WALL ( 6.21 usr +  0.00 sys =  6.22 CPU) @ 16.09/s (n=100)
rec_loop2:  5.90 WALL ( 5.78 usr +  0.01 sys =  5.79 CPU) @ 17.28/s (n=100)
 for_loop:  5.40 WALL ( 5.33 usr +  0.00 sys =  5.33 CPU) @ 18.77/s (n=100)

Date            for_loop rec_loop rec_loop2 
06/9/2010-10:28 0.053    0.062    0.058
06/9/2010-10:27 0.054    0.065    0.059

The code is available as part of the dose3 framework I’m writing for the mancoosi project. You can download it here. If of interest I’ll might ask to merge it with the benchmark project. At the moment the module does not have dependencies to the rest of the code. Enjoy !

When developing ocaml applications I often need to load a bunch of libraries in my toplevel to test a small function. This can be a tedious task when you have a complex project and a lot of libraries installed in your system. In the ocaml doco, kind of buried in the middle of a section there is the solution to this problem : .ocamlinit .

On start-up (before the first phrase is read), if the file .ocamlinit exists in the current directory, its contents are read as a sequence of Objective Caml phrases and executed as per the #use directive described in section 9.2. The evaluation outcode for each phrase are not displayed. If the current directory does not contain an .ocamlinit file, but the user’s home directory (environment variable HOME) does, the latter is read and executed as described below.

so for example if you often use ocamlfind-aware libraries and extlib in particular (I know, batteries… I know…) you can simple put these two lines in the .ocamlinit in your home directory.

#use "topfind";;
#require "extlib";;

and next time you fire the toplevel :

        Objective Caml version 3.11.2

Findlib has been successfully loaded. Additional directives:
  #require "package";;      to load a package
  #list;;                   to list the available packages
  #camlp4o;;                to load camlp4 (standard syntax)
  #camlp4r;;                to load camlp4 (revised syntax)
  #predicates "p,q,...";;   to set these predicates
  Topfind.reset();;         to force that packages will be reloaded
  #thread;;                 to enable threads

/usr/lib/ocaml/extlib: added to search path
/usr/lib/ocaml/extlib/extLib.cma: loaded
# 

As the documentation says you can have an .ocamlinit file in the directory of your project to load specific libraries.

Honestly ocaml format module is a royal PITA to use. The only documentation apart the reference manual is this document here. Don’t get me wrong. I think it’s a very nice piece of software and absolutely worth having it in the stdlib, but it simply not intuitive (at least for me) to use at the first glance. I’ll write down a couple of example. hopefully this will help me - and others - the next time I’ll need to use it.

I’m going to use the Format.fprintf function quite a lot. This function uses similar formatting string to the more widely used Printf.fprintf. In the Format module page you can find all the details. Let’s start easy and print a string. We write a pretty printer function pp_cell that gets a formatter and an element. This is my favourite way of writing printing function as I can daisy chain together in a printf function call using the "%a" formatting string. If the formatter is Format.std_formatter the string will be printed on stdout.

let pp_cell fmt cell = Format.fprintf fmt "%s" cell

Next we examine a simple function to pretty printer a list of elements. The signature of this function is quite similar as before, but this time we also pass an optional separator and a pretty printer for the element of the string.

let rec pp_list ?(sep="") pp_element fmt = function
  |[h] -> Format.fprintf fmt "%a" pp_element h
  |h::t ->
      Format.fprintf fmt "%a%s@,%a"
      pp_element h sep (pp_list ~sep pp_element) t
  |[] -> ()

The function takes care of printing the separator after all elements but the last one.

Let’s start playing witht the boxes. The formatting boxes are the main reason why I use the format module and they are very handy if you want to pretty print nested structure easily.

If we use the std_formatter and the list pretty printer without formatting box, we obtain this output.

# let fmt = Format.std_formatter ;;
# (pp_list ~sep:"," pp_cell) fmt ["aa";"bb";"cc"];;
aa,bb,
cc- : unit =
# 

that is the same as :

# Format.fprintf fmt "%a" (pp_list ~sep:"," pp_cell) ["aa";"bb";"cc"];;
aa,bb,
cc- : unit = ()

To be frank, I don’t quite get yet why the formatter decide to add a new line after the last comma… but moving on. If I now use a formatting box, the result is different. To print the list one one line, I can use the hbox. If I want a vertical list, I can use the vbox. This gives respectively:

# Format.fprintf fmt "@[<h>%a@]@." (pp_list ~sep:"," pp_cell) ["aa";"bb";"cc"];;
aa,bb,cc
# Format.fprintf fmt "@[<v>%a@]@." (pp_list ~sep:"," pp_cell) ["aa";"bb";"cc"];;
aa,
bb,
cc

If we want to print a list with one character of indentation, this can be easily done as:

Format.fprintf fmt "@[<v 1>@,%a@]@." (pp_list ~sep:"," pp_cell) ["aa";"bb";"cc"];;
 aa,
 bb,
 cc

The idea is that by changing the type of formatting boxes, the soft break @, is interpreted differently by the formatter, once as newline, once as space. Moreover by adding an indentation, the formatter will take care of adding an offset to all strings printed within that box. And this is a winner when pretty printing nested structures.

Lets now delve a bit deeper and let’s try to format a table… I didn’t found any tutorial on the net about this, but bit and pieces of code buried into different projects… A table for me is a tuple composed by a header (a string array) and two-dimensional array string array. The point here is to format the table in a way where each element is displayed in a column in relation to the longest element in the table. First we need two support pretty printers, one for the header and the other one the each row in the table. In order to set the tabulation margins of the table, we need to find, for each column the longest string in the table. The result of this computation (the function is shown below in pp_table) is an array of integer widths. When we print the header of the table, we make sure to set the width of each column with the Format.pp_set_tab fmt function. The magic of the Format module will take care of the rest. The second function to print each row is pretty straightforward to understand.

let pp_header widths fmt header =
  let first_row = Array.map (fun x -> String.make (x + 1) ' ') widths in
  Array.iteri (fun j cell ->
    Format.pp_set_tab fmt ();
    for z=0 to (String.length header.(j)) - 1 do cell.[z] <- header.(j).[z] done;
    Format.fprintf fmt "%s" cell
  ) first_row

let pp_row pp_cell fmt row =
  Array.iteri (fun j cell ->
    Format.pp_print_tab fmt ();
    Format.fprintf fmt "%a" pp_cell cell
  ) row

The pretty printer for the table is pretty easy now. First we compute the width of the table, then we open the table box, we print the headers, we iterate on each row and we close the box. tadaaaa :)

let pp_tables pp_row fmt (header,table) =
  (* we build with the largest length of each column of the 
   * table and header *)
  let widths = Array.create (Array.length table.(0)) 0 in
  Array.iter (fun row ->
    Array.iteri (fun j cell ->
      widths.(j) <- max (String.length cell) widths.(j)
    ) row
  ) table;
  Array.iteri (fun j cell ->
    widths.(j) <- max (String.length cell) widths.(j)
  ) header;

  (* open the table box *)
  Format.pp_open_tbox fmt ();

  (* print the header *)
  Format.fprintf fmt "%a@\n" (pp_header widths) header;
  (* print the table *)
  Array.iter (pp_row fmt) table;

  (* close the box *)
  Format.pp_close_tbox fmt ();

for example this is what we get :

let a = Array.make_matrix 3 4 "aaaaaaaa" in
let h = Array.make 4 "dddiiiiiiiiiiiiiiiii" in
let fmt = Format.std_formatter in
Format.fprintf fmt "%a" (pp_tables (pp_row pp_cell)) (h,a);;
dddiiiiiiiiiiiiiiiii          dddiiiiiiiiiiiiiiiii          dddiiiiiiiiiiiiiiiii           dddiiiiiiiiiiiiiiiii 
aaaaaaaa             aaaaaaaa             aaaaaaaa             aaaaaaaa
aaaaaaaa             aaaaaaaa             aaaaaaaa             aaaaaaaa
aaaaaaaa             aaaaaaaa             aaaaaaaa             aaaaaaaa

Well … more or less. On the terminal you will notice that everything is well aligned. This is of course only to scratch the surface. There are still few things I don’t really understand, and many functions that I didn’t consider at all. Maybe I’ll write a second chapter one day.