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 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   636 use 5.004;
  1         4  
34 1     1   5 use strict;
  1         2  
  1         35  
35             #use List::Util 'max';
36             *max = \&Math::PlanePath::_max;
37              
38 1     1   5 use vars '$VERSION', '@ISA';
  1         1  
  1         49  
39             $VERSION = 127;
40 1     1   5 use Math::PlanePath;
  1         2  
  1         45  
41             @ISA = ('Math::PlanePath');
42              
43             use Math::PlanePath::Base::Generic
44 1         75 'is_infinite',
45 1     1   8 'round_nearest';
  1         1  
46             use Math::PlanePath::Base::Digits
47 1         82 'round_down_pow',
48             'digit_split_lowtohigh',
49 1     1   486 'digit_join_lowtohigh';
  1         2  
50             *_divrem = \&Math::PlanePath::_divrem;
51             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
52              
53 1     1   7 use Math::PlanePath::CoprimeColumns;
  1         2  
  1         28  
54             *_coprime = \&Math::PlanePath::CoprimeColumns::_coprime;
55              
56 1     1   4 use Math::PlanePath::GcdRationals;
  1         2  
  1         66  
57             *_gcd = \&Math::PlanePath::GcdRationals::_gcd;
58              
59             # uncomment this to run the ### lines
60             # use Smart::Comments;
61              
62              
63 1         67 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         1  
97              
98 1     1   6 use constant class_x_negative => 0;
  1         1  
  1         84  
99 1     1   7 use constant class_y_negative => 0;
  1         2  
  1         67  
100              
101 1     1   7 use constant x_minimum => 1;
  1         2  
  1         54  
102 1     1   7 use constant y_minimum => 1;
  1         1  
  1         377  
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 6 my ($self) = @_;
157 4         15 return ($self->{'k'}); # complete tree, always k children
158             }
159 1     1   16 use constant tree_n_to_subheight => undef; # complete trees, all infinite
  1         4  
  1         2500  
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 1734 my $self = shift->SUPER::new(@_);
183              
184 9   50     57 $self->{'digit_order'} ||= 'HtoL'; # default
185              
186 9   100     27 my $k = ($self->{'k'} ||= 3); # default
187 9         28 $self->{'half_k'} = int($k / 2);
188              
189 9 100       104 if (! defined $self->{'n_start'}) {
190 4         9 $self->{'n_start'} = 0; # default
191             }
192              
193 9   50     36 $self->{'points'} ||= 'even';
194 9         25 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 3498 my ($self, $n) = @_;
225             ### ChanTree n_to_xy(): "$n k=$self->{'k'} reduced=".($self->{'reduced'}||0)
226              
227 72 50       175 if ($n < $self->{'n_start'}) { return; }
  0         0  
228              
229 72         115 $n -= $self->{'n_start'}-1;
230             ### 1-based N: $n
231 72 50       168 if (is_infinite($n)) { return ($n,$n); }
  0         0  
