File Coverage

blib/lib/Graph/Maker/TwinAlternateAreaTree.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


line stmt bran cond sub pod time code
1             # Copyright 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::TwinAlternateAreaTree;
20 1     1   806 use 5.004;
  1         3  
21 1     1   5 use strict;
  1         2  
  1         25  
22 1     1   7 use Carp 'croak';
  1         3  
  1         58  
23 1     1   170 use Graph::Maker;
  0            
  0            
24              
25             use vars '$VERSION','@ISA';
26             $VERSION = 7;
27             @ISA = ('Graph::Maker');
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 _vertex_name_func_decimal {
38             my ($v) = @_;
39             return $v;
40             }
41             sub _vertex_name_func_binary {
42             my ($v) = @_;
43             return sprintf '%b', $v;
44             }
45             sub _vertex_name_func_xy {
46             my ($v) = @_;
47             my $x = 0;
48             my $y = 0;
49             my $bit = 1;
50             while ($v) {
51             if ($v & 1) { $x |= $bit; }
52             $v >>= 1;
53             if ($v & 1) { $y |= $bit; }
54             $v >>= 1;
55             $bit <<= 1;
56             }
57             $x = $y-$x;
58             return "$x,$y";
59             }
60             sub init {
61             my ($self, %params) = @_;
62              
63             my $level = delete($params{level}) || 0;
64             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
65              
66             # undocumented parameter
67             my $vertex_name_type = delete($params{'vertex_name_type'}) || 'decimal';
68             my $vertex_names_func = $self->can("_vertex_name_func_$vertex_name_type")
69             || croak 'Unrecognised vertex_name_type: ',$vertex_name_type;
70              
71             ### $level
72             ### $vertex_name_type
73              
74             my $graph = $graph_maker->(%params);
75             $graph->set_graph_attribute(name => "Twin Alternate Area Tree $level");
76             $graph->set_graph_attribute(vertex_name_type => $vertex_name_type);
77             $graph->add_vertex($vertex_names_func->(0));
78             my $directed = $graph->is_directed;
79              
80             V: foreach my $v (0 .. 2**$level-1) {
81             ### $v
82              
83             # ...1 edge to ...0
84             if ($v & 1) {
85             ### horizontal ...
86             my $to = $v ^ 1;
87             my $v_name = $vertex_names_func->($v);
88             my $to_name = $vertex_names_func->($to);
89             $graph->add_edge($v_name, $to_name);
90             if ($directed) { $graph->add_edge($to_name, $v_name); }
91             }
92              
93             # ...00 11...11
94             # \-----/ zero or more low 1 bits
95             # edge to
96             # ...11 00...00
97             #
98             my $bit = 1;
99             for (my $pos = 1; ; $pos++, $bit<<=1) {
100             $pos < $level or next V;
101             next if $v & $bit; # still all 1s
102             unless ($v & ($bit<<1)) { # 00 11..11
103             my $to = $v+1+($bit<<1);
104              
105             my $v_name = $vertex_names_func->($v);
106             my $to_name = $vertex_names_func->($to);
107             $graph->add_edge($v_name, $to_name);
108             if ($directed) { $graph->add_edge($to_name, $v_name); }
109             }
110             last;
111             }
112             }
113             return $graph;
114             }
115              
116             Graph::Maker->add_factory_type('twin_alternate_area_tree' => __PACKAGE__);
117             1;
118             __END__