view release on metacpan or  search on metacpan

lib/Binary/Heap/Array.pm  view on Meta::CPAN

   {if ($f =~ m/$_/i)
     {  $f =~ s/$_//gi;
      $name .= uc($_);
     }
    else
     {$name .= lc($_);
     }
   }
  $f =~ /\A\s*\Z/ or confess "Invalid flags '$f' in '$flags'";                  # Check flags syntax

  return bless [], $name;                                                       # Bless into appropriately optimized package
 } # new

sub code {<<'END'}                                                              # Code to be optimised
sub speedInUse{(speedNo>>0)%2}                                                  ## Use a vec() in each array to mark which sub arrays can be reused rather than being freed immediately
sub speedPp   {(speedNo>>1)%2}                                                  ## Use pre/post to skip over elements at the start/end at the cost of two additional fields per array
sub speedSize {(speedNo>>2)%2}                                                  ## Cache the current size of the array at the cost of an additional field per array
sub speedWidth{(speedNo>>3)%2}                                                  ## Cache the current width of the array at the cost of an additional field per array

sub subarray                                                                    ## An array, always a power of 2 wide, containing sub arrays which contain the caller's data or slots which are empty, each of the sub arrays is a power of 2 wide which d...
 {my ($array) = @_;
  no overloading;
  $array->[0] //= []                                                            # Field 1
 }
sub speed :lvalue                                                               ## Algorithm to use
 {my ($array) = @_;
  no overloading;
  $array->[1] //= (my $v = 0)                                                   # Field 2
 }
sub inUse :lvalue                                                               ## A vec() of bits, the same width as subarray where each bit tells us whether the corresponding sub array is in use or not.
 {my ($array) = @_;
  no overloading;
  confess unless speedInUse;
  $array->[2] //= (my $v = '')                                                  # Field 3
 }
sub pre :lvalue                                                                 ## The number of entries to ignore at the beginning to assist with shift/unshift
 {my ($array) = @_;
  no overloading;
  confess unless speedPp;
  $array->[3] //= (my $v = 0)                                                   # Field 4
 }
sub post :lvalue                                                                ## The number of entries to ignore at the end to assist with pop/push
 {my ($array) = @_;
  no overloading;
  confess unless speedPp;
  $array->[4] //= (my $v = 0)                                                   # Field 5
 }
sub currentSize :lvalue                                                         ## The current size of the array
 {my ($array) = @_;
  no overloading;
  confess unless speedSize;
  $array->[5] //= (my $v = 0)                                                   # Field 6
 }
sub currentWidth :lvalue                                                        ## The current width of the array
 {my ($array) = @_;
  no overloading;
  confess unless speedWidth;
  $array->[6] //= (my $v = 0)                                                   # Field 7
 }

sub at($$) :lvalue                                                              # Address the element at a specified index so that it can get set or got
 {my ($array, $index) = @_;                                                     # Array, index of element
  my $n = size($array);                                                         # Array size
  return undef if $index < -$n or $index >= $n;                                 # Index out of range
  return &atUp(@_) if $index >= 0;
  &atDown(@_)
 } # at                                                                         # It would be nice to use overload @{} here but this requires flattening the array which would be very expensive on large arrays

sub inUseVector ($) :lvalue                                                     ## Sub arrays in use
 {my ($array) = @_;
  return inUse($array) if speedInUse;
  my $v = '';
  my @a = @{subarray($array)};
  vec($v, $_, 1) = !!$a[$_] for 0..$#a;
  $v
 }

sub pop($)                                                                      # Pop the topmost element from the leading full array and spread the remainder of its contents as sub arrays of the correct size for each preceding empty slot
 {my ($array) = @_;                                                             # Array from which an element is to be popped
  my $N = size($array);                                                         # Size of array
  return undef unless $N;                                                       # Cannot pop from an empty array

  if (speedPp)                                                                  # Fast with pre and post
   {my $element = at($array, -1);
    post($array)++;
    currentSize($array)-- if speedSize;                                         # Decrease cached size of array if possible - has to be done late to avoid confusion over at
    return $element;
   }
  else
   {currentSize($array)-- if speedSize;                                         # Decrease cached size of array if possible - has to be done late to avoid confusion over at
    my $S = subarray($array);                                                   # Sub array list for this array
    my $v = inUseVector($array);                                                # Sub arrays in use

    for my $i(keys @$S)                                                         # Index to each sub array
     {my $s = $S->[$i];                                                         # Sub array
      if (vec($v, $i, 1))                                                       # Full sub array
       {my $pop = CORE::pop @$s;                                                # Pop an element off the first full sub array
        for my $I(0..$i-1)                                                      # Distribute the remaining elements of this sub array so that each sub array is always a power of two wide which depends on teh position of the sub array in the array of ...
         {my $j = 1<<$I;
          splice @{$S->[$I]}, 0, $j, splice @$s, -$j, $j;                       # Copy block across
          vec(inUse($array), $I, 1) = 1 if speedInUse;                          # Mark this sub array as in use
         }
        if ($N == 1)                                                            # We are popping the last element in a binary heap array
         {$#{subarray($array)} = -1;                                            # Remove all sub arrays
          inUse($array)        = '' if speedInUse;                              # Mark all sub arrays as not in use and shorten the vec() string at the same time
          currentWidth($array) =  0 if speedWidth;                              # New width of array of sub arrays
          @$S = ();                                                             # Empty the array of sub arrays
         }
        else                                                                    # Pop an element that is not the last element in a binary heap array
         {if (speedInUse)
           {vec(inUse($array), $i, 1) = 0;                                      # Mark sub array as not in use
           }
          else
           {$S->[$i] = undef;                                                   # Free sub array as it is no longer in use
           }
          my $W = width($array);                                                # Get current width
          my $w = containingPowerOfTwo($W);                                     # Current width is contained by this power of two
          inUse($array) = substr(inUse($array), 0, 1<<($w-3)) if speedInUse;    # Keep vec() string length in bounds - the 3 is because there 2**3 bits in a byte as used by vec()
          splice @$S, 1<<$w if @$S > 1<<$w;                                     # Shorten the array of sub arrays while leaving some room for a return to growth
          $S->[$_] = undef for $W..(1<<$w)-1;                                   # Remove outer inactive arrays but keep inner inactive arrays to reduce the allocation rate - the whole point of the inUse array
          currentWidth($array) = $w+1                                           # New width of array of sub arrays