File Coverage

blib/lib/Math/PlanePath/DragonCurve.pm
Criterion Covered Total %
statement 97 225 43.1
branch 18 82 21.9
condition 11 16 68.7
subroutine 19 35 54.2
pod 11 11 100.0
total 156 369 42.2


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             # math-image --path=DragonCurve --lines --scale=20
20             # math-image --path=DragonCurve --all --scale=10
21             # math-image --path=DragonCurve --output=numbers_dash
22             #
23             # math-image --wx --path=DragonCurve,arms=4 --expression='i<16384?i:0'
24              
25              
26             package Math::PlanePath::DragonCurve;
27 5     5   9713 use 5.004;
  5         25  
28 5     5   37 use strict;
  5         9  
  5         138  
29 5     5   25 use List::Util 'min'; # 'max'
  5         10  
  5         442  
30             *max = \&Math::PlanePath::_max;
31              
32 5     5   32 use vars '$VERSION', '@ISA';
  5         20  
  5         384  
33             $VERSION = 127;
34 5     5   790 use Math::PlanePath;
  5         15  
  5         133  
35 5     5   458 use Math::PlanePath::Base::NSEW;
  5         11  
  5         189  
36             @ISA = ('Math::PlanePath::Base::NSEW',
37             'Math::PlanePath');
38              
39             use Math::PlanePath::Base::Generic
40 5         305 'is_infinite',
41 5     5   41 'round_nearest';
  5         9  
42             use Math::PlanePath::Base::Digits
43 5         357 'round_up_pow',
44             'bit_split_lowtohigh',
45 5     5   516 'digit_split_lowtohigh';
  5         10  
46             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
47              
48 5     5   1607 use Math::PlanePath::DragonMidpoint;
  5         9  
  5         168  
49              
50             # uncomment this to run the ### lines
51             # use Smart::Comments;
52              
53              
54              
55 5     5   31 use constant n_start => 0;
  5         10  
  5         361  
56              
57 5         974 use constant parameter_info_array => [ { name => 'arms',
58             share_key => 'arms_4',
59             display => 'Arms',
60             type => 'integer',
61             minimum => 1,
62             maximum => 4,
63             default => 1,
64             width => 1,
65             description => 'Arms',
66 5     5   32 } ];
  5         9  
67              
68             {
69             my @x_negative_at_n = (undef, 5,5,5,6);
70             sub x_negative_at_n {
71 0     0 1 0 my ($self) = @_;
72 0         0 return $x_negative_at_n[$self->{'arms'}];
73             }
74             }
75             {
76             my @y_negative_at_n = (undef, 14,11,8,7);
77             sub y_negative_at_n {
78 0     0 1 0 my ($self) = @_;
79 0         0 return $y_negative_at_n[$self->{'arms'}];
80             }
81             }
82             {
83             my @_UNDOCUMENTED__dxdy_list_at_n = (undef, 5, 5, 5, 3);
84             sub _UNDOCUMENTED__dxdy_list_at_n {
85 0     0   0 my ($self) = @_;
86 0         0 return $_UNDOCUMENTED__dxdy_list_at_n[$self->{'arms'}];
87             }
88             }
89              
90 5     5   36 use constant turn_any_straight => 0; # never straight
  5         11  
  5         12040  
