This is my 45th week participating into the weekly challenge.
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)
I was quite busy this week so I decided to bet a bit lazy.
For the first challenge I just used Algorithm::Combinatorics combinations_with_repetition to do all the heavy lifting and just outputted the correct combination in perl.
In Raku i decided to some real work and used a recursive algorithm to find the coin combinations. I add a coin into an imaginary bag if the coins are less than the total.
Perl 5 solution
#!/usr/bin/perl
# Test: ./ch-1.pl
use Modern::Perl;
use List::Util qw /sum0/;
use Algorithm::Combinatorics qw(combinations_with_repetition);
my @C = (1, 2, 4);
my $S = 6;
my $total = 0;
my $solutions;
for my $size (reverse(1 .. $S)) {
my $iter = combinations_with_repetition(\@C,$size);
while (my $v = $iter->next) {
if (sum0(@$v) == $S) {
$total++;
$solutions .= '(' . (join ',', @$v) . ')' . "\n"
}
}
}
say "Output: " . $total . ' solutions';
print $solutions;
Output: perl ./ch-1.pl
Output: 6
(1,1,1,1,1,1)
(1,1,1,1,2)
(1,1,2,2)
(1,1,4)
(2,2,2)
(2,4)Raku solution
# Test: perl6 ch-1.p6
our %found;
sub MAIN() {
my @C = (1, 2, 4);
my $S = 6;
my @bag = ();
coin-combinations(@C, $S, @bag);
say "Output: " ~ %found.keys.elems ~ ' solutions';
}
sub coin-combinations(@C, $S, @bag is copy) {
for (@C) -> $coin {
@bag.push($coin);
if (@bag.sum < $S) {
coin-combinations(@C, $S, @bag);
}
if (@bag.sum == $S) {
my $key = '(' ~ @bag.sort.join(',') ~ ')';
say $key unless (%found{$key});
%found{$key} = True;
}
@bag.pop;
}
}
Output perl6 ch-1.p6
(1,1,1,1,1,1)
(1,1,1,1,2)
(1,1,2,2)
(1,1,4)
(2,2,2)
(2,4)
Output: 6 solutionsTASK #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.
BONUS: Try to print the histogram as shown in the example, if possible.
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)
7 #
6 #
5 # # #
4 # # #
3 # # # # #
2 # # # # # #
1 # # # # # #
_ _ _ _ _ _ _
3 2 3 5 7 5
As I mentioned I was a bit lazy this week so for this task I googled an algorithm to find the max largest rectangle which can be found here:
https://www.geeksforgeeks.org/largest-rectangle-under-histogram/
Then creating the histogram was just a matter of formatting text. (this won’t format nicely for 2 digit numbers).
Perl 5 solution
#!/usr/bin/perl
# Test: ./ch-2.pl
use Modern::Perl;
use List::Util qw /max/;
histogram(2, 1, 4, 5, 3, 7);
say "Output: " . largest_rect(2, 1, 4, 5, 3, 7);
say "\n";
histogram(3, 2, 3, 5, 7, 5);
say "Output: " . largest_rect(3, 2, 3, 5, 7, 5);
sub histogram {
my @A = @_;
my $max = max @A;
for my $row (reverse (1 ..$max)) {
printf ("%s ", $row);
for my $col (@A) {
if ($col >= $row) {
print "# ";
} else {
print " ";
}
}
print "\n";
}
print "- " x (scalar(@A) + 1) . "\n";
print " " . (join ' ', @A) . "\n";
}
sub largest_rect {
my @A = @_;
my @stack;
my $max_area = 0;
my $stack_top;
my $i = 0;
while ($i < scalar(@A)) {
if (!scalar(@stack) || $A[$stack[-1]] <= $A[$i]) {
push @stack, $i++;
} else {
$stack_top = pop @stack;
my $w = (scalar(@stack)) ?
($i - $stack[-1] - 1) : $i;
my $area = $A[$stack_top] * $w;
$max_area = max($max_area, $area);
}
}
while (@stack) {
$stack_top = pop @stack;
my $w = (scalar(@stack)) ?
($i - $stack[-1] - 1) : $i;
my $area = $A[$stack_top] * $w;
$max_area = max($max_area, $area);
}
return $max_area;
}
Output ./ch-2.pl
7 #
6 #
5 # #
4 # # #
3 # # # #
2 # # # # #
1 # # # # # #
- - - - - - -
2 1 4 5 3 7
Output: 12
7 #
6 #
5 # # #
4 # # #
3 # # # # #
2 # # # # # #
1 # # # # # #
- - - - - - -
3 2 3 5 7 5
Output: 15Raku solution
# Test: perl6 ch-2.p6
sub MAIN() {
my @A = (2, 1, 4, 5, 3, 7);
histogram(@A);
say "Output: " ~ largest-rect(@A);
say "\n";
my @B = (3, 2, 3, 5, 7, 5);
histogram(@B);
say "Output: " ~ largest-rect(@B);
}
sub histogram(@A) {
my $max = @A.max;
for (reverse (1 ..$max)) -> $row {
print "$row ";
for (@A) -> $col {
if ($col >= $row) {
print "# ";
} else {
print " ";
}
}
print "\n";
}
print "- " x (@A.elems + 1) ~ "\n";
print " " ~ (join ' ', @A) ~ "\n";
}
sub largest-rect(@A) {
my @stack;
my $max_area = 0;
my $stack_top;
my $i = 0;
while ($i < @A.elems) {
if (!@stack.elems || @A[@stack[*-1]] <= @A[$i]) {
@stack.push($i++);
} else {
$stack_top = @stack.pop;
my $w = (@stack.elems) ??
($i - @stack[*-1] - 1) !! $i;
my $area = @A[$stack_top] * $w;
$max_area = max($max_area, $area);
}
}
while (@stack) {
$stack_top = @stack.pop;
my $w = (@stack.elems) ??
($i - @stack[*-1] - 1) !! $i;
my $area = @A[$stack_top] * $w;
$max_area = max($max_area, $area);
}
return $max_area;
}
Output perl6 ch-2.p6
7 #
6 #
5 # #
4 # # #
3 # # # #
2 # # # # #
1 # # # # # #
- - - - - - -
2 1 4 5 3 7
Output: 12
7 #
6 #
5 # # #
4 # # #
3 # # # # #
2 # # # # # #
1 # # # # # #
- - - - - - -
3 2 3 5 7 5
Output: 15
Perl Weekly Challenge 