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

4 files changed, 553 insertions, 0 deletions

diff --git a/challenge-180/athanasius/perl/ch-1.pl b/challenge-180/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b5f72f2735
--- /dev/null
+++ b/challenge-180/athanasius/perl/ch-1.pl
@@ -0,0 +1,188 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 180
+=========================
+
+TASK #1
+-------
+*First Unique Character*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string, $s.
+
+Write a script to find out the first unique character in the given string and
+print its index (0-based).
+
+Example 1
+
+  Input: $s = "Perl Weekly Challenge"
+  Output: 0 as 'P' is the first unique character
+
+Example 2
+
+  Input: $s = "Long Live Perl"
+  Output: 1 as 'o' is the first unique character
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+1. "Characters" are LETTERS only; whitespace, punctuation, and digits are
+    ignored.
+2.  Matching of characters (i.e., letters) is case-INsensitive.
+
+Interface
+---------
+1. If no string argument is provided on the command line, a small test suite is
+   run.
+2. If the constant $VERBOSE is set to a true value, a short explanation is
+   appended to the output (as per the Examples).
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 <s>
+  perl $0
+
+    <s>    A non-empty string containing at least one letter\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 180, Task #1: First Unique Character (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        my $s =  $ARGV[ 0 ];
+           $s =~ / [[:alpha:]] /x or error( 'No letters in the input string' );
+
+        solve( $s );
+    }
+    else
+    {
+        error( "Expected 0 or 1 command line arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub solve
+#------------------------------------------------------------------------------
+{
+    my ($s) = @_;
+
+    print qq[Input:  \$s = "$s"\n];
+
+    my $index = find_index( $s );
+
+    if ($VERBOSE)
+    {
+        if (defined $index)
+        {
+            printf qq[Output: %s (as "%s" is the first unique letter)\n],
+                   $index, substr( $s, $index, 1 );
+        }
+        else
+        {
+            print "Output: None (as no letters are unique)\n";
+        }
+    }
+    else
+    {
+        printf "Output: %s\n", defined $index ? $index : 'None';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_index
+#------------------------------------------------------------------------------
+{
+    my ($s) = @_;
+    my  %chars;
+
+    for my $char (split //, $s)
+    {
+        ++$chars{ lc $char } if $char =~ / ^ [[:alpha:]] $ /x;
+    }
+
+    my $index;
+
+    for my $i (0 .. length( $s ) - 1)
+    {
+        my $key = lc substr( $s, $i, 1 );
+
+        if (exists $chars{ $key } && $chars{ $key } == 1)
+        {
+            $index = $i;
+            last;
+        }
+    }
+
+    return $index;
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    my @tests =
+    (
+        [ 'Perl Weekly Challenge',     0 ],
+        [ 'Long Live Perl',            1 ],
+        [ 'AaBbCcDdEeFfGgHhIiJj',  undef ],   # All letters are duplicated
+        [ 'AaBbCcDdEeFfGgHhIiJjK',    20 ],
+        [ ' abB',                      1 ],   # Ignore space because not letter
+    );
+
+    for my $test (@tests)
+    {
+        my $test_name = '"' . $test->[ 0 ] . '"';
+
+        is find_index( $test->[ 0 ] ), $test->[ 1 ], $test_name;
+    }
+
+    done_testing;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-180/athanasius/perl/ch-2.pl b/challenge-180/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b1695a24d5
--- /dev/null
+++ b/challenge-180/athanasius/perl/ch-2.pl
@@ -0,0 +1,114 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 180
+=========================
+
+TASK #2
+-------
+*Trim List*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of numbers, @n and an integer $i.
+
+Write a script to trim the given list where element is less than or equal to
+the given integer.
+
+Example 1
+
+  Input: @n = (1,4,2,3,5) and $i = 3
+  Output: (4,5)
+
+Example 2
+
+  Input: @n = (9,0,6,2,3,8,5) and $i = 4
+  Output: (9,6,8,5)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumption
+----------
+$i must be an integer (as specified), but the elements of @n may be any real
+numbers.
+
+Interface
+---------
+$i is given first on the command line, followed by the elements of @n.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $SEP   => ', ';
+const my $USAGE =>
+qq[Usage:
+  perl $0 <i> [<n> ...]
+
+    <i>          An integer
+   [<n> ...]     One or more real numbers\n];
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 180, Task #2: Trim List (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($i, @n) = parse_command_line();
+
+    printf "Input:  \@n = (%s) and \$i = %d\n", join( $SEP, @n ), $i;
+
+    printf "Output: (%s)\n", join $SEP, grep { $_ > $i } @n;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args  = scalar @ARGV;
+       $args >= 2 or error( "Expected at least 2 arguments, found $args" );
+
+    my ($i, @n) = @ARGV;
+
+        $i =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$i" is not a valid integer] );
+
+    for my $n (@n)
+    {
+        $n =~ / ^ $RE{num}{real} $ /x
+                  or error( qq["$n" is not a valid real number] );
+    }
+
+    return ($i, @n);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-180/athanasius/raku/ch-1.raku b/challenge-180/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..aa58e837c7
--- /dev/null
+++ b/challenge-180/athanasius/raku/ch-1.raku
@@ -0,0 +1,163 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 180
+=========================
+
+TASK #1
+-------
+*First Unique Character*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string, $s.
+
+Write a script to find out the first unique character in the given string and
+print its index (0-based).
+
+Example 1
+
+  Input: $s = "Perl Weekly Challenge"
+  Output: 0 as 'P' is the first unique character
+
+Example 2
+
+  Input: $s = "Long Live Perl"
+  Output: 1 as 'o' is the first unique character
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. "Characters" are LETTERS only; whitespace, punctuation, and digits are
+    ignored.
+2.  Matching of characters (i.e., letters) is case-INsensitive.
+
+Interface
+---------
+1. If no string argument is provided on the command line, a small test suite is
+   run.
+2. If the constant $VERBOSE is set to True, a short explanation is appended to
+   the output (as per the Examples).
+
+Note
+----
+Use of /[<:ASCII> & <.alpha>]/ in place of /<[A..Za..z]>/ is documented here:
+https://www.codesections.com/blog/raku-unicode/
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset TestT of List where (Str, UInt);
+
+my Bool constant $VERBOSE = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 180, Task #1: First Unique Character (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A non-empty string containing at least one letter
+
+    Str:D $s where { / [<:ASCII> & <.alpha>] / }
+)
+#==============================================================================
+{
+    qq[Input:  \$s = "$s"].put;
+
+    my UInt $index = find-index( $s );
+
+    if $VERBOSE
+    {
+        if $index.defined
+        {
+            qq[Output: %s (as "%s" is the first unique character)\n].printf:
+                $index, $s.substr( $index, 1 );
+        }
+        else
+        {
+            'Output: None (as no characters are unique)'.put;
+        }
+    }
+    else
+    {
+        "Output: %s\n".printf: $index.defined ?? $index !! 'None';
+    }
+}
+
+#==============================================================================
+multi sub MAIN()                                                    # Run tests
+#==============================================================================
+{
+    my TestT @tests = [ 'Perl Weekly Challenge',    0 ],
+                      [ 'Long Live Perl',           1 ],
+                      [ 'AaBbCcDdEeFfGgHhIiJj',  UInt ],       # All duplicated
+                      [ 'AaBbCcDdEeFfGgHhIiJjK',   20 ],
+                      [ ' abB',                     1 ];       # Ignore space
+
+    for @tests -> TestT $test
+    {
+        my Str $test-name = '"' ~ $test[ 0 ] ~ '"';
+
+        is find-index( $test[ 0 ] ), $test[ 1 ], $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub find-index( Str:D $s --> UInt )
+#------------------------------------------------------------------------------
+{
+    my UInt %chars;
+
+    for $s.split( '', :skip-empty ) -> Str $char
+    {
+        ++%chars{ $char.lc } if $char ~~ / ^ [<:ASCII> & <.alpha>] $ /;
+    }
+
+    my UInt $index;
+
+    for 0 .. $s.chars - 1 -> UInt $i
+    {
+        my Str $key = $s.substr( $i, 1 ).lc;
+
+        if %chars{ $key }:exists && %chars{ $key } == 1
+        {
+            $index = $i;
+            last;
+        }
+    }
+
+    return $index;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-180/athanasius/raku/ch-2.raku b/challenge-180/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..f9fc823204
--- /dev/null
+++ b/challenge-180/athanasius/raku/ch-2.raku
@@ -0,0 +1,88 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 180
+=========================
+
+TASK #2
+-------
+*Trim List*
+
+Submitted by: Mohammad S Anwar
+
+You are given list of numbers, @n and an integer $i.
+
+Write a script to trim the given list where element is less than or equal to
+the given integer.
+
+Example 1
+
+  Input: @n = (1,4,2,3,5) and $i = 3
+  Output: (4,5)
+
+Example 2
+
+  Input: @n = (9,0,6,2,3,8,5) and $i = 4
+  Output: (9,6,8,5)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumption
+----------
+$i must be an integer (as specified), but the elements of @n may be any real
+numbers.
+
+Interface
+---------
+$i is given first on the command line, followed by the elements of @n.
+Note: If $i is negative, it must be preceded by "--" to prevent it from being
+interpreted as a command-line switch.
+
+=end comment
+#==============================================================================
+
+my Str constant $SEP = ', ';
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 180, Task #2: Trim List (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Int:D $i,              #= An integer (must be preceded by "--" if negative)
+
+    *@n where { .elems > 0 && .all ~~ Real:D }      #= One or more real numbers
+)
+#==============================================================================
+{
+    "Input:  @n = (%s) and \$i = %d\n".printf: @n.join( $SEP ), $i;
+
+    "Output: (%s)\n".printf: @n.grep( { $_ > $i } ).join: $SEP;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################