Merge pull request #9965 from mattneleigh/pwc265

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

2 files changed, 203 insertions, 0 deletions

diff --git a/challenge-265/mattneleigh/perl/ch-1.pl b/challenge-265/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..9980bd62c6
--- /dev/null
+++ b/challenge-265/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    # Given cases
+    [ 1, 2, 3, 3, 3, 3, 4, 2 ],
+    [ 1, 1 ],
+    [ 1, 2, 3 ],
+
+    # Additional test case(s)
+    [ 1, 2, 3, 4, 5, 6, 7, 8 ]    
+);
+
+print("\n");
+foreach my $integer_list (@integer_lists){
+    my $found_number = lowest_over_33(@{$integer_list});
+
+    printf(
+        "Input: \@ints = (%s)\nOutput: %s\n\n",
+        join(", ", @{$integer_list}),
+        defined($found_number) ? $found_number : "undef"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Find the lowest value, if any, that appears in an array of integers at least
+# 33% of the time
+# Takes one argument:
+# * The array to examine (e.g. ( 1, 2, 3 ) )
+# Returns:
+# * The lowest value that appeared in at least 33% of the cells of the array,
+#   or undef if no such value was found (e.g. 1 )
+################################################################################
+sub lowest_over_33{
+
+    my %frequency;
+
+    # Count how many times each number
+    # appears in the list
+    foreach my $num (@ARG){
+        $frequency{$num}++;
+    }
+
+    return(
+        # Capture the first (lowest) number in a
+        # sorted list of instances that were
+        # seen at least 33% of the time; this
+        # will be undef if no matching numbers
+        # were found
+        (
+            sort(
+                { $a <=> $b }
+                # Build a list of numbers that were seen
+                # at least 33% of the time
+                map(
+                    $frequency{$_} / scalar(@ARG) >= 0.33 ?
+                        $_
+                        :
+                        (),
+                    keys(%frequency)
+                )
+            )
+        )[0]
+    );
+
+}
+
+
+
diff --git a/challenge-265/mattneleigh/perl/ch-2.pl b/challenge-265/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..2a96230f6e
--- /dev/null
+++ b/challenge-265/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,120 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @word_lists = (
+    [
+        "aBc 11c",
+        [ "accbbb", "abc", "abbc" ]
+    ],
+    [
+        "Da2 abc",
+        [ "abcm", "baacd", "abaadc" ]
+    ],
+    [
+        "JB 007",
+        [ "jj", "bb", "bjb" ]
+    ],
+);
+
+print("\n");
+foreach my $word_list (@word_lists){
+    printf(
+        "Input: \$str = '%s'\n       \@str = (%s)\nOutput: '%s'\n\n",
+        $word_list->[0],
+        join(", ", map("'" . $_ . "'", @{$word_list->[1]})),
+        shortest_completing_word($word_list)
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given a string and a set of words, find the shortest Completing Word among
+# the set, if any.  A Completing Word is defined as a word that contains all
+# the letters in the given string, ignoring spaces and numbers; if a letter
+# appears more than once in the given string, it must appear the same number of
+# times or more in the word.  Note that letter-matching is case-insensitive.
+# Takes one argument:
+# * A ref to a data structure containing a string of characters and an array of
+#   words to examine (e.g.
+#       [
+#           "aBc 11c",
+#           [ "accbbb", "abc", "abbc" ]
+#       ]
+#   )
+# Returns:
+# * The shortest Completing Word, determined as described above, if any, or the
+#   empty string if none of the supplied words were Completing Words (e.g.
+#  "accbbb" )
+################################################################################
+sub shortest_completing_word{
+
+    my %given_table;
+    my $chr;
+    my @completing;
+
+    # Build a frequency table of the letters in the
+    # given word
+    foreach $chr (split(//, lc($ARG[0][0]))){
+        next
+            unless($chr =~ m/[a-z]/);
+        $given_table{$chr}++;
+    }
+
+    # Examine each word
+    foreach my $word (@{$ARG[0][1]}){
+        my %word_table;
+        my $completing = 1;
+
+        # Build a frequency table of the letters in the
+        # word
+        foreach $chr (split(//, lc($word))){
+            $word_table{$chr}++;
+        }
+
+        # Examine each letter from the given string
+        foreach $chr (keys(%given_table)){
+            # Set a flag to zero unless this letter appears
+            # in the word and its count in the word was
+            # greater than or equal to its count in the
+            # given string
+            $completing = 0
+                unless(
+                    $word_table{$chr}
+                    &&
+                    ($word_table{$chr} >= $given_table{$chr})
+                );
+        }
+
+        # If the flag is true, this is a Completing
+        # Word; store it in the list of same
+        push(@completing, $word)
+            if($completing);
+    }
+
+    return(
+        # If there were Completing Words found, return
+        # the shortest of them, otherwise return the
+        # empty string
+        scalar(@completing) ?
+            (sort({ length($a) <=> length($b) } @completing))[0]
+            :
+            ""
+    );
+
+}
+
+
+