Perl Weekly Challenge: Sum Enchanted Evening

Sum enchanted evening… you’ll see a special number
You’ll see a special number, and you’ll sum its squares.
And somehow you know, you know even then,
That somehow you’re working on Perl Weekly Challenge 252!

Task 1: Special Numbers

You are given an array of integers, @ints.

Write a script to find the sum of the squares of all special elements of the given array.

An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0.
Where n is the length of the given array. Also the array is 1-indexed for the task.

Example 1

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

There are exactly 3 special elements in the given array:
$ints[1] since 1 divides 4,
$ints[2] since 2 divides 4, and
$ints[4] since 4 divides 4.

Hence, the sum of the squares of all special elements of given array:
1 * 1 + 2 * 2 + 4 * 4 = 21.

Example 2

Input: @ints = (2, 7, 1, 19, 18, 3)
Output: 63

There are exactly 4 special elements in the given array:
$ints[1] since 1 divides 6,
$ints[2] since 2 divides 6,
$ints[3] since 3 divides 6, and
$ints[6] since 6 divides 6.

Hence, the sum of the squares of all special elements of given array:
2 * 2 + 7 * 7 + 1 * 1 + 3 * 3 = 63

Approach

Well, if you’ve been following me, you know I’m going to break this up into smaller functions. I’m also borrowing code I wrote for Perl Weekly Challenge 229.

Raku

sub specialElementIndices($n) {
  return (1 .. $n).grep({ $n % $_ == 0 });
}

# code borrowed from my code for PWC 229
sub english_list ( *@list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = @list.pop(); # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = @list.join(qq{,\n});
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined ~= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  my $n = @ints.elems;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices.elems;
  my @explain_list = @specialIndices.map({
    "\$ints[$_] since $_ divides $n"
  });
  my $explain = "There are exactly $count special elements "
    ~ "in the given array:\n" ~ english_list(@explain_list);

  # find the special numbers themselves
  my @special = @specialIndices.map({ @ints[$_ - 1] });

  # find the sum of the squares
  my $sum = @special.map({ $_ ** 2 }).sum;

  $explain ~= "\nHence, the sum of the squares of all special "
    ~ "elements of given array:\n"
    ~ @special.map({ "$_ * $_" }).join(' + ')
    ~ " = " ~ $sum;

  return (
    $sum,
    $explain
  );
}

View the entire Raku script for this task on GitHub.

Perl

Nothing really changes in the Perl implementation except the normal syntax changes from Raku to Perl…

use List::Util qw( sum );

sub specialElementIndices($n) {
  return grep { $n % $_ == 0 } 1 .. $n;
}

sub english_list ( @list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = pop @list; # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = join qq{,\n}, @list;
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined .= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  # in scalar context, an array evaluates to the number
  # of elements in the array
  my $n = @ints;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices;
  my @explain_list = map {
    "\$ints[$_] since $_ divides $n"
  } @specialIndices;
  my $explain = "There are exactly $count special elements "
    . "in the given array:\n" . english_list(@explain_list);

  # find the special numbers themselves
  my @special = map { $ints[$_ - 1] } @specialIndices;

  # find the sum of the squares
  my $sum = sum( map { $_ ** 2 } @special);

  $explain .= "\nHence, the sum of the squares of all special "
    . "elements of given array:\n"
    . join(' + ', map { "$_ * $_" } @special)
    . " = " . $sum;

  return (
    $sum,
    $explain
  );
}

View the entire Perl script for this task on GitHub.

Python

Mostly what tripped me up going from Raku to Python was the lack of sigils meaning I couldn’t give variables the same names as built-in functions.

def specialElementIndices(n):
    return list( filter(lambda x: n % x == 0, range(1, n+1)) )

def english_list (strlist):
    # given a list, join it in a way that makes sense
    # to english speakers
    last = strlist.pop(-1) # last element in array
    if (len(strlist) == 0):
        # using an array in a scalar context returns
        # the number of elements in the array

        # there was only one element in the list
        return last

    joined = ',\n'.join(strlist)
    if (len(strlist) > 1):
        # if there's more than element, add an Oxford comma
        joined += ','

    return f'{joined} and\n{last}'

