File Coverage

blib/lib/Math/NumSeq/Fibonacci.pm
Criterion Covered Total %
statement 115 136 84.5
branch 33 50 66.0
condition 6 12 50.0
subroutine 21 22 95.4
pod 6 6 100.0
total 181 226 80.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::Fibonacci;
19 28     28   6135 use 5.004;
  28         65  
20 28     28   101 use strict;
  28         29  
  28         513  
21              
22 28     28   96 use vars '$VERSION','@ISA';
  28         37  
  28         1272  
23             $VERSION = 72;
24 28     28   8501 use Math::NumSeq::Base::Sparse; # FIXME: implement pred() directly ...
  28         40  
  28         693  
25             @ISA = ('Math::NumSeq::Base::Sparse');
26              
27 28     28   795 use Math::NumSeq;
  28         28  
  28         949  
28             *_is_infinite = \&Math::NumSeq::_is_infinite;
29             *_to_bigint = \&Math::NumSeq::_to_bigint;
30              
31             # uncomment this to run the ### lines
32             # use Smart::Comments;
33              
34              
35             # use constant name => Math::NumSeq::__('Fibonacci Numbers');
36 28     28   76 use constant description => Math::NumSeq::__('The Fibonacci numbers 1,1,2,3,5,8,13,21, etc, each F(i) = F(i-1) + F(i-2), starting from 1,1.');
  28         28  
  28         73  
37              
38 28     28   702 use constant values_min => 0;
  28         28  
  28         942  
39 28     28   83 use constant i_start => 0;
  28         27  
  28         945  
40 28     28   83 use constant characteristic_increasing => 1;
  28         50  
  28         1558  
41 28     28   90 use constant characteristic_integer => 1;
  28         60  
  28         1086  
42              
43             #------------------------------------------------------------------------------
44             # cf A105527 - index when n-nacci exceeds Fibonacci
45             # A020695 - Pisot 2,3,5,8,etc starting OFFSET=0
46             # A212804 - starting 1,0 OFFSET=0
47              
48 28     28   92 use constant oeis_anum => 'A000045'; # fibonacci starting at i=0 0,1,1,2,3
  28         26  
  28         15909  
