File Coverage

blib/lib/Tree/Bulk.pm

Criterion	Covered	Total	%
statement	329	343	95.9
branch	218	296	73.6
condition	78	104	75.0
subroutine	57	59	96.6
pod	39	44	88.6
total	721	846	85.2

#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib/ -I.
#-------------------------------------------------------------------------------
# Bulk Tree operations
# Philip R Brenan at appaapps dot com, Appa Apps Ltd Inc., 2021
#-------------------------------------------------------------------------------
# podDocumentation
package Tree::Bulk;
our $VERSION = "20210302";
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess cluck);
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
use feature qw(say current_sub);

sub saveLog($)                                                                  #P Save a result to the log file if we are developing
 {my ($string) = @_;                                                            # String to save
  my $l = q(/home/phil/perl/z/bulkTree/zzz.txt);                                # Log file if available

  owf($l, $string) if -e $l;
  confess "Saved to logfile:\n$l\n";
  exit
 }

sub save                                                                        # Simplified save
 {my ($t) = @_;                                                                 # Tree
  saveLog($t->printKeys);
 }

sub Left  {q(left)}                                                             # Left
sub Right {q(right)}                                                            # Right

#D1 Bulk Tree                                                                   # Bulk Tree

sub node(;$$$$)                                                                 #P Create a new bulk tree node
 {my ($key, $data, $up, $side) = @_;                                            # Key, $data, parent node, side of parent node
  my $t = genHash(__PACKAGE__,                                                  # Bulk tree node
    keysPerNode => $up ? $up->keysPerNode : 4,                                  # Maximum number of keys per node
    up          => $up,                                                         # Parent node
    left        => undef,                                                       # Left node
    right       => undef,                                                       # Right node
    height      => 1,                                                           # Height of node
    keys        => [$key  ? $key  : ()],                                        # Array of data items for this node
    data        => [$data ? $data : ()],                                        # Data corresponding to each key
   );

  if ($up)                                                                      # Install new node in tree
   {if ($side)
     {$up->{$side} = $t;
      $up->setHeights(2);
     }
    else
     {confess 'Specify side' if !$side;
     }
   }
  $t
 }

sub new {node}                                                                  # Create a new tree

sub isRoot($)                                                                   # Return the tree if it is the root
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  !$tree->up ? $tree : undef
 }

sub root($)                                                                     # Return the root node of a tree
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  for(; $tree->up; $tree = $tree->up) {}
  $tree
 }

sub leaf($)                                                                     # Return the tree if it is a leaf
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree and !$tree->right and !$tree->left ? $tree : undef
 }

sub duplex($)                                                                   # Return the tree if it has left and right children
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->right and $tree->left             ? $tree : undef
 }

sub simplex($)                                                                  # Return the tree if it has either a left child or a right child but not both.
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->right xor $tree->left             ? $tree : undef
 }

sub simplexWithLeaf($)                                                          # Return the tree if it has either a left child or a right child but not both and the child it has a leaf.
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  return undef unless $tree->right xor $tree->left;
  return undef if $tree->right and !$tree->right->leaf;
  return undef if $tree->left  and !$tree->left ->leaf;
  $tree
 }

sub empty($)                                                                    # Return the tree if it is empty
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->leaf and !$tree->keys->@*         ? $tree : undef
 }

sub singleton($)                                                                # Return the tree if it contains only the root node and nothing else
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->leaf and $tree->isRoot            ? $tree : undef;
 }

sub isLeftChild($)                                                              # Return the tree if it is the left child
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->up and $tree->up->left and $tree->up->left   == $tree ? $tree : undef;
 }

sub isRightChild($)                                                             # Return the tree if it is the right child
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->up and $tree->up->right and $tree->up->right == $tree ? $tree : undef;
 }

sub name($)                                                                     # Name of a tree
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  join ' ', $tree->keys->@*
 }

sub names($)                                                                    # Names of all nodes in a tree in order
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  join ' ', map {$_->name} $tree->inorder;
 }

sub setHeights($)                                                               #P Set heights along path to root
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  for(my $n = $tree; $n; $n = $n->up)
   {$n->setHeight;
    $n->balance;
   }
 } # setHeights

sub actualHeight($)                                                             #P Get the height of a node
 {my ($tree) = @_;                                                              # Tree
  return 0 unless $tree;
  $tree->height
 }

sub maximum($$)                                                                 #P Maximum of two numbers
 {my ($a, $b) = @_;                                                             # First, second
  $a > $b ? $a : $b
 }

sub setHeight($)                                                                #P Set height of a tree from its left and right trees
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  my $l = actualHeight($tree->left);
  my $r = actualHeight($tree->right);
  $tree->height = 1 + maximum($l, $r);
 } # setHeight

# Rotate left

#    p                  p
#      n                  r
#    l   r              n   R
#       L R           l  L

sub rotateLeft($)                                                               #P Rotate a node left
 {my ($n) = @_;                                                                 # Node
  confess unless $n;
  my $p     = $n->up;
  return unless $p;
  my $r     = $n->right;
  return unless $r;
  my $L     = $r->left;
  $p->{$n->isRightChild ? Right : Left} = $r; $r->up = $p;
  $r->left  = $n; $n->up = $r;
  $n->right = $L; $L->up = $n if $L;
  setHeight $_ for  $n, $r, $p;
  $r->refill;
 } # rotateLeft

sub rotateRight($)                                                              #P Rotate a node right
 {my ($n) = @_;                                                                 # Node
  confess unless $n;
  my $p     = $n->up;
  return unless $p;
  my $l     = $n->left;
  return unless $l;
  my $R     = $l->right;
  $p->{$n->isLeftChild ? Left : Right} = $l; $l->up = $p;
  $l->right = $n; $n->up = $l;
  $n->left  = $R; $R->up = $n if $R;
  setHeight $_ for  $n, $l, $p;
  $l->refill;
 } # rotateLeft

# Balance - make the deepest sub tree one less deep

#    1                1
#      2                     5
#        6            2         6
#      5                4
#    4                    3
#  3

sub balance($)                                                                  # Balance a node
 {my ($t) = @_;                                                                 # Tree
  confess unless $t;
  my ($l, $r) = (actualHeight($t->left), actualHeight($t->right));

  if   ($l > 2 * $r + 1)                                                        # Rotate right
   {if (my $l = $t->left)                                                       # Counter balance if necessary
     {if (actualHeight($l->right) > actualHeight($l->left))
       {$l->rotateLeft
       }
     }
    $t->rotateRight;
   }
  elsif ($r > 2 * $l + 1)                                                       # Rotate left
   {if (my $r = $t->right)                                                      # Counter balance if necessary
     {if (actualHeight($r->left) > actualHeight($r->right))
       {$r->rotateRight
       }
     }
    $t->rotateLeft;
   }

  $t
 } # balance

