File Coverage

blib/lib/Math/NumSeq/ReverseAdd.pm
Criterion Covered Total %
statement 48 111 43.2
branch 2 28 7.1
condition 2 16 12.5
subroutine 13 22 59.0
pod 9 10 90.0
total 74 187 39.5


line stmt bran cond sub pod time code
1             # Copyright 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::ReverseAdd;
19 1     1   14754 use 5.004;
  1         4  
  1         37  
20 1     1   6 use strict;
  1         2  
  1         34  
21              
22 1     1   6 use vars '$VERSION','@ISA';
  1         1  
  1         58  
23             $VERSION = 71;
24 1     1   616 use Math::NumSeq;
  1         3  
  1         55  
25             @ISA = ('Math::NumSeq');
26             *_is_infinite = \&Math::NumSeq::_is_infinite;
27              
28             # uncomment this to run the ### lines
29             #use Smart::Comments;
30              
31              
32 1     1   7 use constant i_start => 0;
  1         2  
  1         62  
33              
34 1     1   5 use constant characteristic_integer => 1;
  1         3  
  1         128  
35             sub characteristic_increasing {
36 1     1 0 2 my ($self) = @_;
37             # any non-zero start always increases
38 1         6 return ($self->{'start'} != 0);
39             }
40             sub values_min {
41 0     0 1 0 my ($self) = @_;
42 0         0 return $self->{'start'};
43             }
44             sub values_max {
45 0     0 1 0 my ($self) = @_;
46             # starting from zero never changes, otherwise unbounded
47 0 0       0 return ($self->{'start'} ? undef : 0);
48             }
49              
50 1     1   639 use Math::NumSeq::Base::Digits;
  1         3  
  1         918  
51 1         20 use constant parameter_info_array =>
52             [
53             {
54             name => 'start',
55             display => Math::NumSeq::__('Start'),
56             type => 'integer',
57             default => 1,
58             minimum => 0,
59             width => 5,
60             description => Math::NumSeq::__('Starting value for the sequence.'),
61             },
62             Math::NumSeq::Base::Digits->parameter_info_list(),
63 1     1   7 ];
  1         3  
