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

4 files changed, 675 insertions, 0 deletions

diff --git a/challenge-184/athanasius/perl/ch-1.pl b/challenge-184/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..0c44cac80c
--- /dev/null
+++ b/challenge-184/athanasius/perl/ch-1.pl
@@ -0,0 +1,177 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 184
+=========================
+
+TASK #1
+-------
+*Sequence Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of strings in the format aa9999 i.e. first 2 characters can
+be anything 'a-z' followed by 4 digits '0-9'.
+
+Write a script to replace the first two characters with sequence starting with
+'00', '01', '02' etc.
+
+Example 1
+
+  Input: @list = ( 'ab1234', 'cd5678', 'ef1342')
+  Output: ('001234', '015678', '021342')
+
+Example 2
+
+  Input: @list = ( 'pq1122', 'rs3334')
+  Output: ('001122', '013334')
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+1. From the wording of the question combined with the two Examples, I assume
+   that sequence numbers are to be assigned in the order in which strings
+   appear in the input list, regardless of the contents of their 2-letter pre-
+   fixes.
+2. If more than 100 strings are given as input, the prefixes simply increment
+   to 3 digits.
+
+Interface
+---------
+If no arguments are given on the command line, the test suite is run.
+
+Implementation
+--------------
+Uses Perl's built-in (postfix) ++ operator: "If ... the variable has been used
+in only string contexts since it was set, and has a value that is not the empty
+string and matches the pattern /^[a-zA-Z]*[0-9]*\z/, the increment is done as a
+string, preserving each character within its range, with carry" [1].
+
+References
+----------
+[1] https://perldoc.perl.org/perlop#Auto-increment-and-Auto-decrement
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<list> ...]
+  perl $0
+
+    [<list> ...]    List of strings, format SSNNNN where S is a-z, N is 0-9\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 184, Task #1: Sequence Number (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @list = parse_command_line();
+
+        printf "Input: \@list = ( %s )\n", format_list(          \@list   );
+        printf "Output:        ( %s )\n",  format_list( replace(  @list ) );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub replace
+#------------------------------------------------------------------------------
+{
+    my @list   =  @_;
+    my $prefix = '00';
+    my @replaced;
+
+    for my $string (@list)
+    {
+        push @replaced, $prefix++ . substr $string, 2, 4;
+    }
+
+    return \@replaced;
+}
+
+#------------------------------------------------------------------------------
+sub format_list
+#------------------------------------------------------------------------------
+{
+    my ($list) = @_;
+
+    return join ', ', map { "'$_'" } @$list;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    for my $item (@ARGV)
+    {
+        $item =~ / ^ [a-z]{2} [0-9]{4} $ /x
+            or error( qq[Invalid string "$item"] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+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 ($name, $in, $exp)  = split / , \s* /x, $line, 3;
+        my  $replaced = replace( split /   \s+ /x, $in );
+
+        is join( ' ', @$replaced ), $exp, $name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1,    ab1234 cd5678 ef1342, 001234 015678 021342
+Example 2,    pq1122 rs3334,        001122 013334
+Same nums,    zz9876 yy9876 xx9876, 009876 019876 029876
+Same letters, aa2468 aa3579 aa1680, 002468 013579 021680
diff --git a/challenge-184/athanasius/perl/ch-2.pl b/challenge-184/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b645412a05
--- /dev/null
+++ b/challenge-184/athanasius/perl/ch-2.pl
@@ -0,0 +1,171 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 184
+=========================
+
+TASK #2
+-------
+*Split Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of strings containing 0-9 and a-z separated by space only.
+
+Write a script to split the data into two arrays, one for integers and one for
+alphabets only.
+
+Example 1
+
+  Input: @list = ( 'a 1 2 b 0', '3 c 4 d')
+  Output: [[1,2,0], [3,4]] and [['a','b'], ['c','d']]
+
+Example 2
+
+  Input: @list = ( '1 2', 'p q r', 's 3', '4 5 t')
+  Output: [[1,2], [3], [4,5]] and [['p','q','r'], ['s'], ['t']]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumption
+----------
+From Example 2 it appears that empty arrays should be omitted from the output.
+
+Implementation
+--------------
+For convenience, identification of valid digit and letter characters is imple-
+mented using the CPAN module Set::Tiny.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Set::Tiny;
+
+const my $VALID_DIGITS  => Set::Tiny->new( '0' .. '9' );
+const my $VALID_LETTERS => Set::Tiny->new( 'a' .. 'z' );
+const my $VALID_CHARS   => $VALID_DIGITS->union( $VALID_LETTERS );
+const my $USAGE         =>
+"Usage:
+  perl $0 [<list> ...]
+
+    [<list> ...]  List of strings: single chars (0-9, a-z), space-separated\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 184, Task #2: Split Array (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @strings = parse_command_line();
+
+    printf "Input: \@list = ( %s )\n", join ', ', map { "'@$_'" } @strings;
+
+    my (@digits, @letters);
+
+    for my $chars (@strings)
+    {
+        my ($digits, $letters) = split_array( $chars );
+
+        push @digits,  $digits  if @$digits;
+        push @letters, $letters if @$letters;
+    }
+
+    printf "Output: [%s] and [%s]\n", fmt_int( \@digits  ),
+                                      fmt_str( \@letters );
+}
+
+#------------------------------------------------------------------------------
+sub split_array
+#------------------------------------------------------------------------------
+{
+    my ($chars) = @_;
+    my (@digits,  @letters);
+
+    for my $char (@$chars)
+    {
+        if (defined $VALID_DIGITS->element( $char ))
+        {
+            push @digits,  $char;
+        }
+        else
+        {
+            push @letters, $char;
+        }
+    }
+
+    return (\@digits, \@letters);
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    scalar @ARGV > 0 or error( 'No command-line arguments found' );
+
+    my @strings;
+
+    for my $string (@ARGV)
+    {
+        my @chars = split /\s+/, $string;
+
+        for my $char (@chars)
+        {
+            defined $VALID_CHARS->element( $char )
+                     or error( qq[Invalid string element "$char"] );
+        }
+
+        push @strings, [ @chars ];
+    }
+
+    return @strings;
+}
+
+#------------------------------------------------------------------------------
+sub fmt_int
+#------------------------------------------------------------------------------
+{
+    my ($list) = @_;
+
+    return join ', ',
+           map { '[' . join( ',',                @$_ ) . ']' } @$list;
+}
+
+#------------------------------------------------------------------------------
+sub fmt_str
+#------------------------------------------------------------------------------
+{
+    my ($list) = @_;
+
+    return join ', ',
+           map { '[' . join( ',', map { "'$_'" } @$_ ) . ']' } @$list;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-184/athanasius/raku/ch-1.raku b/challenge-184/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8dfeec605f
--- /dev/null
+++ b/challenge-184/athanasius/raku/ch-1.raku
@@ -0,0 +1,153 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 184
+=========================
+
+TASK #1
+-------
+*Sequence Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of strings in the format aa9999 i.e. first 2 characters can
+be anything 'a-z' followed by 4 digits '0-9'.
+
+Write a script to replace the first two characters with sequence starting with
+'00', '01', '02' etc.
+
+Example 1
+
+  Input: @list = ( 'ab1234', 'cd5678', 'ef1342')
+  Output: ('001234', '015678', '021342')
+
+Example 2
+
+  Input: @list = ( 'pq1122', 'rs3334')
+  Output: ('001122', '013334')
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. From the wording of the question combined with the two Examples, I assume
+   that sequence numbers are to be assigned in the order in which strings
+   appear in the input list, regardless of the contents of theie 2-letter pre-
+   fixes.
+2. If more than 100 strings are given as input, the prefixes simply increment
+   to 3 digits.
+
+Interface
+---------
+If no arguments are given on the command line, the test suite is run.
+
+Implementation
+--------------
+Uses Raku's built-in (postfix) ++ operator, which "[i]ncrements its argument by
+one and returns the original value." [1] The increment is performed by the
+built-in method succ(), which, given a string, "searches for the last alpha-
+numeric sequence that is not preceded by a dot, and increments it." [2]
+
+References
+----------
+[1] https://docs.raku.org/language/operators#index-entry-postfix_++-++
+[2] https://docs.raku.org/routine/succ
+
+=end comment
+#==============================================================================
+
+use Test;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 184, Task #1: Sequence Number (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| List of strings, format $$#### where $ is a-z, # is 0-9
+
+    *@list where { .all ~~ / ^ <[ a .. z ]> ** 2 <[ 0 .. 9 ]> ** 4 $ / }
+)
+#==============================================================================
+{
+    "Input: @list = ( %s )\n".printf: format-list(          @list   );
+    "Output:        ( %s )\n".printf: format-list( replace( @list ) );
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str  $test             = $line.chomp;
+        my Str ($name, $in, $exp) = $test.split: / \, \s* /, 3, :skip-empty;
+
+        is replace( $in.split( / \s+ / ).list ), $exp, $name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub replace( List:D[Str:D] $list --> List:D[Str:D] )
+#------------------------------------------------------------------------------
+{
+    my Str @replaced;
+    my Str $prefix = '00';
+
+    for @$list -> Str $string
+    {
+        @replaced.push: $prefix++ ~ $string.substr: 2 .. 5;
+    }
+
+    return @replaced;
+}
+
+#------------------------------------------------------------------------------
+sub format-list( List:D[Str:D] $list --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return $list.map( { "'$_'" } ).join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub test-data()
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1,    ab1234 cd5678 ef1342, 001234 015678 021342
+        Example 2,    pq1122 rs3334,        001122 013334
+        Same nums,    zz9876 yy9876 xx9876, 009876 019876 029876
+        Same letters, aa2468 aa3579 aa1680, 002468 013579 021680
+        END
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-184/athanasius/raku/ch-2.raku b/challenge-184/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..5e568d310e
--- /dev/null
+++ b/challenge-184/athanasius/raku/ch-2.raku
@@ -0,0 +1,174 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 184
+=========================
+
+TASK #2
+-------
+*Split Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of strings containing 0-9 and a-z separated by space only.
+
+Write a script to split the data into two arrays, one for integers and one for
+alphabets only.
+
+Example 1
+
+  Input: @list = ( 'a 1 2 b 0', '3 c 4 d')
+  Output: [[1,2,0], [3,4]] and [['a','b'], ['c','d']]
+
+Example 2
+
+  Input: @list = ( '1 2', 'p q r', 's 3', '4 5 t')
+  Output: [[1,2], [3], [4,5]] and [['p','q','r'], ['s'], ['t']]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumption
+----------
+From Example 2 it appears that empty arrays should be omitted from the output.
+
+Implementation
+--------------
+For convenience, identification of valid digit and letter characters is imple-
+mented using Raku's in-built Set class.
+
+=end comment
+#==============================================================================
+
+subset Split of List where (Array[UInt], Array[Str]);
+
+my Set[Str] constant $VALID-DIGITS  = Set[Str].new: '0' .. '9';
+my Set[Str] constant $VALID-LETTERS = Set[Str].new: 'a' .. 'z';
+my Set[Str] constant $VALID-CHARS   = $VALID-DIGITS ∪ $VALID-LETTERS;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 184, Task #2: Split Array (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| List of strings: single chars (0-9, a-z), space-separated
+
+    *@list where { .elems > 0 }
+)
+#==============================================================================
+{
+    my Array[Str] @string-arrays = parse-command-line( @list );
+
+    "Input: @list = ( %s )\n".printf:
+        @string-arrays.map( { "'$_'" } ).join: ', ';
+
+    my Array[UInt] @digits;
+    my Array[Str]  @letters;
+
+    for @string-arrays -> Array[Str] $chars
+    {
+        my (Array[UInt] $digits, Array[Str] $letters) = split-array( $chars );
+
+        @digits\.push: $digits  if $digits;
+        @letters.push: $letters if $letters;
+    }
+
+    "Output: [%s] and [%s]\n".printf: fmt-int( @digits ), fmt-str( @letters );
+}
+
+#------------------------------------------------------------------------------
+sub split-array( Array:D[Str:D] $chars --> Split:D )
+#------------------------------------------------------------------------------
+{
+    my UInt @digits;
+    my Str  @letters;
+
+    for @$chars -> Str $char
+    {
+        if $char ∈ $VALID-DIGITS
+        {
+            @digits\.push: $char.Int;
+        }
+        else
+        {
+            @letters.push: $char;
+        }
+    }
+
+    return @digits, @letters;
+}
+
+#------------------------------------------------------------------------------
+sub parse-command-line( List:D[Str:D] $list --> List:D[List:D[Str:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Str] @strings;
+
+    for @$list -> Str $string
+    {
+        my Str @chars = $string.split: / \s+ /, :skip-empty;
+
+        for @chars -> Str $char
+        {
+            $char ∈ $VALID-CHARS
+               or error( qq[Invalid string element "$char"] );
+        }
+
+        @strings.push: @chars;
+    }
+
+    return @strings;
+}
+
+#------------------------------------------------------------------------------
+sub fmt-int( List:D[UInt:D] $list --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return $list.map( { '[' ~ .join( ',' ) ~ ']' } ).join( ', ' );
+}
+
+#------------------------------------------------------------------------------
+sub fmt-str( List:D[Str:D] $list --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return $list.map( { '[' ~ .map( { "'$_'" } ).join( ',' ) ~ ']' } )\
+                                                .join( ', ' );
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################