Merge pull request #4846 from mattneleigh/pwc128

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

2 files changed, 526 insertions, 0 deletions

diff --git a/challenge-128/mattneleigh/perl/ch-1.pl b/challenge-128/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..e11da3ae66
--- /dev/null
+++ b/challenge-128/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,279 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @matrices = (
+    # This matrix actually has two equivalent
+    # rectangles of zeros... my method tends
+    # to be biased toward the vertically
+    # oriented ones in such cases
+    [
+        [ 1, 0, 0, 0, 1, 0 ],
+        [ 1, 1, 0, 0, 0, 1 ],
+        [ 1, 0, 0, 0, 0, 0 ]
+    ],
+    [
+        [ 0, 0, 1, 1 ],
+        [ 0, 0, 0, 1 ],
+        [ 0, 0, 1, 0 ]
+    ],
+    # Another test case
+    [
+        [ 1, 0, 0, 0, 1, 1, 1 ],
+        [ 1, 1, 1, 1, 1, 0, 1 ],
+        [ 1, 1, 0, 0, 1, 0, 1 ],
+        [ 1, 1, 0, 0, 1, 0, 1 ],
+        [ 1, 1, 1, 1, 1, 1, 1 ],
+    ]
+);
+my $matrix;
+
+foreach $matrix (@matrices){
+    print("Input:\n");
+    print_matrix($matrix, "    ");
+
+    print("Output:\n");
+    print_matrix(find_max_rectangle_zeros($matrix), "    ");
+
+    print("\n");
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Find the largest rectangular area of zeros in a matrix (2D array) of
+# numerical values
+# Takes one argument:
+# * A ref to the matrix
+# Returns:
+# * A ref to a matrix sliced from the larger matrix, which contains the largest
+#   rectangular area of zeros found therein
+# Adapted from the method seen here:
+# https://www.youtube.com/watch?v=g8bSdXCG-lA
+################################################################################
+sub find_max_rectangle_zeros{
+    my $matrix = shift();
+
+    my $i;
+    my $j;
+    my @histogram;
+    my $hist_data;
+    my $max_hist_data = { area => 0 };
+
+    @histogram = map({ 0 } (0 .. $#$matrix));
+    $i = scalar(@{$matrix->[0]});
+    while($i--){
+        $j = scalar(@{$matrix});
+        while($j--){
+            if($matrix->[$j][$i]){
+                # The value is 1; reset this cell in the
+                # histogram
+                $histogram[$j] = 0;
+            } else{
+                # The value is 0; increment this cell in
+                # the histogram
+                $histogram[$j]++;
+            }
+        }
+
+        # Find the largest rectangle under the
+        # current histogram and see if it's
+        # bigger than any we've seen yet
+        $hist_data = find_max_rectangle_under_histogram(\@histogram);
+        if($hist_data->{area} > $max_hist_data->{area}){
+            # Area is bigger- make a note of it, and
+            # where we found it
+            $max_hist_data = $hist_data;
+            $max_hist_data->{matrix_index} = $i;
+        }
+    }
+
+    return(
+        # Make an anonymous array of refs to
+        # all the slices
+        [
+            map(
+                {
+                    # Make an anonymous array out of a
+                    # slice from this row of the matrix
+                    $j = $_;
+                    [
+                        map(
+                            { $matrix->[$j][$_] }
+                            # Horizontal range
+                            $max_hist_data->{matrix_index}
+                            ..
+                            $max_hist_data->{matrix_index}
+                                + $max_hist_data->{height} - 1
+                        )
+                    ]
+                }
+                # Vertical range
+                $max_hist_data->{left} .. $max_hist_data->{right}
+            )
+        ]
+    );
+
+}
+
+
+
+################################################################################
+# Find the maximum rectangular area under a histogram
+# Takes one argument:
+# * A ref to an array of numerical values that constitutes the histogram
+# Returns:
+# * A a ref to a hash containing the following values:
+#   area: The area of the largest rectangle under the histogram
+#   height: The height of the rectangle
+#   left: The index of the left end of the rectangle
+#   right: The index of the right end of the rectangle
+# Adapted from the method seen here:
+# https://www.youtube.com/watch?v=vcv3REtIvEo
+################################################################################
+sub find_max_rectangle_under_histogram{
+    my $histogram = shift();
+
+    my $i;
+    my @stack = ();
+    my @right_limits;
+    my @left_limits;
+    my $max_area;
+    my $max_area_index;
+
+    # Scan to the right, looking for
+    # left limits
+    for $i (0 .. $#$histogram){
+        if(scalar(@stack)){
+            # Index stack is not empty...
+            # Pop the index stack until the top value
+            # is less than the current histogram
+            # value
+            while(
+                scalar(@stack)
+                &&
+                ($histogram->[$i] <= $histogram->[$stack[$#stack]])
+            ){
+                pop(@stack);
+            }
+            if(scalar(@stack)){
+                $left_limits[$i] = $stack[$#stack] + 1;
+            } else{
+                # Stack is empty
+                $left_limits[$i] = 0;
+            }                
+            push(@stack, $i);
+        } else{
+            # Index stack is empty
+            $left_limits[$i] = 0;
+            push(@stack, $i);
+        }
+    }
+
+    # Clear the stack
+    @stack = ();
+
+    # Scan to the left, looking for
+    # right limits
+    $i = scalar(@{$histogram});
+    while($i--){
+        if(scalar(@stack)){
+            # Index stack is not empty...
+            # Pop the index stack until the top value
+            # is less than the current histogram
+            # value
+            while(
+                scalar(@stack)
+                &&
+                ($histogram->[$i] <= $histogram->[$stack[$#stack]])
+            ){
+                pop(@stack);
+            }
+            if(scalar(@stack)){
+                $right_limits[$i] = $stack[$#stack] - 1;
+            } else{
+                # Stack is empty
+                $right_limits[$i] = $#$histogram;
+            }                
+            push(@stack, $i);
+        } else{
+            # Index stack is empty
+            $right_limits[$i] = $#$histogram;
+            push(@stack, $i);
+        }
+    }
+
+    # Calculate areas and find the
+    # maximum
+    $max_area = 0;
+    $max_area_index = 0;
+    for $i (0 .. $#$histogram){
+        my $area;
+
+        # Calculate the area of the rectangle which
+        # completely utilizes the height of this
+        # 'bar' in the histogram
+        $area =
+            $histogram->[$i]
+            *
+            ($right_limits[$i] - $left_limits[$i] + 1);
+
+        if($area > $max_area){
+            # This area is the biggest yet;
+            # take note of its size and
+            # location
+            $max_area = $area;
+            $max_area_index = $i;
+        }
+    }
+
+    return(
+        {
+            area => $max_area,
+            height => $histogram->[$max_area_index],
+            left => $left_limits[$max_area_index],
+            right => $right_limits[$max_area_index]
+        }
+    );
+
+}
+
+
+
+################################################################################
+# Print the contents of a matrix to STDOUT
+# Takes two arguments:
+# * A ref to an array of arrays whose contents are to be printed to STDOUT,
+#   e.g.:
+#   [
+#       [ 1, 2, 3, 4 ],
+#       [ 5, 6, 7, 8 ]
+#   ] 
+# * An optional string to prepend to each line of the output written to STDOUT,
+#   which can be used to establish an indent if desired
+# Returns no meaningful value
+################################################################################
+sub print_matrix{
+    my $matrix = shift();
+    my $indent = shift();
+
+    $indent = "" unless(defined($indent));
+
+    foreach(@{$matrix}){
+        printf("%s[ %s ]\n", $indent, join(" ", @{$_}));
+    }
+
+}
+
+
+
diff --git a/challenge-128/mattneleigh/perl/ch-2.pl b/challenge-128/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..b600f6835a
--- /dev/null
+++ b/challenge-128/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,247 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @schedules = (
+    [
+        [ qw(11:20 14:30) ], # Arrivals
+        [ qw(11:50 15:00) ]  # Departures
+    ],
+    [
+        [ qw(10:20 11:00 11:10 12:20 16:20 19:00) ], # Arrivals
+        [ qw(10:30 13:20 12:40 12:50 20:20 21:20) ]  # Departures
+    ],
+    # Additional test cases
+    [
+        # Arrivals
+        [ '09:00', '10:30', '10:45', '17:30', '23:30', '00:00', '00:00' ],
+        # Departures
+        [ '09:15', '10:50', '11:00', '17:35', '00:10', '00:20', '01:30' ]
+    ]
+);
+my $schedule;
+
+foreach $schedule (@schedules){
+    printf(
+        "Arrivals:   %5s\n",
+        join(", ", @{$schedule->[0]})
+    );
+    printf(
+        "Departures: %5s\n",
+        join(", ", @{$schedule->[1]})
+    );
+
+    # Specify an "end of business day" of 02:00
+    printf(
+        "Platforms required: %d\n\n",
+        calculate_min_platforms($schedule, 2)
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine the minimum number of platforms required to accommodate trains
+# using a station following a specified schedule
+# Takes one required argument and one optional argument:
+# * A required schedule of trains arriving and departing at this station, in
+#   the form of an array ref containing two parallel arrays, the first for
+#   arrival times, and the second for departure times, e.g.:
+#   [
+#       [ '09:00', '10:30', '10:45', '17:30' ],
+#       [ '09:15', '10:50', '11:00', '17:35' ]
+#   ]
+# * An optional "end of business day" time may be specified as a number of
+#   hours (no minutes) past midnight if trains may arrive late- a time after
+#   midnight but before this time will be considered part of the previous day's
+#   schedule for interval calculation purposes.  This value should be a time
+#   when no trains are expected to be at the station for accurate computation
+#   of dwell times.  If this is not specified, midnight (an effective value of
+#   0) will be used.
+# Returns:
+# * The number of platforms required to accommodate the maximum number of
+#   trains expected to be at this station at one time on the given schedule
+################################################################################
+sub calculate_min_platforms{
+    my $schedule = shift();
+    my $EOB = shift();
+
+    # Default "end of business day" is
+    # midnight if not otherwise specified
+    $EOB = 0
+        unless(defined($EOB));
+
+    # The action happens from the inside of
+    # this call to the outside- the steps are
+    # numbered
+    return(
+        # 3) Find the length of the longest list of
+        # overlaps
+        max_list_length(
+            # 2) Search the dwell time interval list for
+            # overlaps
+            find_overlaps(
+                # 1) Rearrange the schedule into a list of
+                # station dwell time intervals for each train,
+                # converting the times into purely numerical
+                # values (minutes since midnight) en passant
+                map(
+                    {
+                        [
+                            convert_time($schedule->[0][$_], $EOB),
+                            convert_time($schedule->[1][$_], $EOB)
+                        ]
+                    }
+                    (0 .. $#{$schedule->[0]})
+                )
+            ) # End call to find_overlaps()
+        ) # End call to max_list_length()
+
+        # 4) Add one because the lists of overlaps
+        # we counted don't include the train being
+        # overlapped
+        + 1
+    );
+
+}
+
+
+
+################################################################################
+# Find the length of the longest array in a list of array references
+# Takes one argument:
+# * A list of references to arrays
+# Returns:
+# * The length of the longest array in the list
+################################################################################
+sub max_list_length{
+
+    my $len;
+    my $maxlen = 0;
+
+    foreach(@ARG){
+        $len = scalar(@{$_});
+        if($len > $maxlen){
+            $maxlen = $len;
+        }
+    }
+
+    return($maxlen);
+
+}
+
+
+
+################################################################################
+# Convert a time in HH:MM format to a number of minutes since midnight.  The
+# time must be in 24-hour format (HH ranges from 0 to 23, with leading zeros
+# permitted but not required; MM ranges from 0 to 59, with leading zeros.
+# required) with no other characters present.  An "end of business day" time is
+# specified as a number of hours (no minutes) past midnight if trains may
+# arrive late- a time after midnight but before this time will be considered
+# part of the previous day's count of minutes (a time of 01:00 will be
+# interpreted as being 1500 minutes past midnight if a value of 3 is specified,
+# for example).  This value should be a time when no trains are expected to be
+# at the station for accurate computation of dwell times.  If this is not
+# desired, a value of 0 (effectively midnight) may be used.
+# Takes two arguments
+# * A string describing the time to convert (see above)
+# * An hour that represents an end of the "business day" after midnight (see
+#   above)
+# Returns on success:
+# * The number of minutes since midnight represented by the time in the
+#   supplied string
+# Returns on error:
+# * undef if the argument(s) does not meet the specifications described above
+################################################################################
+sub convert_time{
+    my $time = shift();
+    my $EOB = shift();
+
+    if($time =~ m/^(\d{1,2}):(\d{2})$/ && ($1 < 24) && ($2 < 60)){
+        if($EOB && ($1 < $EOB)){
+            # Nonzero EOB
+            return(1440 + $1 * 60 + $2);
+        } else{
+            # Zero EOB
+            return($1 * 60 + $2);
+        }
+    } else{
+        return(undef);
+    }
+
+}
+
+
+
+################################################################################
+# Find overlaps between numerical intervals in a list
+# Takes one argument:
+# * A list of refs to intervals- arrays containing two numerical values, which
+#   must appear in ascending order (e.g. [1, 5] but not [7, 3])
+# Returns:
+# * A list of refs to arrays containing the indices of intervals that overlap
+#   with the intrval in the corresponding position in the original list.  If no
+#   overlaps were found for that interval, the corresponding array in the
+#   returned list will be empty.  Note that every overlapping interval will
+#   result in each interval's index being stored in the other's overlap array.
+#
+# Example:
+#   @intervals = ( [3, 10], [3, 5], [0, 2], [7, 10], [4, 9] );
+#   @overlaps = find_overlaps(@intervals);
+#   # @overlaps ==
+#   #     ( [ 1, 3, 4 ], [ 0, 4 ], [  ], [ 0, 4 ], [ 0, 1, 3 ] )
+#
+################################################################################
+sub find_overlaps{
+
+    my $i;
+    my $j;
+    my @overlap_intervals;
+
+    # Set up empty array refs to match the
+    # number of intervals we'll be looking at
+    @overlap_intervals = map({ [] } (0 .. $#ARG));
+
+    # Loop over intervals from the 1th (as
+    # opposed to the 1st) onward
+    for $i (1 .. $#ARG){
+        # Loop over intervals from the 0th to the
+        # (i - 1)th
+        for $j (0 .. ($i - 1)){
+            # Basically:
+            # if(max(beginnings) - min(ends) <= 0)
+            if(
+                # Maximum of the beginnings of the ranges
+                ($ARG[$j][0] > $ARG[$i][0] ? $ARG[$j][0] : $ARG[$i][0])
+                - 
+                # Minimum of the ends of the ranges
+                ($ARG[$j][1] < $ARG[$i][1] ? $ARG[$j][1] : $ARG[$i][1])
+                <=
+                0
+            ){
+                # Store each overlapping interval's index
+                # in the array corresponding to the other
+                push(@{$overlap_intervals[$i]}, $j);
+                push(@{$overlap_intervals[$j]}, $i);
+            }
+        }
+    }
+
+    return(@overlap_intervals);
+
+}
+
+
+