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

Examples

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.

Analysis

The key line in my solution is

$ones = grep {$_ == 1 ? 1 : 0} @{$matrix->[$r]};

This returns the number of 1s in row $r of the matrix pointed to by $matrix.

It's then just a case of looping over all the rows and finding the one with the most 1s.

Try it 

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2024-05-27
use utf8;     # Week 271 - task 1 - Maximum ones
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

maximum_ones([[0, 1], [1, 0]]);
maximum_ones([[0, 0, 0], [1, 0, 1]]);
maximum_ones([[0, 0], [1, 1], [0, 0]]);
maximum_ones([[2, 3], [4, 1], [5, 6], [7, 1]]);
maximum_ones([[3, 3, 3], [4, 4, 4], [0, 0, 0]]);

sub maximum_ones {
    
    my ($matrix, $max, $ones, $max_row, $r);
    
    # initialise
    $matrix = shift;
    $max = -1;
    
    # loop over rows
    for $r (0 .. @$matrix - 1) {
        $ones = grep {$_ == 1 ? 1 : 0} @{$matrix->[$r]};
        
        # found a better one
        if ($ones > $max) {
            $max_row = $r;
            $max = $ones;
        }
    }
    
    # show result
    print_matrix('Input: ', $matrix);
    printf  $max > 0 ? (qq[Output: row %d (%d one%s)\n], $max_row + 1, $max, $max == 1 ? '' : 's') :
        qq[Output: no ones in matrix\n];
}

sub print_matrix {
    
    my ($legend, $matrix, $j);

    # format matrix
    ($legend, $matrix) = @_;
    say '';
    for $j (0 .. @$matrix - 1) {
        say qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
        $legend = ' ' x length($legend);
    }
}

Output

Input:  [0, 1]
        [1, 0]
Output: row 1 (1 one)

Input:  [0, 0, 0]
        [1, 0, 1]
Output: row 2 (2 ones)

Input:  [0, 0]
        [1, 1]
        [0, 0]
Output: row 2 (2 ones)

Input:  [2, 3]
        [4, 1]
        [5, 6]
        [7, 1]
Output: row 2 (1 one)

Input:  [3, 3, 3]
        [4, 4, 4]
        [0, 0, 0]
Output: no ones in matrix