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

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

2 files changed, 283 insertions, 0 deletions

diff --git a/challenge-271/mattneleigh/perl/ch-1.pl b/challenge-271/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..93c114f0f7
--- /dev/null
+++ b/challenge-271/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,189 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @matrices = (
+    [
+        [ 0, 1 ],
+        [ 1, 0 ]
+    ],
+    [
+        [ 0, 0, 0 ],
+        [ 1, 0, 1 ]
+    ],
+    [
+        [ 0, 0 ],
+        [ 1, 1 ],
+        [ 0, 0 ]
+    ]
+);
+
+print("\n");
+foreach my $matrix (@matrices){
+    printf(
+        "Input: \$matrix = [\n%s\n                 ]\nOutput: %d\n\n",
+        join(
+            ",\n",
+            map(
+                "                     " . $_,
+                matrix_to_strings($matrix)
+            )
+        ),
+        row_with_most_ones($matrix)
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine which row (1-indexed) in a binary matrix (consisting solely of
+# zeros and ones) contains the greatest number of ones; if more than one row
+# have the maximum count, the first such instance is reported
+# Takes one argument:
+# * A ref to a 2D array that forms a binary matrix (e.g.
+#       [
+#           [ 0, 1 ],
+#           [ 1, 0 ]
+#       ]
+#   )
+# Returns:
+# * The 1-indexed row at which the largest number of ones was seen; if there
+#   were multiple rows with this count, the lowest index will be returned (e.g.
+#   1 )
+################################################################################
+sub row_with_most_ones{
+    my $matrix = shift();
+
+    my $ones;
+    my @counts;
+
+    # Examine each row of the matrix
+    for my $j (0 .. $#$matrix){
+        $ones = 0;
+
+        # Count the ones in this row
+        $ones = scalar(
+            grep(
+                1 == $_,
+                @{$matrix->[$j]}
+            )
+        );
+
+        # Skip ahead if we found no ones
+        next
+            unless($ones);
+
+        # Store this row's position (1-indexed)
+        # if we HAVEN'T seen this total of ones
+        # before- we are only keeping track of
+        # the first instance of each
+        $counts[$ones] = [$ones, $j + 1]
+            unless($counts[$ones]);
+    }
+
+    return(
+        # 3. Grab the first (largest) count,
+        # extracting the row at which it was
+        # first seen
+        (
+            # 2. Sort the counts in descending
+            # order
+            sort(
+                { $b->[0] <=> $a->[0] }
+                # 1. Filter out undefined elements
+                # (counts that haven't been seen)
+                grep(defined, @counts)
+            )
+        )[0][1]
+    );
+
+}
+
+
+
+
+################################################################################
+# 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]}
+        )
+    );
+
+}
+
+
+
diff --git a/challenge-271/mattneleigh/perl/ch-2.pl b/challenge-271/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..9c08973d02
--- /dev/null
+++ b/challenge-271/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    # Given cases
+    [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ],
+    [ 1024, 512, 256, 128, 64 ],
+
+    # Additional test case(s)
+    [ 18446744073709551615, 7, 20, 128, 18446744073709551614 ]
+);
+
+print("\n");
+foreach my $integer_list (@integer_lists){
+    printf(
+        "Input: \@ints = (%s)\nOutput: (%s)\n\n",
+        join(", ", @{$integer_list}),
+        join(", ", sort_ints_by_one_bit_count(@{$integer_list}))
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Sort a list of positive integers in ascending order by the number of ones in
+# their binary representation; numbers having the same quantity of ones will be
+# ordered by their numerical value
+# Takes one argument:
+# * A list of positive integers to examine (e.g. ( 0, 1, 2, 3, 4, 5, 6, 7, 8 )
+#   )
+# Returns:
+# * The list of integers sorted by the count of ones in their binary
+#   representation (e.g. ( 0, 1, 2, 4, 8, 3, 5, 6, 7 ) )
+################################################################################
+sub sort_ints_by_one_bit_count{
+
+    my $int;
+    my $one_count;
+
+    return(
+        # 3. Build a list of numerical values
+        # extracted from the sorted list of pairs
+        map(
+            $_->[0],
+
+            # 2. Sort the list in ascending order by the
+            # count of ones unless the number of ones is
+            # equal, in which case sort by numerical
+            # value
+            sort(
+                {
+                    $a->[1] == $b->[1] ?
+                        $a->[0] <=> $b->[0]
+                        :
+                        $a->[1] <=> $b->[1]
+                }
+                # 1. Build a list of numerical values paired
+                # with the counts of ones in each
+                map(
+                    {
+                        $int = $_;
+                        $one_count = 0;
+
+                        while($int){
+                            $one_count++
+                                if($int & 0x01);
+                            $int >>= 1;
+                        }
+
+                        [ $_, $one_count ];
+
+                    }
+                    @ARG
+                )
+            )
+        )
+    );
+
+}
+
+
+