Perl Weekly Challenge: Week 304
Challenge 1:
Arranged Binary
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 with1in the given list so that no two consecutive digits are1` 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
My script takes input from command-line arguments where the first one is $n and the rest form @digits.
Well actually, the arguments are immutable in Raku and we will need to modify them so they are copied into a new array.
my @digits = @args;
We will also need to keep track of how many replacements were made. Initially this is zero of course.
my $replacements = 0;
Now starting from the second digit to the end, we look at the digit and the one previous to it. If they are both
0, the current digit is replaced by a 1 and $replacements is incremented.
for 1 .. @digits.end -> $i {
if @digits[$i - 1] == 0 && @digits[$i] == 0 {
@digits[$i] = 1;
$replacements++;
}
}
Now we can test to see if our replacements resulted in a valid rearrangement of @digits.
A variable is defined to hold the result and it is initially set to be False.
my $result = False;
The spec says the number of replacements has to be "at least" $n; I'm assuming that means >= $n. If that is the
case, $result is set to True.
if $replacements >= $n {
$result = True;
However there is one more test that needs to be made; if there are two consecutive 1's, it means the
rearrangement is invalid. Once again, we go through @digits two elements by two and if both equal 1, we
reset $result to False and stop processing.
for 1 .. @digits.end -> $i {
if @digits[$i - 1] == 1 && @digits[$i] == 1 {
$result = False;
last;
}
}
}
Finally, we print $result.
say $result;
For once, Perl has everything we need to do a straight translation from Raku.
my $replacements = 0;
for my $i (1 .. scalar @digits - 1) {
if ($digits[$i - 1] == 0 && $digits[$i] == 0) {
$digits[$i] = 1;
$replacements++;
}
}
my $result = false;
if ($replacements >= $n) {
$result = true;
for my $i (1 .. scalar @digits - 1) {
if ($digits[$i - 1] == 1 && $digits[$i] == 1) {
$result = false;
last;
}
}
}
say $result ? 'true' : 'false';
Challenge 2:
Maximum Average
You are given an array of integers,
@intsand an integer,$nwhich 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
As in challenge 1, the first command-line argument is $n and the rest form @ints.
Now all we need to do here is go through the elements of @ints $n at a time and find the average for
each group.
$maxAverage will keep track of the biggest average fround so far.
my $maxAverage = 0;
for 0 .. @ints.elems - $n -> $i {
An average is the .sum() of $n elements divided by $n. Note the use of the range operator .. to provide
a "slice" of @ints of the apropriate size.
my $average = @ints[$i ..^ $i + $n].sum / $n;
If the average is greater than the current value of $maxAverage it becomes the new value of $maxAverage.
if $average > $maxAverage {
$maxAverage = $average;
}
}
Finally, we print the value of $maxAverage.
say $maxAverage;
For Perl I had to provide a replacement sum() function but everything else is the same as Raku.
my $maxAverage = 0;
for my $i (0 .. (scalar @ints - $n)) {
my $average = sum(@ints[$i .. ($i + $n - 1)]) / $n;
if ($average > $maxAverage) {
$maxAverage = $average;
}
}
say $maxAverage;