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

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

Task 1: Uncommon Words

You are given two sentences, $line1 and $line2.

Write a script to find all uncommon words in any order in the given two sentences. Return ('') if none found.

A word is uncommon if it appears exactly once in one of the sentences and doesn’t appear in other sentence.

Example 1

Input: $line1 = 'Mango is sweet'
       $line2 = 'Mango is sour'
Output: ('sweet', 'sour')

Example 2

Input: $line1 = 'Mango Mango'
       $line2 = 'Orange'
Output: ('Orange')

Example 3

Input: $line1 = 'Mango is Mango'
       $line2 = 'Orange is Orange'
Output: ('')

Approach

The straightforward way to do this is to count up the occurrences of words in each line and return a list of those that occur only once, and then run the same operation on the union of those two lists.

Raku

Once again, I drew inspiration this week from reading laurent_r’s solution to one of last week’s tasks. He used a Raku type called a Bag, which is ❝a collection of distinct elements in no particular order that each have an integer weight assigned to them signifying how many copies of that element are considered “in the bag”.❞ Really, it got me reading up on Sets, Bags, and Mixes in Raku.

sub occursOnce($line) {
  # create a Bag of all words
  my $all = $line.comb(/\w+/).Bag;
  # create a list of words that occur once in the Bag
  return $all.keys.grep({ $all{$_} == 1 });
}

sub uncommonWords($line1, $line2) {
  # create a Bag of words that occur once in each line
  my $all = occursOnce($line1).Bag ⊎ occursOnce($line2).Bag;
  # return a list of words that occur once in that Bag
  return $all.keys.grep({ $all{$_} == 1 });
}

$ raku/ch-1.raku
Example 1:
Input: $line1 = 'Mango is sweet'
       $line2 = 'Mango is sour'
Output: ('sour', 'sweet')

Example 2:
Input: $line1 = 'Mango Mango'
       $line2 = 'Orange'
Output: ('Orange')

Example 3:
Input: $line1 = 'Mango is Mango'
       $line2 = 'Orange is Orange'
Output: ('')

View the entire Raku script for this task on GitHub.

Perl

Perl doesn’t have Bags, but it does have a Hash, and we can use that just like a Bag with a little more work. I also realized that I could just join the list of words that occurred once into a new line and reuse the occursOnce() function again to find the words that only appear in one or the other line, not both. I didn’t go back and change my Raku implementation, though, mostly because I like using the unicode ⊎ operator.

sub occursOnce($line) {
  # create a hash counting the words
  my %all;
  $all{$_}++ for split(/\s+/, $line);
  # create a list of words that occur once in the hash
  return grep { $all{$_} == 1 } keys %all;
}

sub uncommonWords($line1, $line2) {
  return occursOnce(
    join(' ', occursOnce($line1), occursOnce($line2))
  );
}

View the entire Perl script for this task on GitHub.

Python

Then, reading the documentation for the Counter type in the collections module, I noticed that if you passed a list to the instantiator, it initializes the Counter using that list, much like Raku’s Bag.

from collections import Counter

def occursOnce(line):
  # create a Counter of all words
  all = Counter(line.split())
  # create a list of words that occur once in the Counter
  return [ word for word in list(all) if all[word] == 1 ]

def uncommonWords(line1, line2):
  return occursOnce(
     ' '.join(occursOnce(line1) + occursOnce(line2))
  )

View the entire Python script for this task on GitHub.

Task 2: X Matrix

You are given a square matrix, $matrix.

Write a script to find if the given matrix is X Matrix.

A square matrix is an X Matrix if all the elements on the main diagonal and antidiagonal are non-zero and everything else are zero.

Example 1

Input: $matrix = [ [1, 0, 0, 2],
                   [0, 3, 4, 0],
                   [0, 5, 6, 0],
                   [7, 0, 0, 1],
                 ]
Output: true

Example 2

Input: $matrix = [ [1, 2, 3],
                   [4, 5, 6],
                   [7, 8, 9],
                 ]
Output: false

Example 3

Input: $matrix = [ [1, 0, 2],
                   [0, 3, 0],
                   [4, 0, 5],
                 ]
Output: true

Approach

