Solutions and Discussion for Perl Quiz of the Week #19

Sample solutions and discussion
Perl Quiz of The Week #19 (20040707)

My friend Roger and I are ready to become boat owners. He has some
experience in boat building: between the two of us we should be able
to build lakeworthy copies of Sunfish, the boats we have been renting
these past months.

The first milestone in our boat building is to build scale models and
check their handling. At the same time, we can test out some scaled-down
sail rigs of various types and see how they stack up against the lateen
sailshape, which is the rig that Sunfish use. Whichever rig handles best
on the models will be our choice for the full-scale boats we build.

This week's quiz was inspired by the model boat building that we're
doing. Calculating scaling sail areas is a niche need, but it attracted
8 solutions.

There were two different approaches adopted to calculating the area of
a triangle or quadrilateral. Most people used the Polygon Area formula
from Wolfram (http://mathworld.wolfram.com/PolygonArea.html). Abigail
and I used a combination of the Pythagorean Theorem
(http://mathworld.wolfram.com/PythagoreanTheorem.html) and Heron's
Formula (http://mathworld.wolfram.com/HeronsFormula.html).

My test suite consisted of 8 different sailplans. Some of the sailplans
had negative X coordinates in them. At the time I wrote the sailplan
files, this seemed fair: if the intersection of deck and mast is
point 0, 0, sailplans with a jib must naturally have a negative X
coordinate. However, I typo'ed the example jib: it did not have any
negative values, so most programmers discounted (or did not consider)
this possibility.

Pr. Ben Prew's solution was unique in how it parsed lines from the
sailplan file. Pr. Prew's file parsing looks like this:

     my ($sail_info, $coord) = split(/:/, $line);

     my ($sail_name, $verticie) = split(/\./, $sail_info);
     my ($x, $y) = split(/,/, $coord);

Pr. Luke Robinson obviously considered negative numbers valid, because
they are explicitly allowed in his regular expression:

     # from Pr. Luke Robinson's solution
     next unless /^\s*(.+)\.(.):\s*([-\d]+)\s*,\s*([-\d]+)\s*$/;
     my ($tag, $vtag, $x, $y) = ($1, $2, $3, $4);

The other solutions used a regular expression similar to the above,
but omitted the '-' which would allow a negative number.

One of my sailplans had some pounded-out lines in it. Pr. Luke
Robinson's regular expression allowed lines to begin with a '#'
symbol, so produced the output

     lateen.area: 101250 cm^2
     #lateen.area: 101250 cm^2

One solution did not follow the output spec; rather than the expected

    bermudan.area: 60000 cm^2
    jib.area: 50000 cm^2
    total.area: 110000 cm^2

it reported

    sail bermudan has area 7500 cm^2
    sail jib has area 0 cm^2
    total sail area 7500 cm^2

When needed, I adjusted the parsing and display to match the inputs
and outputs that my test suite was using. However, I did not adjust
mathematical errors.

Scaling was handled variously, probably due to how I worded that
section of the quiz. Prs. LeBoutillier and Robinson's solutions
treated scale '25' to mean '2500% the size of the original'. The idea
was that '25' would mean '25% the size of the original'. My solution
treated scale very strangely: scale '25' meant '12.5% the size of the
original'.  Within the code, this looks very deliberate:

     $area *= $scale ** 2;     # <-- a perfect solution but for this

When I originally suggested this quiz to Pr. Mark Jason Dominus,
I indicated that it would only deal with triangular sails. After a
few hours I realized that a quadrilateral sail is just two triangular
sails edge-to-edge, so wrote back saying that I would include gaff
rigged sails. While developing my solution, I included sprit-rigged
and square-rigged sails. Though these sail shapes were not included in
the quiz, most solutions were able to get the correct answer for these:
both algorithms (area of polygon or Pythagoras && Heron) could handle
either sailshape.

My test results:

                   p  o  f  s  1  2  3  4  5* 6* 7* 
               ....................................
       abigail :   y  n  n  n  -  -  -  -  -  -  -
       abigail2:   y  y  y  y  y  y  y  y  n  y  y  
       blyman  :   y  y  y  y  y  y  y  n  y  y  y
       bprew   :   y  y  y  y  y  y  y  y  y  y  y
       jtrammel:   y  y  y  y  y  y  y  y  n  y  y
       kallen  :   y  n  y  y  y  n  n  y  n  n  n  
       robinson:   n  y  y  y  y  y  y  n  y  y  y  
       leboutil:   y  y  y  y  y  y  y  n  n  y  y
       shlomi  :   y  y  y  y  y  y  y  y  n  y  y

       p: parses file correctly
       o: output as expected
       f: accepts filename
       s: accepts scale
       1: lateen, unscaled
       2: gaff, unscaled
       3: bermudan, unscaled
       4: lateen, scaled to 25%
       5: lateen with negative values, unscaled
       6: sprit
       7: square

Tests 5, 6, and 7 were not explicitly mentioned in the spec, so failure
here should be understood as "programmer cannot minds" rather than
"program was not implemented correctly".

Pr. Ben Prew's solution, which passes all tests without any changes on
my part, is presented here in its entirety. The function _calc_area()
uses the polygon area formula mentioned previously.

    #!/usr/local/bin/perl
    
    use warnings;
    use strict;
    
    my ($file, $scale) = @ARGV;
    my %sails;
    
    die "No such file :$file" unless $file && -e $file;
    $scale ||= 100;
    
    open(FILE, $file)
        or die "Err: could not open file $file: $!\n";
    
    while (my $line = <FILE>) {
        next if $line =~ /^#/;
        next if $line =~ /^\s*$/;
    
        my ($sail_info, $coord) = split(/:/, $line);
        my ($sail_name, $verticie) = split(/\./, $sail_info);
        my ($x, $y) = split(/,/, $coord);
        $x =~ s/\s*//g;
        $y =~ s/\s*//g;
        push @{$sails{$sail_name}->{points}}, [$x, $y];
    }
    
    my $total = 0;
    foreach my $sail (keys %sails) {
        my $sail_area = _calc_area($sails{$sail}->{points}) *
                                   ($scale / 100);
        print "$sail.area: $sail_area cm^2\n";
        $total += $sail_area;
    }
    
    print "total.area: $total cm^2\n";
    
    close FILE;
    
    sub _calc_area
    {
        my ($p) = @_;
        my ($x, $y) = _conv_p_to_x_y($p);
        my $area;
    
        # from http://mathworld.wolfram.com/PolygonArea.html
        for (my $i=0; $i < (scalar @$x -1); $i++) {
            $area += ($x->[$i] * $y->[$i+1] - $x->[$i+1] * $y->[$i]);
        }
    
        my $last_x = pop @$x;
        my $last_y = pop @$y;
    
        $area += ($last_x * $y->[0] - $x->[0] * $last_y);
    
        return abs($area) / 2;
    }
    
    sub _conv_p_to_x_y
    {
        my ($p) = @_;
    
        my $x;
        my $y;
        
        foreach my $x_y (@$p) {
            push @$x, $x_y->[0];
            push @$y, $x_y->[1];
        }
        
        return ($x, $y);
    }
    __END__

My thanks to Mark Jason Dominus, both for setting up the Perl Quiz Of
the Week and for his patience and encouragement over this past week
and a half. Formulating and posing this quiz and writing this
follow-up has been an entirely new exercise for me, and I hope to do
it again in the future. In the mean time, I encourage others to send
their suggestions to [email protected] and share the fun!

Belden