File Coverage

blib/lib/Math/NumSeq/FibbinaryBitCount.pm
Criterion Covered Total %
statement 66 71 92.9
branch 11 16 68.7
condition 1 3 33.3
subroutine 15 15 100.0
pod 4 4 100.0
total 97 109 88.9


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              
19             package Math::NumSeq::FibbinaryBitCount;
20 1     1   1783 use 5.004;
  1         4  
21 1     1   5 use strict;
  1         1  
  1         29  
22              
23 1     1   7 use vars '$VERSION', '@ISA';
  1         2  
  1         77  
24             $VERSION = 72;
25              
26 1     1   6 use Math::NumSeq;
  1         2  
  1         24  
27 1     1   4 use Math::NumSeq::Base::IterateIth;
  1         2  
  1         70  
28             @ISA = ('Math::NumSeq::Base::IterateIth',
29             'Math::NumSeq');
30             *_is_infinite = \&Math::NumSeq::_is_infinite;
31              
32              
33             # uncomment this to run the ### lines
34             # use Smart::Comments;
35              
36             # use constant name => Math::NumSeq::__('Fibbinary Bit Count');
37 1     1   4 use constant description => Math::NumSeq::__('Bit count of fibbinary numbers (the numbers without adjacent 1 bits).');
  1         1  
  1         3  
38 1     1   6 use constant default_i_start => 0; # same as Fibbinary.pm
  1         1  
  1         49  
39 1     1   19 use constant characteristic_increasing => 0;
  1         2  
  1         54  
40 1     1   14 use constant characteristic_count => 1;
  1         2  
  1         46  
41 1     1   5 use constant characteristic_smaller => 1;
  1         2  
  1         77  
42              
43 1         8 use constant parameter_info_array =>
44             [ { name => 'digit',
45             display => Math::NumSeq::__('Digit'),
46             share_key => 'digit_1_0_00',
47             type => 'enum',
48             default => '1',
49             choices => ['1','0','00'],
50             description => Math::NumSeq::__('What digit to count.'),
51             },
52 1     1   4 ];
  1         2  
53              
54             sub values_min {
55 1     1 1 6 my ($self) = @_;
56 1 50       6 if ($self->{'digit'} eq 'all') {
57 0         0 return $self->ith($self->i_start);
58             } else {
59 1         2 return 0;
60             }
61             }
62              
63             #------------------------------------------------------------------------------
64             # cf A027941 new highest bit count positions, being Fibonacci(2i+1)-1
65             # A095111 bit count parity, 1/0
66             # A020908 bit count of 2^k
67             #
68             # A072649 n occurs Fibonacci(n) times
69             # is fibbinary bit length
70             # A130233 maximum index k for which F(k) <= n, fibbinary length + 1
71             # A131234 1 then n occurs Fib(n) times
72             # is length(Zeck)+1
73             # A049839 max in row of Euclidean steps table A049837
74             #
75             #
76             my %oeis_anum = (1 => 'A007895', # fibbinary 1-bit count
77             0 => 'A102364',
78             '00' => 'A212278', # count "00" adjacent, possibly overlapping
79             all => 'A072649',
80             # OEIS-Catalogue: A007895
81             # OEIS-Catalogue: A102364 digit=0
82             # OEIS-Catalogue: A212278 digit=00
83             # OEIS-Catalogue: A072649 digit=all i_start=1
84             );
85             sub oeis_anum {
86 1     1 1 4 my ($self) = @_;
87 1         3 return $oeis_anum{$self->{'digit'}};
88             }
89              
90             #------------------------------------------------------------------------------
91              
92             sub ith {
93 178     178 1 164 my ($self, $i) = @_;
94             ### FibbinaryBitCount ith(): $i
95              
96 178 50       216 if (_is_infinite($i)) {
97 0         0 return $i;
98             }
99              
100             # f1+f0 > i
101             # f0 > i-f1
102             # check i-f1 as the stopping point, so that if i=UV_MAX then won't
103             # overflow a UV trying to get to f1>=i
104             #
105 178         142 my @fibs;
106             {
107 178         107 my $f0 = ($i * 0); # inherit bignum 0
  178         111  
108 178         129 my $f1 = $f0 + 1; # inherit bignum 1
109 178         227 while ($f0 <= $i-$f1) {
110 742         523 ($f1,$f0) = ($f1+$f0,$f1);
111 742         891 push @fibs, $f1;
112             }
113             }
114             ### @fibs
115              
116 178         161 my $digit = $self->{'digit'};
117 178 50       208 if ($digit eq 'all') {
118 0         0 return scalar(@fibs);
119             }
120              
121 178         110 my $ones = 0;
122 178         112 my $onezeros = 0;
123 178         101 my $sepzeros = 0;
124 178         226 while (my $f = pop @fibs) {
125             ### at: "$f i=$i"
126 352 100       318 if ($i >= $f) {
127 290         143 $ones++;
128 290         178 $i -= $f;
129             ### sub: "$f to i=$i"
130              
131             # never consecutive fibs, so pop without comparing to i
132 290 100       306 if (pop @fibs) {
133 228         138 $onezeros++;
134             }
135 290 100       702 unless ($i) {
136             ### stop at i=0 ...
137 168         98 $sepzeros += scalar(@fibs);
138 168         124 last;
139             }
140             } else {
141 62         77 $sepzeros++;
142             }
143             }
144             ### $ones
145             ### $onezeros
146             ### $sepzeros
147              
148 178 50       215 if ($digit eq '0') {
149 0         0 return $sepzeros + $onezeros;
150             }
151 178 50       201 if ($digit eq '00') {
152 0         0 return $sepzeros;
153             }
154 178         312 return $ones;
155             }
156              
157             sub pred {
158 14     14 1 39 my ($self, $value) = @_;
159 14   33     34 return ($value >= 0 && $value == int($value));
160             }
161              
162             1;
163             __END__