view release on metacpan or  search on metacpan

lib/Zero/NWayTree.pm  view on Meta::CPAN

     {$o[$r][$c] = ' ' x $W;
     }
   }

  for   my $p(keys @$o)                                                         # Write tree horizontally
   {next unless defined(my $v = $$o[$p][1]);
    my $r = $$o[$p][0];
    my $c = $p;

    $o[$r][$c] = sprintf("%${W}d", $v);
   }

  join "\n", (map { (join "", $o[$_]->@*) =~ s(\s+\Z) ()r;} keys @o), '';       # As a single string after removing trailing spaces on each line
 }

sub printTreeKeys($)                                                            # Print the keys held in a tree.
 {my ($e) = @_;                                                                 # Memory
  printTree($e->memory->[1], 1);
 }

sub printTreeData($)                                                            # Print the data held in a tree.
 {my ($e) = @_;                                                                 # Memory
  printTree($e->memory->[1], 0);
 }

#D1 Utilities                                                                   # Utility functions.

sub randomArray($)                                                              # Create a random array.
 {my ($N) = @_;                                                                 # Size of array

  my @r = 1..$N;
  srand(1);

  for my $i(keys @r)                                                            # Disarrange the array
   {my $s = int rand @r;
    my $t = int rand @r;
    ($r[$t], $r[$s]) = ($r[$s], $r[$t]);
   }
  @r
 }

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

@ISA         = qw(Exporter);
@EXPORT      = qw();
@EXPORT_OK   = qw(Find FindResult_cmp FindResult_data FindResult_key Insert Iterate New printTreeKeys printTreeData randomArray);
#say STDERR '@EXPORT_OK   = qw(', (join ' ', sort @EXPORT_OK), ');'; exit;
%EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);

return 1 if caller;

# Tests

Test::More->builder->output("/dev/null");                                       # Reduce number of confirmation messages during testing

my $debug = -e q(/home/phil/);                                                  # Assume debugging if testing locally
eval {goto latest if $debug};

sub is_deeply;
sub ok($;$);
sub done_testing;
sub x {exit if $debug}                                                          # Stop if debugging.

#latest:;
if (1)                                                                          ##New
 {Start 1;
  Out New(3);
  my $e = Execute(suppressOutput=>1);
  is_deeply $e->out, <<END;
1
END
  is_deeply $e->heap(1), [ 0, 0, 3, 0];
 }

#latest:;
if (1)                                                                          ##New
 {Start 1;
  my $t = New(3);
  my $r = root($t);

  setRoot($t, 1);
  my $R = root($t);

  my $n = maximumNumberOfKeys($t);

  incKeys($t) for 1..3;
  Out [$t, $Tree->address(q(keys)), 'Tree'];

  incNodes($t) for 1..5;
  Out nodes($t);

  my $e = Execute(suppressOutput=>1);
  is_deeply $e->out, <<END;
3
5
END
  is_deeply $e->heap(1), [ 3, 5, 3, 1];
 }

#latest:;
if (1)                                                                          ##Node_new
 {Start 1;
  my $t = New(7);                                                               # Create tree
  my $n = Node_new($t);                                                         # Create node
  my $e = Execute(suppressOutput=>1);

  is_deeply $e->heap(1), [0, 1, 7, 0];
  is_deeply $e->heap(2), [0, 1, 0, 1, 3, 4, 0];
  is_deeply $e->heap(3), [];
  is_deeply $e->heap(4), [];
 }

#latest:;
if (1)                                                                          # Set up to test Node_open
 {Start 1;
  my $N = 7;
  my $t = New($N);                                                              # Create tree
  my $n = Node_new($t);                                                         # Create node

  Node_allocDown $n;