Perl Weekly Challenge: Week 235
Challenge 1:
Remove One
You are given an array of integers.
Write a script to find out if removing ONLY one integer makes it strictly increasing order.
Example 1
Input: @ints = (0, 2, 9, 4, 6)
Output: true
Removing ONLY 9 in the given array makes it strictly increasing order.
Example 2
Input: @ints = (5, 1, 3, 2)
Output: false
Example 3
Input: @ints = (2, 2, 3)
Output: true
This is not a one-liner I'm afraid but it is fairly short and simple.
First we define a flag to note whether we are going in strictly increasing order or not. Initially it is false.
my Bool $increasing = False;
Then setting $i in a range from 0 to the length of @ints (which we have populated from command-line arguments) ...
for 0 .. @ints.end -> $i {
...we make a copy of @ints and remove the $ith element from it.
my @copy = @ints;
@copy.splice($i, 1);
We check if this copy is in strictly increasing order. Originally I did this by comparing @copy with yet another copy
which had .sort() run upon it. If the two were equivalent it would mean increasing order. But it is more efficent to use [<]
operator instead.
if [<] @copy {
If @copy is in increasing order, we can set $increasing to true and stop searching. There may be other viable candidates
but we only care if there is at least one.
$increasing = True;
last;
}
If it wasn't, we go back and try a different copy.
}
Regardless of the outcome, we print the value of $increasing.
say $increasing;
This is the Perl version.
Perl doesn't have specific true and false values so I used 1 and undef instead.
my $increasing = undef;
for my $i (0 .. scalar @ARGV - 1) {
my @copy = @ARGV;
splice @copy, $i, 1;
As we don't have [<] I had to use my previous tactic of comparing the copy to a sorted version of itself. This uses
smart matching so I had to add use experimental qw/ smartmatch /; at the top of the script to prevent an annoying warning message.
Oh and both arguments had to be array references for some reason.
if (\@copy ~~ [sort @copy]) {
$increasing = 1;
last;
}
}
say $increasing ? 'true' : 'false';
Challenge 2:
Duplicate Zeros
You are given an array of integers.
Write a script to duplicate each occurrence of ZERO in the given array and shift the remaining to the right but make sure the size of array remain the same.
Example 1
Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
Ouput: (1, 0, 0, 2, 3, 0, 0, 4)
Example 2
Input: @ints = (1, 2, 3)
Ouput: (1, 2, 3)
Example 3
Input: @ints = (0, 3, 0, 4, 5)
Ouput: (0, 0, 3, 0, 0)
My plan for solving this one is to go through @ints (taken from the command-line arguments as usual.) and copy each
element into a new array.
So we need a new array called @output.
my @output;
Then for each element in @ints...
for @ints -> $elem {
...If the current element is a 0, instead of one, two 0s are copied into @output.
if $elem == 0 {
@output.push(| (0, 0));
Otherwise the element is copied into @output as-is.
} else {
@output.push($elem);
}
If the length of @output has become the same as the length of @ints, it is time to stop processing.
if @output.elems == @ints.elems {
last;
}
}
Finally, we print the suitably prettyed-up @output.
say q{(}, @output.join(q{, }, ), q{)};
This is the Perl version, a straightforward translation from Raku.
my @output;
for my $elem (@ARGV) {
if ($elem == 0) {
push @output, 0, 0;
} else {
push @output, $elem;
}
if (scalar @output == scalar @ARGV) {
last;
}
}
say q{(}, (join q{, }, @output), q{)};