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.

Using just grep to solve the binary matrix task is incredible. Don't forget to try it out the solutions.

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);
    }
}

19 lines of code

Output from script

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