File Coverage

blib/lib/Tree/Bulk.pm

Criterion	Covered	Total	%
statement	277	319	86.8
branch	170	262	64.8
condition	39	82	47.5
subroutine	50	56	89.2
pod	33	38	86.8
total	569	757	75.1

#!/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 = "20210226";
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);
      $up->balance;
     }
    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 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
  join ' ', $tree->keys->@*
 }

sub setHeights($$)                                                              # Set heights along path to root
 {my ($tree, $from) = @_;                                                       # Tree, height for this node
  confess unless $tree;
  confess unless $from;
  for(my $n = $tree; $n; $n = $n->up)
   {my $h = $n->height;
    if ($n->isLeftChild)
     {my $r = $n->right ? $n->right->height + 1 : 1;
      my $l = $from;
      my $h = max($l, $r);
      $n->height = $h;
     }
    else
     {my $l = $n->left ? $n->left->height + 1 : 1;
      my $r = $from;
      my $h = max($l, $r);
      my $c = max($l, $r);
      $n->height = $h;
     }
    ++$from
   }
 } # setHeights

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

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

=pod
  Rotate left
    p                  p
      n                  r
    l   r              n   R
       L R           l  L
=cut

sub updateHeights($)                                                            #P Update height of rotated node
 {my ($n) = @_;                                                                 # Tree
  if (my $l = $n->left)
   {$l->setHeights($l->height);
   }
  elsif (my $r = $n->right)
   {$r->setHeights($r->height);
   }
  else
   {$n->setHeights(1);
   }
 }

sub rotateLeft($)                                                               #P Rotate a node left
 {my ($n) = @_;                                                                 # Node
  confess unless $n;
  my $p     = $n->up;
  confess unless $p;
  my $r     = $n->right;
  confess 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;
  updateHeights $n;
 }

sub rotateRight($)                                                              #P Rotate a node right
 {my ($n) = @_;                                                                 # Node
  confess unless $n;
  my $p     = $n->up;
  confess unless $p;
  my $l     = $n->left;
  confess 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;
  updateHeights $n;
 }

=pod
Balance - make the deepest sub tree one less deep
    1                1
      2                     5
        6            2         6
      5                4
    4                    3
  3
=cut

