Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #131

4 files changed, 531 insertions, 0 deletions

diff --git a/challenge-131/athanasius/perl/ch-1.pl b/challenge-131/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..1980961f9f
--- /dev/null
+++ b/challenge-131/athanasius/perl/ch-1.pl
@@ -0,0 +1,146 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 131
+=========================
+
+TASK #1
+-------
+*Consecutive Arrays*
+
+Submitted by: Mark Anderson
+
+You are given a sorted list of unique positive integers.
+
+Write a script to return list of arrays where the arrays are consecutive
+integers.
+
+Example 1:
+
+ Input:  (1, 2, 3, 6, 7, 8, 9)
+ Output: ([1, 2, 3], [6, 7, 8, 9])
+
+Example 2:
+
+ Input:  (11, 12, 14, 17, 18, 19)
+ Output: ([11, 12], [14], [17, 18, 19])
+
+Example 3:
+
+ Input:  (2, 4, 6, 8)
+ Output: ([2], [4], [6], [8])
+
+Example 4:
+
+ Input:  (1, 2, 3, 4, 5)
+ Output: ([1, 2, 3, 4, 5])
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Note
+----
+The input must be a list of unsigned integers. Any duplicates will be silently
+removed, and the list will be sorted in increasing numerical order, before it
+is processed.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util     qw( uniqint );
+use Regexp::Common qw( number  );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<list> ...]
+
+    [<list> ...]    A list of unsigned integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 131, Task #1: Consecutive Arrays (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @list   = parse_command_line();
+    my @sorted = sort { $a <=> $b } uniqint @list;
+
+    printf "Input:  (%s)\n", join ', ', @sorted;
+
+    my @consec = get_consecutive_arrays( @sorted );
+
+    printf "Output: (%s)\n",
+        join ', ', map { '[' . join( ', ', @$_ ) . ']' } @consec;
+}
+
+#------------------------------------------------------------------------------
+sub get_consecutive_arrays
+#------------------------------------------------------------------------------
+{
+    my  @sorted = @_;
+    my (@consec, @range, $last);
+
+    for my $value (@sorted)
+    {
+        if (!defined( $last ) || $last == $value - 1)
+        {
+            push @range, $value;
+        }
+        else
+        {
+            push @consec, [ @range ];        # Save a copy of the current range
+            @range = $value;                 # Begin the next range
+        }
+
+        $last = $value;
+    }
+
+    push @consec, \@range;
+
+    return @consec;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x
+            or error( qq["$_" is not a valid integer] );
+
+        $_ >= 0
+            or error( qq["$_" is not a positive integer] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "\nERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-131/athanasius/perl/ch-2.pl b/challenge-131/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..62ff4ef73d
--- /dev/null
+++ b/challenge-131/athanasius/perl/ch-2.pl
@@ -0,0 +1,142 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 131
+=========================
+
+TASK #2
+-------
+*Find Pairs*
+
+Submitted by: Yary
+
+You are given a string of delimiter pairs and a string to search.
+
+Write a script to return two strings, the first with any characters matching
+the "opening character" set, the second with any matching the "closing char-
+acter" set.
+
+Example 1:
+
+ Input:
+    Delimiter pairs: ""[]()
+    Search String: "I like (parens) and the Apple ][+" they said.
+
+ Output:
+    "(["
+    ")]"
+
+Example 2:
+
+ Input:
+    Delimiter pairs: **//<>
+    Search String: /* This is a comment (in some languages) */ <could be a tag>
+
+ Output:
+    /**/<
+    /**/>
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Discussion
+----------
+A symbol should be identified as a "delimiter" if and only if it is correctly
+paired with its complement; and delimiters should also be properly nested to be
+recognised as such. However, the Task requirements -- in particular Example 1
+-- clearly specify that symbols are to be recognised as delimiters regardless
+of appropriate pairing. (In Example 1, the substring "Apple ][+" contains a
+closing delimiter *followed by* its opening complement.) Since this is the Task
+as given, it is what has been implemented in the solution below.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <delims> <search>
+
+    <delims>    A string of delimiter pairs
+    <search>    A string to search\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 131, Task #2: Find Pairs (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($delims, $search) = parse_command_line();
+
+    print "Input:\n";
+    print "    Delimiter pairs: $delims\n";
+    print "    Search string:   $search\n\n";
+
+    my (%open_chars, %clse_chars);
+    my  $i = 0;
+
+    for my $delim (split '', $delims)
+    {
+        (++$i % 2 == 1) ? ++$open_chars{ $delim }
+                        : ++$clse_chars{ $delim };
+    }
+
+    my $open_str = '';
+    my $clse_str = '';
+
+    for my $char (split '', $search)
+    {
+        $open_str .= $char if exists $open_chars{ $char };
+        $clse_str .= $char if exists $clse_chars{ $char };
+    }
+
+    print "Output:\n";
+    print "    $open_str\n";
+    print "    $clse_str\n";
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 2
+            or error( "Expected 2 command line arguments, found $args" );
+
+    my ($delims, $search) = @ARGV;
+
+    length( $delims ) % 2 == 0
+            or error( "The delimiter string $delims contains an odd number " .
+                       'of characters' );
+
+    return ($delims, $search);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-131/athanasius/raku/ch-1.raku b/challenge-131/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..fafa48f13b
--- /dev/null
+++ b/challenge-131/athanasius/raku/ch-1.raku
@@ -0,0 +1,126 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 131
+=========================
+
+TASK #1
+-------
+*Consecutive Arrays*
+
+Submitted by: Mark Anderson
+
+You are given a sorted list of unique positive integers.
+
+Write a script to return list of arrays where the arrays are consecutive
+integers.
+
+Example 1:
+
+ Input:  (1, 2, 3, 6, 7, 8, 9)
+ Output: ([1, 2, 3], [6, 7, 8, 9])
+
+Example 2:
+
+ Input:  (11, 12, 14, 17, 18, 19)
+ Output: ([11, 12], [14], [17, 18, 19])
+
+Example 3:
+
+ Input:  (2, 4, 6, 8)
+ Output: ([2], [4], [6], [8])
+
+Example 4:
+
+ Input:  (1, 2, 3, 4, 5)
+ Output: ([1, 2, 3, 4, 5])
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+The input must be a list of unsigned integers. Any duplicates will be silently
+removed, and the list will be sorted in increasing numerical order, before it
+is processed.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 131, Task #1: Consecutive Arrays (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    *@list where { .all ~~ UInt:D }              #= A list of unsigned integers
+)
+#==============================================================================
+{
+    my UInt @sorted = @list.unique.sort;
+
+    "Input:  (%s)\n".printf: @sorted.join: ', ';
+
+    my Array[UInt] @consec = get-consecutive-arrays( @sorted );
+
+    "Output: (%s)\n".printf:
+        @consec.map( { '[' ~ .join( ', ' ) ~ ']' } ).join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub get-consecutive-arrays
+(
+    Array:D[UInt:D] $sorted
+--> Array:D[Array:D[UInt:D]]
+)
+#------------------------------------------------------------------------------
+{
+    my Array[UInt] @consec = Array[Array[UInt]].new;
+    my UInt        @range;
+    my UInt        $last;
+
+    for @$sorted -> UInt $value
+    {
+        if !$last.defined || $last == $value - 1
+        {
+            @range.push: $value;
+        }
+        else
+        {
+            @consec.push: @range.clone;      # Save a copy of the current range
+            @range = $value;                 # Begin the next range
+        }
+
+        $last = $value;
+    }
+
+    @consec.push: @range;
+
+    return @consec;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-131/athanasius/raku/ch-2.raku b/challenge-131/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..cd9e938064
--- /dev/null
+++ b/challenge-131/athanasius/raku/ch-2.raku
@@ -0,0 +1,117 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 131
+=========================
+
+TASK #2
+-------
+*Find Pairs*
+
+Submitted by: Yary
+
+You are given a string of delimiter pairs and a string to search.
+
+Write a script to return two strings, the first with any characters matching
+the "opening character" set, the second with any matching the "closing char-
+acter" set.
+
+Example 1:
+
+ Input:
+    Delimiter pairs: ""[]()
+    Search String: "I like (parens) and the Apple ][+" they said.
+
+ Output:
+    "(["
+    ")]"
+
+Example 2:
+
+ Input:
+    Delimiter pairs: **//<>
+    Search String: /* This is a comment (in some languages) */ <could be a tag>
+
+ Output:
+    /**/<
+    /**/>
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Discussion
+----------
+A symbol should be identified as a "delimiter" if and only if it is correctly
+paired with its complement; and delimiters should also be properly nested to be
+recognised as such. However, the Task requirements -- in particular Example 1
+-- clearly specify that symbols are to be recognised as delimiters regardless
+of appropriate pairing. (In Example 1, the substring "Apple ][+" contains a
+closing delimiter *followed by* its opening complement.) Since this is the Task
+as given, it is what has been implemented in the solution below.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 131, Task #2: Find Pairs (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $delims where { .chars % 2 == 0 },     #= A string of delimiter pairs
+    Str:D $search                                #= A string to search
+)
+#==============================================================================
+{
+    'Input:'.put;
+    "    Delimiter pairs: $delims".put;
+    "    Search string:   $search\n".put;
+
+    my Str (@open-chars, @clse-chars);
+    my UInt $i = 0;
+
+    for $delims.split: '', :skip-empty -> Str $delim
+    {
+        ( ++$i % 2 == 1 ?? @open-chars !! @clse-chars ).push: $delim;
+    }
+
+    my Set[Str] $open-set = Set[Str].new: @open-chars;
+    my Set[Str] $clse-set = Set[Str].new: @clse-chars;
+    my Str      $open-str = '';
+    my Str      $clse-str = '';
+
+    for $search.split: '', :skip-empty -> Str $char
+    {
+        $open-str ~= $char if $char ∈ $open-set;
+        $clse-str ~= $char if $char ∈ $clse-set;
+    }
+
+    'Output:'.put;
+    "    $open-str".put;
+    "    $clse-str".put;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################