—#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib/ -I.
#-------------------------------------------------------------------------------
# Multi-way tree in Pure Perl with an even or odd number of keys per node.
# Philip R Brenan at appaapps dot com, Appa Apps Ltd Inc., 2021
#-------------------------------------------------------------------------------
# podDocumentation
package
Tree::Multi;
our
$VERSION
=
"20210604"
;
use
strict;
our
$numberOfKeysPerNode
= 3;
# Number of keys per node which can be localized because it is ours. The number of keys can be even or odd.
#D1 Multi-way Tree # Create and use a multi-way tree.
my
$nodes
= 0;
# Count the nodes created
sub
new()
#P Create a new multi-way tree node.
{
my
() =
@_
;
# Key, $data, parent node, index of link from parent node
genHash(__PACKAGE__,
# Multi tree node
number
=> ++
$nodes
,
# Number of the node for debugging purposes
up
=>
undef
,
# Parent node
keys
=> [],
# Array of key items for this node
data
=> [],
# Data corresponding to each key
node
=> [],
# Child nodes
);
}
sub
minimumNumberOfKeys()
#P Minimum number of keys per node.
{
int
((
$numberOfKeysPerNode
- 1) / 2)
}
sub
maximumNumberOfKeys()
#P Maximum number of keys per node.
{
$numberOfKeysPerNode
}
sub
maximumNumberOfNodes()
#P Maximum number of children per parent.
{
$numberOfKeysPerNode
+ 1
}
sub
full($)
#P Confirm that a node is full.
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
$tree
->
keys
->@* <= maximumNumberOfKeys or confess
"Keys"
;
$tree
->
keys
->@* == maximumNumberOfKeys
}
sub
halfFull($)
#P Confirm that a node is half full.
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
# $tree->keys->@* <= maximumNumberOfKeys+1 or confess "Keys";
$tree
->
keys
->@* == minimumNumberOfKeys
}
sub
root($)
# Return the root node of a tree.
{
my
(
$tree
) =
@_
;
# Tree
confess
unless
$tree
;
for
(;
$tree
->up;
$tree
=
$tree
->up) {}
$tree
}
sub
leaf($)
# Confirm that the tree is a leaf.
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
!
scalar
$tree
->node->@*
# No children so it must be a leaf
}
sub
separateKeys($)
#P Return ([lower], center, [upper]) keys.
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
my
@k
=
$node
->
keys
->@*;
@k
== maximumNumberOfKeys or
@k
== maximumNumberOfNodes or confess
'Keys'
;
# A node is allowed to overflow by one pending a split
my
@l
;
my
@r
;
while
(
@k
> 1)
{
push
@l
,
shift
@k
;
unshift
@r
,
pop
@k
if
@k
> 1;
}
@l
> 0 or confess
'Left'
;
@r
> 0 or confess
'Right'
;
@k
== 1 or confess
'K'
;
(\
@l
,
$k
[0], \
@r
);
}
sub
separateData($)
#P Return ([lower], center, [upper]) data
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
my
@d
=
$node
->data->@*;
@d
== maximumNumberOfKeys or
@d
== maximumNumberOfNodes or confess
'Keys'
;
# A node is allowed to overflow by one pending a split
my
@l
;
my
@r
;
while
(
@d
> 1)
{
push
@l
,
shift
@d
;
unshift
@r
,
pop
@d
if
@d
> 1;
}
@l
> 0 or confess
'Left'
;
@r
> 0 or confess
'Right'
;
@d
== 1 or confess
'D'
;
(\
@l
,
$d
[0], \
@r
);
}
sub
separateNode($)
#P Return ([lower], [upper]) children
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
my
@n
=
$node
->node->@*;
@n
== maximumNumberOfNodes or confess
'Node'
;
my
@l
;
my
@r
;
while
(
@n
> 1)
{
push
@l
,
shift
@n
;
unshift
@r
,
pop
@n
;
}
if
(
@n
== 1)
# Even keys per node
{
push
@l
,
shift
@n
;
}
@l
> 0 or confess
"Left"
;
@r
> 0 or confess
"Right"
;
@n
==0 or confess
"Node"
;
(\
@l
, \
@r
);
}
sub
reUp($@)
#P Reconnect the children to their new parent
{
my
(
$node
,
@children
) =
@_
;
# Node, children
@_
> 0 or confess;
$_
->up =
$node
for
@children
;
# Add new child to parent known to be not full
}
sub
splitNode($)
#P Split a full node in half assuming it has a non full parent
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
confess
unless
my
$p
=
$node
->up;
# Check parent
confess
unless
$node
->node->@* == maximumNumberOfNodes;
# Check size
my
(
$kl
,
$k
,
$kr
) = separateKeys
$node
;
my
(
$dl
,
$d
,
$dr
) = separateData
$node
;
my
(
$cl
,
$cr
) = separateNode
$node
;
my
(
$l
,
$r
) = (new, new);
# New child nodes
$l
->up =
$r
->up =
$p
;
$l
->
keys
=
$kl
;
$l
->data =
$dl
;
$l
->node =
$cl
; reUp
$l
,
@$cl
;
$r
->
keys
=
$kr
;
$r
->data =
$dr
;
$r
->node =
$cr
; reUp
$r
,
@$cr
;
my
@n
=
$p
->node->@*;
# Insert new nodes in parent known to be not full
for
my
$i
(
keys
@n
)
{
if
(
$n
[
$i
] ==
$node
)
{
splice
$p
->
keys
->@*,
$i
, 0,
$k
;
splice
$p
->data->@*,
$i
, 0,
$d
;
splice
$p
->node->@*,
$i
, 1,
$l
,
$r
;
return
;
}
}
confess;
}
sub
splitRootNode($)
#P Split a full root
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
confess
if
$node
->up;
# Check parent
confess
unless
$node
->node->@* == maximumNumberOfNodes;
# Check size
my
(
$kl
,
$k
,
$kr
) = separateKeys
$node
;
my
(
$dl
,
$d
,
$dr
) = separateData
$node
;
my
(
$cl
,
$cr
) = separateNode
$node
;
my
$p
=
$node
;
my
(
$l
,
$r
) = (new, new);
$l
->up =
$r
->up =
$p
;
$l
->
keys
=
$kl
;
$l
->data =
$dl
;
$l
->node =
$cl
; reUp
$l
,
@$cl
;
$r
->
keys
=
$kr
;
$r
->data =
$dr
;
$r
->node =
$cr
; reUp
$r
,
@$cr
;
$p
->
keys
= [
$k
];
$p
->data = [
$d
];
$p
->node = [
$l
,
$r
];
}
sub
splitFullNode($)
#P Split a full node
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
return
$node
unless
$node
->node->@* == maximumNumberOfNodes;
# Check size
return
splitNode
$node
if
$node
->up;
# Node has a parent
return
splitRootNode
$node
# Root node
}
sub
splitLeafNode($)
#P Split a full leaf node in assuming it has a non full parent
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
confess
unless
my
$p
=
$node
->up;
# Check parent
confess
unless
$node
->
keys
->@* == maximumNumberOfNodes;
# Check size
my
(
$kl
,
$k
,
$kr
) = separateKeys
$node
;
my
(
$dl
,
$d
,
$dr
) = separateData
$node
;
my
(
$l
,
$r
) = (new, new);
# Create new nodes
$l
->up =
$r
->up =
$p
;
$l
->
keys
=
$kl
;
$l
->data =
$dl
;
$r
->
keys
=
$kr
;
$r
->data =
$dr
;
my
@n
=
$p
->node->@*;
# Insert new nodes in parent known to be not full
for
my
$i
(
keys
@n
)
{
if
(
$n
[
$i
] ==
$node
)
{
splice
$p
->
keys
->@*,
$i
, 0,
$k
;
splice
$p
->data->@*,
$i
, 0,
$d
;
splice
$p
->node->@*,
$i
, 1,
$l
,
$r
;
return
;
# Return parent as we have delete the original node
}
}
confess;
}
sub
splitRootLeafNode($)
#P Split a full root that is also a leaf
{
my
(
$node
) =
@_
;
# Node to split
@_
== 1 or confess;
confess
if
$node
->up;
# Check parent
confess
unless
$node
->
keys
->@* == maximumNumberOfNodes;
# Check size
my
(
$kl
,
$k
,
$kr
) = separateKeys
$node
;
my
(
$dl
,
$d
,
$dr
) = separateData
$node
;
my
(
$p
,
$l
,
$r
) = (
$node
, new, new);
# New root and children
$l
->up =
$r
->up =
$p
;
# Initialize children
$l
->
keys
=
$kl
;
$l
->data =
$dl
;
$r
->
keys
=
$kr
;
$r
->data =
$dr
;
$p
->
keys
= [
$k
];
# Initialize parent
$p
->data = [
$d
];
$p
->node = [
$l
,
$r
];
}
sub
findAndSplit($$)
#P Find a key in a tree splitting full nodes along the path to the key
{
my
(
$root
,
$key
) =
@_
;
# Root of tree, key
@_
== 2 or confess;
my
$tree
=
$root
;
# Start at the root
for
(0..999)
# Step down through the tree
{splitFullNode
$tree
;
# Split any full nodes encountered
confess
unless
my
@k
=
$tree
->
keys
->@*;
# We should have at least one key in the tree because we do a special case insert for an empty tree
if
(
$key
<
$k
[0])
# Less than smallest key in node
{
return
(-1,
$tree
, 0)
unless
my
$n
=
$tree
->node->[0];
$tree
=
$n
;
next
;
}
if
(
$key
>
$k
[-1])
# Greater than largest key in node
{
return
(+1,
$tree
,
$#k
)
unless
my
$n
=
$tree
->node->[-1];
$tree
=
$n
;
next
;
}
for
my
$i
(
keys
@k
)
# Search the keys in this node as greater than least key and less than largest key
{
my
$s
=
$key
<=>
$k
[
$i
];
# Compare key
return
(0,
$tree
,
$i
)
if
$s
== 0;
# Found key
if
(
$s
< 0)
# Less than current key
{
return
(-1,
$tree
,
$i
)
unless
my
$n
=
$tree
->node->[
$i
];
# Step through if possible
$tree
=
$n
;
# Step
last
;
}
}
}
confess
"Should not happen"
;
}
sub
find($$)
# Find a key in a tree returning its associated data or undef if the key does not exist
{
my
(
$root
,
$key
) =
@_
;
# Root of tree, key
@_
== 2 or confess;
my
$tree
=
$root
;
# Start at the root
for
(0..999)
# Step down through the tree
{
return
undef
unless
my
@k
=
$tree
->
keys
->@*;
# Empty node
if
(
$key
<
$k
[0])
# Less than smallest key in node
{
return
undef
unless
$tree
=
$tree
->node->[0];
next
;
}
if
(
$key
>
$k
[-1])
# Greater than largest key in node
{
return
undef
unless
$tree
=
$tree
->node->[-1];
next
;
}
for
my
$i
(
keys
@k
)
# Search the keys in this node
{
my
$s
=
$key
<=>
$k
[
$i
];
# Compare key
return
$tree
->data->[
$i
]
if
$s
== 0;
# Found key
if
(
$s
< 0)
# Less than current key
{
return
undef
unless
$tree
=
$tree
->node->[
$i
];
last
;
}
}
}
confess
"Should not happen"
;
}
sub
indexInParent($)
#P Get the index of a node in its parent
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
my
$p
=
$tree
->up;
confess
unless
defined
$p
;
my
@n
=
$p
->node->@*;
for
my
$i
(
keys
@n
)
{
return
$i
if
$n
[
$i
] ==
$tree
;
}
confess
}
sub
fillFromLeftOrRight($$)
#P Fill a node from the specified sibling
{
my
(
$n
,
$dir
) =
@_
;
# Node to fill, node to fill from 0 for left or 1 for right
@_
== 2 or confess;
confess
unless
halfFull(
$n
);
# Confirm leaf is half full
confess
unless
my
$p
=
$n
->up;
# Parent of leaf
my
$i
= indexInParent
$n
;
# Index of leaf in parent
if
(
$dir
)
# Fill from right
{
$i
<
$p
->node->@* - 1 or confess;
# Cannot fill from right
my
$r
=
$p
->node->[
$i
+1];
# Leaf on right
push
$n
->
keys
->@*,
$p
->
keys
->[
$i
];
$p
->
keys
->[
$i
] =
shift
$r
->
keys
->@*;
# Transfer key
push
$n
->data->@*,
$p
->data->[
$i
];
$p
->data->[
$i
] =
shift
$r
->data->@*;
# Transfer data
if
(!leaf
$n
)
# Transfer node if not a leaf
{
push
$n
->node->@*,
shift
$r
->node->@*;
$n
->node->[-1]->up =
$n
;
}
}
else
# Fill from left
{
$i
> 0 or confess;
# Cannot fill from left
my
$l
=
$p
->node->[
$i
-1];
# Leaf on leaf
unshift
$n
->
keys
->@*,
$p
->
keys
->[
$i
-1];
$p
->
keys
->[
$i
-1] =
pop
$l
->
keys
->@*;
# Transfer key
unshift
$n
->data->@*,
$p
->data->[
$i
-1];
$p
->data->[
$i
-1] =
pop
$l
->data->@*;
# Transfer data
if
(!leaf
$n
)
# Transfer node if not a leaf
{
unshift
$n
->node->@*,
pop
$l
->node->@*;
$n
->node->[0]->up =
$n
;
}
}
}
sub
mergeWithLeftOrRight($$)
#P Merge two adjacent nodes
{
my
(
$n
,
$dir
) =
@_
;
# Node to merge into, node to merge is on right if 1 else left
@_
== 2 or confess;
confess
unless
halfFull(
$n
);
# Confirm leaf is half full
confess
unless
my
$p
=
$n
->up;
# Parent of leaf
confess
if
halfFull(
$p
) and
$p
->up;
# Parent must have more than the minimum number of keys because we need to remove one unless it is the root of the tree
my
$i
= indexInParent
$n
;
# Index of leaf in parent
if
(
$dir
)
# Merge with right hand sibling
{
$i
<
$p
->node->@* - 1 or confess;
# Cannot fill from right
my
$r
=
$p
->node->[
$i
+1];
# Leaf on right
confess
unless
halfFull(
$r
);
# Confirm right leaf is half full
push
$n
->
keys
->@*,
splice
(
$p
->
keys
->@*,
$i
, 1),
$r
->
keys
->@*;
# Transfer keys
push
$n
->data->@*,
splice
(
$p
->data->@*,
$i
, 1),
$r
->data->@*;
# Transfer data
if
(!leaf
$n
)
# Children of merged node
{
push
$n
->node->@*,
$r
->node->@*;
# Children of merged node
reUp
$n
,
$r
->node->@*;
# Update parent of children of right node
}
splice
$p
->node->@*,
$i
+1, 1;
# Remove link from parent to right child
}
else
# Merge with left hand sibling
{
$i
> 0 or confess;
# Cannot fill from left
my
$l
=
$p
->node->[
$i
-1];
# Node on left
confess
unless
halfFull(
$l
);
# Confirm right leaf is half full
unshift
$n
->
keys
->@*,
$l
->
keys
->@*,
splice
$p
->
keys
->@*,
$i
-1, 1;
# Transfer keys
unshift
$n
->data->@*,
$l
->data->@*,
splice
$p
->data->@*,
$i
-1, 1;
# Transfer data
if
(!leaf
$n
)
# Children of merged node
{
unshift
$n
->node->@*,
$l
->node->@*;
# Children of merged node
reUp
$n
,
$l
->node->@*;
# Update parent of children of left node
}
splice
$p
->node->@*,
$i
-1, 1;
# Remove link from parent to left child
}
}
sub
mergeOrFill($)
#P make a node larger than a half node
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
return
unless
halfFull(
$tree
);
# No need to merge of if not a half node
confess
unless
my
$p
=
$tree
->up;
# Parent exists
__SUB__->(
$p
)
if
$p
->up;
# Parent is half node so can be merged or filled first
if
(!
$p
->up and
$p
->
keys
->@* == 1 and halfFull(
$p
->node->[0])
# Parent is the root and it only has one key - merge into the child
and halfFull(
$p
->node->[1]))
{
my
$l
=
$p
->node->[0];
# Merge the root node
my
$r
=
$p
->node->[1];
$p
->
keys
=
$tree
->
keys
= [
$l
->
keys
->@*,
$p
->
keys
->@*,
$r
->
keys
->@*];
$p
->data =
$tree
->data = [
$l
->data->@*,
$p
->data->@*,
$r
->data->@*];
$p
->node =
$tree
->node = [
$l
->node->@*,
$r
->node->@*];
reUp
$p
,
$p
->node->@*;
return
;
}
if
(
my
$i
= indexInParent
$tree
)
# Merge with left node
{
my
$l
=
$tree
->up->node->[
$i
-1];
# Left node
if
(halfFull(
my
$r
=
$tree
))
{
$l
->halfFull ? mergeWithLeftOrRight
$r
, 0 : fillFromLeftOrRight
$r
, 0;
# Merge as left and right nodes are half full
}
}
else
# Merge with right node
{
my
$r
=
$p
->node->[1];
# Right node
if
(halfFull(
my
$l
=
$tree
))
{halfFull(
$r
) ? mergeWithLeftOrRight
$l
, 1 : fillFromLeftOrRight
$l
, 1;
# Merge as left and right nodes are half full
}
}
}
sub
leftMost($)
# Return the left most node below the specified one
{
my
(
$tree
) =
@_
;
# Tree
for
(0..999)
# Step down through tree
{
return
$tree
if
leaf
$tree
;
# We are on a leaf so we have arrived at the left most node
$tree
=
$tree
->node->[0];
# Go left
}
confess
"Should not happen"
;
}
sub
rightMost($)
# Return the right most node below the specified one
{
my
(
$tree
) =
@_
;
# Tree
for
(0..999)
# Step down through tree
{
return
$tree
if
leaf
$tree
;
# We are on a leaf so we have arrived at the left most node
$tree
=
$tree
->node->[-1];
# Go right
}
confess
"Should not happen"
;
}
sub
height($)
# Return the height of the tree
{
my
(
$tree
) =
@_
;
# Tree
for
my
$n
(0..999)
# Step down through tree
{
if
(leaf
$tree
)
# We are on a leaf
{
return
$n
+ 1
if
$tree
->
keys
->@*;
# We are in a partially full leaf
return
$n
;
# We are on the root and it is empty
}
$tree
=
$tree
->node->[0];
}
confess
"Should not happen"
;
}
sub
depth($)
# Return the depth of a node within a tree
{
my
(
$tree
) =
@_
;
# Tree
return
0
if
!
$tree
->up and !
$tree
->
keys
->@*;
# We are at the root and it is empty
for
my
$n
(1..999)
# Step down through tree
{
return
$n
unless
$tree
->up;
# We are at the root
$tree
=
$tree
->up;
}
confess
"Should not happen"
;
}
sub
deleteLeafKey($$)
#P Delete a (key, pair) in a leaf
{
my
(
$tree
,
$i
) =
@_
;
# Tree, index to delete at
@_
== 2 or confess;
confess
"Not a leaf"
unless
leaf
$tree
;
my
$key
=
$tree
->
keys
->[
$i
];
mergeOrFill
$tree
if
$tree
->up;
# Merge and fill unless we are on the root and the root is a leaf
for
my
$j
(
keys
$tree
->
keys
->@*)
{
if
(
$tree
->
keys
->[
$j
] ==
$key
)
{
splice
$tree
->
keys
->@*,
$j
, 1;
# Remove keys
splice
$tree
->data->@*,
$j
, 1;
# Remove data
last
;
}
}
}
sub
deleteKey($$)
#P Delete a (key, data) pair in a node
{
my
(
$tree
,
$i
) =
@_
;
# Tree, index to delete at
@_
== 2 or confess;
if
(leaf
$tree
)
# Delete from a leaf
{deleteLeafKey(
$tree
,
$i
);
}
elsif
(
$i
> 0)
# Delete from a node
{
my
$l
= rightMost
$tree
->node->[
$i
];
# Find previous node
splice
$tree
->
keys
->@*,
$i
, 1,
$l
->
keys
->[-1];
splice
$tree
->data->@*,
$i
, 1,
$l
->data->[-1];
deleteLeafKey
$l
, -1 +
scalar
$l
->
keys
->@*;
# Remove leaf key
}
else
# Delete from a node
{
my
$r
= leftMost
$tree
->node->[1];
# Find previous node
splice
$tree
->
keys
->@*, 0, 1,
$r
->
keys
->[0];
splice
$tree
->data->@*, 0, 1,
$r
->data->[0];
deleteLeafKey
$r
, 0;
# Remove leaf key
}
}
sub
delete
($$)
# Find a key in a tree, delete it, return the new tree
{
my
(
$root
,
$key
) =
@_
;
# Tree root, key
@_
== 2 or confess;
my
$tree
=
$root
;
for
(0..999)
{
my
@k
=
$tree
->
keys
->@*;
if
(
$key
<
$k
[0])
# Less than smallest key in node
{
return
unless
$tree
=
$tree
->node->[0];
next
;
}
if
(
$key
>
$k
[-1])
# Greater than largest key in node
{
return
unless
$tree
=
$tree
->node->[-1];
next
;
}
for
my
$i
(
keys
@k
)
# Search the keys in this node
{
my
$s
=
$key
<=>
$k
[
$i
];
# Compare key
if
(
$s
== 0)
# Delete found key
{deleteKey
$tree
,
$i
;
# Delete
return
;
# New tree
}
if
(
$s
< 0)
# Less than current key
{
return
unless
$tree
=
$tree
->node->[
$i
];
last
;
}
}
}
confess
"Should not happen"
;
}
sub
insert($$$)
# Insert a key and data into a tree
{
my
(
$tree
,
$key
,
$data
) =
@_
;
# Tree, key, data
@_
== 3 or confess;
$tree
or confess;
if
( !
$tree
->
keys
->@*)
# Empty tree
{
push
$tree
->
keys
->@*,
$key
;
push
$tree
->data->@*,
$data
;
return
$tree
;
}
my
(
$compare
,
$node
,
$index
) = findAndSplit
$tree
,
$key
;
# Check for existing key
if
(
$compare
== 0)
# Found an equal key whose data we can update
{
$node
->data->[
$index
] =
$data
;
return
$tree
;
}
my
@k
=
$node
->
keys
->@*;
my
@d
=
$node
->data->@*;
@k
<= maximumNumberOfKeys or confess
'Keys'
;
@d
<= maximumNumberOfKeys or confess
'Data'
;
if
(
$compare
< 0)
# Insert into a leaf node below the index
{
$node
->
keys
= [
@k
[0..
$index
-1],
$key
,
@k
[
$index
..
$#k
]];
$node
->data = [
@d
[0..
$index
-1],
$data
,
@d
[
$index
..
$#d
]];
}
else
# Insert into a leaf node node above the index
{
$node
->
keys
= [
@k
[0..
$index
],
$key
,
@k
[
$index
+1..
$#k
]];
$node
->data = [
@d
[0..
$index
],
$data
,
@d
[
$index
+1..
$#d
]];
}
return
$tree
if
$node
->
keys
->@* <= maximumNumberOfKeys;
# No need to split
if
(
$node
->up)
# Split leaf node that is not the root
{splitLeafNode
$node
;
return
;
}
splitRootLeafNode
$node
# Split Root node
}
sub
iterator($)
# Make an iterator for a tree
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
my
$i
= genHash(__PACKAGE__.
'::Iterator'
,
# Iterator
tree
=>
$tree
,
# Tree we are iterating over
node
=>
$tree
,
# Current node within tree
pos
=>
undef
,
# Current position within node
key
=>
undef
,
# Key at this position
data
=>
undef
,
# Data at this position
count
=> 0,
# Counter
more
=> 1,
# Iteration not yet finished
);
$i
->
next
;
# First element if any
$i
# Iterator
}
sub
Tree::Multi::Iterator::
next
($)
# Find the next key
{
my
(
$iter
) =
@_
;
# Iterator
@_
>= 1 or confess;
confess
unless
my
$C
=
$iter
->node;
# Current node required
++
$iter
->count;
# Count the calls to the iterator
my
$new
=
sub
# Load iterator with latest position
{
my
(
$node
,
$pos
) =
@_
;
# Parameters
$iter
->node =
$node
;
$iter
->
pos
=
$pos
//= 0;
$iter
->key =
$node
->
keys
->[
$pos
];
$iter
->data =
$node
->data->[
$pos
]
};
my
$done
=
sub
{
$iter
->more =
undef
};
# The tree has been completely traversed
if
(!
defined
(
$iter
->
pos
))
# Initial descent
{
my
$l
=
$C
->node->[0];
return
$l
?
&$new
(
$l
->leftMost) :
$C
->
keys
->@* ?
&$new
(
$C
) :
&$done
;
# Start node or done if empty tree
}
my
$up
=
sub
# Iterate up to next node that has not been visited
{
for
(
my
$n
=
$C
;
my
$p
=
$n
->up;
$n
=
$n
->up)
{
my
$i
= indexInParent
$n
;
return
&$new
(
$p
,
$i
)
if
$i
<
$p
->
keys
->@*;
}
&$done
# No nodes not visited
};
my
$i
= ++
$iter
->
pos
;
if
(leaf
$C
)
# Leaf
{
$i
<
$C
->
keys
->@* ?
&$new
(
$C
,
$i
) :
&$up
;
}
else
# Node
{
$i
<
$C
->node->@* ?
&$new
(
$C
->node->[
$i
]->leftMost) :
&$up
;
}
}
sub
reverseIterator($)
# Create a reverse iterator for a tree
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
my
$i
= genHash(__PACKAGE__.
'::ReverseIterator'
,
# Iterator
tree
=> root(
$tree
),
# Tree we are iterating over
node
=>
$tree
,
# Current node within tree
pos
=>
undef
,
# Current position within node
key
=>
undef
,
# Key at this position
data
=>
undef
,
# Data at this position
count
=> 0,
# Counter
less
=> 1,
# Iteration not yet finished
);
$i
->prev;
# Last element if any
$i
# Iterator
}
sub
Tree::Multi::ReverseIterator::prev($)
# Find the previous key
{
my
(
$iter
) =
@_
;
# Iterator
@_
>= 1 or confess;
confess
unless
my
$C
=
$iter
->node;
# Current node required
++
$iter
->count;
# Count the calls to the iterator
my
$new
=
sub
# Load iterator with latest position
{
my
(
$node
,
$pos
) =
@_
;
# Parameters
$iter
->node =
$node
;
$iter
->
pos
=
$pos
//= (
$node
->
keys
->@* - 1);
$iter
->key =
$node
->
keys
->[
$pos
];
$iter
->data =
$node
->data->[
$pos
]
};
my
$done
=
sub
{
$iter
->less =
undef
};
# The tree has been completely traversed
if
(!
defined
(
$iter
->
pos
))
# Initial descent
{
my
$l
=
$C
->node->[-1];
return
$l
?
&$new
(
$l
->rightMost) :
$C
->
keys
->@* ?
&$new
(
$C
) :
&$done
;
# Start node or done if empty tree
return
;
}
my
$up
=
sub
# Iterate up to next node that has not been visited
{
for
(
my
$n
=
$C
;
my
$p
=
$n
->up;
$n
=
$n
->up)
{
my
$i
= indexInParent
$n
;
return
&$new
(
$p
,
$i
-1)
if
$i
> 0;
}
&$done
# No nodes not visited
};
my
$i
=
$iter
->
pos
;
if
(leaf
$C
)
# Leaf
{
$i
> 0 ?
&$new
(
$C
,
$i
-1) :
&$up
;
}
else
# Node
{
$i
>= 0 ?
&$new
(
$C
->node->[
$i
]->rightMost) :
&$up
}
}
sub
flat($@)
# Print the keys in a tree from left right to make it easier to visualize the structure of the tree
{
my
(
$tree
,
@title
) =
@_
;
# Tree, title
confess
unless
$tree
;
my
@s
;
my
$D
;
# Deepest
for
(
my
$i
= iterator root
$tree
;
$i
->more;
$i
->
next
)
# Traverse tree
{
my
$d
= depth
$i
->node;
$D
=
$d
unless
$D
and
$D
>
$d
;
$s
[
$d
] //=
''
;
$s
[
$d
] .=
" "
.
$i
->key;
# Add key at appropriate depth
my
$l
=
length
$s
[
$d
];
for
my
$j
(0..
$D
)
# Pad all strings to the current position
{
my
$s
=
$s
[
$j
] //=
''
;
$s
[
$j
] =
substr
(
$s
.(
' '
x999), 0,
$l
)
if
length
(
$s
) <
$l
;
}
}
for
my
$i
(
keys
@s
)
# Clean up trailing blanks so that tests are not affected by spurious white space mismatches
{
$s
[
$i
] =~ s/\s+\n/\n/gs;
$s
[
$i
] =~ s/\s+\Z//gs;
}
unshift
@s
,
join
(
' '
,
@title
)
if
@title
;
# Add title
join
"\n"
,
@s
,
''
;
}
sub
($;$)
# Print the keys in a tree optionally marking the active key
{
my
(
$tree
,
$i
) =
@_
;
# Tree, optional index of active key
confess
unless
$tree
;
my
@s
;
my
=
sub
# Print a node
{
my
(
$t
,
$in
) =
@_
;
return
unless
$t
and
$t
->
keys
and
$t
->
keys
->@*;
my
@t
= (
' '
x
$in
);
# Print keys staring the active key if known
for
my
$j
(
keys
$t
->
keys
->@*)
{
push
@t
,
$t
->
keys
->[
$j
];
push
@t
,
'<='
if
defined
(
$i
) and
$i
==
$j
and
$tree
==
$t
;
}
push
@s
,
join
' '
,
@t
;
# Details of one node
if
(
my
$nodes
=
$t
->node)
# Each key
{__SUB__->(
$_
,
$in
+1)
for
$nodes
->@*;
}
};
(root(
$tree
), 0);
# Print tree
join
"\n"
,
@s
,
''
}
sub
size($)
# Count the number of keys in a tree
{
my
(
$tree
) =
@_
;
# Tree
@_
== 1 or confess;
my
$n
= 0;
my
$count
=
sub
# Print a node
{
my
(
$t
) =
@_
;
return
unless
$t
and
$t
->
keys
and
my
@k
=
$t
->
keys
->@*;
$n
+=
@k
;
if
(
my
$nodes
=
$t
->node)
# Each key
{__SUB__->(
$_
)
for
$nodes
->@*;
}
};
&$count
(root
$tree
);
# Count nodes in tree
$n
;
}
#d
#-------------------------------------------------------------------------------
# Export - eeee
#-------------------------------------------------------------------------------
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw(
)
;
%EXPORT_TAGS
= (
all
=>[
@EXPORT
,
@EXPORT_OK
]);
# podDocumentation
=pod
=encoding utf-8
=head1 Name
Tree::Multi - Multi-way tree in Pure Perl with an even or odd number of keys per node.
=head1 Synopsis
Construct and query a multi-way tree in B<100%> Pure Perl with a choice of an
odd or an even numbers of keys per node:
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size
=head1 Description
Multi-way tree in Pure Perl with an even or odd number of keys per node.
Version "20210604".
The following sections describe the methods in each functional area of this
module. For an alphabetic listing of all methods by name see L<Index|/Index>.
=head1 Multi-way Tree
Create and use a multi-way tree.
=head2 root($tree)
Return the root node of a tree.
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 13; my $t = new;
for my $n(1..$N)
{$t->insert($n, $n);
}
is_deeply $t->leftMost ->keys, [1, 2];
is_deeply $t->rightMost->keys, [13];
ok $t->leftMost ->leaf;
ok $t->rightMost->leaf;
ok $t->root == $t; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok T($t, <<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
=head2 leaf($tree)
Confirm that the tree is a leaf.
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 13; my $t = new;
for my $n(1..$N)
{$t->insert($n, $n);
}
is_deeply $t->leftMost ->keys, [1, 2];
is_deeply $t->rightMost->keys, [13];
ok $t->leftMost ->leaf; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->rightMost->leaf; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->root == $t;
ok T($t, <<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
=head2 find($root, $key)
Find a key in a tree returning its associated data or undef if the key does not exist
Parameter Description
1 $root Root of tree
2 $key Key
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->find (17) == 34; # Find by key # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
=head2 leftMost($tree)
Return the left most node below the specified one
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 13; my $t = new;
for my $n(1..$N)
{$t->insert($n, $n);
}
is_deeply $t->leftMost ->keys, [1, 2]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
is_deeply $t->rightMost->keys, [13];
ok $t->leftMost ->leaf; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->rightMost->leaf;
ok $t->root == $t;
ok T($t, <<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
=head2 rightMost($tree)
Return the right most node below the specified one
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 13; my $t = new;
for my $n(1..$N)
{$t->insert($n, $n);
}
is_deeply $t->leftMost ->keys, [1, 2];
is_deeply $t->rightMost->keys, [13]; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->leftMost ->leaf;
ok $t->rightMost->leaf; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->root == $t;
ok T($t, <<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
=head2 height($tree)
Return the height of the tree
Parameter Description
1 $tree Tree
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 3;
my $t = new; ok $t->height == 0; ok $t->leftMost->depth == 0; ok $t->size == 0; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(1, 1); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 1; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(2, 2); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 2; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(3, 3); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 3; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(4, 4); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 4; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(5, 5); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 5; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(6, 6); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 6; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(7, 7); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 7; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(8, 8); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 8; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
is_deeply $t->flat, <<END; owf $logFile, $t->flat if $develop;
3 6
1 2 4 5 7 8
END
=head2 depth($tree)
Return the depth of a node within a tree
Parameter Description
1 $tree Tree
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 3;
my $t = new; ok $t->height == 0; ok $t->leftMost->depth == 0; ok $t->size == 0; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(1, 1); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 1; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(2, 2); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 2; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(3, 3); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 3; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(4, 4); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 4; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(5, 5); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 5; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(6, 6); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 6; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(7, 7); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 7; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(8, 8); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 8; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
is_deeply $t->flat, <<END; owf $logFile, $t->flat if $develop;
3 6
1 2 4 5 7 8
END
=head2 delete($root, $key)
Find a key in a tree, delete it, return the new tree
Parameter Description
1 $root Tree root
2 $key Key
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
ok $t->find(17) == 34 && $t->size == 1; # Size
=head2 insert($tree, $key, $data)
Insert a key and data into a tree
Parameter Description
1 $tree Tree
2 $key Key
3 $data Data
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size
=head2 iterator($tree)
Make an iterator for a tree
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 256; my $e = 0; my $t = new;
for my $n(0..$N)
{$t->insert($n, $n);
my @n; for(my $i = $t->iterator; $i->more; $i->next) {push @n, $i->key} # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
++$e unless dump(\@n) eq dump [0..$n];
}
is_deeply $e, 0;
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size
=head2 Tree::Multi::Iterator::next($iter)
Find the next key
Parameter Description
1 $iter Iterator
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 256; my $e = 0; my $t = new;
for my $n(0..$N)
{$t->insert($n, $n);
my @n; for(my $i = $t->iterator; $i->more; $i->next) {push @n, $i->key}
++$e unless dump(\@n) eq dump [0..$n];
}
is_deeply $e, 0;
=head2 reverseIterator($tree)
Create a reverse iterator for a tree
Parameter Description
1 $tree Tree
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 64; my $e = 0;
for my $n(0..$N)
{my $t = new;
for my $i(0..$n)
{$t->insert($i, $i);
}
my @n;
for(my $i = $t->reverseIterator; $i->less; $i->prev) # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
{push @n, $i->key;
}
++$e unless dump(\@n) eq dump [reverse 0..$n];
}
is_deeply $e, 0;
=head2 Tree::Multi::ReverseIterator::prev($iter)
Find the previous key
Parameter Description
1 $iter Iterator
B<Example:>
local $numberOfKeysPerNode = 3; my $N = 64; my $e = 0;
for my $n(0..$N)
{my $t = new;
for my $i(0..$n)
{$t->insert($i, $i);
}
my @n;
for(my $i = $t->reverseIterator; $i->less; $i->prev)
{push @n, $i->key;
}
++$e unless dump(\@n) eq dump [reverse 0..$n];
}
is_deeply $e, 0;
=head2 flat($tree, @title)
Print the keys in a tree from left right to make it easier to visualize the structure of the tree
Parameter Description
1 $tree Tree
2 @title Title
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 3;
my $t = new; ok $t->height == 0; ok $t->leftMost->depth == 0; ok $t->size == 0;
$t->insert(1, 1); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 1;
$t->insert(2, 2); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 2;
$t->insert(3, 3); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 3;
$t->insert(4, 4); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 4;
$t->insert(5, 5); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 5;
$t->insert(6, 6); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 6;
$t->insert(7, 7); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 7;
$t->insert(8, 8); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 8;
is_deeply $t->flat, <<END; owf $logFile, $t->flat if $develop; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
3 6
1 2 4 5 7 8
END
=head2 print($tree, $i)
Print the keys in a tree optionally marking the active key
Parameter Description
1 $tree Tree
2 $i Optional index of active key
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size
=head2 size($tree)
Count the number of keys in a tree
Parameter Description
1 $tree Tree
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 3;
my $t = new; ok $t->height == 0; ok $t->leftMost->depth == 0; ok $t->size == 0; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(1, 1); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 1; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(2, 2); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 2; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(3, 3); ok $t->height == 1; ok $t->leftMost->depth == 1; ok $t->size == 3; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(4, 4); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 4; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(5, 5); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 5; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(6, 6); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 6; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(7, 7); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 7; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert(8, 8); ok $t->height == 2; ok $t->leftMost->depth == 2; ok $t->size == 8; # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
is_deeply $t->flat, <<END; owf $logFile, $t->flat if $develop;
3 6
1 2 4 5 7 8
END
=head2 Tree::Multi Definition
Iterator
=head3 Output fields
=head4 count
Counter
=head4 data
Data at this position
=head4 key
Key at this position
=head4 keys
Array of key items for this node
=head4 less
Iteration not yet finished
=head4 more
Iteration not yet finished
=head4 node
Current node within tree
=head4 number
Number of the node for debugging purposes
=head4 pos
Current position within node
=head4 tree
Tree we are iterating over
=head4 up
Parent node
=head1 Private Methods
=head2 new()
Create a new multi-way tree node.
B<Example:>
local $Tree::Multi::numberOfKeysPerNode = 4; # Number of keys per node - can be even
my $t = Tree::Multi::new; # Construct tree # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲
$t->insert($_, 2 * $_) for reverse 1..32; # Load tree in reverse
is_deeply $t->print, <<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok $t->height == 3; # Height
ok $t->find (16) == 32; # Find by key
$t->delete(16); # Delete a key
ok !$t->find (16); # Key no longer present
ok $t->find (17) == 34; # Find by key
my @k;
for(my $i = $t->iterator; $i->more; $i->next) # Iterator
{push @k, $i->key unless $i->key == 17;
}
$t->delete($_) for @k; # Delete
ok $t->find(17) == 34 && $t->size == 1; # Size
=head2 minimumNumberOfKeys()
Minimum number of keys per node.
=head2 maximumNumberOfKeys()
Maximum number of keys per node.
=head2 maximumNumberOfNodes()
Maximum number of children per parent.
=head2 full($tree)
Confirm that a node is full.
Parameter Description
1 $tree Tree
=head2 halfFull($tree)
Confirm that a node is half full.
Parameter Description
1 $tree Tree
=head2 separateKeys($node)
Return ([lower], center, [upper]) keys.
Parameter Description
1 $node Node to split
=head2 separateData($node)
Return ([lower], center, [upper]) data
Parameter Description
1 $node Node to split
=head2 separateNode($node)
Return ([lower], [upper]) children
Parameter Description
1 $node Node to split
=head2 reUp($node, @children)
Reconnect the children to their new parent
Parameter Description
1 $node Node
2 @children Children
=head2 splitNode($node)
Split a full node in half assuming it has a non full parent
Parameter Description
1 $node Node to split
=head2 splitRootNode($node)
Split a full root
Parameter Description
1 $node Node to split
=head2 splitFullNode($node)
Split a full node
Parameter Description
1 $node Node to split
=head2 splitLeafNode($node)
Split a full leaf node in assuming it has a non full parent
Parameter Description
1 $node Node to split
=head2 splitRootLeafNode($node)
Split a full root that is also a leaf
Parameter Description
1 $node Node to split
=head2 findAndSplit($root, $key)
Find a key in a tree splitting full nodes along the path to the key
Parameter Description
1 $root Root of tree
2 $key Key
=head2 indexInParent($tree)
Get the index of a node in its parent
Parameter Description
1 $tree Tree
=head2 fillFromLeftOrRight($n, $dir)
Fill a node from the specified sibling
Parameter Description
1 $n Node to fill
2 $dir Node to fill from 0 for left or 1 for right
=head2 mergeWithLeftOrRight($n, $dir)
Merge two adjacent nodes
Parameter Description
1 $n Node to merge into
2 $dir Node to merge is on right if 1 else left
=head2 mergeOrFill($tree)
make a node larger than a half node
Parameter Description
1 $tree Tree
=head2 deleteLeafKey($tree, $i)
Delete a (key, pair) in a leaf
Parameter Description
1 $tree Tree
2 $i Index to delete at
=head2 deleteKey($tree, $i)
Delete a (key, data) pair in a node
Parameter Description
1 $tree Tree
2 $i Index to delete at
=head2 T($tree, $expected)
Write a result to the log file
Parameter Description
1 $tree Tree
2 $expected Expected print
=head2 disordered($n, $N)
Disordered but stable insertions
Parameter Description
1 $n Keys per node
2 $N Nodes
=head2 disorderedCheck($t, $n, $N)
Check disordered insertions
Parameter Description
1 $t Tree to check
2 $n Keys per node
3 $N Nodes
=head2 randomCheck($n, $N, $T)
Random insertions
Parameter Description
1 $n Keys per node
2 $N Log 10 nodes
3 $T Log 10 number of tests
=head1 Index
1 L<delete|/delete> - Find a key in a tree, delete it, return the new tree
2 L<deleteKey|/deleteKey> - Delete a (key, data) pair in a node
3 L<deleteLeafKey|/deleteLeafKey> - Delete a (key, pair) in a leaf
4 L<depth|/depth> - Return the depth of a node within a tree
5 L<disordered|/disordered> - Disordered but stable insertions
6 L<disorderedCheck|/disorderedCheck> - Check disordered insertions
7 L<fillFromLeftOrRight|/fillFromLeftOrRight> - Fill a node from the specified sibling
8 L<find|/find> - Find a key in a tree returning its associated data or undef if the key does not exist
9 L<findAndSplit|/findAndSplit> - Find a key in a tree splitting full nodes along the path to the key
10 L<flat|/flat> - Print the keys in a tree from left right to make it easier to visualize the structure of the tree
11 L<full|/full> - Confirm that a node is full.
12 L<halfFull|/halfFull> - Confirm that a node is half full.
13 L<height|/height> - Return the height of the tree
14 L<indexInParent|/indexInParent> - Get the index of a node in its parent
15 L<insert|/insert> - Insert a key and data into a tree
16 L<iterator|/iterator> - Make an iterator for a tree
17 L<leaf|/leaf> - Confirm that the tree is a leaf.
18 L<leftMost|/leftMost> - Return the left most node below the specified one
19 L<maximumNumberOfKeys|/maximumNumberOfKeys> - Maximum number of keys per node.
20 L<maximumNumberOfNodes|/maximumNumberOfNodes> - Maximum number of children per parent.
21 L<mergeOrFill|/mergeOrFill> - make a node larger than a half node
22 L<mergeWithLeftOrRight|/mergeWithLeftOrRight> - Merge two adjacent nodes
23 L<minimumNumberOfKeys|/minimumNumberOfKeys> - Minimum number of keys per node.
24 L<new|/new> - Create a new multi-way tree node.
25 L<print|/print> - Print the keys in a tree optionally marking the active key
26 L<randomCheck|/randomCheck> - Random insertions
27 L<reUp|/reUp> - Reconnect the children to their new parent
28 L<reverseIterator|/reverseIterator> - Create a reverse iterator for a tree
29 L<rightMost|/rightMost> - Return the right most node below the specified one
30 L<root|/root> - Return the root node of a tree.
31 L<separateData|/separateData> - Return ([lower], center, [upper]) data
32 L<separateKeys|/separateKeys> - Return ([lower], center, [upper]) keys.
33 L<separateNode|/separateNode> - Return ([lower], [upper]) children
34 L<size|/size> - Count the number of keys in a tree
35 L<splitFullNode|/splitFullNode> - Split a full node
36 L<splitLeafNode|/splitLeafNode> - Split a full leaf node in assuming it has a non full parent
37 L<splitNode|/splitNode> - Split a full node in half assuming it has a non full parent
38 L<splitRootLeafNode|/splitRootLeafNode> - Split a full root that is also a leaf
39 L<splitRootNode|/splitRootNode> - Split a full root
40 L<T|/T> - Write a result to the log file
41 L<Tree::Multi::Iterator::next|/Tree::Multi::Iterator::next> - Find the next key
42 L<Tree::Multi::ReverseIterator::prev|/Tree::Multi::ReverseIterator::prev> - Find the previous key
=head1 Installation
This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B<cpan>:
sudo cpan install Tree::Multi
=head1 Author
L<philiprbrenan@gmail.com|mailto:philiprbrenan@gmail.com>
=head1 Copyright
Copyright (c) 2016-2021 Philip R Brenan.
This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.
=cut
# Tests and documentation
sub
test
{
my
$p
= __PACKAGE__;
binmode
(
$_
,
":utf8"
)
for
*STDOUT
,
*STDERR
;
return
if
eval
"eof(${p}::DATA)"
;
my
$s
=
eval
"join('', <${p}::DATA>)"
;
$@ and
die
$@;
eval
$s
;
$@ and
die
$@;
1
}
test
unless
caller
;
1;
# podDocumentation
#__DATA__
use
Test::Most;
my
$develop
= -e
q(/home/phil/)
;
# Developing
my
$logFile
=
q(/home/phil/perl/cpan/TreeMulti/lib/Tree/zzzLog.txt)
;
# Log file
my
$localTest
= ((
caller
(1))[0]//
'Tree::Multi'
) eq
"Tree::Multi"
;
# Local testing mode
Test::More->builder->output(
"/dev/null"
)
if
$localTest
;
# Reduce number of confirmation messages during testing
if
($^O =~ m(bsd|linux)i)
# Supported systems
{plan
tests
=> 180;
}
else
{plan
skip_all
=>
qq(Not supported on: $^O)
;
}
bail_on_fail;
# Stop if any tests fails
sub
T($$)
#P Write a result to the log file
{
my
(
$tree
,
$expected
) =
@_
;
# Tree, expected print
confess
unless
ref
(
$tree
);
my
$got
=
$tree
->
;
return
$got
eq
$expected
unless
$develop
;
my
$s
=
&showGotVersusWanted
(
$got
,
$expected
);
return
1
unless
$s
;
owf(
$logFile
,
$got
);
confess
"$s\n"
;
}
my
$start
=
time
;
# Tests
eval
{
goto
latest}
if
!
caller
(0) and -e
"/home/phil"
;
# Go to latest test if specified
if
(1) {
local
$numberOfKeysPerNode
= 15;
my
$t
= new;
my
$N
= 256;
$t
->insert(
$_
, 2 *
$_
)
for
1..
$N
;
is_deeply
$t
->
, <<END;
72 144
9 18 27 36 45 54 63
1 2 3 4 5 6 7 8
10 11 12 13 14 15 16 17
19 20 21 22 23 24 25 26
28 29 30 31 32 33 34 35
37 38 39 40 41 42 43 44
46 47 48 49 50 51 52 53
55 56 57 58 59 60 61 62
64 65 66 67 68 69 70 71
81 90 99 108 117 126 135
73 74 75 76 77 78 79 80
82 83 84 85 86 87 88 89
91 92 93 94 95 96 97 98
100 101 102 103 104 105 106 107
109 110 111 112 113 114 115 116
118 119 120 121 122 123 124 125
127 128 129 130 131 132 133 134
136 137 138 139 140 141 142 143
153 162 171 180 189 198 207 216 225 234 243
145 146 147 148 149 150 151 152
154 155 156 157 158 159 160 161
163 164 165 166 167 168 169 170
172 173 174 175 176 177 178 179
181 182 183 184 185 186 187 188
190 191 192 193 194 195 196 197
199 200 201 202 203 204 205 206
208 209 210 211 212 213 214 215
217 218 219 220 221 222 223 224
226 227 228 229 230 231 232 233
235 236 237 238 239 240 241 242
244 245 246 247 248 249 250 251 252 253 254 255 256
END
if
(1)
{
my
$n
= 0;
for
my
$i
(1..
$N
)
{
my
$ii
=
$t
->find(
$i
);
++
$n
if
$t
->find(
$i
) eq 2 *
$i
;
}
ok
$n
==
$N
;
}
}
if
(1) {
# Large number of keys per node
local
$numberOfKeysPerNode
= 15;
my
$t
= new;
my
$N
= 256;
$t
->insert(
$_
, 2 *
$_
)
for
reverse
map
{
scalar
reverse
} 1..
$N
;
is_deeply
$t
->
,
<<END;
371
09 18 032 48 061 75 86 99 132 202 252 322
001 002 03 04 05 06 07 08
011 012 13 14 15 16 17
19 021 022 23 24 25 26 27 28 29 031
33 34 35 36 37 38 39 041 042 43 44 45 46 47
49 051 052 53 54 55 56 57 58 59
62 63 64 65 66 67 68 69 071 72 73 74
76 77 78 79 081 82 83 84 85
87 88 89 091 92 93 94 95 96 97 98
101 102 111 112 121 122 131
141 142 151 152 161 171 181 191 201
211 212 221 222 231 232 241 242 251
261 271 281 291 301 302 311 312 321
331 332 341 342 351 352 361
452 542 622 681 732 822 891
381 391 401 402 411 412 421 422 431 432 441 442 451
461 471 481 491 501 502 511 512 521 522 531 532 541
551 552 561 571 581 591 601 602 611 612 621
631 632 641 642 651 652 661 671
691 701 702 711 712 721 722 731
741 742 751 761 771 781 791 801 802 811 812 821
831 832 841 842 851 861 871 881
901 902 911 912 921 922 931 932 941 942 951 961 971 981 991
END
if
(1)
{
my
$n
= 0;
for
my
$i
(
map
{
scalar
reverse
} 1..
$N
)
{
my
$ii
=
$t
->find(
$i
);
++
$n
if
$t
->find(
$i
) eq 2 *
$i
;
}
ok
$n
==
$N
;
}
}
if
(1) {
local
$numberOfKeysPerNode
= 3;
my
$t
= new;
my
$N
= 16;
$t
->insert(
$_
, 2 *
$_
)
for
1..
$N
;
ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12 15
7 8
10 11
13 14
16
END
ok
$t
->find(16);
$t
->
delete
(16); ok !
$t
->find(16); ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12 14
7 8
10 11
13
15
END
ok
$t
->find(15);
$t
->
delete
(15); ok !
$t
->find(15); ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12
7 8
10 11
13 14
END
ok
$t
->find(14);
$t
->
delete
(14); ok !
$t
->find(14); ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
ok
$t
->find(13);
$t
->
delete
(13); ok !
$t
->find(13); ok T(
$t
,
<<END);
6
3
1 2
4 5
9 11
7 8
10
12
END
ok
$t
->find(12);
$t
->
delete
(12); ok !
$t
->find(12); ok T(
$t
,
<<END);
6
3
1 2
4 5
9
7 8
10 11
END
ok
$t
->find(11);
$t
->
delete
(11); ok !
$t
->find(11); ok T(
$t
,
<<END);
6
3
1 2
4 5
9
7 8
10
END
ok
$t
->find(10);
$t
->
delete
(10); ok !
$t
->find(10); ok T(
$t
,
<<END);
3 6 8
1 2
4 5
7
9
END
ok
$t
->find(9);
$t
->
delete
(9); ok !
$t
->find(9); ok T(
$t
,
<<END);
3 6
1 2
4 5
7 8
END
ok
$t
->find(8);
$t
->
delete
(8); ok !
$t
->find(8); ok T(
$t
,
<<END);
3 6
1 2
4 5
7
END
ok
$t
->find(7);
$t
->
delete
(7); ok !
$t
->find(7); ok T(
$t
,
<<END);
3 5
1 2
4
6
END
ok
$t
->find(6);
$t
->
delete
(6); ok !
$t
->find(6); ok T(
$t
,
<<END);
3
1 2
4 5
END
ok
$t
->find(5);
$t
->
delete
(5); ok !
$t
->find(5); ok T(
$t
,
<<END);
3
1 2
4
END
ok
$t
->find(4);
$t
->
delete
(4); ok !
$t
->find(4); ok T(
$t
,
<<END);
2
1
3
END
ok
$t
->find(3);
$t
->
delete
(3);
ok !
$t
->find(3);
ok T(
$t
,
<<END);
1 2
END
ok
$t
->find(2);
$t
->
delete
(2); ok !
$t
->find(2); ok T(
$t
,
<<END);
1
END
ok
$t
->find(1);
$t
->
delete
(1); ok !
$t
->find(1); ok T(
$t
,
<<END);
END
}
if
(1) {
local
$numberOfKeysPerNode
= 3;
my
$t
= new;
my
$N
= 5;
$t
->insert(
$_
, 2 *
$_
)
for
1..
$N
;
ok T(
$t
,
<<END);
3
1 2
4 5
END
$t
->
delete
(4); ok T(
$t
,
<<END);
3
1 2
5
END
$t
->
delete
(1); ok T(
$t
,
<<END);
3
2
5
END
$t
->
delete
(2);
ok T(
$t
,
<<END);
3 5
END
$t
->
delete
(3); ok T(
$t
,
<<END);
5
END
}
if
(1) {
local
$numberOfKeysPerNode
= 3;
my
$t
= new;
my
$N
= 15;
$t
->insert(
$_
, 2 *
$_
)
for
1..
$N
;
ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12
7 8
10 11
13 14 15
END
ok
$t
->find(3);
$t
->
delete
(3); ok !
$t
->find(3); ok T(
$t
,
<<END);
6
4
1 2
5
9 12
7 8
10 11
13 14 15
END
ok
$t
->find(9);
$t
->
delete
(9); ok !
$t
->find(9); ok T(
$t
,
<<END);
6
4
1 2
5
10 12
7 8
11
13 14 15
END
ok
$t
->find(4);
$t
->
delete
(4); ok !
$t
->find(4); ok T(
$t
,
<<END);
10
2 6
1
5
7 8
12
11
13 14 15
END
ok
$t
->find(12);
$t
->
delete
(12); ok !
$t
->find(12); ok T(
$t
,
<<END);
10
2 6
1
5
7 8
13
11
14 15
END
ok
$t
->find(2);
$t
->
delete
(2); ok !
$t
->find(2); ok T(
$t
,
<<END);
10
6
1 5
7 8
13
11
14 15
END
ok
$t
->find(13);
$t
->
delete
(13); ok !
$t
->find(13); ok T(
$t
,
<<END);
10
6
1 5
7 8
14
11
15
END
ok
$t
->find(6);
$t
->
delete
(6); ok !
$t
->find(6); ok T(
$t
,
<<END);
10
7
1 5
8
14
11
15
END
ok
$t
->find(14);
$t
->
delete
(14); ok !
$t
->find(14); ok T(
$t
,
<<END);
7 10
1 5
8
11 15
END
}
if
(1) {
local
$numberOfKeysPerNode
= 3;
my
$t
= new;
my
$N
= 15;
$t
->insert(
$_
, 2 *
$_
)
for
1..
$N
;
ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12
7 8
10 11
13 14 15
END
ok
$t
->find(6);
$t
->
delete
(6); ok !
$t
->find(6); ok T(
$t
,
<<END);
7
3
1 2
4 5
9 12
8
10 11
13 14 15
END
ok
$t
->find(7);
$t
->
delete
(7); ok !
$t
->find(7); ok T(
$t
,
<<END);
8
3
1 2
4 5
10 12
9
11
13 14 15
END
ok
$t
->find(8);
$t
->
delete
(8); ok !
$t
->find(8); ok T(
$t
,
<<END);
9
3
1 2
4 5
12
10 11
13 14 15
END
ok
$t
->find(9);
$t
->
delete
(9); ok !
$t
->find(9); ok T(
$t
,
<<END);
10
3
1 2
4 5
12
11
13 14 15
END
ok
$t
->find(10);
$t
->
delete
(10); ok !
$t
->find(10); ok T(
$t
,
<<END);
3 5 12
1 2
4
11
13 14 15
END
ok
$t
->find(3);
$t
->
delete
(3); ok !
$t
->find(3); ok T(
$t
,
<<END);
2 5 12
1
4
11
13 14 15
END
ok
$t
->find(2);
$t
->
delete
(2); ok !
$t
->find(2); ok T(
$t
,
<<END);
5 12
1 4
11
13 14 15
END
ok
$t
->find(5);
$t
->
delete
(5); ok !
$t
->find(5); ok T(
$t
,
<<END);
4 12
1
11
13 14 15
END
ok
$t
->find(4);
$t
->
delete
(4); ok !
$t
->find(4); ok T(
$t
,
<<END);
12
1 11
13 14 15
END
ok
$t
->find(12);
$t
->
delete
(12); ok !
$t
->find(12); ok T(
$t
,
<<END);
13
1 11
14 15
END
ok
$t
->find(13);
$t
->
delete
(13); ok !
$t
->find(13); ok T(
$t
,
<<END);
14
1 11
15
END
ok
$t
->find(14);
$t
->
delete
(14); ok !
$t
->find(14); ok T(
$t
,
<<END);
11
1
15
END
ok
$t
->find(11);
$t
->
delete
(11); ok !
$t
->find(11); ok T(
$t
,
<<END);
1 15
END
ok
$t
->find(1);
$t
->
delete
(1); ok !
$t
->find(1); ok T(
$t
,
<<END);
15
END
ok
$t
->find(15);
$t
->
delete
(15); ok !
$t
->find(15); ok T(
$t
,
<<END);
END
}
sub
disordered($$)
#P Disordered but stable insertions
{
my
(
$n
,
$N
) =
@_
;
# Keys per node, nodes
local
$numberOfKeysPerNode
=
$n
;
my
$t
= new;
my
@t
=
map
{
$_
=
scalar
reverse
$_
; s/\A0+//r} 1..
$N
;
$t
->insert(
$_
, 2 *
$_
)
for
@t
;
$t
# Tree built from disordered but stable insertions
}
sub
disorderedCheck($$$)
#P Check disordered insertions
{
my
(
$t
,
$n
,
$N
) =
@_
;
# Tree to check, keys per node, Nodes
my
%t
=
map
{
$_
=>2
*$_
}
map
{
$_
=
scalar
reverse
$_
; s/\A0+//r} 1..
$N
;
my
$e
= 0;
my
$h
=
$t
->height;
for
my
$k
(
sort
{
reverse
(
$a
) cmp
reverse
(
$b
)}
keys
%t
)
{++
$e
unless
$t
->find(
$k
) ==
$t
{
$k
};
$t
->
delete
(
$k
);
delete
$t
{
$k
};
++
$e
if
defined
$t
->find(
$k
);
++
$e
if
$t
->height >
$h
;
}
++
$e
unless
$t
->height == 0;
!
$e
;
# No errors
}
sub
randomCheck($$$)
#P Random insertions
{
my
(
$n
,
$N
,
$T
) =
@_
;
# Keys per node, log 10 nodes, log 10 number of tests
local
$numberOfKeysPerNode
=
$n
;
my
$e
= 0;
for
(1..10*
*$T
)
# Each test
{
my
%t
=
map
{
$_
=>2
*$_
} 1..10*
*$N
;
my
$t
= new;
$t
->insert(
$_
,
$t
{
$_
})
for
keys
%t
;
for
my
$k
(
keys
%t
)
# Delete each key in test
{++
$e
unless
$t
->find(
$k
) ==
$t
{
$k
};
$t
->
delete
(
$k
);
delete
$t
{
$k
};
++
$e
if
defined
$t
->find(
$k
);
}
}
!
$e
;
# No errors
}
if
(1) {
#Titerator #TTree::Multi::Iterator::next #TTree::Multi::Iterator::more
local
$numberOfKeysPerNode
= 3;
my
$N
= 256;
my
$e
= 0;
my
$t
= new;
for
my
$n
(0..
$N
)
{
$t
->insert(
$n
,
$n
);
my
@n
;
for
(
my
$i
=
$t
->iterator;
$i
->more;
$i
->
next
) {
push
@n
,
$i
->key}
++
$e
unless
dump
(\
@n
) eq
dump
[0..
$n
];
}
is_deeply
$e
, 0;
}
if
(1) {
#TleftMost #TrightMost #Tleaf #Troot
local
$numberOfKeysPerNode
= 3;
my
$N
= 13;
my
$t
= new;
for
my
$n
(1..
$N
)
{
$t
->insert(
$n
,
$n
);
}
is_deeply
$t
->leftMost ->
keys
, [1, 2];
is_deeply
$t
->rightMost->
keys
, [13];
ok
$t
->leftMost ->leaf;
ok
$t
->rightMost->leaf;
ok
$t
->root ==
$t
;
ok T(
$t
,
<<END);
6
3
1 2
4 5
9 12
7 8
10 11
13
END
}
if
(1) {
#TreverseIterator #TTree::Multi::ReverseIterator::prev #TTree::Multi::ReverseIterator::less
local
$numberOfKeysPerNode
= 3;
my
$N
= 64;
my
$e
= 0;
for
my
$n
(0..
$N
)
{
my
$t
= new;
for
my
$i
(0..
$n
)
{
$t
->insert(
$i
,
$i
);
}
my
@n
;
for
(
my
$i
=
$t
->reverseIterator;
$i
->less;
$i
->prev)
{
push
@n
,
$i
->key;
}
++
$e
unless
dump
(\
@n
) eq
dump
[
reverse
0..
$n
];
}
is_deeply
$e
, 0;
}
if
(1) {
#Theight #Tdepth #Tsize #Tflat
local
$Tree::Multi::numberOfKeysPerNode
= 3;
my
$t
= new; ok
$t
->height == 0; ok
$t
->leftMost->depth == 0; ok
$t
->size == 0;
$t
->insert(1, 1); ok
$t
->height == 1; ok
$t
->leftMost->depth == 1; ok
$t
->size == 1;
$t
->insert(2, 2); ok
$t
->height == 1; ok
$t
->leftMost->depth == 1; ok
$t
->size == 2;
$t
->insert(3, 3); ok
$t
->height == 1; ok
$t
->leftMost->depth == 1; ok
$t
->size == 3;
$t
->insert(4, 4); ok
$t
->height == 2; ok
$t
->leftMost->depth == 2; ok
$t
->size == 4;
$t
->insert(5, 5); ok
$t
->height == 2; ok
$t
->leftMost->depth == 2; ok
$t
->size == 5;
$t
->insert(6, 6); ok
$t
->height == 2; ok
$t
->leftMost->depth == 2; ok
$t
->size == 6;
$t
->insert(7, 7); ok
$t
->height == 2; ok
$t
->leftMost->depth == 2; ok
$t
->size == 7;
$t
->insert(8, 8); ok
$t
->height == 2; ok
$t
->leftMost->depth == 2; ok
$t
->size == 8;
is_deeply
$t
->flat,
<<END; owf $logFile, $t->flat if $develop;
3 6
1 2 4 5 7 8
END
}
if
(1) {
# Even number of keys
my
$t
= new;
$t
= disordered( 4, 256);
ok disorderedCheck(
$t
, 4, 256);
}
if
(1) {
# Even number of keys
my
$t
= disordered(4, 64);
ok T(
$t
,
<<END);
61
9 31
3 6
1 2
4 5
7 8
13 22
11 12
14 15 16 21
23 24 25 26
34 42 51
32 33
35 36 41
43 44 45 46
52 53 54 55
82
64 72
62 63
65 71
73 74 75 81
91
83 84 85
92 93 94 95
END
}
if
(1) {
# Deleting interior nodes
my
$k
= 3;
my
$n
= 18;
my
$t
= disordered
$k
,
$n
;
my
@s
;
push
@s
,
$t
->flat(
"Start"
);
for
my
$k
(31, 61, 6, 5, 21, 4, 3, 2, 7, 8, 11, 41, 71, 51, 81, 9, 1)
{
$t
->
delete
(
$k
);
push
@s
,
$t
->flat(
"After deleting $k"
);
}
my
$s
=
join
"\n"
,
@s
; owf
$logFile
,
$s
if
$develop
;
is_deeply
$s
,
<<END;
Start
6 31
3 9 61
1 2 4 5 7 8 11 21 41 51 71 81
After deleting 31
6 21
3 9 61
1 2 4 5 7 8 11 41 51 71 81
After deleting 61
6 21
3 9 71
1 2 4 5 7 8 11 41 51 81
After deleting 6
7 21
3 9 71
1 2 4 5 8 11 41 51 81
After deleting 5
7 21
3 9 71
1 2 4 8 11 41 51 81
After deleting 21
11
3 7 71
1 2 4 8 9 41 51 81
After deleting 4
11
2 7 71
1 3 8 9 41 51 81
After deleting 3
11
7 71
1 2 8 9 41 51 81
After deleting 2
11
7 71
1 8 9 41 51 81
After deleting 7
11
8 71
1 9 41 51 81
After deleting 8
11 71
1 9 41 51 81
After deleting 11
41 71
1 9 51 81
After deleting 41
9 71
1 51 81
After deleting 71
51
1 9 81
After deleting 51
9
1 81
After deleting 81
1 9
After deleting 9
1
After deleting 1
END
}
ok
&randomCheck
(3,
$develop
? (2, 1) : (2, 3));
# Randomize and check against a Perl hash
ok
&randomCheck
(4,
$develop
? (2, 1) : (2, 3));
ok
&randomCheck
(5,
$develop
? (2, 1) : (2, 2));
ok
&randomCheck
(6,
$develop
? (2, 1) : (2, 2));
ok
&randomCheck
(7,
$develop
? (2, 1) : (3, 1));
ok
&randomCheck
(8,
$develop
? (2, 1) : (3, 1));
if
(1) {
# Synopsis #Tnew #Tinsert #Tfind #Tdelete #Tprint #Titerator
local
$Tree::Multi::numberOfKeysPerNode
= 4;
# Number of keys per node - can be even
my
$t
= Tree::Multi::new;
# Construct tree
$t
->insert(
$_
, 2 *
$_
)
for
reverse
1..32;
# Load tree in reverse
is_deeply
$t
->
,
<<END;
15 21 27
3 6 9 12
1 2
4 5
7 8
10 11
13 14
18
16 17
19 20
24
22 23
25 26
30
28 29
31 32
END
ok
$t
->height == 3;
# Height
ok
$t
->find (16) == 32;
# Find by key
$t
->
delete
(16);
# Delete a key
ok !
$t
->find (16);
# Key no longer present
ok
$t
->find (17) == 34;
# Find by key
my
@k
;
for
(
my
$i
=
$t
->iterator;
$i
->more;
$i
->
next
)
# Iterator
{
push
@k
,
$i
->key
unless
$i
->key == 17;
}
$t
->
delete
(
$_
)
for
@k
;
# Delete
ok
$t
->find(17) == 34 &&
$t
->size == 1;
# Size
}
lll
"Success:"
,
sprintf
(
"%5.2f seconds"
,
time
-
$start
);