File Coverage

blib/lib/Graph/Maker/TwindragonAreaTree.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 2015, 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::TwindragonAreaTree;
20 1     1   719 use 5.004;
  1         3  
21 1     1   8 use strict;
  1         3  
  1         32  
22 1     1   109 use Graph::Maker;
  0            
  0            
23              
24             use vars '$VERSION','@ISA';
25             $VERSION = 7;
26             @ISA = ('Graph::Maker');
27              
28             # uncomment this to run the ### lines
29             # use Smart::Comments;
30              
31              
32             sub _default_graph_maker {
33             require Graph;
34             Graph->new(@_);
35             }
36             sub init {
37             my ($self, %params) = @_;
38              
39             my $level = delete($params{level}) || 0;
40             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
41             ### $level
42              
43             my $graph = $graph_maker->(%params);
44             $graph->set_graph_attribute(name => "Twindragon Area Tree $level");
45             $graph->add_vertex(0);
46             my $directed = $graph->is_directed;
47              
48             V: foreach my $v (0 .. 2**$level-1) {
49             # ...1 edge to ...0
50             if ($v & 1) {
51             my $to = $v ^ 1;
52             $graph->add_edge($v, $to);
53             if ($directed) { $graph->add_edge($to, $v); }
54             }
55              
56             # ...10 11...11
57             # \-----/ zero or more low 1 bits
58             # edge to
59             # ...01 00...00
60             #
61             my $bit = 1;
62             for (my $pos = 1; ; $pos++) {
63             $pos < $level or next V;
64             $v & $bit or last;
65             $bit <<= 1;
66             }
67             $bit <<= 1;
68             if ($v & $bit) {
69             my $to = $v-$bit+1;
70             $graph->add_edge($v, $to);
71             if ($directed) { $graph->add_edge($to, $v); }
72             }
73             }
74             return $graph;
75             }
76              
77             Graph::Maker->add_factory_type('twindragon_area_tree' => __PACKAGE__);
78             1;
79             __END__