RabbitFarm

2024-11-30

The Weekly Challenge 296 (Prolog Solutions)

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

Part 1: String Compression

You are given a string of alphabetic characters, $chars. Write a script to compress the string with run-length encoding.

A compressed unit can be either a single character or a count followed by a character.

BONUS: Write a decompression function.

There are probably a few good approaches to this problem. Here we’ll use a DCG approach. Ultimately this problem is at its core is to process a list of characters, something a DCG is best suited to handle.

For convenience, let’s define a clause for checking that we have a valid ascii character code. Maybe this is more my opinion than anything else, but working with character codes versus, say, characters seems to simplify matters for this particular problem.

⟨ascii character code check 1 ⟩≡

: code(Code) --> [Code], {integer(Code), Code >= 97, Code =< 122}.
◇

: Fragment referenced in 4.

⟨ascii digit code check 2 ⟩≡

: digit(Code) --> [Code], {integer(Code), Code >= 48, Code =< 57}.
◇

: Fragment never referenced.

We will be passing the state of the partial encoding through the encoding predicates.

⟨encoding state 3 ⟩≡

: encoding(Encoding), [Encoding] --> [Encoding].
encoding(E, Encoding), [Encoding] --> [E].
◇

: Fragment referenced in 11.

⟨encoding process 4 ⟩≡

: encode(Codes) -->
encoding(E, Encoding),
{Codes = [Code | T], Code >= 97, Code =< 122},
{last(E, Count), append(L, [Count], E),
((Count == nil, X = 0, C = Code); Count = C-X),
((Code == C, succ(X, X0), C0 = C,
append(L, [C0 - X0], Encoding));
(Code =\= C, X0 = 1, C0 = Code,
append(E, [C0 - X0], Encoding)))},
encode(T).
encode([]) --> [].
⟨ascii character code check 1 ⟩
◇

: Fragment referenced in 11.

Let’s give this DCG a simple interface. We’ll write some utility predicates.

⟨build the final encoded result 5 ⟩≡

: build_encoded([], ’’).
build_encoded([H|T], Encoded):-
H = C - X,
number_atom(X, N),
atom_codes(A, [C]),
build_encoded(T, E),
((X > 1, atom_concat(N, A, NA), atom_concat(NA, E, Encoded));
(X == 1, atom_concat(A, E, Encoded))).
◇

: Fragment referenced in 11.

⟨encoder 6 ⟩≡

: encoder(String, EncodedString):-
phrase(encode(String), [[nil]], [Encoding]),
build_encoded(Encoding, EncodedString).
◇

: Fragment referenced in 11.

Ok, so that’s the main part, but what about decoding for the bonus? We can also do that with a DCG. This proceeds about the same as the encoding process. We have a main DCG and then some utility predicates.

⟨decoding state 7 ⟩≡

: decoding(Decoding), [Decoding] --> [Decoding].
decoding(D, Decoding), [Decoding] --> [D].
◇

: Fragment referenced in 11.

⟨decoding process 8 ⟩≡

: decode(Codes) --> decoding(D, Decoding),
{phrase(letter(L), Codes, R),
append(D, [L], Decoding)},
decode(R).
decode(Codes) --> decoding(D, Decoding),
{phrase(number_letter(NL), Codes, R),
append(D, [NL], Decoding)},
decode(R).
decode([]) --> [].

number_letter(NL) --> number(N), letter(L), {append([N], L, NL)}.

number(N) --> digit(D), number(N0), {append([D], N0, N)}.
number([]) --> [].

letter(L) --> [C], {C >= 97, C =< 122, L = C}.

digit(D) --> [C], {C >= 48, C =< 57, D = C}.
◇

: Fragment referenced in 11.

⟨build the final decoded result 9 ⟩≡

: build_decoded([], ’’).
build_decoded([H|T], Decoded):-
H = [X|C],
number_codes(N, X),
length(L, N), maplist(=(C), L),
build_decoded(T, D),
atom_codes(A, L),
atom_concat(A, D, Decoded).
build_decoded([H|T], Decoded):-
number(H),
build_decoded(T, D),
atom_codes(A, [H]),
atom_concat(A, D, Decoded).
◇

: Fragment referenced in 11.

⟨decoder 10 ⟩≡

: decoder(String, DecodedString):-
phrase(decode(String), [[]], [Decoding]),
build_decoded(Decoding, DecodedString), !.
◇

: Fragment referenced in 11.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 11≡

: ⟨encoding state 3 ⟩
⟨encoding process 4 ⟩
⟨build the final encoded result 5 ⟩
⟨encoder 6 ⟩
⟨decoding state 7 ⟩
⟨decoding process 8 ⟩
⟨build the final decoded result 9 ⟩
⟨decoder 10 ⟩
◇

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- encoder("abbc", Encoded). 
 
Encoded = a2bc ? 
 
yes 
| ?- encoder("aaabccc", Encoded). 
 
Encoded = ’3ab3c’ ? 
 
yes 
| ?- encoder("abcc", Encoded). 
 
Encoded = ab2c ? 
 
yes 
| ?- encoder("abbc", Encoded), atom_codes(Encoded, C), decoder(C, DecodedString). 
 
C = [97,50,98,99] 
DecodedString = abbc 
Encoded = a2bc ? 
 
yes 
| ?- encoder("abbbbbbccccccccccc", Encoded), atom_codes(Encoded, C), decoder(C, DecodedString). 
 
C = [97,54,98,49,49,99] 
DecodedString = abbbbbbccccccccccc 
Encoded = a6b11c ? 
 
yes 
| ?-

Part 2: Matchstick Square

You are given an array of integers, @ints. Write a script to find if it is possible to make one square using the sticks as in the given array @ints where $ints[$i] is the length of ith stick.

In order to make a square we need four sides that are of the same length. Let’s view this problem as how we can divide the list into four sublists which all sum to the same thing.

Seeing as it is just four sides the code can be a bit rote without looking too horrible.

⟨matchstick square 12 ⟩≡

: ⟨convenience predicate for list removals 13 ⟩ matchstick_square(L):- sublist(S0, L), S0 \== [], remove_one(S0, L, L0), L0 \== [], sublist(S1, L0), S1 \== [], remove_one(S1, L0, L1), L1 \== [], sublist(S2, L1), S2 \== [], remove_one(S2, L1, L2), L2 \== [], sublist(S3, L2), S3 \== [], remove_one(S3, L2, L3), L3 == [], sum_list(S0, Sum0), sum_list(S1, Sum1), sum_list(S2, Sum2), sum_list(S3, Sum3), Sum0 == Sum1, Sum1 == Sum2, Sum2 == Sum3, !.
◇

: Fragment referenced in 14.

⟨convenience predicate for list removals 13 ⟩≡

: remove_one([], S, S).
remove_one([H|T], L, S):-
member(H, L),
select(H, L, L0),
remove_one(T, L0, S).
◇

: Fragment referenced in 12.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 14≡

: ⟨matchstick square 12 ⟩
◇

Sample Run

$ gprolog prolog/ch-2.p 
| ?- matchstick_square([1, 2, 2, 2, 1]). 
 
(8 ms) yes 
| ?- matchstick_square([2, 2, 2, 4]). 
 
(2 ms) no 
| ?- matchstick_square([2, 2, 2, 2, 4]). 
 
(187 ms) no 
| ?- matchstick_square([3, 4, 1, 4, 3, 1]). 
 
(1 ms) yes 
| ?-

References

The Weekly Challenge 296
Generated Code

posted at: 15:13 by: Adam Russell | path: /prolog | permanent link to this entry