laurent_r

These are some answers to the Week 204 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 February 19, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Monotonic Array

You are given an array of integers.

Write a script to find out if the given array is Monotonic. Print 1 if it is otherwise 0.

An array is Monotonic if it is either monotone increasing or decreasing.

Monotone increasing: for i <= j , nums[i] <= nums[j]

Monotone decreasing: for i <= j , nums[i] >= nums[j]

Example 1

Input: @nums = (1,2,2,3)
Output: 1

Example 2

Input: @nums (1,3,2)
Output: 0

Example 3

Input: @nums = (6,5,5,4)
Output: 1

Monotonic Array in Raku

In Raku, the [] meta-operator used together with the >= or <= can check whether the comparison operator holds for all values of the input list or array. So we end up with a very simple program:

sub is-monotonic (@in) {
    [>=] @in or [<=] @in;
}

for <1 2 2 3>, <1 3 2>, <6 5 5 4> -> @test {
    say (~@test).fmt("%-10s => "), + is-monotonic @test;
}

This script displays the following output:

$ raku ./monotonic.raku
1 2 2 3    => 1
1 3 2      => 0
6 5 5 4    => 1

The solution is so concise that it can be changed to a simple one-liner:

$ raku -e 'say +([>=] @*ARGS or [<=] @*ARGS)' 3 7 7 9
1

After I prepared the above solution, I came across a blog post by Andrew Shitov, who asked ChatGPT to solve the problem. Not only did ChatGPT manage to write a correct program at the first try, but with a little guidance from my friend Andrew, it also managed to iteratively simplify the code and ended up to write a very raku-ish solution almost identical to my solution above:

sub is-monotonic(@nums) {
    [>=] @nums || [<=] @nums;
}

my @nums = (1, 2, 2, 3);
say +is-monotonic(@nums);

I found this almost unbelievable (and somewhat frightening). In my humble opinion, you should really read Andrew’s blog post.

Monotonic Array in Perl

The is_monotonic subroutine sets an ascending flag and a descending flag to a true value. It then uses a for loop to iterate over the input array and sets the relevant flag to a false value when it finds items pairs not ascending or not descending. At the end, the input array is monotonic if either of the flags is still true.

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

sub is_monotonic {
    my @in = @_;
    my ($ascending, $descending) = (1, 1);
    for my $i (1..$#in) {
        $ascending  = 0 if $in[$i] < $in[$i-1];
        $descending = 0 if $in[$i] > $in[$i-1]
    }
    return $ascending || $descending;
}
for my $test ([<1 2 2 3>], [<1 3 2>], [<6 5 5 4>]) {
    printf "%-10s => %d\n", "@$test", is_monotonic @$test;
}

This script displays the following output:

$ perl  ./monotonic.pl
1 2 2 3    => 1
1 3 2      => 0
6 5 5 4    => 1

Task 2: Reshape Matrix

You are given a matrix (m x n) and two integers (r) and (c).

Write a script to reshape the given matrix in form (r x c) with the original value in the given matrix. If you can’t reshape print 0.

Example 1

Input: [ 1 2 ]
       [ 3 4 ]

       $matrix = [ [ 1, 2 ], [ 3, 4 ] ]
       $r = 1
       $c = 4

Output: [ 1 2 3 4 ]

Example 2

Input: [ 1 2 3 ]
       [ 4 5 6 ]

       $matrix = [ [ 1, 2, 3 ] , [ 4, 5, 6 ] ]
       $r = 3
       $c = 2

Output: [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ]

        [ 1 2 ]
        [ 3 4 ]
        [ 5 6 ]

Example 3

Input: [ 1 2 ]

       $matrix = [ [ 1, 2 ] ]
       $r = 3
       $c = 2

Output: 0

Reshape Matrix in Raku

The reshape subroutine first determines the number of rows and columns of the input matrix, and returns 0 if the product of these values is not the same as the product $r x $c (since reshaping would not be possible in that case). It then flattens the input matrix into a one-dimension vector and iteratively picks $c items of the flattened array to populate the rows of the target array.