This one is basically going through arrays and examining values. The hardest part of this problem is figuring out which elements are on the diagonals. If we have a 1×1 matrix or a 2×2 matrix, every element is on a diagonal. For a 3×3 matrix, the diagonals are elements 0 and 2 on rows 0 and 2, and element 1 on row 1. For a 4×4 matrix, the diagonals are elements 0 and 3 on rows 0 and 3, and elements 1 and 2 on rows 1 and 2.

So, for an NxN matrix, diagonal elements are 0 and N-1 for rows 0 and N-1, 1 and N-2 for rows 1 and N-2, 2 and N-3 for rows 2 and N-3 and so on until the counts overlap.

We can come up with a function to determine if an element in a matrix is on a diagonal:

isDiagonal(x, y, N):
  return true if N == 1 or N == 2
  return true if x == y
  return true if x + y == N - 1
  return false

Raku

One of the great things about Raku is you can call kv on a List, and you’ll get back an interleaved sequence of indexes and values.

sub isDiagonal($x, $y, $N) {
  return (
    $N == 1 || $N == 2 || $x == $y || $x + $y == $N - 1
  );
}

sub isXMatrix(@matrix) {
  my $N = @matrix.elems;
  for @matrix.kv -> $y, @row {
    for @row.kv -> $x, $value {
      # fail if diagonal values are zero or 
      # non-diagonal values are non-zero
      return False
        unless isDiagonal($x, $y, $N) == ($value != 0);
    }
  }
  return True;
}

$ raku/ch-2.raku
Example 1:
Input: $matrix = [
                   [1, 0, 0, 2],
                   [0, 3, 4, 0],
                   [0, 5, 6, 0],
                   [7, 0, 0, 1]
                 ]
Output: True

Example 2:
Input: $matrix = [
                   [1, 2, 3],
                   [4, 5, 6],
                   [7, 8, 9]
                 ]
Output: False

Example 3:
Input: $matrix = [
                   [1, 0, 2],
                   [0, 3, 0],
                   [4, 0, 5]
                 ]
Output: True

Example 4:
Input: $matrix = [
                   [1, 0, 0, 0, 1],
                   [0, 1, 0, 1, 0],
                   [0, 0, 1, 0, 0],
                   [0, 1, 0, 1, 0],
                   [1, 0, 0, 0, 1]
                 ]
Output: True

Example 5:
Input: $matrix = [
                   [1, 0, 1, 0, 1],
                   [0, 1, 0, 1, 0],
                   [0, 0, 1, 0, 0],
                   [0, 1, 0, 1, 0],
                   [1, 0, 0, 0, 1]
                 ]
Output: False

Example 6:
Input: $matrix = [
                   [1, 1],
                   [1, 1]
                 ]
Output: True

Example 7:
Input: $matrix = [
                   [1, 0],
                   [1, 1]
                 ]
Output: False

View the entire Raku script for this task on GitHub.

Perl

For Perl, all we have to do is change the syntax of the for loops to loop over indices, and extract the values manually.

sub isDiagonal($x, $y, $N) {
  return (
    $N == 1 || $N == 2 || $x == $y || $x + $y == $N - 1
  );
}

sub isXMatrix(@matrix) {
  my $N = scalar @matrix;
  foreach my $y ( 0 .. $#matrix ) {
    my @row = @{$matrix[$y]};
    foreach my $x ( 0 .. $#row ) {
      my $value = $row[$x];
      # fail if diagonal values are zero or 
      # non-diagonal values are non-zero
      return 0
        unless isDiagonal($x, $y, $N) == ($value != 0);
    }
  }
  return 1;
}

View the entire Perl script for this task on GitHub.

Python

Python’s enumerate function, however, works like Raku’s kv.

def isDiagonal(x, y, N):
  return (
    N == 1 or N == 2 or x == y or x + y == N - 1
  )

def isXMatrix(matrix):
  N = len(matrix)
  for y, row in enumerate(matrix):
    for x, value in enumerate(row):
      # fail if diagonal values are zero or 
      # non-diagonal values are non-zero
      if isDiagonal(x, y, N) != (value != 0):
        return False
  return True

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

Tonight’s musical accompaniment was Billy Joel: The 100th – Live at Madison Square Garden. Without being interrupted in the middle of Piano Man.