sub insertUnchecked($$$)                                                        #P Insert a key and some data into a tree
 {my ($tree, $key, $data) = @_;                                                 # Tree, key, data
  confess unless $tree;
  confess unless defined $key;

  my sub insertIntoNode                                                         # Insert the current key into the specified node
   {my @k; my @d;                                                               # Rebuilt node
    my $low = 1;                                                                # Keys less than the key
    for my $i(keys $tree->keys->@*)                                             # Insert key and data in node
     {my $k = $tree->keys->[$i];
      confess "Duplicate key" if $k == $key;
      if ($low and $k > $key)                                                   # Insert key and data before first greater key
       {$low = undef;
        push @k, $key;
        push @d, $data;
       }
      push @k, $k;
      push @d, $tree->data->[$i];
     }
    if ($low)                                                                   # Key bigger than largest key
     {push @d, $data;
      push @k, $key;
     }
    $tree->keys = \@k; $tree->data = \@d;                                       # Keys and data in node
   } # insertIntoNode

  if    ($tree->keys->@* < $tree->keysPerNode and leaf $tree)                   # Small node so we can add within the node
   {insertIntoNode;
    return $tree;
   }

  elsif ($key < $tree->keys->[0])                                               # Less than least - Go left
   {if ($tree->left)                                                            # New node left
     {return __SUB__->($tree->left, $key, $data);
     }
    else
     {return node $key, $data, $tree, Left;                                     # Add a new node left
     }
   }

  elsif ($key > $tree->keys->[-1])                                              # Greater than most  - go right
   {if ($tree->right)                                                           # New node right
     {return __SUB__->($tree->right, $key, $data);
     }
    else
     {return node $key, $data, $tree, Right;                                    # Add a new node right
     }
   }

  else                                                                          # Full node and key is inside it
   {insertIntoNode;                                                             # Keys in node
    if ($tree->keys->@* > $tree->keysPerNode)                                   # Reinsert last key and data if the node is now to big
     {my $k = pop $tree->keys->@*;
      my $d = pop $tree->data->@*;
      if (my $r = $tree->right)
       {return $r->insertUnchecked($k, $d);
       }
      else                                                                      # Insert right in new node and balance
       {return node $k, $d, $tree, Right;
       }
     }
    return $tree;
   }
 } # insertUnchecked

sub insert($$$)                                                                 # Insert a key and some data into a tree
 {my ($tree, $key, $data) = @_;                                                 # Tree, key, data
  confess unless $tree;
  confess unless defined $key;
  $tree->insertUnchecked($key, $data);
 } # insert

sub find($$)                                                                    # Find a key in a tree and returns its data
 {my ($tree, $key) = @_;                                                        # Tree, key
  confess unless $tree;
  confess "No key" unless defined $key;
  confess "Non numeric key" unless $key =~ m(\A\d+\Z);

  sub                                                                           # Find the key in the sub-tree
   {my ($tree) = @_;                                                            # Sub-tree
    if ($tree)
     {my $keys = $tree->keys;
      confess "Empty node" unless $keys->@*;

      return __SUB__->($tree->left)  if $key < $$keys[ 0];
      return __SUB__->($tree->right) if $key > $$keys[-1];

      for my $i(keys $keys->@*)                                                 # Find key in node
       {my $v = $tree->data->[$i];
        confess "undefined data for key $key" unless defined $v;
        return $tree->data->[$i] if $key == $$keys[$i];
       }
     }
    undef
   }->($tree)
 } # find

sub first($)                                                                    # First node in a tree
 {my ($n) = @_;                                                                 # Tree
  confess unless $n;
  $n = $n->left while $n->left;
  $n
 }

sub last($)                                                                     # Last node in a tree
 {my ($n) = @_;                                                                 # Tree
  confess unless $n;
  $n = $n->right while $n->right;
  $n
 }

sub next($)                                                                     # Next node in order
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  if   (my $r = $tree->right)
   {return $r->left ? $r->left->first : $r;
   }
  my $p = $tree;
  for(; $p; $p = $p->up)
   {return $p->up unless $p->up and $p->up->right and $p->up->right == $p;
   }
  undef
 }

sub prev($)                                                                     # Previous node in order
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  if   (my $l = $tree->left)
   {return $l->right ? $l->right->last : $l;
   }
  my $p = $tree;
  for(; $p; $p = $p->up)
   {return $p->up unless $p->up and $p->up->left and $p->up->left == $p;
   }
  undef
 }

sub inorder($)                                                                  # Return a list of all the nodes in a tree in order
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  my @n;
  for(my $n = $tree->first; $n; $n = $n->next)
   {push @n, $n;
   }
  @n
 }

sub unchain($)                                                                  #P Remove a tree from the middle of a chain. A leaf is considered to be in the middle of a chain and so can be removed with this method
 {my ($t) = @_;                                                                 # Tree
  confess unless $t;
  confess "Duplex tree cannot be unchained" if duplex $t;
  confess        "Root cannot be unchained" unless my $p = $t->up;

  my $c = $t->left // $t->right;                                                # Not duplex so at most one of these
  $p->{$t->isLeftChild ? Left : Right} = $c;                                    # Unchain
  $c->up = $p if $c;
  $t->up = undef;

  if    (my $l = $p->left)  {$l->setHeights($l->height)}                        # Set heights from a known point
  elsif (my $r = $p->right) {$r->setHeights($r->height)}
  else                      {$p->setHeights(1)}

  $p->balance;                                                                  # Rebalance parent

  $p                                                                            # Unchained node
 } # unchain

sub refillFromRight($)                                                          #P Push a key to the target node from the next node
 {my ($target) = @_;                                                            # Target tree

  confess unless $target;
  confess "No right"  unless              $target->right;                       # Ensure source will be in this sub tree
  confess "No source" unless my $source = $target->next;                        # No source

  while ($source->keys->@* > 0 and $target->keys->@* < $target->keysPerNode)    # Transfer fill from source
   {push $target->keys->@*, shift  $source->keys->@*;
    push $target->data->@*, shift  $source->data->@*;
   }
  $source->unchain if $source->empty;
  $_->refill for $target, $source;
 } # refillFromRight

sub refillFromLeft($)                                                           #P Push a key to the target node from the previous node
 {my ($target) = @_;                                                            # Target tree

  confess unless $target;
  confess "No left"   unless              $target->left;                        # Ensure source will be in this sub tree
  confess "No source" unless my $source = $target->prev;                        # No source

  while ($source->keys->@* > 0 and $target->keys->@* < $target->keysPerNode)    # Transfer fill from source
   {unshift $target->keys->@*, pop $source->keys->@*;
    unshift $target->data->@*, pop $source->data->@*;
   }

  $source->unchain if $source->empty;
  $_->refill for $target, $source;
 } # refillFromLeft

sub refill($)                                                                   #P Refill a node so it has the expected number of keys
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  return if $tree->singleton;
  return if $tree->keys->@* == $tree->keysPerNode;

  if ($tree->empty)                                                             # Remove an empty leaf that is not the root
   {$tree->unchain unless $tree->isRoot;
   }

  elsif ($tree->keys->@* < $tree->keysPerNode)                                  # Refill the node from neighboring leaf nodes
   {if (!$tree->leaf)                                                           # Do not refill leaves
     {$tree->refillFromRight if $tree->right;
      $tree->refillFromLeft  if $tree->left;
     }
   }

  else
   {while($tree->keys->@* > $tree->keysPerNode)                                 # Empty node if over full
     {$tree->insertUnchecked(pop $tree->keys->@*, pop $tree->data->@*);         # Reinsert lower down
     }
   }
 } # refill

