Add experimental rose tree.

README.md

@@ -162,6 +162,8 @@ access to elements by their index.
 - `Univ`, a universal type encoding with affectation
 - `FlatHashtbl`, a (deprecated) open addressing hashtable with
     a functorial interface (replaced by PHashtbl)
+- `RoseTree`, a tree with an arbitrary number of children and its associated
+  zipper
 - `UnionFind`, a functorial imperative Union-Find structure
 
 ### Others

_oasis

@@ -114,7 +114,7 @@ Library "containers_misc"
   Path:             src/misc
   Pack:             true
   Modules:          AbsSet, Automaton, Bij, CSM, LazyGraph, PHashtbl,
-                    PrintBox, RAL, SmallSet, UnionFind, Univ
+                    PrintBox, RAL, RoseTree, SmallSet, UnionFind, Univ
   BuildDepends:     containers, containers.data
   FindlibName:      misc
   FindlibParent:    containers

doc/intro.txt

@@ -124,6 +124,7 @@ LazyGraph
 PHashtbl
 PrintBox
 RAL
+RoseTree
 SmallSet
 SplayMap
 SplayTree

src/misc/roseTree.ml

@@ -0,0 +1,168 @@
+type +'a t = [`Node of 'a * 'a t list]
+
+type 'a tree = 'a t
+
+let rec fold ~f init_acc (`Node (value, children)) =
+  let acc = f value init_acc in
+  List.fold_left (fun acc' child_node -> fold ~f acc' child_node) acc children
+
+let split_at_length_minus_1 l =
+  let rev_list = List.rev l in
+  match rev_list with
+  | []          -> (l, None)
+  | [item]      -> ([], Some item)
+  | item::items -> (List.rev items, Some item)
+
+let print formatter string_of_value tree =
+  let rec print_children children indent_string =
+    let non_last_children, maybe_last_child =
+      split_at_length_minus_1 children
+    in
+    print_non_last_children non_last_children indent_string;
+    match maybe_last_child with
+    | Some last_child -> print_last_child last_child indent_string;
+    | None            -> ();
+  and print_non_last_children non_last_children indent_string =
+    List.iter (fun (`Node (child_value, grandchildren)) ->
+        Format.pp_print_string formatter indent_string;
+        Format.pp_print_string formatter "|- ";
+        string_of_value child_value |> Format.pp_print_string formatter;
+        Format.pp_force_newline formatter ();
+        let indent_string' = indent_string ^ "|  " in
+        print_children grandchildren indent_string'
+      ) non_last_children;
+  and print_last_child (`Node (last_child_value, last_grandchildren)) indent_string =
+    Format.pp_print_string formatter indent_string;
+    Format.pp_print_string formatter "'- ";
+    string_of_value last_child_value |> Format.pp_print_string formatter;
+    Format.pp_force_newline formatter ();
+    let indent_string' = indent_string ^ "   " in
+    print_children last_grandchildren indent_string'
+  in
+  let print_root (`Node (root_value, root_children)) =
+    string_of_value root_value |> Format.pp_print_string formatter;
+    Format.pp_force_newline formatter ();
+    print_children root_children ""
+  in
+  print_root tree;
+  Format.pp_print_flush formatter ()
+
+module Zipper = struct
+
+  type 'a parent = { left_siblings: ('a tree) list; value: 'a; right_siblings: ('a tree) list }
+
+  type 'a t = { tree: 'a tree; lefts: ('a tree) list; rights: ('a tree) list; parents: ('a parent) list }
+
+  let zipper tree = { tree = tree ; lefts = []; rights = []; parents = [] }
+
+  let tree zipper = zipper.tree
+
+  let left_sibling zipper =
+    match zipper.lefts with
+    | []    -> None
+    | lefts ->
+      let rev_lefts = List.rev lefts in
+      Some {
+        tree = List.hd rev_lefts ;
+        lefts = List.tl rev_lefts |> List.rev ;
+        rights = zipper.tree::zipper.rights ;
+        parents = zipper.parents
+      }
+
+  let right_sibling zipper =
+    match zipper.rights with
+    | []                  -> None
+    | right::other_rights ->
+      Some {
+        tree = right ;
+        lefts = zipper.tree::zipper.lefts ;
+        rights = other_rights ;
+        parents = zipper.parents ;
+      }
+
+  let parent zipper =
+    match zipper.parents with
+    | []                    -> None
+    | { left_siblings ; value ; right_siblings }::other_parents ->
+      Some {
+        tree = `Node (value, zipper.lefts @ [zipper.tree] @ zipper.rights) ;
+        lefts = left_siblings ;
+        rights = right_siblings ;
+        parents = other_parents ;
+      }
+
+  let rec root zipper =
+    let maybe_parent_zipper = parent zipper in
+    match maybe_parent_zipper with
+    | None                -> zipper
+    | Some parent_zipper  -> root parent_zipper
+
+  let nth_child n ({ tree = `Node (value, children) ; _ } as zipper ) =
+    let lefts, maybe_child, rev_rights, counter = List.fold_left (
+        fun (lefts, maybe_child, rev_rights, counter) tree ->
+          let lefts', maybe_child', rev_rights' =
+            match counter with
+            | _ when counter == n -> (lefts, Some tree, [])
+            | _ when counter < n ->
+              (tree::lefts, None, [])
+            | _                   ->
+              (lefts, maybe_child, tree::rev_rights)
+          in
+          (lefts', maybe_child', rev_rights', counter+1)
+      ) ([], None, [], 0) children
+    in
+    begin match maybe_child with
+      | Some child  ->
+        Some {
+          tree = child ;
+          lefts = List.rev lefts;
+          rights = List.rev rev_rights ;
+          parents = {
+            left_siblings = zipper.lefts ;
+            value = value ;
+            right_siblings = zipper.rights ;
+          }::zipper.parents ;
+        }
+      | None        -> None
+    end
+
+  let append_child tree ({ tree = `Node (value, children) ; _ } as zipper ) =
+    {
+      tree ;
+      lefts = children ;
+      rights = [] ;
+      parents = {
+        left_siblings = zipper.lefts ;
+        value = value ;
+        right_siblings = zipper.rights ;
+      }::zipper.parents ;
+    }
+
+  let insert_left_sibling tree zipper =
+    match zipper.parents with
+    | []  -> None
+    | _   -> Some { zipper with tree ; rights = zipper.tree::zipper.rights }
+
+  let insert_right_sibling tree zipper =
+    match zipper.parents with
+    | []  -> None
+    | _   -> Some { zipper with tree ; lefts = zipper.tree::zipper.lefts }
+
+  let replace tree zipper =
+    { zipper with tree }
+
+  let delete ({ tree = `Node (value, children) ; _ } as zipper ) =
+    match zipper with
+    | { lefts = first_left::other_lefts ; _  }     ->
+      Some { zipper with tree = first_left ; lefts = other_lefts }
+    | { rights = first_right::other_rights ; _ }  ->
+      Some { zipper with tree = first_right ; rights = other_rights }
+    | { parents = { left_siblings ; value ; right_siblings }::other_parents ; _ } ->
+      Some {
+        tree = `Node (value, zipper.lefts @ zipper.rights) ;
+        lefts = left_siblings ;
+        rights = right_siblings ;
+        parents = other_parents ;
+      }
+    | _ -> None
+end

src/misc/roseTree.mli

@@ -0,0 +1,115 @@
+(**
+   {1 Rose Tree}
+
+   A persistent, non-lazy tree where each node may have an arbitrary number of
+   children.
+*)
+
+(**
+   The type of a tree node - a (value, children) pair.
+*)
+type +'a t = [`Node of 'a * 'a t list]
+
+type 'a tree = 'a t
+
+(**
+   Folds over the tree. Takes a function [f node accumulator], an initial value
+   for the accumulator, and the tree to operate on.
+*)
+val fold : f : ('a -> 'b -> 'b) -> 'b ->  'a t -> 'b
+
+(**
+   Tree pretty-printer. Takes a [Formatter], a function turning a node into a
+   string, and the tree itself as parameters. Appends the result to the
+   formatter.
+*)
+val print : Format.formatter -> ('a -> string) -> 'a t -> unit
+
+module Zipper : sig
+
+  (**
+     {2 Zipper}
+
+     A zipper to navigate and return modified versions of the tree.
+  *)
+  type 'a t
+
+  (**
+     Builds a zipper from a tree.
+  *)
+  val zipper : 'a tree -> 'a t
+
+  (**
+     Returns the tree associated to the zipper.
+  *)
+  val tree : 'a t -> 'a tree
+
+  (**
+     Moves to the left of the currently focused node, if possible. Returns [Some
+     new_zipper], or [None] if the focused node had no left sibling.
+  *)
+  val left_sibling : 'a t -> ('a t) option
+
+  (**
+     Moves to the right of the currently focused node, if possible. Returns [Some
+     new_zipper], or [None] if the focused node had no right sibling.
+  *)
+  val right_sibling : 'a t -> ('a t) option
+
+  (**
+     Moves one level up of the currently focused node, if possible. Returns
+     [Some new_zipper], or [None] if the focused node was the root.
+  *)
+  val parent : 'a t -> ('a t) option
+
+  (**
+     Moves to the root of the tree.
+  *)
+  val root : 'a t -> 'a t
+
+  (**
+     Moves to the nth child of the current node. Accepts the child number,
+     starting from zero. Returns [Some new_zipper], or [None] if there was no
+     such child.
+  *)
+  val nth_child : int -> 'a t -> ('a t) option
+
+  (**
+     Inserts a new node as the leftmost child of the currently focused node.
+     Returns a new zipper, focused on the newly inserted node.
+  *)
+  val append_child : 'a tree -> 'a t -> 'a t
+
+  (**
+     Inserts a new node to the left of the currently focused node.
+     Returns [Some new_zipper], focused on the newly inserted node, if the
+     focused node is not the root. If the currently focused node is the root,
+     returns [None].
+  *)
+  val insert_left_sibling : 'a tree -> 'a t -> ('a t) option
+
+  (**
+     Inserts a new node to the right of the currently focused node.
+     Returns [Some new_zipper], focused on the newly inserted node, if the
+     focused node is not the root. If the currently focused node is the root,
+     returns [None].
+  *)
+  val insert_right_sibling : 'a tree -> 'a t -> ('a t) option
+
+  (**
+     Replaces the currently focused node with a new node.
+     Returns a new zipper, focused on the new node.
+  *)
+  val replace : 'a tree -> 'a t -> 'a t
+
+  (**
+     Deletes the currently focused node.
+     If the currently focused node is the root, returns [None].
+     Otherwise, returns a [Some new_zipper]. It is focused on the left sibling
+     of the deleted node. If there is no left sibling available, the zipper is
+     focused on the right sibling. If there are no siblings, the zipper is
+     focused on the parent of the focused node.
+  *)
+  val delete : 'a t -> ('a t) option
+
+end

tests/run_tests.ml

@@ -12,6 +12,7 @@ let suite =
       Test_fQueue.suite;
       Test_univ.suite;
       Test_mixtbl.suite;
+      Test_RoseTree.suite;
     ]
 
 let props =

