laurent_r

These are some answers to the Week 271, 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 June 2, 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: Maximum Ones

You are given a m x n binary matrix.

Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.

Example 1

Input: $matrix = [ [0, 1],
                   [1, 0],
                 ]
Output: 1

Row 1 and Row 2 have the same number of ones, so return row 1.

Example 2

Input: $matrix = [ [0, 0, 0],
                   [1, 0, 1],
                 ]
Output: 2

Row 2 has the maximum ones, so return row 2.

Example 3

Input: $matrix = [ [0, 0],
                   [1, 1],
                   [0, 0],
                 ]
Output: 2

Row 2 have the maximum ones, so return row 2.

Note that, in Perl, Raku, and most programming languages, array subscripts start at 0, so that the first row of a matrix would have index 0. Here, the task specification uses common sense row ranks rather than traditional array subscripts. So we will have to add one to the index found to return a common sense row rank.

Maximum Ones in Raku

Since input is a binary matrix, i.e. populated only with 0 and 1, to find the number of ones in a row, we can simply add the items of the row, which we can do with the sum method. We just need to iterate over the matrix rows and keep track of the index of the row with the largest sum.

sub maximum-ones (@mat) {
    my $max = 0; 
    my $max-i;
    for 0..@mat.end -> $i {
        my $sum = @mat[$i].sum;
        if $sum > $max {
            $max = $sum;
            $max-i = $i;
        }
    }
    return $max-i + 1;
}

my @tests = [ [0, 1], [1, 0] ],
            [ [0, 0, 0], [1, 0, 1] ],
            [ [0, 0], [1, 1], [0, 0] ];
for @tests -> @test {
    printf "%-20s => ", @test.gist;
    say maximum-ones @test;
}

This program displays the following output:

$ raku ./maximum-ones.raku
[[0 1] [1 0]]        => 1
[[0 0 0] [1 0 1]]    => 2
[[0 0] [1 1] [0 0]]  => 2

Maximum Ones in Perl

This is a port to Perl of the above Raku program. We iterate over the matrix rows, compute the sum of the row items, and keep track of the index of the row with the largest sum.

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

sub maximum_ones {
    my @mat = @_;
    my $max = 0; 
    my $max_i;
    for my $i (0..$#mat) {
        my $sum = 0;
        $sum += $_ for @{$mat[$i]};
        if ($sum > $max) {
            $max = $sum;
            $max_i = $i;
        }
    }
    return $max_i + 1;
}

my @tests = ( [ [0, 1], [1, 0] ],
              [ [0, 0, 0], [1, 0, 1] ],
              [ [0, 0], [1, 1], [0, 0] ] );
for my $test (@tests) {
    printf "%-8s, %-8s, ... => ", 
        "[@{$test->[0]}]", "[@{$test->[1]}]";
    say maximum_ones @$test;
}

This program displays the following output:

$ perl ./maximum-ones.pl
[0 1]   , [1 0]   , ... => 1
[0 0 0] , [1 0 1] , ... => 2
[0 0]   , [1 1]   , ... => 2`

Note that we display only the first two rows of each input test matrix.

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 June 9, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.