Perl Weekly Challenge 204.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 204.
Task 1: Monotonic Array
Submitted by: Mohammad S Anwar
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 is used as either not-decreasing or not-increasing. A simple solution is to set a flag if I find an increasing region and another if I find a decreasing one. At the end, at least one of them should be unset for monotonic sequences. This yields a oneliner:
perl -E '@l=@ARGV; $c=shift; for(@ARGV){$_>$c and $i=1; $_<$c and $d=1; $c=$_} say join " ", @l, "->", $i&&$d?0:1' 1 2 2 3
perl -E '@l=@ARGV; $c=shift; for(@ARGV){$_>$c and $i=1; $_<$c and $d=1; $c=$_} say join " ", @l, "->", $i&&$d?0:1' 1 3 2
perl -E '@l=@ARGV; $c=shift; for(@ARGV){$_>$c and $i=1; $_<$c and $d=1; $c=$_} say join " ", @l, "->", $i&&$d?0:1' 6 5 5 4
Results:
1 2 2 3 -> 1
1 3 2 -> 0
6 5 5 4 -> 1
(Note that I used and instead of && to avoid precedence problems.
The corresponding full code is
1 # Perl weekly challenge 204
2 # Task 1: Monotonic Array
3 #
4 # See https://wlmb.github.io/2023/02/13/PWC204/#task-1-monotonic-array
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2...]
8 to test if the sequence N1 N2... is monotonic
9 FIN
10 my @orig=@ARGV;
11 my $current=shift;
12 my ($increasing, $decreasing);
13 for(@ARGV){
14 $_>$current and $increasing=1;
15 $_<$current and $decreasing=1;
16 last if $increasing and $decreasing; # shortcut if non monotonic
17 $current=$_;
18 }
19 my ($result, $reason)=
20 $increasing && $decreasing?(0, "Non-monotonic"):
21 $increasing ?(1, "Non-decreasing"):
22 $decreasing ?(1, "Non-increasing"):
23 (1, "Constant");
24 say join " ", @orig, "->", $result, $reason;
Example:
./ch-1.pl 1 2 2 3
./ch-1.pl 1 3 2
./ch-1.pl 6 5 5 4
./ch-1.pl 1
./ch-1.pl 1 1 1 1
Results:
1 2 2 3 -> 1 Non-decreasing
1 3 2 -> 0 Non-monotonic
6 5 5 4 -> 1 Non-increasing
1 -> 1 Constant
1 1 1 1 -> 1 Constant
Task 2: Reshape Matrix
Submitted by: Mohammad S Anwar
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
This task becomes trivial if I use the Perl Data Language’s (PDL)
reshape operator. I assume the input is a string representation of
the input array followed by the dimension(s) of the output array. I
have to take care that in PDL the first index corresponds to columns
and, according to the examples, I have to convert 2D 1-row matrices to
1D row vectors. The code fits a oneliner.
Example 1:
perl -MPDL -E '$M=pdl shift; ($r, $c)=@ARGV; $N=$M->nelem==$r*$c?$M->reshape($r==1?$c:($c,$r)):0; say $N
' "[[ 1 2 ] [ 3 4 ]]" 1 4
Results:
[1 2 3 4]
Example 2:
perl -MPDL -E '$M=pdl shift; ($r, $c)=@ARGV; $N=$M->nelem==$r*$c?$M->reshape($r==1?$c:($c,$r)):0; say $N
' "[[ 1 2 3 ], [ 4 5 6 ]]" 3 2
Results:
[
[1 2]
[3 4]
[5 6]
]
Example 3:
perl -MPDL -E '$M=pdl shift; ($r, $c)=@ARGV; $N=$M->nelem==$r*$c?$M->reshape($r==1?$c:($c,$r)):0; say $N
' "[ 1 2 ]" 3 2
Results:
0
The full code is:
1 # Perl weekly challenge 204
2 # Task 2: Reshape Matrix
3 #
4 # See https://wlmb.github.io/2023/02/13/PWC204/#task-2-reshape-matrix
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV==3;
8 Usage: $0 M r c
9 to convert matrix M (a string using PDL's notation)
10 to a matrix with r rows, c columns
11 FIN
12 my $M=pdl shift;
13 my ($rows, $cols)=@ARGV;
14 my $nelem=$M->nelem; # total number of elements
15 my $desired=$rows*$cols;
16 say("$M cannot be reshaped to $rows rows and $cols columns: 0"), exit
17 unless $desired==$nelem;
18 my $N=$M->copy;
19 $N->reshape($cols) if $rows==1; # 1D row vector
20 $N->reshape($cols, $rows) if $rows!=1; #2D matrix
21 say "$M as $rows x $cols matrix becomes $N"
Example:
./ch-2.pl "[[ 1 2 ] [ 3 4 ]]" 1 4
./ch-2.pl "[[ 1 2 3 ], [ 4 5 6 ]]" 3 2
./ch-2.pl "[ 1 2 ]" 3 2
Results:
[
[1 2]
[3 4]
]
as 1 x 4 matrix becomes [1 2 3 4]
[
[1 2 3]
[4 5 6]
]
as 3 x 2 matrix becomes
[
[1 2]
[3 4]
[5 6]
]
[1 2] cannot be reshaped to 3 rows and 2 columns: 0
Written on February 13, 2023