File Coverage

blib/lib/Math/PlanePath/ImaginaryHalf.pm
Criterion Covered Total %
statement 106 149 71.1
branch 14 38 36.8
condition 15 28 53.5
subroutine 17 23 73.9
pod 8 8 100.0
total 160 246 65.0


line stmt bran cond sub pod time code
1             # Copyright 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             package Math::PlanePath::ImaginaryHalf;
20 1     1   449 use 5.004;
  1         3  
21 1     1   5 use strict;
  1         8  
  1         22  
22 1     1   4 use Carp 'croak';
  1         2  
  1         52  
23             #use List::Util 'max';
24             *max = \&Math::PlanePath::_max;
25              
26 1     1   6 use vars '$VERSION', '@ISA';
  1         1  
  1         50  
27             $VERSION = 127;
28 1     1   6 use Math::PlanePath;
  1         1  
  1         40  
29             @ISA = ('Math::PlanePath');
30             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
31              
32             use Math::PlanePath::Base::Generic
33 1         44 'is_infinite',
34 1     1   5 'round_nearest';
  1         1  
35             use Math::PlanePath::Base::Digits
36 1         50 'digit_split_lowtohigh',
37 1     1   366 'digit_join_lowtohigh';
  1         2  
38              
39 1     1   428 use Math::PlanePath::ImaginaryBase;
  1         2  
  1         39  
40             *_negaradix_range_digits_lowtohigh
41             = \&Math::PlanePath::ImaginaryBase::_negaradix_range_digits_lowtohigh;
42              
43             # uncomment this to run the ### lines
44             #use Smart::Comments;
45              
46              
47 1     1   5 use constant n_start => 0;
  1         2  
  1         42  
48 1     1   5 use constant class_y_negative => 0;
  1         2  
  1         65  
49             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad12;
50              
51 1         91 use constant parameter_info_array =>
52             [ Math::PlanePath::Base::Digits::parameter_info_radix2(),
53             {
54             name => 'digit_order',
55             share_key => 'digit_order_XYX',
56             display => 'Digit Order',
57             type => 'enum',
58             default => 'XYX',
59             choices => ['XYX',
60             'XXY',
61             'YXX',
62             'XnYX',
63             'XnXY',
64             'YXnX',
65             ],
66             },
67 1     1   5 ];
  1         1  
68              
69             {
70             my %x_negative_at_n = (XYX => 2,
71             XXY => 1,
72             YXX => 2,
73             XnYX => 0,
74             XnXY => 0,
75             YXnX => 1,
76             );
77             sub x_negative_at_n {
78 0     0 1 0 my ($self) = @_;
79 0         0 return $self->{'radix'} ** $x_negative_at_n{$self->{'digit_order'}};
80             }
81             }
82              
83             # ENHANCE-ME: prove dY range
84 1     1   6 use constant dy_maximum => 1;
  1         1  
  1         1176  
