Perl Weekly Challenge: The Shortest Distance between Submatrix Sums

I’m not even going to try to come up with something clever to tie this to music; just thinking about the first task makes my brain swim. So I’m tackling the second task first.

Perl Weekly Challenge 248

Task 2: Submatrix Sum

You are given a NxM matrix A of integers.

Write a script to construct a (N-1)x(M-1) matrix B having elements that are the sum over the 2x2 submatrices of A,

b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1]

Example 1

Input: $a = [
              [1,  2,  3,  4],
              [5,  6,  7,  8],
              [9, 10, 11, 12]
            ]

Output: $b = [
               [14, 18, 22],
               [30, 34, 38]
             ]

Example 2

Input: $a = [
              [1, 0, 0, 0],
              [0, 1, 0, 0],
              [0, 0, 1, 0],
              [0, 0, 0, 1]
            ]

Output: $b = [
               [2, 1, 0],
               [1, 2, 1],
               [0, 1, 2]
             ]

Approach

The approach here is fairly straightforward: accept the input matrix, determine the size M and N, then run through the calculations to determine the elements for the sums of the 2×2 submatricies. Jorg Sommrey was even kind enough to give us the formula.

Raku

sub submatrixSum(@a) {
  # subtract 1 because we're 0-indexed
  my $M = @a.elems - 1;    # rows
  my $N = @a[0].elems - 1; # columns
  # we are ASSUMING the matrix is consistent with
  # each row having the same number of columns
  my @b;
  for 0 .. $M - 1 -> $i {
    for 0 .. $N - 1 -> $k {
      @b[$i;$k] = @a[$i;  $k] + @a[$i;  $k+1]
                + @a[$i+1;$k] + @a[$i+1;$k+1];
    }
  }
  return @b;
}

View the entire Raku script for this task on GitHub.

Perl

sub submatrixSum(@a) {
  my $M = $#a;       # rows
  my $N = $#{$a[0]}; # columns
  # we are ASSUMING the matrix is consistent with
  # each row having the same number of columns
  my @b;
  foreach my $i ( 0 .. $M - 1 ) {
    push @b, [];
    foreach my $k ( 0 .. $N - 1 ) {
      $b[$i]->[$k] = $a[$i]->[$k]   + $a[$i]->[$k+1]
                   + $a[$i+1]->[$k] + $a[$i+1]->[$k+1];
    }
  }
  return @b;
}

View the entire Perl script for this task on GitHub.

Python

def submatrixSum(a):
    # subtract 1 because we're 0-indexed
    M = len(a) - 1    # rows
    N = len(a[0]) - 1 # columns
    # we are ASSUMING the matrix is consistent with
    # each row having the same number of columns
    b = []
    for i in range(M): # range is 0 .. M-1
        row = []
        for k in range(N):
            row.append( a[i  ][k] + a[i  ][k+1] +
                        a[i+1][k] + a[i+1][k+1] )
        b.append(row)
    return b

View the entire Python script for this task on GitHub.


Task 1: Shortest Distance

You are given a string and a character in the given string.

Write a script to return an array of integers of size same as length of the given string such that:

distance[i] is the distance from index i to the closest occurrence
of the given character in the given string.

The distance between two indices i and j is abs(i - j).

Example 1

Input: $str = "loveleetcode", $char = "e"
Output: (3,2,1,0,1,0,0,1,2,2,1,0)

The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed).
The closest occurrence of 'e' for index 0 is at index 3, so the distance is abs(0 - 3) = 3.
The closest occurrence of 'e' for index 1 is at index 3, so the distance is abs(1 - 3) = 2.
For index 4, there is a tie between the 'e' at index 3 and the 'e' at index 5,
but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1.
The closest occurrence of 'e' for index 8 is at index 6, so the distance is abs(8 - 6) = 2.

Example 2

Input: $str = "aaab", $char = "b"
Output: (3,2,1,0)

Approach

The approach we should take is pretty much outlined in the description of the example: first generate a list of what indices the target character occurs at, then calculate the closest occurrence based on abs(x - y) where x and y are the positions of the current character and an occurrence of the target character.

Raku

sub shortestDistance($str, $char) {
  # split the string into an array of characters
  my @strchar = $str.split('', :skip-empty);
  # find the positions of the target $char
  my @pos = (0 .. @strchar.end).grep: { @strchar[$_] eq $char };

  my @output;
  for 0 .. @strchar.end -> $i {
    # find the distances
    my @distance = @pos.map: { abs($i - $_) };
    # find the minimum distance
    @output.push( @distance.min );
  }
  return @output;
}

View the entire Raku script for this task on GitHub.

Perl

sub shortestDistance($str, $char) {
  # split the string into an array of characters
  my @strchar = split(//, $str);
  # find the positions of the target $char
  my @pos = grep { $strchar[$_] eq $char } 0 .. $#strchar;
  
  my @output;
  foreach my $i ( 0 .. $#strchar ) {
    # find the distances
    my @distance = map { abs($i - $_) } @pos;
    # find the minimum distance
    push @output, min(@distance);
  }
  return @output;
}

View the entire Perl script for this task on GitHub.

Python

def shortestDistance(s, c):
    # split the string into an array of characters
    strchar = list(s)
    # find the positions of the target char
    pos = [ x for x in range(len(s)) if strchar[x] == c ]

    output = []
    for i in range(len(s)):
        # find the distances
        distance = [ abs(i - p) for p in pos ]
        # find the minimum distance
        output.append(  min(distance) )
    return output

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

Perl Weekly Challenge: Writing Letter Pairs to Santa

When the tasks have “letter” and “Santa”, there’s only one thing that came to my mind: Wakko Warner.

Onward to Perl Weekly Challenge 247!

Task 1: Secret Santa

Secret Santa is a Christmas tradition in which members of a group are randomly assigned a person to whom they give a gift.

You are given a list of names. Write a script that tries to team persons from different families.

Example 1

The givers are randomly chosen but don't share family names with the receivers.

Input: @names = ('Mr. Wall',
                 'Mrs. Wall',
                 'Mr. Anwar',
                 'Mrs. Anwar',
                 'Mr. Conway',
                 'Mr. Cross',
                );

Output:

    Mr. Conway -> Mr. Wall
    Mr. Anwar -> Mrs. Wall
    Mrs. Wall -> Mr. Anwar
    Mr. Cross -> Mrs. Anwar
    Mr. Wall -> Mr. Conway
    Mrs. Anwar -> Mr. Cross

Example 2

One gift is given to a family member.

Input: @names = ('Mr. Wall',
                 'Mrs. Wall',
                 'Mr. Anwar',
                );

Output:

    Mr. Anwar -> Mr. Wall
    Mr. Wall -> Mrs. Wall
    Mrs. Wall -> Mr. Anwar

Approach

Ok, so this is like last week where we’re randomly picking elements from a list, but there are two added twists: when picking the gift recipient for person X, we always want to exclude person X from the result (so nobody is giving a gift to themselves), and we prefer to select a gift recipient who has a different family name. But we also want to make sure nobody is getting gifts from more that one person.

Honestly, I keep going back and forth about how to do this. Excluding the person from giving a gift to themselves is easy, but coming up with the most efficient way to exclude family members if possible could be solved many different ways. I’m thinking that what I’ll do is maintain a list of recipients, and, for each giver, call a routine that a) removes the giver from the list, and b) removes family members from the list. If after removing family members from the list, the list is empty, family members will be added back.

Raku

And when I started testing my approach, I discovered there was a problem: sometimes, I would pick all the possible recipients for other people, leaving the list with only the giver as a possible recipient:

Output:
    Mr. Cross ->
    Mr. Wall -> Mr. Conway
    Mr. Anwar -> Mrs. Wall
    Mrs. Anwar -> Mr. Wall
    Mr. Conway -> Mrs. Anwar
    Mrs. Wall -> Mr. Anwar

So maybe I need to ensure that everyone gets assigned to someone else FIRST, and then worry about family names. Or… I could just accept that this happens occasionally and rather than adjust my algorithm to prevent it from happening, just add a check to make sure that everyone was assigned a gift recipient, and if not, just re-do my entire list.

Yeah, I’m doing that.

sub findRecipient($giver, %recipients) {
  # since %recipients is passed by reference, we can't
  # modify it, so let's make a copy with the giver removed
  my @recipients = %recipients.keys.grep({ !/$giver/ });

  # split on whitespace and take the last element
  # to get the "family name"
  my $family_name = split(" ", $giver)[*-1];

  # now, make a potential recipient hash
  # excluding family members
  my @non_family_members =
    @recipients.grep({ !/$family_name/ });

  if (@non_family_members > 0) {
    return @non_family_members.pick;
  }
  else {
    return @recipients.pick;
  }
}

