Perl Weekly Challenge 383.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 383.
Task 1: Similar List
Submitted by: Mohammad Sajid Anwar
You are given three list of strings.
Write a script to find out if the first two list are similar
with the help the third list. The third list contains the
similar words map.
Example 1
Input: $list1 = ("great", "acting")
$list2 = ("fine", "drama")
$list3 = (["great", "fine"], ["acting", "drama"])
Output: true

Example 2
Input: $list1 = ("apple", "pie")
$list2 = ("banana", "pie")
$list3 = (["apple", "peach"], ["peach", "banana"])
Output: false

Example 3
Input: $list1 = ("perl4", "python")
$list2 = ("raku", "python")
$list3 = (["perl4", "perl5", "raku"])
Output: true

Example 4
Input: $list1 = ("enjoy", "challenge")
$list2 = ("love", "weekly", "challenge")
$list3 = (["enjoy", "love"])
Output: false

Example 5
Input: $list1 = ("fast", "car")
$list2 = ("quick", "vehicle")
$list3 = (["quick", "fast"], ["vehicle", "car"])
Output: true

Example 2 shows that only one substitution is allowed and that words may appear in different lists. Example 3 shows that lists may contain more than two items. It seems that the number and order of words is relevant. I can make a hash with each possible replacement, including replacement by itself. Then, the result is true if every word of the second list equals some replacement of a word in the first list. The result fits a three-liner.
Examples:
perl -MList::Util=all,any -E '
for my($f,$s,$t)(@ARGV){my %e;for(split/;\s*/,$t){@e=split " ";push$e{$_}->@*,@e
for @e;}@f=split " ",$f;@s=split " ",$s;push$e{$_}->@*,$_ for @f;$r=@f==@s&&all{
$x=$f[$_];$y=$s[$_];any{$_ eq $y}$e{$x}->@*}0..@f-1;say "$f\n$s\n$t\n-> ", $r?"T":"F"}
' "great acting" "fine drama" "great fine; acting drama" \
"apple pie" "banana pie" "apple peach; peach banana" \
"perl4 python" "raku python" "perl4 perl5 raku" \
"enjoy challenge" "love weekly challenge" "enjoy love" \
"fast car" "quick vehicle" "quick fast; vehicle car"
Results:
great acting
fine drama
great fine; acting drama
-> T
apple pie
banana pie
apple peach; peach banana
-> F
perl4 python
raku python
perl4 perl5 raku
-> T
enjoy challenge
love weekly challenge
enjoy love
-> F
fast car
quick vehicle
quick fast; vehicle car
-> T
The full code is:
1 # Perl weekly challenge 383
2 # Task 1: Similar List
3 #
4 # See https://wlmb.github.io/2026/07/20/PWC383/#task-1-similar-list
5 use v5.36;
6 use List::Util qw(any all);
7 die <<~"FIN" unless @ARGV and @ARGV%3==0;
8 Usage: $0 F0 S0 E0 F1 S1 E1...
9 to find if the list of words Sn is equivalent to the
10 list Fn using the list of equivalences En. Fn and Sn are
11 space separated lists of words and En are semicolon
12 separated lists of space separated equivalent words.
13 FIN
14 for my($first, $second, $equivalence)(@ARGV){
15 my %equivalences;
16 for(split/;\s*/,$equivalence){
17 my @equivalent = split " ";
18 push $equivalences{$_}->@*, @equivalent for @equivalent;
19 }
20 my @first_words = split " ", $first;
21 my @second_words= split " ", $second;
22 push $equivalences{$_}->@*, $_ for @first_words;
23 my $result = @first_words == @second_words
24 &&
25 all{
26 my $f=$first_words[$_];
27 my $s=$second_words[$_];
28 any{$_ eq $s} $equivalences{$f}->@*
29 }0..@first_words-1;
30 say "First: $first\nSecond: $second\nEquivalences: $equivalence\n-> ", $result?"True":"False", "\n";
31 }
Example:
./ch-1.pl "great acting" "fine drama" "great fine; acting drama" \
"apple pie" "banana pie" "apple peach; peach banana" \
"perl4 python" "raku python" "perl4 perl5 raku" \
"enjoy challenge" "love weekly challenge" "enjoy love" \
"fast car" "quick vehicle" "quick fast; vehicle car"
Results:
First: great acting
Second: fine drama
Equivalences: great fine; acting drama
-> True
First: apple pie
Second: banana pie
Equivalences: apple peach; peach banana
-> False
First: perl4 python
Second: raku python
Equivalences: perl4 perl5 raku
-> True
First: enjoy challenge
Second: love weekly challenge
Equivalences: enjoy love
-> False
First: fast car
Second: quick vehicle
Equivalences: quick fast; vehicle car
-> True
Task 2: Nearest RGB
Submitted by: Mohammad Sajid Anwar
You are given a 6-digit hex color.
Write a script to round the RGB channels to the nearest
web-safe value and return the nearest RGB color.
00 (0), 33 (51), 66 (102), 99 (153), CC (204) and FF (255)
Example 1
Input: $color = "#F4B2D1"
Output: "#FF99CC"
Red: F4 (Decimal 244), closer to 255 => FF
Green: B2 (Decimal 178), closer to 153 => 99
Blue: D1 (Decimal 209), closer to 204 => CC
So the nearest RGB: "#FF99CC"

