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

# -*- Perl -*-
#
# slide rule virtualization for Perl

package Math::SlideRule;

use 5.010000;

use Moo;
use namespace::clean;
use Scalar::Util qw/looks_like_number/;

our $VERSION = '1.10';

########################################################################
#
# ATTRIBUTES

# these are taken from common scale names on a slide rule; see code for
# how they are populated
has A => (is => 'lazy',);
has C => (is => 'lazy',);

sub _build_A { $_[0]->_range_exp_weighted(1, 100) }
sub _build_C { $_[0]->_range_exp_weighted(1, 10) }

# increased precision comes at the cost of additional memory use
#
# NOTE changing the precision after A, C and so forth have been
# generated will do nothing to those values. instead, construct a new
# object with a different precision set, if necessary
has precision => (is => 'rw', default => sub { 10_000 });

########################################################################
#
# METHODS

# builds two arrays, one of values (1, 2, 3...), another of distances
# based on the log of those values. these arrays returned in a hash
# reference. slide rule lookups obtain the index of a value, then use
# that to find the distance of that value, then uses other distances
# to figure out some new location, that a new value can be worked back
# out from
#
# NOTE that these scales are not calibrated directly to one another
# as they would be on a slide rule
sub _range_exp_weighted {
    my ($self, $min, $max) = @_;

    my @range = map log, $min, $max;
    my (@values, @distances);

    my $slope = ($range[1] - $range[0]) / $self->precision;

    for my $d (0 .. $self->precision) {
        # via slope equation; y = mx + b and m = (y2-y1)/(x2-x1) with
        # assumption that precision 0..$mp and @range[min,max]
        push @distances, $slope * $d + $range[0];
        push @values,    exp $distances[-1];
    }

    return { value => \@values, dist => \@distances };
}

# binary search an array of values for a given value, returning index of
# the closest match. used to lookup values and their corresponding
# distances from the various A, C, etc. attribute tables. NOTE this
# routine assumes that the given value has been normalized e.g. via
# standard_form to lie somewhere on or between the minimum and maximum
# values in the given array reference
sub _rank {
    my ($self, $value, $ref) = @_;

    my $lo = 0;
    my $hi = $#$ref;

    while ($lo <= $hi) {
        my $mid = int($lo + ($hi - $lo) / 2);
        if ($ref->[$mid] > $value) {
            $hi = $mid - 1;
        } elsif ($ref->[$mid] < $value) {
            $lo = $mid + 1;
        } else {
            return $mid;
        }
    }

    # no exact match; return index of value closest to the numeral supplied
    if ($lo > $#$ref) {
        return $hi;
    } else {
        if (abs($ref->[$lo] - $value) >= abs($ref->[$hi] - $value)) {
            return $hi;
        } else {
            return $lo;
        }
    }
}

# division is just multiplication done backwards on a slide rule, as the
# same physical distances are involved. there are also "CF" and "CI" (C
# scale, folded, or inverse) and so forth scales to assist with such
# operations, though these mostly just help avoid excess motions on the
# slide rule
#
# NOTE cannot just pass m*(1/n) to multiply() because that looses
# precision: .82 for 75/92 while can get .815 on pocket slide rule
sub divide {
    my $self = shift;
    my $n    = shift;
    my $i    = 0;

    die "need at least two numbers\n"      if @_ < 1;
    die "argument index $i not a number\n" if !defined $n or !looks_like_number($n);

    my ($n_coe, $n_exp, $neg_count) = $self->standard_form($n);

    my $n_idx    = $self->_rank($n_coe, $self->C->{value});
    my $distance = $self->C->{dist}[$n_idx];
    my $exponent = $n_exp;

    for my $m (@_) {
        $i++;
        die "argument index $i not a number\n" if !looks_like_number($m);

        $neg_count++ if $m < 0;

        my ($m_coe, $m_exp, undef) = $self->standard_form($m);
        my $m_idx = $self->_rank($m_coe, $self->C->{value});

        $distance -= $self->C->{dist}[$m_idx];
        $exponent -= $m_exp;

        if ($distance < $self->C->{dist}[0]) {
            $distance = $self->C->{dist}[-1] + $distance;
            $exponent--;
        }
    }

    my $d_idx   = $self->_rank($distance, $self->C->{dist});
    my $product = $self->C->{value}[$d_idx];

    $product *= 10**$exponent;
    $product *= -1 if $neg_count % 2 == 1;

    return $product;
}

