I’m sorry for the lack of music this time around, but when I read “broken keys”, there’s only one broken key I can think of.
Let’s proceed with caution and approach Perl Weekly Challenge 275!
Continue readingCategory Archives: Perl
Perl Weekly Challenge: Bus Route, Bus Goat, Under My Umbrellamaaaaaaaaaaaa
I’m sorry for the strange musical free association. but … 🎶 thinking of a sweet romance beginning in a queue… 🎶 there’s a reason this song is not very far away in my programming-addled brain.
So let’s take a ride down to Perl Weekly Challenge 274!
Perl Weekly Challenge: Time to count B chars
Musical free association: “B after A” became “time to play B sides…“
This week’s challenge is all about characters: counting occurrences of a character in a string and returning what percentage of the string it is, and determining if one of two characters occurs in a string after the last occurrence of the other character.
Without further ado, Perl Weekly Challenge 273!
Perl Weekly Challenge: Defanged Addresses & String Scores
This week, we’re “defanging” IP addresses and calculating string scores, but both these tasks are easy enough we’ll be there in a minute.
Onward to Perl Weekly Challenge 272!
Continue reading
Perl Weekly Challenge: Only Ones
What with all the ones in today’s binary challenges, the first thing that popped into my head was James Taylor’s Only One.
I mean, who can blame me? Now that we’ve set the musical tone, let’s dive into Perl Weekly Challenge 271!
Perl Weekly Challenge: Elements are Special
There’s antimony, arsenic, aluminum, selenium,
And hydrogen and oxygen and nitrogen and rhenium,
And nickel, neodymium, neptunium, germanium,
And iron, americium, ruthenium, uranium…
This week’s challenge is all about ELEMENTS! (That’s Perl Weekly Challenge 270, of course…)
Perl Weekly Challenge: Bitwise Distribution
Before I started on this tonight, I ran across a video of Antônio Carlos Jobim’s One Note Samba being performed by Dean Martin & Caterina Valente, and I knew I needed to make it the musical theme tonight, but I’m going to link you to John Pizzarelli’s version.
So, let’s samba on down to Perl Weekly Challenge 269!
Perl Weekly Challenge: Let’s do the Numbers!
This week’s theme is feuding in my head. On the musical side, “Number Game” made me think of Joni Mitchell, but the repeated use of the word “number” in the task titles made me think of Marketplace Radio (yes, I’m a Public Radio geek).
Anyway, let’s do Perl Weekly Challenge 268!
Task 1: Magic Number
You are given two arrays of integers of same size, @x and @y.
Write a script to find the magic number that when added to each elements of one of the array gives the second array. Elements order is not important.
Example 1
Input: @x = (3, 7, 5)
@y = (9, 5, 7)
Output: 2
The magic number is 2.
@x = (3, 7, 5)
+ 2 2 2
@y = (5, 9, 7)Example 2
Input: @x = (1, 2, 1)
@y = (5, 4, 4)
Output: 3
The magic number is 3.
@x = (1, 2, 1)
+ 3 3 3
@y = (5, 4, 4)Example 3
Input: @x = (2)
@y = (5)
Output: 3Approach
Element order may not be important in specifying the problem, but it feels pretty important in solving the problem. Since we’re looking for a number that, when added to each element of the first array yields an element of the second array, the obvious solution is to sort each array in either ascending or descending order, and then subtract the element in the first array from its corresponding element in the second array. As long as we get the same number each time, we’ve found the magic number. None of the examples show two input arrays that don’t yield a magic number, but nothing in the problem description precludes that.
Raku
sub magicNumber(@x, @y) {
my @xS = @x.sort;
my @yS = @y.sort;
my $magic = @yS.shift - @xS.shift;
while (@xS) {
if (@yS.shift - @xS.shift != $magic) {
return; # no magic number
}
}
return $magic;
}$ raku/ch-1.raku
Example 1:
Input: @x = (3, 7, 5)
@y = (9, 5, 7)
Output: 2
The magic number is 2.
@x = (3, 7, 5)
+ 2 2 2
@y = (5, 9, 7)
Example 2:
Input: @x = (1, 2, 1)
@y = (5, 4, 4)
Output: 3
The magic number is 3.
@x = (1, 2, 1)
+ 3 3 3
@y = (4, 5, 4)
Example 3:
Input: @x = (2)
@y = (5)
Output: 3
The magic number is 3.
@x = (2)
+ 3
@y = (5)
Example 4:
Input: @x = (1, 2)
@y = (4, 2)
Output: no magic numberView the entire Raku script for this task on GitHub.
Perl
sub magicNumber($x, $y) {
my @xS = sort @$x;
my @yS = sort @$y;
my $magic = shift(@yS) - shift(@xS);
while (@xS) {
if (shift(@yS) - shift(@xS) != $magic) {
return; # no magic number
}
}
return $magic;
}View the entire Perl script for this task on GitHub.
Python
def magicNumber(x, y):
xS = sorted(x)
yS = sorted(y)
magic = yS.pop(0) - xS.pop(0)
while xS:
if yS.pop(0) - xS.pop(0) != magic:
return None; # no magic number
return magicView the entire Python script for this task on GitHub.
Task 2: Number Game
You are given an array of integers, @ints, with even number of elements.
Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.
Example 1
Input: @ints = (2, 5, 3, 4)
Output: (3, 2, 5, 4)
Round 1: we picked (2, 3) and push it to the new array (3, 2)
Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)Example 2
Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)Example 3
Input: @ints = (1, 2, 2, 3)
Output: (2, 1, 3, 2)Approach
This feels very much like the previous task: we need to sort the elements so we can pick the two smallest integers, we pull those values off the sorted array (only one array this time, however), and we do some kind of comparison. The big difference this time is we’re adding the elements back to a list.
Raku
The big thing to note here is that Raku’s Array push doesn’t flatten it’s argument list, so “If you pass an array or list as the thing to push, it becomes one additional element; multiple values are added to the array only if you supply them as separate arguments or in a slip.”
sub numberGame(@ints) {
my @intSorted = @ints.sort;
my @new;
while (@intSorted) {
my $x = @intSorted.shift;
my $y = @intSorted.shift;
if ($x > $y) {
@new.push: ($x, $y).Slip;
}
else {
@new.push: ($y, $x).Slip;
}
}
return @new;
}$ raku/ch-2.raku
Example 1:
Input: @ints = (2, 5, 3, 4)
Output: (3, 2, 5, 4)
Example 2:
Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)
Example 3:
Input: @ints = (1, 2, 2, 3)
Output: (2, 1, 3, 2)View the entire Raku script for this task on GitHub.
Perl
sub numberGame(@ints) {
my @intSorted = sort @ints;
my @new;
while (@intSorted) {
my $x = shift @intSorted;
my $y = shift @intSorted;
if ($x > $y) {
push @new, $x, $y;
}
else {
push @new, $y, $x;
}
}
return @new;
}View the entire Perl script for this task on GitHub.
Python
def numberGame(ints):
intSorted = sorted(ints)
new = []
while intSorted:
x = intSorted.pop(0)
y = intSorted.pop(0)
if x > y:
new.extend([x, y])
else:
new.extend([y, x])
return newView the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-268/packy-anderson
Perl Weekly Challenge: 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