PWC 267 Positively Perl Street

Positively 4th Street lyrics

I've just returned from two weeks of traveling from Lisbon through the south of Spain to Barcelona. It's a beautiful country. I wish that for just one time you could stand inside my shoes. The trip was a bit too rushed (Lisbon: check; Cordoba: check; Grenada: check, Seville: check, ...). I could happily return to any of them for a week.

But the best part is coming home to a backlog of Weekly Challenges!

Task 1: Product Sign

You are given an array of @ints. Write a script
to find the sign of product of all integers in
the given array. The sign is 1 if the product
is positive, -1 if the product is negative and
0 if the product is zero.

Example 1

• Input: @ints = (-1, -2, -3, -4, 3, 2, 1)
• Output: 1
• The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0

Example 2

• Input: @ints = (1, 2, 0, -2, -1)
• Output: 0
• The product 1 x 2 x 0 x -2 x -1 => 0

Example 3

• Input: @ints = (-1, -1, 1, -1, 2)
• Output: -1
• The product -1 x -1 x 1 x -1 x 2 => -2 < 0

You got a lotta choices

Simple problem, but there several ways to approach it. We could do as the examples suggest and multiply it out. No, I do not feel that good when I see the integer overflow that could occur.

Because math, we know that it will be zero if any number in the list is zero, and it will be negative if there are an odd number of negative elements in the list. We could walk over the list, counting negatives and bailing out if we find a zero.

But I just want to be on the side that's winning, and there's Perl, offering up the tri-valued <=> operator. Comparing a number to 0 will hand us -1, 0, or 1 -- just what we need.

sub prodSign(@ints)
{
    my $sign = 1;
    while ( $sign && defined(my $n = shift @ints) )
    {
        $sign *= ($n <=> 0);
    }
    return $sign;
}

The while loop is a cute Perl idiom for traversing a list. We eat up the first element in each iteration; it will eventually return undef when nothing is left.

The first condition of the while loop ($sign) will end the loop if the product becomes zero -- a possible optimization. You say you lost your faith that there would be premature optimization? You had no faith to lose, and you know it.

Task 2: Line Counts

You are given a string, $str, and a 26-items
array @widths containing the width of each
character from a to z. Write a script to find
the number of lines and the width of the last
line needed to display the given string, assuming
you can only fit 100 width units on a line.

Example 1

• Input:
  • $str = "abcdefghijklmnopqrstuvwxyz"
  • @widths = (10,10,10,10,10,10,10,10,10,10,10,10,10, 10,10,10,10,10,10,10,10,10,10,10,10,10)
• Output: (3, 60)
• Line 1: abcdefghij (100 pixels)
• Line 2: klmnopqrst (100 pixels)
• Line 3: uvwxyz (60 pixels)

Example 2

• Input:
  • $str = "bbbcccdddaaa"
  • @widths = (4,10,10,10,10,10,10,10,10,10,10,10,10, 10,10,10,10,10,10,10,10,10,10,10,10,10)
• Output: (2, 4)
• Line 1: bbbcccdddaa (98 pixels)
• Line 2: a (4 pixels)

Break it up

Some of these characters are going to have to move to other lines. And now I know you're dissatisfied with your position and your place, but don't you understand that's not my problem? The only problem is to figure out how long the last line is.

We don't even care what the lines actually contain. We can just replace every character with its width, and find groups of 100 or less until we're done.

So let's Perl it up. First, some minimal data integrity. Let's make sure our string really only contains valid characters by converting to lowercase, and deleting any characters that aren't 'a' through 'z'.

    $str = lc $str;
    $str =~ s/[^a-z]//g;

Then, we have a couple of things that are constants: the line width of 100, and the beginning of the alphabet.

use constant { MAXLINE => 100,
               ORD_A   =>  ord('a')
           };

We're taking the easy way out here, assuming ASCII characters. The ord function gives us the numeric value of a character (although everybody knows that 'a' is 0x61 —- highway 61 revisited?), which will give us offsets into the @widths table. We could be a little more robust by turning the @widths table into a hash lookup for a through z, but not today. You say I let you down; you know it's not like that. You know as well as me you'd rather see it optimized.

To replace the characters with their widths, we'll split the string into individual characters and replace them with a width from the @widths array.

my @cw = map { $widths[ ord($_) - ORD_A ] } split(//, $str);

Now we consume that list of widths, starting a new line every time we reach 100.

    my $lineCount = 1;
    my $width = 0;
    while ( defined(my $w = shift @cw) )
    {
        if ( $width + $w <= MAXLINE )
        {
            $width += $w;
        }
        else
        {
            $width = $w;
            $lineCount++;
        }
    }
    return [ $lineCount, $width ];

Comments

[Barbe Vivien]

Great thinking! Thanks!