Perl Weekly Challenge #79, Task #2
Daniel Mantovani
Posted on September 24, 2020
TASK #2 › Trapped Rain Water
Submitted by: Mohammad S Anwar
You are given an array of positive numbers @N.
Write a script to represent it as Histogram Chart and find out how much water it can trap.
Example 1:
Input: @N = (2, 1, 4, 1, 2, 5)
The histogram representation of the given array is as below.
5 #
4 # #
3 # #
2 # # # #
1 # # # # # #
_ _ _ _ _ _ _
2 1 4 1 2 5
Looking at the above histogram, we can see, it can trap 1 unit of rain water between 1st and 3rd column. Similary it can trap 5 units of rain water betweem 3rd and last column.
Therefore your script should print 6.
Example 2:
Input: @N = (3, 1, 3, 1, 1, 5)
The histogram representation of the given array is as below.
5 #
4 #
3 # # #
2 # # #
1 # # # # # #
_ _ _ _ _ _ _
3 1 3 1 1 5
Looking at the above histogram, we can see, it can trap 2 units of rain water between 1st and 3rd column. Also it can trap 4 units of rain water between 3rd and last column.
Therefore your script should print 6.
Last date to submit the solution 23:59 (UK Time) Sunday 27th September 2020.
Proposed solution:
First of all, we are asked to print the histogram. This is not as trivial as it sounds, specially if the numbers involved have more than 1 digit, because that can misalign your columns.
To make all numbers uniform, we are using a sprintf format string with "%d" to accommodate the biggest number. For example, if the biggest number is 15, we need two digits so the used format will be "%2d" for all the numbers.
Histogram printing as requested
We evaluate each line without any spaces first, then we interpolate spaces between letters just to allow a nicer final view.
The following script would allow to print the histogram in that way:
use strict;
use warnings;
use v5.20;
# get input array from command line
my @N = @ARGV;
die "usage: perl $0 <space separate numbers (at least 3)>" unless @N > 2;
# check that all numbers are positive, and find max value
my $max = -1;
for my $n (@N) {
die "$n is not a proper positive number" unless $n && $n =~ /^\d+$/;
$max = $n if $n > $max;
}
# we need to take care of the amount of decimal places needed
# form $max, so the histogram can look ok
my $places = length $max;
# so the format to print numbers should be:
my $dfmt = "\%${places}d";
for my $r (reverse 1 .. $max) {
# construct horizontal row, starting from $max
my $line = join('', map { $_ >= $r ? '#' : ' ' } @N);
# we will add separating spaces between symbols
$line = ' ' . join(' ', split('', $line));
say sprintf($dfmt, $r) . $line;
}
# closing line
say " " x ($places - 1) . '_' . ' _' x @N;
# now print the base rows of the histogram
for my $i (0 .. $places - 1) {
my $line = join(' ', map { substr(sprintf($dfmt, $_), $i, 1) } @N);
say " " x ($places + 1) . $line;
}
Count trapped water units
To find how much water we can trap, we can take a look at a typical row of the histogram, before we add the spaces between letters (only the part of '#'s and spaces is important):
...
2# # #
...
So we have a '#', then 1 space, another '#', 2 more spaces, and finally another '#'.
In this case, we can trap 1 unit of water in the first space, and 2 more units in the 2 spaces after.
The pattern we are looking for then is something like /#\s+#/. Note also that the '#' in the middle should be matched against the first group (1 space), and also against the second group (2 spaces).
To do that we will replace al spaces in the match with another letter (a "W" for instance), so we can reset the regex and start again and match the following one.
The final expression will be:
while ($line =~ s/#(\s+)#/'#'. 'W' x length($1) . '#'/e) { }
This sentence will look for the first match, then replace the inner spaces by "W"s, and then start again until no more matches are found.
Note the /e modifier at the end of the regex, that means that the second part of the substitution is actually an expression to be evaluated (i.e. '#' . 'W' x length($1) . '#'
The final script proposed is then:
use strict;
use warnings;
use v5.20;
# get input array from command line
my @N = @ARGV;
die "usage: perl $0 <space separate numbers (at least 3)>" unless @N > 2;
# check that all numbers are positive, and find max value
my $max = -1;
for my $n (@N) {
die "$n is not a proper positive number" unless $n && $n =~ /^\d+$/;
$max = $n if $n > $max;
}
# we need to take care of the amount of decimal places needed
# form $max, so the histogram can look ok
my $places = length $max;
# so the format to print numbers should be:
my $dfmt = "\%${places}d";
my $acc_water = 0;
for my $r (reverse 1 .. $max) {
# construct horizontal row, starting from $max
my $line = join('', map { $_ >= $r ? '#' : ' ' } @N);
# we need to identify in this particular line how many units
# of rain water we can trap. We will replace with a "W" every
# one of those units.
#
# We search for the pattern #< n spaces>#, and as this will
# allow to trap n units, we will replace the spaces with the
# letter "W"
# Note that after replacing one group, we should start over the
# same line. We cannot continue looking because the last caracter
# matched ('#') may be necesary for the next match. So we cannot
# use a /g to repeat the search, we need to start over the
# matching, but with the spaces changed to "W" so we don't get
# the same match but the following one, if any.
# For the regex, we use substitution (s///) and we calculate
# the replacement with "W" x length(spaces captured), and leave
# the '#'s in place. /e means we are evaluating the second
# argument, instead of taking it literally
#
while ($line =~ s/#(\s+)#/'#'. 'W' x length($1) . '#'/e) { }
# units this row can trap is the amount of "W"s we have on it
# feel free to change the transliteration operator to tr/W/W/
# to keep an indication of the allocated water units
$acc_water += $line =~ tr/W/ /;
# we will add separating spaces between symbols, note we do that after any
# calculation
$line = ' ' . join(' ', split('', $line));
say sprintf($dfmt, $r) . $line;
}
# closing line
say " " x ($places - 1) . '_' . ' _' x @N;
# now print the base rows of the histogram
for my $i (0 .. $places - 1) {
my $line = join(' ', map { substr(sprintf($dfmt, $_), $i, 1) } @N);
say " " x ($places + 1) . $line;
}
say "Trapped water: $acc_water";
Posted on September 24, 2020
Join Our Newsletter. No Spam, Only the good stuff.
Sign up to receive the latest update from our blog.