Perl Weekly Challenge: Week 211

Challenge 1:

Toeplitz Matrix

You are given a matrix m x n.

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

A matrix is Toeplitz if every diagonal from top-left to bottom-right has the same elements.

Example 1
Input: @matrix = [ [4, 3, 2, 1],
                   [5, 4, 3, 2],
                   [6, 5, 4, 3],
                ]
Output: true
Example 2
Input: @matrix = [ [1, 2, 3],
                   [3, 2, 1],
                 ]
Output: false

The first problem I faced when attempting to solve this challenge was how to input the matrix from the command line. I settled on having the first two arguments being the number of rows and columns in the matrix and the rest of them being the matrix data. So, for instance, the inputs for example one would look like this: 3 4 4 3 2 1 5 4 3 2 6 5 4 3.

sub MAIN(
    $r,
    $c,
    *@args
) {

In order to build the matrix, we have to takes @args which is a flat list, and using .batch() convert it into a 2d array consisting of a number of rows of $c columns each.

    my @matrix = @args.batch($c);

Each diagonal starts on the 0th row at a particular column stretching from 0 to the end of $c. The current position in the diagonal is encoded as $i for the current row and $j for the current column.

    for 0 ..^ $c -> $col {
        my $i = 0;
        my $j = $col;

The value of the first position in the diagonal is the one we will check all the other elements of the diagonal against. my $same = @matrix[$i;$j];

Until we reach either the bottom or right hand edge of the matrix, we move down one row and right one column.

        while $i < $r && $j < $c {

If the value of the element at that position isn't the same as that of the first position in the diagonal (i.e. $same,) this isn't a Toeplitz matrix so we can print "false" and exit the script.

            if @matrix[$i;$j] != $same {
                say 'false';
                exit;
            }

If it is the same, we can move on to the next position in the diagonal.

            $i++;
            $j++;
        }
    }

The loop above, accounts for all diagonals that begin on the top edge (i.e. row 0,) but there are also diagonals that begin on the left edge (i.e. column 0.) So we have to loop again this time starting from a particular row instead of a column. The loop starts from 1 because we've already done the diagonal that starts from row 0 in the previous loop.

    for 1 ..^ $r -> $row {
        my $i = $row;
        my $j = 0;
        my $same = @matrix[$i;$j];

        while $i < $r && $j < $c {
            if @matrix[$i;$j] != $same {
                say 'false';
                exit;
            }
            $i++;
            $j++;
        }
    }

If we manage to pass through both loops, we have determined that all diagonals have the same values and therefore, the matrix is a Toeplitz matrix. We print "true" and finish.

    say 'true';
}

Although the code above works, it has a lot of redundancy in the two loops. So I refactored a bunch of code that is repeated into a separate function like this:

sub diagonal(@matrix, $r, $c, $row, $col) {
    my $i = $row;
    my $j = $col;
    my $same = @matrix[$i;$j];

    while $i < $r && $j < $c {
        if @matrix[$i;$j] != $same {
            return False;
        }
        $i++;
        $j++;
    }
    return True;

}

Now the main body of the script looks like this:

sub MAIN(
    $r,
    $c,
    *@args
) {

    my @matrix = @args.batch($c);


    for 0 ..^ $c -> $col {
        unless diagonal(@matrix, $r, $c, 0, $col) {
            say 'false';
            exit;
        }
    }

    for 1 ..^ $r -> $row {
        unless diagonal(@matrix, $r, $c, $row, 0) {
            say 'false';
            exit;
        }
    }

    say 'true';
}

(Full code on Github.)

Much cleaner don't you think?

For comparison, here is the Perl version. I also had to add code to emulate .batch() which Perl doesn't have.

sub diagonal {
    my ($matrix, $r, $c, $row, $col) = @_;
    my $i = $row;
    my $j = $col;
    my $same = $matrix->[$i]->[$j];

    while ($i < $r && $j < $c) {
        if ($matrix->[$i]->[$j] != $same) {
            return undef;
        }
        $i++;
        $j++;
    }
    return 1;
}

my $r = shift;
my $c = shift;
my @matrix = batch(\@ARGV, $c);

for my $col (0 .. $c - 1) {
    unless (diagonal(\@matrix, $r, $c, 0, $col)) {
        say 'false';
        exit;
    }
}

for my $row (1 .. $r - 1) {
    unless (diagonal(\@matrix, $r, $c, $row, 0)) {
        say 'false';
        exit;
    }
}

say "true";

(Full code on Github.)

Challenge 2:

Split Same Average

You are given an array of integers.

Write a script to find out if the given can be split into two separate arrays whose average are the same.

Example 1
Input: @nums = (1, 2, 3, 4, 5, 6, 7, 8)
Output: true

We can split the given array into (1, 4, 5, 8) and (2, 3, 6, 7).
The average of the two arrays are the same i.e. 4.5.
Example 2
Input: @list = (1, 3)
Output: false

To solve this challenge we need all the different permutations of two halves of the input and Raku's aptly named .permutations() list method would seem to be exactly what we need. Actually it is a little bit of overkill; (1 2 3 4) and (4 3 2 1) are treated as separate permutations which is normally what you want but unnecessary when calculating the average. The .map() calling .batch() splits each permutation into two equally sized parts.

for @nums.permutations.map({ @$_.batch(@$_.elems div 2) }) -> $i {

If the average of the two parts is the same, we have success. We print "true" and exit the script.

    if average(@$i[0]) == average(@$i[1]) {
        say "true";
        exit;
    }

I was somewhat surprised to find that Raku doesn't have an .average() method in the standard library but it was easy enough to make one of my own:

sub average(@nums) {
    return @nums.sum / @nums.elems;
}

If we make it through all the permutations without finding one whose two halves have the same average, we print "false".

}
say 'false';

As I wrote this, it occurred to me that I had assumed that both split parts of a permutation have to be of equal size but the spec doesn't actually demand this. For instance (1 2 3 2 2 2 2) could be split into (1 2 3) and (2 2 2 2) both of which have an average of 2. This led me to revise my code like this:

for @nums.permutations -> $i {
    for 1 ..^ @$i.elems -> $j {

This was the only complication. .permutations() returns Lists but .splice() needs an Array.

        my @array = $i.Array;
        my @part1 = @array.splice(0, $j);
        my @part2 = @array;

        if average(@part1) == average(@part2) {
            say "true";
            exit;
        }
    }
}
say 'false';

(Full code on Github.)

This is the Perl version. Once again I had to deal with Perls lack of equivalents for Raku standard library methods. This time I supplemented the code with permute() and sum().

sub average {
    my ($nums) = @_;

    return sum($nums) / scalar @{$nums};
}

my @permutations;
permute { push @permutations, \@_; } @ARGV;

my @nums;
for my $i (@permutations) {

    for my $j (1 .. scalar @{$i} - 1) {
        my @array = @{$i};            
        my @part1 = splice(@array, 0, $j);
        my @part2 = @array;

        if (average([@part1]) == average([@part2])) {
            say "true";
            exit;
        }
    }
}
say 'false';

(Full code on Github.)