Perl Weekly Challenge: Week 297
Challenge 1:
Contiguous Array
You are given an array of binary numbers,
@binary.Write a script to return the maximum length of a contiguous subarray with an equal number of 0 and 1.
Example 1
Input: @binary = (1, 0)
Output: 2
(1, 0) is the longest contiguous subarray with an equal number of 0 and 1.
Example 2
Input: @binary = (0, 1, 0)
Output: 2
(1, 0) or (0, 1) is the longest contiguous subarray with an equal number of 0 and 1.
Example 3
Input: @binary = (0, 0, 0, 0, 0)
Output: 0
Example 4
Input: @binary = (0, 1, 0, 0, 1, 0)
Output: 4
I had hoped to be able to do this entirely with one regular expression but try as I might, I was not able to get it to work. This is what I came up with instead.
A variable is declared to store the longest length; initially this is 0.
my $longest = 0;
While we have two or more elements (obviously we cannot have equal 1s and 0s with only one element)...
while @ints.elems > 1 {
...we .join() the elements of @ints to form a string and look in it for the longest sequence of 10 or 01
using a regular expression and assign the length (determined with .chars()) to the variable $length.
If there is no sequence, $length = 0.
my $length = (@ints.join.match(/([01|10]+)/, :g))[0] ?? $0.chars !! 0;
If $length is larger than the current value of $longest it becomes the new value of $longest.
if $length > $longest {
$longest = $length;
}
@ints is shrunk by removing the leftmost element with shift() and the loop is run again.
shift @ints;
}
Finally, we output $longest.
say $longest;
And this is the Perl version which works the same way.
my $longest = 0;
while (scalar @ints > 1) {
(join q{}, @ints) =~ /((?:01|10)+)/g;
my $length = length($1) // 0;
if ($length > $longest) {
$longest = $length;
}
shift @ints;
}
say $longest;
Challenge 2:
Semi-Ordered Permutation
You are given permutation of $n integers,
@ints.Write a script to find the minimum number of swaps needed to make the @ints a semi-ordered permutation.
A permutation is a sequence of integers from 1 to n of length n containing each number exactly once. A permutation is called semi-ordered if the first number is 1 and the last number equals n.
You are ONLY allowed to pick adjacent elements and swap them.
Example 1
Input: @ints = (2, 1, 4, 3)
Output: 2
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)
Example 2
Input: @ints = (2, 4, 1, 3)
Output: 3
Swap 4 <=> 1 => (2, 1, 4, 3)
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)
Example 3
Input: @ints = (1, 3, 2, 4, 5)
Output: 0
Already a semi-ordered permutation.
First we reserve storage for a count of how many swaps are made.
my $swaps = 0;
Then until the first element of @ints is 1 and the last element is equal to the number
of elements in the array...
while @ints[0] != 1 && @ints[*-1] != @ints.elems {
...we go through all the elements of @ints except the first one.
for 1 .. @ints.end -> $i {
We compare the current element to the one before it and if the one before is larger...
if @ints[$i - 1] > @ints[$i] {
We swap them. I was surprised that Raku doesn't have a standard swap method as it has practically everything else.
my $temp = @ints[$i];
@ints[$i] = @ints[$i - 1];
@ints[$i - 1] = $temp;
We add 1 to the number of swaps made.
$swaps++;
}
}
These steps are repeated until we achieve a semi-ordered permutation.
}
Then we say() the number of swaps made.
say $swaps;
The Perl version is a direct translation from Raku.
my $swaps = 0;
while ($ints[0] != 1 && $#ints != scalar @ints) {
for my $i (1 .. scalar @ints - 1) {
if ($ints[$i - 1] > $ints[$i]) {
my $temp = $ints[$i];
$ints[$i] = $ints[$i - 1];
$ints[$i - 1] = $temp;
$swaps++;
}
}
}
say $swaps;