File Coverage

blib/lib/Math/NumSeq/Repdigits.pm
Criterion Covered Total %
statement 129 148 87.1
branch 48 60 80.0
condition 5 6 83.3
subroutine 20 22 90.9
pod 8 8 100.0
total 210 244 86.0


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             package Math::NumSeq::Repdigits;
19 6     6   7317 use 5.004;
  6         14  
20 6     6   17 use strict;
  6         5  
  6         106  
21              
22 6     6   19 use vars '$VERSION', '@ISA';
  6         6  
  6         282  
23             $VERSION = 72;
24 6     6   388 use Math::NumSeq;
  6         7  
  6         238  
25             @ISA = ('Math::NumSeq');
26             *_is_infinite = \&Math::NumSeq::_is_infinite;
27             *_to_bigint = \&Math::NumSeq::_to_bigint;
28              
29 6     6   2386 use Math::NumSeq::NumAronson 8; # new in v.8
  6         58  
  6         228  
30             *_round_down_pow = \&Math::NumSeq::NumAronson::_round_down_pow;
31              
32             # uncomment this to run the ### lines
33             #use Smart::Comments;
34              
35              
36             # use constant name => Math::NumSeq::__('Repdigits');
37 6     6   22 use constant description => Math::NumSeq::__('Numbers which are a "repdigit", meaning 0, 1 ... 9, 11, 22, 33, ... 99, 111, 222, 333, ..., 999, etc. The default is decimal, or select a radix.');
  6         7  
  6         13  
38 6     6   19 use constant i_start => 0;
  6         6  
  6         189  
39 6     6   15 use constant characteristic_increasing => 1;
  6         6  
  6         187  
40 6     6   17 use constant characteristic_integer => 1;
  6         7  
  6         179  
41 6     6   23 use constant values_min => 0;
  6         10  
  6         208  
42              
43             use Math::NumSeq::Base::Digits
44 6     6   2956 'parameter_info_array'; # radix parameter
  6         9  
  6         7875  
