File Coverage

blib/lib/Math/PlanePath/PixelRings.pm
Criterion Covered Total %
statement 139 183 75.9
branch 30 54 55.5
condition 3 11 27.2
subroutine 25 26 96.1
pod 4 4 100.0
total 201 278 72.3


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             # ENHANCE-ME: What formula for the cumulative pixel count, and its inverse?
20             # Not floor(k*4*sqrt(2)).
21              
22             # ENHANCE-ME: Maybe n_start
23              
24              
25             package Math::PlanePath::PixelRings;
26 1     1   9006 use 5.004;
  1         9  
27 1     1   5 use strict;
  1         2  
  1         23  
28 1     1   435 use Math::Libm 'hypot';
  1         7237  
  1         90  
29             #use List::Util 'min','max';
30             *min = \&Math::PlanePath::_min;
31             *max = \&Math::PlanePath::_max;
32              
33 1     1   8 use vars '$VERSION', '@ISA';
  1         2  
  1         81  
34             $VERSION = 127;
35 1     1   676 use Math::PlanePath;
  1         3  
  1         41  
36             @ISA = ('Math::PlanePath');
37              
38             use Math::PlanePath::Base::Generic
39 1         48 'is_infinite',
40 1     1   6 'round_nearest';
  1         2  
41              
42             # uncomment this to run the ### lines
43             #use Smart::Comments;
44              
45              
46             # use constant parameter_info_array =>
47             # [
48             # {
49             # name => 'offset',
50             # share_key => 'offset_05',
51             # type => 'float',
52             # description => 'Radial offset for the centre of each ring.',
53             # default => 0,
54             # minimum => -0.5,
55             # maximum => 0.5,
56             # page_increment => 0.05,
57             # step_increment => 0.005,
58             # width => 7,
59             # decimals => 4,
60             # },
61             # ];
62 1     1   5 use constant n_frac_discontinuity => 0;
  1         2  
  1         49  
63              
64 1     1   5 use constant x_negative_at_n => 4;
  1         1  
  1         39  
65 1     1   5 use constant y_negative_at_n => 5;
  1         2  
  1         39  
66 1     1   5 use constant dx_minimum => -1;
  1         2  
  1         39  
67 1     1   15 use constant dx_maximum => 2; # jump N=5 to N=6
  1         2  
  1         63  
68 1     1   8 use constant dy_minimum => -1;
  1         2  
  1         46  
69 1     1   5 use constant dy_maximum => 1;
  1         2  
  1         75  
70              
71             # eight plus ENE
72 1         65 use constant _UNDOCUMENTED__dxdy_list => (1,0, # E N=1
73             2,1, # ENE N=5 <-- extra
74             1,1, # NE N=16
75             0,1, # N N=6
76             -1,1, # NW N=2
77             -1,0, # W N=8
78             -1,-1, # SW N=3
79             0,-1, # S N=11
80             1,-1, # SE N=4
81 1     1   7 );
  1         1  
82 1     1   6 use constant _UNDOCUMENTED__dxdy_list_at_n => 16;
  1         2  
  1         54  
83              
84 1     1   7 use constant dsumxy_minimum => -2; # diagonals
  1         1  
  1         53  
85 1     1   6 use constant dsumxy_maximum => 3; # dx=2,dy=1 at jump N=5 to N=6
  1         2  
  1         60  
86 1     1   6 use constant ddiffxy_minimum => -2;
  1         2  
  1         40  
87 1     1   5 use constant ddiffxy_maximum => 2;
  1         2  
  1         53  
88 1     1   6 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         2  
  1         54  
89              
90 1     1   6 use constant _UNDOCUMENTED__turn_any_right_at_n => 81;
  1         2  
  1         1159  
