Re: [QUIZ] Perl 'Easy' Quiz of the Week #2006-04-02 - Rounded Fractions

#!/usr/bin/perl -w

use strict;

my %mean =3D (
        0           =3D> '0',
  ( 1/4 +  0  ) / 2 =3D> '1/4',
  ( 1/3 + 1/4 ) / 2 =3D> '1/3',
  ( 1/2 + 1/3 ) / 2 =3D> '1/2',
  ( 2/3 + 1/2 ) / 2 =3D> '2/3',
  ( 3/4 + 2/3 ) / 2 =3D> '3/4',
);

# IO::Prompt would be well used here, but I'm assuming we're not using
anything not in the core
my $got_first =3D my $got_second =3D 0;

my ( $op1, $op2 );

while ( ! $got_first ) {
  print "\nPlease enter first fraction: ";
  chomp ( $op1 =3D <STDIN> );
  $got_first =3D $op1 =3D~ m!^\d*\s+?\d+/\d+$!;
  print "Whole numbers or fractions only, please." unless $got_first;
}

while ( ! $got_second ) {
  print "\nPlease enter second fraction: ";
  chomp ( $op2 =3D <STDIN> );
  $got_second =3D $op2 =3D~ m!^\d*\s+?\d+/\d+$!;
  print "Whole numbers or fractions only, please." unless $got_second;
}

( my $work_op1 =3D $op1 ) =3D~ s/\s+/+/;
( my $work_op2 =3D $op2 ) =3D~ s/\s+/+/;

my $float_op1 =3D eval $work_op1;
my $float_op2 =3D eval $work_op2;

my ( $whole, $decimal ) =3D split /\./, ( $float_op1 * $float_op2 );

my $fraction;

if ( '' eq $decimal || 0 =3D=3D $decimal ) {

  $fraction =3D '';

} else {

  ( $fraction ) =3D grep { ( '.' . $decimal ) < $_ }
                    sort { $a <=3D> $b }
                      keys %mean;

  $fraction =3D ( ''  eq $fraction ) ? do { $whole++ && '' } :
              ( '0' =3D=3D $fraction ) ? '' :
              ' ' . $mean{ $fraction };
}

print "$op1 * $op2 =3D $whole$fraction\n";
--
Alan