File Coverage

blib/lib/Math/PlanePath/OneOfEight.pm
Criterion Covered Total %
statement 346 890 38.8
branch 136 394 34.5
condition 30 98 30.6
subroutine 20 38 52.6
pod 21 21 100.0
total 553 1441 38.3


line stmt bran cond sub pod time code
1             # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
2              
3             # This file is part of Math-PlanePath-Toothpick.
4             #
5             # Math-PlanePath-Toothpick is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # Math-PlanePath-Toothpick is distributed in the hope that it will be
11             # useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath-Toothpick. If not, see .
17              
18              
19             # '1side' without log2 on lower side, is lower quad of 3mid
20             # '1side_up' mirror image, is upper quad of 3mid
21             # '1side with log2 from X=3*2^k,Y=2^k down, and middle of 3side
22              
23              
24             package Math::PlanePath::OneOfEight;
25 1     1   2988 use 5.004;
  1         3  
26 1     1   5 use strict;
  1         2  
  1         26  
27 1     1   5 use Carp 'croak';
  1         1  
  1         78  
28             #use List::Util 'max';
29             *max = \&Math::PlanePath::_max;
30              
31 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         65  
32             $VERSION = 18;
33 1     1   1133 use Math::PlanePath;
  1         6610  
  1         56  
34             @ISA = ('Math::PlanePath');
35              
36             use Math::PlanePath::Base::Generic
37 1         50 'is_infinite',
38 1     1   11 'round_nearest';
  1         3  
39             use Math::PlanePath::Base::Digits 119 # v.119 for round_up_pow()
40 1         65 'round_up_pow',
41 1     1   749 'round_down_pow';
  1         1740  
42              
43             # uncomment this to run the ### lines
44             # use Smart::Comments;
45              
46              
47 1     1   7 use constant n_start => 0;
  1         2  
  1         127  
48 1         53 use constant parameter_info_array =>
49             [{ name => 'parts',
50             share_key => 'parts_oneofeight',
51             display => 'Parts',
52             type => 'enum',
53             default => '4',
54             choices => ['4','1','octant','octant_up','wedge','3mid', '3side',
55             # 'side'
56             ],
57             choices_display => ['4','1','Octant','Octant Up','Wedge','3 Mid','3 Side',
58             # 'Side'
59             ],
60             description => 'Which parts of the plane to fill.',
61             },
62 1     1   5 ];
  1         1  
63 1     1   5 use constant class_x_negative => 1;
  1         2  
  1         48  
64 1     1   5 use constant class_y_negative => 1;
  1         1  
  1         5648  
