Merge pull request #10255 from mattneleigh/pwc273

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

2 files changed, 141 insertions, 0 deletions

diff --git a/challenge-273/mattneleigh/perl/ch-1.pl b/challenge-273/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..467b8c644d
--- /dev/null
+++ b/challenge-273/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @data_sets = (
+    [ "perl",      "e" ],
+    [ "java",      "a" ],
+    [ "python",    "m" ],
+    [ "ada",       "a" ],
+    [ "ballerina", "l" ],
+    [ "analitik",  "k" ]
+);
+
+print("\n");
+foreach my $data_set (@data_sets){
+    printf(
+        "Input: \$str = \"%s\", \$char = \"%s\"\nOutput: %d\n\n",
+        $data_set->[0],
+        $data_set->[1],
+        character_percentage($data_set->[0], $data_set->[1])
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine what fraction, to the nearest whole percent, of a given string is
+# made up of a specified character
+# Takes two arguments:
+# * The string to examine (e.g. "ballerina")
+# * The character to look for within the string (e.g. "l")
+# Returns:
+# * The percentage of the specified string that is made up of the specified
+#   character, rounded to the nearest whole percent (e.g. 22)
+################################################################################
+sub character_percentage{
+
+    my $percent;
+    my $int;
+
+    # Calculate the percentage of the
+    # character's appearances in the string
+    $percent =
+        (
+            # See how long a list of only the
+            # specifed char is
+            scalar(grep($_ eq $ARG[1], split('', $ARG[0])))
+            /
+            length($ARG[0])
+        )
+        *
+        100;
+
+    # For Perls too old to have POSIX::round, we
+    # round appropriately by hand
+    $int = int($percent);
+    return(
+        $percent - $int < 0.5 ?
+            $int
+            :
+            $int + 1
+    );
+
+}
+
+
+
diff --git a/challenge-273/mattneleigh/perl/ch-2.pl b/challenge-273/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..4eac3de9d5
--- /dev/null
+++ b/challenge-273/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @strings = (
+    "aabb",
+    "abab",
+    "aaa",
+    "bbb",
+);
+
+print("\n");
+foreach my $string (@strings){
+    printf(
+        "Input: \$str = \"%s\"\nOutput: %s\n\n",
+        $string,
+        b_but_no_following_a($string) ?
+            "true"
+            :
+            "false"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether a given string contains at least one 'b', and whether that
+# 'b' is NOT followed by an 'a'
+# Takes one argument:
+# * The string to examine (e.g. "aaaba")
+# Returns:
+# * True if there is at least one 'b' in the string, which is NOT followed by
+#   any instance of an 'a'
+# * False if there are no instances of a 'b' in the string, or if there are, 
+#   they are followed by an instance of an 'a' (as would be the case in the
+#   example above)
+################################################################################
+sub b_but_no_following_a{
+
+    return(
+        # There must be a 'b'
+        $ARG[0] =~ m/b/g
+        &&
+        # And there must NOT be an 'a' after the
+        # 'b'
+        $ARG[0] !~ m/\Ga/g
+    );
+
+}
+
+
+