45              
46             #------------------------------------------------------------------------------
47             # cf A002275 - repunits
48             # A108850 - repunits count of 1 bits
49              
50             my @oeis_anum = (
51             # OEIS-Catalogue array begin
52             undef, # 0
53             undef, # 1
54             'A000225', # radix=2 # 2^i-1
55             'A048328', # radix=3
56             'A048329', # radix=4
57             undef, # A048330 starts OFFSET=1 value=0
58             'A048331', # radix=6
59             'A048332', # radix=7
60             undef, # A048333 starts OFFSET=1 value=0
61             'A048334', # radix=9
62             'A010785', # radix=10 # starting from OFFSET=0 value=0
63             'A048335', # radix=11
64             'A048336', # radix=12
65             'A048337', # radix=13
66             'A048338', # radix=14
67             'A048339', # radix=15
68             'A048340', # radix=16
69             # OEIS-Catalogue array end
70             );
71             sub oeis_anum {
72 4     4 1 17 my ($self) = @_;
73 4         8 return $oeis_anum[$self->{'radix'}];
74             }
75              
76             #------------------------------------------------------------------------------
77              
78             sub rewind {
79 20     20 1 1569 my ($self) = @_;
80 20         26 my $radix = $self->{'radix'};
81 20 50       39 if ($radix < 2) {
82 0         0 $radix = $self->{'radix'} = 10;
83             }
84              
85 20         50 $self->{'i'} = $self->i_start;
86 20         23 $self->{'n'} = -1;
87 20 100       45 if ($radix != 2) {
88 16         16 $self->{'inc'} = 1;
89 16         65 $self->{'digit'} = -1;
90             }
91             }
92             sub _UNTESTED__seek_to_i {
93 0     0   0 my ($self, $i) = @_;
94 0         0 $self->{'i'} = $i;
95 0         0 my $radix = $self->{'radix'};
96 0 0       0 if ($radix == 2) {
97 0 0       0 if ($i == 0) {
98 0         0 $self->{'n'} = -1;
99             } else {
100 0         0 $self->{'n'} = $self->ith($i-1);
101             }
102             } else {
103 0         0 my $digit = $self->{'digit'} = ($i % $radix) - 1;
104 0         0 my $exp = int($i/$radix);
105 0         0 $self->{'inc'} = $self->ith($i-$digit);
106 0         0 $self->{'n'} = $self->{'inc'} * $digit;
107             }
108             }
109             sub _UNTESTED__seek_to_value {
110 0     0   0 my ($self, $value) = @_;
111 0         0 $self->seek_to_i($self->value_to_i_ceil($value));
112             }
113              
114             sub next {
115 132     132 1 1389 my ($self) = @_;
116              
117 132         99 my $i = $self->{'i'}++;
118 132         84 my $radix = $self->{'radix'};
119 132 100       147 if ($radix == 2) {
120 14 50       19 if ($i == 31) {
121 0         0 $self->{'n'} = _to_bigint($self->{'n'});
122             }
123 14 100       26 if ($i) {
124 12         10 $self->{'n'} *= 2;
125             }
126 14         23 return ($i, $self->{'n'} += 1);
127              
128             } else {
129             # ENHANCE-ME: automatic promote to bigint
130              
131 118         95 my $n = ($self->{'n'} += $self->{'inc'});
132 118 100       138 if (++$self->{'digit'} >= $radix) {
133 14         16 $self->{'inc'} = $self->{'inc'} * $radix + 1;
134 14         11 $self->{'digit'} = 1;
135 14         13 $self->{'n'} = ($n += 1); # not ++$n as that gives warnings on overflow
136             ### digit: $self->{'digit'}
137             ### inc: $self->{'inc'}
138             ### $n
139             }
140 118         128 return ($i, $n);
141             }
142             }
143              
144             sub ith {
145 371     371 1 4511 my ($self, $i) = @_;
146 371         280 my $radix = $self->{'radix'};
147              
148 371 50       489 if (_is_infinite ($i)) {
149 0         0 return $i;
150             }
151              
152 371 100       538 if ($radix == 2) {
153 29 100       39 my $one = ($i >= 31 ? _to_bigint(1) : 1);
154 29         72 return ($one << $i) - 1;
155             }
156              
157 342 100       409 if (($i-=1) < 0) {
158 18         28 return 0;
159             }
160 324         279 my $digit = ($i % ($radix-1)) + 1;
161 324         363 $i = int($i/($radix-1)) + 1;
162 324         513 return ($radix ** $i - 1) / ($radix - 1) * $digit;
163             }
164              
165             sub pred {
166 3376     3376 1 7244 my ($self, $value) = @_;
167              
168             {
169 3376         1845 my $int = int($value);
  3376         2010  
170 3376 100       3719 if ($value != $int) {
171 1653         1450 return 0;
172             }
173 1723         1221 $value = $int; # prefer BigInt if input BigFloat
174             }
175              
176 1723         1235 my $radix = $self->{'radix'};
177 1723 100       1793 if ($radix == 2) {
178 71         82 return ! (($value+1) & $value);
179              
180             }
181 1652 100       1690 if ($radix == 10) {
182 1028         813 my $digit = substr($value,0,1);
183 1028         2482 return ($value !~ /[^$digit]/);
184             }
185              
186 624         378 my $digit = $value % $radix;
187 624         748 while ($value = int($value/$radix)) {
188 701 100       864 unless (($value % $radix) == $digit) { # false for inf or nan
189 562         494 return 0;
190             }
191             }
192 62         51 return 1;
193             }
194              
195             sub value_to_i_ceil {
196 835     835 1 1380 my ($self, $value) = @_;
197             ### value_to_i_ceil(): $value
198              
199 835 50       1153 if (_is_infinite ($value)) {
200 0         0 return $value;
201             }
202 835 100       13156 if ($value <= 0) {
203 23         354 return 0;
204             }
205 812         5361 my $int = int($value);
206 812 100       1461 if ($value != $int) {
207 63         60 $int += 1;
208             }
209             ### $int
210              
211 812         1491 my $radix = $self->{'radix'};
212 812 50       814 my @digits = _digit_split_lowtohigh($int, $radix)
213             or return 0; # if $value==0
214              
215 812         1100 my $high_digit = pop @digits;
216 812         868 my $i = $high_digit + ($radix-1) * scalar(@digits);
217             ### $high_digit
218             ### $i
219              
220 812         1464 foreach my $digit (reverse @digits) { # high to low
221 1233 100       1496 if ($digit > $high_digit) {
222 204         401 return $i + 1;
223             }
224 1029 100       1495 if ($digit < $high_digit) {
225 206         192 last;
226             }
227             }
228 608         1068 return $i;
229             }
230             sub value_to_i_floor {
231 855     855 1 1463 my ($self, $value) = @_;
232              
233 855 100       1189 if ($value < 1) {
234 46         394 return 0;
235             }
236 809 50       4121 if (_is_infinite ($value)) {
237 0         0 return $value;
238             }
239 809         12117 $value = int($value);
240              
241 809         1169 my $radix = $self->{'radix'};
242 809 50       769 my @digits = _digit_split_lowtohigh($value, $radix)
243             or return 0; # if $value==0
244              
245 809         1115 my $high_digit = pop @digits;
246 809         785 my $i = $high_digit + ($radix-1) * scalar(@digits);
247              
248 809         1542 foreach my $digit (reverse @digits) { # high to low
249 1240 100       1691 if ($digit < $high_digit) {
250 281         507 return $i - 1;
251             }
252             }
253 528         946 return $i;
254             }
255              
256             # either floor or 1 too big
257             sub value_to_i_estimate {
258 102     102 1 1794 my ($self, $value) = @_;
259             ### value_to_i_estimate() ...
260              
261 102 100       130 if ($value < 1) {
262 36         37 return 0;
263             }
264 66 50       301 if (_is_infinite ($value)) {
265 0         0 return $value;
266             }
267 66         852 my $radix = $self->{'radix'};
268 66         102 my ($power, $exp) = _round_down_pow ($value, $radix);
269 66         472 return int($value/$power) # high digit
270             + ($radix-1) * $exp;
271             }
272              
273             #------------------------------------------------------------------------------
274              
275             {
276             my %binary_to_base4 = ('00' => '0',
277             '01' => '1',
278             '10' => '2',
279             '11' => '3');
280             my @radix_to_coderef;
281             $radix_to_coderef[2] = sub {
282             (my $str = $_[0]->as_bin) =~ s/^0b//; # strip leading 0b
283             return reverse split //, $str;
284             };
285             $radix_to_coderef[4] = sub {
286             (my $str = $_[0]->as_bin) =~ s/^0b//; # strip leading 0b
287             if (length($str) & 1) {
288             $str = "0$str";
289             }
290             $str =~ s/(..)/$binary_to_base4{$1}/ge;
291             return reverse split //, $str;
292             };
293             $radix_to_coderef[8] = sub {
294             (my $str = $_[0]->as_oct) =~ s/^0//; # strip leading 0
295             return reverse split //, $str;
296             };
297             $radix_to_coderef[10] = sub {
298             return reverse split //, $_[0]->bstr;
299             };
300             $radix_to_coderef[16] = sub {
301             (my $str = $_[0]->as_hex) =~ s/^0x//; # strip leading 0x
302             return reverse map {hex} split //, $str;
303             };
304              
305             sub _digit_split_lowtohigh {
306 35326     35326   24733 my ($n, $radix) = @_;
307             ### _digit_split_lowtohigh(): $n
308              
309 35326 100       40000 $n || return; # don't return '0' from BigInt stringize
310              
311 35122 100 66     54698 if (ref $n
      100        
312             && $n->isa('Math::BigInt')
313             && (my $coderef = $radix_to_coderef[$radix])) {
314 141         205 return $coderef->($_[0]);
315             }
316              
317 34981         20526 my @ret;
318 34981         21020 do {
319 308819         403690 push @ret, $n % $radix;
320             } while ($n = int($n/$radix));
321 34981         70412 return @ret; # array[0] low digit
322             }
323             }
324              
325             1;
326             __END__