File Coverage

blib/lib/Math/FractionManip.pm

Criterion	Covered	Total	%
statement	421	523	80.5
branch	161	264	60.9
condition	54	101	53.4
subroutine	38	49	77.5
pod	32	32	100.0
total	706	969	72.8

package Math::FractionManip;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Manipulate fractions

use strict;
#use warnings;

our $VERSION = '0.5502';

use Carp;
use Math::BigInt;
use Math::BigFloat;
use overload
  '+'      => 'add',
  '-'      => 'sub',
  '*'      => 'mul',
  '/'      => 'div',
  'abs'    => 'abs',
  '**'     => 'pow',
  'sqrt'   => 'sqrt',
  '<=>'    => 'cmp',
  '""'     => 'string',
  '0+'     => 'decimal',
  fallback => 1;

my %DEF = (
  CURRENT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, SYSTEM => 1, NAME => 'DEFAULT' },
  DEFAULT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, READONLY => 1, SYSTEM => 1 },
  BLANK   => { TAGS => ['', '', ''], DIGITS => '', READONLY => 1, SYSTEM => 1 },
);

my ($OUTFORMAT, $REDUCE, $SIZE, $AUTO, $INTERNAL, $RED_STATE) = (0 .. 5);
my $TAG_END = 3;    #Last index of tags meant to be kept.

my %TAGS = (
  NORMAL     => [$OUTFORMAT, 'NORMAL'],
  MIXED      => [$OUTFORMAT, 'MIXED'],
  MIXED_RAW  => [$OUTFORMAT, 'MIXED_RAW'],
  RAW        => [$OUTFORMAT, 'RAW'],
  DEF_MIXED  => [$OUTFORMAT, undef],
  REDUCE     => [$REDUCE,    'REDUCE'],
  NO_REDUCE  => [$REDUCE,    'NO_REDUCE'],
  DEF_REDUCE => [$REDUCE,    undef],
  SMALL      => [$SIZE,      'SMALL'],
  BIG        => [$SIZE,      'BIG'],
  DEF_BIG    => [$SIZE,      undef],
  AUTO       => [$AUTO,      'AUTO'],
  NO_AUTO    => [$AUTO,      'NO_AUTO'],
  DEF_AUTO   => [$AUTO,      undef],
  CONVERTED  => [$INTERNAL,  'CONVERTED'],
  IS_REDUCED => [$RED_STATE, 'IS_REDUCED'],
);

my @DEF_TAG = qw(DEF_MIXED DEF_REDUCE DEF_BIG DEF_AUTO);

