| 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__ |