Perl Weekly Challenge: Week 266
Challenge 1:
Uncommon Words
You are given two sentences,
$line1and$line2.Write a script to find all uncommmon 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: ('')
This is yet another problem we can solve using Raku's support for set operations.
First we take each input argument and split it into a list of words with .words(). We need only the words that
occur once in each list and the easiest way to do that is to convert the list into a Bag which will consist of all
the unique words and the number of times they occur, then filter that bag with grep() to find elements with a value of 1
which would mean that element only occurred once in the bag. After that we no longer need the frequencies (values), just the
words (keys) so we select only them with .map(). Performing this process on $line1 and $line2 results in two lists @words1 and @words2.
my @words1 = $line1.words.Bag.grep({ $_.value == 1; }).map({ $_.key });
my @words2 = $line2.words.Bag.grep({ $_.value == 1; }).map({ $_.key });
Applying thhe symmetric difference operator ⊖ to @words1 and @words2 gives us the solution. The rest of this
line is only for printing the output in the style of the examples.
say q{(}, ((@words1 ⊖ @words2).map({ "'{$_.key}'" }).join(q{, }) || "''"), q{)};
Perl is not blessed with Raku's wide range of exotic types and operators so we have to provide the functionality ourselves. Last week I wrote a function called makeBag() which can be repurposed here.
Notice the signature. Ubuntu 24.04 LTS came out this week and now that I've upgraded, I have Perl 5.38 which now makes the hitherto experimental support for subroutine signatures an official part of the language.
sub makeUniqueBag(@array) {
my %bag;
for my $c (@array) {
$bag{$c}++;
}
There's no need to slavishly copy previous code. With the addition of an additional grep() here, I can find the unique words.
That's why this routine is called makeUniqueBag().
return grep { $bag{$_} == 1 } keys %bag;
}
We need a replacement for the ⊖ operator and I thought it would be difficult but it was surprisingly simple.
Subroutine signature again. Unfortunately Perl doesn't support more than one array parameter so we need to pass them by reference like in the good old days.
sub symmetricDifference($set1, $set2) {
All we need to do is combine the two input arrays into one...
my @all = (@{$set1}, @{$set2});
...and run makeUniqueBag() on it. Voila! Symmetric difference.
return makeUniqueBag(@all);
}
Now we have these, we can just port the Raku algorithm.
my @words1 = makeUniqueBag(split /\s+/, @ARGV[0]);
my @words2 = makeUniqueBag(split /\s+/, @ARGV[1]);
say q{(}, ((join q{, }, map { "'$_'" } symmetricDifference(\@words1, \@words2)) || "''"), q{)};
Challenge 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
The Main() function of the Raku solution consists of only one line. Each row of the
matrix is input as a command-line argument. The columns in those rows are separated by whitespace.
So we can easily convert the input into a 2D array with .map() and .words(). This 2D array
is passed into a function called checkMatrix() which does all the heavy lifting. Its' results (True or False)
will be output with say().
say checkMatrix(@args.map({ [$_.words] }));
This is checkMatrix():
sub checkMatrix(@matrix) {
We define two variables which will represent the left or right side of a matrix row. For the first row they will be the first and last columns of the row. They will also be the columns containing the diagonal and antidiagonal on that row.
my $left = 0;
my $right = @matrix[0].end;
Now for every row...
for @matrix.keys -> $row {
...and every column in that row...
for @matrix[$row].keys -> $col {
...we check if it is the $left or the $right. If it is...
if $col == $left || $col == $right {
we check that it does_not contain a 0. If it does, this is not an X matrix so we return False.
if @matrix[$row;$col] == 0 {
return False;
}
If the column was not $left or $right we check that it does contain a 0. If it does not, this is not an X matrix so
we return False.
} else {
if @matrix[$row;$col] != 0 {
return False;
}
}
}
After each row is processed we increment the value of $left and decrement the value of $right and go on to the next row.
$left++;
$right--;
}
If we are still here after all rows have processed, this is an X matrix so we return True.
return True;
}
This is the Perl version. It is mostly the same except we are using 1 and undef instead of True and False.
sub checkMatrix(@matrix) {
my $left = 0;
my $right = scalar @{$matrix[0]} - 1;
for my $row (keys @matrix) {
for my $col (keys @{$matrix[$row]}) {
if ($col == $left || $col == $right) {
if ($matrix[$row][$col] == 0) {
return undef;
}
} else {
if ($matrix[$row][$col] != 0) {
return undef;
}
}
}
$left++;
$right--;
}
return 1;
}
This bit was one line in Raku but I couldn't make it work the same way (due to map() being in scalar context maybe?) so I
just assigned the matrix to an explicit variable and passed that to checkMatrix().
my @matrix = map { [split /\s+/, $_] } @ARGV;
say checkMatrix(@matrix) ? 'true' : 'false';