sub delete($$)                                                                  # Delete a key in a tree
 {my ($tree, $key) = @_;                                                        # Tree, key
  confess unless $tree;
  confess "No key" unless defined $key;

  sub                                                                           # Find then delete the key in the sub-tree
   {my ($tree) = @_;                                                            # Sub-tree
    return unless $tree;
    return unless $tree->keys->@*;                                              # Empty tree
    if    ($key < $tree->keys->[ 0]) {__SUB__->($tree->left)}                   # Less than least key so go left
    elsif ($key > $tree->keys->[-1]) {__SUB__->($tree->right)}                  # Greater than most key so go right
    elsif (grep {$_ == $key} $tree->keys->@*)                                   # Key present in current node
     {my @k, my @d;
      for my $i(keys $tree->keys->@*)                                           # Remove the key and corresponding data
       {next if  $tree->keys->[$i] == $key;
        push @d, $tree->data->[$i];
        push @k, $tree->keys->[$i];
       }
      $tree->keys = \@k; $tree->data = \@d;
      $tree->refill;                                                            # Refill the tree
     }
   }->($tree);
 } # delete

sub printKeys2($$$)                                                             #P print the keys for a tree
 {my ($t, $in, $g) = @_;                                                        # Tree, indentation, list of keys,
  return unless $t;
  __SUB__->($t->left, $in+1, $g);                                               # Left

  my $h = $t->height;
  my $s = $t->up && $t->up->left  && $t->up->left  == $t ? 'L' :                # Print
          $t->up && $t->up->right && $t->up->right == $t ? 'R' : 'S';
     $s .= $t->leaf ? 'z' : $t->isRoot ?  'A' : $t->left && $t->right ? 'd' : $t->left ? 'l' : 'r';
     $s .= "$in $h ".('  ' x $in);
     $s .= $t->name;
     $s .= '->'.$t->up->name if $t->up;
  push @$g, $s;

  __SUB__->($t->right, $in+1, $g);                                              # Right
 }

sub printKeys($)                                                                # Print the keys in a tree
 {my ($t) = @_;                                                                 # Tree
  confess unless $t;

  my @s;
  printKeys2 $t, 0, \@s;

  (join "\n", @s, "") =~ s(\s+\Z) (\n)sr
 } # printKeys

sub setKeysPerNode($$)                                                          # Set the number of keys for the current node
 {my ($tree, $N) = @_;                                                          # Tree, keys per node to be set
  confess unless $tree;
  confess unless $N and $N > 0;
  $tree->keysPerNode =  $N;                                                     # Set
  $tree->refill;                                                                # Refill if necessary
  $tree                                                                         # Allow chaining
 } # setKeysPerNode

sub printKeysAndData($)                                                         # Print the mapping from keys to data in a tree
 {my ($t) = @_;                                                                 # Tree
  confess unless $t;
  my @s;
  my sub print($$)
   {my ($t, $in) = @_;
    return unless $t;
    __SUB__->($t->left, $in+1);                                                 # Left
    push @s, [$t->keys->[$_], $t->data->[$_]] for keys $t->keys->@*;            # Find key in node
    __SUB__->($t->right,   $in+1);                                              # Right
   }
  print $t, 0;
  formatTableBasic(\@s)
 } # printKeysAndData

sub checkLRU($)                                                                 #P Confirm pointers in tree
 {my ($tree) = @_;                                                              # Tree
  my %seen;                                                                     # Nodes we have already seen

  sub                                                                           # Check pointers in a tree
   {my ($tree, $dir) = @_;                                                      # Tree
    return unless $tree;

    confess "Recursed $dir into: ".$tree->name if $seen{$tree->name}++;

    __SUB__->($tree->left,  Left);
    __SUB__->($tree->right, Right);
   }->($tree->root);
 }

sub check($)                                                                    #P Confirm that each node in a tree is ordered correctly
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  $tree->checkLRU;

  my $maxHeight = 0;

  sub
   {my ($tree) = @_;                                                            # Tree
    return unless $tree;

    __SUB__->($tree->left);
    __SUB__->($tree->right);

    confess $tree->name unless $tree->keys->@* == $tree->data->@*;              # Check key count matches data count

    if ( !$tree->leaf and !$tree->isRoot                                        # Confirm that all interior nodes  are fully filled
      and $tree->keys->@* != $tree->keysPerNode)
     {confess "Interior node not full: "
       .$tree->name."\n". $tree->root->printKeys;
     }

    confess $tree->name unless $tree->isRoot or                                 # Node is either a root  or a left or right child
      $tree->up && $tree->up->left  && $tree == $tree->up->left or
      $tree->up && $tree->up->right && $tree == $tree->up->right;

    confess 'Left:'.$tree->name if $tree->left and                              # Left child has correct parent
      !$tree->left->up || $tree->left->up != $tree;

    confess 'Right:'.$tree->name if $tree->right and                            # Right child has correct parent
      !$tree->right->up || $tree->right->up != $tree;

    if ($tree->simplex and !$tree->simplexWithLeaf and $tree->up                # Simplex children must always have duplex parents
      and !$tree->up->isRoot and !$tree->up->duplex)
     {confess "Simplex does not have duplex parent: ".$tree->name
       ."\n".$tree->root->printKeys;
     }

    $maxHeight = $tree->height if $tree->height > $maxHeight;

    my @k  = $tree->keys->@*;                                                   # Check keys
       @k <= $tree->keysPerNode or confess "Too many keys:".scalar(@k);
    for my $i(keys @k)
     {confess "undef key position $i" unless defined $k[$i];
     }

    my @d  = $tree->data->@*;                                                   # Check data
       @d <= $tree->keysPerNode or confess "Too many data:".scalar(@d);

    my %k;
    for my $i(1..$#k)
     {confess  "Out of order: ",   dump(\@k) if $k[$i-1] >= $k[$i];
      confess  "Duplicate key: ",  $k[$i] if $k{$k[$i]}++;
      confess  "Undefined data: ", $k[$i] unless defined $d[$i];
     }
   }->($tree);

  if ($tree->height < $maxHeight)                                               # Check tree heights
   {cluck "Tree height failure at: ", $tree->name;
    save($tree);
   }
 } # check

sub checkAgainstHash($%)                                                        #P Check a tree against a hash
 {my ($t, %t) = @_;                                                             # Tree, expected

  for my $k(keys %t)                                                            # Check we can find all the keys expected
   {my ($t) = @_;
    my $v = $t{$k};
    confess "Cannot find $k" unless my $f = find($t, $k);
    confess "Found $f but expected $v" unless $f == $v;
   }

  sub                                                                           # Check that the tree does not contain unexpected keys
   {my ($t) = @_;
    return unless $t;

    __SUB__->($t->left);                                                        # Left
    for($t->keys->@*)
     {confess $_ unless delete $t{$_};
     }
    __SUB__->($t->right);                                                       # Right
   }->($t);

  confess if keys %t;                                                           # They should have all been deleted
 } # checkAgainstHash
