sgreen solution to challenge 075

4 files changed, 206 insertions, 22 deletions

diff --git a/challenge-075/sgreen/README.md b/challenge-075/sgreen/README.md
index 83c8300508..ad112f5bf6 100644
--- a/challenge-075/sgreen/README.md
+++ b/challenge-075/sgreen/README.md
@@ -1,39 +1,89 @@
-# Perl Weekly Challenge 074
+# Perl Weekly Challenge 075
 
 Solution by Simon Green.
 
-## TASK #1 › Majority Element
+## TASK #1 › Coins Sum
 
-This was a relatively straight forward task, with the following steps.
+The great thing about both of this week's challenges is they require some thought about how to solve them before you type `use strict;` in your editor. Strap in, this is a pretty long README file.
 
-1. Count the number of times each elements occurs, and put it in a hash
-2. Go through the hash, and return the hash key if the hash value (number of times it appears) is greater than half the length of the list. We can also exit, since only one value can meet the condition.
-3. If we haven't exited, return '-1' as no value appears more than half the time.
+For the coin toss task, it was obvious that some type of recursive subroutine was required. In this subroutine I pass three values:
+
+1. The coins available (`$coins` arrayref)
+2. The coins used so far to make the sum (`$sofar` arrayref)
+3. The amount remaining (`$amount_remaining` number, the target minus the coins used so far)
+
+Within the subroutine, I then went through the coins in order of value which resulted in one of three actions:
+
+1. If the coin is less than the remaining amount, we need more coins. This is achieved by recursively calling the subroutine, adding the current coin the the `$sofar` arrayref and reducing the amount remaining by the coin value.
+2. If the coin is the same as the remaining amount, we've found a combination (`$sofar` plus the current coin), and add that to the `@solutions` array.
+3. If the coin is greater than the remaining amount, we can't use the coins. We can also exit the loop immediately as we know larger coins will also fail to produce a solution.
+
+Some other notes:
+
+- I check that every coin is a positive number. If we had '0' coins or negative coins, the list could be endless.
+- The coins are ordered by value (low to high) and non-unique values are removed. The code would still work if we did have non-unique numbers, but that's just unnecessary.
+- My original tests would return the same solution multiple times with the order reversed. For example, it would return '1, 1, 2' and '1, 2, 1'. To avoid this, I add a check in the recursive subroutine to skip coins less than the last used coin (if any).
+- I could have put the amount and sorted unique list of coins as a global variable rather than using it in subroutine function, but global variable are just evil, mmkay? :P
 
 ### Examples
-    » ./ch-1.pl 1 2 2 3 2 4 2
-    2
 
-    » ./ch-1.pl 1 3 1 2 4 5
-    -1
+    » ./ch-1.pl 1 2 4 6
+    1, 1, 1, 1, 1, 1
+    1, 1, 1, 1, 2
+    1, 1, 2, 2
+    1, 1, 4
+    2, 2, 2
+    2, 4
+
+## TASK 2 › Largest Rectangle Histogram
 
+This tasks also involved a bit of thinking before hitting the keyboard. For the first part of the task (calculating the largest rectangle), I used the following methodology:
 
-## TASK 2 › FNR Character
+- The largest rectangle will always start at the first column.
+- Using this, I worked through the rows from left to right ( `0` to `@#array`).
+- We now know the start of the rectangle, so we can calculate all the rectangles from this point. To do this, we go through the remaining rows on the right, starting with the current row. We find the minimum value in the array for the selected rows. The size of the rectangle is ($last_row - $first_row + 1 ) × the minimum height.
+- As a bonus, I also record the rows and columns that make up the rectangle, and display this in the result. It handles situations where there is more than one combination that makes up the rectangle.
 
-This taks requires a bit more thought about how to solve it. This of course is a good thing since we don't want all tasks to be too easy.
+### Bonus round
 
-This is how I attacked it. It will be interesting if other contributors took a different approach.
+Who doesn't like bonus points? :)
 
-1. Split the string into an array called `@letters`.
-2. Work through the list (left to right) from `0` to `$#letters`. `$#` is a short cut for one less than the length of the array, assuming you don't mess with `$[` (and you NEVER want to do that!)
-3. Add that letter to the `%used` array to count the number of times it is used.
-4. Work backwards (right to left) from the current letter to the first letter. For each letter, if it has been used once, print it. If no letters are found, print '#'
-5. Print the new line character `\n`
+The major issue in tackling this part of the task is handling the width of each part of the output. Each column needs to be the length of the highest amount as the first column and last row needs to show the height of each row.
+
+I make extensive use of the [`x` operator](https://perldoc.pl/perlop#Multiplicative), which repeats a scalar or list a specified number of times, and the map and sprintf functions.
+
+The output is broken into three parts.
+
+1. Print the body of the graph. Count from the maximum value to 1, print the number, and then for each row print a '#' character if the value of the row is <= the current count.
+2. Print the row of dashes. This uses the x operator twice.
+3. Finally print the totals as the last row.
+
+Still here? Thanks for reading :)
 
 ## Examples
 