my $ID = 01;

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my ($self, @frac, @tags, $tag, $decimal, $p1, $p2, $p3);
  if (_is_decimal($_[0]) and _is_decimal($_[1]) and _is_decimal($_[2])) {
    my $sign = $_[0] / abs($_[0]);
    @tags = _tags(@_[3 .. $#_]);
    ($decimal, $p1, $p2, $p3) = _fix_num(\@tags, @_[0 .. 2]);
    ($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3));
    @frac = ($p1 * $p3 + $p2, $sign * $p3);
    @frac = _de_decimal(@frac, \@tags) if $decimal;
  }
  elsif (_is_decimal($_[0]) and _is_decimal($_[1])) {
    @tags = _tags(@_[2 .. $#_]);
    ($decimal, @frac) = _fix_num(\@tags, @_[0 .. 1]);
    @frac = _de_decimal(@frac, \@tags) if $decimal;
    @frac = _simplify_sign(@frac);
  }
  elsif (_is_decimal($_[0])) {
    {
      @tags = _tags(@_[1 .. $#_]);
      ($decimal, $p1) = _fix_num(\@tags, $_[0]);
      @frac = ($p1, 1), last if not $decimal;
      (@frac[0 .. 1], $tag) = _from_decimal($p1);
      @tags = _tags(@tags, $tag);
      ($decimal, @frac) = _fix_num(\@tags, @frac);
      @frac = _de_decimal(@frac, \@tags) if $decimal;
    }
  }
  elsif ($_[0] =~ /\s*([\+\-]?)\s*([0-9e\.\+\-]+)\s+([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) {
    my $sign = $1 . '1';
    @tags = _tags(@_[1 .. $#_]);
    ($decimal, $p1, $p2, $p3) = _fix_num(\@tags, $2, $3, $4);
    ($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3));
    @frac = ($p1 * $p3 + $p2, $sign * $p3);
    @frac = _de_decimal($p1 * $p3 + $p2, $sign * $p3, \@tags) if $decimal;
  }
  elsif ($_[0] =~ /\s*([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) {
    @tags = _tags(@_[1 .. $#_]);
    ($decimal, @frac) = _fix_num(\@tags, $1, $2);
    @frac = _de_decimal(@frac, \@tags) if $decimal;
    @frac = _simplify_sign(@frac);
  }
  else {
    croak("\"$_[0]\" is of unknown format");
  }
  croak("Can not have 0 as the denominator") if $frac[1] == 0;
  if (_tag($REDUCE, \@tags) ne 'NO_REDUCE' and _tag($RED_STATE, \@tags) ne 'IS_REDUCED') {
    my $not_reduced;
    ($not_reduced, @frac) = _reduce(@frac);
    @frac = _fix_auto('DOWN', \@tags, @frac) if $not_reduced and _tag($AUTO, \@tags) eq 'AUTO';
  }
  @tags[$RED_STATE] = undef if _tag($RED_STATE, \@tags) eq 'IS_REDUCED';
  $self->{frac} = \@frac;
  $self->{tags} = \@tags;
  bless($self, $class);
  return $self;
}

sub string {
  my $self = shift;
  my @frac;
  my $mixed = _tag($OUTFORMAT, [$_[0]], $self->{tags});
  if ($mixed eq 'MIXED') {
    @frac = $self->list('MIXED');
    my $string = "";
    $string .= "$frac[0]"          if $frac[0] != 0;
    $string .= " "                 if $frac[0] != 0 and $frac[1] != 0;
    $string .= "$frac[1]/$frac[2]" if $frac[1] != 0;
    $string = "0" if $string eq '';
    return $string;
  }
  elsif ($mixed eq 'MIXED_RAW') {
    @frac = $self->list('MIXED');
    return "$frac[0] $frac[1]/$frac[2]";
  }
  elsif ($mixed eq 'RAW') {
    @frac = $self->list;
    return ($frac[0] >= 0 ? '+' : '') . "$frac[0]/$frac[1]";
  }
  else {
    @frac = $self->list;
    return "$frac[0]/$frac[1]";
  }
}

sub list {
  my $self = shift;
  my @frac = @{ $self->{frac} };
  if ($_[0] eq "MIXED") {
    my $whole = $frac[0] / $frac[1];
    $whole   = int($whole) if not ref($frac[0]);
    $frac[0] = abs($frac[0] - $frac[1] * $whole);
    @frac    = ($whole, @frac);
  }
  foreach (@frac) { s/^\+//; }
  return @frac;
}

sub reduce {
  my $self = shift;
  my ($undef, @frac) = _reduce(@{ $self->{frac} });
  return Math::FractionManip->new(@frac, @{ $self->{tags} });
}


sub decimal {
  my $self = shift;
  my @frac = @{ $self->{frac} };
  return $frac[0] / $frac[1] if not ref($frac[0]);
  return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]);
}

sub num {
  my $self = shift;
  my @frac = @{ $self->{frac} };
  return $frac[0] / $frac[1] if not ref $frac[0];
  return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]);
}

## For the next three methods:
# If used on the object use the tags of the object
# If given a class use the dafault tags,
# .... if a default set is specified then return for that set.

sub is_tag {
  my $self    = shift;
  my $tag     = shift;
  my $default = 1 if $_[0] eq 'INC_DEF';
  my $is_tag  = 0;
  my @tags;
  {
    $is_tag = 0, last if not $TAGS{$tag};    #if there is no such tag ret=0
    my ($num, $tag) = @{ $TAGS{$tag} };
    if (ref($self) eq "Math::FractionManip") {
      @tags   = @{ $self->{tags} };
      $is_tag = 1, last if $tags[$num] eq $tag;
      $is_tag = undef, last if $tags[$num] eq undef and not $default;
      $is_tag = -1, last if $DEF{CURRENT}{TAGS}[$num] eq $tag
        and $tags[$num] eq undef and $default;
      $is_tag = 0;
    }
    else {
      my $set;
      $set = 'CURRENT' unless $set = $_[0];
      $set = 'BLANK'   unless exists $DEF{$set};
      $is_tag = 1, last if $DEF{$set}{TAGS}[$num] eq $tag;
      $is_tag = 0;
    }
  }
  return $is_tag;
}

sub tags {
  my $self = shift;
  my @tags;
  if (ref($self) eq "Math::FractionManip") {
    my $inc_def = 1 if $_[0] eq 'INC_DEF';
    @tags = @{ $self->{tags} }[0 .. $TAG_END];
    my $num;
    foreach $num (0 .. $#tags) {
      $tags[$num] = $DEF_TAG[$num] if $tags[$num] eq undef and not $inc_def;
      $tags[$num] = $DEF{CURRENT}{TAGS}[$num] if $tags[$num] eq undef and $inc_def;
    }
  }
  elsif (ref($self) ne "Math::FractionManip") {
    my $set;
    $set = 'CURRENT' unless $set = $_[0];
    $set = 'BLANK'   unless exists $DEF{$set};
    @tags = @{ $DEF{$set}{TAGS} };
  }
  return @tags;
}

sub digits {
  my $self = shift;
  my $set;
  $set = 'CURRENT' unless $set = $_[0];
  $set = 'BLANK'   unless exists $DEF{$set};
  return $DEF{$set}{DIGITS};
}

###############################
# These methods are used for managing default sets.

sub sets {
  my $self = shift;
  return keys %DEF;
}

sub name_set {
  shift;
  return $DEF{CURRENT}{NAME} if not $_[0];
  $DEF{CURRENT}{NAME} = $_[0] if $_[0];
}

sub exists_set {
  return exists $DEF{ $_[1] };
}

sub use_set {
  my $self = shift;
  my $name = shift;
  if (exists $DEF{$name} and not $DEF{$name}{READONLY}) {
    $DEF{CURRENT} = $DEF{$name};
    return $name;
  }
  else {
    return undef;
  }
}

sub temp_set {
  my $self = shift;
  my $name = shift;
  if (not $name) {
    $ID++;
    $name = "\cI\cD$ID";
    $self->copy_set('CURRENT', $name);
    $self->copy_set('DEFAULT', 'CURRENT');
    return $name;
  }
  else {    #if $name;
    my $return = $self->copy_set($name, 'CURRENT');
    $self->del_set($name);
    return $return;
  }
}

sub load_set {
  my $self = shift;
  if (exists $DEF{ $_[0] }) {
    $self->copy_set($_[0], 'CURRENT') if exists $DEF{ $_[0] };
    return $_[0];
  }
  else {
    return undef;
  }
}

sub save_set {
  my $self = shift;
  my $name;
  $name = $DEF{CURRENT}{NAME} unless $name = shift;
  ++$ID, $name = "\cI\cD:$ID" if not $name or $name eq 'RAND';
  return $self->copy_set('CURRENT', $name) && $name;
}

sub copy_set {
  shift;
  my ($name1, $name2) = @_;
  if ($DEF{$name2}{READONLY} or $name2 eq 'BLANK' or not exists $DEF{$name1}) {
    return 0;
  }
  else {
    $DEF{$name2}         = {};                        # kill any links from use;
    $DEF{$name2}{TAGS}   = [@{ $DEF{$name1}{TAGS} }];
    $DEF{$name2}{DIGITS} = $DEF{$name1}{DIGITS};
    $DEF{$name2}{NAME} = $name2 unless $name2 eq 'CURRENT';
    $DEF{$name2}{NAME} = $name1 if $name2 eq 'CURRENT';
    return 1;
  }
}

sub del_set {
  if (exists $DEF{ $_[1] } and not $DEF{ $_[1] }{SYSTEM}) {
    delete $DEF{ $_[1] };
    return $_[1];
  }
}

###############################
# All of the modify methods are not meant to return anything, they modify
# the object being referenced.

# This method works almost like the new method except that it takes an
# object as an argement and will modify it instead of creating a new
# object, also any tags associated with the object are left in tact
# unless a new tag is given to override the old.
sub modify {
  my $me = shift;
  my $self;
  my @tags = @{ $me->{tags} };
  $self = Math::FractionManip->new(@_, @tags, @_); # The extra @_ is there to override tags
  $me->{frac} = $self->{frac};
  $me->{tags} = $self->{tags};
}

# XXX This method appears to break things? -GB
sub modify_digits {
  my $self = shift;
  $DEF{CURRENT}{DIGITS} = shift;
}

sub modify_reduce {
  my $me   = shift;
  my $self = $me->reduce;
  $me->{frac} = $self->{frac};
  $me->{tags} = $self->{tags};
}

sub modify_num {
  my $self = shift;
  $self->[0] = $_[0];
}

sub modify_den {
  my $self = shift;
  $self->[1] = $_[0];
}

sub modify_tag {
  my $self = shift;
  my ($return, @return);
  my $newtag;
  foreach $newtag (@_) {
    my $tagnum = _tagnum($newtag);
    if ($tagnum == -1) {
      push @return, undef;
    }
    elsif (ref($self) eq "Math::FractionManip") {
      my @frac    = @{ $self->{frac} };
      my @tags    = @{ $self->{tags} };
      my @newtags = _tags(@tags, $newtag);

      # Now transform the Fraction based on the new tag.
      if ($tagnum == $SIZE) {
        my $newtag = _tag($SIZE, \@newtags);
        @frac = map { "$_" + 0 } @frac              if $newtag eq 'SMALL';
        @frac = map { Math::BigInt->new($_) } @frac if $newtag eq 'BIG';
      }
      elsif ($tagnum == $REDUCE) {
        (undef, @frac) = _reduce(@frac) if _tag($REDUCE, \@newtags) eq 'REDUCE';
      }

      # Finally Modify the Fraction
      $self->{frac} = \@frac;
      $self->{tags} = \@newtags;
    }
    else {
      $DEF{CURRENT}{TAGS}[$tagnum] = $newtag;
    }
    push @return, $newtag;
  }
  return @return;
}

###############################
# These methods are meant to be called with the overload operators.

sub add {
  my @frac1 = @{ $_[0]->{frac} };
  my @tags1 = @{ $_[0]->{tags} };
  my (@frac2, @frac, @tags2, $frac);
  my $skipauto = 0;
  @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  @frac2 = _from_decimal($_[1]), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip";
  my @tags = _tags_preserve([@tags1], [@tags2]);

LOOP: {
    if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') {
      @frac = ($frac1[0] * $frac2[1] + $frac2[0] * $frac1[1], $frac1[1] * $frac2[1]);
    }
    else {

      # Taken from Knuth v2 (rev 2), p313.
      # It will always return a reduced fraction.
      my $gcd1 = _gcd($frac1[1], $frac2[1]);
      my $tmp = $frac1[0] * ($frac2[1] / $gcd1) + $frac2[0] * ($frac1[1] / $gcd1);
      my $gcd2 = _gcd($tmp, $gcd1);
      @frac = ($tmp / $gcd2, ($frac1[1] / $gcd1) * ($frac2[1] / $gcd2));
      $tags[$RED_STATE] = 'IS_REDUCED';
    }
    if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
    {
      (@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2);
      $tags[$SIZE] = 'BIG';
      $skipauto = 1;
      redo LOOP;
    }
  }
  return Math::FractionManip->new(@frac, @tags);
}

sub sub {
  my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]);    # swap if needed
  $frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip";
  $frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip";

  $frac2 = Math::FractionManip->new($frac2->{frac}[0], -$frac2->{frac}[1], @{ $frac2->{tags} });

  return $frac1 + $frac2;
}

sub mul {
  my @frac1 = @{ $_[0]{frac} };
  my @tags1 = @{ $_[0]{tags} };
  my (@frac2, @frac, @tags2);
  @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  @frac2 = (_from_decimal($_[1])), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip";
  my @tags     = _tags_preserve([@tags1], [@tags2]);
  my $skipauto = 0;
LOOP: {
    if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') {
      @frac = ($frac1[0] * $frac2[0], $frac1[1] * $frac2[1]);
    }
    else {
      my ($gcd1, $gcd2) = (_gcd($frac1[0], $frac2[1]), _gcd($frac2[0], $frac1[1]));
      $frac[0]          = ($frac1[0] / $gcd1) * ($frac2[0] / $gcd2);
      $frac[1]          = ($frac1[1] / $gcd2) * ($frac2[1] / $gcd1);
      $tags[$RED_STATE] = 'IS_REDUCED';
    }
    if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
    {
      (@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2);
      $tags[$SIZE] = 'BIG';
      $skipauto = 1;
      redo LOOP;
    }
  }
  return Math::FractionManip->new(@frac, @tags);
}

sub div {
  my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]);    # swap if needed
  $frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip";
  $frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip";

  $frac2 = Math::FractionManip->new($frac2->{frac}[1], $frac2->{frac}[0], @{ $frac2->{tags} });

  #Makes a copy of the fraction with the num and den switched.

  return $frac1 * $frac2;
}

sub pow {
  my (@frac, @frac1, @tags1);
  @frac1 = @{ $_[$_[2]]->{frac} }, @tags1 = @{ $_[$_[2]]->{tags} } if ref($_[$_[2]]) eq "Math::FractionManip";
  @frac1 = _from_decimal($_[$_[2]]) if ref($_[$_[2]]) ne "Math::FractionManip";
  my $frac2;
  $frac2 = $_[not $_[2]]->decimal if ref($_[not $_[2]]) eq "Math::FractionManip";
  $frac2 = $_[not $_[2]] if ref($_[not $_[2]]) ne "Math::FractionManip";
  my @tags     = @tags1;
  my $skipauto = 0;

LOOP: {
    @frac = ($frac1[0] ** $frac2, $frac1[1] ** $frac2);

    if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
    {
      @frac1       = map { Math::BigInt->new($_) } @frac1;
      $tags[$SIZE] = 'BIG';
      $skipauto    = 1;
      redo LOOP;
    }
  }

  return Math::FractionManip->new(@frac, @tags);
}

sub sqrt {
  my $self = shift;
  my @frac = @{ $self->{frac} };
  my @tags = @{ $self->{tags} };
  my $ans;
  if (ref($frac[0])) {
    $frac[0] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[0], $DEF{CURRENT}{DIGITS}));
    $frac[1] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[1], $DEF{CURRENT}{DIGITS}));
  }
  else {
    @frac = (sqrt($frac[0]), sqrt($frac[1]));
  }
  return Math::FractionManip->new(@frac, @tags);
}

