Yesterday, I tackled PWC 267 Task 1. Today I took on PWC 267 Task 2.
Continue readingTag Archives: perl-weekly-challenge
Perl Weekly Challenge: Now with Elixir!
One of the things I want to challenge myself to do is learn some more useful things, and one of the languages they’re using at work is Elixir. It’s a functional language, not a procedural language like Perl, so this is not only learning a new language but it’s learning a new way to think about code.
Since I can’t really learn by just reading about a language or watching a bunch of excellent videos one of my coworkers produced, I decided that I needed to start doing the Perl Weekly Challenge tasks in Elixir. Today, I’m tackling PWC 267 Task 1.
Continue readingPerl Weekly Challenge: It’s the Product Line Sign that Counts
Task 1: Product Sign
You are given an array of @ints.
Write a script to find the sign of product of all integers in the given array. The sign is 1 if the product is positive, -1 if the product is negative and 0 if product is zero.
Example 1
Input: @ints = (-1, -2, -3, -4, 3, 2, 1)
Output: 1
The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0
Example 2
Input: @ints = (1, 2, 0, -2, -1)
Output: 0
The product 1 x 2 x 0 x -2 x -1 => 0
Example 3
Input: @ints = (-1, -1, 1, -1, 2)
Output: -1
The product -1 x -1 x 1 x -1 x 2 => -2 < 0
Approach
Really, this is just doing a list multiplication operator on the list, and then comparing the result to zero.
Raku
As soon as I saw the task, I knew this was going to be Raku’s Reduction Metaoperator with multiplication([*]). Also, if the product isn’t 0, I can get the desired sign by just dividing the product by its absolute value. I’m spending more lines of code formatting the explanatory text than I am calculating the result.
sub productSign(@ints) {
my $product = [*] @ints;
my $sign = $product == 0 ?? 0
!! $product/abs($product);
my $explain = 'The product ' ~ @ints.join(' × ')
~ " => $product";
if ($sign < 0) {
$explain ~= " < 0";
}
elsif ($sign > 0) {
$explain ~= " > 0";
}
return ($sign, $explain);
}
$ raku/ch-1.raku
Example 1:
Input: @arr = (-1, -2, -3, -4, 3, 2, 1)
Output: 1
The product -1 × -2 × -3 × -4 × 3 × 2 × 1 => 144 > 0
Example 2:
Input: @arr = (1, 2, 0, -2, -1)
Output: 0
The product 1 × 2 × 0 × -2 × -1 => 0
Example 3:
Input: @arr = (-1, -1, 1, -1, 2)
Output: -1
The product -1 × -1 × 1 × -1 × 2 => -2 < 0
View the entire Raku script for this task on GitHub.
Perl
Since Perl doesn’t have a reduction metaoperator built in, we just pull in the reduce function from List::Util.
use List::Util qw( reduce );
sub productSign(@ints) {
my $product = reduce { $a * $b } @ints;
my $sign = $product == 0 ? 0
: $product/abs($product);
my $explain = 'The product ' . join(' × ', @ints)
. " => $product";
if ($sign < 0) {
$explain .= " < 0";
}
elsif ($sign > 0) {
$explain .= " > 0";
}
return ($sign, $explain);
}
View the entire Perl script for this task on GitHub.
Python
Similarly, in Python we’s use the reduce function from functools.
def productSign(ints):
product = reduce(lambda a, b: a * b, ints)
sign = 0 if product == 0 else int(product / abs(product))
explain = (
'The product ' + ' × '.join(map(lambda i: str(i), ints))
+ ' => ' + str(product)
)
if (sign < 0): explain += " < 0"
if (sign > 0): explain += " > 0"
return (sign, explain)
View the entire Python script for this task on GitHub.
Task 2: Line Counts
You are given a string, $str, and a 26-items array @widths containing the width of each character from a to z.
Write a script to find out the number of lines and the width of the last line needed to display the given string, assuming you can only fit 100 width units on a line.
Example 1
Input: $str = "abcdefghijklmnopqrstuvwxyz"
@widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (3, 60)
Line 1: abcdefghij (100 pixels)
Line 2: klmnopqrst (100 pixels)
Line 3: uvwxyz (60 pixels)
Example 2
Input: $str = "bbbcccdddaaa"
@widths = (4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (2, 4)
Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)
Approach
One of the things I’ve started to notice about the challenge is that the tasks are related. They’re usually the same kind of operation, applied to numbers in one task and strings in the other. This task really feels like it could be a list reduction of some sort. Let’s look at how a reduction works…
A reduction operation takes some two-argument function and passes it the first two elements of a list, and then takes the result and the next element and passes that to the function, and so on until the list is exhausted.
In our case, the function would accept a line and a character, and it would check to see how many pixels adding the character would make the line. If it would be <= 100 pixels, the character is added to the line. If it would be > 100 pixels, the existing line is flushed to output along with its length, and a new line is started with the character and its width.
Raku
For Raku, I’m building the hash of widths with the Zip metaoperator. However, it produces a list that looks like [(a 4) (b 10) (c 10) (d 10) .. , so to turn it into a Hash, I want to flatten it.
sub lineCounts($str, @widths) {
my ($lines, $last_line, $last_width, $explain) =
(0, '', 0, '');
my %width = ('a' .. 'z' Z @widths).flat.Hash;
for $str.comb -> $c {
if ($last_width + %width{$c} > 100) {
$lines++;
$explain ~= "\nLine $lines: $last_line "
~ "($last_width pixels)";
($last_line, $last_width) = ($c, %width{$c});
}
else {
$last_line ~= $c;
$last_width += %width{$c};
}
}
$lines++;
$explain ~= "\nLine $lines: $last_line "
~ "($last_width pixels)";
return ($lines, $last_width, $explain);
}
$ raku/ch-2.raku
Example 1:
Input: $str = "abcdefghijklmnopqrstuvwxyz"
@widths = (10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10)
Output: (3, 60)
Line 1: abcdefghij (100 pixels)
Line 2: klmnopqrst (100 pixels)
Line 3: uvwxyz (60 pixels)
Example 2:
Input: $str = "bbbcccdddaaa"
@widths = (4, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10)
Output: (2, 4)
Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)
Example 3:
Input: $str = "thequickbrownfoxjumpedoverthelazydog"
@widths = (7, 8, 7, 8, 7, 5, 8, 8, 4, 4, 8, 4, 12, 8, 8, 8, 8, 5, 6, 4, 8, 8, 12, 8, 8, 7)
Output: (3, 65)
Line 1: thequickbrownf (100 pixels)
Line 2: oxjumpedovert (95 pixels)
Line 3: helazydog (65 pixels)
View the entire Raku script for this task on GitHub.
Perl
In Perl, rather that use List::Util‘s zip, we’re going to use mesh, because it produces a flattened list by default, where zip returns a list of array references.
use List::Util qw( mesh );
sub lineCounts($str, @widths) {
my ($lines, $last_line, $last_width, $explain) =
(0, '', 0, '');
my %width = mesh ['a' .. 'z'], \@widths;
foreach my $c ( split //, $str ) {
if ($last_width + $width{$c} > 100) {
$lines++;
$explain .= "\nLine $lines: $last_line "
. "($last_width pixels)";
($last_line, $last_width) = ($c, $width{$c});
}
else {
$last_line .= $c;
$last_width += $width{$c};
}
}
$lines++;
$explain .= "\nLine $lines: $last_line "
. "($last_width pixels)";
return ($lines, $last_width, $explain);
}
View the entire Perl script for this task on GitHub.
Python
In Python, however, zip is built in, and can be passed to dict to build a dictionary.
def lineCounts(strvar, widths):
(lines, last_line, last_width, explain) = (0, '', 0, '')
# we can't do a range of characters, but we can do a range
# of the ASCII values of the characters
letters = [ chr(c) for c in range(ord('a'), ord('z')+1) ]
width = dict( zip(letters, widths) )
for c in strvar:
if last_width + width[c] > 100:
lines += 1
explain += f"\nLine {lines}: {last_line} "
explain += f"({last_width} pixels)"
(last_line, last_width) = (c, width[c])
else:
last_line += c
last_width += width[c]
lines += 1
explain += f"\nLine {lines}: {last_line} "
explain += f"({last_width} pixels)"
return (lines, last_width, explain)
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-267/packy-anderson
Perl Weekly Challenge: A Matrix of Uncommon X Words
Today’s musical theme has nothing to do with the tasks; it’s just that earlier this week I heard Crosby, Stills, Nash & not-at-this-point-in-time-Young’s Wasted on the Way, and it got stuck in my head on loop while I was writing this.
Onward to Perl Weekly Challenge 266!
Task 1: Uncommon Words
You are given two sentences, $line1 and $line2.
Write a script to find all uncommon words in any order in the given two sentences. Return ('') if none found.
A word is uncommon if it appears exactly once in one of the sentences and doesn’t appear in other sentence.
Example 1
Input: $line1 = 'Mango is sweet'
$line2 = 'Mango is sour'
Output: ('sweet', 'sour')
Example 2
Input: $line1 = 'Mango Mango'
$line2 = 'Orange'
Output: ('Orange')
Example 3
Input: $line1 = 'Mango is Mango'
$line2 = 'Orange is Orange'
Output: ('')
Approach
The straightforward way to do this is to count up the occurrences of words in each line and return a list of those that occur only once, and then run the same operation on the union of those two lists.
Raku
Once again, I drew inspiration this week from reading laurent_r’s solution to one of last week’s tasks. He used a Raku type called a Bag, which is ❝a collection of distinct elements in no particular order that each have an integer weight assigned to them signifying how many copies of that element are considered “in the bag”.❞ Really, it got me reading up on Sets, Bags, and Mixes in Raku.
sub occursOnce($line) {
# create a Bag of all words
my $all = $line.comb(/\w+/).Bag;
# create a list of words that occur once in the Bag
return $all.keys.grep({ $all{$_} == 1 });
}
sub uncommonWords($line1, $line2) {
# create a Bag of words that occur once in each line
my $all = occursOnce($line1).Bag ⊎ occursOnce($line2).Bag;
# return a list of words that occur once in that Bag
return $all.keys.grep({ $all{$_} == 1 });
}
$ raku/ch-1.raku
Example 1:
Input: $line1 = 'Mango is sweet'
$line2 = 'Mango is sour'
Output: ('sour', 'sweet')
Example 2:
Input: $line1 = 'Mango Mango'
$line2 = 'Orange'
Output: ('Orange')
Example 3:
Input: $line1 = 'Mango is Mango'
$line2 = 'Orange is Orange'
Output: ('')
View the entire Raku script for this task on GitHub.
Perl
Perl doesn’t have Bags, but it does have a Hash, and we can use that just like a Bag with a little more work. I also realized that I could just join the list of words that occurred once into a new line and reuse the occursOnce() function again to find the words that only appear in one or the other line, not both. I didn’t go back and change my Raku implementation, though, mostly because I like using the unicode ⊎ operator.
sub occursOnce($line) {
# create a hash counting the words
my %all;
$all{$_}++ for split(/\s+/, $line);
# create a list of words that occur once in the hash
return grep { $all{$_} == 1 } keys %all;
}
sub uncommonWords($line1, $line2) {
return occursOnce(
join(' ', occursOnce($line1), occursOnce($line2))
);
}
View the entire Perl script for this task on GitHub.
Python
Then, reading the documentation for the Counter type in the collections module, I noticed that if you passed a list to the instantiator, it initializes the Counter using that list, much like Raku’s Bag.
from collections import Counter
def occursOnce(line):
# create a Counter of all words
all = Counter(line.split())
# create a list of words that occur once in the Counter
return [ word for word in list(all) if all[word] == 1 ]
def uncommonWords(line1, line2):
return occursOnce(
' '.join(occursOnce(line1) + occursOnce(line2))
)
View the entire Python script for this task on GitHub.
Task 2: X Matrix
You are given a square matrix, $matrix.
Write a script to find if the given matrix is X Matrix.
A square matrix is an X Matrix if all the elements on the main diagonal and antidiagonal are non-zero and everything else are zero.
Example 1
Input: $matrix = [ [1, 0, 0, 2],
[0, 3, 4, 0],
[0, 5, 6, 0],
[7, 0, 0, 1],
]
Output: true
Example 2
Input: $matrix = [ [1, 2, 3],
[4, 5, 6],
[7, 8, 9],
]
Output: false
Example 3
Input: $matrix = [ [1, 0, 2],
[0, 3, 0],
[4, 0, 5],
]
Output: true
Approach
This one is basically going through arrays and examining values. The hardest part of this problem is figuring out which elements are on the diagonals. If we have a 1×1 matrix or a 2×2 matrix, every element is on a diagonal. For a 3×3 matrix, the diagonals are elements 0 and 2 on rows 0 and 2, and element 1 on row 1. For a 4×4 matrix, the diagonals are elements 0 and 3 on rows 0 and 3, and elements 1 and 2 on rows 1 and 2.
So, for an NxN matrix, diagonal elements are 0 and N-1 for rows 0 and N-1, 1 and N-2 for rows 1 and N-2, 2 and N-3 for rows 2 and N-3 and so on until the counts overlap.
We can come up with a function to determine if an element in a matrix is on a diagonal:
isDiagonal(x, y, N):
return true if N == 1 or N == 2
return true if x == y
return true if x + y == N - 1
return false
Raku
One of the great things about Raku is you can call kv on a List, and you’ll get back an interleaved sequence of indexes and values.
sub isDiagonal($x, $y, $N) {
return (
$N == 1 || $N == 2 || $x == $y || $x + $y == $N - 1
);
}
sub isXMatrix(@matrix) {
my $N = @matrix.elems;
for @matrix.kv -> $y, @row {
for @row.kv -> $x, $value {
# fail if diagonal values are zero or
# non-diagonal values are non-zero
return False
unless isDiagonal($x, $y, $N) == ($value != 0);
}
}
return True;
}
$ raku/ch-2.raku
Example 1:
Input: $matrix = [
[1, 0, 0, 2],
[0, 3, 4, 0],
[0, 5, 6, 0],
[7, 0, 0, 1]
]
Output: True
Example 2:
Input: $matrix = [
[1, 2, 3],
[4, 5, 6],
[7, 8, 9]
]
Output: False
Example 3:
Input: $matrix = [
[1, 0, 2],
[0, 3, 0],
[4, 0, 5]
]
Output: True
Example 4:
Input: $matrix = [
[1, 0, 0, 0, 1],
[0, 1, 0, 1, 0],
[0, 0, 1, 0, 0],
[0, 1, 0, 1, 0],
[1, 0, 0, 0, 1]
]
Output: True
Example 5:
Input: $matrix = [
[1, 0, 1, 0, 1],
[0, 1, 0, 1, 0],
[0, 0, 1, 0, 0],
[0, 1, 0, 1, 0],
[1, 0, 0, 0, 1]
]
Output: False
Example 6:
Input: $matrix = [
[1, 1],
[1, 1]
]
Output: True
Example 7:
Input: $matrix = [
[1, 0],
[1, 1]
]
Output: False
View the entire Raku script for this task on GitHub.
Perl
For Perl, all we have to do is change the syntax of the for loops to loop over indices, and extract the values manually.
sub isDiagonal($x, $y, $N) {
return (
$N == 1 || $N == 2 || $x == $y || $x + $y == $N - 1
);
}
sub isXMatrix(@matrix) {
my $N = scalar @matrix;
foreach my $y ( 0 .. $#matrix ) {
my @row = @{$matrix[$y]};
foreach my $x ( 0 .. $#row ) {
my $value = $row[$x];
# fail if diagonal values are zero or
# non-diagonal values are non-zero
return 0
unless isDiagonal($x, $y, $N) == ($value != 0);
}
}
return 1;
}
View the entire Perl script for this task on GitHub.
Python
Python’s enumerate function, however, works like Raku’s kv.
def isDiagonal(x, y, N):
return (
N == 1 or N == 2 or x == y or x + y == N - 1
)
def isXMatrix(matrix):
N = len(matrix)
for y, row in enumerate(matrix):
for x, value in enumerate(row):
# fail if diagonal values are zero or
# non-diagonal values are non-zero
if isDiagonal(x, y, N) != (value != 0):
return False
return True
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-266/packy-anderson
Perl Weekly Challenge: Completing a Third of an Appearance
Tonight’s musical accompaniment was Billy Joel: The 100th – Live at Madison Square Garden. Without being interrupted in the middle of Piano Man.
So, let’s hope we don’t break away to out local affiliate before the end of this week’s Perl Weekly Challenge!
Task 1: 33% Appearance
You are given an array of integers, @ints.
Write a script to find an integer in the given array that appeared 33% or more. If more than one found, return the smallest. If none found then return undef.
Example 1
Input: @ints = (1,2,3,3,3,3,4,2)
Output: 3
1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.
3 appeared 50% (>33%) in the given array.
Example 2
Input: @ints = (1,1)
Output: 1
1 appeared 2 times.
1 appeared 100% (>33%) in the given array.
Example 3
Input: @ints = (1,2,3)
Output: 1
1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.
Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.
Approach
Ok, we’re counting how many times individual integers appear in an array. That sounds like a hash to me. Make a pass through the array, counting the occurrences of each integer, and when we’re done we divide by the number of elements in the array to get percentages. We could then use something like min to find the smallest.
BUT… we know before we loop through the array how many times an integer will have to appear to meet the threshold. We’re not looking for the integer that occurred the most times, only for the smallest one that occurred at least 1/3 of the time. So we pre-calculate the 1/3 value, and as we’re counting, if the count for an integer is greater than the 1/3 value and smaller than the last integer whose count was greater than the 1/3 value, we save it as the output value.
Raku
sub oneThirdAppearance(@ints) {
my Int $smallest;
my Rat $oneThird = @ints.elems / 3;
my Int %seen;
for @ints -> $i {
if (++%seen{$i} >= $oneThird) {
if (! $smallest.defined || $i < $smallest) {
$smallest = $i;
}
}
}
return $smallest;
}
$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 2, 3, 3, 3, 3, 4, 2)
Output: 3
Example 2:
Input: @ints = (1, 1)
Output: 1
Example 3:
Input: @ints = (1, 2, 3)
Output: 1
View the entire Raku script for this task on GitHub.
Perl
Because an array evaluated in a scalar context returns the size of the array, all we need to determine the oneThird threshold is to fivide the array by 3:
sub oneThirdAppearance(@ints) {
my $smallest;
my $oneThird = @ints / 3;
my %seen;
foreach my $i ( @ints ) {
if (++$seen{$i} >= $oneThird) {
if (! defined($smallest) || $i < $smallest) {
$smallest = $i;
}
}
}
return $smallest;
}
View the entire Perl script for this task on GitHub.
Python
As always, when I’m counting things in Python, I use the Counter type in the collections module.
from collections import Counter
def oneThirdAppearance(ints):
smallest = None
oneThird = len(ints) / 3
seen = Counter()
for i in ints:
seen[i] += 1
if seen[i] >= oneThird:
if smallest is None or i < smallest:
smallest = i
return smallest
View the entire Python script for this task on GitHub.
Task 2: Completing Word
You are given a string, $str, containing alphanumeric characters and an array of strings (alphabetic characters only), @str.
Write a script to find the shortest completing word. If none found return empty string.
A completing word is a word that contains all the letters in the given string, ignoring space and number. If a letter appeared more than once in the given string then it must appear the same number or more in the word.
Example 1
Input: $str = 'aBc 11c'
@str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'
The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times
The only string in the given array that satisfies the condition is 'accbbb'.
Example 2
Input: $str = 'Da2 abc'
@str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'
The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times
The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.
Shortest of the two is 'baacd'
Example 3
Input: $str = 'JB 007'
@str = ('jj', 'bb', 'bjb')
Output: 'bjb'
The given string contains following, ignoring case and number:
j 1 times
b 1 times
The only string in the given array that satisfies the condition is 'bjb'.
Approach
I’m sure there’s a clever way to accomplish this, but I’m just going to plow through a straightforward way. Counting the letters again seems like a job for a hash, and we’re going to have to generate this hash not only for $str but for each string in @str, so it seems useful to make a function for generating the hash. Then we compare the hash generated by $str against the hashes for each of the strings in @str: if there’s any letters missing, or if a letter in the string doesn’t occur at least as many times it does in the target, the string is disqualified. Finally, we only keep the shortest string that met the criteria.
Raku
Last week, reading laurent_r’s solutions for PWC 264’s task 1, I saw a couple of things what I wanted to take note of: rather than using .split('', :skip-empty) to split a string into a list of characters, he used .comb. Also, he used grep with a lower case character class to filter out just the lower case characters in the input. If we pass $str.lc.comb into the grep, we’ll just get back just the letters, regardless of case.
sub letterCounts($str) {
my %counts;
map { %counts{$_}++ }, (grep { / <lower> / }, $str.lc.comb);
return %counts;
}
sub completingWord($str, @str) {
my %target = letterCounts($str);
my $shortest;
CANDIDATE: for @str -> $s {
my %candidate = letterCounts($s);
for %target.kv -> $c, $i {
next CANDIDATE # skip this candidate
unless %candidate{$c}:exists # this letter exists
&& %candidate{$c} >= $i; # at least as many times
}
if (! $shortest.defined || $s.chars < $shortest.chars) {
$shortest = $s;
}
}
return $shortest // q{};
}
$ raku/ch-2.raku
Example 1:
Input: $str = 'aBc 11c'
@str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'
Example 2:
Input: $str = 'Da2 abc'
@str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'
Example 3:
Input: $str = 'JB 007'
@str = ('jj', 'bb', 'bjb')
Output: 'bjb'
View the entire Raku script for this task on GitHub.
Perl
My first instinct was to use each %target in Perl the same way I used %target.kv, but when I tried, I discovered that I’d forgotten a big caveat of each:
The iterator used by
eachis attached to the hash or array, and is shared between all iteration operations applied to the same hash or array. Thus all uses ofeachon a single hash or array advance the same iterator location. All uses ofeachare also subject to having the iterator reset by any use ofkeysorvalueson the same hash or array, or by the hash (but not array) being referenced in list context. This makeseach-based loops quite fragile: it is easy to arrive at such a loop with the iterator already part way through the object, or to accidentally clobber the iterator state during execution of the loop body. It’s easy enough to explicitly reset the iterator before starting a loop, but there is no way to insulate the iterator state used by a loop from the iterator state used by anything else that might execute during the loop body. To avoid these problems, use aforeachloop rather thanwhile–each.
When I had while ( my($c, $i) = each %target ), it would only loop through %target once, and for subsequent candidates it would skip the loop entirely.
sub letterCounts($str) {
my %counts;
map { $counts{$_}++ } grep { /[a-z]/ } split //, lc($str);
return %counts;
}
sub completingWord($str, @str) {
my %target = letterCounts($str);
my $shortest;
CANDIDATE: foreach my $s ( @str ) {
my %candidate = letterCounts($s);
foreach my $c ( keys %target ) {
my $i = $target{$c};
next CANDIDATE # skip this candidate
unless exists $candidate{$c} # this letter exists
&& $candidate{$c} >= $i; # at least as many times
}
if (! defined($shortest) || length($s) < length($shortest)) {
$shortest = $s;
}
}
return $shortest // q{};
}
View the entire Perl script for this task on GitHub.
Python
In Python, we can make the string all lowercase with lower() and filter for just letters by using isalpha(). Because we can’t break out to an outer loop from inside an inner loop, I’m using an isCandidate boolean flag to track whether a candidate is still valid to be considered the shortest candidate.
from collections import Counter
def letterCounts(strVal):
counts = Counter()
for c in strVal.lower():
if c.isalpha():
counts[c] += 1
return counts
def completingWord(targetStr, candidateStrs):
targetCounts = letterCounts(targetStr)
shortest = None
for s in candidateStrs:
candidateCounts = letterCounts(s)
isCandidate = True
for c, i in targetCounts.items():
# this letter does not exist
if ( not c in candidateCounts
or # occurs fewer times
candidateCounts[c] < i):
isCandidate = False
if (isCandidate and
(shortest is None or len(s) < len(shortest))):
shortest = s
return shortest
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-265/packy-anderson
Perl Weekly Challenge: I’m The Greatest Target!
The first task in this challenge started with the words “Greatest English”. When I think of “greatest” and “English”, it should be obvious that my mind immediately jumps to… Ringo Starr. It may be John Lennon’s song, but it was on Ringo’s album.
Anyway, enough Beatles blather. Onward to PWC 264!
Task 1: Greatest English Letter
You are given a string, $str, made up of only alphabetic characters [a..zA..Z].
Write a script to return the greatest english letter in the given string.
A letter is greatest if it occurs as lower and upper case. Also letter ‘b’ is greater than ‘a’ if ‘b’ appears after ‘a’ in the English alphabet.
Example 1
Input: $str = 'PeRlwEeKLy'
Output: L
There are two letters E and L that appears as lower and upper.
The letter L appears after E, so the L is the greatest english letter.
Example 2
Input: $str = 'ChaLlenge'
Output: L
Example 3
Input: $str = 'The'
Output: ''
Approach
I saw this and I figured that I could accomplish this with a single pass through the string by maintaining a hash of the characters we’d seen already, and if we’d already seen the swapped case version of the character, we could add it to a list of “greatest” characters. Once we’d gone through the string, we could just use a max function to get the greatest character in that last and return it.
Raku
I already knew how to do this in Perl—using the tr operator—and I figured there would be a corresponding way to do it in Raku. Sure enough, the Str class has a trans method. In addition, the max method on the Any class doesn’t care what type the elements are because it uses the smart cmp operator semantics to find the largest element in the List.
sub greatestEnglishLetter($str) {
my %seen;
my @greatest;
# find the characters that exist as both
# upper and lower case in the string
for $str.split('', :skip-empty) -> $c {
# note that we've seen the character
%seen{$c} = 1;
# swap the case of the character
my $C = $c.trans(
['a' .. 'z', 'A' .. 'Z'] => ['A' .. 'Z', 'a' .. 'z']
);
# if we've seen the swapped case version of the char,
# add the uppercase version to our greatest hits
@greatest.push: $c.uc if %seen{$C}:exists;
}
# if we found greatest characters,
# return the greater of them
if (@greatest) {
return @greatest.max;
}
# otherwise, return something that
# represents an empty result
return q{''};
$ raku/ch-1.raku
Example 1:
Input: $str = 'PeRlwEeKLy'
Output: L
Example 2:
Input: $str = 'ChaLlenge'
Output: L
Example 3:
Input: $str = 'The'
Output: ''
View the entire Raku script for this task on GitHub.
Perl
The Perl version is a little more compact. We do need to pull in the maxstr function from List::Util, however. Note that I’m using the non-destructive /r option on the tr operator.
use List::Util qw( maxstr );
sub greatestEnglishLetter($str) {
my %seen;
my @greatest;
# find the characters that exist as both
# upper and lower case in the string
foreach my $c ( split //, $str ) {
# note that we've seen the character
$seen{$c} = 1;
# swap the case of the character
my $C = ($c =~ tr/a-zA-Z/A-Za-z/r);
# if we've seen the swapped case version of the char,
# add the uppercase version to our greatest hits
push @greatest, uc($c) if exists $seen{$C};
}
# if we found greatest characters,
# return the greater of them
if (@greatest) {
return maxstr(@greatest);
}
# otherwise, return something that
# represents an empty result
return q{''};
}
View the entire Perl script for this task on GitHub.
Python
Because Python loves to borrow all of Perl’s useful functionality, I knew there had to be a tr equivalent somewhere… and I found it in the translate method on the Str type. There’s even a static maketrans method on the Str type that allows you to create a translation table you can pass into translate. The syntax isn’t as concise as Perl’s (or Raku’s, for that matter), but it wasn’t too bad.
# make a translation table to switch the case of
# English letters
transTable = str.maketrans(
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
)
def greatestEnglishLetter(strVar):
seen = {}
greatest = []
# find the characters that exist as both
# upper and lower case in the string
for c in strVar:
# note that we've seen the character
seen[c] = 1
# swap the case of the character
C = c.translate(transTable)
# if we've seen the swapped case version of the char,
# add the uppercase version to our greatest hits
if C in seen:
greatest.append(c.upper())
# if we found greatest characters,
# return the greater of them
if greatest:
return max(greatest)
# otherwise, return something that
# represents an empty result
return "''"
View the entire Python script for this task on GitHub.
Task 2: Target Array
You are given two arrays of integers, @source and @indices. The @indices can only contains integers 0 <= i < size of @source.
Write a script to create target array by insert at index $indices[i] the value $source[i].
Example 1
Input: @source = (0, 1, 2, 3, 4)
@indices = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)
@source @indices @target
0 0 (0)
1 1 (0, 1)
2 2 (0, 1, 2)
3 2 (0, 1, 3, 2)
4 1 (0, 4, 1, 3, 2)
Example 2
Input: @source = (1, 2, 3, 4, 0)
@indices = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)
@source @indices @target
1 0 (1)
2 1 (1, 2)
3 2 (1, 2, 3)
4 3 (1, 2, 3, 4)
0 0 (0, 1, 2, 3, 4)
Example 3
Input: @source = (1)
@indices = (0)
Output: (1)
Approach
This is just a single loop through the @indices list to build the @target list. The “trickiest” part is inserting into the @target list at arbitrary locations, not just the beginning or the end.
Raku
Fortunately, in Raku there’s an Array routine for that: splice. It’s supposed to replace elements in an array, but if you specify a zero length for the replacement, it winds up just inserting elements without removing any.
sub targetArray(@source, @indices) {
my @target;
my @explain;
for 0..@indices.end -> $i {
@target.splice(@indices[$i], 0, @source[$i]);
@explain.push: [
@source[$i], @indices[$i], @target.clone
];
}
return @target, @explain;
}
$ raku/ch-2.raku
Example 1:
Input: @source = (0, 1, 2, 3, 4)
@indicies = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)
@source @indices @target
0 0 (0)
1 1 (0, 1)
2 2 (0, 1, 2)
3 2 (0, 1, 3, 2)
4 1 (0, 4, 1, 3, 2)
Example 2:
Input: @source = (1, 2, 3, 4, 0)
@indicies = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)
@source @indices @target
1 0 (1)
2 1 (1, 2)
3 2 (1, 2, 3)
4 3 (1, 2, 3, 4)
0 0 (0, 1, 2, 3, 4)
Example 3:
Input: @source = (1)
@indicies = (0)
Output: (1)
@source @indices @target
1 0 (1)
View the entire Raku script for this task on GitHub.
Perl
For Perl the biggest change is passing around array references rather than arrays.
sub targetArray($source, $indices) {
my @target;
my @explain;
foreach my $i ( 0 .. $#{$indices}) {
splice(@target, $indices->[$i], 0, $source->[$i]);
push @explain, [
$source->[$i], $indices->[$i], [ @target ]
];
}
return \@target, \@explain;
}
View the entire Perl script for this task on GitHub.
Python
In Python, the method for inserting elements into lists at arbitrary locations is named, appropriately enough, insert.
def targetArray(source, indices):
target = []
explain = []
for i in range(len(indices)):
target.insert(indices[i], source[i])
explain.append([
source[i], indices[i], target.copy()
])
return target, explain
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-264/packy-anderson
Perl Weekly Challenge: Merge the Target Index Items
For some reason, my brain conflated “index” with “reflex”, so this week’s musical theme is The Reflex by Duran Duran. Yeah, I remember when that was on the radio.
Onward to Perl Weekly Challenge 263!
Task 1: Target Index
You are given an array of integers, @ints and a target element $k.
Write a script to return the list of indices in the sorted array where the element is same as the given target element.
Example 1
Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
Output: (1, 2)
Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (1, 2) as $ints[1] = 2 and $ints[2] = 2
Example 2
Input: @ints = (1, 2, 4, 3, 5), $k = 6
Output: ()
No element in the given array matching the given target.
Example 3
Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
Output: (4)
Sorted array: (1, 2, 2, 3, 4, 5)
Target index: (4) as $ints[4] = 4
Approach
The approach here is pretty straightforward: sort the list, then scan for entries where the value matches the target. There’s probably a clever way to do it, but it’s not coming to me, and I’ve always stressed ease of implementation and comprehension over cleverness in my solutions.
Raku
In Raku, we can use the kv routine on lists to loop over the sorted list of ints and have both the index and the value at that index.
sub targetIndex($k, @ints) {
my @sorted = @ints.sort;
my $explain = 'Sorted array: (' ~ @sorted.join(', ') ~ ")\n";
my @output;
for @sorted.kv -> $i, $v {
next unless $v == $k;
@output.push($i);
}
if (@output == 0) {
$explain ~= 'No element in the given array matching '
~ 'the given target.';
}
else {
$explain ~= 'Target indices: (' ~ @output.join(', ')
~ ') as ';
my @explain_indices = @output.map({ "\$ints[$_] = $k"});
$explain ~= @explain_indices.join(' and ');
}
return $explain, @output;
}
$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
Output: (1 2)
Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (1, 2) as $ints[1] = 2 and $ints[2] = 2
Example 2:
Input: @ints = (1, 2, 4, 3, 5), $k = 6
Output: ()
Sorted array: (1, 2, 3, 4, 5)
No element in the given array matching the given target.
Example 3:
Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
Output: (4)
Sorted array: (1, 2, 2, 3, 4, 5)
Target indices: (4) as $ints[4] = 4
View the entire Raku script for this task on GitHub.
Perl
In Perl, however, we just loop over the indices as $i and use $sorted[$i] to access the values at those indices.
sub targetIndex($k, @ints) {
my @sorted = sort @ints;
my $explain = 'Sorted array: (' . join(', ', @sorted) . ")\n";
my @output;
foreach my $i (0 .. $#sorted) {
next unless $sorted[$i] == $k;
push @output, $i;
}
if (@output == 0) {
$explain .= 'No element in the given array matching '
. 'the given target.';
}
else {
$explain .= 'Target indices: (' . join(', ', @output)
. ') as ';
my @explain_indices = map { "\$ints[$_] = $k"} @output;
$explain .= join(' and ', @explain_indices);
}
return $explain, @output;
}
View the entire Perl script for this task on GitHub.
Python
In Python, we get to use the enumerate function I last used back in PWC251.
def comma_join(arr):
return ', '.join(map(lambda i: str(i), arr))
def targetIndex(k, ints):
sortedArray = sorted(ints)
explain = f'Sorted array: ({comma_join(sortedArray)})\n'
output = []
for i, v in enumerate(sortedArray):
if v == k:
output.append(i)
if len(output) == 0:
explain += 'No element in the given array matching '
explain += 'the given target.'
else:
explain += f'Target indices: ({comma_join(output)}) as '
explain_indices = [ f'$ints[{i}] = {k}' for i in output ]
explain += ' and '.join(
map(lambda i: str(i), explain_indices)
)
return explain, output
View the entire Python script for this task on GitHub.
Task 2: Merge Items
You are given two 2-D array of positive integers, $items1 and $items2 where element is pair of (item_id, item_quantity).
Write a script to return the merged items.
Example 1
Input: $items1 = [ [1,1], [2,1], [3,2] ]
$items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]
Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
Item id (3) appears 1 time: [3,2]
Example 2
Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
$items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]
Example 3
Input: $items1 = [ [1,1], [2,2], [3,3] ]
$items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]
Approach
This feels like a wonderful thing to use a hash for: as we loop through the pairs and use the item_id as the hash key and just add item_quantity to the hash value.
Raku
sub mergeItems(@items1, @items2) {
my %merged;
# loop over the items and add item_quantities (element 1)
# to the count for each item_id (element 0)
for (slip(@items1), slip(@items2)) -> @i {
%merged{@i[0]} += @i[1];
}
# re-render the hash as a 2D array
return %merged.keys.sort.map({ [ $_, %merged{$_} ] });
}
$ raku/ch-2.raku
Example 1:
Input: $items1 = [ [1,1], [2,1], [3,2] ]
$items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]
Example 2:
Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
$items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]
Example 3:
Input: $items1 = [ [1,1], [2,2], [3,3] ]
$items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]
View the entire Raku script for this task on GitHub.
Perl
sub mergeItems($items1, $items2) {
my %merged;
# loop over the items and add item_quantities (element 1)
# to the count for each item_id (element 0)
foreach my $i (@$items1, @$items2) {
$merged{$i->[0]} += $i->[1];
}
# re-render the hash as a 2D array
return [ map { [ $_, $merged{$_} ] } sort keys %merged ];
}
View the entire Perl script for this task on GitHub.
Python
As always, when I’m counting things in Python, I use the Counter type in the collections module. I also found that the chain function in itertools:
Make an iterator that returns elements from the first iterable until it is exhausted, then proceeds to the next iterable, until all of the iterables are exhausted. Used for treating consecutive sequences as a single sequence.
def mergeItems(items1, items2):
merged = Counter()
# loop over the items and add item_quantities (element 1)
# to the count for each item_id (element 0)
for i in chain(items1, items2):
merged[ i[0] ] += i[1]
# re-render the hash as a 2D array
return [ [i, v] for i, v in merged.items() ]
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-263/packy-anderson
Perl Weekly Challenge: Counting to the Max!
Tonight’s music doesn’t have anything to do with the tasks; it’s just the soundtrack while I was writing up, as my wife calls it, “my cooking blog”.
Onward to the solutions for Perl Weekly Challenge 262!
Task 1: Max Positive Negative
You are given an array of integers, @ints.
Write a script to return the maximum number of either positive or negative integers in the given array.
Example 1
Input: @ints = (-3, 1, 2, -1, 3, -2, 4)
Output: 4
Count of positive integers: 4
Count of negative integers: 3
Maximum of count of positive and negative integers: 4
Example 2
Input: @ints = (-1, -2, -3, 1)
Output: 3
Count of positive integers: 1
Count of negative integers: 3
Maximum of count of positive and negative integers: 3
Example 3
Input: @ints = (1,2)
Output: 2
Count of positive integers: 2
Count of negative integers: 0
Maximum of count of positive and negative integers: 2
Approach
Really, this is two loops over the array of integers. One to count positive ints, one to count negative ints. If I do a map of the array each time and return 1 for each int I want to count and 0 for each int I don’t want to count, I can do the counting with a sum operator.
Raku
Like last week, we use Raku’s Reduction Metaoperator with addition ([+]) for the summation, and the max routine on the Any class to pick the maximum.
sub maxPosNeg(@ints) {
my $pos = [+] @ints.map({ $_ > 0 ?? 1 !! 0 });
my $neg = [+] @ints.map({ $_ < 0 ?? 1 !! 0 });
my $max = max $pos, $neg;
return (
$max,
(
"Count of positive integers: $pos",
"Count of negative integers: $neg",
"Maximum of count of positive and " ~
"negative integers: $max"
).join("\n")
);
}
Yes, it looks like Perl.
$ raku/ch-1.raku
Example 1:
Input: @arr = (-3, 1, 2, -1, 3, -2, 4)
Output: 4
Count of positive integers: 4
Count of negative integers: 3
Maximum of count of positive and negative integers: 4
Example 2:
Input: @arr = (-1, -2, -3, 1)
Output: 3
Count of positive integers: 1
Count of negative integers: 3
Maximum of count of positive and negative integers: 3
Example 3:
Input: @arr = (1, 2)
Output: 2
Count of positive integers: 2
Count of negative integers: 0
Maximum of count of positive and negative integers: 2
View the entire Raku script for this task on GitHub.
Perl
In Perl, we can get max and sum from List::Util.
sub maxPosNeg(@ints) {
my $pos = sum map { $_ > 0 ? 1 : 0 } @ints;
my $neg = sum map { $_ < 0 ? 1 : 0 } @ints;
my $max = max $pos, $neg;
return (
$max,
join("\n",
"Count of positive integers: $pos",
"Count of negative integers: $neg",
"Maximum of count of positive and " .
"negative integers: $max"
)
);
}
View the entire Perl script for this task on GitHub.
Python
For Python, sum and max are built in and don’t need to be pulled in from a library.
def maxPosNeg(ints):
pos = sum([1 for i in ints if i > 0])
neg = sum([1 for i in ints if i < 0])
maxCount = max(pos, neg)
return (
maxCount,
"\n".join([
f"Count of positive integers: {pos}",
f"Count of negative integers: {neg}",
f"Maximum of count of positive and " +
f"negative integers: {maxCount}"
])
)
View the entire Python script for this task on GitHub.
Task 2: Count Equal Divisible
You are given an array of integers, @ints and an integer $k.
Write a script to return the number of pairs (i, j) where
a) 0 <= i < j < size of @ints
b) ints[i] == ints[j]
c) i x j is divisible by k
Example 1
Input: @ints = (3,1,2,2,2,1,3) and $k = 2
Output: 4
(0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
(2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
(2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
(3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
Example 2
Input: @ints = (1,2,3) and $k = 1
Output: 0
Approach
Ok, let’s look at these criteria:
0 <= i < j < size of @ints. For a 0-indexed array, it means that both i and j are indices of the array (the 0 <= and < size of @ints parts) and that i < j. Not a big deal.
ints[i] == ints[j] means the numbers at these indices are the same. So Example 2 fails this criteria because none of the numbers are the same.
i x j is divisible by k. Really, this is the big condition.
As with the last task, we’re counting.
Raku
Here I’m leaning into the Raku looking like Perl.
sub countEquDiv($k, @ints) {
my @explain;
my $cnt = 0;
for 0 .. @ints.end - 1 -> $i {
for $i + 1 .. @ints.end -> $j {
# does ints[i] == ints[j]?
next unless @ints[$i] == @ints[$j];
# is i x j divisible by k?
next unless ( ($i * $j) mod $k ) == 0;
# count the pair and explain why
$cnt++;
@explain.push(
"($i, $j) => ints[$i] == ints[$j] " ~
"and $i x $j is divisible by $k"
);
}
}
return($cnt, @explain.join("\n"));
}
$ raku/ch-2.raku
Example 1:
Input: @arr = (3, 1, 2, 2, 2, 1, 3) and $k = 2
Output: 4
(0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
(2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
(2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
(3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
Example 2:
Input: @arr = (1, 2, 3) and $k = 1
Output: 0
View the entire Raku script for this task on GitHub.
Perl
sub countEquDiv($k, @ints) {
my @explain;
my $cnt = 0;
foreach my $i ( 0 .. $#ints - 1 ) {
foreach my $j ( $i + 1 .. $#ints ) {
# does ints[i] == ints[j]?
next unless $ints[$i] == $ints[$j];
# is i x j divisible by k?
next unless ( ($i * $j) % $k ) == 0;
# count the pair and explain why
$cnt++;
push @explain,
"($i, $j) => ints[$i] == ints[$j] " .
"and $i x $j is divisible by $k";
}
}
return($cnt, join("\n", @explain));
}
View the entire Perl script for this task on GitHub.
Python
Here I’m leaning into the Python looking like Perl. I mean, except for the lack of block delimiters and sigils, how can you NOT think this looks like perl?
def countEquDiv(k, ints):
explain = []
cnt = 0
for i in range(len(ints) - 1):
for j in range(i+1, len(ints)):
# does ints[i] == ints[j]?
if not ints[i] == ints[j]: break
# is i x j divisible by k?
if not ( (i * j) % k ) == 0: break
# count the pair and explain why
cnt += 1
explain.append(
f"({i}, {j}) => ints[{i}] == ints[{j}] " +
f"and {i} x {j} is divisible by {k}"
)
return(cnt, "\n".join(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-262/packy-anderson
Perl Weekly Challenge: Two Elements, Multiplied by Digit Sum
No music this week, only solutions to Perl Weekly Challenge 261!
Task 1: Element Digit Sum
You are given an array of integers, @ints.
Write a script to evaluate the absolute difference between element and digit sum of the given array.
Example 1
Input: @ints = (1,2,3,45)
Output: 36
Element Sum: 1 + 2 + 3 + 45 = 51
Digit Sum: 1 + 2 + 3 + 4 + 5 = 15
Absolute Difference: | 51 - 15 | = 36
Example 2
Input: @ints = (1,12,3)
Output: 9
Element Sum: 1 + 12 + 3 = 16
Digit Sum: 1 + 1 + 2 + 3 = 7
Absolute Difference: | 16 - 7 | = 9
Example 3
Input: @ints = (1,2,3,4)
Output: 0
Element Sum: 1 + 2 + 3 + 4 = 10
Digit Sum: 1 + 2 + 3 + 4 = 10
Absolute Difference: | 10 - 10 | = 0
Example 4
Input: @ints = (236, 416, 336, 350)
Output: 1296
Approach
To me, this seems like an exercise in treating a list of numbers like integers in one case (element sum) and as a string of characters in another (digit sum).
Raku
Ok, I’ve been accused of writing my Raku like Perl, so I need to really lean into thinking in Raku, not Perl. Our solution function should accept a list, and we should probably use Raku’s Reduction Metaoperator to create our sums and our string of characters, and abs is a method on the Numeric role that numeric objects have.
sub elementDigitSum(@ints) {
# [+] sums all the elements of @ints
my $elementSum = [+] @ints;
my $explain = 'Element Sum: '
~ @ints.join(' + ')
~ ' = ' ~ $elementSum;
# use [~] to concatenate all the integers together
# into a single string, then use split() to get the
# individual digits
my @digits = ([~] @ints).split('', :skip-empty);
# [+] sums all the elements of @digits
my $digitSum = [+] @digits;
$explain ~= "\n" ~ 'Digit Sum: '
~ @digits.join(' + ')
~ ' = ' ~ $digitSum;
my $abs = ($elementSum - $digitSum).abs;
$explain ~= "\nAbsolute Difference: "
~ "| $elementSum - $digitSum | = $abs";
return ($abs, $explain);
}
View the entire Raku script for this task on GitHub.
$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 2, 3, 45)
Output: 36
Element Sum: 1 + 2 + 3 + 45 = 51
Digit Sum: 1 + 2 + 3 + 4 + 5 = 15
Absolute Difference: | 51 - 15 | = 36
Example 2:
Input: @ints = (1, 12, 3)
Output: 9
Element Sum: 1 + 12 + 3 = 16
Digit Sum: 1 + 1 + 2 + 3 = 7
Absolute Difference: | 16 - 7 | = 9
Example 3:
Input: @ints = (1, 2, 3, 4)
Output: 0
Element Sum: 1 + 2 + 3 + 4 = 10
Digit Sum: 1 + 2 + 3 + 4 = 10
Absolute Difference: | 10 - 10 | = 0
Example 4:
Input: @ints = (236, 416, 336, 350)
Output: 1296
Element Sum: 236 + 416 + 336 + 350 = 1338
Digit Sum: 2 + 3 + 6 + 4 + 1 + 6 + 3 + 3 + 6 + 3 + 5 + 0 = 42
Absolute Difference: | 1338 - 42 | = 1296
Perl
Sigh. Even though I tried to lean into making the Raku version use more Raku features, it turns out that [+] is just a built-in version of List::Util’s sum, and [~] is just a neater version of join('', @array).
use List::Util qw( sum );
sub elementDigitSum(@ints) {
my $elementSum = sum @ints;
my $explain = 'Element Sum: '
. join(' + ', @ints)
. ' = ' . $elementSum;
# use join() to concatenate all the integers together
# into a single string, then use split() to get the
# individual digits
my @digits = split //, join('', @ints);
my $digitSum = sum @digits;
$explain .= "\nDigit Sum: "
. join(' + ', @digits)
. ' = ' . $digitSum;
my $abs = abs($elementSum - $digitSum);
$explain .= "\nAbsolute Difference: "
. "| $elementSum - $digitSum | = $abs";
return ($abs, $explain);
}
View the entire Perl script for this task on GitHub.
Python
I will, however, gladly cop to my Python looking like Perl, because it does. That’s because I don’t believe there’s a lot of difference between the languages. Though, when I’m writing my Python, I start with the Raku version because both Raku and Python have the same “everything is an object” edict at their heart.
def plus_join(arr):
return ' + '.join(map(lambda i: str(i), arr))
def elementDigitSum(ints):
elementSum = sum(ints)
explain = f'Element Sum: {plus_join(ints)} = {elementSum}'
# concatenate all the integers together into a single
# string
digitStr = ''.join([ str(i) for i in ints ])
# loop over the individual digits
digits = [ int(d) for d in digitStr ]
digitSum = sum(digits)
explain += "\n"
explain += f'Digit Sum: {plus_join(digits)} = {digitSum}'
absVal = abs(elementSum - digitSum)
explain += "\n"
explain += 'Absolute Difference: '
explain += f'| {elementSum} - {digitSum} | = {absVal}'
return (absVal, explain)
View the entire Python script for this task on GitHub.
Task 2: Multiply by Two
You are given an array of integers, @ints and an integer $start..
Write a script to do the followings:
a) Look for $start in the array @ints, if found multiply the number by 2
b) If not found stop the process otherwise repeat
In the end return the final value.
Example 1
Input: @ints = (5,3,6,1,12) and $start = 3
Output: 24
Step 1: 3 is in the array so 3 x 2 = 6
Step 2: 6 is in the array so 6 x 2 = 12
Step 3: 12 is in the array so 12 x 2 = 24
24 is not found in the array so return 24.
Example 2
Input: @ints = (1,2,4,3) and $start = 1
Output: 8
Step 1: 1 is in the array so 1 x 2 = 2
Step 2: 2 is in the array so 2 x 2 = 4
Step 3: 4 is in the array so 4 x 2 = 8
8 is not found in the array so return 8.
Example 3
Input: @ints = (5,6,7) and $start = 2
Output: 2
2 is not found in the array so return 2.
Approach
Well, this is a fairly straightforward loop, the interesting part is checking to see if $start is in the array. The boring way would be to loop over the elements of the array, but each of the languages I’m using have more interesting ways to
Raku
In Raku, we have a data type called a Set, and it has an infix (elem) operator which can be written with the unicode character ∈.
sub multiplyByTwo(@ints, $s) {
my $start = $s; # so we can modify the value
my $ints = Set(@ints);
my @explain;
my $step = 0;
while ($start ∈ $ints) {
$step++;
my $old = $start;
$start *= 2;
@explain.push(
"Step $step: $old is in the array so $old x 2 = $start"
);
}
@explain.push(
"$start is not in the array so return $start."
);
return ($start, @explain.join("\n"));
}
View the entire Raku script for this task on GitHub.
$ raku/ch-2.raku
Example 1:
Input: @ints = (5, 3, 6, 1, 12) and $start = 3
Output: 24
Step 1: 3 is in the array so 3 x 2 = 6
Step 2: 6 is in the array so 6 x 2 = 12
Step 3: 12 is in the array so 12 x 2 = 24
24 is not in the array so return 24.
Example 2:
Input: @ints = (1, 2, 4, 3) and $start = 1
Output: 8
Step 1: 1 is in the array so 1 x 2 = 2
Step 2: 2 is in the array so 2 x 2 = 4
Step 3: 4 is in the array so 4 x 2 = 8
8 is not in the array so return 8.
Example 3:
Input: @ints = (5, 6, 7) and $start = 2
Output: 2
2 is not in the array so return 2.
Perl
Perl, on the other hand, doesn’t have a Set data type, but we can easily do the same thing with a hash!
sub multiplyByTwo($start, @ints) {
my %ints = map { $_ => 1 } @ints;
my @explain;
my $step = 0;
while ( exists $ints{$start} ) {
$step++;
my $old = $start;
$start *= 2;
push @explain,
"Step $step: $old is in the array so $old x 2 = $start";
}
push @explain,
"$start is not in the array so return $start.";
return ($start, join("\n", @explain));
}
View the entire Perl script for this task on GitHub.
Python
Python, however, does have a set datatype. In this case, because we don’t need to change the set after we create it, I’m going to use a frozenset.
def multiplyByTwo(ints, start):
intSet = frozenset(ints)
explain = []
step = 0
while start in intSet:
step += 1
old = start
start *= 2
explain.append(
f"Step {step}: {old} is in the array " +
f"so {old} x 2 = {start}"
)
explain.append(
f"{start} is not in the array so return {start}."
)
return (start, "\n".join(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-261/packy-anderson
Perl Weekly Challenge: Unique Dictionary Occurrences are Rank
Rank? Take note, this is probably the only time I’m evoking Lynyrd Skynyrd.
Onward to Perl Weekly Challenge 260!
Task 1: Unique Occurrences
You are given an array of integers, @ints.
Write a script to return 1 if the number of occurrences of each value in the given array is unique or 0 otherwise.
Example 1
Input: @ints = (1,2,2,1,1,3)
Output: 1
The number 1 occurred 3 times.
The number 2 occurred 2 times.
The number 3 occurred 1 time.
All occurrences are unique, therefore the output is 1.
Example 2
Input: @ints = (1,2,3)
Output: 0
Example 3
Input: @ints = (-2,0,1,-2,1,1,0,1,-2,9)
Output: 1
Approach
This immediately says hashes to me: a hash to count the number of times each integer occurs, and another hash to track whether a particular integer count occurs more than once.
Raku
sub uniqueOccurrences(@ints) {
my %counts;
for @ints -> $i {
# count how many time each int occurs
%counts{$i}++;
}
my %seen;
for %counts.kv -> $i, $c {
# if we've seen this count before, return 0
return 0 if %seen{$c}:exists;
%seen{$c} = $i;
}
# each count was unique
return 1;
}
$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 2, 2, 1, 1, 3)
Output: 1
Example 2:
Input: @ints = (1, 2, 3)
Output: 0
Example 3:
Input: @ints = (-2, 0, 1, -2, 1, 1, 0, 1, -2, 9)
Output: 1
View the entire Raku script for this task on GitHub.
Perl
The big change from Raku to Perl is going from for %counts.kv -> $i, $c to while ( my($i, $c) = each %counts ):
sub uniqueOccurrences(@ints) {
my %counts;
foreach my $i ( @ints ) {
# count how many time each int occurs
$counts{$i}++;
}
my %seen;
while ( my($i, $c) = each %counts ) {
# if we've seen this count before, return 0
return 0 if exists $seen{$c};
$seen{$c} = $i;
}
# each count was unique
return 1;
}
View the entire Perl script for this task on GitHub.
Python
As always, when I’m counting things in Python, I use the Counter type in the collections module.
from collections import Counter
def uniqueOccurrences(ints):
counts = Counter()
for i in ints:
# count how many time each int occurs
counts[i] += 1
seen = {}
for i, c in counts.items():
# if we've seen this count before, return 0
if c in seen: return 0
seen[c] = i
# each count was unique
return 1
View the entire Python script for this task on GitHub.
Task 2: Dictionary Rank
You are given a word, $word.
Write a script to compute the dictionary rank of the given word.
Example 1
Input: $word = 'CAT'
Output: 3
All possible combinations of the letters:
CAT, CTA, ATC, TCA, ACT, TAC
Arrange them in alphabetical order:
ACT, ATC, CAT, CTA, TAC, TCA
CAT is the 3rd in the list.
Therefore the dictionary rank of CAT is 3.
Example 2
Input: $word = 'GOOGLE'
Output: 88
Example 3
Input: $word = 'SECRET'
Output: 255
Approach
This feels akin to the first task: operate on the list (of characters, this time) to produce another list, and the analyze the second list in some way. Here, we’re breaking a string into characters, producing all the permutations of those characters as new strings, then sorting them and seeing how far down the sorted list the original string appears.
Raku
In Raku, there’s a permutations method on the List type to do the heavy lifting:
sub dictionaryRank($word) {
# split the string into an array of characters
my @letters = $word.split('', :skip-empty);
# find the permutations of the letters
my @perms;
for @letters.permutations -> @l {
@perms.append(@l.join(''));
}
# find where in the sorted list of
# permutations the word is
my $rank = 1;
for @perms.unique.sort -> $p {
return $rank if $p eq $word;
$rank++;
}
}
$ raku/ch-2.raku | less
Example 1:
Input: $word = 'CAT'
Output: 3
Example 2:
Input: $word = 'GOOGLE'
Output: 349
Example 3:
Input: $word = 'SECRET'
Output: 509
But wait! GOOGLE and SECRET are supposed to be 88 and 255, not 349 and 509. What gives? Let’s look at what @perms.sort looks like by adding say @perms.sort.raku; right after we build the array…
Example 2:
Input: $word = 'GOOGLE'
("EGGLOO", "EGGLOO", "EGGLOO", "EGGLOO", "EGGOLO", "EGGOLO",
"EGGOLO", "EGGOLO", "EGGOOL", "EGGOOL", "EGGOOL", "EGGOOL",
"EGLGOO", "EGLGOO", "EGLGOO", "EGLGOO", "EGLOGO", "EGLOGO",
"EGLOGO", "EGLOGO", "EGLOOG", "EGLOOG", "EGLOOG", "EGLOOG",
"EGOGLO", "EGOGLO", "EGOGLO", "EGOGLO", "EGOGOL", "EGOGOL",
...
Oh! I see what’s happening! It wants all the unique combinations! Fortunately, Raku has a unique method for just that.
sub dictionaryRank($word) {
# split the string into an array of characters
my @letters = $word.split('', :skip-empty);
# find the permutations of the letters
my @perms;
for @letters.permutations -> @l {
@perms.append(@l.join(''));
}
# find where in the sorted list of
# UNIQUE permutations the word is
my $rank = 1;
for @perms.unique.sort -> $p {
return $rank if $p eq $word;
$rank++;
}
}
$ raku/ch-2.raku | less
Example 1:
Input: $word = 'CAT'
Output: 3
Example 2:
Input: $word = 'GOOGLE'
Output: 88
Example 3:
Input: $word = 'SECRET'
Output: 255
View the entire Raku script for this task on GitHub.
Perl
Perl, however, doesn’t have the same built-in features, so we need to rely on CPAN modules. For uniqueness, I’m using uniq from List::Util, and for permutations, I’m using Algorithm::Combinatorics’ permutations function, like I did back in PWC 244.
use Algorithm::Combinatorics qw( permutations );
use List::Util qw( uniq );
sub dictionaryRank($word) {
# split the string into an array of characters
my @letters = split //, $word;
# find the permutations of the letters
my @perms;
foreach my $l ( permutations(\@letters) ) {
push @perms, join('', @$l);
}
# find where in the sorted list of
# UNIQUE permutations the word is
my $rank = 1;
foreach my $p ( sort { $a cmp $b } uniq @perms ) {
return $rank if $p eq $word;
$rank++;
}
}
View the entire Perl script for this task on GitHub.
Python
Again, like I did in PWC 244, I’m using itertools, but this time it’s the permutations function.
def dictionaryRank(word):
# we don't need to split the string, because
# permutations() will accept a string as a parameter
#
# set() produces a set of unique elements
#
# sorted() returns a sorted list
perms = sorted(
set([ ''.join(l) for l in permutations(word) ])
)
rank = 1
for p in perms:
if p == word: return rank
rank += 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-260/packy-anderson