Perl Weekly Challenge 352.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 352.
Task 1: Match String
Submitted by: Mohammad Sajid Anwar
You are given an array of strings.
Write a script to return all strings that are a substring of another word
in the given array in the order they occur.
Example 1
Input: @words = ("cat", "cats", "dog", "dogcat", "dogcat", "rat", "ratcatdogcat")
Output: ("cat", "dog", "dogcat", "rat")
Example 2
Input: @words = ("hello", "hell", "world", "wor", "ellow", "elloworld")
Output: ("hell", "world", "wor", "ellow")
Example 3
Input: @words = ("a", "aa", "aaa", "aaaa")
Output: ("a", "aa", "aaa")
Example 4
Input: @words = ("flower", "flow", "flight", "fl", "fli", "ig", "ght")
Output: ("flow", "fl", "fli", "ig", "ght")
Example 5
Input: @words = ("car", "carpet", "carpenter", "pet", "enter", "pen", "pent")
Output: ("car", "pet", "enter", "pen", "pent")
I use each word to build a regular expression to test all the words. If there is success (beyond matching itself) then that word is a substring of some other word and I add to an output array. The code takes a 1.5-liner.
Examples:
perl -E '
for(@ARGV){$n=@i=split " ";@o=();for(@i){$c=$_;push @o,$c if 1<grep {/$c/}@i}
say "$_ -> ", join " ", @o;}
' "cat cats dog dogcat dogcat rat" "hello hell world wor ellow elloworld" \
"a aa aaa aaaa" "flower flow flight fl fli ig ght" "car carpet carpenter pet enter pen pent"
Results:
cat cats dog dogcat dogcat rat ratcatdogcat -> cat dog dogcat dogcat rat
hello hell world wor ellow elloworld -> hell world wor ellow
a aa aaa aaaa -> a aa aaa
flower flow flight fl fli ig ght -> flow fl fli ig ght
car carpet carpenter pet enter pen pent -> car pet enter pen pent
Comparison with the task statement shows that I also have to remove
duplicates. To that end, I use uniq from List::Util
perl -MList::Util=uniq -E '
for(@ARGV){$n=@i=split " ";@o=();for(@i){$c=$_;push @o,$c if 1<grep {/$c/}@i}
say "$_ -> ", join " ", uniq @o;}
' "cat cats dog dogcat dogcat rat ratcatdogcat" "hello hell world wor ellow elloworld" \
"a aa aaa aaaa" "flower flow flight fl fli ig ght" "car carpet carpenter pet enter pen pent"
Results:
cat cats dog dogcat dogcat rat ratcatdogcat -> cat dog dogcat rat
hello hell world wor ellow elloworld -> hell world wor ellow
a aa aaa aaaa -> a aa aaa
flower flow flight fl fli ig ght -> flow fl fli ig ght
car carpet carpenter pet enter pen pent -> car pet enter pen pent
For long lists it may be slightly faster using any from List::Util
to shortcut the comparisons at the first success. But then I would
have to avoid matching a string to itself, but allow matching to
repetitions of itself in the input. To that end, in the full code I
use the string indices.
1 # Perl weekly challenge 352
2 # Task 1: Match String
3 #
4 # See https://wlmb.github.io/2025/12/16/PWC352/#task-1-match-string
5 use v5.36;
6 use List::Util qw(any uniq);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 S1...
9 to find space separated strings in Sn that are substrings of others.
10 FIN
11 for(@ARGV){
12 my $n=my @in=split " ";
13 my @out=();
14 for(0..@in-1){
15 my $current=$in[my $current_indx=$_];
16 push @out, $current if any{$current_indx ne $_ && $in[$_]=~/$current/} 0..@in-1;
17 }
18 say "$_ -> ", join " ", uniq @out;
19 }
Example:
./ch-1.pl "cat cats dog dogcat dogcat rat ratcatdogcat" "hello hell world wor ellow elloworld" \
"a aa aaa aaaa" "flower flow flight fl fli ig ght" "car carpet carpenter pet enter pen pent"
Results:
cat cats dog dogcat dogcat rat ratcatdogcat -> cat dog dogcat rat
hello hell world wor ellow elloworld -> hell world wor ellow
a aa aaa aaaa -> a aa aaa
flower flow flight fl fli ig ght -> flow fl fli ig ght
car carpet carpenter pet enter pen pent -> car pet enter pen pent
Task 2: Binary Prefix
Submitted by: Mohammad Sajid Anwar
You are given an array, @nums, where each element is either 0 or 1.
Define xi as the number formed by taking the first i+1 bits of @nums
(from $nums[0] to $nums[i]) and interpreting them as a binary number,
with $nums[0] being the most significant bit.
For example:
If @nums = (1, 0, 1), then:
x0 = 1 (binary 1)
x1 = 2 (binary 10)
x2 = 5 (binary 101)
For each i, check whether xi is divisible by 5.
Write a script to return an array @answer where $answer[i] is true if x<sub>i</sub> is divisible by 5, otherwise false.
Example 1
Input: @nums = (0,1,1,0,0,1,0,1,1,1)
Output: (true, false, false, false, false, true, true, false, false, false)
Binary numbers formed (decimal values):
0: 0
01: 1
011: 3
0110: 6
01100: 12
011001: 25
0110010: 50
01100101: 101
011001011: 203
0110010111: 407
Example 2
Input: @num = (1,0,1,0,1,0)
Output: (false, false, true, true, false, false)
1: 1
10: 2
101: 5
1010: 10
10101: 21
101010: 42
Example 3
Input: @num = (0,0,1,0,1)
Output: (true, true, false, false, true)
0: 0
00: 0
001: 1
0010: 2
00101: 5
Example 4
Input: @num = (1,1,1,1,1)
Output: (false, false, false, true, false)
1: 1
11: 3
111: 7
1111: 15
11111: 31
Example 5
Input: @num = (1,0,1,1,0,1,0,0,1,1)
Output: (false, false, true, false, false, true, true, true, false, false)
1: 1
10: 2
101: 5
1011: 11
10110: 22
101101: 45
1011010: 90
10110100: 180
101101001: 361
1011010011: 723
I could initialize the starting value of x at 0, and for each digit d
calculate 2*x+d to get the current binary number xi, test for its
divisibility by 5 and iterate. Nevertheless, I can change x by x%5
without changing the divisibility condition, with the advantage that
2*(x%5)+1 is bounded between 0 and 9. Thus, instead of computing
(2*x+1)%5 I could calculate (2*(x%5)+1)%5 using a small array
lookup, where the array contains the numbers 0,1,2,3,4,0,1,2,3,4. I
may use reductions from List::Utils to keep the number modulo 5
and map zeroes to true and everything else to false. The result
fits a one-liner.
Examples:
perl -MList::Util=reductions -E '
@c=(0..4)x2; for(@ARGV){@i=split "";say "$_ -> ", map {$_?"F":"T"}reductions{$c[2*$a+$b]}@i}
' "0110010111" "101010" "00101" "11111" "1011010011"
Results:
0110010111 -> TFFFFTTFFF
101010 -> FFTTFF
00101 -> TTFFT
11111 -> FFFTF
1011010011 -> FFTFFTTTFF
The full code is:
1 # Perl weekly challenge 352
2 # Task 2: Binary Prefix
3 #
4 # See https://wlmb.github.io/2025/12/16/PWC352/#task-2-binary-prefix
5 use v5.36;
6 use feature qw(try);
7 use List::Util qw(reductions);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 S0 S1...
10 to find which left substrings of the binary strings Sn correspond to
11 binary numbers divisible by 5.
12 FIN
13 my @convert=(0..4)x2;
14 for(@ARGV){
15 try {
16 die "Not a binary string: $_" unless /^[01]+$/;
17 my @digits=split "";
18 say "$_ -> ", map {$_?"False ":"True "}
19 reductions{$convert[2*$a+$b]}@digits;
20 }
21 catch($e){warn $e;}
22 }
Example:
./ch-2.pl "0110010111" "101010" "00101" "11111" "1011010011"
Results:
0110010111 -> True False False False False True True False False False
101010 -> False False True True False False
00101 -> True True False False True
11111 -> False False False True False
1011010011 -> False False True False False True True True False False
/;
Written on December 16, 2025