File Coverage

blib/lib/Math/PlanePath/PixelRings.pm
Criterion Covered Total %
statement 142 186 76.3
branch 30 54 55.5
condition 3 11 27.2
subroutine 26 27 96.3
pod 4 4 100.0
total 205 282 72.7


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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   9453 use 5.004;
  1         10  
27 1     1   5 use strict;
  1         2  
  1         24  
28 1     1   519 use Math::Libm 'hypot';
  1         7382  
  1         90  
29             #use List::Util 'min','max';
30             *min = \&Math::PlanePath::_min;
31             *max = \&Math::PlanePath::_max;
32              
33 1     1   7 use vars '$VERSION', '@ISA';
  1         2  
  1         71  
34             $VERSION = 129;
35 1     1   762 use Math::PlanePath;
  1         3  
  1         44  
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   6 use constant n_frac_discontinuity => 0;
  1         2  
  1         50  
63              
64 1     1   5 use constant x_negative_at_n => 4;
  1         2  
  1         41  
65 1     1   6 use constant y_negative_at_n => 5;
  1         1  
  1         41  
66 1     1   17 use constant dx_minimum => -1;
  1         2  
  1         66  
67 1     1   9 use constant dx_maximum => 2; # jump N=5 to N=6
  1         1  
  1         49  
68 1     1   6 use constant dy_minimum => -1;
  1         1  
  1         52  
69 1     1   7 use constant dy_maximum => 1;
  1         2  
  1         66  
70              
71             # eight plus ENE
72 1     1   7 use constant 1.02;
  1         13  
  1         55  
73 1         69 use constant _UNDOCUMENTED__dxdy_list => (1,0, # E N=1
74             2,1, # ENE N=5 <-- extra
75             1,1, # NE N=16
76             0,1, # N N=6
77             -1,1, # NW N=2
78             -1,0, # W N=8
79             -1,-1, # SW N=3
80             0,-1, # S N=11
81             1,-1, # SE N=4
82 1     1   6 );
  1         2  
83 1     1   6 use constant _UNDOCUMENTED__dxdy_list_at_n => 16;
  1         10  
  1         60  
84              
85 1     1   6 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         42  
86 1     1   5 use constant dsumxy_maximum => 3; # dx=2,dy=1 at jump N=5 to N=6
  1         2  
  1         57  
87 1     1   6 use constant ddiffxy_minimum => -2;
  1         2  
  1         59  
88 1     1   6 use constant ddiffxy_maximum => 2;
  1         2  
  1         45  
89 1     1   5 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         2  
  1         55  
90              
91 1     1   6 use constant _UNDOCUMENTED__turn_any_right_at_n => 81;
  1         2  
  1         1224  