sub secretSanta(@names) {
  # let's use a hash to hold the giver/recipient pairings
  my %results;
 
  # put our work in a labelled loop
  ASSIGN_RECIPIENTS: loop {
    # convert the array of names into a hash with names as keys
    my %available_recipients = @names.map: * => 1;

    # now go through each of the names and find a
    # recipient for them
    for @names -> $giver {
      my $recipient =
        findRecipient($giver, %available_recipients);

      # occasionally, we assign recipients so in the last
      # iteration of the for loop the only available
      # recipient is $giver. When that happens, the easiest
      # way to fix things is to just re-do the entire list
      redo ASSIGN_RECIPIENTS if ! defined $recipient;

      %results{$giver} = $recipient;
      %available_recipients{$recipient}:delete;
    }
    last; # exit the labelled loop
  }
  return %results;
}

View the entire Raku script for this task on GitHub.

Perl

For the Perl implementation, I’m finally giving in and using Perl’s function signatures (as I noted last week, they’ve been the default since Perl 5.36, so why shouldn’t I use them?) and to take the place of Raku’s pick, I’m using List::Util’s sample function.

use List::Util qw( sample );

sub findRecipient($giver, $recipients) {
  # since $recipients is a reference to a hash, we can't
  # modify it, so let's make a copy with the giver removed
  my @recipients = grep { !/$giver/ } keys %$recipients;

  # split on whitespace and take the last element
  # to get the "family name"
  my $family_name = (split /\s+/, $giver)[-1];

  # now, make a potential recipient hash
  # excluding family members
  my @non_family_members =
    grep { !/$family_name/ } @recipients;

  if (@non_family_members > 0) {
    return sample(1, @non_family_members);
  }
  else {
    return sample(1, @recipients);
  }
}

sub secretSanta(@names) {
  # let's use a hash to hold the giver/recipient pairings
  my %results;
 
  # put our work in a labelled loop
  ASSIGN_RECIPIENTS: while () {
    # convert the array of names into a hash with names as keys
    my %available_recipients = map { $_ => 1 } @names;

    # now go through each of the names and find a
    # recipient for them
    foreach my $giver ( @names ) {
      my $recipient =
        findRecipient($giver, \%available_recipients);

      # occasionally, we assign recipients so in the last
      # iteration of the for loop the only available
      # recipient is $giver. When that happens, the easiest
      # way to fix things is to just re-do the entire list
      redo ASSIGN_RECIPIENTS if ! defined $recipient;

      $results{$giver} = $recipient;
      delete $available_recipients{$recipient};
    }
    last; # exit the labelled loop
  }
  return %results;
}

I wound up using while () as a standing for Raku’s loop (even though loop is analogous to Perl’s for, using for in Perl to do an unbounded loop would be for (;;), and I just like the while form better).

View the entire Perl script for this task on GitHub.

Python

Python doesn’t have named loops, so it was just easier to set a variable if we encountered our error condition and, if it’s set to True, recursively call the function again.

from random import sample
import re

def findRecipient(giver, recipients):
    # exclude the giver from the recipient list
    possible_recipients = [
        name for name in recipients if name != giver
    ]

    # if there are no possible recipients, bail early
    if len(recipients) == 0:
        return None

    # split on whitespace and take the last element
    # to get the "family name"
    family_name = re.compile((giver.split())[-1])

    # now, make a potential recipient list
    # excluding family members
    non_family_members = [
        name for name in possible_recipients \
            if not family_name.search(name)
    ]

    # sample() returns a LIST, so just return the first elem
    if len(non_family_members) > 0:
        return sample(non_family_members, 1)[0]
    else:
        return sample(recipients, 1)[0]

def secretSanta(names):
    # let's use a dictionary to hold the giver/recipient
    # pairings
    results = {}
 
    # copy the names into a new list
    available_recipients = names.copy()

    # now go through each of the names and find a
    # recipient for them
    must_redo = False
    for giver in names:
        recipient = findRecipient(giver, available_recipients)
        if recipient is None:
            must_redo = True
        results[giver] = recipient
        available_recipients.remove(recipient)

    if must_redo:
        return secretSanta(names)
    else:
        return results

View the entire Python script for this task on GitHub.


Task 2: Most Frequent Letter Pair

You are given a string S of lower case letters 'a'..'z'.

Write a script that finds the pair of consecutive letters in S that appears most frequently. If there is more than one such pair, chose the one that is the lexicographically first.

Example 1

Input: $s = 'abcdbca'
Output: 'bc'

'bc' appears twice in `$s`

Example 2

Input: $s = 'cdeabeabfcdfabgcd'
Output: 'ab'

'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically smaller than 'cd'.

Approach

This feels fairly straightforward: take the first two characters of the string, count them as a pair. Discard the first character from the string, then repeat the process with the new first two characters of the string, until there’s only one character in the string left. A hash is perfect for keeping track of the pairs we’ve counted.

The wrinkle is that we need to handle when more than one pair has the same count.

Having to sort on frequency and then some natural order reminds me of the second task in PWC 233.

Raku

use Lingua::Conjunction;
use Lingua::EN::Numbers;

sub pairCount($string) {
  my $s = $string; # make a copy so we can modify it
  my %count;
  while ($s.chars > 1) {
    my $pair = substr($s, 0..1); # the first two characters
    %count{$pair}++;          # count the pair
    $s = substr($s, 1, *); # remove the first character
  }
  return %count;
}

sub mostFrequentPair($s) {
  # count the letter pairs
  my %pairs = pairCount($s);

  # sort the pairs by their counts
  my @sorted = %pairs.keys.sort: {
    # sort by count first
    %pairs{$^b} <=> %pairs{$^a}
    ||
    # then by lexicographical order
    $^a cmp $^b
  };

  my @max_pair  = shift(@sorted); # pull off first value
  my $max_count = %pairs{@max_pair[0]}; # get it's count

  while ( %pairs{@sorted[0]} == $max_count ) {
    # there are pairs on the sorted list that have the
    # same count, so let's put them on the list, too
    @max_pair.append( shift(@sorted) );
  }
  my $explain;

  # set aside the pair that sorted to the top
  my $first_pair = @max_pair[0];

  # now quote all the pairs
  @max_pair = @max_pair.map: { qq{'$_'} };

  # make the count an english word
  my $count =  ($max_count == 1) ?? 'once'      # 🎶
            !! ($max_count == 2) ?? 'twice'     # 🎶
            !! cardinal($max_count) ~ ' times'; # a lady 🎶

  # and format the explanation
  if (@max_pair == 1) {
    $explain = "'$first_pair' appears $count in \$s";
  }
  else {
    my $str = qq{|list| appear $count in \$s and }
            ~ qq{'$first_pair' is lexicographically smallest.};
    $explain = conjunction @max_pair, :$str;
  }

  return $first_pair, $explain;
}

View the entire Raku script for this task on GitHub.

Perl

use Lingua::EN::Inflexion qw( noun wordlist );

sub pairCount($s) {
  my %count;
  while (length($s) > 1) {
    my $pair = substr($s, 0, 2); # the first two characters
    $count{$pair}++;        # count the pair
    $s = substr($s, 1); # remove the first character
  }
  return %count;
}

sub mostFrequentPair($s) {
  # count the letter pairs
  my %pairs = pairCount($s);

  # sort the pairs by their 
  my @sorted = sort {
    # sort by count first
    $pairs{$b} <=> $pairs{$a}
    ||
    # then by lexicographical order
    $a cmp $b
  } keys %pairs;

  my @max_pair  = shift(@sorted); # pull off first value
  my $max_count = $pairs{$max_pair[0]}; # get it's count

  while ( $pairs{$sorted[0]} == $max_count ) {
    # there are pairs on the sorted list that have the
    # same count, so let's put them on the list, too
    push @max_pair, shift(@sorted);
  }
  my $explain;

  # set aside the pair that sorted to the top
  my $first_pair = $max_pair[0];

  # now quote all the pairs
  my $pair_list = wordlist( map { qq{'$_'} } @max_pair );

  # make the count an english word
  my $count = ($max_count == 1) ? 'once'             # 🎶
            : ($max_count == 2) ? 'twice'            # 🎶
            : noun($max_count)->cardinal . ' times'; # a lady 🎶

  # and format the explanation
  if (@max_pair == 1) {
    $explain = "'$first_pair' appears $count in \$s";
  }
  else {
    $explain = $pair_list . " appear $count in \$s and "
             . "'$first_pair' is lexicographically smallest.";
  }

  return $first_pair, $explain;
}

View the entire Perl script for this task on GitHub.

Python

The last time I needed to do English conjunctions in Python back in PWC 233, I didn’t bother looking for a module to load; I just rolled my own. I’ve borrowed that function here. I’ve also re-uses the Counter type in the collections module I discovered back in PWC 234, and Savoir-faire Linux’s num2words module I used in PWC 237.

I did a bit of searching on how to sort on multiple criteria, and I came across what the Python documentation called the Decorate-Sort-Undecorate idiom: create a list of tuples having the values you want to sort on, then sort the list of tuples, then re-create the list from the sorted tuples. But while I was reading it, I realized that I knew this technique, just under a different name: it’s a Schwartzian Transformation.

from collections import Counter
from num2words import num2words

def conjunction(words):
    if len(words) < 2:
        return(words)
    elif len(words) == 2:
        return(f'{words[0]} and {words[1]}')
    else:
        last = words.pop(-1)
        l = ', '.join(words)
        return(f'{l}, and {last}')

