laurent_r

These are some answers to the Week 235, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on September 24, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 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

Remove One in Raku

We simply iterate over the input array and count the items that are out of order (where @in[$i-1] >= @in[$i]). We return False if the number of such items is more than 1, and True otherwise.

sub can-strictly-increase (@in) {
    my $count = 0;
    for 1..@in.end -> $i {
        $count++ if @in[$i-1] >= @in[$i];
    }
    return $count > 1 ?? False !! True;
}

for <0 2 9 4 6>, <5 1 3 2>, <2 2 3>, <3 3 3> -> @test {
    printf "%-12s => ", "@test[]";
    say can-strictly-increase @test;
}

This program displays the following output:

$ raku ./remove-one.raku
0 2 9 4 6    => True
5 1 3 2      => False
2 2 3        => True
3 3 3        => False

Remove One in Perl

This is a port to Perl of the above Raku program, with absolutely no change except for syntax differences.

use strict;
use warnings;
use feature 'say';

sub can_strictly_increase {
    my $count = 0;
    for my $i (1..$#_) {
        $count++ if $_[$i-1] >= $_[$i];
    }
    return $count > 1 ? "false" : "true";
}

for my $test ([<0 2 9 4 6>], [<5 1 3 2>], 
              [<2 2 3>], [<3 3 3>]) {
    printf "%-12s => ", "@$test";
    say can_strictly_increase @$test;
}

This program displays the following output:

$ perl ./remove-one.pl
0 2 9 4 6    => true
5 1 3 2      => false
2 2 3        => true
3 3 3        => false

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 1, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.