Perl Weekly Challenge: Week 299
Challenge 1:
Replace Words
You are given an array of words and a sentence.
Write a script to replace all words in the given sentence that start with any of the words in the given array.
Example 1
Input: @words = ("cat", "bat", "rat")
$sentence = "the cattle was rattle by the battery"
Output: "the cat was rat by the bat"
Example 2
Input: @words = ("a", "b", "c")
$sentence = "aab aac and cac bab"
Output: "a a a c b"
Example 3
Input: @words = ("man", "bike")
$sentence = "the manager was hit by a biker"
Output: "the man was hit by a bike"
Perl first for a change and it's the easiest challenge we've had for a long time.
All we have to do is for each word in @words...
for my $word (@words) {
Replace any instance of that word in $sentence followed by one or more instances of any "word" character (i.e. alphanumeric or punctuation) with the word by itself.
$sentence =~ s/$word\w+/$word/g;
}
And print out the result.
say $sentence;
The only real change we need to make for Raku is that function arguments are immutable so we have to
give $sentence the is copy role.
sub MAIN(
$sentence is copy,
*@words
) {
for @words -> $word {
$sentence ~~ s:g/$word\w+/$word/;
}
say $sentence;
}
Challenge 2:
Word Searchl
You are given a grid of characters and a string.
Write a script to determine whether the given string can be found in the given grid of characters. You may start anywhere and take any orthogonal path, but may not reuse a grid cell.
Example 1
Input: @chars = (['A', 'B', 'D', 'E'],
['C', 'B', 'C', 'A'],
['B', 'A', 'A', 'D'],
['D', 'B', 'B', 'C'])
$str = 'BDCA'
Output: true
Example 2
Input: @chars = (['A', 'A', 'B', 'B'],
['C', 'C', 'B', 'A'],
['C', 'A', 'A', 'A'],
['B', 'B', 'B', 'B'])
$str = 'ABAC'
Output: false
Example 3
Input: @chars = (['B', 'A', 'B', 'A'],
['C', 'C', 'C', 'C'],
['A', 'B', 'A', 'B'],
['B', 'B', 'A', 'A'])
$str = 'CCCAA'
Output: true
This one is a little more complicated.
First we break up $str into a List of individual characters.
my @string = $str.comb;
Each element of @chars is also turned into a List of characters. and added tp @grid.
my @grid;
for @chars -> $row {
@grid.push($row.comb);
}
We need a place to store the result. Initially it is assumed to be False.
my $found = False;
$current represents the first character in $str.
my $current = @string.shift;
Now we visit every cell in the @grid.
for 0 ..^ @grid.elems -> $row {
for 0 ..^ @grid[$row].elems -> $col {
If the cell contains the $current letter (i.e. the first letter in $str,) we
can proceed with searching for the rest. If it doesn't, we move on to the next cell.
if @grid[$row;$col] eq $current {
Assuming this was the correct cell, we set up a SetHash to hold the positions of any
cells we have already seen in this search. This fulfills the specs' requirement
'...may not reuse a grid cell'.
my %visited is SetHash[Str];
We call the traverse() function recursively (explained below) and if it return True,
we set $found to True and stop processing.
if traverse(@grid, @string, %visited, $row, $col) {
$found = True;
last;
}
}
}
}
Finally we print the value of $found.
say $found;
traverse() is a function that takes the @grid, the list of characters originally in $str,
the set of visited cells, and the row and column of the current cell as parameters.
sub traverse(@grid, @string, %visited, $row, $col) {
We are going to need to know the horizontal and vertical neighboring cells of the one we are in.
It is a state (what C++ would call static) variable so we don't have to recreate it every time
the function is called.
state @directions = ([-1, 0], [0, 1], [1, 0], [0, -1]);
If @string is empty, it means we have successfully found the target string within @grid so we
can return True and leave the function.
unless @string.elems {
return True;
}
If not, first we mark this cell as visited.
%visited.set("$row;$col");
Because parameters are immutable, we cant make direct changes to @stringso we first copy it to a
new variable imaginativly named @newstring. The first character from it is removed and made the current
letter we are searching for.
my @newstring = @string;
my $current = @newstring.shift;
For each direction in our @directions list...
for @directions -> $dir {
...we use it to create the co-ordinates of a neighbor of the current cell.
my ($newRow, $newCol) = ($row, $col) Z+ @$dir;
If this neighbor is:
within the bounds of
@grid.if $newRow ~~ 0 ..^ @grid.elems && $newCol ~~ 0 ..^ @grid[0].elems &¬ yet visited.
"$newRow;$newCol" ∉ %visited &&contains the
$currentletter we are searching for.@grid[$newRow;$newCol] eq $current {
We recursively call traverse() again.
return traverse(@grid, @newstring, %visited, $newRow, $newCol);
}
}
If none of the neighbors contained the character we are searching for, we return False.
return False;
}
The Perl version uses the same algorithm. We are using the new experimental true and false
constants in the newest Perl versions so we have to include these two lines at the top of the script:
use builtin qw/ true false /;
no warnings 'experimental::builtin';
my @string = split //, $str;
my @grid;
for my $row (@chars) {
push @grid, [split //, $row];
}
my $found = false;
my $current = shift @string;
for my $row (0 .. scalar @grid - 1) {
for my $col (0 .. scalar @{$grid[$row]} - 1) {
if ($grid[$row]->[$col] eq $current) {
Because we don't have Sets in Perl, %visited is a plain old hash.
my %visited;
if (traverse(\@grid, \@string, \%visited, $row, $col)) {
$found = true;
last;
}
}
}
}
say $found ? 'true' : 'false';
traverse() also works almost the same as in Raku. Every hash or array has to be
passed and accessed as a reference which is a bit annoying.
sub traverse($grid, $string, $visited, $row, $col) {
state @directions = ([-1, 0], [0, 1], [1, 0], [0, -1]);
unless (scalar @{$string}) {
return true;
}
$visited->{"$row;$col"} = true;
my @newstring = @{$string};
my $current = shift @newstring;
for my $dir (@directions) {
my $newRow = $row + $dir->[0];
my $newCol = $col + $dir->[1];
if ($newRow >= 0 && $newRow < scalar @{$grid} &&
$newCol >= 0 && $newCol < scalar $grid->[0] &&
!$visited->{"$newRow;$newCol"} &&
One little thing which tripped me up is that in Perl, I also have to check if a cell exists before attempting to access it otherwise an unsightly warning is emitted.
defined $grid->[$newRow]->[$newCol] &&
$grid->[$newRow]->[$newCol] eq $current
) {
return traverse($grid, \@newstring, $visited, $newRow, $newCol);
}
}
return false;
}