def specialNumberSquareSum(ints):
    n = len(ints)

    # find the list of indices for "special" numbers
    specialIndices = specialElementIndices(n)
    count = len(specialIndices)
    explain_list = [
        f"$ints[{x}] since {x} divides {n}"
        for x in specialIndices
    ] 
    explain = (
        "There are exactly $count special elements " +
        "in the given array:\n" + english_list(explain_list)
    )

    # find the special numbers themselves
    special = [ ints[x - 1] for x in specialIndices ]

    # find the sum of the squares
    sumval = sum([ x ** 2 for x in special ])

    explain += '\nHence, the sum of the squares of all special '
    explain += 'elements of given array:\n'
    explain += ' + '.join(map(lambda x: f'{x} * {x}', special))
    explain += f' = {sumval}'

    return (
        sumval,
        explain
    )

View the entire Python script for this task on GitHub.


Task 2: Unique Sum Zero

You are given an integer, $n.

Write a script to find an array containing $n unique integers such that they add up to zero.

Example 1

Input: $n = 5
Output: (-7, -1, 1, 3, 4)

Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).

Example 2

Input: $n = 3
Output: (-1, 0, 1)

Example 3

Input: $n = 1
Output: (0)

Approach

This one is a little more challenging. Looking at the examples, I can see that when $n is 1, the array has to be ( 0 ). When $n is 3, the array needs to be ( -x, 0, x ) where x is some positive integer. We can extrapolate that when $n is 2, array needs to be ( -x, x ) where x is some positive integer. As $n gets larger, the number of possible arrays gets larger: the example output arrays have the form ( -(x+y), -z, z, x, y ) and ( -x, -y, z, -z, x+y ).

Rather than generate permutations of $n unique integers and check them to see if they sum to 0, I think I’m going to take the approach of generating a list I know will sum to 0 ahead of time:

  • If $n is odd, push 0 onto the list and decrement $n by one
  • set $x to 1
  • if $n is still greater than 0, push -$x and $x onto the list, then decrement $n by two and increment $x by one
  • repeat the last step until $n is equal to 0

With this algorithm, my output winds up being:

Example 1:
Input: $n = 5
Output: (-2, -1, 0, 1, 2)

Example 2:
Input: $n = 3
Output: (-1, 0, 1)

Example 3:
Input: $n = 1
Output: (0)

But for $n = 2, the output would be (-1, 1), and for $n = 4, the output would be
(-2, -1, 1, 2).

Raku

Because subroutine parameters are read-only (and you can mark them read-write with is rw only if what’s being passed into them is a writable object, not a numeric constant, I’m copying the value from the parameter to a working variable.

sub uniqueSumZero($input) {
  my $n = $input;
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      @list.push(0);
      $n -= 1;
    }
    else { # $n is even
      @list.append($x * -1, $x);
      $x += 1;
      $n -= 2;
    }
  }
  return @list.sort;
}

View the entire Raku script for this task on GitHub.

Perl

Perl, however, doesn’t have the problem with the subroutine parameter being read-only, so I can modify $n to my heart’s content.

sub uniqueSumZero($n) {
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      push @list, 0;
      $n--;
    }
    else { # $n is even
      push @list, $x * -1, $x;
      $x++;
      $n -= 2;
    }
  }
  return sort { $a <=> $b } @list;
}

View the entire Perl script for this task on GitHub.

Python

def uniqueSumZero(n):
    zero_sum_list = []
    x = 1
    while n > 0:
        if (n % 2 == 1): # n is odd
            zero_sum_list.append(0)
            n -= 1
        else: # n is even
            zero_sum_list.append(x * -1)
            zero_sum_list.append(x)
            x += 1
            n -= 2
    zero_sum_list.sort()
    return zero_sum_list

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

Perl Weekly Challenge: Luck Concatenate Numbers Tonight!

Tonight’s musical mood: Luck Be A Lady!

Onward to Perl Weekly Challenge 251!


Task 1: Concatenation Value

You are given an array of integers, @ints.

Write a script to find the concatenation value of the given array.

The concatenation of two numbers is the number formed by concatenating their numerals.

For example, the concatenation of 10, 21 is 1021.
The concatenation value of @ints is initially equal to 0.
Perform this operation until @ints becomes empty:

If there exists more than one number in @ints, pick the first element and last element in @ints respectively and add the value of their concatenation to the concatenation value of @ints, then delete the first and last element from @ints.

If one element exists, add its value to the concatenation value of @ints, then delete it.

Example 1

