File Coverage

blib/lib/Math/NumSeq/AsciiSelf.pm
Criterion Covered Total %
statement 97 100 97.0
branch 12 12 100.0
condition 11 19 57.8
subroutine 18 19 94.7
pod 6 7 85.7
total 144 157 91.7


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             # math-image --values=AsciiSelf --output=list
19              
20              
21             package Math::NumSeq::AsciiSelf;
22 2     2   7851 use 5.004;
  2         6  
23 2     2   7 use strict;
  2         3  
  2         41  
24              
25 2     2   5 use vars '$VERSION', '@ISA';
  2         2  
  2         107  
26             $VERSION = 72;
27 2     2   391 use Math::NumSeq;
  2         2  
  2         84  
28             @ISA = ('Math::NumSeq');
29             *_is_infinite = \&Math::NumSeq::_is_infinite;
30              
31             # uncomment this to run the ### lines
32             # use Smart::Comments;
33              
34              
35             # use constant name => Math::NumSeq::__('Ascii Self');
36 2     2   7 use constant description => Math::NumSeq::__('Sequence is itself in ASCII.');
  2         2  
  2         7  
37 2     2   7 use constant i_start => 1;
  2         2  
  2         64  
38 2     2   12 use constant characteristic_increasing => 0;
  2         2  
  2         88  
39 2     2   7 use constant characteristic_smaller => 1;
  2         2  
  2         69  
40 2     2   7 use constant characteristic_integer => 1;
  2         2  
  2         66  
41              
42             # use constant characteristic_charset => 'ASCII';
43             # sub characteristic_charset_digits {
44             # my ($self) = @_;
45             # return $self->{'radix'};
46             # }
47              
48             use Math::NumSeq::Base::Digits
49 2     2   329 'parameter_info_array'; # radix parameter
  2         2  
  2         1433  
