File Coverage

blib/lib/Math/PlanePath/HexSpiral.pm
Criterion Covered Total %
statement 105 119 88.2
branch 22 30 73.3
condition 1 2 50.0
subroutine 21 27 77.7
pod 8 8 100.0
total 157 186 84.4


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath 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 Math-PlanePath. If not, see .
17              
18              
19              
20             # Kanga "Number Mosaics" rotated to
21             #
22             # ...-16---15
23             # \
24             # 6----5 14
25             # / \ \
26             # 7 1 4 13
27             # / / / /
28             # 8 2----3 12
29             # \ /
30             # 9---10---11
31             #
32             #
33             # Could go pointy end with same loop/step, or point to the right
34             #
35             # 13--12--11
36             # / |
37             # 14 4---3 10
38             # / / | |
39             # 15 5 1---2 9
40             # \ \ |
41             # 16 6---7---8
42             # \ |
43             # 17--18--19--20
44             #
45              
46              
47             package Math::PlanePath::HexSpiral;
48 4     4   8996 use 5.004;
  4         23  
49 4     4   17 use strict;
  4         6  
  4         173  
50             #use List::Util 'max';
51             *max = \&Math::PlanePath::_max;
52              
53 4     4   20 use vars '$VERSION', '@ISA';
  4         6  
  4         221  
54             $VERSION = 127;
55 4     4   1753 use Math::PlanePath;
  4         9  
  4         169  
56             *_sqrtint = \&Math::PlanePath::_sqrtint;
57             @ISA = ('Math::PlanePath');
58              
59             use Math::PlanePath::Base::Generic
60 4         145 'round_nearest',
61 4     4   27 'xy_is_even';
  4         7  
62              
63              
64             # uncomment this to run the ### lines
65             #use Devel::Comments '###';
66              
67              
68 4     4   1733 use Math::PlanePath::SquareSpiral;
  4         10  
  4         825  
69             *parameter_info_array = \&Math::PlanePath::SquareSpiral::parameter_info_array;
70              
71             # 2w+3 --- 3w/2+3 -- w+4
72             # / \
73             # 2w+4 0 -------- w+3 *
74             # \ /
75             # 2w+5 ----------------- 3w+7 w=2; 1+3*w+7=14
76             # ^
77             # X=0
78             sub x_negative_at_n {
79 0     0 1 0 my ($self) = @_;
80 0 0       0 return $self->n_start + ($self->{'wider'} ? 0 : 3);
81             }
82             sub y_negative_at_n {
83 0     0 1 0 my ($self) = @_;
84 0         0 return $self->n_start + 2*$self->{'wider'} + 5;
85             }
86             sub _UNDOCUMENTED__dxdy_list_at_n {
87 0     0   0 my ($self) = @_;
88 0         0 return $self->n_start + 3*$self->{'wider'} + 7;
89             }
90              
91             sub rsquared_minimum {
92 0     0 1 0 my ($self) = @_;
93 0 0       0 return ($self->{'wider'} % 2
94             ? 1 # odd "wider" minimum X=1,Y=0
95             : 0); # even "wider" includes X=0,Y=0
96             }
97             *sumabsxy_minimum = \&rsquared_minimum;
98              
99 4     4   25 use constant dx_minimum => -2;
  4         8  
  4         193  
100 4     4   19 use constant dx_maximum => 2;
  4         6  
  4         177  
101 4     4   21 use constant dy_minimum => -1;
  4         5  
  4         155  
102 4     4   18 use constant dy_maximum => 1;
  4         7  
  4         221  
103              
104             *_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::_UNDOCUMENTED__dxdy_list_six;
105              
106 4     4   21 use constant absdx_minimum => 1;
  4         6  
  4         219  
107             *absdiffxy_minimum = \&rsquared_minimum;
108              
109 4     4   19 use constant dsumxy_minimum => -2; # SW diagonal
  4         6  
  4         157  
110 4     4   18 use constant dsumxy_maximum => 2; # dX=+2 and diagonal
  4         6  
  4         178  