So, let’s hope we don’t break away to out local affiliate before the end of this week’s Perl Weekly Challenge!

Task 1: 33% Appearance

You are given an array of integers, @ints.

Write a script to find an integer in the given array that appeared 33% or more. If more than one found, return the smallest. If none found then return undef.

Example 1

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

1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.

3 appeared 50% (>33%) in the given array.

Example 2

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

1 appeared 2 times.

1 appeared 100% (>33%) in the given array.

Example 3

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

1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.

Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.

Approach

Ok, we’re counting how many times individual integers appear in an array. That sounds like a hash to me. Make a pass through the array, counting the occurrences of each integer, and when we’re done we divide by the number of elements in the array to get percentages. We could then use something like min to find the smallest.

BUT… we know before we loop through the array how many times an integer will have to appear to meet the threshold. We’re not looking for the integer that occurred the most times, only for the smallest one that occurred at least 1/3 of the time. So we pre-calculate the 1/3 value, and as we’re counting, if the count for an integer is greater than the 1/3 value and smaller than the last integer whose count was greater than the 1/3 value, we save it as the output value.

Raku

sub oneThirdAppearance(@ints) {
  my Int $smallest;
  my Rat $oneThird = @ints.elems / 3;
  my Int %seen;
  for @ints -> $i {
    if (++%seen{$i} >= $oneThird) {
      if (! $smallest.defined || $i < $smallest) {
        $smallest = $i;
      }
    }
  }
  return $smallest;
}

$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 2, 3, 3, 3, 3, 4, 2)
Output: 3

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

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

View the entire Raku script for this task on GitHub.

Perl

Because an array evaluated in a scalar context returns the size of the array, all we need to determine the oneThird threshold is to fivide the array by 3:

sub oneThirdAppearance(@ints) {
  my $smallest;
  my $oneThird = @ints / 3;
  my %seen;
  foreach my $i ( @ints ) {
    if (++$seen{$i} >= $oneThird) {
      if (! defined($smallest) || $i < $smallest) {
        $smallest = $i;
      }
    }
  }
  return $smallest;
}

View the entire Perl script for this task on GitHub.

Python

As always, when I’m counting things in Python, I use the Counter type in the collections module.

from collections import Counter

def oneThirdAppearance(ints):
  smallest = None
  oneThird = len(ints) / 3
  seen = Counter()
  for i in ints:
    seen[i] += 1
    if seen[i] >= oneThird:
      if smallest is None or i < smallest:
        smallest = i
  return smallest

View the entire Python script for this task on GitHub.

Task 2: Completing Word

You are given a string, $str, containing alphanumeric characters and an array of strings (alphabetic characters only), @str.

Write a script to find the shortest completing word. If none found return empty string.

A completing word is a word that contains all the letters in the given string, ignoring space and number. If a letter appeared more than once in the given string then it must appear the same number or more in the word.

Example 1

Input: $str = 'aBc 11c'
       @str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'

The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times

The only string in the given array that satisfies the condition is 'accbbb'.

Example 2

Input: $str = 'Da2 abc'
       @str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'

The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times

The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.

Shortest of the two is 'baacd'

Example 3

Input: $str = 'JB 007'
       @str = ('jj', 'bb', 'bjb')
Output: 'bjb'

The given string contains following, ignoring case and number:
j 1 times
b 1 times

The only string in the given array that satisfies the condition is 'bjb'.

Approach

I’m sure there’s a clever way to accomplish this, but I’m just going to plow through a straightforward way. Counting the letters again seems like a job for a hash, and we’re going to have to generate this hash not only for $str but for each string in @str, so it seems useful to make a function for generating the hash. Then we compare the hash generated by $str against the hashes for each of the strings in @str: if there’s any letters missing, or if a letter in the string doesn’t occur at least as many times it does in the target, the string is disqualified. Finally, we only keep the shortest string that met the criteria.

Raku

Last week, reading laurent_r’s solutions for PWC 264’s task 1, I saw a couple of things what I wanted to take note of: rather than using .split('', :skip-empty) to split a string into a list of characters, he used .comb. Also, he used grep with a lower case character class to filter out just the lower case characters in the input. If we pass $str.lc.comb into the grep, we’ll just get back just the letters, regardless of case.

