File Coverage

blib/lib/Math/PlanePath/AlternatePaper.pm
Criterion Covered Total %
statement 193 290 66.5
branch 71 128 55.4
condition 59 116 50.8
subroutine 21 35 60.0
pod 12 12 100.0
total 356 581 61.2


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 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: Explanation for this bit ...
20             # 'arms=4' =>
21             # { dSum => 'A020985', # GRS
22             # # OEIS-Other: A020985 planepath=AlternatePaper,arms=4 delta_type=dSum
23             # },
24              
25              
26             package Math::PlanePath::AlternatePaper;
27 2     2   10044 use 5.004;
  2         8  
28 2     2   10 use strict;
  2         3  
  2         77  
29 2     2   14 use List::Util 'min'; # 'max'
  2         2  
  2         226  
30             *max = \&Math::PlanePath::_max;
31              
32 2     2   13 use vars '$VERSION', '@ISA';
  2         4  
  2         168  
33             $VERSION = 129;
34 2     2   770 use Math::PlanePath;
  2         4  
  2         50  
35 2     2   437 use Math::PlanePath::Base::NSEW;
  2         3  
  2         81  
36             @ISA = ('Math::PlanePath::Base::NSEW',
37             'Math::PlanePath');
38              
39             use Math::PlanePath::Base::Generic
40 2         108 'is_infinite',
41 2     2   14 'round_nearest';
  2         2  
42             use Math::PlanePath::Base::Digits
43 2         233 'round_down_pow',
44             'digit_split_lowtohigh',
45             'digit_join_lowtohigh',
46 2     2   505 'bit_split_lowtohigh';
  2         4  
47             *_divrem = \&Math::PlanePath::_divrem;
48             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
49              
50             # uncomment this to run the ### lines
51             # use Smart::Comments;
52              
53              
54 2         124 use constant parameter_info_array => [ { name => 'arms',
55             share_key => 'arms_8',
56             display => 'Arms',
57             type => 'integer',
58             minimum => 1,
59             maximum => 8,
60             default => 1,
61             width => 1,
62             description => 'Arms',
63 2     2   15 } ];
  2         4  
64              
65 2     2   12 use constant n_start => 0;
  2         4  
  2         558  
66             sub x_negative {
67 6     6 1 107 my ($self) = @_;
68 6         17 return ($self->{'arms'} >= 3);
69             }
70             sub y_negative {
71 6     6 1 364 my ($self) = @_;
72 6         20 return ($self->{'arms'} >= 5);
73             }
74             {
75             my @x_negative_at_n = (undef,
76             undef,undef,8,7,
77             4,4,4,4);
78             sub x_negative_at_n {
79 0     0 1 0 my ($self) = @_;
80 0         0 return $x_negative_at_n[$self->{'arms'}];
81             }
82             }
83             {
84             my @y_negative_at_n = (undef,
85             undef,undef,undef,undef,
86             44,23,13,14);
87             sub y_negative_at_n {
88 0     0 1 0 my ($self) = @_;
89 0         0 return $y_negative_at_n[$self->{'arms'}];
90             }
91             }
92              
93             sub sumxy_minimum {
94 0     0 1 0 my ($self) = @_;
95 0 0       0 return ($self->arms_count <= 3
96             ? 0 # 1,2,3 arms above X=-Y diagonal
97             : undef);
98             }
99             sub diffxy_minimum {
100 0     0 1 0 my ($self) = @_;
101 0 0       0 return ($self->arms_count == 1
102             ? 0 # 1 arms right of X=Y diagonal
103             : undef);
104             }
105              
106 2     2   15 use constant turn_any_straight => 0; # never straight
  2         3  
  2         3517  
