Task — Remove one

You are given an array of integers. Write a script to find out if removing ONLY one integer makes it be in strictly increasing order.

Examples

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

Analysis

This is an interesting challenge. The simple solution is simply to try deleting each element in turn and seeing if the resulting array is strictly increasing. However, that's a lot of work if the array is large, because you're checking the whole array for being ordered for as many times as there are elements in the array.

So here's a better way. First let's analyse the array into what we can runs, which are subsequences of the array which are in strictly increasing order, and breaks which are points between two elements of the array which are not in increasing order. For example, the array (4, 5, 6, 1, 2, 3) contains two runs - 4, 5, 6 and 1, 2, 3 - and one break between 6 and 1. That requires just a single pass along the array.

Now we can say:

• If there are no breaks then the result is true because we could remove any element and the array would still be in increasing order
• If there are two or more breaks then the result is false because no single removal will fix two breaks
• If there is just one break, there are two potential ways of restoring the order:
  • remove the element before the break (eg 1, 2, 6| 3, 4 =>
    1, 2, 3, 4)
  • remove the element after the break may restore the order (eg 1, 2| 0, 3, 4 => 1, 2, 3, 4)
  • but neither of these may succeed (eg 3, 4, 9, 1, 2 => ?)

There are two edge cases: if the break is immediately after the first or before the last element of the array, removing respectively the first or last element will restore order.

I tried this with @ints = 1 .. 1000000, 0 (so removing the zero will restore order) and it came up with the answer in around 5 seconds on my quite slow server.

Note: It was pointed out that my solution didn't work for examples such as 1, 2, 3, 1, 2, 3. This was due to a typo in the code which has now been corrected. I was in holiday in France when I did it ...

Try it 

Script

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-09-18
use utf8;     # Week 235 task 1 - Remove one
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

remove_one(1, 2, 3, 4, 5);
remove_one(5, 4, 3, 2, 1);
remove_one(9, 2, 3, 4, 5);
remove_one(1, 2, 3, 4, 0);
remove_one(1, 2, 0, 4, 5);
remove_one(1, 2, 9, 4, 5);
remove_one(1, 2, 3, 1, 2, 3);

sub remove_one {
    
    my (@ints, $result, $remove, $last, $j, $break);
    
    # initialise
    @ints = @_;
    $result = 'false';
    $last = scalar @ints - 1;
    
    # must have at least 3 elements
    if ($last >= 2) {
        
        # loop over elements
        J: for $j (1 .. $last) {
            
            # do nothing if this element > previous element
            next J if $ints[$j] > $ints[$j - 1];

            # if this is a second break then no hope
            if (defined $break) {
                $result = 'false';
                last J;
            }
            
            # so this is a first break
            $break = $j;
            
            # if this is the first or last element then we can remove that
            if ($j == 1) {
                $result = 'true';
                $remove = 0;
                
            } elsif ($j == $last) {
                $result = 'true';
                $remove = $last;
            
            # will removing $j work?
            } elsif ($ints[$j - 1] < $ints[$j + 1]) {
                $result = 'true';
                $remove = $j;
                
            # ... or $j - 1?
            } elsif ($ints[$j - 2] < $ints[$j]) {
                $result = 'true';
                $remove = $j - 1;
            }
        }
        
        # if the sequence is already monotonically increasing then we can remove any element
        unless (defined $break) {
            $result = 'true';
            $remove = 0;
        }
    }
    say qq[\nInput: \@ints = (] . join(', ', @ints) . ')';
    say qq[Output: $result] . ($result eq 'true' ? qq[ (remove $ints[$remove])] : '');
}

Output

Input: @ints = (1, 2, 3, 4, 5)
Output: true (remove 1)

Input: @ints = (5, 4, 3, 2, 1)
Output: false

Input: @ints = (9, 2, 3, 4, 5)
Output: true (remove 9)

Input: @ints = (1, 2, 3, 4, 0)
Output: true (remove 0)

Input: @ints = (1, 2, 0, 4, 5)
Output: true (remove 0)

Input: @ints = (1, 2, 9, 4, 5)
Output: true (remove 9)

Input: @ints = (1, 2, 3, 1, 2, 3)
Output: false