64              
65             sub description {
66 0     0 1 0 my ($self) = @_;
67 0         0 my $ret = Math::NumSeq::__('Reverse-add sequence, reverse the digits and add.');
68 0 0       0 if (ref $self) { # object method
69 0         0 $ret .= "\nStarting from $self->{'start'}, in radix $self->{'radix'}.";
70             }
71 0         0 return $ret;
72             }
73              
74             #------------------------------------------------------------------------------
75             my %oeis_anum;
76              
77             # cf A058042 written out in binary
78             # ~/OEIS/a058042.txt on reaching binary palindromes
79             # A033908 sort-add
80              
81             $oeis_anum{'2'}->{'1'} = 'A035522';
82             $oeis_anum{'2'}->{'22'} = 'A061561';
83             $oeis_anum{'2'}->{'77'} = 'A075253';
84             $oeis_anum{'2'}->{'442'} = 'A075268';
85             $oeis_anum{'2'}->{'537'} = 'A077076';
86             $oeis_anum{'2'}->{'775'} = 'A077077';
87             # OEIS-Catalogue: A035522 radix=2 start=1
88             # OEIS-Catalogue: A061561 radix=2 start=22
89             # OEIS-Catalogue: A075253 radix=2 start=77
90             # OEIS-Catalogue: A075268 radix=2 start=442
91             # OEIS-Catalogue: A077076 radix=2 start=537
92             # OEIS-Catalogue: A077077 radix=2 start=775
93              
94             $oeis_anum{'3'}->{'1'} = 'A035523';
95             # OEIS-Catalogue: A035523 radix=3 start=1
96              
97             $oeis_anum{'4'}->{'1'} = 'A035524';
98             $oeis_anum{'4'}->{'290'} = 'A075299';
99             $oeis_anum{'4'}->{'318'} = 'A075153';
100             $oeis_anum{'4'}->{'266718'} = 'A075466';
101             $oeis_anum{'4'}->{'270798'} = 'A075467';
102             $oeis_anum{'4'}->{'1059774'} = 'A076247';
103             $oeis_anum{'4'}->{'1059831'} = 'A076248';
104             # OEIS-Catalogue: A035524 radix=4 start=1
105             # OEIS-Catalogue: A075299 radix=4 start=290
106             # OEIS-Catalogue: A075153 radix=4 start=318
107             # OEIS-Catalogue: A075466 radix=4 start=266718
108             # OEIS-Catalogue: A075467 radix=4 start=270798
109             # OEIS-Catalogue: A076247 radix=4 start=1059774
110             # OEIS-Catalogue: A076248 radix=4 start=1059831
111              
112             $oeis_anum{'10'}->{'1'} = 'A001127';
113             $oeis_anum{'10'}->{'3'} = 'A033648';
114             $oeis_anum{'10'}->{'5'} = 'A033649';
115             $oeis_anum{'10'}->{'7'} = 'A033650';
116             $oeis_anum{'10'}->{'9'} = 'A033651';
117             $oeis_anum{'10'}->{'89'} = 'A033670';
118             $oeis_anum{'10'}->{'196'} = 'A006960';
119             # OEIS-Catalogue: A001127 start=1
120             # OEIS-Catalogue: A033648 start=3
121             # OEIS-Catalogue: A033649 start=5
122             # OEIS-Catalogue: A033650 start=7
123             # OEIS-Catalogue: A033651 start=9
124             # OEIS-Catalogue: A033670 start=89
125             # OEIS-Catalogue: A006960 start=196
126              
127             sub oeis_anum {
128 0     0 1 0 my ($self) = @_;
129 0         0 my $start = $self->{'start'};
130              
131 0 0       0 if ($start == 0) { return 'A000004'; } # all zeros
  0         0  
132             # some sample zeros to exercise
133             # OEIS-Other: A000004 radix=2 start=0
134             # OEIS-Other: A000004 radix=9 start=0
135              
136 0         0 return $oeis_anum{$self->{'radix'}}->{$start};
137             }
138              
139             #------------------------------------------------------------------------------
140              
141             my $max = do {
142             my $m = 1;
143             foreach (1 .. 256) {
144             my $double = 2*$m;
145             my $next = 2*$m + 1;
146             if ($next <= 2*$m || $next >= 2*$m+2) {
147             last;
148             }
149             # must be able to divide for _reverse_in_radix()
150             if (int($next/2) != $m) {
151             last;
152             }
153             $m = $next;
154             }
155             $m = int($m/2);
156             ### $m
157             ### m hex: sprintf '%X', $m
158             $m
159             };
160              
161             sub rewind {
162 1     1 1 2 my ($self) = @_;
163 1         6 $self->{'i'} = $self->i_start;
164 1         4 $self->{'value'} = $self->{'start'};
165 1         6 $self->{'uv_limit'} = int ($max / $self->{'radix'});
166             }
167             sub next {
168 0     0 1 0 my ($self) = @_;
169             ### ReverseAdd next(): "i=$self->{'i'} ".(ref $self->{'value'})." $self->{'value'}"
170             ### reverse: _reverse_in_radix($self->{'value'}, $self->{'radix'})
171              
172 0         0 my $ret = $self->{'value'};
173 0 0 0     0 if (! ref $ret && $ret >= $self->{'uv_limit'}) {
174             ### go to bigint ...
175 0         0 $self->{'value'} = Math::NumSeq::_to_bigint($ret);
176             }
177 0         0 $self->{'value'} += _reverse_in_radix($ret, $self->{'radix'});
178 0         0 return ($self->{'i'}++,
179             $ret);
180             }
181              
182             sub ith {
183 0     0 1 0 my ($self, $i) = @_;
184             ### ReverseAdd ith(): $i
185              
186 0 0       0 if (_is_infinite($i)) {
187 0         0 return undef;
188             }
189              
190 0         0 my $radix = $self->{'radix'};
191 0   0     0 my $start = $self->{'start'} || return 0; # start 0 gives 0
192 0         0 my $value = ($i*0) + $start; # inherit bignum from $i
193              
194 0         0 while ($i-- > 0) {
195 0         0 $value += _reverse_in_radix($value, $radix);
196             }
197 0         0 return $value;
198             }
199             # if ($value >= $self->{'uv_limit'}) {
200             # ### go to bigint ...
201             # $value = Math::NumSeq::_to_bigint($value);
202             # while ($i-- > 0) {
203             # $value += _reverse_in_radix($value, $radix);
204             # }
205             # last;
206             # }
207              
208             sub pred {
209 0     0 1 0 my ($self, $value) = @_;
210             ### ReverseAdd pred(): $value
211              
212 0   0     0 my $start = $self->{'start'} || return ($value == 0); # start 0 gives 0
213 0 0 0     0 if ($value < $start || _is_infinite($value)) {
214 0         0 return 0;
215             }
216              
217             {
218 0         0 my $int = int($value);
  0         0  
219 0 0       0 if ($value != $int) {
220 0         0 return 0;
221             }
222 0         0 $value = $int;
223             }
224              
225 0         0 my $radix = $self->{'radix'};
226 0         0 my $k = ($value*0) + $start;
227 0         0 while ($k < $self->{'uv_limit'}) {
228 0 0       0 unless ($value > $k) {
229 0         0 return ($value == $k);
230             }
231 0         0 $k += _reverse_in_radix($k, $radix);
232             }
233              
234             ### go to bigint ...
235 0         0 for (;;) {
236 0 0       0 unless ($value > $k) {
237 0         0 return ($value == $k);
238             }
239 0         0 $k += _reverse_in_radix($k, $radix);
240             }
241             }
242              
243             # if ($value >= $self->{'uv_limit'}) {
244             # ### go to bigint ...
245             # $value = Math::NumSeq::_to_bigint($value);
246             # while ($i-- > 0) {
247             # $value += _reverse_in_radix($value, $radix);
248             # }
249             # last;
250             # }
251              
252             # FIXME: smaller than this
253             sub value_to_i_estimate {
254 0     0 1 0 my ($self, $value) = @_;
255 0 0       0 if (_is_infinite($value)) {
256 0         0 return $value;
257             }
258 0         0 my $i = 1;
259 0         0 for (;; $i++) {
260 0         0 $value = int($value/2);
261 0 0       0 if ($value <= 1) {
262 0         0 return $i;
263             }
264             }
265             }
266              
267             my %binary_to_base4 = (# '0b' => '',
268             '00' => '0',
269             '01' => '1',
270             '10' => '2',
271             '11' => '3');
272             sub _bigint_as_base4 {
273 1     1   2 my ($big) = @_;
274 1         5 my $str = $big->as_bin;
275 1         25 $str =~ s/^0b//;
276 1 50       5 if (length($str) & 1) {
277 1         3 $str = "0$str";
278             }
279 1         7 $str =~ s/(..)/$binary_to_base4{$1}/ge;
  5         17  
280 1         4 return $str;
281             }
282             my @base4_to_binary = ('00','01','10','11');
283             sub _bigint_from_base4 {
284 1     1   2 my ($class, $str) = @_;
285             ### _bigint_from_base4(): $str
286 1         5 $str =~ s/(.)/$base4_to_binary[$1]/ge;
  5         16  
287 1         5 return $class->from_bin("0b$str");
288             }
289              
290 0     0   0 sub _bigint_from_bin_with_0b {
291             }
292              
293             my @radix_to_stringize_method;
294             my @string_to_bigint_method;
295             my $bigint = Math::NumSeq::_bigint();
296             {
297             if ($bigint->can('as_bin') && $bigint->can('from_bin')) {
298             $radix_to_stringize_method[2] = 'as_bin';
299             # in past BigInt must have 0b prefix for from_bin()
300             $string_to_bigint_method[2]
301             = ($bigint->from_bin('0') == 0
302             ? 'from_bin'
303             : sub {
304             ### from_bin with 0b: "0b$_[1]"
305             $_[0]->from_bin("0b$_[1]");
306             });
307              
308             $radix_to_stringize_method[4] = \&_bigint_as_base4;
309             $string_to_bigint_method[4] = \&_bigint_from_base4;
310             }
311             if ($bigint->can('as_oct') && $bigint->can('from_oct')) {
312             $radix_to_stringize_method[8] = 'as_oct';
313             $string_to_bigint_method[8] = 'from_oct';
314             }
315             if ($bigint->can('as_hex') && $bigint->can('from_hex')) {
316             $radix_to_stringize_method[16] = 'as_hex';
317             # in past BigInt must have 0x prefix for from_hex()
318             $string_to_bigint_method[16]
319             = ($bigint->from_hex('0') == 0
320             ? 'from_hex'
321             : sub {
322             ### from_hex with 0x: "0x$_[1]"
323             $_[0]->from_hex("0x$_[1]");
324             });
325             }
326             if ($bigint->can('bstr')) {
327             $radix_to_stringize_method[10] = 'bstr';
328             $string_to_bigint_method[10] = 'new';
329             }
330             }
331             ### @radix_to_stringize_method
332             ### @string_to_bigint_method
333              
334             # return $n reversed in $radix
335             sub _reverse_in_radix {
336 5     5   557 my ($n, $radix) = @_;
337              
338             # prefer bstr() over plain stringize "$n" since BigInt in 5.8 and 5.10
339             # seems to do something dubious in "$n" which rounds off
340 5 50 33     59 if (ref $n
      33        
341             && $n->isa('Math::BigInt')
342             && (my $method = $radix_to_stringize_method[$radix])) {
343 5         9 my $from = $string_to_bigint_method[$radix];
344 5         26 my $str = $n->$method();
345 5         231 $str =~ s/^0[bx]?//;
346             ### $str
347             ### $from
348             ### reverse: scalar(reverse($str))
349             ### result: $bigint->$from(scalar(reverse($str))).''
350 5         59 return $bigint->$from(scalar(reverse($str)));
351             }
352              
353 0 0         if ($radix == 10) {
354 0           return scalar(reverse("$n"));
355             }
356              
357             # ### _reverse_in_radix(): sprintf '%#X %d', $n, $n
358              
359 0           my $ret = $n*0; # inherit bignum 0
360 0           do {
361 0           $ret = $ret * $radix + ($n % $radix);
362             } while ($n = int($n/$radix));
363              
364             # ### ret: sprintf '%#X %d', $ret, $ret
365 0           return $ret;
366             }
367              
368             1;
369             __END__