#d
#-------------------------------------------------------------------------------
# Export - eeee
#-------------------------------------------------------------------------------

use Exporter qw(import);

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

@ISA          = qw(Exporter);
@EXPORT       = qw();
@EXPORT_OK    = qw(
 );
%EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);

# podDocumentation
=pod

=encoding utf-8

=head1 Name

Tree::Bulk - Bulk Tree operations

=head1 Synopsis

Bulk trees store several (key,data) pairs in each node of a balanced tree to
reduce the number of tree pointers: up, left, right, etc. used to maintain the
tree.  This has no useful effect in Perl code, but in C code, especially C code
that uses SIMD instructions, the savings in space can be considerable which
allows the processor caches to be used more effectively. This module
demonstrates insert, find, delete operations on bulk trees as a basis for
coding these algorithms more efficiently in assembler code.

  is_deeply $t->printKeys, <
SA0 4 1 2 3 4
Lz2 1     5 6 7 8->9 10 11 12
Rd1 3   9 10 11 12->1 2 3 4
Lz3 1       13 14 15 16->17 18 19 20
Rd2 2     17 18 19 20->9 10 11 12
Rz3 1       21 22->17 18 19 20
END

  for my $n($t->inorder)
   {$n->setKeysPerNode(2);
   }

  is_deeply $t->printKeys, <
SA0 5 1 2
Lz3 1       3 4->5 6
Ld2 2     5 6->9 10
Rz3 1       7 8->5 6
Rd1 4   9 10->1 2
Lz4 1         11 12->13 14
Ld3 2       13 14->17 18
Rz4 1         15 16->13 14
Rd2 3     17 18->9 10
Rr3 2       19 20->17 18
Rz4 1         21 22->19 20
END

=head1 Description

Bulk Tree operations


Version "20210302".


The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L.



=head1 Bulk Tree

Bulk Tree

=head2 isRoot($tree)

Return the tree if it is the root

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);
    ok  $a->isLeftChild;
    ok  $c->isRightChild;
    ok !$a->isRightChild;
    ok !$c->isLeftChild;

    ok  $b->isRoot;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$a->isRoot;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$c->isRoot;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  $a->leaf;
    ok  $c->leaf;
    ok  $b->duplex;
    ok  $c->root == $b;
    ok  $c->root != $a;
   }


=head2 root($tree)

Return the root node of a tree

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);
    ok  $a->isLeftChild;
    ok  $c->isRightChild;
    ok !$a->isRightChild;
    ok !$c->isLeftChild;
    ok  $b->isRoot;
    ok !$a->isRoot;
    ok !$c->isRoot;
    ok  $a->leaf;
    ok  $c->leaf;
    ok  $b->duplex;

    ok  $c->root == $b;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  $c->root != $a;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

   }


=head2 leaf($tree)

Return the tree if it is a leaf

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);
    ok  $a->isLeftChild;
    ok  $c->isRightChild;
    ok !$a->isRightChild;
    ok !$c->isLeftChild;
    ok  $b->isRoot;
    ok !$a->isRoot;
    ok !$c->isRoot;

    ok  $a->leaf;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  $c->leaf;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  $b->duplex;
    ok  $c->root == $b;
    ok  $c->root != $a;
   }


=head2 duplex($tree)

Return the tree if it has left and right children

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);
    ok  $a->isLeftChild;
    ok  $c->isRightChild;
    ok !$a->isRightChild;
    ok !$c->isLeftChild;
    ok  $b->isRoot;
    ok !$a->isRoot;
    ok !$c->isRoot;
    ok  $a->leaf;
    ok  $c->leaf;

    ok  $b->duplex;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  $c->root == $b;
    ok  $c->root != $a;
   }


=head2 simplex($tree)

Return the tree if it has either a left child or a right child but not both.

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "SetHeights";
    my  $a = node(1,1)->setKeysPerNode(1);
    my  $b = node(2,2)->setKeysPerNode(1);
    my  $c = node(3,3)->setKeysPerNode(1);
    my  $d = node(4,4)->setKeysPerNode(1);
    my  $e = node(5,5);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->right = $d; $d->up = $c;
    $d->right = $e; $e->up = $d;

    is_deeply $a->printKeys, <
  SA0 1 1
  Rr1 1   2->1
  Rr2 1     3->2
  Rr3 1       4->3
  Rz4 1         5->4
  END
  #save $a;

    $e->setHeights(1);
    is_deeply $a->printKeys, <
  SA0 4 1
  Rr1 3   2->1
  Lz3 1       3->4
  Rd2 2     4->2
  Rz3 1       5->4
  END
  #save $a;

    ok  $b->simplex;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$c->simplex;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $c->balance;
    is_deeply $a->printKeys, <
  SA0 4 1
  Rr1 3   2->1
  Lz3 1       3->4
  Rd2 2     4->2
  Rz3 1       5->4
  END
  #save $a;

    $b->balance;
    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Rz2 1     5->4
  END
  #save $a;
   }


=head2 simplexWithLeaf($tree)

Return the tree if it has either a left child or a right child but not both and the child it has a leaf.

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Balance";
    my  $a = node(1,1)->setKeysPerNode(1); $a->height = 5;
    my  $b = node(2,2)->setKeysPerNode(1); $b->height = 4;
    my  $c = node(3,3)->setKeysPerNode(1); $c->height = 3;
    my  $d = node(4,4)->setKeysPerNode(1); $d->height = 2;
    my  $e = node(5,5);                    $e->height = 1;
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->right = $d; $d->up = $c;
    $d->right = $e; $e->up = $d;

    $e->balance;
    is_deeply $a->printKeys, <
  SA0 5 1
  Rr1 4   2->1
  Rr2 3     3->2
  Rr3 2       4->3
  Rz4 1         5->4
  END
  #save $a;

    ok  $d->simplexWithLeaf;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$c->simplexWithLeaf;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $d->balance;
    is_deeply $a->printKeys, <
  SA0 5 1
  Rr1 4   2->1
  Rr2 3     3->2
  Rr3 2       4->3
  Rz4 1         5->4
  END
  #save $a;

    $c->balance;
    is_deeply $a->printKeys, <
  SA0 5 1
  Rr1 3   2->1
  Lz3 1       3->4
  Rd2 2     4->2
  Rz3 1       5->4
  END
  #save $a;

    $b->balance;
    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Rz2 1     5->4
  END
  #save $a;
   }


=head2 empty($tree)

Return the tree if it is empty

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Balance";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);

    ok $t->empty;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok $t->singleton;
   }


=head2 singleton($tree)

Return the tree if it contains only the root node and nothing else

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Balance";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    ok $t->empty;

    ok $t->singleton;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

   }


=head2 isLeftChild($tree)