def pairCount(s):
    # instantiate a counter object
    count = Counter()
    while (len(s) > 1):
        pair = s[0:2]    # the first two characters
        count[pair] += 1 # count the pair
        s = s[1:]        # remove the first character
    # convert it back to a dict now that we're done counting
    return dict(count)

def mostFrequentPair(s):
    # count the letter pairs
    pairs = pairCount(s)

    # sort the pairs by their counts
    # use the Decorate-Sort-Undecorate idiom
    # to convert the dict into a list
    decorated = [ (pairs[p], p) for p in pairs.keys() ]
    sorted_tuples = sorted(
        decorated,
        # the - before the first element sorts descending
        key=lambda k: (-k[0], k[1])
    )
    sorted_pairs = [ t[1] for t in sorted_tuples ]

    max_pair = []
    # pull off first value from the sorted pairs
    max_pair.append( sorted_pairs.pop(0) )
    # get it's count
    max_count = pairs[ max_pair[0] ]

    while pairs[ sorted_pairs[0] ] == max_count:
        # there are pairs on the sorted list that have the
        # same count, so let's put them on the list, too
        max_pair.append( sorted_pairs.pop(0) )

    # set aside the pair that sorted to the top
    first_pair = max_pair[0]

    # make the count an english word
    count = (
        'once'  if (max_count == 1) else # 🎶
        'twice' if (max_count == 2) else # 🎶
        num2words(max_count) + ' times'  # a lady 🎶
    )

    # and format the explanation
    if len(max_pair) == 1:
        explain = f"'{first_pair}' appears {count} in \$s"
    else:
        # quote all the pairs
        max_pair = [ f"'{x}'" for x in max_pair]
        explain = f"{conjunction(max_pair)} appear {count} in "
        explain += f"$s and '{first_pair}' is "
        explain += "lexicographically smallest."

    return first_pair, 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-247/packy-anderson

Perl Weekly Challenge: 25 or 6 out of four… ty-nine

Hey, when the first task is “6 out of 49”, I challenge you to not hear Chicago in your head.

Task 1: 6 out of 49

6 out of 49 is a German lottery.

Write a script that outputs six unique random integers from the range 1 to 49.

Output

3
10
11
22
38
49

Approach

We need to generate 6 unique numbers, so we need to quickly check to see if a number we’ve generated is already part of the output set. Sounds like hashes to me.

Raku

Except when I went to refresh my memory about how Raku did random numbers, I remembered that there was a special routine on the List class: pick.

routine pick

multi sub    pick($count, *@list --> Seq:D)
multi method pick(List:D: $count --> Seq:D)
multi method pick(List:D: --> Mu)
multi method pick(List:D: Callable $calculate --> Seq:D)

If $count is supplied: Returns $count elements chosen at random and without repetition from the invocant. If * is passed as $count, or $count is greater than or equal to the size of the list, then all elements from the invocant list are returned in a random sequence; i.e. they are returned shuffled.

In method form, if $count is omitted: Returns a single random item from the list, or Nil if the list is empty

Since it returns a number of elements chosen at random without repetition, there’s all our work done for us. All we need to do is generate a list of integers from 1 to 49:

sub sixOutOfFourtyNine {
  return (1 .. 49).pick(6).sort;
}

I’m sorting the results as well, because that’s how the sample output was presented.

View the entire Raku script for this task on GitHub.

Approach Revision

But now that I’ve got the Raku version under my belt, I’m rethinking my approach. Why generate potentially duplicate random numbers, when I can generate the set of numbers from 1 – 49, and SHUFFLE those numbers, and then just pull the first 6 values off that list.

Perl

use List::Util qw( shuffle );

sub sixOutOfFourtyNine {
  return sort { $a <=> $b } ( shuffle(1 .. 49) )[0 .. 5];
}

View the entire Perl script for this task on GitHub.

Python

Except… when I went to look in the random module in Python to see if it had a shuffle method, I found out that not only did it have one…

random.shuffle(x)

Shuffle the sequence x in place.

To shuffle an immutable sequence and return a new shuffled list, use sample(x, k=len(x)) instead.

So there was a sample method that “Returns a k length list of unique elements chosen from the population sequence. Used for random sampling without replacement.” Bingo! Just what we need!

from random import sample

def sixOutOfFourtyNine():
    return sorted(sample(range(1, 49), 6))

View the entire Python script for this task on GitHub.


Task 2: Linear Recurrence of Second Order

You are given an array @a of five integers.

Write a script to decide whether the given integers form a linear recurrence of second order with integer factors.

linear recurrence of second order has the form

a[n] = p * a[n-2] + q * a[n-1] with n > 1

where p and q must be integers.

Example 1

Input: @a = (1, 1, 2, 3, 5)
Output: true

@a is the initial part of the Fibonacci sequence a[n] = a[n-2] + a[n-1]
with a[0] = 1 and a[1] = 1.

Example 2

Input: @a = (4, 2, 4, 5, 7)
Output: false

a[1] and a[2] are even. Any linear combination of two even numbers with integer factors is even, too.
Because a[3] is odd, the given numbers cannot form a linear recurrence of second order with integer factors.

Example 3

Input: @a = (4, 1, 2, -3, 8)
Output: true

a[n] = a[n-2] - 2 * a[n-1]

Approach

Ok, so to determine if a sequence is a linear recurrence of second order we need to start examining the third element onwards and see if it’s the sum of integer multiples of the previous two values in the sequence (q times the previous value, p times the value before that).

I decided that there has to be an already-established way for solving these, and when I went looking, I found that there is: Cramer’s rule. If we have a linear system

then the values for x and y can be found with this formula:

To render this in our a[n] / p / q notation, then we get

p = (a[2] * a[2] - a[1] * a[3]) / (a[0] * a[2] - a[1] * a[1])
q = (a[0] * a[3] - a[2] * a[1]) / (a[0] * a[2] - a[1] * a[1])

If p and q have integer solutions (and the solutions for elements 0..3 are the same for 1..4), we’ve got a linear recurrence of second order.

Raku

sub findPandQ(@a) {
  my $p = (@a[2] * @a[2] - @a[1] * @a[3])
        / (@a[0] * @a[2] - @a[1] * @a[1]);
  my $q = (@a[0] * @a[3] - @a[2] * @a[1])
        / (@a[0] * @a[2] - @a[1] * @a[1]);
  return($p, $q);
}

sub isLinearRecurranceOfSecondOrder(@a) {
  my ($p1, $q1) = findPandQ(@a[0 .. 3]);
  my ($p2, $q2) = findPandQ(@a[1 .. 4]);
  if ($p1 != $p2 || $q1 != $q2) {
    say "Values for P ($p1, $p2) and Q ($q1, $q2) "
      ~ "are not consistent across all five elements";
    return False;
  }
  if ($p1 != $p1.Int || $q1 != $q1.Int) {
    say "Values for P ($p1) and Q ($q1) for first "
      ~ "four elements are not integers";
    return False;
  }
  say "Found integer values for P ($p1) and Q ($q1)";
  return True;
}

Here I’d like to show the output of my script:

$ raku/ch-2.raku
Example 1:
Input: @a = (1, 1, 2, 3, 5)
Found integer values for P (1) and Q (1)
Output: True

Example 2:
Input: @a = (4, 2, 4, 5, 7)
Values for P (0.5) and Q (1) for first four elements are not integers
Output: False

Example 3:
Input: @a = (4, 1, 2, -3, 8)
Found integer values for P (1) and Q (-2)
Output: True

It’s not that there aren’t factors p and q for the sequence in the second example; it’s that the factors aren’t both integers.

View the entire Raku script for this task on GitHub.

Perl

sub findPandQ {
  my @a = @_;
  my $p = ($a[2] * $a[2] - $a[1] * $a[3])
        / ($a[0] * $a[2] - $a[1] * $a[1]);
  my $q = ($a[0] * $a[3] - $a[2] * $a[1])
        / ($a[0] * $a[2] - $a[1] * $a[1]);
  return($p, $q);
}

sub isLinearRecurranceOfSecondOrder {
  my @a = @_;
  my ($p1, $q1) = findPandQ(@a[0 .. 3]);
  my ($p2, $q2) = findPandQ(@a[1 .. 4]);
  if ($p1 != $p2 || $q1 != $q2) {
    say "Values for P ($p1, $p2) and Q ($q1, $q2) "
      . "are not consistent across all five elements";
    return 0;
  }
  if ($p1 != int($p1) || $q1 != int($q1)) {
    say "Values for P ($p1) and Q ($q1) for first "
      . "four elements are not integers";
    return 0;
  }
  say "Found integer values for P ($p1) and Q ($q1)";
  return 1;
}

I don’t know why I’m not using Perl’s function signatures; they’ve been the default since Perl 5.36; but they still don’t feel very perl-ish to me. If I used them, though, the only changes from the Raku version would be

  • $ sigil instead of @ for accessing individual array values
  • . instead of ~ for string concatenation
  • int($var) instead of $var.Int to get the integer portion of a variable
  • Using 1 / 0 for booleans instead of the Raku Bools True / False.

