site.base_url }}/">The Bear's Den -->

The Bear's Den

Enter at your own risk

Lines and Signs

Task 1: Product Sign

Submitted by: Mohammad Sajid Anwar

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 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


There are some subtleties in this task:

Though this looks like a typical use case for reduce, we need to trick it into short-circuit to take advantage of these special circumstances.

use strict;
use warnings;
use List::Util 'reduce';

sub product_sign {
    eval {reduce {($b || die) < 0 ? -$a : $a} 1, @_} || 0;

If there is no zero in the list, then reduce either returns minus one or plus one, which is passed thought by eval. This is a true Boolean value that gives the final result. OTOH, if there is a zero in the list, the reduce block will die, leading to a false return value from eval that is safely transformed into a zero.

See the full solution to task 1.

Task 2: Line Counts

Submitted by: Mohammad Sajid Anwar

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 out 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,
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,
Output: (2, 4)

Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)


As @width has 26 elements, we have to make sure only lower case letters are processed from $str. This may be achieved easily with a global match using /[a-z]/g.

Furthermore, the characters 'a' to 'z' are not contiguous in some encoding schemata, particularly EBCDIC. Therefore we must not use ord($c) - ord('a') as an index for @widths.

Finally considering the edge case where $str is empty: $lines and $width should both be zero. To handle this case smoothly, we separate the line wrap and the line count’s increment by different conditions: If the next character would overflow the current line, we reset the width to zero. And we increment the line count, whenever we put a character into an empty line.

use strict;
use warnings;
use feature qw(state postderef);
use experimental 'signatures';

sub line_counts ($str, $widths, $limit) {
    my ($lines, $width) = (0, 0);
    state $letters;
    $letters->@{'a' .. 'z'} = (0 .. 25) unless $letters;
    for my $c ($str =~ /[a-z]/g) {
        my $len = $widths->[$letters->{$c}];
        if ($width + $len > $limit) {
            $width = 0;
        $lines++ unless $width;
        $width += $len;

    ($lines, $width);

See the full solution to task 2.

If you have a question about this post or if you like to comment on it, feel free to open an issue in my github repository.