Advent Calendar 2024
| Day 23 | Day 24 | Day 25 |
The gift is presented by Jaldhar H. Vyas. Today he is talking about his solution to The Weekly Challenge - 299. This is re-produced for Advent Calendar 2024 from the original post.
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.
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 Search
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.
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 to @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 &&
not yet visited.
"$newRow;$newCol" ∉ %visited &&
contains the $current letter 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;
}
If you have any suggestion then please do share with us perlweeklychallenge@yahoo.com.