RabbitFarm

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

Sort Algorithms in Prolog

Challenge 233

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

use v5.38;
use boolean;

sub is_similar{
    my($s0, $s1) = @_;
    my(%h0, %h1);
    do { $h0{$_} = undef } for split //, $s0; 
    do { $h1{$_} = undef } for split //, $s1; 
    return false if keys %h0 != keys %h1;
    do { return false if !exists $h1{$_} } for keys %h0;
    return true;
}

sub similar_words_pairs_count{
    my @words = @_;
    my @similar;
    do{
        my $word_index = $_;
        my @similar_temp = grep { $words[$word_index] ne $words[$_] && 
                                  is_similar $words[$word_index], $words[$_] } $word_index + 1 .. @words - 1;
        push @similar, @words[@similar_temp] if @similar_temp > 0;
    } for 0 .. @words - 1;
    return @similar + 0;
}

MAIN:{
    say similar_words_pairs_count qw/aba aabb abcd bac aabc/;
    say similar_words_pairs_count qw/aabb ab ba/;
    say similar_words_pairs_count qw/nba cba dba/;
}

Sample Run

$ perl perl/ch-1.pl 
2
3
0

Notes

The core of this problem is to count up the number of pairs of similar words. A clearly good use of grep, but how to do that exactly? Well, here we define a subroutine is_similar that returns a true/false value depending on if the words meet the definition of similar given in the problem. That's done by expanding the words into arrays of characters, stuffing those characters into hash key slots in order to force uniqueness, and then seeing if the two key sets are equal.

Once we have the logic to determine similarity worked out we can then use it in grep and count up the results.

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

use v5.38;
sub frequency_sort{
    my(@numbers) = @_;
    my %frequency;
    do{$frequency{$_}++} for @numbers;
    my $frequency_sorter = sub{
        my $c = $frequency{$a} <=> $frequency{$b};
        return $c unless !$c;
        return $b <=> $a;

    };
    return sort $frequency_sorter @numbers;
}

MAIN:{
    say join q/, /, frequency_sort 1, 1, 2, 2, 2, 3;
    say join q/, /, frequency_sort 2, 3, 1, 3, 2;
    say join q/, /, frequency_sort -1, 1, -6, 4, 5, -6, 1, 4, 1
}

Sample Run

$ perl perl/ch-2.pl 
3, 1, 1, 2, 2, 2
1, 3, 3, 2, 2
5, -1, 4, 4, -6, -6, 1, 1, 1

Notes

This problem ended up being a bit more complex than it seemed after the first reading. Perl makes this sort of complexity easy to manage though! sort can take a custom sorting subroutine as an argument. That is what is done here, with the requirements of the frequency sort for this problem implemented within the subroutine referenced by $frequency_sorter. This is written as an anonymous subroutine in order to obtain a closure around %frequency. Finally, observe that we can use the scalar reference directly with sort. sort is flexible enough to know how to use the reference.

References

Challenge 233

What's the Frequency, Kenneth?