RabbitFarm
2022-09-04
The Weekly Challenge 180 (Prolog Solutions)
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
You are given a string. Write a script to find out the first unique character in the given string and print its index (0-based).
Solution
index_first_unique(Words, IndexUnique):-
index_first_unique(Words, 0, IndexUnique).
index_first_unique(String, I, IndexUnique):-
succ(I, Index),
length(String, Length),
nth(Index, String, Character),
delete(String, Character, Deleted),
length(Deleted, LengthDeleted),
LengthDifference is Length - LengthDeleted,
LengthDifference == 1, !,
IndexUnique = I.
index_first_unique(String, I, IndexUnique):-
succ(I, Index),
length(String, Length),
nth(Index, String, Character),
delete(String, Character, Deleted),
length(Deleted, LengthDeleted),
LengthDifference is Length - LengthDeleted,
\+ LengthDifference == 1,
succ(I, X),
index_first_unique(String, X, IndexUnique).
Sample Run
$ gprolog --consult-file prolog/ch-1.p
| ?- index_first_unique("Long Live Perl", IndexUnique).
IndexUnique = 1
yes
| ?- index_first_unique("Perl Weekly Challenge", IndexUnique).
IndexUnique = 0
yes
| ?- index_first_unique("aabbcc", IndexUnique).
no
| ?- index_first_unique("Prolog Solution to Perl Weekly Challenge", IndexUnique).
IndexUnique = 7
yes
Notes
The main steps here are to check to see if after a character is deleted from the list if the new list length only varies from the original by 1. If so, then we are done. In the case the list is exhausted without finding a unique character the predicate simply fails.
Also note that GNU Prolog's nth/3
assumes 1 indexing and so to get the correct 0 based
answer we do an extra succ/2
.
Part 2
You are given list of numbers and an integer. Write a script to trim the given list when an element is less than or equal to the given integer.
Solution
trimmer(X, Y, Z):-
X < Y,
Z = Y.
trimmer(X, Y, Z):-
X >= Y,
Z = 'trimmed'.
trim_list(Numbers, I, TrimmedList):-
maplist(trimmer(I), Numbers, PartialTrimmedList),
delete(PartialTrimmedList, 'trimmed', TrimmedList).
Sample Run
$ gprolog --consult-file prolog/ch-2.p
| ?- trim_list([1, 4, 2, 3, 5], 3, TrimmedList).
TrimmedList = [4,5] ?
yes
| ?- trim_list([9, 0, 6, 2, 3, 8, 5], 4, TrimmedList).
TrimmedList = [9,6,8,5] ?
yes
Notes
maplist/3
is always tempting to use when required to process a list. In order to get the
effect that we want, however, requires that the predicate used in the maplist succeed for
each value of the list to be processed. Here trimmer/3
will either succeed with the
numerical value that passes that comparison or succeed and provide the atom trimmed
for
values in the list that fail the comparison. The resulting list is then used with
delete/3
to get the final list containing only the numerical values required.
References
posted at: 16:18 by: Adam Russell | path: /prolog | permanent link to this entry
First Uniquely Trimmed Index
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
You are given a string, $s. Write a script to find out the first unique character in the given string and print its index (0-based).
Solution
use v5.36;
use strict;
use warnings;
sub index_first_unique{
my($s) = @_;
my @s = split(//, $s);
map {my $i = $_; my $c = $s[$i]; return $_ if 1 == grep {$c eq $_ } @s } 0 .. @s - 1;
}
MAIN:{
say index_first_unique(q/Perl Weekly Challenge/);
say index_first_unique(q/Long Live Perl/);
}
Sample Run
$ perl perl/ch-1.pl
0
1
Notes
I use the small trick of return-ing early out of a map
. Since we only want the first
unique index there is no need to consider other characters in the string and we can do
this short circuiting to bail early.
Part 2
You are given list of numbers, @n and an integer $i. Write a script to trim the given list when an element is less than or equal to the given integer.
Solution
use v5.36;
use strict;
use warnings;
sub trimmer{
my($i) = @_;
return sub{
my($x) = @_;
return $x if $x > $i;
}
}
sub trim_list_r{
my($n, $trimmer, $trimmed) = @_;
$trimmed = [] unless $trimmed;
return @$trimmed if @$n == 0;
my $x = pop @$n;
$x = $trimmer->($x);
unshift @$trimmed, $x if $x;
trim_list_r($n, $trimmer, $trimmed);
}
sub trim_list{
my($n, $i) = @_;
my $trimmer = trimmer($i);
return trim_list_r($n, $trimmer);
}
MAIN:{
my(@n, $i);
$i = 3;
@n = (1, 4, 2, 3, 5);
say join(", ", trim_list(\@n, $i));
$i = 4;
@n = (9, 0, 6, 2, 3, 8, 5);
say join(", ", trim_list(\@n, $i));
}
Sample Run
$ perl perl/ch-2.pl
4, 5
9, 6, 8, 5
Notes
After using map
and grep
in the first part this week's challenge I decided to try out
something else for this problem. grep
would certainly be a perfect fit for this!
Instead, though, I do the following:
- Create an anonymous subroutine closure around
$i
to perform the comparison. The subroutine is referenced in the variable$trimmer
. - This subroutine reference is then passed to a recursive function along with the list.
- The recursive function accumulates numbers meeting the criteria in an array reference
$trimmed
.unshift
is used to maintain the original ordering. I could have also, for example, processed the list of numbers in reverse and usingpush
. I haven't usedunshift
in a long time so this seemed more fun. $trimmed
is returned to when the list of numbers to be reviewed is exhausted.
This works quite well, especially for something so intentionally over engineered. If you
end up trying this yourself be careful with the size of the list used with the recursion.
For processing long lists in this way you'll either need to set no warnings 'recusion
or, preferably, goto __SUB__
in order to take advantage of Perl style tail recursion.
References
posted at: 11:57 by: Adam Russell | path: /perl | permanent link to this entry