sub abs {
  my $self = shift;
  my @frac = @{ $self->{frac} };
  my @tags = @{ $self->{tags} };
  return Math::FractionManip->new(abs($frac[0]), abs($frac[1]), @tags, 'IS_REDUCED');
}

sub cmp {
  my @frac1 = @{ $_[0]->{frac} };
  my @tags1 = @{ $_[0]->{tags} };
  my (@frac2, @frac, @tags2, $x, $y);
  @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  @frac2 = _from_decimal($_[1]), @tags2 = qw(CONVERTED) if ref($_[1]) ne "Math::FractionManip";
  my @tags = _tags_preserve([@tags1], [@tags2]);
  if (_tag($REDUCE, \@tags) == 'NO_REDUCE') {
    $x = $frac1[0] * $frac2[1];
    $y = $frac2[0] * $frac1[1];
  }
  else {
    my $gcd1 = _gcd($frac1[1], $frac2[1]);
    $x = $frac1[0] * ($frac2[1] / $gcd1);
    $y = $frac2[0] * ($frac1[1] / $gcd1);
  }
  return $x <=> $y;
}

################################
# These functions are internal

sub _fix_num {
  my $tagsref = shift;
  my @return  = @_;
  my $auto    = _tag($AUTO, $tagsref) eq 'AUTO';
  $tagsref->[$SIZE] = _tag($SIZE, $tagsref);
  $tagsref->[$SIZE] = 'SMALL' if $auto;
  my $num;
  my $decimal = 0;
  foreach $num (@return) {
    if (ref($num) eq "Math::BigFloat") {
      $tagsref->[$SIZE] = 'BIG' unless $auto;
      $decimal = 1;
    }
    elsif (ref($num) eq "Math::BigInt") {
      $tagsref->[$SIZE] = 'BIG' unless $auto;
    }
    elsif (ref($num)) {

      # do nothing
    }
    elsif ($num =~ /[\.\e]/) {
      $decimal = 1;
    }
    if ($auto) {
      $num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/;
      my $length = length($1) + length($2);
      $tagsref->[$SIZE] = 'BIG' if $length > 15;
    }
  }
  if ($tagsref->[$SIZE] eq 'BIG') {
    @return = map { Math::BigInt->new("$_") } @return   if not $decimal;
    @return = map { Math::BigFloat->new("$_") } @return if $decimal;
  }
  if ($tagsref->[$SIZE] eq 'SMALL' and $auto) {
    @return = map { "$_" + 0 } @return;
  }
  return ($decimal, @return);
}