111 4     4   20 use constant ddiffxy_minimum => -2; # NW diagonal
  4         7  
  4         139  
112 4     4   18 use constant ddiffxy_maximum => 2; # SE diagonal
  4         17  
  4         169  
113 4     4   21 use constant dir_maximum_dxdy => (1,-1); # South-East
  4         5  
  4         182  
114              
115 4     4   20 use constant turn_any_right => 0; # only left or straight
  4         12  
  4         2448  
116             sub _UNDOCUMENTED__turn_any_left_at_n {
117 0     0   0 my ($self) = @_;
118 0         0 return $self->n_start + $self->{'wider'} + 1;
119             }
120              
121              
122             #------------------------------------------------------------------------------
123              
124             sub new {
125 6     6 1 1076 my $self = shift->SUPER::new (@_);
126              
127             # parameters
128 6   50     44 $self->{'wider'} ||= 0; # default
129 6 100       13 if (! defined $self->{'n_start'}) {
130 4         18 $self->{'n_start'} = $self->default_n_start;
131             }
132              
133 6         14 return $self;
134             }
135              
136             # wider==0
137             # diagonal down and to the left
138             # d = [ 0, 1, 2, 3 ]
139             # N = [ 1, 6, 17, 34 ]
140             # N = (3*$d**2 + 2*$d + 1)
141             # d = -1/3 + sqrt(1/3 * $n + -2/9)
142             # = (-1 + sqrt(3*$n - 2)) / 3
143             #
144             # wider==1
145             # diagonal down and to the left
146             # d = [ 0, 1, 2, 3 ]
147             # N = [ 1, 8, 21, 40 ]
148             # N = (3*$d**2 + 4*$d + 1)
149             # d = -2/3 + sqrt(1/3 * $n + 1/9)
150             # = (-2 + sqrt(3*$n + 1)) / 3
151             #
152             # wider==2
153             # diagonal down and to the left
154             # d = [ 0, 1, 2, 3, 4 ]
155             # N = [ 1, 10, 25, 46, 73 ]
156             # N = (3*$d**2 + 6*$d + 1)
157             # d = -1 + sqrt(1/3 * $n + 2/3)
158             # = (-3 + sqrt(3*$n + 6)) / 3
159             #
160             # N = 3*$d*$d + (2+2*$w)*$d + 1
161             # = (3*$d + 2 + 2*$w)*$d + 1
162             # d = (-1-w + sqrt(3*$n + ($w+2)*$w - 2)) / 3
163             # = (sqrt(3*$n + ($w+2)*$w - 2) -1-w) / 3
164              
165             sub n_to_xy {
166 51     51 1 7418 my ($self, $n) = @_;
167             #### n_to_xy: "$n wider=$self->{'wider'}"
168              
169 51         87 $n = $n - $self->{'n_start'}; # N=0 basis
170 51 50       101 if ($n < 0) { return; }
  0         0  
171 51         62 my $w = $self->{'wider'};
172              
173 51         130 my $d = int((_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3);
174             #### d frac: ((_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3)
175             #### $d
176              
177 51         70 $n += 1; # N=1 basis
178              
179 51         67 $n -= (3*$d + 2 + 2*$w)*$d + 1;
180             #### remainder: $n
181              
182 51         54 $d = $d + 1; # no warnings if $d==inf
183 51 100       82 if ($n <= $d+$w) {
184             #### bottom horizontal
185 24         34 $d = -$d + 1;
186 24         54 return (2*$n + $d - $w,
187             $d);
188             }
189 27         36 $n -= $d+$w;
190 27 100       44 if ($n <= $d-1) {
191             #### right lower diagonal, being 1 shorter: $n
192 4         11 return ($n + $d + 1 + $w,
193             $n - $d + 1);
194             }
195 23         27 $n -= $d-1;
196 23 100       39 if ($n <= $d) {
197             #### right upper diagonal: $n
198 7         20 return (-$n + 2*$d + $w,
199             $n);
200             }
201 16         18 $n -= $d;
202 16 100       23 if ($n <= $d+$w) {
203             #### top horizontal
204 7         16 return (-2*$n + $d + $w,
205             $d);
206             }
207 9         12 $n -= $d+$w;
208 9 100       25 if ($n <= $d) {
209             #### left upper diagonal
210 7         19 return (-$n - $d - $w,
211             -$n + $d );
212             }
213             #### left lower diagonal
214 2         3 $n -= $d;
215 2         79 return ($n - 2*$d - $w,
216             -$n);
217             }
218              
219             sub xy_is_visited {
220 0     0 1 0 my ($self, $x, $y) = @_;
221 0         0 return xy_is_even($self,$x+$self->{'wider'},$y);
222             }
223              
224             sub xy_to_n {
225 9     9 1 430 my ($self, $x, $y) = @_;
226             ### xy_to_n(): "$x, $y"
227              
228 9         20 $x = round_nearest ($x);
229 9         17 $y = round_nearest ($y);
230 9         13 my $w = $self->{'wider'};
231 9 50       19 if (($x ^ $y ^ $w) & 1) {
232 0         0 return undef; # nothing on odd squares
233             }
234              
235 9         14 my $ay = abs($y);
236 9         10 my $ax = abs($x) - $w;
237 9 100       15 if ($ax > $ay) {
238 3         5 my $d = ($ax + $ay)/2; # x+y is even
239              
240 3 100       12 if ($x > 0) {
241             ### right ends
242             ### $d
243             return ((3*$d - 2 + 2*$w)*$d - $w # horizontal to the right
244             + $y # offset up or down
245 2         28 + $self->{'n_start'});
246              
247             } else {
248             ### left ends
249             return ((3*$d + 1 + 2*$w)*$d # horizontal to the left
250             - $y # offset up or down
251 1         2 + $self->{'n_start'});
252             }
253              
254             } else {
255 6         9 my $d = $ay;
256              
257 6 100       12 if ($y > 0) {
258             ### top horizontal
259             ### $d
260             return ((3*$d + 2*$w)*$d # diagonal up to the left
261             + (-$d - $x-$w) / 2 # negative offset rightwards
262 2         5 + $self->{'n_start'});
263             } else {
264             ### bottom horizontal, and centre horizontal
265             ### $d
266             ### offset: $d
267             return ((3*$d + 2 + 2*$w)*$d # diagonal down to the left
268             + ($x + $w + $d)/2 # offset rightwards
269 4         13 + $self->{'n_start'});
270             }
271             }
272             }
273              
274             # not exact
275             sub rect_to_n_range {
276 1     1 1 6 my ($self, $x1,$y1, $x2,$y2) = @_;
277             ### HexSpiral rect_to_n_range(): $x1,$y1, $x2,$y2
278 1         2 my $w = $self->{'wider'};
279              
280             # symmetric in +/-y, and biggest y is biggest n
281 1         3 my $y = max (abs($y1), abs($y2));
282              
283             # symmetric in +/-x, and biggest x
284 1         3 my $x = max (abs($x1), abs($x2));
285 1 50       3 if ($x >= $w) {
286 1         2 $x -= $w;
287             }
288              
289             # in the middle horizontal path parts y determines the loop number
290             # in the end parts diagonal distance, 2 apart
291 1 50       3 my $d = ($y >= $x
292             ? $y # middle
293             : ($x + $y + 1)/2); # ends
294 1         3 $d = int($d) + 1;
295              
296             # diagonal downwards bottom left being the end of a revolution
297             # s=0
298             # s=1 n=7
299             # s=2 n=19
300             # s=3 n=37
301             # s=4 n=61
302             # n = 3*$d*$d + 3*$d + 1
303             #
304             # ### gives: "sum $d is " . (3*$d*$d + 3*$d + 1)
305              
306             # ENHANCE-ME: find actual minimum if rect doesn't cover 0,0
307             return ($self->{'n_start'},
308 1         3 (3*$d + 3 + 2*$w)*$d + $self->{'n_start'});
309             }
310              
311             1;
312             __END__