Perl Weekly Challenge 302.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 302.
Task 1: Ones and Zeroes
Submitted by: Mohammad Sajid Anwar
You are given an array of binary strings, @str, and two integers, $x and $y.
Write a script to return the size of the largest subset of @str such that there
are at most $x 0’s and $y 1’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")
A simple solution consists of recursively adding elements to the subset updating the remaining permitted number of zeroes and ones. Then, drop the first string and try again. Choose the maximum number of elements found in the resulting subsets. To avoid repeated computations, I build an array of how many zeroes and ones are in each string. The code fits a 2.5 liner.
Example 1:
perl -MList::Util=max,sum -E '
($x,$y,@i)=@ARGV;$t=@i-1;$m=0;@j=map {$o=sum(@d=split "");[@d-$o,$o]} @i;$m=max($m,f($x,$y,@j[$_..$t]))
for 0..$t;say "x=$x, y=$y, str=(@i) -> $m";sub f($z,$o,@j){@j||return 0;my @k=@j;($p,$q)=shift(@k)->@*;
$z>=$p&&$o>=$q?1+f($z-$p,$o-$q,@k):f($z,$o,@k);}
' 5 3 10 0001 111001 1 0
Results:
x=5, y=3, str=(10 0001 111001 1 0) -> 4
Example 2:
perl -MList::Util=max,sum -E '
($x,$y,@i)=@ARGV;$t=@i-1;$m=0;@j=map {$o=sum(@d=split "");[@d-$o,$o]} @i;$m=max($m,f($x,$y,@j[$_..$t]))
for 0..$t;say "x=$x, y=$y, str=(@i) -> $m";sub f($z,$o,@j){@j||return 0;my @k=@j;($p,$q)=shift(@k)->@*;
$z>=$p&&$o>=$q?1+f($z-$p,$o-$q,@k):f($z,$o,@k);}
' 1 1 10 1 0
Results:
x=1, y=1, str=(10 1 0) -> 2
The full code makes some tests and some optimization. I order the elements from larger to smaller, to finish each attempt as early as possible. I could also memoize the recursive routine.
1 # Perl weekly challenge 302
2 # Task 1: Ones and Zeroes
3 #
4 # See https://wlmb.github.io/2024/12/29/PWC302/#task-1-ones-and-zeroes
5 use v5.36;
6 use List::Util qw(max sum);
7 use List::UtilsBy qw(rev_nsort_by);
8 die <<~"FIN" unless @ARGV > 2;
9 Usage: $0 x y S1 S2...
10 to find the largest subset of the binary strings S1, S2...
11 such that its total number of zeroes and ones doesn't exceed x and y respectively.
12 FIN
13 my ($x,$y,@str)=@ARGV;
14 for(@str){
15 die "$_ is not binary" unless /^[01]+$/;
16 }
17 my @descriptions = map {
18 my $ones = sum(my @digits = split "");
19 my $zeroes = @digits - $ones;
20 [$zeroes, $ones]
21 } rev_nsort_by {length} @str;
22 my $max = 0;
23 $max = max($max, subset($x, $y, @descriptions[$_..@descriptions-1])) for 0..@descriptions-1;
24 say "x=$x, y=$y, str=(@str) -> $max";
25 sub subset($zeroes, $ones, @rest){
26 return 0 unless @rest && ($zeroes || $ones);
27 my @rest1 = @rest;
28 my ($zeroes1, $ones1) = shift(@rest1)->@*; # try first element of @rest
29 $zeroes >= $zeroes1 && $ones >= $ones1 # if enough zeroes and ones available
30 ? 1 + subset($zeroes -$zeroes1,$ones - $ones1, @rest1) # add element to subset
31 : subset($zeroes, $ones, @rest1); # otherwise, don't
32 }
33
Example:
./ch-1.pl 5 3 10 0001 111001 1 0
./ch-1.pl 1 1 10 1 0
Results:
x=5, y=3, str=(10 0001 111001 1 0) -> 4
x=1, y=1, str=(10 1 0) -> 2
Task 2: Step by Step
Submitted by: Mohammad Sajid Anwar
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
I can reduce the input array by computing the running sum of its initial elements. If I subtract the minimum number the running sums would be non-negative. So if I add the additive inverse of the minimum number plus one, the running sums would always be positive. Furthermore, the start value itself has to be positive. The result fits a half-liner.
Example 1:
perl -MList::Util=reductions,min,max -E '
say "@ARGV -> ",max 1,1 - min reductions{$a+$b}@ARGV
' -- -3 2 -3 4 2
Results:
-3 2 -3 4 2 -> 5
Example 2:
perl -MList::Util=reductions,min,max -E '
say "@ARGV -> ",max 1,1 - min reductions{$a+$b}@ARGV
' 1 2
Results:
1 2 -> 1
Example 3:
perl -MList::Util=reductions,min,max -E '
say "@ARGV -> ",max 1,1 - min reductions{$a+$b}@ARGV
' 1 -2 -3
Results:
1 -2 -3 -> 5
The full code is similar:
1 # Perl weekly challenge 302
2 # Task 2: Step by Step
3 #
4 # See https://wlmb.github.io/2024/12/29/PWC302/#task-2-step-by-step
5 use v5.36;
6 use List::Util qw(reductions min max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 N2...
9 to find the minimum positive start value S such that step by step
10 sum S, S+N1, S+N1+N2... is never less than one.
11 FIN
12 say "@ARGV -> ",max 1,1 - min reductions{$a+$b}@ARGV;
Examples:
./ch-2.pl -3 2 -3 4 2
./ch-2.pl 1 2
./ch-2.pl 1 -2 -3
Results:
-3 2 -3 4 2 -> 5
1 2 -> 1
1 -2 -3 -> 5
/;