Input: @ints = (6, 12, 25, 1)
Output: 1286

1st operation: concatenation of 6 and 1 is 61
2nd operation: concatenation of 12 and 25 is 1225

Concatenation Value => 61 + 1225 => 1286

Example 2

Input: @ints = (10, 7, 31, 5, 2, 2)
Output: 489

1st operation: concatenation of 10 and 2 is 102
2nd operation: concatenation of 7 and 2 is 72
3rd operation: concatenation of 31 and 5 is 315

Concatenation Value => 102 + 72 + 315 => 489

Example 3

Input: @ints = (1, 2, 10)
Output: 112

1st operation: concatenation of 1 and 10 is 110
2nd operation: only element left is 2

Concatenation Value => 110 + 2 => 112

Approach

I know there’s an iterative approach that’s probably more efficient, but when I saw the definition of how to do calculate the concatenation value of an array of integers, my brain flew back to being a 15-year-old learning how to program, and discovering the wonders of… recursion.

Edit: It occurs to me that seeing Niklaus Wirth’ obituary probably also inspired me, because part and parcel of my discovering recursion when I was 15 was learning Pascal, my favorite programming language before Perl (also the second or third (I don’t remember if it was BASIC, Pascal, then COBOL, or BASIC, COBOL, then Pascal)).

Raku

sub concatenationValue(@ints) {
  return 0        if @ints.elems == 0; # no elements
  return @ints[0] if @ints.elems == 1; # one element

  my $first = @ints.shift; # first element
  my $last  = @ints.pop;   # last element
  my $concat = "$first$last".Int; # concatenate and convert

  return $concat + concatenationValue(@ints);
}

View the entire Raku script for this task on GitHub.

Perl

Once again I got to trot out the “adding 0 to a string to make it clear I’m converting it into a numeric value” trick, and I also got to show how evaluating an array in scalar context (the @ints == 0 and @ints == 1) yields the number of elements in the array.

sub concatenationValue(@ints) {
  return 0        if @ints == 0; # no elements
  return $ints[0] if @ints == 1; # one element

  my $first = shift @ints; # first element
  my $last  = pop @ints;   # last element
  my $concat = "$first$last"+0; # concatenate and convert

  return $concat + concatenationValue(@ints);
}

View the entire Perl script for this task on GitHub.

Python

The only thing to point out here is Python’s pop method, which removes the element at the position specified by the parameter. If the parameter is omitted, it removes and returns the last value in the array, but since I had to specify position 0 to get the first element, I figured it was symmetrical to specify -1 to explicitly get the last value.

def concatenationValue(ints):
    if len(ints) == 0: # no elements
        return 0
    if len(ints) == 1: # one element
        return ints[0]

    first = ints.pop(0);  # first element
    last  = ints.pop(-1); # last element
    concat = int(f"{first}{last}") # concatenate and convert

    return concat + concatenationValue(ints)

View the entire Python script for this task on GitHub.


Task 2: Lucky Numbers

You are given a m x n matrix of distinct numbers.

Write a script to return the lucky number, if there is one, or -1 if not.

A lucky number is an element of the matrix such that it is
the minimum element in its row and maximum in its column.

Example 1

Input: $matrix = [ [ 3,  7,  8],
                   [ 9, 11, 13],
                   [15, 16, 17] ];
Output: 15

15 is the only lucky number since it is the minimum in its row
and the maximum in its column.

Example 2

Input: $matrix = [ [ 1, 10,  4,  2],
                   [ 9,  3,  8,  7],
                   [15, 16, 17, 12] ];
Output: 12

Example 3

Input: $matrix = [ [7 ,8],
                   [1 ,2] ];
Output: 7

Approach

Since the definition of the problem states that the numbers are distinct (the same number will not appear twice in the matrix), we can break this down into two problems: find the minimum elements in each row, and find the maximum elements in each column. If a value appears in both lists, we have our lucky number.

Getting the minimum in each row is easy, but getting the max in each column is a little more work; what I’m going to do is rotate the matrix so the rows are now columns and the columns are now rows, and just take the max value from what are now rows in the matrix.

Raku

sub maxCols(@matrix) {
  my @rotated; # rotate cols to rows
  for @matrix -> @row {
    for @row.kv -> $k, $v {
      @rotated[$k].push($v);
    }
  }
  # return the max of the now rows!
  return @rotated.map({ $_.max() });
}

