Task — Special positions

You are given a m x n binary matrix. Write a script to return the number of special positions in the given binary matrix. A position (i, j) is called special if $matrix[i][j] == 1 and all other elements in the row i and column j are 0.

Examples

Example 1
Input: $matrix = [ [1, 0, 0],
                   [0, 0, 1],
                   [1, 0, 0],
                 ]
Output: 1
There is only special position (1, 2) as 
$matrix[1][2] == 1 and all other elements in row 1 and 
column 2 are 0.

Example 2
Input: $matrix = [ [1, 0, 0],
                   [0, 1, 0],
                   [0, 0, 1],
                 ]
Output: 3
Special positions are (0,0), (1, 1) and (2,2).

Analysis

My initial thought was that doing it by eye I would look for any 1s, and check to see if their row and columns were all otherwise 0s. So let's just do that.

Is there a better way? This approach has the advantage of clarity and brevity, and is efficient in that it eliminates a 1 from consideration as soon as it finds a non-0 to its left or above it.

It could be said that this line:

$count = $special =~ s|,|,|g + 0;

is a little cryptic. What it does is to count the commas in $special, which contains the list of special cells found, each followed by a comma. The s|,|,|g doesn't change the value of $special but it does return the number of times it has substituted a comma for a comma, in other words the number of commas in $special, which is the number we are after. The + 0 is there for the case where there are no special positions.

Try it 

Script

#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2024-05-20
use utf8;     # Week 270 - task 1 - Special positions
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

special_positions([[1, 0, 0],
                   [0, 0, 1],
                   [1, 0, 0]]);
                   
special_positions([[1, 0, 0],
                   [0, 0, 1],
                   [0, 0, 1]]);

special_positions([[1, 0, 1],
                   [0, 0, 0],
                   [1, 0, 1]]);
                   
special_positions([[1, 0, 0, 0, 0, 0],
                   [0, 1, 0, 0, 0, 0],
                   [0, 0, 1, 0, 0, 0],
                   [0, 0, 0, 1, 0, 0],
                   [0, 0, 0, 0, 1, 1]]);

sub special_positions {
    
    my ($matrix, $ones, $r, $c, $special, $r1, $c1, $count);
    
    $matrix = shift;
    $special = '';
    
    # look for 1s
    ROW: for $r (0 .. @$matrix - 1) {
        COL: for $c (0 .. @{$matrix->[$r]} - 1) {
            next COL unless $matrix->[$r]->[$c] == 1;
            
            # check that it's the only 1 in its row
            for $r1 (0 .. @$matrix - 1) {
                next COL if ($matrix->[$r1]->[$c] != 0 and $r1 != $r);
            }
            
            # and in its column
            for $c1 (0 .. @{$matrix->[$r]} - 1) {
                next COL if ($matrix->[$r]->[$c1] != 0 and $c1 != $c); 
            }
            
            # found one!
            $special .= qq[r$r c$c, ];
        }
    }
    
    # count the commas and show answer
    $count = $special =~ s|,|,|g + 0;
    print_matrix(q[Input: ], $matrix);
    say qq[Output: $count] . ($count > 0 ? ' - ' . substr($special, 0, -2) : '');
}

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:  [1, 0, 0]
        [0, 0, 1]
        [1, 0, 0]
Output: 1 - r1 c2

Input:  [1, 0, 0]
        [0, 0, 1]
        [0, 0, 1]
Output: 1 - r0 c0

Input:  [1, 0, 1]
        [0, 0, 0]
        [1, 0, 1]
Output: 0

Input:  [1, 0, 0, 0, 0, 0]
        [0, 1, 0, 0, 0, 0]
        [0, 0, 1, 0, 0, 0]
        [0, 0, 0, 1, 0, 0]
        [0, 0, 0, 0, 1, 1]
Output: 4 - r0 c0, r1 c1, r2 c2, r3 c3