sub letterCounts($str) {
  my %counts;
  map { %counts{$_}++ }, (grep { / <lower> / }, $str.lc.comb);
  return %counts;
}

sub completingWord($str, @str) {
  my %target = letterCounts($str);
  my $shortest;
  CANDIDATE: for @str -> $s {
    my %candidate = letterCounts($s);
    for %target.kv -> $c, $i {
      next CANDIDATE # skip this candidate
        unless %candidate{$c}:exists # this letter exists
            && %candidate{$c} >= $i; # at least as many times
    }
    if (! $shortest.defined || $s.chars < $shortest.chars) {
      $shortest = $s;
    }
  }
  return $shortest // q{};
}

$ raku/ch-2.raku
Example 1:
Input: $str = 'aBc 11c'
       @str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'

Example 2:
Input: $str = 'Da2 abc'
       @str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'

Example 3:
Input: $str = 'JB 007'
       @str = ('jj', 'bb', 'bjb')
Output: 'bjb'

View the entire Raku script for this task on GitHub.

Perl

My first instinct was to use each %target in Perl the same way I used %target.kv, but when I tried, I discovered that I’d forgotten a big caveat of each:

The iterator used by each is attached to the hash or array, and is shared between all iteration operations applied to the same hash or array. Thus all uses of each on a single hash or array advance the same iterator location. All uses of each are also subject to having the iterator reset by any use of keys or values on the same hash or array, or by the hash (but not array) being referenced in list context. This makes each-based loops quite fragile: it is easy to arrive at such a loop with the iterator already part way through the object, or to accidentally clobber the iterator state during execution of the loop body. It’s easy enough to explicitly reset the iterator before starting a loop, but there is no way to insulate the iterator state used by a loop from the iterator state used by anything else that might execute during the loop body. To avoid these problems, use a foreach loop rather than while–each.

When I had while ( my($c, $i) = each %target ), it would only loop through %target once, and for subsequent candidates it would skip the loop entirely.

sub letterCounts($str) {
  my %counts;
  map { $counts{$_}++ } grep { /[a-z]/ } split //, lc($str);
  return %counts;
}

sub completingWord($str, @str) {
  my %target = letterCounts($str);
  my $shortest;
  CANDIDATE: foreach my $s ( @str ) {
    my %candidate = letterCounts($s);
    foreach my $c ( keys %target ) {
      my $i = $target{$c};
      next CANDIDATE # skip this candidate
        unless exists $candidate{$c} # this letter exists
            && $candidate{$c} >= $i; # at least as many times
    }
    if (! defined($shortest) || length($s) < length($shortest)) {
      $shortest = $s;
    }
  }
  return $shortest // q{};
}

View the entire Perl script for this task on GitHub.

Python

In Python, we can make the string all lowercase with lower() and filter for just letters by using isalpha(). Because we can’t break out to an outer loop from inside an inner loop, I’m using an isCandidate boolean flag to track whether a candidate is still valid to be considered the shortest candidate.

from collections import Counter

def letterCounts(strVal):
  counts = Counter()
  for c in strVal.lower():
    if c.isalpha():
      counts[c] += 1
  return counts

def completingWord(targetStr, candidateStrs):
  targetCounts = letterCounts(targetStr)
  shortest = None
  for s in candidateStrs:
    candidateCounts = letterCounts(s)
    isCandidate = True
    for c, i in targetCounts.items():
      #    this letter does not exist
      if ( not c in candidateCounts
           or # occurs fewer times
           candidateCounts[c] < i): 
         isCandidate = False
    if (isCandidate and 
        (shortest is None or len(s) < len(shortest))):
      shortest = s
  return shortest

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

Task 1: Greatest English Letter

You are given a string, $str, made up of only alphabetic characters [a..zA..Z].

Write a script to return the greatest english letter in the given string.

A letter is greatest if it occurs as lower and upper case. Also letter ‘b’ is greater than ‘a’ if ‘b’ appears after ‘a’ in the English alphabet.

Example 1

Input: $str = 'PeRlwEeKLy'
Output: L

There are two letters E and L that appears as lower and upper.
The letter L appears after E, so the L is the greatest english letter.

Example 2

Input: $str = 'ChaLlenge'
Output: L

