Perl Weekly Challenge 299.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 299.
Task 1: Replace Words
Submitted by: Mohammad Sajid Anwar
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"
I can build a regular expression in which all words are alternatives. I use it to replace all words consisting of any word followed by any number of word characters by the matched and captured word. I use the /g modifier to perform the substitution repeatedly and the /r modifier to return the modified string. The result fits a one-liner.
Example 1:
perl -E '
$s=shift;$w=join "|",@ARGV; say "Sentence: $s\nwords: @ARGV\n -> ", $s=~s/($w)\w*/$1/gr
' "the cattle was rattle by the battery" cat bat rat
Results:
Sentence: the cattle was rattle by the battery
words: cat bat rat
-> the cat was rat by the bat
Example 2:
perl -E '
$s=shift;$w=join "|",@ARGV; say "Sentence: $s\nwords: @ARGV\n -> ", $s=~s/($w)\w*/$1/gr
' "aab aac and cac bab" a b c
Results:
Sentence: aab aac and cac bab
words: a b c
-> a a a c b
Example 3:
perl -E '
$s=shift;$w=join "|",@ARGV; say "Sentence: $s\nwords: @ARGV\n -> ", $s=~s/($w)\w*/$1/gr
' "the manager was hit by a biker" man bike
Results:
Sentence: the manager was hit by a biker
words: man bike
-> the man was hit by a bike
The full code is similar.
1 # Perl weekly challenge 299
2 # Task 1: Replace Words
3 #
4 # See https://wlmb.github.io/2024/12/09/PWC299/#task-1-replace-words
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S W1 W2...
8 to replace all words in the sentence S that start with word Wi by Wi
9 FIN
10 my $sentence=shift;
11 my @words=@ARGV;
12 my $alternation=join "|",@words;
13 say "Sentence: $sentence\nwords: @words\n -> ", $sentence=~s/($alternation)\w*/$1/gr, "\n";
Examples:
./ch-1.pl "the cattle was rattle by the battery" cat bat rat
./ch-1.pl "aab aac and cac bab" a b c
./ch-1.pl "the manager was hit by a biker" man bike
Results:
Sentence: the cattle was rattle by the battery
words: cat bat rat
-> the cat was rat by the bat
Sentence: aab aac and cac bab
words: a b c
-> a a a c b
Sentence: the manager was hit by a biker
words: man bike
-> the man was hit by a bike
Task 2: Word Search
Submitted by: Mohammad Sajid Anwar
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
I read the arguments, using split and regular expressions to
identify the start and end of each row and of the matrix, removing brackets and spaces
and I use the ord function to convert letters to
numbers. Then I assemble the resulting matrix of numbers as a PDL
ndarray. I similarly convert the input word to a vector of numbers. I glue
columns and rows of zeroes all around as guards, to avoid having to
check for out of bound indices. I use a 2D vector to keep the indices
and an array of horizontal and vertical displacements to move along
the array. I make a recursive function that fails if the first letter
of the word doesn’t agree with the letter at the current position. If
it agrees, it marks the current position with an invalid code and it
recurses over the rest of the word and the four nearest neighbor
positions. I call this function for each possible starting point until
it succeds. The code is the following:
1 # Perl weekly challenge 299
2 # Task 2: Word Search
3 #
4 # See https://wlmb.github.io/2024/12/09/PWC299/#task-2-word-search
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 my $matrix;
9 my $zero=pdl(0);
10 while(@ARGV){
11 $matrix=$zero->glue(0,
12 $zero->glue(1,
13 pdl([map{[map {ord} split ' ']} map {split /\]\s*\[/}
14 (my $alpha_matrix=shift)=~s/^\s*\[\s*\[\s*//r=~s/\s*\]\s*\]\s*$//r]),
15 $zero), $zero);
16 my $word=pdl[map {ord} split "", my $alpha_word=shift];
17 my $result=0;
18 C: for my $i(1..$matrix->dim(0)-2){
19 for my $j(1..$matrix->dim(1)-2){
20 $result=1, last C if test(pdl($i,$j),$word);
21 }
22 }
23 say "$alpha_matrix, $alpha_word -> $result";
24 }
25 sub test($ind,$word){
26 state @d=map {pdl $_}([1,0],[0,1],[-1,0],[0,-1]);
27 return 1 unless $word->nelem;
28 my $old=(my $s=$matrix->indexND($ind))->copy;
29 return 0 unless $word(0)==$s;
30 $s.=0;
31 return 1 if $word->nelem==1;
32 for(@d){return 1 if test($ind+$_, $word(1:-1))}
33 $s.=$old;
34 return 0;
35 }
Examples:
./ch-2.pl "[ [A B D E][C B C A][B A A D] [D B B C] ]" BDCA \
"[ [A A B B][C C B A][C A A A][B B B B] ]" ABAC \
"[ [B A B A][C C C C][A B A B][B B A A] ]" CCCAA
Results:
[ [A B D E][C B C A][B A A D] [D B B C] ], BDCA -> 1
[ [A A B B][C C B A][C A A A][B B B B] ], ABAC -> 0
[ [B A B A][C C C C][A B A B][B B A A] ], CCCAA -> 1
Just for fun, the code may be compressed into an incomprehensible 5-liner.
perl -MPDL -MPDL::NiceSlice -E '
@d=map {pdl $_}map{[0,$_],[$_,0]}(-1,1);my $z=pdl(0);while(@ARGV){$m=$z->glue(0,$z->glue(
1,pdl([map{[map {ord} split ""]}split " ",$a=shift]),$z), $z);$w=pdl[map {ord} split "",
$u=shift];my $r=0;C:for $i(1..$m->dim(0)-2){for $j(1..$m->dim(1)-2){$r=1, last C if t(
pdl($i,$j),$w)}}say "$a, $u -> $r"}sub t($i,$w){my$old=(my$s=$m->indexND($i));$w(0)==
$s||return 0;$s.=0;$w->nelem==1&&return 1;for(@d){return 1 if t($i+$_, $w(1:-1))}$s.=$old;0}
' "ABDE CBCA BAAD DBBC" BDCA \
"AABB CCBA CAAA BBBB" ABAC \
"BABA CCCC ABAB BBAA" CCCAA
Results:
ABDE CBCA BAAD DBBC, BDCA -> 1
AABB CCBA CAAA BBBB, ABAC -> 0
BABA CCCC ABAB BBAA, CCCAA -> 1