sub balance($)                                                                  # Balance a node
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  for(my $n = $tree; $n->up; $n = $n->up)                                       # Balance our way up the tree
   {my ($l, $r) = (actualHeight($n->left), actualHeight($n->right));

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

  $tree
 } # 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 refill($)                                                                   #P Refill a node so it has the expected number of keys
 {my ($tree) = @_;                                                              # Tree
  confess unless $tree;
  my $refillFromRight; my $refillFromLeft; my $unchain;                         # Forward declare recursive methods

  my sub refill($)                                                              # Refill a non leaf node from a node further down the tree
   {my ($target) = @_;                                                          # Target tree
    confess unless $target;
    if (empty $target)
     {&$unchain($target)
     }
    elsif ($target->left)
     {&$refillFromLeft($target)
     }
    elsif ($target->right)
     {&$refillFromRight($target);
     }
   } # refill

  $refillFromRight = sub                                                        # 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
    my $source = $target->next;
    confess "No source"     unless $source;
    while ($source->keys->@* > 0 and $target->keys->@* < $tree->keysPerNode and !$tree->singleton)
     {push $target->keys->@*, shift  $source->keys->@*;
      push $target->data->@*, shift  $source->data->@*;
     }
    refill $source;
   }; # refillFromRight

  $refillFromLeft = sub                                                         # 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
    my $source = $target->prev;
    confess "No source"     unless $source;
    while ($source->keys->@* and $target->keys->@* < $tree->keysPerNode and !$tree->singleton)
     {unshift $target->keys->@*, pop $source->keys->@*;
      unshift $target->data->@*, pop $source->data->@*;
     }
    refill $source;
   }; # refillFromLeft

  $unchain = sub                                                                # 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 $r = $t->left // $t->right;                                              # Not duplex so at most one of these
    $p->{$t->isLeftChild ? Left : Right} = $r;                                  # Unchain
    $r->up = $p if $r;                                                          # Disconnect node
    $t->up = undef;
    $p->setHeights($r ? $r->height+1 : $p->leaf ? 1 : 2);                        # Make removed node into separate tree and reset heights of nodes above
    $p->balance;                                                                # Rebalance parent
    $t                                                                          # Unchained node
   }; # unchain

  while(!$tree->singleton and $tree->keys->@* < $tree->keysPerNode)             # Refill the node from neighboring leaf nodes
   {if (empty($tree) and !isRoot $tree)                                         # Removal created an empty leaf that is not the root
     {&$unchain($tree);                                                         # Unchain leaf
      last;
     }

    if    (leaf  $tree) {last}                                                  # No action required on leaf that is not empty
    elsif (right $tree) {&$refillFromRight($tree)}                              # Refill the root from the right as it is not a leaf
    else                {&$refillFromLeft ($tree)}                              # Refill the root from the left as it is not a leaf and has no tree to the right
   }

  while($tree->keys->@* > $tree->keysPerNode)                                   # Empty node if over full
   {my $d = pop $tree->data->@*;                                                # Data component
    my $k = pop $tree->keys->@*;                                                # Key component
    $tree->insertUnchecked($k, $d);                                             # 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
    confess "No tree" 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;
     }
   }->($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;
  $tree->refill;
  $tree
 } # 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 checkLR($)                                                                  #P Confirm pointers in tree
 {my ($tree) = @_;                                                              # Tree
  my %seen;                                                                     # Nodes we have already seen

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

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

    __SUB__->($tree->left,  'left', $tree->name);
    __SUB__->($tree->right, 'right', $tree->name);
   }->($tree->root);
 }

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

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

    __SUB__->($tree->left,  'left', $tree->name);
    __SUB__->($tree->right, 'right', $tree->name);

    confess $tree->name unless $tree->keys->@* == $tree->data->@*;              # Check key count matches data count
#    if (!$tree->leaf)
#     {confess $tree->name unless $tree->keys->@* == $tree->keysPerNode;        # Check node is filled unless it is a leaf
#     }

    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->up and !$tree->up->isRoot and !$tree->up->duplex)
#      {say STDERR "AAAA\n", $tree->up->up->printKeys;
#       confess if $tree->simplex and $tree->up and !$tree->up->duplex;         # Simplex children must always have duplex parents
#      }

#    if (!$tree->isRoot)                                                        # Check depth
#     {my ($l, $r) = (actualHeight($tree->left), actualHeight($tree->right));
#      if    ($l > 2 * $r + 1)
#       {cluck "Unbalanced left l=$l r=$r ".$tree->name;
#       }
#      elsif ($r > 2 * $l + 1)
#       {cluck "Unbalanced right l=$l r=$r ".$tree->name;
#       }
#     }

    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)
 } # 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) = @_;
    confess unless find($t, $k) == $t{$k};
   }

  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 "20210226".


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 "Rotate";
    my  $t = Tree::Bulk::new->setKeysPerNode(1);
    my  $a = node(1,2);
    my  $b = node(2,4);
    my  $c = node(3,6);
    my  $d = node(4,8);
    $a->right = $b; $b->up = $a;
    $b->right = $c; $c->up = $b;
    $c->right = $d; $d->up = $c;
    $d->setHeights(1);


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


    is_deeply $a->printKeys, <
  SA0 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 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 4 1
  Lz3 1       2->3
  Ll2 2     3->4
  Rl1 3   4->1
  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 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 1       4->3
  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;

    my  $a = node(1,2);
    my  $b = node(2,4);
    my  $c = node(6,12);
    my  $d = node(5,10);
    my  $e = node(4,8);
    my  $f = node(3,6);
    $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 6 1
  Rr1 5   2->1
  Lz5 1           3->4
  Ll4 2         4->5
  Ll3 3       5->6
  Rl2 4     6->2
  END
  #save $a;

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


