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

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

2 files changed, 202 insertions, 0 deletions

diff --git a/challenge-234/mattneleigh/perl/ch-1.pl b/challenge-234/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..48a2b61ed9
--- /dev/null
+++ b/challenge-234/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @word_lists = (
+    [ "java", "javascript", "julia" ],
+    [ "bella", "label", "roller" ],
+    [ "cool", "lock", "cook" ]
+);
+
+print("\n");
+foreach my $word_list (@word_lists){
+    printf(
+        "Input: \@word_list = (%s)\nOutput: (%s)\n\n",
+        join(", ", map("\"". $_ . "\"", @{$word_list})),
+        join(", ",
+            map(
+                "\"". $_ . "\"",
+                find_omnipresent_and_repeated_letters(@{$word_list})
+            )
+        )
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine which letters are present in all of the words in a list, with each
+# such letter repeated the minimum number of times it's duplicated within each
+# word
+# Takes one argument:
+# * The list of words to examine (e.g. ( "bella", "label", "roller" ) )
+# Returns:
+# * A list of omnipresent (and possibly duplicated) letters (e.g. ( "e", "l",
+#   "l" ) )
+# NOTE: The order in which letters appear in the returned list is dictated by
+# their order in the first word in the input list
+################################################################################
+sub find_omnipresent_and_repeated_letters{
+
+    my @letters;
+    my %table;
+
+    # Build a letter frequency list for the first
+    # word, preserving the order of letters therein
+    foreach my $letter (split('', lc(shift()))){
+        if(defined($table{$letter})){
+            # Letter seen before- increment its count,
+            # looking up its array index from the letter
+            # table
+            $letters[$table{$letter}][1]++;
+        } else{
+            # Letter not seen before- start its count
+            # and store its index in the letter table
+            push(@letters, [ $letter, 1 ]);
+            $table{$letter} = $#letters;
+        }
+    }
+
+    # Loop over remaining words
+    while(@ARG){
+        my $i = 0;
+
+        # Build a new letter frequency table for this word
+        %table = ();
+        foreach my $letter (split('', lc(shift()))){
+            if($table{$letter}){
+                # Letter seen before- increment its count
+                $table{$letter}++;
+            } else{
+                # Letter not seen before- start its count
+                $table{$letter} = 1;
+            }
+        }
+
+        # Loop over duplicate letters from
+        # previous words
+        while($i <= $#letters){
+            if($table{$letters[$i][0]}){
+                # Letter is present in the new word...
+                if($table{$letters[$i][0]} < $letters[$i][1]){
+                    # ...and its frequency count is LESS than in
+                    # any previously seen word- store the new
+                    # count and then...
+                    $letters[$i][1] = $table{$letters[$i][0]};
+                }
+                # ...move on to the next letter
+                $i++;
+            } else{
+                # Letter isn't present in the new word-
+                # delete it
+                splice(@letters, $i, 1);
+            }
+        }
+    }
+
+    return(
+        # Loop over remaining letters that were seen
+        # in each word...
+        map(
+            {
+                my $ref = $_;
+
+                # ...and repeat each letter the minimum number
+                # of times it was seen in any word
+                map($ref->[0], (1 .. $ref->[1]));
+            }
+            @letters
+        )
+    );
+
+}
+
+
+
diff --git a/challenge-234/mattneleigh/perl/ch-2.pl b/challenge-234/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..ce530c6fa1
--- /dev/null
+++ b/challenge-234/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    [ 4, 4, 2, 4, 3 ],
+    [ 1, 1, 1, 1, 1 ],
+    [ 4, 7, 1, 10, 7, 4, 1, 1 ]
+);
+
+print("\n");
+foreach my $interger_list (@integer_lists){
+    printf(
+        "Input: \@ints = (%s)\nOuput: %d\n\n",
+        join(", ", @{$interger_list}),
+        count_unequal_triplets(@{$interger_list})
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine how many unequal triplets exist within a list of integers (i.e.
+# count the sets ($list[$i], $list[$j], $list[$k]) such that $list[$i] !=
+# $list[$j] != $list[$k] ).  Note that all examined triplets will occur in
+# their original order within the list (i.e. $i < $j < $k ).
+# Takes one argument:
+# * A list of integers to examine (e.g. ( 4, 7, 1, 10, 7, 4, 1, 1 ) )
+# Returns on success:
+# * The count of unequal triplets within the list (e.g. 28 )
+# Returns on error:
+# * undef if there are not at least three elements in the list
+################################################################################
+sub count_unequal_triplets{
+
+    my $count = 0;
+
+    return(undef)
+        if(scalar(@ARG) < 3);
+
+    # Loop over all $i, $j, $k such that
+    # $i < $j < $k
+    for my $i (0 .. $#ARG - 2){
+        for my $j ($i + 1 .. $#ARG - 1){
+            for my $k ($j + 1 .. $#ARG){
+                # Increment the count if the values in
+                # @ARG at these $i, $j, $k are not equal
+                $count++
+                    unless(
+                        ($ARG[$i] == $ARG[$j])
+                        ||
+                        ($ARG[$j] == $ARG[$k])
+                        ||
+                        ($ARG[$k] == $ARG[$i])
+                    );
+            }
+        }
+    }
+
+    return($count);
+
+}
+
+
+