sub _fix_auto {
  my $direction = shift;
  my $tagsref   = shift;
  my @return    = @_;
  $tagsref->[$SIZE] = 'SMALL';
  my $num;
  foreach $num (@return) {
    $num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/;
    my $length = length($1) + length($2);
    $tagsref->[$SIZE] = 'BIG' if $length > 15;
  }
  if ($tagsref->[$SIZE] eq 'BIG' and $direction eq 'BOTH') {
    @return = map { Math::BigInt->new("$_") } @return;
  }
  elsif ($tagsref->[$SIZE] eq 'SMALL') {
    @return = map { "$_" + 0 } @return;
  }
  return (@return);
}

sub _is_decimal {
  return undef unless defined $_[0];
  my $return = $_[0] =~ /^\s*[\+\-0-9eE\.]+\s*$/;
  return $return;
}

sub _reduce {
  my @frac = @_;
  my $gcd  = _gcd(@frac);
  if ($gcd == 1) {
    return (0, @frac);
  }
  else {
    return (1, $frac[0] / $gcd, $frac[1] / $gcd);
  }
}

sub _simplify_sign {
  my @frac = @_;
  my $sign = 1;
  $sign = ($frac[0] / CORE::abs($frac[0])) * ($frac[1] / CORE::abs($frac[1])) if $frac[0];
  @frac = ($sign * CORE::abs($frac[0]), CORE::abs($frac[1]));
  return @frac;
}

