Throw the Windows Wide Open — Change Is In the Air

Wherein we look to find the biggest opening we can and try and figure out all the different ways to make things come out even with the tools we have.

THE WEEKLY CHALLENGE – PERL & RAKU #75

TASK #1 › Coins Sum

Submitted by: Mohammad S Anwar

You are given a set of coins @C, assuming you have infinite amount of each coin in the set.
Write a script to find how many ways you make sum $S using the coins from the set @C.

Example:

Input:
    @C = (1, 2, 4)
    $S = 6

Output: 6
There are 6 possible ways to make sum 6.
a) (1, 1, 1, 1, 1, 1)
b) (1, 1, 1, 1, 2)
c) (1, 1, 2, 2)
d) (1, 1, 4)
e) (2, 2, 2)
f) (2, 4)

Method

At heart this challenge is one of combinatorics; we are looking for combinations with repetition that satisfy a certain requirement. Because we don’t know at the onset how many coins will be needed to make the sum, an open-ended recursive approach seems sensible. We will walk the possibilities and assemble coin groupings, adding another coin on every recursion, keeping a running tally of the amount left to be tendered as we go.

If we diminish the options available in the coin bag as the total amount to be made up decreases, we increasingly constrain the field of possibilities until there are only two: either we have a group of coins that total to the requested sum, or it is no longer possible to add another coin to make up the difference and that particular grouping will not work. We end up filtering the coin bag twice on each recursion: once to remove coins larger than the remaining amount before choosing the next coin, then again after we have selected a coin to limit the bag passed forward to only those coins of equal value or smaller. This last step serves to keep the solution sets distinct; for example given the two equivalent groupings (25, 5) and (5, 25) only the first will be allowed. As the coin list going in is also ordered, this too is be reflected in the output, making the patterning even easier to see.

The two solutions are both based around a similar recursive subroutine: given a target amount, a set of coins, and a partial group of coins already selected, there are two edge cases to stop the loop: either the target amount drops to 0, indicating success, or the coin bag is empty, indicating failure. If the path is successful, the finished group of coins is added to a @solutions array.

Perl Solution

I spent some time exactly duplicating the example output, including a proper English sentence using Damian Conway’s excellent Lingua::EN::Inflexion module. I really just wanted to use that again, to play around a bit with NLP, and ended up taking the report as a challenge, including the alphabetical sequencing identifiers. Because the number of solutions for larger amounts can potentially become quite large, I has the sequence automatically jump to “aa)”, “ab)”, “ac)” etc. after the 26th option, and eventually “aaa)” past that.

~/PWC/75_1_change_in_the_air.pl 27
--------------------------------------------------------------------------------
Input:
    @C = (2 5 10 25)
    $S = 27

Output: 7
There are seven possible ways to make the sum 27.
	a)  (5, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
	b)  (5, 5, 5, 2, 2, 2, 2, 2, 2)
	c)  (5, 5, 5, 5, 5, 2)
	d)  (10, 5, 2, 2, 2, 2, 2, 2)
	e)  (10, 5, 5, 5, 2)
	f)  (10, 10, 5, 2)
	g)  (25, 2)

use warnings;
use strict;
use feature ":5.26";

use Lingua::EN::Inflexion;

## ## ## ## ## MAIN:

## in
my $S      = shift @ARGV // 27;
our @coins = sort { $a <=> $b} @ARGV;
@coins     = (2,5,10,25) if ! @ARGV;
our @solutions;

## work
get_coin_groups($S);

## out
print_output(\@solutions);

## ## ## ## ## SUBS:

sub get_coin_groups {
    my ($amt, $group, $bag) = @_;
    $group //= [];
    $bag     //= \@coins;
    
    ## base case, cashed out
    if ($amt == 0) {
        push @solutions, $group;
        return;
    }
    
    ## limit coin bag to those smaller or equal to the current amount
    my @coin_bag = grep { $_ <= $amt } $bag->@*;
    
    ## edge case, cannot complete group with remaining coins
    if (@coin_bag == 0) {
        return;
    }
    
    for my $coin ( @coin_bag ) {        
        ## limit coin bag to this coin or smaller
        ## keeps groups ordered and disallows duplicate rearrangements
        my @smaller_coin_bag = grep { $_ <= $coin } $bag->@*; 
        get_coin_groups( $amt - $coin, [@$group, $coin], \@smaller_coin_bag );
    }
}

sub print_output {
    my ($output, $sum ) = @_;
    my $count = scalar $output->@*;
    
    say<<"__EOD__";
Input:
    \@C = (@coins)
    \$S = $S
__EOD__
 
    say "Output: $count";
    my $str = inflect("<#d:$count>There <V:is> <#wnc:$count> possible <N:ways> to make the sum $S.");
    say $str;
    
    my @letter_prefixes = ('a'..'z', 'aa'..'zz', 'aaa'..'zzz');
    say "\t", shift @letter_prefixes, ')  (', (join ', ', $_->@*), ')' for @solutions;

}

Raku Solution

unit sub MAIN ($S = 27, *@coins) ;

@coins = (10,2,5,25) if @coins.elems == 0;
@coins .= sort( { $^a <=> $^b } );
my @solutions;

## work
get_coin_groups($S);

## out
print_output(@solutions);

## ## ## ## ##

