line
stmt
bran
cond
sub
pod
time
code
1
#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib
2
#-------------------------------------------------------------------------------
3
# Tree operations
4
# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc., 2020
5
#-------------------------------------------------------------------------------
6
# podDocumentation
7
package Tree::Ops;
8
our $VERSION = 20201030;
9
require v5.26;
10
1
1
1258
use warnings FATAL => qw(all);
1
9
1
94
11
1
1
7
use strict;
1
2
1
32
12
1
1
6
use Carp;
1
2
1
85
13
1
1
576
use Data::Dump qw(dump);
1
9910
1
70
14
1
1
4498
use Data::Table::Text qw(:all);
1
137986
1
1711
15
1
1
13
use feature qw(current_sub say);
1
2
1
146
16
1
1
768
use experimental qw(smartmatch);
1
3642
1
6
17
18
my $logFile = q(/home/phil/z/z/z/zzz.txt); # Log printed results if developing
19
20
#D1 Build # Create a tree. There is no implicit ordering applied to the tree, the relationships between parents and children within the tree are as established by the user and can be reorganized at will using the methods in this module.
21
22
sub new(;$$) #S Create a new child optionally recording the specified key or value.
23
263
263
1
776
{my ($key, $value) = @_; # Key, value
24
263
713
genHash(__PACKAGE__, # Child in the tree.
25
children => [], # Children of this child.
26
key => $key, # Key for this child - any thing that can be compared with the L operator.
27
value => $value, # Value for this child.
28
parent => undef, # Parent for this child.
29
lastChild => undef, # Last active child chain - enables us to find the currently open scope from the start if the tree.
30
);
31
}
32
33
sub activeScope($) # Locate the active scope in a tree.
34
426
426
1
564
{my ($tree) = @_; # Tree
35
426
489
my $active; # Latest active child
36
426
865
for(my $l = $tree; $l; $l = $l->lastChild) {$active = $l} # Skip down edge of parse tree to deepest active child.
1331
23060
37
426
1858
$active
38
}
39
40
sub setParentOfChild($$) #P Set the parent of a child and return the child.
41
227
227
1
415
{my ($child, $parent) = @_; # Child, parent
42
227
3530
$child->parent = $parent; # Parent child
43
227
1041
$child
44
}
45
46
sub open($;$$) # Add a child and make it the currently active scope into which new children will be added.
47
213
213
1
359
{my ($tree, $key, $value) = @_; # Tree, key, value to be recorded in the interior child being opened
48
213
370
my $parent = activeScope $tree; # Active parent
49
213
440
my $child = new $key, $value; # New child
50
213
16871
push $parent->children->@*, $child; # Place new child last under parent
51
213
4141
$parent->lastChild = $child; # Make child active
52
213
866
setParentOfChild $child, $parent # Parent child
53
}
54
55
sub close($) # Close the current scope returning to the previous scope.
56
210
210
1
325
{my ($tree) = @_; # Tree
57
210
314
my $parent = activeScope $tree; # Locate active scope
58
210
100
3332
delete $parent->parent->{lastChild} if $parent->parent; # Close scope
59
210
4530
$parent
60
}
61
62
sub single($;$$) # Add one child in the current scope.
63
129
129
1
234
{my ($tree, $key, $value) = @_; # Tree, key, value to be recorded in the child being created
64
129
334
$tree->open($key, $value); # Open scope
65
129
276
$tree->close; # Close scope immediately
66
}
67
68
sub include($$) # Include the specified tree in the currently open scope.
69
1
1
1
3
{my ($tree, $include) = @_; # Tree being built, tree to include
70
1
5
my $parent = activeScope $tree; # Active parent
71
1
18
my $n = new $include->key, $include->value; # New intermediate child
72
1
83
$n->children = $include->children; # Include children
73
1
23
$n->parent = $parent; # Parent new node
74
1
8
$parent->putLast($n) # Include node
75
}
76
77
sub fromLetters($) # Create a tree from a string of letters returning the children created in alphabetic order - useful for testing.
78
20
20
1
51
{my ($letters) = @_; # String of letters and ( ).
79
20
62
my $t = new(my $s = 'a');
80
20
1558
my @l = split //, $letters;
81
82
20
41
my @c; # Last letter seen
83
20
88
for my $l(split(//, $letters), '') # Each letter
84
371
611
{my $c = shift @c; # Last letter
85
371
50
826
if ($l eq '(') {$t->open ($c) if $c} # Open new scope
77
100
215
100
86
77
100
241
elsif ($l eq ')') {$t->single($c) if $c; $t->close} # Close scope
77
149
87
217
100
466
else {$t->single($c) if $c; @c = $l} # Save current letter as last letter
217
526
88
}
89
90
20
90
sort {$a->key cmp $b->key} $t->by # Sorted results
514
9432
91
}
92
93
#D1 Navigation # Navigate through a tree.
94
95
sub first($) # Get the first child under the specified parent.
96
84
84
1
227
{my ($parent) = @_; # Parent
97
84
1298
$parent->children->[0]
98
}
99
100
sub last($) # Get the last child under the specified parent.
101
68
68
1
167
{my ($parent) = @_; # Parent
102
68
1072
$parent->children->[-1]
103
}
104
105
sub indexOfChildInParent($) #P Get the index of a child within the specified parent.
106
152
152
1
262
{my ($child) = @_; # Child
107
152
50
2361
return undef unless my $parent = $child->parent; # Parent
108
152
2787
my $c = $parent->children; # Siblings
109
152
100
753
for(keys @$c) {return $_ if $$c[$_] == $child} # Locate child and return index
295
1359
110
undef # Root has no index
111
0
0
}
112
113
sub next($) # Get the next sibling following the specified child.
114
54
54
1
109
{my ($child) = @_; # Child
115
54
100
849
return undef unless my $parent = $child->parent; # Parent
116
50
897
my $c = $parent->children; # Siblings
117
50
100
66
333
return undef if @$c == 0 or $$c[-1] == $child; # No next child
118
49
118
$$c[+1 + indexOfChildInParent $child] # Next child
119
}
120
121
sub prev($) # Get the previous sibling of the specified child.
122
64
64
1
115
{my ($child) = @_; # Child
123
64
100
1028
return undef unless my $parent = $child->parent; # Parent
124
56
1009
my $c = $parent->children; # Siblings
125
56
100
66
374
return undef if @$c == 0 or $$c[0] == $child; # No previous child
126
55
129
$$c[-1 + indexOfChildInParent $child] # Previous child
127
}
128
129
sub firstMost($) # Return the first most descendant child in the tree starting at this parent or else return B if this parent has no children.
130
19
19
1
84
{my ($parent) = @_; # Parent
131
19
30
my $f;
132
19
42
for(my $p = $parent; $p; $p = $p->first) {$f = $p} # Go first most
44
184
133
19
157
$f
134
}
135
136
sub nextMost($) # Return the next child with no children, i.e. the next leaf of the tree, else return B if there is no such child.
137
20
20
1
44
{my ($child) = @_; # Current leaf
138
20
100
333
return firstMost $child if $child->children->@*; # First most child if we are not starting on a child with no children - i.e. on a leaf.
139
9
48
my $p = $child; # Traverse upwards and then right
140
9
25
$p = $p->parent while $p->isLast; # Traverse upwards
141
9
100
64
return undef unless $p = $p->next; # Traverse right else we are at the root
142
7
17
firstMost $p # First most child
143
}
144
145
sub prevMost($) # Return the previous child with no children, i.e. the previous leaf of the tree, else return B if there is no such child.
146
21
21
1
45
{my ($child) = @_; # Current leaf
147
21
35
my $p = $child; # Traverse upwards and then left
148
21
51
$p = $p->parent while $p->isFirst; # Traverse upwards
149
21
100
143
return undef unless $p = $p->prev; # Traverse left else we are at the root
150
15
36
lastMost $p # Last most child
151
}
152
153
sub lastMost($) # Return the last most descendant child in the tree starting at this parent or else return B if this parent has no children.
154
17
17
1
32
{my ($parent) = @_; # Parent
155
17
23
my $f;
156
17
41
for(my $p = $parent; $p; $p = $p->last) {$f = $p} # Go last most
32
120
157
17
139
$f
158
}
159
160
sub topMost($) # Return the top most parent in the tree containing the specified child.
161
1
1
1
3
{my ($child) = @_; # Child
162
1
100
5
for(my $p = $child; $p;) {return $p unless my $q = $p->parent; $p = $q} # Go up
4
67
3
16
163
0
0
confess "Child required";
164
}
165
166
sub mostRecentCommonAncestor($$) # Find the most recent common ancestor of the specified children.
167
2
2
1
8
{my ($first, $second) = @_; # First child, second child
168
2
50
9
return $first if $first == $second; # Same first and second child
169
2
6
my @f = context $first; # Context of first child
170
2
6
my @s = context $second; # Context of second child
171
2
33
4
my $c; $c = pop @f, pop @s while @f and @s and $f[-1] == $s[-1]; # Remove common ancestors
2
66
23
172
2
10
$c
173
}
174
175
sub go($@) # Return the child at the end of the path starting at the specified parent. A path is a list of zero based children numbers. Return B if the path is not valid.
176
10
10
1
23
{my ($parent, @path) = @_; # Parent, list of zero based children numbers
177
10
14
my $p = $parent; # Start
178
10
50
12
my $q; defined($q = $p->children->[$_]) ? $p = $q : return undef for @path; # Down # Same first and second child
10
149
179
10
339
$p
180
}
181
182
#D1 Location # Verify the current location.
183
184
sub context($) # Get the context of the current child.
185
21
21
1
39
{my ($child) = @_; # Child
186
21
29
my @c; # Context
187
21
46
for(my $c = $child; $c; $c = $c->parent) {push @c, $c} # Walk up
88
1574
188
@c
189
21
162
}
190
191
sub isFirst($) # Return the specified child if that child is first under its parent, else return B.
192
80
80
1
678
{my ($child) = @_; # Child
193
80
100
1258
return undef unless my $parent = $child->parent; # Parent
194
72
100
1357
$parent->children->[0] == $child ? $child : undef # There will be at least one child
195
}
196
197
sub isLast($) # Return the specified child if that child is last under its parent, else return B.
198
64
64
1
527
{my ($child) = @_; # Child
199
64
100
1007
return undef unless my $parent = $child->parent; # Parent
200
60
1101
my $c = $parent->children;
201
60
100
1015
$parent->children->[-1] == $child ? $child : undef # There will be at least one child
202
}
203
204
sub isTop($) # Return the specified parent if that parent is the top most parent in the tree.
205
2
2
1
6
{my ($parent) = @_; # Parent
206
2
100
36
$parent->parent ? undef : $parent
207
}
208
209
sub singleChildOfParent($) # Return the only child of this parent if the parent has an only child, else B
210
1
1
1
4
{my ($parent) = @_; # Parent
211
1
50
18
$parent->children->@* == 1 ? $parent->children->[0] : undef # Return only child if it exists
212
}
213
214
sub empty($) # Return the specified parent if it has no children else B
215
2
2
1
5
{my ($parent) = @_; # Parent
216
2
100
34
$parent->children->@* == 0 ? $parent : undef
217
}
218
219
#D1 Put # Insert children into a tree.
220
221
sub putFirst($$) # Place a new child first under the specified parent and return the child.
222
4
4
1
85
{my ($parent, $child) = @_; # Parent, child
223
4
75
unshift $parent->children->@*, $child; # Place child
224
4
27
setParentOfChild $child, $parent # Parent child
225
}
226
227
sub putLast($$) # Place a new child last under the specified parent and return the child.
228
6
6
1
84
{my ($parent, $child) = @_; # Parent, child
229
6
101
push $parent->children->@*, $child; # Place child
230
6
35
setParentOfChild $child, $parent # Parent child
231
}
232
233
sub putNext($$) # Place a new child after the specified child.
234
2
2
1
75
{my ($child, $new) = @_; # Existing child, new child
235
2
50
7
return undef unless defined(my $i = indexOfChildInParent $child); # Locate child within parent
236
2
42
splice $child->parent->children->@*, $i, 1, $child, $new; # Place new child
237
2
79
setParentOfChild $new, $child->parent # Parent child
238
}
239
240
sub putPrev($$) # Place a new child before the specified child.
241
2
2
1
75
{my ($child, $new) = @_; # Child, new child
242
2
50
7
return undef unless defined(my $i = indexOfChildInParent($child)); # Locate child within parent
243
2
35
splice $child->parent->children->@*, $i, 1, $new, $child; # Place new child
244
2
72
setParentOfChild $new, $child->parent # Parent child
245
}
246
247
#D1 Steps # Move the start or end of a scope forwards or backwards as suggested by Alex Monroe.
248
249
sub step($) # Make the first child of the specified parent the parents previous sibling and return the parent. In effect this moves the start of the parent one step forwards.
250
1
1
1
4
{my ($parent) = @_; # Parent
251
1
50
4
return undef unless my $f = $parent->first; # First child
252
1
12
putPrev $parent, cut $f; # Place first child
253
1
16
$parent
254
}
255
256
sub stepEnd($) # Make the next sibling of the specified parent the parents last child and return the parent. In effect this moves the end of the parent one step forwards.
257
3
3
1
8
{my ($parent) = @_; # Parent
258
3
50
8
return undef unless my $n = $parent->next; # Next sibling
259
3
15
putLast $parent, cut $n; # Place next sibling as first child
260
3
22
$parent
261
}
262
263
sub stepBack # Make the previous sibling of the specified parent the parents first child and return the parent. In effect this moves the start of the parent one step backwards.
264
2
2
1
7
{my ($parent) = @_; # Parent
265
2
50
7
return undef unless my $p = $parent->prev; # Previous sibling
266
2
7
putFirst $parent, cut $p; # Place previous sibling as first child
267
2
32
$parent
268
}
269
270
sub stepEndBack # Make the last child of the specified parent the parents next sibling and return the parent. In effect this moves the end of the parent one step backwards.
271
1
1
1
3
{my ($parent) = @_; # Parent
272
1
50
4
return undef unless my $l = $parent->last; # Last child sibling
273
1
10
putNext $parent, cut $l; # Place last child as first sibling
274
1
16
$parent
275
}
276
277
#D1 Edit # Edit a tree in situ.
278
279
sub cut($) # Cut out a child and all its content and children, return it ready for reinsertion else where.
280
10
10
1
22
{my ($child) = @_; # Child
281
10
50
184
return $child unless my $parent = $child->parent; # The whole tree
282
10
193
splice $parent->children->@*, indexOfChildInParent($child), 1; # Remove child
283
10
59
$child
284
}
285
286
sub dup($) # Duplicate a specified parent and all its descendants returning the root of the resulting tree.
287
1
1
1
51
{my ($parent) = @_; # Parent
288
289
sub # Duplicate a child
290
8
8
95
{my ($old) = @_; # Existing child
291
8
131
my $new = new $old->key, $old->value; # New child
292
8
599
push $new->children->@*, __SUB__->($_) for $old->children->@*; # Duplicate children of child
293
8
91
$new
294
1
10
}->($parent) # Start duplication at parent
295
}
296
297
sub transcribe($) # Duplicate a specified parent and all its descendants recording the mapping in a temporary {transcribed} field in the tree being transcribed. Returns the root parent of the tree being duplicated.
298
1
1
1
2
{my ($parent) = @_; # Parent
299
300
sub # Duplicate a child
301
8
8
116
{my ($old) = @_; # Existing child
302
8
163
my $new = new $old->key, $old->value; # New child
303
8
477
$old->{transcribedTo} = $new; # To where we went
304
8
12
$new->{transcribedFrom} = $old; # From where we came
305
8
138
push $new->children->@*, __SUB__->($_) for $old->children->@*; # Duplicate children of child and record transcription
306
8
104
$new
307
1
7
}->($parent) # Start duplication at parent
308
}
309
310
sub unwrap($) # Unwrap the specified child and return that child.
311
5
5
1
28
{my ($child) = @_; # Child
312
5
50
13
return undef unless defined(my $i = indexOfChildInParent $child); # Locate child within parent
313
5
84
my $parent = $child->parent; # Parent
314
5
87
$_->parent = $parent for $child->children->@*; # Reparent unwrapped children of child
315
5
139
delete $child ->{parent}; # Remove parent of unwrapped child
316
5
77
splice $parent->children->@*, $i, 1, $child->children->@*; # Remove child
317
5
84
$parent
318
}
319
320
sub wrap($;$$) # Wrap the specified child with a new parent and return the new parent optionally setting its L[key] and L[value].
321
5
5
1
93
{my ($child, $key, $value) = @_; # Child to wrap, optional key, optional value
322
5
50
14
return undef unless defined(my $i = indexOfChildInParent $child); # Locate child within existing parent
323
5
84
my $parent = $child->parent; # Existing parent
324
5
23
my $new = new $key, $value; # Create new parent
325
5
395
$new->parent = $parent; # Parent new parent
326
5
92
$new->children = [$child]; # Set children for new parent
327
5
89
splice $parent->children->@*, $i, 1, $new; # Place new parent in existing parent
328
5
94
$child->parent = $new # Reparent child to new parent
329
}
330
331
sub wrapChildren($;$$) # Wrap the children of the specified parent with a new intermediate parent that becomes the child of the specified parent, optionally setting the L[key] and the L[value] for the new parent. Return the new parent.
332
1
1
1
3
{my ($parent, $key, $value) = @_; # Child to wrap, optional key for new wrapping parent, optional value for new wrapping parent
333
1
5
my $new = new $key, $value; # Create new parent
334
1
85
$new->children = $parent->children; # Move children;
335
1
23
$parent->children = [$new]; # Grand parent
336
1
19
$new->parent = $parent; # Parent new parent
337
1
19
$_->parent = $new for $new->children->@*; # Reparent new children
338
1
53
$new # New parent
339
}
340
341
sub merge($) # Unwrap the children of the specified parent with the whose L[key] fields L that of their parent. Returns the specified parent regardless.
342
1
1
1
3
{my ($parent) = @_; # Merging parent
343
1
18
for my $c($parent->children->@*) # Children of parent
344
4
100
74
{unwrap $c if $c->key ~~ $parent->key; # Unwrap child if like parent
345
}
346
$parent
347
1
22
}
348
349
sub mergeLikePrev($) # Merge the preceding sibling of the specified child if that sibling exists and the L[key] data of the two siblings L. Returns the specified child regardless. From a proposal made by Micaela Monroe.
350
1
1
1
7
{my ($child) = @_; # Child
351
1
50
5
return $child unless my $prev = $child->prev; # No merge possible if child is first
352
1
5
$child->putFirst($prev->cut)->unwrap # Children to be merged
353
}
354
355
sub mergeLikeNext($) # Merge the following sibling of the specified child if that sibling exists and the L[key] data of the two siblings L. Returns the specified child regardless. From a proposal made by Micaela Monroe.
356
1
1
1
8
{my ($child) = @_; # Child
357
1
50
5
return $child unless my $next = $child->next; # No merge possible if child is last
358
1
4
$child->putLast($next->cut)->unwrap # Children to be merged
359
}
360
361
sub split($) # Make the specified parent a grandparent of each of its children by interposing a copy of the specified parent between the specified parent and each of its children. Return the specified parent.
362
1
1
1
4
{my ($parent) = @_; # Parent to make into a grand parent
363
1
19
wrap $_, $parent->key for $parent->children->@*; # Grandparent each child
364
1
20
$parent
365
}
366
367
#D1 Traverse # Traverse a tree.
368
369
sub by($;$) # Traverse a tree in post-order to process each child with the specified sub and return an array of the results of processing each child. If no sub sub is specified, the children are returned in tree order.
370
24
24
1
57
{my ($tree, $sub) = @_; # Tree, optional sub to process each child
371
24
100
239
185
$sub //= sub{@_}; # Default sub
239
471
372
373
24
37
my @r; # Results
374
sub # Traverse
375
262
262
3123
{my ($child) = @_; # Child
376
262
4085
__SUB__->($_) for $child->children->@*; # Children of child
377
262
2714
push @r, &$sub($child); # Process child saving result
378
24
106
}->($tree); # Start at root of tree
379
380
@r
381
24
779
}
382
383
sub select($$) # Select matching children in a tree in post-order. A child can be selected via named value, array of values, a hash of values, a regular expression or a sub reference.
384
7
7
1
20
{my ($tree, $select) = @_; # Tree, method to select a child
385
7
15
my $ref = ref $select; # Selector type
386
my $sel = # Selection method
387
10
10
39
$ref =~ m(array)i ? sub{grep{$_[0] eq $_} @$select} : # Array
20
46
388
10
10
44
$ref =~ m(hash)i ? sub{$$select{$_[0]}} : # Hash
389
17
17
117
$ref =~ m(exp)i ? sub{$_[0] =~ m($select)} : # Regular expression
390
17
17
298
$ref =~ m(code)i ? sub{&$select($_[0])} : # Sub
391
7
100
7
59
sub{$_[0] eq $select}; # Scalar
7
100
41
100
100
392
7
13
my @s; # Selection
393
394
sub # Traverse
395
61
61
330
{my ($child) = @_; # Child
396
61
100
991
push @s, $child if &$sel($child->key); # Select child if it matches
397
61
975
__SUB__->($_) for $child->children->@*; # Each child
398
7
33
}->($tree); # Start at root
399
400
@s
401
7
177
}
402
403
#D1 Partitions # Various partitions of the tree
404
405
sub leaves($) # The set of all children without further children, i.e. each leaf of the tree.
406
2
2
1
6
{my ($tree) = @_; # Tree
407
2
5
my @leaves; # Leaves
408
sub # Traverse
409
20
20
29
{my ($child) = @_; # Child
410
20
100
319
if (my @c = $child->children->@*) # Children of child
411
11
74
{__SUB__->($_) for @c; # Process children of child
412
}
413
else
414
9
55
{push @leaves, $child; # Save leaf
415
}
416
2
17
}->($tree); # Start at root of tree
417
418
@leaves
419
2
17
}
420
421
sub parentsOrdered($$$) #P The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in the specified order.
422
7
7
1
15
{my ($tree, $preorder, $reverse) = @_; # Tree, pre-order if true else post-order, reversed if true
423
7
12
my @parents; # Parents
424
sub # Traverse
425
73
73
175
{my ($child) = @_; # Child
426
73
100
1159
if (my @c = $child->children->@*) # Children of child
427
36
100
199
{@c = reverse @c if $reverse; # Reverse if requested
428
36
100
63
push @parents, $child if $preorder; # Pre-order
429
36
106
__SUB__->($_) for @c; # Process children of child
430
36
100
169
push @parents, $child unless $preorder; # Post-order
431
}
432
7
40
}->($tree); # Start at root of tree
433
434
@parents
435
7
76
}
436
437
sub parentsPreOrder($) # The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal pre-order.
438
1
1
1
3
{my ($tree) = @_; # Tree
439
1
4
parentsOrdered($tree, 1, 0);
440
}
441
442
sub parentsPostOrder($) # The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal post-order.
443
4
4
1
9
{my ($tree) = @_; # Tree
444
4
9
parentsOrdered($tree, 0, 0);
445
}
446
447
sub parentsReversePreOrder($) # The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in reverse pre-order.
448
1
1
1
4
{my ($tree) = @_; # Tree
449
1
4
parentsOrdered($tree, 1, 1);
450
}
451
452
sub parentsReversePostOrder($) # The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in reverse post-order.
453
1
1
1
4
{my ($tree) = @_; # Tree
454
1
4
&parentsOrdered($tree, 0, 1);
455
}
456
457
sub parents($) # The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal post-order.
458
2
2
1
6
{my ($tree) = @_; # Tree
459
2
8
&parentsPostOrder(@_);
460
}
461
462
#D1 Order # Check the order and relative position of children in a tree.
463
464
sub above($$) # Return the first child if it is above the second child else return B.
465
4
4
1
8
{my ($first, $second) = @_; # First child, second child
466
4
50
13
return undef if $first == $second; # A child cannot be above itself
467
4
49
my @f = context $first; # Context of first child
468
4
9
my @s = context $second; # Context of second child
469
4
66
52
pop @f, pop @s while @f and @s and $f[-1] == $s[-1]; # Find first different ancestor
100
470
4
100
26
!@f ? $first : undef # First is above second if the ancestors of first are also ancestors of second
471
}
472
473
sub below($$) # Return the first child if it is below the second child else return B.
474
2
2
1
5
{my ($first, $second) = @_; # First child, second child
475
2
100
6
above($second, $first) ? $first : undef
476
}
477
478
sub after($$) # Return the first child if it occurs strictly after the second child in the tree or else B if the first child is L[above], L[below] or L[before] the second child.
479
4
4
1
37
{my ($first, $second) = @_; # First child, second child
480
4
11
my @f = context $first; # Context of first child
481
4
9
my @s = context $second; # Context of second child
482
4
66
48
pop @f, pop @s while @f and @s and $f[-1] == $s[-1]; # Find first different ancestor
100
483
4
100
66
22
return undef unless @f and @s; # Not strictly after
484
2
50
8
indexOfChildInParent($f[-1]) > indexOfChildInParent($s[-1]) ? $first : undef # First child relative to second child at first common ancestor
485
}
486
487
sub before($$) # Return the first child if it occurs strictly before the second child in the tree or else B if the first child is L[above], L[below] or L[after] the second child.
488
2
2
1
6
{my ($first, $second) = @_; # First child, second child
489
2
100
5
after($second, $first) ? $first : undef
490
}
491
492
#D1 Paths # Find paths between nodes
493
494
sub path($) # Return the list of zero based child indexes for the path from the root of the tree containing the specified child to the specified child for use by the L[go] method.
495
1
1
1
4
{my ($child) = @_; # Child
496
1
2
my @p; # Path
497
1
19
for(my $p = $child; my $q = $p->parent; $p = $q) # Go up
498
3
18
{unshift @p, indexOfChildInParent $p # Record path
499
}
500
@p
501
1
10
}
502
503
sub pathFrom($$) # Return the list of zero based child indexes for the path from the specified ancestor to the specified child for use by the L[go] method else confess if the ancestor is not, in fact, an ancestor.
504
9
9
1
20
{my ($child, $ancestor) = @_; # Child, ancestor
505
9
100
40
return () if $child == $ancestor; # Easy case
506
8
14
my @p; # Path
507
8
134
for(my $p = $child; my $q = $p->parent; $p = $q) # Go up
508
15
83
{unshift @p, indexOfChildInParent $p; # Record path
509
15
100
260
return @p if $q == $ancestor; # Stop at ancestor
510
}
511
0
0
confess "Not an ancestor"
512
}
513
514
sub siblingsBefore($) # Return a list of siblings before the specified child.
515
1
1
1
4
{my ($child) = @_; # Child
516
1
50
19
return () unless my $parent = $child->parent; # Parent
517
1
26
my @c = $parent->children->@*; # Children
518
1
7
my $i = indexOfChildInParent $child; # Our position
519
1
24
@c[0..$i-1]
520
}
521
522
sub siblingsAfter($) # Return a list of siblings after the specified child.
523
1
1
1
3
{my ($child) = @_; # Child
524
1
50
18
return () unless my $parent = $child->parent; # Parent
525
1
22
my @c = $parent->children->@*; # Children
526
1
7
my $i = indexOfChildInParent $child; # Our position
527
1
9
@c[$i+1..$#c]
528
}
529
530
sub siblingsStrictlyBetween($$) # Return a list of the siblings strictly between two children of the same parent else return B.
531
2
2
1
7
{my ($start, $finish) = @_; # Start child, finish child
532
2
50
36
return () unless my $parent = $start->parent; # Parent
533
2
100
44
confess "Must be siblings" unless $parent == $finish->parent; # Check both children have the same parent
534
1
22
my @c = $parent->children->@*; # All siblings
535
1
66
14
shift @c while @c and $c[0] != $start; # Remove all siblings up to the start child
536
1
66
7
pop @c while @c and $c[-1] != $finish; # Remove all siblings after the finish child
537
1
50
3
shift @c; pop @c if @c; # Remove first and last child to make range strictly between
1
4
538
@c # Siblings strictly between start and finish
539
1
5
}
540
541
sub lineage($$) # Return the path from the specified child to the specified ancestor else return B if the child is not a descendant of the ancestor.
542
2
2
1
6
{my ($child, $ancestor) = @_; # Child, ancestor
543
2
5
my @p; # Path
544
2
8
for(my $p = $child; $p; $p = $p->parent) # Go up
545
8
31
{push @p, $p; # Record path
546
8
100
136
last if $p == $ancestor # Stop if we encounter the specified ancestor
547
}
548
2
100
66
32
return @p if !@p or $p[-1] == $ancestor; # Found the ancestor
549
undef # No such ancestor
550
1
5
}
551
552
sub nextPreOrderPath($) # Return a list of children visited between the specified child and the next child in pre-order.
553
22
22
1
42
{my ($start) = @_; # The child at the start of the path
554
22
100
366
return ($start->first) if $start->children->@*; # First child if possible
555
13
58
my $p = $start; # Traverse upwards and then right
556
13
17
my @p; # Path
557
13
32
push @p, $p = $p->parent while $p->isLast; # Traverse upwards
558
13
100
85
$p->next ? (@p, $p->next) : () # Traverse right else we are at the root
559
}
560
561
sub nextPostOrderPath($) # Return a list of children visited between the specified child and the next child in post-order.
562
22
22
1
43
{my ($start) = @_; # The child at the start of the path
563
22
31
my $p = $start; # Traverse upwards and then right, then first most
564
22
26
my @p; # Path
565
22
100
359
if (!$p->parent) # Starting at the root which is last in a post order traversal
566
2
16
{push @p, $p while $p = $p->first;
567
return @p
568
2
45
}
569
20
100
98
return (@p, $p->parent) if $p->isLast; # Traverse upwards
570
11
50
74
if (my $q = $p->next) # Traverse right
571
11
25
{for( ; $q; $q = $q->first) {push @p, $q} # Traverse first most
13
34
572
return @p
573
11
218
}
574
0
0
($p) # Back at the root
575
}
576
577
sub prevPostOrderPath($) # Return a list of children visited between the specified child and the previous child in post-order.
578
22
22
1
41
{my ($start) = @_; # The child at the start of the path
579
22
100
355
return ($start->last) if $start->children->@*; # Last child if possible
580
13
75
my $p = $start; # Traverse upwards and then left
581
13
19
my @p; # Path
582
13
28
push @p, $p = $p->parent while $p->isFirst; # Traverse upwards
583
13
100
89
$p->prev ? (@p, $p->prev) : () # Traverse left else we are at the root
584
}
585
586
sub prevPreOrderPath($) # Return a list of children visited between the specified child and the previous child in pre-order.
587
22
22
1
36
{my ($start) = @_; # The child at the start of the path
588
22
32
my $p = $start; # Traverse upwards and then left, then last most
589
22
30
my @p; # Path
590
22
100
358
if (!$p->parent) # Starting at the root which is last in a post order traversal
591
2
18
{push @p, $p while $p = $p->last;
592
return @p
593
2
43
}
594
20
100
102
return (@p, $p->parent) if $p->isFirst; # Traverse upwards
595
11
50
79
if (my $q = $p->prev) # Traverse left
596
11
25
{for( ; $q; $q = $q->last) {push @p, $q} # Traverse last most
18
64
597
return @p
598
11
219
}
599
0
0
($p) # Back at the root
600
}
601
602
#D1 Print # Print a tree.
603
604
sub printTree($$$$) #P String representation as a horizontal tree.
605
37
37
1
92
{my ($tree, $print, $preorder, $reverse) = @_; # Tree, optional print method, pre-order, reverse
606
37
60
my @s; # String representation
607
608
sub # Print a child
609
355
355
572
{my ($child, $depth) = @_; # Child, depth
610
355
5713
my $key = $child->key; # Key
611
355
6238
my $value = $child->value; # Value
612
355
50
1806
my $k = join '', ' ' x $depth, $print ? &$print($key) : $key; # Print key
613
355
50
647
my $v = !defined($value) ? '' : ref($value) ? dump($value) : $value; # Print value
100
614
355
100
963
push @s, [$k, $v] if $preorder;
615
355
100
5752
my @c = $child->children->@*; @c = reverse @c if $reverse;
355
1600
616
355
1079
__SUB__->($_, $depth+1) for @c; # Print children of child
617
355
100
883
push @s, [$k, $v] unless $preorder;
618
37
257
}->($tree, 0); # Print root
619
620
37
477
my $r = formatTableBasic [[qw(Key Value)], @s]; # Print tree
621
37
50
15115
owf($logFile, $r) if -e $logFile; # Log the result if requested
622
37
408
$r
623
}
624
625
sub printPreOrder($;$) # Print tree in normal pre-order.
626
34
34
1
61
{my ($tree, $print) = @_; # Tree, optional print method
627
34
85
printTree($tree, $print, 1, 0);
628
}
629
630
sub printPostOrder($;$) # Print tree in normal post-order.
631
1
1
1
5
{my ($tree, $print) = @_; # Tree, optional print method
632
1
4
printTree($tree, $print, 0, 0);
633
}
634
635
sub printReversePreOrder($;$) # Print tree in reverse pre-order
636
1
1
1
4
{my ($tree, $print) = @_; # Tree, optional print method
637
1
4
printTree($tree, $print, 1, 1);
638
}
639
640
sub printReversePostOrder($;$) # Print tree in reverse post-order
641
1
1
1
3
{my ($tree, $print) = @_; # Tree, optional print method
642
1
4
printTree($tree, $print, 0, 1);
643
}
644
645
sub print($;$) # Print tree in normal pre-order.
646
33
33
1
75
{my ($tree, $print) = @_; # Tree, optional print method
647
33
89
&printPreOrder(@_);
648
}
649
650
sub brackets($;$$) # Bracketed string representation of a tree.
651
7
7
1
16
{my ($tree, $print, $separator) = @_; # Tree, optional print method, optional child separator
652
7
50
31
my $t = $separator // ''; # Default child separator
653
sub # Print a child
654
62
62
97
{my ($child) = @_; # Child
655
62
983
my $key = $child->key; # Key
656
62
50
254
my $p = $print ? &$print($key) : $key; # Printed child
657
62
994
my $c = $child->children; # Children of child
658
62
100
363
return $p unless @$c; # Return child immediately if no children to format
659
31
62
join '', $p, '(', join($t, map {__SUB__->($_)} @$c), ')' # String representation
55
141
660
7
43
}->($tree) # Print root
661
}
662
663
sub xml($;$) # Print a tree as as xml.
664
1
1
1
4
{my ($tree, $print) = @_; # Tree, optional print method
665
sub # Print a child
666
12
12
19
{my ($child) = @_; # Child
667
12
190
my $key = $child->key; # Key
668
12
50
54
my $p = $print ? &$print($key) : $key; # Printed child
669
12
182
my $c = $child->children; # Children of child
670
12
100
77
return "<$p/>" unless @$c; # Singleton
671
6
14
join '', "<$p>", (map {__SUB__->($_)} @$c), "$p>" # String representation
11
26
672
1
9
}->($tree) # Print root
673
}
674
675
#D1 Data Structures # Data structures use by this package.
676
677
#D0
678
#-------------------------------------------------------------------------------
679
# Export
680
#-------------------------------------------------------------------------------
681
682
1
1
6737
use Exporter qw(import);
1
2
1
42
683
684
1
1
7
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
1
4
1
807
685
686
@ISA = qw(Exporter);
687
@EXPORT_OK = qw(
688
);
689
%EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);
690
691
# podDocumentation
692
693
=pod
694
695
=encoding utf-8
696
697
=head1 Name
698
699
Tree::Ops - Tree operations.
700
701
=head1 Synopsis
702
703
Create a tree:
704
705
my $a = Tree::Ops::new 'a', 'A';
706
707
for(1..2)
708
{$a->open ('b', "B$_");
709
$a->single('c', "C$_");
710
$a->close;
711
}
712
$a->single ('d', 'D');
713
$a->single ('e', 'E');
714
715
Print it:
716
717
is_deeply $a->print, <
718
Key Value
719
a A
720
b B1
721
c C1
722
b B2
723
c C2
724
d D
725
e E
726
END
727
728
Navigate through the tree:
729
730
is_deeply $a->lastMost->prev->prev->first->key, 'c';
731
is_deeply $a->first->next->last->parent->first->value, 'C2';
732
733
Traverse the tree:
734
735
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
736
737
Select items from the tree:
738
739
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
740
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
741
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
742
743
Reorganize the tree:
744
745
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
746
is_deeply $a->print, <
747
Key Value
748
a A
749
b B1
750
c C1
751
b B2
752
d D
753
c C2
754
e E
755
END
756
757
=head1 Description
758
759
Tree operations.
760
761
762
Version 20201030.
763
764
765
The following sections describe the methods in each functional area of this
766
module. For an alphabetic listing of all methods by name see L.
767
768
769
770
=head1 Build
771
772
Create a tree. There is no implicit ordering applied to the tree, the relationships between parents and children within the tree are as established by the user and can be reorganized at will using the methods in this module.
773
774
=head2 new($key, $value)
775
776
Create a new child optionally recording the specified key or value.
777
778
Parameter Description
779
1 $key Key
780
2 $value Value
781
782
B
783
784
785
786
my $a = Tree::Ops::new 'a', 'A'; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
787
788
for(1..2)
789
{$a->open ('b', "B$_");
790
$a->single('c', "C$_");
791
ok $a->activeScope->key eq 'b';
792
$a->close;
793
}
794
$a->single ('d', 'D');
795
$a->single ('e', 'E');
796
is_deeply $a->print, <
797
Key Value
798
a A
799
b B1
800
c C1
801
b B2
802
c C2
803
d D
804
e E
805
END
806
807
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
808
809
is_deeply $a->lastMost->prev->prev->first->key, 'c';
810
is_deeply $a->first->next->last->parent->first->value, 'C2';
811
812
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
813
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
814
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
815
816
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
817
is_deeply $a->print, <
818
Key Value
819
a A
820
b B1
821
c C1
822
b B2
823
d D
824
c C2
825
e E
826
END
827
828
829
This is a static method and so should either be imported or invoked as:
830
831
Tree::Ops::new
832
833
834
=head2 activeScope($tree)
835
836
Locate the active scope in a tree.
837
838
Parameter Description
839
1 $tree Tree
840
841
B
842
843
844
my $a = Tree::Ops::new 'a', 'A';
845
for(1..2)
846
{$a->open ('b', "B$_");
847
$a->single('c', "C$_");
848
849
ok $a->activeScope->key eq 'b'; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
850
851
$a->close;
852
}
853
$a->single ('d', 'D');
854
$a->single ('e', 'E');
855
is_deeply $a->print, <
856
Key Value
857
a A
858
b B1
859
c C1
860
b B2
861
c C2
862
d D
863
e E
864
END
865
866
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
867
868
is_deeply $a->lastMost->prev->prev->first->key, 'c';
869
is_deeply $a->first->next->last->parent->first->value, 'C2';
870
871
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
872
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
873
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
874
875
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
876
is_deeply $a->print, <
877
Key Value
878
a A
879
b B1
880
c C1
881
b B2
882
d D
883
c C2
884
e E
885
END
886
887
888
=head2 open($tree, $key, $value)
889
890
Add a child and make it the currently active scope into which new children will be added.
891
892
Parameter Description
893
1 $tree Tree
894
2 $key Key
895
3 $value Value to be recorded in the interior child being opened
896
897
B
898
899
900
my $a = Tree::Ops::new 'a', 'A';
901
for(1..2)
902
903
{$a->open ('b', "B$_"); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
904
905
$a->single('c', "C$_");
906
ok $a->activeScope->key eq 'b';
907
$a->close;
908
}
909
$a->single ('d', 'D');
910
$a->single ('e', 'E');
911
is_deeply $a->print, <
912
Key Value
913
a A
914
b B1
915
c C1
916
b B2
917
c C2
918
d D
919
e E
920
END
921
922
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
923
924
is_deeply $a->lastMost->prev->prev->first->key, 'c';
925
is_deeply $a->first->next->last->parent->first->value, 'C2';
926
927
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
928
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
929
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
930
931
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
932
is_deeply $a->print, <
933
Key Value
934
a A
935
b B1
936
c C1
937
b B2
938
d D
939
c C2
940
e E
941
END
942
943
944
=head2 close($tree)
945
946
Close the current scope returning to the previous scope.
947
948
Parameter Description
949
1 $tree Tree
950
951
B
952
953
954
my $a = Tree::Ops::new 'a', 'A';
955
for(1..2)
956
{$a->open ('b', "B$_");
957
$a->single('c', "C$_");
958
ok $a->activeScope->key eq 'b';
959
960
$a->close; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
961
962
}
963
$a->single ('d', 'D');
964
$a->single ('e', 'E');
965
is_deeply $a->print, <
966
Key Value
967
a A
968
b B1
969
c C1
970
b B2
971
c C2
972
d D
973
e E
974
END
975
976
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
977
978
is_deeply $a->lastMost->prev->prev->first->key, 'c';
979
is_deeply $a->first->next->last->parent->first->value, 'C2';
980
981
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
982
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
983
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
984
985
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
986
is_deeply $a->print, <
987
Key Value
988
a A
989
b B1
990
c C1
991
b B2
992
d D
993
c C2
994
e E
995
END
996
997
998
=head2 single($tree, $key, $value)
999
1000
Add one child in the current scope.
1001
1002
Parameter Description
1003
1 $tree Tree
1004
2 $key Key
1005
3 $value Value to be recorded in the child being created
1006
1007
B
1008
1009
1010
my $a = Tree::Ops::new 'a', 'A';
1011
for(1..2)
1012
{$a->open ('b', "B$_");
1013
1014
$a->single('c', "C$_"); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1015
1016
ok $a->activeScope->key eq 'b';
1017
$a->close;
1018
}
1019
1020
$a->single ('d', 'D'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1021
1022
1023
$a->single ('e', 'E'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1024
1025
is_deeply $a->print, <
1026
Key Value
1027
a A
1028
b B1
1029
c C1
1030
b B2
1031
c C2
1032
d D
1033
e E
1034
END
1035
1036
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
1037
1038
is_deeply $a->lastMost->prev->prev->first->key, 'c';
1039
is_deeply $a->first->next->last->parent->first->value, 'C2';
1040
1041
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)];
1042
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)];
1043
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)];
1044
1045
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
1046
is_deeply $a->print, <
1047
Key Value
1048
a A
1049
b B1
1050
c C1
1051
b B2
1052
d D
1053
c C2
1054
e E
1055
END
1056
1057
1058
=head2 include($tree, $include)
1059
1060
Include the specified tree in the currently open scope.
1061
1062
Parameter Description
1063
1 $tree Tree being built
1064
2 $include Tree to include
1065
1066
B
1067
1068
1069
my ($i) = fromLetters 'b(cd)';
1070
1071
my $a = Tree::Ops::new 'A';
1072
$a->open ('B');
1073
1074
$a->include($i); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1075
1076
$a->close;
1077
1078
is_deeply $a->print, <
1079
Key Value
1080
A
1081
B
1082
a
1083
b
1084
c
1085
d
1086
END
1087
1088
1089
=head2 fromLetters($letters)
1090
1091
Create a tree from a string of letters returning the children created in alphabetic order - useful for testing.
1092
1093
Parameter Description
1094
1 $letters String of letters and ( ).
1095
1096
B
1097
1098
1099
1100
my ($a) = fromLetters(q(bc(d)e)); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1101
1102
1103
is_deeply $a->print, <
1104
Key Value
1105
a
1106
b
1107
c
1108
d
1109
e
1110
END
1111
1112
1113
=head1 Navigation
1114
1115
Navigate through a tree.
1116
1117
=head2 first($parent)
1118
1119
Get the first child under the specified parent.
1120
1121
Parameter Description
1122
1 $parent Parent
1123
1124
B
1125
1126
1127
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1128
is_deeply $c->parent, $b;
1129
1130
is_deeply $a->first, $b; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1131
1132
is_deeply $a->last, $d;
1133
is_deeply $e->next, $f;
1134
is_deeply $f->prev, $e;
1135
1136
1137
=head2 last($parent)
1138
1139
Get the last child under the specified parent.
1140
1141
Parameter Description
1142
1 $parent Parent
1143
1144
B
1145
1146
1147
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1148
is_deeply $c->parent, $b;
1149
is_deeply $a->first, $b;
1150
1151
is_deeply $a->last, $d; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1152
1153
is_deeply $e->next, $f;
1154
is_deeply $f->prev, $e;
1155
1156
1157
=head2 next($child)
1158
1159
Get the next sibling following the specified child.
1160
1161
Parameter Description
1162
1 $child Child
1163
1164
B
1165
1166
1167
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1168
is_deeply $c->parent, $b;
1169
is_deeply $a->first, $b;
1170
is_deeply $a->last, $d;
1171
1172
is_deeply $e->next, $f; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1173
1174
is_deeply $f->prev, $e;
1175
1176
1177
=head2 prev($child)
1178
1179
Get the previous sibling of the specified child.
1180
1181
Parameter Description
1182
1 $child Child
1183
1184
B
1185
1186
1187
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1188
is_deeply $c->parent, $b;
1189
is_deeply $a->first, $b;
1190
is_deeply $a->last, $d;
1191
is_deeply $e->next, $f;
1192
1193
is_deeply $f->prev, $e; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1194
1195
1196
1197
=head2 firstMost($parent)
1198
1199
Return the first most descendant child in the tree starting at this parent or else return B if this parent has no children.
1200
1201
Parameter Description
1202
1 $parent Parent
1203
1204
B
1205
1206
1207
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
1208
fromLetters 'b(c)y(x)d(efgh(i(j)))';
1209
1210
is_deeply $a->print, <
1211
Key Value
1212
a
1213
b
1214
c
1215
y
1216
x
1217
d
1218
e
1219
f
1220
g
1221
h
1222
i
1223
j
1224
END
1225
1226
is_deeply $a->xml,
1227
' ';
1228
1229
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
1230
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
1231
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
1232
is_deeply [$a->parents], [$a->parentsPostOrder];
1233
1234
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
1235
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
1236
1237
ok !$j->parents;
1238
1239
ok $a->lastMost == $j;
1240
ok !$a->prevMost;
1241
ok $j->prevMost == $g;
1242
ok $i->prevMost == $g;
1243
ok $h->prevMost == $g;
1244
ok $g->prevMost == $f;
1245
ok $f->prevMost == $e;
1246
ok $e->prevMost == $x;
1247
ok $d->prevMost == $x;
1248
ok $x->prevMost == $c;
1249
ok $y->prevMost == $c;
1250
ok !$c->prevMost;
1251
ok !$b->prevMost;
1252
ok !$a->prevMost;
1253
1254
1255
ok $a->firstMost == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1256
1257
ok $a->nextMost == $c;
1258
ok $b->nextMost == $c;
1259
ok $c->nextMost == $x;
1260
ok $y->nextMost == $x;
1261
ok $x->nextMost == $e;
1262
ok $d->nextMost == $e;
1263
ok $e->nextMost == $f;
1264
ok $f->nextMost == $g;
1265
ok $g->nextMost == $j;
1266
ok $h->nextMost == $j;
1267
ok $i->nextMost == $j;
1268
ok !$j->nextMost;
1269
1270
ok $i->topMost == $a;
1271
1272
1273
=head2 nextMost($child)
1274
1275
Return the next child with no children, i.e. the next leaf of the tree, else return B if there is no such child.
1276
1277
Parameter Description
1278
1 $child Current leaf
1279
1280
B
1281
1282
1283
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
1284
fromLetters 'b(c)y(x)d(efgh(i(j)))';
1285
1286
is_deeply $a->print, <
1287
Key Value
1288
a
1289
b
1290
c
1291
y
1292
x
1293
d
1294
e
1295
f
1296
g
1297
h
1298
i
1299
j
1300
END
1301
1302
is_deeply $a->xml,
1303
' ';
1304
1305
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
1306
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
1307
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
1308
is_deeply [$a->parents], [$a->parentsPostOrder];
1309
1310
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
1311
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
1312
1313
ok !$j->parents;
1314
1315
ok $a->lastMost == $j;
1316
ok !$a->prevMost;
1317
ok $j->prevMost == $g;
1318
ok $i->prevMost == $g;
1319
ok $h->prevMost == $g;
1320
ok $g->prevMost == $f;
1321
ok $f->prevMost == $e;
1322
ok $e->prevMost == $x;
1323
ok $d->prevMost == $x;
1324
ok $x->prevMost == $c;
1325
ok $y->prevMost == $c;
1326
ok !$c->prevMost;
1327
ok !$b->prevMost;
1328
ok !$a->prevMost;
1329
1330
ok $a->firstMost == $c;
1331
1332
ok $a->nextMost == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1333
1334
1335
ok $b->nextMost == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1336
1337
1338
ok $c->nextMost == $x; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1339
1340
1341
ok $y->nextMost == $x; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1342
1343
1344
ok $x->nextMost == $e; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1345
1346
1347
ok $d->nextMost == $e; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1348
1349
1350
ok $e->nextMost == $f; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1351
1352
1353
ok $f->nextMost == $g; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1354
1355
1356
ok $g->nextMost == $j; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1357
1358
1359
ok $h->nextMost == $j; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1360
1361
1362
ok $i->nextMost == $j; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1363
1364
1365
ok !$j->nextMost; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1366
1367
1368
ok $i->topMost == $a;
1369
1370
1371
=head2 prevMost($child)
1372
1373
Return the previous child with no children, i.e. the previous leaf of the tree, else return B if there is no such child.
1374
1375
Parameter Description
1376
1 $child Current leaf
1377
1378
B
1379
1380
1381
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
1382
fromLetters 'b(c)y(x)d(efgh(i(j)))';
1383
1384
is_deeply $a->print, <
1385
Key Value
1386
a
1387
b
1388
c
1389
y
1390
x
1391
d
1392
e
1393
f
1394
g
1395
h
1396
i
1397
j
1398
END
1399
1400
is_deeply $a->xml,
1401
' ';
1402
1403
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
1404
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
1405
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
1406
is_deeply [$a->parents], [$a->parentsPostOrder];
1407
1408
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
1409
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
1410
1411
ok !$j->parents;
1412
1413
ok $a->lastMost == $j;
1414
1415
ok !$a->prevMost; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1416
1417
1418
ok $j->prevMost == $g; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1419
1420
1421
ok $i->prevMost == $g; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1422
1423
1424
ok $h->prevMost == $g; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1425
1426
1427
ok $g->prevMost == $f; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1428
1429
1430
ok $f->prevMost == $e; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1431
1432
1433
ok $e->prevMost == $x; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1434
1435
1436
ok $d->prevMost == $x; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1437
1438
1439
ok $x->prevMost == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1440
1441
1442
ok $y->prevMost == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1443
1444
1445
ok !$c->prevMost; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1446
1447
1448
ok !$b->prevMost; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1449
1450
1451
ok !$a->prevMost; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1452
1453
1454
ok $a->firstMost == $c;
1455
ok $a->nextMost == $c;
1456
ok $b->nextMost == $c;
1457
ok $c->nextMost == $x;
1458
ok $y->nextMost == $x;
1459
ok $x->nextMost == $e;
1460
ok $d->nextMost == $e;
1461
ok $e->nextMost == $f;
1462
ok $f->nextMost == $g;
1463
ok $g->nextMost == $j;
1464
ok $h->nextMost == $j;
1465
ok $i->nextMost == $j;
1466
ok !$j->nextMost;
1467
1468
ok $i->topMost == $a;
1469
1470
1471
=head2 lastMost($parent)
1472
1473
Return the last most descendant child in the tree starting at this parent or else return B if this parent has no children.
1474
1475
Parameter Description
1476
1 $parent Parent
1477
1478
B
1479
1480
1481
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
1482
fromLetters 'b(c)y(x)d(efgh(i(j)))';
1483
1484
is_deeply $a->print, <
1485
Key Value
1486
a
1487
b
1488
c
1489
y
1490
x
1491
d
1492
e
1493
f
1494
g
1495
h
1496
i
1497
j
1498
END
1499
1500
is_deeply $a->xml,
1501
' ';
1502
1503
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
1504
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
1505
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
1506
is_deeply [$a->parents], [$a->parentsPostOrder];
1507
1508
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
1509
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
1510
1511
ok !$j->parents;
1512
1513
1514
ok $a->lastMost == $j; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1515
1516
ok !$a->prevMost;
1517
ok $j->prevMost == $g;
1518
ok $i->prevMost == $g;
1519
ok $h->prevMost == $g;
1520
ok $g->prevMost == $f;
1521
ok $f->prevMost == $e;
1522
ok $e->prevMost == $x;
1523
ok $d->prevMost == $x;
1524
ok $x->prevMost == $c;
1525
ok $y->prevMost == $c;
1526
ok !$c->prevMost;
1527
ok !$b->prevMost;
1528
ok !$a->prevMost;
1529
1530
ok $a->firstMost == $c;
1531
ok $a->nextMost == $c;
1532
ok $b->nextMost == $c;
1533
ok $c->nextMost == $x;
1534
ok $y->nextMost == $x;
1535
ok $x->nextMost == $e;
1536
ok $d->nextMost == $e;
1537
ok $e->nextMost == $f;
1538
ok $f->nextMost == $g;
1539
ok $g->nextMost == $j;
1540
ok $h->nextMost == $j;
1541
ok $i->nextMost == $j;
1542
ok !$j->nextMost;
1543
1544
ok $i->topMost == $a;
1545
1546
1547
=head2 topMost($child)
1548
1549
Return the top most parent in the tree containing the specified child.
1550
1551
Parameter Description
1552
1 $child Child
1553
1554
B
1555
1556
1557
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
1558
fromLetters 'b(c)y(x)d(efgh(i(j)))';
1559
1560
is_deeply $a->print, <
1561
Key Value
1562
a
1563
b
1564
c
1565
y
1566
x
1567
d
1568
e
1569
f
1570
g
1571
h
1572
i
1573
j
1574
END
1575
1576
is_deeply $a->xml,
1577
' ';
1578
1579
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
1580
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
1581
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
1582
is_deeply [$a->parents], [$a->parentsPostOrder];
1583
1584
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
1585
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
1586
1587
ok !$j->parents;
1588
1589
ok $a->lastMost == $j;
1590
ok !$a->prevMost;
1591
ok $j->prevMost == $g;
1592
ok $i->prevMost == $g;
1593
ok $h->prevMost == $g;
1594
ok $g->prevMost == $f;
1595
ok $f->prevMost == $e;
1596
ok $e->prevMost == $x;
1597
ok $d->prevMost == $x;
1598
ok $x->prevMost == $c;
1599
ok $y->prevMost == $c;
1600
ok !$c->prevMost;
1601
ok !$b->prevMost;
1602
ok !$a->prevMost;
1603
1604
ok $a->firstMost == $c;
1605
ok $a->nextMost == $c;
1606
ok $b->nextMost == $c;
1607
ok $c->nextMost == $x;
1608
ok $y->nextMost == $x;
1609
ok $x->nextMost == $e;
1610
ok $d->nextMost == $e;
1611
ok $e->nextMost == $f;
1612
ok $f->nextMost == $g;
1613
ok $g->nextMost == $j;
1614
ok $h->nextMost == $j;
1615
ok $i->nextMost == $j;
1616
ok !$j->nextMost;
1617
1618
1619
ok $i->topMost == $a; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1620
1621
1622
1623
=head2 mostRecentCommonAncestor($first, $second)
1624
1625
Find the most recent common ancestor of the specified children.
1626
1627
Parameter Description
1628
1 $first First child
1629
2 $second Second child
1630
1631
B
1632
1633
1634
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k) =
1635
fromLetters 'b(c(d(e))f(g(h)i)j)k';
1636
1637
is_deeply $a->print, <
1638
Key Value
1639
a
1640
b
1641
c
1642
d
1643
e
1644
f
1645
g
1646
h
1647
i
1648
j
1649
k
1650
END
1651
1652
1653
ok $e->mostRecentCommonAncestor($h) == $b; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1654
1655
1656
ok $e->mostRecentCommonAncestor($k) == $a; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1657
1658
1659
1660
=head2 go($parent, @path)
1661
1662
Return the child at the end of the path starting at the specified parent. A path is a list of zero based children numbers. Return B if the path is not valid.
1663
1664
Parameter Description
1665
1 $parent Parent
1666
2 @path List of zero based children numbers
1667
1668
B
1669
1670
1671
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cd(e(fg)h)i)j';
1672
1673
is_deeply $a->print, <
1674
Key Value
1675
a
1676
b
1677
c
1678
d
1679
e
1680
f
1681
g
1682
h
1683
i
1684
j
1685
END
1686
1687
1688
ok $a->go(0,1,0,1) == $g; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1689
1690
1691
ok $d->go(0,0) == $f; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1692
1693
1694
is_deeply [$e->path], [0,1,0];
1695
is_deeply [$g->pathFrom($d)], [0,1];
1696
1697
is_deeply $b->dup->print, <
1698
Key Value
1699
b
1700
c
1701
d
1702
e
1703
f
1704
g
1705
h
1706
i
1707
END
1708
1709
my $B = $b->transcribe;
1710
1711
$b->by(sub
1712
{my ($c) = @_;
1713
my @path = $c->pathFrom($b);
1714
1715
my $C = $B->go(@path); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1716
1717
is_deeply $c->key, $C->key;
1718
is_deeply $c->{transcribedTo}, $C;
1719
is_deeply $C->{transcribedFrom}, $c;
1720
});
1721
1722
is_deeply $B->print, <
1723
Key Value
1724
b
1725
c
1726
d
1727
e
1728
f
1729
g
1730
h
1731
i
1732
END
1733
1734
1735
=head1 Location
1736
1737
Verify the current location.
1738
1739
=head2 context($child)
1740
1741
Get the context of the current child.
1742
1743
Parameter Description
1744
1 $child Child
1745
1746
B
1747
1748
1749
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $s, $t, $x, $y, $z) =
1750
fromLetters 'b(c)y(x)z(st)d(efgh(i(j))))';
1751
1752
1753
is_deeply [$x->context], [$x, $y, $a]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1754
1755
1756
is_deeply join(' ', $a->by(sub{$_[0]->key})), "c b x y s t z e f g j i h d a";
1757
is_deeply join(' ', map{$_->key} $a->by), "c b x y s t z e f g j i h d a";
1758
1759
is_deeply $a->print, <
1760
Key Value
1761
a
1762
b
1763
c
1764
y
1765
x
1766
z
1767
s
1768
t
1769
d
1770
e
1771
f
1772
g
1773
h
1774
i
1775
j
1776
END
1777
1778
$z->cut;
1779
is_deeply $a->print, <
1780
Key Value
1781
a
1782
b
1783
c
1784
y
1785
x
1786
d
1787
e
1788
f
1789
g
1790
h
1791
i
1792
j
1793
END
1794
1795
1796
=head2 isFirst($child)
1797
1798
Return the specified child if that child is first under its parent, else return B.
1799
1800
Parameter Description
1801
1 $child Child
1802
1803
B
1804
1805
1806
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1807
1808
is_deeply $a->print, <
1809
Key Value
1810
a
1811
b
1812
c
1813
d
1814
e
1815
f
1816
g
1817
h
1818
i
1819
j
1820
END
1821
1822
is_deeply $b->singleChildOfParent, $c;
1823
1824
is_deeply $e->isFirst, $e; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1825
1826
1827
ok !$f->isFirst; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1828
1829
ok !$g->isLast;
1830
is_deeply $h->isLast, $h;
1831
ok $j->empty;
1832
ok !$i->empty;
1833
ok $a->isTop;
1834
ok !$b->isTop;
1835
1836
1837
=head2 isLast($child)
1838
1839
Return the specified child if that child is last under its parent, else return B.
1840
1841
Parameter Description
1842
1 $child Child
1843
1844
B
1845
1846
1847
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1848
1849
is_deeply $a->print, <
1850
Key Value
1851
a
1852
b
1853
c
1854
d
1855
e
1856
f
1857
g
1858
h
1859
i
1860
j
1861
END
1862
1863
is_deeply $b->singleChildOfParent, $c;
1864
is_deeply $e->isFirst, $e;
1865
ok !$f->isFirst;
1866
1867
ok !$g->isLast; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1868
1869
1870
is_deeply $h->isLast, $h; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1871
1872
ok $j->empty;
1873
ok !$i->empty;
1874
ok $a->isTop;
1875
ok !$b->isTop;
1876
1877
1878
=head2 isTop($parent)
1879
1880
Return the specified parent if that parent is the top most parent in the tree.
1881
1882
Parameter Description
1883
1 $parent Parent
1884
1885
B
1886
1887
1888
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1889
1890
is_deeply $a->print, <
1891
Key Value
1892
a
1893
b
1894
c
1895
d
1896
e
1897
f
1898
g
1899
h
1900
i
1901
j
1902
END
1903
1904
is_deeply $b->singleChildOfParent, $c;
1905
is_deeply $e->isFirst, $e;
1906
ok !$f->isFirst;
1907
ok !$g->isLast;
1908
is_deeply $h->isLast, $h;
1909
ok $j->empty;
1910
ok !$i->empty;
1911
1912
ok $a->isTop; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1913
1914
1915
ok !$b->isTop; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1916
1917
1918
1919
=head2 singleChildOfParent($parent)
1920
1921
Return the only child of this parent if the parent has an only child, else B
1922
1923
Parameter Description
1924
1 $parent Parent
1925
1926
B
1927
1928
1929
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1930
1931
is_deeply $a->print, <
1932
Key Value
1933
a
1934
b
1935
c
1936
d
1937
e
1938
f
1939
g
1940
h
1941
i
1942
j
1943
END
1944
1945
1946
is_deeply $b->singleChildOfParent, $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1947
1948
is_deeply $e->isFirst, $e;
1949
ok !$f->isFirst;
1950
ok !$g->isLast;
1951
is_deeply $h->isLast, $h;
1952
ok $j->empty;
1953
ok !$i->empty;
1954
ok $a->isTop;
1955
ok !$b->isTop;
1956
1957
1958
=head2 empty($parent)
1959
1960
Return the specified parent if it has no children else B
1961
1962
Parameter Description
1963
1 $parent Parent
1964
1965
B
1966
1967
1968
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
1969
1970
is_deeply $a->print, <
1971
Key Value
1972
a
1973
b
1974
c
1975
d
1976
e
1977
f
1978
g
1979
h
1980
i
1981
j
1982
END
1983
1984
is_deeply $b->singleChildOfParent, $c;
1985
is_deeply $e->isFirst, $e;
1986
ok !$f->isFirst;
1987
ok !$g->isLast;
1988
is_deeply $h->isLast, $h;
1989
1990
ok $j->empty; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1991
1992
1993
ok !$i->empty; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
1994
1995
ok $a->isTop;
1996
ok !$b->isTop;
1997
1998
1999
=head1 Put
2000
2001
Insert children into a tree.
2002
2003
=head2 putFirst($parent, $child)
2004
2005
Place a new child first under the specified parent and return the child.
2006
2007
Parameter Description
2008
1 $parent Parent
2009
2 $child Child
2010
2011
B
2012
2013
2014
my ($a, $b, $c, $d, $e) = fromLetters 'b(c)d(e)';
2015
2016
is_deeply $a->print, <
2017
Key Value
2018
a
2019
b
2020
c
2021
d
2022
e
2023
END
2024
2025
my $z = $b->putNext(new 'z');
2026
is_deeply $a->print, <
2027
Key Value
2028
a
2029
b
2030
c
2031
z
2032
d
2033
e
2034
END
2035
2036
my $y = $d->putPrev(new 'y');
2037
is_deeply $a->print, <
2038
Key Value
2039
a
2040
b
2041
c
2042
z
2043
y
2044
d
2045
e
2046
END
2047
2048
$z->putLast(new 't');
2049
is_deeply $a->print, <
2050
Key Value
2051
a
2052
b
2053
c
2054
z
2055
t
2056
y
2057
d
2058
e
2059
END
2060
2061
2062
$z->putFirst(new 's'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2063
2064
is_deeply $a->print, <
2065
Key Value
2066
a
2067
b
2068
c
2069
z
2070
s
2071
t
2072
y
2073
d
2074
e
2075
END
2076
2077
2078
=head2 putLast($parent, $child)
2079
2080
Place a new child last under the specified parent and return the child.
2081
2082
Parameter Description
2083
1 $parent Parent
2084
2 $child Child
2085
2086
B
2087
2088
2089
my ($a, $b, $c, $d, $e) = fromLetters 'b(c)d(e)';
2090
2091
is_deeply $a->print, <
2092
Key Value
2093
a
2094
b
2095
c
2096
d
2097
e
2098
END
2099
2100
my $z = $b->putNext(new 'z');
2101
is_deeply $a->print, <
2102
Key Value
2103
a
2104
b
2105
c
2106
z
2107
d
2108
e
2109
END
2110
2111
my $y = $d->putPrev(new 'y');
2112
is_deeply $a->print, <
2113
Key Value
2114
a
2115
b
2116
c
2117
z
2118
y
2119
d
2120
e
2121
END
2122
2123
2124
$z->putLast(new 't'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2125
2126
is_deeply $a->print, <
2127
Key Value
2128
a
2129
b
2130
c
2131
z
2132
t
2133
y
2134
d
2135
e
2136
END
2137
2138
$z->putFirst(new 's');
2139
is_deeply $a->print, <
2140
Key Value
2141
a
2142
b
2143
c
2144
z
2145
s
2146
t
2147
y
2148
d
2149
e
2150
END
2151
2152
2153
=head2 putNext($child, $new)
2154
2155
Place a new child after the specified child.
2156
2157
Parameter Description
2158
1 $child Existing child
2159
2 $new New child
2160
2161
B
2162
2163
2164
my ($a, $b, $c, $d, $e) = fromLetters 'b(c)d(e)';
2165
2166
is_deeply $a->print, <
2167
Key Value
2168
a
2169
b
2170
c
2171
d
2172
e
2173
END
2174
2175
2176
my $z = $b->putNext(new 'z'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2177
2178
is_deeply $a->print, <
2179
Key Value
2180
a
2181
b
2182
c
2183
z
2184
d
2185
e
2186
END
2187
2188
my $y = $d->putPrev(new 'y');
2189
is_deeply $a->print, <
2190
Key Value
2191
a
2192
b
2193
c
2194
z
2195
y
2196
d
2197
e
2198
END
2199
2200
$z->putLast(new 't');
2201
is_deeply $a->print, <
2202
Key Value
2203
a
2204
b
2205
c
2206
z
2207
t
2208
y
2209
d
2210
e
2211
END
2212
2213
$z->putFirst(new 's');
2214
is_deeply $a->print, <
2215
Key Value
2216
a
2217
b
2218
c
2219
z
2220
s
2221
t
2222
y
2223
d
2224
e
2225
END
2226
2227
2228
=head2 putPrev($child, $new)
2229
2230
Place a new child before the specified child.
2231
2232
Parameter Description
2233
1 $child Child
2234
2 $new New child
2235
2236
B
2237
2238
2239
my ($a, $b, $c, $d, $e) = fromLetters 'b(c)d(e)';
2240
2241
is_deeply $a->print, <
2242
Key Value
2243
a
2244
b
2245
c
2246
d
2247
e
2248
END
2249
2250
my $z = $b->putNext(new 'z');
2251
is_deeply $a->print, <
2252
Key Value
2253
a
2254
b
2255
c
2256
z
2257
d
2258
e
2259
END
2260
2261
2262
my $y = $d->putPrev(new 'y'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2263
2264
is_deeply $a->print, <
2265
Key Value
2266
a
2267
b
2268
c
2269
z
2270
y
2271
d
2272
e
2273
END
2274
2275
$z->putLast(new 't');
2276
is_deeply $a->print, <
2277
Key Value
2278
a
2279
b
2280
c
2281
z
2282
t
2283
y
2284
d
2285
e
2286
END
2287
2288
$z->putFirst(new 's');
2289
is_deeply $a->print, <
2290
Key Value
2291
a
2292
b
2293
c
2294
z
2295
s
2296
t
2297
y
2298
d
2299
e
2300
END
2301
2302
2303
=head1 Steps
2304
2305
Move the start or end of a scope forwards or backwards as suggested by Alex Monroe.
2306
2307
=head2 step($parent)
2308
2309
Make the first child of the specified parent the parents previous sibling and return the parent. In effect this moves the start of the parent one step forwards.
2310
2311
Parameter Description
2312
1 $parent Parent
2313
2314
B
2315
2316
2317
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2318
2319
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2320
2321
2322
$d->step; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2323
2324
is_deeply $a->brackets, 'a(b(c)ed(fgh(i(j))))';
2325
2326
$d->stepBack;
2327
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2328
2329
$b->stepEnd;
2330
is_deeply $a->brackets, 'a(b(cd(efgh(i(j)))))';
2331
2332
$b->stepEndBack;
2333
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2334
2335
2336
=head2 stepEnd($parent)
2337
2338
Make the next sibling of the specified parent the parents last child and return the parent. In effect this moves the end of the parent one step forwards.
2339
2340
Parameter Description
2341
1 $parent Parent
2342
2343
B
2344
2345
2346
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2347
2348
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2349
2350
$d->step;
2351
is_deeply $a->brackets, 'a(b(c)ed(fgh(i(j))))';
2352
2353
$d->stepBack;
2354
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2355
2356
2357
$b->stepEnd; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2358
2359
is_deeply $a->brackets, 'a(b(cd(efgh(i(j)))))';
2360
2361
$b->stepEndBack;
2362
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2363
2364
2365
=head2 stepBack()
2366
2367
Make the previous sibling of the specified parent the parents first child and return the parent. In effect this moves the start of the parent one step backwards.
2368
2369
2370
B
2371
2372
2373
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2374
2375
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2376
2377
$d->step;
2378
is_deeply $a->brackets, 'a(b(c)ed(fgh(i(j))))';
2379
2380
2381
$d->stepBack; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2382
2383
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2384
2385
$b->stepEnd;
2386
is_deeply $a->brackets, 'a(b(cd(efgh(i(j)))))';
2387
2388
$b->stepEndBack;
2389
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2390
2391
2392
=head2 stepEndBack()
2393
2394
Make the last child of the specified parent the parents next sibling and return the parent. In effect this moves the end of the parent one step backwards.
2395
2396
2397
B
2398
2399
2400
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2401
2402
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2403
2404
$d->step;
2405
is_deeply $a->brackets, 'a(b(c)ed(fgh(i(j))))';
2406
2407
$d->stepBack;
2408
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2409
2410
$b->stepEnd;
2411
is_deeply $a->brackets, 'a(b(cd(efgh(i(j)))))';
2412
2413
2414
$b->stepEndBack; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2415
2416
is_deeply $a->brackets, 'a(b(c)d(efgh(i(j))))';
2417
2418
2419
=head1 Edit
2420
2421
Edit a tree in situ.
2422
2423
=head2 cut($child)
2424
2425
Cut out a child and all its content and children, return it ready for reinsertion else where.
2426
2427
Parameter Description
2428
1 $child Child
2429
2430
B
2431
2432
2433
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $s, $t, $x, $y, $z) =
2434
fromLetters 'b(c)y(x)z(st)d(efgh(i(j))))';
2435
2436
is_deeply [$x->context], [$x, $y, $a];
2437
2438
is_deeply join(' ', $a->by(sub{$_[0]->key})), "c b x y s t z e f g j i h d a";
2439
is_deeply join(' ', map{$_->key} $a->by), "c b x y s t z e f g j i h d a";
2440
2441
is_deeply $a->print, <
2442
Key Value
2443
a
2444
b
2445
c
2446
y
2447
x
2448
z
2449
s
2450
t
2451
d
2452
e
2453
f
2454
g
2455
h
2456
i
2457
j
2458
END
2459
2460
2461
$z->cut; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2462
2463
is_deeply $a->print, <
2464
Key Value
2465
a
2466
b
2467
c
2468
y
2469
x
2470
d
2471
e
2472
f
2473
g
2474
h
2475
i
2476
j
2477
END
2478
2479
2480
=head2 dup($parent)
2481
2482
Duplicate a specified parent and all its descendants returning the root of the resulting tree.
2483
2484
Parameter Description
2485
1 $parent Parent
2486
2487
B
2488
2489
2490
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cd(e(fg)h)i)j';
2491
2492
is_deeply $a->print, <
2493
Key Value
2494
a
2495
b
2496
c
2497
d
2498
e
2499
f
2500
g
2501
h
2502
i
2503
j
2504
END
2505
2506
ok $a->go(0,1,0,1) == $g;
2507
ok $d->go(0,0) == $f;
2508
2509
is_deeply [$e->path], [0,1,0];
2510
is_deeply [$g->pathFrom($d)], [0,1];
2511
2512
2513
is_deeply $b->dup->print, <
2514
2515
Key Value
2516
b
2517
c
2518
d
2519
e
2520
f
2521
g
2522
h
2523
i
2524
END
2525
2526
my $B = $b->transcribe;
2527
2528
$b->by(sub
2529
{my ($c) = @_;
2530
my @path = $c->pathFrom($b);
2531
my $C = $B->go(@path);
2532
is_deeply $c->key, $C->key;
2533
is_deeply $c->{transcribedTo}, $C;
2534
is_deeply $C->{transcribedFrom}, $c;
2535
});
2536
2537
is_deeply $B->print, <
2538
Key Value
2539
b
2540
c
2541
d
2542
e
2543
f
2544
g
2545
h
2546
i
2547
END
2548
2549
2550
=head2 transcribe($parent)
2551
2552
Duplicate a specified parent and all its descendants recording the mapping in a temporary {transcribed} field in the tree being transcribed. Returns the root parent of the tree being duplicated.
2553
2554
Parameter Description
2555
1 $parent Parent
2556
2557
B
2558
2559
2560
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cd(e(fg)h)i)j';
2561
2562
is_deeply $a->print, <
2563
Key Value
2564
a
2565
b
2566
c
2567
d
2568
e
2569
f
2570
g
2571
h
2572
i
2573
j
2574
END
2575
2576
ok $a->go(0,1,0,1) == $g;
2577
ok $d->go(0,0) == $f;
2578
2579
is_deeply [$e->path], [0,1,0];
2580
is_deeply [$g->pathFrom($d)], [0,1];
2581
2582
is_deeply $b->dup->print, <
2583
Key Value
2584
b
2585
c
2586
d
2587
e
2588
f
2589
g
2590
h
2591
i
2592
END
2593
2594
2595
my $B = $b->transcribe; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2596
2597
2598
$b->by(sub
2599
{my ($c) = @_;
2600
my @path = $c->pathFrom($b);
2601
my $C = $B->go(@path);
2602
is_deeply $c->key, $C->key;
2603
is_deeply $c->{transcribedTo}, $C;
2604
is_deeply $C->{transcribedFrom}, $c;
2605
});
2606
2607
is_deeply $B->print, <
2608
Key Value
2609
b
2610
c
2611
d
2612
e
2613
f
2614
g
2615
h
2616
i
2617
END
2618
2619
2620
=head2 unwrap($child)
2621
2622
Unwrap the specified child and return that child.
2623
2624
Parameter Description
2625
1 $child Child
2626
2627
B
2628
2629
2630
my ($a, $b, $c, $d, $e, $f, $g) = fromLetters 'b(c(de)f)g';
2631
2632
is_deeply $a->print, <
2633
Key Value
2634
a
2635
b
2636
c
2637
d
2638
e
2639
f
2640
g
2641
END
2642
2643
$c->wrap('z');
2644
2645
is_deeply $a->print, <
2646
Key Value
2647
a
2648
b
2649
z
2650
c
2651
d
2652
e
2653
f
2654
g
2655
END
2656
2657
2658
$c->parent->unwrap; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2659
2660
2661
is_deeply $a->print, <
2662
Key Value
2663
a
2664
b
2665
c
2666
d
2667
e
2668
f
2669
g
2670
END
2671
2672
$c->wrapChildren("Z");
2673
2674
is_deeply $a->print, <
2675
Key Value
2676
a
2677
b
2678
c
2679
Z
2680
d
2681
e
2682
f
2683
g
2684
END
2685
2686
2687
=head2 wrap($child, $key, $value)
2688
2689
Wrap the specified child with a new parent and return the new parent optionally setting its L and L.
2690
2691
Parameter Description
2692
1 $child Child to wrap
2693
2 $key Optional key
2694
3 $value Optional value
2695
2696
B
2697
2698
2699
my ($a, $b, $c, $d, $e, $f, $g) = fromLetters 'b(c(de)f)g';
2700
2701
is_deeply $a->print, <
2702
Key Value
2703
a
2704
b
2705
c
2706
d
2707
e
2708
f
2709
g
2710
END
2711
2712
2713
$c->wrap('z'); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2714
2715
2716
is_deeply $a->print, <
2717
Key Value
2718
a
2719
b
2720
z
2721
c
2722
d
2723
e
2724
f
2725
g
2726
END
2727
2728
$c->parent->unwrap;
2729
2730
is_deeply $a->print, <
2731
Key Value
2732
a
2733
b
2734
c
2735
d
2736
e
2737
f
2738
g
2739
END
2740
2741
$c->wrapChildren("Z");
2742
2743
is_deeply $a->print, <
2744
Key Value
2745
a
2746
b
2747
c
2748
Z
2749
d
2750
e
2751
f
2752
g
2753
END
2754
2755
2756
=head2 wrapChildren($parent, $key, $value)
2757
2758
Wrap the children of the specified parent with a new intermediate parent that becomes the child of the specified parent, optionally setting the L and the L for the new parent. Return the new parent.
2759
2760
Parameter Description
2761
1 $parent Child to wrap
2762
2 $key Optional key for new wrapping parent
2763
3 $value Optional value for new wrapping parent
2764
2765
B
2766
2767
2768
my ($a, $b, $c, $d, $e, $f, $g) = fromLetters 'b(c(de)f)g';
2769
2770
is_deeply $a->print, <
2771
Key Value
2772
a
2773
b
2774
c
2775
d
2776
e
2777
f
2778
g
2779
END
2780
2781
$c->wrap('z');
2782
2783
is_deeply $a->print, <
2784
Key Value
2785
a
2786
b
2787
z
2788
c
2789
d
2790
e
2791
f
2792
g
2793
END
2794
2795
$c->parent->unwrap;
2796
2797
is_deeply $a->print, <
2798
Key Value
2799
a
2800
b
2801
c
2802
d
2803
e
2804
f
2805
g
2806
END
2807
2808
2809
$c->wrapChildren("Z"); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2810
2811
2812
is_deeply $a->print, <
2813
Key Value
2814
a
2815
b
2816
c
2817
Z
2818
d
2819
e
2820
f
2821
g
2822
END
2823
2824
2825
=head2 merge($parent)
2826
2827
Unwrap the children of the specified parent with the whose L fields L that of their parent. Returns the specified parent regardless.
2828
2829
Parameter Description
2830
1 $parent Merging parent
2831
2832
B
2833
2834
2835
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2836
2837
is_deeply $a->print, <
2838
Key Value
2839
a
2840
b
2841
c
2842
d
2843
e
2844
f
2845
g
2846
h
2847
i
2848
j
2849
END
2850
2851
$d->split;
2852
is_deeply $a->print, <
2853
Key Value
2854
a
2855
b
2856
c
2857
d
2858
d
2859
e
2860
d
2861
f
2862
d
2863
g
2864
d
2865
h
2866
i
2867
j
2868
END
2869
2870
$f->parent->mergeLikePrev;
2871
is_deeply $a->print, <
2872
Key Value
2873
a
2874
b
2875
c
2876
d
2877
d
2878
e
2879
f
2880
d
2881
g
2882
d
2883
h
2884
i
2885
j
2886
END
2887
2888
$g->parent->mergeLikeNext;
2889
is_deeply $a->print, <
2890
Key Value
2891
a
2892
b
2893
c
2894
d
2895
d
2896
e
2897
f
2898
d
2899
g
2900
h
2901
i
2902
j
2903
END
2904
2905
2906
$d->merge; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2907
2908
is_deeply $a->print, <
2909
Key Value
2910
a
2911
b
2912
c
2913
d
2914
e
2915
f
2916
g
2917
h
2918
i
2919
j
2920
END
2921
2922
2923
=head2 mergeLikePrev($child)
2924
2925
Merge the preceding sibling of the specified child if that sibling exists and the L data of the two siblings L. Returns the specified child regardless. From a proposal made by Micaela Monroe.
2926
2927
Parameter Description
2928
1 $child Child
2929
2930
B
2931
2932
2933
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
2934
2935
is_deeply $a->print, <
2936
Key Value
2937
a
2938
b
2939
c
2940
d
2941
e
2942
f
2943
g
2944
h
2945
i
2946
j
2947
END
2948
2949
$d->split;
2950
is_deeply $a->print, <
2951
Key Value
2952
a
2953
b
2954
c
2955
d
2956
d
2957
e
2958
d
2959
f
2960
d
2961
g
2962
d
2963
h
2964
i
2965
j
2966
END
2967
2968
2969
$f->parent->mergeLikePrev; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
2970
2971
is_deeply $a->print, <
2972
Key Value
2973
a
2974
b
2975
c
2976
d
2977
d
2978
e
2979
f
2980
d
2981
g
2982
d
2983
h
2984
i
2985
j
2986
END
2987
2988
$g->parent->mergeLikeNext;
2989
is_deeply $a->print, <
2990
Key Value
2991
a
2992
b
2993
c
2994
d
2995
d
2996
e
2997
f
2998
d
2999
g
3000
h
3001
i
3002
j
3003
END
3004
3005
$d->merge;
3006
is_deeply $a->print, <
3007
Key Value
3008
a
3009
b
3010
c
3011
d
3012
e
3013
f
3014
g
3015
h
3016
i
3017
j
3018
END
3019
3020
3021
=head2 mergeLikeNext($child)
3022
3023
Merge the following sibling of the specified child if that sibling exists and the L data of the two siblings L. Returns the specified child regardless. From a proposal made by Micaela Monroe.
3024
3025
Parameter Description
3026
1 $child Child
3027
3028
B
3029
3030
3031
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
3032
3033
is_deeply $a->print, <
3034
Key Value
3035
a
3036
b
3037
c
3038
d
3039
e
3040
f
3041
g
3042
h
3043
i
3044
j
3045
END
3046
3047
$d->split;
3048
is_deeply $a->print, <
3049
Key Value
3050
a
3051
b
3052
c
3053
d
3054
d
3055
e
3056
d
3057
f
3058
d
3059
g
3060
d
3061
h
3062
i
3063
j
3064
END
3065
3066
$f->parent->mergeLikePrev;
3067
is_deeply $a->print, <
3068
Key Value
3069
a
3070
b
3071
c
3072
d
3073
d
3074
e
3075
f
3076
d
3077
g
3078
d
3079
h
3080
i
3081
j
3082
END
3083
3084
3085
$g->parent->mergeLikeNext; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3086
3087
is_deeply $a->print, <
3088
Key Value
3089
a
3090
b
3091
c
3092
d
3093
d
3094
e
3095
f
3096
d
3097
g
3098
h
3099
i
3100
j
3101
END
3102
3103
$d->merge;
3104
is_deeply $a->print, <
3105
Key Value
3106
a
3107
b
3108
c
3109
d
3110
e
3111
f
3112
g
3113
h
3114
i
3115
j
3116
END
3117
3118
3119
=head2 split($parent)
3120
3121
Make the specified parent a grandparent of each of its children by interposing a copy of the specified parent between the specified parent and each of its children. Return the specified parent.
3122
3123
Parameter Description
3124
1 $parent Parent to make into a grand parent
3125
3126
B
3127
3128
3129
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(c)d(efgh(i(j)))';
3130
3131
is_deeply $a->print, <
3132
Key Value
3133
a
3134
b
3135
c
3136
d
3137
e
3138
f
3139
g
3140
h
3141
i
3142
j
3143
END
3144
3145
3146
$d->split; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3147
3148
is_deeply $a->print, <
3149
Key Value
3150
a
3151
b
3152
c
3153
d
3154
d
3155
e
3156
d
3157
f
3158
d
3159
g
3160
d
3161
h
3162
i
3163
j
3164
END
3165
3166
$f->parent->mergeLikePrev;
3167
is_deeply $a->print, <
3168
Key Value
3169
a
3170
b
3171
c
3172
d
3173
d
3174
e
3175
f
3176
d
3177
g
3178
d
3179
h
3180
i
3181
j
3182
END
3183
3184
$g->parent->mergeLikeNext;
3185
is_deeply $a->print, <
3186
Key Value
3187
a
3188
b
3189
c
3190
d
3191
d
3192
e
3193
f
3194
d
3195
g
3196
h
3197
i
3198
j
3199
END
3200
3201
$d->merge;
3202
is_deeply $a->print, <
3203
Key Value
3204
a
3205
b
3206
c
3207
d
3208
e
3209
f
3210
g
3211
h
3212
i
3213
j
3214
END
3215
3216
3217
=head1 Traverse
3218
3219
Traverse a tree.
3220
3221
=head2 by($tree, $sub)
3222
3223
Traverse a tree in post-order to process each child with the specified sub and return an array of the results of processing each child. If no sub sub is specified, the children are returned in tree order.
3224
3225
Parameter Description
3226
1 $tree Tree
3227
2 $sub Optional sub to process each child
3228
3229
B
3230
3231
3232
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $s, $t, $x, $y, $z) =
3233
fromLetters 'b(c)y(x)z(st)d(efgh(i(j))))';
3234
3235
is_deeply [$x->context], [$x, $y, $a];
3236
3237
3238
is_deeply join(' ', $a->by(sub{$_[0]->key})), "c b x y s t z e f g j i h d a"; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3239
3240
3241
is_deeply join(' ', map{$_->key} $a->by), "c b x y s t z e f g j i h d a"; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3242
3243
3244
is_deeply $a->print, <
3245
Key Value
3246
a
3247
b
3248
c
3249
y
3250
x
3251
z
3252
s
3253
t
3254
d
3255
e
3256
f
3257
g
3258
h
3259
i
3260
j
3261
END
3262
3263
$z->cut;
3264
is_deeply $a->print, <
3265
Key Value
3266
a
3267
b
3268
c
3269
y
3270
x
3271
d
3272
e
3273
f
3274
g
3275
h
3276
i
3277
j
3278
END
3279
3280
3281
=head2 select($tree, $select)
3282
3283
Select matching children in a tree in post-order. A child can be selected via named value, array of values, a hash of values, a regular expression or a sub reference.
3284
3285
Parameter Description
3286
1 $tree Tree
3287
2 $select Method to select a child
3288
3289
B
3290
3291
3292
my $a = Tree::Ops::new 'a', 'A';
3293
for(1..2)
3294
{$a->open ('b', "B$_");
3295
$a->single('c', "C$_");
3296
ok $a->activeScope->key eq 'b';
3297
$a->close;
3298
}
3299
$a->single ('d', 'D');
3300
$a->single ('e', 'E');
3301
is_deeply $a->print, <
3302
Key Value
3303
a A
3304
b B1
3305
c C1
3306
b B2
3307
c C2
3308
d D
3309
e E
3310
END
3311
3312
is_deeply [map{$_->value} $a->by], [qw(C1 B1 C2 B2 D E A)];
3313
3314
is_deeply $a->lastMost->prev->prev->first->key, 'c';
3315
is_deeply $a->first->next->last->parent->first->value, 'C2';
3316
3317
3318
is_deeply [map{$_->value} $a->select('b')], [qw(B1 B2)]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3319
3320
3321
is_deeply [map{$_->value} $a->select(qr(b|c))], [qw(B1 C1 B2 C2)]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3322
3323
3324
is_deeply [map{$_->value} $a->select(sub{$_[0] eq 'd'})], [qw(D)]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3325
3326
3327
$a->first->next->stepEnd->stepEnd->first->next->stepBack;
3328
is_deeply $a->print, <
3329
Key Value
3330
a A
3331
b B1
3332
c C1
3333
b B2
3334
d D
3335
c C2
3336
e E
3337
END
3338
3339
3340
=head1 Partitions
3341
3342
Various partitions of the tree
3343
3344
=head2 leaves($tree)
3345
3346
The set of all children without further children, i.e. each leaf of the tree.
3347
3348
Parameter Description
3349
1 $tree Tree
3350
3351
B
3352
3353
3354
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3355
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3356
3357
is_deeply $a->print, <
3358
Key Value
3359
a
3360
b
3361
c
3362
y
3363
x
3364
d
3365
e
3366
f
3367
g
3368
h
3369
i
3370
j
3371
END
3372
3373
is_deeply $a->xml,
3374
' ';
3375
3376
3377
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3378
3379
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
3380
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
3381
is_deeply [$a->parents], [$a->parentsPostOrder];
3382
3383
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
3384
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
3385
3386
ok !$j->parents;
3387
3388
ok $a->lastMost == $j;
3389
ok !$a->prevMost;
3390
ok $j->prevMost == $g;
3391
ok $i->prevMost == $g;
3392
ok $h->prevMost == $g;
3393
ok $g->prevMost == $f;
3394
ok $f->prevMost == $e;
3395
ok $e->prevMost == $x;
3396
ok $d->prevMost == $x;
3397
ok $x->prevMost == $c;
3398
ok $y->prevMost == $c;
3399
ok !$c->prevMost;
3400
ok !$b->prevMost;
3401
ok !$a->prevMost;
3402
3403
ok $a->firstMost == $c;
3404
ok $a->nextMost == $c;
3405
ok $b->nextMost == $c;
3406
ok $c->nextMost == $x;
3407
ok $y->nextMost == $x;
3408
ok $x->nextMost == $e;
3409
ok $d->nextMost == $e;
3410
ok $e->nextMost == $f;
3411
ok $f->nextMost == $g;
3412
ok $g->nextMost == $j;
3413
ok $h->nextMost == $j;
3414
ok $i->nextMost == $j;
3415
ok !$j->nextMost;
3416
3417
ok $i->topMost == $a;
3418
3419
3420
=head2 parentsPreOrder($tree)
3421
3422
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal pre-order.
3423
3424
Parameter Description
3425
1 $tree Tree
3426
3427
B
3428
3429
3430
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3431
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3432
3433
is_deeply $a->print, <
3434
Key Value
3435
a
3436
b
3437
c
3438
y
3439
x
3440
d
3441
e
3442
f
3443
g
3444
h
3445
i
3446
j
3447
END
3448
3449
is_deeply $a->xml,
3450
' ';
3451
3452
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
3453
3454
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3455
3456
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
3457
is_deeply [$a->parents], [$a->parentsPostOrder];
3458
3459
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
3460
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
3461
3462
ok !$j->parents;
3463
3464
ok $a->lastMost == $j;
3465
ok !$a->prevMost;
3466
ok $j->prevMost == $g;
3467
ok $i->prevMost == $g;
3468
ok $h->prevMost == $g;
3469
ok $g->prevMost == $f;
3470
ok $f->prevMost == $e;
3471
ok $e->prevMost == $x;
3472
ok $d->prevMost == $x;
3473
ok $x->prevMost == $c;
3474
ok $y->prevMost == $c;
3475
ok !$c->prevMost;
3476
ok !$b->prevMost;
3477
ok !$a->prevMost;
3478
3479
ok $a->firstMost == $c;
3480
ok $a->nextMost == $c;
3481
ok $b->nextMost == $c;
3482
ok $c->nextMost == $x;
3483
ok $y->nextMost == $x;
3484
ok $x->nextMost == $e;
3485
ok $d->nextMost == $e;
3486
ok $e->nextMost == $f;
3487
ok $f->nextMost == $g;
3488
ok $g->nextMost == $j;
3489
ok $h->nextMost == $j;
3490
ok $i->nextMost == $j;
3491
ok !$j->nextMost;
3492
3493
ok $i->topMost == $a;
3494
3495
3496
=head2 parentsPostOrder($tree)
3497
3498
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal post-order.
3499
3500
Parameter Description
3501
1 $tree Tree
3502
3503
B
3504
3505
3506
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3507
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3508
3509
is_deeply $a->print, <
3510
Key Value
3511
a
3512
b
3513
c
3514
y
3515
x
3516
d
3517
e
3518
f
3519
g
3520
h
3521
i
3522
j
3523
END
3524
3525
is_deeply $a->xml,
3526
' ';
3527
3528
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
3529
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
3530
3531
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3532
3533
3534
is_deeply [$a->parents], [$a->parentsPostOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3535
3536
3537
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
3538
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
3539
3540
ok !$j->parents;
3541
3542
ok $a->lastMost == $j;
3543
ok !$a->prevMost;
3544
ok $j->prevMost == $g;
3545
ok $i->prevMost == $g;
3546
ok $h->prevMost == $g;
3547
ok $g->prevMost == $f;
3548
ok $f->prevMost == $e;
3549
ok $e->prevMost == $x;
3550
ok $d->prevMost == $x;
3551
ok $x->prevMost == $c;
3552
ok $y->prevMost == $c;
3553
ok !$c->prevMost;
3554
ok !$b->prevMost;
3555
ok !$a->prevMost;
3556
3557
ok $a->firstMost == $c;
3558
ok $a->nextMost == $c;
3559
ok $b->nextMost == $c;
3560
ok $c->nextMost == $x;
3561
ok $y->nextMost == $x;
3562
ok $x->nextMost == $e;
3563
ok $d->nextMost == $e;
3564
ok $e->nextMost == $f;
3565
ok $f->nextMost == $g;
3566
ok $g->nextMost == $j;
3567
ok $h->nextMost == $j;
3568
ok $i->nextMost == $j;
3569
ok !$j->nextMost;
3570
3571
ok $i->topMost == $a;
3572
3573
3574
=head2 parentsReversePreOrder($tree)
3575
3576
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in reverse pre-order.
3577
3578
Parameter Description
3579
1 $tree Tree
3580
3581
B
3582
3583
3584
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3585
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3586
3587
is_deeply $a->print, <
3588
Key Value
3589
a
3590
b
3591
c
3592
y
3593
x
3594
d
3595
e
3596
f
3597
g
3598
h
3599
i
3600
j
3601
END
3602
3603
is_deeply $a->xml,
3604
' ';
3605
3606
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
3607
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
3608
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
3609
is_deeply [$a->parents], [$a->parentsPostOrder];
3610
3611
3612
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3613
3614
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
3615
3616
ok !$j->parents;
3617
3618
ok $a->lastMost == $j;
3619
ok !$a->prevMost;
3620
ok $j->prevMost == $g;
3621
ok $i->prevMost == $g;
3622
ok $h->prevMost == $g;
3623
ok $g->prevMost == $f;
3624
ok $f->prevMost == $e;
3625
ok $e->prevMost == $x;
3626
ok $d->prevMost == $x;
3627
ok $x->prevMost == $c;
3628
ok $y->prevMost == $c;
3629
ok !$c->prevMost;
3630
ok !$b->prevMost;
3631
ok !$a->prevMost;
3632
3633
ok $a->firstMost == $c;
3634
ok $a->nextMost == $c;
3635
ok $b->nextMost == $c;
3636
ok $c->nextMost == $x;
3637
ok $y->nextMost == $x;
3638
ok $x->nextMost == $e;
3639
ok $d->nextMost == $e;
3640
ok $e->nextMost == $f;
3641
ok $f->nextMost == $g;
3642
ok $g->nextMost == $j;
3643
ok $h->nextMost == $j;
3644
ok $i->nextMost == $j;
3645
ok !$j->nextMost;
3646
3647
ok $i->topMost == $a;
3648
3649
3650
=head2 parentsReversePostOrder($tree)
3651
3652
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in reverse post-order.
3653
3654
Parameter Description
3655
1 $tree Tree
3656
3657
B
3658
3659
3660
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3661
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3662
3663
is_deeply $a->print, <
3664
Key Value
3665
a
3666
b
3667
c
3668
y
3669
x
3670
d
3671
e
3672
f
3673
g
3674
h
3675
i
3676
j
3677
END
3678
3679
is_deeply $a->xml,
3680
' ';
3681
3682
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
3683
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
3684
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
3685
is_deeply [$a->parents], [$a->parentsPostOrder];
3686
3687
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
3688
3689
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3690
3691
3692
ok !$j->parents;
3693
3694
ok $a->lastMost == $j;
3695
ok !$a->prevMost;
3696
ok $j->prevMost == $g;
3697
ok $i->prevMost == $g;
3698
ok $h->prevMost == $g;
3699
ok $g->prevMost == $f;
3700
ok $f->prevMost == $e;
3701
ok $e->prevMost == $x;
3702
ok $d->prevMost == $x;
3703
ok $x->prevMost == $c;
3704
ok $y->prevMost == $c;
3705
ok !$c->prevMost;
3706
ok !$b->prevMost;
3707
ok !$a->prevMost;
3708
3709
ok $a->firstMost == $c;
3710
ok $a->nextMost == $c;
3711
ok $b->nextMost == $c;
3712
ok $c->nextMost == $x;
3713
ok $y->nextMost == $x;
3714
ok $x->nextMost == $e;
3715
ok $d->nextMost == $e;
3716
ok $e->nextMost == $f;
3717
ok $f->nextMost == $g;
3718
ok $g->nextMost == $j;
3719
ok $h->nextMost == $j;
3720
ok $i->nextMost == $j;
3721
ok !$j->nextMost;
3722
3723
ok $i->topMost == $a;
3724
3725
3726
=head2 parents($tree)
3727
3728
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in normal post-order.
3729
3730
Parameter Description
3731
1 $tree Tree
3732
3733
B
3734
3735
3736
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
3737
fromLetters 'b(c)y(x)d(efgh(i(j)))';
3738
3739
is_deeply $a->print, <
3740
Key Value
3741
a
3742
b
3743
c
3744
y
3745
x
3746
d
3747
e
3748
f
3749
g
3750
h
3751
i
3752
j
3753
END
3754
3755
is_deeply $a->xml,
3756
' ';
3757
3758
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
3759
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
3760
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
3761
3762
is_deeply [$a->parents], [$a->parentsPostOrder]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3763
3764
3765
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
3766
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
3767
3768
3769
ok !$j->parents; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3770
3771
3772
ok $a->lastMost == $j;
3773
ok !$a->prevMost;
3774
ok $j->prevMost == $g;
3775
ok $i->prevMost == $g;
3776
ok $h->prevMost == $g;
3777
ok $g->prevMost == $f;
3778
ok $f->prevMost == $e;
3779
ok $e->prevMost == $x;
3780
ok $d->prevMost == $x;
3781
ok $x->prevMost == $c;
3782
ok $y->prevMost == $c;
3783
ok !$c->prevMost;
3784
ok !$b->prevMost;
3785
ok !$a->prevMost;
3786
3787
ok $a->firstMost == $c;
3788
ok $a->nextMost == $c;
3789
ok $b->nextMost == $c;
3790
ok $c->nextMost == $x;
3791
ok $y->nextMost == $x;
3792
ok $x->nextMost == $e;
3793
ok $d->nextMost == $e;
3794
ok $e->nextMost == $f;
3795
ok $f->nextMost == $g;
3796
ok $g->nextMost == $j;
3797
ok $h->nextMost == $j;
3798
ok $i->nextMost == $j;
3799
ok !$j->nextMost;
3800
3801
ok $i->topMost == $a;
3802
3803
3804
=head1 Order
3805
3806
Check the order and relative position of children in a tree.
3807
3808
=head2 above($first, $second)
3809
3810
Return the first child if it is above the second child else return B.
3811
3812
Parameter Description
3813
1 $first First child
3814
2 $second Second child
3815
3816
B
3817
3818
3819
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n) =
3820
fromLetters('b(c(d(efgh(i(j)k)l)m)n');
3821
3822
is_deeply $a->print, <
3823
Key Value
3824
a
3825
b
3826
c
3827
d
3828
e
3829
f
3830
g
3831
h
3832
i
3833
j
3834
k
3835
l
3836
m
3837
n
3838
END
3839
3840
3841
ok $c->above($j) == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3842
3843
3844
ok !$m->above($j); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3845
3846
3847
ok $i->below($b) == $i;
3848
ok !$i->below($n);
3849
3850
ok $n->after($e) == $n;
3851
ok !$k->after($c);
3852
3853
ok $c->before($n) == $c;
3854
ok !$c->before($m);
3855
3856
is_deeply [map{$_->key} $j->lineage($d)], [qw(j i h d)];
3857
ok !$d->lineage($m);
3858
3859
3860
=head2 below($first, $second)
3861
3862
Return the first child if it is below the second child else return B.
3863
3864
Parameter Description
3865
1 $first First child
3866
2 $second Second child
3867
3868
B
3869
3870
3871
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n) =
3872
fromLetters('b(c(d(efgh(i(j)k)l)m)n');
3873
3874
is_deeply $a->print, <
3875
Key Value
3876
a
3877
b
3878
c
3879
d
3880
e
3881
f
3882
g
3883
h
3884
i
3885
j
3886
k
3887
l
3888
m
3889
n
3890
END
3891
3892
ok $c->above($j) == $c;
3893
ok !$m->above($j);
3894
3895
3896
ok $i->below($b) == $i; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3897
3898
3899
ok !$i->below($n); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3900
3901
3902
ok $n->after($e) == $n;
3903
ok !$k->after($c);
3904
3905
ok $c->before($n) == $c;
3906
ok !$c->before($m);
3907
3908
is_deeply [map{$_->key} $j->lineage($d)], [qw(j i h d)];
3909
ok !$d->lineage($m);
3910
3911
3912
=head2 after($first, $second)
3913
3914
Return the first child if it occurs strictly after the second child in the tree or else B if the first child is L, L or L the second child.
3915
3916
Parameter Description
3917
1 $first First child
3918
2 $second Second child
3919
3920
B
3921
3922
3923
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n) =
3924
fromLetters('b(c(d(efgh(i(j)k)l)m)n');
3925
3926
is_deeply $a->print, <
3927
Key Value
3928
a
3929
b
3930
c
3931
d
3932
e
3933
f
3934
g
3935
h
3936
i
3937
j
3938
k
3939
l
3940
m
3941
n
3942
END
3943
3944
ok $c->above($j) == $c;
3945
ok !$m->above($j);
3946
3947
ok $i->below($b) == $i;
3948
ok !$i->below($n);
3949
3950
3951
ok $n->after($e) == $n; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3952
3953
3954
ok !$k->after($c); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3955
3956
3957
ok $c->before($n) == $c;
3958
ok !$c->before($m);
3959
3960
is_deeply [map{$_->key} $j->lineage($d)], [qw(j i h d)];
3961
ok !$d->lineage($m);
3962
3963
3964
=head2 before($first, $second)
3965
3966
Return the first child if it occurs strictly before the second child in the tree or else B if the first child is L, L or L the second child.
3967
3968
Parameter Description
3969
1 $first First child
3970
2 $second Second child
3971
3972
B
3973
3974
3975
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n) =
3976
fromLetters('b(c(d(efgh(i(j)k)l)m)n');
3977
3978
is_deeply $a->print, <
3979
Key Value
3980
a
3981
b
3982
c
3983
d
3984
e
3985
f
3986
g
3987
h
3988
i
3989
j
3990
k
3991
l
3992
m
3993
n
3994
END
3995
3996
ok $c->above($j) == $c;
3997
ok !$m->above($j);
3998
3999
ok $i->below($b) == $i;
4000
ok !$i->below($n);
4001
4002
ok $n->after($e) == $n;
4003
ok !$k->after($c);
4004
4005
4006
ok $c->before($n) == $c; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4007
4008
4009
ok !$c->before($m); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4010
4011
4012
is_deeply [map{$_->key} $j->lineage($d)], [qw(j i h d)];
4013
ok !$d->lineage($m);
4014
4015
4016
=head1 Paths
4017
4018
Find paths between nodes
4019
4020
=head2 path($child)
4021
4022
Return the list of zero based child indexes for the path from the root of the tree containing the specified child to the specified child for use by the L method.
4023
4024
Parameter Description
4025
1 $child Child
4026
4027
B
4028
4029
4030
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cd(e(fg)h)i)j';
4031
4032
is_deeply $a->print, <
4033
Key Value
4034
a
4035
b
4036
c
4037
d
4038
e
4039
f
4040
g
4041
h
4042
i
4043
j
4044
END
4045
4046
ok $a->go(0,1,0,1) == $g;
4047
ok $d->go(0,0) == $f;
4048
4049
4050
is_deeply [$e->path], [0,1,0]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4051
4052
is_deeply [$g->pathFrom($d)], [0,1];
4053
4054
is_deeply $b->dup->print, <
4055
Key Value
4056
b
4057
c
4058
d
4059
e
4060
f
4061
g
4062
h
4063
i
4064
END
4065
4066
my $B = $b->transcribe;
4067
4068
$b->by(sub
4069
{my ($c) = @_;
4070
4071
my @path = $c->pathFrom($b); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4072
4073
4074
my $C = $B->go(@path); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4075
4076
is_deeply $c->key, $C->key;
4077
is_deeply $c->{transcribedTo}, $C;
4078
is_deeply $C->{transcribedFrom}, $c;
4079
});
4080
4081
is_deeply $B->print, <
4082
Key Value
4083
b
4084
c
4085
d
4086
e
4087
f
4088
g
4089
h
4090
i
4091
END
4092
4093
4094
=head2 pathFrom($child, $ancestor)
4095
4096
Return the list of zero based child indexes for the path from the specified ancestor to the specified child for use by the L method else confess if the ancestor is not, in fact, an ancestor.
4097
4098
Parameter Description
4099
1 $child Child
4100
2 $ancestor Ancestor
4101
4102
B
4103
4104
4105
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cd(e(fg)h)i)j';
4106
4107
is_deeply $a->print, <
4108
Key Value
4109
a
4110
b
4111
c
4112
d
4113
e
4114
f
4115
g
4116
h
4117
i
4118
j
4119
END
4120
4121
ok $a->go(0,1,0,1) == $g;
4122
ok $d->go(0,0) == $f;
4123
4124
is_deeply [$e->path], [0,1,0];
4125
4126
is_deeply [$g->pathFrom($d)], [0,1]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4127
4128
4129
is_deeply $b->dup->print, <
4130
Key Value
4131
b
4132
c
4133
d
4134
e
4135
f
4136
g
4137
h
4138
i
4139
END
4140
4141
my $B = $b->transcribe;
4142
4143
$b->by(sub
4144
{my ($c) = @_;
4145
4146
my @path = $c->pathFrom($b); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4147
4148
my $C = $B->go(@path);
4149
is_deeply $c->key, $C->key;
4150
is_deeply $c->{transcribedTo}, $C;
4151
is_deeply $C->{transcribedFrom}, $c;
4152
});
4153
4154
is_deeply $B->print, <
4155
Key Value
4156
b
4157
c
4158
d
4159
e
4160
f
4161
g
4162
h
4163
i
4164
END
4165
4166
4167
=head2 siblingsBefore($child)
4168
4169
Return a list of siblings before the specified child.
4170
4171
Parameter Description
4172
1 $child Child
4173
4174
B
4175
4176
4177
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cde(f)ghi)j';
4178
is_deeply $a->print, <
4179
Key Value
4180
a
4181
b
4182
c
4183
d
4184
e
4185
f
4186
g
4187
h
4188
i
4189
j
4190
END
4191
4192
is_deeply [$d->siblingsStrictlyBetween($h)], [$e, $g];
4193
is_deeply [$d->siblingsAfter], [$e, $g, $h, $i];
4194
4195
is_deeply [$g->siblingsBefore], [$c, $d, $e]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4196
4197
eval {$e->siblingsStrictlyBetween($f)};
4198
ok $@ =~ m(Must be siblings);
4199
4200
4201
=head2 siblingsAfter($child)
4202
4203
Return a list of siblings after the specified child.
4204
4205
Parameter Description
4206
1 $child Child
4207
4208
B
4209
4210
4211
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cde(f)ghi)j';
4212
is_deeply $a->print, <
4213
Key Value
4214
a
4215
b
4216
c
4217
d
4218
e
4219
f
4220
g
4221
h
4222
i
4223
j
4224
END
4225
4226
is_deeply [$d->siblingsStrictlyBetween($h)], [$e, $g];
4227
4228
is_deeply [$d->siblingsAfter], [$e, $g, $h, $i]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4229
4230
is_deeply [$g->siblingsBefore], [$c, $d, $e];
4231
eval {$e->siblingsStrictlyBetween($f)};
4232
ok $@ =~ m(Must be siblings);
4233
4234
4235
=head2 siblingsStrictlyBetween($start, $finish)
4236
4237
Return a list of the siblings strictly between two children of the same parent else return B.
4238
4239
Parameter Description
4240
1 $start Start child
4241
2 $finish Finish child
4242
4243
B
4244
4245
4246
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j) = fromLetters 'b(cde(f)ghi)j';
4247
is_deeply $a->print, <
4248
Key Value
4249
a
4250
b
4251
c
4252
d
4253
e
4254
f
4255
g
4256
h
4257
i
4258
j
4259
END
4260
4261
4262
is_deeply [$d->siblingsStrictlyBetween($h)], [$e, $g]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4263
4264
is_deeply [$d->siblingsAfter], [$e, $g, $h, $i];
4265
is_deeply [$g->siblingsBefore], [$c, $d, $e];
4266
4267
eval {$e->siblingsStrictlyBetween($f)}; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4268
4269
ok $@ =~ m(Must be siblings);
4270
4271
4272
=head2 lineage($child, $ancestor)
4273
4274
Return the path from the specified child to the specified ancestor else return B if the child is not a descendant of the ancestor.
4275
4276
Parameter Description
4277
1 $child Child
4278
2 $ancestor Ancestor
4279
4280
B
4281
4282
4283
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n) =
4284
fromLetters('b(c(d(efgh(i(j)k)l)m)n');
4285
4286
is_deeply $a->print, <
4287
Key Value
4288
a
4289
b
4290
c
4291
d
4292
e
4293
f
4294
g
4295
h
4296
i
4297
j
4298
k
4299
l
4300
m
4301
n
4302
END
4303
4304
ok $c->above($j) == $c;
4305
ok !$m->above($j);
4306
4307
ok $i->below($b) == $i;
4308
ok !$i->below($n);
4309
4310
ok $n->after($e) == $n;
4311
ok !$k->after($c);
4312
4313
ok $c->before($n) == $c;
4314
ok !$c->before($m);
4315
4316
4317
is_deeply [map{$_->key} $j->lineage($d)], [qw(j i h d)]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4318
4319
4320
ok !$d->lineage($m); # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4321
4322
4323
4324
=head2 nextPreOrderPath($start)
4325
4326
Return a list of children visited between the specified child and the next child in pre-order.
4327
4328
Parameter Description
4329
1 $start The child at the start of the path
4330
4331
B
4332
4333
4334
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r) =
4335
fromLetters 'b(c(d(e(fg)hi(j(kl)m)n)op)q)r';
4336
my @p = [$a];
4337
4338
for(1..99)
4339
4340
{my @n = $p[-1][-1]->nextPreOrderPath; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4341
4342
last unless @n;
4343
push @p, [@n];
4344
}
4345
4346
is_deeply $a->print, <
4347
Key Value
4348
a
4349
b
4350
c
4351
d
4352
e
4353
f
4354
g
4355
h
4356
i
4357
j
4358
k
4359
l
4360
m
4361
n
4362
o
4363
p
4364
q
4365
r
4366
END
4367
4368
my @pre = map{[map{$_->key} @$_]} @p;
4369
is_deeply scalar(@pre), scalar(['a'..'r']->@*);
4370
is_deeply [@pre],
4371
[["a"],
4372
["b"],
4373
["c"],
4374
["d"],
4375
["e"],
4376
["f"],
4377
["g"],
4378
["e", "h"],
4379
["i"],
4380
["j"],
4381
["k"],
4382
["l"],
4383
["j", "m"],
4384
["i", "n"],
4385
["d", "o"],
4386
["p"],
4387
["c", "q"],
4388
["b", "r"]];
4389
4390
4391
=head2 nextPostOrderPath($start)
4392
4393
Return a list of children visited between the specified child and the next child in post-order.
4394
4395
Parameter Description
4396
1 $start The child at the start of the path
4397
4398
B
4399
4400
4401
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r) =
4402
fromLetters 'b(c(d(e(fg)hi(j(kl)m)n)op)q)r';
4403
4404
my @n = $a;
4405
my @p;
4406
for(1..99)
4407
4408
{@n = $n[-1]->nextPostOrderPath; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4409
4410
last unless @n;
4411
push @p, [@n];
4412
last if $n[-1] == $a;
4413
}
4414
4415
is_deeply $a->print, <
4416
Key Value
4417
a
4418
b
4419
c
4420
d
4421
e
4422
f
4423
g
4424
h
4425
i
4426
j
4427
k
4428
l
4429
m
4430
n
4431
o
4432
p
4433
q
4434
r
4435
END
4436
4437
my @post = map{[map{$_->key} @$_]} @p;
4438
is_deeply scalar(@post), scalar(['a'..'r']->@*);
4439
is_deeply [@post],
4440
[["b" .. "f"],
4441
["g"],
4442
["e"],
4443
["h"],
4444
["i", "j", "k"],
4445
["l"],
4446
["j"],
4447
["m"],
4448
["i"],
4449
["n"],
4450
["d"],
4451
["o"],
4452
["p"],
4453
["c"],
4454
["q"],
4455
["b"],
4456
["r"],
4457
["a"]];
4458
4459
4460
=head2 prevPostOrderPath($start)
4461
4462
Return a list of children visited between the specified child and the previous child in post-order.
4463
4464
Parameter Description
4465
1 $start The child at the start of the path
4466
4467
B
4468
4469
4470
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r) =
4471
fromLetters 'b(c(d(e(fg)hi(j(kl)m)n)op)q)r';
4472
my @p = [$a];
4473
4474
for(1..99)
4475
4476
{my @n = $p[-1][-1]->prevPostOrderPath; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4477
4478
last unless @n;
4479
push @p, [@n];
4480
}
4481
4482
is_deeply $a->print, <
4483
Key Value
4484
a
4485
b
4486
c
4487
d
4488
e
4489
f
4490
g
4491
h
4492
i
4493
j
4494
k
4495
l
4496
m
4497
n
4498
o
4499
p
4500
q
4501
r
4502
END
4503
4504
my @post = map{[map{$_->key} @$_]} @p;
4505
is_deeply scalar(@post), scalar(['a'..'r']->@*);
4506
is_deeply [@post],
4507
[["a"],
4508
["r"],
4509
["b"],
4510
["q"],
4511
["c"],
4512
["p"],
4513
["o"],
4514
["d"],
4515
["n"],
4516
["i"],
4517
["m"],
4518
["j"],
4519
["l"],
4520
["k"],
4521
["j", "i", "h"],
4522
["e"],
4523
["g"],
4524
["f"]];
4525
4526
4527
=head2 prevPreOrderPath($start)
4528
4529
Return a list of children visited between the specified child and the previous child in pre-order.
4530
4531
Parameter Description
4532
1 $start The child at the start of the path
4533
4534
B
4535
4536
4537
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r) =
4538
fromLetters 'b(c(d(e(fg)hi(j(kl)m)n)op)q)r';
4539
4540
my @n = $a;
4541
my @p;
4542
for(1..99)
4543
4544
{@n = $n[-1]->prevPreOrderPath; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
4545
4546
last unless @n;
4547
push @p, [@n];
4548
last if $n[-1] == $a;
4549
}
4550
4551
is_deeply $a->print, <
4552
Key Value
4553
a
4554
b
4555
c
4556
d
4557
e
4558
f
4559
g
4560
h
4561
i
4562
j
4563
k
4564
l
4565
m
4566
n
4567
o
4568
p
4569
q
4570
r
4571
END
4572
4573
my @pre = map{[map{$_->key} @$_]} @p;
4574
is_deeply scalar(@pre), scalar(['a'..'r']->@*);
4575
is_deeply [@pre],
4576
[["r"],
4577
["b", "q"],
4578
["c", "p"],
4579
["o"],
4580
["d", "n"],
4581
["i", "m"],
4582
["j", "l"],
4583
["k"],
4584
["j"],
4585
["i"],
4586
["h"],
4587
["e", "g"],
4588
["f"],
4589
["e"],
4590
["d"],
4591
["c"],
4592
["b"],
4593
["a"]];
4594
4595
4596
=head1 Print
4597
4598
Print a tree.
4599
4600
=head2 printPreOrder($tree, $print)
4601
4602
Print tree in normal pre-order.
4603
4604
Parameter Description
4605
1 $tree Tree
4606
2 $print Optional print method
4607
4608
B
4609
4610
4611
my ($a, $b, $c, $d) = fromLetters 'b(c)d';
4612
my sub test(@) {join ' ', map{join '', $_->key} @_}
4613
4614
4615
is_deeply $a->printPreOrder, <
4616
4617
Key Value
4618
a
4619
b
4620
c
4621
d
4622
END
4623
4624
is_deeply test($a->nextPreOrderPath), 'b';
4625
is_deeply test($b->nextPreOrderPath), 'c';
4626
is_deeply test($c->nextPreOrderPath), 'b d';
4627
is_deeply test($d->nextPreOrderPath), '';
4628
4629
is_deeply $a->printPostOrder, <
4630
Key Value
4631
c
4632
b
4633
d
4634
a
4635
END
4636
4637
is_deeply test($a->nextPostOrderPath), 'b c';
4638
is_deeply test($c->nextPostOrderPath), 'b';
4639
is_deeply test($b->nextPostOrderPath), 'd';
4640
is_deeply test($d->nextPostOrderPath), 'a';
4641
4642
is_deeply $a->printReversePreOrder, <
4643
Key Value
4644
a
4645
d
4646
b
4647
c
4648
END
4649
is_deeply test($a->prevPreOrderPath), 'd';
4650
is_deeply test($d->prevPreOrderPath), 'b c';
4651
is_deeply test($c->prevPreOrderPath), 'b';
4652
is_deeply test($b->prevPreOrderPath), 'a';
4653
4654
is_deeply $a->printReversePostOrder, <
4655
Key Value
4656
d
4657
c
4658
b
4659
a
4660
END
4661
4662
is_deeply test($a->prevPostOrderPath), 'd';
4663
is_deeply test($d->prevPostOrderPath), 'b';
4664
is_deeply test($b->prevPostOrderPath), 'c';
4665
is_deeply test($c->prevPostOrderPath), '';
4666
4667
4668
=head2 printPostOrder($tree, $print)
4669
4670
Print tree in normal post-order.
4671
4672
Parameter Description
4673
1 $tree Tree
4674
2 $print Optional print method
4675
4676
B
4677
4678
4679
my ($a, $b, $c, $d) = fromLetters 'b(c)d';
4680
my sub test(@) {join ' ', map{join '', $_->key} @_}
4681
4682
is_deeply $a->printPreOrder, <
4683
Key Value
4684
a
4685
b
4686
c
4687
d
4688
END
4689
4690
is_deeply test($a->nextPreOrderPath), 'b';
4691
is_deeply test($b->nextPreOrderPath), 'c';
4692
is_deeply test($c->nextPreOrderPath), 'b d';
4693
is_deeply test($d->nextPreOrderPath), '';
4694
4695
4696
is_deeply $a->printPostOrder, <
4697
4698
Key Value
4699
c
4700
b
4701
d
4702
a
4703
END
4704
4705
is_deeply test($a->nextPostOrderPath), 'b c';
4706
is_deeply test($c->nextPostOrderPath), 'b';
4707
is_deeply test($b->nextPostOrderPath), 'd';
4708
is_deeply test($d->nextPostOrderPath), 'a';
4709
4710
is_deeply $a->printReversePreOrder, <
4711
Key Value
4712
a
4713
d
4714
b
4715
c
4716
END
4717
is_deeply test($a->prevPreOrderPath), 'd';
4718
is_deeply test($d->prevPreOrderPath), 'b c';
4719
is_deeply test($c->prevPreOrderPath), 'b';
4720
is_deeply test($b->prevPreOrderPath), 'a';
4721
4722
is_deeply $a->printReversePostOrder, <
4723
Key Value
4724
d
4725
c
4726
b
4727
a
4728
END
4729
4730
is_deeply test($a->prevPostOrderPath), 'd';
4731
is_deeply test($d->prevPostOrderPath), 'b';
4732
is_deeply test($b->prevPostOrderPath), 'c';
4733
is_deeply test($c->prevPostOrderPath), '';
4734
4735
4736
=head2 printReversePreOrder($tree, $print)
4737
4738
Print tree in reverse pre-order
4739
4740
Parameter Description
4741
1 $tree Tree
4742
2 $print Optional print method
4743
4744
B
4745
4746
4747
my ($a, $b, $c, $d) = fromLetters 'b(c)d';
4748
my sub test(@) {join ' ', map{join '', $_->key} @_}
4749
4750
is_deeply $a->printPreOrder, <
4751
Key Value
4752
a
4753
b
4754
c
4755
d
4756
END
4757
4758
is_deeply test($a->nextPreOrderPath), 'b';
4759
is_deeply test($b->nextPreOrderPath), 'c';
4760
is_deeply test($c->nextPreOrderPath), 'b d';
4761
is_deeply test($d->nextPreOrderPath), '';
4762
4763
is_deeply $a->printPostOrder, <
4764
Key Value
4765
c
4766
b
4767
d
4768
a
4769
END
4770
4771
is_deeply test($a->nextPostOrderPath), 'b c';
4772
is_deeply test($c->nextPostOrderPath), 'b';
4773
is_deeply test($b->nextPostOrderPath), 'd';
4774
is_deeply test($d->nextPostOrderPath), 'a';
4775
4776
4777
is_deeply $a->printReversePreOrder, <
4778
4779
Key Value
4780
a
4781
d
4782
b
4783
c
4784
END
4785
is_deeply test($a->prevPreOrderPath), 'd';
4786
is_deeply test($d->prevPreOrderPath), 'b c';
4787
is_deeply test($c->prevPreOrderPath), 'b';
4788
is_deeply test($b->prevPreOrderPath), 'a';
4789
4790
is_deeply $a->printReversePostOrder, <
4791
Key Value
4792
d
4793
c
4794
b
4795
a
4796
END
4797
4798
is_deeply test($a->prevPostOrderPath), 'd';
4799
is_deeply test($d->prevPostOrderPath), 'b';
4800
is_deeply test($b->prevPostOrderPath), 'c';
4801
is_deeply test($c->prevPostOrderPath), '';
4802
4803
4804
=head2 printReversePostOrder($tree, $print)
4805
4806
Print tree in reverse post-order
4807
4808
Parameter Description
4809
1 $tree Tree
4810
2 $print Optional print method
4811
4812
B
4813
4814
4815
my ($a, $b, $c, $d) = fromLetters 'b(c)d';
4816
my sub test(@) {join ' ', map{join '', $_->key} @_}
4817
4818
is_deeply $a->printPreOrder, <
4819
Key Value
4820
a
4821
b
4822
c
4823
d
4824
END
4825
4826
is_deeply test($a->nextPreOrderPath), 'b';
4827
is_deeply test($b->nextPreOrderPath), 'c';
4828
is_deeply test($c->nextPreOrderPath), 'b d';
4829
is_deeply test($d->nextPreOrderPath), '';
4830
4831
is_deeply $a->printPostOrder, <
4832
Key Value
4833
c
4834
b
4835
d
4836
a
4837
END
4838
4839
is_deeply test($a->nextPostOrderPath), 'b c';
4840
is_deeply test($c->nextPostOrderPath), 'b';
4841
is_deeply test($b->nextPostOrderPath), 'd';
4842
is_deeply test($d->nextPostOrderPath), 'a';
4843
4844
is_deeply $a->printReversePreOrder, <
4845
Key Value
4846
a
4847
d
4848
b
4849
c
4850
END
4851
is_deeply test($a->prevPreOrderPath), 'd';
4852
is_deeply test($d->prevPreOrderPath), 'b c';
4853
is_deeply test($c->prevPreOrderPath), 'b';
4854
is_deeply test($b->prevPreOrderPath), 'a';
4855
4856
4857
is_deeply $a->printReversePostOrder, <
4858
4859
Key Value
4860
d
4861
c
4862
b
4863
a
4864
END
4865
4866
is_deeply test($a->prevPostOrderPath), 'd';
4867
is_deeply test($d->prevPostOrderPath), 'b';
4868
is_deeply test($b->prevPostOrderPath), 'c';
4869
is_deeply test($c->prevPostOrderPath), '';
4870
4871
4872
=head2 print($tree, $print)
4873
4874
Print tree in normal pre-order.
4875
4876
Parameter Description
4877
1 $tree Tree
4878
2 $print Optional print method
4879
4880
B
4881
4882
4883
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
4884
fromLetters 'b(c)y(x)d(efgh(i(j)))';
4885
4886
4887
is_deeply $a->print, <
4888
4889
Key Value
4890
a
4891
b
4892
c
4893
y
4894
x
4895
d
4896
e
4897
f
4898
g
4899
h
4900
i
4901
j
4902
END
4903
4904
is_deeply $a->xml,
4905
' ';
4906
4907
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
4908
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
4909
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
4910
is_deeply [$a->parents], [$a->parentsPostOrder];
4911
4912
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
4913
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
4914
4915
ok !$j->parents;
4916
4917
ok $a->lastMost == $j;
4918
ok !$a->prevMost;
4919
ok $j->prevMost == $g;
4920
ok $i->prevMost == $g;
4921
ok $h->prevMost == $g;
4922
ok $g->prevMost == $f;
4923
ok $f->prevMost == $e;
4924
ok $e->prevMost == $x;
4925
ok $d->prevMost == $x;
4926
ok $x->prevMost == $c;
4927
ok $y->prevMost == $c;
4928
ok !$c->prevMost;
4929
ok !$b->prevMost;
4930
ok !$a->prevMost;
4931
4932
ok $a->firstMost == $c;
4933
ok $a->nextMost == $c;
4934
ok $b->nextMost == $c;
4935
ok $c->nextMost == $x;
4936
ok $y->nextMost == $x;
4937
ok $x->nextMost == $e;
4938
ok $d->nextMost == $e;
4939
ok $e->nextMost == $f;
4940
ok $f->nextMost == $g;
4941
ok $g->nextMost == $j;
4942
ok $h->nextMost == $j;
4943
ok $i->nextMost == $j;
4944
ok !$j->nextMost;
4945
4946
ok $i->topMost == $a;
4947
4948
4949
=head2 brackets($tree, $print, $separator)
4950
4951
Bracketed string representation of a tree.
4952
4953
Parameter Description
4954
1 $tree Tree
4955
2 $print Optional print method
4956
3 $separator Optional child separator
4957
4958
B
4959
4960
4961
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
4962
fromLetters 'b(c)y(x)d(efgh(i(j)))';
4963
4964
is_deeply $a->print, <
4965
Key Value
4966
a
4967
b
4968
c
4969
y
4970
x
4971
d
4972
e
4973
f
4974
g
4975
h
4976
i
4977
j
4978
END
4979
4980
is_deeply $a->xml,
4981
' ';
4982
4983
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
4984
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
4985
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
4986
is_deeply [$a->parents], [$a->parentsPostOrder];
4987
4988
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
4989
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
4990
4991
ok !$j->parents;
4992
4993
ok $a->lastMost == $j;
4994
ok !$a->prevMost;
4995
ok $j->prevMost == $g;
4996
ok $i->prevMost == $g;
4997
ok $h->prevMost == $g;
4998
ok $g->prevMost == $f;
4999
ok $f->prevMost == $e;
5000
ok $e->prevMost == $x;
5001
ok $d->prevMost == $x;
5002
ok $x->prevMost == $c;
5003
ok $y->prevMost == $c;
5004
ok !$c->prevMost;
5005
ok !$b->prevMost;
5006
ok !$a->prevMost;
5007
5008
ok $a->firstMost == $c;
5009
ok $a->nextMost == $c;
5010
ok $b->nextMost == $c;
5011
ok $c->nextMost == $x;
5012
ok $y->nextMost == $x;
5013
ok $x->nextMost == $e;
5014
ok $d->nextMost == $e;
5015
ok $e->nextMost == $f;
5016
ok $f->nextMost == $g;
5017
ok $g->nextMost == $j;
5018
ok $h->nextMost == $j;
5019
ok $i->nextMost == $j;
5020
ok !$j->nextMost;
5021
5022
ok $i->topMost == $a;
5023
5024
5025
=head2 xml($tree, $print)
5026
5027
Print a tree as as xml.
5028
5029
Parameter Description
5030
1 $tree Tree
5031
2 $print Optional print method
5032
5033
B
5034
5035
5036
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $x, $y) =
5037
fromLetters 'b(c)y(x)d(efgh(i(j)))';
5038
5039
is_deeply $a->print, <
5040
Key Value
5041
a
5042
b
5043
c
5044
y
5045
x
5046
d
5047
e
5048
f
5049
g
5050
h
5051
i
5052
j
5053
END
5054
5055
5056
is_deeply $a->xml, # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
5057
5058
' ';
5059
5060
is_deeply [$c, $x, $e, $f, $g, $j], [$a->leaves];
5061
is_deeply [$a, $b, $y, $d, $h, $i], [$a->parentsPreOrder];
5062
is_deeply [$b, $y, $i, $h, $d, $a], [$a->parentsPostOrder];
5063
is_deeply [$a->parents], [$a->parentsPostOrder];
5064
5065
is_deeply [$a, $d, $h, $i, $y, $b], [$a->parentsReversePreOrder];
5066
is_deeply [$i, $h, $d, $y, $b, $a], [$a->parentsReversePostOrder];
5067
5068
ok !$j->parents;
5069
5070
ok $a->lastMost == $j;
5071
ok !$a->prevMost;
5072
ok $j->prevMost == $g;
5073
ok $i->prevMost == $g;
5074
ok $h->prevMost == $g;
5075
ok $g->prevMost == $f;
5076
ok $f->prevMost == $e;
5077
ok $e->prevMost == $x;
5078
ok $d->prevMost == $x;
5079
ok $x->prevMost == $c;
5080
ok $y->prevMost == $c;
5081
ok !$c->prevMost;
5082
ok !$b->prevMost;
5083
ok !$a->prevMost;
5084
5085
ok $a->firstMost == $c;
5086
ok $a->nextMost == $c;
5087
ok $b->nextMost == $c;
5088
ok $c->nextMost == $x;
5089
ok $y->nextMost == $x;
5090
ok $x->nextMost == $e;
5091
ok $d->nextMost == $e;
5092
ok $e->nextMost == $f;
5093
ok $f->nextMost == $g;
5094
ok $g->nextMost == $j;
5095
ok $h->nextMost == $j;
5096
ok $i->nextMost == $j;
5097
ok !$j->nextMost;
5098
5099
ok $i->topMost == $a;
5100
5101
5102
=head1 Data Structures
5103
5104
Data structures use by this package.
5105
5106
5107
=head2 Tree::Ops Definition
5108
5109
5110
Child in the tree.
5111
5112
5113
5114
5115
=head3 Output fields
5116
5117
5118
=head4 children
5119
5120
Children of this child.
5121
5122
=head4 key
5123
5124
Key for this child - any thing that can be compared with the L operator.
5125
5126
=head4 lastChild
5127
5128
Last active child chain - enables us to find the currently open scope from the start if the tree.
5129
5130
=head4 parent
5131
5132
Parent for this child.
5133
5134
=head4 value
5135
5136
Value for this child.
5137
5138
5139
5140
=head1 Private Methods
5141
5142
=head2 setParentOfChild($child, $parent)
5143
5144
Set the parent of a child and return the child.
5145
5146
Parameter Description
5147
1 $child Child
5148
2 $parent Parent
5149
5150
=head2 indexOfChildInParent($child)
5151
5152
Get the index of a child within the specified parent.
5153
5154
Parameter Description
5155
1 $child Child
5156
5157
=head2 parentsOrdered($tree, $preorder, $reverse)
5158
5159
The set of all parents in the tree, i.e. each non leaf of the tree, i.e the interior of the tree in the specified order.
5160
5161
Parameter Description
5162
1 $tree Tree
5163
2 $preorder Pre-order if true else post-order
5164
3 $reverse Reversed if true
5165
5166
=head2 printTree($tree, $print, $preorder, $reverse)
5167
5168
String representation as a horizontal tree.
5169
5170
Parameter Description
5171
1 $tree Tree
5172
2 $print Optional print method
5173
3 $preorder Pre-order
5174
4 $reverse Reverse
5175
5176
5177
=head1 Index
5178
5179
5180
1 L - Return the first child if it is above the second child else return B.
5181
5182
2 L - Locate the active scope in a tree.
5183
5184
3 L - Return the first child if it occurs strictly after the second child in the tree or else B if the first child is L, L or L the second child.
5185
5186
4 L - Return the first child if it occurs strictly before the second child in the tree or else B if the first child is L, L or L the second child.
5187
5188
5 L - Return the first child if it is below the second child else return B.
5189
5190
6 L - Bracketed string representation of a tree.
5191
5192
7 L - Traverse a tree in post-order to process each child with the specified sub and return an array of the results of processing each child.
5193
5194
8 L - Close the current scope returning to the previous scope.
5195
5196
9 L - Get the context of the current child.
5197
5198
10 L - Cut out a child and all its content and children, return it ready for reinsertion else where.
5199
5200
11 L - Duplicate a specified parent and all its descendants returning the root of the resulting tree.
5201
5202
12 L - Return the specified parent if it has no children else B
5203
5204
13 L - Get the first child under the specified parent.
5205
5206
14 L - Return the first most descendant child in the tree starting at this parent or else return B if this parent has no children.
5207
5208
15 L - Create a tree from a string of letters returning the children created in alphabetic order - useful for testing.
5209
5210
16 L - Return the child at the end of the path starting at the specified parent.
5211
5212
17 L - Include the specified tree in the currently open scope.
5213
5214
18 L - Get the index of a child within the specified parent.
5215
5216
19 L - Return the specified child if that child is first under its parent, else return B.
5217
5218
20 L - Return the specified child if that child is last under its parent, else return B.
5219
5220
21 L - Return the specified parent if that parent is the top most parent in the tree.
5221
5222
22 L - Get the last child under the specified parent.
5223
5224
23 L - Return the last most descendant child in the tree starting at this parent or else return B if this parent has no children.
5225
5226
24 L - The set of all children without further children, i.
5227
5228
25 L - Return the path from the specified child to the specified ancestor else return B if the child is not a descendant of the ancestor.
5229
5230
26 L - Unwrap the children of the specified parent with the whose L fields L that of their parent.
5231
5232
27 L - Merge the following sibling of the specified child if that sibling exists and the L data of the two siblings L.
5233
5234
28 L - Merge the preceding sibling of the specified child if that sibling exists and the L data of the two siblings L.
5235
5236
29 L - Find the most recent common ancestor of the specified children.
5237
5238
30 L - Create a new child optionally recording the specified key or value.
5239
5240
31 L - Get the next sibling following the specified child.
5241
5242
32 L - Return the next child with no children, i.
5243
5244
33 L - Return a list of children visited between the specified child and the next child in post-order.
5245
5246
34 L - Return a list of children visited between the specified child and the next child in pre-order.
5247
5248
35 L - Add a child and make it the currently active scope into which new children will be added.
5249
5250
36 L - The set of all parents in the tree, i.
5251
5252
37 L - The set of all parents in the tree, i.
5253
5254
38 L - The set of all parents in the tree, i.
5255
5256
39 L - The set of all parents in the tree, i.
5257
5258
40 L - The set of all parents in the tree, i.
5259
5260
41 L - The set of all parents in the tree, i.
5261
5262
42 L - Return the list of zero based child indexes for the path from the root of the tree containing the specified child to the specified child for use by the L method.
5263
5264
43 L - Return the list of zero based child indexes for the path from the specified ancestor to the specified child for use by the L method else confess if the ancestor is not, in fact, an ancestor.
5265
5266
44 L - Get the previous sibling of the specified child.
5267
5268
45 L - Return the previous child with no children, i.
5269
5270
46 L - Return a list of children visited between the specified child and the previous child in post-order.
5271
5272
47 L - Return a list of children visited between the specified child and the previous child in pre-order.
5273
5274
48 L - Print tree in normal pre-order.
5275
5276
49 L - Print tree in normal post-order.
5277
5278
50 L - Print tree in normal pre-order.
5279
5280
51 L - Print tree in reverse post-order
5281
5282
52 L - Print tree in reverse pre-order
5283
5284
53 L - String representation as a horizontal tree.
5285
5286
54 L - Place a new child first under the specified parent and return the child.
5287
5288
55 L - Place a new child last under the specified parent and return the child.
5289
5290
56 L - Place a new child after the specified child.
5291
5292
57 L - Place a new child before the specified child.
5293
5294
58 L - Select matching children in a tree in post-order.
5295
5296
59 L - Set the parent of a child and return the child.
5297
5298
60 L - Return a list of siblings after the specified child.
5299
5300
61 L - Return a list of siblings before the specified child.
5301
5302
62 L - Return a list of the siblings strictly between two children of the same parent else return B.
5303
5304
63 L - Add one child in the current scope.
5305
5306
64 L - Return the only child of this parent if the parent has an only child, else B
5307
5308
65 L - Make the specified parent a grandparent of each of its children by interposing a copy of the specified parent between the specified parent and each of its children.
5309
5310
66 L - Make the first child of the specified parent the parents previous sibling and return the parent.
5311
5312
67 L - Make the previous sibling of the specified parent the parents first child and return the parent.
5313
5314
68 L - Make the next sibling of the specified parent the parents last child and return the parent.
5315
5316
69 L - Make the last child of the specified parent the parents next sibling and return the parent.
5317
5318
70 L - Return the top most parent in the tree containing the specified child.
5319
5320
71 L - Duplicate a specified parent and all its descendants recording the mapping in a temporary {transcribed} field in the tree being transcribed.
5321
5322
72 L - Unwrap the specified child and return that child.
5323
5324
73 L - Wrap the specified child with a new parent and return the new parent optionally setting its L and L.
5325
5326
74 L - Wrap the children of the specified parent with a new intermediate parent that becomes the child of the specified parent, optionally setting the L and the L for the new parent.
5327
5328
75 L - Print a tree as as xml.
5329
5330
=head1 Installation
5331
5332
This module is written in 100% Pure Perl and, thus, it is easy to read,
5333
comprehend, use, modify and install via B:
5334
5335
sudo cpan install Tree::Ops
5336
5337
=head1 Author
5338
5339
L
5340
5341
L
5342
5343
=head1 Copyright
5344
5345
Copyright (c) 2016-2019 Philip R Brenan.
5346
5347
This module is free software. It may be used, redistributed and/or modified
5348
under the same terms as Perl itself.
5349
5350
=cut
5351
5352
5353
5354
# Tests and documentation
5355
5356
sub test
5357
1
1
0
7
{my $p = __PACKAGE__;
5358
1
10
binmode($_, ":utf8") for *STDOUT, *STDERR;
5359
1
50
113
return if eval "eof(${p}::DATA)";
5360
1
59
my $s = eval "join('', <${p}::DATA>)";
5361
1
50
10
$@ and die $@;
5362
1
1
7
eval $s;
1
1
3
1
1
35
1
1
5
1
2
1
26
1
5
1
2
1
7
1
730
1
64459
1
9
1
74
5363
1
50
11
$@ and die $@;
5364
1
141
1
5365
}
5366
5367
test unless caller;
5368
5369
1;
5370
# podDocumentation
5371
__DATA__