laurent_r

These are some answers to the Week 270, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on May 26, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: 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.

Example 1

Input: $matrix = [ [1, 0, 0],
                   [0, 0, 1],
                   [1, 0, 0],
                 ]
Output: 1

There is only one 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).

Special Positions in Raku

We use an array slice (with the any junction) to check rows and standard for loop to check columns.

sub special-positions (@mat) {
    my $row-max = @mat[0].end;
    my $count = 0;
    IND_I: for 0..$row-max -> $i {
        for 0..@mat.end -> $j {                            `
            next if @mat[$i][$j] != 1;
            next unless 
                (@mat[$i][0..^$j, $j^..$row-max]).any != 0;
            for 0..@mat.end -> $k {
                next if $k == $i;
                next IND_I unless @mat[$i][$k] == 0;
            }
            # say "$i, $j"; # uncomment to see the positions
            $count++;
        }
    }
    return $count;
}

my @tests = 
        [ [1, 0, 0],
          [0, 0, 1],
          [1, 0, 0],
        ],
        [ [1, 0, 0],
          [0, 1, 0],
          [0, 0, 1],
        ];
for @tests -> @test {
    printf "%-8s %-8s ... => ", "@test[0]", "@test[1]";
    say special-positions @test;
}

This program displays the following output:

$ raku ./special-positions.raku
1 0 0    0 0 1    ... => 1
1 0 0    0 1 0    ... => 3

Special Positions in Perl

This is a port to Perl of the above Raku program. Since Perl doesn't have any junction, we had to replace it with a for loop.

use strict;
use warnings;
use feature 'say';

sub special_positions {
    my $mat = shift;
    my $row_max = $#{$mat->[0]};
    my $col_max =  $#{$mat};
    my $count = 0;
    for my $i (0..$row_max) {
    IND_J: for my $j (0..$col_max) {
            next if $mat->[$i][$j] != 1;
            # check row
            for my $m (0..$row_max) {
                next if $m == $i;
                next IND_J unless $mat->[$m][$j] == 0;
            }
            # check column
            for my $k (0..$col_max) {
                next if $k == $j;
                next IND_J unless $mat->[$i][$k] == 0;
            }
            # say "$i, $j"; # uncomment to see the positions
            $count++;
        }
    }
    return $count;
}

my @tests = (
        [ [1, 0, 0],
          [0, 0, 1],
          [1, 0, 0],
        ],
        [ [1, 0, 0],
          [0, 1, 0],
          [0, 0, 1],
        ]
        );
for my $test (@tests) {
    printf "[%-8s %-8s ...] => ", "@{$test->[0]}", "@{$test->[1]}";
    say special_positions $test;
}

his program displays the following output:

$ perl ./special-positions.pl
[1 0 0    0 0 1    ...] => 1
[1 0 0    0 1 0    ...] => 3

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on June 2, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.