File Coverage

blib/lib/Math/PlanePath/ImaginaryBase.pm
Criterion Covered Total %
statement 122 152 80.2
branch 22 32 68.7
condition 6 6 100.0
subroutine 17 24 70.8
pod 10 10 100.0
total 177 224 79.0


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             # math-image --path=ImaginaryBase --lines --scale=10
20             # math-image --path=ImaginaryBase --all --output=numbers_dash --size=80x50
21             #
22             # cf A005351 positives as negabinary index
23             # A005352 negatives as negabinary index
24             # A039724 positives as negabinary index, in binary
25             # A027615 negabinary bit count
26             # = 3 * A072894(n+1) - 2n - 3
27             # A098725 first diffs of A072894
28             # A000695 same value binary and negabinary, being base 4 digits 0,1
29             # A001045 abs(negabinary) of 0b11111 all ones (2^n-(-1)^n)/3
30             # A185269 negabinary primes
31             #
32             # A073785 positives as -3 index
33             # A007608 positives as -4 index
34             # A073786 -5
35             # A073787 -6
36             # A073788 -7
37             # A073789 -8
38             # A073790 -9
39             # A039723 positives as negadecimal index
40             # A051022 same value integer and negadecimal, 0s between digits
41             #
42             # http://mathworld.wolfram.com/Negabinary.html
43             # http://mathworld.wolfram.com/Negadecimal.html
44              
45             package Math::PlanePath::ImaginaryBase;
46 4     4   10289 use 5.004;
  4         20  
47 4     4   22 use strict;
  4         8  
  4         228  
48             #use List::Util 'min','max';
49             *min = \&Math::PlanePath::_min;
50             *max = \&Math::PlanePath::_max;
51              
52 4     4   32 use vars '$VERSION', '@ISA';
  4         17  
  4         251  
53             $VERSION = 129;
54 4     4   789 use Math::PlanePath;
  4         8  
  4         266  
55             @ISA = ('Math::PlanePath');
56             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
57              
58             use Math::PlanePath::Base::Generic
59 4         290 'is_infinite',
60 4     4   26 'round_nearest';
  4         7  
61             use Math::PlanePath::Base::Digits
62 4         262 'parameter_info_array', # radix parameter
63             'round_down_pow',
64             'round_up_pow',
65             'digit_split_lowtohigh',
66 4     4   504 'digit_join_lowtohigh';
  4         8  
67              
68 4     4   1606 use Math::PlanePath::ZOrderCurve;
  4         11  
  4         176  
69             *_digit_interleave = \&Math::PlanePath::ZOrderCurve::_digit_interleave;
70              
71             # uncomment this to run the ### lines
72             #use Smart::Comments;
73              
74              
75 4     4   26 use constant n_start => 0;
  4         8  
  4         222  
76 4     4   24 use constant xy_is_visited => 1;
  4         7  
  4         173  
77 4     4   21 use constant absdx_minimum => 1; # X coord always changes
  4         8  
  4         5581  