85              
86             {
87             my %absdx_minimum = (XYX => 1,
88             XXY => 1,
89             YXX => 0, # dX=0 at N=0
90             XnYX => 2, # dX=-2 at N=0
91             XnXY => 1,
92             YXnX => 0, # dX=0 at N=0
93             );
94             sub absdx_minimum {
95 0     0 1 0 my ($self) = @_;
96 0         0 return $absdx_minimum{$self->{'digit_order'}};
97             }
98             }
99             {
100             my %absdy_minimum = (XYX => 0, # dY=0 at N=0
101             XXY => 0, # dY=0 at N=0
102             YXX => 1,
103             XnYX => 0, # dY=0 at N=0
104             XnXY => 0, # dY=0 at N=0
105             YXnX => 1,
106             );
107             sub absdy_minimum {
108 0     0 1 0 my ($self) = @_;
109 0         0 return $absdy_minimum{$self->{'digit_order'}};
110             }
111             }
112              
113             # was this anything?
114             #
115             # sub dir4_minimum {
116             # my ($self) = @_;
117             # if ($self->{'digit_order'} eq 'zzXYX') {
118             # return Math::NumSeq::PlanePathDelta::_delta_func_Dir4
119             # ($self->{'radix'}-1,-2);
120             # } else {
121             # return 0;
122             # }
123             # }
124              
125             {
126             # radix>2 has a straight somewhere
127             # radix=2 only has straight in XXY, XnXY
128             my %turn_any_straight = (# XYX => 0,
129             XXY => 1,
130             # YXX => 0,
131             XnXY => 1,
132             # XnYX => 0,
133             # YXnX => 0,
134             );
135             sub turn_any_straight {
136 0     0 1 0 my ($self) = @_;
137             return ($self->{'radix'} > 2
138 0   0     0 || $turn_any_straight{$self->{'digit_order'}});
139             }
140             }
141              
142             sub _UNDOCUMENTED__turn_any_left_at_n {
143 0     0   0 my ($self) = @_;
144 0         0 my $digit_order = $self->{'digit_order'};
145 0         0 my $radix = $self->{'radix'};
146 0 0       0 if ($digit_order eq 'XXY') {
147 0         0 return $radix*$radix - 1;
148             }
149 0 0 0     0 if ($digit_order eq 'YXX' || $digit_order eq 'XnYX') {
150 0         0 return $radix;
151             }
152 0 0       0 if ($digit_order eq 'XnXY') {
153 0         0 return $radix*$radix ;
154             }
155 0         0 return $radix - 1;
156             }
157             sub _UNDOCUMENTED__turn_any_right_at_n {
158 0     0   0 my ($self) = @_;
159 0         0 my $digit_order = $self->{'digit_order'};
160 0         0 my $radix = $self->{'radix'};
161 0 0       0 if ($digit_order eq 'XXY') {
162 0         0 return $radix*$radix;
163             }
164 0 0       0 if ($digit_order eq 'XnXY') {
165 0         0 return $radix*$radix - 1;
166             }
167 0 0 0     0 if ($digit_order eq 'YXX' || $digit_order eq 'XnYX') {
168 0         0 return $radix - 1;
169             }
170 0         0 return $radix;
171             }
172              
173              
174             #------------------------------------------------------------------------------
175             my %digit_permutation = (XYX => [0,2,1],
176             YXX => [2,0,1],
177             XXY => [0,1,2],
178              
179             XnYX => [1,2,0],
180             YXnX => [2,1,0],
181             XnXY => [1,0,2],
182             );
183              
184             sub new {
185 8     8 1 1616 my $self = shift->SUPER::new(@_);
186              
187 8         16 my $radix = $self->{'radix'};
188 8 50 33     24 if (! defined $radix || $radix <= 2) { $radix = 2; }
  8         11  
189 8         15 $self->{'radix'} = $radix;
190              
191 8   100     23 my $digit_order = ($self->{'digit_order'} ||= 'XYX');
192 8   33     21 $self->{'digit_permutation'} = $digit_permutation{$digit_order}
193             || croak "Unrecognised digit_order: ",$digit_order;
194              
195 8         13 return $self;
196             }
197              
198             sub n_to_xy {
199 48     48 1 3651 my ($self, $n) = @_;
200             ### ImaginaryHalf n_to_xy(): $n
201              
202 48 50       104 if ($n < 0) { return; }
  0         0  
203 48 50       100 if (is_infinite($n)) { return ($n,$n); }
  0         0  
204              
205             {
206 48         69 my $int = int($n);
  48         65  
207             ### $int
208             ### $n
209 48 50       66 if ($n != $int) {
210 0         0 my ($x1,$y1) = $self->n_to_xy($int);
211 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
212 0         0 my $frac = $n - $int; # inherit possible BigFloat
213 0         0 my $dx = $x2-$x1;
214 0         0 my $dy = $y2-$y1;
215 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
216             }
217 48         64 $n = $int; # BigFloat int() gives BigInt, use that
218             }
219              
220 48         67 my $radix = $self->{'radix'};
221 48         58 my $zero = ($n*0); # inherit bignum 0
222              
223 48         98 my @xydigits = ([],[0],[]);
224 48         78 my $digit_permutation = $digit_permutation{$self->{'digit_order'}};
225 48         102 my @ndigits = digit_split_lowtohigh($n, $radix);
226 48         95 foreach my $i (0 .. $#ndigits) {
227 102         143 my $p = $digit_permutation->[$i%3];
228 102 100       113 push @{$xydigits[$p]}, $ndigits[$i], ($p < 2 ? (0) : ());
  102         248  
229             }
230              
231 48         120 return (digit_join_lowtohigh ($xydigits[0], $radix, $zero)
232             - digit_join_lowtohigh ($xydigits[1], $radix, $zero),
233             digit_join_lowtohigh ($xydigits[2], $radix, $zero));
234             }
235              
236             sub xy_to_n {
237 48     48 1 3297 my ($self, $x, $y) = @_;
238             ### ImaginaryHalf xy_to_n(): "$x, $y"
239              
240 48         101 $y = round_nearest ($y);
241 48 50       94 if (is_infinite($y)) { return $y; }
  0         0  
242 48 50       85 if ($y < 0) { return undef; }
  0         0  
243              
244 48         71 $x = round_nearest ($x);
245 48 50       83 if (is_infinite($x)) { return $x; }
  0         0  
246              
247 48         79 my $zero = ($x * 0 * $y); # inherit bignum 0
248 48         68 my $radix = $self->{'radix'};
249 48         104 my @ydigits = digit_split_lowtohigh($y, $radix);
250 48         82 my $digit_permutation = $digit_permutation{$self->{'digit_order'}};
251              
252 48         65 my @ndigits; # digits low to high
253             my @nd;
254 48   100     116 while ($x || @ydigits) {
255 42         82 $nd[0] = _divrem_mutate ($x, $radix);
256 42         62 $x = -$x;
257 42         64 $nd[1] = _divrem_mutate ($x, $radix);
258 42         53 $x = -$x;
259 42   100     86 $nd[2] = shift @ydigits || 0;
260              
261 42         170 push @ndigits,
262             $nd[$digit_permutation->[0]],
263             $nd[$digit_permutation->[1]],
264             $nd[$digit_permutation->[2]];
265             }
266 48         106 return digit_join_lowtohigh (\@ndigits, $radix, $zero);
267             }
268              
269             # Nlevel=2^level-1
270             # 66666666 55 55 5555 7.[16].7
271             # 66666666 55 55 5555 7.[16].7
272             # 66666666 33 22 4444 7.[16].7
273             # 9 66666666 33 01 4444 7.[16].7
274             # ^ ^ ^ ^ ^ ^ ^
275             # -11 -3 -1 1 2 6 22
276             #
277             # X=1 when level=1
278             # X=1+1=2 when level=4
279             # X=2+4=6 when level=7
280             # X=6+16=22 when level=10
281             #
282             # X=0-2=-2 when level=3
283             # X=-2-8=-10 when level=6
284             # X=-10-32=-42 when level=9
285             #
286             # Y=1 k=0 want level=2
287             # Y=2 k=1 want level=5
288             # Y=4 k=2 want level=8
289             #
290             # X = 1 + 1 + 4 + 16 + 4^k
291             # = 1 + (4^(k+1) - 1) / (4-1)
292             # X*(R2-1) = (R2-1) + R2^(k+1) - 1
293             # X*(R2-1) + 1 - (R2-1) = R2^(k+1)
294             # R2^(k+1) = (X-1)*(R2-1) + 1
295             # k+1 = round down pow (X-1)*(R2-1) + 1
296             # (1-1)*3+1=1 k+1=0 want level=1
297             # (2-1)*3+1=4 k+1=1 want level=4
298             # (6-1)*3+1=16 k+1=2 want level=7
299             # (22-1)*3+1=64 k+1=3 want level=10
300             #
301             # X = 1 + 2 + 8 + 32 + ... 2*4^k
302             # = 1 + 2*(4^(k+1) - 1) / (4-1)
303             # X = 1 + R*(R2^(k+1) - 1) / (R2-1)
304             # R*(R2^(k+1) - 1) / (R2-1) = X-1
305             # R2^(k+1) - 1 = (X-1)*(R2-1)/R
306             # R2^(k+2) - R2 = (X-1)*(R2-1)*R
307             # R2^(k+2) = (X-1)*(R2-1)*R + R2
308             # (1-1)*3*2+4=4 k+2=1 want level=3
309             # (3-1)*3*2+4=16 k+2=2 want level=6
310             # (11-1)*3*2+4=64 k+2=3 want level=9
311              
312             # exact
313             sub rect_to_n_range {
314 96     96 1 10485 my ($self, $x1,$y1, $x2,$y2) = @_;
315             ### ImaginaryBase rect_to_n_range(): "$x1,$y1 $x2,$y2"
316              
317 96         157 my $zero = $x1 * 0 * $x2 * $y1 * $y2;
318              
319 96         203 $y1 = round_nearest($y1);
320 96         177 $y2 = round_nearest($y2);
321 96 50       169 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
322 96 50       170 if ($y2 < 0) {
323             ### rectangle all Y negative, no points ...
324 0         0 return (1, 0);
325             }
326 96 50       186 if (is_infinite($y2)) {
327 0         0 return (0, $y2);
328             }
329 96 50       152 if ($y1 < 0) { $y1 *= 0; } # "*=" to preserve bigint y1
  0         0  
330              
331 96         150 $x1 = round_nearest($x1);
332 96         145 $x2 = round_nearest($x2);
333              
334 96         165 my $radix = $self->{'radix'};
335              
336 96         201 my ($min_xdigits, $max_xdigits)
337             = _negaradix_range_digits_lowtohigh($x1,$x2, $radix);
338 96 50       163 unless (defined $min_xdigits) {
339 0         0 return (0, $max_xdigits); # infinity
340             }
341              
342 96         175 my @min_ydigits = digit_split_lowtohigh ($y1, $radix);
343 96         153 my @max_ydigits = digit_split_lowtohigh ($y2, $radix);
344              
345 96         179 my $digit_permutation = $digit_permutation{$self->{'digit_order'}};
346             my @min_ndigits
347 96         160 = _digit_permutation_interleave ($digit_permutation,
348             $min_xdigits, \@min_ydigits);
349             my @max_ndigits
350 96         169 = _digit_permutation_interleave ($digit_permutation,
351             $max_xdigits, \@max_ydigits);
352              
353 96         203 return (digit_join_lowtohigh (\@min_ndigits, $radix, $zero),
354             digit_join_lowtohigh (\@max_ndigits, $radix, $zero));
355             }
356              
357             sub _digit_permutation_interleave {
358 192     192   290 my ($digit_permutation, $xaref, $yaref) = @_;
359 192         209 my @ret;
360             my @d;
361 192         442 foreach (0 .. max($#$xaref,2*$#$yaref)) {
362 480   100     1034 $d[0] = shift @$xaref || 0;
363 480   100     868 $d[1] = shift @$xaref || 0;
364 480   100     869 $d[2] = shift @$yaref || 0;
365 480         859 push @ret,
366             $d[$digit_permutation->[0]],
367             $d[$digit_permutation->[1]],
368             $d[$digit_permutation->[2]];
369             }
370 192         490 return @ret;
371             }
372              
373             #------------------------------------------------------------------------------
374             # levels
375              
376             *level_to_n_range = \&Math::PlanePath::ImaginaryBase::level_to_n_range;
377             *n_to_level = \&Math::PlanePath::ImaginaryBase::n_to_level;
378              
379             #------------------------------------------------------------------------------
380             1;
381             __END__