## Advent Calendar - December 20, 2023

Wednesday, Dec 20, 2023| Tags: Perl, Raku

### |   Day 19   |   Day 20   |   Day 21   |

The gift is presented by `Jaldhar H. Vyas`. Today he is talking about his solution to The Weekly Challenge - 235. This is re-produced for `Advent Calendar 2023` from the original post.

## 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;
``````

Full code on GitHub: Raku

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';
``````

Full code on GitHub: Perl

## 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` `0`s 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{)};
``````

Full code on GitHub: Raku

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{)};
``````

Full code on GitHub: Perl

If you have any suggestion then please do share with us perlweeklychallenge@yahoo.com.

## SO WHAT DO YOU THINK ?

If you have any suggestions or ideas then please do share with us.