sub get_coin_groups ($amt, @group = [], @bag = @coins) {

    ## base case, cashed out
    $amt == 0 and return @solutions.push: @group;

    ## limit coin bag to those smaller or equal to the current amount
    my @coin_bag = @bag.grep: { $_ <= $amt } ;
    
    ## edge case, cannot complete group with remaining coins
    @coin_bag == 0 and return;

    for @coin_bag -> $coin {
        ## limit coin bag to this coin or smaller
        ## keeps groups ordered and disallows duplicate rearrangements
        my @smaller_coin_bag = @bag.grep: { $_ <= $coin } ;
        get_coin_groups( $amt - $coin, ( |@group, $coin ) , @smaller_coin_bag );
    }
}

sub print_output ($output) {
    my $count = $output.elems;
    
    say "Input:\n    \@C = ", @coins;
    say "    \$S = $S\n";
    say "Output: $count";
    say $count == 1 
        ?? "There is one possible way to make sum $S"
        !! "There are $count ways to make sum $S";
        
    
    my @letter_prefixes = |('a'..'z'), |('aa'..'zz');
    say "\t", @letter_prefixes.shift, ') ', $_ for @solutions;

}

---

TASK #2 › Largest Rectangle Histogram

Submitted by: Mohammad S Anwar

You are given an array of positive numbers @A.
Write a script to find the largest rectangle histogram created by the given array.

Example 1:

Input: @A = (2, 1, 4, 5, 3, 7)
  
     7           #
     6           #
     5       #   #
     4     # #   #
     3     # # # #
     2 #   # # # #
     1 # # # # # #
     _ _ _ _ _ _ _
       2 1 4 5 3 7

Looking at the above histogram, the largest rectangle (4 x 3) is formed by columns (4, 5, 3 and 7).

Output: 12

Example 2:

Input: @A = (3, 2, 3, 5, 7, 5)

Input: @A = (3, 2, 3, 5, 7, 5)

     7         #
     6         #
     5       # # #
     4       # # #
     3 #   # # # #
     2 # # # # # #
     1 # # # # # #
     _ _ _ _ _ _ _
       3 2 3 5 7 5

Looking at the above histogram, the largest rectangle (3 x 5) is formed by columns (5, 7 and 5).

Output: 15

Method

The rectangles requested, the ones that we’re looking for, are limited in height by the smallest element contained within a span defined by a given set of indices. Put another way this is the minimum value of the array within the range defined by the span. We are tasked to find the largest of these available, so by looking at every range set within the bounds of the array, we can find the corresponding minimum for each range; multiplying that by the width of the window gives us the area of the rectangle within.

We are asked to find “the” largest rectangle, but there’s nothing about the criteria that precludes having more than one area of a given size. We could just output one result, but that just doesn’t seem complete. If we’re going to allow for multiple equal areas, outputting all values, one way to do this is to keep all the rectangle data and review it and select before reporting. We’ll keep everything in an array of arrays, with a structure for area, start index, end index, and height.

We will choose to not consider a single data point to be a proper rectangle, as more of a line, so in altering the input of EXAMPLE 2 to the list (3, 2, 3, 5, 7, 16), the result would still be 15, being the rectangle with height 5 over (5,7,16), rather than just the 16 value. It would be easy enough to fudge the iterators to make it work that way, but I see a single point as a degenerate and honestly slightly boring case, overly sensitive to outliers and signal noise. Let’s keep it interesting and say rectangles need at minimum width 2.

Perl Solution

For the Perl solution we can set up a couple of nested loops to get the endpoints of the ranges, then take the minimum from there, using List::Util::min(). Once our structures are stored, we can reverse sort the list by area, taking the first value and then finding all other rectangles that match the value.

~/Code/PWC/75_2_windows_wide_open.pl
--------------------------------------------------------------------------------
array (16 17 19 12 21 6 23 10 14 18 2 4)

rectangle found at:
    start index 0
    end   index 4
    height      12
    width       5
    area        60


rectangle found at:
    start index 0
    end   index 9
    height      6
    width       10
    area        60

use warnings;
use strict;
use feature ":5.26";

use List::Util qw( min sample );

## ## ## ## ## MAIN:

my @A = sample 12, (1..24);
my @windows;

for my $start (0..@A-2) {
    for my $end ($start+1..@A-1) {
        my $min = min @A[$start..$end];
        push @windows, [$min*($end-$start+1), $start, $end, $min];
    }
} 

my @sorted  = sort { $b->[0] <=> $a->[0]        } @windows;
my @largest = grep { $_->[0] == $sorted[0]->[0] } @sorted;

say "array (@A)";

for my $rect ( @largest ) {
    my $width = $rect->[2] - $rect->[1] + 1;
    say<<__EOD__;

rectangle found at:
    start index $rect->[1]
    end   index $rect->[2]
    height      $rect->[3]
    width       $width
    area        $rect->[0]
__EOD__
}

Raku Solution

For the Raku version, we can get our range endpoints all in one fell swoop by generating a sequence of choose 2 combinations from indices of @A, using the very handy .combinations() method. Once we have this, it is only a matter of finding the largest area field and using grep to apply a condition, to filter only rectangles with that value for our output. This last part isn’t fundamentally different that the Perl logic, but is a bit cleaner and more direct.

unit sub MAIN () ;

## cfg
my @A = (^24).pick(12);
my @windows;

## work
for (^@A.elems).combinations(2) -> ($start, $end) {
    my $min = @A[$start..$end].min;
    @windows.push: ($min*($start..$end).elems, $start, $end, $min);
}

my $max     = @windows.max({$_[0]});
my @largest = @windows.grep({ $_[0] == $max[0] });


## out
say "array ", @A, "\n";
for @largest -> @r {
    my $width = @r[2]-@r[1]+1;
    
    say qq:to/__EOD__/;
        rectangle found at:
            start index @r[1]
            end index   @r[2]
            height      @r[3]
            width       $width
            area        @r[0]
        __EOD__
}