232              
233             {
234 72         124 my $int = int($n);
  72         108  
235 72 50       134 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         125 my $k = $self->{'k'};
247 72         112 my $half_k = int($self->{'k'} / 2);
248 72         150 my $half_ceil = int(($self->{'k'}+1) / 2);
249 72         178 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         124 my $x = (pop @digits) + ($n*0); # inherit bignum zero
254 72         112 my $y = $x+1;
255 72 100       127 if ($x > $half_k) {
256 20         27 $x = $k+1 - $x;
257             }
258 72 100       124 if ($y > $half_k) {
259 44         61 $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       151 if ($self->{'digit_order'} eq 'HtoL') {
308 72         106 @digits = reverse @digits; # high to low is the default
309             }
310 72         123 foreach my $digit (@digits) {
311             # c1 = 1,2,3,3,2,1 or 1,2,3,2,1
312 64 100       114 my $c0 = ($digit <= $half_ceil ? $digit : $k-$digit+1);
313 64 100       119 my $c1 = ($digit < $half_ceil ? $digit+1 : $k-$digit);
314 64 100       126 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         140 ($x,$y) = ($x*$c1 + $y*$c0,
318             $x*$c2 + $y*$c1);
319             }
320             ### loop: "x=$x y=$y"
321              
322 72 100 100     175 if (($k & 1) && ($n % 2) == 0) { # odd N=2n+1 when 1 based
323 8 50       24 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       135 if ($self->{'reduced'}) {
338             ### unreduced: "x=$x y=$y"
339 18 50       31 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         44 my $g = _gcd($x,$y);
351 18         32 $x /= $g;
352 18         27 $y /= $g;
353             }
354             }
355              
356             ### n_to_xy() return: "x=$x y=$y"
357 72         184 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 3239 my ($self, $x, $y) = @_;
367             ### Chan xy_to_n(): "x=$x y=$y k=$self->{'k'}"
368              
369 36         99 $x = round_nearest ($x);
370 36         70 $y = round_nearest ($y);
371              
372 36 50       75 if (is_infinite($x)) {
373 0         0 return $x; # infinity
374             }
375 36 50       79 if (is_infinite($y)) {
376 0         0 return $y; # infinity
377             }
378 36         60 my $orig_x = $x;
379 36         49 my $orig_y = $y;
380              
381 36         59 my $k = $self->{'k'};
382 36         51 my $zero = ($x * 0 * $y); # inherit bignum
383 36         57 my $half_k = $self->{'half_k'};
384 36         86 my $half_ceil = int(($self->{'k'}+1) / 2);
385              
386 36 100       86 if ($k & 1) {
387 9 0 33     32 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     23 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     30 if (($x % 2) && ($y % 2)) {
415 0         0 return undef;
416             }
417             }
418              
419 36 0 33     80 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       76 if ($self->{'reduced'}) {
426             ### unreduced: "x=$x y=$y"
427 9 50       30 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         62 my @digits;
511 36         55 for (;;) {
512             ### at: "x=$x, y=$y"
513             ### assert: $x==int($x)
514             ### assert: $y==int($y)
515              
516 68 50 33     212 if ($x < 1 || $y < 1) {
517             ### X,Y negative, no such point ...
518 0         0 return undef;
519             }
520              
521 68 100       115 if ($x == $y) {
522 7 100 33     19 if ($x == $half_k) {
    50          
523             ### X=Y=half_k, done: $half_k
524 5         8 push @digits, $x;
525 5         9 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         90 my $diff = $x - $y;
537 61 100       109 if ($diff < 0) {
538             ### X
539              
540 38 100 100     96 if ($diff == -1 && $x < $half_ceil) {
541             ### end at diff=-1 ...
542 19         34 push @digits, $x;
543 19         26 last;
544             }
545              
546 19         54 my ($t) = _divrem ($y, -$diff); # y/(y-x)
547             ### $t
548 19 100       39 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         28 ($x,$y) = ($t*$x - ($t-1)*$y,
551             $t*$y - ($t+1)*$x);
552 12         32 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       3 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         2 $x = $next_x;
572 1         2 $y = $next_x - $diff;
573             } else {
574             ### left middle even, t=half_k ...
575 6         10 my $next_y = $y - $x;
576             ### $next_y
577 6 100       11 if ($y % $half_k) {
578             ### y not a multiple of half_k ...
579 2 50       5 unless ($self->{'reduced'}) {
580 0         0 return undef;
581             }
582 2         7 my $g = _gcd($y,$half_k);
583 2         5 $y /= $g;
584 2         13 $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         22 ($x,$y) = ($y/$half_k - $next_y, # x = ly/t - y
590             $next_y); # y = ly - lx
591             }
592             }
593 7         18 push @digits, $half_ceil-1;
594             }
595              
596             } else {
597             ### X>Y, right of row ...
598 23 100 100     67 if ($diff == 1 && $y < $half_ceil) {
599             ### end at diff=1 ...
600 10         18 push @digits, $k+1-$x;
601 10         15 last;
602             }
603              
604 13         33 my ($t) = _divrem ($x, $diff);
605             ### $t
606 13 100       36 if ($t < $half_ceil) {
607 7         22 ($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         3 $next_x /= $k; # X = ((t+1)X - tY) / k
627             }
628 1         3 $x = $next_x;
629 1         2 $y = $next_x - $diff;
630 1         2 push @digits, $half_k;
631             } else {
632             ### right middle even ...
633              
634 5         9 my $next_x = $x - $y;
635 5 50       10 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         10 push @digits, $half_k;
652             }
653             }
654             }
655             }
656              
657             ### @digits
658 36 50       86 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         109 my $n = digit_join_lowtohigh (\@digits, $k, $zero) + $self->{'n_start'}-1;
664             ### $n
665              
666             # if (! $self->{'reduced'})
667             {
668 36         60 my ($nx,$ny) = $self->n_to_xy($n);
  36         77  
669             ### reversed to: "$nx, $ny cf orig $orig_x, $orig_y"
670 36 50 33     116 if ($nx != $orig_x || $ny != $orig_y) {
671 0         0 return undef;
672             }
673             }
674              
675             ### xy_to_n result: "n=$n"
676 36         77 return $n;
677             }
678              
679             # not exact
680             sub rect_to_n_range {
681 72     72 1 7354 my ($self, $x1,$y1, $x2,$y2) = @_;
682             ### ChanTree rect_to_n_range(): "$x1,$y1 $x2,$y2"
683              
684 72         183 $x1 = round_nearest ($x1);
685 72         135 $y1 = round_nearest ($y1);
686 72         150 $x2 = round_nearest ($x2);
687 72         125 $y2 = round_nearest ($y2);
688              
689 72 50       148 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
690 72 50       127 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
691              
692 72 50 33     238 if ($x2 < 1 || $y2 < 1) {
693 0         0 return (1,0);
694             }
695              
696 72         115 my $zero = ($x1 * 0 * $y1 * $x2 * $y2); # inherit bignum
697 72 50       161 if ($self->{'points'} eq 'all_div') {
698 0         0 $x2 *= 2;
699             }
700              
701 72         177 my $max = max($x2,$y2);
702 72 100 66     241 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         219 $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__