91              
92              
93             #------------------------------------------------------------------------------
94              
95             sub new {
96 3     3 1 1053 my $self = shift->SUPER::new(@_);
97              
98 3   50     21 $self->{'offset'} ||= 0;
99 3         7 $self->{'cumul'} = [ 1, 2 ];
100 3         7 $self->{'cumul_x'} = 0;
101 3         6 $self->{'cumul_y'} = 0;
102 3         4 $self->{'cumul_add'} = 0;
103              
104 3         6 return $self;
105             }
106              
107             sub _cumul_extend {
108 4241     4241   6275 my ($self) = @_;
109             ### _cumul_extend(): "length of r=".($#{$self->{'cumul'}})
110              
111 4241         6116 my $cumul = $self->{'cumul'};
112 4241         6108 my $r = $#$cumul;
113 4241         6572 $self->{'cumul_add'} += 4;
114 4241 100       7993 if ($self->{'cumul_x'} == $self->{'cumul_y'}) {
115             ### at: "$self->{'cumul_x'},$self->{'cumul_y'}"
116             ### step across and maybe up
117 2116         3046 $self->{'cumul_x'}++;
118              
119             ### xy hypot: ($self->{'cumul_x'}+.5)**2 + ($self->{'cumul_y'})**2
120             ### r squared: $r*$r
121             ### E: ($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 - ($r+$self->{'offset'})**2
122              
123 2116 100       7270 if (($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 < ($r+$self->{'offset'})**2) {
124             ### midpoint of x,y inside, increment to x,y+1
125 874         1407 $self->{'cumul_y'}++;
126 874         1364 $self->{'cumul_add'} += 4;
127             }
128              
129             } else {
130             ### at: "$self->{'cumul_x'},$self->{'cumul_y'}"
131             ### try y+1 with x or x+1 is: ($self->{'cumul_x'}+.5).",".($self->{'cumul_y'}+1)
132 2125         3472 $self->{'cumul_y'}++;
133              
134             ### xy hypot: ($self->{'cumul_x'}+.5)**2 + ($self->{'cumul_y'})**2
135             ### r squared: $r*$r
136             ### E: ($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 - ($r+$self->{'offset'})**2
137              
138 2125 100       5839 if (($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 < ($r+$self->{'offset'})**2) {
139             ### midpoint inside, increment x too
140 883         1352 $self->{'cumul_x'}++;
141 883         1355 $self->{'cumul_add'} += 4;
142             }
143             }
144             ### to: "$self->{'cumul_x'},$self->{'cumul_y'}"
145             ### cumul extend: scalar(@$cumul).' = '.($cumul->[-1] + $self->{'cumul_add'})
146             ### cumul_add: $self->{'cumul_add'}
147 4241         12000 push @$cumul, $cumul->[-1] + $self->{'cumul_add'};
148             }
149              
150             sub n_to_xy {
151 2117     2117 1 8532 my ($self, $n) = @_;
152             ### PixelRings n_to_xy(): $n
153              
154 2117 100       4653 if ($n < 2) {
155 1 50       5 if ($n < 1) { return; }
  0         0  
156 1         4 return ($n-1, 0);
157             }
158 2116 50       4018 if (is_infinite($n)) {
159 0         0 return ($n,$n);
160             }
161              
162              
163             {
164             # ENHANCE-ME: direction of N+1 from the cumulative lookup
165 2116         3561 my $int = int($n);
  2116         3063  
166 2116 50       4038 if ($n != $int) {
167 0         0 my $frac = $n - $int;
168 0         0 my ($x1,$y1) = $self->n_to_xy($int);
169 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
170 0 0 0     0 if ($y2 == 0 && $x2 > 0) { $x2 -= 1; }
  0         0  
171 0         0 my $dx = $x2-$x1;
172 0         0 my $dy = $y2-$y1;
173 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
174             }
175 2116         3087 $n = $int;
176             }
177              
178             ### search cumul for n: $n
179 2116         3213 my $cumul = $self->{'cumul'};
180 2116         2749 my $r = 1;
181 2116         2753 for (;;) {
182 4499191 50       7102469 if ($r >= @$cumul) {
183 0         0 _cumul_extend ($self);
184             }
185 4499191 100       7058663 if ($cumul->[$r] > $n) {
186 2116         4145 last;
187             }
188 4497075         5345089 $r++;
189             }
190 2116         3537 $r--;
191              
192 2116         3624 $n -= $cumul->[$r];
193 2116         4952 my $len = $cumul->[$r+1] - $cumul->[$r];
194             ### cumul: "$cumul->[$r] to $cumul->[$r+1]"
195             ### $len
196             ### n rem: $n
197 2116         4297 $len /= 4;
198 2116         3751 my $quadrant = $n / $len;
199 2116         3901 $n %= $len;
200             ### len of quadrant: $len
201             ### $quadrant
202             ### n into quadrant: $n
203              
204 2116         2687 my $rev;
205 2116 50       4924 if ($rev = ($n > $len/2)) {
206 0         0 $n = $len - $n;
207             }
208             ### $rev
209             ### $n
210 2116         3405 my $y = $n;
211 2116         11216 my $x = int (sqrt (max (0, ($r+$self->{'offset'})**2 - $y*$y)) + .5);
212 2116 50       4353 if ($rev) {
213 0         0 ($x,$y) = ($y,$x);
214             }
215              
216 2116 50       5285 if ($quadrant & 2) {
217 0         0 $x = -$x;
218 0         0 $y = -$y;
219             }
220 2116 50       3697 if ($quadrant & 1) {
221 0         0 ($x,$y) = (-$y, $x);
222             }
223             ### return: "$x, $y"
224 2116         7326 return ($x, $y);
225             }
226              
227             sub xy_to_n {
228 3000     3000 1 24687 my ($self, $x, $y) = @_;
229             ### PixelRings xy_to_n(): "$x, $y"
230              
231 3000         7167 $x = round_nearest ($x);
232 3000         5972 $y = round_nearest ($y);
233              
234 3000 100 66     6926 if ($x == 0 && $y == 0) {
235 1         2 return 1;
236             }
237              
238 2999         4081 my $r;
239             {
240 2999         3912 my $xa = abs($x);
  2999         4351  
241 2999         4480 my $ya = abs($y);
242 2999 50       5129 if ($xa < $ya) {
243 0         0 ($xa,$ya) = ($ya,$xa);
244             }
245 2999         8796 $r = int (hypot ($xa+.5,$ya));
246             ### r frac: hypot ($xa+.5,$ya)
247             ### $r
248             ### r < inside frac: hypot ($xa-.5,$ya)
249 2999 100       7823 if ($r < hypot ($xa-.5,$ya)) {
250             ### pixel not crossed
251 879         2242 return undef;
252             }
253 2120 50       4529 if ($xa == $ya) {
254             ### and pixel below for diagonal
255             ### r < below frac: $r . " < " . hypot ($xa+.5,$ya-1)
256 2120 100       5953 if ($r < hypot ($xa+.5,$ya-1)) {
257             ### same loop, no sharp corner
258 4         9 return undef;
259             }
260             }
261             }
262 2116 50       5200 if (is_infinite($r)) {
263 0         0 return undef;
264             }
265              
266 2116         4911 my $cumul = $self->{'cumul'};
267 2116         4464 while ($#$cumul <= $r) {
268             ### extend cumul for r: $r
269 4241         7542 _cumul_extend ($self);
270             }
271              
272 2116         3402 my $n = $cumul->[$r];
273 2116         3531 my $len = $cumul->[$r+1] - $n;
274             ### $r
275             ### n base: $n
276             ### $len
277             ### len/4: $len/4
278 2116 50       3848 if ($y < 0) {
279             ### y neg, rotate 180
280 0         0 $y = -$y;
281 0         0 $x = -$x;
282 0         0 $n += $len/2;
283             }
284 2116 50       3900 if ($x < 0) {
285 0         0 $n += $len/4;
286 0         0 ($x,$y) = ($y,-$x);
287             ### neg x, rotate 90
288             ### n base now: $n + $len/4
289             ### transpose: "$x,$y"
290             }
291             ### assert: $x >= 0
292             ### assert: $y >= 0
293 2116 50       3608 if ($y > $x) {
294             ### top octant, reverse: "x=$x len/4=".($len/4)." gives ".($len/4 - $x)
295 0         0 $y = $len/4 - $x;
296             }
297             ### n return: $n + $y
298 2116         4147 return $n + $y;
299             }
300              
301             # not exact
302             sub rect_to_n_range {
303 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
304             ### PixelRings rect_to_n_range(): "$x1,$y1 $x2,$y2"
305              
306             # ENHANCE-ME: use an estimate from rings no bigger than sqrt(2), so can
307             # get a range for big x,y
308              
309 0           $x1 = round_nearest ($x1);
310 0           $y1 = round_nearest ($y1);
311 0           $x2 = round_nearest ($x2);
312 0           $y2 = round_nearest ($y2);
313              
314 0 0 0       my $r_min
315             = ((($x1<0) ^ ($x2<0)) || (($y1<0) ^ ($y2<0))
316             ? 0
317             : max (0,
318             int (hypot (min(abs($x1),abs($x2)), min(abs($y1),abs($y2))))
319             - 1));
320 0           my $r_max = 2 + int (hypot (max(abs($x1),abs($x2)), max(abs($y1),abs($y2))));
321             ### $r_min
322             ### $r_max
323              
324 0 0         if (is_infinite($r_min)) {
325 0           return ($r_min, $r_min);
326             }
327              
328 0           my ($n_max, $r_target);
329 0 0         if (is_infinite($r_max)) {
330 0           $n_max = $r_max; # infinity
331 0           $r_target = $r_min;
332             } else {
333 0           $r_target = $r_max;
334             }
335              
336 0           my $cumul = $self->{'cumul'};
337 0           while ($#$cumul < $r_target) {
338             ### extend cumul for r: $r_target
339 0           _cumul_extend ($self);
340             }
341              
342 0 0         if (! defined $n_max) {
343 0           $n_max = $cumul->[$r_max];
344             }
345 0           return ($cumul->[$r_min], $n_max);
346             }
347              
348             1;
349             __END__