RabbitFarm
2023-09-07
The Weekly Challenge 233 (Prolog Solutions)
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
You are given an array of words made up of alphabets only. Write a script to find the number of pairs of similar words. Two words are similar if they consist of the same characters.
Solution
similar(A, B, Similar):-
atom_codes(A, ACodes),
sort(ACodes, ASorted),
atom_codes(B, BCodes),
sort(BCodes, BSorted),
(ASorted = BSorted, Similar = 1);
Similar = 0.
count_similar_pairs([], 0).
count_similar_pairs([Word|Words], PairsSimilar):-
count_similar_pairs(Words, P),
maplist(similar(Word), Words, Similar), !,
sum_list(Similar, SimilarCount),
PairsSimilar is P + SimilarCount.
Sample Run
$ gprolog --consult-file prolog/ch-1.p
| ?- count_similar_pairs([aba, aabb, abcd, bac, aabc], PairsSimilar).
PairsSimilar = 2
yes
| ?- count_similar_pairs([aabb, ab, ba], PairsSimilar).
PairsSimilar = 3
(1 ms) yes
| ?- count_similar_pairs([nba, cba, dba], PairsSimilar).
PairsSimilar = 0
yes
| ?-
Notes
Similarity of words is determined by doing a pairwise comparison of the unique character
codes. I've gotten into the habit of counting things by using maplist
with a predicate
that provides a list of 0 and 1 elements. The count is done by summing the list. Here the
counting is done in this way by similar/3
. count_similar_pairs/2
recursively considers
all pairs.
Part 2
You are given an array of integers. Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.
Solution
kvf_insert_sort(List,Sorted):-
i_sort(List,[],Sorted).
i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
kvf_insert(H,Acc,NAcc),
i_sort(T,NAcc,Sorted).
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
V0 > V1,
kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
V0 = V1,
K0 < K1,
kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
V0 = V1,
K0 > K1.
kvf_insert(K0-V0, [], [K0-V0]).
frequency_writer(_-0).
frequency_writer(K-F):-
write(K),
write(', '),
succ(X, F),
frequency_writer(K-X).
write_frequencies([K-F|[]]):-
succ(X, F),
frequency_writer(K-X),
write(K),
nl.
write_frequencies([H|T]):-
frequency_writer(H),
write_frequencies(T).
frequency_counter(Numbers, Number, Number-Count):-
length(Numbers, StartCount),
delete(Numbers, Number, NumberDeleted),
length(NumberDeleted, EndCount),
Count is StartCount - EndCount.
frequency_sorter(Numbers, FrequencySorted):-
sort(Numbers, UniqueNumbers),
maplist(frequency_counter(Numbers), UniqueNumbers, Frequencies),
kvf_insert_sort(Frequencies, FrequencySorted).
Sample Run
$ gprolog --consult-file prolog/ch-2.p
| ?- frequency_sorter([1, 1, 2, 2, 2, 3], Sorted), write_frequencies(Sorted).
3, 1, 1, 2, 2, 2
Sorted = [3-1,1-2,2-3] ?
(1 ms) yes
| ?- frequency_sorter([2, 3, 1, 3, 2], Sorted), write_frequencies(Sorted).
1, 3, 3, 2, 2
Sorted = [1-1,3-2,2-2] ?
(1 ms) yes
| ?- frequency_sorter([-1, 1, -6, 4, 5, -6, 1, 4, 1], Sorted), write_frequencies(Sorted).
5, -1, 4, 4, -6, -6, 1, 1, 1
Sorted = [5-1,-1-1,4-2,-6-2,1-3] ?
(1 ms) yes
| ?-
Notes
First off, we get a count of the frequencies of each number in the list, via a maplist
with frequency_counter/3
. After that is when we hit the real complexity of the problem.
This problem requires a somewhat unique idea of sorting frequencies! The frequencies have
been built as key-value pairs but an ordinary sort or key sort won't work here for these
unique requirements. All the required unique sort logic is contained in the
kvf_insert_sort/2
and related predicates. This is a modification of insertion sort
found in Roman Barták's Guide to Prolog Programming.
With the list of frequencies sorted all that is left is to print the result as specified,
which is the work of write_frequencies/1
. Those somewhat lengthy looking predicates
expand the key-value pairs from the sorted result and print them in the new order.
References
posted at: 17:09 by: Adam Russell | path: /prolog | permanent link to this entry