File Coverage

blib/lib/Math/Cephes/Fraction.pm

Criterion	Covered	Total	%
statement	60	103	58.2
branch	14	34	41.1
condition			n/a
subroutine	14	18	77.7
pod	0	14	0.0
total	88	169	52.0

############# Class : fract ##############
package Math::Cephes::Fraction;
use strict;
use warnings;
use vars qw(%OWNER @ISA %ITERATORS
	    @EXPORT_OK %EXPORT_TAGS $VERSION);

require Exporter;
*import = \&Exporter::import;
#my @fract = qw(radd rsub rmul rdiv euclid fract mixed_fract);
my @fract = qw(euclid fract mixed_fract);
@EXPORT_OK = (@fract);
%EXPORT_TAGS = ('fract' => [@fract]);

$VERSION = '0.5304';
#use Math::Cephes qw(new_fract euclid);
require Math::Cephes;
@ISA = qw( Math::Cephes );

%OWNER = ();
%ITERATORS = ();

*swig_n_get = *Math::Cephesc::fract_n_get;
*swig_n_set = *Math::Cephesc::fract_n_set;
*swig_d_get = *Math::Cephesc::fract_d_get;
*swig_d_set = *Math::Cephesc::fract_d_set;
sub new {
    my $pkg = shift;
    my $self = Math::Cephesc::new_fract(@_);
    bless $self, $pkg if defined($self);
}

sub DESTROY {
    return unless $_[0]->isa('HASH');
    my $self = tied(%{$_[0]});
    return unless defined $self;
    delete $ITERATORS{$self};
    if (exists $OWNER{$self}) {
        Math::Cephesc::delete_fract($self);
        delete $OWNER{$self};
    }
}

sub DISOWN {
    my $self = shift;
    my $ptr = tied(%$self);
    delete $OWNER{$ptr};
}

sub ACQUIRE {
    my $self = shift;
    my $ptr = tied(%$self);
    $OWNER{$ptr} = 1;
}


sub fract {
  return Math::Cephes::Fraction->new(@_);
}

sub n {
    my ($self, $value) = @_;
    return $self->{n} unless $value;
    $self->{n} = $value;
    return $value;
}

sub d {
    my ($self, $value) = @_;
    return $self->{d} unless $value;
    $self->{d} = $value;
    return $value;
}

sub euclid {
  return Math::Cephes::euclid($_[0], $_[1]);
}


sub mixed_fract {
  my $f = shift;
  my $nin = int($f->{n});
  my $din = int($f->{d});
  my $gcd;
   if ($din < 0) {
     $din *= -1;
     $nin *= -1;
   }
   if (abs($nin) < abs($din)) {
     if ( $nin == 0 ) {
       return (0, 0, 0);
     }
     else {
       ($gcd, $nin, $din) = euclid($nin, $din);
       return (0, $nin, $din);
     }
   }
   else {
     my $n = abs($nin) % $din;
     my $w = int($nin / $din);
     if ($n == 0) {
       return ($w, 0, 1);
     }
     else {
       ($gcd, $n, $din)  = euclid($n, $din);
       return ($w, $n, $din);
     }
   }
}

sub as_string {
  my $f = shift;
  my ($gcd, $string);
  my $num = int($f->{n});
  my $den = int($f->{d});
  if ( abs($num % $den) == 0) {
    my $w = $num / $den;
    $string = "$w";
  }
  elsif ($num == 0) {
    $string = '0';
  }
  else {
    if ($den < 0) {
      $num *= -1;
      $den *= -1;
    }
    ($gcd, $num, $den) = euclid($num, $den);
    $string = "$num/$den";
  }
  return $string;
}

sub as_mixed_string {
  my $f = shift;
  my ($gcd, $string);
  my $num = int($f->{n});
  my $den = int($f->{d});
  if ($den < 0) {
    $den *= -1;
    $num *= -1;
  }
  if (abs($num) < abs($den)) {
    if ( $num == 0 ) {
      $string = '0';
     }
     else {
       ($gcd, $num, $den) = euclid($num, $den);
       $string = "$num/$den";
     }
   }
   else {
     my $n = abs($num) % $den;
     my $w = int($num / $den);
     if ($n == 0) {
       $string = "$w";
     }
     else {
       ($gcd, $num, $den) = euclid($num, $den);
       $string = "$w $n/$den";
     }
   }
  return $string;
}


sub radd {
  my ($f1, $f2) = @_;
  my $f = Math::Cephes::Fraction->new();
  Math::Cephes::radd($f1, $f2, $f);
  return $f;
}

sub rsub {
  my ($f1, $f2) = @_;
  my $f = Math::Cephes::Fraction->new();
  Math::Cephes::rsub($f2, $f1, $f);
  return $f;
}

sub rmul {
  my ($f1, $f2) = @_;
  my $f = Math::Cephes::Fraction->new();
  Math::Cephes::rmul($f1, $f2, $f);
  return $f;
}

sub rdiv {
  my ($f1, $f2) = @_;
  my $f = Math::Cephes::Fraction->new();
  Math::Cephes::rdiv($f2, $f1, $f);
  return $f;
}

1;

__END__