File Coverage

blib/lib/Math/NumSeq/SternDiatomic.pm
Criterion Covered Total %
statement 66 67 98.5
branch 7 8 87.5
condition 1 3 33.3
subroutine 18 18 100.0
pod 6 6 100.0
total 98 102 96.0


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             # Edsgar Dijkstra
20             # http://www.cs.utexas.edu/users/EWD/ewd05xx/EWD570.PDF
21             # http://www.cs.utexas.edu/users/EWD/ewd05xx/EWD578.PDF
22              
23             # Some Properties of a Function Studied by De Rham, Carlitz and Dijkstra and
24             # its Relation to the Eisenstein-Stern's Diatomic Sequence
25             # I. Urhiba, Math. Comm. 6 2001 181-198
26              
27             # Lind stern summary
28             # An extension of Stern's diatomic sequence Duke Math J 36
29             # 1969 55-60
30              
31              
32             package Math::NumSeq::SternDiatomic;
33 2     2   2002 use 5.004;
  2         4  
34 2     2   6 use strict;
  2         2  
  2         44  
35              
36 2     2   7 use vars '$VERSION', '@ISA';
  2         2  
  2         100  
37             $VERSION = 72;
38 2     2   8 use Math::NumSeq;
  2         1  
  2         70  
39             @ISA = ('Math::NumSeq');
40             *_is_infinite = \&Math::NumSeq::_is_infinite;
41              
42 2     2   7 use Math::NumSeq::Fibonacci;
  2         2  
  2         61  
43             *_bit_split_hightolow = \&Math::NumSeq::Fibonacci::_bit_split_hightolow;
44              
45             # uncomment this to run the ### lines
46             #use Smart::Comments;
47              
48             # use constant name => Math::NumSeq::__('Stern Diatomic');
49 2     2   6 use constant description => Math::NumSeq::__('Stern\'s diatomic sequence.');
  2         2  
  2         6  
50 2     2   8 use constant default_i_start => 0;
  2         3  
  2         79  
51 2     2   6 use constant values_min => 0;
  2         3  
  2         67  
52 2     2   5 use constant characteristic_smaller => 1;
  2         3  
  2         61  
53 2     2   7 use constant characteristic_increasing => 0;
  2         3  
  2         80  
54 2     2   6 use constant characteristic_integer => 1;
  2         3  
  2         71  
55              
56             #------------------------------------------------------------------------------
57             # cf A126606 - starting 0,2 gives 2*diatomic
58             # A049455 - repeat 0..2^k
59             # A049456 - extra 1 at end of each row
60             # A174980 - type ([0,1],1), adding 1 extra at n=2^k
61             # A049455,A049456 stern/farey tree
62             # A070878 stern by rows
63             # A070879 stern by rows
64             # http://oeis.org/stern_brocot.html
65             #
66             # cf Michael Somos iteration in A002487
67 2     2   6 use constant oeis_anum => 'A002487';
  2         2  
  2         616  
68              
69             #------------------------------------------------------------------------------
70              
71             sub rewind {
72 4     4 1 416 my ($self) = @_;
73 4         13 $self->{'i'} = $self->i_start;
74 4         6 $self->{'p'} = 0;
75 4         8 $self->{'q'} = 1;
76             }
77             sub seek_to_i {
78 12     12 1 124 my ($self, $i) = @_;
79 12         8 $self->{'i'} = $i;
80 12         13 ($self->{'p'},$self->{'q'}) = $self->ith_pair($i);
81             }
82              
83             sub next {
84 203     203 1 4974 my ($self) = @_;
85 203         175 my $p = $self->{'p'};
86 203         139 my $q = $self->{'q'};
87 203         145 $self->{'p'} = $q;
88 203         198 $self->{'q'} = $p + $q - 2*($p % $q);
89 203         246 return ($self->{'i'}++, $p);
90             }
91              
92             sub ith {
93 17     17 1 50 my ($self, $i) = @_;
94 17         19 return ($self->ith_pair($i))[0];
95             }
96              
97             # Return ($value[i], $value[i+1]).
98             sub ith_pair {
99 40     40 1 48 my ($self, $i) = @_;
100             ### SternDiatomic _ith_pair(): "$i"
101              
102 40 100       54 if ($i < 0) {
103 3 100       4 if ($i < -1) {
104 1         2 return (undef,undef);
105             } else {
106 2         4 return (undef,0);
107             }
108             }
109 37 50       48 if (_is_infinite($i)) { # don't loop forever if $value is +/-infinity
110 0         0 return ($i,$i);
111             }
112              
113 37         30 my $p = ($i * 0); # inherit bignum 0
114 37         30 my $q = $p + 1; # inherit bignum 1
115              
116 37         54 foreach my $bit (_bit_split_hightolow($i)) {
117 103 100       87 if ($bit) {
118 60         58 $p += $q;
119             } else {
120 43         30 $q += $p;
121             }
122 103         89 $i = int($i/2);
123             }
124              
125             ### result: "$p, $q"
126 37         57 return ($p,$q);
127             }
128              
129             sub pred {
130 12     12 1 33 my ($self, $value) = @_;
131             ### SternDiatomic pred(): $value
132 12   33     29 return ($value >= 0 && $value == int($value));
133             }
134              
135             1;
136             __END__