File Coverage

blib/lib/Math/SlideRule.pm
Criterion Covered Total %
statement 111 112 99.1
branch 32 44 72.7
condition 5 13 38.4
subroutine 12 12 100.0
pod 4 4 100.0
total 164 185 88.6


line stmt bran cond sub pod time code
1             # -*- Perl -*-
2             #
3             # slide rule virtualization for Perl
4              
5             package Math::SlideRule;
6              
7 3     3   105464 use 5.010000;
  3         10  
8              
9 3     3   929 use Moo;
  3         18801  
  3         12  
10 3     3   3507 use namespace::clean;
  3         18994  
  3         14  
11 3     3   981 use Scalar::Util qw/looks_like_number/;
  3         6  
  3         3481  
12              
13             our $VERSION = '1.08';
14              
15             ########################################################################
16             #
17             # ATTRIBUTES
18              
19             # these are taken from common scale names on a slide rule; see code for
20             # how they are populated
21             has A => (is => 'lazy',);
22             has C => (is => 'lazy',);
23              
24 1     1   12 sub _build_A { $_[0]->_range_exp_weighted(1, 100) }
25 1     1   11 sub _build_C { $_[0]->_range_exp_weighted(1, 10) }
26              
27             # increased precision comes at the cost of additional memory use
28             #
29             # NOTE changing the precision after A, C and so forth have been
30             # generated will do nothing to those values. instead, construct a new
31             # object with a different precision set, if necessary
32             has precision => (is => 'rw', default => sub { 10_000 });
33              
34             ########################################################################
35             #
36             # METHODS
37              
38             # builds two arrays, one of values (1, 2, 3...), another of distances
39             # based on the log of those values. these arrays returned in a hash
40             # reference. slide rule lookups obtain the index of a value, then use
41             # that to find the distance of that value, then uses other distances
42             # to figure out some new location, that a new value can be worked back
43             # out from
44             #
45             # NOTE that these scales are not calibrated directly to one another
46             # as they would be on a slide rule
47             sub _range_exp_weighted {
48 2     2   5 my ($self, $min, $max) = @_;
49              
50 2         12 my @range = map log, $min, $max;
51 2         3 my (@values, @distances);
52              
53 2         8 my $slope = ($range[1] - $range[0]) / $self->precision;
54              
55 2         5 for my $d (0 .. $self->precision) {
56             # via slope equation; y = mx + b and m = (y2-y1)/(x2-x1) with
57             # assumption that precision 0..$mp and @range[min,max]
58 20002         24657 push @distances, $slope * $d + $range[0];
59 20002         23722 push @values, exp $distances[-1];
60             }
61              
62 2         26 return { value => \@values, dist => \@distances };
63             }
64              
65             # binary search an array of values for a given value, returning index of
66             # the closest match. used to lookup values and their corresponding
67             # distances from the various A, C, etc. attribute tables. NOTE this
68             # routine assumes that the given value has been normalized e.g. via
69             # standard_form to lie somewhere on or between the minimum and maximum
70             # values in the given array reference
71             sub _rank {
72 87     87   720 my ($self, $value, $ref) = @_;
73              
74 87         101 my $lo = 0;
75 87         101 my $hi = $#$ref;
76              
77 87         154 while ($lo <= $hi) {
78 893         1121 my $mid = int($lo + ($hi - $lo) / 2);
79 893 100       1297 if ($ref->[$mid] > $value) {
    100          
80 406         538 $hi = $mid - 1;
81             } elsif ($ref->[$mid] < $value) {
82 444         608 $lo = $mid + 1;
83             } else {
84 43         79 return $mid;
85             }
86             }
87              
88             # no exact match; return index of value closest to the numeral supplied
89 44 50       78 if ($lo > $#$ref) {
90 0         0 return $hi;
91             } else {
92 44 100       87 if (abs($ref->[$lo] - $value) >= abs($ref->[$hi] - $value)) {
93 24         49 return $hi;
94             } else {
95 20         39 return $lo;
96             }
97             }
98             }
99              
100             # division is just multiplication done backwards on a slide rule, as the
101             # same physical distances are involved. there are also "CF" and "CI" (C
102             # scale, folded, or inverse) and so forth scales to assist with such
103             # operations, though these mostly just help avoid excess motions on the
104             # slide rule
105             #
106             # NOTE cannot just pass m*(1/n) to multiply() because that looses
107             # precision: .82 for 75/92 while can get .815 on pocket slide rule
108             sub divide {
109 4     4 1 392 my $self = shift;
110 4         9 my $n = shift;
111 4         6 my $i = 0;
112              
113 4 50       12 die "need at least two numbers\n" if @_ < 1;
114 4 50 33     27 die "argument index $i not a number\n" if !defined $n or !looks_like_number($n);
115              
116 4         25 my ($n_coe, $n_exp, $neg_count) = $self->standard_form($n);
117              
118 4         58 my $n_idx = $self->_rank($n_coe, $self->C->{value});
119 4         49 my $distance = $self->C->{dist}[$n_idx];
120 4         17 my $exponent = $n_exp;
121              
122 4         8 for my $m (@_) {
123 6         8 $i++;
124 6 50       23 die "argument index $i not a number\n" if !looks_like_number($m);
125              
126 6 50       13 $neg_count++ if $m < 0;
127              
128 6         13 my ($m_coe, $m_exp, undef) = $self->standard_form($m);
129 6         51 my $m_idx = $self->_rank($m_coe, $self->C->{value});
130              
131 6         52 $distance -= $self->C->{dist}[$m_idx];
132 6         21 $exponent -= $m_exp;
133              
134 6 50       44 if ($distance < $self->C->{dist}[0]) {
135 6         58 $distance = $self->C->{dist}[-1] + $distance;
136 6         24 $exponent--;
137             }
138             }
139              
140 4         28 my $d_idx = $self->_rank($distance, $self->C->{dist});
141 4         33 my $product = $self->C->{value}[$d_idx];
142              
143 4         23 $product *= 10**$exponent;
144 4 50       10 $product *= -1 if $neg_count % 2 == 1;
145              
146 4         36 return $product;
147             }
148              
149             sub multiply {
150 16     16 1 32 my $self = shift;
151 16         24 my $n = shift;
152 16         19 my $i = 0;
153              
154 16 50       37 die "need at least two numbers\n" if @_ < 1;
155 16 50 33     74 die "argument index $i not a number\n" if !defined $n or !looks_like_number($n);
156              
157 16         33 my ($n_coe, $n_exp, $neg_count) = $self->standard_form($n);
158              
159             # chain method has first lookup on D and then subsequent done by
160             # moving C on slider and keeping tabs with the hairline, then reading
161             # back on D for the final result. (plus incrementing the exponent
162             # count when a reverse slide is necessary, for example for 3.4*4.1, as
163             # that jumps to the next magnitude)
164             #
165             # one can also do the multiplication on the A and B scales, which is
166             # handy if you then need to pull the square root off of D. but this
167             # implementation ignores such alternatives
168 16         181 my $n_idx = $self->_rank($n_coe, $self->C->{value});
169 16         124 my $distance = $self->C->{dist}[$n_idx];
170 16         55 my $exponent = $n_exp;
171              
172 16         29 for my $m (@_) {
173 24         39 $i++;
174 24 50       49 die "argument index $i not a number\n" if !looks_like_number($m);
175              
176 24 100       55 $neg_count++ if $m < 0;
177              
178 24         32 my ($m_coe, $m_exp, undef) = $self->standard_form($m);
179 24         190 my $m_idx = $self->_rank($m_coe, $self->C->{value});
180              
181 24         193 $distance += $self->C->{dist}[$m_idx];
182 24         81 $exponent += $m_exp;
183              
184             # order of magnitude change, adjust back to bounds (these are
185             # notable on a slide rule by having to index from the opposite
186             # direction than usual for the C and D scales (though one could
187             # also obtain the value with the A and B or the CI and DI
188             # scales, but those would then need some rule to track the
189             # exponent change))
190 24 100       172 if ($distance > $self->C->{dist}[-1]) {
191 8         73 $distance -= $self->C->{dist}[-1];
192 8         31 $exponent++;
193             }
194             }
195              
196 16         144 my $d_idx = $self->_rank($distance, $self->C->{dist});
197 16         120 my $product = $self->C->{value}[$d_idx];
198              
199 16         65 $product *= 10**$exponent;
200 16 100       34 $product *= -1 if $neg_count % 2 == 1;
201              
202 16         113 return $product;
203             }
204              
205             # relies on conversion from A to C scales (and that the distances in
206             # said scales are linked to one another)
207             sub sqrt {
208 6     6 1 13 my ($self, $n) = @_;
209 6 50 33     34 die "argument not a number\n" if !defined $n or !looks_like_number($n);
210 6 50       13 die "Can't take sqrt of $n\n" if $n < 0;
211              
212 6         13 my ($n_coe, $n_exp, undef) = $self->standard_form($n);
213              
214 6 100       15 if ($n_exp % 2 == 1) {
215 3         6 $n_coe *= 10;
216 3         3 $n_exp--;
217             }
218              
219 6         117 my $n_idx = $self->_rank($n_coe, $self->A->{value});
220              
221             # NOTE division is due to A and C scale distances not being calibrated
222             # directly with one another
223 6         102 my $distance = $self->A->{dist}[$n_idx] / 2;
224              
225 6         109 my $d_idx = $self->_rank($distance, $self->C->{dist});
226 6         79 my $sqrt = $self->C->{value}[$d_idx];
227              
228 6         39 $sqrt *= 10**($n_exp / 2);
229              
230 6         54 return $sqrt;
231             }
232              
233             # converts numbers to standard form (scientific notation) or otherwise
234             # between a particular range of numbers (to support A/B "double
235             # decade" scales)
236             sub standard_form {
237 68     68 1 128 my ($self, $val, $min, $max) = @_;
238              
239 68   50     204 $min //= 1;
240 68   50     182 $max //= 10;
241              
242 68 100       110 my $is_neg = $val < 0 ? 1 : 0;
243              
244 68         75 $val = abs $val;
245 68         76 my $exp = 0;
246              
247 68 100       128 if ($val < $min) {
    100          
248 9         15 while ($val < $min) {
249 17         27 $val *= 10;
250 17         25 $exp--;
251             }
252             } elsif ($val >= $max) {
253 39         71 while ($val >= $max) {
254 53         61 $val /= 10;
255 53         87 $exp++;
256             }
257             }
258              
259 68         174 return $val, $exp, $is_neg;
260             }
261              
262             1;
263             __END__