RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given a list of sentences. Write a script to find out the maximum number of words that appear in a single sentence.

Solution

use v5.38;
sub max_sentence_length{
    my(@sentences) = @_;
    my $max_words = -1;
    do{
        my @word_matches = $_ =~ m/(\w+)/g; 
        $max_words = @word_matches if @word_matches > $max_words;
    } for @sentences;
    return $max_words;
}

MAIN:{
    my @list;
    @list = ("Perl and Raku belong to the same family.", "I love Perl.", 
"The Perl and Raku Conference.");
    say  max_sentence_length(@list);
    @list = ("The Weekly Challenge.", "Python is the most popular guest language.",
"Team PWC has over 300 members.");
    say  max_sentence_length(@list);
}

Sample Run

$ perl perl/ch-1.pl 
8
7

Notes

This is the perfect job for a regular expression! In fact \w is a special character sequence which matches word characters, so they heart of the solution is to apply it to the given sentences and count the matches.

The expression my @word_matches = $_ =~ m/(\w+)/g may look a little weird at first. What is happening here is that we are collecting all groups of matchs (enclosed in parentheses in the regex) into a single array. In this way, we immediately know the number of words in each sentence, it is just the size of the array.

Part 2

You are given an array of integers. Write a script to return left right sum difference array.

Solution

use v5.38;
sub left_right_sum{
    return unpack("%32I*", pack("I*", @_));
}

sub left_right_differences{
    my(@left_sum, @right_sum);
    for(my $i = 0; $i < @_; $i++){
        push @left_sum, left_right_sum(@_[0 .. $i - 1]);
        push @right_sum, left_right_sum(@_[$i + 1 .. @_ - 1]);
    }    
    return map { abs($left_sum[$_] - $right_sum[$_]) } 0 .. @_ - 1;
}

MAIN:{
    say join(q/, /, left_right_differences 10, 4, 8, 3);
    say join(q/, /, left_right_differences 1);
    say join(q/, /, left_right_differences 1, 2, 3, 4, 5);
}

Sample Run

$ perl perl/ch-2.pl 
15, 1, 11, 22
0
14, 11, 6, 1, 10

Notes

The problem statement may be a little confusing at first. What we are trying to do here is to get two lists the prefix sums and suffix sums, also called the left and right sums. We then pairwise take the absolute values of each element in these lists to get the final result. Iterating over the list the prefix sums are the partial sums of the list elements to the left of the current element. The suffix sums are the partial sums of the list elements to the right of the current element.

With that understanding in hand the solution becomes much more clear! We iterate over the list and then using slices get the prefix and suffix arrays for each element. Using my favorite way to sum a list of numbers, left_right_sum() does the job with pack/unpack. Finally, a map computes the set of differences.

References

Challenge 225

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given a list of sentences. Write a script to find out the maximum number of words that appear in a single sentence.

Solution

check_and_read(32, [], _):-
    !.
check_and_read(46, [], _):-
    !. 
check_and_read(-1, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

sentence_atoms(Sentence, Atoms):-
    open_input_codes_stream(Sentence, Stream),
    read_data(Stream, Atoms).

max_sentence_length(Sentences, MaxLength):-
    maplist(sentence_atoms, Sentences, SentenceAtoms),
    maplist(length, SentenceAtoms, Lengths),
    max_list(Lengths, MaxLength).

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- max_sentence_length(["Perl and Raku belong to the same family.", "I love Perl.", "The Perl and Raku Conference."], MaxLength).            

MaxLength = 8 ? 

yes
| ?- max_sentence_length(["The Weekly Challenge.", "Python is the most popular guest language.", "Team PWC has over 300 members."], MaxLength).

MaxLength = 7 ? 

yes
| ?- 

Notes

Since these are programming challenges which are designed with Perl in mind the inputs sometimes require a little manipulation to make them more Prolog friendly. In this case the sentence strings need to be turned into lists of atoms. This is done here by use of Stream processing!

I don't think I've had much occasion to use open_input_codes_stream/2 before. What this does is take the double quoted string, which is seen by Prolog as a list of character codes, and open this as a Stream. We can then process this in the same way as we'd process any other input stream, more typically a file. In fact, much of the code for processing this Stream is re-used from other such code.

The solution, then, is that max_sentence_length/2 will take a list of sentences, call senetence_atoms/2 via a maplist/3 to get a list of list of atoms, then again with a maplist/3 get the lengths of the atom lists, and then finally get the maximum sentence length (the result) from max_list/2.

Part 2

You are given an array of integers. Write a script to return left right sum difference array.

Solution

difference(X, Y, Z):-
    Z is abs(X - Y).

differences(_, 0, LeftAccum, RightAccum, LeftRightDifferences):-
    maplist(difference, LeftAccum, RightAccum, LeftRightDifferences).
differences(Numbers, Index, LeftAccum, RightAccum, LeftRightDifferences):-
    length(Numbers, L),
    Left is Index - 1,
    Right is L - Index,
    length(Prefix, Left),
    length(Suffix, Right),
    prefix(Prefix, Numbers),
    suffix(Suffix, Numbers),
    sum_list(Prefix, LeftSum),
    sum_list(Suffix, RightSum),
    succ(IndexNext, Index),
    differences(Numbers, IndexNext, [LeftSum|LeftAccum], [RightSum|RightAccum], LeftRightDifferences).

left_right_differences(Numbers, LeftRightDifferences):-
    length(Numbers, L),
    differences(Numbers, L, [], [], LeftRightDifferences).

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- left_right_differences([10, 4, 8, 3], LeftRightDifferences).

LeftRightDifferences = [15,1,11,22] ? 

yes
| ?- left_right_differences([1], LeftRightDifferences). 

LeftRightDifferences = [0] ? 

yes
| ?- left_right_differences([1, 2, 3, 4, 5], LeftRightDifferences).

LeftRightDifferences = [14,11,6,1,10] ? 

(1 ms) yes
| ?- 

Notes

The problem statement may be a little confusing at first. What we are trying to do here is to get two lists the prefix sums and suffix sums, also called the left and right sums. We then pairwise take the absolute values of each element in these lists to get the final result. Recursively iterating over the list the prefix sums are the partial sums of the list elements to the left of the current element. The suffix sums are the partial sums of the list elements to the right of the current element.

Once the problem is understood the components of the solution start to come together:

1. Iterate over the original list and build up the partial sums. prefix/2, suffix/2, and sum_list/2 are very helpful here!
2. When we are done building the lists of partial sums take the pairwise differences. This could also be done iteratively, but more elegantly we can make use of maplist/4.
3. Our use of maplist/4 uses the small utility predicate difference/3.

References

Challenge 225