laurent_r

These are some answers to the Week 68 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Zero Matrix

You are given a matrix of size M x N having only 0s and 1s.

Write a script to set the entire row and column to 0 if an element is 0.

Example 1:

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

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

Example 2:

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

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

Zero Matrix in Raku

In my first attempt, I decided to modify the matrix in place. Assuming you’re processing the matrix line by line, this means that you cannot set columns to zero when processing rows, since it would alter the result for the next rows. In other words, you have to postpone updating of columns until you’ve finished processing the rows. So, I keep the subscripts of the columns to be set to 0 in the @cols array. Similarly, I need to keep track of columns to be nullified before nullifying a row.

use v6;

sub display (@mat) {
    .say for @mat; say "";
}

my @matrix = [1, 1, 1], [1, 0, 1], [1, 1, 1], [1, 1, 1];
display @matrix;

my @cols;
for 0..@matrix.end -> $i {
  my $row = False;
    for 0..@matrix[$i].end -> $j {
        if @matrix[$i][$j] == 0 {
            $row = True;
            push @cols, $j;
        }
    }
    @matrix[$i] = [0 xx @matrix[$i].elems] if $row;
}
for @cols -> $j {
    @matrix[$_][$j] = 0 for 0..@matrix.end;
}
display @matrix;

This works as expected:

$ raku zero-matrix.raku
[1 1 1]
[1 0 1]
[1 1 1]
[1 1 1]

[1 0 1]
[0 0 0]
[1 0 1]
[1 0 1]

Overall, modifying the matrix in place feels a bit clunky. So, I decided to create a new copy of the matrix. But this:

my @matrix = [1, 1, 1], [1, 0, 1], [1, 1, 1], [1, 1, 1];
my @new-matrix = @matrix;   # Wrong
for 0..@matrix.end -> $i {
    # ...

does not work as expected, because this appears to make a shallow copy: when you modify @new-matrix, the original matrix is also changed. I was hoping that using the clone built-in would create an independent copy (the documentation says that modifications of elements in the clone are not propagated to the original), but that also doesn’t work with nested arrays and leads to the same problem (modifications are actually propagated). So, I had to use a loop to populate @new-matrix, so that changing @new-matrix does not alter the original @matrix:

sub display (@mat) {
    .say for @mat; say "";
}

my @matrix = [1, 1, 1], [1, 0, 1], [1, 1, 1], [1, 1, 1];
display @matrix;
my @new-matrix;
for 0..@matrix.end -> $i {
    @new-matrix[$i] = [1 xx @matrix[$i].elems]
}
for 0..@matrix.end -> $i {
    for 0..@matrix[$i].end -> $j {
        if @matrix[$i][$j] == 0 {
            @new-matrix[$i] = [0 xx @matrix[$i].elems];
            @new-matrix[$_][$j] = 0 for 0..@matrix.end;
        }
    }
}
display @new-matrix;

This works correctly:

$ raku zero-matrix2.raku
[1 1 1]
[1 0 1]
[1 1 1]
[1 1 1]

[1 0 1]
[0 0 0]
[1 0 1]
[1 0 1]

Zero Matrix in Perl

This a port to Perl of the second Raku implementation above:

use strict;
use warnings;
use feature qw/say/;

sub display {
    say "@$_" for @_; say "";
}

my @matrix = ([1, 1, 1], [1, 0, 1], [1, 1, 1], [1, 1, 1]);
display @matrix;
my @new_matrix;
push @new_matrix, [ @$_ ] for @matrix; # deep copy
for my $i (0..$#matrix) {
    for my $j (0..scalar @{$matrix[$i]} - 1) {
        if ($matrix[$i][$j] == 0) {
            $new_matrix[$i] = [ (0) x scalar @{$matrix[$i]} ];
            $new_matrix[$_][$j] = 0 for 0..$#matrix;
        }
    }
}
display @new_matrix;

This works as in Raku:

$ perl zero-matrix.pl
1 1 1
1 0 1
1 1 1
1 1 1

1 0 1
0 0 0
1 0 1
1 0 1

Wrapping up

Perl Weekly Challenge 68 had another task (reorder lists), but I’m already much too late and don’t have time to complete it.

The next week Perl Weekly Challenge has already started. 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 Sunday, July 19, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.