Merge pull request #9498 from mattneleigh/pwc254

new file:   challenge-254/mattneleigh/perl/ch-1.pl

2 files changed, 163 insertions, 0 deletions

diff --git a/challenge-254/mattneleigh/perl/ch-1.pl b/challenge-254/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..104ca93fff
--- /dev/null
+++ b/challenge-254/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @ints = (
+    # Given cases
+    27, 0, 6,
+
+    # Additional test cases
+    3375, -3375, 1073741824
+);
+
+print("\n");
+foreach my $int (@ints){
+    printf(
+        "Input: \$n = %d\nOutput: %s\n\n",
+        $int,
+        is_power_of_three($int) ?
+            "true"
+            :
+            "false"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given an integer, determine whether that integer is a power of three
+# Takes one argument:
+# * The integer to examine
+# Returns:
+# * 1 if the integer appears to be another integer raised to the third power
+# * 0 if the integer does NOT appear to be another integer raised to the third
+#   power
+################################################################################
+sub is_power_of_three{
+
+    # Compute the cube root of the first argument-
+    # with a bit of trickery required for negative
+    # values
+    my $cuberoot = ($ARG[0] < 0) ?
+        -((-$ARG[0]) ** (1/3))
+        :
+        $ARG[0] ** (1/3);
+
+    return(
+        # Account for round-off error- see if $cuberoot
+        # is very close to being an integer
+        abs($cuberoot - sprintf("%.0f", $cuberoot)) < 0.000001 ?
+            1
+            :
+            0        
+    );
+
+}
+
+
+
diff --git a/challenge-254/mattneleigh/perl/ch-2.pl b/challenge-254/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..b9338d796e
--- /dev/null
+++ b/challenge-254/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @strings = (
+    # Given cases
+    qw(
+        Raku
+        Perl
+        Julia
+        Uiua
+    ),
+
+    # Additional test cases
+    qw(
+        UPPERCASE
+        lowercase
+        MiXeDcAsE
+    )
+);
+
+print("\n");
+foreach my $string (@strings){
+    printf(
+        "Input: \$s = \"%s\"\nOutput: \"%s\"\n\n",
+        $string,
+        reverse_vowel_order($string)
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given a string, reverse the positions of all the vowels within, preserving
+# original letter case in each position within the string
+# Takes one argument:
+# * The string to examine (e.g. "Julia")
+# Returns:
+# * The string, with all vowel positions reversed (e.g. "Jaliu")
+# Note that case of each position will be preserved even if letters in that
+# position are changed (e.g. "MiXeDcAsE" --> "MeXaDcEsI")
+################################################################################
+sub reverse_vowel_order{
+    my $string = shift();
+
+    my $index = 0;
+    my @vowels;
+    my @indices;
+
+    # Find each vowel, make a note of where it
+    # is, and whether it was capitalized
+    foreach my $char (split('', $string)){
+        if($char =~ m/[aeiou]/i){
+            unshift(@vowels, lc($char));
+            # If $char and $vowels[0] match, the original
+            # character was lower case
+            push(@indices, [ $index, $char eq $vowels[0] ? 0 : 1 ]);
+        }
+
+        $index++;
+    }
+
+    # Replace vowels with their new counterparts
+    # at observed locations, matching original
+    # case at each
+    for $index (0 .. $#vowels){
+        substr(
+            $string,
+            $indices[$index][0],
+            1,
+            $indices[$index][1] ?
+                uc($vowels[$index])
+                :
+                $vowels[$index]
+        );
+    }
+
+    return($string);
+
+}
+
+
+