Example 3

Input: $str = 'The'
Output: ''

Approach

I saw this and I figured that I could accomplish this with a single pass through the string by maintaining a hash of the characters we’d seen already, and if we’d already seen the swapped case version of the character, we could add it to a list of “greatest” characters. Once we’d gone through the string, we could just use a max function to get the greatest character in that last and return it.

Raku

I already knew how to do this in Perl—using the tr operator—and I figured there would be a corresponding way to do it in Raku. Sure enough, the Str class has a trans method. In addition, the max method on the Any class doesn’t care what type the elements are because it uses the smart cmp operator semantics to find the largest element in the List.

sub greatestEnglishLetter($str) {
  my %seen;
  my @greatest;

  # find the characters that exist as both
  # upper and lower case in the string
  for $str.split('', :skip-empty) -> $c {

    # note that we've seen the character
    %seen{$c} = 1;

    # swap the case of the character
    my $C = $c.trans(
      ['a' .. 'z', 'A' .. 'Z'] => ['A' .. 'Z', 'a' .. 'z']
    );

    # if we've seen the swapped case version of the char,
    # add the uppercase version to our greatest hits
    @greatest.push: $c.uc if %seen{$C}:exists;
  }

  # if we found greatest characters,
  # return the greater of them
  if (@greatest) {
    return @greatest.max;
  }
  # otherwise, return something that
  # represents an empty result
  return q{''};

$ raku/ch-1.raku
Example 1:
Input: $str = 'PeRlwEeKLy'
Output: L

Example 2:
Input: $str = 'ChaLlenge'
Output: L

Example 3:
Input: $str = 'The'
Output: ''

View the entire Raku script for this task on GitHub.

Perl

The Perl version is a little more compact. We do need to pull in the maxstr function from List::Util, however. Note that I’m using the non-destructive /r option on the tr operator.

use List::Util qw( maxstr );

sub greatestEnglishLetter($str) {
  my %seen;
  my @greatest;

  # find the characters that exist as both
  # upper and lower case in the string
  foreach my $c ( split //, $str ) {

    # note that we've seen the character
    $seen{$c} = 1;

    # swap the case of the character
    my $C = ($c =~ tr/a-zA-Z/A-Za-z/r);

    # if we've seen the swapped case version of the char,
    # add the uppercase version to our greatest hits
    push @greatest, uc($c) if exists $seen{$C};
  }

  # if we found greatest characters,
  # return the greater of them
  if (@greatest) {
    return maxstr(@greatest);
  }
  # otherwise, return something that
  # represents an empty result
  return q{''};
}

View the entire Perl script for this task on GitHub.

Python

Because Python loves to borrow all of Perl’s useful functionality, I knew there had to be a tr equivalent somewhere… and I found it in the translate method on the Str type. There’s even a static maketrans method on the Str type that allows you to create a translation table you can pass into translate. The syntax isn’t as concise as Perl’s (or Raku’s, for that matter), but it wasn’t too bad.

# make a translation table to switch the case of
# English letters
transTable = str.maketrans(
  'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
)

def greatestEnglishLetter(strVar):
  seen = {}
  greatest = []

  # find the characters that exist as both
  # upper and lower case in the string
  for c in strVar:

    # note that we've seen the character
    seen[c] = 1

    # swap the case of the character
    C = c.translate(transTable)

    # if we've seen the swapped case version of the char,
    # add the uppercase version to our greatest hits
    if C in seen:
        greatest.append(c.upper())

  # if we found greatest characters,
  # return the greater of them
  if greatest:
    return max(greatest)

  # otherwise, return something that
  # represents an empty result
  return "''"

View the entire Python script for this task on GitHub.

Task 2: Target Array

You are given two arrays of integers, @source and @indices. The @indices can only contains integers 0 <= i < size of @source.

Write a script to create target array by insert at index $indices[i] the value $source[i].

Example 1

Input: @source  = (0, 1, 2, 3, 4)
       @indices = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)

@source  @indices  @target
0        0         (0)
1        1         (0, 1)
2        2         (0, 1, 2)
3        2         (0, 1, 3, 2)
4        1         (0, 4, 1, 3, 2)

Example 2