65              
66             {
67             my %x_negative = (4 => 1,
68             1 => 0,
69             octant => 0,
70             octant_up => 0,
71             wedge => 1,
72             '3mid' => 1,
73             '3side' => 1,
74             side => 0,
75             );
76             sub x_negative {
77 0     0 1 0 my ($self) = @_;
78 0         0 return $x_negative{$self->{'parts'}};
79             }
80             }
81             {
82             my %y_negative = (4 => 1,
83             1 => 0,
84             octant => 0,
85             octant_up => 0,
86             wedge => 0,
87             '3mid' => 1,
88             '3side' => 1,
89             side => 0,
90             );
91             sub y_negative {
92 0     0 1 0 my ($self) = @_;
93 0         0 return $y_negative{$self->{'parts'}};
94             }
95             }
96             {
97             my %y_minimum = (# 4 => undef,
98             1 => 0,
99             octant => 0,
100             octant_up => 0,
101             wedge => 0,
102             # '3mid' => undef,
103             # '3side' => undef,
104             side => 1,
105             );
106             sub y_minimum {
107 0     0 1 0 my ($self) = @_;
108 0         0 return $y_minimum{$self->{'parts'}};
109             }
110             }
111              
112             {
113             my %x_negative_at_n = (4 => 4,
114             1 => undef,
115             octant => undef,
116             octant_up => undef,
117             wedge => 3,
118             '3mid' => 5,
119             '3side' => 15,
120             side => undef,
121             );
122             sub x_negative_at_n {
123 0     0 1 0 my ($self) = @_;
124 0         0 return $x_negative_at_n{$self->{'parts'}};
125             }
126             }
127             {
128             my %y_negative_at_n = (4 => 6,
129             1 => undef,
130             octant => undef,
131             octant_up => undef,
132             wedge => undef,
133             '3mid' => 1,
134             '3side' => 1,
135             side => undef,
136             );
137             sub y_negative_at_n {
138 0     0 1 0 my ($self) = @_;
139 0         0 return $y_negative_at_n{$self->{'parts'}};
140             }
141             }
142              
143             {
144             my %sumxy_minimum = (1 => 0,
145             octant => 0,
146             octant_up => 0,
147             wedge => 0, # X>=-Y so X+Y>=0
148             );
149             sub sumxy_minimum {
150 0     0 1 0 my ($self) = @_;
151 0         0 return $sumxy_minimum{$self->{'parts'}};
152             }
153             }
154             {
155             my %diffxy_minimum = (octant => 0, # Y<=X so X-Y>=0
156             );
157             sub diffxy_minimum {
158 0     0 1 0 my ($self) = @_;
159 0         0 return $diffxy_minimum{$self->{'parts'}};
160             }
161             }
162             {
163             my %diffxy_maximum = (octant_up => 0, # X<=Y so X+Y<=0
164             wedge => 0, # X<=Y so X+Y<=0
165             );
166             sub diffxy_maximum {
167 0     0 1 0 my ($self) = @_;
168 0         0 return $diffxy_maximum{$self->{'parts'}};
169             }
170             }
171              
172             {
173             my %_UNDOCUMENTED__turn_any_right_at_n
174             = (4 => 32,
175             1 => 3,
176             octant => 2,
177             octant_up => 2,
178             wedge => 3,
179             '3mid' => 29,
180             '3side' => 26,
181             );
182             sub _UNDOCUMENTED__turn_any_right_at_n {
183 0     0   0 my ($self) = @_;
184 0         0 return $_UNDOCUMENTED__turn_any_right_at_n{$self->{'parts'}};
185             }
186             }
187              
188             # parts=1,3mid dx=2*2^k-3 dy=-2^k, it seems
189             # parts=3side dx=2*2^k-5 dy=-2^k-2, it seems
190             my %dir_maximum_dxdy
191             = (4 => [0,-1], # South
192             1 => [2,-1], # ESE, supremum
193             octant => [1,-1], # South-East
194             octant_up => [0,-1], # N=12 South
195             wedge => [0,-1], # South
196             '3mid' => [2,-1], # ESE, supremum
197             '3side' => [2,-1], # ESE, supremum
198             );
199             sub dir_maximum_dxdy {
200 0     0 1 0 my ($self) = @_;
201 0         0 return @{$dir_maximum_dxdy{$self->{'parts'}}};
  0         0  
202             }
203              
204             {
205             my %tree_num_children_list = (4 => [ 0, 1, 2, 3, 5, 8 ],
206             1 => [ 0, 1, 2, 3, 5 ],
207             octant => [ 0, 1, 2, 3 ],
208             octant_up => [ 0, 1, 2, 3 ],
209             wedge => [ 0, 1, 2, 3 ],
210             '3mid' => [ 0, 1, 2, 3, 5 ],
211             '3side' => [ 0, 2, 3 ],
212             side => [ 0, 2, 3 ],
213             );
214             sub tree_num_children_list {
215 0     0 1 0 my ($self) = @_;
216 0         0 return @{$tree_num_children_list{$self->{'parts'}}};
  0         0  
217             }
218             }
219              
220              
221             #------------------------------------------------------------------------------
222              
223             sub new {
224 11     11 1 1080 my $self = shift->SUPER::new(@_);
225 11   100     88 my $parts = ($self->{'parts'} ||= '4');
226 11 50       27 if (! exists $dir_maximum_dxdy{$parts}) {
227 0         0 croak "Unrecognised parts: ",$parts;
228             }
229 11         28 return $self;
230             }
231              
232              
233             #------------------------------------------------------------------------------
234             # n_to_xy()
235              
236             my %initial_n_to_xy
237             = (4 => [ [0,0], [1,0], [1,1], [0,1],
238             [-1,1], [-1,0], [-1,-1], [0,-1], [1,-1] ],
239             1 => [ [0,0], [1,0], [1,1], [0,1] ],
240             octant => [ [0,0], [1,0], [1,1] ],
241             octant_up => [ [0,0], [1,1], [0,1] ],
242             wedge => [ [0,0], [1,1], [0,1], [-1,1] ],
243             '3mid' => [ [0,0], [1,-1], [1,0], [1,1],
244             [0,1], [-1,1] ],
245              
246             # for 3side table up to N=8 because cell X=1,Y=2 at N=7
247             # is overlapped by two upper octants
248             '3side' => [ [0,0], [1,-1], [1,0], [1,1],
249             [1,-2], [2,-2], [2,2], [1,2], [0,2] ],
250              
251             side => [ [0,0], [1,0], [1,1], [2,2], [1,2] ],
252             );
253              
254             # depth=0 1 2 3
255             my @octant_small_n_to_v = ([0], [0,1], [2], [1,2,3]);
256             my @octant_mid_n_to_v = ([0], [-1,0,1]);
257              
258             sub n_to_xy {
259 92     92 1 3997 my ($self, $n) = @_;
260             ### OneOfEight n_to_xy(): $n
261              
262 92 50       193 if ($n < 0) { return; }
  0         0  
263 92 50       209 if (is_infinite($n)) { return ($n,$n); }
  0         0  
264              
265             {
266 92         540 my $int = int($n);
  92         116  
267             ### $int
268             ### $n
269 92 50       206 if ($n != $int) {
270 0         0 my ($x1,$y1) = $self->n_to_xy($int);
271 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
272 0         0 my $frac = $n - $int; # inherit possible BigFloat
273 0         0 my $dx = $x2-$x1;
274 0         0 my $dy = $y2-$y1;
275 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
276             }
277 92         116 $n = $int; # BigFloat int() gives BigInt, use that
278             }
279 92         123 my $zero = $n*0;
280              
281 92         135 my $parts = $self->{'parts'};
282             {
283 92         107 my $initial = $initial_n_to_xy{$parts};
  92         159  
284 92 100       258 if ($n <= $#$initial) {
285             ### initial_n_to_xy{}: $initial->[$n]
286 22         23 return @{$initial->[$n]};
  22         74  
287             }
288             }
289              
290 70         134 (my $depth, $n) = _n0_to_depth_and_rem($self, $n);
291             ### $depth
292             ### remainder n: $n
293             ### cf this depth n: $self->tree_depth_to_n($depth)
294             ### cf next depth n: $self->tree_depth_to_n($depth+1)
295              
296             # $hdx,$hdy is the dx,dy offsets which is "horizontal". Initially this is
297             # hdx=1,hdy=0 so horizontal along the X axis, but subsequent blocks rotate
298             # around or mirror to point other directions.
299             #
300             # $vdx,$vdy is similar dx,dy which is "vertical". Initially vdx=0,vdy=1
301             # so vertical along the Y axis.
302             #
303             # $mirror is true if in a "mirror image" such as upper octant 0<=X<=Y
304             # portion of the pattern. The difference is that $mirror false has points
305             # numbered anti-clockwise "upwards" from the ragged edge towards the
306             # diagonal, but when $mirror is true instead clockwise "down" from the
307             # diagonal towards the ragged edge.
308             #
309             # When $mirror is true the octant generated is still reckoned as 0<=Y<=X,
310             # but the $hdx,$hdy and $vdx,$vdy are suitably mangled so that this
311             # logical first octant ends up in whatever target is desired. For example
312             # the 0<=X<=Y second octant of the pattern starts with hdx=0,hdy=1 and
313             # vdx=1,vdy=0, so the "horizontal" is upwards and the "vertical" is to the
314             # right.
315             #
316             # $log2_extras is true if the extra cell at the log2 positions
317             # X=3,7,15,31,etc and Y=1 should be included in the pattern. Initially
318             # true, but later in the "lower" block there are no such extra cells.
319             #
320             # $top_no_extra_pow is a 2^k power if the top of the diagonal at
321             # X=pow-1,Y=pow-1 should not be included in the pattern. Or 0 if this
322             # diagonal cell should be included. Initially true, but later going
323             # "lower" followed by "upper" it's the end of the diagonal is not wanted.
324             # The first such is at X=8,Y=2 which should not be in the "upper"
325             # (mirrored) diagonal coming from X=11,Y=5. In general if $log2_extras is
326             # false then $top_no_extra_pow excludes that log2 cell when going to the
327             # "upper" block.
328             #
329 70         85 my $x = 0;
330 70         76 my $y = 0;
331 70         81 my $hdx = 1;
332 70         105 my $hdy = 0;
333 70         91 my $vdx = 0;
334 70         81 my $vdy = 1;
335 70         64 my $mirror = 0; # plain
336 70         83 my $log2_extras = 1; # include cells X=3,7,15,31;Y=1 etc
337 70         98 my $top_no_extra_pow = 0;
338              
339 70 50 66     440 if ($parts eq 'octant') {
    50 66        
    50          
    50          
    0          
    0          
    0          
340             ### parts=octant ...
341              
342             } elsif ($parts eq 'octant_up') {
343             ### parts=octant_up ...
344 0         0 $hdx = 0;
345 0         0 $hdy = 1;
346 0         0 $vdx = 1;
347 0         0 $vdy = 0;
348 0         0 $mirror = 1;
349              
350             } elsif ($parts eq 'wedge') {
351             ### parts=wedge ...
352 0         0 my $add = _depth_to_octant_added([$depth],[1],$zero);
353 0 0       0 if ($n < $add) {
354 0         0 $hdx = 0; # same as octant_up
355 0         0 $hdy = 1;
356 0         0 $vdx = 1;
357 0         0 $vdy = 0;
358 0         0 $mirror = 1;
359             } else {
360 0         0 $n -= $add;
361 0         0 $hdx = 0; # rotate +90
362 0         0 $hdy = 1;
363 0         0 $vdx = -1;
364 0         0 $vdy = 0;
365             }
366              
367             } elsif ($parts eq '1' || $parts eq '2' || $parts eq '4') {
368 70         185 my $add = _depth_to_octant_added([$depth],[1],$zero);
369             ### octant add: $add
370              
371 70 100       190 if ($parts eq '4') {
372             # Half-plane is 4 octants, less 2 for duplicate diagonal.
373 42         58 my $hadd = 4*$add-2;
374 42 100       89 if ($n >= $hadd) {
375             ### initial rotate 180 ...
376 18         20 $n -= $hadd;
377 18         19 $hdx = -1;
378 18         25 $vdy = -1;
379             }
380             }
381 70 100 66     287 if ($parts eq '2' || $parts eq '4') {
382             # Each quadrant is 2 octants, less 1 for duplicate diagonal.
383 42         51 my $qadd = 2*$add-1;
384 42 100       83 if ($n >= $qadd) {
385             ### initial rotate +90 ...
386 19         30 $n -= $qadd;
387 19         30 ($hdx,$hdy) = (-$hdy,$hdx);
388 19         36 ($vdx,$vdy) = (-$vdy,$vdx);
389             }
390             }
391 70 100       148 if ($n >= $add) {
392             ### initial mirror ...
393 24         30 $mirror = 1;
394 24         36 ($hdx,$hdy, $vdx,$vdy) # mirror by transpose
395             = ($vdx,$vdy, $hdx,$hdy);
396 24         42 $n -= $add;
397 24         62 $n += 1; # excluding diagonal
398             }
399              
400             } elsif ($parts eq '3mid') {
401 0 0       0 my $add = _depth_to_octant_added([$depth+1],[1],$zero)
402             - (_is_pow2($depth+2) ? 2 : 1);
403             ### lower of side 1, excluding diagonal: "depth=".($depth+1)." add=".$add
404 0 0       0 if ($n < $add) {
405             ### lower of side 1 ...
406 0         0 $hdx = 0; $hdy = -1; $vdx = 1; $vdy = 0;
  0         0  
  0         0  
  0         0  
407 0         0 $log2_extras = 0;
408 0         0 $depth += 1;
409 0         0 $x = -1; $y = 1;
  0         0  
410             } else {
411 0         0 $n -= $add;
412             ### past side 1 lower, not past diagonal: "n=$n"
413              
414 0         0 $add = _depth_to_octant_added([$depth],[1],$zero);
415 0 0       0 if ($n < $add) {
416             ### upper of side 1 ...
417 0         0 $vdy = -1;
418 0         0 $mirror = 1;
419             } else {
420 0         0 $n -= $add;
421              
422 0 0       0 if ($n < $add) {
423             ### lower of centre ...
424             } else {
425 0         0 $n -= $add;
426 0         0 $n += 1; # past diagonal
427              
428 0 0       0 if ($n < $add) {
429             ### upper of centre ...
430 0         0 $hdx = 0;
431 0         0 $hdy = 1;
432 0         0 $vdx = 1;
433 0         0 $vdy = 0;
434 0         0 $mirror = 1;
435             } else {
436 0         0 $n -= $add;
437              
438 0 0       0 if ($n < $add) {
439             ### upper of side 3 ...
440 0         0 $hdx = 0;
441 0         0 $hdy = 1;
442 0         0 $vdx = -1;
443 0         0 $vdy = 0;
444             } else {
445 0         0 $n -= $add;
446 0         0 $n += 1; # past diagonal
447              
448             ### lower of side 3 ...
449 0         0 $hdx = -1;
450 0         0 $depth += 1;
451 0         0 $x = 1; $y = -1;
  0         0  
452 0         0 $log2_extras = 0;
453 0         0 $mirror =1;
454             }
455             }
456             }
457             }
458             }
459              
460             } elsif ($parts eq '3side') {
461 0 0       0 my $add = (_depth_to_octant_added([$depth+1],[1],$zero)
462             - (_is_pow2($depth+2) ? 2 : 1));
463             ### lower of side 1, excluding diagonal: "depth=".($depth+1)." add=".$add
464 0 0       0 if ($n < $add) {
465             ### lower of side 1 ...
466 0         0 $hdx = 0;
467 0         0 $hdy = -1;
468 0         0 $vdx = 1;
469 0         0 $vdy = 0;
470 0         0 $log2_extras = 0;
471 0         0 $depth += 1;
472 0         0 $x = -1; $y = 1;
  0         0  
473             } else {
474 0         0 $n -= $add;
475              
476 0         0 $add = _depth_to_octant_added([$depth],[1],$zero);
477             ### plain add, including diagonal: "add=$add cf n=$n"
478 0 0       0 if ($n < $add) {
479             ### upper of side 1 ...
480 0         0 $vdy = -1;
481 0         0 $mirror = 1;
482             } else {
483 0         0 $n -= $add;
484             ### not upper of side 1, leaving n: $n
485              
486 0 0       0 if ($n < $add) {
487             ### lower of centre, including diagonal ...
488             } else {
489 0         0 $n -= $add;
490 0         0 $n += 1; # past diagonal
491             ### not lower of centre, and past diagonal to n: $n
492              
493 0         0 $add = _depth_to_octant_added([$depth-1],[1],$zero);
494             ### upper of centre, excluding diagonal: "depth=".($depth-1)." add-1=".$add
495 0 0       0 if ($n < $add) {
496             ### upper of centre ...
497 0         0 $hdx = 0; $hdy = 1; $vdx = 1; $vdy = 0;
  0         0  
  0         0  
  0         0  
498 0         0 $x = 1; $y = 1;
  0         0  
499 0         0 $mirror = 1;
500 0         0 $depth -= 1;
501             } else {
502 0         0 $n -= $add;
503             ### not upper of centre, to n: $n
504              
505 0 0       0 if ($n < $add) {
506             ### upper of side 3 ...
507 0         0 $hdx = 0; $hdy = 1; $vdx = -1; $vdy = 0; # rotate -90
  0         0  
  0         0  
  0         0  
508 0         0 $x = 1; $y = 1;
  0         0  
509 0         0 $depth -= 1;
510             } else {
511 0         0 $n -= $add;
512 0         0 $n += 1; # past diagonal
513             ### not upper of side 3, and past diagonal to n: $n
514              
515             ### lower of side 3 ...
516 0         0 $hdx = -1;
517 0         0 $x = 2;
518 0         0 $log2_extras = 0;
519 0         0 $mirror =1;
520             }
521             }
522             }
523             }
524             }
525              
526             } elsif ($parts eq 'side') {
527 0         0 my $add = _depth_to_octant_added([$depth],[1],$zero);
528             ### first octant add: $add
529 0 0       0 if ($n < $add) {
530             ### first octant ...
531             } else {
532             ### second octant ...
533 0         0 $n -= $add;
534 0         0 $n += 1; # past diagonal
535 0         0 $hdx = 0; $hdy = 1; $vdx = 1; $vdy = 0;
  0         0  
  0         0  
  0         0  
536 0         0 $depth += 1;
537 0         0 $log2_extras = 0;
538 0         0 $mirror = 1;
539 0         0 $x = -1; $y = -1;
  0         0  
540             }
541             }
542              
543             ### adjusted to octant style: "depth=$depth remainder n=$n"
544              
545 70         184 my ($pow,$exp) = round_down_pow ($depth+1, 2);
546             ### initial exp: $exp
547             ### initial pow: $pow
548              
549 70         749 for ( ; $exp >= 0; $pow/=2, $exp--) {
550             ### at: "pow=$pow exp=$exp depth=$depth n=$n mirror=$mirror log2extras=$log2_extras topnopow=$top_no_extra_pow xy=$x,$y h=$hdx,$hdy v=$vdx,$vdy"
551             ### assert: $depth >= 1
552             ### assert: $mirror == 0 || $mirror == 1
553              
554 122 100       264 if ($depth < $pow) {
555             ### block 0 ...
556 36         68 $top_no_extra_pow = 0;
557 36         90 next;
558             }
559              
560 86 100       163 if ($depth <= 3) {
561 46 100       80 if ($mirror) {
562             ### mirror small depth ...
563 17 50       35 if ($depth == $top_no_extra_pow-1) {
564 0         0 $n += 1;
565             ### inc n for top_no_extra_pow: "to n=$n"
566             }
567             ### assert: $n <= $#{$octant_small_n_to_v[$depth]}
568 17         24 $n = -1-$n; # perl negative index to read array in reverse
569             } else {
570             ### small depth ...
571 29 100 66     94 if (! $log2_extras && $depth == 3) {
572 1         3 $n += 1;
573             ### inc n for no log2_extras: "to n=$n"
574             }
575             ### assert: $n <= $#{$octant_small_n_to_v[$depth]}
576             }
577 46         74 my $v = $octant_small_n_to_v[$depth][$n];
578             ### hv: "h=$depth, v=$v"
579 46         63 $x += $depth*$hdx + $v*$vdx; # $depth is "$h" horizontal position
580 46         70 $y += $depth*$hdy + $v*$vdy;
581 46         61 last;
582             }
583              
584 40         58 $x += $pow * ($hdx + $vdx); # $pow along diagonal
585 40         53 $y += $pow * ($hdy + $vdy);
586 40         44 $depth -= $pow;
587             ### diagonal to: "depth=$depth xy=$x,$y"
588              
589 40 100       76 if ($depth <= 1) {
590             ### mid two levels ...
591 24 100       42 if ($mirror) {
592             ### negative perl array index to reverse for mirror state ...
593 7         9 $n = -1-$n;
594             }
595 24         38 my $v = $octant_mid_n_to_v[$depth][$n];
596             ### hv: "h=$depth v=$v"
597 24         32 $x += $depth*$hdx + $v*$vdx; # $depth is "$h" horizontal position
598 24         30 $y += $depth*$hdy + $v*$vdy;
599 24         32 last;
600             }
601              
602 16 100       28 if ($mirror == 0) { # plain
603              
604             # See if $n within lower.
605             # Not at depth+1==pow since lower has already finished then.
606             #
607 9 100       19 if ($depth+1 < $pow) {
608 3         9 my $add = _depth_to_octant_added([$depth+1],[1],$zero);
609 3 50       9 if (_is_pow2($depth+2)) {
610             ### add lower decreased for remaining depth+2 a power-of-2 ...
611 3         4 $add -= 1;
612             }
613 3         6 $add -= 1;
614             ### add in lower, excluding diagonal: $add
615 3 100       7 if ($n < $add) {
616             ### lower, rotate +90 ...
617 1         2 $top_no_extra_pow = 0;
618 1         2 $log2_extras = 0;
619 1         2 $depth += 1;
620             ### assert: $depth < $pow
621 1         3 ($hdx,$hdy, $vdx,$vdy) # rotate 90 in direction v toward h
622             = (-$vdx,-$vdy, $hdx,$hdy);
623 1         2 $x -= $hdx + $vdx;
624 1         2 $y -= $hdy + $vdy;
625 1         3 next;
626             }
627 2         3 $n -= $add;
628             } else {
629             ### skip lower at depth==pow-1 ...
630             }
631              
632             # See if $n within upper.
633             #
634 8         18 my $add = _depth_to_octant_added([$depth],[1],$zero);
635 8 50 33     25 if (! $log2_extras && $depth+1 == $pow) {
636             ### add upper decreased for no log2_extras at depth=pow-1 ...
637 0         0 $add -= 1;
638             }
639             ### add in upper, including diagonal: $add
640 8 100       19 if ($n < $add) {
641             ### upper, mirror ...
642 4         5 $mirror = 1;
643 4         6 $vdx = -$vdx; # flip vertically
644 4         5 $vdy = -$vdy;
645 4 50       14 $top_no_extra_pow = ($log2_extras ? 0 : $pow);
646 4         3 $log2_extras = 1;
647 4         13 next;
648             }
649 4         5 $n -= $add;
650             ### assert: $n < $add
651              
652             # Otherwise $n is within extend.
653             #
654             ### extend ...
655 4         5 $top_no_extra_pow /= 2;
656 4         12 $log2_extras = 1;
657              
658             } else {
659             # $mirror == 1, mirrored
660              
661             # See if $n within extend.
662             #
663 7         20 my $eadd = my $add = _depth_to_octant_added([$depth],[1],$zero);
664 7         14 $top_no_extra_pow /= 2; # since after $depth+=$pow
665 7 50       36 if ($depth == $top_no_extra_pow - 1) {
666             ### add extend decreased for no top extra ...
667 0         0 $eadd -= 1;
668             }
669             ### add in extend: $eadd
670 7 100       15 if ($n < $eadd) {
671             ### extend ...
672 2         3 $log2_extras = 1;
673 2         6 next;
674             }
675 5         7 $n -= $eadd;
676              
677             # See if $n within upper.
678             #
679             ### add in upper, including diagonal: "$add cf n=$n"
680 5 100       10 if ($n < $add) {
681             ### upper, unmirror ...
682 4 50       8 $top_no_extra_pow = ($log2_extras ? 0 : $pow);
683 4         5 $log2_extras = 1;
684 4         5 $mirror = 0;
685 4         5 $vdx = -$vdx; # flip vertically
686 4         4 $vdy = -$vdy;
687 4         13 next;
688             }
689 1         2 $n -= $add;
690              
691             # Otherwise $n is within lower.
692             #
693 1         3 $n += 1; # past diagonal
694             ### lower, rotate: "n=$n"
695             ### assert: $n < _depth_to_octant_added([$depth+1],[1],$zero)
696 1         2 $top_no_extra_pow = 0;
697 1         1 $log2_extras = 0;
698 1         2 $depth += 1;
699             ### assert: $depth < $pow
700 1         2 ($hdx,$hdy, $vdx,$vdy) # rotate 90 in direction v toward h
701             = (-$vdx,-$vdy, $hdx,$hdy);
702 1         2 $x -= $hdx + $vdx;
703 1         4 $y -= $vdx + $vdy;
704             }
705             }
706              
707             ### n_to_xy() return: "$x,$y (depth=$depth n=$n)"
708 70         179 return ($x,$y);
709             }
710              
711             # ($depth, $nrem) = _n0_to_depth_and_rem($self,$n)
712             #
713             # _n0_to_depth_and_rem() finds the tree $depth level containing $n and
714             # returns that $depth and the offset of $n into that level, being
715             # $n - $self->tree_depth_to_n($depth).
716             #
717             # The current approach is a binary search for the bits of depth which have
718             # tree_depth_to_n($depth) <= $n.
719             #
720             # Ndepth grows as roughly depth*depth, so this is about log4(N) many bsearch
721             # compares. Maybe for modest N a table of depth->N could be used for the
722             # search (and for tree_depth_to_n()). It would cover up to about sqrt(N),
723             # so for large N would still need some searching code.
724             #
725             # quadrant(2^k) = (4*4^k + 6*k + 14) / 9
726             # N*9/4 = 4^k + 6/4*k + 14/4
727             # parts=1 N*9 to round up to next power
728             # parts=octant N*18
729             # parts=4 N*9/4 = N*3 as estimate
730             # parts=3 N*9/4 = N*3 too
731             #
732             my %parts_to_depth_multiplier = (4 => 3,
733             1 => 9,
734             octant => 18,
735             octant_up => 18,
736             wedge => 9,
737             '3mid' => 3,
738             '3side' => 3,
739             side => 9,
740             );
741             sub _n0_to_depth_and_rem {
742 70     70   98 my ($self, $n) = @_;
743             ### _n0_to_depth_and_rem(): "n=$n parts=$self->{'parts'}"
744              
745             my ($pow,$exp) = round_down_pow
746 70         215 ($n * $parts_to_depth_multiplier{$self->{'parts'}},
747             4);
748 70 50       780 if (is_infinite($exp)) {
749 0         0 return ($exp,0);
750             }
751             ### $pow
752             ### $exp
753              
754 70         410 my $depth = 0;
755 70         79 my $n_depth = 0;
756 70         92 $pow = 2 ** $exp; # pow=2^exp down to 1, inclusive
757              
758 70         148 while ($exp-- >= 0) {
759 266         339 my $try_depth = $depth + $pow;
760 266         525 my $try_n_depth = $self->tree_depth_to_n($try_depth);
761              
762             ### $depth
763             ### $pow
764             ### $try_depth
765             ### $try_n_depth
766              
767 266 100       589 if ($try_n_depth <= $n) {
768             ### use this tried depth ...
769 141         154 $depth = $try_depth;
770 141         194 $n_depth = $try_n_depth;
771             }
772 266         589 $pow /= 2;
773             }
774              
775             ### _n0_to_depth_and_rem() final ...
776             ### $depth
777             ### remainder: $n - $n_depth
778              
779 70         141 return ($depth, $n - $n_depth);
780             }
781              
782             #------------------------------------------------------------------------------
783             # xy_to_n()
784              
785             my @yxoct_to_n = ([ 0, 1 ], # Y=0
786             [ undef, 2 ]); # Y=1
787             my @yxoctup_to_n = ([ 0, undef ], # Y=0
788             [ 2, 1 ]); # Y=1
789             my @yxwedge_to_n = ([ 0, undef, undef ], # Y=0 X=0,1,-1
790             [ 2, 1, 3 ]); # Y=1
791             my @yx1_to_n = ([ 0, 1 ], # Y=0
792             [ 3, 2 ]); # Y=1
793             my @yx3_to_n = ([ 0, 2, undef ], # Y=0 X=0,1,-1
794             [ 4, 3, 5 ], # Y=1
795             [ undef, 1, undef ]); # Y=-1
796             my @yx4_to_n = ([ 0, 1, 5 ], # Y=0 X=0,1,-1
797             [ 3, 2, 4 ], # Y=1
798             [ 7, 8, 6 ]); # Y=-1
799             my @yx3mid_to_n = ([ 0, 2, undef ], # Y=0 X=0,1,-1
800             [ 4, 3, 5 ], # Y=1
801             [ undef, 1, undef ]); # Y=-1
802             my @yx3side_to_n = ([ 0, 2, undef ], # Y=0 X=0,1,-1
803             [ undef, 3, undef ], # Y=1
804             [ 8, 7, 16 ], # Y=2
805             [ undef, 4, undef ], # Y=-2
806             [ undef, 1, undef ]); # Y=-1
807             my @yxside_to_n = ([ 0, 1 ], # Y=0 X=0,1,-1
808             [ undef, 2 ]); # Y=1
809              
810             # N values relative to tree_depth_to_n() start of the depth level
811             my @yx_to_n = ([ [ 0, 0, ], # plain
812             [ undef, 1, undef, 0 ],
813             [ undef, undef, 0, 1 ],
814             [ undef, undef, undef, 2 ] ],
815             [ [ 0, 1, ], # mirror
816             [ undef, 0, undef, 2 ],
817             [ undef, undef, 0, 1 ],
818             [ undef, undef, undef, 0 ] ]);
819              
820             #use Smart::Comments;
821              
822             sub xy_to_n {
823 60     60 1 1012 my ($self, $x, $y) = @_;
824             ### OneOfEight xy_to_n(): "$x, $y"
825              
826             # {
827             # require Math::PlanePath::OneOfEightByCells;
828             # my $cells = ($self->{'cells'} ||= Math::PlanePath::OneOfEightByCells->new (parts => $self->{'parts'}));
829             # return $cells->xy_to_n($x,$y);
830             # }
831              
832 60         143 $x = round_nearest ($x);
833 60         416 $y = round_nearest ($y);
834 60 50       377 if (is_infinite($x)) {
835 0         0 return $x;
836             }
837 60 50       416 if (is_infinite($y)) {
838 0         0 return $y;
839             }
840              
841 60         394 my ($pow,$exp) = round_down_pow (max(abs($x),abs($y))+2, 2);
842             ### initial pow: "exp=$exp pow=$pow"
843             ### from abs(x): abs($x)
844             ### from abs(y): abs($y)
845             ### from max: max(abs($x),abs($y))
846              
847 60 50       1012 if (is_infinite($exp)) {
848 0         0 return $exp;
849             }
850              
851 60         356 my $zero = $x * 0 * $y;
852 60         99 my @add_offset;
853             my @add_mult;
854 0         0 my @add_log2_extras;
855 0         0 my @add_top_no_extra_pow;
856 60         63 my $mirror = 0;
857 60         57 my $log2_extras = 1;
858 60         85 my $top_extra = 1;
859 60         93 my $top_no_extra_pow = 0;
860 60         85 my $depth = 0;
861 60         61 my $n = $zero;
862              
863 60         86 my $parts = $self->{'parts'};
864 60 50 33     346 if ($parts eq 'octant') {
    50          
    50          
    50          
    0          
    0          
    0          
    0          
865             ### parts==octant ...
866 0 0 0     0 if ($y < 0 || $y > $x) {
867 0         0 return undef;
868             }
869 0 0 0     0 if ($x <= 1 && $y <= 1) {
870 0         0 return $yxoct_to_n[$y][$x];
871             }
872              
873             } elsif ($parts eq 'octant_up') {
874             ### parts==octant_up ...
875 0 0 0     0 if ($x < 0 || $x > $y) {
876             ### outside upper octant ...
877 0         0 return undef;
878             }
879 0 0 0     0 if ($x <= 1 && $y <= 1) {
880             ### yxoctup_to_n[] table ...
881 0         0 return $yxoctup_to_n[$y][$x];
882             }
883             # transpose and mirror
884 0         0 ($x,$y) = ($y,$x);
885 0         0 $mirror = 1;
886              
887             } elsif ($parts eq 'wedge') {
888             ### parts==wedge ...
889 0 0 0     0 if ($x > $y || $x < -$y) {
890 0         0 return undef;
891             }
892 0 0 0     0 if (abs($x) <= 1 && $y <= 1) {
893 0         0 return $yxwedge_to_n[$y][$x];
894             }
895 0 0       0 if ($x >= 0) {
896 0         0 ($x,$y) = ($y,$x); # transpose and mirror
897 0         0 $mirror = 1;
898             } else {
899 0         0 ($x,$y) = ($y,-$x); # rotate -90
900 0         0 push @add_offset, 0;
901 0         0 push @add_mult, 1;
902 0         0 push @add_top_no_extra_pow, 0;
903 0         0 push @add_log2_extras, 1;
904             }
905              
906             } elsif ($parts eq '1' || $parts eq '4') {
907 60         65 my $mult = 0;
908 60 50       101 if ($parts eq '1') {
909             ### parts==1 ...
910 0 0 0     0 if ($x < 0 || $y < 0) {
911 0         0 return undef;
912             }
913 0 0 0     0 if ($x <= 1 && $y <= 1) {
914 0         0 return $yx1_to_n[$y][$x];
915             }
916             } else {
917             ### parts==4 ...
918 60 100 100     179 if (abs($x) <= 1 && abs($y) <= 1) {
919 18         57 return $yx4_to_n[$y][$x];
920             }
921 42 100       88 if ($y < 0) {
922             ### quad 3 or 4, rotate 180 ...
923 18         21 $mult = 4; # past first,second quads
924 18         21 $n -= 2; # unduplicate diagonals
925 18         21 $x = -$x; # rotate 180
926 18         23 $y = -$y;
927             }
928 42 100       89 if ($x < 0) {
929             ### quad 2 (or 4), rotate 90 ...
930 19         22 $mult += 2;
931 19         24 $n -= 1; # unduplicate diagonal
932 19         43 ($x,$y) = ($y,-$x); # rotate -90
933             }
934             }
935              
936             ### now in first quadrant: "x=$x y=$y"
937 42 100       81 if ($y > $x) {
938             ### second octant, transpose and mirror ...
939 13         24 ($x,$y) = ($y,$x);
940 13         17 $mult++;
941 13         17 $n -= 1; # unduplicate diagonal
942 13         22 $mirror = 1;
943             }
944 42 100       79 if ($mult) {
945 34         44 push @add_offset, 0;
946 34         44 push @add_mult, $mult;
947 34         42 push @add_top_no_extra_pow, 0;
948 34         48 push @add_log2_extras, 1;
949             }
950              
951             } elsif ($parts eq '3mid') {
952             ### parts==3mid ...
953 0 0 0     0 if (abs($x) <= 1 && abs($y) <= 1) {
954             ### 3mid small: $yx3mid_to_n[$y][$x]
955 0         0 return $yx3mid_to_n[$y][$x];
956             }
957 0 0       0 if ($y < 0) {
958 0 0       0 if ($x < 0) {
959             ### third quadrant, no such point ...
960 0         0 return undef;
961             }
962 0         0 $y = -$y;
963 0 0       0 if ($y >= $x) {
964             ### block 0 lower ...
965 0         0 $log2_extras = 0;
966 0         0 ($x,$y) = ($y+1,$x+1);
967 0         0 $depth = -1;
968             } else {
969             ### block 1 upper ...
970 0         0 $mirror = 1;
971              
972             ### past block 0 lower, excluding diagonal ...
973 0         0 push @add_offset, -1;
974 0         0 push @add_mult, 1;
975 0         0 push @add_top_no_extra_pow, 0;
976 0         0 push @add_log2_extras, 0;
977 0         0 $n -= 1; # excluding diagonal
978             }
979             } else {
980 0 0       0 if ($x >= 0) {
981 0 0       0 if ($y <= $x) {
982             ### block 2 first octant ...
983              
984             ### past block 0 lower, excluding diagonal ...
985 0         0 push @add_offset, -1;
986 0         0 push @add_mult, 1;
987 0         0 push @add_top_no_extra_pow, 0;
988 0         0 push @add_log2_extras, 0;
989 0         0 $n -= 1; # excluding diagonal
990              
991             ### past block 1 ...
992 0         0 push @add_offset, 0;
993 0         0 push @add_mult, 1;
994 0         0 push @add_top_no_extra_pow, 0;
995 0         0 push @add_log2_extras, 1;
996              
997             } else {
998             ### block 3 second octant ...
999 0         0 ($x,$y) = ($y,$x);
1000 0         0 $mirror = 1;
1001              
1002             ### past block 0 lower, excluding diagonal ...
1003 0         0 push @add_offset, -1;
1004 0         0 push @add_mult, 1;
1005 0         0 push @add_top_no_extra_pow, 0;
1006 0         0 push @add_log2_extras, 0;
1007 0         0 $n -= 1; # excluding diagonal
1008              
1009             ### past blocks 1,2, excluding leading diagonal ...
1010 0         0 push @add_offset, 0;
1011 0         0 push @add_mult, 2;
1012 0         0 push @add_top_no_extra_pow, 0;
1013 0         0 push @add_log2_extras, 1;
1014 0         0 $n -= 1; # excluding leading diagonal
1015             }
1016             } else {
1017             ### second quadrant ...
1018 0         0 $x = -$x;
1019 0 0       0 if ($y >= $x) {
1020             ### block 4 third octant ...
1021 0         0 ($x,$y) = ($y,$x);
1022              
1023             ### past block 0 lower, excluding diagonal ...
1024 0         0 push @add_offset, -1;
1025 0         0 push @add_mult, 1;
1026 0         0 push @add_top_no_extra_pow, 0;
1027 0         0 push @add_log2_extras, 0;
1028 0         0 $n -= 1; # excluding diagonal
1029              
1030             ### past blocks 1,2,3 excluding leading diagonal ...
1031 0         0 push @add_offset, 0;
1032 0         0 push @add_mult, 3;
1033 0         0 push @add_top_no_extra_pow, 0;
1034 0         0 push @add_log2_extras, 1;
1035 0         0 $n -= 1; # excluding leading diagonal
1036              
1037             } else {
1038             ### block 5 fourth octant ...
1039 0         0 $x += 1; $y += 1;
  0         0  
1040 0         0 $mirror = 1;
1041 0         0 $depth = -1;
1042 0         0 $log2_extras = 0;
1043              
1044             ### past block 0 lower, excluding diagonal ...
1045 0         0 push @add_offset, -1;
1046 0         0 push @add_mult, 1;
1047 0         0 push @add_top_no_extra_pow, 0;
1048 0         0 push @add_log2_extras, 0;
1049 0         0 $n -= 1; # excluding diagonal
1050              
1051 0         0 push @add_offset, 0;
1052 0         0 push @add_mult, 4;
1053 0         0 push @add_top_no_extra_pow, 0;
1054 0         0 push @add_log2_extras, 1;
1055 0         0 $n -= 2; # unduplicate two diagonals
1056             }
1057             }
1058             }
1059              
1060             } elsif ($parts eq '3side') {
1061             ### parts==3side ...
1062 0 0 0     0 if (abs($x) <= 1 && abs($y) <= 2) {
1063             ### 3side small: $yx3side_to_n[$y][$x]
1064 0         0 return $yx3side_to_n[$y][$x];
1065             }
1066 0 0       0 if ($y < 0) {
1067 0 0       0 if ($x < 0) {
1068             ### third quadrant, no such point ...
1069 0         0 return undef;
1070             }
1071 0         0 $y = -$y;
1072 0 0       0 if ($y >= $x) {
1073             ### block 0 lower ...
1074 0         0 $log2_extras = 0;
1075 0         0 ($x,$y) = ($y+1,$x+1);
1076 0         0 $depth = -1;
1077             } else {
1078             ### block 1 upper ...
1079 0         0 $mirror = 1;
1080              
1081             ### past block 0 lower, excluding diagonal ...
1082 0         0 push @add_offset, -1;
1083 0         0 push @add_mult, 1;
1084 0         0 push @add_top_no_extra_pow, 0;
1085 0         0 push @add_log2_extras, 0;
1086 0         0 $n -= 1; # excluding diagonal
1087             }
1088             } else {
1089 0 0       0 if ($x > 0) {
1090 0 0       0 if ($y <= $x) {
1091             ### block 2 first octant ...
1092              
1093             ### past block 0 lower, excluding diagonal ...
1094 0         0 push @add_offset, -1;
1095 0         0 push @add_mult, 1;
1096 0         0 push @add_top_no_extra_pow, 0;
1097 0         0 push @add_log2_extras, 0;
1098 0         0 $n -= 1; # excluding diagonal
1099              
1100             ### past block 1 ...
1101 0         0 push @add_offset, 0;
1102 0         0 push @add_mult, 1;
1103 0         0 push @add_top_no_extra_pow, 0;
1104 0         0 push @add_log2_extras, 1;
1105              
1106             } else {
1107             ### block 3 second octant ...
1108 0         0 ($x,$y) = ($y-1,$x-1);
1109 0         0 $depth = 1;
1110 0         0 $mirror = 1;
1111              
1112             ### past block 0 lower, excluding diagonal ...
1113 0         0 push @add_offset, -1;
1114 0         0 push @add_mult, 1;
1115 0         0 push @add_top_no_extra_pow, 0;
1116 0         0 push @add_log2_extras, 0;
1117 0         0 $n -= 1; # excluding diagonal
1118              
1119             ### past block 1,2, excluding leading diagonal ...
1120 0         0 push @add_offset, 0;
1121 0         0 push @add_mult, 2;
1122 0         0 push @add_top_no_extra_pow, 0;
1123 0         0 push @add_log2_extras, 1;
1124 0         0 $n -= 1; # excluding leading diagonal
1125             }
1126             } else {
1127             ### second quadrant ...
1128 0         0 $x = 2-$x;
1129             ### X mirror to: "x=$x y=$y"
1130              
1131 0 0       0 if ($y >= $x) {
1132             ### block 4 third octant ...
1133 0         0 ($x,$y) = ($y-1,$x-1);
1134             ### transpose to: "x=$x y=$y"
1135 0         0 $depth = 1;
1136              
1137             ### past block 0 lower, excluding diagonal ...
1138 0         0 push @add_offset, -1;
1139 0         0 push @add_mult, 1;
1140 0         0 push @add_top_no_extra_pow, 0;
1141 0         0 push @add_log2_extras, 0;
1142 0         0 $n -= 1; # excluding diagonal
1143              
1144             ### past block 1,2, excluding leading diagonal ...
1145 0         0 push @add_offset, 0;
1146 0         0 push @add_mult, 2;
1147 0         0 push @add_top_no_extra_pow, 0;
1148 0         0 push @add_log2_extras, 1;
1149 0         0 $n -= 1; # excluding leading diagonal
1150              
1151             ### past block 3 ...
1152 0         0 push @add_offset, 1;
1153 0         0 push @add_mult, 1;
1154 0         0 push @add_top_no_extra_pow, 0;
1155 0         0 push @add_log2_extras, 1;
1156              
1157             } else {
1158             ### block 5 fourth octant ...
1159 0         0 $mirror = 1;
1160 0         0 $log2_extras = 0;
1161              
1162             ### past block 0 lower, excluding diagonal ...
1163 0         0 push @add_offset, -1;
1164 0         0 push @add_mult, 1;
1165 0         0 push @add_top_no_extra_pow, 0;
1166 0         0 push @add_log2_extras, 0;
1167 0         0 $n -= 1; # excluding diagonal
1168              
1169             ### past block 1,2, excluding leading diagonal ...
1170 0         0 push @add_offset, 0;
1171 0         0 push @add_mult, 2;
1172 0         0 push @add_top_no_extra_pow, 0;
1173 0         0 push @add_log2_extras, 1;
1174 0         0 $n -= 1; # unduplicate leading diagonal
1175              
1176             ### past block 3,4 ...
1177 0         0 push @add_offset, 1;
1178 0         0 push @add_mult, 2;
1179 0         0 push @add_top_no_extra_pow, 0;
1180 0         0 push @add_log2_extras, 1;
1181 0         0 $n -= 1; # excluding block4 diagonal
1182             }
1183             }
1184             }
1185              
1186             } elsif ($parts eq 'side') {
1187             ### parts==side ...
1188 0 0 0     0 if ($x < 0 || $y < 0) {
1189 0         0 return undef;
1190             }
1191 0 0 0     0 if ($x <= 1 && $y <= 1) {
1192 0         0 return $yxside_to_n[$y][$x];
1193             }
1194              
1195 0 0       0 if ($y > $x) {
1196             ### second octant ...
1197 0         0 ($x,$y) = ($y+1,$x+1);
1198 0         0 $depth = -1;
1199 0         0 $mirror = 1;
1200 0         0 $log2_extras = 0;
1201 0         0 $n -= 1; # excluding diagonal
1202              
1203             ### past block 1 ...
1204 0         0 push @add_offset, 0;
1205 0         0 push @add_mult, 1;
1206 0         0 push @add_top_no_extra_pow, 0;
1207 0         0 push @add_log2_extras, 1;
1208             }
1209              
1210              
1211             } elsif ($parts eq '2') {
1212             ### parts==2 ...
1213             # if ($x == 0) {
1214             # if ($y == 1) { return 0; }
1215             # }
1216             # if ($y == 1) {
1217             # if ($x == 1) { return 1; }
1218             # if ($x == -1) { return 2; }
1219             # }
1220             # if ($x < 0) {
1221             # ### initial mirror second quadrant ...
1222             # $x = -$x;
1223             # $mirror = 1;
1224             # push @add_offset, -1;
1225             # push @add_mult, 1;
1226             # }
1227             }
1228              
1229 42 50 33     169 if ($x == 0 || $y == 0) {
1230             ### nothing on axes after origin ...
1231 0         0 return undef;
1232             }
1233              
1234 42         44 for (;;) {
1235             ### at: "x=$x,y=$y n=$n pow=$pow depth=$depth mirror=$mirror log2_extras=$log2_extras top_extra=$top_extra top_no_extra_pow=$top_no_extra_pow"
1236             ### assert: $x >= 0
1237             ### assert: $x < 2 * $pow
1238             ### assert: $y >= 0
1239             ### assert: $y <= $x
1240              
1241 42 100       84 if ($x <= 3) {
1242             ### loop small XY ...
1243             ### $top_no_extra_pow
1244              
1245 24 100       47 if ($x == 3) {
1246 20 50       40 if (! $log2_extras) {
1247 0 0       0 if ($y == 1) {
1248             ### no log2_extras ...
1249 0         0 return undef;
1250             }
1251 0 0       0 if (! $mirror) {
1252             ### no log2_extras, N decrement, (not mirrored) ...
1253 0         0 $n -= 1;
1254             }
1255             }
1256 20 50       38 if ($top_no_extra_pow == 4) {
1257 0 0       0 if ($y == 3) {
1258             ### no top extra, so no such point ...
1259 0         0 return undef;
1260             }
1261             ### top_no_extra_pow, N decrement by mirror: $mirror
1262 0         0 $n -= $mirror;
1263             }
1264             }
1265              
1266 24         46 my $nyx = $yx_to_n[$mirror][$y][$x];
1267             ### $nyx
1268 24 50       50 if (! defined $nyx) {
1269             ### no such point ...
1270 0         0 return undef;
1271             }
1272 24         26 $n += $nyx;
1273 24         30 $depth += $x;
1274 24         31 last;
1275             }
1276              
1277 18 100       52 if ($x == $pow) {
    50          
1278 4 50       11 if ($y == $pow) {
1279             ### mid X=pow,Y=pow, stop ...
1280 4         5 $depth += $pow;
1281 4         6 last;
1282             }
1283             ### X=pow no such point ...
1284 0         0 return undef;
1285             } elsif ($x == $pow+1) {
1286 14 100       28 if ($y == $pow-1) {
1287             ### mid X=pow+1,Y=pow-1, stop ...
1288 5         8 $depth += $pow+1;
1289 5 100       10 $n += ($mirror ? 2 : 0);
1290 5         7 last;
1291             }
1292 9 100       17 if ($y == $pow) {
1293             ### mid X=pow+1,Y=pow, stop ...
1294 6         8 $depth += $pow+1;
1295 6         8 $n += 1;
1296 6         8 last;
1297             }
1298 3 50       16 if ($y == $pow+1) {
1299             ### mid X=pow+1,Y=pow+1, stop ...
1300 3         8 $depth += $pow+1;
1301 3 50       7 $n += ($mirror ? 0 : 2);
1302 3         4 last;
1303             }
1304             }
1305              
1306 0 0       0 if ($x < $pow) {
1307             ### base block ...
1308 0         0 $top_no_extra_pow = 0;
1309              
1310             } else {
1311 0         0 $x -= $pow;
1312 0         0 $depth += $pow;
1313 0 0       0 if ($y < $pow) {
1314 0         0 $y = $pow-$y;
1315             ### Y flip to: $y
1316              
1317 0 0       0 if ($y > $x) {
1318             ### block lower, excluding diagonal ...
1319 0         0 ($x,$y) = ($y+1,$x+1);
1320             ### rotate to: "x=$x y=$y"
1321             ### assert: $y >= 0
1322 0 0 0     0 unless ($y && $x < $pow) {
1323             ### Y=0 or X>=pow, no such point ...
1324 0         0 return undef;
1325             }
1326 0         0 $top_no_extra_pow = 0;
1327 0         0 $log2_extras = 0;
1328 0         0 $depth -= 1;
1329 0 0       0 if ($mirror) {
1330             ### offset past extend,upper, undup diagonal, (mirrored) ...
1331 0         0 push @add_offset, $depth+1;
1332 0         0 push @add_mult, 2;
1333 0         0 push @add_top_no_extra_pow, $top_no_extra_pow/2;
1334 0         0 push @add_log2_extras, 1;
1335 0         0 $n -= 1; # duplicated diagonal upper,lower
1336             }
1337              
1338             } else {
1339             ### block upper ...
1340 0 0       0 if ($mirror) {
1341             ### offset past extend (mirrored) ...
1342 0         0 push @add_offset, $depth;
1343 0         0 push @add_mult, 1;
1344 0         0 push @add_top_no_extra_pow, $top_no_extra_pow/2;
1345 0         0 push @add_log2_extras, 1;
1346             } else {
1347 0 0       0 if ($x < $pow-1) {
1348             ### offset past lower, unduplicate diagonal, (not mirrored) ...
1349 0         0 push @add_offset, $depth-1;
1350 0         0 push @add_mult, 1;
1351 0         0 push @add_top_no_extra_pow, 0;
1352 0         0 push @add_log2_extras, 0;
1353 0         0 $n -= 1; # duplicated diagonal upper,lower
1354             }
1355             }
1356 0 0       0 $top_no_extra_pow = ($log2_extras ? 0 : $pow);
1357 0         0 $log2_extras = 1;
1358 0         0 $mirror ^= 1;
1359             }
1360             } else {
1361             ### extend, same ...
1362 0 0       0 unless ($x) {
1363             ### on X=0, past block3, no such point ...
1364 0         0 return undef;
1365             }
1366 0 0       0 if ($mirror) {
1367             ### no offset past lower at X=pow-1 ...
1368             } else {
1369 0 0       0 if ($x < $pow-1) {
1370             ### offset past lower (not mirrored) ...
1371 0         0 push @add_offset, $depth-1;
1372 0         0 push @add_mult, 1;
1373 0         0 push @add_top_no_extra_pow, 0;
1374 0         0 push @add_log2_extras, 0;
1375 0         0 $n -= 1; # duplicated diagonal
1376             }
1377             ### offset past upper (not mirrored) ...
1378 0         0 push @add_offset, $depth;
1379 0         0 push @add_mult, 1;
1380 0 0       0 push @add_top_no_extra_pow, ($log2_extras ? 0 : $pow);
1381 0         0 push @add_log2_extras, 1;
1382             # if (! $log2_extras) {
1383             # ### no log2_extras so N decrement ...
1384             # $n -= 1;
1385             # }
1386             }
1387 0         0 $y -= $pow;
1388 0         0 $log2_extras = 1;
1389 0         0 $top_extra = 1;
1390 0         0 $top_no_extra_pow /= 2;
1391             }
1392             }
1393              
1394 0 0       0 if (--$exp < 0) {
1395             ### final xy: "$x,$y"
1396 0 0 0     0 if ($x == 1 && $y == 1) {
    0 0        
1397             } elsif ($x == 1 && $y == 2) {
1398 0         0 $depth += 1;
1399             } else {
1400             ### not in final position ...
1401 0         0 return undef;
1402             }
1403 0         0 last;
1404             }
1405 0         0 $pow /= 2;
1406             }
1407              
1408              
1409             ### final depth: $depth
1410             ### $n
1411             ### depth_to_n: $self->tree_depth_to_n($depth)
1412             ### add_offset: join(',',@add_offset)
1413             ### add_mult: join(',',@add_mult)
1414             ### assert: scalar(@add_offset) == scalar(@add_mult)
1415             ### assert: scalar(@add_offset) == scalar(@add_log2_extras)
1416             ### assert: scalar(@add_offset) == scalar(@add_top_no_extra_pow)
1417              
1418 42         78 $n += $self->tree_depth_to_n($depth);
1419              
1420 42 100       91 if (@add_offset) {
1421 34         69 foreach my $i (0 .. $#add_offset) {
1422 34         51 my $d = $add_offset[$i] = $depth - $add_offset[$i];
1423              
1424 34 50       67 if ($d+1 == $add_top_no_extra_pow[$i]) {
1425             ### no top_extra, decrement applied: "d=$d"
1426 0         0 $n -= 1;
1427             }
1428 34 0 33     95 if (! $add_log2_extras[$i] && $d >= 3 && _is_pow2($d+1)) {
      33        
1429             ### no log2_extras, decrement applied: "depth d=$d"
1430 0         0 $n -= 1;
1431             }
1432              
1433             ### add: "depth=$add_offset[$i] is "._depth_to_octant_added([$add_offset[$i]],[1],$zero)." x $add_mult[$i] log2_extras=$add_log2_extras[$i] top_no_extra_pow=$add_top_no_extra_pow[$i]"
1434             }
1435              
1436             ### total add: _depth_to_octant_added ([@add_offset], [@add_mult], $zero)
1437 34         71 $n += _depth_to_octant_added (\@add_offset, \@add_mult, $zero);
1438             }
1439              
1440             ### xy_to_n() return n: $n
1441 42         127 return $n;
1442             }
1443              
1444              
1445             #------------------------------------------------------------------------------
1446             # rect_to_n_range()
1447              
1448             # not exact
1449             sub rect_to_n_range {
1450 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
1451             ### OneOfEight rect_to_n_range(): "$x1,$y1 $x2,$y2"
1452              
1453 0         0 $x1 = round_nearest ($x1);
1454 0         0 $y1 = round_nearest ($y1);
1455 0         0 $x2 = round_nearest ($x2);
1456 0         0 $y2 = round_nearest ($y2);
1457 0 0       0 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
1458 0 0       0 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
1459 0         0 my $parts = $self->{'parts'};
1460              
1461 0 0       0 my $extra = ($parts eq '3side' ? 2 : 0);
1462 0         0 my ($pow,$exp) = round_down_pow (max(1,
1463             abs($x1),
1464             abs($x2)+$extra,
1465             abs($y1),
1466             abs($y2)+$extra),
1467             2);
1468              
1469 0 0       0 if ($parts eq '1') {
1470             # (total(2^k)+3)/4 = ((16*4^k + 24*k - 7)/9 + 3)/4
1471             # = (16*4^k + 24*k - 7 + 27)/9/4
1472             # = (16*4^k + 24*k + 20)/9/4
1473             # = (4*4^k + 6*k + 5)/9
1474             # applied to k=exp+1 2*pow=2^k
1475             # = (4* 2*pow * 2*pow + 6*(exp+1) + 5)/9
1476             # = (16*pow*pow + 6*exp + 11)/9
1477 0         0 return (0, (16*$pow*$pow + 6*$exp + 11) / 9);
1478             }
1479              
1480             # $parts eq '4'
1481             # total(2^k) = (16*4^k + 24*k - 7)/9
1482             # applied to k=exp+1 2*pow=2^k
1483             # = (16 * 2*pow * 2*pow + 24*(exp+1) - 7) / 9
1484             # = (64*pow*pow + 24*exp + 24-7) / 9
1485             # = (64*pow*pow + 24*exp + 17) / 9
1486 0         0 return (0, (64*$pow*$pow + 24*$exp + 17) / 9);
1487             }
1488              
1489             #------------------------------------------------------------------------------
1490             # tree
1491              
1492 1     1   8 use constant tree_num_roots => 1;
  1         2  
  1         2801  