49              
50             #------------------------------------------------------------------------------
51              
52             # $uv_limit is the biggest Fibonacci number f0 for which both f0 and f1 fit
53             # into a UV. Upon reaching $uv_limit the next step will require BigInt.
54             # $uv_i_limit is the i index of $uv_limit.
55             #
56             my $uv_limit;
57             my $uv_i_limit = 0;
58             {
59             # Float integers too in 32 bits ?
60             # my $max = 1;
61             # for (1 .. 256) {
62             # my $try = $max*2 + 1;
63             # ### $try
64             # if ($try == 2*$max || $try == 2*$max+2) {
65             # last;
66             # }
67             # $max = $try;
68             # }
69             my $max = ~0;
70              
71             # f1+f0 > i
72             # f0 > i-f1
73             # check i-f1 as the stopping point, so that if i=UV_MAX then won't
74             # overflow a UV trying to get to f1>=i
75             #
76             my $f0 = 1;
77             my $f1 = 1;
78             my $prev_f0;
79             while ($f0 <= $max - $f1) {
80             $prev_f0 = $f0;
81             ($f1,$f0) = ($f1+$f0,$f1);
82             $uv_i_limit++;
83             }
84              
85             ### Fibonacci UV limit ...
86             ### $prev_f0
87             ### $f0
88             ### $f1
89             ### ~0 : ~0
90              
91             $uv_limit = $prev_f0;
92              
93             ### $uv_limit
94             ### $uv_i_limit
95              
96             __PACKAGE__->ith($uv_i_limit) == $uv_limit
97             or warn "Oops, wrong uv_i_limit";
98             }
99              
100             sub rewind {
101 10     10 1 474 my ($self) = @_;
102             ### Fibonacci rewind()
103 10         23 $self->{'f0'} = 0;
104 10         12 $self->{'f1'} = 1;
105 10         38 $self->{'i'} = $self->i_start;
106             }
107             sub seek_to_i {
108 183     183 1 10944 my ($self, $i) = @_;
109 183         240 ($self->{'f0'}, $self->{'f1'}) = $self->ith_pair($i);
110 183         302 $self->{'i'} = $i;
111             }
112             sub next {
113 1139     1139 1 35342 my ($self) = @_;
114             ### Fibonacci next(): "f0=$self->{'f0'}, f1=$self->{'f1'}"
115             (my $ret,
116             $self->{'f0'},
117             $self->{'f1'})
118             = ($self->{'f0'},
119             $self->{'f1'},
120 1139         1662 $self->{'f0'} + $self->{'f1'});
121             ### $ret
122              
123 1139 100       12455 if ($ret == $uv_limit) {
124             ### go to bigint f1 ...
125 4         71 $self->{'f1'} = _to_bigint($self->{'f1'});
126             }
127              
128 1139         15979 return ($self->{'i'}++, $ret);
129             }
130              
131             # F[k-1] + F[k] = F[k+1]
132             # F[k-1] = F[k+1] - F[k]
133             # F[2k+1] = (2F[k]+F[k-1])*(2F[k]-F[k-1]) + 2*(-1)^k
134             # = (2F[k] + F[k+1] - F[k])*(2F[k] - (F[k+1] - F[k])) + 2*(-1)^k
135             # = (F[k] + F[k+1])*(2F[k] - F[k+1] + F[k]) + 2*(-1)^k
136             # = (F[k] + F[k+1])*(3F[k] - F[k+1]) + 2*(-1)^k
137             # F[2k] = F[k]*(F[k]+2F[k-1])
138             # = F[k]*(F[k]+2(F[k+1] - F[k]))
139             # = F[k]*(F[k]+2F[k+1] - 2F[k])
140             # = F[k]*(2F[k+1] - F[k])
141              
142             sub ith {
143 686     686 1 34518 my ($self, $i) = @_;
144             ### Fibonacci ith(): $i
145              
146 686         685 my $lowbit = ($i % 2);
147 686         1183 my $pair_i = ($i - $lowbit) / 2;
148 686         1231 my ($F0, $F1) = $self->ith_pair($pair_i);
149              
150 686 100 100     1536 if ($i > $uv_i_limit && ! ref $F0) {
151             ### automatic BigInt as not another bignum class ...
152 243         400 $F0 = _to_bigint($F0);
153 243         6097 $F1 = _to_bigint($F1);
154             }
155              
156             # last step needing just one of F[2k] or F[2k+1] done by one multiply
157             # instead of two squares in the ith_pair() loop
158             #
159 686 100       4798 if ($lowbit) {
160 356 100       652 $F0 = ($F0 + $F1) * (3*$F0 - $F1) + ($pair_i % 2 ? -2 : 2);
161             } else {
162 330         411 $F0 *= (2*$F1 - $F0);
163             }
164 686         63261 return $F0;
165             }
166              
167             sub ith_pair {
168 2127     2127 1 49999 my ($self, $i) = @_;
169             ### Fibonacci ith_pair(): $i
170              
171 2127 100       3229 if (_is_infinite($i)) {
172 3         114 return ($i,$i);
173             }
174              
175 2124         2094 my $neg = ($i < 0);
176 2124 100       2438 if ($neg) {
177 22         18 $i = -1-$i;
178             }
179              
180 2124         2637 my @bits = _bit_split_hightolow($i+1);
181             ### @bits
182 2124         1800 shift @bits; # drop high 1-bit
183              
184             # k=1 which is the high bit of @bits
185             # $Fk1 = F[k-1] = 0
186             # $Fk = F[k] = 1
187             #
188 2124         1562 my $Fk1 = ($i * 0); # inherit bignum 0
189 2124 100 66     3975 if ($i >= $uv_i_limit && ! ref $Fk1) {
190             # automatic BigInt if not another number class
191 550         885 $Fk1 = _to_bigint(0);
192             }
193 2124         29034 my $Fk = $Fk1 + 1; # inherit bignum 1
194              
195 2124         39714 my $add = -2; # (-1)^k
196 2124         3693 while (@bits) {
197             ### remaining bits: @bits
198             ### Fk1: "$Fk1"
199             ### Fk: "$Fk"
200              
201             # two squares and some adds
202             # F[2k+1] = 4*F[k]^2 - F[k-1]^2 + 2*(-1)^k
203             # F[2k-1] = F[k]^2 + F[k-1]^2
204             # F[2k] = F[2k+1] - F[2k-1]
205             #
206 10522         9714 $Fk *= $Fk;
207 10522         114569 $Fk1 *= $Fk1;
208 10522         105737 my $F2kplus1 = 4*$Fk - $Fk1 + $add;
209 10522         696926 $Fk1 += $Fk; # F[2k-1]
210 10522         109551 my $F2k = $F2kplus1 - $Fk1;
211              
212 10522 100       210166 if (shift @bits) { # high to low
213 4826         3149 $Fk1 = $F2k; # F[2k]
214 4826         3738 $Fk = $F2kplus1; # F[2k+1]
215 4826         7235 $add = -2;
216             } else {
217             # $Fk1 is F[2k-1] already
218 5696         3624 $Fk = $F2k; # F[2k]
219 5696         9421 $add = 2;
220             }
221             }
222              
223 2124 100       2518 if ($neg) {
224 22         24 ($Fk1,$Fk) = ($Fk, $Fk1);
225 22 100       31 if ($i % 2) {
226 9         9 $Fk1 = -$Fk1;
227             } else {
228 13         12 $Fk = -$Fk;
229             }
230             }
231              
232             ### final ...
233             ### Fk1: "$Fk1"
234             ### Fk: "$Fk"
235 2124         3024 return ($Fk1, $Fk);
236             }
237              
238             sub _bit_split_hightolow {
239 2575     2575   1866 my ($n) = @_;
240             ### _bit_split_hightolow(): "$n"
241              
242 2575 100       2971 if (ref $n) {
243 39 50 33     230 if ($n->isa('Math::BigInt')
244             && $n->can('as_bin')) {
245             ### BigInt: $n->as_bin
246 39         76 return split //, substr($n->as_bin,2);
247             }
248             }
249 2536         1751 my @bits;
250 2536         3057 while ($n) {
251 14459         9462 push @bits, $n % 2;
252 14459         17167 $n = int($n/2);
253             }
254 2536         4320 return reverse @bits;
255             }
256              
257 28     28   120 use constant 1.02 _PHI => (1 + sqrt(5)) / 2;
  28         394  
  28         1505  
