File Coverage

blib/lib/Math/FixedPoint.pm

Criterion	Covered	Total	%
statement	143	153	93.4
branch	63	64	98.4
condition	10	11	90.9
subroutine	16	17	94.1
pod	1	1	100.0
total	233	246	94.7

package Math::FixedPoint;
{
  $Math::FixedPoint::VERSION = '0.20130625.1928';
}
use strict;
use warnings;
use Carp qw(croak);
use overload
  '+'      => \&_add,
  '-'      => \&_substract,
  '*'      => \&_multiply,
  '/'      => \&_division,
  '='      => \&_copy,
  '""'     => \&_stringify,
  'int'    => \&_intify,
  'abs'    => \&_absify,
  '<=>'    => \&_num_cmp_tree_way,
  'cmp'    => \&_str_cmp_tree_way,
  fallback => 1;

sub new {
    my ( $class, $num, $radix ) = @_;

    my $self;

    if ( defined $num ) {
        my @values = _parse_num( $num, $radix );

        $self = \@values;
    }

    else {
        $self = [ 1, 0, 0 ];
    }

    bless $self, $class;
}

sub _parse_num {
    my ( $str, $wanted_radix ) = @_;

    if ( int($str) eq $str ) {
        my $value = abs($str);
        my $sign = $str < 0 ? -1 : 1;

        return
          defined $wanted_radix
          ? ( $sign, $value * 10**$wanted_radix, $wanted_radix )
          : ( $sign, $value, 0 );
    }

    elsif ( $str =~ /^  ([-+]?)(\d*)  (?:\.(\d+))?  (?:[eE]([-+]?\d+))?  $/x ) {

        my $sign = defined $1 && $1 eq '-' ? -1 : 1;
        my $num     = $2 || 0;
        my $decimal = $3 || '';
        my $exp     = $4 || 0;

        my $radix = length($decimal);
        $radix -= $exp;

        my $value =
            $radix < 0
          ? $num . $decimal . ( '0' x -$radix )
          : $num . $decimal;

        $radix = 0 if $radix < 0;

        return
          defined $wanted_radix
          ? ( $sign, int _coerce( $value, $radix, $wanted_radix ),
            $wanted_radix )
          : ( $sign, int $value, $radix );
    }
    else {
        croak "$str not a valid number";
    }
}

sub _coerce {
    my ( $num, $radix, $wanted_radix ) = @_;

    return $num if $radix == $wanted_radix;

    if ( $wanted_radix >= $radix ) {
        return $num * 10**( $wanted_radix - $radix );
    }

    else {
        my $places   = $wanted_radix - $radix;
        my $reminder = substr( $num, $places );
        my $new_num  = substr( $num, 0, $places );

        $new_num++ if $reminder > 5 * 10**( -1 * $places - 1 );

        return $new_num;
    }
}

sub _copy {
    my $self = shift;
    my $new  = Math::FixedPoint->new;

    $new->[0] = $self->[0];
    $new->[1] = $self->[1];
    $new->[2] = $self->[2];

    return $new;
}

sub _add {
    my ( $self, $num ) = @_;

    my ( $sign, $value, $radix ) = @$self;

    my $new_sign;
    my $new_value;

    if ( ref $num ne 'Math::FixedPoint' ) {
        ( $new_sign, $new_value ) = _parse_num( $num, $radix );
    }

    else {
        $new_sign = $num->[0];
        $new_value = _coerce( $num->[1], $num->[2], $radix );
    }

    my $signed_result   = $new_sign * $new_value + $sign * $value;
    my $unsigned_result = abs($signed_result);

    my $new = Math::FixedPoint->new;
    $new->[0] = $signed_result < 0 ? -1 : 1;
    $new->[1] = $unsigned_result;
    $new->[2] = $radix;

    return $new;
}

sub _substract {
    my ( $self, $num, $reverse ) = @_;

    my ( $sign, $value, $radix ) = @$self;

    my $new_sign;
    my $new_value;

    if ( ref $num ne 'Math::FixedPoint' ) {
        ( $new_sign, $new_value ) = _parse_num( $num, $radix );
    }

    else {
        $new_sign = $num->[0];
        $new_value = _coerce( $num->[1], $num->[2], $radix );
    }

    $new_sign = $reverse ? $new_sign  : -1 * $new_sign;
    $sign     = $reverse ? -1 * $sign : $sign;

    my $signed_result   = $new_sign * $new_value + $sign * $value;
    my $unsigned_result = abs($signed_result);

    my $new = Math::FixedPoint->new;
    $new->[0] = $signed_result < 0 ? -1 : 1;
    $new->[1] = $unsigned_result;
    $new->[2] = $radix;

    return $new;
}

