Merge pull request #7293 from PerlMonk-Athanasius/branch-for-challenge-196

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

4 files changed, 759 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]
diff --git a/challenge-196/athanasius/raku/ch-1.raku b/challenge-196/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..6861fa85fb
--- /dev/null
+++ b/challenge-196/athanasius/raku/ch-1.raku
@@ -0,0 +1,179 @@
+use v6d;
+
+###############################################################################
+=begin 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)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+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;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 196, Task #1: Pattern 132 (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 3 or more integers
+
+    *@list where { .elems >= 3 && .all ~~ Int:D }
+)
+#==============================================================================
+{
+    "Input:  \@list = (%s)\n".printf:              @list\ .join: ', ';
+
+    "Output: (%s)\n"\        .printf: pattern_132( @list ).join: ', ';
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub pattern_132( List:D[Int:D] $list --> List:D[Int:D] )
+#------------------------------------------------------------------------------
+{
+    my Int @pattern;
+
+    L-OUTER:
+    for 0 .. $list.end - 2 -> UInt $i
+    {
+        for $i + 1 .. $list.end - 1 -> UInt $j
+        {
+            next unless $list[ $i ] < $list[ $j ];
+
+            for $j + 1 .. $list.end -> UInt $k
+            {
+                if $list[ $i ] < $list[ $k ] < $list[ $j ]
+                {
+                    @pattern = $list[ $i, $j, $k ];
+                    last L-OUTER;
+                }
+            }
+        }
+    }
+
+    return @pattern;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) =
+                $line.split: / \| /, $TEST-FIELDS;
+
+        $input    ~~ s/ ^ \s* (.+) \s* $ /$0/;                # Trim whitespace
+        $expected ~~ s/ ^ \s* (.+) \s* $ /$0/;
+
+        my Int @list = $input.split( / \s+ / ).map: { .Int };
+        my Str $got  = pattern_132( @list ).join: ', ';
+
+        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| 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
+        END
+}
+
+###############################################################################
diff --git a/challenge-196/athanasius/raku/ch-2.raku b/challenge-196/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..468f615418
--- /dev/null
+++ b/challenge-196/athanasius/raku/ch-2.raku
@@ -0,0 +1,197 @@
+use v6d;
+
+###############################################################################
+=begin 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]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+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;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 196, Task #2: Range List (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    *@array where array-is-valid( @array )      #= A list of 1 or more integers
+)
+#==============================================================================
+{
+    "Input:  \@array = (%s)\n".printf: @array.join: ',';
+
+    my Array[Int] @ranges = find-ranges( @array );
+
+    "Output: %s\n".printf:
+       find-ranges( @array ).map( { '[' ~ @$_.join( ',' ) ~ ']' } ).join: ', ';
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-ranges( List:D[Int:D] $array --> List:D[List:D[Int:D]] )
+#------------------------------------------------------------------------------
+{
+    my (Array[Int] @ranges, Int @range);
+
+    for @$array -> Int $n
+    {
+        if @range.elems == 0       ||        # Start the first range
+           $n == @range[ *-1 ] + 1           # Extend an existing range
+        {
+            @range.push: $n;
+        }
+        else                                 # Start a new range
+        {
+            # First, handle (either keep or discard) the previous range
+
+            @ranges.push: @range.clone if @range.elems > 1;
+
+            @range = $n;
+        }
+    }
+
+    @ranges.push: @range if @range.elems > 1;          # Handle the final range
+
+    @$_ = $_[ 0, *-1 ] for @ranges;    # Remove all middle elements from ranges
+
+    return @ranges;
+}
+
+#------------------------------------------------------------------------------
+sub array-is-valid( List:D[Int:D] $array --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    return False unless $array.elems >= 1;            # Array must not be empty
+
+    my UInt %integers{Int};
+
+    for @$array -> Int $n              # Test whether array elements are unique
+    {
+        return False if ++%integers{ $n } > 1;
+    }
+
+    my Int @sorted = $array.sort;      # Test whether array elements are sorted
+
+    return @sorted ~~ $array;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) =
+            $line.split: / \| /, $TEST-FIELDS;
+
+        $input    ~~ s/ ^ \s* (.+) \s* $ /$0/;                # Trim whitespace
+        $expected ~~ s/ ^ \s* (.+) \s* $ /$0/;
+
+        my Int        @array  = $input .split( / \s+ /, :skip-empty )
+                                       .map: { .Int };
+        my Array[Int] @ranges = find-ranges( @array );
+        my Str        $got    = @ranges.map( { '[' ~ join( ',', @$_ ) ~ ']' } )
+                                       .join: ', ';
+
+        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  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]
+        END
+}
+
+###############################################################################