-    » ./ch-2.pl ababc
-    abb#c
+    » ./ch-2.pl 2 1 4 5 3 7
+    Largest rectangle histogram is 12 (rows 3 - 6 cols 1 - 3)
+
+    7           #
+    6           #
+    5       #   #
+    4     # #   #
+    3     # # # #
+    2 #   # # # #
+    1 # # # # # #
+    - - - - - - -
+      2 1 4 5 3 7
 
-    » ./ch-2.pl xyzzyx
-    xyzyx#
+    » ./ch-2.pl 3 2 3 5 7 5
+    Largest rectangle histogram is 15 (rows 4 - 6 cols 1 - 5)
+    
+    7         #  
+    6         #  
+    5       # # #
+    4       # # #
+    3 #   # # # #
+    2 # # # # # #
+    1 # # # # # #
+    - - - - - - -
+      3 2 3 5 7 5
diff --git a/challenge-075/sgreen/blog.txt b/challenge-075/sgreen/blog.txt
new file mode 100644
index 0000000000..4d78598e53
--- /dev/null
+++ b/challenge-075/sgreen/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-075/sgreen/README.md
diff --git a/challenge-075/sgreen/perl/ch-1.pl b/challenge-075/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..58beceaab5
--- /dev/null
+++ b/challenge-075/sgreen/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use List::Util qw(uniqnum);
+use 5.10.1;
+
+sub _calculate {
+    my ( $coins, $sofar, $remaining_amount ) = @_;
+    my @solutions = ();
+
+    # To ensure we don't get duplicate results (e.g 2 + 4 / 4 + 2), we
+    #  only consider coins greater than or equal to the last used coin
+    my $last_coin = scalar(@$sofar) ? $sofar->[-1] : 0;
+
+    foreach my $coin (@$coins) {
+        next if $coin < $last_coin;
+
+        if ( $coin < $remaining_amount ) {
+            # We need to find some more coins
+            push @solutions,
+              _calculate(
+                $coins,
+                [ @$sofar, $coin ],
+                $remaining_amount - $coin
+              );
+        }
+        elsif ( $coin == $remaining_amount ) {
+            # We have a solution!
+            push @solutions, [ @$sofar, $coin ];
+            # Higher coins will exceed the remaining amount
+            last;
+        }
+        else {
+            # This coin (and all larger coins) will exceed the remaining amount
+            last;
+        }
+    }
+
+    return @solutions;
+}
+
+sub main {
+    my $S = pop;
+    my @C = @_;
+
+    # Sanity check the inputs
+    if ( !scalar(@C) ) { die "Usage: $0 coin1 .. coin_n sum\n"; }
+    foreach ( @C, $S ) {
+        die "Value $_ is not a positive number"
+          unless $_ > 0;
+    }
+
+    # We want to sort the coins numerically, and remove dups
+    @C = uniqnum sort { $a <=> $b } map { 0 + $_ } @C;
+
+    my @solutions = _calculate( \@C, [], $S );
+    say join ', ', @$_ foreach @solutions;
+}
+
+main(@ARGV);
diff --git a/challenge-075/sgreen/perl/ch-2.pl b/challenge-075/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..82810a0c8b
--- /dev/null
+++ b/challenge-075/sgreen/perl/ch-2.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use List::Util qw(min max);
+use 5.10.1;
+
+sub _format_val {
+    # Return something like "row 1" or "rows 1 - 3"
+    my ( $type, $low, $high ) = @_;
+    return $low == $high ? "$type $low" : "${type}s $low - $high";
+}
+
+sub main {
+    my @array = @_;
+
+    # Sanity check
+    die "You must enter at least one value" if $#array == -1;
+
+    foreach my $value (@array) {
+        die "Value '$value' is not an integer\n"
+          unless $value =~ /^[1-9][0-9]*$/;
+    }
+
+    # This stores the results
+    my $maximum   = 0;
+    my @rows      = ();
+    my $max_value = max @array;
+
+    # Let's calculate the largest histogram rectangle
+    for my $left ( 0 .. $#array ) {
+        for my $right ( $left .. $#array ) {
+            # Find the minimum value from the rows, and therefore the
+            #  size of the rectangle
+            my $min  = min( @array[ $left .. $right ] );
+            my $rect = ( $right - $left + 1 ) * $min;
+            if ( $rect >= $maximum ) {
+                if ( $rect > $maximum ) {
+                    $maximum = $rect;
+                    @rows    = ();
+                }
+                push @rows,
+                  _format_val( 'row', $left + 1, $right + 1 ) . ' '
+                  . _format_val( 'col', 1, $min );
+            }
+        }
+    }
+
+    # Display the result
+    say "Largest rectangle histogram is $maximum (", join( '; ', @rows ), ')';
+    say '';
+
+    # BONUS POINTS: Display the histogram
+    my $width = length($max_value);
+    my $empty = ' ' x ($width);
+    my $fill  = '#' . ( ' ' x ( $width - 1 ) );
+
+    for ( my $i = $max_value ; $i > 0 ; $i-- ) {
+        say join ' ',
+          sprintf( "\%${width}d", $i ),
+          map { $_ >= $i ? $fill : $empty } @array;
+    }
+
+    # The dashes row
+    say join ' ', ( '-' x $width ) x ( $#array + 2 );
+
+    # And finally the counts for each array
+    say join ' ', ( ' ' x $width ), map { sprintf "\%-${width}s", $_ } @array;
+
+}
+
+main(@ARGV);