File Coverage

blib/lib/Math/NumSeq/RepdigitRadix.pm
Criterion Covered Total %
statement 104 107 97.2
branch 35 40 87.5
condition 5 8 62.5
subroutine 18 18 100.0
pod 6 6 100.0
total 168 179 93.8


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
2              
3             # This file is part of Math-NumSeq.
4             #
5             # Math-NumSeq 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-NumSeq 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-NumSeq. If not, see .
17              
18              
19             # ENHANCE-ME: ith() might be a touch faster than next() now, perhaps
20             # something sieve/flag in next()
21              
22              
23             package Math::NumSeq::RepdigitRadix;
24 2     2   7536 use 5.004;
  2         6  
25 2     2   8 use strict;
  2         3  
  2         43  
26              
27 2     2   5 use vars '$VERSION', '@ISA';
  2         2  
  2         111  
28             $VERSION = 72;
29 2     2   351 use Math::NumSeq;
  2         4  
  2         74  
30             @ISA = ('Math::NumSeq');
31             *_is_infinite = \&Math::NumSeq::_is_infinite;
32              
33 2     2   329 use Math::NumSeq::NumAronson;
  2         2  
  2         64  
34             *_round_down_pow = \&Math::NumSeq::NumAronson::_round_down_pow;
35              
36 2     2   346 use Math::Factor::XS 0.40 'factors'; # version 0.40 for factors() on BigInt
  2         18188  
  2         113  
37              
38             # uncomment this to run the ### lines
39             #use Smart::Comments;
40              
41              
42             # use constant name => Math::NumSeq::__('Repdigit Radix');
43 2     2   10 use constant description => Math::NumSeq::__('First radix in which i is a repdigit (at most base=i-1 since otherwise "11" would always give i).');
  2         2  
  2         9  
44 2     2   9 use constant characteristic_smaller => 1;
  2         9  
  2         91  
45 2     2   7 use constant characteristic_increasing => 0;
  2         2  
  2         75  
46 2     2   21 use constant characteristic_integer => 1;
  2         3  
  2         79  
47 2     2   7 use constant characteristic_value_is_radix => 1;
  2         3  
  2         1150  
