aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-135/athanasius/perl/ch-1.pl117
-rw-r--r--challenge-135/athanasius/perl/ch-2.pl205
-rw-r--r--challenge-135/athanasius/raku/ch-1.raku93
-rw-r--r--challenge-135/athanasius/raku/ch-2.raku181
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;
+}
+
+##############################################################################
generated by cgit (git 2.34.1) at 2026-03-06 04:57:40 +0000