File Coverage

blib/lib/Graph/Maker/BinaryBeanstalk.pm

Criterion	Covered	Total	%
statement	6	8	75.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	9	11	81.8

# Copyright 2016, 2017 Kevin Ryde
#
# This file is part of Graph-Maker-Other.
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# This file is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Graph-Maker-Other.  See the file COPYING.  If not, see
# .

package Graph::Maker::BinaryBeanstalk;
use 5.004;
use strict;
use Graph::Maker;

use vars '$VERSION','@ISA';
$VERSION = 7;
@ISA = ('Graph::Maker');


# uncomment this to run the ### lines
# use Smart::Comments;


sub _default_graph_maker {
  require Graph;
  Graph->new(@_);
}
sub init {
  my ($self, %params) = @_;

  my $height = delete($params{'height'});
  my $N      = delete($params{'N'});
  my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;

  my $graph = $graph_maker->(%params);

  if ((defined $height && $height > 0)
      || (defined $N && $N > 0)) {
    $graph->add_vertex(0);
    my $directed = $graph->is_directed;

    my $row_start = 0;
    my $v = 1;
    my $h = 1;
    for (;;) {
      my $parent = $v - _count_1_bits($v);
      ### at: "$v parent $parent  h=$h"
      if ($parent >= $row_start) {
        $row_start = $v;

        $h++;
        if (defined $height && $h > $height) {
          # stop for height limit
          $graph->set_graph_attribute(name=>"Binary Beanstalk height $height");
          last;
        }
      }
      if (defined $N && $v >= $N) {
        # stop for N limit
        $graph->set_graph_attribute (name => "Binary Beanstalk to $N");
        last;
      }

      $graph->add_edge($parent, $v);
      if ($directed) { $graph->add_edge($v, $parent); }

      $v++;
    }
  } else {
    $graph->set_graph_attribute (name => "Binary Beanstalk empty");
  }
  return $graph;
}

sub _count_1_bits {
  my ($n) = @_;
  my $count = 0;
  while ($n) {
    $count += ($n & 1);
    $n >>= 1;
  }
  return $count;
}

Graph::Maker->add_factory_type('binary_beanstalk' => __PACKAGE__);
1;

__END__