File Coverage

blib/lib/Math/NumSeq/UndulatingNumbers.pm
Criterion Covered Total %
statement 134 137 97.8
branch 52 56 92.8
condition 21 23 91.3
subroutine 18 18 100.0
pod 6 6 100.0
total 231 240 96.2


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             # http://mathworld.wolfram.com/UndulatingNumber.html
20              
21             package Math::NumSeq::UndulatingNumbers;
22 2     2   7268 use 5.004;
  2         5  
23 2     2   6 use strict;
  2         3  
  2         38  
24              
25 2     2   5 use vars '$VERSION', '@ISA';
  2         4  
  2         93  
26             $VERSION = 72;
27 2     2   344 use Math::NumSeq;
  2         2  
  2         76  
28             @ISA = ('Math::NumSeq');
29             *_is_infinite = \&Math::NumSeq::_is_infinite;
30              
31             # uncomment this to run the ### lines
32             # use Smart::Comments;
33              
34              
35             # use constant name => Math::NumSeq::__('Undulating Numbers');
36 2     2   7 use constant description => Math::NumSeq::__('Numbers like 37373 which are a pattern of digits ABAB...');
  2         3  
  2         5  
37 2     2   6 use constant default_i_start => 0;
  2         2  
  2         66  
38 2     2   6 use constant characteristic_increasing => 1;
  2         3  
  2         66  
39 2     2   7 use constant characteristic_integer => 1;
  2         1  
  2         63  
40 2     2   6 use constant values_min => 0;
  2         2  
  2         61  
41              
42 2     2   319 use Math::NumSeq::Base::Digits;
  2         3  
  2         112  
43 2         5 use constant parameter_info_array =>
44             [
45             Math::NumSeq::Base::Digits::parameter_common_radix(),
46             { name => 'including_repdigits',
47             type => 'boolean',
48             display => Math::NumSeq::__('Repdigits'),
49             default => 1,
50             description => Math::NumSeq::__('Whether to include repdigits A=B.'),
51             },
52 2     2   6 ];
  2         2  
