Imperatively traverse binary trees in OCaml, print zigzag

in

OCaml tree examples tend to be defined with algebraic data types and tend to be functional examples. Here are two imperative tree traversals, a pre-order and in-order. I’m still trying to work out a nice post-order imperative solution in OCaml so if you have one then please tweet it at me: @edgararout

EDIT: I’ve added a zigzag function procedure as well. This question came up recently at an interview and I messed it up. The point is to print the tree in a zigzag pattern.

type 'a node = {mutable data: 'a;
                mutable left : 'a node option;
                mutable right: 'a node option; }

let new_node data = {data; left = None; right = None;}

let insert tree new_data =
  let module Wrapper = struct exception Stop_loop end in
  let iter = ref tree in
  try
    while true do
      if new_data < !iter.data
      then match !iter.left with
        | None ->
          !iter.left <- Some (new_node new_data);
          raise Wrapper.Stop_loop
        | Some left_tree -> iter := left_tree
      else if new_data > !iter.data
      then match !iter.right with
        | None ->
          !iter.right <- Some (new_node new_data);
          raise Wrapper.Stop_loop
        | Some right_tree -> iter := right_tree
    done
  with Wrapper.Stop_loop -> ()

let pre_order_traversal tree =
  let s = Stack.create () in
  Stack.push tree s;
  while not (Stack.is_empty s) do
    let iter_node = Stack.pop s in

    Printf.sprintf "%s " iter_node.data
    |> print_string;

    (match iter_node.right with
       None -> ()
     | Some right -> Stack.push right s);

    (match iter_node.left with
       None -> ()
     | Some left -> Stack.push left s)
  done

