aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-204/athanasius/perl/ch-1.pl164
-rw-r--r--challenge-204/athanasius/perl/ch-2.pl339
-rw-r--r--challenge-204/athanasius/raku/ch-1.raku168
-rw-r--r--challenge-204/athanasius/raku/ch-2.raku346
4 files changed, 1017 insertions, 0 deletions
diff --git a/challenge-204/athanasius/perl/ch-1.pl b/challenge-204/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..fd45b51e54
--- /dev/null
+++ b/challenge-204/athanasius/perl/ch-1.pl
@@ -0,0 +1,164 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl 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
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+use enum qw( Flat Up Down );
+
+const my $USAGE =>
+"Usage:
+ perl $0 [<nums> ...]
+ perl $0
+
+ [<nums> ...] A list of 1 or more integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 204, Task #1: Monotonic Array (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+ if (scalar @ARGV == 0)
+ {
+ run_tests();
+ }
+ else
+ {
+ my @nums = @ARGV;
+
+ / ^ $RE{num}{int} $ /x
+ or die qq[ERROR: "$_" is not a valid integer\n$USAGE]
+ for @nums;
+
+ printf "Input: \@array = (%s)\n", join ',', @nums;
+
+ printf "Output: %d\n", is_monotonic( \@nums );
+ }
+}
+
+#------------------------------------------------------------------------------
+sub is_monotonic
+#------------------------------------------------------------------------------
+{
+ my ($nums) = @_;
+ my $dir = Flat;
+ my $last = $nums->[ 0 ];
+
+ for my $i (1 .. $#$nums)
+ {
+ my $next = $nums->[ $i ];
+
+ if ($next > $last)
+ {
+ return 0 if $dir == Down;
+
+ $dir = Up;
+ }
+ elsif ($next < $last)
+ {
+ return 0 if $dir == Up;
+
+ $dir = Down;
+ }
+
+ $last = $next;
+ }
+
+ return 1;
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ my ($test_name, $input, $expected) = split / \| /x, $line;
+
+ my @nums = split / , \s* /x, $input;
+ my $got = is_monotonic( \@nums );
+
+ is $got, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1 | 1, 2, 2, 3 |1
+Example 2 | 1, 3, 2 |0
+Example 3 | 6, 5, 5, 4 |1
+Flat | 4, 4, 4, 4 |1
+Negatives 1|-1,-1,-2,-2,-4,-5 |1
+Negatives 2|-1,-1,-2,-2,-4,-3 |0
+Single |42 |1
+Mixed 1 |-5,-2, 0, 0, 1, 3,5,5|1
+Mixed 2 |-5,-2,-3,-1, 0, 4,6 |0
diff --git a/challenge-204/athanasius/perl/ch-2.pl b/challenge-204/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..9ae5dbb72b
--- /dev/null
+++ b/challenge-204/athanasius/perl/ch-2.pl
@@ -0,0 +1,339 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 204
+=========================
+
+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
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to a true value, and the solution matrix has more than
+ one row, then the reshaped matrix is displayed again in two dimensions.
+3. Elements in the original matrix are treated as strings, which may contain
+ any non-whitespace characters other than "]".
+4. The input matrix has the form "[ [ elem_1, elem_2, ... ], [ ... ], ... ]".
+ Each row must be enclosed in square brackets. A separator (comma followed by
+ optional whitespace) is optional between rows. Within a row, elements must
+ be separated by either whitespace or commas (and commas may optionally be
+ followed by whitespace). The sequence of rows must itself be enclosed in
+ square brackets.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE =>
+qq{Usage:
+ perl $0 <matrix> <r> <c>
+ perl $0
+
+ <matrix> Matrix represented as a string: "[ [ 1, 2 ], [ 3, 4 ] ]"
+ <r> Number of rows required in the reshaped matrix
+ <c> Number of columns required in the reshaped matrix\n};
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 204, Task #2: Reshape Matrix (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+ if (scalar @ARGV == 0)
+ {
+ run_tests();
+ }
+ else
+ {
+ my ($matrix, $r, $c) = parse_command_line();
+ my @matrix = parse_matrix_string( $matrix );
+
+ printf "Input: \$matrix = %s\n", format_matrix_1D( \@matrix );
+ print " \$r = $r\n";
+ print " \$c = $c\n";
+
+ my $new_matrix = reshape_matrix( \@matrix, $r, $c );
+
+ printf "\nOutput: %s\n", scalar( @$new_matrix ) > 0 ?
+ format_matrix_1D( $new_matrix ) : '0';
+
+ if ($VERBOSE && scalar( @$new_matrix ) > 1)
+ {
+ printf "\n%s", format_matrix_2D( $new_matrix, 8 );
+ }
+ }
+}
+
+#------------------------------------------------------------------------------
+sub reshape_matrix
+#------------------------------------------------------------------------------
+{
+ my ($matrix, $r, $c) = @_;
+ my $orig_size = scalar @$matrix * scalar @{ $matrix->[ 0 ] };
+ my @new_matrix;
+
+ if ($r * $c == $orig_size)
+ {
+ my @list;
+ push @list, @$_ for @$matrix;
+
+ while (@list)
+ {
+ my @row;
+ push @row, shift @list for 1 .. $c;
+ push @new_matrix, [ @row ];
+ }
+ }
+
+ return \@new_matrix;
+}
+
+#------------------------------------------------------------------------------
+sub format_matrix_1D
+#------------------------------------------------------------------------------
+{
+ my ($matrix) = @_;
+ my $string = '[ ';
+ my $first = 1;
+
+ for my $row (@$matrix)
+ {
+ if ($first)
+ {
+ $first = 0;
+ }
+ else
+ {
+ $string .= ', ';
+ }
+
+ $string .= '[ ' . join( ', ', @$row ) . ' ]';
+ }
+
+ $string .= ' ]';
+
+ return $string;
+}
+
+#------------------------------------------------------------------------------
+sub format_matrix_2D
+#------------------------------------------------------------------------------
+{
+ my ($matrix, $offset) = @_;
+
+ my $rows = scalar @$matrix;
+ my $columns = scalar @{ $matrix->[ 0 ] };
+ my @col_width = (0) x $columns;
+
+ for my $i (0 .. $rows - 1)
+ {
+ for my $j (0 .. $columns - 1)
+ {
+ my $width = length $matrix->[ $i ][ $j ];
+
+ if ($width > $col_width[ $j ])
+ {
+ $col_width[ $j ] = $width;
+ }
+ }
+ }
+
+ my $string;
+
+ for my $i (0 .. $rows - 1)
+ {
+ $string .= ' ' x $offset . '[';
+ my $row = $matrix->[ $i ];
+
+ for my $j (0 .. $columns - 1)
+ {
+ $string .= sprintf ' %*s', $col_width[ $j ], $row->[ $j ];
+ }
+
+ $string .= " ]\n";
+ }
+
+ return $string;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+ my $args = scalar @ARGV;
+ $args == 3 or error( "Expected 3 command-line arguments, found $args" );
+
+ my ($matrix, $r, $c) = @ARGV;
+
+ $r =~ / ^ $RE{num}{int} $ /x && $r > 0
+ or error( qq["$r" is not a valid row number] );
+
+ $c =~ / ^ $RE{num}{int} $ /x && $c > 0
+ or error( qq["$c" is not a valid column number] );
+
+ return ($matrix, $r, $c);
+}
+
+#------------------------------------------------------------------------------
+sub parse_matrix_string
+#------------------------------------------------------------------------------
+{
+ my ($matrix) = @_;
+
+ $matrix =~ / ^ \s* \[ \s* (.+?) \s* \] \s* $ /x
+ or error( 'Malformed matrix string' );
+
+ $matrix = $1;
+ my $cols = -1;
+ my @matrix;
+
+ while ($matrix =~ / \G \,? \s* \[ \s* ([^\]]+?) \s* \] /cgx)
+ {
+ my @row = split / (?:,\s*|\s+) /x, $1;
+ my $elems = scalar @row;
+
+ if ($elems == 0)
+ {
+ error( 'Invalid matrix: empty row' );
+ }
+ elsif ($cols < 0)
+ {
+ $cols = $elems;
+ }
+ elsif ($elems != $cols)
+ {
+ error( 'Malformed matrix: ragged rows' );
+ }
+
+ push @matrix, [ @row ];
+ }
+
+ my ($rest) = $matrix =~ / \G (.*) $ /x;
+ $rest =~ / ^ \s* $ /x or error( qq[Malformed matrix string "$rest"] );
+
+ scalar @matrix > 0 or error( 'Empty matrix' );
+
+ return @matrix;
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ if ($line =~ / \\ $ /x)
+ {
+ my $next = <DATA>;
+ chomp $next;
+ chop $line;
+
+ $line .= $next;
+ }
+
+ my ($test_name, $matrix, $r, $c, $expected) = split / \| /x, $line;
+
+ my @old = parse_matrix_string( $matrix );
+ my $new = reshape_matrix( \@old, $r, $c );
+ my $got = scalar( @$new ) > 0 ? format_matrix_1D( $new ) : 0;
+
+ is $got, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
+
+__DATA__
+Example 1|[ [ 1, 2 ], [ 3, 4 ] ] |1|4|[ [ 1, 2, 3, 4 ] ]
+Example 2|[ [ 1, 2, 3 ], [ 4, 5, 6 ] ] |3|2|[ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ]
+Example 3|[ [ 1, 2 ] ] |3|2|0
+Letters 1|[[a,b,c][d,e,f][g,h,i][j,k,l]]|3|4|[ [ a, b, c, d ], [ e, f, g, h ],\
+ [ i, j, k, l ] ]
+Letters 2|[[a,b,c][d,e,f][g,h,i][j,k,l]]|6|2|[ [ a, b ], [ c, d ], [ e, f ],\
+ [ g, h ], [ i, j ], [ k, l ] ]
+Letters 3|[[a,b,c][d,e,f][g,h,i][j,k,l]]|2|6|[ [ a, b, c, d, e, f ],\
+ [ g, h, i, j, k, l ] ]
diff --git a/challenge-204/athanasius/raku/ch-1.raku b/challenge-204/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..6258333ebb
--- /dev/null
+++ b/challenge-204/athanasius/raku/ch-1.raku
@@ -0,0 +1,168 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl 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
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first argument is negative, it must be preceded by "--" to distin-
+ guish it from a command-line flag.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+ "\nChallenge 204, Task #1: Monotonic Array (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+ #| A list of 1 or more integers
+
+ *@nums where { .elems >= 1 && .all ~~ Int:D }
+)
+#==============================================================================
+{
+ "Input: \@nums = (%s)\n".printf: @nums.join: ',';
+
+ "Output: %d\n".printf: is-monotonic( @nums ) ?? 1 !! 0;
+}
+
+#==============================================================================
+multi sub MAIN() # No input: run the test suite
+#==============================================================================
+{
+ run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub is-monotonic( List:D[Int:D] $nums --> Bool:D )
+#------------------------------------------------------------------------------
+{
+ enum Dir < Flat Up Down >;
+
+ my Dir $dir = Flat;
+ my Int $last = $nums[ 0 ];
+
+ for 1 .. $nums.end -> UInt $i
+ {
+ my Int $next = $nums[ $i ];
+
+ if $next > $last
+ {
+ return False if $dir == Down;
+
+ $dir = Up;
+ }
+ elsif $next < $last
+ {
+ return False if $dir == Up;
+
+ $dir = Down;
+ }
+
+ $last = $next;
+ }
+
+ return True;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ for test-data.lines -> Str $line
+ {
+ my Str ($test-name, $input, $expected) = $line.split: / \| /;
+
+ my Int @nums = $input.split( / \, \s* / ).map: { .Int };
+ my UInt $got = is-monotonic( @nums ) ?? 1 !! 0;
+
+ is $got, $expected.Int, $test-name;
+ }
+
+ done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+ my Str $usage = $*USAGE;
+
+ $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+ $usage.put;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+ return q:to/END/;
+ Example 1 | 1, 2, 2, 3 |1
+ Example 2 | 1, 3, 2 |0
+ Example 3 | 6, 5, 5, 4 |1
+ Flat | 4, 4, 4, 4 |1
+ Negatives 1|-1,-1,-2,-2,-4,-5 |1
+ Negatives 2|-1,-1,-2,-2,-4,-3 |0
+ Single |42 |1
+ Mixed 1 |-5,-2, 0, 0, 1, 3,5,5|1
+ Mixed 2 |-5,-2,-3,-1, 0, 4,6 |0
+ END
+}
+
+###############################################################################
diff --git a/challenge-204/athanasius/raku/ch-2.raku b/challenge-204/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..e4b9bfad7c
--- /dev/null
+++ b/challenge-204/athanasius/raku/ch-2.raku
@@ -0,0 +1,346 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 204
+=========================
+
+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
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to True, and the solution matrix has more than one row,
+ then the reshaped matrix is displayed again in two dimensions.
+3. Elements in the original matrix are treated as strings, which may contain
+ any non-whitespace characters other than "]".
+4. The input matrix has the form "[ [ elem_1, elem_2, ... ], [ ... ], ... ]".
+ Each row must be enclosed in square brackets. A separator (comma followed by
+ optional whitespace) is optional between rows. Within a row, elements must
+ be separated by either whitespace or commas (and commas may optionally be
+ followed by whitespace). The sequence of rows must itself be enclosed in
+ square brackets.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+my Bool constant $VERBOSE = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+ "\nChallenge 204, Task #2: Reshape Matrix (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+ Str:D $matrix, #= Matrix represented as a string: "[ [ 1, 2 ], [ 3, 4 ] ]"
+ Pos:D $r, #= Number of rows required in the reshaped matrix
+ Pos:D $c #= Number of columns required in the reshaped matrix
+)
+#==============================================================================
+{
+ my Array[Str] @matrix = parse-matrix-string( $matrix );
+
+ "Input: \$matrix = %s\n".printf: format-matrix_1D( @matrix );
+ " \$r = $r".put;
+ " \$c = $c".put;
+
+ my Array[Str] @new-matrix = reshape-matrix( @matrix, $r, $c );
+
+ "\nOutput: %s\n".printf: @new-matrix.elems > 0 ??
+ format-matrix_1D( @new-matrix ) !! '0';
+
+ if $VERBOSE && @new-matrix.elems > 1
+ {
+ "\n%s".printf: format-matrix_2D( @new-matrix, 8 );
+ }
+}
+
+#==============================================================================
+multi sub MAIN() # No input: run the test suite
+#==============================================================================
+{
+ run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub reshape-matrix
+(
+ List:D[List:D[Str:D]] $matrix,
+ Pos:D $r,
+ Pos:D $c
+--> List:D[List:D[Str:D]]
+)
+#------------------------------------------------------------------------------
+{
+ my Pos $orig-size = $matrix.elems * $matrix[ 0 ].elems;
+ my Array[Str] @new-matrix;
+
+ if $r * $c == $orig-size
+ {
+ my Str @list;
+
+ @list.push: |$_ for @$matrix;
+
+ while @list
+ {
+ my Str @row;
+
+ @row\ .push: @list.shift for 1 .. $c;
+ @new-matrix.push: @row;
+ }
+ }
+
+ return @new-matrix;
+}
+
+#------------------------------------------------------------------------------
+sub format-matrix_1D( List:D[List:D[Str:D]] $matrix --> Str:D )
+#------------------------------------------------------------------------------
+{
+ my Str $string = '[ ';
+ my Bool $first = True;
+
+ for @$matrix -> Array[Str] $row
+ {
+ if $first
+ {
+ $first = False;
+ }
+ else
+ {
+ $string ~= ', ';
+ }
+
+ $string ~= '[ ' ~ $row.join( ', ' ) ~ ' ]';
+ }
+
+ $string ~= ' ]';
+
+ return $string;
+}
+
+#------------------------------------------------------------------------------
+sub format-matrix_2D( List:D[List:D[Str:D]] $matrix, UInt:D $offset --> Str:D )
+#------------------------------------------------------------------------------
+{
+ my Pos $rows = $matrix.elems;
+ my Pos $columns = $matrix[ 0 ].elems;
+ my UInt @col-width = 0 xx $columns;
+
+ for 0 .. $rows - 1 -> UInt $i
+ {
+ for 0 .. $columns - 1 -> UInt $j
+ {
+ my Pos $width = $matrix[ $i; $j ].chars;
+
+ @col-width[ $j ] = $width if $width > @col-width[ $j ];
+ }
+ }
+
+ my Str $string;
+
+ for 0 .. $rows - 1 -> UInt $i
+ {
+ $string ~= ' ' x $offset ~ '[';
+
+ my Str @row = |$matrix[ $i ];
+
+ for 0 .. $columns - 1 -> UInt $j
+ {
+ $string ~= ' %*s'.sprintf: @col-width[ $j ], @row[ $j ];
+ }
+
+ $string ~= " ]\n";
+ }
+
+ return $string;
+}
+
+#------------------------------------------------------------------------------
+sub parse-matrix-string( Str:D $matrix --> List:D[List:D[Str:D]] )
+#------------------------------------------------------------------------------
+{
+ my Str $matrix-str = $matrix;
+
+ $matrix-str ~~ / ^ \s* \[ \s* (.+?) \s* \] \s* $ /
+ or error( 'Malformed matrix string' );
+
+ $matrix-str = ~$0;
+
+ my Int $cols = -1;
+ my Array[Str] @matrix;
+
+ {
+ my Match $/;
+ my UInt $last-pos;
+
+ while $matrix-str ~~ m:c/ \,? \s* \[ \s* ( <-[\]]>+? ) \s* \] /
+ {
+ my Str @row = $0.split: / [\,\s*|\s+] /;
+ my UInt $elems = @row.elems;
+
+ if $elems == 0
+ {
+ error( 'Invalid matrix: empty row' );
+ }
+ elsif $cols < 0
+ {
+ $cols = $elems;
+ }
+ elsif $elems != $cols
+ {
+ error( 'Malformed matrix: ragged rows' );
+ }
+
+ @matrix.push: Array[Str].new: @row;
+ $last-pos = $/.pos;
+ }
+
+ $matrix-str ~~ m:c( $last-pos )/ (.*) $ /;
+
+ my Str $rest = ~$0;
+
+ $rest ~~ / ^ \s* $ / or error( qq[Malformed matrix string "$rest"] );
+ }
+
+ @matrix.elems > 0 or error( 'Empty matrix' );
+
+ return @matrix;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ my Str @lines = test-data.lines;
+
+ while @lines
+ {
+ my Str $line = @lines.shift;
+
+ if $line ~~ / \\ $ /
+ {
+ my Str $next = @lines.shift;
+
+ $line .= chop;
+ $line ~= $next;
+ }
+
+ my Str ($test-name, $matrix, $r, $c, $expected) = $line.split: / \| /;
+
+ my Array[Str] @old = parse-matrix-string( $matrix );
+ my Array[Str] @new = reshape-matrix( @old, $r.Int, $c.Int );
+ my Str $got = @new.elems > 0 ?? format-matrix_1D( @new ) !! '0';
+
+ is $got, $expected, $test-name;
+ }
+
+ done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+ "ERROR: $message".put;
+
+ USAGE();
+
+ exit 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+ my Str $usage = $*USAGE;
+
+ $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+ $usage.put;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+ return q:to/END/;
+ Example 1|[ [ 1, 2 ], [ 3, 4 ] ] |1|4|[ [ 1, 2, 3, 4 ] ]
+ Example 2|[ [ 1, 2, 3 ], [ 4, 5, 6 ] ] |3|2|[ [ 1, 2 ], [ 3, 4 ], \
+ [ 5, 6 ] ]
+ Example 3|[ [ 1, 2 ] ] |3|2|0
+ Letters 1|[[a,b,c][d,e,f][g,h,i][j,k,l]]|3|4|[ [ a, b, c, d ], \
+ [ e, f, g, h ], [ i, j, k, l ] ]
+ Letters 2|[[a,b,c][d,e,f][g,h,i][j,k,l]]|6|2|[ [ a, b ], [ c, d ], \
+ [ e, f ], [ g, h ], [ i, j ], [ k, l ] ]
+ Letters 3|[[a,b,c][d,e,f][g,h,i][j,k,l]]|2|6|[ [ a, b, c, d, e, f ], \
+ [ g, h, i, j, k, l ] ]
+ END
+}
+###############################################################################
generated by cgit (git 2.34.1) at 2026-04-13 20:17:23 +0000