File Coverage

blib/lib/Math/NumSeq/FibonacciWord.pm
Criterion Covered Total %
statement 90 94 95.7
branch 12 16 75.0
condition 6 8 75.0
subroutine 18 19 94.7
pod 8 8 100.0
total 134 145 92.4


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             package Math::NumSeq::FibonacciWord;
20 2     2   55332 use 5.004;
  2         11  
  2         130  
21 2     2   16 use strict;
  2         6  
  2         108  
22              
23 2     2   45 use vars '$VERSION', '@ISA';
  2         5  
  2         283  
24             $VERSION = 71;
25              
26 2     2   857 use Math::NumSeq;
  2         4  
  2         56  
27 2     2   764 use Math::NumSeq::Base::IterateIth;
  2         5  
  2         92  
28             @ISA = ('Math::NumSeq::Base::IterateIth',
29             'Math::NumSeq');
30              
31 2     2   813 use Math::NumSeq::Fibbinary;
  2         6  
  2         265  
32              
33             # uncomment this to run the ### lines
34             #use Smart::Comments;
35              
36              
37             sub description {
38 4     4 1 18 my ($self) = @_;
39 4 100 100     23 if (ref $self && $self->{'fibonacci_word_type'} eq 'dense') {
40 1         7 return Math::NumSeq::__('0/1/2 dense Fibonacci word taking pairs from the plain word.');
41             }
42 3         11 return Math::NumSeq::__('0/1 values related to Fibonacci numbers, 0,1,0,0,1,0,1,0,etc.');
43             }
44 2     2   12 use constant default_i_start => 0;
  2         4  
  2         130  
45 2     2   10 use constant characteristic_integer => 1;
  2         5  
  2         100  
46 2     2   10 use constant characteristic_smaller => 1;
  2         5  
  2         98  
47 2     2   11 use constant values_min => 0;
  2         4  
  2         378  
48             sub values_max {
49 0     0 1 0 my ($self) = @_;
50 0 0       0 return ($self->{'fibonacci_word_type'} eq 'dense' ? 2 : 1);
51             }
52              
53 2         12 use constant parameter_info_array =>
54             [
55             { name => 'fibonacci_word_type',
56             display => Math::NumSeq::__('Fibonacci Word Type'),
57             type => 'enum',
58             default => 'plain',
59             choices => ['plain','dense'],
60             choices_display => [Math::NumSeq::__('Plain'),
61             Math::NumSeq::__('Dense'),
62             ],
63             description => Math::NumSeq::__('Which of the pair of values to show.'),
64             },
65 2     2   11 ];
  2         5  