107              
108              
109             #------------------------------------------------------------------------------
110              
111             sub new {
112 37     37 1 6402 my $self = shift->SUPER::new(@_);
113 37   100     335 $self->{'arms'} = max(1, min(8, $self->{'arms'} || 1));
114 37         93 return $self;
115             }
116              
117             {
118             # <------
119             # state=0 /| +----+----+
120             # (dir=0) / | |\ 1||<--/
121             # /2 | |^\ || 0/
122             # /-->| || \v| /
123             # +----+ ||3 \|/
124             # /|\ 3|| +----+
125             # / |^\ || |<--/ state=4
126             # / 0|| \v| | 2/ (dir=2)
127             # /-->||1 \| | /
128             # +----+----+ |/
129             # -------->
130             #
131             # |\ state=8 +----+----+ state=12
132             # ^ |^\ (dir=1) \ 1||<--/| | (dir=3)
133             # | || \ \ || 0/ | |
134             # | ||3 \ \v| /2 | |
135             # | +----+ \|/-->| |
136             # | |<--/|\ +----+ |
137             # | | 2/ |^\ \ 3|| |
138             # | | /0 || \ \ || |
139             # | |/-->||1 \ \v| v
140             # +----+----+ \|
141              
142             my @next_state = (0, 8, 0, 12, # forward
143             4, 12, 4, 8, # forward NW
144             0, 8, 4, 8, # reverse
145             4, 12, 0, 12, # reverse NE
146             );
147             my @digit_to_x = (0,1,1,1,
148             1,0,0,0,
149             0,1,0,0,
150             1,0,1,1,
151             );
152             my @digit_to_y = (0,0,1,0,
153             1,1,0,1,
154             0,0,0,1,
155             1,1,1,0,
156             );
157              
158             # state_to_dx[S] == state_to_x[S+3] - state_to_x[S+0]
159             my @state_to_dx = (1, -1, 0, 0);
160             my @state_to_dy = (0, 0, 1, -1);
161              
162             sub n_to_xy {
163 7847     7847 1 252779 my ($self, $n) = @_;
164             ### AlternatePaper n_to_xy(): $n
165              
166 7847 50       15428 if ($n < 0) { return; }
  0         0  
167 7847 50       15546 if (is_infinite($n)) { return ($n, $n); }
  0         0  
168              
169 7847         14588 my $int = int($n); # integer part
170 7847         11811 $n -= $int; # fraction part
171             ### $int
172             ### $n
173              
174 7847         11019 my $zero = ($int * 0); # inherit bignum 0
175 7847         19281 my $arm = _divrem_mutate ($int, $self->{'arms'});
176              
177             ### $arm
178             ### $int
179              
180 7847         16584 my @digits = digit_split_lowtohigh($int,4);
181 7847         11173 my $state = 0;
182 7847         11090 my (@xbits,@ybits); # bits low to high (like @digits)
183              
184 7847         14671 foreach my $i (reverse 0 .. $#digits) { # high to low
185 19082         26605 $state += $digits[$i];
186 19082         27147 $xbits[$i] = $digit_to_x[$state];
187 19082         26613 $ybits[$i] = $digit_to_y[$state];
188 19082         28304 $state = $next_state[$state];
189             }
190 7847         17873 my $x = digit_join_lowtohigh(\@xbits,2,$zero);
191 7847         15480 my $y = digit_join_lowtohigh(\@ybits,2,$zero);
192              
193             # X+1,Y+1 for final state=4 or state=12
194 7847         11947 $x += $digit_to_x[$state];
195 7847         11011 $y += $digit_to_y[$state];
196              
197             ### final: "xy=$x,$y state=$state"
198              
199             # apply possible fraction part of $n in direction of $state
200 7847         12474 $x = $n * $state_to_dx[$state >>= 2] + $x;
201 7847         10868 $y = $n * $state_to_dy[$state] + $y;
202              
203             # rotate,transpose for arm number
204 7847 100       14890 if ($arm & 1) {
205 3366         5982 ($x,$y) = ($y,$x); # transpose
206             }
207 7847 100       13562 if ($arm & 2) {
208 2886         5076 ($x,$y) = (-$y,$x+1); # rotate +90 and shift origin to X=0,Y=1
209             }
210 7847 100       13544 if ($arm & 4) {
211 2023         2734 $x = -1 - $x; # rotate +180 and shift origin to X=-1,Y=1
212 2023         2636 $y = 1 - $y;
213             }
214              
215             ### rotated return: "$x,$y"
216 7847         19134 return ($x,$y);
217             }
218             }
219              
220             # 8
221             #
222             # 42 43 7
223             #
224             # 40 41/45 44 6
225             #
226             # 34 35/39 38/46 47 5
227             #
228             # 32-33/53-36/52-37/49---48 4
229             # | \
230             # 10 11/31 30/54 51/55 50/58 59 3
231             # | \
232             # 8 9/13 12/28 25/29 24/56 57/61 60 2
233             # | \
234             # 2 3/7 6/14 15/27 18/26 19/23 22/62 63 1
235             # | \
236             # 0 1 4 5 16 17 20 21 ==64 0
237             #
238             # 0 1 2 3 4 5 6 7 8
239              
240             sub xy_to_n {
241 121     121 1 8387 return scalar((shift->xy_to_n_list(@_))[0]);
242             }
243             sub xy_to_n_list {
244 159     159 1 5252 my ($self, $x, $y) = @_;
245             ### AlternatePaper xy_to_n(): "$x, $y"
246              
247 159         400 $x = round_nearest($x);
248 159         317 $y = round_nearest($y);
249 159 50       329 if (is_infinite($x)) { return $x; }
  0         0  
250 159 50       340 if (is_infinite($y)) { return $y; }
  0         0  
251              
252 159         331 my $arms = $self->{'arms'};
253 159         234 my $arm = 0;
254 159         216 my @ret;
255 159         320 foreach (1 .. 4) {
256 231         441 push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y);
  181         400  
257 231 100       506 last if ++$arm >= $arms;
258              
259 113         226 ($x,$y) = ($y,$x); # transpose
260 113         213 push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y);
  41         87  
