RabbitFarm
2023-08-20
The Weekly Challenge 230 (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 positive integers. Write a script to separate the given array into single digits.
Solution
clone(X, [X]).
separate(Number, Digits):-
number_chars(Number, Chars),
maplist(clone, Chars, DigitChars),
maplist(number_chars, Digits, DigitChars).
separate_digits(Numbers, Digits):-
maplist(separate, Numbers, D),
flatten(D, Digits).
Sample Run
$ gprolog --consult-file prolog/ch-1.p
| ?- separate_digits([1, 34, 5, 6], Digits).
Digits = [1,3,4,5,6] ?
yes
Notes
For a long time I really never embraced the full power of maplist
. At present I can't
seem to get enough! In this solution to TWC230.1 we use maplist to first create a
singleton list for each digit character in each of the given numbers, we then use maplist
to convert these singleton lists to single digit numbers as required.
Part 2
You are given an array of words made up of alphabetic characters and a prefix. Write a script to return the count of words that starts with the given prefix.
Solution
prefix_match(Prefix, Word, Match):-
atom_chars(Prefix, PrefixChars),
atom_chars(Word, WordChars),
((prefix(PrefixChars, WordChars), Match = 1);
(\+ prefix(PrefixChars, WordChars), Match = 0)).
count_words(Prefix, Words, Count):-
maplist(prefix_match(Prefix), Words, Matches),
sum_list(Matches, Count).
Sample Run
$ gprolog --consult-file prolog/ch-2.p
| ?- count_words(at, [pay, attention, practice, attend], Count).
Count = 2 ?
yes
| ?- count_words(ja, [janet, julia, java, javascript], Count).
Count = 3 ?
(1 ms) yes
| ?-
Notes
Another nice use of maplist, but a bit less gratuitous. In this solution to TWC230.2 we
use maplist to generate a list of 0s or 1s, depending on whether a given word starts with
the given prefix. The count of matching words is then the sum_list/2
of those results.
References
posted at: 21:40 by: Adam Russell | path: /prolog | permanent link to this entry
Separate and Count
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
You are given an array of positive integers. Write a script to separate the given array into single digits.
Solution
use v5.38;
sub separate_digits{
return separater([], @_);
}
sub separater{
my $seperated = shift;
return @{$seperated} if @_ == 0;
my @digits = @_;
push @{$seperated}, split //, shift @digits;
separater($seperated, @digits);
}
MAIN:{
say join q/,/, separate_digits 1, 34, 5, 6;
}
Sample Run
$ perl perl/ch-1.pl
1,3,4,5,6
Notes
It has been a while since I wrote recursive Perl code, this week's TWC offered two nice
chances to do so. The first call to separate_digits
invokes the call to the recursive
subroutine separater
, adding an array reference for the convenience of accumulating the
individual digits at each recursive step.
Within separater
each number in the array is taken one at a time and expanded to its
individual digits. The digits are pushed into the accumulator. When we run of digits we
return the complete list of digits.
Part 2
You are given an array of words made up of alphabetic characters and a prefix. Write a script to return the count of words that starts with the given prefix.
Solution
use v5.38;
sub count_words{
return counter(0, @_);
}
sub counter{
my $count = shift;
my $prefix = shift;
return $count if @_ == 0;
my $word = shift;
$count++ if $word =~ m/^$prefix/;
counter($count, $prefix, @_);
}
MAIN:{
say count_words qw/at pay attention practice attend/;
say count_words qw/ja janet julia java javascript/;
}
Sample Run
$ perl perl/ch-2.pl
2
3
Notes
The exact same approach used for Part 1 is used here in the second part. Instead of accumulating am array of digits instead we increment the counter of words which start with the prefix characters.
References
posted at: 21:40 by: Adam Russell | path: /perl | permanent link to this entry