=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;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    my  $a = node(1,2);
    my  $b = node(2,4);
    my  $c = node(6,12);
    my  $d = node(5,10);
    my  $e = node(4,8);
    my  $f = node(3,6);
    $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 6 1
  Rr1 5   2->1
  Lz5 1           3->4
  Ll4 2         4->5
  Ll3 3       5->6
  Rl2 4     6->2
  END
  #save $a;

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


=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 setHeights($tree, $from)

Set heights along path to root

     Parameter  Description
  1  $tree      Tree
  2  $from      Height for this node

B


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

    ok $t->empty;
    ok $t->singleton;

    my  $a = node(1,2);
    my  $b = node(2,4);
    my  $c = node(6,12);
    my  $d = node(5,10);
    my  $e = node(4,8);
    my  $f = node(3,6);
    $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 6 1
  Rr1 5   2->1
  Lz5 1           3->4
  Ll4 2         4->5
  Ll3 3       5->6
  Rl2 4     6->2
  END
  #save $a;

    $b->balance;
    is_deeply $a->printKeys, <
  SA0 5 1
  Lr2 3     2->5
  Lz4 1         3->4
  Rl3 2       4->2
  Rd1 4   5->1
  Rz2 1     6->5
  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
  Lz2 1     9 11 13->15 17 19 21
  Rl1 2   15 17 19 21->1 3 5 7
  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 balance($tree)

Balance a node

     Parameter  Description
  1  $tree      Tree

B


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

    ok $t->empty;
    ok $t->singleton;

    my  $a = node(1,2);
    my  $b = node(2,4);
    my  $c = node(6,12);
    my  $d = node(5,10);
    my  $e = node(4,8);
    my  $f = node(3,6);
    $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 6 1
  Rr1 5   2->1
  Lz5 1           3->4
  Ll4 2         4->5
  Ll3 3       5->6
  Rl2 4     6->2
  END
  #save $a;


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

    is_deeply $a->printKeys, <
  SA0 5 1
  Lr2 3     2->5
  Lz4 1         3->4
  Rl3 2       4->2
  Rd1 4   5->1
  Rz2 1     6->5
  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, 7;

    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, 7;

    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, 7;

    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, 7;

    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, 7;

    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
  Lz2 1     2->3
  Rl1 2   3->1
  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
  Lz2 1     9 11 13->15 17 19 21
  Rl1 2   15 17 19 21->1 3 5 7
  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 updateHeights($n)

Update height of rotated node

     Parameter  Description
  1  $n         Tree

=head2 rotateLeft($n)

Rotate a node left

     Parameter  Description
  1  $n         Node

B


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

    ok $c->simplex;

    is_deeply $a->printKeys, <
  SA0 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 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 4 1
  Lz3 1       2->3
  Ll2 2     3->4
  Rl1 3   4->1
  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 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 1       4->3
  END
  #save $a;
   }


=head2 rotateRight($n)

Rotate a node right

     Parameter  Description
  1  $n         Node

B


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

    ok $c->simplex;

    is_deeply $a->printKeys, <
  SA0 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 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 4 1
  Lz3 1       2->3
  Ll2 2     3->4
  Rl1 3   4->1
  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 4 1
  Rr1 3   2->1
  Rr2 2     3->2
  Rz3 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 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 checkLR($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 - Next node in order

22 L - Create a new bulk tree node

23 L - Previous node in order

24 L - Print the keys in a tree

25 L - print the keys for a tree

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

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

28 L - Return the root node of a tree

29 L - Rotate a node left

30 L - Rotate a node right

31 L - Set heights along path to root

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

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

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

35 L - Update height of rotated node

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