261 113 100       247 last if ++$arm >= $arms;
262              
263             # X,Y -> Y,X
264             # -> Y,X-1 # Y-1 shift
265             # -> X-1,-Y # rot -90
266             # ie. mirror across X axis and shift
267 72         146 ($x,$y) = ($x-1,-$y);
268             }
269 159         501 return sort {$a<=>$b} @ret;
  86         294  
270             }
271              
272             sub _xy_to_n_list__onearm {
273 344     344   561 my ($self, $x, $y) = @_;
274             ### _xy_to_n_list__onearm(): "$x,$y"
275              
276 344 100 100     1117 if ($y < 0 || $y > $x || $x < 0) {
      66        
277             ### outside first octant ...
278 182         296 return;
279             }
280              
281 162         389 my ($len,$level) = round_down_pow($x, 2);
282             ### $len
283             ### $level
284 162 50       370 if (is_infinite($level)) {
285 0         0 return;
286             }
287              
288 162         325 my $n = my $big_n = $x * 0 * $y; # inherit bignum 0
289 162         215 my $rev = 0;
290              
291 162         225 my $big_x = $x;
292 162         226 my $big_y = $y;
293 162         244 my $big_rev = 0;
294              
295 162         312 while ($level-- >= 0) {
296             ### at: "$x,$y len=$len n=$n"
297              
298             # the smaller N
299             {
300 447         600 $n *= 4;
301 447 100       691 if ($rev) {
302 135 100       256 if ($x+$y < 2*$len) {
303             ### rev 0 or 1 ...
304 51 100       83 if ($x < $len) {
305             } else {
306             ### rev 1 ...
307 24         42 $rev = 0;
308 24         34 $n -= 2;
309 24         43 ($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90
310             }
311              
312             } else {
313             ### rev 2 or 3 ...
314 84 100 66     268 if ($y > $len || ($x==$len && $y==$len)) {
      100        
315             ### rev 2 ...
316 35         55 $n -= 2;
317 35         46 $x -= $len;
318 35         48 $y -= $len;
319             } else {
320             ### rev 3 ...
321 49         86 $n -= 4;
322 49         67 $rev = 0;
323 49         97 ($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90
324             }
325             }
326             } else {
327 312 100 100     1338 if ($x+$y <= 2*$len
      100        
      66        
      100        
328             && !($x==$len && $y==$len)
329             && !($x==2*$len && $y==0)) {
330             ### 0 or 1 ...
331 180 100       342 if ($x <= $len) {
332             } else {
333             ### 1 ...
334 57         90 $n += 2;
335 57         83 $rev = 1;
336 57         122 ($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90
337             }
338              
339             } else {
340             ### 2 or 3 ...
341 132 100 100     447 if ($y >= $len && !($x==2*$len && $y==$len)) {
      100        
342 75         109 $n += 2;
343 75         111 $x -= $len;
344 75         102 $y -= $len;
345             } else {
346 57         86 $n += 4;
347 57         80 $rev = 1;
348 57         105 ($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90
349             }
350             }
351             }
352             }
353              
354             # the bigger N
355             {
356 447         563 $big_n *= 4;
  447         533  
  447         595  
357 447 100       694 if ($big_rev) {
358 169 100 100     667 if ($big_x+$big_y <= 2*$len
      100        
      66        
      100        
359             && !($big_x==$len && $big_y==$len)
360             && !($big_x==2*$len && $big_y==0)) {
361             ### rev 0 or 1 ...
362 77 100       130 if ($big_x <= $len) {
363             } else {
364             ### rev 1 ...
365 30         53 $big_rev = 0;
366 30         39 $big_n -= 2;
367 30         57 ($big_x,$big_y) = ($len-$big_y, $big_x-$len); # x-len,y-len then rotate +90
368             }
369              
370             } else {
371             ### rev 2 or 3 ...
372 92 100 100     277 if ($big_y >= $len && !($big_x==2*$len && $big_y==$len)) {
      100        
373             ### rev 2 ...
374 37         55 $big_n -= 2;
375 37         52 $big_x -= $len;
376 37         58 $big_y -= $len;
377             } else {
378             ### rev 3 ...
379 55         89 $big_n -= 4;
380 55         69 $big_rev = 0;
381 55         98 ($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90
382             }
383             }
384             } else {
385 278 100       485 if ($big_x+$big_y < 2*$len) {
386             ### 0 or 1 ...
387 177 100       284 if ($big_x < $len) {
388             } else {
389             ### 1 ...
390 108         143 $big_n += 2;
391 108         143 $big_rev = 1;
392 108         205 ($big_x,$big_y) = ($len-$big_y, $big_x-$len); # x-len,y-len then rotate +90
393             }
394              
395             } else {
396             ### 2 or 3 ...
397 101 100 66     330 if ($big_y > $len || ($big_x==$len && $big_y==$len)) {
      100        
398 60         85 $big_n += 2;
399 60         76 $big_x -= $len;
400 60         81 $big_y -= $len;
401             } else {
402 41         60 $big_n += 4;
403 41         51 $big_rev = 1;
404 41         77 ($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90
405             }
406             }
407             }
408             }
409 447         858 $len /= 2;
410             }
411              
412 162 100       282 if ($x) {
413 66 100       122 $n += ($rev ? -1 : 1);
414             }
415 162 100       280 if ($big_x) {
416 66 100       108 $big_n += ($big_rev ? -1 : 1);
417             }
418              
419             ### final: "$x,$y n=$n rev=$rev"
420             ### final: "$x,$y big_n=$n big_rev=$rev"
421              
422 162 100       411 return ($n,
423             ($n == $big_n ? () : ($big_n)));
424             }
425              
426              
427             # not exact
428             sub rect_to_n_range {
429 40     40 1 3466 my ($self, $x1,$y1, $x2,$y2) = @_;
430             ### AlternatePaper rect_to_n_range(): "$x1,$y1 $x2,$y2"
431              
432 40         105 $x1 = round_nearest($x1);
433 40         82 $x2 = round_nearest($x2);
434 40         78 $y1 = round_nearest($y1);
435 40         74 $y2 = round_nearest($y2);
436              
437 40 50       83 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
438 40 50       83 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
439              
440             ### rounded: "$x1,$y1 $x2,$y2"
441              
442 40         82 my $arms = $self->{'arms'};
443 40 50 66     260 if (($arms == 1 && $y1 > $x2) # x2,y1 bottom right corner
      66        
      33        
      66        
      33        
444             || ($arms <= 2 && $x2 < 0)
445             || ($arms <= 4 && $y2 < 0)) {
446             ### outside ...
447 0         0 return (1,0);
448             }
449              
450             # arm start 0,1 at X=0,Y=0
451             # 2,3 at X=0,Y=1
452             # 4,5 at X=-1,Y=1
453             # 6,7 at X=-1,Y=1
454             # arms>=6 is arm=5 starting at Y=+1, so 1-$y1
455             # arms>=8 starts at X=-1 so extra +1 for x2 to the right in that case
456 40 100       174 my ($len, $level) =round_down_pow (max ($x2+($arms>=8),
    100          
    100          
457             ($arms >= 2 ? $y2 : ()),
458             ($arms >= 4 ? -$x1 : ()),
459             ($arms >= 6 ? 1-$y1 : ())),
460             2);
461 40         123 return (0, 4*$arms*$len*$len-1);
462             }
463              
464              
465             my @dir4_to_dx = (1,0,-1,0);
466             my @dir4_to_dy = (0,1,0,-1);
467              
468             sub n_to_dxdy {
469 2000     2000 1 37422 my ($self, $n) = @_;
470             ### n_to_dxdy(): $n
471              
472 2000 50       3579 if ($n < 0) { return; }
  0         0  
473 2000 50       3557 if (is_infinite($n)) { return ($n,$n); }
  0         0  
474 2000         3445 my $int = int($n);
475 2000         2642 $n -= $int; # $n fraction part
476             ### $int
477             ### $n
478              
479 2000         3928 my $arm = _divrem_mutate ($int, $self->{'arms'});
480             ### $arm
481             ### $int
482              
483             # $dir initial direction from the arm.
484             # $inc +/-1 according to the bit position odd or even, but also odd
485             # numbered arms are transposed so flip them.
486             #
487 2000         3796 my @bits = bit_split_lowtohigh($int);
488 2000         3498 my $dir = ($arm+1) >> 1;
489 2000 100       3885 my $inc = (($#bits ^ $arm) & 1 ? -1 : 1);
490 2000         2875 my $prev = 0;
491              
492             ### @bits
493             ### initial dir: $dir
494             ### initial inc: $inc
495              
496 2000         3086 foreach my $bit (reverse @bits) {
497 15991 100       27218 if ($bit != $prev) {
498 9088         11439 $dir += $inc;
499 9088         12230 $prev = $bit;
500             }
501 15991         22596 $inc = -$inc; # opposite at each bit
502             }
503 2000         2700 $dir &= 3;
504 2000         2884 my $dx = $dir4_to_dx[$dir];
505 2000         2497 my $dy = $dir4_to_dy[$dir];
506             ### $dx
507             ### $dy
508              
509 2000 50       3449 if ($n) {
510             ### apply fraction part: $n
511              
512             # maybe:
513             # +/- $n as dx or dy
514             # +/- (1-$n) as other dy or dx
515              
516             # strip any low 1-bits, and the 0-bit above them
517             # $inc is +1 at an even bit position or -1 at an odd bit position
518 0 0       0 $inc = my $inc = ($arm & 1 ? -1 : 1);
519 0         0 while (shift @bits) {
520 0         0 $inc = -$inc;
521             }
522 0 0       0 if ($bits[0]) { # bit above lowest 0-bit, 1=right,0=left
523 0         0 $inc = -$inc;
524             }
525 0         0 $dir += $inc; # apply turn to give $dir at $n+1
526 0         0 $dir &= 3;
527 0         0 $dx += $n*($dir4_to_dx[$dir] - $dx);
528 0         0 $dy += $n*($dir4_to_dy[$dir] - $dy);
529             }
530              
531             ### result: "$dx, $dy"
532 2000         5433 return ($dx,$dy);
533             }
534              
535             # {
536             # sub print_table {
537             # my ($name, $aref) = @_;
538             # print "my \@$name = (";
539             # my $entry_width = max (map {length($_//'')} @$aref);
540             #
541             # foreach my $i (0 .. $#$aref) {
542             # printf "%*s", $entry_width, $aref->[$i]//'undef';
543             # if ($i == $#$aref) {
544             # print ");\n";
545             # } else {
546             # print ",";
547             # if (($i % 16) == 15
548             # || ($entry_width >= 3 && ($i % 4) == 3)) {
549             # print "\n ".(" " x length($name));
550             # } elsif (($i % 4) == 3) {
551             # print " ";
552             # }
553             # }
554             # }
555             # }
556             #
557             # my @next_state;
558             # my @state_to_dxdy;
559             #
560             # sub make_state {
561             # my %values = @_;
562             # # if ($oddpos) { $rot = ($rot-1)&3; }
563             # my $state = delete $values{'nextturn'};
564             # $state <<= 2; $state |= delete $values{'rot'};
565             # $state <<= 1; $state |= delete $values{'oddpos'};
566             # $state <<= 1; $state |= delete $values{'lowerbit'};
567             # $state <<= 1; $state |= delete $values{'bit'};
568             # die if %values;
569             # return $state;
570             # }
571             # sub state_string {
572             # my ($state) = @_;
573             # my $bit = $state & 1; $state >>= 1;
574             # my $lowerbit = $state & 1; $state >>= 1;
575             # my $oddpos = $state & 1; $state >>= 1;
576             # my $rot = $state & 3; $state >>= 2;
577             # my $nextturn = $state;
578             # # if ($oddpos) { $rot = ($rot+1)&3; }
579             # return "rot=$rot,oddpos=$oddpos nextturn=$nextturn lowerbit=$lowerbit (bit=$bit)";
580             # }
581             #
582             # foreach my $nextturn (0, 1, 2) {
583             # foreach my $rot (0, 1, 2, 3) {
584             # foreach my $oddpos (0, 1) {
585             # foreach my $lowerbit (0, 1) {
586             # foreach my $bit (0, 1) {
587             # my $state = make_state (bit => $bit,
588             # lowerbit => $lowerbit,
589             # rot => $rot,
590             # oddpos => $oddpos,
591             # nextturn => $nextturn);
592             # ### $state
593             #
594             # my $new_nextturn = $nextturn;
595             # my $new_lowerbit = $bit;
596             # my $new_rot = $rot;
597             # my $new_oddpos = $oddpos ^ 1;
598             #
599             # if ($bit != $lowerbit) {
600             # if ($oddpos) {
601             # $new_rot++;
602             # } else {
603             # $new_rot--;
604             # }
605             # $new_rot &= 3;
606             # }
607             # if ($lowerbit == 0 && ! $nextturn) {
608             # $new_nextturn = ($bit ^ $oddpos ? 1 : 2); # bit above lowest 0
609             # }
610             #
611             # my $dx = 1;
612             # my $dy = 0;
613             # if ($rot & 2) {
614             # $dx = -$dx;
615             # $dy = -$dy;
616             # }
617             # if ($rot & 1) {
618             # ($dx,$dy) = (-$dy,$dx); # rotate +90
619             # }
620             # ### rot to: "$dx, $dy"
621             #
622             # # if ($oddpos) {
623             # # ($dx,$dy) = (-$dy,$dx); # rotate +90
624             # # } else {
625             # # ($dx,$dy) = ($dy,-$dx); # rotate -90
626             # # }
627             #
628             # my $next_dx = $dx;
629             # my $next_dy = $dy;
630             # if ($nextturn == 2) {
631             # ($next_dx,$next_dy) = (-$next_dy,$next_dx); # left, rotate +90
632             # } else {
633             # ($next_dx,$next_dy) = ($next_dy,-$next_dx); # right, rotate -90
634             # }
635             # my $frac_dx = $next_dx - $dx;
636             # my $frac_dy = $next_dy - $dy;
637             #
638             # # mask to rot,oddpos only, ignore bit,lowerbit
639             # my $masked_state = $state & ~3;
640             # $state_to_dxdy[$masked_state] = $dx;
641             # $state_to_dxdy[$masked_state + 1] = $dy;
642             # $state_to_dxdy[$masked_state + 2] = $frac_dx;
643             # $state_to_dxdy[$masked_state + 3] = $frac_dy;
644             #
645             # my $next_state = make_state (bit => 0,
646             # lowerbit => $new_lowerbit,
647             # rot => $new_rot,
648             # oddpos => $new_oddpos,
649             # nextturn => $new_nextturn);
650             # $next_state[$state] = $next_state;
651             # }
652             # }
653             # }
654             # }
655             # }
656             #
657             # my @arm_to_state;
658             # foreach my $arm (0 .. 7) {
659             # my $rot = $arm >> 1;
660             # my $oddpos = 0;
661             # if ($arm & 1) {
662             # $rot++;
663             # $oddpos ^= 1;
664             # }
665             # $arm_to_state[$arm] = make_state (bit => 0,
666             # lowerbit => 0,
667             # rot => $rot,
668             # oddpos => $oddpos,
669             # nextturn => 0);
670             # }
671             #
672             # ### @next_state
673             # ### @state_to_dxdy
674             # ### next_state length: 4*(4*2*2 + 4*2)
675             #
676             # print "# next_state length ", scalar(@next_state), "\n";
677             # print_table ("next_state", \@next_state);
678             # print_table ("state_to_dxdy", \@state_to_dxdy);
679             # print_table ("arm_to_state", \@arm_to_state);
680             # print "\n";
681             #
682             # foreach my $arm (0 .. 7) {
683             # print "# arm=$arm ",state_string($arm_to_state[$arm]),"\n";
684             # }
685             # print "\n";
686             #
687             #
688             #
689             # use Smart::Comments;
690             #
691             # sub n_to_dxdy {
692             # my ($self, $n) = @_;
693             # ### n_to_dxdy(): $n
694             #
695             # my $int = int($n);
696             # $n -= $int; # $n fraction part
697             # ### $int
698             # ### $n
699             #
700             # my $state = _divrem_mutate ($int, $self->{'arms'}) << 2;
701             # ### arm as initial state: $state
702             #
703             # foreach my $bit (bit_split_lowtohigh($int)) {
704             # $state = $next_state[$state + $bit];
705             # }
706             # $state &= 0x1C; # mask out "prevbit"
707             #
708             # ### final state: $state
709             # ### dx: $state_to_dxdy[$state]
710             # ### dy: $state_to_dxdy[$state+1],
711             # ### frac dx: $state_to_dxdy[$state+2],
712             # ### frac dy: $state_to_dxdy[$state+3],
713             #
714             # return ($state_to_dxdy[$state] + $n * $state_to_dxdy[$state+2],
715             # $state_to_dxdy[$state+1] + $n * $state_to_dxdy[$state+3]);
716             # }
717             #
718             # }
719              
720             #------------------------------------------------------------------------------
721             # levels
722              
723 2     2   1285 use Math::PlanePath::DragonCurve;
  2         6  
  2         1843  
724             *level_to_n_range = \&Math::PlanePath::DragonCurve::level_to_n_range;
725             *n_to_level = \&Math::PlanePath::DragonCurve::n_to_level;
726              
727             #------------------------------------------------------------------------------
728              
729             sub _UNDOCUMENTED_level_to_right_line_boundary {
730 0     0     my ($self, $level) = @_;
731 0 0         if ($level == 0) {
732 0           return 1;
733             }
734 0           my ($h,$odd) = _divrem($level,2);
735 0 0         return ($odd
736             ? 6 * 2**$h - 4
737             : 2 * 2**$h);
738             }
739             sub _UNDOCUMENTED_level_to_left_line_boundary {
740 0     0     my ($self, $level) = @_;
741 0 0         if ($level == 0) {
742 0           return 1;
743             }
744 0           my ($h,$odd) = _divrem($level,2);
745 0 0         return ($odd
746             ? 2 * 2**$h
747             : 4 * 2**$h - 4);
748             }
749             sub _UNDOCUMENTED_level_to_line_boundary {
750 0     0     my ($self, $level) = @_;
751 0           my ($h,$odd) = _divrem($level,2);
752 0 0         return (($odd?8:6) * 2**$h - 4);
753             }
754              
755             sub _UNDOCUMENTED_level_to_hull_area {
756 0     0     my ($self, $level) = @_;
757 0           return (2**$level - 1)/2;
758             }
759              
760             sub _UNDOCUMENTED__n_is_x_positive {
761 0     0     my ($self, $n) = @_;
762 0 0 0       if (! ($n >= 0) || is_infinite($n)) { return 0; }
  0            
763              
764 0           $n = int($n);
765             {
766 0           my $arm = _divrem_mutate($n, $self->{'arms'});
  0            
767              
768             # arm 1 good only on N=1 which is remaining $n==0
769 0 0         if ($arm == 1) {
770 0           return ($n == 0);
771             }
772              
773             # arm 0 good
774             # arm 8 good for N>=15 which is remaining $n>=1
775 0 0 0       unless ($arm == 0
      0        
776             || ($arm == 7 && $n > 0)) {
777 0           return 0;
778             }
779             }
780              
781 0           return _is_base4_01($n);
782             }
783              
784             sub _UNDOCUMENTED__n_is_diagonal_NE {
785 0     0     my ($self, $n) = @_;
786 0 0 0       if (! ($n >= 0) || is_infinite($n)) { return 0; }
  0            
787              
788 0           $n = int($n);
789 0 0 0       if ($self->{'arms'} >= 8 && $n == 15) { return 1; }
  0            
790 0 0         if (_divrem_mutate($n, $self->{'arms'}) >= 2) { return 0; }
  0            
791 0           return _is_base4_02($n);
792             }
793              
794             # X axis N is base4 digits 0,1
795             # and -1 from even is 0,1 low 0333333
796             # and -2 from even is 0,1 low 0333332
797             # so $n+2 low digit any then 0,1s above
798             sub _UNDOCUMENTED__n_segment_is_right_boundary {
799 0     0     my ($self, $n) = @_;
800 0 0 0       if ($self->{'arms'} >= 8
      0        
801             || ! ($n >= 0)
802             || is_infinite($n)) {
803 0           return 0;
804             }
805 0           $n = int($n);
806              
807 0 0         if (_divrem_mutate($n, $self->{'arms'}) >= 1) {
808 0           return 0;
809             }
810 0           $n += 2;
811 0           _divrem_mutate($n,4);
812 0           return _is_base4_01($n);
813             }
814              
815             # diagonal N is base4 digits 0,2,
816             # and -1 from there is 0,2 low 1
817             # or 0,2 low 13333
818             # so $n+1 low digit possible 1 or 3 then 0,2s above
819             # which means $n+1 low digit any and 0,2s above
820             #use Smart::Comments;
821              
822             sub _UNDOCUMENTED__n_segment_is_left_boundary {
823 0     0     my ($self, $n) = @_;
824             ### _UNDOCUMENTED__n_segment_is_left_boundary(): $n
825              
826 0           my $arms = $self->{'arms'};
827 0 0 0       if ($arms >= 8
      0        
828             || ! ($n >= 0)
829             || is_infinite($n)) {
830 0           return 0;
831             }
832 0           $n = int($n);
833              
834 0 0 0       if (($n == 1 && $arms >= 4)
      0        
      0        
      0        
      0        
835             || ($n == 3 && $arms >= 5)
836             || ($n == 5 && $arms == 7)) {
837 0           return 1;
838             }
839 0 0         if (_divrem_mutate($n, $arms) < $arms-1) {
840             ### no, not last arm ...
841 0           return 0;
842             }
843              
844 0 0         if ($arms % 2) {
845             ### odd arms, stair-step boundary ...
846 0           $n += 1;
847 0           _divrem_mutate($n,4);
848 0           return _is_base4_02($n);
849             } else {
850             # even arms, notched like right boundary
851 0           $n += 2;
852 0           _divrem_mutate($n,4);
853 0           return _is_base4_01($n);
854             }
855             }
856              
857             sub _is_base4_01 {
858 0     0     my ($n) = @_;
859 0           while ($n) {
860 0           my $digit = _divrem_mutate($n,4);
861 0 0         if ($digit >= 2) { return 0; }
  0            
862             }
863 0           return 1;
864             }
865             sub _is_base4_02 {
866 0     0     my ($n) = @_;
867 0           while ($n) {
868 0           my $digit = _divrem_mutate($n,4);
869 0 0 0       if ($digit == 1 || $digit == 3) { return 0; }
  0            
870             }
871 0           return 1;
872             }
873              
874             1;
875             __END__