File Coverage

blib/lib/Math/PlanePath/ChanTree.pm
Criterion Covered Total %
statement 171 291 58.7
branch 66 142 46.4
condition 26 84 30.9
subroutine 19 38 50.0
pod 21 22 95.4
total 303 577 52.5


line stmt bran cond sub pod time code
1             # Copyright 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             # digit_direction LtoH
20             # digit_order HtoL
21             # reduced = bool
22             # points = even, all_mul, all_div
23              
24             # points=all wrong
25             #
26             # Chan corollary 3 taking frac(2n) = b(2n) / b(2n+1)
27             # frac(2n+1) = b(2n+1) / 2*b(2n+2)
28             # at N odd multiply 2 into denominator,
29             # which is divide out 2 from numerator since b(2n+1) odd terms are even
30             #
31              
32             package Math::PlanePath::ChanTree;
33 1     1   642 use 5.004;
  1         4  
34 1     1   6 use strict;
  1         2  
  1         36  
35             #use List::Util 'max';
36             *max = \&Math::PlanePath::_max;
37              
38 1     1   6 use vars '$VERSION', '@ISA';
  1         2  
  1         51  
39             $VERSION = 129;
40 1     1   18 use Math::PlanePath;
  1         3  
  1         46  
41             @ISA = ('Math::PlanePath');
42              
43             use Math::PlanePath::Base::Generic
44 1         50 'is_infinite',
45 1     1   6 'round_nearest';
  1         2  
46             use Math::PlanePath::Base::Digits
47 1         85 'round_down_pow',
48             'digit_split_lowtohigh',
49 1     1   532 'digit_join_lowtohigh';
  1         2  
50             *_divrem = \&Math::PlanePath::_divrem;
51             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
52              
53 1     1   8 use Math::PlanePath::CoprimeColumns;
  1         2  
  1         41  
54             *_coprime = \&Math::PlanePath::CoprimeColumns::_coprime;
55              
56 1     1   6 use Math::PlanePath::GcdRationals;
  1         2  
  1         71  
57             *_gcd = \&Math::PlanePath::GcdRationals::_gcd;
58              
59             # uncomment this to run the ### lines
60             # use Smart::Comments;
61              
62              
63 1         81 use constant parameter_info_array =>
64             [ { name => 'k',
65             display => 'k',
66             type => 'integer',
67             default => 3,
68             minimum => 2,
69             },
70              
71             # Not sure about these yet.
72             # { name => 'reduced',
73             # display => 'Reduced',
74             # type => 'boolean',
75             # default => 0,
76             # },
77             # { name => 'points',
78             # share_key => 'points_ea',
79             # display => 'Points',
80             # type => 'enum',
81             # default => 'even',
82             # choices => ['even','all_mul','all_div'],
83             # choices_display => ['Even','All Mul','All Div'],
84             # when_name => 'k',
85             # when_condition => 'odd',
86             # },
87             # { name => 'digit_order',
88             # display => 'Digit Direction',
89             # type => 'enum',
90             # default => 'HtoL',
91             # choices => ['HtoL','LtoH'],
92             # choices_display => ['High to Low','Low to High'],
93             # },
94              
95             Math::PlanePath::Base::Generic::parameter_info_nstart0(),
96 1     1   6 ];
  1         2  
97              
98 1     1   8 use constant class_x_negative => 0;
  1         2  
  1         57  
99 1     1   7 use constant class_y_negative => 0;
  1         2  
  1         57  
100              
101 1     1   7 use constant x_minimum => 1;
  1         2  
  1         43  
102 1     1   6 use constant y_minimum => 1;
  1         2  
  1         401  
