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

Hi,

I have written a solution to the running quest of the week (rounded
fractions).
I hope I am not too soon with this solution.

My solution has six functions which I want to introduce here shortly:


1) sub main

This function is called at the very beginning of the program with the given
command line arguments in @ARGV.

If there are not exactly two command line arguments, the program asks the
user
for input, just as it was asked for in the decription of the qotw.

If there is usefull input, the calculation in the function calculate is
called
and the result is printed.


2) sub calculate

It gets the quantity and the multiplier as parameters.
It analyses both of them with help of the function analyse and then
multiplies
them with the function multiply.

At last it constructs the result string dependig on the value of the result.
This can be "1", "2/3" or "4 1/3". Or "0", don't miss this case :-)


3) sub analyse

This function analyses one of the given input strings which can have one of
the
forms described above ("1", "2/3" or "4 1/3").

It returns a hash reference to an anonymous hash with the keys
    whole       : The whole part of the value.
    numerator   : The numerator of the fraction part of the value.
    denominator : The denominator of the fraction part of the value.
    total       : The total value as a floating point number.
    string      : The given value as string.


4) sub multiply

This function gets two hash references of the form that the function analyse
returns as parameters.

It first simple multiplies the total values of the both input values and
then
generates the whole, numerator, and denominator parts of the result.

To determine the nearest form to half, thirds, and fourths it calls the
function nearest_fraction.

The result of this function is simular to the result of the sub analyse, but
it
adds a key 'exact_total' with the exact result of the multiply as a floating
number.


5) sub nearest_fraction

This function gets a number between zero (including) and one (excluding) -
the
fractional part of the result of the multiplying done before.

Then it determines one of the fraction 0, 1/4, 1/3, 1/2, 2/3, 3/4, and 1 as
the
nearest match.

Therefore it builds an array with anonymous arrays with the distance to that
fraction and denominator and numerator part of that fraction. The best of
them
is determined with help of the last function min. This best match is
returned.


6) sub min

This function gets an AoA and has to determine the element, which value at
index zero has the lowest value.

This is done bruteforce with help of sort. I know that this is overkill, but
the array always has only seven elements, do I decided to choose simlicity
in
this case.


Here are some example runs of the program:

    C:\Daten\perl>qotw_rounded_fractions.pl
    quantity  : 1 2/3
    multiplier: 3
    result    : 5

    C:\Daten\perl>qotw_rounded_fractions.pl  "1 2/3" 2
    quantity  : 1 2/3
    multiplier: 2
    result    : 3 1/3

    C:\Daten\perl>qotw_rounded_fractions.pl  2 "1 2/3"
    quantity  : 2
    multiplier: 1 2/3
    result    : 3 1/3

    C:\Daten\perl>qotw_rounded_fractions.pl  1/9 1
    quantity  : 1/9
    multiplier: 1
    result    : 0

    C:\Daten\perl>qotw_rounded_fractions.pl  3/10 3
    quantity  : 3/10
    multiplier: 3
    result    : 1

And here finaly comes the program
itself:



#!/usr/bin/perl
#------------------------------------------------------------------------------
# Programm  : q o t w _ r o u n d e d _ f r a c t i o n s . p
l
#------------------------------------------------------------------------------
# Author    : Christian Dühl
# ceated    : 2006-04-03
# changed   : 2006-04-04
# task      : Cooking often involves multiplication and rounding of
fractions,
#             at least for those of us stuck under the tyranny of U.S.
#             customary units.
#             For instance, to make oatmeal, I use 7 parts water to 4 parts
#             thick-cut rolled oats.  If I have 1 2/3 cups oats, about how
#             much water should I use?
#             5/3 * 7/4 = 35/12 = ~3 cups.
# 
#             Your task: create a script that prompts for a ratio of two
#             integers and a quantity given as a whole number and/or a
#             fraction (e.g. "1 3/5", "12", "3/7") and print out a rounded
#             result of multiplying the quantity by the ratio in the same
#             format.
# 
#             The result should be rounded to the nearest half, third, or
#             fourth, whichever is most accurate (in cases exactly between
two
#             quantities, using the lowest denominator).
#             You may assume none of the integers are overly large.
# parameter : optional quantity and multiplier (otherwise the program asks
for
#             that
parameters)
#------------------------------------------------------------------------------

