File Coverage

blib/lib/Math/SlideRule.pm

Criterion	Covered	Total	%
statement	111	112	99.1
branch	42	44	95.4
condition	13	13	100.0
subroutine	12	12	100.0
pod	4	4	100.0
total	182	185	98.3

# -*- 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.11';

########################################################################
#
# 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"
      unless defined $n and 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"
      unless defined $n and 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" unless defined $n and 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__