258 28     28   100 use constant 1.02 _BETA => -1/_PHI;
  28         301  
  28         9662  
259              
260             sub value_to_i_estimate {
261 40     40 1 297 my ($self, $value) = @_;
262 40 50       49 if (_is_infinite($value)) {
263 0         0 return $value;
264             }
265 40 100       293 if ($value <= 0) {
266 9         10 return 0;
267             }
268              
269 31 100       103 if (defined (my $blog2 = _blog2_estimate($value))) {
270             # i ~= (log2(F(i)) + log2(phi)) / log2(phi-beta)
271             # with log2(x) = log(x)/log(2)
272 1         205 return int( ($blog2 + (log(_PHI - _BETA)/log(2)))
273             / (log(_PHI)/log(2)) );
274             }
275              
276             # i ~= (log(F(i)) + log(phi)) / log(phi-beta)
277 30         47 return int( (log($value) + log(_PHI - _BETA))
278             / log(_PHI) );
279             }
280              
281             sub _UNTESTED__value_to_i {
282 0     0   0 my ($self, $value) = @_;
283 0 0       0 if ($value < 0) { return undef; }
  0         0  
284 0         0 my $i = $self->value_to_i_estimate($value) - 3;
285 0 0       0 if (_is_infinite($i)) { return $i; }
  0         0  
286              
287 0 0       0 if ($i < 0) { $i = 0; }
  0         0  
288 0         0 my ($f0,$f1) = $self->ith_pair($i);
289 0         0 foreach (1 .. 10) {
290 0 0       0 if ($f0 == $value) {
291 0         0 return $i;
292             }
293 0 0       0 last if $f0 > $value;
294 0 0 0     0 if ($i == $uv_i_limit && ! ref $f0) {
295             # automatic BigInt if not another number class
296 0         0 $f1 = _to_bigint($f1);
297             }
298 0         0 ($f0, $f1) = ($f1, $f0+$f1);
299 0         0 $i += 1;
300             }
301 0         0 return undef;
302             }
303              
304             #------------------------------------------------------------------------------
305             # generic, shared
306              
307             # if $n is a BigInt, BigRat or BigFloat then return an estimate of log base 2
308             # otherwise return undef.
309             #
310             # For Math::BigInt
311             #
312             # For BigRat the calculation is just a bit count of the numerator less the
313             # denominator so may be off by +/-1 or +/-2 or some such. For
314             #
315             sub _blog2_estimate {
316 569     569   426 my ($n) = @_;
317              
318 569 100       701 if (ref $n) {
319             ### _blog2_estimate(): "$n"
320              
321 32 50       152 if ($n->isa('Math::BigRat')) {
322 0         0 return ($n->numerator->copy->blog(2) - $n->denominator->copy->blog(2))->numify;
323             }
324 32 50       176 if ($n->isa('Math::BigFloat')) {
325 0         0 return $n->as_int->blog(2)->numify;
326             }
327 32 50       102 if ($n->isa('Math::BigInt')) {
328 32         75 return $n->copy->blog(2)->numify;
329             }
330             }
331 537         937 return undef;
332             }
333              
334             1;
335             __END__