File Coverage

blib/lib/Math/PlanePath/AnvilSpiral.pm
Criterion Covered Total %
statement 122 133 91.7
branch 33 36 91.6
condition 2 4 50.0
subroutine 22 27 81.4
pod 6 6 100.0
total 185 206 89.8


line stmt bran cond sub pod time code
1             # Copyright 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             # math-image --path=AnvilSpiral --all --output=numbers_dash
20             # math-image --path=AnvilSpiral,wider=3 --all --output=numbers_dash
21              
22             package Math::PlanePath::AnvilSpiral;
23 1     1   957 use 5.004;
  1         3  
24 1     1   5 use strict;
  1         1  
  1         59  
25             #use List::Util 'min','max';
26             *min = \&Math::PlanePath::_min;
27             *max = \&Math::PlanePath::_max;
28              
29 1     1   5 use vars '$VERSION', '@ISA';
  1         1  
  1         50  
30             $VERSION = 127;
31 1     1   634 use Math::PlanePath;
  1         3  
  1         43  
32             @ISA = ('Math::PlanePath');
33             *_sqrtint = \&Math::PlanePath::_sqrtint;
34              
35             use Math::PlanePath::Base::Generic
36 1     1   5 'round_nearest';
  1         2  
  1         32  
37              
38              
39             # pentagonal N = (3k-1)*k/2
40             # preceding
41             # Np = (3k-1)*k/2 - 1
42             # = (3k^2 - k - 2)/2
43             # = (3k+2)(k-1)/2
44             #
45              
46              
47             # parameters "wider","n_start"
48 1     1   485 use Math::PlanePath::SquareSpiral;
  1         2  
  1         40  
49             *parameter_info_array
50             = \&Math::PlanePath::SquareSpiral::parameter_info_array;
51 1     1   6 use constant xy_is_visited => 1;
  1         1  
  1         44  
52              
53 1     1   5 use constant dx_minimum => -1;
  1         1  
  1         33  
54 1     1   4 use constant dx_maximum => 1;
  1         2  
  1         33  
55 1     1   5 use constant dy_minimum => -1;
  1         1  
  1         30  
56 1     1   4 use constant dy_maximum => 1;
  1         2  
  1         40  
57 1         146 use constant _UNDOCUMENTED__dxdy_list => (1,0, # E # no N,S
58             1,1, # NE
59             -1,1, # NW
60             -1,0, # W
61             -1,-1, # SW
62 1     1   4 1,-1); # SE
  1         1  
63             # last NW at lower right
64             # 2w+4 ------- w+1
65             # \ /
66             # * 0---- w *
67             # / \
68             # 2w+6 ---------- 3w+10 w=3; 1+3*w+10=20
69             #
70             sub x_negative_at_n {
71 0     0 1 0 my ($self) = @_;
72 0 0       0 return $self->n_start + ($self->{'wider'} ? 0 : 3);
73             }
74             sub y_negative_at_n {
75 0     0 1 0 my ($self) = @_;
76 0         0 return $self->n_start + 2*$self->{'wider'} + 6;
77             }
78             sub _UNDOCUMENTED__dxdy_list_at_n {
79 0     0   0 my ($self) = @_;
80 0         0 return $self->n_start + 3*$self->{'wider'} + 10;
81             }
82              
83 1     1   6 use constant absdx_minimum => 1; # abs(dX)=1 always
  1         2  
  1         48  
84 1     1   12 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         37  
85 1     1   5 use constant dsumxy_maximum => 2;
  1         1  
  1         45  
86 1     1   6 use constant ddiffxy_minimum => -2;
  1         1  
  1         52  
87 1     1   5 use constant ddiffxy_maximum => 2;
  1         2  
  1         36  
88 1     1   5 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         1  
  1         751  
