Perl Weekly Challenge 267: Product Sign

These are some answers to the Week 267, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on May 5, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 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 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

Product Sign in Raku

We can simply compute the product of all the integers in the input array. For this, the canonical way in Raku would be to use the [*] reduction operator. Once we have computed the product, we can use the ?? .. !! ternary conditional operator to output 1, 0, or -1, depending on the sign of the product. This is simple enough to be done in a Raku one-liner:

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 4 3 6
1

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 -4 3 6
-1

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 -4 3 6 0 -3
0

This can be made even simpler (or, at least, shorter) using the cmp "smart" three-way comparator. Note that, in Raku, cmp is a "smart" comparison operator, that it is compares strings with string semantics and numbers with number semantics. Also note that cmp returns order objects (Same, More, or Less), but these get coerced into 0, 1, or -1, respectively, in numeric context. We use a + to force a numeric context.

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6
-1

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6 -6
1

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6 0 -6
0

This being said, computing the full product when we only need its sign may be a waste of CPU cycles if the integers of the input list are large. We can read the input integers one by one and keep track of the product sign 0, 1, or -1). Here, we use again the cmp "smart" three-way comparator at each iteration through the input list..

sub product-sign (@in) {
    my $result = 1;
    for @in -> $i {
        $result *= $i cmp 0;
    }
    return $result;
}
my @tests = <-1 -2 -3 -4 3 2 1>, <1 2 0 -2 -1>, <-1 -1 1 -1 2>;
for @tests -> @test {
    printf "%-18s => ", "@test[]";
    say product-sign @test;
}

This program displays the following output:

$ raku ./product-sign.raku
-1 -2 -3 -4 3 2 1  => 1
1 2 0 -2 -1        => 0
-1 -1 1 -1 2       => -1

Product Sign in Perl

This is a port to Perl of the above Raku program. Note that we have to use the <=> numeric comparison operator (instead of cmp) to force a numeric comparison semantics.

use strict;
use warnings;
use feature 'say';

sub product_sign {
    my $result = 1;
    for my $i (@_) {
        $result *= $i <=> 0;
    }
    return $result;
}
my @tests = ( [<-1 -2 -3 -4 3 2 1>], 
              [<1 2 0 -2 -1>], 
              [<-1 -1 1 -1 2>] );
for my $test (@tests) {
    printf "%-18s => ", "@$test";
    say product_sign @$test;
}

This program displays the following output:

$ perl ./product-sign.pl
-1 -2 -3 -4 3 2 1  => 1
1 2 0 -2 -1        => 0
-1 -1 1 -1 2       => -1

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on May 12, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.