1493              
1494             sub tree_n_to_depth {
1495 0     0 1 0 my ($self, $n) = @_;
1496             ### tree_n_to_depth(): "$n"
1497              
1498 0 0       0 if ($n < 0) {
1499 0         0 return undef;
1500             }
1501 0         0 my ($depth) = _n0_to_depth_and_rem($self, int($n));
1502             ### n0 depth: $depth
1503 0         0 return $depth;
1504             }
1505              
1506             my @surround8_dx = (1, 1, 0, -1, -1, -1, 0, 1);
1507             my @surround8_dy = (0, 1, 1, 1, 0, -1, -1, -1);
1508              
1509             sub tree_n_children {
1510 0     0 1 0 my ($self, $n) = @_;
1511             ### tree_n_children(): $n
1512              
1513 0 0       0 my ($x,$y) = $self->n_to_xy($n)
1514             or return;
1515             ### $x
1516             ### $y
1517              
1518 0         0 my $depth = $self->tree_n_to_depth($n) + 1;
1519             return
1520 0         0 sort {$a<=>$b}
1521 0         0 grep { $self->tree_n_to_depth($_) == $depth }
1522 0         0 map { $self->xy_to_n_list($x + $surround8_dx[$_],
  0         0  
1523             $y + $surround8_dy[$_]) }
1524             0 .. $#surround8_dx;
1525             }
1526             sub tree_n_parent {
1527 0     0 1 0 my ($self, $n) = @_;
1528              
1529 0 0       0 if ($n < 0) {
1530 0         0 return undef;
1531             }
1532 0 0       0 my ($x,$y) = $self->n_to_xy($n)
1533             or return undef;
1534 0         0 my $parent_depth = $self->tree_n_to_depth($n) - 1;
1535              
1536 0         0 foreach my $i (0 .. $#surround8_dx) {
1537 0         0 my $pn = $self->xy_to_n($x + $surround8_dx[$i],
1538             $y + $surround8_dy[$i]);
1539 0 0 0     0 if (defined $pn && $self->tree_n_to_depth($pn) == $parent_depth) {
1540 0         0 return $pn;
1541             }
1542             }
1543 0         0 return undef;
1544             }
1545              
1546              
1547             #------------------------------------------------------------------------------
1548             # tree_depth_to_n()
1549              
1550             # 1 1 1
1551             # 2 9 1001
1552             # 4 33 100001
1553             # 8 121 1111001
1554             # 16 465 111010001
1555             # 32 1833 11100101001
1556             # 64 7297 1110010000001
1557             # 128 29145 111000111011001
1558             # 256 116529 11100011100110001
1559             # 512 466057 1110001110010001001
1560             # 1024 1864161 111000111000111100001
1561             #
1562             # before 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1563             # side = 0, 1,3, 6,9,14,21, 27,30,35,43,52,63,80,100, 112
1564             # 3,5,8,9,11,17,20,12
1565             #
1566             # side(5) = side(4) + side(2) + 2*side(1) + 2
1567             # = 6 + 1 + 2*0 + 2 = 9
1568             # side(9) = side(8) + side(1) + 2
1569             # side(10) = side(8) + side(3) + 2*side(2) + 3 = 27 + 3 + 2*1 + 3 = 35
1570             # side(11) = side(8) + side(4) + 2*side(3) + log2(4/4) + 3 = 27+6+2*3+1+3 = 42
1571             #
1572             # side(2^k) = 4*side(2^(k-1)) -1 block 1 missing one in corner
1573             # + k-2 block 2 extra lower
1574             # + 3 centre A,B,C
1575             # = 4*side(2^(k-1)) + k
1576             # = k + (k-1)*4^1 + (k-2)*4^2 + ... + 2*4^(k-1) + 4^k
1577             # eg. k=3 3+2*4+1*16 = 27
1578             # = 1 + 1+4 + 1+4+16 = 1 + 5 + 21
1579             # sum 1+4+...+4^(k-1) = (4^k-1)/3
1580             # side(2^k) = (4^k-1)/3 + (4^(k-1)-1)/3 + ... + (4^1-1)/3
1581             # = (4^k - 1 + 4^(k-1) - 1 + ... + 4^1 - 1)/3 # k terms 4^k to 4^1
1582             # = (4^k + 4^(k-1) + ... + 4^1 - k)/3
1583             # = (4^k + 4^(k-1) + ... + 4^1 + 4^0 - 1 - k)/3
1584             # = ((4^(k+1)-1)/3 - 1 - k)/3
1585             # = (4^(k+1)-1 - 3*k - 3)/9
1586             # = (4*4^k - 3*k - 4)/9
1587             #
1588             # side(2^1=2) = 1
1589             # side(2^2=4) = 1 + 1-1 + 1+0 + 1 + 3 = 6 = 4*1 + 2 = 4^1 + 2
1590             # side(2^3=8) = 6 + 6-1 + 6+1 + 6 + 3 = 27 = 4*6 + 3 = 4^2 + 4*2+3
1591             # side(2^4=16) = 27+27-1 +27+2 +27 + 3 = 112 = 4*27 + 4 = 4^3 + 16*2+4*3+4
1592             #
1593             #
1594             #
1595             # centre(2^k) = 2*side(2^(k-1)) + 2*centre(2^(k-1))
1596             # centre(1) = 1
1597             # centre(2) = 4
1598             # centre(4) = 2*side(2) + 2*centre(2)
1599             # = 2*side(2) + 2*4
1600             # = 2*1 + 2*4 = 10
1601             # centre(8) = 2*side(4) + 2*centre(4) = 2*6+2*10 = 32
1602             # = 2*side(4) + 2*(2*side(2) + 2*4)
1603             # = 2*side(4) + 4*side(2) + 4*4
1604             # = 2*6 + 4*1 + 4*4 = 32
1605             # centre(16) = 2*side(4) + 2*centre(4) = 2*6+2*10 = 32
1606             # = 2*side(8) + 4**side(4) + 8*side(2) + 8
1607             # = 2*27 + 4*6 + 8*1 + 8 = 94
1608             #
1609             # 4parts = 4*centre - 7
1610             # 4parts(4) = 4*10-7 = 33
1611             # 4parts(8) = 4*32-7 = 121
1612             #
1613             # 3side total 0,1, 4, 9,17
1614             # +1 +3 +5 +8
1615             #
1616             # centre(2^k)
1617             # = 2*side(2^(k-1)) + 2*centre(2^(k-1))
1618             # = 2*side(2^(k-1) + 2^2*side(2^(k-1) + ... + 2^(k-1)*side(2^1) + 2^(k-1)*4
1619             # k-1 many terms, and constant at end
1620             # side(2^k) = (4*4^k - 3*k - 4)/9
1621             #
1622             # constant part
1623             # 2 + 4 + ... + 2^(k-1)
1624             # = 2^k - 2
1625             # eg. k=2 2
1626             # eg. k=3 2 + 4 = 6
1627             # eg. k=4 2 + 4 + 8 = 14
1628             #
1629             # linear part
1630             # 2*(k-1) + 4*(k-2) + ... + 2^(k-1)*(1) + 2^k*(0)
1631             # = 2^(k-1)-1 + 2^(k-2)-1 + ... + 2-1
1632             # = 2*2^k - 2*k - 2
1633             # eg. k=2 2*1 = 2
1634             # eg. k=3 2*2 + 4*1 = 8
1635             # eg. k=4 2*3 + 4*2 + 8*1 = 22
1636             # eg. k=5 2*4 + 4*3 + 8*2 + 16*1 = 52
1637             #
1638             # exponential part
1639             # 2*4^(k-1) + 4*4^(k-2) + 8*4^(k-3) + ... + 2^(k-1)*4^1
1640             # = 2^(2k-2+1) + 2^(2k-4+2) + 2^(2k-6+3) + ... + 2^(k+1)
1641             # = 2^(2k-1) + 2^(2k-2) + 2^(2k-3) + ... + 2^(k+1)
1642             # = 2^(k+1) * [ 2^(k-2) + 2^(k-3) + 2^(k-4) + ... + 2^(0) ]
1643             # = 2^(k+1) * (2^(k-1) - 1)
1644             # = 2^k * (2^k - 2)
1645             # eg. k=2 2*4^1 = 8
1646             # eg. k=3 2*4^2 + 4*4^1 = 48
1647             # eg. k=4 2*4^3 + 4*4^2 + 8*4^1 = 224
1648             # eg. k=5 2*4^4 + 4*4^3 + 8*4^2 + 16*4^1 = 960
1649             #
1650             # centre(2^k) = (4*(2^k * (2^k - 2)) - 3*(2*2^k-2*k-2) - 4*(2^k-2)) / 9 + 2*2^k
1651             # eg. k=2 sidepart = 2*1 = 1 plus
1652             # eg. k=3 sidepart = 2*6 + 4*1 = 16
1653             # eg. k=4 sidepart = 2*27 + 4*6 + 8*1 = 86
1654             # = (4*(2^k * (2^k - 2)) - 3*(2*2^k-2*k-2) - 4*(2^k-2)) / 9 + 2*2^k
1655             # = (4*2^k*(2^k - 2) - 6*2^k + 3*2*k + 6 - 4*2^k + 8 + 18*2^k) / 9
1656             # = (4*2^k*2^k - 8*2^k - 6*2^k + 3*2*k - 4*2^k + 18*2^k + 14) / 9
1657             # = (4*2^k*2^k + 6*k + 14) / 9
1658             # = (4*depth^2 + 6*k + 14) / 9
1659             #
1660             # centre(2^k) = (4*4^k + 6*k + 14) / 9
1661             # side(2^k) = (4*4^k - 3*k - 4) / 9
1662             # diff = (9k+18)/9 = k+2
1663             # double centre(2^(k+1)) - 4*centre(2^k)
1664             # = (4*4^(k+1) + 6*(k+1) + 14 - 4*(4*4^k + 6*k + 14)) / 9
1665             # = (4*4*4^k + 6*k + 6 + 14 - 4*4*4^k - 4*6*k - 4*14) / 9
1666             # = (6*k - 4*6*k + 6 + 14 - 4*14) / 9
1667             # = (-18*k - 36) / 9
1668             # = -2*k - 4
1669             # smaller than 4* on each doubling
1670             # 6k+14 term only adds extra 6, doesn't go 4*(6k+14)
1671             #
1672             # side(pow+rem) = side(pow) + side(rem+1) -1 if rem+1=pow
1673             # + side(rem)
1674             # + side(rem) + log2(rem+1) + 2
1675             # except rem==1 is side(pow)+3
1676             # eg side(5) = side(4) + 3
1677             # = 6 + 3 = 9
1678             # eg side(6) = side(4) + side(3) + 2*side(2) + log2(3)+2
1679             # = 6 + 3 + 2*1 +1 + 2 = 14
1680             #
1681             # centre(pow+rem) = centre(pow) + centre(rem) + 2*side(rem)
1682             # = 2*side(pow/2) + 4*side(pow/4) + ...
1683             # + centre(rem) + 2*side(rem)
1684              
1685             # d = p1+p2+p3+p4
1686             # C(d) = C(p1) + 2*S(p2+p3+p4) + C(p2+p3+p4)
1687             # = C(p1) + 2*S(p2+p3+p4) + C(p2) + 2*S(p3+p4) + C(p3+p4)
1688             # = C(p1) + C(p2) + 2*S(p2+p3+p4) + 2*S(p3+p4) + C(p3) + C(p4) + 2*S(p4)
1689             # = C(p1) + C(p2) + C(p3) + C(p4) + 2*S(p2+p3+p4) + 2*S(p3+p4) + 2*S(p4)
1690             # eg. C(4+1) = C(4) + C(1) + 2*S(1)
1691             # = 10 + 1 + 2*0 = 11
1692             # eg. C(4+1) = C(4) + C(2) + 2*S(2)
1693             # = 10 + 4 + 2*1 = 18
1694             # eg. C(8+1) = C(8) + C(1) + 2*S(1)
1695             # = 32 + 1 + 2*0 = 35
1696             # eg. C(8+2) = C(8) + C(2) + 2*S(2)
1697             # = 32 + 4 + 2*1 = 38
1698             # eg. C(8+4) = C(8) + C(4) + 2*S(4)
1699             # = 32 + 10 + 2*6 = 54
1700             # eg. C(8+4+1) = C(8) + C(4) + C(1) + 2*S(4+1) + 2*S(1)
1701             # = 32 + 10 + 1 + 2*9 + 2*0 = 61
1702             # eg. C(8+4+2) = C(8) + C(4) + C(2) + 2*S(4+2) + 2*S(2)
1703             # = 32 + 10 + 4 + 2*14 + 2*1 = 76
1704             #
1705             # A151735
1706             # before 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1707             # centre = 0,1,4,5, 10,11,16,21, 32,33,38,43,54,61 76 95 118
1708             #
1709             # before 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1710             # side = 0, 1,3, 6,9,14,21, 27,30,35,43,52,63,80,100, 112
1711             #
1712             # A151725 total cells 0,1,9,13, 33,37,57,77, 121,125,145,165,209,237,297,373,
1713             #
1714             #
1715             # 15 | 15 15 15 15 15 15 15 15 15 15 15 15
1716             # 14 | 14 14 14 14 15
1717             # 13 | 14 13 13 13 14 14 13 13 13 15
1718             # 12 | 14 12 12 13
1719             # 11 | 12 11 11 11 11 11 11 13 15
1720             # 10 | 14 12 10 10 11 14 14 15
1721             # 9 | 14 13 13 10 9 9 9 11 15
1722             # 8 | 8 9
1723             # 7 | 7 7 7 7 7 7 9 11 15
1724             # 6 | 6 6 7 10 10 11 14 14 15 19 18
1725             # 5 | 6 5 5 5 7 11 13 15 20 15 14 13
1726             # 4 | 4 5 13 12 12 12 13 10 12
1727             # 3 | 3 3 3 5 7 13 13 15 9 8 7 11
1728             # 2 | 2 3 6 6 7 14 14 14 14 14 15 4 6 16 17
1729             # 1 | 1 1 3 7 15 3 2 5
1730             # 0 | 0 1 0 1
1731             # +----------------------------------------------
1732             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1733             #
1734             # same mirror 1->9 same 1->9
1735             # extra log(d) in Y=8 row
1736             #
1737             # 16 | 16
1738             # 15 | 15 15 15 15 15 15 15 15 15 15 15 15 16 k=4 depth=16
1739             # 14 | 14 14 14 14 16
1740             # 13 | 14 13 13 13 14 14 13 13 13 14
1741             # 12 | 14 12 12 14
1742             # 11 | 12 11 11 11 11 11 11 12
1743             # 10 | 14 12 10 10 12 14
1744             # 9 | 14 13 13 10 9 9e 9d10 13 13 14
1745             # 8 | 8c 10 14
1746             # 7 | 7 7 7 7 7 7 8b
1747             # 6 | 6 6 8a 10 14 rotate -90 1->8
1748             # 5 | 6 5 5 5 6 9 9 10 13 13 14 miss one in corner
1749             # 4 | 4 6 10 12 14
1750             # 3 | 3 3 3 4 12 11 11 11 12
1751             # 2 | 2 4 6 12 12 14
1752             # 1 | 1 1 2 5 5 6 13 13 13 13 13 14
1753             # 0 | 0 . **** ****
1754             # +---------------------------------------------------
1755             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1756             #
1757             # Octant
1758             #
1759             # 16 |
1760             # 15 | 15
1761             # 14 | 14 15
1762             # 13 | 13 15
1763             # 12 | 12 13
1764             # 11 | 11 13 15
1765             # 10 | 10 11 14 14 15
1766             # 9 | 9 11 15
1767             # 8 | 8 9
1768             # 7 | 7 9 11 15
1769             # 6 | 6 7 10 10 11 14 14 15
1770             # 5 | 5 7 11 13 15
1771             # 4 | 4 5 13 12 12 12 13
1772             # 3 | 3 5 7 13 13 15
1773             # 2 | 2 3 6 6 7 14 14 14 14 14 15
1774             # 1 | 1 3 7 15
1775             # 0 | 0 1
1776             # +---------------------------------------------------
1777             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1778             #
1779             # oct(pow+rem) = oct(pow)
1780             # + oct(rem) # extend
1781             # + oct(rem) # upper
1782             # + oct(rem+1) # lower
1783             # - rem # undouble spine
1784             # + 2*floor(log2(rem+1)) # upper+extend log2_extras
1785             #
1786             # side(rem) = oct(rem) + oct(rem+1)
1787             # - rem # no double spine
1788             # + floor(log2(rem+1)) # upper log2_extras
1789             #
1790             # pow=2^k
1791             # oct(2*pow) = 4*oct(pow) + 2*(k-2) - (pow-2)
1792             # oct(2^0=1) = 0
1793             # oct(2^1=2) = 1
1794             # oct(2^2=4) = 4 = 4*1 - 0
1795             # oct(2^3=8) = 16 = 4*4 - 0
1796             # oct(2^4=16) = 16+7+4+7+3+4+5+4+3+3+3+2+1 = 62 = 4*16 - 2
1797              
1798             # 3side
1799             #
1800             # **** *** *** *** *** *** *** ***
1801             # * * * * * * * * *
1802             # ** ***** ***** ***** *****
1803             # * * * * * * * *
1804             # ** **** **** **** ****
1805             # * * * * * * * * * * * * *
1806             # ** *** ***** *** *** ***** ***
1807             # * * * * * * side side
1808             # ** *888 888 888 888* depth+1
1809             # * * * * 7 7 7 7 * * * upper | upper
1810             # *** *** 76667 76667 *** *** depth-1 | depth-1
1811             # * * * * 7 5 5 7 * * * \ |
1812             # ** ***** 5444 4445 ***** \ | /
1813             # * * * * 7 5 3 3 5 7 * * * lower \ | / lower
1814             # ** **** ** 766 32223 667 ** **** depth \ | / depth
1815             # 1 3 7 * ---------------------------
1816             # 01 | \ upper
1817             # 1 3 7 * | \ depth
1818             # 223 667 ** **** | \
1819             # 3 5 7 * * * | lower \
1820             # 54445 ***** | depth+1 side
1821             # 5 5 7 * * *
1822             # 66 6667 *** ***
1823             # 7 * * *
1824             # dcc 9888*
1825             # d b 9 * * *
1826             # baaa **** ***
1827             # e b * * *
1828             # dcccd *****
1829             # d d * * *
1830             # ee eee *** ****
1831             # *
1832              
1833             my @oct_to_n = (0, 1);
1834              
1835             my %tree_depth_to_n = (4 => [ 0, 1 ],
1836             1 => [ 0, 1 ],
1837             octant => [ 0, 1 ],
1838             wedge => [ 0, 1, 4 ],
1839             '3mid' => [ 0, 1 ],
1840             '3side' => [ 0, 1, 4 ],
1841             side => [ 0, 1 ]);
1842             my %tree_depth_to_n_extra_depth_pow = (4 => 0,
1843             1 => 0,
1844             octant => 0,
1845             octant_up => 0,
1846             wedge => 0,
1847             '3mid' => 1,
1848             '3side' => 1,
1849             side => 1);
1850              
1851             sub tree_depth_to_n {
1852 413     413 1 2932 my ($self, $depth) = @_;
1853             ### tree_depth_to_n(): "$depth parts=$self->{'parts'}"
1854              
1855 413         483 $depth = int($depth);
1856 413 50       767 if ($depth < 0) {
1857 0         0 return undef;
1858             }
1859              
1860 413         641 my $parts = $self->{'parts'};
1861             {
1862 413         466 my $initial = $tree_depth_to_n{$parts};
  413         626  
1863 413 100       983 if ($depth <= $#$initial) {
1864             ### table %tree_depth_to_n{}: $initial->[$depth]
1865 21         57 return $initial->[$depth];
1866             }
1867             }
1868              
1869             my ($pow,$exp) = round_down_pow
1870 392         1196 ($depth + $tree_depth_to_n_extra_depth_pow{$parts},
1871             2);
1872 392 50       4257 if (is_infinite($exp)) {
1873 0         0 return $exp;
1874             }
1875             ### $pow
1876             ### $exp
1877              
1878 392         2403 my $zero = $depth * 0; # inherit bignum
1879 392         470 my $n = $zero;
1880              
1881             # @side is a list of depth values.
1882             # @mult is the multiple of T[depth] desired for that @side entry.
1883             #
1884             # @side is mostly high to low and growing by one more value at each
1885             # $exp level, but sometimes it's a bit more and some values not high to
1886             # low and possibly duplicated.
1887             #
1888 392         641 my @pending = ($depth);
1889 392         441 my @mult;
1890              
1891 392 100 100     1035 if ($parts eq '4') {
    100          
    100          
    100          
    100          
    50          
    0          
1892 209         297 @mult = (8);
1893 209         324 $n -= 4*$depth + 7;
1894              
1895             } elsif ($parts eq '1') {
1896 123         186 @mult = (2);
1897 123         163 $n -= $depth;
1898              
1899             } elsif ($parts eq 'octant' || $parts eq 'octant_up') {
1900 27         48 @mult = (1);
1901              
1902             } elsif ($parts eq 'wedge') {
1903 9         14 push @mult, 2;
1904 9         11 $n -= 2; # unduplicate centre two
1905              
1906             } elsif ($parts eq '3mid') {
1907 12         19 unshift @pending, $depth+1;
1908 12         17 @mult = (2, 4);
1909             # Duplicated diagonals, and no log2_extras on two outermost octants.
1910             # Each log2 at depth=2^k-2, so another log2 decrease when depth=2^k-1.
1911             # $exp == _log2_floor($depth+1) so at $depth==2*$pow-1 one less.
1912 12         23 $n -= 3*$depth + 2*$exp + 6;
1913              
1914             } elsif ($parts eq '3side') {
1915 12         27 @pending = ($depth+1, $depth, $depth-1);
1916 12         20 @mult = (1, 3, 2);
1917             # Duplicated diagonals, and no log2_extras on two outermost octants.
1918             # For plain depth each log2 at depth=2^k-2, so another log2 decrease
1919             # when depth=2^k-1.
1920             # For depth+1 block each log2 at depth=2^k-2, so another log2 decrease
1921             # when depth=2^k-2.
1922             # $exp == _log2_floor($depth+1) so at $depth==2*$pow-1 one less.
1923 12 100       27 $n -= 3*$depth + 2*$exp + ($depth == $pow-1 ? 3 : 4);
1924              
1925             } elsif ($parts eq 'side') {
1926 0         0 unshift @pending, $depth+1;
1927 0         0 @mult = (1, 1);
1928             # $exp == _log2_floor($depth+1)
1929 0         0 $n -= $depth + 1 + $exp;
1930             }
1931              
1932 392   100     1751 while ($exp >= 0 && @pending) {
1933             ### at: "pow=$pow exp=$exp n=$n"
1934             ### assert: $pow == 2 ** $exp
1935             ### pending: join(',',@pending)
1936             ### mult: join(',',@mult)
1937              
1938 469         617 my @new_pending;
1939             my @new_mult;
1940 0         0 my $oct_pow;
1941 469         666 foreach my $depth (@pending) {
1942 566         650 my $mult = shift @mult;
1943             ### assert: $depth >= 0
1944              
1945 566 100       1079 if ($depth <= 1) {
1946             ### small depth: "depth=$depth mult=$mult * $oct_to_n[$depth]"
1947 3         5 $n += $mult * $depth; # oct=0 at depth=0, oct=1 at depth=1
1948 3         6 next;
1949             }
1950 563         695 my $rem = $depth - $pow;
1951 563 100       1022 if ($rem < 0) {
1952 24         26 push @new_pending, $depth;
1953 24         53 push @new_mult, $mult;
1954 24         43 next;
1955             }
1956              
1957             ### $depth
1958             ### $mult
1959             ### $rem
1960             ### assert: $rem >= 0 && $rem < $pow
1961              
1962 539         659 my $powmult = $mult;
1963 539 100       977 if ($rem <= 1) {
1964 474 100       893 if ($rem == 0) {
1965             ### rem=0, oct(pow) only ...
1966             } else { # $rem == 1
1967             ### rem=1, oct(pow)+1 ...
1968 177         231 $n += $mult;
1969             }
1970             } else {
1971             ### formula ...
1972             # oct(pow+rem) = oct(pow)
1973             # + oct(rem+1)
1974             # + 2*oct(rem)
1975             # - floor(log2(rem+1))
1976             # - rem - 3
1977              
1978 65         81 my $rem1 = $rem + 1;
1979             {
1980 65         63 my ($lpow,$lexp) = round_down_pow ($rem1, 2);
  65         192  
1981 65         656 $n -= ($lexp + $rem + 3)*$mult;
1982             ### sub also: ($lexp + $rem + 3). " *mult=$mult"
1983             }
1984 65 100 33     211 if ($rem1 == $pow) {
    50          
1985             ### rem+1 == pow, increase powmult ...
1986 16         21 $powmult *= 2; # oct(pow)+oct(rem+1) is 2*oct(pow)
1987             } elsif (@new_pending && $new_pending[-1] == $rem1) {
1988             ### merge into previously pushed new_pending[] ...
1989             # print "rem+1=$rem1 ",join(',',@new_pending),"\n";
1990 0         0 $new_mult[-1] += $mult;
1991             } else {
1992             ### push: "depth=$rem1 mult=$mult"
1993 49         65 push @new_pending, $rem1;
1994 49         70 push @new_mult, $mult;
1995             }
1996              
1997             ### push: "depth=$rem mult=".2*$mult
1998 65         86 push @new_pending, $rem;
1999 65         98 push @new_mult, 2*$mult;
2000             }
2001              
2002             # oct(pow) = (2*pow*pow + 3*exp + 7)/9 + pow/2
2003             # = ((4*pow+9)*pow + 6*exp + 14)/18
2004             #
2005 539   66     1731 $oct_pow ||= ((4*$pow+9)*$pow + 6*$exp + 14)/18;
2006 539         1029 $n += $oct_pow * $powmult;
2007             ### oct(pow): "pow=$pow is $oct_pow * powmult=$powmult"
2008             }
2009 469         786 @pending = @new_pending;
2010 469         617 @mult = @new_mult;
2011              
2012 469         499 $exp--;
2013 469         2117 $pow /= 2;
2014             }
2015              
2016             ### return: $n
2017 392         834 return $n;
2018             }
2019              
2020              
2021             # _depth_to_octant_added() returns the number of cells added at a given
2022             # $depth level in parts=octant. This is the same as
2023             # $added = tree_depth_to_n(depth+1) - tree_depth_to_n(depth)
2024             #
2025             # @$depth_aref is a list of depth values.
2026             # @$mult_aref is the multiple of oct(depth) desired for each @depth_aref.
2027             #
2028             # On input @$depth_aref must have $depth_aref->[0] as the highest value.
2029             #
2030             # Within the code the depth list is mostly high to low and growing by one
2031             # extra depth value at each $exp level. But sometimes it grows a bit more
2032             # than that and sometimes the values are not high to low, and sometimes
2033             # there's duplication.
2034             #
2035             my @_depth_to_octant_added = (1, 2, 1); # depth=0to2 small values
2036              
2037             sub _depth_to_octant_added {
2038 122     122   170 my ($depth_aref, $mult_aref, $zero) = @_;
2039             ### _depth_to_octant_added(): join(',',@$depth_aref)
2040             ### mult_aref: join(',',@$mult_aref)
2041             ### assert: scalar(@$depth_aref) == scalar(@$mult_aref)
2042              
2043             # $depth_aref->[0] must be the biggest depth, to make the $pow finding easy
2044             ### assert: scalar(@$depth_aref) >= 1
2045             ### assert: max(@$depth_aref) == $depth_aref->[0]
2046              
2047 122         314 my ($pow,$exp) = round_down_pow ($depth_aref->[0], 2);
2048 122 50       1276 if (is_infinite($exp)) {
2049 0         0 return $exp;
2050             }
2051             ### $pow
2052             ### $exp
2053              
2054 122         711 my $added = $zero;
2055              
2056             # running $pow down to 2 (inclusive)
2057 122   66     552 while ($exp >= 0 && @$depth_aref) {
2058             ### at: "pow=$pow exp=$exp"
2059             ### assert: $pow == 2 ** $exp
2060              
2061             ### depth: join(',',@$depth_aref)
2062             ### mult: join(',',@$mult_aref)
2063 127         190 my @new_depth;
2064             my @new_mult;
2065 127         204 foreach my $depth (@$depth_aref) {
2066 132         174 my $mult = shift @$mult_aref;
2067             ### assert: $depth >= 0
2068              
2069 132 100       354 if ($depth <= $#_depth_to_octant_added) {
2070             ### small depth: "depth=$depth mult=$mult * $_depth_to_octant_added[$depth]"
2071 17         22 $added += $mult * $_depth_to_octant_added[$depth];
2072 17         31 next;
2073             }
2074 115 50       226 if ($depth < $pow) {
2075 0         0 push @new_depth, $depth;
2076 0         0 push @new_mult, $mult;
2077 0         0 next;
2078             }
2079              
2080 115         160 my $rem = $depth - $pow;
2081              
2082             ### $depth
2083             ### $mult
2084             ### $rem
2085             ### assert: $rem >= 0 && $rem < $pow
2086              
2087 115 100       187 if ($rem <= 1) {
2088 99 100       160 if ($rem == 0) {
2089             ### rem=0, grow 1 ...
2090 8         17 $added += $mult;
2091             } else {
2092             ### rem=1, grow 3 ...
2093 91         189 $added += 3 * $mult;
2094             }
2095             } else {
2096 16         17 my $rem1 = $rem + 1;
2097 16 100       27 if ($rem1 == $pow) {
2098             ### rem+1=pow, no lower part, 3/2 of pow ...
2099 11         26 $added += ($pow/2) * (3*$mult);
2100             } else {
2101             ### formula ...
2102             # oadd(pow+rem) = oadd(rem+1) + 2*oadd(rem)
2103             # + (is_pow2($rem+2) ? -2 : -1)
2104              
2105             # upper/lower diagonal overlap, and no log2_extras in lower
2106 5 50       12 $added -= (_is_pow2($rem+2) ? 2*$mult : $mult);
2107              
2108 5 50 33     17 if (@new_depth && $new_depth[-1] == $rem1) {
2109             ### merge into previously pushed new_depth ...
2110             # print "rem=$rem ",join(',',@new_depth),"\n";
2111 0         0 $new_mult[-1] += $mult;
2112             } else {
2113             ### push: "rem+1 depth=$rem1 mult=$mult"
2114 5         9 push @new_depth, $rem1;
2115 5         14 push @new_mult, $mult;
2116             }
2117              
2118             ### push: "rem depth=$rem mult=".2*$mult
2119 5         6 push @new_depth, $rem;
2120 5         11 push @new_mult, 2*$mult;
2121             }
2122             }
2123             }
2124 127         167 $depth_aref = \@new_depth;
2125 127         166 $mult_aref = \@new_mult;
2126              
2127 127         168 $exp--;
2128 127         637 $pow /= 2;
2129             }
2130              
2131             ### return: $added
2132 122         252 return $added;
2133             }
2134              
2135              
2136             #------------------------------------------------------------------------------
2137             # tree_n_to_subheight()
2138              
2139             #use Smart::Comments;
2140              
2141             {
2142             my %tree_n_to_subheight
2143             = do {
2144             my $depth0 = [ ]; # depth=0
2145             (wedge => [ $depth0,
2146             [ undef, 0 ], # depth=1
2147             ],
2148             '3mid' => [ $depth0,
2149             [ undef, 0, undef, 0 ], # depth=1
2150             ],
2151             '3side' => [ $depth0,
2152             [ undef, 0, undef ], # depth=1
2153             [ 0, undef, undef, 0 ], # depth=2 N=4to8
2154             ],
2155             )
2156             };
2157              
2158             sub tree_n_to_subheight {
2159 0     0 1 0 my ($self, $n) = @_;
2160             ### tree_n_to_subheight(): $n
2161              
2162 0 0       0 if ($n < 0) { return undef; }
  0         0  
2163 0 0       0 if (is_infinite($n)) { return $n; }
  0         0  
2164              
2165 0         0 my $zero = $n * 0;
2166 0         0 (my $depth, $n) = _n0_to_depth_and_rem($self, int($n));
2167             ### $depth
2168             ### $n
2169              
2170 0         0 my $parts = $self->{'parts'};
2171 0 0       0 if (my $initial = $tree_n_to_subheight{$parts}->[$depth]) {
2172             ### $initial
2173 0         0 return $initial->[$n];
2174             }
2175              
2176 0 0       0 if ($parts eq 'octant') {
    0          
    0          
    0          
    0          
2177 0         0 my $add = _depth_to_octant_added ([$depth],[1], $zero);
2178 0         0 $n = $add-1 - $n;
2179             ### octant mirror numbering to n: $n
2180              
2181             } elsif ($parts eq 'octant_up') {
2182              
2183             } elsif ($parts eq 'wedge') {
2184 0         0 my $add = _depth_to_octant_added ([$depth],[1], $zero);
2185             ### assert: $n < 2*$add
2186 0 0       0 if ($n >= $add) {
2187             ### wedge second half ...
2188 0         0 $n = 2*$add-1 - $n; # mirror
2189             }
2190              
2191             } elsif ($parts eq '3mid') {
2192 0         0 my $add = _depth_to_octant_added ([$depth+1],[1], $zero);
2193 0 0       0 if (_is_pow2($depth+2)) { $add -= 1; }
  0         0  
2194             ### $add
2195              
2196 0         0 $n -= $add-1;
2197             ### n decrease to: $n
2198 0 0       0 if ($n < 0) {
2199             ### 3mid first octant, mirror ...
2200 0         0 $n = - $n;
2201 0         0 $depth += 1;
2202             }
2203              
2204 0         0 $add = _depth_to_octant_added ([$depth],[1], $zero);
2205 0         0 my $end = 4*$add - 2;
2206             ### $add
2207             ### $end
2208 0 0       0 if ($n >= $end) {
2209             ### 3mid last octant ...
2210 0         0 $n -= $end;
2211 0         0 $depth += 1;
2212             } else {
2213 0         0 $n %= 2*$add-1;
2214 0 0       0 if ($n >= $add) {
2215             ### 3mid second half, mirror ...
2216 0         0 $n = 2*$add-1 - $n;
2217             }
2218             }
2219              
2220             } elsif ($parts eq '3side') {
2221 0         0 my $add = _depth_to_octant_added ([$depth+1],[1], $zero);
2222 0 0       0 if (_is_pow2($depth+2)) { $add -= 1; }
  0         0  
2223             ### $add
2224              
2225 0         0 $n -= $add-1;
2226             ### n decrease to: $n
2227 0 0       0 if ($n < 0) {
2228             ### 3side first octant, mirror ...
2229 0         0 $n = - $n;
2230 0         0 $depth += 1;
2231             }
2232              
2233 0         0 $add = _depth_to_octant_added ([$depth],[1], $zero);
2234 0 0       0 if ($n < 2*$add) {
2235 0 0       0 if ($n >= $add) {
2236 0         0 $n = 2*$add-1 - $n;
2237             }
2238             } else {
2239 0         0 $n -= 2*$add-1;
2240              
2241 0         0 $add = _depth_to_octant_added ([$depth-1],[1], $zero);
2242 0 0       0 if ($n < 2*$add) {
2243 0         0 $depth -= 1;
2244 0 0       0 if ($n >= $add) {
2245 0         0 $n = 2*$add-1 - $n;
2246             }
2247             } else {
2248 0         0 $n -= 2*$add-1;
2249             }
2250             }
2251              
2252             } else {
2253             ### assert: $parts eq '1' || $parts eq '4'
2254 0 0       0 if ($depth == 1) {
2255 0 0       0 return ($n % 2 ? undef : 0);
2256             }
2257 0         0 my $add = _depth_to_octant_added([$depth],[1], $zero);
2258              
2259             # quadrant rotate ...
2260 0         0 $n %= 2*$add-1;
2261              
2262 0         0 $n -= $add;
2263 0 0       0 if ($n < 0) {
2264             ### lower octant ...
2265 0         0 $n = -1-$n; # mirror
2266             } else {
2267             ### upper octant ...
2268 0         0 $n += 1; # undouble spine
2269             }
2270             }
2271              
2272 0         0 my $dbase;
2273 0         0 my ($pow,$exp) = round_down_pow ($depth, 2);
2274              
2275 0         0 for ( ; $exp-- >= 0; $pow /= 2) {
2276             ### at: "depth=$depth pow=$pow n=$n dbase=".($dbase||'inf')
2277             ### assert: $n >= 0
2278              
2279 0 0       0 if ($n == 0) {
2280             ### n=0 on spine ...
2281 0         0 last;
2282             }
2283 0 0       0 next if $depth < $pow;
2284              
2285 0 0       0 if (defined $dbase) { $dbase = $pow; }
  0         0  
2286 0         0 $depth -= $pow;
2287             ### depth remaining: $depth
2288              
2289 0 0       0 if ($depth == 1) {
2290             ### assert: 1 <= $n && $n <= 2
2291 0 0       0 if ($n == 1) {
2292             ### depth=1 and n=1 remaining ...
2293 0         0 return 0;
2294             }
2295 0         0 $n += 1;
2296             }
2297              
2298 0         0 my $add = _depth_to_octant_added ([$depth],[1], $zero);
2299             ### $add
2300              
2301 0 0       0 if ($n < $add) {
2302             ### extend part, unchanged ...
2303             } else {
2304 0         0 $dbase = $pow;
2305 0         0 $n -= 2*$add;
2306             ### sub 2*add to: $n
2307              
2308 0 0       0 if ($n < 0) {
2309             ### upper part, mirror to n: -1 - $n
2310 0         0 $n = -1 - $n; # mirror, $n = $add-1 - $n = -($n-$add) - 1
2311             } else {
2312             ### lower part ...
2313 0         0 $depth += 1;
2314 0         0 $n += 1; # undouble upper,lower spine
2315             }
2316             }
2317              
2318             }
2319              
2320             ### final ...
2321             ### $dbase
2322             ### $depth
2323 0 0       0 return (defined $dbase ? $dbase - $depth - 1 : undef);
2324             }
2325             }
2326              
2327             #------------------------------------------------------------------------------
2328             # levels
2329              
2330             sub level_to_n_range {
2331 70     70 1 2866 my ($self, $level) = @_;
2332 70         106 my $depth = 2**$level;
2333 70 100       201 unless ($self->{'parts'} eq '3side') { $depth -= 1; }
  60         88  
2334 70         179 return (0, $self->tree_depth_to_n_end($depth));
2335             }
2336             sub n_to_level {
2337 0     0 1 0 my ($self, $n) = @_;
2338 0         0 my $depth = $self->tree_n_to_depth($n);
2339 0 0       0 if (! defined $depth) { return undef; }
  0         0  
2340 0 0       0 unless ($self->{'parts'} eq '3side') { $depth += 1; }
  0         0  
2341 0         0 my ($pow, $exp) = round_up_pow ($depth, 2);
2342 0         0 return $exp;
2343             }
2344              
2345             #------------------------------------------------------------------------------
2346              
2347             # return true if $n is a power 2^k for k>=0
2348             sub _is_pow2 {
2349 8     8   10 my ($n) = @_;
2350 8         19 my ($pow,$exp) = round_down_pow ($n, 2);
2351 8         86 return ($n == $pow);
2352             }
2353             sub _log2_floor {
2354 0     0     my ($n) = @_;
2355 0 0         if ($n < 2) { return 0; }
  0            
2356 0           my ($pow,$exp) = round_down_pow ($n, 2);
2357 0           return $exp;
2358             }
2359              
2360             1;
2361             __END__