Perl Weekly Challenge: Week 302
Challenge 1:
Ones and Zeroes
You are given an array of binary strings,
@str, and two integers,$xand$y.Write a script to return the size of the largest subset of
@strsuch that there are at most$x0’s and$y1’s in the subset.A set m is a subset of n if all elements of m are also elements of n.
Example 1
Input: @str = ("10", "0001", "111001", "1", "0")
$x = 5
$y = 3
Output: 4
The largest subset with at most five 0's and three 1's:
("10", "0001", "1", "0")
Example 2
Input: @str = ("10", "1", "0")
$x = 1
$y = 1
Output: 2
The largest subset with at most one 0's and one 1's:
("1", "0")
Here is another problem that lends itself well to dynaamic programming techniques. We initialize a 2D array @dp with dimensions $x + 1 x $y + 1, filled with zeros. This table will be used to store the maximum subset sizes for different counts of 0's and 1's.
my @dp = [0 xx ($y + 1)] xx ($x + 1);
Then we loop through each of the binary strings from our input. For each string, we count the number of 0's and 1's using .comb(), .grep() and .elems() and store them in $zeros and $ones.
for @str -> $s {
my $zeros = $s.comb.grep({ $_ eq '0' }).elems;
my $ones = $s.comb.grep({ $_ eq '1' }).elems;
We update the dynamic programming table @dp in reverse order to avoid overwriting values that we still need to use. For each cell, we check if we can include the current binary string in the subset. If we can, we update the cell with the maximum value between the current value and the value obtained by including the string.
for reverse 0..$x -> $i {
for reverse 0..$y -> $j {
if $i >= $zeros && $j >= $ones {
@dp[$i;$j] = max(@dp[$i;$j], 1 + @dp[$i - $zeros;$j - $ones]);
}
}
}
}
Finally, we return the value in the cell @dp[$x][$y], which contains the size of the largest subset with at most $x 0's and $y 1's.
say @dp[$x;$y];
For Perl, I had to bring in my replacements for xx() and max(). Due to the awkwardness of Perls' 2D
array syntax, I had to redo the code to create @dp a little bit.
my @dp;
for (0 .. $x) {
push @dp, [ xx([0], $y + 1) ];
}
for my $s (@str) {
my $zeros = scalar grep { $_ eq '0' } split //, $s;
my $ones = scalar grep { $_ eq '1' } split //, $s;
for my $i (reverse 0 .. $x) {
for my $j (reverse 0 .. $y) {
if ($i >= $zeros && $j >= $ones) {
$dp[$i][$j] = max($dp[$i][$j], 1 + $dp[$i - $zeros][$j - $ones]);
}
}
}
}
say $dp[$x][$y];
Challenge 2:
Step by Step
You are given an array of integers, @ints.
Write a script to find the minimum positive start value such that step by step sum is never less than one.
Example 1
Input: @ints = (-3, 2, -3, 4, 2)
Output: 5
For start value 5.
5 + (-3) = 2
2 + (+2) = 4
4 + (-3) = 1
1 + (+4) = 5
5 + (+2) = 7
Example 2
Input: @ints = (1, 2)
Output: 1
Example 3
Input: @ints = (1, -2, -3)
Output: 5
Basically we need to find the lowest possible value the sum can have and find a value such that subtracting the lowest value will not be less than 1. Logic tells us that will be 1 - the minimum.
So all we need to do is go through @ints keeping track of the current sum and the minimum sum (which both start at 0.)
my $min = 0;
my $current = 0;
for @ints -> $n {
$current += $n;
If the current sum is less than the minimum sum, it becomes the new value for the minimum sum.
if $current < $min {
$min = $current;
}
}
Finally we print the value 1 - the minimum sum.
say 1 - $min;
The Perl version is almost exactly the same as Raku.
my $min = 0;
my $current = 0;
for my $n (@ints) {
$current += $n;
if ($current < $min) {
$min = $current;
}
}
say 1 - $min;