From fdc6f28d55d85c312b1b7602aae53e5ef90d2deb Mon Sep 17 00:00:00 2001 From: Emm Date: Sun, 25 Jan 2015 22:06:48 +0100 Subject: [PATCH] Add experimental rose tree. --- README.md | 2 + _oasis | 2 +- doc/intro.txt | 1 + src/misc/roseTree.ml | 168 ++++++++++++ src/misc/roseTree.mli | 115 ++++++++ tests/run_tests.ml | 1 + tests/test_RoseTree.ml | 600 +++++++++++++++++++++++++++++++++++++++++ 7 files changed, 888 insertions(+), 1 deletion(-) create mode 100644 src/misc/roseTree.ml create mode 100644 src/misc/roseTree.mli create mode 100644 tests/test_RoseTree.ml diff --git a/README.md b/README.md index 4a4a5007..1771a9a6 100644 --- a/README.md +++ b/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 diff --git a/_oasis b/_oasis index 15078c4f..9c618201 100644 --- a/_oasis +++ b/_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 diff --git a/doc/intro.txt b/doc/intro.txt index 570c36a9..0103a7d1 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -124,6 +124,7 @@ LazyGraph PHashtbl PrintBox RAL +RoseTree SmallSet SplayMap SplayTree diff --git a/src/misc/roseTree.ml b/src/misc/roseTree.ml new file mode 100644 index 00000000..242281e2 --- /dev/null +++ b/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 diff --git a/src/misc/roseTree.mli b/src/misc/roseTree.mli new file mode 100644 index 00000000..c946d8df --- /dev/null +++ b/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 diff --git a/tests/run_tests.ml b/tests/run_tests.ml index 6fd66b5d..5756e961 100644 --- a/tests/run_tests.ml +++ b/tests/run_tests.ml @@ -12,6 +12,7 @@ let suite = Test_fQueue.suite; Test_univ.suite; Test_mixtbl.suite; + Test_RoseTree.suite; ] let props = diff --git a/tests/test_RoseTree.ml b/tests/test_RoseTree.ml new file mode 100644 index 00000000..41d2e059 --- /dev/null +++ b/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 ; + ]