Perl Weekly Challenge: Hey! Are we doing government work here?

Posted on by

Perl Weekly Challenge 383‘s tasks are “Similar List” and “Nearest RGB”.

Since this week’s tasks are both about finding things that are close, but not exact, and because my wife has us on a Weird Al kick lately, let’s pick Close But No Cigar as this week’s musical selection.

Task 1: Similar List

You are given three list of strings.

Write a script to find out if the first two lists 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

Approach

Ok, this one took me a while to understand. “The third list contains the similar words map.” What does that even mean? I started comparing the examples where the output was true, and I noted in example 1, words from lists 1 and 2 appeared in list 3, and in example 3 one word from each list 1 and 2 appeared in list 3, and in example 5, words from lists 1 and 2 appeared in list 3. But we have words in lists 1 and 2 appearing in list 3 in examples 2 and 4, and those are false. So it wasn’t just words appearing in the lists.

Then I noticed that similar lists had the same number of words. So I think rule 1 for a similar list is that they both have to have the same number of words.

I also noticed that in example 3, one of two examples where list 3 contains just one list, the word “python” appears in both lists 1 and 2. So I think rule 2 is that identical words count towards making two lists similar.

Finally, I noticed that list 3 isn’t just a list of words, it’s a list of lists of words, and words in the same list must be “similar” (rule 3). So let’s look at each of the examples and see how they stack up against these rules I’ve gleaned:

Example 1: Both lists have the same number of words. Rule 3 satisfied. Neither list has identical words, so rule 2 isn’t broken. List 1’s “great” and list 2’s “fine” are in the same sublist of list 3, so they’re similar, and list 1’s “acting” and list 2’s “drama” are in the same sublist of list 3, so they’re similar, and rule 3 is satisfied.

Example 2: both list have the same number of words, both lists have an identical word, but the remaining words, “apple” and “banana”, appear in different sublists of list 3, so they can’t be similar.

Example 3: same number of words, both lists have an identical word, and the remaining words, “perl4” and “raku”, appear in the same sublist of list 3. The lists are similar.

Example 4: list 1 has two words, list 2 has three words, so I’m guessing that’s why they’re not similar. The other two rules would be satisfied.

Example 5: same number of words, no identical words, but List 1’s “fast” and list 2’s “quick” are in the same sublist of list 3, so they’re similar, and list 1’s “car” and list 2’s “vehicle” are in the same sublist of list 3, so they’re similar, and rule 3 is satisfied.

Raku

I figured the easiest way to do this would be to eliminate identical and similar words from copies of the lists and if we wound up with empty lists at the end, the original lists are similar.