Return the tree if it is the left child

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);

    ok  $a->isLeftChild;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  $c->isRightChild;
    ok !$a->isRightChild;

    ok !$c->isLeftChild;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  $b->isRoot;
    ok !$a->isRoot;
    ok !$c->isRoot;
    ok  $a->leaf;
    ok  $c->leaf;
    ok  $b->duplex;
    ok  $c->root == $b;
    ok  $c->root != $a;
   }


=head2 isRightChild($tree)

Return the tree if it is the right child

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Attributes";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $b = $t->insert(2,4);
    my  $a = $t->insert(1,2);
    my  $c = $t->insert(3,6);
    ok  $a->isLeftChild;

    ok  $c->isRightChild;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$a->isRightChild;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok !$c->isLeftChild;
    ok  $b->isRoot;
    ok !$a->isRoot;
    ok !$c->isRoot;
    ok  $a->leaf;
    ok  $c->leaf;
    ok  $b->duplex;
    ok  $c->root == $b;
    ok  $c->root != $a;
   }


=head2 name($tree)

Name of a tree

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Split and Refill";
    my $N = 22;
    my $t = Tree::Bulk::new;
    for my $k(1..$N)
     {$t->insert($k, 2 * $k);
     }


    is_deeply $t->name, "1 2 3 4";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;

    for my $n($t->inorder)
     {$n->setKeysPerNode(2);
     }
    is_deeply $t->printKeys, <
  SA0 5 1 2
  Lz3 1       3 4->5 6
  Ld2 2     5 6->9 10
  Rz3 1       7 8->5 6
  Rd1 4   9 10->1 2
  Lz4 1         11 12->13 14
  Ld3 2       13 14->17 18
  Rz4 1         15 16->13 14
  Rd2 3     17 18->9 10
  Rr3 2       19 20->17 18
  Rz4 1         21 22->19 20
  END
  #save $t;

    for my $n($t->inorder)
     {$n->setKeysPerNode(1);
     }
    is_deeply $t->printKeys, <
  SA0 6 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 5   9->1
  Lz5 1           10->11
  Ld4 2         11->13
  Rz5 1           12->11
  Ld3 3       13->17
  Lz5 1           14->15
  Rd4 2         15->13
  Rz5 1           16->15
  Rd2 4     17->9
  Lz4 1         18->19
  Rd3 3       19->17
  Lz5 1           20->21
  Rd4 2         21->19
  Rz5 1           22->21
  END
  #save $t;

    $_->setKeysPerNode(2) for $t->inorder;
    is_deeply $t->printKeys, <
  SA0 5 1 2
  Lz3 1       3 4->5 6
  Ld2 2     5 6->9 10
  Rz3 1       7 8->5 6
  Rd1 4   9 10->1 2
  Lz4 1         11 12->13 14
  Ld3 2       13 14->17 18
  Rz4 1         15 16->13 14
  Rd2 3     17 18->9 10
  Lz4 1         19 20->21 22
  Rl3 2       21 22->17 18
  END
  #save $t;

    $_->setKeysPerNode(4) for $t->inorder;
    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;
   }


=head2 names($tree)

Names of all nodes in a tree in order

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {my sub randomLoad($$$)                                                        # Randomly load different size nodes
     {my ($N, $keys, $height) = @_;                                               # Number of elements, number of keys per node, expected height

      lll "Random load $keys";

      srand(1);                                                                   # Same randomization
      my $t = Tree::Bulk::new->setKeysPerNode($keys);
      for my $r(randomizeArray 1..$N)
       {$debug = $r == 74;
        $t->insert($r, 2 * $r);
        $t->check;
       }

      is_deeply $t->actualHeight, $height;                                        # Check height
      confess unless $t->actualHeight == $height;

      is_deeply join(' ', 1..$N), $t->names;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


      my %t = map {$_=>2*$_}   1..$N;
      for my $r(randomizeArray 1..$N)                                             # Delete in random order
       {$t->delete   ($r);
            delete $t{$r};
        checkAgainstHash $t, %t;
        check($t);
       }

      ok $t->empty;
      is_deeply $t->actualHeight, 1;
     }

    randomLoad(222, 1, 11);
    randomLoad(222, 8, 8);
    randomLoad(222, 4, 9);
   }


=head2 balance($t)

Balance a node

     Parameter  Description
  1  $t         Tree

B


  if (1)
   {lll "Balance";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);

    my  $a = node(1,2) ->setKeysPerNode(1);
    my  $b = node(2,4) ->setKeysPerNode(1);
    my  $c = node(6,12)->setKeysPerNode(1);
    my  $d = node(5,10)->setKeysPerNode(1);
    my  $e = node(4,8) ->setKeysPerNode(1);
    my  $f = node(3,6) ->setKeysPerNode(1);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->left  = $d; $d->up = $c;
    $d->left  = $e; $e->up = $d;
    $e->left  = $f; $f->up = $e;
    $f->setHeights(1);
    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Lz3 1       5->6
  Rl2 2     6->4
  END
  #save $a;


    $b->balance;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Lz3 1       5->6
  Rl2 2     6->4
  END
  #save $a;
   }


=head2 insert($tree, $key, $data)

Insert a key and some data into a tree

     Parameter  Description
  1  $tree      Tree
  2  $key       Key
  3  $data      Data

B


  if (1)
   {lll "Insert";
    my $N = 23;
    my $t = Tree::Bulk::new->setKeysPerNode(1);
    for(1..$N)

     {$t->insert($_, 2 * $_);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     }

    is_deeply $t->printKeys, <
  SA0 8 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 7   9->1
  Lz4 1         10->11
  Ld3 2       11->13
  Rz4 1         12->11
  Rd2 6     13->9
  Lz5 1           14->15
  Ld4 2         15->17
  Rz5 1           16->15
  Rd3 5       17->13
  Lz5 1           18->19
  Rd4 4         19->17
  Lz6 1             20->21
  Rd5 3           21->19
  Rr6 2             22->21
  Rz7 1               23->22
  END
  #save $t;
    ok $t->height == 8;
   }


=head2 find($tree, $key)

Find a key in a tree and returns its data

     Parameter  Description
  1  $tree      Tree
  2  $key       Key

B


  if (1)
   {my $t = Tree::Bulk::new;
       $t->insert($_, $_*$_)    for  1..20;

    ok !find($t,  0);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !find($t, 21);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  find($t, $_) == $_ * $_ for qw(1 5 10 11 15 20);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

   }


=head2 first($n)

First node in a tree

     Parameter  Description
  1  $n         Tree

B


  if (1)
   {my $N = 220;
    my $t = Tree::Bulk::new;

    for(reverse 1..$N)
     {$t->insert($_, 2*$_);
     }

    is_deeply $t->actualHeight, 10;

    if (1)
     {my @n;

      for (my $n = $t->first; $n; $n = $n->next)  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

       {push @n, $n->keys->@*
       }
      is_deeply \@n, [1..$N];
     }

    if (1)
     {my @p;
      for my $p(reverse $t->inorder)
       {push @p, reverse $p->keys->@*;
       }
      is_deeply \@p, [reverse 1..$N];
     }

    my @p;
    for(my $p = $t->last; $p; $p = $p->prev)
     {push @p, reverse $p->keys->@*
     }
    is_deeply \@p, [reverse 1..$N];

    my %t = map {$_=>2*$_} 1..$N;
    for   my $i(0..3)
     {for my $j(map {4 * $_-$i} 1..$N/4)
       {$t->delete   ($j);
            delete $t{$j};
        checkAgainstHash $t, %t;
       }
     }

    ok $t->empty;
    is_deeply $t->actualHeight, 1;
   }


