File Coverage

blib/lib/Math/PlanePath/ZOrderCurve.pm
Criterion Covered Total %
statement 92 160 57.5
branch 12 50 24.0
condition 8 13 61.5
subroutine 19 26 73.0
pod 9 9 100.0
total 140 258 54.2


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             # math-image --path=ZOrderCurve,radix=3 --all --output=numbers
20             # math-image --path=ZOrderCurve --values=Fibbinary --text
21             #
22             # increment N+1 changes low 1111 to 10000
23             # X bits change 011 to 000, no carry, decreasing by number of low 1s
24             # Y bits change 011 to 100, plain +1
25             #
26             # cf A105186 replace odd position ternary digits with 0
27             #
28              
29              
30             package Math::PlanePath::ZOrderCurve;
31 10     10   9004 use 5.004;
  10         38  
32 10     10   51 use strict;
  10         30  
  10         348  
33 10     10   61 use List::Util 'max';
  10         18  
  10         955  
34              
35 10     10   65 use vars '$VERSION', '@ISA';
  10         16  
  10         583  
36             $VERSION = 127;
37 10     10   723 use Math::PlanePath;
  10         18  
  10         402  
38             @ISA = ('Math::PlanePath');
39              
40             use Math::PlanePath::Base::Generic
41 10         536 'is_infinite',
42 10     10   58 'round_nearest';
  10         18  
43             use Math::PlanePath::Base::Digits
44 10         629 'parameter_info_array',
45             'round_up_pow',
46             'digit_split_lowtohigh',
47 10     10   535 'digit_join_lowtohigh';
  10         17  
48             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
49              
50             # uncomment this to run the ### lines
51             #use Smart::Comments;
52              
53              
54 10     10   60 use constant n_start => 0;
  10         16  
  10         542  
55 10     10   59 use constant class_x_negative => 0;
  10         17  
  10         460  
56 10     10   56 use constant class_y_negative => 0;
  10         16  
  10         608  
57             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
58              
59 10     10   58 use constant dx_maximum => 1;
  10         20  
  10         452  
60 10     10   65 use constant dy_maximum => 1;
  10         16  
  10         523  
61 10     10   60 use constant absdx_minimum => 1; # X coord always changes
  10         17  
  10         481  
62 10     10   54 use constant dsumxy_maximum => 1; # forward straight only
  10         28  
  10         11643  