89              
90             sub _UNDOCUMENTED__turn_any_left_at_n {
91 0     0   0 my ($self) = @_;
92             # left turn at w when w!=0 or at w+1 when w==0
93 0   0     0 return $self->n_start + ($self->{'wider'} || 1);
94             }
95             sub _UNDOCUMENTED__turn_any_right_at_n {
96 0     0   0 my ($self) = @_;
97 0         0 return $self->n_start + 2*$self->{'wider'} + 5;
98             }
99              
100              
101             #------------------------------------------------------------------------------
102              
103             sub new {
104 20     20 1 4055 my $self = shift->SUPER::new (@_);
105              
106             # parameters
107 20 100       70 if (! defined $self->{'n_start'}) {
108 8         44 $self->{'n_start'} = $self->default_n_start;
109             }
110 20   100     58 $self->{'wider'} ||= 0; # default
111              
112 20         46 return $self;
113             }
114              
115             # [1,2,3,4],[1,12,35,70] # horizontal
116             # N = (6 d^2 - 7 d + 2)
117             # = (6*$d**2 - 7*$d + 2)
118             # = ((6*$d - 7)*$d + 2)
119             # d = 7/12 + sqrt(1/6 * $n + 1/144)
120             # = (7 + 12*sqrt(1/6 * $n + 1/144))/12
121             # = (7 + sqrt(144/6*$n + 1))/12
122             # = (7 + sqrt(24*$n + 1))/12
123             #
124             # wider=1
125             # [1,2,3,4],[1+1,12+1+2,35+1+2+2,70+1+2+2+2]
126             # N = (6 d^2 - 5 d + 1)
127             # d = 5/12 + sqrt(1/6 * $n + 1/144)
128             #
129             # wider=2
130             # [1,2,3,4],[1+2,12+2+4,35+2+4+4,70+2+4+4+4]
131             # N = (6 d^2 - 3 d)
132             # d = 3/12 + sqrt(1/6 * $n + 9/144)
133             #
134             # wider=3
135             # [1,2,3,4],[1+3,12+3+6,35+3+6+6,70+3+6+6+6]
136             # N = (6 d^2 - d - 1)
137             # d = 1/12 + sqrt(1/6 * $n + 25/144)
138             #
139             # wider=4
140             # [1,2,3,4],[1+4,12+4+8,35+4+8+8,70+4+8+8+8]
141             # N = (6 d^2 + d - 2)
142             # d = -1/12 + sqrt(1/6 * $n + 49/144) # 49=7*7=(2w-1)*(2w-1)
143             #
144             # in general
145             # N = (6 d^2 - (7-2w) d + 2-w)
146             # = (6d - (7-2w)) d + 2-w
147             # = (6d - 7 + 2w))*d + 2-w
148             # d = (7-2w)/12 + sqrt(1/6 * $n + (w-1)^2/144)
149             # = [ 7-2w + 12*sqrt(1/6 * $n + (w-1)^2/144) ] / 12
150             # = [ 7-2w + sqrt(144/6*$n + (w-1)^2) ] / 12
151             # = [ 7-2w + sqrt(24*$n + (w-1)^2) ] / 12
152              
153              
154              
155             sub n_to_xy {
156 9234     9234 1 35728 my ($self, $n) = @_;
157             ### AnvilSpiral n_to_xy(): $n
158              
159 9234         10632 $n = $n - $self->{'n_start'}; # to N=0 basis, warning if $n==undef
160 9234 50       13177 if ($n < 0) { return; }
  0         0  
161 9234         10723 my $w = $self->{'wider'};
162 9234         11970 my $w_right = int($w/2);
163 9234         10534 my $w_left = $w - $w_right;
164             ### $w
165             ### $w_left
166             ### $w_right
167              
168 9234 100       12670 if ($n <= $w) {
169             ### centre horizontal
170 114         218 return ($n - $w_left, # N=0 at $w_left
171             0);
172             }
173              
174 9120         18003 my $d = int((_sqrtint(24*($n+1) + (2*$w-1)**2) + 7-2*$w) / 12);
175             ### ($n+1)
176             ### $d
177             ### d frac: ((sqrt(int(24*($n+1)) + (2*$w-1)**2) + 7-2*$w) / 12)
178             ### d sqrt add: ($w-1)*($w-1)
179             ### d const part: 7-2*$w
180              
181 9120         13598 $n -= (6*$d - 7 + 2*$w)*$d + 2-$w;
182             ### base: (6*$d - 7 + 2*$w)*$d + 2-$w
183             ### remainder: $n
184              
185 9120 100       14288 if ($n <= 5*$d+$w-2) {
186 4268 100       5821 if ($n+1 <= $d) {
187             ### upper right slope ...
188 874         1724 return ($n + $d + $w_right,
189             $n+1);
190             } else {
191             ### top ...
192 3394         6831 return (-$n + 3*$d + $w_right - 2,
193             $d);
194             }
195             }
196              
197 4852         5421 $n -= 7*$d + $w - 2;
198 4852 100       6496 if ($n <= 0) {
199             ### left slopes: $n
200 1320         2784 return (-abs($n+$d) - $d - $w_left,
201             -$n - $d);
202             }
203              
204 3532         4144 $n -= 4*$d + $w;
205 3532 100       4914 if ($n < 0) {
206             ### bottom ...
207 2944         6062 return ($n + 2*$d + $w_right,
208             -$d);
209             } else {
210             ### right lower ...
211 588         1254 return (-$n + 2*$d + $w_right,
212             $n - $d);
213             }
214             }
215              
216             sub xy_to_n {
217 9234     9234 1 47749 my ($self, $x, $y) = @_;
218             ### AnvilSpiral xy_to_1 n(): "$x, $y"
219              
220 9234         14316 $x = round_nearest ($x);
221 9234         14070 $y = round_nearest ($y);
222              
223 9234         12230 my $w = $self->{'wider'};
224 9234         12101 my $w_right = int($w/2);
225 9234         10525 my $w_left = $w - $w_right;
226             ### $w
227             ### $w_left
228             ### $w_right
229              
230 9234         9956 my $abs_y = abs($y);
231 9234 100       15168 if ($x-$w_right >= 2*$abs_y) {
232             ### right slopes: "d=".($x-$w_right - $abs_y)
233 1327         1525 my $d = $x-$w_right - $abs_y; # zero based
234             return ((6*$d + 5 + 2*$w)*$d + $w
235             + $y
236 1327         2648 + $self->{'n_start'});
237             }
238              
239 7907 100       11691 if ($x+$w_left < -2*$abs_y) {
240             ### left slopes: "d=".($x+$w_left + $abs_y)
241 1178         1408 my $d = $x+$w_left + $abs_y; # negative, and zero based
242             return ((6*$d + 1 - 2*$w)*$d
243             - $y
244 1178         2267 + $self->{'n_start'});
245             }
246              
247 6729 100       9481 if ($y > 0) {
248             ### top horizontal ...
249             return ((6*$y - 4 + 2*$w)*$y - $w
250             + $w_right-$x
251 3547         7109 + $self->{'n_start'});
252             } else {
253             ### bottom horizontal ...
254             # y negative
255             return ((6*$y - 2 - 2*$w)*$y
256             + $x+$w_left
257 3182         6389 + $self->{'n_start'});
258             }
259             }
260              
261             # uncomment this to run the ### lines
262             #use Smart::Comments;
263              
264             # ...-78-77-76-75-74
265             # /
266             # 43-42-41-40-39-38 73
267             # / /
268             # 17-16-15-14 37 72
269             # / / /
270             # -3--2 13 36 71
271             # / / / /
272             # 1 12 35 70
273             #
274             # column X=2, dmin decreasing until Y=1=floor(x/2)
275             # column X=3, dmin decreasing until Y=2=ceil(x/2)
276             # so x1 - min(y2,int((x1+1)/2))
277             #
278             #
279             # column Xmax=2, dmax increasing down until x2-y1
280             #
281             # horizontal Y>=0 N increases left and right of X=Y*3/2
282             # so candidate max at top-left x1,y2 or top-right x2,y2
283             #
284             # horizontal Y<0 N increases left and right of X=-Y*3/2
285             # so candidate max at bottom-left x1,y1 or bottom-right x2,y1
286             #
287             # vertical Y>=0 N increases above and below Y=ceil(X/2)
288             # so candidate max at top-right or bottom-right, or Y=0
289             #
290             # vertical Y<0 N increases above and below Y=ceil(X/2)
291             # so candidate max at top-right or bottom-right, or Y=0
292             #
293             # int(($y2+1)/2), $y2
294             # int(($y1+1)/2), $y1
295             #
296             # my @corners = ($self->xy_to_n($x1,$y1),
297             # $self->xy_to_n($x2,$y1),
298             # $self->xy_to_n($x1,$y2),
299             # $self->xy_to_n($x2,$y2));
300             # return (($x_zero && $y_zero ? 1 : min (@corners)),
301             # max (@corners,
302             # ($y_zero ? ($self->xy_to_n($x1,0),
303             # $self->xy_to_n($x2,0)) : ())));
304              
305              
306              
307              
308             # not exact
309             sub rect_to_n_range {
310 18468     18468 1 80266 my ($self, $x1,$y1, $x2,$y2) = @_;
311             ### AnvilSpiral rect_to_n_range(): "$x1,$y1 $x2,$y2"
312              
313 18468         22518 my $w = $self->{'wider'};
314 18468         23842 my $w_right = int($w/2);
315 18468         20537 my $w_left = $w - $w_right;
316              
317 18468         26414 $x1 = round_nearest($x1);
318 18468         28220 $x2 = round_nearest($x2);
319 18468         27963 $y1 = round_nearest($y1);
320 18468         27183 $y2 = round_nearest($y2);
321              
322 18468         24404 my $x_zero = (($x1<0) != ($x2<0));
323 18468         21154 my $y_zero = (($y1<0) != ($y2<0));
324             ### $x_zero
325             ### $y_zero
326              
327 18468         19921 $x1 += $w_left;
328 18468         19181 $x2 += $w_left;
329              
330 18468 100       25745 if ($x1 < 0) { $x1 = $w-$x1; }
  7598         8566  
331 18468 100       25511 if ($x2 < 0) { $x2 = $w-$x2; }
  3799         4321  
332 18468         19704 $y1 = abs($y1);
333 18468         18714 $y2 = abs($y2);
334              
335 18468 100       28472 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
336 18468 100       26938 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
337              
338 18468 100       24861 if ($x_zero) { $x1 = 0; }
  4621         5306  
339 18468 100       23497 if ($y_zero) { $y1 = 0; }
  4186         4662  
340              
341             ### abs: "$x1,$y1 $x2,$y2"
342             ### d1 slope max y: int(($x1+1)/2)
343             ### d1 slope: $x1 - min($y2,int(($x1+1)/2))
344              
345             # --------*
346             # /
347             # /
348             # * <-y=0
349             # x=0....w
350             #
351             # d=x-w-y on the slope
352             # d=y on the top horizontal
353             #
354 18468         36569 my $d1 = min ($x1-$w - min($y2,int(($x1-$w+1)/2)) - 1,
355             $y2);
356 18468         31053 my $d2 = 1 + max ($x2-$w - $y1,
357             $y2);
358             ### $d1
359             ### $d2
360             ### d2 right slope would be: $x2-$w_right - $y2
361              
362             # d1==0 is the centre horizontal
363             #
364              
365             return ($d1 <= 0
366             ? $self->{'n_start'}
367             : (6*$d1 - 7 + 2*$w)*$d1 + 1-$w + $self->{'n_start'},
368              
369 18468 100       51220 (6*$d2 - 6 + 2*$w)*$d2 - $w + $self->{'n_start'});
370             }
371              
372             1;
373             __END__