Perl Weekly Challenge 304.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 304.
Task 1: Arrange Binary
Submitted by: Mohammad Sajid Anwar
You are given a list of binary digits (0 and 1) and a positive integer, $n.
Write a script to return true if you can re-arrange the list by replacing
at least $n digits with 1 in the given list so that no two consecutive digits
are 1 otherwise return false.
Example 1
Input: @digits = (1, 0, 0, 0, 1), $n = 1
Output: true
Re-arranged list: (1, 0, 1, 0, 1)
Example 2
Input: @digits = (1, 0, 0, 0, 1), $n = 2
Output: false
I find some ambiguity in the statement of the problem. If the array already has consecutive 1’s, should the output be false? Or is it only that changing 0->1 doesn’t produce additional consecutive 1’s?. Another ambiguity is that it is not clear if we can only change 0’s to 1’s or if we can also reorder the resulting list. I’ll assume that we can not reorder digits.
The problem may be solved recursively as follows:
- if $n is zero, we have had success,
- if the array is empty, we have failed,
- if the next digit is a one, we cannot replace the current digit, so we advance one place and try again,
- if the current digit is a 1 (followed by 0, or the end), we cannot convert the next digit, so we advance two places,
- the current digit is a 0 (followed by 0, or the end), we can try to convert it to one, decrease $n, and advance two places, or leave it as it is and advance one place (though I guess this alternative is unnecessary).
The result fits a 2.5-liner.
Examples:
perl -E '
for my($n,$i)(@ARGV){say"$n, $i => ", $i!~/11/&&f($n,0,split"",$i)?"True":"False"}
sub f($n,$m,@i){return 1 if $n<=0;return 0 if $m>=@i;return f($n,$m+1,@i) if $i[$m+1]==1;
return f($n,$m+2,@i) if $i[$m]==1; f($n-1, $m+2, @i)}
' 1 10001 2 10001 1 100011
Results:
1, 10001 => True
2, 10001 => False
1, 100011 => False
The last example fails because there are already two consecutive 1’s in the input. The full code adds some tests:
1 # Perl weekly challenge 304
2 # Task 1: Arrange Binary
3 #
4 # See https://wlmb.github.io/2025/01/13/PWC304/#task-1-arrange-binary
5 use v5.36;
6 die <<~"FIN" unless @ARGV && @ARGV%2!=1;
7 Usage: $0 N1 B1 N2 B2...
8 to check if Ni 0's within the binary string Bi can be converted to 1's so that
9 there are no consecutive 1's.
10 FIN
11 for my($n,$b)(@ARGV){
12 warn("String not binary: $b"), next unless $b=~/^[01]*$/;
13 my $result= $b!~/11/ && test ($n,0,split"",$b);
14 say "$n, $b -> ", $result? "True" : "False";
15 }
16
17 sub test($n,$m,@b){
18 return 1 if $n<=0; # nothing to change
19 return 0 if $m>=@b; # no more digits
20 return test($n,$m+1,@b) if defined $b[$m+1] && $b[$m+1]==1; # b1bbb...->bbb...
21 return test($n,$m+2,@b) if $b[$m]==1; # 10bbb...->bbb...
22 return test($n-1, $m+2, @b); # 00bbb->10bbb->bbb
23 }
Examples:
./ch-1.pl 1 10001 2 10001 1 100011
Results:
1, 10001 -> True
2, 10001 -> False
1, 100011 -> False
Task 2: Maximum Average
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints and an integer, $n which is less than
or equal to total elements in the given array.
Write a script to find the contiguous subarray whose length is the given integer,
$n, and has the maximum average. It should return the average.
Example 1
Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4
Output: 12.75
Subarray: (12, -5, -6, 50)
Average: (12 - 5 - 6 + 50) / 4 = 12.75
Example 2
Input: @ints = (5), $n = 1
Output: 5
If a subarray has the maximum average, it has the maximum sum. I can obtain the sum of the first $n elements and succesively consider the next group of $n elements by subtracting and removing the first element and adding and incorporating that beyond the last. I choose the maximum of the resulting numbers and divide by $n to get the average. Slightly simpler is to make an array of $ints[$i+$n]-$ints[$i], prepend 0, and sum them the the initial sum. The result fits a 1-liner.
Example 1:
perl -MList::Util=sum0,max -E '
$n=shift; @i=@ARGV; $s=sum0 @i[0..$n-1];say "$n, ( @i ) -> ", ($s+max(0,map{$i[$_+$n]-$i[$_]}(0..@i-$n)))/$n
' 4 1 12 -5 -6 50 -3
Results:
4, ( 1 12 -5 -6 50 -3 ) -> 12.75
Example 2:
perl -MList::Util=sum0,max -E '
$n=shift; @i=@ARGV; $s=sum0 @i[0..$n-1];say "$n, ( @i ) -> ", ($s+max(0,map{$i[$_+$n]-$i[$_]}(0..@i-$n)))/$n
' 1 5
Results:
1, ( 5 ) -> 5
The full-code is:
1 # Perl weekly challenge 304
2 # Task 2: Maximum Average
3 #
4 # See https://wlmb.github.io/2025/01/13/PWC304/#task-2-maximum-average
5 use v5.36;
6 use List::Util qw(sum0 max);
7 use POSIX qw(floor);
8 die <<~"FIN" unless @ARGV>=2;
9 Usage: $0 N I1 I2...
10 to find the maximum average of coutiguous subarrays of Ii with N elements.
11 FIN
12 my $n=shift;
13 die "N should be >=1: $n" unless floor($n)>=0;
14 $n=floor($n);
15 my @i=@ARGV;
16 my $first = sum0 @i[0..$n-1];
17 my @changes = map{$i[$_+$n]-$i[$_]} (0..@i-$n);
18 unshift @changes, 0;
19 my $max_change=max @changes;
20 my $max_sum=$first + $max_change;
21 my $max_avg = $max_sum/$n;
22 say "$n, ( @i ) -> $max_avg";
Example 1:
./ch-2.pl 4 1 12 -5 -6 50 -3
Results:
4, ( 1 12 -5 -6 50 -3 ) -> 12.75
Example 2:
./ch-2.pl 1 5
Results:
1, ( 5 ) -> 5