Perl & Raku solutions to Tasks 1 & 2 for Week 196

2 files changed, 383 insertions, 0 deletions

diff --git a/challenge-196/athanasius/perl/ch-1.pl b/challenge-196/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..ca40db18c7
--- /dev/null
+++ b/challenge-196/athanasius/perl/ch-1.pl
@@ -0,0 +1,188 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 196
+=========================
+
+TASK #1
+-------
+*Pattern 132*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers, @list.
+
+Write a script to find out subsequence that respect Pattern 132. Return empty
+array if none found.
+
+    Pattern 132 in a sequence (a[i], a[j], a[k]) such that i < j < k and a[i] <
+    a[k] < a[j].
+
+Example 1
+
+  Input:  @list = (3, 1, 4, 2)
+  Output: (1, 4, 2) respect the Pattern 132.
+
+Example 2
+
+  Input: @list = (1, 2, 3, 4)
+  Output: () since no susbsequence can be found.
+
+Example 3
+
+  Input: @list = (1, 3, 2, 4, 6, 5)
+  Output: (1, 3, 2) if more than one subsequence found then return the first.
+
+Example 4
+
+  Input: @list = (1, 3, 4, 2)
+  Output: (1, 3, 2)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#==============================================================================
+
+use v5.32;
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FLDS => 3;
+const my $USAGE     =>
+"Usage:
+  perl $0 [<list> ...]
+  perl $0
+
+    [<list> ...]    A list of 3 or more integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 196, Task #1: Pattern 132 (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args <  3)
+    {
+        error( "Expected 0 or 3+ command-line arguments, found $args" );
+    }
+    else
+    {
+        my @list = parse_command_line();
+
+        printf "Input:  \@list = (%s)\n", join ', ',              @list;
+        printf "Output: (%s)\n",          join ', ', pattern_132( @list );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub pattern_132
+#------------------------------------------------------------------------------
+{
+    my @list = @_;
+    my @pattern;
+
+    OUTER:
+    for my $i (0 .. $#list - 2)
+    {
+        for my $j ($i + 1 .. $#list - 1)
+        {
+            next unless $list[ $i ] < $list[ $j ];
+
+            for my $k ($j + 1 .. $#list)
+            {
+                if ($list[ $i ] < $list[ $k ] < $list[ $j ])
+                {
+                    @pattern = @list[ $i, $j, $k ];
+                    last OUTER;
+                }
+            }
+        }
+    }
+
+    return @pattern;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my @list = @ARGV;
+
+    for (@list)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    return @list;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $input, $expected) = split / \| /x, $line, $TEST_FLDS;
+
+        $input    =~ s/ ^ \s* (.+) \s* $ /$1/x;               # Trim whitespace
+        $expected =~ s/ ^ \s* (.+) \s* $ /$1/x;
+
+        my @list = split / \s+ /x, $input;
+        my $got  = join ', ', pattern_132( @list );
+
+        is $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1| 3  1 4 2    | 1, 4, 2
+Example 2| 1  2 3 4    |
+Example 3| 1  3 2 4 6 5| 1, 3, 2
+Example 4| 1  3 4 2    | 1, 3, 2
+Negatives|-1 -2 1 0    |-1, 1, 0
diff --git a/challenge-196/athanasius/perl/ch-2.pl b/challenge-196/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2711dd9289
--- /dev/null
+++ b/challenge-196/athanasius/perl/ch-2.pl
@@ -0,0 +1,195 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 196
+=========================
+
+TASK #2
+-------
+*Range List*
+
+Submitted by: Mohammad S Anwar
+
+You are given a sorted unique integer array, @array.
+
+Write a script to find all possible Number Range i.e [x, y] represent range all integers from x and y (both inclusive).
+
+    Each subsequence of two or more contiguous integers
+
+Example 1
+
+  Input: @array = (1,3,4,5,7)
+  Output: [3,5]
+
+Example 2
+
+  Input: @array = (1,2,3,6,7,9)
+  Output: [1,3], [6,7]
+
+Example 3
+
+  Input: @array = (0,1,2,4,5,6,8,9)
+  Output: [0,2], [4,6], [8,9]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 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 Data::Compare;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FIELDS => 3;
+const my $USAGE       =>
+"Usage:
+  perl $0 [<list> ...]
+  perl $0
+
+    [<list> ...]    A list of 1 or more integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 196, Task #2: Range List (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $array  = parse_command_line();
+
+        printf "Input:  \@array = (%s)\n", join ',', @$array;
+
+        my $ranges = find_ranges( $array );
+
+        printf "Output: %s\n",
+                join ', ', map { '[' . join( ',', @$_ ) . ']' } @$ranges;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_ranges
+#------------------------------------------------------------------------------
+{
+    my ($array) = @_;
+    my (@range, @ranges);
+
+    for my $n (@$array)
+    {
+        if (scalar @range == 0      ||       # Start the first range
+            $n == $range[ -1 ] + 1)          # Extend an existing range
+        {
+            push @range, $n;
+        }
+        else                                 # Start a new range
+        {
+            # First, handle (either keep or discard) the previous range
+
+            push @ranges, [ @range ] if scalar @range > 1;
+
+            @range = $n;
+        }
+    }
+
+    push @ranges, \@range if scalar @range > 1;        # Handle the final range
+
+    @$_ = @$_[ 0, -1 ] for @ranges;    # Remove all middle elements from ranges
+
+    return \@ranges;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my (@array, %integers);
+
+    for my $n (@ARGV)
+    {
+        $n =~ / ^ $RE{num}{int} $ /x
+            or error( qq["$n" is not a valid integer] );
+
+        push @array, $n;
+
+        ++$integers{ $n } == 1
+            or error( 'Elements of the input array are not unique: ' .
+                       qq["$n" appears twice] );
+    }
+
+    my @sorted = sort { $a <=> $b } @array;
+
+    Compare( \@array, \@sorted )
+        or error( 'The input array is not sorted' );
+
+    return \@array;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $input, $expected) =
+            split / \| /x, $line, $TEST_FIELDS;
+
+        $input    =~ s/ ^ \s* (.+) \s* $ /$1/x;               # Trim whitespace
+        $expected =~ s/ ^ \s* (.+) \s* $ /$1/x;
+
+        my @array  = split / \s+ /x, $input;
+        my $ranges = find_ranges( \@array );
+        my $got    = join ', ', map { '[' . join( ',', @$_ ) . ']' } @$ranges;
+
+        is $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1| 1  3  4 5 7      |[3,5]
+Example 2| 1  2  3 6 7 9    |[1,3], [6,7]
+Example 3| 0  1  2 4 5 6 8 9|[0,2], [4,6], [8,9]
+Negatives|-3 -2 -1 1 2 5 6  |[-3,-1], [1,2], [5,6]