tests/test_RoseTree.ml

@@ -0,0 +1,600 @@
+open Containers_misc
+open OUnit
+
+let format_node value = Printf.sprintf "%d" value
+
+let string_of_tree tree =
+  let buffer = Buffer.create 1024 in
+  let formatter = Format.formatter_of_buffer buffer in
+  RoseTree.print formatter format_node tree;
+  Buffer.contents buffer
+
+let assert_equal_tree expected_tree_rep tree =
+  let expected_tree_rep_string =
+    (String.concat "\n" expected_tree_rep) ^ "\n"
+  in
+  let tree_as_string = string_of_tree tree in
+  assert_equal ~printer:(fun x -> x) expected_tree_rep_string tree_as_string
+
+let assert_equal_zipper expected_tree_rep zipper =
+  assert_equal_tree expected_tree_rep (RoseTree.Zipper.tree zipper)
+
+let single_node_tree = `Node (10, [])
+
+let single_tree_strings = ["10"]
+
+let normal_tree =
+  `Node (0, [
+      `Node (1, [
+          `Node (10, []) ;
+        ]) ;
+      `Node (2, [
+          `Node (20, []) ;
+          `Node (21, []) ;
+        ]) ;
+      `Node (3, [
+          `Node (30, []) ;
+          `Node (31, []) ;
+          `Node (32, []) ;
+        ]) ;
+    ])
+
+let normal_tree_strings = [
+  "0" ;
+  "|- 1" ;
+  "|  '- 10" ;
+  "|- 2" ;
+  "|  |- 20" ;
+  "|  '- 21" ;
+  "'- 3" ;
+  "   |- 30" ;
+  "   |- 31" ;
+  "   '- 32" ;
+]
+
+let new_tree =
+  `Node (100, [
+      `Node (1000, [
+          `Node (10000, []) ;
+        ]) ;
+      `Node (1001, [
+          `Node (10010, []) ;
+          `Node (10012, []) ;
+        ]) ;
+    ])
+
+let new_tree_strings = [
+  "100" ;
+  "|- 1000" ;
+  "|  '- 10000" ;
+  "'- 1001" ;
+  "   |- 10010" ; 
+  "   '- 10012" ; 
+]
+
+let test_print_single_node_tree () =
+  let expected = single_tree_strings in
+  assert_equal_tree expected single_node_tree
+
+let test_print_normal_tree () =
+  let expected = normal_tree_strings in
+  assert_equal_tree expected normal_tree
+
+let test_fold_single_node_tree () = 
+  let tree_double_sum = RoseTree.fold ~f:(fun value acc -> acc + value * 2) 0 single_node_tree
+  in
+  assert_equal 20 tree_double_sum
+
+let test_fold_normal_tree () = 
+  let tree_sum = RoseTree.fold ~f:(fun value acc -> acc + value) 0 normal_tree
+  in
+  assert_equal 150 tree_sum
+
+let test_base_zipper_single_node_tree () =
+  let expected = single_tree_strings in
+  assert_equal_zipper expected (RoseTree.Zipper.zipper single_node_tree)
+
+let test_base_zipper_normal_tree () =
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected (RoseTree.Zipper.zipper normal_tree)
+
+let test_zipper_nth_child_0 () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 0
+               |> CCOpt.get_exn
+  in
+  let expected = [
+    "1" ;
+    "'- 10" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_nth_child_1 () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 1
+               |> CCOpt.get_exn
+  in
+  let expected = [
+    "2" ;
+    "|- 20" ;
+    "'- 21" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_nth_child_2 () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 2
+               |> CCOpt.get_exn
+  in
+  let expected = [
+    "3" ;
+    "|- 30" ;
+    "|- 31" ;
+    "'- 32" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_nth_child_does_not_exist () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.nth_child 3
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_zipper_nth_child_negative_index () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.nth_child (-2)
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_zipper_nth_child_plus_parent_is_noop () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 2
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.parent
+               |> CCOpt.get_exn
+  in
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_zipper_left_sibling () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 2
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.left_sibling
+               |> CCOpt.get_exn
+  in
+  let expected = [
+    "2" ;
+    "|- 20" ;
+    "'- 21" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_left_sibling_twice () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 2
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.left_sibling
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.left_sibling
+               |> CCOpt.get_exn
+  in
+  let expected = [
+  "1" ;
+  "'- 10" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_left_sibling_does_not_exist () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.nth_child 2
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.left_sibling
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.left_sibling
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.left_sibling
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_zipper_nth_child_plus_left_sibling_plus_parent_is_noop () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 2
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.left_sibling
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.parent
+               |> CCOpt.get_exn
+  in
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_zipper_right_sibling () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 0
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.right_sibling
+               |> CCOpt.get_exn
+  in
+  let expected = [
+    "2" ;
+    "|- 20" ;
+    "'- 21" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_right_sibling_twice () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 0
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.right_sibling
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.right_sibling
+               |> CCOpt.get_exn
+  in
+  let expected = [
+  "3" ;
+  "|- 30" ;
+  "|- 31" ;
+  "'- 32" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_zipper_right_sibling_does_not_exist () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.nth_child 0
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.right_sibling
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.right_sibling
+                     |> CCOpt.get_exn
+                     |> RoseTree.Zipper.right_sibling
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_zipper_nth_child_plus_right_sibling_plus_parent_is_noop () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+               |> RoseTree.Zipper.nth_child 0
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.right_sibling
+               |> CCOpt.get_exn
+               |> RoseTree.Zipper.parent
+               |> CCOpt.get_exn
+  in
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_parent () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.parent
+             |> CCOpt.get_exn
+  in
+  let expected = [
+    "1" ;
+    "'- 10" ;
+  ] in
+  assert_equal_zipper expected zipper
+
+let test_parent_on_root () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.parent
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_root () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.root
+  in
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_root_on_root () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.root
+  in
+  let expected = normal_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_insert_left_sibling () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.insert_left_sibling new_tree
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.root
+  in
+  let expected = [
+    "0" ;
+    "|- 1" ;
+    "|  |- 100" ;
+    "|  |  |- 1000" ;
+    "|  |  |  '- 10000" ;
+    "|  |  '- 1001" ;
+    "|  |     |- 10010" ; 
+    "|  |     '- 10012" ; 
+    "|  '- 10" ;
+    "|- 2" ;
+    "|  |- 20" ;
+    "|  '- 21" ;
+    "'- 3" ;
+    "   |- 30" ;
+    "   |- 31" ;
+    "   '- 32" ;
+  ] in
+  assert_equal_zipper expected zipper
+
+let test_insert_left_sibling_focuses_on_new_tree () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.insert_left_sibling new_tree
+             |> CCOpt.get_exn
+  in
+  let expected = new_tree_strings
+  in
+  assert_equal_zipper expected zipper
+
+let test_insert_left_sibling_on_root () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.insert_left_sibling new_tree
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_insert_right_sibling () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.insert_right_sibling new_tree
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.root
+  in
+  let expected = [
+    "0" ;
+    "|- 1" ;
+    "|  |- 10" ;
+    "|  '- 100" ;
+    "|     |- 1000" ;
+    "|     |  '- 10000" ;
+    "|     '- 1001" ;
+    "|        |- 10010" ; 
+    "|        '- 10012" ; 
+    "|- 2" ;
+    "|  |- 20" ;
+    "|  '- 21" ;
+    "'- 3" ;
+    "   |- 30" ;
+    "   |- 31" ;
+    "   '- 32" ;
+  ] in
+  assert_equal_zipper expected zipper
+
+let test_insert_right_sibling_focuses_on_new_tree () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.insert_right_sibling new_tree
+             |> CCOpt.get_exn
+  in
+  let expected = new_tree_strings
+  in
+  assert_equal_zipper expected zipper
+
+let test_insert_right_sibling_on_root () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.insert_right_sibling new_tree
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let test_append_child () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 2
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.append_child new_tree
+             |> RoseTree.Zipper.root
+  in
+  let expected = [
+    "0" ;
+    "|- 1" ;
+    "|  '- 10" ;
+    "|- 2" ;
+    "|  |- 20" ;
+    "|  '- 21" ;
+    "'- 3" ;
+    "   |- 30" ;
+    "   |- 31" ;
+    "   |- 32" ;
+    "   '- 100" ;
+    "      |- 1000" ;
+    "      |  '- 10000" ;
+    "      '- 1001" ;
+    "         |- 10010" ; 
+    "         '- 10012" ; 
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_append_child_focuses_on_new_tree () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 2
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.append_child new_tree
+  in
+  let expected = new_tree_strings
+  in
+  assert_equal_zipper expected zipper
+
+let test_replace () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 1
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.replace new_tree
+             |> RoseTree.Zipper.root
+  in
+  let expected = [
+  "0" ;
+  "|- 1" ;
+  "|  '- 10" ;
+  "|- 100" ;
+  "|  |- 1000" ;
+  "|  |  '- 10000" ;
+  "|  '- 1001" ;
+  "|     |- 10010" ; 
+  "|     '- 10012" ; 
+  "'- 3" ;
+  "   |- 30" ;
+  "   |- 31" ;
+  "   '- 32" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_replace_focuses_on_new_tree () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 1
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.replace new_tree
+  in
+  let expected = new_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_replace_root () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.replace new_tree
+  in
+  let expected = new_tree_strings in
+  assert_equal_zipper expected zipper
+
+let test_delete () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 1
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.delete
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.root
+  in
+  let expected = [
+  "0" ;
+  "|- 1" ;
+  "|  '- 10" ;
+  "'- 3" ;
+  "   |- 30" ;
+  "   |- 31" ;
+  "   '- 32" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_delete_focuses_on_leftmost_sibling_if_possible () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 1
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.delete
+             |> CCOpt.get_exn
+  in
+  let expected = [
+  "1" ;
+  "'- 10" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_delete_focuses_on_rightmost_sibling_if_no_left_sibling () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.delete
+             |> CCOpt.get_exn
+  in
+  let expected = [
+  "2" ;
+  "|- 20" ;
+  "'- 21" ;
+  ]
+  in
+  assert_equal_zipper expected zipper
+
+let test_delete_focuses_on_parent_if_no_more_siblings () =
+  let zipper = RoseTree.Zipper.zipper normal_tree
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.nth_child 0
+             |> CCOpt.get_exn
+             |> RoseTree.Zipper.delete
+             |> CCOpt.get_exn
+  in
+  let expected = ["1"] in
+  assert_equal_zipper expected zipper
+
+let test_delete_root () =
+  let maybe_zipper = RoseTree.Zipper.zipper normal_tree
+                     |> RoseTree.Zipper.delete
+  in
+  assert_equal false (CCOpt.is_some maybe_zipper)
+
+let suite =
+  "test_RoseTree" >:::
+  [
+    "test_print_single_node_tree" >:: test_print_single_node_tree ;
+    "test_print_normal_tree" >:: test_print_normal_tree ;
+    "test_fold_single_node_tree" >:: test_fold_single_node_tree ;
+    "test_fold_normal_tree" >:: test_fold_normal_tree ;
+    "test_base_zipper_single_node_tree" >:: test_base_zipper_single_node_tree ;
+    "test_base_zipper_normal_tree" >:: test_base_zipper_normal_tree ;
+    "test_zipper_nth_child_0" >:: test_zipper_nth_child_0 ;
+    "test_zipper_nth_child_1" >:: test_zipper_nth_child_1 ;
+    "test_zipper_nth_child_2" >:: test_zipper_nth_child_2 ;
+    "test_zipper_nth_child_does_not_exist" >:: test_zipper_nth_child_does_not_exist ;
+    "test_zipper_nth_child_negative_index" >:: test_zipper_nth_child_negative_index ;
+    "test_zipper_nth_child_plus_parent_is_noop" >:: test_zipper_nth_child_plus_parent_is_noop ;
+    "test_zipper_left_sibling" >:: test_zipper_left_sibling ;
+    "test_zipper_left_sibling_twice" >:: test_zipper_left_sibling_twice ;
+    "test_zipper_left_sibling_does_not_exist" >:: test_zipper_left_sibling_does_not_exist ;
+    "test_zipper_nth_child_plus_left_sibling_plus_parent_is_noop" >:: test_zipper_nth_child_plus_left_sibling_plus_parent_is_noop ;
+    "test_zipper_right_sibling" >:: test_zipper_right_sibling ;
+    "test_zipper_right_sibling_twice" >:: test_zipper_right_sibling_twice ;
+    "test_zipper_right_sibling_does_not_exist" >:: test_zipper_right_sibling_does_not_exist ;
+    "test_zipper_nth_child_plus_right_sibling_plus_parent_is_noop" >:: test_zipper_nth_child_plus_right_sibling_plus_parent_is_noop ;
+    "test_parent" >:: test_parent ;
+    "test_parent_on_root" >:: test_parent_on_root ;
+    "test_root" >:: test_root ;
+    "test_root_on_root" >:: test_root_on_root ;
+    "test_insert_left_sibling" >:: test_insert_left_sibling ;
+    "test_insert_left_sibling_focuses_on_new_tree" >:: test_insert_left_sibling_focuses_on_new_tree ;
+    "test_insert_left_sibling_on_root" >:: test_insert_left_sibling_on_root ;
+    "test_insert_right_sibling" >:: test_insert_right_sibling ;
+    "test_insert_right_sibling_focuses_on_new_tree" >:: test_insert_right_sibling_focuses_on_new_tree ;
+    "test_insert_right_sibling_on_root" >:: test_insert_right_sibling_on_root ;
+    "test_append_child" >:: test_append_child ;
+    "test_append_child_focuses_on_new_tree" >:: test_append_child_focuses_on_new_tree ;
+    "test_replace" >:: test_replace ;
+    "test_replace_focuses_on_new_tree" >:: test_replace_focuses_on_new_tree ;
+    "test_replace_root" >:: test_replace_root ;
+    "test_delete" >:: test_delete ;
+    "test_delete_focuses_on_leftmost_sibling_if_possible" >:: test_delete_focuses_on_leftmost_sibling_if_possible ;
+    "test_delete_focuses_on_rightmost_sibling_if_no_left_sibling" >:: test_delete_focuses_on_rightmost_sibling_if_no_left_sibling ;
+    "test_delete_focuses_on_parent_if_no_more_siblings" >:: test_delete_focuses_on_parent_if_no_more_siblings ;
+    "test_delete_root" >:: test_delete_root ;
+  ]