File Coverage

blib/lib/Math/NumSeq/GolayRudinShapiro.pm
Criterion Covered Total %
statement 50 57 87.7
branch 5 6 83.3
condition 2 9 22.2
subroutine 14 17 82.3
pod 5 7 71.4
total 76 96 79.1


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::GolayRudinShapiro;
19 2     2   1313 use 5.004;
  2         5  
20 2     2   9 use strict;
  2         2  
  2         42  
21 2     2   6 use List::Util 'max','min';
  2         3  
  2         142  
22              
23 2     2   8 use vars '$VERSION', '@ISA';
  2         2  
  2         99  
24             $VERSION = 72;
25              
26 2     2   7 use Math::NumSeq;
  2         2  
  2         32  
27 2     2   376 use Math::NumSeq::Base::IterateIth;
  2         2  
  2         78  
28             @ISA = ('Math::NumSeq::Base::IterateIth',
29             'Math::NumSeq');
30             *_is_infinite = \&Math::NumSeq::_is_infinite;
31              
32 2     2   327 use Math::NumSeq::Repdigits;
  2         4  
  2         60  
33             *_digit_split_lowtohigh = \&Math::NumSeq::Repdigits::_digit_split_lowtohigh;
34              
35             # uncomment this to run the ### lines
36             #use Smart::Comments;
37              
38              
39             # use constant name => Math::NumSeq::__('Golay-Rudin-Shapiro');
40 2     2   9 use constant default_i_start => 0;
  2         2  
  2         164  
41              
42 2         7 use constant parameter_info_array =>
43             [ {
44             name => 'values_type',
45             share_key => 'values_type_1-101',
46             type => 'enum',
47             default => '1,-1',
48             choices => ['1,-1',
49             '0,1',
50             ],
51             # TRANSLATORS: "1,-1" offered for translation of the "," if that might look like a decimal point, otherwise can be left unchanged
52             choices_display => [Math::NumSeq::__('1,-1'),
53             Math::NumSeq::__('0,1'),
54             ],
55             description => Math::NumSeq::__('The values to give for even or odd parity.'),
56             },
57 2     2   8 ];
  2         2  
58              
59             sub description {
60 4     4 1 10 my ($self) = @_;
61 4 100       9 my ($even,$odd) = (ref $self ? @{$self->{'values'}} : (1,-1));
  2         4  
62             # ENHANCE-ME: use __x(), maybe
63 4         8 return sprintf(Math::NumSeq::__('Golay/Rudin/Shapiro parity of adjacent 11 bit pairs, %s if even count %s if odd count.'),
64             $even, $odd);
65             }
66              
67             sub characteristic_integer {
68 0     0 0 0 my ($self) = @_;
69             return (_is_integer($self->{'values_min'})
70 0   0     0 && _is_integer($self->{'values_max'}));
71             }
72             sub characteristic_pn1 {
73 0     0 0 0 my ($self) = @_;
74 0   0     0 return ($self->{'values_min'} == -1 && $self->{'values_max'} == 1);
75             }
76              
77             #------------------------------------------------------------------------------
78             # cf A022155 - positions of -1
79             # A203463 - positions of +1
80             # A014081 - count of 11 bit pairs
81             # A020986 - cumulative 1,-1, always positive
82             # A020990 - cumulative GRS(2n+1), flips sign at odd i
83             # A020991 - position of last occurrence of n in the partial sums
84             # A005943 - number of subwords length n
85             #
86             my %oeis_anum = ('1,-1' => 'A020985', # 1 and -1
87             '0,1' => 'A020987', # 0 and 1
88             # OEIS-Catalogue: A020985
89             # OEIS-Catalogue: A020987 values_type=0,1
90             );
91             sub oeis_anum {
92 2     2 1 8 my ($self) = @_;
93 2         4 return $oeis_anum{$self->{'values_type'}};
94             }
95              
96             #------------------------------------------------------------------------------
97              
98             sub new {
99 9     9 1 307 my $self = shift->SUPER::new(@_);
100              
101 9         38 my @values = split /,/, $self->{'values_type'};
102 9         15 $self->{'values'} = \@values;
103 9         50 $self->{'values_min'} = min(@values);
104 9         21 $self->{'values_max'} = max(@values);
105             ### $self
106 9         25 return $self;
107             }
108              
109             # ENHANCE-ME: use as_bin() on BigInt when available
110             #
111             # ENHANCE-ME: use unpack() checksum 1-bit count as described by
112             # perlfunc.pod, if fit a UV or C "int" or whatever
113             #
114             # # N & Nshift leaves bits with a 1 below them, then parity of bit count
115             # $i &= ($i >> 1);
116             # return (1 & unpack('%32b*', pack('I', $i)));
117             #
118             sub ith {
119 20516     20516 1 13677 my ($self, $i) = @_;
120 20516 100       24212 if ($i < 0) {
121 6         8 return undef;
122             }
123 20510 50       24442 if (_is_infinite($i)) {
124 0         0 return $i;
125             }
126              
127 20510         16590 my $prev = 0;
128 20510         11292 my $xor = 0;
129 20510         26104 foreach my $bit (_digit_split_lowtohigh($i,2)) {
130 249046         138303 $xor ^= ($prev & $bit);
131 249046         152958 $prev = $bit;
132             }
133 20510         46837 return $self->{'values'}->[$xor];
134             }
135              
136             sub pred {
137 34     34 1 83 my ($self, $value) = @_;
138             return ($value == $self->{'values'}->[0]
139 34   66     71 || $value == $self->{'values'}->[1]);
140             }
141              
142             # Jorg Arndt fxtbook next step by
143             # low 1s 0111 increment to become 1000
144             # if even number of 1s then that's a "11" parity change
145             # and if the 1000 has a 1 above it then that's a parity change too
146             # so flip if 10..00 is an odd bit position XOR the bit above it
147              
148              
149             #------------------------------------------------------------------------------
150             sub _is_integer {
151 0     0     my ($n) = @_;
152 0           return ($n == int($n));
153             }
154              
155             1;
156             __END__