View the entire Perl script for this task on GitHub.

Python

def findPandQ(a):
    p = (
      (a[2] * a[2] - a[1] * a[3])
      /
      (a[0] * a[2] - a[1] * a[1])
    )
    q = (
      (a[0] * a[3] - a[2] * a[1])
      / 
      (a[0] * a[2] - a[1] * a[1])
    )
    return(p, q)


def isLinearRecurranceOfSecondOrder(a):
    (p1, q1) = findPandQ(a[0:4])
    (p2, q2) = findPandQ(a[1:5])
    if p1 != p2 or q1 != q2:
        print(f'Values for P ({p1}, {p2}) ', end='')
        print(f'and Q ({q1}, {q2}) ', end='')
        print(f'are not consistent across all five elements')
        return False
    if p1 != int(p1) or q1 != int(q1):
        print(f'Values for P ({p1}) ', end='')
        print(f'and Q ({q1}) ', end='')
        print(f'for first four elements are not integers')
        return False

    print(f'Found integer values for P ({int(p1)}) ', end='')
    print(f'and Q ({int(q1)})')
    return True

The thing I have to remember about Python slices is that the ending element is not included in the slice. So a[0:3] will give me elements 0, 1, and 2, but not 3.

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

Perl Weekly Challenge: Sort Languages to the Largest of Three

Yeah, yeah, it feels like a bit of a stretch this week, but when I saw the tasks, my brain read off “Largest of Three” to the tune of “Power of Two” by The Indigo Girls. No more of a stretch than Three of a Reverse Sum Pair was, I guess.

Task 1: Sort Language

You are given two array of languages and its popularity.

Write a script to sort the language based on popularity.

Example 1

Input: @lang = ('perl', 'c', 'python')
       @popularity = (2, 1, 3)
Output: ('c', 'perl', 'python')

Example 2

Input: @lang = ('c++', 'haskell', 'java')
       @popularity = (1, 3, 2)
Output: ('c++', 'java', 'haskell')

Approach

This could be done with a single loop, using the second array to assign values from the first array to particular indices in the output array:

for (i = 0; i < length(lang); i++) {
  output[ popularity[i]-1 ] = lang[i];
}

But this task is phrased as a sort, so let’s code it that way: the second array has the values we’ll use to compare the first array elements with in a custom sort.

Raku

sub sortLanguage(@lang, @popularity) {
  # build a hash associating @popularity with @lang
  my %lang_pop = map {
    @lang[$_] => @popularity[$_]
  }, @lang.keys;
  my @sorted = @lang.sort({
    # sort by %lang_pop, not @lang
    %lang_pop{$^a} <=> %lang_pop{$^b}
  });
  return @sorted;
}

I’m remembering my discovery last week that @lang.keys would give me the sequence 0, 1, 2.

View the entire Raku script for this task on GitHub.

Perl

Again, the changes from Raku to Perl aren’t Earth-shattering:

sub sortLanguage{
  my ($lang, $popularity) = @_;
  # build a hash associating @popularity with @lang
  my %lang_pop = map {
    $lang->[$_] => $popularity->[$_]
  } 0 .. $#{$lang};
  my @sorted = sort {
    # sort by %lang_pop, not @$lang
    $lang_pop{$a} <=> $lang_pop{$b}
  } @$lang;
  return @sorted;
}

View the entire Perl script for this task on GitHub.

Python

Python’s nifty sorted built-in makes this pretty easy.

def sortLanguage(lang, popularity):
    # build a dict associating popularity with lang
    lang_pop = {
        v: popularity[i] for i,v in enumerate(lang)
    }
    sorted_list = sorted(lang,
                         # sort by lang_pop, not lang
                         key=lambda x: (lang_pop[x]))
    return sorted_list

View the entire Python script for this task on GitHub.


Task 2: Largest of Three

You are given an array of integers >= 0.

Write a script to return the largest number formed by concatenating some of the given integers in any order which is also multiple of 3. Return -1 if none found.

Example 1

Input: @ints = (8, 1, 9)
Output: 981

981 % 3 == 0

Example 2

Input: @ints = (8, 6, 7, 1, 0)
Output: 8760

Example 3

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

Approach

Ok, it’s pretty obvious that the largest combination will have the digits sorted in descending order, so I’m guessing I want to sort the digits first, and then start making combinations until I either a) find a combination that’s a multiple of 3, or b) exhaust my combinations.

Raku

sub largestOfThree(@ints) {
  my $max = -1; # initialize our failure case
  for @ints.combinations -> @combo {
    next unless @combo.elems > 0; # not empty set
    # sort the digits in descending order,
    # join them, then convert to an Int
    my $num = @combo.sort.reverse.join('').Int;
    next unless $num > $max;   # not bigger than current max
    next unless $num % 3 == 0; # not divisible by 3
    $max = $num;
  }
  return $max;
}

View the entire Raku script for this task on GitHub.

Perl

Again,  Algorithm::Combinatorics’ combinations function comes to the rescue.

use Algorithm::Combinatorics qw( combinations );

sub largestOfThree {
  my @ints = @_;
  my $max = -1; # initialize our failure case
  my @combos = map {
    combinations(\@ints, $_)
  } 1 .. scalar(@ints);
  foreach my $combo ( @combos ) {
    # sort the digits in descending order,
    # join them, then convert to an Int
    my $num = join('', reverse sort @$combo) + 0;
    next unless $num > $max;   # not bigger than current max
    next unless $num % 3 == 0; # not divisible by 3
    $max = $num;
  }
  return $max;
}

View the entire Perl script for this task on GitHub.

Python

from itertools import combinations

def largestOfThree(ints):
    # generate a list of combinations
    combos = [
        c for i in range(1, len(ints)+1)
          for c in combinations(ints, i)
    ]
    maxval = -1 # initialize our failure case
    for combo in combos:
        combo_list = list(combo)
        combo_list.sort(reverse=True)
        num = int(''.join(map(str, combo_list)))
        if num <= maxval: # not bigger than current max
            continue
        if num % 3 != 0: # not divisible by 3
            continue
        maxval = num
    return maxval

At least this week I made the nested for loops to generate the combinations prettier.

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

Perl Weekly Challenge: Bonus Script

Recently, the Perl Weekly Challenge has been linking to a EZPWC script that tries to automate a bunch of the interaction that’s necessary to participate in the challenge. But it does a bunch of stuff I don’t need, and it feels a bit like overkill. So I decided to whip up my own pwc script that I can run each week to take care of the repetitive stuff I do each week when I work on my challenge solutions.

#!bash - for syntax highlighting

function pwc_skeleton () {
  SKELETON=$1
  FILE=$2
  if [[ ! -f $FILE ]]; then
    cp $SKELETON $FILE
  fi
  chmod +x $FILE
}

function pwc () {
  cd $HOME/git/perlweeklychallenge-club/

  # update the repository to the latest week
  if ! git remote | grep upstream >/dev/null; then
    git remote add upstream \
      git@github.com:manwar/perlweeklychallenge-club.git
  fi
  git fetch upstream 
  git switch master
  git merge upstream/master
  git push

  # find the latest challenge directory
  CHALLENGE_DIR=$(ls -d challenge-* | tail -1)
  cd $CHALLENGE_DIR/packy-anderson

  # set up the skeleton files
  mkdir raku
  pwc_skeleton $CFGDIR/pwc/skeleton.raku raku/ch-1.raku
  pwc_skeleton $CFGDIR/pwc/skeleton.raku raku/ch-2.raku

  mkdir perl
  pwc_skeleton $CFGDIR/pwc/skeleton.pl perl/ch-1.pl
  pwc_skeleton $CFGDIR/pwc/skeleton.pl perl/ch-2.pl

  mkdir python
  pwc_skeleton $CFGDIR/pwc/skeleton.py python/ch-1.py
  pwc_skeleton $CFGDIR/pwc/skeleton.py python/ch-2.py

  touch blog.txt
  git add .
  code .
}

And yes, it’s in Bash and not Perl or Raku. Because sometimes Bash is just the right tool for the job. This file gets sourced from my .bashrc file, so the functions are defined and when I type pwc it’s executed in my current shell.

This and my skeleton files are under source control at https://github.com/packy/maccfg/tree/master/pwc.

Perl Weekly Challenge: Count… just a little bit smaller…

Ok, I don’t get to choose what music my brain pushes at me when I look at these challenges. Because my wife is performing in a production of Beehive: The 60’s Musical, one of the songs she gets to do is Try by Janis Joplin.

My wife does Janis proud.

But on to this week’s Challenge!

Image of Kay Koch as Janis Joplin

Task 1: Count Smaller

You are given an array of integers.

Write a script to calculate the number of integers smaller than the integer at each index.

Example 1

Input: @int = (8, 1, 2, 2, 3)
Output: (4, 0, 1, 1, 3)

For index = 0, count of elements less 8 is 4.
For index = 1, count of elements less 1 is 0.
For index = 2, count of elements less 2 is 1.
For index = 3, count of elements less 2 is 1.
For index = 4, count of elements less 3 is 3.

Example 2

Input: @int = (6, 5, 4, 8)
Output: (2, 1, 0, 3)

