Streaming learning OCaml

Question

I wrote a simple online logistic regression, calibrated using gradient descent to compare the speed of an OCaml implementation vs the same Python script, executed with Pypy. It turned out that the OCaml implementation was slightly faster than the one run with Pypy (by about 10%). Now I would like to optimize my code even further.

The assumption about the data is that the values of each rows are sparse (can be considered as factors), they are encoded as integers (collisions are allowed) and stored in a large array.

maths.ml

(** Various mathematical functions*)

(** Given a list of indices v  and a vector of weights *)
let dot_product indices weights =
    let rec aux indices weights acc = 
        match indices with
        | [] -> acc
        | h::tail -> aux tail weights (acc +. weights.(h)) in
    aux indices weights 0.

(** Evaluates {%latex: $s(x)=\frac{1}{1+\exp(-x)}$ %}*) 
let sigmoid x = 1. /. (1. +. exp(0. -. x))

(** Logarithmic loss, p (the first argument) is the predicted value, y (the second argument) is the actual value*)
let log_loss p y = match y with 1. -> -. log(p) | _ -> -. log(1. -. p)

(** Evaluates {%latex: $a^b$ %} where {%latex: $a$ %} is the first argument, {%latex: $b$ %} the second argument*)
let rec pow a = function
  | 0 -> 1
  | 1 -> a
  | n -> 
    let b = pow a (n / 2) in
    b * b * (if n mod 2 == 0 then 1 else a) 

read_tools.ml

open Str

let csv_separator = ","

let err_lists_sizes = "Incompatible lists size"

(** Streams the lines of a channel.*)
let line_stream_of_channel channel =
    Stream.from (fun _ -> try Some (input_line channel) with End_of_file -> None)

(** Streams the lines of a file.*)  
let read_lines file_path = line_stream_of_channel (open_in file_path)

(** Reads the first line of a file.*)
let read_first_line file_path = Stream.next (read_lines file_path)

(** Splits a line according the separator.*)    
let split_line line = Str.split (Str.regexp csv_separator) line

(** Given two lists, returns a hashtable whose keys are the elements of the first list and the values are the elements of the second list. *)
let to_dict list1 list2 =
    let rec aux list1 list2 my_hash = match list1,list2 with
    | [],[] -> my_hash
    | a,[] -> failwith err_lists_sizes
    | [],a -> failwith err_lists_sizes
    | h1::t1,h2::t2 -> Hashtbl.add my_hash h1 h2; aux t1 t2 my_hash in aux list1 list2 (Hashtbl.create 15)

(** Given a file path to a csv file, reads it as a stream of hashtable whose keys are the header of the file *)
let dict_reader file_path = 
    let line_stream = read_lines file_path in
    let header = split_line (Stream.next line_stream) in
    Stream.from
      (fun _ ->
         try Some (to_dict header (split_line (Stream.next line_stream))) with End_of_file -> None)

train.ml

(** Implements the usual framework for streaming learning *)

(** Predict the target and update the model for every line of the stream, engineered by the feature_engine *)
let train dict_stream feature_engine updater predict loss_function refresh_loss target_name = 
    let rec aux updater dict_stream t loss = match (try Some(Stream.next dict_stream) with _ -> None) with
    | Some dict ->  
               let y = float_of_string (Hashtbl.find dict target_name) in
                       Hashtbl.remove dict target_name;
               let indices = feature_engine dict in
               let p = predict indices in
               updater indices p y;

               if ((t mod refresh_loss) == 0) && t > 0 then begin 
                Printf.printf "[TRA] Execution time: %fs \t encountered %n \t loss : %f" (Sys.time()) t (loss /. float_of_int(t));
                    print_endline " "; 
               end;

               aux updater dict_stream (t + 1) (loss +. (loss_function p y))

    | None -> () in aux updater dict_stream 0 0. ;;

log_reg.ml

open Maths
open Read_tools
open Train

(* data *)

let train_dict_stream = dict_reader "train_small.csv" 

(* parameters *)    

(** Number of slots to store the features*)
let n = pow 2 20 

(** Vector of weights for the features *)
let weights = Array.make n 0. 

(** Print progress every refresh_loss lines *)
let refresh_loss = 1000000 

(** Parameter of the model *)
let alpha = 0.01

(* feature engineering *)

let _get_indices dict n = Hashtbl.fold (fun k v acc -> ((Hashtbl.hash k) lxor (Hashtbl.hash v) mod n)  :: acc) dict [] 

let feature_engineer dict =  _get_indices dict n 

(* logistic regression *)

let rec _update indices weights step =  match indices with
    | [] -> ()
    | h::tail -> weights.(h) <- (weights.(h) -. step) ; _update tail weights step 

let predict indices = sigmoid (dot_product indices weights) 

let update indices p y = _update indices weights ((p -. y) *. alpha) 

let () = train train_dict_stream feature_engineer update predict log_loss refresh_loss "click"

Answer 1

I would say that 10% gain over pypy means that code is suboptimal, I would expect the gain factor of 10 to 100. To get 100 you it would better to use BLAS or GSL bindings. They will basically deliver a performance of C and Fortran programs. But, I assume, that it is a toy project, with the main purpose to learn OCaml, and to understand its internals.

So let's start with math. The dot_product is fine, except the name. It is not the dot_product, so it might confuse the readers e.g., myself (and yourself, few months later). The log_loss would be readable if you will use if/else instead of match. The pow function is not need, surprisingly OCaml already has one - pow x y = x**y

In read_tools it looks like that a more straightforward code without a stream, would be more readable (and efficient). Just write a recursive function, that will read a line and populate the hashtable. There is no need for intermediate data structures.

In train.ml, you have to many parameters to the train function. If you indeed need so much, the it is better to gather them into a record. But usually, such amount of parameters indicate improper choice of abstractions. Maybe you should split your functions differently. The inner aux function has parameters that are loop invariant (updater and dict_stream). It is better to transfer strings to numbers, when you're populating the hashtable, instead of doing this every time you found an element. First of all it is a better style, as you enforce the invariants as soon as possible (usually you should try to catch errors as soon as possible). Second, it is more efficient, if you will hit the same value more than once.

Final note, you're using recursive function to often in places where you can use iter and fold_left function. For example,

let rec _update indices weights step =  match indices with
    | [] -> ()
    | h::tail -> weights.(h) <- (weights.(h) -. step) ; _update tail weights step 

Can be written as

 let _update idxs ws step = 
   List.iter (fun idx -> ws.(idx) <- ws.(idx) -. step) idxs