=head2 last($n)

Last node in a tree

     Parameter  Description
  1  $n         Tree

B


  if (1)
   {my $N = 220;
    my $t = Tree::Bulk::new;

    for(reverse 1..$N)
     {$t->insert($_, 2*$_);
     }

    is_deeply $t->actualHeight, 10;

    if (1)
     {my @n;
      for (my $n = $t->first; $n; $n = $n->next)
       {push @n, $n->keys->@*
       }
      is_deeply \@n, [1..$N];
     }

    if (1)
     {my @p;
      for my $p(reverse $t->inorder)
       {push @p, reverse $p->keys->@*;
       }
      is_deeply \@p, [reverse 1..$N];
     }

    my @p;

    for(my $p = $t->last; $p; $p = $p->prev)  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     {push @p, reverse $p->keys->@*
     }
    is_deeply \@p, [reverse 1..$N];

    my %t = map {$_=>2*$_} 1..$N;
    for   my $i(0..3)
     {for my $j(map {4 * $_-$i} 1..$N/4)
       {$t->delete   ($j);
            delete $t{$j};
        checkAgainstHash $t, %t;
       }
     }

    ok $t->empty;
    is_deeply $t->actualHeight, 1;
   }


=head2 next($tree)

Next node in order

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {my $N = 220;
    my $t = Tree::Bulk::new;

    for(reverse 1..$N)
     {$t->insert($_, 2*$_);
     }

    is_deeply $t->actualHeight, 10;

    if (1)
     {my @n;

      for (my $n = $t->first; $n; $n = $n->next)  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

       {push @n, $n->keys->@*
       }
      is_deeply \@n, [1..$N];
     }

    if (1)
     {my @p;
      for my $p(reverse $t->inorder)
       {push @p, reverse $p->keys->@*;
       }
      is_deeply \@p, [reverse 1..$N];
     }

    my @p;
    for(my $p = $t->last; $p; $p = $p->prev)
     {push @p, reverse $p->keys->@*
     }
    is_deeply \@p, [reverse 1..$N];

    my %t = map {$_=>2*$_} 1..$N;
    for   my $i(0..3)
     {for my $j(map {4 * $_-$i} 1..$N/4)
       {$t->delete   ($j);
            delete $t{$j};
        checkAgainstHash $t, %t;
       }
     }

    ok $t->empty;
    is_deeply $t->actualHeight, 1;
   }


=head2 prev($tree)

Previous node in order

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {my $N = 220;
    my $t = Tree::Bulk::new;

    for(reverse 1..$N)
     {$t->insert($_, 2*$_);
     }

    is_deeply $t->actualHeight, 10;

    if (1)
     {my @n;
      for (my $n = $t->first; $n; $n = $n->next)
       {push @n, $n->keys->@*
       }
      is_deeply \@n, [1..$N];
     }

    if (1)
     {my @p;
      for my $p(reverse $t->inorder)
       {push @p, reverse $p->keys->@*;
       }
      is_deeply \@p, [reverse 1..$N];
     }

    my @p;

    for(my $p = $t->last; $p; $p = $p->prev)  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     {push @p, reverse $p->keys->@*
     }
    is_deeply \@p, [reverse 1..$N];

    my %t = map {$_=>2*$_} 1..$N;
    for   my $i(0..3)
     {for my $j(map {4 * $_-$i} 1..$N/4)
       {$t->delete   ($j);
            delete $t{$j};
        checkAgainstHash $t, %t;
       }
     }

    ok $t->empty;
    is_deeply $t->actualHeight, 1;
   }


=head2 inorder($tree)

Return a list of all the nodes in a tree in order

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {my $N = 220;
    my $t = Tree::Bulk::new;

    for(reverse 1..$N)
     {$t->insert($_, 2*$_);
     }

    is_deeply $t->actualHeight, 10;

    if (1)
     {my @n;
      for (my $n = $t->first; $n; $n = $n->next)
       {push @n, $n->keys->@*
       }
      is_deeply \@n, [1..$N];
     }

    if (1)
     {my @p;

      for my $p(reverse $t->inorder)  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

       {push @p, reverse $p->keys->@*;
       }
      is_deeply \@p, [reverse 1..$N];
     }

    my @p;
    for(my $p = $t->last; $p; $p = $p->prev)
     {push @p, reverse $p->keys->@*
     }
    is_deeply \@p, [reverse 1..$N];

    my %t = map {$_=>2*$_} 1..$N;
    for   my $i(0..3)
     {for my $j(map {4 * $_-$i} 1..$N/4)
       {$t->delete   ($j);
            delete $t{$j};
        checkAgainstHash $t, %t;
       }
     }

    ok $t->empty;
    is_deeply $t->actualHeight, 1;
   }


=head2 delete($tree, $key)

Delete a key in a tree

     Parameter  Description
  1  $tree      Tree
  2  $key       Key

B


  if (1)
   {lll "Delete";
    my $N = 28;
    my $t = Tree::Bulk::new->setKeysPerNode(1);
    for(1..$N)
     {$t->insert($_, 2 * $_);
     }

    is_deeply $t->printKeys, <
  SA0 8 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 7   9->1
  Lz5 1           10->11
  Ld4 2         11->13
  Rz5 1           12->11
  Ld3 3       13->17
  Lz5 1           14->15
  Rd4 2         15->13
  Rz5 1           16->15
  Rd2 6     17->9
  Lz5 1           18->19
  Ld4 2         19->21
  Rz5 1           20->19
  Rd3 5       21->17
  Lz5 1           22->23
  Rd4 4         23->21
  Lz6 1             24->25
  Rd5 3           25->23
  Lz7 1               26->27
  Rd6 2             27->25
  Rz7 1               28->27
  END
  #save $t;

    for my $k(reverse 1..$N)

     {$t->delete($k);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

      is_deeply $t->printKeys, <
  SA0 5 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 4   9->1
  Lz4 1         10->11
  Ld3 2       11->13
  Rz4 1         12->11
  Rd2 3     13->9
  Lz4 1         14->15
  Rd3 2       15->13
  Rz4 1         16->15
  END
  #save $t if $k == 17;

      is_deeply $t->printKeys, <
  SA0 4 1
  Lz3 1       2->3
  Ld2 2     3->5
  Rz3 1       4->3
  Rd1 3   5->1
  Lz3 1       6->7
  Rd2 2     7->5
  Rz3 1       8->7
  END
  #save $t if $k == 9;

      is_deeply $t->printKeys, <
  SA0 4 1
  Lz2 1     2->3
  Rd1 3   3->1
  Lz3 1       4->5
  Rl2 2     5->3
  END
  #save $t if $k == 6;

      is_deeply $t->printKeys, <
  SA0 3 1
  Rr1 2   2->1
  Rz2 1     3->2
  END
  #save $t if $k == 4;

      is_deeply $t->printKeys, <
  SA0 2 1
  Rz1 1   2->1
  END
  #save $t if $k == 3;

      is_deeply $t->printKeys, <
  Sz0 1
  END
  #save $t if $k == 1;
     }
   }


