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

new file:   challenge-255/mattneleigh/perl/ch-2.pl

2 files changed, 201 insertions, 0 deletions

diff --git a/challenge-255/mattneleigh/perl/ch-1.pl b/challenge-255/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..5d10cd0028
--- /dev/null
+++ b/challenge-255/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @string_pairs = (
+    # Given cases
+    [ "Perl",   "Preel"    ],
+    [ "Weekly", "Weeakly"  ],
+    [ "Box",    "Boxy"     ],
+
+    # Additional test cases
+    [ "Pizza",  "Pizzeria" ],
+    [ "No",     "Match"    ],
+    [ "Peer",   "Peerless" ]
+);
+
+print("\n");
+foreach my $string_pair (@string_pairs){
+    printf(
+        "Input: \$s = \"%s\"\n       \$t = \"%s\"\nOutput: %s\n\n",
+        @{$string_pair},
+        join(
+            ", ",
+            find_additional_characters(@{$string_pair})
+        )
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given two strings, find the characters in the second that are NOT present in
+# the first, with quantity of characters being taken into account rather than
+# mere presence alone (see below)
+# Takes two arguments:
+# * The first string (e.g. "Peer" )
+# * The second string (e.g. "Peerless" )
+# Returns:
+# * A lexicographically sorted list of characters that are present in the
+#   second string but not in the first (e.g. ( "e", "l", "s", "s" ) ).  Note
+#   that 'e' is included once and 's' is included twice as that represents the
+#   number of times each appears more in the second string than in the first.
+################################################################################
+sub find_additional_characters{
+
+    my $char;
+    my %chars;
+
+    # Make a table of character counts from the second
+    # argument
+    foreach $char (split('', $ARG[1])){
+        if($chars{$char}){
+            $chars{$char}++;
+        } else{
+            $chars{$char} = 1;
+        }
+    }
+
+    # Decrement (or remove entirely) the counts of
+    # characters that appear in the first argument
+    foreach $char (split('', $ARG[0])){
+        if(exists($chars{$char})){
+            $chars{$char}--;
+            delete($chars{$char})
+                unless($chars{$char});
+        }
+    }
+
+    # Return a lexicographically sorted list of
+    # remaining characters
+    return(
+        sort(
+            # Make a list of remaining characters
+            map(
+                {
+                    $char = $_;
+
+                    # Repeat the character the appropriate
+                    # number of times
+                    map(
+                        $char,
+                        1 .. $chars{$char}
+                    )
+                }
+                keys(%chars)
+            )
+        )
+    );
+
+}
+
+
+
diff --git a/challenge-255/mattneleigh/perl/ch-2.pl b/challenge-255/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..9674ba97d9
--- /dev/null
+++ b/challenge-255/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @paragraphs_and_words = (
+    [
+        "Joe hit a ball, the hit ball flew far after it was hit.",
+        "hit"
+    ],
+    [
+        "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.",
+       "the"
+    ]
+);
+
+print("\n");
+foreach my $paragraph_and_word (@paragraphs_and_words){
+    printf(
+        "Input: \$p = \"%s\"\n       \$w = \"%s\"\nOutput: \"%s\"\n\n",
+        @{$paragraph_and_word},
+        most_frequent_permitted_word(@{$paragraph_and_word})
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given a paragraph and a banned word, find the permitted word that appears
+# most frequently in the paragraph
+# Takes two arguments:
+# * The paragraph to examine (e.g. "Joe hit a ball, the hit ball flew far after
+#   it was hit." )
+# * The word to ban (e.g. "hit")
+# Returns:
+# * The permitted word that appears most frequently in the paragraph (e.g.
+#   "ball").  If there are multiple words tied for most frequent, the one that
+#   sorts first, lexicographically speaking, will be returned
+################################################################################
+sub most_frequent_permitted_word{
+
+    my %words;
+
+    # Get a table of counts of permitted words
+    foreach my $word (split(' ', $ARG[0])){
+        # Stip anything that isn't a letter or number
+        $word =~ s/[^A-Za-z0-9]//g;
+
+        # If the word isn't the forbidden one, add to
+        # its count in the word table
+        if($word ne $ARG[1]){
+            if($words{$word}){
+                $words{$word}++;
+            } else{
+                $words{$word} = 1;
+            }
+        }
+    }
+
+    return(
+        # 3: Get the 0th field of the 0th record in
+        # the sorted list- this will be the most
+        # frequently observed word
+        (
+            # 2: Sort the list in descending order by
+            # count, unless the counts are equal, in
+            # which case sort lexicographically
+            sort(
+                {
+                    $b->[1] == $a->[1] ?
+                        $a->[0] cmp $b->[0]
+                        :
+                        $b->[1] <=> $a->[1]
+                }
+                # 1: Make a list of words and their counts
+                map(
+                    [ $_, $words{$_} ],
+                    keys(%words)
+                )
+            )
+        )[0][0]
+    );
+
+}
+
+
+