Input: @source  = (1, 2, 3, 4, 0)
       @indices = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)

@source  @indices  @target
1        0         (1)
2        1         (1, 2)
3        2         (1, 2, 3)
4        3         (1, 2, 3, 4)
0        0         (0, 1, 2, 3, 4)

Example 3

Input: @source  = (1)
       @indices = (0)
Output: (1)

Approach

This is just a single loop through the @indices list to build the @target list. The “trickiest” part is inserting into the @target list at arbitrary locations, not just the beginning or the end.

Raku

Fortunately, in Raku there’s an Array routine for that: splice. It’s supposed to replace elements in an array, but if you specify a zero length for the replacement, it winds up just inserting elements without removing any.

sub targetArray(@source, @indices) {
  my @target;
  my @explain;

  for 0..@indices.end -> $i {
    @target.splice(@indices[$i], 0, @source[$i]);
    @explain.push: [
      @source[$i], @indices[$i], @target.clone
    ];
  }
  return @target, @explain;
}

$ raku/ch-2.raku
Example 1:
Input: @source   = (0, 1, 2, 3, 4)
       @indicies = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)

@source @indices @target
0       0        (0)
1       1        (0, 1)
2       2        (0, 1, 2)
3       2        (0, 1, 3, 2)
4       1        (0, 4, 1, 3, 2)

Example 2:
Input: @source   = (1, 2, 3, 4, 0)
       @indicies = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)

@source @indices @target
1       0        (1)
2       1        (1, 2)
3       2        (1, 2, 3)
4       3        (1, 2, 3, 4)
0       0        (0, 1, 2, 3, 4)

Example 3:
Input: @source   = (1)
       @indicies = (0)
Output: (1)

@source @indices @target
1       0        (1)

View the entire Raku script for this task on GitHub.

Perl

For Perl the biggest change is passing around array references rather than arrays.

sub targetArray($source, $indices) {
  my @target;
  my @explain;

  foreach my $i ( 0 .. $#{$indices}) {
    splice(@target, $indices->[$i], 0, $source->[$i]);
    push @explain, [
      $source->[$i], $indices->[$i], [ @target ]
    ];
  }
  return \@target, \@explain;
}

View the entire Perl script for this task on GitHub.

Python

In Python, the method for inserting elements into lists at arbitrary locations is named, appropriately enough, insert.

def targetArray(source, indices):
  target = []
  explain = []

  for i in range(len(indices)):
    target.insert(indices[i], source[i])
    explain.append([
      source[i], indices[i], target.copy()
    ])
  return target, 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-264/packy-anderson

Task 1: Target Index

You are given an array of integers, @ints and a target element $k.

Write a script to return the list of indices in the sorted array where the element is same as the given target element.

Example 1

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

Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (1, 2) as $ints[1] = 2 and $ints[2] = 2

Example 2

Input: @ints = (1, 2, 4, 3, 5), $k = 6
Output: ()

No element in the given array matching the given target.

Example 3

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

Sorted array: (1, 2, 2, 3, 4, 5)
Target index: (4) as $ints[4] = 4

Approach

The approach here is pretty straightforward: sort the list, then scan for entries where the value matches the target. There’s probably a clever way to do it, but it’s not coming to me, and I’ve always stressed ease of implementation and comprehension over cleverness in my solutions.

Raku

In Raku, we can use the kv routine on lists to loop over the sorted list of ints and have both the index and the value at that index.

sub targetIndex($k, @ints) {
  my @sorted = @ints.sort;
  my $explain = 'Sorted array: (' ~ @sorted.join(', ') ~ ")\n";

  my @output;
  for @sorted.kv -> $i, $v {
    next unless $v == $k;
    @output.push($i);
  }
  if (@output == 0) {
    $explain ~= 'No element in the given array matching '
             ~  'the given target.';
  }
  else {
    $explain ~= 'Target indices: (' ~ @output.join(', ')
             ~  ') as ';
    my @explain_indices = @output.map({ "\$ints[$_] = $k"});
    $explain ~= @explain_indices.join(' and ');
  }
  return $explain, @output;
}

$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
Output: (1 2)

Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (1, 2) as $ints[1] = 2 and $ints[2] = 2

Example 2:
Input: @ints = (1, 2, 4, 3, 5), $k = 6
Output: ()