sub _multiply {
    my ( $self, $num ) = @_;

    my ( $sign, $value, $radix ) = @$self;

    my $new_sign;
    my $new_value;
    my $new_radix;

    if ( ref $num ne 'Math::FixedPoint' ) {
        ( $new_sign, $new_value, $new_radix ) = _parse_num($num);

        $new_value =
          _coerce( $value * $new_value, $new_radix + $radix, $radix );
    }
    else {
        $new_sign = $num->[0];
        $new_value = _coerce( $value * $num->[1], $radix + $num->[2], $radix );
    }

    my $new = Math::FixedPoint->new;

    $new->[0] = $sign * $new_sign;
    $new->[1] = $new_value;
    $new->[2] = $radix;

    return $new;
}

sub _division {
    my ( $self, $num, $reverse ) = @_;

    my ( $sign, $value, $radix ) = @$self;

    my $another_sign;
    my $another_value;
    my $another_radix;

    if ( ref $num ne 'Math::FixedPoint' ) {
        $another_sign  = $num < 0 ? -1 : 1;
        $another_value = abs($num);
        $another_radix = 0;
    }

    else {
        ( $another_sign, $another_value, $another_radix ) = @$num;
    }

    croak 'Illegal division by zero' if $another_value == 0;

    my $result = $reverse ? $another_value / $value : $value / $another_value;
    my ( $new_sign, $new_value, $new_radix ) = _parse_num($result);

    my $extra_radix =
        $reverse
      ? $another_radix - $radix
      : $radix - $another_radix;

    $new_value = _coerce( $new_value, $new_radix + $extra_radix, $radix );

    my $new = Math::FixedPoint->new;

    $new->[0] = $sign * $another_sign;
    $new->[1] = $new_value;
    $new->[2] = $radix;

    return $new;
}

sub _stringify {
    my $self = shift;

    my $sign  = $self->[0] < 0 ? '-' : '';
    my $value = $self->[1];
    my $radix = $self->[2];

    return "$sign$value" if $radix == 0;

    my $length = length($value);
    return sprintf( "${sign}0.%0${radix}d", $value ) if $length <= $radix;

    my $decimal = substr( $value, -$radix );
    my $integer = substr( $value, 0, -$radix );
    return "$sign$integer.$decimal";
}

sub _intify {
    my $self = shift;

    my ( $sign, $value, $radix ) = @$self;

    my $new = Math::FixedPoint->new;
    $new->[2] = 0;

    if ( $radix == 0 ) {
        $new->[0] = $sign;
        $new->[1] = $value;
    }

    else {
        my $new_value = substr $value, 0, -$radix;
        $new_value ||= 0;
        $new->[0] = $new_value == 0 ? 1 : $sign;
        $new->[1] = $new_value;
    }

    return $new;
}

sub _absify {
    my $self = shift;

    my ( $sign, $value, $radix ) = @$self;

    my $new = Math::FixedPoint->new;
    $new->[0] = 1;
    $new->[1] = $value;
    $new->[2] = $radix;

    return $new;
}

sub _num_cmp_tree_way {
    my ( $self, $num ) = @_;

    my ( $sign1, $value1, $radix1 ) = @$self;

    my $sign2;
    my $value2;
    my $radix2;

    if ( ref $num ne 'Math::FixedPoint' ) {
        ( $sign2, $value2, $radix2 ) = _parse_num($num);
    }

    else {
        ( $sign2, $value2, $radix2 ) = @$num;
    }

    $value1 = _coerce( $value1, $radix1, $radix2 ) if $radix2 > $radix1;
    $value2 = _coerce( $value2, $radix2, $radix1 ) if $radix1 > $radix2;

    return $sign1 * $value1 <=> $sign2 * $value2;
}

sub _str_cmp_tree_way {
    my ( $self, $num ) = @_;

    $self->_stringify cmp "$num";
}

1;

__END__