File Coverage

blib/lib/Data/Random/Tree.pm
Criterion Covered Total %
statement 42 43 97.6
branch 5 8 62.5
condition 6 6 100.0
subroutine 7 7 100.0
pod 1 1 100.0
total 61 65 93.8


line stmt bran cond sub pod time code
1             package Data::Random::Tree;
2              
3             our $DATE = '2016-03-26'; # DATE
4             our $VERSION = '0.04'; # VERSION
5              
6 1     1   620 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         1  
  1         20  
8 1     1   4 use warnings;
  1         1  
  1         27  
9              
10 1     1   776 use Exporter::Rinci qw(import);
  1         414  
  1         6  
11              
12             our %SPEC;
13              
14             $SPEC{create_random_tree} = {
15             v => 1.1,
16             summary => 'Create a random tree',
17             description => <<'_',
18              
19             This routine creates a random tree object. You need to supply at least one node
20             class. A node class is a class that must at least have these attributes:
21             `parent`, and `children`. See `Role::TinyCommons::Tree::Node` if you want to
22             use a role to enforce this for your class.
23              
24             TODO: allow specifying the minimum/maximum number of objects (per-level).
25              
26             TODO: allow specifying the minimum/maximum level.
27              
28             TODO: allow varying the number of children of each node.
29              
30             TODO: allow to customize the distribution of class instances (e.g. root node
31             up until level 3 should only be C1 nodes, and so on).
32              
33             TODO: Allow setting node attributes with random values (without having the user
34             use `code_instantiate_node`).
35              
36             _
37             args => {
38             num_objects_per_level => {
39             schema => ['array*', of=>['int*', min=>1], min_len=>0],
40             req => 1,
41             summary => 'Number of objects per level',
42             description => <<'_',
43              
44             This argument specifies number of objects per level and should be an array. The
45             first element of the array corresponds to the total number of children nodes
46             below the root node (i.e. the total number of objects at level 1), the second
47             element of the array corresponds to the total number of all that children's
48             children (i.e. the total number of objects at level 2, *not* the number of
49             children for each child), and so on.
50              
51             _
52             },
53             classes => {
54             schema => ['array*', of=>['str*'], min_len=>1],
55             req => 1,
56             summary => 'Class(es) to use to instantiate node objects',
57             description => <<'_',
58              
59             The nodes will be created from a random pick of this list of classes. If you
60             only supply one class, then all nodes will be of that class.
61              
62             _
63             },
64             code_instantiate_node => {
65             schema => 'code*',
66             description => <<'_',
67              
68             By default, node object will be created with:
69              
70             $class->new()
71              
72             you can customize this by providing a routine to instantiate the node. The code will receive:
73              
74             ($class, $level, $parent)
75              
76             where `$class` is the class name (your code can naturally create nodes using any
77             class you want), `$level` is the current level (0 for root node, 1 for its
78             children, and so on), `$parent` is the parent node object. The code should
79             return the node object.
80              
81             Your code need not set the node's `parent()`, connecting parent and children
82             nodes will be performed by this routine.
83              
84             Example:
85              
86             sub {
87             ($class, $level, $parent) = @_;
88             $class->new( attr => 10*rand );
89             }
90              
91             _
92             },
93             # XXX {min,max}_objects, {min,max}_objects_per_level
94             # XXX {min,max}_levels
95             },
96             result_naked => 1,
97             };
98             sub create_random_tree {
99 1     1 1 20 my %args = @_;
100              
101             my $nobj_per_level = $args{num_objects_per_level}
102 1 50       4 or die "Please specify 'num_objects_per_level'";
103              
104 1 50       3 my $classes = $args{classes} or die "Please specify 'classes'";
105 1     20401   5 my $code_class = sub { $classes->[@$classes * rand()] };
  20401         35384  
106              
107 1         2 my $code_inst0 = $args{code_instantiate_node};
108             my $code_inst = sub {
109 20401     20401   15742 my ($level, $parent) = @_;
110 20401         12225 my $node;
111 20401 50       19658 if ($code_inst0) {
112 20401         17842 $node = $code_inst0->($code_class->(), $level);
113             } else {
114 0         0 $node = $code_class->()->new();
115             }
116             # connect node with its parent
117 20401 100       188347 $node->parent($parent) if $parent;
118 20401         59353 $node;
119 1         4 };
120              
121 1         3 my $root = $code_inst->(0, undef);
122              
123 1         2 my @parents = ($root);
124 1         4 for my $level (1 .. @$nobj_per_level) {
125 7         27 my $nobj = $nobj_per_level->[$level-1];
126 7         11 my @children; # key = index parent, val = [child, ...]
127 7         20 for my $i (1..$nobj) {
128 20400         28775 my $parent_idx = int(($i-1)/$nobj * @parents);
129 20400         17739 my $parent = $parents[$parent_idx];
130 20400   100     40878 $children[$parent_idx] //= [];
131 20400         19711 my $child = $code_inst->($level, $parent);
132 20400         13700 push @{ $children[$parent_idx] }, $child;
  20400         29759  
133             }
134             # connect parent with its children
135 7         26 for my $i (0..$#parents) {
136 20101   100     82331 $parents[$i]->children($children[$i] // []);
137             }
138              
139 7   100     1234 @parents = map { @{ $children[$_] // [] } } 0..$#parents;
  20101         11525  
  20101         51344  
140             }
141              
142 1         22 $root;
143             }
144              
145             1;
146             # ABSTRACT: Create a random tree
147              
148             __END__
149              
150             =pod
151              
152             =encoding UTF-8
153              
154             =head1 NAME
155              
156             Data::Random::Tree - Create a random tree
157              
158             =head1 VERSION
159              
160             This document describes version 0.04 of Data::Random::Tree (from Perl distribution Data-Random-Tree), released on 2016-03-26.
161              
162             =head1 SYNOPSIS
163              
164             use Data::Random::Tree qw(create_random_tree);
165             use MyNode;
166             use MyOtherNode;
167              
168             my $tree = create_random_tree(
169             num_objects_per_level => [100, 3000, 5000, 8000, 3000, 1000, 300],
170             classes => ['MyNode', 'MyOtherNode'],
171             # optional
172             #code_instantiate_node => sub {
173             # my ($class, $level, $parent) = @_;
174             # $class->new(...);
175             #},
176             );
177              
178             =head1 FUNCTIONS
179              
180              
181             =head2 create_random_tree(%args) -> any
182              
183             Create a random tree.
184              
185             This routine creates a random tree object. You need to supply at least one node
186             class. A node class is a class that must at least have these attributes:
187             C<parent>, and C<children>. See C<Role::TinyCommons::Tree::Node> if you want to
188             use a role to enforce this for your class.
189              
190             TODO: allow specifying the minimum/maximum number of objects (per-level).
191              
192             TODO: allow specifying the minimum/maximum level.
193              
194             TODO: allow varying the number of children of each node.
195              
196             TODO: allow to customize the distribution of class instances (e.g. root node
197             up until level 3 should only be C1 nodes, and so on).
198              
199             TODO: Allow setting node attributes with random values (without having the user
200             use C<code_instantiate_node>).
201              
202             This function is not exported.
203              
204             Arguments ('*' denotes required arguments):
205              
206             =over 4
207              
208             =item * B<classes>* => I<array[str]>
209              
210             Class(es) to use to instantiate node objects.
211              
212             The nodes will be created from a random pick of this list of classes. If you
213             only supply one class, then all nodes will be of that class.
214              
215             =item * B<code_instantiate_node> => I<code>
216              
217             By default, node object will be created with:
218              
219             $class->new()
220              
221             you can customize this by providing a routine to instantiate the node. The code will receive:
222              
223             ($class, $level, $parent)
224              
225             where C<$class> is the class name (your code can naturally create nodes using any
226             class you want), C<$level> is the current level (0 for root node, 1 for its
227             children, and so on), C<$parent> is the parent node object. The code should
228             return the node object.
229              
230             Your code need not set the node's C<parent()>, connecting parent and children
231             nodes will be performed by this routine.
232              
233             Example:
234              
235             sub {
236             ($class, $level, $parent) = @_;
237             $class->new( attr => 10*rand );
238             }
239              
240             =item * B<num_objects_per_level>* => I<array[int]>
241              
242             Number of objects per level.
243              
244             This argument specifies number of objects per level and should be an array. The
245             first element of the array corresponds to the total number of children nodes
246             below the root node (i.e. the total number of objects at level 1), the second
247             element of the array corresponds to the total number of all that children's
248             children (i.e. the total number of objects at level 2, I<not> the number of
249             children for each child), and so on.
250              
251             =back
252              
253             Return value: (any)
254              
255             =head1 HOMEPAGE
256              
257             Please visit the project's homepage at L<https://metacpan.org/release/Data-Random-Tree>.
258              
259             =head1 SOURCE
260              
261             Source repository is at L<https://github.com/perlancar/perl-Data-Random-Tree>.
262              
263             =head1 BUGS
264              
265             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Random-Tree>
266              
267             When submitting a bug or request, please include a test-file or a
268             patch to an existing test-file that illustrates the bug or desired
269             feature.
270              
271             =head1 SEE ALSO
272              
273             L<Role::TinyCommons::Tree::Node>
274              
275             Other C<Data::Random::*> modules.
276              
277             L<Tree::FromStruct>
278              
279             =head1 AUTHOR
280              
281             perlancar <perlancar@cpan.org>
282              
283             =head1 COPYRIGHT AND LICENSE
284              
285             This software is copyright (c) 2016 by perlancar@cpan.org.
286              
287             This is free software; you can redistribute it and/or modify it under
288             the same terms as the Perl 5 programming language system itself.
289              
290             =cut