File Coverage

blib/lib/Math/PlanePath/OneOfEight.pm
Criterion Covered Total %
statement 347 887 39.1
branch 136 392 34.6
condition 30 98 30.6
subroutine 20 37 54.0
pod 21 21 100.0
total 554 1435 38.6


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