Perl Weekly Challenge: Week 267
Challenge 1:
Product Sign
You are given an array of
@ints.Write a script to find the sign of product of all integers in the given array. The sign is
1if the product is positive,-1if the product is negative and0if product is zero.
Example 1
Input: @ints = (-1, -2, -3, -4, 3, 2, 1)
Output: 1
The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0
Example 2
Input: @ints = (1, 2, 0, -2, -1)
Output: 0
The product 1 x 2 x 0 x -2 x -1 => 0
Example 3
Input: @ints = (-1, -1, 1, -1, 2)
Output: -1
The product -1 x -1 x 1 x -1 x 2 => -2 < 0
After a short holiday, Raku one-liners are back and this might be the shortest one yet.
([*] @*ARGS).sign.say;
First we multiply all the command line arguments together with the [*] operator. Then we apply .sign() to the resulting product. This method does exactly what the spec is asking for; it returns 1 if the product is positive, -1 if the product is negative, and 0 if the product is 0. This value is then printed out with .say().
Perl doesn't have an [*] operator so I made a product() function that takes an array, multiplys all the elements together and returns the product.
sub product(@terms) {
my $result = 1;
for my $term (@terms) {
$result *= $term;
}
return $result;
}
I could have sworn that Perl has an sgn() function in its' standard library that does the same as Raku's .sign() but evidently not. It is easy to recreate though:
sub sign($number) {
return ($number > 0) ? 1 : ($number < 0) ? -1 : 0;
}
With these, the Perl solution is almost as short as the Raku one.
say sign(product(@ARGV));
Challenge 2:
Line Counts
You are given a string,
$str, and a26-itemsarray@widthscontaining the width of each character from a to z.Write a script to find out the number of lines and the width of the last line needed to display the given string, assuming you can only fit 100
widthunits on a line.
Example 1
Input: $str = "abcdefghijklmnopqrstuvwxyz"
@widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (3, 60)
Line 1: abcdefghij (100 pixels)
Line 2: klmnopqrst (100 pixels)
Line 3: uvwxyz (60 pixels)
Example 2
Input: $str = "bbbcccdddaaa"
@widths = (4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (2, 4)
Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)
The first step is to separate $str into individual letters with .comb().
my @letters = $str.comb;
Then we map each unique letter, sorted into alphabetical order, to its corresponding width in @widths to make a hash called %widthmap. For instance 'j' is the tenth letter of the alphabet so it has to map to the tenth element in @widths (i.e. @widths[9]). An easy way to find the right position is with the .ord() method which gives the numeric value of a character. Subtracting that from the numeric value of 'a' gives a number from 0 to 25 which is the range of indices in @widths.
my %widthmap = @letters.sort.unique.map({ $_ => @widths[$_.ord - 'a'.ord] });
We need a variable to hold the amount of freespace left in the line we're working on. Initially that's going to be 100 according to the spec.
my $freespace = 100;
And a variable to hold the line we are currently on. Being a CS guy, I instinctively set this to 0 but, no, the first line is 1.
my $lines = 1;
Now we go through each letter in our separated $str.
for @letters -> $letter {
If there isn't enough free space to fit the width of this letter...
if $freespace < %widthmap{$letter} {
...we move to the next line and reset $freespace to 100.
$lines++;
$freespace = 100;
}
Otherwise, we substract the width of this letter from $freespace and move on to the next one.
$freespace -= %widthmap{$letter};
}
Finally, we print the number of lines used and whatever is left on the last line (i.e. 100 - the last value of $freespace.)
say "($lines, {100 - $freespace})";
Perl has almost everything we need to replicate our Raku version except unique(). This is my replacement. It just
adds the elements of a list to hash. Duplicate elements will still be assigned to the same key so if we return the keys of the hash, we are in effect getting the unique values of the list.
sub unique(@list) {
my %elems;
for (@list) {
$elems{$_}++;
}
return keys %elems;
}
The main part of the Perl solution as I said is a copy of the Raku version.
my @letters = split //, $str;
my %widthmap = map { $_ => @widths[ord($_) - ord('a')] } sort unique(@letters);
my $freespace = 100;
my $lines = 1;
for my $letter (@letters) {
if ($freespace < $widthmap{$letter}) {
$lines++;
$freespace = 100;
}
$freespace -= $widthmap{$letter};
}
say "($lines, ", 100 - $freespace, ')';