File Coverage

blib/lib/Math/PlanePath/CornerReplicate.pm
Criterion Covered Total %
statement 110 167 65.8
branch 35 68 51.4
condition 6 10 60.0
subroutine 18 20 90.0
pod 4 4 100.0
total 173 269 64.3


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             package Math::PlanePath::CornerReplicate;
20 1     1   9298 use 5.004;
  1         11  
21 1     1   7 use strict;
  1         2  
  1         61  
22             #use List::Util 'max';
23             *max = \&Math::PlanePath::_max;
24              
25 1     1   7 use vars '$VERSION', '@ISA';
  1         8  
  1         69  
26             $VERSION = 129;
27 1     1   689 use Math::PlanePath;
  1         3  
  1         50  
28             @ISA = ('Math::PlanePath');
29             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
30              
31             use Math::PlanePath::Base::Generic
32 1         47 'is_infinite',
33 1     1   7 'round_nearest';
  1         2  
34             use Math::PlanePath::Base::Digits
35 1         78 'round_down_pow',
36             'bit_split_lowtohigh',
37 1     1   475 'digit_split_lowtohigh';
  1         2  
38              
39             # uncomment this to run the ### lines
40             # use Smart::Comments;
41              
42              
43 1     1   7 use constant n_start => 0;
  1         2  
  1         49  
44 1     1   6 use constant class_x_negative => 0;
  1         2  
  1         40  
45 1     1   5 use constant class_y_negative => 0;
  1         2  
  1         82  
46             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
47              
48 1     1   6 use constant dy_maximum => 1; # dY=1,-1,-3,-7,-15,etc only
  1         2  
  1         54  
49 1     1   6 use constant dsumxy_maximum => 1;
  1         2  
  1         46  
50 1     1   5 use constant ddiffxy_minimum => -1;
  1         2  
  1         61  
51 1     1   6 use constant dir_maximum_dxdy => (2,-1); # ESE
  1         2  
  1         53  
52 1     1   6 use constant turn_any_straight => 0; # never straight
  1         2  
  1         1211  
