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 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   9625 use 5.004;
  2         7  
28 2     2   10 use strict;
  2         4  
  2         65  
29 2     2   12 use List::Util 'min'; # 'max'
  2         3  
  2         203  
30             *max = \&Math::PlanePath::_max;
31              
32 2     2   13 use vars '$VERSION', '@ISA';
  2         2  
  2         137  
33             $VERSION = 128;
34 2     2   649 use Math::PlanePath;
  2         4  
  2         51  
35 2     2   412 use Math::PlanePath::Base::NSEW;
  2         3  
  2         75  
36             @ISA = ('Math::PlanePath::Base::NSEW',
37             'Math::PlanePath');
38              
39             use Math::PlanePath::Base::Generic
40 2         100 'is_infinite',
41 2     2   13 'round_nearest';
  2         2  
42             use Math::PlanePath::Base::Digits
43 2         214 'round_down_pow',
44             'digit_split_lowtohigh',
45             'digit_join_lowtohigh',
46 2     2   454 'bit_split_lowtohigh';
  2         5  
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         114 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         2  
64              
65 2     2   12 use constant n_start => 0;
  2         3  
  2         526  
66             sub x_negative {
67 6     6 1 79 my ($self) = @_;
68 6         17 return ($self->{'arms'} >= 3);
69             }
70             sub y_negative {
71 6     6 1 312 my ($self) = @_;
72 6         17 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   14 use constant turn_any_straight => 0; # never straight
  2         4  
  2         3065  
107              
108              
109             #------------------------------------------------------------------------------
110              
111             sub new {
112 37     37 1 5461 my $self = shift->SUPER::new(@_);
113 37   100     286 $self->{'arms'} = max(1, min(8, $self->{'arms'} || 1));
114 37         85 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 245572 my ($self, $n) = @_;
164             ### AlternatePaper n_to_xy(): $n
165              
166 7847 50       14439 if ($n < 0) { return; }
  0         0  
167 7847 50       14373 if (is_infinite($n)) { return ($n, $n); }
  0         0  
168              
169 7847         14784 my $int = int($n); # integer part
170 7847         10443 $n -= $int; # fraction part
171             ### $int
172             ### $n
173              
174 7847         9865 my $zero = ($int * 0); # inherit bignum 0
175 7847         16062 my $arm = _divrem_mutate ($int, $self->{'arms'});
176              
177             ### $arm
178             ### $int
179              
180 7847         15299 my @digits = digit_split_lowtohigh($int,4);
181 7847         10540 my $state = 0;
182 7847         10393 my (@xbits,@ybits); # bits low to high (like @digits)
183              
184 7847         13518 foreach my $i (reverse 0 .. $#digits) { # high to low
185 19063         25116 $state += $digits[$i];
186 19063         25406 $xbits[$i] = $digit_to_x[$state];
187 19063         25419 $ybits[$i] = $digit_to_y[$state];
188 19063         26501 $state = $next_state[$state];
189             }
190 7847         16229 my $x = digit_join_lowtohigh(\@xbits,2,$zero);
191 7847         14308 my $y = digit_join_lowtohigh(\@ybits,2,$zero);
192              
193             # X+1,Y+1 for final state=4 or state=12
194 7847         11652 $x += $digit_to_x[$state];
195 7847         10357 $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         12084 $x = $n * $state_to_dx[$state >>= 2] + $x;
201 7847         10597 $y = $n * $state_to_dy[$state] + $y;
202              
203             # rotate,transpose for arm number
204 7847 100       14274 if ($arm & 1) {
205 3378         5703 ($x,$y) = ($y,$x); # transpose
206             }
207 7847 100       12657 if ($arm & 2) {
208 2889         4694 ($x,$y) = (-$y,$x+1); # rotate +90 and shift origin to X=0,Y=1
209             }
210 7847 100       12306 if ($arm & 4) {
211 2027         2497 $x = -1 - $x; # rotate +180 and shift origin to X=-1,Y=1
212 2027         2372 $y = 1 - $y;
213             }
214              
215             ### rotated return: "$x,$y"
216 7847         17645 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 6036 return scalar((shift->xy_to_n_list(@_))[0]);
242             }
243             sub xy_to_n_list {
244 159     159 1 3460 my ($self, $x, $y) = @_;
245             ### AlternatePaper xy_to_n(): "$x, $y"
246              
247 159         316 $x = round_nearest($x);
248 159         269 $y = round_nearest($y);
249 159 50       269 if (is_infinite($x)) { return $x; }
  0         0  
250 159 50       282 if (is_infinite($y)) { return $y; }
  0         0  
251              
252 159         257 my $arms = $self->{'arms'};
253 159         177 my $arm = 0;
254 159         184 my @ret;
255 159         240 foreach (1 .. 4) {
256 231         382 push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y);
  157         302  
257 231 100       394 last if ++$arm >= $arms;
258              
259 113         176 ($x,$y) = ($y,$x); # transpose
260 113         182 push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y);
  60         107  
261 113 100       179 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         447 ($x,$y) = ($x-1,-$y);
268             }
269 159         423 return sort {$a<=>$b} @ret;
  79         236  
