Merge pull request #8944 from mattneleigh/pwc240

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

2 files changed, 134 insertions, 0 deletions

diff --git a/challenge-240/mattneleigh/perl/ch-1.pl b/challenge-240/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..7bf6ea5787
--- /dev/null
+++ b/challenge-240/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @string_sets = (
+    [
+        [ "Perl", "Python", "Pascal" ],
+        "ppp"
+    ],
+    [
+        [ "Perl", "Raku" ],
+        "rp"
+    ],
+    [
+        [ "Oracle", "Awk", "C" ],
+        "oac"
+    ]
+);
+
+print("\n");
+foreach my $string_set (@string_sets){
+    printf(
+        "Input: \@str = (%s)\n       \$chk = %s\nOutput: %s\n\n",
+        join(", ", map("\"" . $_ . "\"", @{$string_set->[0]})),
+        $string_set->[1],
+        is_acronym($string_set->[1], @{$string_set->[0]}) ?
+            "true"
+            :
+            "false"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether a set of words can form a particular acronym; case is
+# ignored when performing this check
+# Takes two arguments:
+# * The intended acronym
+# * A list of words whose ability to form the supplied acronym is to be
+#   verified
+# Returns:
+# * A true value if the supplied words will form the specified acronym
+# * A false value if the supplied words will NOT form the specified acronym
+################################################################################
+sub is_acronym{
+
+    return(
+        # Lower-case the first string
+        lc(shift())
+        eq
+        # Concatenate of all the first letters
+        # from subsequent strings
+        join(
+            "",
+            # Make a list of lower-cased first letters
+            # from subsequent strings
+            map(
+                lc(substr($_, 0, 1)),
+                @ARG
+            )
+        )
+    );
+
+}
+
+
+
diff --git a/challenge-240/mattneleigh/perl/ch-2.pl b/challenge-240/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..09e268b184
--- /dev/null
+++ b/challenge-240/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    [ 0, 2, 1, 5, 3, 4 ],
+    [ 5, 0, 1, 2, 3, 4 ]
+);
+
+print("\n");
+foreach my $integer_list (@integer_lists){
+    printf(
+        "Input: \@int = (%s)\nOutput: (%s)\n\n",
+        join(", ", @{$integer_list}),
+        join(", ", rearrange_integers(@{$integer_list}))
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Rearrange an array of integers into a new array such that:
+#   $new[$i] = $old[$old[$i]] for all $i within the bounds of the two arrays
+# Takes one argument:
+# * The array of integers to rearrange
+# Returns:
+# * The rearranged array
+################################################################################
+sub rearrange_integers{
+
+    return(
+        # Loop over all array indices
+        map(
+            # Pretty much straight from the problem
+            # spec...
+            $ARG[$ARG[$_]],
+            0 .. $#ARG
+        )
+    );
+
+}
+
+
+