Tree rotation using mutable refs

Hello,
I started coding this hoping that the imperative approach will not be too hard to implement. But it doesn’t seem so. I have come across other functional approaches but before abandoning this I want to ask the forum.

Will this approach work ? The code compiles and executes but the references may not be correct as it is not complete.
Are there full-fledged examples of tree rotations using mutable refs somewhere ?

Thanks,
Mohan

type 'a splay_tree = Leaf | Node of 'a node1
and 'a node1 = { key : 'a;value : 'a; mutable left : 'a splay_tree option; mutable right : 'a splay_tree option; }
type 'a t = 'a splay_tree option ref

let splay i t =
  match !t with
  |Leaf ->  None
  | Node { key=_; left  ;value=_ ;  right} -> 
    match left, right with
    | Some Node _,Some Node {left=_; key=_; value=_; right=_}->None
    | Some Node {left; key; value=_; right},Some Leaf | Some Node {left; key; value=_; right}, _ -> 
      if i < key then (
        let y = left in
        let _l = right in
        let _right = t in
        let left = y in 
        left (* Return 'left' value *)
      ) else (
        let left = t in
        let _right = t in 
        let newT = left in
        Some !newT (* Returning 'left' value wrapped in 'Some' *)
      )
      | Some Leaf,Some Node _-> None 
      | Some Leaf,Some Leaf->  None
      | _ ,Some Leaf -> None
      | Some Leaf,None -> None
      |(None, Some (Node _))-> None
      |None, None ->None 

The approach you take here should work. Namely, the mutable approach is to have a top-level reference which holds the real tree structure and an auxiliary type (here splay_tree) which denotes the actual tree structure. A couple of remarks though:

  • It seems you are translating a C or Java implementation (or some equivalent pseudo-code) using None to represent the null pointer and Some ... for an actual value. I think you don’t need that here, you can just use Leaf to represent an empty tree (I don’t see a situation where you would want both Some Leaf and None).
  • you can use inline records instead of introducing node1:
type 'a splay_tree = Leaf 
          | Node of { key : 'a;value : 'a; mutable left : 'a splay_tree ; mutable right : 'a splay_tree ; }

which can make some of the matching a bit lighter.

  • Even though it works to use a reference to hold the tree structure, you could use a dedicated record type with other fields to store e.g. the height and size of your tree (this is orthogonal).

But regardless of whether you use your type or the simplified version I suggest, you should be able to port any existing Java/C code that for splay tree relatively easily to this mutable version.

2 Likes

Yes it would work just fine, but you need to use the syntax node.left <- ... to update the mutable fields rather than let. As an example, see how base implements rotations on AVL trees: https://github.com/janestreet/base/blob/master/src/avltree.ml#L120

Regarding your splay_tree type, I also think you could do without the option everywhere as you already have Leaf to represent an empty tree :slight_smile:

I recommend that you implement the purely functional version first, as it is simpler (and likely faster!) and can easily be translated to an imperative version as a second step.

1 Like

This is my imperative code and it doesn’t look pretty. Moreover it seems to be worse than the C code I was porting. Functional code is better. I think.
It compiles and works but it isn’t tested properly.
Based on earlier comments I can refactor this. Are there any comments ? Can I assume that this is not the way to write this code ?

let insert_with_key_value: int splay_tree option ref=
  ref (Some ( Node {
      key = 1;
      value = 2;
      left = Some (Node {key=3; value=1; left=Some (Leaf); right=Some (Leaf)});
      right = Some (Node {key=4; value=3; left=Some (Leaf); right=Some (Node {
          key = 2;
          value = 2;
          left = Some (Node {key=3; value=1; left=Some (Leaf); right=Some (Leaf)});
          right = Some (Node {key=4; value=3; left=Some (Leaf); right=Some (Leaf)})
        })})
    }))


let splay (i : int ) (t : int splay_tree option ref) =
  let n = { key = 0;value=0; left = None; right = None } in
  let l = ref n in
  let r = ref n in
  let get_key node = match node with
    | Some n -> n.key
    | None -> 0 in
  let  loop t =
    match !t with
    | None -> ()
    | Some node ->
      let y = ref None in
       match !node with 
        | { key = k; value=0;left = Some left_node; right = _ } as n when i < k ->
          let left_key = get_key (Some !node )in
          if i < left_key then (
            y := Some left_node;
            !node.left <- !y;
            begin match !y with
            | Some y_node ->
              begin match y_node with
              |Node r -> r.right <- !node.left;
              | Leaf -> ()
              end;
            | None -> ()
            end;
            node := !r
          ) else if i = k then node := !node
              else (
                begin match n.right with
                  | None -> ()
                  |  Some right ->
                    match right with
                    |Node r -> 
                      let right_key = get_key (Some r) in
                      if i > right_key then (
                        y := Some right;
                        !node.right <- !y;
                        begin match !y with
                        | None -> ()
                        | Some y_node ->
                              begin match y_node with
                                |Node _l -> r.left <- !node.left;
                                | Leaf -> ()
                              end;
                        end;
                        node := !l
                      )
                    | _-> ()
                end;
              )
        | _ -> ()
  in
  l := { key = 0; value = 0; left = None; right =  !t };
  r := !l;
  match !t with
  | None -> None
  | Some node ->
    match node with
        | Leaf -> None 
        | Node root ->
          loop (ref (Some (ref root)));
          match !t with
          | None -> None
          | Some node ->
            !l.right <- n.right;
            !r.left <-  n.left;
            match node with
            | Leaf -> None
            | Node localnode ->
              localnode.left <-  n.right;
              localnode.right <- n.left;
              Some node

As I suggested previously, regardless of whether it is imperative, you should just remove the option.
You can observe that everywhere you have this pattern:

match e with
  None ->    e1
| Some node -> begin match node with 
                              Leaf -> e1 (* the same as above *)
                           | Node ... -> ...
end

which indicate that wrapping in an option is useless. Some Leaf and Node serve the same purpose. If you remove this option, your code will already be much short (no nested matches with begin /end etc…).

Then of course, if you want to turn it into a purely functional version (no refs) then the code will be
even shorter since you won’t have the ref/mutable update.