92              
93              
94             #------------------------------------------------------------------------------
95              
96             sub new {
97 3     3 1 1139 my $self = shift->SUPER::new(@_);
98              
99 3   50     22 $self->{'offset'} ||= 0;
100 3         7 $self->{'cumul'} = [ 1, 2 ];
101 3         6 $self->{'cumul_x'} = 0;
102 3         7 $self->{'cumul_y'} = 0;
103 3         5 $self->{'cumul_add'} = 0;
104              
105 3         8 return $self;
106             }
107              
108             sub _cumul_extend {
109 4241     4241   7206 my ($self) = @_;
110             ### _cumul_extend(): "length of r=".($#{$self->{'cumul'}})
111              
112 4241         6480 my $cumul = $self->{'cumul'};
113 4241         5748 my $r = $#$cumul;
114 4241         6064 $self->{'cumul_add'} += 4;
115 4241 100       7817 if ($self->{'cumul_x'} == $self->{'cumul_y'}) {
116             ### at: "$self->{'cumul_x'},$self->{'cumul_y'}"
117             ### step across and maybe up
118 2116         3166 $self->{'cumul_x'}++;
119              
120             ### xy hypot: ($self->{'cumul_x'}+.5)**2 + ($self->{'cumul_y'})**2
121             ### r squared: $r*$r
122             ### E: ($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 - ($r+$self->{'offset'})**2
123              
124 2116 100       7175 if (($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 < ($r+$self->{'offset'})**2) {
125             ### midpoint of x,y inside, increment to x,y+1
126 874         1372 $self->{'cumul_y'}++;
127 874         1249 $self->{'cumul_add'} += 4;
128             }
129              
130             } else {
131             ### at: "$self->{'cumul_x'},$self->{'cumul_y'}"
132             ### try y+1 with x or x+1 is: ($self->{'cumul_x'}+.5).",".($self->{'cumul_y'}+1)
133 2125         3118 $self->{'cumul_y'}++;
134              
135             ### xy hypot: ($self->{'cumul_x'}+.5)**2 + ($self->{'cumul_y'})**2
136             ### r squared: $r*$r
137             ### E: ($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 - ($r+$self->{'offset'})**2
138              
139 2125 100       5881 if (($self->{'cumul_x'}+.5)**2 + $self->{'cumul_y'}**2 < ($r+$self->{'offset'})**2) {
140             ### midpoint inside, increment x too
141 883         1423 $self->{'cumul_x'}++;
142 883         1333 $self->{'cumul_add'} += 4;
143             }
144             }
145             ### to: "$self->{'cumul_x'},$self->{'cumul_y'}"
146             ### cumul extend: scalar(@$cumul).' = '.($cumul->[-1] + $self->{'cumul_add'})
147             ### cumul_add: $self->{'cumul_add'}
148 4241         11700 push @$cumul, $cumul->[-1] + $self->{'cumul_add'};
149             }
150              
151             sub n_to_xy {
152 2117     2117 1 7947 my ($self, $n) = @_;
153             ### PixelRings n_to_xy(): $n
154              
155 2117 100       3822 if ($n < 2) {
156 1 50       16 if ($n < 1) { return; }
  0         0  
157 1         7 return ($n-1, 0);
158             }
159 2116 50       3905 if (is_infinite($n)) {
160 0         0 return ($n,$n);
161             }
162              
163              
164             {
165             # ENHANCE-ME: direction of N+1 from the cumulative lookup
166 2116         3573 my $int = int($n);
  2116         3143  
167 2116 50       3762 if ($n != $int) {
168 0         0 my $frac = $n - $int;
169 0         0 my ($x1,$y1) = $self->n_to_xy($int);
170 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
171 0 0 0     0 if ($y2 == 0 && $x2 > 0) { $x2 -= 1; }
  0         0  
172 0         0 my $dx = $x2-$x1;
173 0         0 my $dy = $y2-$y1;
174 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
175             }
176 2116         3646 $n = $int;
177             }
178              
179             ### search cumul for n: $n
180 2116         3268 my $cumul = $self->{'cumul'};
181 2116         2798 my $r = 1;
182 2116         2704 for (;;) {
183 4499191 50       7038808 if ($r >= @$cumul) {
184 0         0 _cumul_extend ($self);
185             }
186 4499191 100       7143303 if ($cumul->[$r] > $n) {
187 2116         3932 last;
188             }
189 4497075         5440934 $r++;
190             }
191 2116         2920 $r--;
192              
193 2116         3806 $n -= $cumul->[$r];
194 2116         5091 my $len = $cumul->[$r+1] - $cumul->[$r];
195             ### cumul: "$cumul->[$r] to $cumul->[$r+1]"
196             ### $len
197             ### n rem: $n
198 2116         3999 $len /= 4;
199 2116         3892 my $quadrant = $n / $len;
200 2116         3232 $n %= $len;
201             ### len of quadrant: $len
202             ### $quadrant
203             ### n into quadrant: $n
204              
205 2116         3031 my $rev;
206 2116 50       4907 if ($rev = ($n > $len/2)) {
207 0         0 $n = $len - $n;
208             }
209             ### $rev
210             ### $n
211 2116         3366 my $y = $n;
212 2116         10380 my $x = int (sqrt (max (0, ($r+$self->{'offset'})**2 - $y*$y)) + .5);
213 2116 50       4609 if ($rev) {
214 0         0 ($x,$y) = ($y,$x);
215             }
216              
217 2116 50       4582 if ($quadrant & 2) {
218 0         0 $x = -$x;
219 0         0 $y = -$y;
220             }
221 2116 50       3769 if ($quadrant & 1) {
222 0         0 ($x,$y) = (-$y, $x);
223             }
224             ### return: "$x, $y"
225 2116         7195 return ($x, $y);
226             }
227              
228             sub xy_to_n {
229 3000     3000 1 21908 my ($self, $x, $y) = @_;
230             ### PixelRings xy_to_n(): "$x, $y"
231              
232 3000         7019 $x = round_nearest ($x);
233 3000         6078 $y = round_nearest ($y);
234              
235 3000 100 66     6520 if ($x == 0 && $y == 0) {
236 1         3 return 1;
237             }
238              
239 2999         4260 my $r;
240             {
241 2999         4206 my $xa = abs($x);
  2999         4174  
242 2999         4084 my $ya = abs($y);
243 2999 50       4960 if ($xa < $ya) {
244 0         0 ($xa,$ya) = ($ya,$xa);
245             }
246 2999         8774 $r = int (hypot ($xa+.5,$ya));
247             ### r frac: hypot ($xa+.5,$ya)
248             ### $r
249             ### r < inside frac: hypot ($xa-.5,$ya)
250 2999 100       7542 if ($r < hypot ($xa-.5,$ya)) {
251             ### pixel not crossed
252 879         2558 return undef;
253             }
254 2120 50       4366 if ($xa == $ya) {
255             ### and pixel below for diagonal
256             ### r < below frac: $r . " < " . hypot ($xa+.5,$ya-1)
257 2120 100       5774 if ($r < hypot ($xa+.5,$ya-1)) {
258             ### same loop, no sharp corner
259 4         12 return undef;
260             }
261             }
262             }
263 2116 50       5159 if (is_infinite($r)) {
264 0         0 return undef;
265             }
266              
267 2116         5026 my $cumul = $self->{'cumul'};
268 2116         4750 while ($#$cumul <= $r) {
269             ### extend cumul for r: $r
270 4241         7339 _cumul_extend ($self);
271             }
272              
273 2116         3531 my $n = $cumul->[$r];
274 2116         4210 my $len = $cumul->[$r+1] - $n;
275             ### $r
276             ### n base: $n
277             ### $len
278             ### len/4: $len/4
279 2116 50       3975 if ($y < 0) {
280             ### y neg, rotate 180
281 0         0 $y = -$y;
282 0         0 $x = -$x;
283 0         0 $n += $len/2;
284             }
285 2116 50       3678 if ($x < 0) {
286 0         0 $n += $len/4;
287 0         0 ($x,$y) = ($y,-$x);
288             ### neg x, rotate 90
289             ### n base now: $n + $len/4
290             ### transpose: "$x,$y"
291             }
292             ### assert: $x >= 0
293             ### assert: $y >= 0
294 2116 50       3594 if ($y > $x) {
295             ### top octant, reverse: "x=$x len/4=".($len/4)." gives ".($len/4 - $x)
296 0         0 $y = $len/4 - $x;
297             }
298             ### n return: $n + $y
299 2116         4527 return $n + $y;
300             }
301              
302             # not exact
303             sub rect_to_n_range {
304 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
305             ### PixelRings rect_to_n_range(): "$x1,$y1 $x2,$y2"
306              
307             # ENHANCE-ME: use an estimate from rings no bigger than sqrt(2), so can
308             # get a range for big x,y
309              
310 0           $x1 = round_nearest ($x1);
311 0           $y1 = round_nearest ($y1);
312 0           $x2 = round_nearest ($x2);
313 0           $y2 = round_nearest ($y2);
314              
315 0 0 0       my $r_min
316             = ((($x1<0) ^ ($x2<0)) || (($y1<0) ^ ($y2<0))
317             ? 0
318             : max (0,
319             int (hypot (min(abs($x1),abs($x2)), min(abs($y1),abs($y2))))
320             - 1));
321 0           my $r_max = 2 + int (hypot (max(abs($x1),abs($x2)), max(abs($y1),abs($y2))));
322             ### $r_min
323             ### $r_max
324              
325 0 0         if (is_infinite($r_min)) {
326 0           return ($r_min, $r_min);
327             }
328              
329 0           my ($n_max, $r_target);
330 0 0         if (is_infinite($r_max)) {
331 0           $n_max = $r_max; # infinity
332 0           $r_target = $r_min;
333             } else {
334 0           $r_target = $r_max;
335             }
336              
337 0           my $cumul = $self->{'cumul'};
338 0           while ($#$cumul < $r_target) {
339             ### extend cumul for r: $r_target
340 0           _cumul_extend ($self);
341             }
342              
343 0 0         if (! defined $n_max) {
344 0           $n_max = $cumul->[$r_max];
345             }
346 0           return ($cumul->[$r_min], $n_max);
347             }
348              
349             1;
350             __END__