Example 2
Input: $color = "#15E6E5"
Output: "#00FFCC"
Red: 15 (Decimal 21), closer to 0 => 00
Green: E6 (Decimal 230), closer to 255 => FF
Blue: E5 (Decimal 229), closer to 204 => CC

Example 3
Input: $color = "#191A65"
Output: "#003366"
Red: 19 (Decimal 25), closer to 0 => 00
Green: 1A (Decimal 26), closer to 51 => 33
Blue: 65 (Decimal 101), closer to 102 => 66

Example 4
Input: $color = "#2D5A1B"
Output: "#336633"
Red: 2D (Decimal 45), closer to 51 => 33
Green: 5A (Decimal 90), closer to 102 => 66
Blue: 1B (Decimal 27), closer to 51 => 33

Example 5
Input: $color = "#00FF66"
Output: "#00FF66"
Red: 00 (Decimal 0), closer to 0 => 00
Green: FF (Decimal 255), closer to 255 => FF
Blue: 66 (Decimal 102), closer to 102 => 66
I make a list of borders between the basins of each safe
value. For each color coordinate, I get the index of the
first border (from List::Util) not smaller than that coordinate and the
corresponding hex number with which I build the output safe
color. The result fits a two-liner.
Examples:
perl -MList::Util=first -E '
@s=qw(00 33 66 99 CC FF);@b=map{hex($_)+25}@s;say"$_ -> ",join"","\#",
map{$v=hex $_; $s[first{$v<=$b[$_]}0..@b-1]}s/\#//r=~/(..)/g for@ARGV;
' "#F4B2D1" "#15E6E5" "#191A65" "#2D5A1B" "#00FF66"
Results:
#F4B2D1 -> #FF99CC
#15E6E5 -> #00FFCC
#191A65 -> #003366
#2D5A1B -> #336633
#00FF66 -> #00FF66
The full code is:
1 # Perl weekly challenge 383
2 # Task 2: Nearest RGB
3 #
4 # See https://wlmb.github.io/2026/07/20/PWC383/#task-2-nearest-rgb
5 use v5.36;
6 use feature qw(try);
7 use List::Util qw(first);
8
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 C0 C1...
11 to obtain the nearest RGB safe color corresponding to
12 the color Cn, expressed as an hexadecimal number preceeded
13 by a hash mark.
14 FIN
15
16 my @safe = qw(00 33 66 99 CC FF);
17 my @boundaries = map{ hex($_) + 25} @safe;
18 for(@ARGV){
19 try{
20 die "Expected a hash followed by 6 hex digits: $_" unless /^\#[[:xdigit:]]{6}$/;
21 say "$_ -> ",
22 join "", "\#",
23 map{
24 my $value = hex $_;
25 $safe[
26 first{$value <= $boundaries[$_]} 0..@boundaries-1
27 ]
28 }
29 s/\#//r # remove leading hash
30 =~/(..)/g # separate in pairs of digits
31 }
32 catch($e){warn $e;}
33 }
Example:
./ch-2.pl "#F4B2D1" "#15E6E5" "#191A65" "#2D5A1B" "#00FF66"
Results:
#F4B2D1 -> #FF99CC
#15E6E5 -> #00FFCC
#191A65 -> #003366
#2D5A1B -> #336633
#00FF66 -> #00FF66
/;
Written on July 20, 2026