103              
104             sub sumxy_minimum {
105 0     0 1 0 my ($self) = @_;
106 0 0 0     0 return ($self->{'reduced'} || $self->{'k'} == 2
107             ? 2 # X=1,Y=1 if reduced or k=2
108             : 3); # X=1,Y=2
109             }
110             sub absdiffxy_minimum {
111 0     0 1 0 my ($self) = @_;
112 0 0       0 return ($self->{'k'} & 1
113             ? 1 # k odd, X!=Y since one odd one even
114             : 0); # k even, has X=Y in top row
115             }
116             sub rsquared_minimum {
117 0     0 1 0 my ($self) = @_;
118             return ($self->{'k'} == 2
119 0 0 0     0 || ($self->{'reduced'} && ($self->{'k'} & 1) == 0)
120             ? 2 # X=1,Y=1 reduced k even, including k=2 top 1/1
121             : 5); # X=1,Y=2
122             }
123             sub gcdxy_maximum {
124 0     0 0 0 my ($self) = @_;
125             return ($self->{'k'} == 2 # k=2, RationalsTree CW above
126 0 0 0     0 || $self->{'reduced'}
127             ? 1
128             : undef); # other, unlimited
129             }
130              
131             sub absdx_minimum {
132 0     0 1 0 my ($self) = @_;
133 0 0       0 return ($self->{'k'} & 1
134             ? 1 # k odd
135             : 0); # k even, dX=0,dY=-1 at N=k/2 middle of roots
136             }
137             sub absdy_minimum {
138 0     0 1 0 my ($self) = @_;
139 0 0 0     0 return ($self->{'k'} == 2 || ($self->{'k'} & 1)
140             ? 1 # k=2 or k odd
141             : 0); # k even, dX=1,dY=0 at N=k/2-1 middle of roots
142             }
143              
144             sub dir_minimum_dxdy {
145 0     0 1 0 my ($self) = @_;
146 0 0       0 return ($self->{'k'} == 2
147             ? (0,1) # k=2, per RationalsTree CW
148              
149             # otherwise East
150             # k even exact dX=1,dY=0 middle of roots
151             # k odd infimum dX=big,dY=-1 eg k=5 N="2222220"
152             : (1,0));
153             }
154              
155             sub tree_num_children_list {
156 4     4 1 8 my ($self) = @_;
157 4         14 return ($self->{'k'}); # complete tree, always k children
158             }
159 1     1   8 use constant tree_n_to_subheight => undef; # complete trees, all infinite
  1         9  
  1         2547  
