File Coverage

blib/lib/Graph/Maker/KnightGrid.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              
20             package Graph::Maker::KnightGrid;
21 1     1   822 use 5.004;
  1         3  
22 1     1   4 use strict;
  1         2  
  1         16  
23 1     1   109 use Graph::Maker;
  0            
  0            
24              
25             use vars '$VERSION','@ISA';
26             $VERSION = 8;
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              
38             # last $dim runs fastest, per Graph::Maker::Grid
39             sub _coordinates_to_vertex {
40             my ($c, $dims) = @_;
41             my $v = $c->[0];
42             die if $c->[0] >= $dims->[0];
43             foreach my $i (1 .. $#$dims) {
44             $v *= $dims->[$i];
45             $v += $c->[$i];
46             die if $c->[$i] >= $dims->[$i];
47             }
48             return $v+1;
49             }
50              
51             sub init {
52             my ($self, %params) = @_;
53              
54             my $dims = delete($params{'dims'}) || [];
55             my $cyclic = delete($params{'cyclic'});
56             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
57              
58             ### KnightGrid ...
59             ### $dims
60              
61             my $graph = $graph_maker->(%params);
62              
63             $graph->set_graph_attribute(name =>
64             "Knight Grid "
65             . (@$dims ? join('x',@$dims) : 'empty')
66             . ($cyclic ? " cyclic" : ""));
67             unless (_aref_any_nonzero($dims)) {
68             ### all dims zero ...
69             return $graph;
70             }
71              
72             my @c = (0) x scalar(@$dims);
73             for (;;) {
74             my $v = _coordinates_to_vertex(\@c, $dims);
75             $graph->add_vertex($v);
76             ### at: join(',',@c)."=[$v]"
77              
78             foreach my $i (0 .. $#c) {
79             foreach my $j (0 .. $#c) {
80             next if $i == $j;
81             foreach my $isign (1,-1) {
82             foreach my $jsign (1,-1) {
83             foreach my $offset (0, 1) {
84             my @c2 = @c;
85             $c2[$i] += (1+$offset)*$isign;
86             $c2[$j] += (2-$offset)*$jsign;
87             if ($cyclic) {
88             $c2[$i] %= $dims->[$i];
89             $c2[$j] %= $dims->[$j];
90             } else {
91             next unless ($c2[$i] >= 0 && $c2[$i] < $dims->[$i]
92             && $c2[$j] >= 0 && $c2[$j] < $dims->[$j]);
93             }
94             my $v2 = _coordinates_to_vertex(\@c2, $dims);
95             ### edge: join(',',@c)."=[$v] to ".join(',',@c2)."=[$v2]"
96             unless ($graph->has_edge($v,$v2)) {
97             $graph->add_edge($v,$v2);
98             }
99             }
100             }
101             }
102             }
103             }
104              
105             # increment @c coordinates
106             for (my $i = 0; ; $i++) {
107             if ($i > $#$dims) {
108             return $graph;
109             }
110             if (++$c[$i] < $dims->[$i]) {
111             last;
112             }
113             $c[$i] = 0;
114             }
115             }
116             }
117              
118             sub _aref_any_nonzero {
119             my ($aref) = @_;
120             foreach my $elem (@$aref) {
121             if ($elem) {
122             return 1;
123             }
124             }
125             return 0;
126             }
127              
128             Graph::Maker->add_factory_type('knight_grid' => __PACKAGE__);
129             1;
130              
131             __END__