sub _tags {
  my @return = (undef, undef);
  my ($NUM, $VALUE) = (0, 1);

  foreach (@_) {
    next if not $TAGS{$_};
    my ($num, $value) = @{ $TAGS{$_} };
    $return[$num] = $value;
  }

  return @return;
}

sub _tag {
  my $item = shift;
  my $return;
  my $ref;
  foreach $ref (@_, $DEF{CURRENT}{TAGS}) {
    last if $return = ${$ref}[$item];
  }
  return $return;
}

sub _tagnum {
  my $item = shift;
  if (exists $TAGS{$item}) {
    return $TAGS{$item}[0];
  }
  else {
    return -1;
  }
}

sub _tags_preserve {
  my @tags1 = @{ $_[0] };
  my @tags2 = @{ $_[1] };
  my @tags;
  if ($tags1[$INTERNAL] eq 'CONVERTED') {
    @tags = @tags2;
  }
  elsif ($tags2[$INTERNAL] eq 'CONVERTED') {
    @tags = @tags1;
  }
  else {
    @tags = map { $tags1[$_] eq $tags2[$_] and $tags1[$_] } (0 .. $#tags1);
  }
  return @tags;
}

sub _gcd {
  my ($x, $y) = (CORE::abs($_[0]), CORE::abs($_[1]));
  if (ref($x)) {
    $x = Math::BigInt->new($x->bgcd($y));
  }
  else {
    {
      $x = 1, last if $y > 1e17;  # If this is so % will thinks its a zero so if
                                  # $y>1e17 will simply will basicly give up and
                                  # have it return 1 as the GCD.
      my ($x0);
      while ($y != 0) {
        $x0 = $x;
        ($x, $y) = ($y, $x % $y);

        # Note $x0 = $x, $x = $y, $y= $x % $y   Before the Swith
        $x = 1, last if ($x0 > 99999999 or $x > 999999999) and int($x0 / $x) * $x + $y != $x0;

        # This is to see if the mod operater through up on us when dealing with
        # large numbers.  If it did set the gcd = 1 and quit.
      }
    }
  }
  return $x;
}

sub _de_decimal {
  my @frac = @_;
  my @return;
  my $big = _tag($SIZE, $_[2]);
  my (@int_part, @decimal_part);
  ($int_part[0], $decimal_part[0]) = $frac[0] =~ /(\d+)\.(\d+)/;
  ($int_part[1], $decimal_part[1]) = $frac[1] =~ /(\d+)\.(\d+)/;
  @decimal_part = sort { $a <=> $b } (length($decimal_part[0]), length($decimal_part[1]));
  my $factor = 10 ** $decimal_part[1];
  @frac = ($_[0] * $factor, $_[1] * $factor);
  return @frac;
}

sub _from_decimal {
  my $decimal = shift;                    # the decimal (1.312671267127)
  my $big     = 'BIG' if ref($decimal);
  my ($repeat);    # flag to keep track if it is repeating or not
  my ($sign);
  my ($factor, $int_factor);
  my ($factor2);
  my ($whole_num, $whole_num_len);
  my ($int_part);                           # integer part (1)
  my ($decimal_part, $decimal_part_len);    # decimal part (312671267127)
  my ($decimal_part2);    # decimal part - last bit \/ (312671267)
  my ($pat, $pat_len);    # repeating pat (1267)
  my ($pat_lastb);        # last bit of repeating pat (127)
  my ($beg_part,   $beg_part_len);      # non-repeating part (3)
  my ($other_part, $other_part_len);    # repeating part     (1267126712127)
  my ($frac1,      $frac2, $frac3);

  my $rnd_mode = $Math::BigFloat::rnd_mode;    # to avoid problems with incon.
  $Math::BigFloat::rnd_mode = 'trunc';         # rounding

  $decimal = "$decimal";
  $decimal =~ s/\s//g;
  ($sign, $int_part, $decimal_part) = $decimal =~ /([\+\-]?)\s*(\d*)\.(\d+)$/;
  $sign .= '1';
  $decimal_part_len = length($decimal_part);
  $int_part         = "" unless $int_part;
  $factor           = '1' . '0' x (length($decimal_part));
  $factor           = Math::BigFloat->new($factor) if $big;

  # Make it a BigFloat now to simplfy latter
  $int_factor   = '1' . '0' x (length($int_part));
  $beg_part_len = 0;
OuterBlock:
  while ($beg_part_len < $decimal_part_len) {
    $beg_part   = substr($decimal_part, 0, $beg_part_len);
    $other_part = substr($decimal_part, $beg_part_len);
    $other_part_len = length($other_part);
    my $i;
    for ($i = 1; $i < ($other_part_len / 2 + 1); $i++) {
      $pat     = substr($other_part, 0, $i);
      $pat_len = $i;
      local $_ = $other_part;
      $repeat = undef;
      while (1) {
        ($_) = /^$pat(.*)/;
        my $length = length($_);

        if ($length <= $pat_len) {
          last unless $length;
          $pat_lastb = substr($pat, 0, $length);
          $repeat    = 1, last OuterBlock if $pat_lastb eq $_;
          if ($pat_lastb eq $_ - 1) {

            # this is needed to see if it really is the repeating fracton
            # we intented it to be.  If we don't do this 1.1212 would become
            # 1120/999 = 1.1211211211.
            # The first three lines converts it to a fraction and the
            # rests tests it to the actual repeating decimal/
            # The NO_REDUCE flag is their to save time as reducing large
            # fraction can take a bit of time which is unnecessary as we will
            # be converting it to a decimal.
            $decimal_part2 = substr($decimal_part, 0, $decimal_part_len - length($pat_lastb));
            $factor2 = '1' . '0' x (length($decimal_part2));
            $frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, 'NO_REDUCE', $big);
            $frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, 'NO_REDUCE', $big);
            $frac3 = $frac1 + $frac2;
            my $what_i_get    = $frac3->decimal;
            my $places        = length($what_i_get);
            my $decimal_p_tmp = $decimal_part2 if not $big;
            $decimal_p_tmp = Math::BigFloat->new($decimal_part2) if $big;
            my $what_i_should_get = (($decimal_p_tmp) / $factor2) . "$pat" x ($places);

            # The rest of this is doing nothing more but trying to compare
            # the what_i_get and what_i_should_get but becuse the stupid
            # BigFloat module is so pragmentic all this hopla is nessary
            $what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big;
            $what_i_should_get = $what_i_should_get->fround(length($what_i_get) - 1) if $big;
            $what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big;
            # ^^ Needed because the fround method does not return a BigFloat object!

            my $pass = "$what_i_get" eq "$what_i_should_get" if $big;
            $pass = $what_i_get == $what_i_should_get if not $big;
            $repeat = 1, last OuterBlock if ($pass);
          }
        }
      }
    }
    $beg_part_len++;
  }
  if ($repeat) {
    $frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, $big);
    $frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, $big);
    $int_part = Math::FractionManip->new('0' . $int_part, 1, 'BIG') if $big;
    $frac3    = $sign * ($int_part + $frac1 + $frac2);
    return @{ $frac3->{frac} };
  }
  else {
    return ($decimal * $factor, $factor, $big);
  }
  $Math::BigFloat::rnd_mode = $rnd_mode;    # set it back to what it was.
}

1;

__END__