Advent Calendar 2023

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

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.

|   Advent Calendar 2023   |