Example 3

Input: @int = (2, 2, 2)
Output: (0, 0, 0)

Approach

This is another double-loop over a single array, like last week. The outer loop (let’s call it the i loop) iterates over each of the elements in the array to produce the count for that index. The inner (j) loop iterates over each of the elements again and compares them to the i element. Easy-peasy.

Raku

sub countSmaller(@int) {
  my @counts;
  for 0 .. @int.elems - 1 -> $i {\
    for 0 .. @int.elems - 1 -> $j {
      @counts[$i]++ if @int[$j] < @int[$i];
    }
  }
  return @counts;
}

But when I ran this, I got

$ raku/ch-1.raku
Example 1:
Input: @int = (8, 1, 2, 2, 3)
Use of uninitialized value @output of type Any in string context.
Methods .^name, .raku, .gist, or .say can be used to stringify it to something meaningful.
  in sub solution at raku/ch-1.raku line 17
Output: (4, , 1, 1, 3)

Example 2:
Input: @int = (6, 5, 4, 8)
Use of uninitialized value @output of type Any in string context.
Methods .^name, .raku, .gist, or .say can be used to stringify it to something meaningful.
  in sub solution at raku/ch-1.raku line 17
Output: (2, 1, , 3)

Example 3:
Input: @int = (2, 2, 2)
Output: ()

What was going on here? Time to add some debugging:

sub countSmaller(@int) {
  my @counts;
  for 0 .. @int.elems - 1 -> $i {
    for 0 .. @int.elems - 1 -> $j {
      @counts[$i]++ if @int[$j] < @int[$i];
    }
  }
  say @counts.raku;
  return @counts;
}
$ raku/ch-1.raku
Example 1:
Input: @int = (8, 1, 2, 2, 3)
[4, Any, 1, 1, 3]
Use of uninitialized value @output of type Any in string context.
Methods .^name, .raku, .gist, or .say can be used to stringify it to something meaningful.
  in sub solution at raku/ch-1.raku line 18
Output: (4, , 1, 1, 3)

Example 2:
Input: @int = (6, 5, 4, 8)
[2, 1, Any, 3]
Use of uninitialized value @output of type Any in string context.
Methods .^name, .raku, .gist, or .say can be used to stringify it to something meaningful.
  in sub solution at raku/ch-1.raku line 18
Output: (2, 1, , 3)

Example 3:
Input: @int = (2, 2, 2)
[]
Output: ()

Ahhh! I see what’s happening: because I’m only incrementing the @counts[$i] value if @counts[$j] is smaller, then if none of the values are smaller, I never autovivified the value for that element. In Perl, the value would be undef, but in Raku, it’s Any. There’s an easy way to fix this: just initialize @counts[$i] to 0 before the $j loop:

sub countSmaller(@int) {
  my @counts;
  for 0 .. @int.elems - 1 -> $i {
    @counts[$i] = 0;
    for 0 .. @int.elems - 1 -> $j {
      @counts[$i]++ if @int[$j] < @int[$i];
    }
  }
  return @counts;
}

But something was bothering me. Coming from Perl, I have to say I like $#int better than @int.elems - 1. There should be a Raku-ish way to get the index of the last element in a list. I seem to recall seeing it once. And, after a bit of searching, I found it again: .end.

sub countSmaller(@int) {
  my @counts;
  for 0 .. @int.end -> $i {
    @counts[$i] = 0;
    for 0 .. @int.end -> $j {
      @counts[$i]++ if @int[$j] < @int[$i];
    }
  }
  return @counts;
}

Then I saw there’s something even BETTER: .keys! I’d never thought to get the keys of a list, only of a hash. But of course this should work in Raku!

sub countSmaller(@int) {
  my @counts;
  for @int.keys -> $i {
    @counts[$i] = 0;
    for @int.keys -> $j {
      @counts[$i]++ if @int[$j] < @int[$i];
    }
  }
  return @counts;
}

View the entire Raku script for this task on GitHub.

Perl

sub countSmaller {
  my @int = @_;
  my @counts;
  foreach my $i ( 0 .. $#int ) {
    $counts[$i] = 0;
    for my $j ( 0 .. $#int ) {
      $counts[$i]++ if $int[$j] < $int[$i];
    }
  }
  return @counts;
}

View the entire Perl script for this task on GitHub.

Python

Ooh. I just ran across a nifty Python built-in, enumerate:

def countSmaller(arr):
    counts = []
    for i, i_val in enumerate(arr):
        counts[i] = 0
        for j, j_val in enumerate(arr):
            if j_val < i_val:
                counts[i] += 1
    return counts
$ python/ch-1.py
Example 1:
Input: @int = (8, 1, 2, 2, 3)
Traceback (most recent call last):
  File "/Users/packy/git/perlweeklychallenge-club/challenge-244/packy-anderson/python/ch-1.py", line 22, in <module>
    solution([8, 1, 2, 2, 3])
  File "/Users/packy/git/perlweeklychallenge-club/challenge-244/packy-anderson/python/ch-1.py", line 18, in solution
    output = countSmaller(arr)
  File "/Users/packy/git/perlweeklychallenge-club/challenge-244/packy-anderson/python/ch-1.py", line 7, in countSmaller
    counts[i] = 0
IndexError: list assignment index out of range

Oh, right. You can’t just add elements to a Python array by assigning to its index. You need to .append() to the array:

def countSmaller(arr):
    counts = []
    for i, i_val in enumerate(arr):
        counts.append(0)
        for j, j_val in enumerate(arr):
            if j_val < i_val:
                counts[i] += 1
    return counts

View the entire Python script for this task on GitHub.


Task 2: Group Hero

You are given an array of integers representing the strength.

Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest.

Example 1

Input: @nums = (2, 1, 4)
Output: 141

Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8
Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1
Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64
Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4
Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32
Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16
Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16

Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141

Approach

Ok, I feel like there are a bunch of pieces here, and the clearest way to tackle the problem is to attack each of the pieces individually:

First, we need a function that, given a list, calculates the power for that list. The meat of that abstracts out to square(max(list)) * min(list). Then we need to generate lists of all the combinations of our list of numbers, push each of those through our power function, and then sum those results.

Raku

Fortunately, in Raku, getting the max and min values of a list are easy:

sub power(@nums) {
  return( (@nums.max ** 2) * @nums.min );
}

And getting all the possible combinations for a list is easy, too: .combinations.

sub groupHero(@nums) {
  my $sum = 0;
  for @nums.combinations: 1 .. @nums.elems -> @list {
    $sum += power(@list);
  }
  return $sum;
}

But wait! I’m just adding things up? That sounds like… Raku’s Reduction Metaoperator[ ]! All I have to do is put what I’m summing in a list…

sub groupHero(@nums) {
  return [+] (
    power($_) for @nums.combinations: 1 .. @nums.elems
  );
}

View the entire Raku script for this task on GitHub.

Perl

In Perl, not everything is built in, but that’s where the power of CPAN comes in: List::Util and its min, max, and sum functions, and Algorithm::Combinatorics’ combinations function.

use Algorithm::Combinatorics qw( combinations );
use List::Util qw( min max sum );

sub power {
  my $list = shift;
  return( (max(@$list) ** 2) * min(@$list) );
}

sub groupHero(@nums) {
  return sum(
    # generate the list of powers for each combination
    map { power($_) }
    # generate the list of combinations
    map { combinations(\@nums, $_) } 1 .. scalar(@nums)
  );
}

View the entire Perl script for this task on GitHub.

Python

from itertools import combinations

def power(arr):
    return( (max(arr) ** 2) * min(arr) )

def groupHero(nums):
    # generate a list of combinations
    comb = []
    for i in range(1, len(nums)+1):
        for c in combinations(nums, i):
            comb.append(c)
    return sum(
      # generate the list of powers for each combination
      [ power(x) for x in comb ] 
    )

I tried to not build the list of combinations with two loops and an intermediate array object, but I kept getting a list of iterables passed to power, so I got tired…

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

Perl Weekly Challenge: Three of a Reverse Sum Pair

King Crimson - Three of a Perfect Pair

Finally, for Perl Weekly Challenge 243 I get my musical association mojo back, and the first challenge immediately made me think of King Crimson’s Three of a Perfect Pair.

I’m listening to the album while I write these solutions.

Task 1: Reverse Pairs

You are given an array of integers.

Write a script to return the number of reverse pairs in the given array.

A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].

Example 1

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

