Barely Used Perl Untapped resources of the perl core libraries #10

Fraction example

{

    package MooseX::Number::Fraction;

    use Moose;

    use overload
      q("")    => 'to_string',
      '0+'     => 'to_num',
      '+'      => 'add',
      fallback => 1;

    has num => ( is => 'rw', isa => 'Int' );
    has den => ( is => 'rw', isa => 'Int' );

    sub BUILD {
        my ($self) = @_;
        $self->_normalise;
    }

    sub to_string {
        my ($self) = @_;

        if ( $self->den eq 1 ) {
            return $self->num;
        }
        else {
            return sprintf "%s/%s", $self->num, $self->den;
        }
    }

    sub _normalise {
        my ($self) = @_;

        my $hcf = _hcf( $self->num, $self->den );

        for (qw/num den/) {
            $self->$_( $self->$_ / $hcf );
        }

        if ( $self->{den} < 0 ) {
            for (qw/num den/) {
                $self->$_( $self->$_ * -1 );
            }
        }
    }

    sub to_num {
        my ($self) = @_;
        return $self->num / $self->den;
    }

    sub _hcf {
        my ( $x, $y ) = @_;

        ( $x, $y ) = ( $y, $x ) if $y > $x;

        return $x if $x == $y;

        while ($y) {
            ( $x, $y ) = ( $y, $x % $y );
        }
        return $x;
    }

    sub add {
        my ( $l, $r, $rev ) = @_;

        if ( ( ref $r ) eq 'MooseX::Number::Fraction' ) {
            return ( ref $l )->new( num => ( $l->num * $r->den + $r->num * $l->den ), den => ( $r->den * $l->den ) );
        }
        else {
            if ( $r =~ /^[-+]?\d+$/ ) {
                return $l + ( ref $l )->new( num => $r, den => 1 );
            }
            else {
                return $l->to_num + $r;
            }
        }
    }

    no Moose;
}

my $half         = MooseX::Number::Fraction->new( num => 1, den => 2 );
my $quarter      = MooseX::Number::Fraction->new( num => 1, den => 4 );
my $three_forths = MooseX::Number::Fraction->new( num => 3, den => 4 );

my $result = $half + $quarter + $three_forths;
$result += 2;

printf "%s \n%f", $result, $result;
continued...
Copyright © 2007 Robert Boone