simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

updated roseTree (cosmetic; printer; to_seq) and test

Browse source
This commit is contained in:
Simon Cruanes 2015-01-26 11:55:59 +01:00
parent b599e9941a
commit 8f66f0d7d8
3 changed files with 96 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
src/misc/roseTree.ml
View file

@ -1,11 +1,48 @@
(*
copyright (c) 2013-2014, Simon Cruanes, Emmanuel Surleau
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
type +'a t = [`Node of 'a * 'a t list]
type 'a tree = 'a t
type 'a sequence = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> unit
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 to_seq t yield =
let rec iter (`Node (value, children)) =
yield value;
List.iter iter children
in
iter t
let split_at_length_minus_1 l =
let rev_list = List.rev l in
match rev_list with
@ -13,7 +50,7 @@ let split_at_length_minus_1 l =
| [item] -> ([], Some item)
| item::items -> (List.rev items, Some item)
let print formatter string_of_value tree =
let print pp_val formatter tree =
let rec print_children children indent_string =
let non_last_children, maybe_last_child =
split_at_length_minus_1 children
@ -26,7 +63,7 @@ let print formatter string_of_value tree =
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;
pp_val formatter child_value;
Format.pp_force_newline formatter ();
let indent_string' = indent_string ^ "| " in
print_children grandchildren indent_string'
@ -34,13 +71,13 @@ let print formatter string_of_value tree =
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;
pp_val formatter last_child_value;
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;
pp_val formatter root_value;
Format.pp_force_newline formatter ();
print_children root_children ""
in

54
src/misc/roseTree.mli
View file

@ -1,39 +1,67 @@
(**
{1 Rose Tree}
(*
copyright (c) 2013-2014, Simon Cruanes, Emmanuel Surleau
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** {1 Rose Tree}
A persistent, non-lazy tree where each node may have an arbitrary number of
children.
@since NEXT_RELEASE
*)
@since NEXT_RELEASE *)
(**
The type of a tree node - a (value, children) pair.
*)
(** The type of a tree node - a (value, children) pair. *)
type +'a t = [`Node of 'a * 'a t list]
type 'a tree = 'a t
type 'a sequence = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> unit
(**
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
(** Iterate over the tree *)
val to_seq : 'a t -> 'a sequence
(**
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
val print : 'a printer -> 'a t printer
(**
{2 Zipper}
A zipper to navigate and return modified versions of the tree.
*)
module Zipper : sig
(**
{2 Zipper}
A zipper to navigate and return modified versions of the tree.
*)
type 'a t
(**

29
tests/test_RoseTree.ml
View file

@ -1,11 +1,10 @@
open Containers_misc
open OUnit
let format_node value = Printf.sprintf "%d" value
let format_node = Format.pp_print_int
let string_of_tree tree =
CCFormat.sprintf "%a" (fun formatter value ->
RoseTree.print formatter format_node tree) tree
CCFormat.sprintf "%a" (RoseTree.print format_node) tree
let assert_equal_tree expected_tree_rep tree =
let expected_tree_rep_string =
@ -66,8 +65,8 @@ let new_tree_strings = [
"|- 1000" ;
"| '- 10000" ;
"'- 1001" ;
" |- 10010" ;
" '- 10012" ;
" |- 10010" ;
" '- 10012" ;
]
let test_print_single_node_tree () =
@ -78,12 +77,12 @@ let test_print_normal_tree () =
let expected = normal_tree_strings in
assert_equal_tree expected normal_tree
let test_fold_single_node_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 test_fold_normal_tree () =
let tree_sum = RoseTree.fold ~f:(fun value acc -> acc + value) 0 normal_tree
in
assert_equal 150 tree_sum
@ -325,8 +324,8 @@ let test_insert_left_sibling () =
"| | |- 1000" ;
"| | | '- 10000" ;
"| | '- 1001" ;
"| | |- 10010" ;
"| | '- 10012" ;
"| | |- 10010" ;
"| | '- 10012" ;
"| '- 10" ;
"|- 2" ;
"| |- 20" ;
@ -375,8 +374,8 @@ let test_insert_right_sibling () =
"| |- 1000" ;
"| | '- 10000" ;
"| '- 1001" ;
"| |- 10010" ;
"| '- 10012" ;
"| |- 10010" ;
"| '- 10012" ;
"|- 2" ;
"| |- 20" ;
"| '- 21" ;
@ -428,8 +427,8 @@ let test_append_child () =
" |- 1000" ;
" | '- 10000" ;
" '- 1001" ;
" |- 10010" ;
" '- 10012" ;
" |- 10010" ;
" '- 10012" ;
]
in
assert_equal_zipper expected zipper
@ -459,8 +458,8 @@ let test_replace () =
"| |- 1000" ;
"| | '- 10000" ;
"| '- 1001" ;
"| |- 10010" ;
"| '- 10012" ;
"| |- 10010" ;
"| '- 10012" ;
"'- 3" ;
" |- 30" ;
" |- 31" ;