66              
67             #------------------------------------------------------------------------------
68              
69             # cf A003842 same with values 1/2 instead of 0/1
70             # A014675 same with values 2/1 instead of 0/1
71             # A001468 values 2/1 instead of 0/1, skip leading 0, self-referential
72             # A005614 inverse 1/0, starting from 1
73             #
74             # A003622 positions of 1s
75             # A000201 positions of 0s
76             # A089910 positions of 1,1 pairs
77             # A114986 characteristic of A000201, with extra 1 ??
78             # A096270 expressed as 01 and 011, is inverse with leading 0
79             # A036299 values 0/1 inverse, bignum concatenating
80             # A008352 values 1/2 inverse, bignum concatenating
81             #
82             # A189479 0->01 1->101
83             # A007066 positions of 0s
84             # A076662 first diffs of positions, values 3/2 with extra leading 3
85             #
86             # A135817 whythoff repres 0s
87             # A135818 whythoff repres 1s
88             # A189921 whythoff form
89             # A135817 whythoff length A+B
90             #
91              
92             # A003849 OFFSET=0 values 0,1, 0,0, 1,0, 1,0, etc
93             # A143667 OFFSET=1 values 1,0,2,2,etc
94             #
95             my %oeis_anum
96             = (
97             # OEIS-Catalogue array begin
98             plain => 'A003849', #
99             'dense,i_start=1,i_offset=-1' => 'A143667', # fibonacci_word_type=dense i_start=1 i_offset=-1
100             # OEIS-Catalogue array end
101             );
102             sub oeis_anum {
103 2     2 1 10 my ($self) = @_;
104 2         6 my $key = $self->{'fibonacci_word_type'};
105 2         8 my $i_start = $self->i_start;
106 2 50       11 if ($i_start != $self->default_i_start) {
107 0         0 $key .= ",i_start=$i_start";
108             }
109 2 50       7 if ($self->{'i_offset'}) {
110 0         0 $key .= ",i_offset=$self->{'i_offset'}";
111             }
112 2         8 return $oeis_anum{$key};
113             }
114              
115             #------------------------------------------------------------------------------
116             # i_offset is a hack to number A143667 starting OFFSET=1, whereas otherwise
117             # here start i=0
118             #
119             # $self->{'i'} is the next $i to return from next()
120             #
121             # $self->{'value'} is Fibbinary->ith($self->{'i'}), or for "dense" is
122             # Fibbinary->ith(2 * $self->{'i'}). $self->{'value'} is incremented by the
123             # same bit-twiddling as in Fibbinary. The low bit of $self->{'value'} is
124             # the FibonacciWord $value. Or for "dense" the low bit of two successive
125             # values combined.
126             #
127              
128             sub rewind {
129 10     10 1 1269 my ($self) = @_;
130 10         52 $self->{'i'} = $self->i_start;
131 10         21 $self->{'value'} = 0;
132 10   50     73 $self->{'i_offset'} ||= 0;
133             }
134             sub seek_to_i {
135 27     27 1 552 my ($self, $i) = @_;
136 27         45 $self->{'i'} = $i;
137 27 100       96 if ($self->{'fibonacci_word_type'} eq 'dense') {
138 14         60 $self->{'value'} = Math::NumSeq::Fibbinary->ith(2*$i);
139             } else {
140 13         51 $self->{'value'} = Math::NumSeq::Fibbinary->ith($i);
141             }
142             }
143             sub next {
144 751     751 1 7001 my ($self) = @_;
145             ### FibonacciWord next() ...
146              
147 751 100       1884 if ($self->{'fibonacci_word_type'} eq 'dense') {
148 133         191 my $v = $self->{'value'};
149 133         196 my $high = ($v & 1) << 1;
150              
151 133         177 my $filled = ($v >> 1) | $v;
152 133         199 my $mask = (($filled+1) ^ $filled) >> 1;
153 133         160 $v = ($v | $mask) + 1;
154              
155 133         171 $filled = ($v >> 1) | $v;
156 133         165 $mask = (($filled+1) ^ $filled) >> 1;
157 133         203 $self->{'value'} = ($v | $mask) + 1;
158              
159 133         450 return ($self->{'i'}++, $high | ($v & 1));
160              
161             } else {
162 618         864 my $v = $self->{'value'};
163 618         975 my $filled = ($v >> 1) | $v;
164 618         896 my $mask = (($filled+1) ^ $filled) >> 1;
165 618         922 $self->{'value'} = ($v | $mask) + 1;
166              
167             ### value : sprintf('0b %6b',$v)
168             ### filled: sprintf('0b %6b',$filled)
169             ### mask : sprintf('0b %6b',$mask)
170             ### bit : sprintf('0b %6b',$mask+1)
171             ### newv : sprintf('0b %6b',$self->{'value'})
172              
173 618         1814 return ($self->{'i'}++, $v & 1);
174             }
175             }
176              
177             sub ith {
178 593     593 1 51594 my ($self, $i) = @_;
179             ### FibonacciWord ith(): $i
180              
181 593         906 $i = $i + $self->{'i_offset'};
182              
183             # if $i is inf or nan then $f0=$i*0 is nan and the while loop zero-trips
184             # and return is nan
185              
186 593         1616 my $f0 = ($i * 0) + 1; # inherit bignum 1
187 593         1945 my $f1 = $f0 + 1; # inherit bignum 2
188 593         1318 my $level = 0;
189             ### start: "$f1,$f0 level=$level"
190              
191             # f1+f0 > i
192             # f0 > i-f1
193             # check i-f1 as the stopping point, so that if i=UV_MAX then won't
194             # overflow a UV trying to get to f1>=i
195             #
196 593         1273 while ($f0 <= $i-$f1) {
197 4868         24361 ($f1,$f0) = ($f1+$f0,$f1);
198 4868         17348 $level++;
199             }
200             ### above: "$f1,$f0 level=$level"
201              
202 593 100       2422 if ($self->{'fibonacci_word_type'} eq 'dense') {
203 45         166 my $v = Math::NumSeq::Fibbinary->ith(2*$i);
204 45         67 my $high = ($v & 1) << 1;
205              
206 45         65 my $filled = ($v >> 1) | $v;
207 45         62 my $mask = (($filled+1) ^ $filled) >> 1;
208 45         57 $v = ($v | $mask) + 1;
209              
210 45         172 return ($high | ($v & 1));
211              
212             } else {
213              
214 548         1092 do {
215             ### at: "$f1,$f0 i=$i"
216 5331 100       20621 if ($i >= $f1) {
217 1681         3922 $i -= $f1;
218             }
219 5331         24210 ($f1,$f0) = ($f0,$f1-$f0);
220             } while ($level--);
221              
222             ### assert: $i == 0 || $i == 1
223             ### ret: $i
224 548         3537 return $i;
225             }
226             }
227              
228             sub pred {
229 33     33 1 161 my ($self, $value) = @_;
230 33   66     199 return ($value == 0 || $value == 1
231             || ($self->{'fibonacci_word_type'} eq 'dense'
232             && $value == 2));
233             }
234              
235             1;
236             __END__