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

4 files changed, 643 insertions, 0 deletions

diff --git a/challenge-282/athanasius/perl/ch-1.pl b/challenge-282/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..bfd952e96b
--- /dev/null
+++ b/challenge-282/athanasius/perl/ch-1.pl
@@ -0,0 +1,167 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 282
+=========================
+
+TASK #1
+-------
+*Good Integer*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a positive integer, $int, having 3 or more digits.
+
+Write a script to return the Good Integer in the given integer or -1 if none
+found.
+
+    A good integer is exactly three consecutive matching digits.
+
+Example 1
+
+  Input: $int = 12344456
+  Output: "444"
+
+Example 2
+
+  Input: $int = 1233334
+  Output: -1
+
+Example 3
+
+  Input: $int = 10020003
+  Output: "000"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A positive integer of 3 or more digits is entered on the command-line.
+
+Assumptions
+-----------
+1. Since the input integer must have at least 3 digits, and valid integers do
+   not have leading zeros, the smallest valid input integer is 100.
+2. A leading plus ("+") sign is also disallowed: only the digits 0-9 are accept-
+   ed.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <int>
+  perl $0
+
+    <int>    A positive integer of 3 or more digits
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 282, Task #1: Good Integer (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $int =  $ARGV[ 0 ];
+           $int =~ / ^ [1-9] \d{2,} /x
+                or error( qq["$int" is not a valid input integer] );
+
+        print "Input: \$int = $int\n";
+
+        my $good_int = find_good_integer( $int );
+
+        print "Output: $good_int\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_good_integer
+#-------------------------------------------------------------------------------
+{
+    my ($int) = @_;
+    my  @runs = grep { length $_ == 3 } $int =~ / ( (\d) \2{2,} ) /gx;
+
+    return scalar @runs ? qq["$runs[ 0 ]"] : -1;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int, $expected) = split / \| /x, $line;
+
+        for ($test_name, $int, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $good_int = find_good_integer( $int );
+
+        is $good_int, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1   |12344456          |"444"
+Example 2   |1233334           |-1
+Example 3   |10020003          |"000"
+Multiple    |122234445666      |"222"
+Initial     |9992555           |"999"
+Final       |123776666888      |"888"
+Final 4     |123456789999      |-1
+All too long|111112222333334444|-1
+Between 4s  |122223334444567   |"333"
diff --git a/challenge-282/athanasius/perl/ch-2.pl b/challenge-282/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..79d0c7e1cf
--- /dev/null
+++ b/challenge-282/athanasius/perl/ch-2.pl
@@ -0,0 +1,166 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 282
+=========================
+
+TASK #2
+-------
+*Changing Keys*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an alphabetic string, $str, as typed by user.
+
+Write a script to find the number of times user had to change the key to type
+the given string. Changing key is defined as using a key different from the last
+used key. The shift and caps lock keys won't be counted.
+
+Example 1
+
+  Input: $str = 'pPeERrLl'
+  Output: 3
+
+  p -> P : 0 key change
+  P -> e : 1 key change
+  e -> E : 0 key change
+  E -> R : 1 key change
+  R -> r : 0 key change
+  r -> L : 1 key change
+  L -> l : 0 key change
+
+Example 2
+
+  Input: $str = 'rRr'
+  Output: 0
+
+Example 3
+
+  Input: $str = 'GoO'
+  Output: 1
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single, alphabetic, string is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;          # Enables strictures and warnings
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    An alphabetic string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 282, Task #2: Changing Keys (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str =  $ARGV[ 0 ];
+           $str =~ / ^ [A-Za-z]* $ /x or error( 'Invalid input string' );
+
+        print qq[Input:  \$str = "$str"\n];
+
+        my $key_changes = count_key_changes( $str );
+
+        print "Output: $key_changes\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub count_key_changes
+#-------------------------------------------------------------------------------
+{
+    my ($str)    = @_;
+    my  $changes = 0;
+    my  @chars   = split //, $str;
+
+    for my $i (1 .. $#chars)
+    {
+        ++$changes unless lc $chars[ $i - 1 ] eq lc $chars[ $i ];
+    }
+
+    return $changes;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $key_changes = count_key_changes( $str );
+
+        is $key_changes, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|pPeERrLl|3
+Example 2|rRr     |0
+Example 3|GoO     |1
+Empty    |        |0
diff --git a/challenge-282/athanasius/raku/ch-1.raku b/challenge-282/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..fbcc3cfff5
--- /dev/null
+++ b/challenge-282/athanasius/raku/ch-1.raku
@@ -0,0 +1,156 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 282
+=========================
+
+TASK #1
+-------
+*Good Integer*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a positive integer, $int, having 3 or more digits.
+
+Write a script to return the Good Integer in the given integer or -1 if none
+found.
+
+    A good integer is exactly three consecutive matching digits.
+
+Example 1
+
+  Input: $int = 12344456
+  Output: "444"
+
+Example 2
+
+  Input: $int = 1233334
+  Output: -1
+
+Example 3
+
+  Input: $int = 10020003
+  Output: "000"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A positive integer of 3 or more digits is entered on the command-line.
+
+Assumptions
+-----------
+1. Since the input integer must have at least 3 digits, and valid integers do
+   not have leading zeros, the smallest valid input integer is 100.
+2. A leading plus ("+") sign is also disallowed: only the digits 0-9 are accept-
+   ed.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 282, Task #1: Good Integer (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A positive integer of 3 or more digits
+
+    Str:D $int where / ^ <[ 1..9 ]> \d ** 2..* /
+)
+#===============================================================================
+{
+    "Input: \$int = $int".put;
+
+    my Str $good-int = find-good-integer( $int.Int );
+
+    "Output: $good-int".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-good-integer( UInt:D $int where * >= 100 --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @runs = ($int ~~ m:g/ ( (\d) {} :my $n = $0; $n ** 2..* ) /)\
+                   .map( { ~$_ } ).grep: { .chars == 3 };
+
+    return @runs.elems ?? qq["@runs[ 0 ]"] !! '-1';
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int, $expected) = $line.split: / \| /;
+
+        for     $test-name, $int, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $good-int = find-good-integer( $int.Int );
+
+        is $good-int, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1   |12344456          |"444"
+        Example 2   |1233334           |-1
+        Example 3   |10020003          |"000"
+        Multiple    |122234445666      |"222"
+        Initial     |9992555           |"999"
+        Final       |123776666888      |"888"
+        Final 4     |123456789999      |-1
+        All too long|111112222333334444|-1
+        Between 4s  |122223334444567   |"333"
+        END
+}
+
+################################################################################
diff --git a/challenge-282/athanasius/raku/ch-2.raku b/challenge-282/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c8828fd1a1
--- /dev/null
+++ b/challenge-282/athanasius/raku/ch-2.raku
@@ -0,0 +1,154 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 282
+=========================
+
+TASK #2
+-------
+*Changing Keys*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an alphabetic string, $str, as typed by user.
+
+Write a script to find the number of times user had to change the key to type
+the given string. Changing key is defined as using a key different from the last
+used key. The shift and caps lock keys won't be counted.
+
+Example 1
+
+  Input: $str = 'pPeERrLl'
+  Output: 3
+
+  p -> P : 0 key change
+  P -> e : 1 key change
+  e -> E : 0 key change
+  E -> R : 1 key change
+  R -> r : 0 key change
+  r -> L : 1 key change
+  L -> l : 0 key change
+
+Example 2
+
+  Input: $str = 'rRr'
+  Output: 0
+
+Example 3
+
+  Input: $str = 'GoO'
+  Output: 1
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single, alphabetic, string is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 282, Task #2: Changing Keys (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str where / ^ <[ A..Z a..z]>* $ /             #= An alphabetic string
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str"].put;
+
+    my UInt $key-changes = count-key-changes( $str );
+
+    "Output: $key-changes".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub count-key-changes( Str:D $str where / ^ <[ A..Z a..z ]>* $ / --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $changes = 0;
+    my Str  @chars   = $str.split: '', :skip-empty;
+
+    for 1 .. @chars.end -> UInt $i
+    {
+        ++$changes unless @chars[ $i - 1 ].lc eq @chars[ $i ].lc;
+    }
+
+    return $changes;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt $key-changes = count-key-changes( $str );
+
+        is $key-changes, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|pPeERrLl|3
+        Example 2|rRr     |0
+        Example 3|GoO     |1
+        Empty    |        |0
+        END
+}
+
+################################################################################