Merge pull request #12592 from mattneleigh/pwc336

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

2 files changed, 176 insertions, 0 deletions

diff --git a/challenge-336/mattneleigh/perl/ch-1.pl b/challenge-336/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..d2dc9b5e2b
--- /dev/null
+++ b/challenge-336/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    [ 1, 1, 2, 2, 2, 2 ],
+    [ 1, 1, 1, 2, 2, 2, 3, 3 ],
+    [ 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7 ],
+    [ 1, 2, 3, 4 ],
+    [ 8, 8, 9, 9, 10, 10, 11, 11 ]
+);
+
+print("\n");
+foreach my $integer_list (@integer_lists){
+    printf(
+        "Input: \@ints = (%s)\nOutput: %s\n\n",
+        join(", ", @{$integer_list}),
+        array_evenly_regroupable(@{$integer_list}) ?
+            "true"
+            :
+            "false"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given an array of integers, determine whether they can be divided into groups
+# in which all members of each group has the same value, the groups have the
+# same number of members, and each group has at least two members
+# Takes one argument:
+# * The array of integers to examine (e.g. (8, 8, 9, 9, 10, 10, 11, 11) )
+# Returns:
+# * 0 if the array does not meet the criteria described above
+# * 1 if the array meets the criteria described above (as would be the case in
+#   the example provided)
+################################################################################
+sub array_evenly_regroupable{
+    use List::Util qw(min);
+
+    my %count_table;
+    my @counts;
+    my $min;
+
+    # Count the instances of each number
+    foreach(@ARG){
+        $count_table{$_}++;
+    }
+
+    # Make a list of counts and find the smallest
+    @counts = map($count_table{$_}, keys(%count_table));
+    $min = min(@counts);
+
+    # Make sure the smallest count is at least 2
+    return(0)
+        unless($min > 1);
+
+    # Return 0 if any count isn't evenly divisible
+    # by the minimum count
+    foreach my $count (@counts){
+        return(0)
+            if($count % $min);
+    }
+
+    # Got here- the array met our criteria;
+    # return 1
+    return(1);
+
+}
+
+
+
diff --git a/challenge-336/mattneleigh/perl/ch-2.pl b/challenge-336/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..94a2b1b0d8
--- /dev/null
+++ b/challenge-336/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @score_sets = (
+    [ "5", "2", "C", "D", "+" ],
+    [ "5", "-2", "4", "C", "D", "9", "+", "+" ],
+    [ "7", "D", "D", "C", "+", "3" ],
+    [ "-5", "-10", "+", "D", "C", "+" ],
+    [ "3", "6", "+", "D", "C", "8", "+", "D", "-2", "C", "+" ]
+);
+
+print("\n");
+foreach my $scores (@score_sets){
+    printf(
+        "Input: \@scores = (%s)\nOutput: %d\n\n",
+        join(
+            ", ",
+            map(
+                "\"" . $_ . "\"",
+                @{$scores}
+            )
+        ),
+        evaluate_scores(@{$scores})
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given a list of scores and instructional codes, evaluate the list and
+# determine the resulting total score; scores may consist of the following:
+# * + - An instruction to add the last two scores in the list together and
+#       place the result at the end of the list, leaving the two added scores
+#       in place (i.e. (...5, 10) --> (...5, 10, 15) )
+# * C - An instruction to invalidate the last score and remove it from the
+#       list (i.e. (...5, 10) --> (...5) )
+# * D - An instruction to double the last score and place it at the end of the
+#       list, leaving the value that was doubled in place as well (i.e.
+#       (...5, 10) --> (...5, 10, 20)
+# * An integer value to be added to the list 
+# All values in the list will be summed after processing, and the resulting
+# value returned
+# Takes one argument:
+# * The list of scores and instructions to examine (e.g.
+#   ("3", "6", "+", "D", "C", "8", "+", "D", "-2", "C", "+") )
+# Returns:
+# * The result of processing the scores and instructions as described above
+#   (e.g. 128)
+################################################################################
+sub evaluate_scores{
+    use List::Util qw(sum);
+
+    my @scores;
+
+    # Loop over every score or embedded opcode
+    foreach my $score (@ARG){
+        if($score eq '+'){
+            # Sum opcode- add the sum of the last two
+            # scores to the list
+            push(@scores, $scores[-1] + $scores[-2]);
+        } elsif($score eq 'C'){
+            # Cancel opcode- remove the last score from
+            # the list
+            pop(@scores);
+        } elsif($score eq 'D'){
+            # Double opcode- double the last score and
+            # add the result to the list 
+            push(@scores, $scores[-1] * 2);
+        } else{
+            # A score- add it to the list
+            push(@scores, $score);
+        }
+    }
+
+    # Return the sum of the scores
+    return(sum(@scores));
+
+}
+
+
+