RabbitFarm
2025-05-18
The Weekly Challenge 321 (Prolog Solutions)
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1: Distinct Average
You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.
Our solution will be pretty short, contained in just a single file that has the following structure.
We’ll define a predicate for getting the minimum/maximum pairs. These will be the first/last pairs from a sorted list.
-
first_last([], []).
first_last(Numbers, FirstLastPairs):-
nth(1, Numbers, First),
last(Numbers, Last),
append([First|Rest], [Last], Numbers),
first_last(Rest, FirstLastPairs0),
append([[First, Last]], FirstLastPairs0, FirstLastPairs).
◇
-
Fragment referenced in 1.
We just need a single predicate to sort the given list of numbers, call first_last/2, call maplist/2 with sum_list/2, sort/2 the results, and return the count of unique pairs. Since we only have pairs of numbers their averages will be the same if their sums are the same. (This also allows us to ignore potential floating point number annoyances). Also, remember that sort/2 will remove duplicates.
-
distinct_average(Numbers, DistinctAverage):-
sort(Numbers, NumbersSorted),
first_last(NumbersSorted, MinimumMaximumPairs),
maplist(sum_list, MinimumMaximumPairs, MinimumMaximumSums),
sort(MinimumMaximumSums, MinimumMaximumSumsSorted),
length(MinimumMaximumSumsSorted, DistinctAverage).
◇
-
Fragment referenced in 1.
Sample Run
$ gprolog --consult-file prolog/ch-1.p | ?- distinct_average([1, 2, 4, 3, 5, 6], DistinctAverage). DistinctAverage = 1 ? yes | ?- distinct_average([0, 2, 4, 8, 3, 5], DistinctAverage). DistinctAverage = 2 ? yes | ?- distinct_average([7, 3, 1, 0, 5, 9], DistinctAverage). DistinctAverage = 2 ? yes | ?-
Part 2: Backspace Compare
You are given two strings containing zero or more #. Write a script to return true if the two given strings are same by treating # as backspace.
We’ll use a DCG approach to process the strings and maintain an list of characters.
Let’s have some predicates for maintaining the state of a character list as the DCG processes the string.
-
characters(Characters), [Characters] --> [Characters].
characters(C, Characters), [Characters] --> [C].
◇
-
Fragment referenced in 4.
Now we need to process the strings, which we’ll treat as lists of character codes.
-
process(String) --> characters(C, Characters),
{String = [Code | Codes],
last(C, PreviousCharacter),
((Code \== 35, char_code(C0, Code),
append(C, [C0], Characters));
(append(Characters, [PreviousCharacter], C))), !},
process(Codes).
process([]) --> [].
◇
-
Fragment referenced in 4.
Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3. This will process both strings and then compare the results.
-
backspace_compare(String1, String2):-
phrase(process(String1), [[’’]], [R1]),
delete(R1, ’’, R2),
atom_chars(Result1, R2),
phrase(process(String2), [[’’]], [R3]),
delete(R3, ’’, R4),
atom_chars(Result2, R4),
Result1 == Result2.
◇
-
Fragment referenced in 4.
Sample Run
$ gprolog --consult-file prolog/ch-2.p | ?- backspace_compare("ab#c", "ad#c"). yes | ?- backspace_compare("ab##", "a#b#"). yes | ?- backspace_compare("a#b", "c"). no | ?-
References
posted at: 13:02 by: Adam Russell | path: /prolog | permanent link to this entry
Back to a Unique Evaluation
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1: Distinct Average
You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.
Our solution will be pretty short, contained in just a single file that has the following structure.
The preamble is just whatever we need to include. Here we aren’t using anything special, just specifying the latest Perl version.
the main section is just some basic tests.
-
MAIN:{
say distinct_average 1, 2, 4, 3, 5, 6;
say distinct_average 0, 2, 4, 8, 3, 5;
say distinct_average 7, 3, 1, 0, 5, 9;
}
◇
-
Fragment referenced in 1.
All the work is done in the following subroutine. This problem is straightforward enough to not require much more code than this.
To describe the details of this subroutine sections of it are separated out into their own code sections.
Sample Run
$ perl perl/ch-1.pl 1 2 2
Part 2: Backspace Compare
You are given two strings containing zero or more #. Write a script to return true if the two given strings are same by treating # as backspace.
Our solution will have the following structure.
The main section is just some basic tests.
-
MAIN:{
say backspace_compare q/ab#c/, q/ad#c/;
say backspace_compare q/ab##/, q/a#b#/;
say backspace_compare q/a#b/, q/c/;
}
◇
-
Fragment referenced in 8.
The approach is to maintain two arrays (think of them as stacks), one for each string. As we process each string we will push a character onto the stack as each non-# character is encountered. We’ll pop a character from the stack for every # encountered. When both strings have been processed we’ll compare the two resulting stacks. This code seems to be well contained in a single subroutine.
-
sub backspace_compare{
my($s, $t) = @_;
my @s = split //, $s;
my @t = split //, $t;
my @u = ();
my @v = ();
{
my $s_ = shift @s || undef;
my $t_ = shift @t || undef;
push @u, $s_ if $s_ && $s_ ne q/#/;
push @v, $t_ if $t_ && $t_ ne q/#/;
pop @u if $s_ && $s_ eq q/#/;
pop @v if $t_ && $t_ eq q/#/;
redo if @s || @t;
}
return join(q//, @u) eq join(q//, @v)?q/true/:q/false/;
}
◇
-
Fragment referenced in 8.
Sample Run
$ perl perl/ch-2.pl true true false
References
posted at: 13:01 by: Adam Russell | path: /perl | permanent link to this entry