sub reshape (@matrix, $r, $c) {
    my @result;
    my $rows = @matrix.elems;
    my $cols = @matrix[0].elems;
    return 0 if $r * $c != $rows * $cols;
    my @flattened = | @matrix.map({| $_ });
    for 0..^$r -> $i {
        push @result, @flattened[$i*$c .. $i*$c + $c -1 ]
    }
    return @result;
}
sub display-result (@mat, $rc) {
    say @mat.gist.fmt("%-18s - "), "$rc => ", 
        reshape(@mat, | $rc);
}

my @test = ((1, 2), (3, 4));
for <1 4>, <4 1>, <2 2>, <3 4> -> $rc {
    display-result @test, $rc;
}
@test = ((1, 2, 3), (4, 5, 6));
for <3 2>, <2 3>, <1 6>, <6 1>, <6 3> -> $rc {
    display-result @test, $rc;
}

This program displays the following output:

$ raku ./reshape.raku
[(1 2) (3 4)]      - 1 4 => [(1 2 3 4)]
[(1 2) (3 4)]      - 4 1 => [(1) (2) (3) (4)]
[(1 2) (3 4)]      - 2 2 => [(1 2) (3 4)]
[(1 2) (3 4)]      - 3 4 => 0
[(1 2 3) (4 5 6)]  - 3 2 => [(1 2) (3 4) (5 6)]
[(1 2 3) (4 5 6)]  - 2 3 => [(1 2 3) (4 5 6)]
[(1 2 3) (4 5 6)]  - 1 6 => [(1 2 3 4 5 6)]
[(1 2 3) (4 5 6)]  - 6 1 => [(1) (2) (3) (4) (5) (6)]
[(1 2 3) (4 5 6)]  - 6 3 => 0

Reshape Matrix in Perl

This is a port to Perl of the above Raku program, using the same method. Note that this is a bit more difficult in Perl because of the need to use array references and to explicitly dereference these references in order to access the data, whereas Raku essentially manages most of these chores for us.

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

sub reshape {
    my @matrix = @{$_[0]};
    my ($r, $c) = @{$_[1]};
    my @result;
    my $rows = scalar @matrix;
    my $cols = scalar @{$matrix[0]};
    return [0] if $r * $c != $rows * $cols;
    my @flat = map { @$_ } @matrix;
    for my $i (0..$r - 1) {
        push @result, [ @flat[$i*$c .. $i*$c + $c -1 ] ];
    }
    return @result;
}
sub display_result {
    my ($mat, $rc) = @_;
    printf "%-15s - %-3s => ", join ("", 
        map ("[@$_]",  @$mat)), "@$rc";
    say map "[@$_]", reshape($mat, $rc);;
}

my @test = ([1, 2], [3, 4]);
for my $rc ([<1 4>], [<4 1>], [<2 2>], [<3 4>]) {
    display_result \@test, $rc;
}
@test = ([1, 2, 3], [4, 5, 6]);
for my $rc ([<3 2>], [<2 3>], [<1 6>], [<6 1>], [<6 3>]) {
    display_result \@test, $rc;
}

This program displays the following output:

$ perl  ./reshape.pl
[1 2][3 4]      - 1 4 => [1 2 3 4]
[1 2][3 4]      - 4 1 => [1][2][3][4]
[1 2][3 4]      - 2 2 => [1 2][3 4]
[1 2][3 4]      - 3 4 => [0]
[1 2 3][4 5 6]  - 3 2 => [1 2][3 4][5 6]
[1 2 3][4 5 6]  - 2 3 => [1 2 3][4 5 6]
[1 2 3][4 5 6]  - 1 6 => [1 2 3 4 5 6]
[1 2 3][4 5 6]  - 6 1 => [1][2][3][4][5][6]
[1 2 3][4 5 6]  - 6 3 => [0]

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