=head2 printKeys($t)

Print the keys in a tree

     Parameter  Description
  1  $t         Tree

B


  if (1)
   {lll "Insert";
    my $N = 23;
    my $t = Tree::Bulk::new->setKeysPerNode(1);
    for(1..$N)
     {$t->insert($_, 2 * $_);
     }


    is_deeply $t->printKeys, <

  SA0 8 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 7   9->1
  Lz4 1         10->11
  Ld3 2       11->13
  Rz4 1         12->11
  Rd2 6     13->9
  Lz5 1           14->15
  Ld4 2         15->17
  Rz5 1           16->15
  Rd3 5       17->13
  Lz5 1           18->19
  Rd4 4         19->17
  Lz6 1             20->21
  Rd5 3           21->19
  Rr6 2             22->21
  Rz7 1               23->22
  END
  #save $t;
    ok $t->height == 8;
   }


=head2 setKeysPerNode($tree, $N)

Set the number of keys for the current node

     Parameter  Description
  1  $tree      Tree
  2  $N         Keys per node to be set

B


  if (1)
   {lll "Split and Refill";
    my $N = 22;
    my $t = Tree::Bulk::new;
    for my $k(1..$N)
     {$t->insert($k, 2 * $k);
     }

    is_deeply $t->name, "1 2 3 4";

    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;

    for my $n($t->inorder)

     {$n->setKeysPerNode(2);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     }
    is_deeply $t->printKeys, <
  SA0 5 1 2
  Lz3 1       3 4->5 6
  Ld2 2     5 6->9 10
  Rz3 1       7 8->5 6
  Rd1 4   9 10->1 2
  Lz4 1         11 12->13 14
  Ld3 2       13 14->17 18
  Rz4 1         15 16->13 14
  Rd2 3     17 18->9 10
  Rr3 2       19 20->17 18
  Rz4 1         21 22->19 20
  END
  #save $t;

    for my $n($t->inorder)

     {$n->setKeysPerNode(1);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     }
    is_deeply $t->printKeys, <
  SA0 6 1
  Lz4 1         2->3
  Ld3 2       3->5
  Rz4 1         4->3
  Ld2 3     5->9
  Lz4 1         6->7
  Rd3 2       7->5
  Rz4 1         8->7
  Rd1 5   9->1
  Lz5 1           10->11
  Ld4 2         11->13
  Rz5 1           12->11
  Ld3 3       13->17
  Lz5 1           14->15
  Rd4 2         15->13
  Rz5 1           16->15
  Rd2 4     17->9
  Lz4 1         18->19
  Rd3 3       19->17
  Lz5 1           20->21
  Rd4 2         21->19
  Rz5 1           22->21
  END
  #save $t;


    $_->setKeysPerNode(2) for $t->inorder;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $t->printKeys, <
  SA0 5 1 2
  Lz3 1       3 4->5 6
  Ld2 2     5 6->9 10
  Rz3 1       7 8->5 6
  Rd1 4   9 10->1 2
  Lz4 1         11 12->13 14
  Ld3 2       13 14->17 18
  Rz4 1         15 16->13 14
  Rd2 3     17 18->9 10
  Lz4 1         19 20->21 22
  Rl3 2       21 22->17 18
  END
  #save $t;


    $_->setKeysPerNode(4) for $t->inorder;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;
   }


=head2 printKeysAndData($t)

Print the mapping from keys to data in a tree

     Parameter  Description
  1  $t         Tree

B


  if (1)
   {my $N = 22;
    my $t = Tree::Bulk::new;
    ok $t->empty;
    ok $t->leaf;

    for(1..$N)
     {$t->insert($_, 2 * $_);
     }

    ok $t->right->duplex;
    is_deeply actualHeight($t), 4;

    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;


    is_deeply $t->printKeysAndData, <

   1   2
   2   4
   3   6
   4   8
   5  10
   6  12
   7  14
   8  16
   9  18
  10  20
  11  22
  12  24
  13  26
  14  28
  15  30
  16  32
  17  34
  18  36
  19  38
  20  40
  21  42
  22  44
  END

    my %t = map {$_=>2*$_} 1..$N;

    for(map {2 * $_} 1..$N/2)
     {$t->delete($_);
      delete $t{$_};
      checkAgainstHash $t, %t;
     }

    is_deeply $t->printKeys, <
  SA0 3 1 3 5 7
  Rr1 2   9 11 13 15->1 3 5 7
  Rz2 1     17 19 21->9 11 13 15
  END
  #save($t);


    is_deeply $t->printKeysAndData, <

   1   2
   3   6
   5  10
   7  14
   9  18
  11  22
  13  26
  15  30
  17  34
  19  38
  21  42
  END

    for(map {2 * $_-1} 1..$N/2)
     {$t->delete($_);
      delete $t{$_};
      checkAgainstHash $t, %t;
     }

    is_deeply $t->printKeys, <
  Sz0 1
  END
  #save($t);
   }



=head2 Tree::Bulk Definition


Bulk tree node




=head3 Output fields


=head4 data

Data corresponding to each key

=head4 height

Height of node

=head4 keys

Array of data items for this node

=head4 keysPerNode

Maximum number of keys per node

=head4 left

Left node

=head4 right

Right node

=head4 up

Parent node



=head1 Attributes


The following is a list of all the attributes in this package.  A method coded
with the same name in your package will over ride the method of the same name
in this package and thus provide your value for the attribute in place of the
default value supplied for this attribute by this package.

=head2 Replaceable Attribute List


new


=head2 new

Create a new tree




=head1 Private Methods

=head2 node($key, $data, $up, $side)

Create a new bulk tree node

     Parameter  Description
  1  $key       Key
  2  $data      $data
  3  $up        Parent node
  4  $side      Side of parent node

=head2 setHeights($tree)

Set heights along path to root

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {lll "Balance";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);

    my  $a = node(1,2) ->setKeysPerNode(1);
    my  $b = node(2,4) ->setKeysPerNode(1);
    my  $c = node(6,12)->setKeysPerNode(1);
    my  $d = node(5,10)->setKeysPerNode(1);
    my  $e = node(4,8) ->setKeysPerNode(1);
    my  $f = node(3,6) ->setKeysPerNode(1);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->left  = $d; $d->up = $c;
    $d->left  = $e; $e->up = $d;
    $e->left  = $f; $f->up = $e;

    $f->setHeights(1);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Lz3 1       5->6
  Rl2 2     6->4
  END
  #save $a;

    $b->balance;
    is_deeply $a->printKeys, <
  SA0 4 1
  Lr2 2     2->4
  Rz3 1       3->2
  Rd1 3   4->1
  Lz3 1       5->6
  Rl2 2     6->4
  END
  #save $a;
   }


