RabbitFarm

2026-07-25

The Weekly Challenge 383 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 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.

Our solution is short and will be contained in a single file that has the following structure.

"ch-1.p" 1≡

: ⟨utilities 2 ⟩
⟨similar 3 ⟩
⟨similar DCG 4 ⟩
◇

First we’ll define a couple of helper predicates for constructing pairs from the given input lists. These pairs will be used as a data structure for the given mappings.

⟨utilities 2 ⟩≡

: make_kv(K, V, K-V).
make_kv(L, KV):-
L = [H|T],
maplist(make_kv(H), T, KV1),
reverse(L, LR),
LR = [HR|TR],
maplist(make_kv(HR), TR, KVR),
append(KV1, KVR, KV).
make_kvs([], []).
make_kvs([H|T], [KV|KVs]):-
make_kvs(T, KVs),
make_kv(H, KV).
◇

: Fragment referenced in 1.

Now we’ll compare the lists. First is just a small predicate for calling the DCG using phrase/2.

⟨similar 3 ⟩≡

: similar(L1, L2, M):-
make_kvs(M, KV1),
flatten(KV1, KVs),
phrase(similar(KVs, L1), L2).
◇

: Fragment referenced in 1.

This makes use of the following DCG definition.

⟨similar DCG 4 ⟩≡

: similar(_, []) --> [].
similar(_, []) --> [_], {!, fail}.
similar(KVs, L) --> [W], {L = [H|T], (H == W; member(H-W, KVs);
member(W-H, KVs))}, similar(KVs, T).
◇

: Fragment referenced in 1.

Sample Run

% gprolog --consult-file prolog/ch-1.p 
| ?- similar([great, acting], [fine, drama], [[great, fine], [acting, drama]]). 
 
true ? 
 
yes 
| ?- similar([apple, pie], [banana, pie], [[apple, peach], [peach, banana]]). 
 
no 
| ?- similar([perl4, python], [raku, python], [[perl4, perl5, raku]]). 
 
true ? 
 
yes 
| ?- similar([enjoy, challenge], [love, weekly, challenge], [[enjoy, love]]). 
 
no 
| ?- similar([fast, car], [quick, vehicle], [[quick, fast], [vehicle, car]]). 
 
true ? 
 
yes 
| ?-

Part 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.

This will proceed in a way very similar to Part 1, but this is a short enough problem so we won’t bother writing DCG rules.

"ch-2.p" 5≡

: ⟨utilities 10 ⟩
⟨compute the nearest RGB values 11 ⟩
◇

We’ll define a few helper predicates first.

⟨remove leading octothorpe 6 ⟩≡

: leading_octothorpe(Hex, Hex1):-
nth(1, Hex, 35),
Hex = [_|Hex1].
◇

: Fragment referenced in 10.

⟨code to hex conversion 7 ⟩≡

: codes_nearest_hex(Codes, Hex):-
atom_codes(A, Codes),
atom_concat(’0x’, A, A1),
number_atom(Decimal, A1),
N is truncate((Decimal + 25.5) / 51) * 51,
Offset is N + 256,
format_to_atom(Temp, ’~16R’, [Offset]),
sub_atom(Temp, 1, 2, _, Hex).
◇

: Fragment referenced in 10.

⟨split into RGB 8 ⟩≡

: rgb(Hex, R, G, B):-
length(R, 2),
length(G, 2),
length(B, 2),
append(R, GB, Hex),
append(G, B, GB).
◇

: Fragment referenced in 10.

⟨compute nearest 9 ⟩≡