91              
92              
93             #------------------------------------------------------------------------------
94              
95             sub new {
96 20     20 1 3402 my $self = shift->SUPER::new(@_);
97 20   100     126 $self->{'arms'} = max(1, min(4, $self->{'arms'} || 1));
98 20         52 return $self;
99             }
100              
101             {
102             # sub state_string {
103             # my ($state) = @_;
104             # my $digit = $state & 3; $state >>= 2;
105             # my $rot = $state & 3; $state >>= 2;
106             # my $rev = $state & 1; $state >>= 1;
107             # return "rot=$rot rev=$rev (digit=$digit)";
108             # }
109              
110             # generated by tools/dragon-curve-table.pl
111             # next_state length 32
112             my @next_state = (12,16, 4,16, 0,20, 8,20, 4,24,12,24, 8,28, 0,28,
113             0,20, 0,28, 4,24, 4,16, 8,28, 8,20, 12,16,12,24);
114             my @digit_to_x = ( 0, 0, 1, 1, 0, 1, 1, 0, 0, 0,-1,-1, 0,-1,-1, 0,
115             0, 1, 1, 2, 0, 0,-1,-1, 0,-1,-1,-2, 0, 0, 1, 1);
116             my @digit_to_y = ( 0,-1,-1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0,-1,-1,
117             0, 0, 1, 1, 0, 1, 1, 2, 0, 0,-1,-1, 0,-1,-1,-2);
118             my @digit_to_dxdy = ( 1, 0,undef,undef, 0, 1,undef,undef, -1, 0,undef,undef, 0,-1,undef,undef,
119             1, 0,undef,undef, 0, 1,undef,undef, -1, 0,undef,undef, 0,-1);
120              
121             sub n_to_xy {
122 491     491 1 38793 my ($self, $n) = @_;
123             ### DragonCurve n_to_xy(): $n
124              
125 491 50       1159 if ($n < 0) { return; }
  0         0  
126 491 50       1192 if (is_infinite($n)) { return ($n, $n); }
  0         0  
127              
128 491         1007 my $int = int($n); # integer part
129 491         871 $n -= $int; # $n = fraction part
130 491         788 my $zero = ($int * 0); # inherit bignum 0
131              
132 491         1205 my $arm = _divrem_mutate ($int, $self->{'arms'});
133 491         1281 my @digits = digit_split_lowtohigh($int,4);
134             ### @digits
135              
136             # initial state from rotation by arm and number of digits
137 491         1026 my $state = ((scalar(@digits) + $arm) & 3) << 2;
138              
139 491         963 my $len = (2+$zero) ** $#digits;
140 491         747 my $x = $zero;
141 491         698 my $y = $zero;
142 491         890 foreach my $digit (reverse @digits) { # high to low
143             ### at: "x=$x,y=$y len=$len digit=$digit state=$state"
144             # ### state is: state_string($state)
145              
146 2482         3232 $state += $digit;
147 2482         3681 $x += $len * $digit_to_x[$state];
148 2482         3488 $y += $len * $digit_to_y[$state];
149 2482         3475 $state = $next_state[$state];
150 2482         3701 $len /= 2;
151             }
152              
153             ### final: "x=$x y=$y state=$state"
154             # ### state is: state_string($state)
155             ### final: "frac dx=$digit_to_dxdy[$state], dy=$digit_to_dxdy[$state+1]"
156              
157 491         1798 return ($n * $digit_to_dxdy[$state] + $x,
158             $n * $digit_to_dxdy[$state+1] + $y);
159             }
160             }
161              
162              
163             {
164             # generated by tools/dragon-curve-dxdy.pl
165             # next_state length 32
166             my @next_state = ( 0, 6,20, 2, 4,10,24, 6, 8,14,28,10, 12, 2,16,14,
167             0,22,20,18, 4,26,24,22, 8,30,28,26, 12,18,16,30);
168             my @state_to_dxdy = ( 1, 0,-1, 1, 0, 1,-1,-1, -1, 0, 1,-1, 0,-1, 1, 1,
169             1, 0,-1,-1, 0, 1, 1,-1, -1, 0, 1, 1, 0,-1,-1, 1);
170              
171             sub n_to_dxdy {
172 2010     2010 1 36326 my ($self, $n) = @_;
173             ### n_to_dxdy(): $n
174              
175 2010 100       3640 if ($n < 0) { return; }
  3         18  
176 2007 50       3791 if (is_infinite($n)) { return ($n, $n); }
  0         0  
177              
178 2007         3990 my $int = int($n);
179 2007         2713 $n -= $int; # $n fraction part
180             ### $int
181             ### $n
182              
183 2007         4214 my $state = 4 * _divrem_mutate ($int, $self->{'arms'});
184             ### arm as initial state: $state
185              
186 2007         4057 foreach my $bit (reverse bit_split_lowtohigh($int)) { # high to low
187 15999         28050 $state = $next_state[$state + $bit];
188             }
189 2007         4170 $state &= 0x1C; # mask out "prevbit" from state, leaving state==0 mod 4
190              
191             ### final state: $state
192             ### dx: $state_to_dxdy[$state]
193             ### dy: $state_to_dxdy[$state+1],
194             ### frac dx: $state_to_dxdy[$state+2],
195             ### frac dy: $state_to_dxdy[$state+3],
196              
197 2007         5603 return ($state_to_dxdy[$state] + $n * $state_to_dxdy[$state+2],
198             $state_to_dxdy[$state+1] + $n * $state_to_dxdy[$state+3]);
199             }
200             }
201              
202             # point N=2^(2k) at XorY=+/-2^k radius 2^k
203             # N=2^(2k-1) at X=Y=+/-2^(k-1) radius sqrt(2)*2^(k-1)
204             # radius = sqrt(2^level)
205             # R(l)-R(l-1) = sqrt(2^level) - sqrt(2^(level-1))
206             # = sqrt(2^level) * (1 - 1/sqrt(2))
207             # about 0.29289
208             #
209             my @try_dx = (0,0,-1,-1);
210             my @try_dy = (0,1,1,0);
211              
212             sub xy_to_n {
213 25     25 1 685 return scalar((shift->xy_to_n_list(@_))[0]);
214             }
215             sub xy_to_n_list {
216 29     29 1 73 my ($self, $x, $y) = @_;
217             ### DragonCurve xy_to_n(): "$x, $y"
218              
219 29         72 $x = round_nearest($x);
220 29         99 $y = round_nearest($y);
221              
222 29 50       69 if (is_infinite($x)) {
223 0         0 return $x; # infinity
224             }
225 29 50       70 if (is_infinite($y)) {
226 0         0 return $y; # infinity
227             }
228              
229 29 100 100     108 if ($x == 0 && $y == 0) {
230 7         27 return (0 .. $self->arms_count - 1);
231             }
232              
233 22         34 my @n_list;
234 22         38 my $xm = $x+$y; # rotate -45 and mul sqrt(2)
235 22         35 my $ym = $y-$x;
236 22         39 foreach my $dx (0,-1) {
237 44         77 foreach my $dy (0,1) {
238 80         243 my $t = $self->Math::PlanePath::DragonMidpoint::xy_to_n
239             ($xm+$dx, $ym+$dy);
240 80 100       211 next unless defined $t;
241              
242 62 50       142 my ($tx,$ty) = $self->n_to_xy($t)
243             or next;
244              
245 62 100 100     231 if ($tx == $x && $ty == $y) {
246             ### found: $t
247 35 100 100     96 if (@n_list && $t < $n_list[0]) {
248 5         11 unshift @n_list, $t;
249             } else {
250 30         49 push @n_list, $t;
251             }
252 35 100       82 if (@n_list == 2) {
253 13         46 return @n_list;
254             }
255             }
256             }
257             }
258 9         30 return @n_list;
259             }
260              
261             #------------------------------------------------------------------------------
262              
263             sub xy_is_visited {
264 0     0 1 0 my ($self, $x, $y) = @_;
265              
266 0         0 my $arms_count = $self->{'arms'};
267 0 0       0 if ($arms_count == 4) {
268             # yes, whole plane visited
269 0         0 return 1;
270             }
271              
272 0         0 my $xm = $x+$y;
273 0         0 my $ym = $y-$x;
274             {
275 0         0 my $arm = Math::PlanePath::DragonMidpoint::_xy_to_arm($xm,$ym);
  0         0  
276 0 0       0 if ($arm < $arms_count) {
277             # yes, segment $xm,$ym is on the desired arms
278 0         0 return 1;
279             }
280 0 0 0     0 if ($arm == 2 && $arms_count == 1) {
281             # no, segment $xm,$ym is on arm 2, which means its opposite is only on
282             # arm 1,2,3 not arm 0 so arms_count==1 cannot be visited
283 0         0 return 0;
284             }
285             }
286 0         0 return (Math::PlanePath::DragonMidpoint::_xy_to_arm($xm-1,$ym+1)
287             < $arms_count);
288             }
289              
290              
291             #------------------------------------------------------------------------------
292              
293             # f = (1 - 1/sqrt(2) = .292
294             # 1/f = 3.41
295             # N = 2^level
296             # Rend = sqrt(2)^level
297             # Rmin = Rend / 2 maybe
298             # Rmin^2 = (2^level)/4
299             # N = 4 * Rmin^2
300             #
301             # not exact
302             sub rect_to_n_range {
303 29     29 1 2738 my ($self, $x1,$y1, $x2,$y2) = @_;
304             ### DragonCurve rect_to_n_range(): "$x1,$y1 $x2,$y2"
305 29         98 my $xmax = int(max(abs($x1),abs($x2)));
306 29         76 my $ymax = int(max(abs($y1),abs($y2)));
307             return (0,
308 29         102 $self->{'arms'} * ($xmax*$xmax + $ymax*$ymax + 1) * 7);
309             }
310              
311             # Not quite right yet ...
312             #
313             # sub rect_to_n_range {
314             # my ($self, $x1,$y1, $x2,$y2) = @_;
315             # ### DragonCurve rect_to_n_range(): "$x1,$y1 $x2,$y2"
316             #
317             #
318             # my ($length, $level_limit) = round_down_pow
319             # ((max(abs($x1),abs($x2))**2 + max(abs($y1),abs($y2))**2 + 1) * 7,
320             # 2);
321             # $level_limit += 2;
322             # ### $level_limit
323             #
324             # if (is_infinite($level_limit)) {
325             # return ($level_limit,$level_limit);
326             # }
327             #
328             # $x1 = round_nearest ($x1);
329             # $y1 = round_nearest ($y1);
330             # $x2 = round_nearest ($x2);
331             # $y2 = round_nearest ($y2);
332             # ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
333             # ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
334             # ### sorted range: "$x1,$y1 $x2,$y2"
335             #
336             #
337             # my @xend = (0, 1);
338             # my @yend = (0, 0);
339             # my @xmin = (0, 0);
340             # my @xmax = (0, 1);
341             # my @ymin = (0, 0);
342             # my @ymax = (0, 0);
343             # my @sidemax = (0, 1);
344             # my $extend = sub {
345             # my ($i) = @_;
346             # ### extend(): $i
347             # while ($i >= $#xend) {
348             # ### extend from: $#xend
349             # my $xend = $xend[-1];
350             # my $yend = $yend[-1];
351             # ($xend,$yend) = ($xend-$yend, # rotate +45
352             # $xend+$yend);
353             # push @xend, $xend;
354             # push @yend, $yend;
355             # my $xmax = $xmax[-1];
356             # my $xmin = $xmin[-1];
357             # my $ymax = $ymax[-1];
358             # my $ymin = $ymin[-1];
359             # ### assert: $xmax >= $xmin
360             # ### assert: $ymax >= $ymin
361             #
362             # # ### at: "end=$xend,$yend $xmin..$xmax $ymin..$ymax"
363             # push @xmax, max($xmax, $xend + $ymax);
364             # push @xmin, min($xmin, $xend + $ymin);
365             #
366             # push @ymax, max($ymax, $yend - $xmin);
367             # push @ymin, min($ymin, $yend - $xmax);
368             #
369             # push @sidemax, max ($xmax[-1], -$xmin[-1],
370             # $ymax[-1], -$ymin[-1],
371             # abs($xend),
372             # abs($yend));
373             # }
374             # ### @sidemax
375             # };
376             #
377             # my $rect_dist = sub {
378             # my ($x,$y) = @_;
379             # my $xd = ($x < $x1 ? $x1 - $x
380             # : $x > $x2 ? $x - $x2
381             # : 0);
382             # my $yd = ($y < $y1 ? $y1 - $y
383             # : $y > $y2 ? $y - $y2
384             # : 0);
385             # return max($xd,$yd);
386             # };
387             #
388             # my $arms = $self->{'arms'};
389             # ### $arms
390             # my $n_lo;
391             # {
392             # my $top = 0;
393             # for (;;) {
394             # ARM_LO: foreach my $arm (0 .. $arms-1) {
395             # my $i = 0;
396             # my @digits;
397             # if ($top > 0) {
398             # @digits = ((0)x($top-1), 1);
399             # } else {
400             # @digits = (0);
401             # }
402             #
403             # for (;;) {
404             # my $n = 0;
405             # foreach my $digit (reverse @digits) { # high to low
406             # $n = 2*$n + $digit;
407             # }
408             # $n = $n*$arms + $arm;
409             # my ($nx,$ny) = $self->n_to_xy($n);
410             # my $nh = &$rect_dist ($nx,$ny);
411             #
412             # ### lo consider: "i=$i digits=".join(',',reverse @digits)." is n=$n xy=$nx,$ny nh=$nh"
413             #
414             # if ($i == 0 && $nh == 0) {
415             # ### lo found inside: $n
416             # if (! defined $n_lo || $n < $n_lo) {
417             # $n_lo = $n;
418             # }
419             # next ARM_LO;
420             # }
421             #
422             # if ($i == 0 || $nh > $sidemax[$i+2]) {
423             # ### too far away: "nxy=$nx,$ny nh=$nh vs ".$sidemax[$i+2]." at i=$i"
424             #
425             # while (++$digits[$i] > 1) {
426             # $digits[$i] = 0;
427             # if (++$i <= $top) {
428             # ### backtrack up ...
429             # } else {
430             # ### not found within this top and arm, next arm ...
431             # next ARM_LO;
432             # }
433             # }
434             # } else {
435             # ### lo descend ...
436             # ### assert: $i > 0
437             # $i--;
438             # $digits[$i] = 0;
439             # }
440             # }
441             # }
442             #
443             # # if an $n_lo was found on any arm within this $top then done
444             # if (defined $n_lo) {
445             # last;
446             # }
447             #
448             # ### lo extend top ...
449             # if (++$top > $level_limit) {
450             # ### nothing below level limit ...
451             # return (1,0);
452             # }
453             # &$extend($top+3);
454             # }
455             # }
456             #
457             # my $n_hi = 0;
458             # ARM_HI: foreach my $arm (reverse 0 .. $arms-1) {
459             # &$extend($level_limit+2);
460             # my @digits = ((1) x $level_limit);
461             # my $i = $#digits;
462             # for (;;) {
463             # my $n = 0;
464             # foreach my $digit (reverse @digits) { # high to low
465             # $n = 2*$n + $digit;
466             # }
467             #
468             # $n = $n*$arms + $arm;
469             # my ($nx,$ny) = $self->n_to_xy($n);
470             # my $nh = &$rect_dist ($nx,$ny);
471             #
472             # ### hi consider: "arm=$arm i=$i digits=".join(',',reverse @digits)." is n=$n xy=$nx,$ny nh=$nh"
473             #
474             # if ($i == 0 && $nh == 0) {
475             # ### hi found inside: $n
476             # if ($n > $n_hi) {
477             # $n_hi = $n;
478             # next ARM_HI;
479             # }
480             # }
481             #
482             # if ($i == 0 || $nh > $sidemax[$i+2]) {
483             # ### too far away: "$nx,$ny nh=$nh vs ".$sidemax[$i+2]." at i=$i"
484             #
485             # while (--$digits[$i] < 0) {
486             # $digits[$i] = 1;
487             # if (++$i < $level_limit) {
488             # ### hi backtrack up ...
489             # } else {
490             # ### hi nothing within level limit for this arm ...
491             # next ARM_HI;
492             # }
493             # }
494             #
495             # } else {
496             # ### hi descend
497             # ### assert: $i > 0
498             # $i--;
499             # $digits[$i] = 1;
500             # }
501             # }
502             # }
503             #
504             # if ($n_hi == 0) {
505             # ### oops, lo found but hi not found
506             # $n_hi = $n_lo;
507             # }
508             #
509             # return ($n_lo, $n_hi);
510             # }
511              
512              
513             #------------------------------------------------------------------------------
514             # level ranges
515              
516             # arms=1 arms=2 arms=4
517             # level 0 0..1 = 2 0..3 = 4 0..7 = 8
518             # level 1 0..2 = 3 0..5 = 6 0..11 = 12
519             # level 2 0..4 = 5 0..9 = 10 0..19 = 20
520             # level 3 0..8 = 9 0..17 = 18 0..35 = 36
521             # 2^k 2*2^k+1 4*2^k+3
522             #
523             sub level_to_n_range {
524 8     8 1 652 my ($self, $level) = @_;
525 8         30 return (0, (2**$level + 1) * $self->{'arms'} - 1);
526             }
527             # 0 .. 2^level
528             # -1 .. 2^level-1
529             # level = round_up_pow(N)
530             # eg N=13 -> 2^4=16 level=4
531             #
532             sub n_to_level {
533 0     0 1   my ($self, $n) = @_;
534 0 0         if ($n < 0) { return undef; }
  0            
535 0 0         if (is_infinite($n)) { return $n; }
  0            
536 0           $n = round_nearest($n);
537 0           _divrem_mutate ($n, $self->{'arms'});
538 0           my ($pow, $exp) = round_up_pow ($n, 2);
539 0           return $exp;
540             }
541              
542             #------------------------------------------------------------------------------
543              
544             {
545             my @_UNDOCUMENTED_level_to_left_line_boundary = (1,2,4);
546             sub _UNDOCUMENTED_level_to_left_line_boundary {
547 0     0     my ($self, $level) = @_;
548 0 0         if ($level < 0) { return undef; }
  0            
549 0 0         if ($level <= 2) { return $_UNDOCUMENTED_level_to_left_line_boundary[$level]; }
  0            
550 0 0         if (is_infinite($level)) { return $level; }
  0            
551              
552 0           my $l0 = 2;
553 0           my $l1 = 4;
554 0           my $l2 = 8;
555 0           foreach (4 .. $level) {
556 0           ($l2,$l1,$l0) = ($l2 + 2*$l0, $l2, $l1);
557             }
558 0           return $l2;
559             }
560             }
561              
562             {
563             my @level_to_right_line_boundary = (1,2,4,8,undef);
564             sub _UNDOCUMENTED_level_to_right_line_boundary {
565 0     0     my ($self, $level) = @_;
566 0 0         if ($level < 0) { return undef; }
  0            
567 0 0         if ($level <= 3) { return $level_to_right_line_boundary[$level]; }
  0            
568 0 0         if (is_infinite($level)) { return $level; }
  0            
569              
570 0           my $r0 = 2;
571 0           my $r1 = 4;
572 0           my $r2 = 8;
573 0           my $r3 = 16;
574 0           foreach (5 .. $level) {
575 0           ($r3,$r2,$r1,$r0) = (2*$r3 - $r2 + 2*$r1 - 2*$r0, $r3, $r2, $r1);
576             }
577 0           return $r3;
578             }
579             }
580             sub _UNDOCUMENTED_level_to_line_boundary {
581 0     0     my ($self, $level) = @_;
582 0 0         if ($level < 0) { return undef; }
  0            
583 0           return $self->_UNDOCUMENTED_level_to_right_line_boundary($level+1);
584             }
585              
586             sub _UNDOCUMENTED_level_to_u_left_line_boundary {
587 0     0     my ($self, $level) = @_;
588 0 0         if ($level < 0) { return undef; }
  0            
589 0 0         return ($level == 0 ? 3
590             : $self->_UNDOCUMENTED_level_to_right_line_boundary($level) + 4);
591             }
592             sub _UNDOCUMENTED_level_to_u_right_line_boundary {
593 0     0     my ($self, $level) = @_;
594 0 0         if ($level < 0) { return undef; }
  0            
595 0           return ($self->_UNDOCUMENTED_level_to_right_line_boundary($level)
596             + $self->_UNDOCUMENTED_level_to_right_line_boundary($level+1));
597             }
598             sub _UNDOCUMENTED_level_to_u_line_boundary {
599 0     0     my ($self, $level) = @_;
600 0 0         if ($level < 0) { return undef; }
  0            
601 0           return ($self->_UNDOCUMENTED_level_to_u_left_line_boundary($level)
602             + $self->_UNDOCUMENTED_level_to_u_right_line_boundary($level));
603             }
604              
605             sub _UNDOCUMENTED_level_to_enclosed_area {
606 0     0     my ($self, $level) = @_;
607             # A[k] = 2^(k-1) - B[k]/4
608 0 0         if ($level < 0) { return undef; }
  0            
609 0 0         if ($level == 0) { return 0; } # avoid 2**(-1)
  0            
610 0           return 2**($level-1) - $self->_UNDOCUMENTED_level_to_line_boundary($level) / 4;
611             }
612             *_UNDOCUMENTED_level_to_doubled_points = \&_UNDOCUMENTED_level_to_enclosed_area;
613              
614             {
615             my @_UNDOCUMENTED_level_to_single_points = (2,3,5);
616             sub _UNDOCUMENTED_level_to_single_points {
617 0     0     my ($self, $level) = @_;
618 0 0         if ($level < 0) { return undef; }
  0            
619 0 0         if ($level <= 2) { return $_UNDOCUMENTED_level_to_single_points[$level]; }
  0            
620 0 0         if (is_infinite($level)) { return $level; }
  0            
621              
622 0           my $l0 = 3;
623 0           my $l1 = 5;
624 0           my $l2 = 9;
625 0           foreach (4 .. $level) {
626 0           ($l2,$l1,$l0) = ($l2 + 2*$l0, $l2, $l1);
627             }
628 0           return $l2;
629             }
630             }
631              
632             {
633             my @_UNDOCUMENTED_level_to_enclosed_area_join = (0,0,0,1);
634             sub _UNDOCUMENTED_level_to_enclosed_area_join {
635 0     0     my ($self, $level) = @_;
636 0 0         if ($level < 0) { return undef; }
  0            
637 0 0         if ($level <= 3) { return $_UNDOCUMENTED_level_to_enclosed_area_join[$level]; }
  0            
638 0 0         if (is_infinite($level)) { return $level; }
  0            
639              
640 0           my ($j0,$j1,$j2,$j3) = @_UNDOCUMENTED_level_to_enclosed_area_join;
641 0           $j3 += $level*0;
642 0           foreach (4 .. $level) {
643 0           ($j3,$j2,$j1,$j0) = (2*$j3 - $j2 + 2*$j1 - 2*$j0, $j3, $j2, $j1);
644             }
645 0           return $j3;
646             }
647             }
648              
649             #------------------------------------------------------------------------------
650             # points visited
651              
652             {
653             my @_UNDOCUMENTED_level_to_visited = (2, 3, 5, 9, 16);
654             sub _UNDOCUMENTED_level_to_visited {
655 0     0     my ($self, $level) = @_;
656              
657 0 0         if ($level < 0) { return undef; }
  0            
658 0 0         if ($level <= $#_UNDOCUMENTED_level_to_visited) { return $_UNDOCUMENTED_level_to_visited[$level]; }
  0            
659 0 0         if (is_infinite($level)) { return $level; }
  0            
660              
661 0           my ($p0,$p1,$p2,$p3,$p4) = @_UNDOCUMENTED_level_to_visited;
662 0           foreach (5 .. $level) {
663 0           ($p4,$p3,$p2,$p1,$p0) = (4*$p4 - 5*$p3 + 4*$p2 - 6*$p1 + 4*$p0, $p4, $p3, $p2, $p1);
664             }
665 0           return $p4;
666             }
667             }
668              
669             #------------------------------------------------------------------------------
670             {
671             my @_UNDOCUMENTED__n_segment_is_right_boundary
672             # R M A B C D F G H
673             # 1 2 3 4 5 6 7 8 9
674             = ([undef,1,3,1,6,7,9,3 ],
675             [undef,2,4,5,4,8,5,0,0,4 ]);
676              
677             sub _UNDOCUMENTED__n_segment_is_right_boundary {
678 0     0     my ($self, $n) = @_;
679 0 0         if (is_infinite($n)) { return 0; }
  0            
680 0 0         unless ($n >= 0) { return 0; }
  0            
681 0           $n = int($n);
682              
683 0           my $state = 1;
684 0           foreach my $bit (reverse bit_split_lowtohigh($n)) { # high to low
685 0   0       $state = $_UNDOCUMENTED__n_segment_is_right_boundary[$bit][$state]
686             || return 0;
687             }
688 0           return 1;
689             }
690             }
691              
692             1;
693             __END__