Perl Weekly Challenge 267.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 267.
Task 1: Product Sign
Submitted by: Mohammad Sajid Anwar
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 1 if the product is positive, -1 if the product is negative and 0
if 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
A simple solution is to apply a three way comparison <=> of the
product (from List::Utils) with 0. This yields a half-liner:
Example 1:
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- -1 -2 -3 -4 3 2 1
Results:
-1 -2 -3 -4 3 2 1 -> 1
Example 2:
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- 1 2 0 -2 -1
Results:
1 2 0 -2 -1 -> 0
Example 3:
perl -MList::Util=product -E 'say "@ARGV -> ", product(@ARGV) <=> 0' -- -1 -1 1 -1 2
Results:
-1 -1 1 -1 2 -> -1
A similar program may be built with PDL:
Examples:
perl -MPDL -E 'for(@ARGV){$x=pdl($_); say "$x -> ", $x->prodover<=>0}
' -- "-1 -2 -3 -4 3 2 1" "1 2 0 -2 -1" "-1 -1 1 -1 2"
Results:
[-1 -2 -3 -4 3 2 1] -> 1
[1 2 0 -2 -1] -> 0
[-1 -1 1 -1 2] -> -1
The full code is almost identical.
1 # Perl weekly challenge 267
2 # Task 1: Product Sign
3 #
4 # See https://wlmb.github.io/2024/04/29/PWC267/#task-1-product-sign
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 "x0 ẍ1..." ¨"y0 y1..." ...
9 to find the sign of the products x0 x1..., y0 y1..., etc.
10 FIN
11 for(@ARGV){
12 my $x=pdl($_);
13 say "$x -> ", $x->prodover<=>0;
14 }
Examples:
./ch-1.pl "-1 -2 -3 -4 3 2 1" "1 2 0 -2 -1" "-1 -1 1 -1 2"
Results:
[-1 -2 -3 -4 3 2 1] -> 1
[1 2 0 -2 -1] -> 0
[-1 -1 1 -1 2] -> -1
Using the flexibility of PDL, I can use the code above to get the sign of the products of all the rows of a matrix, or of an n dimensional array.
Example:
./ch-1.pl "[[1 2 3][-1 0 1][-3 -2 -1]]"
Results:
[
[ 1 2 3]
[-1 0 1]
[-3 -2 -1]
]
-> [1 0 -1]
Task 2: Line Counts
Submitted by: Mohammad Sajid Anwar
You are given a string, $str, and a 26-items array @widths containing
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 width units 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)
I guess the simplest solution is to add characters one by one
incrementing a horizontal counter, until it overflows, in which case,
it is reset and a vertical counter is incremented. At the end, both
counters are reported. Characters may be mapped to array indices by
subtracting ord("a"). There are some edge cases to check: If the
last line is exactly 100 pixels long, should a new empty line be
started or should we wait for an actual overflow to start the next
line. I guess the former criteria is to be expected, though it is
slightly more complex. The result fits a two-liner.
Example 1:
perl -E '$l=1;$p=100;$a=shift;@w=@ARGV;@s=map {$w[ord($_)-ord("a")]} split "", $a;
for(@s){$c+=$_;$c=$_,$l++ if $c>$p;$c=0,$l++ if $c==$p}say "$a\n@w\n-> ($l, $c)";
' "abcdefghijklmnopqrstuvwxyz" \
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
Results:
abcdefghijklmnopqrstuvwxyz
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
-> (3, 60)
Example 2:
perl -E '$l=1;$p=100;$a=shift;@w=@ARGV;@s=map {$w[ord($_)-ord("a")]} split "", $a;
for(@s){$c+=$_;$c=$_,$l++ if $c>$p;$c=0,$l++ if $c==$p}say "$a\n@w\n-> ($l, $c)";
' "bbbcccdddaaa"\
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
Results:
bbbcccdddaaa
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
-> (2, 4)
The full code follows:
1 # Perl weekly challenge 267
2 # Task 2: Line Counts
3 #
4 # See https://wlmb.github.io/2024/04/29/PWC267/#task-2-line-counts
5 use v5.36;
6 die <<~"FIN" unless @ARGV==27;
7 Usage: $0 S W1 W2...W26
8 to find how many lines and additional characters are needed to print
9 the string S given the widths W1, W2..W26 of the letters a, b...z.
10 FIN
11
12 my $line_width=100;
13 my $string=shift;
14 my @widths_ord=@ARGV;
15 my @widths_string=map {$widths_ord[ord($_)-ord("a")]} split "", $string;
16 my $current_line=1; # Note that I report one line, 0 chars for an empty string!
17 my $current_column = 0; # current column
18 for(@widths_string){
19 $current_column += $_;
20 $current_column = $_, ++$current_line if $current_column > $line_width;
21 $current_column = 0, ++$current_line if $current_column == $line_width;
22
23 }
24 say "string=$string\nwidths=\n\t@widths_ord[0..9]\n\t@widths_ord[10..19]",
25 "\n\t@widths_ord[20..25]\n -> ($current_line, $current_column)";
Examples:
./ch-2.pl "abcdefghijklmnopqrstuvwxyz" \
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
./ch-2.pl "bbbcccdddaaa"\
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
Results:
string=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
-> (3, 60)
string=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
-> (2, 4)