Merge pull request #9459 from mattneleigh/pwc253

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

2 files changed, 273 insertions, 0 deletions

diff --git a/challenge-253/mattneleigh/perl/ch-1.pl b/challenge-253/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..3dd9246ed2
--- /dev/null
+++ b/challenge-253/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @word_lists = (
+    [
+        [ "one.two.three", "four.five", "six" ],
+        "."
+    ],
+    [
+        [ "\$perl\$\$", "\$\$raku\$" ],
+        "\$"
+    ]
+);
+
+print("\n");
+foreach my $word_list (@word_lists){
+    printf(
+        "Input: \@words = (%s)\n\$separator = \"%s\"\nOutput: %s\n\n",
+        join(
+            ", ",
+            map(
+                "\"" . $_ . "\"",
+                @{$word_list->[0]}
+            )
+        ),
+        $word_list->[1],
+        join(
+            ", ",
+            map(
+                "\"" . $_ . "\"",
+                split_by_delimiter($word_list)
+            )
+        )
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given an array of strings and a delimeter character, separate all strings by
+# that delimiter, returning a list of the resulting words
+# Takes one argument:
+# * A ref to a nested array that contains the array of strings and the
+#   delimiter character (e.g.
+#       [
+#           # Word list
+#           [ "one.two.three", "four.five", "six" ],
+#
+#           # Delimiter character
+#           "."
+#       ]
+#   )
+#   If the delimiter string has more than one character, only the first will be
+#   used.
+# Returns:
+# * A list of words that have been separated by the specified delimiter (e.g.
+#   ( "one", "two", "three", "four", "five", "six" ) )
+# NOTE: Any empty fields indicated by repeated, leading, or trailing occurences
+# of the delimiter character will not be returned
+################################################################################
+sub split_by_delimiter{
+
+    # Make sure we're only using one character
+    my $delimiter = substr($ARG[0][1], 0, 1);
+
+    return(
+        # Filter out empty fields returned by split()
+        # via map()
+        grep(
+            $_ ne "",
+            map(
+                # Treat the delimiter as a member of a character
+                # class so we don't have to worry about escaping
+                # metacharacters when splitting
+                split(/[$delimiter]/, $_),
+                @{$ARG[0][0]}
+            )
+        )
+    );
+
+}
+
+
+
diff --git a/challenge-253/mattneleigh/perl/ch-2.pl b/challenge-253/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..0bf890df2e
--- /dev/null
+++ b/challenge-253/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,177 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @matrices = (
+    [
+        [ 1, 1, 0, 0, 0 ],
+        [ 1, 1, 1, 1, 0 ],
+        [ 1, 0, 0, 0, 0 ],
+        [ 1, 1, 0, 0, 0 ],
+        [ 1, 1, 1, 1, 1 ]
+    ],
+    [
+        [ 1, 0, 0, 0 ],
+        [ 1, 1, 1, 1 ],
+        [ 1, 0, 0, 0 ],
+        [ 1, 0, 0, 0 ]
+    ]
+);
+
+print("\n");
+foreach my $matrix (@matrices){
+    printf(
+        "Input: \$matrix = [\n%s\n                 ]\nOutput: (%s)\n\n",
+        join(
+            "\n",
+            map(
+                "                     " . $_,
+                matrix_to_strings($matrix)
+            )
+        ),
+        join(
+            ", ",
+            rank_matrix_rows_by_strength($matrix)
+        )
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Given a matrix consisting only of ones and zeros, rank the rows of the matrix
+# in order of strength, where one row is stronger than another if:
+# 1) It has more 1's than the other row, or
+# 2) If the number of 1's is equal between the two, it has a larger index than
+#    the other
+# Takes one argument:
+# * A reference to the matrix to examine (e.g.
+#       [
+#           [ 1, 0, 0, 0 ],
+#           [ 1, 1, 1, 1 ],
+#           [ 1, 0, 0, 0 ],
+#           [ 1, 0, 0, 0 ]
+#       ]
+#   )
+# Returns:
+# * A list of row indices in order of row strength, from weakest to strongest
+#   (e.g. ( 0, 2, 3, 1 ) )
+################################################################################
+sub rank_matrix_rows_by_strength{
+
+    my $j = 0;
+
+    return(
+        # 3: Make a list of just the indices from the
+        # list generated in (1) and sorted in (2)
+        map(
+            $_->[1],
+            # 2: Sort the list by count of 1's, unless the
+            # counts are equal, in which case sort by
+            # index
+            sort(
+                {
+                    $a->[0] == $b->[0] ?
+                        $a->[1] <=> $b->[1]
+                        :
+                        $a->[0] <=> $b->[0];
+                }
+                # 1: Make a list of the counts of 1's in each
+                # row, paired with that row's index
+                map(
+                    [ scalar(grep($_ == 1, @{$_})), $j++ ],
+                    @{$ARG[0]}
+                )
+            )
+        )
+    );
+
+}
+
+
+
+################################################################################
+# Given a matrix, produce a set of strings of uniform length and formatting
+# containing the contents of the matrix
+# Takes one argument:
+# * A ref to the matrix (e.g.
+#       [
+#           [ 4,  2 ],
+#           [ 1, 12 ]
+#       ]
+#   )
+# Returns:
+# * A list of strings describing the contents of the matrix with uniform length
+#   and formatting (e.g.
+#       (
+#           "[  4,  2 ]",
+#           "[  1, 12 ]"
+#       )
+#   )
+# Note that strings returned by this function will have square brackets at each
+# end, but will neither have commas nor carriage returns to separate the
+# rows in printed output, nor will they contain spaces for indenting; if the
+# calling code requires any of these, it must provide them itself.
+################################################################################
+sub matrix_to_strings{
+    use List::Util qw(max);
+
+    # Make a printf() format that will accommodate
+    # the longest value, textually speaking, in
+    # the matrix
+    my $value_format =
+        "%"
+        .
+        # 3: Get the longest length amongst all the
+        # rows
+        max(
+            map(
+                # 2: Get the longest length in each row
+                max(
+                    # 1: Get the textual length for each value
+                    map(length($_), @{$_})
+                ),
+                @{$ARG[0]}
+            )
+        )
+        .
+        "d";
+
+    return(
+        # 4: Make a list of lines of text containing
+        # the contents of all matrix rows
+        map(
+            # 3: Put square brackets around each row
+            sprintf(
+                "[ %s ]",
+                # 2: Make a string of uniform length out of
+                # each matrix row
+                join(
+                    ", ",
+                    # 1: Make a formatted string of uniform length
+                    # out of each matrix value in the row
+                    map(
+                        sprintf($value_format, $_),
+                        @{$_}
+                    )
+                )
+            ),
+            @{$ARG[0]}
+        )
+    );
+
+}
+
+
+