sub luckyNumber(@matrix) {
  my @minRows = @matrix.map({ $_.min() });
  my @maxCols = maxCols(@matrix);
  return ( @minRows (&) @maxCols ) // -1;
}

View the entire Raku script for this task on GitHub.

Perl

Perl doesn’t have built-in min, max, or intersection operators, so we need to pull them in from the CPAN modules Array::Utils and List::Util (though List::Util is in the core).

use Array::Utils qw( intersect );
use List::Util qw( min max );

sub maxCols(@matrix) {
  my @rotated; # rotate cols to rows
  foreach my $row ( @matrix ) {
    foreach my $k ( 0 .. $#{$row} ) {
      my $v = $row->[$k];
      push @{$rotated[$k]}, $v;
    }
  }
  # return the max of the now rows!
  return map { max( @$_ ) } @rotated;
}

sub luckyNumber(@matrix) {
  my @minRows = map { min( @$_ ) } @matrix;
  my @maxCols = maxCols(@matrix);
  # intersect() returns an array, so get the first element
  return (intersect( @minRows, @maxCols ))[0] // -1;

View the entire Perl script for this task on GitHub.

Python

For my Python solution, I was able to do it entirely using built-in functions.

def maxCols(matrix):
    # initialize rotated with empty row for each column
    rotated = [ [] for col in matrix[0] ]
    for row in matrix:
        for k, v in enumerate(row):
            rotated[k].append(v)
    # return the max of the now rows!
    return [ max(row) for row in rotated ]

def luckyNumber(matrix):
    mRows = [ min(row) for row in matrix ]
    mCols = maxCols(matrix)
    intersection = list( set(mRows) & set(mCols) )
    if intersection:
        return intersection[0]
    else:
        return -1

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

Two-Hundred Fifty Perl Weekly Challenges! Two-Hundred Fifty problems so clear…

Yeah, I’m trying to get back to music for the theme of the post, and for some reason the number 250 made me think of a song from Rent

If PWC runs for 525,600 weeks, that will be over ten thousand years. I can dream that we’re still using Perl or Raku that long. Anyway, onward to Perl Weekly Challenge 250!


Task 1: Smallest Index

You are given an array of integers, @ints.

Write a script to find the smallest index i such that i mod 10 == $ints[i] otherwise return -1.

Example 1

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

i=0: 0 mod 10 = 0 == $ints[0].
i=1: 1 mod 10 = 1 == $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
All indices have i mod 10 == $ints[i], so we return the smallest index 0.

Example 2

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

i=0: 0 mod 10 = 0 != $ints[0].
i=1: 1 mod 10 = 1 != $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
i=3: 3 mod 10 = 3 != $ints[3].
2 is the only index which has i mod 10 == $ints[i].

Example 3

Input: @ints = (1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
Output: -1
Explanation: No index satisfies i mod 10 == $ints[i].

Approach

When I was thinking about this problem, I found myself asking “Why are we doing i mod 10? So the list can’t be more than 10 elements long?” No, I realized: so the elements are only single digits. Take a look at example 3: if we line them up so we can see what the indices are next to the values, we can see that none of the values match the indices.

ints[0] = 1
ints[1] = 2
ints[2] = 3
ints[3] = 4
ints[4] = 5
ints[5] = 6
ints[6] = 7
ints[7] = 8
ints[8] = 9
ints[9] = 0

But what if we inserted another value before the end? What if the end looked like this?

ints[8]  = 9
ints[9]  = 8
ints[10] = 0

Suddenly, we’d have i mod 10 == 0, which would be the value of the final element. This also makes the comparison slightly more interesting than “find the minimal value for i where i = ints[i]“.

Initially, I was leaning towards using a map to generate all the possible cases where i = ints[i] and then use min to get the smallest one, but a voice in my head said “You’re looping over all the values anyway… just find the first one and exit when you find it. It’s faster.”

Raku

sub smallestIndex(@ints) {
  for 0 .. @ints.end -> $i {
    return $i if ($i mod 10) == @ints[$i];
  }
  return -1;
}

View the entire Raku script for this task on GitHub.

Perl

Again, the Perl version is almost identical to the Raku version: the modulo operator is % instead of mod, the for loop is structured differently, and we have to use $ as the sigil to access individual array elements.

sub smallestIndex(@ints) {
  foreach my $i ( 0 .. $#ints ) {
    return $i if ($i % 10) == $ints[$i];
  }
  return -1;
}

View the entire Perl script for this task on GitHub.

Python

As always, I need to remind myself that a) Python’s range function goes up to but does not include the largest value, and b) if you only pass a single value, the range starts at 0. So range(4) returns the range 0, 1, 2, 3.