=head2 actualHeight($tree)

Get the height of a node

     Parameter  Description
  1  $tree      Tree

B


  if (1)
   {my $N = 22;
    my $t = Tree::Bulk::new;
    ok $t->empty;
    ok $t->leaf;

    for(1..$N)
     {$t->insert($_, 2 * $_);
     }

    ok $t->right->duplex;

    is_deeply actualHeight($t), 4;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $t->printKeys, <
  SA0 4 1 2 3 4
  Lz2 1     5 6 7 8->9 10 11 12
  Rd1 3   9 10 11 12->1 2 3 4
  Lz3 1       13 14 15 16->17 18 19 20
  Rd2 2     17 18 19 20->9 10 11 12
  Rz3 1       21 22->17 18 19 20
  END
  #save $t;

    is_deeply $t->printKeysAndData, <
   1   2
   2   4
   3   6
   4   8
   5  10
   6  12
   7  14
   8  16
   9  18
  10  20
  11  22
  12  24
  13  26
  14  28
  15  30
  16  32
  17  34
  18  36
  19  38
  20  40
  21  42
  22  44
  END

    my %t = map {$_=>2*$_} 1..$N;

    for(map {2 * $_} 1..$N/2)
     {$t->delete($_);
      delete $t{$_};
      checkAgainstHash $t, %t;
     }

    is_deeply $t->printKeys, <
  SA0 3 1 3 5 7
  Rr1 2   9 11 13 15->1 3 5 7
  Rz2 1     17 19 21->9 11 13 15
  END
  #save($t);

    is_deeply $t->printKeysAndData, <
   1   2
   3   6
   5  10
   7  14
   9  18
  11  22
  13  26
  15  30
  17  34
  19  38
  21  42
  END

    for(map {2 * $_-1} 1..$N/2)
     {$t->delete($_);
      delete $t{$_};
      checkAgainstHash $t, %t;
     }

    is_deeply $t->printKeys, <
  Sz0 1
  END
  #save($t);
   }


=head2 maximum($a, $b)

Maximum of two numbers

     Parameter  Description
  1  $a         First
  2  $b         Second

B


  if (1)

   {is_deeply maximum(1,2), 2;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply maximum(2,1), 2;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

   }


=head2 setHeight($tree)

Set height of a tree from its left and right trees

     Parameter  Description
  1  $tree      Tree

=head2 rotateLeft($n)

Rotate a node left

     Parameter  Description
  1  $n         Node

B


  if (1)
   {lll "Rotate";
    my  $a = node(1,2)->setKeysPerNode(1);
    my  $b = node(2,4)->setKeysPerNode(1);
    my  $c = node(3,6)->setKeysPerNode(1);
    my  $d = node(4,8)->setKeysPerNode(1);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->right = $d; $d->up = $c;
    $d->setHeights(1);

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;

    $b->rotateLeft;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;


    $c->rotateLeft; $c->setHeights(2);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;

    $d->rotateRight; $d->setHeights(1);
    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;

    $c->rotateRight; $c->setHeights(2);
    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;
   }


=head2 rotateRight($n)

Rotate a node right

     Parameter  Description
  1  $n         Node

B


  if (1)
   {lll "Rotate";
    my  $a = node(1,2)->setKeysPerNode(1);
    my  $b = node(2,4)->setKeysPerNode(1);
    my  $c = node(3,6)->setKeysPerNode(1);
    my  $d = node(4,8)->setKeysPerNode(1);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->right = $d; $d->up = $c;
    $d->setHeights(1);

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;
    $b->rotateLeft;
    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;

    $c->rotateLeft; $c->setHeights(2);
    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;


    $d->rotateRight; $d->setHeights(1);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;


    $c->rotateRight; $c->setHeights(2);  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $a->printKeys, <
  SA0 3 1
  Lz2 1     2->3
  Rd1 2   3->1
  Rz2 1     4->3
  END
  #save $a;
   }


=head2 insertUnchecked($tree, $key, $data)

Insert a key and some data into a tree

     Parameter  Description
  1  $tree      Tree
  2  $key       Key
  3  $data      Data

=head2 unchain($t)

Remove a tree from the middle of a chain. A leaf is considered to be in the middle of a chain and so can be removed with this method

     Parameter  Description
  1  $t         Tree

=head2 refillFromRight($target)

Push a key to the target node from the next node

     Parameter  Description
  1  $target    Target tree

=head2 refillFromLeft($target)

Push a key to the target node from the previous node

     Parameter  Description
  1  $target    Target tree

=head2 refill($tree)

Refill a node so it has the expected number of keys

     Parameter  Description
  1  $tree      Tree

=head2 printKeys2($t, $in, $g)

print the keys for a tree

     Parameter  Description
  1  $t         Tree
  2  $in        Indentation
  3  $g         List of keys

=head2 checkLRU($tree)

Confirm pointers in tree

     Parameter  Description
  1  $tree      Tree

=head2 check($tree)

Confirm that each node in a tree is ordered correctly

     Parameter  Description
  1  $tree      Tree

=head2 checkAgainstHash($t, %t)

Check a tree against a hash

     Parameter  Description
  1  $t         Tree
  2  %t         Expected


=head1 Index


1 L - Get the height of a node

2 L - Balance a node

3 L - Confirm that each node in a tree is ordered correctly

4 L - Check a tree against a hash

5 L - Confirm pointers in tree

6 L - Delete a key in a tree

7 L - Return the tree if it has left and right children

8 L - Return the tree if it is empty

9 L - Find a key in a tree and returns its data

10 L - First node in a tree

11 L - Return a list of all the nodes in a tree in order

12 L - Insert a key and some data into a tree

13 L - Insert a key and some data into a tree

14 L - Return the tree if it is the left child

15 L - Return the tree if it is the right child

16 L - Return the tree if it is the root

17 L - Last node in a tree

18 L - Return the tree if it is a leaf

19 L - Maximum of two numbers

20 L - Name of a tree

21 L - Names of all nodes in a tree in order

22 L - Next node in order

23 L - Create a new bulk tree node

24 L - Previous node in order

25 L - Print the keys in a tree

26 L - print the keys for a tree

27 L - Print the mapping from keys to data in a tree

28 L - Refill a node so it has the expected number of keys

29 L - Push a key to the target node from the previous node

30 L - Push a key to the target node from the next node

31 L - Return the root node of a tree

32 L - Rotate a node left

33 L - Rotate a node right

34 L - Set height of a tree from its left and right trees

35 L - Set heights along path to root

36 L - Set the number of keys for the current node

37 L - Return the tree if it has either a left child or a right child but not both.

38 L - Return the tree if it has either a left child or a right child but not both and the child it has a leaf.

39 L - Return the tree if it contains only the root node and nothing else

40 L - Remove a tree from the middle of a chain.

=head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B:

  sudo cpan install Tree::Bulk

=head1 Author

L

L

=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__