(1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
(3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1

Example 2

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

(1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
(2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
(3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1

Approach

This is a pretty straightforward nested loop over an array: one loop for i from 0 to array length – 1, and an inner loop for j from i to array length. Just to make things easier to read, I’m going to make the test a function, isReversePair(), so the code is more expressive.

Raku

sub isReversePair(@arr, $i, $j) {
  return @arr[$i] > 2 * @arr[$j];
}

sub findReversePairs(@arr) {
  my @pairs;
  for 0 .. @arr.elems - 2 -> $i {
    for $i+1 .. @arr.elems - 1 -> $j {
      @pairs.push([$i, $j]) if isReversePair(@arr, $i, $j);
    }
  }
  return @pairs;
}

Now, I don’t have to test condition a) of the definition of a reverse pair, because the way I’m looping, 0 <= i < j < nums.length will always be true.

But you know what? That’s boring. I feel like, in Raku, at least, I should be able to make isReversePair() a method call on the array… and in Raku, I can. It took a little bit of searching for examples of how to extend the Array class, but I found it in the Raku Advent Calendar for Dec 8, 2013: Array-based Objects. In retrospect, it seems obvious that all I would need to do in a method to access the array elements is self[].

class ReversePairArray is Array {
  method isReversePair($i, $j) {
    return self[$i] > 2 * self[$j];
  }
}

sub findReversePairs(@arr) {
  my @pairs;
  my @rpArray := ReversePairArray.new(@arr);
  for 0 .. @rpArray.elems - 2 -> $i {
    for $i+1 .. @rpArray.elems - 1 -> $j {
      @pairs.push([$i, $j]) if @rpArray.isReversePair($i, $j);
    }
  }
  return @pairs;
}

The one thing that I’m glad the advent calendar entry addressed was the need for := instead of = if I wanted to use the sigil @ on my variable. Without the colon, a positional container (a variable with the sigil @) will be created as an empty Array whose contained values are then set to the list after the =. I could have used a $ for a variable that would hold any type and used a =, but I wanted to make this feel as array-like as possible.

View the entire Raku script for this task on GitHub.

Perl

sub isReversePair {
  my ($arr, $i, $j) = @_;
  return $arr->[$i] > 2 * $arr->[$j];
}

sub findReversePairs {
  my @arr = @_;
  my @pairs;
  foreach my $i ( 0 .. $#arr - 1) {
    foreach my $j ( $i+1 .. $#arr) {
      push @pairs, [$i, $j] if isReversePair(\@arr, $i, $j);
    }
  }
  return @pairs;
}

For Perl, however, I arrays aren’t built-in classes that I can easily override, so I’m just going with the boring function-based approach where I’m passing in a reference to the array and the two indices I’m checking.

If I was concerned with performance over expressiveness, I could just inline the condition and forgo the function isReversePair():

sub findReversePairs {
  my @arr = @_;
  my @pairs;
  foreach my $i ( 0 .. $#arr - 1) {
    foreach my $j ( $i+1 .. $#arr) {
      push @pairs, [$i, $j] if $arr[$i] > 2 * $arr[$j];
    }
  }
  return @pairs;
}

View the entire Perl script for this task on GitHub.

Python

from collections import UserList

class ReversePairArray(UserList):
    def isReversePair(self, i, j):
        return self.data[i] > 2 * self.data[j]

def findReversePairs(nums):
    pairs = []
    rpArray = ReversePairArray(nums)
    for i in range(0, len(nums) - 1):
        for j in range(i+1, len(nums)):
            if rpArray.isReversePair(i, j):
                pairs.append([i, j])
    return pairs

I had to do a bunch of Googling to figure out the best way to extend arrays, and it seems that collections.UserList was the best candidate:

This class acts as a wrapper around list objects. It is a useful base class for your own list-like classes which can inherit from them and override existing methods or add new ones. In this way, one can add new behaviors to lists.

View the entire Python script for this task on GitHub.


Task 2: Floor Sum

You are given an array of positive integers (>=1).

Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division.

Example 1

Input: @nums = (2, 5, 9)
Output: 10

floor(2 / 5) = 0
floor(2 / 9) = 0
floor(5 / 9) = 0
floor(2 / 2) = 1
floor(5 / 5) = 1
floor(9 / 9) = 1
floor(5 / 2) = 2
floor(9 / 2) = 4
floor(9 / 5) = 1

Example 2

Input: @nums = (7, 7, 7, 7, 7, 7, 7)
Output: 49

Approach

Another nested loop over an array. This time we’re just summing the results of performing integer division on each of the elements against each other. I don’t quite grok the arrangement of the explanatory text in Example 1; I feel like it should be sorted like this:

floor(2 / 2) = 1
floor(2 / 5) = 0
floor(2 / 9) = 0
floor(5 / 2) = 2
floor(5 / 5) = 1
floor(5 / 9) = 0
floor(9 / 2) = 4
floor(9 / 5) = 1
floor(9 / 9) = 1

For the second example, it’s just going to be dividing 7 by itself each time, yielding 1. Since there’s 7 elements in the input list, we’re doing this division 49 (72) times.

Raku

sub floorSum(@arr) {
  my $sum = 0;
  for 0 .. @arr.elems - 1 -> $i {
    for 0 .. @arr.elems - 1 -> $j {
      $sum += (@arr[$i] / @arr[$j]).truncate;
    }
  }
  return $sum;
}

View the entire Raku script for this task on GitHub.

Perl

sub floorSum {
  my @arr = @_;
  my $sum = 0;
  foreach my $i (0 .. $#arr) {
    foreach my $j (0 .. $#arr) {
      $sum += int($arr[$i] / $arr[$j]);
    }
  }
  return $sum;
}

View the entire Perl script for this task on GitHub.

Python

from math import trunc

def floorSum(nums):
    sum = 0;
    for i in range(0, len(nums)):
        for j in range(0, len(nums)):
            sum += trunc(nums[i] / nums[j])
    return sum

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

Perl Weekly Challenge: Flip the Missing Matrix Members

Is it bad that I’m getting frustrated that I’m not coming up with a musical inspiration for these two challenges? 😤

Task 1: Missing Members

You are given two arrays of integers.

Write a script to find out the missing members in each other arrays.

Example 1

Input: @arr1 = (1, 2, 3)
       @arr2 = (2, 4, 6)
Output: ([1, 3], [4, 6])

(1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
(2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).

Example 2

Input: @arr1 = (1, 2, 3, 3)
       @arr2 = (1, 1, 2, 2)
Output: ([3])

(1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since they are same, keep just one.
(1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).

Approach

Well, whenever we need to look for whether an element exists in a set, I think hashes. If we take the target array, hashify it, and then ask whether each element in the source array exists in that hash, we can easily find elements in the source missing from the target.

Raku

In Raku, that would look like this:

sub findMissing(@source, @target) {
  # convert the target into a hash with each element as keys
  my %targetHash = @target.map: * => 1;

  # see which elements in the source are not in the target
  my @missing;
  for @source -> $elem {
    if (%targetHash{$elem}:!exists) {
      @missing.push($elem);
    }
  }

  return @missing;
}

Remembering from Challenge 334 that

  • Testing for the existence of an element is the Subscript Adverb :exists.
  • If you try to use the construction ! $hash{$key}:exists, you get the error Precedence issue with ! and :exists, perhaps you meant :!exists? (I didn’t get an error with unless ($hash{$key}:exists), but I also wound up not getting the results I wanted.

But we need to call this twice to find the missing elements, and formatting the explanation will also be repetitive, so let’s put that in the subroutine, too:

use Lingua::Conjunction;

sub findMissing(@source, @target, @output, $explanation is rw) {
  # convert the target into a hash with each element as keys
  my %targetHash = @target.map: * => 1;

  # see which elements in the source are not in the target
  my @missing;
  for @source -> $elem {
    if (%targetHash{$elem}:!exists) {
      @missing.push($elem);
    }
  }

  # format output explaining what we found
  $explanation ~= "\n(" ~ @source.join(', ') ~ ") has ";
  $explanation ~= @missing.elems;
  $explanation ~= conjunction(@missing, :str(' member[|s] '));
  if (@missing.elems > 0) {
    $explanation ~= '(' ~ @missing.join(', ') ~ ') ';
    @output.push(@missing.unique);
  }
  $explanation ~= 'missing from the array ';
  $explanation ~= '(' ~ @target.join(', ') ~ ')';
}

sub findSolution(@arr1, @arr2, @output, $explanation is rw) {
  findMissing(@arr1, @arr2, @output, $explanation);
  findMissing(@arr2, @arr1, @output, $explanation);
}

Note I’m making the string parameter $explanation a read-write parameter by specifying is rw. I don’t have to do that for @output because arrays are passed by reference by default.

View the entire Raku script for this task on GitHub.

Perl

The Perl solution is basically the same, except we pass around references instead of read/write parameters.

use List::Util qw( uniq );

sub findMissing {
  my ($source, $target, $output, $explanation) = @_;

  # convert the target into a hash with each element as keys
  my %targetHash = map { $_ => 1 } @$target;

  # see which elements in the source are not in the target
  my @missing;
  foreach my $elem ( @$source ) {
    if (! exists $targetHash{$elem}) {
      push @missing, $elem;
    }
  }

  # format output explaining what we found
  $$explanation .= "\n(" . join(', ', @$source) . ") has ";
  $$explanation .= scalar(@missing);
  $$explanation .= @missing == 1 ? ' member ' : ' members ';
  if (scalar(@missing) > 0) {
    $$explanation .= '(' . join(', ', @missing) . ') ';
    push @$output, [ uniq @missing ];
  }
  $$explanation .= 'missing from the array ';
  $$explanation .= '(' . join(', ', @$target) . ')';
}

sub findSolution {
  my($arr1, $arr2, $output, $explanation) = @_;
  findMissing($arr1, $arr2, $output, $explanation);
  findMissing($arr2, $arr1, $output, $explanation);
}

View the entire Perl script for this task on GitHub.

Python

In Python, all passing is by value, which isn’t a problem for an object like an array, since the value that’s passed in is the reference to the object. But when a string is passed, the value of the string is passed, so any changes to the string are local to the function… unless we return the string as a return value. 😉

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

def findMissing(source, target, output, explanation):
    # convert the target into a map with each element as keys
    targetMap = { x: 1 for x in target }

    # see which elements in the source are not in the target
    missing = []
    for elem in source:
        if not elem in targetMap:
            missing.append(elem)

    # format output explaining what we found
    explanation += "\n(" + comma_join(source) + ") has "
    explanation += str(len(missing))
    explanation += ' member ' if len(missing) == 1 \
                              else ' members '
    if (len(missing) > 0):
        explanation += '(' + comma_join(missing) + ') '
        output.append(set(missing))
    explanation += 'missing from the array '
    explanation += '(' + comma_join(target) + ')'
    return explanation


def findSolution(arr1, arr2, output):
    explanation = ''
    explanation = findMissing(arr1, arr2, output, explanation)
    explanation = findMissing(arr2, arr1, output, explanation)
    return explanation

View the entire Python script for this task on GitHub.


Task 2: Flip Matrix

You are given n x n binary matrix.

Write a script to flip the given matrix as below.

1 1 0
0 1 1
0 0 1

a) Reverse each row

0 1 1
1 1 0
1 0 0

b) Invert each member

1 0 0
0 0 1
0 1 1

Example 1

Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])
Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])

Example 2

Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])
Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])

