The Bear's Den

Enter at your own risk

Similar Colors

\[\newcommand{\r}{\operatorname{r}}\]

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

Solution

Deducing some properties of the “similar” relation from the examples:

Further assumptions:

Modifying the task:

We call a subset \(u \subset M\) uniformly similar, if there is an \(s \in S\) with \(u \subseteq s\).

For 2-element subsets this generates a symmetric relation “is similar to” that is not reflexive per se.

A set property analog to a reflexive relation is one that is true for all singletons: Consider the set \(\{x, y\}\). It is a singleton if and only if \(x = y\). If the set property holds for singletons, the induced relation is reflexive.

Therefore the lists \(L_i\) are called similar if they have the same size and all sets \(l_j = \{m_{ij}\}\) are uniformly similar or singletons.

Applied to two lists, this definition recovers the original task.

Using a representative

Suppose we had a representative function \(\r(x)\) for every element of \(M\) such that \(\r(x) = \r(y)\) if and only if “x is similar to y”.

Let \(M = \{a, b, c\}\) and \(S = \{\{a, b\}, \{b, c\}\}\) like example 2. There are three non-trivial relations:

Suppose \(\r(b) \ne b\). Without loss of generality, let \(\r(b) = a\). In any case, \(\r(c)\) must be either \(b\) or \(c\), which means \(\r(b) \ne \r(c)\), violating “b is similar to c”.

Therefore \(\r(b) = b\) must hold.

\(\r(a)\) must either be \(a\) or \(b\).

From \(\r(a) = a\) it would follow “a is not similar to b” contrary to the actual relation.

This leads to the only remaining alternative \(\r(a) = b\) and \(r(c) = b\), implying “a is similar to c”, which is not true.

Such a representative function \(\r(x)\) therefore cannot exist.

J

Implementing the above definition as a tacit verb in J.

All sets are implemented as lists.

A small detail: short subsets from \(S\) are filled with empty boxes, while short columns are filled with boxed space. Both shall not appear anywhere else and compare as not equal. Thus there is no need to give attention to the lists’ sizes.

similar_lists =: _(adverb define)
   NB. does y contain exactly one unique item?
   singleton =. 1&= @ # @ ~.

   NB. open boxed lists of boxed strings and transpose these
   NB. set missing items to "boxed space"
   open_cols =. |: @: (>!.(<' '))

   NB. test if items from y are contained in x
   in =. e.~

   any =. +./
   all =. *./

   NB. use  "x u1`u2 if v y" to apply "x u2 y" when "x v y" is true,
   NB. or "x u1 y" otherwise
   if =. @.

   true =. 1:

   NB. check if there is a row in x that
   NB. contains all items of y
   common_superset =. any @: (all rows) @: (in rows)

   NB. for each column from y check if it is a singleton
   NB. or if has a common superset in x
   NB. this must be true for all columns
   [: : (>@[ all @: (common_superset`true if (singleton@])"_ 1) open_cols@]) f.
)

See the full solution.

Perl

Almost the same in Perl.

The subsets in the similarities and the list columns are implemented as sets, while the similarities as a whole are treated as a list.

Almost the same detail:
zip fills short colums with undef, which is treated as an empty string by Set::Scalar, which shall not appear anywhere else. Again, there is no need to give attention to the lists’ sizes.

use strict;
use warnings;
use Set::Scalar;
use List::Util 'zip';
use List::MoreUtils qw(all any);

sub similar_lists {
    my @similar = map Set::Scalar->new(@$_), pop()->@*;

    all {
        my $col = Set::Scalar->new(@$_);
        $col->size == 1 || any {$col <= $_} @similar;
    } zip @_;
}

See the full solution to task 1.

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

Solution

For each color value \(x\), a quantization from 256 to 6 values is performed by:

\[\operatorname{q}(x) = 51 \Big\lfloor\frac{x + 25}{51} \Big\rfloor\]

J

This is a nice use-case for J’s “under” conjunction. Basically (ignoring ranks), u&.v y acts as v^:_1 u v y, i.e. v is applied to y, u is applied to the result which is then the argument to the inverse of v: v^:_1.

The above formula has to be applied to an integer value derived from its hexadecimal representation and then back-transformed to hexadecimal: a typical case for “under”.

The same within the formula itself: divide by 51, apply floor and reverse the division by multiplication with 51.

An amazing feature of J is its ability to “know” the inverse of several primitive verbs with one fixed argument, such as “divide by 51” %&51 and composed verbs of this kind.

As such, the conversion from a hex string to integer has a known inverse. However, this inverse would produce hex strings of variable length.

OTOH a conversion from a 2-digit hex string to an integer has a known inverse, too. This is an integer-to-hexadecimal converter that throws an error if the result does not fit into two hex digits.

web_hex =: _(adverb define)
   NB. drop first item from y
   behead =. }.

   NB. convert integer to 2-digit hex string
   NB. (it has a default inverse)
   hex =. '0123456789ABCDEF' {~ ((2 $ 16)&#:)

   NB. floor((y + 25) / 51) * 51
   round_51 =. [: <.&.(%&51) 25 + ]

   NB. flatten to 1-d (monad)
   ravel =. ,

   NB. append (dyad)
   append =. ,

   NB. first item from y
   head =. {.

   NB. - drop first character from y
   NB. - apply to groups of 2 characters:
   NB.   - convert from hex string to integer
   NB.   - round to nearest multiple of 51
   NB.   - (implicitly) convert from integer to hex string
   NB. - flatten the result
   NB. - prepend the first character from y
   (head append [: ravel _2 round_51&.(hex inv)\ behead) f. : [:
)
   web_hex '#F4B2D1'
#FF99CC

See the full solution.

Perl

A straightforward implementation of the above formula under split/join and hexadecimal de-/encoding.

use strict;
use warnings;
use Math::Prime::Util qw(fromdigits todigitstring);
use experimental 'signatures';

sub web_hex ($str) {
    my $head = substr $str, 0, 1, '';
    $head . join '', map {
        uc todigitstring(int((fromdigits($_, 16) + 25) / 51) * 51, 16, 2)
    } $str =~ /../g;
}

See the full solution to task 2.