sub similar(@list1 is copy, @list2 is copy, @list3) {
  # are the lists the same length?
  return False unless @list1 == @list2;

  # eliminate identical words
  for @list1 -> $word {
    next unless $word eq @list2.any;
    @list1 = [ @list1.grep({ $_ ne $word }) ];
    @list2 = [ @list2.grep({ $_ ne $word }) ];
  }

  # eliminate "similar" words using list3
  for @list1 -> $word {
    for @list3 -> @sublist {
      next unless $word eq @sublist.any;
      next unless my $word2 = @sublist.grep(any @list2);
      @list1 = [ @list1.grep({ $_ ne $word  }) ];
      @list2 = [ @list2.grep({ $_ ne $word2 }) ];
    }
  }

  return @list1 == @list2 == 0;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
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

Perl

The only tricky bit of translating this from Raku into Perl was I couldn’t pass the Junction any into grep because Perl’s grep needs to use the default variable $_, and List::AllUtils’ any also works by setting $_ in the block, so I needed to save the grep‘s $_ into a temporary variable so I could compare it with any‘s $_ (line 22).

use List::AllUtils qw( any );

sub similar($list1, $list2, $list3) {
  # are the lists the same length?
  return 'False' unless @$list1 == @$list2;

  # eliminate identical words
  for my $word (@$list1) {
    next unless any { $word eq $_ } @$list2;
    $list1 = [ grep { $_ ne $word } @$list1 ];
    $list2 = [ grep { $_ ne $word } @$list2 ];
  }

  # eliminate "similar" words using list3
  for my $word (@$list1) {
    for my $sublist (@$list3) {
      next unless any { $word eq $_ } @$sublist;
      next unless my ($word2) = grep {
        my $w = $_; any { $_ eq $w } @$list2
      } @$sublist;
      $list1 = [ grep { $_ ne $word  } @$list1 ];
      $list2 = [ grep { $_ ne $word2 } @$list2 ];
    }
  }

  return @$list1 == @$list2 == 0 ? 'True' : 'False';
}

View the entire Perl script for this task on GitHub.

Python

Python made things easier because you can just use var not in listvar to test to see if a variable’s value appears in a list.

def similar(list1, list2, list3):
  # are the lists the same length?
  if len(list1) != len(list2): return False

  # eliminate identical words
  for word in list1:
    if word not in list2: continue
    list1 = [ w for w in list1 if w != word ]
    list2 = [ w for w in list2 if w != word ]
    
  # eliminate "similar" words using list3
  for word in list1:
    for sublist in list3:
      if word not in sublist: continue
      word2 = None
      for w2 in sublist:
        if w2 not in list2: continue
        word2 = w2
        break
      if word2 is None: continue
      list1 = [ w for w in list1 if w != word  ]
      list2 = [ w for w in list2 if w != word2 ]

  return "True" if len(list1) == len(list2) == 0 else "False"

View the entire Python script for this task on GitHub.

Elixir

Elixir is complicated, of course, by every statement needing to provide else statements returning unmodified versions of our lists if we didn’t find elements we wanted to eliminate (lines 24-25, 41-42, 45-46). One thing that made it easier was List.delete/2, which let me just provide a value to delete from a list, and it returned the modified list. I wrote a little function in_sublist/2 to find the sublist under list3 (if any) where a particular word appears, and Enum.any?/2 works just like var in listvar in Python does.

def in_sublist(_, []), do: []

def in_sublist(word, [sublist | rest]) do
  if Enum.any?(sublist, fn w -> w == word end) do
    sublist
  else
    in_sublist(word, rest)
  end
end

# are the lists the same length?
def similar(list1, list2, _)
  when length(list1) != length(list2), do: "False"

def similar(list1, list2, list3) do
  # eliminate identical words
  {list1, list2} = Enum.reduce(
    list1, {list1, list2}, fn word, {list1, list2} ->
      if Enum.any?(list2, fn w -> w == word end) do
        { List.delete(list1, word), List.delete(list2, word) }
      else
        {list1, list2}
      end
    end)

  # eliminate "similar" words using list3
  {list1, list2} = Enum.reduce(
    list1, {list1, list2}, fn word, {list1, list2} ->
      sublist = in_sublist(word, list3)
      if length(sublist) > 0 do
        Enum.reduce_while(
          list2, {list1, list2}, fn word2, {list1, list2} ->
            if Enum.any?(sublist, fn w -> w == word2 end) do
              {:halt, {
                List.delete(list1, word),
                List.delete(list2, word2)
              }}
            else
              {:cont, {list1, list2}}
            end
          end)
      else
        {list1, list2}
      end
    end)
    
  if length(list1) == length(list2) and length(list2) == 0,
   do: "True", else: "False"
end

View the entire Elixir script for this task on GitHub.

Task 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

Approach

Fortunately, this task was very straightforward, and I didn’t have to suss out any of the requirements.

The approach is similarly straightforward: for each 8-bit word in the color spec, find the closest value to one of the 6 web-safe values, and adjust the word to match that value. We can find the closest web-safe W value to a number N by calculating N-W for each of the web-safe values and then finding the difference with the smallest absolute value. We then make sure each of the numbers is expressed in hexadecimal again and rebuild the color spec.

Raku

First I needed to figure out how to get the minimum value in a list based on the abs of that value, and Any.min provided that: if I passed an anonymous function, it would use it to compare values to determine the minimum value. I used a regular expression to parse out the characters in the color spec, but that returned a Match object, so I needed to call .list on it to get the captured values out of the object. Str.parse-base provided me what I needed to convert those values from hex strings into numeric values, and I then passed those values through my closest() function to get the closest value.

I loved that List.fmt not only let me format the strings back to hex but it also let me join the strings on the empty string, so all I needed to do was prepend a new hash character and return the adjusted color code.

my @safe = (0, 51, 102, 153, 204, 255);

sub closest($num, @arr) {
  $num - @arr.map({ $num - $_ }).min({ $_.abs });
}

sub nearestRGB($color) {
  my $match = $color ~~ /\#(..)(..)(..)/; # grab the RGB values

  my @colors =
    $match.list                     # get the values 
    .map({ $_.Str.parse-base(16) }) # convert to decimal
    .map({ closest($_, @safe) });   # find closest web-safe value

  # convert back to hex and return as color code
  "#" ~ @colors.fmt('%02X', '');
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku 
Example 1:
Input: $color = "#F4B2D1"
Output: "#FF99CC"

Example 2:
Input: $color = "#15E6E5"
Output: "#00FFCC"

Example 3:
Input: $color = "#191A65"
Output: "#003366"

Example 4:
Input: $color = "#2D5A1B"
Output: "#336633"

Example 5:
Input: $color = "#00FF66"
Output: "#00FF66"

Also, because VSCode shows color swatches whenever you use an RGB color code, here’s how close these colors actually are:

Perl

For the Perl solution, I got a little nostalgic and used unpack to grab the values in the color codes, then convert them into decimal, run them through my closest() function and spit out a hex color spec. This time, I got it all in one statement, which is best read from bottom to top.

use List::AllUtils qw( min_by );

my @safe = (0, 51, 102, 153, 204, 255);

sub closest($num, @arr) {
  $num - min_by { abs($_) } map { $num - $_ } @arr;
}

sub nearestRGB($color) {
  sprintf "#%02X%02X%02X",      # convert back to hex and
                                # return as color code
    map { closest($_, @safe) }  # find closest web-safe value
    map { hex($_) }             # convert to decimal
    unpack("x1a2a2a2", $color); # grab the RGB values  
}

View the entire Perl script for this task on GitHub.

Python

For the Python solution, I needed to invoke min() with the key=abs argument to have it push the values through abs before deciding which was the minimum value. I looked around for some clever way to parse out the two-hexdigit color codes, but after a few minutes I thought, “Bah, I’ll just pull the characters out by position.” I’m calling int() with a base to translate the numbers into decimal before finding the closest values, and I’m using a f-string format spec to spit out the modified numbers as upper-case hex.

safe = (0, 51, 102, 153, 204, 255)

def closest(num, arr):
  return num - min([ num - x for x in arr ], key=abs)

def nearest_rgb(color):
  # grab the RGB values
  colors = color[1:3], color[3:5], color[5:7]
  # convert to decimal & find closest web-safe value
  colors = [ closest(int(n, 16), safe) for n in colors ]
  # convert back to hex and return as color code
  return "#" + "".join([f'{n:02X}' for n in colors])

View the entire Python script for this task on GitHub.

Elixir

As always, the Elixir solution was fun because I was able to chain statements together. Without the capture: :all_but_first option in Regex.scan/3, the result would include the portion of the string that was matched, which would be the entire string. Initially, I had each of the statements in lines 16-19 in their own Enum.map/2 call, but I wanted to stress how each of those operations were working on a single piece of information, that being a color code from 0-255. 

defp closest(num) do
  [0, 51, 102, 153, 204, 255]  # safe colors
  |> Enum.map(&( num - &1 ))   # find difference
  |> Enum.min_by(&( abs(&1) )) # min abs difference
  |> then(&( num - &1 ))       # subtract min value
end

def nearest_rgb(color) do
  # grab color codes from color spec
  Regex.scan(~r/#(..)(..)(..)/, color, capture: :all_but_first)
  |> hd # it's a list of lists, we only need the first list
  |> Enum.map(&(
    String.to_integer(&1, 16)     # parse as hex
    |> closest                    # find closest web-safe value
    |> Integer.to_string(16)      # convert back to hex
    |> String.pad_leading(2, "0") # pad with 0
  ))
  |> Enum.join
  |> then(&( "#" <> &1 ))
end

View the entire Elixir script for this task on GitHub.

Here’s all my solutions in GitHub: https://github.com/packy/perlweeklychallenge-club/tree/challenge-383-packy-anderson/challenge-383/packy-anderson

Leave a Reply