Approach

There isn’t much to this: reverse each row, then flip the bits.

Raku

sub flipMatrix(@matrix) {
  for @matrix -> @subarray {
    @subarray = @subarray.reverse.map: (* - 1).abs;
  }
  return @matrix;
}

I’m taking advantage of the digits only being 1 and 0 by subtracting 1 from the digit and then taking the absolute value to flip them: 1 becomes 1 - 1 then 0, and 0 becomes 0 - 1 then -1 then 1. The most challenging thing was getting the slurpy parameters correct on my solution function.

View the entire Raku script for this task on GitHub.

Perl

If anything, Perl was easier because there wasn’t any danger of automatically flattening the arrays:

sub flipMatrix {
  my(@matrix) = @_;
  foreach my $subarray ( @matrix ) {
    $subarray = [ map { abs($_ - 1) } reverse @$subarray ];
  }
  return @matrix;
}

View the entire Perl script for this task on GitHub.

Python

Python was slightly trickier because I wanted to modify the matrix while I was looping over it, and the way to do that is to access the array via indices:

def flipMatrix(matrix):
    for index in range(0, len(matrix)):
        matrix[index] = map(
            lambda i: abs(i - 1), reversed(matrix[index])
        )
    return matrix

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

Perl Weekly Challenge: Triplets Prime

From disappointing to worse: not only can’t I come up with a musical theme for this week, I just discovered that I didn’t submit my pull request for last week’s solutions, so they didn’t count. 😭

This week I have to make sure I get my entries in on time.


Task 1: Arithmetic Triplets

You are given an array (3 or more members) of integers in increasing order and a positive integer.

Write a script to find out the number of unique Arithmetic Triplets satisfying the following rules:

a) i < j < k
b) nums[j] - nums[i] == diff
c) nums[k] - nums[j] == diff

Example 1

Input: @nums = (0, 1, 4, 6, 7, 10)
       $diff = 3
Output: 2

Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 == 3.
Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 == 3.

Example 2

Input: @nums = (4, 5, 6, 7, 8, 9)
       $diff = 2
Output: 2

