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

4 files changed, 696 insertions, 0 deletions

diff --git a/challenge-254/athanasius/perl/ch-1.pl b/challenge-254/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..e793ab8324
--- /dev/null
+++ b/challenge-254/athanasius/perl/ch-1.pl
@@ -0,0 +1,161 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 254
+=========================
+
+TASK #1
+-------
+*Three Power*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer, $n.
+
+Write a script to return true if the given integer is a power of three otherwise
+return false.
+
+Example 1
+
+  Input: $n = 27
+  Output: true
+
+  27 = 3 ^ 3
+
+Example 2
+
+  Input: $n = 0
+  Output: true
+
+  0 = 0 ^ 3
+
+Example 3
+
+  Input: $n = 6
+  Output: false
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <n>
+  perl $0
+
+    <n>    A positive integer
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 254, Task #1: Three Power (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $n = $ARGV[ 0 ];
+
+        $n =~ / ^ $RE{num}{int} $ /x
+                or error( qq["$n" is not a valid integer] );
+
+        $n >= 0 or error( qq["$n" is not positive] );
+
+        print  "Input:  \$n = $n\n";
+
+        printf "Output: %s\n", is_three_power( $n ) ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 1 or 0 arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub is_three_power
+#-------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    my $cube_root = int( ($n ** (1 / 3)) + 0.5 );
+
+    return $cube_root * $cube_root * $cube_root == $n;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $n, $expected) = split / \| /x, $line;
+
+        for ($test_name, $n, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $result = is_three_power( $n ) ? 'true' : 'false';
+
+        is $result, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |     27|true
+Example 2  |      0|true
+Example 3  |      6|false
+Large power|1030301|true
+One under  |1030300|false
+One over   |1030302|false
diff --git a/challenge-254/athanasius/perl/ch-2.pl b/challenge-254/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..0ed2fce433
--- /dev/null
+++ b/challenge-254/athanasius/perl/ch-2.pl
@@ -0,0 +1,191 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 254
+=========================
+
+TASK #2
+-------
+*Reverse Vowels*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string, $s.
+
+Write a script to reverse all the vowels (a, e, i, o, u) in the given string.
+
+Example 1
+
+  Input: $s = "Raku"
+  Output: "Ruka"
+
+Example 2
+
+  Input: $s = "Perl"
+  Output: "Perl"
+
+Example 3
+
+  Input: $s = "Julia"
+  Output: "Jaliu"
+
+Example 4
+
+  Input: $s = "Uiua"
+  Output: "Auiu"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Note
+----
+It appears from Example 4 that a new vowel placed into position i of the string
+is capitaltalized if and only if the vowel originally in position i was itself
+capitalized.
+
+=cut
+#===============================================================================
+
+use v5.32.1;     # Enables strictures
+use warnings;
+use Const::Fast;
+use List::Util   qw( any );
+use Test::More;
+
+const my @UC_VOWELS => qw[ A E I O U ];
+const my $USAGE     => <<END;
+Usage:
+  perl $0 <s>
+  perl $0
+
+    <s>    A string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 254, Task #2: Reverse Vowels (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $s = $ARGV[ 0 ];
+
+        print  qq[Input:  \$s = "$s"\n];
+
+        printf qq[Output:      "%s"\n], reverse_vowels( $s );
+    }
+    else
+    {
+        error( "Expected 1 or 0 arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub reverse_vowels
+#-------------------------------------------------------------------------------
+{
+    my ($s)       = @_;
+    my  $reversed = '';
+    my  @chars    = split '', $s;
+    my (@indices, @vowels);
+
+    for my $i (0 .. $#chars)
+    {
+        my $char = $chars[ $i ];
+
+        if (any { $_ eq uc $char } @UC_VOWELS)
+        {
+            push @indices, $i;
+            push @vowels,  lc $char;
+        }
+    }
+
+    for my $i (0 .. $#chars)
+    {
+        if (@indices && $indices[ 0 ] == $i)
+        {
+            shift @indices;
+
+            my $vowel  = pop @vowels;
+               $vowel  = uc $vowel if any { $_ eq $chars[ $i ] } @UC_VOWELS;
+            $reversed .= $vowel;
+        }
+        else
+        {
+            $reversed .= $chars[ $i ];
+        }
+    }
+
+    return $reversed;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $s, $expected) = split / \| /x, $line;
+
+        for ($test_name, $s, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $reversed = reverse_vowels( $s );
+
+        is $reversed, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|Raku       |Ruka
+Example 2|Perl       |Perl
+Example 3|Julia      |Jaliu
+Example 4|Uiua       |Auiu
+No vowels|Uvwxyz     |Uvwxyz
+Two words|Happy Irene|Heppy Erina
diff --git a/challenge-254/athanasius/raku/ch-1.raku b/challenge-254/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..eb75259705
--- /dev/null
+++ b/challenge-254/athanasius/raku/ch-1.raku
@@ -0,0 +1,153 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 254
+=========================
+
+TASK #1
+-------
+*Three Power*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer, $n.
+
+Write a script to return true if the given integer is a power of three otherwise
+return false.
+
+Example 1
+
+  Input: $n = 27
+  Output: true
+
+  27 = 3 ^ 3
+
+Example 2
+
+  Input: $n = 0
+  Output: true
+
+  0 = 0 ^ 3
+
+Example 3
+
+  Input: $n = 6
+  Output: false
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 254, Task #1: Three Power (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    UInt:D $n                       #= A positive integer
+)
+#===============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    "Output: %s\n".printf: is-three-power( $n ) ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub is-three-power( UInt:D $n --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $cube-root = (($n ** (1 / 3)) + 0.5).floor;
+
+    return $cube-root * $cube-root * $cube-root == $n;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $n, $expected) = $line.split: / \| /;
+
+        for     $test-name, $n, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $result = is-three-power( $n.Int ) ?? 'true' !! 'false';
+
+        is $result, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+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  |     27|true
+        Example 2  |      0|true
+        Example 3  |      6|false
+        Large power|1030301|true
+        One under  |1030300|false
+        One over   |1030302|false
+        END
+}
+
+################################################################################
diff --git a/challenge-254/athanasius/raku/ch-2.raku b/challenge-254/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..6e2142352f
--- /dev/null
+++ b/challenge-254/athanasius/raku/ch-2.raku
@@ -0,0 +1,191 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 254
+=========================
+
+TASK #2
+-------
+*Reverse Vowels*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string, $s.
+
+Write a script to reverse all the vowels (a, e, i, o, u) in the given string.
+
+Example 1
+
+  Input: $s = "Raku"
+  Output: "Ruka"
+
+Example 2
+
+  Input: $s = "Perl"
+  Output: "Perl"
+
+Example 3
+
+  Input: $s = "Julia"
+  Output: "Jaliu"
+
+Example 4
+
+  Input: $s = "Uiua"
+  Output: "Auiu"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Note
+----
+It appears from Example 4 that a new vowel placed into position i of the string
+is capitaltalized if and only if the vowel originally in position i was itself
+capitalized.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my constant @UC-VOWELS = < A E I O U >;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 254, Task #2: Reverse Vowels (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $s                            #= A string
+)
+#===============================================================================
+{
+    qq[Input:  \$s = "$s"].put;
+
+    qq[Output:      "%s"\n].printf: reverse-vowels( $s );
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub reverse-vowels( Str:D $s --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str  $reversed = '';
+    my Str  @chars    = $s.split: '', :skip-empty;
+    my UInt @indices;
+    my Str  @vowels;
+
+    for 0 .. @chars.end -> UInt $i
+    {
+        my Str $char = @chars[ $i ];
+
+        if $char.uc eq @UC-VOWELS.any
+        {
+            @indices.push: $i;
+            @vowels\.push: $char.lc;
+        }
+    }
+
+    for 0 .. @chars.end -> UInt $i
+    {
+        if @indices.elems > 0 && @indices[ 0 ] == $i
+        {
+            @indices.shift;
+
+            my Str $vowel = @vowels.pop;
+            $vowel       .= uc if @chars[ $i ] eq @UC-VOWELS.any;
+            $reversed    ~= $vowel;
+        }
+        else
+        {
+            $reversed    ~= @chars[ $i ];
+        }
+    }
+
+    return $reversed;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $s, $expected) = $line.split: / \| /;
+
+        for     $test-name, $s, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $reversed = reverse-vowels( $s );
+
+        is $reversed, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+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|Raku       |Ruka
+        Example 2|Perl       |Perl
+        Example 3|Julia      |Jaliu
+        Example 4|Uiua       |Auiu
+        No vowels|Uvwxyz     |Uvwxyz
+        Two words|Happy Irene|Heppy Erina
+        END
+}
+
+################################################################################