53              
54              
55             #------------------------------------------------------------------------------
56             my @digit_to_x = (0,1,1,0);
57             my @digit_to_y = (0,0,1,1);
58              
59             sub n_to_xy {
60 286     286 1 16223 my ($self, $n) = @_;
61             ### CornerReplicate n_to_xy(): $n
62              
63 286 50       621 if ($n < 0) { return; }
  0         0  
64 286 50       717 if (is_infinite($n)) { return ($n,$n); }
  0         0  
65              
66             {
67 286         470 my $int = int($n);
  286         426  
68             ### $int
69             ### $n
70 286 100       509 if ($n != $int) {
71 60         118 my ($x1,$y1) = $self->n_to_xy($int);
72 60         152 my ($x2,$y2) = $self->n_to_xy($int+1);
73 60         132 my $frac = $n - $int; # inherit possible BigFloat
74 60         89 my $dx = $x2-$x1;
75 60         97 my $dy = $y2-$y1;
76 60         210 return ($frac*$dx + $x1, $frac*$dy + $y1);
77             }
78 226         391 $n = $int; # BigFloat int() gives BigInt, use that
79             }
80              
81 226         360 my $x = my $y = ($n * 0); # inherit bignum 0
82 226         319 my $len = $x + 1; # inherit bignum 1
83              
84 226         492 foreach my $digit (digit_split_lowtohigh($n,4)) {
85             ### at: "$x,$y digit=$digit"
86              
87 957         1342 $x += $digit_to_x[$digit] * $len;
88 957         1243 $y += $digit_to_y[$digit] * $len;
89 957         1316 $len *= 2;
90             }
91              
92             ### final: "$x,$y"
93 226         493 return ($x,$y);
94             }
95              
96             my @digit_to_next_dx = (1, 0, -1, -1);
97             my @digit_to_next_dy = (0, 1, 0, 0);
98              
99             # use Smart::Comments;
100             sub n_to_dxdy {
101 0     0 1 0 my ($self, $n) = @_;
102             ### CornerReplicate n_to_dxdy(): $n
103              
104 0 0       0 if ($n < 0) { return; }
  0         0  
105 0 0       0 if (is_infinite($n)) { return ($n,$n); }
  0         0  
106              
107 0         0 my $zero = $n * 0;
108 0         0 my $int = int($n);
109 0         0 $n -= $int; # fractional part
110              
111 0         0 my $digit = _divrem_mutate($int,4);
112             ### low digit: $digit
113              
114 0 0       0 if ($digit == 0) {
115             # N = "...0" eg. N=0
116             # ^
117             # | this dX=1,dY=0
118             # N---* next dX=0,dY=1
119             # dX = dXthis*(1-frac) + dXnext*frac
120             # = 1*(1-frac) + 0*frac
121             # = 1-frac
122             # dY = dYthis*(1-frac) + dYnext*frac
123             # = 0*(1-frac) + 1*frac
124             # = frac
125 0         0 return (1-$n,$n);
126             }
127              
128 0 0       0 if ($digit == 1) {
129             # N = "...1" eg. N=1
130             # <---*
131             # | this dX=0,dY=1
132             # N next dX=-1,dY=0
133             # dX = dXthis*(1-frac) + dXnext*frac
134             # = 0*(1-frac) + -1*frac
135             # = -frac
136             # dY = dYthis*(1-frac) + dYnext*frac
137             # = 1*(1-frac) + 0*frac
138             # = 1-frac
139 0         0 return (-$n,1-$n);
140             }
141              
142 0         0 my ($dx,$dy);
143 0 0       0 if ($digit == 2) {
144             # N="...2"
145             # *---N this dX=-1, dY=0
146             # \ next dX=power, dY=power
147             # \
148             # power part for next only needed if $n fractional
149 0         0 $dx = -1;
150 0         0 $dy = 0;
151              
152 0 0       0 if ($n) {
153             # N = "[digit]333..3332"
154 0         0 (my $exp, $digit) = _count_low_base4_3s($int);
155              
156 0 0       0 if ($digit == 1) {
157             # N = "1333..3332" so N=6, N=30, N=126, ...
158             # ^
159             # | this dX=-1, dY=0
160             # *---N next dX=0, dY=+1
161             # dX = dXthis*(1-frac) + dXnext*frac
162             # = -1*(1-frac) + 0*frac
163             # = frac-1
164             # dY = dYthis*(1-frac) + dYnext*frac
165             # = 0*(1-frac) + 1*frac
166             # = frac
167 0         0 return ($n-1, $n);
168             }
169              
170 0         0 my $next_dx = (2+$zero) ** ($exp+1);
171 0         0 my $next_dy;
172             ### power: $dx
173              
174 0 0       0 if ($digit) { # $digit == 2
175             # N = "2333..3332" so N=10, N=14, N=62, ...
176             # *---N this dX=-1, dY=0
177             # / next dX=-2^k, dY=-(2^k-1)=1-2^k
178             # /
179 0         0 $next_dx = -$next_dx;
180 0         0 $next_dy = $next_dx+1;
181             } else { # $digit == 0
182             # N = "0333..3332" so N=2, N=14, N=62, ...
183             # *---N this dX=-1, dY=0
184             # \ next dX=+2^k, dY=-(2^k-1)=1-2^k
185             # \
186 0         0 $next_dy = 1-$next_dx;
187             }
188              
189 0         0 my $f1 = 1-$n;
190 0         0 $dx = $f1*$dx + $n*$next_dx;
191 0         0 $dy = $f1*$dy + $n*$next_dy;
192             }
193              
194             } else { # $digit == 3
195 0         0 my ($exp, $digit) = _count_low_base4_3s($int);
196             ### $exp
197             ### $digit
198              
199 0 0       0 if ($digit == 1) {
200             # N = "1333..333" eg. N=31
201             # N+1 = "2000..000" eg. N=32
202             # *--->
203             # | this dX=0, dY=+1
204             # N next dX=+1, dY=0
205             # dX = dXthis*(1-frac) + dXnext*frac
206             # = 0*(1-frac) + 1*frac
207             # = frac
208             # dY = dYthis*(1-frac) + dYnext*frac
209             # = 1*(1-frac) + 0*frac
210             # = 1-frac
211 0         0 return ($n, 1-$n);
212             }
213              
214 0         0 $dx = (2+$zero) ** ($exp+1);
215             ### power: $dx
216 0 0       0 if ($digit) { # $digit == 2
217             # N = "2333..333" so N=11, N=47, N=191
218             # N
219             # / this dX=-2^k, dY=-(2^k-1)=1-2^k
220             # / next dX=1, dY=0
221             # *->
222 0         0 $dx = -$dx;
223 0         0 $dy = $dx+1;
224             } else { # $digit == 0
225             # N = "0333..333" so N=3, N=15, N=63, ...
226             # N
227             # \ this dX=2^k, dY=-(2^k-1)=1-2^k
228             # \ next dX=1, dY=0
229             # *->
230 0         0 $dy = 1-$dx;
231             }
232              
233 0 0       0 if ($n) {
234             # dX*(1-frac) + nextdX*frac
235             # dY*(1-frac) + nextdY*frac
236             # nextdX=1, nextdY=0
237 0         0 my $f1 = 1-$n;
238 0         0 $dx = $f1*$dx + $n;
239 0         0 $dy = $f1*$dy;
240             }
241             }
242             ### final: "$dx,$dy"
243 0         0 return ($dx,$dy);
244             }
245              
246             # Return ($count,$digit) where $count is how many trailing 3s on $n
247             # (possibly 0), and $digit is the next digit above those 3s.
248             sub _count_low_base4_3s {
249 0     0   0 my ($n) = @_;
250 0         0 my $count =0;
251 0         0 for (;;) {
252 0         0 my $digit = _divrem_mutate($n,4);
253 0 0       0 if ($digit != 3) {
254 0         0 return ($count,$digit);
255             }
256 0         0 $count++;
257             }
258             }
259              
260             # my @yx_to_digit = ([0,1],
261             # [3,2]);
262             sub xy_to_n {
263 66     66 1 1909 my ($self, $x, $y) = @_;
264             ### CornerReplicate xy_to_n(): "$x, $y"
265              
266 66         166 $x = round_nearest ($x);
267 66         133 $y = round_nearest ($y);
268 66 50 33     218 if ($x < 0 || $y < 0) {
269 0         0 return undef;
270             }
271 66 50       128 if (is_infinite($x)) { return $x; }
  0         0  
272 66 50       136 if (is_infinite($y)) { return $y; }
  0         0  
273              
274 66         157 my @xbits = bit_split_lowtohigh($x);
275 66         139 my @ybits = bit_split_lowtohigh($y);
276              
277 66         118 my $n = ($x * 0 * $y); # inherit bignum 0
278 66         237 foreach my $i (reverse 0 .. max($#xbits,$#ybits)) { # high to low
279 281         361 $n *= 4;
280 281   100     607 my $ydigit = $ybits[$i] || 0;
281 281   100     732 $n += 2*$ydigit + (($xbits[$i]||0) ^ $ydigit);
282             }
283 66         227 return $n;
284             }
285              
286             # these tables generated by tools/corner-replicate-table.pl
287             my @min_digit = (0,0,1, 0,0,1, 3,2,2);
288             my @max_digit = (0,1,1, 3,3,2, 3,3,2);
289              
290             # exact
291             sub rect_to_n_range {
292 83     83 1 7406 my ($self, $x1,$y1, $x2,$y2) = @_;
293             ### CornerReplicate rect_to_n_range(): "$x1,$y1 $x2,$y2"
294              
295 83         227 $x1 = round_nearest ($x1);
296 83         164 $y1 = round_nearest ($y1);
297 83         162 $x2 = round_nearest ($x2);
298 83         149 $y2 = round_nearest ($y2);
299 83 50       199 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
300 83 50       157 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
301             ### rect: "X = $x1 to $x2, Y = $y1 to $y2"
302              
303 83 50 33     304 if ($x2 < 0 || $y2 < 0) {
304             ### rectangle outside first quadrant ...
305 0         0 return (1, 0);
306             }
307              
308 83         201 my ($len, $level) = round_down_pow (max($x2,$y2), 2);
309             ### $len
310             ### $level
311 83 50       195 if (is_infinite($level)) {
312 0         0 return (0,$level);
313             }
314              
315 83         185 my $n_min = my $n_max
316             = my $x_min = my $y_min
317             = my $x_max = my $y_max
318             = ($x1 * 0 * $x2 * $y1 * $y2); # inherit bignum 0
319              
320 83         186 while ($level-- >= 0) {
321             ### $level
322              
323             {
324 311         469 my $x_cmp = $x_max + $len;
325 311         425 my $y_cmp = $y_max + $len;
326 311 100       716 my $digit = $max_digit[($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
    100          
    100          
    100          
327             + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0)];
328 311         442 $n_max = 4*$n_max + $digit;
329 311 100       538 if ($digit_to_x[$digit]) { $x_max += $len; }
  175         247  
330 311 100       529 if ($digit_to_y[$digit]) { $y_max += $len; }
  145         219  
331              
332             # my $key = ($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
333             # + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0);
334             ### max ...
335             ### len: sprintf "%#X", $len
336             ### $x_cmp
337             ### $y_cmp
338             # ### $key
339             ### $digit
340             ### n_max: sprintf "%#X", $n_max
341             ### $x_max
342             ### $y_max
343             }
344              
345             {
346 311         413 my $x_cmp = $x_min + $len;
  311         420  
  311         419  
347 311         403 my $y_cmp = $y_min + $len;
348 311 100       717 my $digit = $min_digit[($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
    100          
    100          
    100          
349             + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0)];
350 311         449 $n_min = 4*$n_min + $digit;
351 311 100       523 if ($digit_to_x[$digit]) { $x_min += $len; }
  166         214  
352 311 100       528 if ($digit_to_y[$digit]) { $y_min += $len; }
  129         197  
353              
354             # my $key = ($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
355             # + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0);
356             ### min ...
357             ### len: sprintf "%#X", $len
358             ### $x_cmp
359             ### $y_cmp
360             # ### $key
361             ### $digit
362             ### n_min: sprintf "%#X", $n_min
363             ### $x_min
364             ### $y_min
365             }
366 311         548 $len /= 2;
367             }
368              
369 83         210 return ($n_min, $n_max);
370             }
371              
372             #------------------------------------------------------------------------------
373             # levels
374              
375 1     1   567 use Math::PlanePath::HilbertCurve;
  1         2  
  1         63  
376             *level_to_n_range = \&Math::PlanePath::HilbertCurve::level_to_n_range;
377             *n_to_level = \&Math::PlanePath::HilbertCurve::n_to_level;
378              
379             #------------------------------------------------------------------------------
380             1;
381             __END__