Perl Weekly Challenge: Week 225
Challenge 1:
Max Words
You are given a list of sentences,
@list.A sentence is a list of words that are separated by a single space with no leading or trailing spaces.
Write a script to find out the maximum number of words that appear in a single sentence.
Example 1
Input: @list = ("Perl and Raku belong to the same family.",
"I love Perl.",
"The Perl and Raku Conference.")
Output: 8
Example 2
Input: @list = ("The Weekly Challenge.",
"Python is the most popular guest language.",
"Team PWC has over 300 members.")
Output: 7
This week too, we can solve challenge 1 as a one-liner.
@*ARGS.map({.words.elems}).max.say
We use .map() to transform the command line arguments by splitting each one into words with .words() and counting how many words
were found with .elem(). From that list of counted words, .max() finds the largest one and .say() prints that value out.
Usually Perl is not so succint but while this weeks Perl version is a little longer than Raku, it is still short enough to be expressed as a one-liner.
say [sort {$b<=>$a} map {scalar @{[split q{ }]}} @ARGV]->[0]
We have to use split() instead of .words() and scalar() instead of .elems(). Instead of .max(), the list of
word counts is sorted in descending numerical order, treated as an anonymous list reference (thats what the [] around it are for)
and the first element (which is the largest) is taken and printed out with say().
When doing this challenge I had a problem that perplexed for a long time. When I do a one-liner, I wrap it in a shell script like this:
#!/bin/sh
raku -e '[code goes here]` $@
The $@ is expanded by the shell into the scripts arguments. So you would run it like this (with e.g. example 1):
./raku/ch-1.sh "Perl and Raku belong to the same family." "I love Perl." "The Perl and Raku Conference."
But instead of getting 3 arguments in @*ARGS, I was getting 16. Apparently, the shell was splitting the command-line arguments
into a list of 16 words for me. What I actually wanted was each argument as a list of words. I tried all kinds of things but I could not make this work. Finally after a lot of rummaging through the Internet I discovered that what I actually should have had is "$@" The addition of quotation marks gave me the 3 arguments I expected. AAARGH! These kinds of quirks and gotchas remind
me of years ago and what a breath of fresh air the new upstart Perl was when shell was the only scripting game in town. Todays'
generation of coders consider Perl to be pretty quirky too but it was a huge improvement over what came before. And Raku has filed
off many of Perls rough edges.
Challenge 2:
Left Right Sum Diff
You are given an array of integers,
@ints.Write a script to return left right sum diff array as shown below:
@ints = (a, b, c, d, e)
@left = (0, a, (a+b), (a+b+c))
@right = ((c+d+e), (d+e), e, 0)
@left_right_sum_diff = ( | 0 - (c+d+e) |,
| a - (d+e) |,
| (a+b) - e |,
| (a+b+c) - 0 | )
Example 1
Input: @ints = (10, 4, 8, 3)
Output: (15, 1, 11, 22)
@left = (0, 10, 14, 22)
@right = (15, 11, 3, 0)
@left_right_sum_diff = ( |0-15|, |10-11|, |14-3|, |22-0|)
= (15, 1, 11, 22)
Example 2
Input: @ints = (1)
Output: (0)
@left = (0)
@right = (0)
@left_right_sum_diff = ( |0-0| ) = (0)
Example 3
Input: @ints = (1, 2, 3, 4, 5)
Output: (14, 11, 6, 1, 10)
@left = (0, 1, 3, 6, 10)
@right = (14, 12, 9, 5, 0)
@left_right_sum_diff = ( |0-14|, |1-12|, |3-9|, |6-5|, |10-0|)
= (14, 11, 6, 1, 10)
The description of this challenge didn't make a lot of sense to me at first but after a bit of experimenting I got it.
We start by calculating @left. This list is initialized with 0.
my @left = (0);
Then from the 0th element to the one before last, we advance one element at a time.
We calculate the sum of all the elements from 0 to the current one with .sum() and
add the result to the right side of @lieft with .push().
for 0 ..^ @ints.end -> $i {
@left.push(@ints[0 .. $i].sum);
}
for @right we do a similar thing except we start with the last element and go backwards
to the element before the 0th one. The sum of the elements from the current to the last is
added to the left side of @right with .unshift().
my @right = (0);
for (0 ^.. @ints.end).reverse -> $i {
@right.unshift(@ints[$i .. *-1].sum);
}
Now we have @left and @right, we can find the values of subtracting each element of @right from
the corresponding element in @left via the Z- operator. We run the resulting list through .map() to normalize
each element to its' absolute value with .abs(). The rest of the line is just for printing the results in the same
format as in the examples.
say q{(}, (@left Z- @right).map({ .abs }).join(q{, }), q{)};
For the Perl version, we need some missing code. The function Zminusabs() emulates Z-. It also handles
the .map({ .abs }) part for good measure.
sub Zminusabs {
my @a = @{ $_[0] };
my @b = @{ $_[1] };
my @result;
for my $i (0 .. scalar @b - 1) {
push @result, abs($a[$i] - $b[$i]);
}
return @result;
}
sum() is a replacement for Raku's method of the same name.
sub sum {
my ($arr) = @_;
my $total = 0;
for my $elem (@{$arr}) {
$total += $elem;
}
return $total;
}
my @ints = @ARGV;
Because we need to know the index of the last element of @ints in a couple of places
and the calculation is a bit fiddly, it makes sense to store it in a variable for future use.
my $end = scalar @ints - 1;
Now we can compute @left and @right alsmost as easily as in Raku.
my @left = (0);
for my $i (0 .. $end - 1) {
push @left, sum([@ints[0 .. $i]]);
}
my @right = (0);
for my $i (reverse 1 .. $end) {
unshift @right, sum([@ints[$i .. $end]]);
}
say q{(}, (join q{, }, Zminusabs(\@left, \@right)), q{)};