def smallestIndex(ints):
    for i in range(len(ints)):
        if (i % 10) == ints[i]:
            return i
    return -1

View the entire Python script for this task on GitHub.


Task 2: Alphanumeric String Value

You are given an array of alphanumeric strings.

Write a script to return the maximum value of alphanumeric string in the given array.

The value of alphanumeric string can be defined as

a) The numeric representation of the string in base 10 if it is made up of digits only.
b) otherwise the length of the string

Example 1

Input: @alphanumstr = ("perl", "2", "000", "python", "r4ku")
Output: 6

"perl" consists of letters only so the value is 4.
"2" is digits only so the value is 2.
"000" is digits only so the value is 0.
"python" consists of letters so the value is 6.
"r4ku" consists of letters and digits so the value is 4.

Example 2

Input: @alphanumstr = ("001", "1", "000", "0001")
Output: 1

Approach

This could probably be done in a single loop, but I want to make things clearer and easier to read, so I’m breaking it out into two parts: a function that, given a string, returns its value according to the criteria above, and then a map that calls that function for each string in an array to generate an array of string values, and we can use max to find the largest value. See? I got to use my map!

Raku

sub alphanumValue($str) {
  if ($str ~~ /^\d+$/) {
    return Int($str);
  }
  return $str.chars;
}

sub maxAlphanumValue(@alphanumstr) {
  my @values = @alphanumstr.map({ alphanumValue($_) });
  return @values.max;
}

View the entire Raku script for this task on GitHub.

Perl

Perl doesn’t have a max function built in, so I’m using the one everybody uses in List::Util. Also, I’m using the old trick of adding 0 to a string to convert it explicitly into a numeric value.

use List::Util qw( max );

sub alphanumValue($str) {
  if ($str =~ /^\d+$/) {
    return $str + 0;
  }
  return length($str);
}

sub maxAlphanumValue(@alphanumstr) {
  my @values = map { alphanumValue($_) } @alphanumstr;
  return max(@values);
}

View the entire Perl script for this task on GitHub.

Python

For the Python solution, I’m pre-compiling the regular expression once outside the alphanumValue function. I could have done that in Raku or Perl for a minor performance gain, but I’m doing it here because the cleanest way to do the match is to compile the regex to an re object and then call .match() on that object with the string. Since we needed to compile it separately from the match call, it made sense to put that compile outside the function so it’s only done once. In Raku and Perl, the compiling takes place automagically, so doing it separately doesn’t look as clean.

import re

is_numeric = re.compile('^\d+$')

def alphanumValue(strval):
    if (is_numeric.match(strval)):
        return int(strval)
    return len(strval)

def maxAlphanumValue(alphanumstr):
    values = [ alphanumValue(x) for x in alphanumstr ]
    return max(values)

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

Perl Weekly Challenge: Stringy DI and Paired Equals

I dunno. I saw “DI string” and thought of Lady Di. It’s Christmas. I’m full of yummy Christmas food and not firing on all cylinders.

Onward to Perl Weekly Challenge 249!

Task 1: Equal Pairs

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

Write a script to divide the given array into equal pairs such that:

a) Each element belongs to exactly one pair.
b) The elements present in a pair are equal.

Example 1

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

There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the conditions.

Example 2

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

There is no way to divide @ints 2 pairs such that the pairs satisfy every condition.

Approach

Ok, this reminds me of PWC 237’s Task 2, where we wound up counting the integers in our input list and subtracting them from that count instead of pulling them off a list. In this case, I think a similar approach would work: loop over the input list and count up how many of each integer we have. If we don’t have an even number of each integer, we can fail immediately because we can’t satisfy condition b. Then we pull integers off the count by twos.

Raku