270             }
271              
272             sub _xy_to_n_list__onearm {
273 344     344   464 my ($self, $x, $y) = @_;
274             ### _xy_to_n_list__onearm(): "$x,$y"
275              
276 344 100 100     932 if ($y < 0 || $y > $x || $x < 0) {
      66        
277             ### outside first octant ...
278 183         250 return;
279             }
280              
281 161         357 my ($len,$level) = round_down_pow($x, 2);
282             ### $len
283             ### $level
284 161 50       280 if (is_infinite($level)) {
285 0         0 return;
286             }
287              
288 161         256 my $n = my $big_n = $x * 0 * $y; # inherit bignum 0
289 161         173 my $rev = 0;
290              
291 161         192 my $big_x = $x;
292 161         173 my $big_y = $y;
293 161         176 my $big_rev = 0;
294              
295 161         293 while ($level-- >= 0) {
296             ### at: "$x,$y len=$len n=$n"
297              
298             # the smaller N
299             {
300 427         479 $n *= 4;
301 427 100       538 if ($rev) {
302 122 100       178 if ($x+$y < 2*$len) {
303             ### rev 0 or 1 ...
304 54 100       79 if ($x < $len) {
305             } else {
306             ### rev 1 ...
307 20         23 $rev = 0;
308 20         24 $n -= 2;
309 20         31 ($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90
310             }
311              
312             } else {
313             ### rev 2 or 3 ...
314 68 100 66     219 if ($y > $len || ($x==$len && $y==$len)) {
      100        
315             ### rev 2 ...
316 23         29 $n -= 2;
317 23         30 $x -= $len;
318 23         29 $y -= $len;
319             } else {
320             ### rev 3 ...
321 45         55 $n -= 4;
322 45         50 $rev = 0;
323 45         65 ($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90
324             }
325             }
326             } else {
327 305 100 100     1128 if ($x+$y <= 2*$len
      100        
      66        
      100        
328             && !($x==$len && $y==$len)
329             && !($x==2*$len && $y==0)) {
330             ### 0 or 1 ...
331 174 100       283 if ($x <= $len) {
332             } else {
333             ### 1 ...
334 54         64 $n += 2;
335 54         62 $rev = 1;
336 54         86 ($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90
337             }
338              
339             } else {
340             ### 2 or 3 ...
341 131 100 100     416 if ($y >= $len && !($x==2*$len && $y==$len)) {
      100        
342 71         85 $n += 2;
343 71         78 $x -= $len;
344 71         83 $y -= $len;
345             } else {
346 60         73 $n += 4;
347 60         64 $rev = 1;
348 60         100 ($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90
349             }
350             }
351             }
352             }
353              
354             # the bigger N
355             {
356 427         451 $big_n *= 4;
  427         457  
  427         452  
357 427 100       517 if ($big_rev) {
358 169 100 100     579 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 81 100       123 if ($big_x <= $len) {
363             } else {
364             ### rev 1 ...
365 22         26 $big_rev = 0;
366 22         24 $big_n -= 2;
367 22         42 ($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 88 100 100     222 if ($big_y >= $len && !($big_x==2*$len && $big_y==$len)) {
      100        
373             ### rev 2 ...
374 33         38 $big_n -= 2;
375 33         36 $big_x -= $len;
376 33         37 $big_y -= $len;
377             } else {
378             ### rev 3 ...
379 55         69 $big_n -= 4;
380 55         62 $big_rev = 0;
381 55         78 ($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90
382             }
383             }
384             } else {
385 258 100       401 if ($big_x+$big_y < 2*$len) {
386             ### 0 or 1 ...
387 162 100       216 if ($big_x < $len) {
388             } else {
389             ### 1 ...
390 105         117 $big_n += 2;
391 105         124 $big_rev = 1;
392 105         165 ($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 96 100 66     250 if ($big_y > $len || ($big_x==$len && $big_y==$len)) {
      100        
398 54         69 $big_n += 2;
399 54         370 $big_x -= $len;
400 54         71 $big_y -= $len;
401             } else {
402 42         48 $big_n += 4;
403 42         45 $big_rev = 1;
404 42         66 ($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90
405             }
406             }
407             }
408             }
409 427         679 $len /= 2;
410             }
411              
412 161 100       227 if ($x) {
413 67 100       103 $n += ($rev ? -1 : 1);
414             }
415 161 100       216 if ($big_x) {
416 67 100       93 $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 161 100       321 return ($n,
423             ($n == $big_n ? () : ($big_n)));
424             }
425              
426              
427             # not exact
428             sub rect_to_n_range {
429 40     40 1 2202 my ($self, $x1,$y1, $x2,$y2) = @_;
430             ### AlternatePaper rect_to_n_range(): "$x1,$y1 $x2,$y2"
431              
432 40         92 $x1 = round_nearest($x1);
433 40         66 $x2 = round_nearest($x2);
434 40         76 $y1 = round_nearest($y1);
435 40         62 $y2 = round_nearest($y2);
436              
437 40 50       68 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
438 40 50       61 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
439              
440             ### rounded: "$x1,$y1 $x2,$y2"
441              
442 40         60 my $arms = $self->{'arms'};
443 40 50 66     224 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       141 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         103 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 35707 my ($self, $n) = @_;
470             ### n_to_dxdy(): $n
471              
472 2000 50       3314 if ($n < 0) { return; }
  0         0  
473 2000 50       3525 if (is_infinite($n)) { return ($n,$n); }
  0         0  
474 2000         3335 my $int = int($n);
475 2000         2561 $n -= $int; # $n fraction part
476             ### $int
477             ### $n
478              
479 2000         3776 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         3761 my @bits = bit_split_lowtohigh($int);
488 2000         3290 my $dir = ($arm+1) >> 1;
489 2000 100       3497 my $inc = (($#bits ^ $arm) & 1 ? -1 : 1);
490 2000         2728 my $prev = 0;
491              
492             ### @bits
493             ### initial dir: $dir
494             ### initial inc: $inc
495              
496 2000         3089 foreach my $bit (reverse @bits) {
497 15991 100       25530 if ($bit != $prev) {
498 9088         10328 $dir += $inc;
499 9088         11240 $prev = $bit;
500             }
501 15991         20982 $inc = -$inc; # opposite at each bit
502             }
503 2000         2560 $dir &= 3;
504 2000         2704 my $dx = $dir4_to_dx[$dir];
505 2000         2490 my $dy = $dir4_to_dy[$dir];
506             ### $dx
507             ### $dy
508              
509 2000 50       3346 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         5699 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   1103 use Math::PlanePath::DragonCurve;
  2         5  
  2         1634  
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__