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__ |