sub multiply {
    my $self = shift;
    my $n    = shift;
    my $i    = 0;

    die "need at least two numbers\n"      if @_ < 1;
    die "argument index $i not a number\n" if !defined $n or !looks_like_number($n);

    my ($n_coe, $n_exp, $neg_count) = $self->standard_form($n);

    # chain method has first lookup on D and then subsequent done by
    # moving C on slider and keeping tabs with the hairline, then reading
    # back on D for the final result. (plus incrementing the exponent
    # count when a reverse slide is necessary, for example for 3.4*4.1, as
    # that jumps to the next magnitude)
    #
    # one can also do the multiplication on the A and B scales, which is
    # handy if you then need to pull the square root off of D. but this
    # implementation ignores such alternatives
    my $n_idx    = $self->_rank($n_coe, $self->C->{value});
    my $distance = $self->C->{dist}[$n_idx];
    my $exponent = $n_exp;

    for my $m (@_) {
        $i++;
        die "argument index $i not a number\n" if !looks_like_number($m);

        $neg_count++ if $m < 0;

        my ($m_coe, $m_exp, undef) = $self->standard_form($m);
        my $m_idx = $self->_rank($m_coe, $self->C->{value});

        $distance += $self->C->{dist}[$m_idx];
        $exponent += $m_exp;

        # order of magnitude change, adjust back to bounds (these are
        # notable on a slide rule by having to index from the opposite
        # direction than usual for the C and D scales (though one could
        # also obtain the value with the A and B or the CI and DI
        # scales, but those would then need some rule to track the
        # exponent change))
        if ($distance > $self->C->{dist}[-1]) {
            $distance -= $self->C->{dist}[-1];
            $exponent++;
        }
    }

    my $d_idx   = $self->_rank($distance, $self->C->{dist});
    my $product = $self->C->{value}[$d_idx];

    $product *= 10**$exponent;
    $product *= -1 if $neg_count % 2 == 1;

    return $product;
}

# relies on conversion from A to C scales (and that the distances in
# said scales are linked to one another)
sub sqrt {
    my ($self, $n) = @_;
    die "argument not a number\n" if !defined $n or !looks_like_number($n);
    die "Can't take sqrt of $n\n" if $n < 0;

    my ($n_coe, $n_exp, undef) = $self->standard_form($n);

    if ($n_exp % 2 == 1) {
        $n_coe *= 10;
        $n_exp--;
    }

    my $n_idx = $self->_rank($n_coe, $self->A->{value});

    # NOTE division is due to A and C scale distances not being calibrated
    # directly with one another
    my $distance = $self->A->{dist}[$n_idx] / 2;

    my $d_idx = $self->_rank($distance, $self->C->{dist});
    my $sqrt  = $self->C->{value}[$d_idx];

    $sqrt *= 10**($n_exp / 2);

    return $sqrt;
}

# converts numbers to standard form (scientific notation) or otherwise
# between a particular range of numbers (to support A/B "double
# decade" scales)
sub standard_form {
    my ($self, $val, $min, $max) = @_;

    $min //= 1;
    $max //= 10;

    my $is_neg = $val < 0 ? 1 : 0;

    $val = abs $val;
    my $exp = 0;

    if ($val < $min) {
        while ($val < $min) {
            $val *= 10;
            $exp--;
        }
    } elsif ($val >= $max) {
        while ($val >= $max) {
            $val /= 10;
            $exp++;
        }
    }

    return $val, $exp, $is_neg;
}

1;
__END__