50              
51             {
52             my @values_min;
53             my @values_max;
54             $values_min[3] = 49;
55             $values_min[6] = 49;
56             $values_min[8] = $values_max[8] = 54;
57             $values_min[11] = 49;
58             $values_min[12] = 52;
59             $values_min[14] = 49;
60             $values_min[15] = 51;
61             $values_min[16] = $values_max[16] = 51; # only 51s
62             $values_min[20] = 50;
63             $values_min[21] = 50;
64             $values_min[23] = 50;
65             $values_min[24] = $values_max[24] = 50; # only 50s
66             $values_min[28] = 49;
67             $values_min[29] = 49;
68             $values_min[30] = 49;
69             $values_min[31] = 49;
70             $values_min[32] = 49;
71             $values_min[33] = 49;
72             $values_min[34] = 49;
73              
74             $values_max[6] = 50;
75             $values_max[11] = 65;
76             $values_max[12] = 52;
77             $values_max[13] = 67;
78             $values_max[14] = 68;
79             $values_max[15] = 67;
80             $values_max[16] = 51;
81             $values_max[17] = 71;
82             $values_max[18] = 72;
83             $values_max[19] = 73;
84             $values_max[20] = 72;
85             $values_max[21] = 70;
86             $values_max[22] = 76;
87             $values_max[23] = 75;
88             $values_max[24] = 50;
89             $values_max[25] = 79;
90             $values_max[26] = 80;
91             $values_max[27] = 81;
92             $values_max[28] = 77;
93             $values_max[29] = 83;
94             $values_max[30] = 82;
95             $values_max[31] = 80;
96             $values_max[32] = 80;
97             $values_max[33] = 87;
98             $values_max[34] = 78;
99             $values_max[35] = 89;
100              
101             sub values_min {
102 1     1 1 5 my ($self) = @_;
103 1         1 my $radix = $self->{'radix'};
104 1   50     6 return ($values_max[$radix] || 48);
105             }
106             sub values_max {
107 0     0 1 0 my ($self) = @_;
108 0         0 my $radix = $self->{'radix'};
109 0   0     0 return ($values_max[$radix]
110             || $radix + ($radix <= 10 ? 47 : 65-10));
111             }
112             }
113              
114             #------------------------------------------------------------------------------
115              
116             # cf A109648 ascii with comma and space
117             my @oeis_anum;
118             $oeis_anum[10] = 'A109733';
119             # OEIS-Catalogue: A109733
120             sub oeis_anum {
121 1     1 1 3 my ($self) = @_;
122 1         2 return $oeis_anum[$self->{'radix'}];
123             }
124              
125             #------------------------------------------------------------------------------
126              
127             # ith() on radix 7 is wrong, report it as not available
128             sub can {
129 134     134 0 1985 my ($self, $name) = @_;
130 134 100 66     349 if ($name eq 'ith' && ref $self && $self->{'radix'} == 7) {
      100        
131 1         2 return undef;
132             }
133 133         190 return $self->SUPER::can($name);
134             }
135              
136             sub rewind {
137 72     72 1 410 my ($self) = @_;
138             ### AsciiSelf rewind() ...
139 72         126 $self->{'i'} = $self->i_start;
140              
141             # FIXME: this is a pre-calculation rather than a rewind ...
142 72         53 my $radix = $self->{'radix'};
143             ### $radix;
144 72         46 my $start;
145 72         140 foreach my $digit (0 .. $radix-1) {
146 1298         1090 my $ascii = _digit_to_ascii($digit);
147 1298         1093 my $r = $self->{'map'}->[$ascii] = [ _radix_ascii($radix,$ascii) ];
148 1298 100       1833 if ($r->[0] == $ascii) {
149 82   66     236 $start ||= $r->[0];
150             }
151             }
152 72   50     109 $start ||= 48;
153 72         52 $self->{'width'} = scalar(@{$self->{'map'}->[48]});
  72         87  
154 72         75 $self->{'start'} = $start;
155             ### $start
156              
157 72         84 $self->{'state'} = [ $self->{'map'}->[$start] ];
158 72         128 $self->{'digits'} = [ -1 ]; # to start from 0 with preincrement
159             }
160              
161             sub next {
162 1716     1716 1 3126 my ($self) = @_;
163             ### AsciiSelf next(): "$self->{'i'}"
164             ### digits: $self->{'digits'}
165             ### state: $self->{'state'}
166              
167 1716         1152 my $state = $self->{'state'};
168 1716         1033 my $digits = $self->{'digits'};
169 1716         954 my $pos = 0;
170 1716         971 my $digit;
171 1716         978 for (;;) {
172 3128 100       3364 if ($pos >= @$digits) {
173 160         185 push @$state, $self->{'map'}->[$self->{'start'}];
174 160         114 push @$digits, ($digit = 1);
175              
176             ### extend at pos: $pos
177             ### extended digits: $digits
178             ### extended state: $state
179 160         113 last;
180             }
181 2968         1882 $digit = ++($digits->[$pos]);
182 2968 100       1580 if ($digit < scalar(@{$state->[$pos]})) {
  2968         3504  
183 1556         968 last;
184             }
185 1412         840 $pos++;
186             }
187              
188             ### $pos
189             ### $digit
190              
191 1716         1146 my $value = $state->[$pos]->[$digit];
192 1716         1945 while ($pos > 0) {
193             ### $value
194 1412         1079 my $newtable = $state->[--$pos] = $self->{'map'}->[$value];
195 1412         791 $digits->[$pos] = 0;
196 1412         1609 $value = $newtable->[0];
197             }
198              
199             ### now digits: $digits
200             ### now state: $state
201             ### final value: $value
202              
203 1716         1961 return ($self->{'i'}++, $value);
204             }
205              
206             sub ith {
207 1727     1727 1 2947 my ($self, $i) = @_;
208             ### AsciiSelf ith(): "$i"
209              
210 1727 100 66     1941 if (_is_infinite($i) || ($i -= 1) < 0) {
211 4         6 return undef;
212             }
213              
214 1723         1419 my $map = $self->{'map'};
215 1723         1058 my $width = $self->{'width'};
216 1723         912 my @digits;
217 1723         1908 while ($i) {
218 7644         4901 push @digits, $i % $width;
219 7644         8463 $i = int($i/$width);
220             }
221              
222 1723         1411 my $value = $self->{'start'};
223 1723         2028 while (@digits) {
224 7644         4553 my $digit = pop @digits;
225 7644         8883 $value = $map->[$value]->[$digit];
226             }
227 1723         1761 return $value;
228             }
229              
230             sub _radix_ascii {
231 4698     4698   6978 my ($radix, $n) = @_;
232 4698         2485 my @digits;
233 4698         5047 while ($n) {
234 10431         6602 my $digit = ($n % $radix);
235 10431         8264 push @digits, _digit_to_ascii($digit);
236 10431         13286 $n = int($n/$radix);
237             }
238 4698         5672 return reverse @digits;
239             }
240              
241             sub _digit_to_ascii {
242 11735     11735   6947 my ($digit) = @_;
243             ### assert: $digit >= 0
244             ### assert: $digit < 36
245 11735 100       12327 return $digit + ($digit < 10 ? 48 : 65-10); # '0' or 'A'
246             }
247              
248             1;
249             __END__