: nearest_rgb(R, G, B, Nearest):-
maplist(codes_nearest_hex, [R, G, B], [R1, G1, B1]),
atom_concat(’#’, R1, H1),
atom_concat(H1, G1, H2),
atom_concat(H2, B1, Nearest).
◇

: Fragment referenced in 10.

⟨utilities 10 ⟩≡

: ⟨remove leading octothorpe 6 ⟩
⟨code to hex conversion 7 ⟩
⟨split into RGB 8 ⟩
⟨compute nearest 9 ⟩
◇

: Fragment referenced in 5.

Finally we’ll have a small predicate for tying everything together.

⟨compute the nearest RGB values 11 ⟩≡

: nearest_rgb(Hex, Nearest):-
leading_octothorpe(Hex, Hex1),
rgb(Hex1, R, G, B),
nearest_rgb(R, G, B, Nearest).
◇

: Fragment referenced in 5.

Sample Run

% gprolog --consult-file prolog/ch-2.p 
| ?- nearest_rgb("#F4B2D1", Nearest). 
 
Nearest = ’#FF99CC’ 
 
yes 
| ?- nearest_rgb("#15E6E5", Nearest). 
 
Nearest = ’#00FFCC’ 
 
yes 
| ?- nearest_rgb("#191A65", Nearest). 
 
Nearest = ’#003366’ 
 
yes 
| ?- nearest_rgb("#2D5A1B", Nearest). 
 
Nearest = ’#336633’ 
 
yes 
| ?- nearest_rgb("#00FF66", Nearest). 
 
Nearest = ’#00FF66’ 
 
yes 
| ?-

References

The Weekly Challenge 383
Generated Code

posted at: 23:22 by: Adam Russell | path: /prolog | permanent link to this entry

Similar and Nearest but in No Way Clearest

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 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.

The code can be contained in a single file which has the following structure. The different code sections are explained in detail later.

"ch-1.pl" 1≡

: use builtin q/true/, q/false/;
⟨build map 2 ⟩
⟨check similar 4 ⟩
⟨main 5 ⟩
◇

Some preliminary work is needed, to build the map given into a useful data structure. Given the relatively short lists involved we’ll just use a multi-valued hash. That is, a hash whose value is an array reference.

⟨build map 2 ⟩≡

: sub build_map{
my($m) = @_;
my $h = {};
{
my $l = pop @{$m};
my $k = shift @{$l};
for my $x (@{$l}){
$h->{$x} = $k;
}
redo if @{$m};
}
return $h;
}
◇

: Fragment referenced in 1.
: Uses: $m 4.

Now, first off, we can abandon all further processing if the lists are not of equal length. We’ll use this section inside the larger subroutine.

⟨check lengths 3 ⟩≡

: return false if @{$u} ne @{$v};
◇

: Fragment referenced in 4.
: Uses: $u 4, $v 4.

Otherwise we can loop over the lists and compare using the map.

⟨check similar 4 ⟩≡

: sub similar{
my($u, $v, $m) = @_;
⟨check lengths 3 ⟩
my $mapping = build_map($m);
{
my $vv = pop @{$v};
my $uu = pop @{$u};
return false unless($vv eq $uu || $mapping->{$vv} eq $uu
|| $mapping->{$uu} eq $vv);
redo if @{$u};
}
return true;
}
◇

: Fragment referenced in 1.
: Defines: $m 2, $u 3, $v 3.

Just to make sure things work as expected we’ll define a few short tests.

⟨main 5 ⟩≡

: MAIN:{ print similar ["great", "acting"], ["fine", "drama"], [["great", "fine"], ["acting", "drama"]]; print qq/\n/; print similar ["apple", "pie"], ["banana", "pie"], [["apple", "peach"], ["peach", "banana"]]; print qq/\n/; print similar ["perl4", "python"], ["raku", "python"], [["perl4", "perl5", "raku"]]; print qq/\n/; print similar ["enjoy", "challenge"], ["love", "weekly", "challenge"], [["enjoy", "love"]]; print qq/\n/; print similar ["fast", "car"], ["quick", "vehicle"], [["quick", "fast"], ["vehicle", "car"]]; print qq/\n/; }
◇

: Fragment referenced in 1.

Sample Run

% perl perl/ch-1.pl 
1 
 
1 
 
1

Part 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.

"ch-2.pl" 6≡

: use feature q/say/;
⟨nearest rgb 9 ⟩
⟨main 10 ⟩
◇

To be clear, in order to convert any hex color to its nearest web-safe equivalent, you need to convert the hex string to RGB decimal values, round each channel to the nearest multiple of 51 (since 0x33 is 51), and convert it back to hex.

Let’s first consider the removal of any leading octothorpe and make sure the input is of the right length.

⟨remove leading hash and check length 7 ⟩≡

: $color =~ tr/#//d;
return undef if length($color) != 6;
◇

: Fragment referenced in 9.
: Uses: $color 9.

⟨nearest multiple of 51 8 ⟩≡

: my $r_safe = int(($r + 25.5) / 51) * 51;
my $g_safe = int(($g + 25.5) / 51) * 51;
my $b_safe = int(($b + 25.5) / 51) * 51;
◇

: Fragment referenced in 9.
: Defines: $b_safe 9, $g_safe 9, $r_safe 9.
: Uses: $b 9, $g 9, $r 9.

⟨nearest rgb 9 ⟩≡

: sub nearest_rgb{
my ($color) = @_;

⟨remove leading hash and check length 7 ⟩

my $r = hex(substr($color, 0, 2));
my $g = hex(substr($color, 2, 2));
my $b = hex(substr($color, 4, 2));

⟨nearest multiple of 51 8 ⟩

return sprintf(q/#%02X%02X%02X/, $r_safe, $g_safe, $b_safe);
}
◇

: Fragment referenced in 6.
: Defines: $b 8, $color 7, $g 8, $r 8.
: Uses: $b_safe 8, $g_safe 8, $r_safe 8.

The main section is just some basic tests.

⟨main 10 ⟩≡

: MAIN:{
say nearest_rgb q/#F4B2D1/;
say nearest_rgb q/#15E6E5/;
say nearest_rgb q/#191A65/;
say nearest_rgb q/#2D5A1B/;
say nearest_rgb q/#00FF66/;
}
◇

: Fragment referenced in 6.

Sample Run

% perl perl/ch-2.pl 
#FF99CC 
#00FFCC 
#003366 
#336633 
#00FF66

References

The Weekly Challenge 383
Generated Code

posted at: 16:39 by: Adam Russell | path: /perl | permanent link to this entry