53              
54             #------------------------------------------------------------------------------
55              
56             # cf A046075 - decimal A!=B and min length 3
57             # A033619 - decimal A=B any length
58             #
59             # A046076 - "binary undulants", numbers k where 2^k written in decimal
60             # has an 010 or 101 somewhere
61             #
62             my @oeis_anum;
63              
64             $oeis_anum[1]->[2] = 'A000975'; # binary A!=B no consecutive equal bits
65             # OEIS-Catalogue: A000975 radix=2 including_repdigits=0
66              
67             # $oeis_anum[0]->[10] = 'A033619'; # decimal incl A=B, but OFFSET=1 value=0
68             # # OEIS-Catalogue: A033619 including_repdigits=1
69              
70             sub oeis_anum {
71 4     4 1 15 my ($self) = @_;
72 4         9 return $oeis_anum[!$self->{'including_repdigits'}]->[$self->{'radix'}];
73             }
74              
75             #------------------------------------------------------------------------------
76              
77             sub rewind {
78 42     42 1 3234 my ($self) = @_;
79 42         61 my $radix = $self->{'radix'};
80 42 50       101 if ($radix < 2) { $radix = 10; }
  0         0  
81 42         60 $self->{'radix'} = $radix;
82              
83 42         56 $self->{'i'} = 0;
84 42         53 $self->{'value'} = -1;
85 42         46 $self->{'inc'} = 1; # 10101010 or 101010101
86 42         52 $self->{'inc_even'} = 0; # 1 if inc=10101010 or 0 if inc=101010101
87 42         47 $self->{'a'} = 0; # 1 to 9, or 0 for initial smalls
88 42         142 $self->{'b'} = 0; # 0 to 9, perhaps skipping a==b
89             }
90              
91             sub next {
92 4927     4927 1 11284 my ($self) = @_;
93             ### UndulatingNumbers next() ...
94             ### inc: $self->{'inc'}
95             ### value: $self->{'value'}
96              
97 4927         3408 my $radix = $self->{'radix'};
98 4927         2949 my $value;
99 4927 100       6793 if ($value = ($self->{'value'} += $self->{'inc'})) {
100 4889         3116 $self->{'b'}++;
101             ### value: $self->{'value'}
102             ### a: $self->{'a'}
103             ### b: $self->{'b'}
104              
105 4889 100 100     10054 if (! $self->{'including_repdigits'}
106             && $self->{'b'} == $self->{'a'}) {
107 293         251 $self->{'value'} = ($value += $self->{'inc'});
108 293         205 $self->{'b'}++;
109              
110             ### no repdigits, skip a==b to new b: $self->{'b'}
111             ### value now: $value
112             }
113              
114 4889 100       5852 if ($self->{'b'} >= $radix ) {
115             ### b overflow, a inc ...
116             ### inc_even: $self->{'inc_even'}
117              
118             # a9a + 10 -> (a+1)0(a)
119             # if inc=10..10 ends in 0 then need 1 extra to give (a+1)0(a+1)
120              
121 552         379 $self->{'b'} = 0;
122 552         423 $self->{'value'} = ($value += $self->{'inc_even'});
123             ### value now: $value
124              
125 552 100       710 if (++$self->{'a'} >= $radix) {
126             ### a overflow, next length ...
127              
128             # inc=101 -> 1010 inc_even=0
129             # or 1010 -> 10101 inc_even=0
130 102         105 my $inc_even = ($self->{'inc_even'} ^= 1);
131 102         105 $self->{'inc'} = $self->{'inc'} * $radix + !$inc_even;
132 102         71 $self->{'a'} = 1;
133 102         86 $self->{'value'} = ($value += $inc_even);
134              
135             ### lengthen to inc: $self->{'inc'}
136             ### n now: $value
137             }
138             }
139             }
140 4927         5692 return ($self->{'i'}++, $value);
141             }
142              
143             # A is 0 to 9 = 10 values
144             # AB is 10 to 99 = 90 values
145             # total R*R
146             # then high AB is 10 to 99 = 90 values
147             # total 90 = (R-1)*R
148             # R=2 total 2*2-1=3 1,10,11
149             #
150             # or without repdigits
151             # AB skips 11, ..., 99 = 10 values
152             # total R*R - R = R*(R-1)
153             #
154             sub ith {
155 5146     5146 1 12621 my ($self, $i) = @_;
156             ### UndulatingNumbers ith(): $i
157 5146         3633 my $radix = $self->{'radix'};
158 5146         3596 my $rdec = $radix - 1;
159              
160 5146 100       5758 if ($i < 0) {
161 12         19 return undef;
162             }
163              
164 5134         3374 my $including_repdigits = $self->{'including_repdigits'};
165              
166 5134 100       5186 my $pair_step = ($including_repdigits ? $radix*$radix : $radix*$rdec+1);
167             ### small pair_step: $pair_step
168              
169 5134 100 66     8165 if ($i < $pair_step || _is_infinite($i)) {
170             ### below small pairs ...
171              
172             # at i=11 skip to value=12
173             # i=19 value=20
174             # i=20 value=21
175             # i=21 skip to value=23
176             #
177 3200 100 100     6361 if (! $including_repdigits && $i > $radix) {
178 1474         1476 $i += int(($i-1)/$radix); # skip 11,22,33 etc
179             }
180 3200         3722 return $i;
181             }
182              
183 1934         1615 $i -= $pair_step;
184             ### i remainder: $i
185              
186 1934 100       2001 $pair_step = $rdec*($including_repdigits ? $radix : $rdec);
187             ### decreased pair_step: $pair_step
188              
189 1934         1391 my $i_pair = $i % $pair_step;
190 1934         1775 my $i_len = int($i/$pair_step);
191             ### $i_pair
192             ### $i_len
193              
194 1934         1077 my ($a, $b);
195 1934 100       1825 if ($including_repdigits) {
196 882         706 $a = int($i_pair/$radix) + 1;
197 882         619 $b = $i_pair % $radix;
198             } else {
199 1052         832 $a = int($i_pair/$rdec) + 1;
200 1052         603 $b = $i_pair % $rdec;
201 1052         767 $b += ($b >= $a);
202             }
203             ### $a
204             ### $b
205              
206 1934         1468 my $ret = $a*$radix + $b;
207             ### $ret
208 1934         2475 while ($i_len-- >= 0) {
209 2134         1381 $ret = ($ret * $radix) + $a;
210             ### append A to: $ret
211              
212 2134 100       2960 last unless $i_len-- >= 0;
213 445         538 $ret = ($ret * $radix) + $b;
214             ### append B to: $ret
215             }
216              
217             ### $ret
218 1934         2279 return $ret;
219             }
220              
221             sub pred {
222 33839     33839 1 109302 my ($self, $value) = @_;
223              
224 33839 50       39064 if (_is_infinite($value)) {
225 0         0 return undef;
226             }
227 33839 100       43463 if ($value != int($value)) {
228 1784         1511 return 0;
229             }
230              
231 32055         22789 my $radix = $self->{'radix'};
232 32055         20987 my $a = $value % $radix;
233 32055 100       40067 if ($value = int($value/$radix)) {
234 31749         18689 my $b = $value % $radix;
235 31749 100 100     60493 if (! $self->{'including_repdigits'}
236             && $a == $b) {
237 2708         2774 return 0;
238             }
239              
240 29041         34968 while ($value = int($value/$radix)) {
241 27111 100       30965 if (($value % $radix) != $a) { return 0; }
  22389         22879  
242              
243 4722   100     6126 $value = int($value/$radix) || last;
244 3136 100       4238 if (($value % $radix) != $b) { return 0; }
  2070         2199  
245             }
246             }
247 4888         4693 return 1;
248             }
249              
250             sub value_to_i_floor {
251 31349     31349 1 97458 my ($self, $value) = @_;
252             ### value_to_i_floor(): $value
253              
254 31349 100       35551 if ($value <= 0) {
255 90         554 return 0;
256             }
257 31259 50       56264 if (_is_infinite($value)) {
258 0         0 return $value;
259             }
260              
261 31259         72442 my $radix = $self->{'radix'};
262 31259         30772 my @digits = _digit_split(int($value), $radix);
263              
264 31259         23136 my $a = pop @digits;
265 31259 100       35685 @digits or return $a; # one digit only
266              
267 30969         22082 my $including_repdigits = $self->{'including_repdigits'};
268 30969         20906 my $rdec = $radix - 1;
269              
270 30969         18306 my $b = pop @digits;
271             ### $a
272             ### $b
273             ### $including_repdigits
274             ### digit count: scalar(@digits)
275             ### $radix
276             ### $rdec
277              
278 30969 100 100     88375 my $i = $a * ($including_repdigits ? $radix : $rdec) + $b
    100          
    100          
279             + ($including_repdigits || $a < $b ? 0 : 1)
280             + scalar(@digits) * $rdec*($including_repdigits ? $radix : $rdec);
281             ### $i
282              
283             # see if the value is in fact smaller than ABABAB...
284             # if !repdigits and have a=b then it's bigger
285              
286 30969 100 100     127891 if (! $including_repdigits && $a == $b) {
287             ### repdigits when a=b ...
288 2414         3256 return $i-1;
289             }
290              
291 28555 50 66     55925 if ($including_repdigits
292             || $a != $b) {
293              
294 28555         34761 while (@digits) {
295 29635 100       34272 if ((my $c = pop @digits) != $a) { # found different than ABABAB...
296 23749 100       26365 if ($c < $a) { $i -= 1; }
  10157         7509  
297 23749         30858 return $i;
298             }
299 5886         11572 ($a,$b) = ($b,$a);
300             }
301             }
302             # value is either ABAB exactly, or something bigger
303 4806         6078 return $i;
304             }
305             *value_to_i_estimate = \&value_to_i_floor;
306              
307              
308             sub _digit_split {
309 31259     31259   23889 my ($n, $radix) = @_;
310             ### _digit_split(): $n
311 31259         18673 my @ret;
312 31259         34512 while ($n) {
313 118703         128884 push @ret, $n % $radix;
314 118703         195284 $n = int($n/$radix);
315             }
316 31259         63668 return @ret; # low to high
317             }
318              
319             1;
320             __END__