Perl Weekly Challenge 370.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 370.
Task 1: Popular Word
Submitted by: Mohammad Sajid Anwar
You are given a string paragraph and an array of the banned words.
Write a script to return the most popular word that is not
banned. It is guaranteed there is at least one word that is
not banned and the answer is unique. The words in paragraph
are case-insensitive and the answer should be in
lowercase. The words can not contain punctuation symbols.
Example 1
Input: $paragraph = "Bob hit a ball, the hit BALL flew far after it was hit."
@banned = ("hit")
Output: "ball"
After removing punctuation and converting to lowercase, the
word "hit" appears 3 times, and "ball" appears 2 times.
Since "hit" is on the banned list, we ignore it.
Example 2
Input: $paragraph = "Apple? apple! Apple, pear, orange, pear, apple, orange."
@banned = ("apple", "pear")
Output: "orange"
"apple" appears 4 times.
"pear" appears 2 times.
"orange" appears 2 times.
"apple" and "pear" are both banned.
Even though "orange" has the same frequency as "pear", it is
the only non-banned word with the highest frequency.
Example 3
Input: $paragraph = "A. a, a! A. B. b. b."
@banned = ("b")
Output: "a"
"a" appears 4 times.
"b" appears 3 times.
The input has mixed casing and heavy punctuation.
The normalised, "a" is the clear winner, since "b" is
banned, "a" is the only choice.
Example 4
Input: $paragraph = "Ball.ball,ball:apple!apple.banana"
@banned = ("ball")
Output: "apple"
Here the punctuation acts as a delimiter.
"ball" appears 3 times.
"apple" appears 2 times.
"banana" appears 1 time.
Example 5
Input: $paragraph = "The dog chased the cat, but the dog was faster than the cat."
@banned = ("the", "dog")
Output: "cat"
"the" appears 4 times.
"dog" appears 2 times.
"cat" appears 2 times.
"chased", "but", "was", "faster", "than" appear 1 time each.
"the" is the most frequent but is banned.
"dog" is the next most frequent but is also banned.
The next most frequent non-banned word is "cat".
I assume @ARGV is of the form P0 B0 P1 B1… where Pn is a
paragraph and Bn a space separated list of banned
words. First I split the banned words a use them to build a
hash. I split the lowercased paragraph into (alphabetical)
words, grep out the valid words using the banned hash,
count the frequency of each valid word and find their
max_by frequency (from List::UtilsBy). The result fits a two-liner.
Examples:
perl -MList::UtilsBy=max_by -E '
for my($p,$b)(@ARGV){my(%b,%w);++$b{$_} for split" ",$b;++$w{$_}for grep
{!$b{$_}}split/[^a-z]+/,lc $p;say "p=$p b=$b -> ", max_by{$w{$_}}keys %w;}
' \
"Bob hit a ball, the hit BALL flew far after it was hit." "hit" \
"Apple? apple! Apple, pear, orange, pear, apple, orange." "apple pear" \
"A. a, a! A. B. b. b." "b" \
"Ball.ball,ball:apple!apple.banana" "ball" \
"The dog chased the cat, but the dog was faster than the cat." "the dog"
Results:
p=Bob hit a ball, the hit BALL flew far after it was hit. b=hit -> ball
p=Apple? apple! Apple, pear, orange, pear, apple, orange. b=apple pear -> orange
p=A. a, a! A. B. b. b. b=b -> a
p=Ball.ball,ball:apple!apple.banana b=ball -> apple
p=The dog chased the cat, but the dog was faster than the cat. b=the dog -> cat
The full code is:
1 # Perl weekly challenge 370
2 # Task 1: Popular Word
3 #
4 # See https://wlmb.github.io/2026/04/20/PWC370/#task-1-popular-word
5 use v5.36;
6 use List::UtilsBy qw(max_by);
7 die <<~"FIN" unless @ARGV and @ARGV%2==0;
8 Usage: $0 P0 B0 P1 B1...
9 where Pn is a paragraph and Bn is a space separated list
10 if banned words, to find the most frequent permitted word
11 of each paragraph.
12 FIN
13 for my($paragraph, $banned)(@ARGV){
14 my %banned;
15 my %words;
16 ++$banned{$_} for split " ", $banned;
17 ++$words{$_} for
18 grep {!$banned{$_}}
19 split/[^a-z]+/,
20 lc $paragraph;
21 print <<~"END";
22 Paragraph="$paragraph";
23 banned="$banned"
24 END
25 say " -> ", max_by{$words{$_}} keys %words;
26 }
Example:
./ch-1.pl \
"Bob hit a ball, the hit BALL flew far after it was hit." "hit" \
"Apple? apple! Apple, pear, orange, pear, apple, orange." "apple pear" \
"A. a, a! A. B. b. b." "b" \
"Ball.ball,ball:apple!apple.banana" "ball" \
"The dog chased the cat, but the dog was faster than the cat." "the dog"
Results:
Paragraph="Bob hit a ball, the hit BALL flew far after it was hit.";
banned="hit"
-> ball
Paragraph="Apple? apple! Apple, pear, orange, pear, apple, orange.";
banned="apple pear"
-> orange
Paragraph="A. a, a! A. B. b. b.";
banned="b"
-> a
Paragraph="Ball.ball,ball:apple!apple.banana";
banned="ball"
-> apple
Paragraph="The dog chased the cat, but the dog was faster than the cat.";
banned="the dog"
-> cat
Task 2: Scramble String
Submitted by: Roger Bell-West You are given two strings A and B of the same length.
Write a script to return true if string B is a scramble of string A otherwise return false.
String B is a scramble of string A if A can be transformed into B by a single (recursive) scramble operation.
A scramble operation is:
- If the string consists of only one character, return the string.
- Divide the string X into two non-empty parts.
- Optionally, exchange the order of those parts.
- Optionally, scramble each of those parts.
- Concatenate the scrambled parts to return a single string.
Example 1 Input: $str1 = “abc”, $str2 = “acb” Output: true
“abc” split: [“a”, “bc”] split: [“a”, [“b”, “c”]] swap: [“a”, [“c”, “b”]] concatenate: “acb”
Example 2 Input: $str1 = “abcd”, $str2 = “cdba” Output: true
“abcd” split: [“ab”, “cd”] swap: [“cd”, “ab”] split: [“cd”, [“a”, “b”]] swap: [“cd”, [“b”, “a”]] concatenate: “cdba”
Example 3 Input: $str1 = “hello”, $str2 = “hiiii” Output: false
A fundamental rule of scrambled strings is that they must be anagrams.
Example 4 Input: $str1 = “ateer”, $str2 = “eater” Output: true
“ateer” split: [“ate”, “er”] split: [[“at”, “e”], “er”] swap: [[“e”, “at”], “er”] concatenate: “eater”
Example 5 Input: $str1 = “abcd”, $str2 = “bdac” Output: false #+endexample
I do a recursive sub to check if two words are scrambled
versions of each other. The result is trivial if the strings
are identical or if they contain different sets of
letters. If not, then I split the first string into a pairs
of different lengths,
and compare each of the substrings with the correspondingly
sized substrings of the other string before and if necessary
after transposing them until I succeed. If every splitting
fails, the whole test fails. The result can be fitted to a
4-liner, not that it makes much sense.
Examples:
perl -MList::Util=none -E '
for my($v,$w)(@ARGV){say "$v, $w -> ",c($v, $w)?"T":"F";}sub f($x,$y,$z){substr($x,$y,$z)}sub c($v,
$w){return 1if$v eq$w;my%l;++$l{$_}for split"",$v;--$l{$_}for split"",$w;return 0unless none{$_}
values %l;my$s=length$v;for my$i(1..$s-1){return 1if(c(f($v,0,$i),f($w,0,$i))&&c(f($v,$i,$s-$i),
f($w,$i,$s-$i)))||(c(f($v,$i,$s-$i),f($w,0,$s-$i))&&c(f($v,0,$i),f($w,$s-$i,$i)));}return 0;}
' abc acb abcd cdba hello hiiii ateer eater abcd bdac
Results:
abc, acb -> T
abcd, cdba -> T
hello, hiiii -> F
ateer, eater -> T
abcd, bdac -> F
By the way, trying to compact the above program I learned
that intrinsic functions such as substr may not be called
using the goto & syntax nor using @arrays instead of
spelling out all arguments.
The full code is:
1 # Perl weekly challenge 370
2 # Task 2: Scramble String
3 #
4 # See https://wlmb.github.io/2026/04/20/PWC370/#task-2-scramble-string
5 use v5.36;
6 use List::Util qw(none);
7 die <<~"FIN" unless @ARGV && @ARGV%2==0;
8 Usage: $0 A0 B0 A1 B1...
9 to check if string Bn may be obtained by scrambling string An.
10 FIN
11
12 for my ($word1, $word2)(@ARGV){
13 say "$word1, $word2 -> ", check($word1, $word2)?"True":"False";
14 }
15
16 sub check($word1, $word2){
17 return 1 if $word1 eq $word2;
18 my %letters;
19 ++$letters{$_} for split "", $word1;
20 --$letters{$_} for split "", $word2;
21 return 0 unless none {$_} values %letters;
22 my $length = length $word1;
23 for my $i(1..$length-1){
24 return 1
25 if (check(substr($word1, 0, $i), substr($word2,0,$i))
26 && check(substr($word1,$i,$length-$i), substr($word2,$i,$length-$i)))
27 || (check(substr($word1, $i, $length-$i), substr($word2,0,$length-$i))
28 && check(substr($word1,0, $i), substr($word2,$length-$i,$i)))
29 ;
30 }
31 return 0;
32 }
Example:
./ch-2.pl abc acb abcd cdba hello hiiii ateer eater abcd bdac
Results:
abc, acb -> True
abcd, cdba -> True
hello, hiiii -> False
ateer, eater -> True
abcd, bdac -> False
/;