# 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

#### What's the Similar Frequency, Kenneth?

*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

posted at: 17:08 by: Adam Russell | path: /perl | permanent link to this entry