48             sub values_min {
49 1     1 1 5 my ($self) = @_;
50 1 50       2 return ($self->i_start >= 3 ? 2 : 0);
51             }
52             sub i_start {
53 15     15 1 47 my ($self) = @_;
54 15   50     65 return $self->{'i_start'} || 0;
55             }
56              
57             # smallest base in which n is a repdigit, starting n=3
58 1     1 1 2 sub oeis_anum { 'A059711' }
59             # OEIS-Catalogue: A059711 i_start=3
60              
61              
62             # d * (b^3 + b^2 + b + 1) = i
63             # b^3 + b^2 + b + 1 = i/d
64             # (b+1)^3 = b^3 + 3b^2 + 3b + 1
65             #
66             # (b-1) * (b^3 + b^2 + b + 1) = b^4 - 1
67             #
68             # 8888 base 9 = 6560
69             # 1111 base 10
70              
71             # b^2 + b + 1 = k
72             # (b+0.5)^2 + .75 = k
73             # (b+0.5)^2 = (k-0.75)
74             # b = sqrt(k-0.75)-0.5;
75              
76             sub rewind {
77 6     6 1 355 my ($self) = @_;
78 6         14 $self->{'i'} = $self->i_start;
79 6         14 $self->{'ones'} = [ undef, undef, 7 ];
80 6         15 $self->{'digits'} = [ undef, undef, 1 ];
81             ### rewind to: $self
82             }
83              
84             # (r+1)^2 + (r+1) + 1
85             # = r^2 + 2r + 1 + r +1 + 1
86             # = r^2 + 3r + 3
87             # = (r + 3)*r + 3
88              
89             # 0 1 2
90             my @small = (2, 0, 0);
91              
92             sub next {
93 519     519 1 65697 my ($self) = @_;
94             ### RepdigitRadix next(): $self->{'i'}
95              
96 519         733 my $i = $self->{'i'}++;
97 519         485 my $ones = $self->{'ones'};
98 519         428 my $digits = $self->{'digits'};
99              
100 519 100       916 if ($i < 3) {
101 9         16 return ($i, $small[$i]);
102             }
103              
104 510         561 for (my $radix = 2; ; $radix++) {
105             ### $radix
106             ### ones: $ones->[$radix]
107             ### digit: $digits->[$radix]
108              
109 35515         20363 my $one;
110 35515 100       37305 if ($radix > $#$ones) {
111             ### maybe extend array: $radix
112 505         359 $one = $radix + 1; # or three digits ... ($radix + 1) *
113 505 100       628 unless ($one <= $i) {
114             ### not repdigit of 3 digits in any radix, take as 2 digits ...
115 3         7 return ($i, $i-1);
116             }
117 502         471 $ones->[$radix] = $one;
118 502         496 $digits->[$radix] = 1;
119              
120             } else {
121 35010         26933 $one = $ones->[$radix];
122             }
123              
124 35512         29996 my $repdigit = $one * $digits->[$radix];
125 35512         44685 while ($repdigit < $i) {
126 1634         1347 my $digit = ++$digits->[$radix];
127 1634 100       1966 if ($digit >= $radix) {
128 36         39 $digit = $digits->[$radix] = 1;
129 36         40 $one = $ones->[$radix] = ($one * $radix + 1);
130             }
131 1634         2231 $repdigit = $one * $digit;
132             }
133             ### consider repdigit: $repdigit
134 35512 100       45114 if ($repdigit == $i) {
135             ### found radix: $radix
136 507         1296 return ($i, $radix);
137             }
138             }
139             }
140              
141             # d=r-1
142             # v = d*(r^(len-1)+...+1)
143             # = r^len-1
144             # dlimit = nthroot(v+1, len)
145             #
146             # q=v/d
147             # q=r^(len-1)+...+1
148             # q > r^(len-1) # when len>2
149             # r < nthroot(q, len-1)
150              
151             sub ith {
152 533     533 1 155242 my ($self, $i) = @_;
153             ### RepdigitRadix ith(): $i
154 533 100       1101 if ($i < 0) {
155 3         3 $i = abs($i);
156             }
157 533 100       874 if ($i < 3) {
158 14         21 return $small[$i];
159             }
160 519 50       799 if ($i > 0xFFFF_FFFF) {
161 0         0 return undef;
162             }
163 519 50       1128 if (_is_infinite($i)) {
164 0         0 return $i; # nan
165             }
166              
167 519         2606 my @factors = reverse (1, factors($i));
168             ### @factors
169              
170 519         1269 my ($pow, $len) = _round_down_pow ($i, 2);
171 519         568 $len++;
172             ### initial len: $len
173              
174 519         387 my $r_found;
175 519         880 for ( ; $len >= 3; $len--) {
176 3035 100       5446 my $d_limit = (defined $r_found ? $r_found-1 : _nth_root_floor($i+1,$len));
177             ### $len
178             ### $d_limit
179              
180 3035         3663 foreach my $d (grep {$_<=$d_limit} @factors) { # descending order
  16928         18196  
181             ### try d: $d
182              
183             # if ($d > $d_limit) {
184             # ### stop for d > d_limit ...
185             # last;
186             # }
187              
188 4956         3925 my $q = $i / $d;
189 4956         5640 my $r = _nth_root_floor($q,$len-1);
190             ### $q
191             ### $r
192             ### ones: ($r**$len - 1) / ($r-1)
193              
194 4956 100 66     7495 if (defined $r_found && $r >= $r_found) {
195             ### stop at r >= r_found ...
196 70         135 last;
197             }
198              
199 4886 100       6014 if ($r <= $d) {
200             ### r smaller than d ...
201             # since d>=1 this also excludes r<2
202 856         941 next;
203             }
204              
205 4030 100       10442 if ($q == ($r**$len - 1) / ($r-1)) {
206 71         114 $r_found = $r;
207             }
208             }
209             }
210              
211 519 100       999 my $d_limit = (defined $r_found ? $r_found-1 : int(sqrt($i+1)));
212 519         675 foreach my $d (grep {$_<=$d_limit} @factors) { # descending order
  2741         2854  
213             ### try d: $d
214              
215             # v = d*(r+1)
216             # v/d = r+1
217             # r = v/d - 1
218             #
219 908         919 my $r = $i/$d - 1;
220             ### $r
221              
222 908 100 66     2546 if (defined $r_found && $r >= $r_found) {
223             ### stop at r >= r_found ...
224 417         521 last;
225             }
226              
227 491 100       621 if ($r <= $d) {
228             ### r smaller than d ...
229             # since d>=1 this also excludes r<2
230 43         53 next;
231             }
232              
233 448         472 $r_found = $r;
234             }
235              
236 519 50       1303 return (defined $r_found ? $r_found : $i-1);
237              
238              
239             # for (my $radix = 2; ; $radix++) {
240             # ### $radix
241             #
242             # my $one = $radix + 1; # ... or 3 digits 111 ($radix + 1) *
243             # unless ($one <= $i) {
244             # ### stop at ones too big not a 3-digit repdigit: $one
245             # return $i-1;
246             # }
247             # ### $one
248             #
249             # do {
250             # if ($one == $i) {
251             # return $radix;
252             # }
253             # foreach my $digit (2 .. $radix-1) {
254             # ### $digit
255             # if ((my $repdigit = $digit * $one) <= $i) {
256             # if ($repdigit == $i) {
257             # return $radix;
258             # }
259             # }
260             # }
261             # } while (($one = $one * $radix + 1) <= $i);
262             # }
263             }
264              
265             # value = root^power
266             # log(value) = power*log(root)
267             # log(root) = log(value)/power
268             # root = exp(log(value)/power)
269             #
270             sub _nth_root_floor {
271 7958     7958   6761 my ($value, $power) = @_;
272 7958         10192 my $root = int (exp (log($value)/$power));
273 7958 100       11527 if ($root**$power > $value) {
274 5         216 return $root-1;
275             }
276 7953 50       10305 if (($root+1)**$power < $value) {
277 0         0 return $root+1;
278             }
279 7953         6672 return $root;
280             }
281              
282             # R^2+R+1
283             # R=65 "111"=4291
284             #
285             # Does every radix occur? Is it certain that at least one repdigit in base
286             # R is not a repdigit in anything smaller?
287             #
288             # sub pred {
289             # my ($self, $value) = @_;
290             # return ($value == int($value)
291             # && ($value == 0 || $value >= 2));
292             # }
293              
294             1;
295             __END__