laurent_r

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

Task 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

One way to do that is to find if any item of the matrix has the same value as the item immediately above and immediately left. We return False for any case where this is not the case, and True if we get to the end of the loop.

Toeplitz Matrix in Raku

The implementation is fairly straight forward:

sub is-toeplitz (@in) {
    for 1..@in.end -> $i {
        for 1..@in[0].end -> $j {
            # say "$i $j @in[$i][$j] @in[$i-1][$j-1]";
            return False if @in[$i][$j] != @in[$i-1][$j-1];
        }
    }
    return True;
}


for ( <4 3 2 1>, <5 4 3 2>, <6 5 4 3> ), 
    ( <3 2 1 0>, <4 3 2 1>, <5 4 3 2> ),
    ( <3 2 1 0>, <4 3 2 1>, <5 5 3 2> ),
    ( <1 2 3>, <3 2 1> ) -> @test {
    say @test;
    say is-toeplitz(@test), "\n";
}

This program displays the following output:

$ raku ./toeplitz-matrix.raku
((4 3 2 1) (5 4 3 2) (6 5 4 3))
True

((3 2 1 0) (4 3 2 1) (5 4 3 2))
True

((3 2 1 0) (4 3 2 1) (5 5 3 2))
False

((1 2 3) (3 2 1))
False

Toeplitz Matrix in Perl

This is a port to Perl of the Raku program above:

use strict;
use warnings;
use feature "say";

sub is_toeplitz {
    my @in = @_;
    my $j_max = scalar @{$in[0]} - 1;
    for my $i (1..$#in) {
        for my $j (1..$j_max) {
            # say "$i $j $in[$i][$j] $in[$i-1][$j-1]";
            return "false" if $in[$i][$j] != $in[$i-1][$j-1];
        }
    }
    return "true";
}

for my $test 
    ( [ [<4 3 2 1>], [<5 4 3 2>], [<6 5 4 3>] ], 
      [ [<3 2 1 0>], [<4 3 2 1>], [<5 4 3 2>] ],
      [ [<3 2 1 0>], [<4 3 2 1>], [<5 5 3 2>] ],
      [ [<1 2 3>], [<3 2 1>] ] ) {
    say "[ ", (join ", ", map "[@$_]", @$test), " ]";
    say is_toeplitz(@$test), "\n";
}

This program displays the following output:

$ perl ./toeplitz-matrix.pl
[ [4 3 2 1], [5 4 3 2], [6 5 4 3] ]
true

[ [3 2 1 0], [4 3 2 1], [5 4 3 2] ]
true

[ [3 2 1 0], [4 3 2 1], [5 5 3 2] ]
false

[ [1 2 3], [3 2 1] ]
false

Task 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

Let us notice that each sub-array should have the same average as the full array’s average. So, we simply need to find a sub-array that has the same average, the other sub-array is bound to have the same average.

An additional comment is that there can be several solutions. In the case of the (1, 2, 3, 4, 5, 6, 7, 8) array, we find solution not the same as the one in the task specification, i.e. [(1 2 3 6 7 8) (4 5)], but it is also a correct solution to the task, as both arrays have an average of 4.5.

Split Same Average in Raku

sub avg (@a) { return ([+] @a) / @a.elems; }

sub find-partition (@current, @left) {
    return if @left.elems <= 1;
    # say "Current: ", avg @current if @current.elems > 0;
    if @current.elems > 0 and $*target == avg @current  {
        push @*result, @current;
        return;
    }
    for 0..@left.end -> $i {
        find-partition( (@current, @left[$i]).flat, 
            (@left[0..$i-1, $i+1..@left.end]).flat);
        return if @*result.elems > 0;
    }
}

sub start-partition (@in) {
    my $*target = avg @in;
    my @*result;
    my @current;
    find-partition @current, @in;
    return @*result;
}

for <1 2 3 4 5 6 7 8>, <1 2 3>, <1 3> -> @test {
    my @output = start-partition @test;
    print @test, " => ";
    if @output.elems == 0 {
        say "false";
    } else {
        print "true : ";
        push @output, (@test (-) @output[0]).keys;
        say @output;
    }
}

This program displays the following output:

$ raku  ./split-same-avg.raku
1 2 3 4 5 6 7 8 => true : [(1 2 3 6 7 8) (4 5)]
1 2 3 => true : [(2) (1 3)]
1 3 => false

Split Same Average in Perl

use strict;
use warnings;
use feature "say";

my ($target, @result);

sub avg {
    my $nb_elems = scalar @_;
    my $sum = shift;
    $sum += $_ for @_;
    return $sum / $nb_elems;
}

sub find_partition {
    my @current = @{$_[0]};
    my @left = @{$_[1]};
    return if scalar @left <= 1;
    if (scalar @current > 0 and $target == avg(@current)) {
        push @result, @current;
        return;
    }
    for my $i (0..$#left) {
        find_partition( [@current, $left[$i]], [@left[0..$i-1, $i+1..$#left]]);
        return if @result > 0;
    }
}

sub start_partition {
    my @in = @_;
    $target = avg @in;
    @result = ();
    my @current;
    find_partition [@current], [@in];
    return @result;
}

for my $test ([<1 2 3 4 5 6 7 8>], [<1 2 3>], [<1 3>]) {
    my @output = start_partition @$test;
    print "@$test => ";
    if (scalar @output == 0) {
        say "false";
    } else {
        print "true : [@output] ";
        my %out = map { $_ => 1 } @output;
        say "[", join " ", grep { not exists $out{$_} } @$test, "]";
    }
}

This program displays the following output:

$ perl ./split-same-avg.pl
1 2 3 4 5 6 7 8 => true : [1 2 3 6 7 8] [4 5 ]
1 2 3 => true : [2] [1 3 ]
1 3 => false

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 April 16, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.