sub equalPairs(@ints) {
  my @pairs;
  my %num_count;
  # count how many of each int we have
  for @ints -> $num {
    %num_count{$num}++;
  }
  # first, make sure we have even numbers of each integer
  for %num_count.kv -> $k, $v {
    next if $v % 2 == 0; # it's even, we can make pairs
    return @pairs; # we have an odd number, can't make pairs
  }
  # now make pairs from those integers
  for %num_count.kv -> $k, $v {
    my $count = $v; # the values $k, $v are read-only
    while ($count > 0) {
      @pairs.push( [$k, $k] );
      $count -= 2;
    }
  }
  return @pairs;
}

View the entire Raku script for this task on GitHub.

Perl

sub equalPairs(@ints) {
  my @pairs;
  my %num_count;
  # count how many of each int we have
  foreach my $num ( @ints ) {
    $num_count{$num}++;
  }
  # first, make sure we have even numbers of each integer
  foreach my $k ( keys %num_count ) {
    my $v = $num_count{$k};
    next if $v % 2 == 0; # it's even, we can make pairs
    return @pairs; # we have an odd number, can't make pairs
  }
  # now make pairs from those integers
  foreach my $k ( keys %num_count ) {
    my $count = $num_count{$k};
    while ($count > 0) {
      push @pairs, [$k, $k];
      $count -= 2;
    }
  }
  return @pairs;
}

View the entire Perl script for this task on GitHub.

Python

from collections import Counter

def equalPairs(nums):
    pairs = []
    num_count = Counter()
    # count how many of each int we have
    for num in nums:
        num_count[num] += 1

    # first, make sure we have even numbers of each integer
    for k, v in dict(num_count).items():
        if v % 2 == 0: # it's even, we can make pairs
            continue
        else:
            return pairs # we have an odd number, no pairs

    # now make pairs from those integers
    for k, v in dict(num_count).items():
        count = v # the values k, v are read-only
        while count > 0:
            pairs.append( [k, k] )
            count -= 2

    return pairs

View the entire Python script for this task on GitHub.


Task 2: DI String Match

You are given a string s, consisting of only the characters "D" and "I".

Find a permutation of the integers [0 .. length(s)] such that for each character s[i] in the string:

s[i] == 'I' ⇒ perm[i] < perm[i + 1]
s[i] == 'D' ⇒ perm[i] > perm[i + 1]

Example 1

Input: $str = "IDID"
Output: (0, 4, 1, 3, 2)

Example 2

Input: $str = "III"
Output: (0, 1, 2, 3)

Example 3

Input: $str = "DDI"
Output: (3, 2, 0, 1)

Approach

Again, this reminds me of PWC 237’s Task 2, this time because we sorted the integers so we could pull maximum and minimum integers off a list. In this case, the range 0 .. length(s) is sorted already, but we would take a similar approach to building the output permutation list: if the letter is D, we pull the maximum number off the end of the list, guaranteeing that it will be greater than anything that could come after it. If the letter is I, we pull the minimum number off the beginning of the list, guaranteeing that it will be less than anything that could come after it.

Raku

sub diStringMatch($str) {
  my @permutation;
  # first, generate the list of integers
  # we're making permutations of
  my @nums = 0 .. $str.chars;
  # now let's generate our permutation
  for $str.split('', :skip-empty) -> $c {
    if ($c eq 'D') {
      # take the largest number available
      @permutation.push( @nums.pop() );
    }
    else {
      # take the smallest number available
      @permutation.push( @nums.shift() );
    }
  }
  # add last remaining number
  @permutation.push( @nums[0] );

  return @permutation;
}

View the entire Raku script for this task on GitHub.

Perl

sub diStringMatch($str) {
  my @permutation;
  # first, generate the list of integers
  # we're making permutations of
  my @nums = 0 .. length($str);
  # now let's generate our permutation
  foreach my $c ( split(//, $str) ) {
    if ($c eq 'D') {
      # take the largest number available
      push @permutation, pop(@nums);
    }
    else {
      # take the smallest number available
      push @permutation, shift(@nums);
    }
  }
  # add last remaining number
  push @permutation, $nums[0];

  return @permutation;
}

View the entire Perl script for this task on GitHub.

Python

def diStringMatch(str):
    permutation = []
    # first, generate the list of integers
    # we're making permutations of
    nums = list(range(len(str)+1))
    # now let's generate our permutation
    for c in str:
        if c == 'D':
            # take the largest number available
            permutation.append( nums.pop(-1) )
        else:
            # take the smallest number available
            permutation.append( nums.pop(0) )
    # add last remaining number
    permutation.append( nums[0] )

    return permutation

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

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