Perl Weekly Challenge 375.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 375.
Task 1: Single Common Word
Submitted by: Mohammad Sajid Anwar
You are given two array of strings.
Write a script to return the number of strings that appear
exactly once in each of the two given arrays. String
comparison is case sensitive.
Example 1
Input: @array1 = ("apple", "banana", "cherry")
@array2 = ("banana", "cherry", "date")
Output: 2

Example 2
Input: @array1 = ("a", "ab", "abc")
@array2 = ("a", "a", "ab", "abc")
Output: 2
"a" appears once in @array1 but appears twice in @array2,
therefore, not counted.
Example 3
Input: @array1 = ("orange", "lemon")
@array2 = ("grape", "melon")
Output: 0
Example 4
Input: @array1 = ("test", "test", "demo")
@array2 = ("test", "demo", "demo")
Output: 0
Example 5
Input: @array1 = ("Hello", "world")
@array2 = ("hello", "world")
Output: 1
String comparison is case sensitive.

I’ll assume that the arrays are provided in @ARGV as
space separated strings. Then I can split them, make hashes
counting the number of appearances of each string in each
array and filter the keys of one of them by checking both
counts. The result fits a simple two-liner.
Examples:
perl -E '
for my($x,$y)(@ARGV){my(%c,%d);$c{$_}++for split" ",$x;$d{$_}++for
split" ",$y;say"\"$x\", \"$y\" -> ",0+grep{$c{$_}==$d{$_}==1}keys%c;}
' "apple banana cherry" "banana cherry date" "a ab abc" "a a ab abc" \
"orange lemon" "grape melon" "test test demo" "test demo demo" \
"Hello world" "hello world"
Results:
"apple banana cherry", "banana cherry date" -> 2
"a ab abc", "a a ab abc" -> 2
"orange lemon", "grape melon" -> 0
"test test demo", "test demo demo" -> 0
"Hello world", "hello world" -> 1
The full code is:
1 # Perl weekly challenge 375
2 # Task 1: Single Common Word
3 #
4 # See https://wlmb.github.io/2026/05/26/PWC375/#task-1-single-common-word
5 use v5.36;
6 die <<~"FIN" unless @ARGV and @ARGV%2==0;
7 Usage: $0 X0 Y0 X1 Y1...
8 to find those space separated words that appear exactly once
9 in strings Xn and Yn
10 FIN
11 for my ($x,$y) (@ARGV){
12 my(%count_x, %count_y);
13 $count_x{$_}++ for split " ", $x;
14 $count_y{$_}++ for split" ", $y;
15 say"\"$x\", \"$y\" -> ",0+grep{($count_x{$_}//0) == ($count_y{$_}//0) == 1}
16 keys %count_x;
17 }
Notice that I used the // operator to avoid comparing
undefined values.
Examples:
./ch-1.pl "apple banana cherry" "banana cherry date" \
"a ab abc" "a a ab abc" \
"orange lemon" "grape melon" \
"test test demo" "test demo demo" \
"Hello world" "hello world"
Results:
"apple banana cherry", "banana cherry date" -> 2
"a ab abc", "a a ab abc" -> 2
"orange lemon", "grape melon" -> 0
"test test demo", "test demo demo" -> 0
"Hello world", "hello world" -> 1
Task 2: Find K-Beauty
Submitted by: Mohammad Sajid Anwar
You are given a number and a digit (k).
Write a script to find the K-Beauty of the given number. The
K-Beauty of an integer number is defined as the number of
substrings of given number when it is read as a string has
length of ‘k’ and is a divisor of given number.
Example 1
Input: $num = 240, $k = 2
Output: 2
Substring with length 2:
24: 240 is divisible by 24
40: 240 is divisible by 40

Example 2
Input: $num = 1020, $k = 2
Output: 3
Substring with length 2:
10: 1020 is divisible by 10
02: 1020 is divisible by 2
20: 1020 is divisible by 20

Example 3
Input: $num = 444, $k = 2
Output: 0
Substring with length 2:
First "44": 444 is not divisible by 44
Second "44": 444 is not divisible by 44

Example 4
Input: $num = 17, $k = 2
Output: 1
Substring with length 2:
17: 17 is divisible by 17

Example 5
Input: $num = 123, $k = 1
Output: 2
Substring with length 1:
1: 123 is divisible by 1
2: 123 is not divisible by 2
3: 123 is divisible by 3
I use a regular expression to produce all substrings of the given length. I filter them according to their divisibility and then I count them. The result fits a one liner.
Examples:
perl -E '
for my($n, $k)(@ARGV){say"num=$n k=$k -> ", 0+grep{$n%$_==0}$n=~/(?=(\d{$k}))/g;}
' 240 2 1020 2 444 2 17 2 123 1
Results:
num=240 k=2 -> 2
num=1020 k=2 -> 3
num=444 k=2 -> 0
num=17 k=2 -> 1
num=123 k=1 -> 2
The regular expression matches and captures repeatedly (/g) a
sequence of $k digits (\d{$k}), but the capture is enclosed in a
zero width lookahead assertion /(?=(\d{$k}))/ so that the
position doesn’t advance. The /g modifier advances it one
step to avoid an infinite loop, so the match produces a
list of all substrings of digits of length $k.
The full code is almost identical:
1 # Perl weekly challenge 375
2 # Task 2: Find K-Beauty
3 #
4 # See https://wlmb.github.io/2026/05/26/PWC375/#task-2-find-k-beauty
5 use v5.36;
6 die <<~"FIN" unless @ARGV and @ARGV%2==0;
7 Usage: $0 N0 K0 N1 K1...
8 to find how many substrings of Nn of length Kn divide Nn.
9 FIN
10 for my ($n, $k) (@ARGV) {
11 say"num=$n k=$k -> ", 0+grep{ $n%$_ == 0} $n=~/(?=(\d{$k}))/g;
12 }
Example:
./ch-2.pl 240 2 1020 2 444 2 17 2 123 1
Results:
num=240 k=2 -> 2
num=1020 k=2 -> 3
num=444 k=2 -> 0
num=17 k=2 -> 1
num=123 k=1 -> 2
/;