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.

Well documented and crafted solutions in Perl and on top you get to play with it. Well done and keep it up great work.

Try it 

#!/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);
    }
}

22 lines of code

Output from script

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