use strict;
use warnings;


main(@ARGV);
exit;


sub main {
    my ($quantity, $multiplier) = @_;

    # Do we not have exactly two arguments? Then ask the user for them:
    if (2 != @_) {
        { 
            local $|;
            print "quantity  : ";
        }
        chomp($quantity = <STDIN>);
        { 
            local $|;
            print "multiplier: ";
        }
        chomp($multiplier = <STDIN>);
    }
    else {
        print "quantity  : $quantity\n",
              "multiplier: $multiplier\n";
    }

    # If we have something to calculate, do it:
    if (length($quantity) * length($multiplier)) {
        my $result = calculate($quantity, $multiplier);
        print "result    : $result\n";
    }
} # sub main


sub calculate {
    my ($quantity, $multiplier) = @_;

    # Analyse the whole and fraction parts:
    my $q = analyse($quantity);
    my $m = analyse($multiplier);

    # Multiply both:
    my $r = multiply($q, $m);

    # Build the result string and return it:
    my $part1  = $r->{whole} ? $r->{whole} : '';
    my $part2  = $r->{numerator} ? $r->{numerator} . '/' . $r->{denominator}
: '';
    my $space  = (length $part1 and length $part2) ? ' ' : '';
    my $return = $part1 . $space . $part2;

    return length($return) ? $return : 0;
} # sub calculate


sub analyse {
    my ($value) = @_;

    # Look for the values in the input string:
    my ($whole, $numerator, $denominator) = $value =~
        m~^\s*(\d+)(?:\s+(\d+)\s*/\s*(\d+))?\s*$~;
    $denominator = 1 unless defined $denominator;
    $numerator   = 0 unless defined $numerator;

    unless (defined $whole) {
        $whole = 0;
        ($numerator, $denominator) = $value =~
            m~^\s*(\d+)\s*/\s*(\d+)\s*$~;
        die "can't analyse [$value]\n" unless defined $denominator;
    }

    return {
        whole       => $whole,
        numerator   => $numerator,
        denominator => $denominator,
        total       => $whole + $numerator / $denominator,
        string      => $value,
    };
} # sub analyse


sub multiply {
    my ($q, $m) = @_;

    # Calculate whole and total:
    my $total       = $q->{total} * $m->{total};
    my $whole       = int $total;

    # Determine nearest half, third, or fourth:
    my $fraction      = $total - $whole;
    my ($dist, $denominator, $numerator) = @{ nearest_fraction($fraction) };

    # Normalise '3 2/2' to '4':
    if ($denominator == $numerator) {
        ++$whole;
        $denominator = 1;
        $numerator   = 0;
    }

    return {
        whole       => $whole,
        numerator   => $numerator,
        denominator => $denominator,
        total       => $whole + $numerator / $denominator,
        exact_total => $total,
    };
} # sub multiply


sub nearest_fraction {
    my ($f) = @_;

    return min(
        [$f, 2, 0],  [abs(1 - $f), 2, 2],
        [abs($f - 1/2), 2, 1],
        [abs($f - 1/3), 3, 1], [abs($f - 2/3), 3, 2],
        [abs($f - 1/4), 4, 1], [abs($f - 3/4), 4, 3],
    );

    # What is in that anonymous arrays?
    #  - index 0: distance between $f and the fraction
    #  - index 1: the denominater (2, 3, or 4)
    #  - index 2: the numerator

} # sub nearest_fraction


sub min {
    [sort {$a->[0] <=> $b->[0]} @_]->[0]
} # sub min




I hope I didn't miss anything, but how ever, it was fun to write it,

greetings, Christian.