(0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
(1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.

Approach

Ok, we have two pieces of input: a list of integers in increasing order, and a target difference. We’re looking for three-element increasing order subsets from the list where the difference between the first and second and the second and third elements match the target difference.

It seems the most straightforward way to identify these triplets is to find pairs where the difference is the target difference, and then build triplets from those pairs.

Raku

sub findTriplets($diff, @nums) {
  my $count = 0;
  my $details = q{};
  for 0 .. @nums.elems - 3 -> $i {
    for $i + 1 .. @nums.elems - 2 -> $j {
      next unless @nums[$j] - @nums[$i] == $diff;
      for $j + 1 .. @nums.elems - 1 -> $k {
        next unless @nums[$k] - @nums[$j] == $diff;
        $count++;
        $details ~= "($i, $j, $k) is an arithmetic triplet "
          ~  "because both @nums[$k] - @nums[$j] = $diff "
          ~  "and @nums[$j] - @nums[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

Once again, I find myself chafing that I need to use @nums.elems - 1 to get the index of the last element in a Raku array. In Perl, it’s much easier.

View the entire Raku script for this task on GitHub.

Perl

sub findTriplets {
  my($diff, $nums) = @_;
  my $count = 0;
  my $details = q{};
  foreach my $i ( 0 .. $#$nums - 2 ) {
    foreach my $j ( $i + 1 .. $#$nums - 1 ) {
      next unless $nums->[$j] - $nums->[$i] == $diff;
      foreach my $k ( $j + 1 .. $#$nums ) {
        next unless $nums->[$k] - $nums->[$j] == $diff;
        $count++;
        $details .= "($i, $j, $k) is an arithmetic triplet "
          .  "because both $nums->[$k] - $nums->[$j] = $diff "
          .  "and $nums->[$j] - $nums->[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

View the entire Perl script for this task on GitHub.

Python

def findTriplets(diff, nums):
    count = 0
    details = ''
    for i in range(0, len(nums) - 2):
        for j in range(i + 1, len(nums) - 1):
            if not nums[j] - nums[i] == diff:
                continue
            for k in range(j + 1, len(nums)):
                if not nums[k] - nums[j] == diff:
                    continue
                count += 1
                details += (
                    f"({i}, {j}, {k}) is an arithmetic " +
                    f"triplet because both " +
                    f"{nums[k]} - {nums[j]} = {diff} and " +
                    f"{nums[j]} - {nums[i]} = {diff}\n"
                )
    return count, details

This screwed me up for a little while because my indentation on the innermost portion where I was counting results wasn’t properly lined up. This is one of my big complaints about Python: the lack of block delimiters, and all blocks being defined by indentation.

View the entire Python script for this task on GitHub.


Task 2: Prime Order

You are given an array of unique positive integers greater than 2.

Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

Example 1

Input: @int = (11, 8, 27, 4)
Output: (11, 4, 8, 27)

Prime factors of 11 => 11
Prime factors of  4 => 2, 2
Prime factors of  8 => 2, 2, 2
Prime factors of 27 => 3, 3, 3

Example 2 (added by me)

Input: @int = (2, 4, 8, 12, 11)
Output: (2, 11, 4, 8, 12)

Prime factors of  2 => 2
Prime factors of 11 => 11
Prime factors of  4 => 2, 2
Prime factors of  8 => 2, 2, 2
Prime factors of 12 => 2, 2, 3

Approach

Ok, so first we need to find the prime factors of a given integer. I had to look this up, but the algorithm to find the prime factors of N is:

  • Divide by 2 as many times as possible, checking to see if the remainder is 0
  • Loop from 3 to sqrt(N), dividing and checking to see if the remainder is 0
  • If the remaining number is still > 2, it’s a prime

Once we have a list of the prime factors, we need to sort by list size and numbers in the list.

Raku

First, the prime factor algorithm:

sub findPrimeFactors(Int $number) {
  my @factors;
  my $num = $number;
  while ( $num % 2 == 0 ) {
    @factors.push(2);
    $num /= 2;
  }
  for 3 .. sqrt($num).Int -> $i {
    while ( $num % $i == 0 ) {
      @factors.push($i);
      $num /= $i;
    }
  }
  if ($num > 2) {
    @factors.push($num);
  }
  return @factors;
}

Because we’re assigning to $num, I want it to be a copy of what we get passed in so we don’t change that variable. Now we use that to sort the numbers:

sub sortByPrimeFactors(@int) {
  my %primeFactors;
  # calculate the prime factors for each number
  for @int -> $n {
    %primeFactors{$n} = findPrimeFactors($n);
  }
  # now sort the numbers
  my @sorted = @int.sort({
    # first, sort by number of factors
    %primeFactors{$^a} <=> %primeFactors{$^b}
    ||
    # then sort by the value of the factors
    listCompare(%primeFactors{$^a}, %primeFactors{$^b})
  });
  # now build the output
  my $factors = q{};
  for @sorted -> $n {
    $factors ~= sprintf 'Prime factors of %2d => ', $n;
    $factors ~= %primeFactors{$n}.join(', ') ~ "\n";
  }
  return @sorted, $factors;
}

sub listCompare(@a, @b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i < @a.elems && @a[$i] == @b[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i >= @a.elems;

  return @a[$i] <=> @b[$i];
}

It isn’t an issue in the only example given, so I added another example where it would be an issue: if both lists of factors have the same number of elements, we need to compare the list items one by one until we get an inequality. 8 and 12 are perfect numbers for this, because their factor lists are (2, 2, 2) and (2, 2, 3), respectively, and we have to compare them out to the last element to find a difference.

View the entire Raku script for this task on GitHub.

Perl

The Perl solution is pretty much exactly the same.

sub findPrimeFactors {
  my $num = shift;
  my @factors;
  while ( $num % 2 == 0 ) {
    push @factors, 2;
    $num /= 2;
  }
  foreach my $i ( 3 .. int(sqrt($num)) ) {
    while ( $num % $i == 0 ) {
      push @factors, $i;
      $num /= $i;
    }
  }
  if ($num > 2) {
    push @factors, $num;
  }
  return @factors;
}

sub sortByPrimeFactors {
  my @int = @_;
  my %primeFactors;
  # calculate the prime factors for each number
  foreach my $n ( @int ) {
    $primeFactors{$n} = [ findPrimeFactors($n) ];
  }
  # now sort the numbers
  my @sorted = sort {
    # first, sort by number of factors
    $#{$primeFactors{$a}} <=> $#{$primeFactors{$b}}
    ||
    # then sort by the value of the factors
    listCompare($primeFactors{$a}, $primeFactors{$b})
  } @int;
  # now build the output
  my $factors = q{};
  foreach my $n ( @sorted ) {
    $factors .= sprintf 'Prime factors of %2d => ', $n;
    $factors .= join(', ', @{$primeFactors{$n}}) . "\n";
  }
  return \@sorted, $factors;
}

sub listCompare($a, $b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i <= $#{$a} && $a->[$i] == $b->[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i > $#{$a};

  return $a->[$i] <=> $b->[$i];
}

View the entire Perl script for this task on GitHub.

Python

import math

def findPrimeFactors(num):
    factors = []
    while num % 2 == 0:
        factors.append(2)
        num /= 2

    for i in range(3, int(math.sqrt(num))):
        while num % i == 0:
            factors.append(i)
            num /= i

    if num > 2:
        factors.append(int(num))

    return factors

def sortByPrimeFactors(nums):
    primeFactors = {}
    # calculate the prime factors for each number
    for n in nums:
        primeFactors[n] = findPrimeFactors(n)
    # now sort the numbers
    sorted_list = sorted(nums,
                         key=lambda x: (
                             len(primeFactors[x]),
                             primeFactors[x]
                         )
                        )

    # now build the output
    factors = ''
    for n in sorted_list:
        factors += f'Prime factors of {n:2d} => '
        as_list = ', '.join(
            map(lambda i: str(i), primeFactors[n])
        )
        factors += as_list + '\n'

    return sorted_list, factors

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

Perl Weekly Challenge: Building Acronym Arrays

This Perl Weekly Challenge didn’t lend itself to a song. Drat.

My learning Elixir is going to have to wait a few weeks; I’ve added some theatrical tech work to my evenings, so until I’m done with that, I’m just writing these solutions in the languages I know well.

Task 1: Acronym

You are given an array of strings and a check string.

Write a script to find out if the check string is the acronym of the words in the given array.

Example 1

Input: @str = ("Perl", "Python", "Pascal")
       $chk = "ppp"
Output: true

Example 2

Input: @str = ("Perl", "Raku")
       $chk = "rp"
Output: false

Example 3

Input: @str = ("Oracle", "Awk", "C")
       $chk = "oac"
Output: true

Approach

Pretty straightforward: go through each of the items in @str, grab the first character, append it to a string, then lowercase the result and compare it to the value of $chk. Easy-peasy.

Raku

Once again, I wanted to use Raku’s Reduction Metaoperator[ ], because it’s just so neat… but at first I couldn’t think of a way to get it to append the first character from each element without it just becoming the first character of the first and last elements. So I did this:

sub makeAcronym(@str) {
  my $acronym;
  for @str -> $s {
    $acronym ~= substr($s, 0, 1);
  }
  return $acronym.lc;
}

But then I was reading more that the reduction metaoperator gives the same result as the reduce routine, so I went and read up on that. And I saw the following:

When the list contains no elements, an exception is thrown, unless &with is an operator with a known identity value (e.g., the identity value of infix:<+> is 0). For this reason, you’re advised to prefix the input list with an initial value (or explicit identity value):

my \strings = "One good string!", "And one another good string!";
say reduce { $^a ~ $^b }, '', |strings;               # like strings.join 
 
my \numbers = 1, 2, 3, 4, 5;
say reduce { $^a > $^b ?? $^a !! $^b }, 0, |numbers; # like numbers.max 
 
sub count-and-sum-evens( (Int \count, Int \sum), Int \x ) {
    x %% 2 ?? (count+1, sum+x) !! (count, sum)
}
 
say reduce &count-and-sum-evens, (0, 0), |numbers;    # OUTPUT: «(2 6)␤»

Well, that made me think: if I reduced { $^a ~ substr($^b, 0, 1) } and made an empty string the first element of the list I was reducing, then the first time through the reduction my $^a string would be an empty string, and each subsequent time it would be the entirety of the acronym I was building. This got me to a new version:

sub makeAcronym(@str) {
  my $acronym = reduce { $^a ~ substr($^b, 0, 1) },
      ('', |@str);
  return $acronym.lc;
}

The |@str part took me a little while to grok: because ('', @str) winds up being represented internally as ['', [ 'one', 'two', 'three' ] ], I needed some way to flatten @str when it was being added to the list. I thought ('', @str.flat) would do what I wanted, but it didn’t. It turns out that if I was going to use .flat I needed to use ('', @str).flat. But then I realized it was staring me in the face in the documentation: |. This is a quick way to do a Slip:

Sometimes you want to insert the elements of a list into another list. This can be done with a special type of list called a Slip.

Another way to make a Slip is with the | prefix operator. Note that this has a tighter precedence than the comma, so it only affects a single value, but unlike the above options, it will break Scalars.

say (1, |(2, 3), 4) eqv (1, 2, 3, 4);        # OUTPUT: «True␤» 
say (1, |$(2, 3), 4) eqv (1, 2, 3, 4);       # OUTPUT: «True␤» 
say (1, slip($(2, 3)), 4) eqv (1, 2, 3, 4);  # OUTPUT: «True␤»

I was being thrown by the sample code in the reduce routine documentation because it didn’t use a @ sigil for its arrays.

Since I’d gotten it to work with reduce, could I get it to work with a reduction metaoperator? Sure. But because it wasn’t a single operator, I would need to wrap a call to a function instead:

sub firstOfSecond { $^a ~ substr($^b, 0, 1) };

sub makeAcronym(@str) {
  my $acronym = [[&firstOfSecond]] ('', |@str);
  return $acronym.lc;
}

I like that solution a lot. View the entire Raku script for this task on GitHub.

Perl

It turns out my Perl-fu is still greater than my Raku-fu, because turning the Raku code into Perl code just fell from my fingers:

use List::Util qw( reduce );

sub makeAcronym {
  my $str = shift;
  my $acronym = reduce { $a . substr($b, 0, 1) } '', @$str;
  return lc($acronym);
}

Mostly, it’s Perl’s proclivity to generate lists from scalars or arrays separated by commas. I didn’t have to do anything fancy to make sure that '', @$str was flattened to a list of scalars.
View the entire Perl script on GitHub.

Python

Because last week I was using functools.reduce, it was fresh on my mind.

from functools import reduce

def makeAcronym(str_list):
    # add empty string to beginning of list
    str_list = [''] + str_list
    acronym = reduce(lambda a, b: a + b[0], str_list)
    return acronym.lower()

View the entire Python script for this task on GitHub.


Task 2: Build Array

You are given an array of integers.

Write a script to create an array such that new[i] = old[old[i]] where 0 <= i < new.length.

Example 1

Input: @int = (0, 2, 1, 5, 3, 4)
Output: (0, 1, 2, 4, 5, 3)

Example 2

Input: @int = (5, 0, 1, 2, 3, 4)
Output: (4, 5, 0, 1, 2, 3)

Approach

This one feels weird. I think its the old[old[i]] construction that makes it a little confusing. I’m hoping that given the array old I’ll just be able to use old[old[i]] as I loop through the indices of the array and it will just produce the desired output.

I also don’t know why it specifies new.length instead of old.length, because if we’re building the array new, we don’t really know the length of the array before we start, and if we tried to have i >= old.length we’d get an out-of-bounds error (whether it was caught or not) when we tried to access old[i]. Oh, well.

Raku

sub buildArray(@old) {
  my @new;
  for 0 .. @old.elems - 1 -> $i {
    @new.push(@old[@old[$i]]);
  }
  return @new;
}

And it does produce the desired output. View the entire Raku script for this task on GitHub.

Perl

sub buildArray(@old) {
  my @new;
  foreach my $i (0 .. $#old) {
    push @new, $old[$old[$i]];
  }
  return @new;
}

One thing I like about Perl over Raku is being able to say $#old to get the index of the last element of an array instead of @old.elems - 1. View the entire Perl script on GitHub.

Python

def buildArray(old):
    new = []
    for i in range(0, len(old)):
        new.append(old[old[i]])
    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-240/packy-anderson