Perl Weekly Challenge: It’s the Product Line Sign that Counts

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

Approach

Really, this is just doing a list multiplication operator on the list, and then comparing the result to zero.

Raku

As soon as I saw the task, I knew this was going to be Raku’s Reduction Metaoperator with multiplication([*]). Also, if the product isn’t 0, I can get the desired sign by just dividing the product by its absolute value. I’m spending more lines of code formatting the explanatory text than I am calculating the result.

sub productSign(@ints) {
  my $product = [*] @ints;
  my $sign = $product == 0 ?? 0
          !! $product/abs($product);
  my $explain = 'The product ' ~ @ints.join(' × ')
              ~ " => $product";
  if ($sign < 0) {
    $explain ~= " < 0";
  }
  elsif ($sign > 0) {
    $explain ~= " > 0";
  }
  return ($sign, $explain);
}
$ raku/ch-1.raku
Example 1:
Input: @arr = (-1, -2, -3, -4, 3, 2, 1)
Output: 1

The product -1 × -2 × -3 × -4 × 3 × 2 × 1 => 144 > 0

Example 2:
Input: @arr = (1, 2, 0, -2, -1)
Output: 0

The product 1 × 2 × 0 × -2 × -1 => 0

Example 3:
Input: @arr = (-1, -1, 1, -1, 2)
Output: -1

The product -1 × -1 × 1 × -1 × 2 => -2 < 0

View the entire Raku script for this task on GitHub.

Perl

Since Perl doesn’t have a reduction metaoperator built in, we just pull in the reduce function from List::Util.

use List::Util qw( reduce );

sub productSign(@ints) {
  my $product = reduce { $a * $b } @ints;
  my $sign = $product == 0 ? 0
          : $product/abs($product);
  my $explain = 'The product ' . join(' × ', @ints)
              . " => $product";
  if ($sign < 0) {
    $explain .= " < 0";
  }
  elsif ($sign > 0) {
    $explain .= " > 0";
  }
  return ($sign, $explain);
}

View the entire Perl script for this task on GitHub.

Python

Similarly, in Python we’s use the reduce function from functools.

def productSign(ints):
  product = reduce(lambda a, b: a * b, ints)
  sign = 0 if product == 0 else int(product / abs(product))

  explain = (
    'The product ' + ' × '.join(map(lambda i: str(i), ints))
    + ' => ' + str(product)
  )
  if (sign < 0): explain += " < 0"
  if (sign > 0): explain += " > 0"

  return (sign, explain)

View the entire Python script for this task on GitHub.


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

Approach

One of the things I’ve started to notice about the challenge is that the tasks are related. They’re usually the same kind of operation, applied to numbers in one task and strings in the other. This task really feels like it could be a list reduction of some sort. Let’s look at how a reduction works…

A reduction operation takes some two-argument function and passes it the first two elements of a list, and then takes the result and the next element and passes that to the function, and so on until the list is exhausted.

In our case, the function would accept a line and a character, and it would check to see how many pixels adding the character would make the line. If it would be <= 100 pixels, the character is added to the line. If it would be > 100 pixels, the existing line is flushed to output along with its length, and a new line is started with the character and its width.

Raku

For Raku, I’m building the hash of widths with the Zip metaoperator. However, it produces a list that looks like [(a 4) (b 10) (c 10) (d 10) .. , so to turn it into a Hash, I want to flatten it.

sub lineCounts($str, @widths) {
  my ($lines, $last_line, $last_width, $explain) =
    (0, '', 0, '');
  my %width = ('a' .. 'z' Z @widths).flat.Hash;
  for $str.comb -> $c {
      if ($last_width + %width{$c} > 100) {
        $lines++;
        $explain ~= "\nLine $lines: $last_line "
                 ~  "($last_width pixels)";
        ($last_line, $last_width) = ($c, %width{$c});
      }
      else {
        $last_line  ~= $c;
        $last_width += %width{$c};
      }
  }
  $lines++;
  $explain ~= "\nLine $lines: $last_line "
           ~  "($last_width pixels)";
  return ($lines, $last_width, $explain);
}
$ raku/ch-2.raku
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)

Example 3:
Input: $str = "thequickbrownfoxjumpedoverthelazydog"
       @widths = (7, 8, 7, 8, 7, 5, 8, 8, 4, 4, 8, 4, 12, 8, 8, 8, 8, 5, 6, 4, 8, 8, 12, 8, 8, 7)
Output: (3, 65)
Line 1: thequickbrownf (100 pixels)
Line 2: oxjumpedovert (95 pixels)
Line 3: helazydog (65 pixels)

View the entire Raku script for this task on GitHub.

Perl

In Perl, rather that use List::Util‘s zip, we’re going to use mesh, because it produces a flattened list by default, where zip returns a list of array references.

use List::Util qw( mesh );

sub lineCounts($str, @widths) {
  my ($lines, $last_line, $last_width, $explain) =
    (0, '', 0, '');
  my %width = mesh ['a' .. 'z'], \@widths;
  foreach my $c ( split //, $str ) {
      if ($last_width + $width{$c} > 100) {
        $lines++;
        $explain .= "\nLine $lines: $last_line "
                 .  "($last_width pixels)";
        ($last_line, $last_width) = ($c, $width{$c});
      }
      else {
        $last_line  .= $c;
        $last_width += $width{$c};
      }
  }
  $lines++;
  $explain .= "\nLine $lines: $last_line "
           .  "($last_width pixels)";
  return ($lines, $last_width, $explain);
}

View the entire Perl script for this task on GitHub.

Python

In Python, however, zip is built in, and can be passed to dict to build a dictionary.

def lineCounts(strvar, widths):
    (lines, last_line, last_width, explain) = (0, '', 0, '')
    # we can't do a range of characters, but we can do a range
    # of the ASCII values of the characters
    letters = [ chr(c) for c in range(ord('a'), ord('z')+1) ]
    width = dict( zip(letters, widths) )
    for c in strvar:
        if last_width + width[c] > 100:
            lines += 1
            explain += f"\nLine {lines}: {last_line} "
            explain += f"({last_width} pixels)"
            (last_line, last_width) = (c, width[c])
        else:
            last_line  += c
            last_width += width[c]
    lines += 1
    explain += f"\nLine {lines}: {last_line} "
    explain += f"({last_width} pixels)"
    return (lines, last_width, explain)

View the entire Python script for this task on GitHub.


Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-267/packy-anderson