160              
161             sub turn_any_left {
162 0     0 1 0 my ($self) = @_;
163 0   0     0 return ($self->{'k'} <= 3 || $self->{'reduced'});
164             }
165             sub turn_any_straight {
166 0     0 1 0 my ($self) = @_;
167 0         0 return ($self->{'k'} >= 7);
168             }
169              
170             # left reduced=1,k=5,7,9,11 at N=51,149,327,609,...
171             sub _UNDOCUMENTED__turn_any_left_at_n {
172 0     0   0 my ($self) = @_;
173 0 0 0     0 if ($self->{'k'} == 5 && $self->{'reduced'}) { return 51; }
  0         0  
174 0 0 0     0 if ($self->{'k'} == 7 && $self->{'reduced'}) { return 149; }
  0         0  
175 0         0 return undef;
176             }
177              
178              
179             #------------------------------------------------------------------------------
180              
181             sub new {
182 9     9 1 1788 my $self = shift->SUPER::new(@_);
183              
184 9   50     144 $self->{'digit_order'} ||= 'HtoL'; # default
185              
186 9   100     29 my $k = ($self->{'k'} ||= 3); # default
187 9         24 $self->{'half_k'} = int($k / 2);
188              
189 9 100       23 if (! defined $self->{'n_start'}) {
190 4         8 $self->{'n_start'} = 0; # default
191             }
192              
193 9   50     34 $self->{'points'} ||= 'even';
194 9         20 return $self;
195             }
196              
197             # rows
198             # level=0 k-1
199             # level=1 k * (k-1)
200             # level=2 k^2 * (k-1)
201             # total (k-1)*(1+k+k^2+...+k^level)
202             # = (k-1)*(k^(level+1) - 1)/(k-1)
203             # = k^(level+1) - 1
204             #
205             # middle odd
206             # k(r+s)/2-r-2s / k(r+s)/2-s
207             # (k-1)(r+s)/2+r / (k-1)(r+s)/2+s
208             # k(r+s)/2-r-2s / k(r+s)/2-s
209             #
210             # k=5
211             # 5(r+2)/2 -r-2s / 5(r+s)/2-s
212             #
213             # (1 + 2*x + 3*x^2 + 2*x^3 + x^4 + 2*x^5 + 3*x^6 + 2*x^7 + x^8)
214             # * (1 + 2*x^5 + 3*x^10 + 2*x^15 + x^20 + 2*x^25 + 3*x^30 + 2*x^35 + x^40)
215             # * (1 + 2*x^(25*1) + 3*x^(25*2) + 2*x^(25*3) + x^(25*4) + 2*x^(25*5) + 3*x^(25*6) + 2*x^(25*7) + x^(25*8))
216             #
217             # 1 2 3 2
218             # 1 4 7 8 5 2 7 12 13 8 3 8
219              
220             # x^48 + 2*x^47 + 3*x^46 + 2*x^45 + x^44 + 4*x^43 + 7*x^42 + 8*x^41 + 5*x^40 + 2*x^39 + 7*x^38 + 12*x^37 + 13*x^36 + 8*x^35 + 3*x^34 + 8*x^33 + 13*x^32 + 12*x^31 + 7*x^30 + 2*x^29 + 5*x^28 + 8*x^27 + 7*x^26 + 4*x^25 + x^24 + 4*x^23 + 7*x^22 + 8*x^21 + 5*x^20 + 2*x^19 + 7*x^18 + 12*x^17 + 13*x^16 + 8*x^15 + 3*x^14 + 8*x^13 + 13*x^12 + 12*x^11 + 7*x^10 + 2*x^9 + 5*x^8 + 8*x^7 + 7*x^6 + 4*x^5 + x^4 + 2*x^3 + 3*x^2 + 2*x + 1
221              
222              
223             sub n_to_xy {
224 72     72 1 3596 my ($self, $n) = @_;
225             ### ChanTree n_to_xy(): "$n k=$self->{'k'} reduced=".($self->{'reduced'}||0)
226              
227 72 50       168 if ($n < $self->{'n_start'}) { return; }
  0         0  
228              
229 72         114 $n -= $self->{'n_start'}-1;
230             ### 1-based N: $n
231 72 50       191 if (is_infinite($n)) { return ($n,$n); }
  0         0  
232              
233             {
234 72         162 my $int = int($n);
  72         168  
235 72 50       145 if ($n != $int) {
236 0         0 my $frac = $n - $int; # inherit possible BigFloat/BigRat
237 0         0 $int += $self->{'n_start'}-1; # back to n_start() based
238 0         0 my ($x1,$y1) = $self->n_to_xy($int);
239 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
240 0         0 my $dx = $x2-$x1;
241 0         0 my $dy = $y2-$y1;
242 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
243             }
244             }
245              
246 72         108 my $k = $self->{'k'};
247 72         140 my $half_k = int($self->{'k'} / 2);
248 72         133 my $half_ceil = int(($self->{'k'}+1) / 2);
249 72         181 my @digits = digit_split_lowtohigh ($n, $k);
250             ### @digits
251              
252             # top 1/2, 2/3, ..., (k/2-1)/(k/2), (k/2)/(k/2) ... 3/2, 2/1
253 72         125 my $x = (pop @digits) + ($n*0); # inherit bignum zero
254 72         131 my $y = $x+1;
255 72 100       137 if ($x > $half_k) {
256 20         30 $x = $k+1 - $x;
257             }
258 72 100       141 if ($y > $half_k) {
259 44         64 $y = $k+1 - $y;
260             }
261             ### top: "x=$x y=$y"
262              
263              
264             # 1/2 2/3 3/4 ...
265             # 1/4 4/7 7/10 10/13 ...
266              
267             # descend
268             #
269             # middle even
270             # (k/2-1)(r+s)-s / (k/2)(r+s)-s
271             # (k/2)(r+s)-s / (k/2)(r+s)
272             # (k/2)(r+s) / (k/2)(r+s)-r
273             # (k/2)(r+s)-r / (k/2-1)(r+s)-r
274             #
275             # k=4 r/s=1/2
276             # r/2r+s 1/4
277             # 2r+s/2r+2s 4/6
278             # 2r+2s/r+2s 6/5
279             # r+2s/s 5/1
280             #
281             # even eg k=4 half_k==2 half_ceil==2
282             # x + 0*(x+y) / x + 1*(x+y) 0 1x+0y / 2x+1y <1/2
283             # x + 1*(x+y) / 2*(x+y) 1 2x+1y / 2x+2y <2/3
284             # 2*(x+y) / 1*(x+y) + y 2 2x+2y / 1x+2y >3/2
285             # 1*(x+y) + y / 0*(x+y) + y 3 1x+2y / 0x+1y >2/1
286             #
287             # even eg k=6 half_k==3 half_ceil==3
288             # x + 0*(x+y) / x + 1*(x+y) 0 1x+0y / 2x+1y
289             # x + 1*(x+y) / x + 2*(x+y) 1 2x+1y / 3x+2y
290             # x + 2*(x+y) / 3(x+y) 2 3x+2y / 3x+3y
291             # 3*(x+y) / 2*(x+y) + y 3 3x+3y / 2x+3y
292             # 2*(x+y) + y / 1*(x+y) + y 4 2x+3y / 1x+2y
293             # 1*(x+y) + y / 0*(x+y) + y 5 1x+2y / 0x+1y
294             #
295             # odd eg k=3 half_k==1 half_ceil==2
296             # x + 0*(x+y) / x + 1*(x+y) 0 1x+0y / 2x+1y <1/2
297             # x + 1*(x+y) / 1*(x+y) + y 1 2x+1y / 1x+2y
298             # 1*(x+y) + y / 0*(x+y) + y 2 1x+2y / 0x+1y >2/1
299             #
300             # odd eg k=5 half_k==2 half_ceil==3
301             # x + 0*(x+y) / x + 1*(x+y) 0 1x+0y / 2x+1y <1/2
302             # x + 1*(x+y) / x + 2*(x+y) 1 2x+1y / 3x+2y <2/3
303             # x + 2*(x+y) / 2*(x+y) + y 2 3x+2y / 2x+3y
304             # 2*(x+y) + y / 1*(x+y) + y 3 2x+3y / 1x+2y >3/2
305             # 1*(x+y) + y / 0*(x+y) + y 4 1x+2y / 0x+1y >2/1
306              
307 72 50       153 if ($self->{'digit_order'} eq 'HtoL') {
308 72         119 @digits = reverse @digits; # high to low is the default
309             }
310 72         116 foreach my $digit (@digits) {
311             # c1 = 1,2,3,3,2,1 or 1,2,3,2,1
312 64 100       109 my $c0 = ($digit <= $half_ceil ? $digit : $k-$digit+1);
313 64 100       115 my $c1 = ($digit < $half_ceil ? $digit+1 : $k-$digit);
314 64 100       129 my $c2 = ($digit < $half_ceil-1 ? $digit+2 : $k-$digit-1);
315             ### at: "x=$x y=$y next digit=$digit $c1,$c0 $c2,$c1"
316              
317 64         137 ($x,$y) = ($x*$c1 + $y*$c0,
318             $x*$c2 + $y*$c1);
319             }
320             ### loop: "x=$x y=$y"
321              
322 72 100 100     197 if (($k & 1) && ($n % 2) == 0) { # odd N=2n+1 when 1 based
323 8 50       22 if ($self->{'points'} eq 'all_div') {
    50          
324 0         0 $x /= 2;
325             ### all_div divide X to: "x=$x y=$y"
326             } elsif ($self->{'points'} eq 'all_mul') {
327 0 0 0     0 if ($self->{'reduced'} && ($x % 2) == 0) {
328 0         0 $x /= 2;
329             ### all_mul reduced divide X to: "x=$x y=$y"
330             } else {
331 0         0 $y *= 2;
332             ### all_mul multiply Y to: "x=$x y=$y"
333             }
334             }
335             }
336              
337 72 100       130 if ($self->{'reduced'}) {
338             ### unreduced: "x=$x y=$y"
339 18 50       33 if ($k & 1) {
340             # k odd, gcd(x,y)=k^m for some m, divide out factors of k as possible
341 0         0 foreach (0 .. scalar(@digits)) {
342 0 0 0     0 last if ($x % $k) || ($y % $k);
343 0         0 $x /= $k;
344 0         0 $y /= $k;
345             }
346             } else {
347             # k even, gcd(x,y) divides (k/2)^m for some m, but gcd isn't
348             # necessarily equal to such a power, only a divisor of it, so must do
349             # full gcd calculation
350 18         47 my $g = _gcd($x,$y);
351 18         37 $x /= $g;
352 18         29 $y /= $g;
353             }
354             }
355              
356             ### n_to_xy() return: "x=$x y=$y"
357 72         186 return ($x,$y);
358             }
359              
360             # (3*pow+1)/2 - (pow+1)/2
361             # = (3*pow + 1 - pow - 1)/2
362             # = (2*pow)/2
363             # = pow
364             #
365             sub xy_to_n {
366 36     36 1 3303 my ($self, $x, $y) = @_;
367             ### Chan xy_to_n(): "x=$x y=$y k=$self->{'k'}"
368              
369 36         100 $x = round_nearest ($x);
370 36         67 $y = round_nearest ($y);
371              
372 36 50       86 if (is_infinite($x)) {
373 0         0 return $x; # infinity
374             }
375 36 50       80 if (is_infinite($y)) {
376 0         0 return $y; # infinity
377             }
378 36         63 my $orig_x = $x;
379 36         52 my $orig_y = $y;
380              
381 36         61 my $k = $self->{'k'};
382 36         54 my $zero = ($x * 0 * $y); # inherit bignum
383 36         48 my $half_k = $self->{'half_k'};
384 36         119 my $half_ceil = int(($self->{'k'}+1) / 2);
385              
386 36 100       81 if ($k & 1) {
387 9 0 33     49 if ($self->{'points'} eq 'all_div'
      33        
388             || ($self->{'points'} eq 'all_mul' && ($self->{'reduced'}))) {
389 0         0 my $n = do {
390 0         0 local $self->{'points'} = 'even';
391 0         0 $self->xy_to_n(2*$x,$y)
392             };
393 0 0       0 if (defined $n) {
394 0         0 my ($nx,$ny) = $self->n_to_xy($n);
395 0 0 0     0 if ($nx == $x && $ny == $y) {
396 0         0 return $n;
397             }
398             }
399             }
400 9 50 33     21 if ($self->{'points'} eq 'all_mul' && ($y % 2) == 0) {
401 0         0 my $n = do {
402 0         0 local $self->{'points'} = 'even';
403 0         0 $self->xy_to_n($x,$y/2)
404             };
405 0 0       0 if (defined $n) {
406 0         0 my ($nx,$ny) = $self->n_to_xy($n);
407 0 0 0     0 if ($nx == $x && $ny == $y) {
408 0         0 return $n;
409             }
410             }
411             }
412              
413             # k odd cannot have X,Y both odd
414 9 50 66     27 if (($x % 2) && ($y % 2)) {
415 0         0 return undef;
416             }
417             }
418              
419 36 0 33     78 if (ref $x && ref $y && $x < 0xFF_FFFF && $y < 0xFF_FFFF) {
      33        
      0        
420             # numize BigInt for speed
421 0         0 $x = "$x";
422 0         0 $y = "$y";
423             }
424              
425 36 100       66 if ($self->{'reduced'}) {
426             ### unreduced: "x=$x y=$y"
427 9 50       32 unless (_coprime($x,$y)) {
428 0         0 return undef;
429             }
430             }
431              
432             # left t'th child (t-1)/t < x/y < t/(t+1) x/y<1 t=1,2,3,...
433             # x/y < (t-1)/t
434             # xt < (t-1)y
435             # xt < ty-y
436             # y < (y-x)t
437             # t > y/(y-x)
438             #
439             # lx = x + (t-1)*(x+y) = t*x + (t-1)y # t=1 upwards
440             # ly = x + t*(x+y) = (t+1)x + ty
441             # t*lx - (t-1)*ly
442             # = t*t*x - (t-1)(t+1)x
443             # = (t^2 - (t^2 - 1))x
444             # = x
445             # x = t*lx - (t-1)*ly
446             #
447             # lx = x + (t-1)*(x+y)
448             # ly = x + t*(x+y)
449             # ly-lx = x+y
450             # y = ly-lx - x
451             # = ly-lx - (t*lx - (t-1)*ly)
452             # = ly-lx - t*lx + (t-1)*ly
453             # = (-1-t)*lx + (1 + t-1)*ly
454             # = t*ly - (t+1)*lx
455             #
456             # right t'th child is (t+1)/t < x/y < t/(t-1) x/y > 1
457             # (t+1)*y < t*x
458             # ty+y < tx
459             # t(x-y) > y
460             # t > y/(x-y)
461             #
462             # lx = y + t*(x+y) = t*x + (t+1)y
463             # ly = y + (t-1)*(x+y) = (t-1)x + ty
464             # t*lx - (t+1)*ly
465             # = t*t*x - (t+1)(t-1)x
466             # = (t^2 - (t^2 - 1))x
467             # = x
468             # x = t*lx - (t+1)*ly
469             #
470             # lx-ly = x+y
471             # y = lx-ly - x
472             # = lx - ly - t*lx + (t+1)*ly
473             # = (1-t)*lx + t*ly
474             # = t*ly - (t-1)*lx
475             #
476             # middle odd
477             # lx = x + t*(x+y) = (t+1)x + ty
478             # ly = y + t*(x+y) = tx + (t+1)y
479             # (t+1)*lx - t*ly
480             # = (t+1)*(t+1)*x - t*t*x
481             # = (2t+1)*x
482             # x = ((t+1)*lx - t*ly) / k with 2t+1=k
483             # lx-ly = x-y
484             # y = ly - lx + x
485             # = x-diff
486             # ky = kx-k*diff
487             #
488             # (t+1)*ly - t*lx
489             # = (t+1)*(t+1)*y - t*t*y
490             # = (2t+1)*y
491             #
492             # eg. k=11 x=6 y=5 t=5 -> child_x=6+5*(6+5)=61 child_y=5+5*(6+5)=60
493             # N=71 digits=5,6 top=6,5 -> 61,60
494             # low diff=11-10=1 k*ly-k*lx + x
495             #
496             # middle even first, t=k/2
497             # lx = tx + (t-1)y # eg. x + 2*(x+y) / 3(x+y) = 3x+2y / 3x+3y
498             # ly = tx + ty
499             # y = ly-lx
500             # t*x = ly - t*y
501             # x = ly/t - y
502             # eg k=4 lx=6,ly=10 t=2 y=10-6=4 x=10/2-4=1
503             # middle even second, t=k/2
504             # lx = tx + ty # eg. 3*(x+y) / 2*(x+y) + y = 3x+3y / 2x+3y
505             # ly = (t-1)x + ty
506             # x = lx-ly
507             # t*y = lx - t*x
508             # y = lx/t - x
509              
510 36         72 my @digits;
511 36         50 for (;;) {
512             ### at: "x=$x, y=$y"
513             ### assert: $x==int($x)
514             ### assert: $y==int($y)
515              
516 68 50 33     219 if ($x < 1 || $y < 1) {
517             ### X,Y negative, no such point ...
518 0         0 return undef;
519             }
520              
521 68 100       119 if ($x == $y) {
522 7 100 33     23 if ($x == $half_k) {
    50          
523             ### X=Y=half_k, done: $half_k
524 5         9 push @digits, $x;
525 5         8 last;
526             } elsif ($x == 1 && $self->{'reduced'}) {
527             ### X=Y=1 reduced, is top middle ...
528 2         5 push @digits, $half_k;
529 2         4 last;
530             } else {
531             ### X=Y, no such point ...
532 0         0 return undef;
533             }
534             }
535              
536 61         88 my $diff = $x - $y;
537 61 100       103 if ($diff < 0) {
538             ### X
539              
540 38 100 100     100 if ($diff == -1 && $x < $half_ceil) {
541             ### end at diff=-1 ...
542 19         35 push @digits, $x;
543 19         30 last;
544             }
545              
546 19         56 my ($t) = _divrem ($y, -$diff); # y/(y-x)
547             ### $t
548 19 100       38 if ($t < $half_ceil) {
549             # eg. k=4 t=1, k=5 t=1,2 k=6 t=1,2 k=7 t=1,2,3
550 12         29 ($x,$y) = ($t*$x - ($t-1)*$y,
551             $t*$y - ($t+1)*$x);
552 12         26 push @digits, $t-1;
553              
554             } else {
555 7 100       16 if ($k & 1) {
556             ### left middle odd, t=half_k ...
557             # x = ((t+1)*lx - t*ly) / k with 2t+1=k t=(k-1)/2
558 1         3 my $next_x = $half_ceil * $x - $half_k * $y;
559             ### $next_x
560 1 50       4 if ($next_x % $k) {
561 0 0       0 unless ($self->{'reduced'}) {
562             ### no divide k, no such point ...
563 0         0 return undef;
564             }
565 0         0 $diff *= $k;
566             ### no divide k, diff increased to: $diff
567             } else {
568             ### divide k ...
569 1         3 $next_x /= $k; # X = ((t+1)X - tY) / k
570             }
571 1         1 $x = $next_x;
572 1         3 $y = $next_x - $diff;
573             } else {
574             ### left middle even, t=half_k ...
575 6         18 my $next_y = $y - $x;
576             ### $next_y
577 6 100       14 if ($y % $half_k) {
578             ### y not a multiple of half_k ...
579 2 50       7 unless ($self->{'reduced'}) {
580 0         0 return undef;
581             }
582 2         7 my $g = _gcd($y,$half_k);
583 2         13 $y /= $g;
584 2         6 $next_y *= $half_k / $g;
585 2         7 ($x,$y) = ($y - $next_y, # x = ly/t - y
586             $next_y); # y = ly - lx
587             } else {
588             ### divide half_k ...
589 4         12 ($x,$y) = ($y/$half_k - $next_y, # x = ly/t - y
590             $next_y); # y = ly - lx
591             }
592             }
593 7         16 push @digits, $half_ceil-1;
594             }
595              
596             } else {
597             ### X>Y, right of row ...
598 23 100 100     94 if ($diff == 1 && $y < $half_ceil) {
599             ### end at diff=1 ...
600 10         22 push @digits, $k+1-$x;
601 10         17 last;
602             }
603              
604 13         36 my ($t) = _divrem ($x, $diff);
605             ### $t
606 13 100       30 if ($t < $half_ceil) {
607 7         17 ($x,$y) = ($t*$x - ($t+1)*$y,
608             $t*$y - ($t-1)*$x);
609 7         13 push @digits, $k-$t;
610              
611             } else {
612 6 100       13 if ($k & 1) {
613             ### right middle odd ...
614             # x = ((t+1)*lx - t*ly) / k with 2t+1=k t=(k-1)/2
615 1         3 my $next_x = $half_ceil * $x - $half_k * $y;
616             ### $next_x
617 1 50       3 if ($next_x % $k) {
618 0 0       0 unless ($self->{'reduced'}) {
619             ### no divide k, no such point ...
620 0         0 return undef;
621             }
622 0         0 $diff *= $k;
623             ### no divide k, diff increased to: $diff
624             } else {
625             ### divide k ...
626 1         2 $next_x /= $k; # X = ((t+1)X - tY) / k
627             }
628 1         2 $x = $next_x;
629 1         2 $y = $next_x - $diff;
630 1         3 push @digits, $half_k;
631             } else {
632             ### right middle even ...
633              
634 5         11 my $next_x = $x - $y;
635 5 50       14 if ($x % $half_k) {
636             ### x not a multiple of half_k ...
637 0 0       0 unless ($self->{'reduced'}) {
638 0         0 return undef;
639             }
640             # multiply lx,ly by half_k/gcd so lx is a multiple of half_k
641 0         0 my $g = _gcd($x,$half_k);
642 0         0 $x /= $g;
643 0         0 $next_x *= $half_k / $g;
644 0         0 ($x,$y) = ($next_x, # x = lx-ly
645             $x - $next_x); # y = lx/t - x
646             } else {
647             ### divide half_k ...
648 5         11 ($x,$y) = ($next_x, # x = lx-ly
649             $x/$half_k - $next_x); # y = lx/t - x
650             }
651 5         11 push @digits, $half_k;
652             }
653             }
654             }
655             }
656              
657             ### @digits
658 36 50       79 if ($self->{'digit_order'} ne 'HtoL') {
659 0         0 my $high = pop @digits;
660 0         0 @digits = (reverse(@digits), $high);
661             ### reverse digits to: @digits
662             }
663 36         104 my $n = digit_join_lowtohigh (\@digits, $k, $zero) + $self->{'n_start'}-1;
664             ### $n
665              
666             # if (! $self->{'reduced'})
667             {
668 36         51 my ($nx,$ny) = $self->n_to_xy($n);
  36         78  
669             ### reversed to: "$nx, $ny cf orig $orig_x, $orig_y"
670 36 50 33     120 if ($nx != $orig_x || $ny != $orig_y) {
671 0         0 return undef;
672             }
673             }
674              
675             ### xy_to_n result: "n=$n"
676 36         86 return $n;
677             }
678              
679             # not exact
680             sub rect_to_n_range {
681 72     72 1 7612 my ($self, $x1,$y1, $x2,$y2) = @_;
682             ### ChanTree rect_to_n_range(): "$x1,$y1 $x2,$y2"
683              
684 72         174 $x1 = round_nearest ($x1);
685 72         152 $y1 = round_nearest ($y1);
686 72         135 $x2 = round_nearest ($x2);
687 72         137 $y2 = round_nearest ($y2);
688              
689 72 50       146 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
690 72 50       117 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
691              
692 72 50 33     257 if ($x2 < 1 || $y2 < 1) {
693 0         0 return (1,0);
694             }
695              
696 72         106 my $zero = ($x1 * 0 * $y1 * $x2 * $y2); # inherit bignum
697 72 50       150 if ($self->{'points'} eq 'all_div') {
698 0         0 $x2 *= 2;
699             }
700              
701 72         185 my $max = max($x2,$y2);
702 72 100 66     303 my $level = ($self->{'reduced'} || $self->{'k'} == 2 # k=2 is reduced
703             ? $max + 1
704             : int($max/2));
705              
706             return ($self->{'n_start'},
707 72         233 $self->{'n_start'}-2 + ($self->{'k'}+$zero)**$level);
708             }
709              
710             #------------------------------------------------------------------------------
711             # (N - (Nstart-1))*k + Nstart run -1 to k-2
712             # = N*k - (Nstart-1)*k + Nstart run -1 to k-2
713             # = N*k - k*Nstart + k + Nstart run -1 to k-2
714             # = (N+1)*k + (1-k)*Nstart run -1 to k-2
715             # k*Nstart - k - Nstart + 1 = (k-1)*(Nstart-1)
716             # = N*k - (k-1)*(Nstart-1) +1 run -1 to k-2
717             # = N*k - (k-1)*(Nstart-1) run 0 to k-1
718             #
719             sub tree_n_children {
720 0     0 1   my ($self, $n) = @_;
721 0           my $n_start = $self->{'n_start'};
722 0 0         unless ($n >= $n_start) {
723 0           return;
724             }
725 0           my $k = $self->{'k'};
726 0           $n = $n*$k - ($k-1)*($n_start-1);
727 0           return map {$n+$_} 0 .. $k-1;
  0            
728             }
729             sub tree_n_num_children {
730 0     0 1   my ($self, $n) = @_;
731 0 0         return ($n >= $self->{'n_start'} ? $self->{'k'} : undef);
732             }
733              
734             # parent = floor((N-Nstart+1) / k) + Nstart-1
735             # = floor((N-Nstart+1 + k*Nstart-k) / k)
736             # = floor((N + (k-1)*(Nstart-1)) / k)
737             # N-(Nstart-1) >= k
738             # N-Nstart+1 >= k
739             # N-Nstart >= k-1
740             # N >= k-1+Nstart
741             # N >= k+Nstart-1
742             sub tree_n_parent {
743 0     0 1   my ($self, $n) = @_;
744             ### ChanTree tree_n_parent(): $n
745 0           my $n_start = $self->{'n_start'};
746 0           $n = $n - ($n_start-1); # to N=1 basis, and warn if $n undef
747 0           my $k = $self->{'k'};
748 0 0         unless ($n >= $k) {
749             ### root node, no parent ...
750 0           return undef;
751             }
752 0           _divrem_mutate ($n, $k); # delete low digit ...
753 0           return $n + ($n_start-1);
754             }
755             sub tree_n_to_depth {
756 0     0 1   my ($self, $n) = @_;
757             ### ChanTree tree_n_to_depth(): $n
758 0           $n = $n - $self->{'n_start'} + 1; # N=1 basis, and warn if $n==undef
759 0 0         unless ($n >= 1) {
760 0           return undef;
761             }
762 0           my ($pow, $exp) = round_down_pow ($n, $self->{'k'});
763 0           return $exp; # floor(log base k (N-Nstart+1))
764             }
765             sub tree_depth_to_n {
766 0     0 1   my ($self, $depth) = @_;
767             return ($depth >= 0
768 0 0         ? $self->{'k'}**$depth + ($self->{'n_start'}-1)
769             : undef);
770             }
771              
772             sub tree_num_roots {
773 0     0 1   my ($self) = @_;
774 0           return $self->{'k'} - 1;
775             }
776             sub tree_root_n_list {
777 0     0 1   my ($self) = @_;
778 0           my $n_start = $self->{'n_start'};
779 0           return $n_start .. $n_start + $self->{'k'} - 2;
780             }
781              
782             sub tree_n_root {
783 0     0 1   my ($self, $n) = @_;
784 0           my $n_start_offset = $self->{'n_start'} - 1;
785 0           $n = $n - $n_start_offset; # N=1 basis, and warn if $n==undef
786             return ($n >= 1
787 0 0         ? _high_digit($n,$self->{'k'}) + $n_start_offset
788             : undef);
789             }
790             # Return the most significant digit of $n written in base $radix.
791             sub _high_digit {
792 0     0     my ($n, $radix) = @_;
793             ### assert: ! ($n < 1)
794 0           my ($pow) = round_down_pow ($n, $radix);
795 0           _divrem_mutate($n,$pow); # $n=quotient
796 0           return $n;
797             }
798              
799             1;
800             __END__