78              
79             sub x_negative_at_n {
80 0     0 1 0 my ($self) = @_;
81 0         0 return $self->{'radix'}**2;
82             }
83             sub y_negative_at_n {
84 0     0 1 0 my ($self) = @_;
85 0         0 return $self->{'radix'}**3;
86             }
87              
88             sub dir_maximum_dxdy {
89 0     0 1 0 my ($self) = @_;
90 0         0 return ($self->{'radix'}-1, -2);
91             }
92              
93             sub turn_any_straight {
94 0     0 1 0 my ($self) = @_;
95 0         0 return ($self->{'radix'} != 2); # radix=2 never straight
96             }
97             sub _UNDOCUMENTED__turn_any_left_at_n {
98 0     0   0 my ($self) = @_;
99 0         0 return $self->{'radix'} - 1;
100             }
101             sub _UNDOCUMENTED__turn_any_right_at_n {
102 0     0   0 my ($self) = @_;
103 0         0 return $self->{'radix'};
104             }
105              
106              
107              
108             #------------------------------------------------------------------------------
109             sub new {
110 9     9 1 1260 my $self = shift->SUPER::new(@_);
111              
112 9         31 my $radix = $self->{'radix'};
113 9 100 100     52 if (! defined $radix || $radix <= 2) { $radix = 2; }
  4         7  
114 9         21 $self->{'radix'} = $radix;
115              
116 9         22 return $self;
117             }
118              
119             sub n_to_xy {
120 100     100 1 13750 my ($self, $n) = @_;
121             ### ImaginaryBase n_to_xy(): $n
122              
123 100 50       251 if ($n < 0) { return; }
  0         0  
124 100 50       283 if (is_infinite($n)) { return ($n,$n); }
  0         0  
125              
126             # ENHANCE-ME: lowest non-(r-1) digit determines direction to next, or
127             # something like that
128             {
129 100         185 my $int = int($n);
  100         139  
130             ### $int
131             ### $n
132 100 50       184 if ($n != $int) {
133 0         0 my ($x1,$y1) = $self->n_to_xy($int);
134 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
135 0         0 my $frac = $n - $int; # inherit possible BigFloat
136 0         0 my $dx = $x2-$x1;
137 0         0 my $dy = $y2-$y1;
138 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
139             }
140 100         157 $n = $int; # BigFloat int() gives BigInt, use that
141             }
142              
143 100         184 my $radix = $self->{'radix'};
144 100         150 my $x = 0;
145 100         132 my $y = 0;
146 100         196 my $len = ($n*0)+1; # inherit bignum 1
147              
148 100 50       254 if (my @digits = digit_split_lowtohigh($n, $radix)) {
149 100         172 $radix = -$radix;
150 100         133 for (;;) {
151 296         444 $x += (shift @digits) * $len; # digits low to high
152 296 100       539 @digits || last;
153              
154 231         307 $y += (shift @digits) * $len; # digits low to high
155 231 100       467 @digits || last;
156              
157 196         271 $len *= $radix; # $radix negative negates each time
158             }
159             }
160              
161             ### final: "$x,$y"
162 100         242 return ($x,$y);
163             }
164              
165             # ($x-$digit) and ($y-$digit) are multiples of $radix, but apply int() in
166             # case floating point rounding
167             #
168             sub xy_to_n {
169 1385     1385 1 34069 my ($self, $x, $y) = @_;
170             ### ImaginaryBase xy_to_n(): "$x, $y"
171              
172 1385         2799 $x = round_nearest ($x);
173 1385 50       2910 if (is_infinite($x)) { return ($x); }
  0         0  
174              
175 1385         3097 $y = round_nearest ($y);
176 1385 50       2863 if (is_infinite($y)) { return ($y); }
  0         0  
177              
178 1385         2525 my $radix = $self->{'radix'};
179 1385         2011 my $zero = ($x * 0 * $y); # inherit bignum 0
180 1385         1859 my @n; # digits low to high
181              
182 1385   100     2790 while ($x || $y) {
183             ### at: "x=$x,y=$y n=".join(',',@n)
184              
185 3078         5828 push @n, _divrem_mutate ($x, $radix);
186 3078         4791 $x = -$x;
187 3078         5487 push @n, _divrem_mutate ($y, $radix);
188 3078         7861 $y = -$y;
189             }
190 1385         3099 return digit_join_lowtohigh (\@n,$radix, $zero);
191             }
192              
193             # left xmax = (r-1) + (r^2 -r) + (r^3-r^2) + ... + (r^k - r^(k-1))
194             # = r^(k-1) - 1
195             #
196             # right xmin = - (r + r^3 + ... + r^(2k+1))
197             # = -r * (1 + r^2 + ... + r^2k)
198             # = -r * ((r^2)^(k+1) -1) / (r^2 - 1)
199             #
200              
201             # exact
202             sub rect_to_n_range {
203 104     104 1 7561 my ($self, $x1,$y1, $x2,$y2) = @_;
204             ### ImaginaryBase rect_to_n_range(): "$x1,$y1 $x2,$y2"
205              
206 104         653 $x1 = round_nearest($x1);
207 104         227 $y1 = round_nearest($y1);
208 104         237 $x2 = round_nearest($x2);
209 104         212 $y2 = round_nearest($y2);
210              
211 104         209 my $zero = $x1 * 0 * $y1 * $x2 * $y2;
212 104         2001 my $radix = $self->{'radix'};
213              
214 104         200 my ($min_xdigits, $max_xdigits)
215             = _negaradix_range_digits_lowtohigh($x1,$x2, $radix);
216 104 100       214 unless (defined $min_xdigits) {
217 2         9 return (0, $max_xdigits); # infinity
218             }
219              
220 102         182 my ($min_ydigits, $max_ydigits)
221             = _negaradix_range_digits_lowtohigh($y1,$y2, $radix);
222 102 100       208 unless (defined $min_ydigits) {
223 2         11 return (0, $max_ydigits); # infinity
224             }
225              
226             ### $min_xdigits
227             ### $max_xdigits
228             ### min_x: digit_join_lowtohigh ($min_xdigits, $radix, $zero)
229             ### max_x: digit_join_lowtohigh ($max_xdigits, $radix, $zero)
230             ### $min_ydigits
231             ### $max_ydigits
232             ### min_y: digit_join_lowtohigh ($min_ydigits, $radix, $zero)
233             ### max_y: digit_join_lowtohigh ($max_ydigits, $radix, $zero)
234              
235 100         283 my @min_digits = _digit_interleave ($min_xdigits, $min_ydigits);
236 100         214 my @max_digits = _digit_interleave ($max_xdigits, $max_ydigits);
237              
238             ### final ...
239             ### @min_digits
240             ### @max_digits
241              
242 100         338 return (digit_join_lowtohigh (\@min_digits, $radix, $zero),
243             digit_join_lowtohigh (\@max_digits, $radix, $zero));
244             }
245              
246              
247              
248             # Return arrayrefs ($min_digits, $max_digits) which are the digits making
249             # up the index range for negaradix values $x1 to $x2 inclusive.
250             # The arrays are lowtohigh, so $min_digits->[0] is the least significant digit.
251             #
252             sub _negaradix_range_digits_lowtohigh {
253 302     302   578 my ($x1,$x2, $radix) = @_;
254             ### _negaradix_range_digits(): "$x1,$x2 radix=$radix"
255              
256 302 100       569 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # make x1 <= x2
  26         354  
257              
258 302         684 my $radix_minus_1 = $radix - 1;
259             ### $radix
260             ### $radix_minus_1
261              
262              
263 302         568 my ($len, $level, $min_base) = _negaradix_range_level ($x1,$x2, $radix);
264             ### $len
265             ### $level
266 302 100       2282 if (is_infinite($level)) {
267 4         1399 return (undef, $level);
268             }
269 298         583 my $max_base = $min_base;
270              
271             ### assert: $min_base <= $x1
272             ### assert: $min_base + $len > $x2
273              
274 298         461 my @min_digits; # digits formed high to low, stored low to high
275             my @max_digits;
276 298         595 while (--$level > 0) {
277 445         633 $len /= $radix;
278             ### at: "len=$len reverse"
279              
280             # reversed digits, x1 low end for max, x2 high end for min
281             {
282 445         1060 my $digit = max (0,
283             min ($radix_minus_1,
284             int (($x2 - $min_base) / $len)));
285             ### min base: $min_base
286             ### min diff: $x2-$min_base
287             ### min digit raw: $digit
288             ### min digit reversed: $radix_minus_1 - $digit
289 445         735 $min_base += $digit * $len;
290 445         771 $min_digits[$level] = $radix_minus_1 - $digit;
291             }
292             {
293 445         593 my $digit = max (0,
  445         599  
  445         900  
294             min ($radix_minus_1,
295             int (($x1 - $max_base) / $len)));
296             ### max base: $max_base
297             ### max diff: $x1-$max_base
298             ### max digit raw: $digit
299             ### max digit reversed: $radix_minus_1 - $digit
300 445         679 $max_base += $digit * $len;
301 445         796 $max_digits[$level--] = $radix_minus_1 - $digit;
302             }
303              
304 445         629 $len /= $radix;
305             ### at: "len=$len plain"
306              
307             # plain digits, x1 low end for min, x2 high end for max
308             {
309 445         915 my $digit = max (0,
310             min ($radix_minus_1,
311             int (($x1 - $min_base) / $len)));
312             ### min base: $min_base
313             ### min diff: $x1-$min_base
314             ### min digit: $digit
315 445         685 $min_base += $digit * $len;
316 445         645 $min_digits[$level] = $digit;
317             }
318             {
319 445         614 my $digit = max (0,
  445         585  
  445         981  
320             min ($radix_minus_1,
321             int (($x2 - $max_base) / $len)));
322             ### max base: $max_base
323             ### max diff: $x2-$max_base
324             ### max digit: $digit
325 445         683 $max_base += $digit * $len;
326 445         879 $max_digits[$level] = $digit;
327             }
328             }
329             ### @min_digits
330             ### @max_digits
331 298         756 return (\@min_digits, \@max_digits);
332             }
333              
334             # return ($len,$level,$base)
335             # $level = number of digits in the bigest integer in negaradix $x1..$x2,
336             # rounded up to be $level even
337             # $len = $radix**$level
338             # $base = lowest negaradix reached by indexes from 0 to $len-1
339             #
340             # have $base <= $x1, $x2 < $base+$len
341             # and $level is the smallest even number with that coverage
342             #
343             # negabinary
344             # 0,1,5,21
345             #
346             # negaternary
347             # 1 3 9 27 81 243
348             # 0,2, 20 182
349             # -6 -60 -546
350             #
351             sub _negaradix_range_level {
352 302     302   525 my ($x1,$x2, $radix) = @_;
353             ### _negaradix_range_level(): "$x1,$x2 radix=$radix"
354             ### assert: $x1 <= $x2
355              
356 302         841 my ($len, $level)
357             = round_down_pow (max($radix - $x1*($radix + 1),
358             (($radix+1)*$x2 - 1) * $radix),
359             $radix);
360 302 100       989 if ($level & 1) {
361             ### increase level to even ...
362 106         702 $len *= $radix;
363 106         555 $level += 1;
364             }
365             ### $len
366             ### $level
367              
368             # because level is even r^2k-1 is a multiple of r^2-1 and therefore of r+1
369             ### assert: ($len-1) % ($radix+1) == 0
370              
371 302         1117 return ($len,
372             $level,
373             ((1-$len) / ($radix+1)) * $radix); # base
374             }
375              
376              
377             #------------------------------------------------------------------------------
378             # levels
379              
380             # shared by ImaginaryHalf and CubicBase
381             sub level_to_n_range {
382 8     8 1 605 my ($self, $level) = @_;
383 8         27 return (0, $self->{'radix'}**$level - 1);
384             }
385             sub n_to_level {
386 0     0 1   my ($self, $n) = @_;
387 0 0         if ($n < 0) { return undef; }
  0            
388 0 0         if (is_infinite($n)) { return $n; }
  0            
389 0           $n = round_nearest($n);
390 0           my ($pow, $exp) = round_up_pow ($n+1, $self->{'radix'});
391 0           return $exp;
392             }
393              
394             #------------------------------------------------------------------------------
395             1;
396             __END__