let in_order_traversal tree =
  let module W = struct exception Stop_loop end in
  let visited_stack = Stack.create () in
  let iter_node = ref (Some tree) in
  try while true do
      (* Inner loop, we keep trying to go left *)
      (try while true do
           match !iter_node with
           | None -> raise W.Stop_loop
           | Some left ->
             Stack.push left visited_stack;
             iter_node := left.left
         done;
       with W.Stop_loop -> ());

      (* If we have no more to process in the stack, then we're
         done *)
      if Stack.length visited_stack = 0
      then raise W.Stop_loop
      else
        (* Here we're forced to start moving rightward *)
        let temp = Stack.pop visited_stack in
        Printf.sprintf "%s " temp.data |> print_string;
        iter_node := temp.right
    done
  with W.Stop_loop -> ()

let print_spiral root =
  let (current, next) = Stack.(ref (create ()), ref (create ())) in
  let left_to_right = ref true in

  let swap a b = let (a_, b_) = !a, !b in a := b_; b := a_ in

  Stack.push root !current;

  while not (Stack.is_empty !current) do
    let r = Stack.top !current in
    Stack.pop !current |> ignore;
    Printf.sprintf "%s " r.data |> print_string;
    if !left_to_right then
      begin
        (match r.left with None -> () | Some l -> Stack.push l !next);
        (match r.right with None -> () | Some r -> Stack.push r !next)
      end
    else begin
      (match r.right with None -> () | Some r -> Stack.push r !next);
      (match r.left with None -> () | Some l -> Stack.push l !next)
    end;

    if Stack.length !current = 0
    then (left_to_right := not !left_to_right; swap current next)

  done

let () =
  let root = new_node "F" in

  ["B";"G";"A";"D";"I";"C";"E";"H"] |> List.iter (insert root);

  pre_order_traversal root;
  print_newline ();
  in_order_traversal root
  print_newline ();
  print_spiral root

Intermediate js_of_ocaml

in

This post is mainly aimed at intermediate level users of js_of_ocaml, the OCaml to JavaScript compiler and at improving the sad state of documentation for js_of_ocaml. (Plus I’m interviewing for jobs, hire me!, and wanted to use both OCaml, JavaScript while preparing for interviews)

OCaml typing of JavaScript (Uses PPX)

Say we want to express some algorithms in OCaml but using JavaScript as the runtime execution language/environment. Let’s start with our main data structure, a tree node.

function TreeNode(value) {
  this.value = value;
  this.left = this.right = null;
}

Our OCaml version will be:

class type ['data] tree_node = object
  method value : 'data Js.prop
  method left : 'data tree_node Js.t Js.prop
  method right : 'data tree_node Js.t Js.prop
end

Note that there is a small thing about typing the nullability of the left, right fields, I will return to this at the end of the blog post and it was done for convenience.

So explanations:

  1. We are creating a class type, this just describes the object, how we describe it is key.
  2. The 'data is a type variable and lets us use any kind of type for the value in this node.
  3. OCaml objects only expose methods to the outside world, so properties need Js.prop, this lets us read and write to this field. We can control it to be read only by instead using Js.readonly_prop or even write only with Js.writeonly_prop.
  4. Methods left, right are also properties. Read the signature from right to left, aka left is a JavaScript read or write property which has a JavaScript object typed as tree_node and parameterized with the 'data type variable. Aka tree_nodes of string or int or whatever the type of 'data is.

Now we need to provide a way to make this object.

let __hidden__ =
  Js.Unsafe.pure_js_expr "function TreeNode(value) {\
                          this.value = value; \
                          this.left = this.right = null;}"

This is the JavaScript we’ll be using, essentially. Do note that the field names match up, this is important. Now we provide a constructor function:

let node : ('data -> 'data tree_node Js.t) Js.constr = __hidden__

This node constructor says that its a special JavaScript constructor that will invoke __hidden__ with new and such that it expects one argument. An example is:

let root = new%js node "Hello"

We can also make specialized constructors,

let node_from_int : (int -> int tree_node Js.t) Js.constr = __hidden__

and a simple usage:

let () =
  let root = new%js node "Hello" in
  root##.left := new%js node "Left side";
  root##.left##.left := new%js node "Grand Kid";

  (* Note that this just prints the raw object representation of the
  field value *)
  Firebug.console##log root##.left##.left##.value;

  (* This shows the value as expected *)
  print_endline root##.left##.left##.value

You can compile and run it on node with: (Assuming file name is trees_in_js.ml)

$ ocamlfind ocamlc -package js_of_ocaml.ppx -linkpkg trees_in_js.ml
$ js_of_ocaml a.out -o T.js
$ node T.js

And you should get something like the following printed out:

h { t: 0, c: 'Grand Kid', l: 9 }
Grand Kid

Depth First Search, Level order traversal complete examples

Now here’s an example of a preorder depth first search and level order traversal.

class type ['data] tree_node = object
  method value : 'data Js.prop
  method left : 'data tree_node Js.t Js.prop
  method right : 'data tree_node Js.t Js.prop
end

let node : ('data -> 'data tree_node Js.t) Js.constr = __hidden__

let depth_first_search starting_node =
  let stack = Stack.create () in
  Stack.push starting_node stack;
  while not (Stack.is_empty stack) do
    let iter_node = Stack.pop stack in

    Printf.sprintf "%s " iter_node##.value
    |> print_string;

    if Js.Opt.return iter_node##.right |> Js.Opt.test
    then Stack.push iter_node##.right stack;

    if Js.Opt.return iter_node##.left |> Js.Opt.test
    then Stack.push iter_node##.left stack

  done

let level_order starting_node =
  let q = Queue.create () in
  Queue.add starting_node q;

  while not (Queue.is_empty q) do
    let pop = Queue.pop q in
    Printf.sprintf "%s " pop##.value
    |> print_string;

    if Js.Opt.(return pop##.left |> test)
    then Queue.push pop##.left q;

    if Js.Opt.(return pop##.right |> test)
    then Queue.push pop##.right q

  done

let () =
  let root = new%js node "F" in
  root##.left := new%js node "B";
  root##.right := new%js node "G";
  root##.right##.right := new%js node "I";
  root##.left##.left := new%js node "A";
  root##.left##.right := new%js node "D";
  root##.left##.right##.left := new%js node "C";
  root##.left##.right##.right := new%js node "E";
  root##.right##.right##.left := new%js node "H";

  depth_first_search root |> print_newline;
  level_order root |> print_newline

and compile it just like given earlier in the blog post. Shameless plug, you can also turn it into an executable with a feature I added to the js_of_ocaml compiler,

$ ocamlfind ocamlc -package js_of_ocaml.ppx -linkpkg trees_in_js.ml
$ js_of_ocaml --custom-header='#!/usr/bin/env node' a.out -o T.js
$ chmod +x T.js
$ /T.js

Yay, we used the resources of two programming languages standard libaries in one program!

Now we can return to why the typing of the class type matters. The fully correct typing of tree_node is:

class type ['data] tree_node = object
  method value : 'data Js.prop
  method left : 'data tree_node Js.t Js.Opt.t Js.prop
  method right : 'data tree_node Js.t Js.Opt.t Js.prop
end

Notice the addition of Js.Opt.t. Since the left, right are nullable, we should capture that in the OCaml API, this however does force us to use Js.Opt and so we’d have to do things like:

root##.left := new%js node "Left side" |> Js.Opt.return;

When trying to set the field, etc. But since we didn’t expose that nullability of the field in the type signature, the depth_first_search code needs to check if the field is indeed null, which would have been otherwise forced by the type system had we used Js.Opt, aka:

if Js.Opt.return iter_node##.right |> Js.Opt.test
then Stack.push iter_node##.right stack;

These are tradeoffs that you can make in your own usage.

I hope this makes it easier for you to use OCaml, JavaScript together.

Using system threads with Lwt

in

This blog post shows you how to use real system threads in OCaml by using Lwt, Lwt_preemptive.

!!Note!!

While this shows system threads being used, only one is will actually be running at any given point in time (Think this akin to Python’s single threadedness, still useful to use threads if bottleneck are IO)

Common complaint about multicore

A common complaint about OCaml is the lack of true parallelism, about the single threadedness of the runtime. This is true but its not like OCaml programmers don’t have solutions some solutions. Here’s an easy example that you can instantly use in your coding.

Setup

First we will need some way to verify that our system threads are actually working, we’ll use some math equation to purposefully cause CPU load. Here’s the Sieve Of Eratosthenes Algorithm that I copied from here.

open List

type integer = Int of int
let number_two = Int(2)
let number_zero = Int(0)
let is_less_than_two (Int n) = n < 2
let incr (Int n) = Int(n + 1)
let decr (Int n) = Int(n - 1)
let is_number_zero (Int n) = n = 0

let iota n =
  let rec loop curr counter =
    if is_less_than_two counter then []
    else curr::(loop (incr curr) (decr counter))
  in
  loop number_two n

let sieve lst =
  let rec choose_pivot = function
    | [] -> []
    | car::cdr when is_number_zero car ->
      car::(choose_pivot cdr)
    | car::cdr ->
      car::(choose_pivot (do_sieve car (decr car) cdr))

  and do_sieve step current lst =
    match lst with
    | [] -> []
    | car::cdr ->
      if is_number_zero current
      then number_zero::(do_sieve step (decr step) cdr)
      else car::(do_sieve step (decr current) cdr)
  in
  choose_pivot lst

let is_prime n =
  match rev (sieve (iota n)) with
    x::_ -> not (is_number_zero x)

Now our Lwt, Lwt_preemptive code:

open Lwt.Infix

let do_example port =
  let address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
  Lwt_io.establish_server address (fun (tcp_in, tcp_out) ->
      () |> Lwt_preemptive.detach (fun () ->
          while true do
            ignore (is_prime (Int port))
          done
        )
      |> Lwt.ignore_result
    )
  |> ignore |> Lwt.return

let () =
  let rec forever () = fst (Lwt.wait ()) >>= forever in
  Lwt_preemptive.init 5 10 ignore;
  ([2000; 2001; 2002; 2003; 2004]
   |> Lwt_list.iter_p do_example >>= forever)
  |> Lwt_main.run

The code that runs inside the callback to Lwt_io.establish_server uses Lwt_preemptive.detach, this creates a new system thread whenever there is something that connects on ports [2000; 2001; 2002; 2003; 2004]. You don’t have to call Lwt_preemptive.init since detach will do it anyway, but I am doing it to ensure that at least 5 threads are made with 10 being the max.

We compile it with:

$ ocamlfind ocamlopt -thread -package lwt.unix,lwt.preemptive test_case.ml -linkpkg -o TEST_CASE

And we test it by starting up ./TEST_CASE, opening htop and finding TEST_CASE (hit t in htop to see a tree based process view) and running socat STDIN TCP:localhost:<some_port>, where <some_port> is a number in our list of ports (remember [2000; 2001; 2002; 2003; 2004]).

Thus we see in htop the CPU % utilization move for each of the threads of TEST_CASE.

Success! Real system threads.

Simple timeout usage

in

I wanted to use a timeout in OCaml for some shell coding but I didn’t want to introduce a big dependency on Lwt. After some googling I found this

Here’s my take on the timeout function, basically its the same but I push everything into the timeout function itself and use labeled args along a callback for when the timeout goes off.

let timeout ?(on_timeout = fun () -> ()) ~arg ~timeout ~default_value f =
  let module Wrapper = struct exception Timeout end in
  let sigalrm_handler = Sys.Signal_handle (fun _ -> raise Wrapper.Timeout) in
  let old_behavior = Sys.signal Sys.sigalrm sigalrm_handler in
  let reset_sigalrm () = Sys.set_signal Sys.sigalrm old_behavior in
  ignore (Unix.alarm timeout);
  try
    let res = f arg in
    reset_sigalrm ();
    res
  with exc ->
    reset_sigalrm ();
    if exc = Wrapper.Timeout
    then (on_timeout (); default_value)
    else raise exc

and you can can use it like so:

Sys.command
|> timeout 
   ~arg:"sleep 3" 
   ~timeout:2 
   ~default_value:(-1) 
   ~on_timeout:(fun () -> print_endline "func timed out")

You might notice that your wrapped function only gets one arg, so how can we use this timeout wrapper on functions that take more than one argument? By currying and using a dummy arg of unit.

Example:

let () =
  let partialed first second third () = first + second + third in
  timeout ~arg:() ~timeout:4 ~default_value:(-1) (partialed 1 2 3)
  |> ignore

I’ve added this to my podge library found here, a collection of useful utility functions.

Building xen-arm-builder from source

in

I’m in Morocco for the first mirageos hackathon. One of the things I’ve done here is build xen-arm-builder from source and it was a big challenge. Here’s my general notes and pointers to help you get over this hump. I assume you know what mirageos/xen are.

Much MUCH thanks to Thomas Leonard and Mindy Preston for lending me a cubieboard2 and helping me with all the debugging, compiling issues; wouldn’t have been able to do it without them.

Machine Setup

I did this on Ubuntu 15 and was deploying to a cubieboard2.

Example Workflow

Assuming that you are connecting the cubieboard2 to your laptop over a serial connection then you can get a shell on the machine with

$ screen -h 10000 /dev/ttyUSB0 115200

Then say you are using mirage-skeleton, here’s an example flow.

$ git clone https://github.com/mirage/mirage-skeleton
$ cd mirage-skeleton
$ make configure MODE=xen
$ cd console
$ make
$ sudo xl create console.xe

Yay Unikernel on Cubieboard2!

Troublesome issues

I had many, many issues in building the code from source, here are some troubleshooting steps that might help you as well.

  1. Be sure to have fast internet because building from source including making a clone of the Linux source, ouch.
  2. OPAMVERBOSE=1 opam <anything> is incredibly useful.
  3. Ubuntu 15 will install a gcc-5.0 version of the cross-compiler, be sure to do make build CC=arm-linux-gnueabihf-gcc-4.8 instead of a plain make build.
  4. Be sure to not use the 4.02.0 compiler, the cubieboard2 is super slow and that OCaml compiler had a performance bug, use the 4.02.3 compiler instead.
  5. Check top to see some kind of xp binary, it eats the CPU and that really slows down compilation, best to kill them.
  6. Do make sure that the time on the machine is correct, otherwise you’ll have weird hanging by opam which will seem like its building but actually its just stuck on a timing issue, aka be sure to do: sudo ntpdate uk.pool.ntp.org before doing anything with mirage/opam/aptitude.
  7. If you get odd errors like:
Parsing config from console.xl
xc: error: panic: xc_dom_core.c:185: failed to open file: No such file or directory: Internal error
libxl: error: libxl_dom.c:377:libxl__build_pv: xc_dom_kernel_file failed: No such file or directory
libxl: error: libxl_create.c:1022:domcreate_rebuild_done: cannot
(re-)build domain: -3

Then check that the libraries are correctly set in /usr/lib, check with

$ sudo strace -e open xl create console.xl

and either cp or ln them correctly.

  1. I recommend just installing all the depopts of all the mirage projects, there are some bugs in mirage opam files that don’t install other needed packages.