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


line stmt bran cond sub pod time code
1             # Copyright 2016, 2017 Kevin Ryde
2             #
3             # This file is part of Graph-Maker-Other.
4             #
5             # This file is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # This file is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Graph-Maker-Other. See the file COPYING. If not, see
17             # .
18              
19             package Graph::Maker::BinaryBeanstalk;
20 1     1   724 use 5.004;
  1         4  
21 1     1   4 use strict;
  1         2  
  1         17  
22 1     1   90 use Graph::Maker;
  0            
  0            
23              
24             use vars '$VERSION','@ISA';
25             $VERSION = 7;
26             @ISA = ('Graph::Maker');
27              
28              
29             # uncomment this to run the ### lines
30             # use Smart::Comments;
31              
32              
33             sub _default_graph_maker {
34             require Graph;
35             Graph->new(@_);
36             }
37             sub init {
38             my ($self, %params) = @_;
39              
40             my $height = delete($params{'height'});
41             my $N = delete($params{'N'});
42             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
43              
44             my $graph = $graph_maker->(%params);
45              
46             if ((defined $height && $height > 0)
47             || (defined $N && $N > 0)) {
48             $graph->add_vertex(0);
49             my $directed = $graph->is_directed;
50              
51             my $row_start = 0;
52             my $v = 1;
53             my $h = 1;
54             for (;;) {
55             my $parent = $v - _count_1_bits($v);
56             ### at: "$v parent $parent h=$h"
57             if ($parent >= $row_start) {
58             $row_start = $v;
59              
60             $h++;
61             if (defined $height && $h > $height) {
62             # stop for height limit
63             $graph->set_graph_attribute(name=>"Binary Beanstalk height $height");
64             last;
65             }
66             }
67             if (defined $N && $v >= $N) {
68             # stop for N limit
69             $graph->set_graph_attribute (name => "Binary Beanstalk to $N");
70             last;
71             }
72              
73             $graph->add_edge($parent, $v);
74             if ($directed) { $graph->add_edge($v, $parent); }
75              
76             $v++;
77             }
78             } else {
79             $graph->set_graph_attribute (name => "Binary Beanstalk empty");
80             }
81             return $graph;
82             }
83              
84             sub _count_1_bits {
85             my ($n) = @_;
86             my $count = 0;
87             while ($n) {
88             $count += ($n & 1);
89             $n >>= 1;
90             }
91             return $count;
92             }
93              
94             Graph::Maker->add_factory_type('binary_beanstalk' => __PACKAGE__);
95             1;
96              
97             __END__