laurent_r

These are some answers to the Week 266, Task 2, 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 April 28, 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 2: X Matrix

You are given a square matrix, $matrix.

Write a script to find if the given matrix is X Matrix.

A square matrix is an X Matrix if all the elements on the main diagonal and antidiagonal are non-zero and everything else are zero.

Example 1

Input: $matrix = [ [1, 0, 0, 2],
                   [0, 3, 4, 0],
                   [0, 5, 6, 0],
                   [7, 0, 0, 1],
                 ]
Output: true

Example 2

Input: $matrix = [ [1, 2, 3],
                   [4, 5, 6],
                   [7, 8, 9],
                 ]
Output: false

Example 3

Input: $matrix = [ [1, 0, 2],
                   [0, 3, 0],
                   [4, 0, 5],
                 ]
Output: true

The matrix items on the main diagonal (from top left to bottom right) are those whose row index is equal to the column index, such as @matrix[0][0] or @matrix[1][1], i.e. items 1, 3, 6, and 1 in the first example above.

The matrix items on the anti-diagonal (from top right to bottom left) are those whose row index plus the column index is equal to the matrix size - 1, such as @matrix[0][3] or @matrix[1][2], i.e. items 2, 4, 5 and 7 in the first example above.

X Matrix in Raku

We iterate over the items of the matrix using two nested loops. If an item on a diagonal or an anti-diagonal (see above) is zero, then we return False; if an item not on a diagonal or an anti-diagonal is not zero, then we also return False. If we arrive at the end of the two loops, then we have an X matrix and can return True.

sub is-x-matrix (@m) {
    my $end = @m.end; # end = size - 1
    for 0..$end -> $i {
        for 0..$end -> $j {
            if $i == $j or $i + $j == $end { # diag or antidiag
                return False if @m[$i][$j] == 0;
            } else {    # not diag or antidiag
                return False if @m[$i][$j] != 0;
            }
        }
    }
    # If we got here, it is an X-matrix
    return True;
}

my @tests = 
    [ [1, 0, 0, 2],
      [0, 3, 4, 0],
      [0, 5, 6, 0],
      [7, 0, 0, 1],
    ],
    [ [1, 2, 3],
      [4, 5, 6],
      [7, 8, 9],
    ],
    [ [1, 0, 2],                                                          
      [0, 3, 0],
      [4, 0, 5],
    ];
for @tests -> @test {
    printf "[%-10s...] => ", "@test[0]";
    say is-x-matrix @test;
}

Note that we display only the first row of each test matrix for the sake of getting a better formatting. This program displays the following output:

$ raku ./x-matrix.raku
[1 0 0 2   ...] => True
[1 2 3     ...] => False
[1 0 2     ...] => True

X Matrix in Perl

This is a port to Perl of the above Raku program. Please refer to the previous section if you need further explanations.

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

sub is_x_matrix {
    my $m = shift;
    my $end = scalar @{$m->[0]} - 1; # $end = size - 1
    for my $i (0..$end) {
        for my $j (0..$end) {
            if ($i == $j or $i + $j == $end) { # diag or antidiag
                return "false" if $m->[$i][$j] == 0;
            } else {    # not diag or antidiag
                return "false" if $m->[$i][$j] != 0;
            }
        }
    }
    # If we got here, it is an X-matrix
    return "true";
}

my @tests = (
    [ [1, 0, 0, 2],
      [0, 3, 4, 0],
      [0, 5, 6, 0],
      [7, 0, 0, 1],
    ],
    [ [1, 2, 3],
      [4, 5, 6],
      [7, 8, 9],
    ],
    [ [1, 0, 2],                                                          
      [0, 3, 0],
      [4, 0, 5],
    ]
    );
for my $test (@tests) {
    printf "[%-10s...] => ", "@{$test->[0]}";
    say is_x_matrix $test;
}

This program displays the following output:

$ perl ./x-matrix.pl
[1 0 0 2   ...] => true
[1 2 3     ...] => false
[1 0 2     ...] => true

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 May 5, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.