Perl Weekly Challenge: Week 383
Challenge 1:
Similar List
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
I feel the spec was a little vague, it took me some time to figure out exactly how the third list was supposed to work but maybe that's just me. In any case, once I got the idea it was pretty much plain sailing.
To get the input into the script, the approach I chose was to make the first twp
command-line arguments the source of @list1 and @list2 and the rest the
source of @list3 where each argument would be a sublist. The elements of
each list or sublist would be words separated by whitespace. So for example 5,
the input would be "fast car" "quick vehicle" "quick fast" "vehicle car".
my @list1 = @args.shift.words;
my @list2 = @args.shift.words;
I don't know exactly why I would need to add .List here when it was not
neceesary in the previous two lines but Raku apparently flattens the sublists
into one if you don't.
my @list3 = @args.map({ .words.List });
We also create a variable to hold the result.
my $result = True;
If @list1 and @list2 are of different lengths, they are obviously not similar
so we change the result to False and skip the rest of the processing.
if @list1.elems != @list2.elems {
$result = False;
} else {
Otherwise we compare consecutive pairs of elements from @list1 and @list2.
I'm using the indices of @list1 as the loop counter but I could just have
easily used @list2 as we know they are the same length.
for @list1.keys -> $i {
If the two elements are the same, well, you can't get more similar than that so we remove them.
if @list1[$i] eq @list2[$i] {
@list1[$i]:delete;
@list2[$i]:delete;
}
}
After equal pairs have been removed, we do another round. This time we compare
the two elements to the appropriate sublist of @list3. If either element is
not an element of (Raku has a special operator ∉ for "not an element of") the
sublist, the $result is False and we stop processing here.
for @list1.keys -> $i {
my $similar = @list3[$i];
if @list1[$i] ∉ @$similar || @list2[$i] ∉ @$similar {
$result = False;
last;
}
}
}
Finally we print the result.
say $result;
The Perl version does not require any additional code but we do need to workaround some Raku features missing in Perl.
split /\s+/ replaces .words()
my @list1 = split /\s+/, shift;
my @list2 = split /\s+/, shift;
my @list3 = map { [ split /\s+/ ] } @ARGV;
my $result = true;
if (scalar @list1 != scalar @list2) {
$result = false;
} else {
for my $i (keys @list1) {
if ($list1[$i] eq $list2[$i]) {
delete $list1[$i];
delete $list2[$i];
}
}
for my $i (keys @list1) {
my @similar = @{$list3[$i]};
Instead of ∉ we have to using boring but dependable old grep().
unless ((grep { $_ eq $list1[$i] } @similar) &&
(grep { $_ eq $list2[$i] } @similar)) {
$result = false;
last;
}
}
}
say $result ? "true" : "false";
Challenge 2:
Nearest RGB
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
The MAIN() function is very simple.
$color is split up into units of two characters with .comb(). Using .map()
each one isturned into a hexadecimal number literal by prefixing it with 0x and
fed to thw nearest() function which will be explained below. The output is
stored in the variables $r, $g and $b.
my ($r, $g, $b) = $color.comb(2).map({ nearest("0x$_") });
These veriabless are concatenated and prefixed with an # as in the spec and
printed out.
say "#$r$g$b";
nearest() takes a 2-digit hexadecimal number literal and returns the nearest
web-safe value.
sub nearest($n) {
The web-safe values never change so we store them as a static or state variable
called @near.
state @near = (0x0, 0x33, 0x66, 0x99, 0xCC, 0xFF);
The result is initially set to the last element of @near.
my/ $result = @near[*-1];
For each element of @near from the second to the end...
for 1 .. @near.end -> $i {
...we see if $n is less or equal. If so we compare $ns distance to the current element and the one before it and sets $result to whichever is nearer; at this point we can stop processing.
if $n <= @near[$i] {
$result = ($n - @near[$i - 1]) < (@near[$i] - $n)
?? @near[$i - 1]
!! @near[$i];
last;
}
Otherwise, we continue to the next element.
}
Finally we return $result formatted as a zero-padded two-digit hexadecimal number.
return '%02X'.sprintf($result);
}
For Perl, we use a regular expression to break up $color into two-character
chunks. We also have to call hex() on each chunk to convert it into a
hexadecimal number.
my ($r, $g, $b) = map { nearest(hex($_)) } $color =~ /(..)/g;
say "#$r$g$b";
The Perl version of nearest() works exactly the same as in Raku.
sub nearest($n) {
state @near = (0x0, 0x33, 0x66, 0x99, 0xCC, 0xFF);
my $result = $near[-1];
for my $i (1 .. (scalar @near - 1)) {
if ($n <= $near[$i]) {
$result = ($n - $near[$i - 1]) < ($near[$i] - $n)
? $near[$i - 1]
: $near[$i];
last;
}
}
return sprintf('%02X', $result);
}