63              
64             sub dir_maximum_dxdy {
65 0     0 1 0 my ($self) = @_;
66 0         0 return (1, 1 - $self->{'radix'}); # SE diagonal
67             }
68              
69             sub turn_any_straight {
70 0     0 1 0 my ($self) = @_;
71 0         0 return ($self->{'radix'} != 2); # radix=2 never straight
72             }
73             sub _UNDOCUMENTED__turn_any_left_at_n {
74 0     0   0 my ($self) = @_;
75 0         0 return $self->{'radix'} - 1;
76             }
77             sub _UNDOCUMENTED__turn_any_right_at_n {
78 0     0   0 my ($self) = @_;
79 0         0 return $self->{'radix'};
80             }
81              
82              
83             #------------------------------------------------------------------------------
84              
85             sub new {
86 10     10 1 3345 my $self = shift->SUPER::new(@_);
87              
88 10         114 my $radix = $self->{'radix'};
89 10 100 100     53 if (! defined $radix || $radix <= 2) { $radix = 2; }
  6         14  
90 10         28 $self->{'radix'} = $radix;
91              
92 10         24 return $self;
93             }
94              
95             sub n_to_xy {
96 1292     1292 1 9724 my ($self, $n) = @_;
97             ### ZOrderCurve n_to_xy(): $n
98 1292 50       1988 if ($n < 0) {
99 0         0 return;
100             }
101 1292 50       2326 if (is_infinite($n)) {
102 0         0 return ($n,$n);
103             }
104              
105 1292         3250 my $int = int($n);
106 1292         1625 $n -= $int; # fraction part
107              
108 1292         2132 my $radix = $self->{'radix'};
109 1292         2045 my @ndigits = digit_split_lowtohigh ($int, $radix);
110             ### @ndigits
111 1292 100       2107 unless ($#ndigits & 1) {
112 559         710 push @ndigits, 0; # pad @ndigits to an even number of digits
113             }
114              
115 1292         1569 my @xdigits;
116             my @ydigits;
117 1292         2067 while (@ndigits) {
118 3046         3736 push @xdigits, shift @ndigits; # low to high
119 3046         5080 push @ydigits, shift @ndigits; # low to high
120             }
121             ### @xdigits
122             ### @ydigits
123              
124 1292         1719 my $zero = ($int * 0); # inherit bigint 0
125 1292         2848 my $x = digit_join_lowtohigh (\@xdigits, $radix, $zero);
126 1292         2195 my $y = digit_join_lowtohigh (\@ydigits, $radix, $zero);
127              
128 1292 100       1884 if ($n) {
129             # fraction part
130 1         23 my $dx = 1;
131 1         2 my $dy = $zero;
132 1         3 my $radix_minus_1 = $radix - 1;
133 1         4 foreach my $i (0 .. $#xdigits) { # low to high
134 1 50       4 if ($xdigits[$i] != $radix_minus_1) {
135             ### lowest non-9 is an X digit, so dx=1 dy=0,-R+1,-R^2+1,etc
136 1         223 last;
137             }
138 0         0 $dy = ($dy * $radix) - $radix_minus_1; # 1-$radix**$i
139 0 0       0 if ($ydigits[$i] != $radix_minus_1) {
140             ### lowest non-9 is a Y digit, so dy=1, dx=-R+1,-R^2+1,etc
141 0         0 $dx = $dy;
142 0         0 $dy = 1;
143 0         0 last;
144             }
145             }
146             ### $dx
147             ### $dy
148 1         6 $x = $n*$dx + $x;
149 1         711 $y = $n*$dy + $y;
150             }
151              
152 1292         2984 return ($x, $y);
153             }
154              
155             sub n_to_dxdy {
156 0     0 1 0 my ($self, $n) = @_;
157             ### ZOrderCurve n_to_xy(): $n
158              
159 0 0       0 if ($n < 0) {
160 0         0 return;
161             }
162              
163 0         0 my $int = int($n);
164 0         0 $n -= $int; # fraction part
165              
166 0 0       0 if (is_infinite($int)) {
167 0         0 return ($int,$int);
168             }
169              
170 0         0 my $radix = $self->{'radix'};
171 0         0 my $digit = _divrem_mutate($int,$radix); # lowest digit of N
172 0 0       0 if ($digit < $radix - 2) {
173             # N an integer at lowdigit
174 0         0 return (1, 0);
175             }
176              
177 0         0 my $radix_minus_1 = $radix - 1;
178 0         0 my $scan_for_dx = ($digit == $radix_minus_1);
179 0 0       0 unless ($scan_for_dx) {
180             ### assert: $digit == $radix-2
181 0 0       0 unless ($n) {
182             # N an integer with lowdigit==radix-2, so dx=1,dy=0
183 0         0 return (1, 0);
184             }
185             # scan digits for next_dx,next_dy
186             }
187              
188 0         0 my $power = $radix + ($int*0); # $radix**$i, inherit bigint
189              
190 0         0 for (;;) {
191 0 0       0 if (_divrem_mutate($int,$radix) != $radix_minus_1) {
192             ### lowest non-9 is a Y digit, so dy=1, dx=-R+1,-R^2+1,etc
193 0 0       0 if ($scan_for_dx) {
194             # scanned for dx=1-power,dy=1 have nextdx=1,nextdy=0
195             # frac*(nextdx-dx) + dx = n*(1-(1-power))+(1-power)
196             # = n*(1-1+power))+1-power
197             # = n*power+1-power
198             # = (n-1)*power+1
199             # frac*(nextdy-dy) + dy = n*(0-1) + 1
200             # = 1-n
201 0         0 return (($n-1)*$power + 1,
202             1-$n);
203              
204             } else {
205             # scanned for nextdx=1-power,nextdy=1 have dx=1,dy=0
206             # frac*(nextdx-dx) + dx = n*((1-power)-1)+1
207             # = n*(1-power-1)+1
208             # = n*-power+1
209             # = 1 - n*power
210             # frac*(nextdy-dy) + dy = n*(1-0) + 0
211             # = n
212 0         0 return (1 - $n*$power,
213             $n);
214             }
215             }
216              
217 0 0       0 if (_divrem_mutate($int,$radix) != $radix_minus_1) {
218             ### lowest non-9 is an X digit, so dx=1 dy=0,-R+1,-R^2+1,etc
219 0         0 $power -= 1;
220 0 0       0 if ($scan_for_dx) {
221             # scanned for dx=1,dy=1-power have nextdx=1,nextdy=0
222             # frac*(nextdx-dx) + dx = n*(1-1)+1
223             # = 1
224             # frac*(nextdy-dy) + dy = n*(0-(1-power)) + (1-power)
225             # = n*(-1+power) + 1-power
226             # = -n + n*power + 1 - power
227             # = 1-n + (n-1)*power
228             # = (n-1)*(power-1)
229 0         0 return (1,
230             ($n-1) * $power);
231             } else {
232             # scanned for nextdx=1,nextdy=1-power have dx=1,dy=0
233             # frac*(nextdx-dx) + dx = n*(1-1) + 1
234             # = 1
235             # frac*(nextdy-dy) + dy = n*((1-power) - 0) + 0
236             # = n*(1-power)
237 0         0 return (1,
238             -$n*$power);
239             }
240             }
241              
242 0         0 $power *= $radix;
243             }
244             }
245              
246             sub xy_to_n {
247 2     2 1 3801 my ($self, $x, $y) = @_;
248             ### ZOrderCurve xy_to_n(): "$x, $y"
249              
250 2         13 $x = round_nearest ($x);
251 2         7 $y = round_nearest ($y);
252 2 50 33     12 if ($x < 0 || $y < 0) { return undef; }
  0         0  
253 2 50       351 if (is_infinite($x)) { return $x; }
  0         0  
254 2 50       421 if (is_infinite($y)) { return $y; }
  0         0  
255              
256 2         412 my $radix = $self->{'radix'};
257 2         7 my $zero = ($x * 0 * $y); # inherit bigint 0
258              
259 2         551 my @x = digit_split_lowtohigh($x,$radix);
260 2         9 my @y = digit_split_lowtohigh($y,$radix);
261 2         11 return digit_join_lowtohigh ([ _digit_interleave (\@x, \@y) ],
262             $radix,
263             $zero);
264             }
265              
266             # return list of @$xaref interleaved with @$yaref
267             # ($xaref->[0], $yaref->[0], $xaref->[1], $yaref->[1], ...)
268             #
269             sub _digit_interleave {
270 202     202   272 my ($xaref, $yaref) = @_;
271 202         215 my @ret;
272 202         658 foreach my $i (0 .. max($#$xaref,$#$yaref)) {
273 858   100     1630 push @ret, $xaref->[$i] || 0;
274 858   100     1706 push @ret, $yaref->[$i] || 0;
275             }
276 202         543 return @ret;
277             }
278              
279             # exact
280             sub rect_to_n_range {
281 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
282              
283 0         0 $x1 = round_nearest ($x1);
284 0         0 $y1 = round_nearest ($y1);
285 0         0 $x2 = round_nearest ($x2);
286 0         0 $y2 = round_nearest ($y2);
287              
288 0 0       0 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # x1 smaller
  0         0  
289 0 0       0 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # y1 smaller
  0         0  
290              
291 0 0 0     0 if ($y2 < 0 || $x2 < 0) {
292 0         0 return (1, 0); # rect all negative, no N
293             }
294              
295 0 0       0 if ($x1 < 0) { $x1 *= 0; } # "*=" to preserve bigint x1 or y1
  0         0  
296 0 0       0 if ($y1 < 0) { $y1 *= 0; }
  0         0  
297              
298             # monotonic increasing in X and Y directions, so this is exact
299 0         0 return ($self->xy_to_n ($x1, $y1),
300             $self->xy_to_n ($x2, $y2));
301             }
302              
303             #------------------------------------------------------------------------------
304             # levels
305              
306             # arms=1
307             # level 1 0..0 = 1
308             # level 1 0..3 = 4
309             # level 2 0..15 = 16
310             # 4^k-1
311              
312             # shared by Math::PlanePath::GrayCode and others
313             sub level_to_n_range {
314 5     5 1 1129 my ($self, $level) = @_;
315 5         18 return (0, $self->{'radix'}**(2*$level) - 1);
316             }
317             sub n_to_level {
318 0     0 1   my ($self, $n) = @_;
319 0 0         if ($n < 0) { return undef; }
  0            
320 0           $n = round_nearest($n);
321 0           my ($pow, $exp) = round_up_pow ($n+1, $self->{'radix'}*$self->{'radix'});
322 0           return $exp;
323             }
324              
325             #------------------------------------------------------------------------------
326             1;
327             __END__