Merge pull request #5086 from PerlMonk-Athanasius/branch-for-challenge-135

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

4 files changed, 596 insertions, 0 deletions

diff --git a/challenge-135/athanasius/perl/ch-1.pl b/challenge-135/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f2185caa88
--- /dev/null
+++ b/challenge-135/athanasius/perl/ch-1.pl
@@ -0,0 +1,117 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 135
+=========================
+
+TASK #1
+-------
+*Middle 3-digits*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer.
+
+Write a script find out the middle 3-digits of the given integer, if possible
+otherwise throw sensible error.
+
+Example 1
+
+  Input: $n = 1234567
+  Output: 345
+
+Example 2
+
+  Input: $n = -123
+  Output: 123
+
+Example 3
+
+  Input: $n = 1
+  Output: too short
+
+Example 4
+
+  Input: $n = 10
+  Output: even number of digits
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <n>
+
+    <n>    An integer of d digits where d is odd at least 3\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 135, Task #1: Middle 3-digits (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $n = parse_command_line();
+
+    print "Input:  \$n = $n\n";
+
+    my $digits = length abs $n;
+
+    if    ($digits % 2 == 0)
+    {
+        print "Output: \$n has an even number of digits\n";
+    }
+    elsif ($digits < 3)
+    {
+        print "Output: \$n has too few digits\n";
+    }
+    else   # Valid $n
+    {
+        my @digits  = split '', abs $n;
+        my $mid_idx = (($digits - 1) / 2);
+
+        printf "Output: %s%s%s\n", @digits[ $mid_idx - 1 .. $mid_idx + 1 ];
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1
+            or error( "Expected 1 command line argument, found $args" );
+
+    my $n = $ARGV[ 0 ];
+       $n =~ / ^ $RE{num}{int} $ /x
+            or error( qq["$_" is not a valid integer] );
+
+    return $n;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-135/athanasius/perl/ch-2.pl b/challenge-135/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ea8c9c3679
--- /dev/null
+++ b/challenge-135/athanasius/perl/ch-2.pl
@@ -0,0 +1,205 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 135
+=========================
+
+TASK #2
+-------
+*Validate SEDOL*
+
+Submitted by: Mohammad S Anwar
+
+You are given 7-characters alphanumeric SEDOL.
+
+Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL
+otherwise 0.
+
+For more information about SEDOL, please checkout the
+[ https://en.wikipedia.org/wiki/SEDOL |wikipedia] page.
+
+Example 1
+
+  Input: $SEDOL = '2936921'
+  Output: 1
+
+Example 2
+
+  Input: $SEDOL = '1234567'
+  Output: 0
+
+Example 3
+
+  Input: $SEDOL = 'B0YBKL9'
+  Output: 1
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+no  Carp::Assert;
+use Const::Fast;
+use Getopt::Long;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [--verbose|-v] <SEDOL>
+
+    <SEDOL>        7-character alphanumeric SEDOL string
+    --v[erbose]    Print annotated output?\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 135, Task #2: Validate SEDOL (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($SEDOL, $verbose) = parse_command_line();
+
+    print "Input:  \$SEDOL = '$SEDOL'\n";
+
+    my $valid   =  0;
+    my $message = '';
+
+    if ((my $length = length $SEDOL) == 7)
+    {
+        my $code = substr $SEDOL, 0, 6;
+
+        ($valid, $message) = validate_code( $code );
+
+        if ($valid)
+        {
+            my $check = substr $SEDOL, 6, 1;
+
+            ($valid, $message) = validate_check_digit( $code, $check );
+        }
+    }
+    else
+    {
+        $message = "Invalid number of characters: found $length, must be 7", 
+    }
+
+    printf "Output: %d%s\n", $valid ? 1 : 0, $verbose ? " ($message)" : '';
+}
+
+#------------------------------------------------------------------------------
+sub validate_code
+#------------------------------------------------------------------------------
+{
+    my ($code) = @_;
+
+    assert( length $code == 6 ) if DEBUG;
+
+    my $valid   = 1;
+    my $message = '';
+
+    for my $i (0 .. 5)
+    {
+        my $char = substr $code, $i, 1;
+
+        if ($char !~ /[0-9B-DF-HJ-NP-TV-Z]/)
+        {
+            $valid   = 0;
+            $message = "Invalid code character '$char'";
+            last;
+        }
+    }
+
+    return ($valid, $message);
+}
+
+#------------------------------------------------------------------------------
+sub validate_check_digit
+#------------------------------------------------------------------------------
+{
+    my ($code, $check) = @_;
+
+    assert( length $code  == 6 ) if DEBUG;
+    assert( length $check == 1 ) if DEBUG;
+
+    my $valid   =  0;
+    my $message = '';
+
+    if ($check =~ /[0-9]/)
+    {
+        my $check_digit = get_check_digit( $code );
+
+        if ($check == $check_digit)
+        {
+            $valid   = 1;
+            $message = 'The check digit is correct';
+        }
+        else
+        {
+            $message = "Incorrect check digit: found '$check', should be " .
+                       "'$check_digit'";
+        }
+    }
+    else
+    {
+        $message = "Invalid check digit '$check'";
+    }
+
+    return ($valid, $message);
+}
+
+#------------------------------------------------------------------------------
+sub get_check_digit
+#------------------------------------------------------------------------------
+{
+    my ($code) = @_;
+
+    assert( length $code == 6 ) if DEBUG;
+
+    my @weighting    = (1, 3, 1, 7, 3, 9, 1);
+    my $weighted_sum =  0;
+
+    for my $i (0 .. 5)
+    {
+        my $char  = substr $code, $i, 1;
+        my $value = $char =~ /[0-9]/ ? $char : 10 + ord( $char ) - ord( 'A' );
+
+        $weighted_sum += $value * $weighting[ $i ];
+    }
+
+    return (10 - ($weighted_sum % 10)) % 10;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions( verbose => \$verbose )
+                  or error( 'Invalid command line flag' );
+
+    my $args = scalar @ARGV;
+       $args == 1 or error( 'Invalid number of command line arguments' );
+
+    return ($ARGV[ 0 ], $verbose);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-135/athanasius/raku/ch-1.raku b/challenge-135/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..bd8ade5eda
--- /dev/null
+++ b/challenge-135/athanasius/raku/ch-1.raku
@@ -0,0 +1,93 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 135
+=========================
+
+TASK #1
+-------
+*Middle 3-digits*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer.
+
+Write a script find out the middle 3-digits of the given integer, if possible
+otherwise throw sensible error.
+
+Example 1
+
+  Input: $n = 1234567
+  Output: 345
+
+Example 2
+
+  Input: $n = -123
+  Output: 123
+
+Example 3
+
+  Input: $n = 1
+  Output: too short
+
+Example 4
+
+  Input: $n = 10
+  Output: even number of digits
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 135, Task #1: Middle 3-digits (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Int:D $n                #= An integer of d digits where d is odd at least 3
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    my UInt $digits = $n.abs.chars;
+
+    if    $digits % 2 == 0
+    {
+        "Output: \$n has an even number of digits".put;
+    }
+    elsif $digits < 3
+    {
+        "Output: \$n has too few digits".put;
+    }
+    else  # Valid $n
+    {
+        my UInt @digits  = $n.abs.split( '', :skip-empty ).map: { .Int };
+        my UInt $mid-idx = (($digits - 1) / 2).Int;
+
+        "Output: %d%d%d\n".printf: @digits[ $mid-idx - 1 .. $mid-idx + 1 ];
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-135/athanasius/raku/ch-2.raku b/challenge-135/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c1c0358a9a
--- /dev/null
+++ b/challenge-135/athanasius/raku/ch-2.raku
@@ -0,0 +1,181 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 135
+=========================
+
+TASK #2
+-------
+*Validate SEDOL*
+
+Submitted by: Mohammad S Anwar
+
+You are given 7-characters alphanumeric SEDOL.
+
+Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL
+otherwise 0.
+
+For more information about SEDOL, please checkout the
+[ https://en.wikipedia.org/wiki/SEDOL |wikipedia] page.
+
+Example 1
+
+  Input: $SEDOL = '2936921'
+  Output: 1
+
+Example 2
+
+  Input: $SEDOL = '1234567'
+  Output: 0
+
+Example 3
+
+  Input: $SEDOL = 'B0YBKL9'
+  Output: 1
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 135, Task #2: Validate SEDOL (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D   $SEDOL,                    #= 7-character alphanumeric SEDOL string
+    Bool:D :$verbose = False           #= Print annotated output?
+)
+#==============================================================================
+{
+    "Input:  \$SEDOL = '$SEDOL'".put;
+
+    my Bool $valid   = False;
+    my Str  $message = '';
+
+    if (my UInt $length = $SEDOL.chars) == 7
+    {
+        my Str $code = $SEDOL.substr: 0, 6;
+
+        ($valid, $message) = validate-code( $code );
+
+        if $valid
+        {
+            my Str $check = $SEDOL.substr: 6, 1;
+
+            ($valid, $message) = validate-check-digit( $code, $check );
+        }
+    }
+    else
+    {
+        $message = "Invalid number of characters: found $length, must be 7";
+    }
+
+    "Output: %d%s\n".printf: $valid   ?? 1 !! 0,
+                             $verbose ?? " ($message)" !! '';
+}
+
+#------------------------------------------------------------------------------
+sub validate-code
+(
+    Str:D $code where $code.chars == 6,
+--> Array:D[Bool:D, Str:D]
+)
+#------------------------------------------------------------------------------
+{
+    my Bool $valid   = True;
+    my Str  $message = '';
+
+    for 0 .. 5 -> UInt $i
+    {
+        my Str $char = $code.substr: $i, 1;
+
+        if $char !~~ / <[0..9] + [A..Z] - [AEIOU]> /
+        {
+            $valid   = False;
+            $message = "Invalid code character '$char'";
+            last;
+        }
+    }
+
+    return [$valid, $message];
+}
+
+#------------------------------------------------------------------------------
+sub validate-check-digit
+(
+    Str:D $code  where $code\.chars == 6,
+    Str:D $check where $check.chars == 1
+--> Array:D[Bool:D, Str:D]
+)
+#------------------------------------------------------------------------------
+{
+    my Bool $valid   = False;
+    my Str  $message = '';
+
+    if $check ~~ / <[0..9]> /
+    {
+        my UInt $check-digit = get-check-digit( $code );
+
+        if $check.Int == $check-digit
+        {
+            $valid   = True;
+            $message = 'The check digit is correct';
+        }
+        else
+        {
+            $message = "Incorrect check digit: found '$check', should be " ~
+                       "'$check-digit'";
+        }
+    }
+    else
+    {
+        $message = "Invalid check digit '$check'";
+    }
+
+    return [$valid, $message];
+}
+
+#------------------------------------------------------------------------------
+sub get-check-digit
+(
+    Str:D $code where $code.chars == 6
+--> UInt:D
+)
+#------------------------------------------------------------------------------
+{
+    my UInt @weighting    = 1, 3, 1, 7, 3, 9, 1;
+    my UInt $weighted-sum = 0;
+
+    for 0 .. 5 -> UInt $i
+    {
+        my Str  $char  = $code.substr: $i, 1;
+        my UInt $value = $char ~~ / <[0..9]> / ?? $char.Int
+                                               !! 10 + $char.ord - 'A'.ord;
+
+        $weighted-sum += $value * @weighting[ $i ];
+    }
+
+    return (10 - ($weighted-sum % 10)) % 10;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################