Lonely ones and equalities

Weekly challenge 270 — 20 May 2024

Week 270 - 20 May 2024

Task 1

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.

Example 1Input: $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 2Input: $matrix = [ [1, 0, 0], [0, 1, 0], [0, 0, 1], ] Output: 3 Special positions are (0,0), (1, 1) and (2,2).

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.

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

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

The content of
this website
is licensed by
Peter
Campbell Smith under a
Creative Commons Attribution 4.0 International Licence