RabbitFarm

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

Challenge 230

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

Challenge 230