RabbitFarm
2022-11-06
The Weekly Challenge 189 (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 characters (a..z) and a target character. Write a script to find out the smallest character in the given array lexicographically greater than the target character.
Solution
greater_than_character(Target, C0, C1):-
C0 > Target,
C1 = C0.
greater_than_character(Target, C0, C1):-
\+ C0 > Target,
C1 = nil.
greater_character(Characters, Target, Greater):-
maplist(greater_than_character(Target), Characters, GreaterCharacters),
delete(GreaterCharacters, nil, GreaterCharactersNonNil),
length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
GreaterCharactersNonNilLength > 0,
min_list(GreaterCharactersNonNil, GreaterChar),
char_code(Greater, GreaterChar), !.
greater_character(Characters, [Target], Greater):-
maplist(greater_than_character(Target), Characters, GreaterCharacters),
delete(GreaterCharacters, nil, GreaterCharactersNonNil),
length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
GreaterCharactersNonNilLength == 0,
char_code(Greater, Target), !.
Sample Run
$ gprolog --consult-file prolog/ch-1.p
| ?- greater_character("emug", "b", LeastGreaterCharacter).
LeastGreaterCharacter = e
(1 ms) yes
| ?- greater_character("dcef", "a", LeastGreaterCharacter).
LeastGreaterCharacter = c
yes
| ?- greater_character("jar", "o", LeastGreaterCharacter).
LeastGreaterCharacter = r
(1 ms) yes
| ?- greater_character("dcaf", "a", LeastGreaterCharacter).
LeastGreaterCharacter = c
(1 ms) yes
| ?- greater_character("tgal", "v", LeastGreaterCharacter).
LeastGreaterCharacter = v
yes
Notes
First off, I should note that the use of double quoted strings here might confuse some people. To clarify, in GNU Prolog what look like double quoted strings are handled as lists of character codes. Character codes, not characters! So the use of Character in some variable names may seem a little distracting. They are accurate in intent, but if you are unaware of what's going on it may seem a little strange.
For the solution itself I use a trick with maplist/3
that I have used
previously.
greater_than_character/3
will either return the character greater than the target or
nil
otherwise. min_list/2
is then used to get the smallest character which is
greater than the target, as required. Also, note that in the case no character is found to
be greater than the target we instead supply the target itself.
Part 2
You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.
Solution
array_degree(Array, Degree):-
array_degree(Array, Array, 0, Degree), !.
array_degree([], _, Degree, Degree).
array_degree([H|T], Array, DegreeAccum, Degree):-
length(Array, ArrayLength),
delete(Array, H, ArrayWithout),
length(ArrayWithout,ArrayWithoutLength),
CurrentDegree is ArrayLength - ArrayWithoutLength,
CurrentDegree > DegreeAccum,
array_degree(T, Array, CurrentDegree, Degree).
array_degree([H|T], Array, DegreeAccum, Degree):-
length(Array, ArrayLength),
delete(Array, H, ArrayWithout),
length(ArrayWithout,ArrayWithoutLength),
CurrentDegree is ArrayLength - ArrayWithoutLength,
\+ CurrentDegree > DegreeAccum,
array_degree(T, Array, DegreeAccum, Degree).
least_slice_degree(Array, LeastDegreeSlice):-
array_degree(Array, ArrayDegree),
findall(Sublist, (prefix(Prefix, Array), suffix(Suffix, Array),
sublist(Sublist, Array), length(Sublist, SublistLength),
SublistLength >= 2, flatten([Prefix, Sublist, Suffix], Array)), Sublists),
sort(Sublists, Slices),
findall(DegreeSlice, (member(Slice, Slices), array_degree(Slice, Degree), DegreeSlice = Degree-Slice), DegreeSlices),
findall(MatchingSlice, (member(DegreeSlice, DegreeSlices), ArrayDegree-MatchingSlice = DegreeSlice), MatchingSlices),
findall(LengthSlice, (member(MatchingDegreeSlice, MatchingSlices), length(MatchingDegreeSlice, MatchingDegreeSliceLength), LengthSlice = MatchingDegreeSliceLength-MatchingDegreeSlice), LengthSlices),
keysort(LengthSlices),
[_-LeastDegreeSlice|_] = LengthSlices.
Sample Run
$ gprolog --consult-file prolog/ch-2.p
| ?- least_slice_degree([1, 3, 3, 2], LeastDegreeSlice).
LeastDegreeSlice = [3,3]
(6 ms) yes
| ?- least_slice_degree([1, 2, 1, 3], LeastDegreeSlice).
LeastDegreeSlice = [1,2,1]
(6 ms) yes
| ?- least_slice_degree([1, 3, 2, 1, 2], LeastDegreeSlice).
LeastDegreeSlice = [2,1,2]
(19 ms) yes
| ?- least_slice_degree([1, 1, 2, 3, 2], LeastDegreeSlice).
LeastDegreeSlice = [1,1]
(19 ms) yes
| ?- least_slice_degree([2, 1, 2, 1, 1], LeastDegreeSlice).
LeastDegreeSlice = [1,2,1,1]
(20 ms) yes
Notes
This is the most I've used findall/3
in a long time! The main complexity here, I feel,
is in that we must compute all contiguous slices of the original list. sublist/2
is not
useful by itself here as it returns sublists which are not contiguous, only ordered. With
the help of prefix/2
and suffix/2
we are able to identify contiguous sublists.
findall/3
is used, then, to obtain and then process all of these contiguous slices to
ultimately identify the one that meets all criteria. First we identify all slices, then we
obtain all degree/slice pairs, and then finally we examine the lengths.
References
posted at: 20:57 by: Adam Russell | path: /prolog | permanent link to this entry
To a Greater Degree
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
You are given an array of characters (a..z) and a target character. Write a script to find out the smallest character in the given array lexicographically greater than the target character.
Solution
use v5.36;
use strict;
use warnings;
sub greatest_character{
my($characters, $target) = @_;
return [sort {$a cmp $b} grep {$_ gt $target} @{$characters}]->[0] || $target;
}
MAIN:{
say greatest_character([qw/e m u g/], q/b/);
say greatest_character([qw/d c e f/], q/a/);
say greatest_character([qw/j a r/], q/o/);
say greatest_character([qw/d c a f/], q/a/);
say greatest_character([qw/t g a l/], q/v/);
}
Sample Run
$ perl perl/ch-1.pl
e
c
r
c
v
Notes
Practically a one liner! Here we use grep
to filter out all the characters greater than
the target. The results are then sorted and we return the first one. If all that yields no
result, say there are no characters greater than the target, the just return the target.
Part 2
You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.
Solution
use v5.36;
use strict;
use warnings;
sub array_degree{
my(@integers) = @_;
my @counts;
map { $counts[$_]++ } @integers;
@counts = grep {defined} @counts;
return [sort {$b <=> $a} @counts]->[0];
}
sub least_slice_degree{
my(@integers) = @_;
my @minimum_length_slice;
my $minimum_length = @integers;
my $array_degree = array_degree(@integers);
for my $i (0 .. @integers - 1){
for my $j ($i + 1 .. @integers - 1){
if(array_degree(@integers[$i .. $j]) == $array_degree && @integers[$i .. $j] < $minimum_length){
@minimum_length_slice = @integers[$i .. $j];
$minimum_length = @minimum_length_slice;
}
}
}
return @minimum_length_slice;
}
MAIN:{
say "(" . join(", ", least_slice_degree(1, 3, 3, 2)) . ")";
say "(" . join(", ", least_slice_degree(1, 2, 1)) . ")";
say "(" . join(", ", least_slice_degree(1, 3, 2, 1, 2)) . ")";
say "(" . join(", ", least_slice_degree(1, 1 ,2 ,3, 2)) . ")";
say "(" . join(", ", least_slice_degree(2, 1, 2, 1, 1)) . ")";
}
Sample Run
$ perl perl/ch-2.pl
(3, 3)
(1, 2, 1)
(2, 1, 2)
(1, 1)
(1, 2, 1, 1)
Notes
I view this problem in two main pieces:
Compute the degree of any given array.
Generate all contiguous slices of the given array and looking for a match on the criteria.
So, with that in mind we perform (1) in sub array_degree
and then think of how we might
best compute all those contiguous slices. Here we use a nested for
loop. Since we also
need to check to see if any of the computed slices have an array degree equal to the
starting array we just do that inside the nested loop as well. This way we don't need to
use any extra storage. Instead we just track the minimum length slice with matching array
degree. Once the loops exit we return that minimum length slice.
References
posted at: 18:58 by: Adam Russell | path: /perl | permanent link to this entry