Perl Weekly Challenge: Let’s do the Numbers!

This week’s theme is feuding in my head. On the musical side, “Number Game” made me think of Joni Mitchell, but the repeated use of the word “number” in the task titles made me think of Marketplace Radio (yes, I’m a Public Radio geek).

Anyway, let’s do Perl Weekly Challenge 268!

Task 1: Magic Number

You are given two arrays of integers of same size, @x and @y.

Write a script to find the magic number that when added to each elements of one of the array gives the second array. Elements order is not important.

Example 1

Input: @x = (3, 7, 5)
       @y = (9, 5, 7)
Output: 2

The magic number is 2.
@x = (3, 7, 5)
   +  2  2  2
@y = (5, 9, 7)

Example 2

Input: @x = (1, 2, 1)
       @y = (5, 4, 4)
Output: 3

The magic number is 3.
@x = (1, 2, 1)
   +  3  3  3
@y = (5, 4, 4)

Example 3

Input: @x = (2)
       @y = (5)
Output: 3

Approach

Element order may not be important in specifying the problem, but it feels pretty important in solving the problem. Since we’re looking for a number that, when added to each element of the first array yields an element of the second array, the obvious solution is to sort each array in either ascending or descending order, and then subtract the element in the first array from its corresponding element in the second array. As long as we get the same number each time, we’ve found the magic number. None of the examples show two input arrays that don’t yield a magic number, but nothing in the problem description precludes that.

Raku

sub magicNumber(@x, @y) {
  my @xS = @x.sort;
  my @yS = @y.sort;
  my $magic = @yS.shift - @xS.shift;
  while (@xS) {
    if (@yS.shift - @xS.shift != $magic) {
      return; # no magic number
    }
  }
  return $magic;
}
$ raku/ch-1.raku
Example 1:
Input: @x = (3, 7, 5)
       @y = (9, 5, 7)
Output: 2

The magic number is 2.
@x = (3, 7, 5)
   +  2  2  2
@y = (5, 9, 7)

Example 2:
Input: @x = (1, 2, 1)
       @y = (5, 4, 4)
Output: 3

The magic number is 3.
@x = (1, 2, 1)
   +  3  3  3
@y = (4, 5, 4)

Example 3:
Input: @x = (2)
       @y = (5)
Output: 3

The magic number is 3.
@x = (2)
   +  3
@y = (5)

Example 4:
Input: @x = (1, 2)
       @y = (4, 2)
Output: no magic number

View the entire Raku script for this task on GitHub.

Perl

sub magicNumber($x, $y) {
  my @xS = sort @$x;
  my @yS = sort @$y;
  my $magic = shift(@yS) - shift(@xS);
  while (@xS) {
    if (shift(@yS) - shift(@xS) != $magic) {
      return; # no magic number
    }
  }
  return $magic;
}

View the entire Perl script for this task on GitHub.

Python

def magicNumber(x, y):
    xS = sorted(x)
    yS = sorted(y)
    magic = yS.pop(0) - xS.pop(0)
    while xS:
        if yS.pop(0) - xS.pop(0) != magic:
            return None; # no magic number
    return magic

View the entire Python script for this task on GitHub.


Task 2: Number Game

You are given an array of integers, @ints, with even number of elements.

Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.

Example 1

Input: @ints = (2, 5, 3, 4)
Output: (3, 2, 5, 4)

Round 1: we picked (2, 3) and push it to the new array (3, 2)
Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)

Example 2

Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)

Example 3

Input: @ints = (1, 2, 2, 3)
Output: (2, 1, 3, 2)

Approach

This feels very much like the previous task: we need to sort the elements so we can pick the two smallest integers, we pull those values off the sorted array (only one array this time, however), and we do some kind of comparison. The big difference this time is we’re adding the elements back to a list.

Raku

The big thing to note here is that Raku’s Array push doesn’t flatten it’s argument list, so “If you pass an array or list as the thing to push, it becomes one additional element; multiple values are added to the array only if you supply them as separate arguments or in a slip.”

sub numberGame(@ints) {
  my @intSorted = @ints.sort;
  my @new;
  while (@intSorted) {
    my $x = @intSorted.shift;
    my $y = @intSorted.shift;
    if ($x > $y) {
      @new.push: ($x, $y).Slip;
    }
    else {
      @new.push: ($y, $x).Slip;
    }
  }
  return @new;
}
$ raku/ch-2.raku
Example 1:
Input: @ints = (2, 5, 3, 4)
Output: (3, 2, 5, 4)

Example 2:
Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)

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

View the entire Raku script for this task on GitHub.

Perl

sub numberGame(@ints) {
  my @intSorted = sort @ints;
  my @new;
  while (@intSorted) {
    my $x = shift @intSorted;
    my $y = shift @intSorted;
    if ($x > $y) {
      push @new, $x, $y;
    }
    else {
      push @new, $y, $x;
    }
  }
  return @new;
}

View the entire Perl script for this task on GitHub.

Python

def numberGame(ints):
    intSorted = sorted(ints)
    new = []
    while intSorted:
        x = intSorted.pop(0)
        y = intSorted.pop(0)
        if x > y:
            new.extend([x, y])
        else:
            new.extend([y, x])
    return new

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-268/packy-anderson

Perl Weekly Challenge: Now with Elixir!

One of the things I want to challenge myself to do is learn some more useful things, and one of the languages they’re using at work is Elixir. It’s a functional language, not a procedural language like Perl, so this is not only learning a new language but it’s learning a new way to think about code.

Since I can’t really learn by just reading about a language or watching a bunch of excellent videos one of my coworkers produced, I decided that I needed to start doing the Perl Weekly Challenge tasks in Elixir. Today, I’m tackling PWC 267 Task 1.

Continue reading

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