Sorted array: (1, 2, 3, 4, 5)
No element in the given array matching the given target.

Example 3:
Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
Output: (4)

Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (4) as $ints[4] = 4

View the entire Raku script for this task on GitHub.

Perl

In Perl, however, we just loop over the indices as $i and use $sorted[$i] to access the values at those indices.

sub targetIndex($k, @ints) {
  my @sorted = sort @ints;
  my $explain = 'Sorted array: (' . join(', ', @sorted) . ")\n";

  my @output;
  foreach my $i (0 .. $#sorted) {
    next unless $sorted[$i] == $k;
    push @output, $i;
  }
  if (@output == 0) {
    $explain .= 'No element in the given array matching '
             .  'the given target.';
  }
  else {
    $explain .= 'Target indices: (' . join(', ', @output)
             .  ') as ';
    my @explain_indices = map { "\$ints[$_] = $k"} @output;
    $explain .= join(' and ', @explain_indices);
  }
  return $explain, @output;
}

View the entire Perl script for this task on GitHub.

Python

In Python, we get to use the enumerate function I last used back in PWC251.

def comma_join(arr):
    return ', '.join(map(lambda i: str(i), arr))

def targetIndex(k, ints):
  sortedArray = sorted(ints)
  explain = f'Sorted array: ({comma_join(sortedArray)})\n'

  output = []
  for i, v in enumerate(sortedArray):
    if v == k:
      output.append(i)
  
  if len(output) == 0:
    explain += 'No element in the given array matching '
    explain += 'the given target.'
  else:
    explain += f'Target indices: ({comma_join(output)}) as '
    explain_indices = [ f'$ints[{i}] = {k}' for i in output ]
    explain += ' and '.join(
       map(lambda i: str(i), explain_indices)
    )
  return explain, output

View the entire Python script for this task on GitHub.

Task 2: Merge Items

You are given two 2-D array of positive integers, $items1 and $items2 where element is pair of (item_id, item_quantity).

Write a script to return the merged items.

Example 1

Input: $items1 = [ [1,1], [2,1], [3,2] ]
       $items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]

Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
Item id (3) appears 1 time: [3,2]

Example 2

Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
       $items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]

Example 3

Input: $items1 = [ [1,1], [2,2], [3,3] ]
       $items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]

Approach

This feels like a wonderful thing to use a hash for: as we loop through the pairs and use the item_id as the hash key and just add item_quantity to the hash value.

Raku

sub mergeItems(@items1, @items2) {
  my %merged;
  # loop over the items and add item_quantities (element 1)
  # to the count for each item_id (element 0)
  for (slip(@items1), slip(@items2)) -> @i {
    %merged{@i[0]} += @i[1];
  }
  # re-render the hash as a 2D array
  return %merged.keys.sort.map({ [ $_, %merged{$_} ] });
}

$ raku/ch-2.raku
Example 1:
Input: $items1 = [ [1,1], [2,1], [3,2] ]
       $items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]

Example 2:
Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
       $items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]

Example 3:
Input: $items1 = [ [1,1], [2,2], [3,3] ]
       $items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]

View the entire Raku script for this task on GitHub.

Perl

sub mergeItems($items1, $items2) {
  my %merged;
  # loop over the items and add item_quantities (element 1)
  # to the count for each item_id (element 0)
  foreach my $i (@$items1, @$items2) {
    $merged{$i->[0]} += $i->[1];
  }
  # re-render the hash as a 2D array
  return [ map { [ $_, $merged{$_} ] } sort keys %merged ];
}

View the entire Perl script for this task on GitHub.

Python

As always, when I’m counting things in Python, I use the Counter type in the collections module. I also found that the chain function in itertools:

Make an iterator that returns elements from the first iterable until it is exhausted, then proceeds to the next iterable, until all of the iterables are exhausted. Used for treating consecutive sequences as a single sequence. 

def mergeItems(items1, items2):
  merged = Counter()
  # loop over the items and add item_quantities (element 1)
  # to the count for each item_id (element 0)
  for i in chain(items1, items2):
    merged[ i[0] ] += i[1]

  # re-render the hash as a 2D array
  return [ [i, v] for i, v in merged.items() ]

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