PWC 235 Steppin' in a Slide Zone

I always try to find the common theme between the tasks in the weekly challenge, and I will just straight up invent one if I have to. What I see in week 235 is two tasks that are about moving down a list in a quirky way. The blog title? Moving down a list in pairs reminded me of the slide function, and that reminded me of a minor hit from the Moody Blues circa 1978, Steppin' in a Slide Zone.

That invoked a nostalgic digression to listen to the whole album (downloaded in minutes from 45 years ago -- we live in a marvelous age). I am distressed by the number of brain cells that are uselessly calcified with lyrics of obscure songs from a half-century ago, when they could be so much better used storing obscure Perl programming facts.

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

Discourse Upon The Topic

I was misled by examples that are too easy. My impulse was to look for the number of times that the sequence descends instead of ascends, and report if that number was more than one. However, that doesn't cover the case where removing an element still leaves the list with a descending step. For instance, the list (10 20 30 18 19 40) has only one downward step, but we need to remove at least two elements to get to sorted. Back to this after an interlude of how to do it wrong.

Even though I started with a bad solution, it illuminated some topics of list iteration, so let's look at ways of finding the descending steps in a sequence. The motion is two-at-a-time, and there are several ways of doing that.

The basic way, similar in many languages, is to move an index from 0 to not quite the end, and compare $ints[$i] and $ints[$i+1]. Counting downward steps is a necessary but insufficient condition, so we're including that.

  sub removeOne(@ints)
  {
      my $rmvCount = 0;
      for ( my $i = 0; $i < $#ints && $rmvCount < 2 ; $i++ )
      {
          $rmvCount++ if $ints[$i+1] < $ints[$i];
      }
      return $rmvCount < 2;
  }

When we're given a list, it's always tempting to manipulate the list as a whole with map and similar functions, which often helps with tricky boundary conditions. We can apply map to pairs of the list by using indexes in the same way as the for loop -- excluding the very last index at the boundary, and mapping each pair of integers to a boolean that says whether the pair is ascending or descending. Then a count of the descending pairs (false) will tell us how many might need to be removed.

sub removeOne(@ints)
  {
      my $rmvCount = grep { $_ == false }
                  map { $ints[$_] < $ints[$_+1] } 0 .. ( $#ints-1 );
      return $rmvCount < 2;
  }

Another very Perl-ish way to process pairs at a time is to shift elements off the array, consuming the array in the process.

my $first = shift @ints; 
while ( defined (my $next = shift @ints ) )
{
    say "PAIR: ($first, $next)";
    $first = $next;
}

Perl v5.36 added the ability in for loops to iterate over successive tuples of an array. That's not quite what we want here, because it moves two elements in every iteration, but it's worth a mention.

for my ($first, $second) (1,2,3,4) { say "$first, $second" }
# 1, 2
# 3, 4

Pair-at-a-time list iteration is common enough that there is a module for it: List::MoreUtils::slide applies a block to each pair in sequence, attaching the names $a and $b to the elements for the convenience of a code block. Using slide is probably the most readable version (assuming one knows what slide does).

sub removeOne(@ints)
{
    use List::MoreUtils qw/slide/;
    my $rmvCount = 0;
    slide { $rmvCount++ if ( $b < $a ) } @ints;
    return $rmvCount < 2;
}

Both the map and the slide solution suffer from a potential inefficiency that often plagues array operations: they operate on the entire array, even if we could discover the answer in the first elements of the array.

One way we could make slide give up sooner is to throw an exception from the block. Perl has had exception modules available for years, but in 5.36 try/catch/finally became [an experimental] part of the language. Here's a way to break out of slide before it wastes time:

sub removeOne(@ints)
{
    use List::MoreUtils qw/slide/;
    use feature 'try'; no warnings "experimental::try";
    my $rmvOne = true;
    try {
        my $rmvCount = 0;
        slide { do { die if ++$rmvCount > 1 } if ( $b < $a ) } @ints;
    }
    catch ($e)
    {
        $rmvOne = false;
    }
    return $rmvOne;
}

But back to actually solving the problem. We still have the sub-problem of finding a descending step in the sequence. Take 10 20 30 24 25 40 as an example. Which elements should we remove to create a sorted list?

When we hit a down step, we have a choice of what to remove: we can either remove the greater elements to the left until we get back in order, or we can remove the lesser elements to the right until we start ascending again. If we can do it by removing one, we might succeed; if we have to remove more in either direction, we fail.

10  ^ 20  ^ 30   V  24  ^ 25  ^ 40
10    20   [30] <== 24    25    40 # Go back
10    20    30 ==> [24   25]    40 # Skip ahead

The tricky part of this solution is the likelihood of off-by-one errors to take care of the out-of-order element being at the beginning or end of @ints. Here's code that literally walks backward and forward from the point of disorder:

sub removeOne(@ints)
{
    use List::Util qw/min/;

    return true if @ints < 3;

    my $rmvCount = 0;

    # Walk forward until we hit a descending step.
    for ( my $i = 0 ; $i < $#ints && $rmvCount < 2 ; $i++ )
    {
        next if $ints[$i+1] >= $ints[$i];

        # How far backward would we have to go to get back in order?
        my $back = 0;
        for ( my $j = $i ;    $j >= 0 
                           && $ints[$j] > $ints[$i+1]
                           && $back < 3; 
              $j-- )
        {
            $back++;
        }

        # How far ahead would we have to go to get back in order?
        my $ahead = 0;
        for ( my $j = $i+1;    $j <= $#ints 
                            && $ints[$j] <= $ints[$i] 
                            && $ahead < 3;
              $j++ )
        {
            $ahead++;
        }
        $rmvCount += min($back, $ahead);

    }
    return $rmvCount < 2;
}

Consider a sequence like ( 1000, 1..999, 2000). It would be a waste of time moving ahead 1000 steps to rediscover order. We never really need to move backward or forward more than two steps to know the answer. An optimization is to include that condition in the back and forth motions.

I use unit testing frameworks to make sure I don't break one boundary condition when I fix another. These are my test cases:

sub runTest
{
    use Test2::V0;
    no warnings "experimental::builtin";

    is( removeOne(0,2,9,4,6), true,  "Example 1");
    is( removeOne(5,1,3,2  ), false, "Example 2");
    is( removeOne(2,2,3    ), true,  "Example 3");
    is( removeOne(10,1,2,3 ), true,  "First element goes");
    is( removeOne(10,11,1  ), true,  "Last element goes");
    is( removeOne(10,20,30,24,25,40), true, "One high peak");
    is( removeOne(10,20,30,18,25,40), false, "One high, one low");
    is( removeOne(1,2,5,3,4,6,3,4),   false, "Multiple disorders");
    is( removeOne(99, 1000, 1..999, 2000), false, "Long failure");

    done_testing;
}

One note: I use true and false booleans, which were introduced as experimental built-in functions in 5.36. Annoyingly, they emit warnings, so the incantation to put at the top of the file is

use builtin qw/true false/; no warnings "experimental::builtin";

The Test2::V0 testing module re-enables all warnings, so the suppression of warnings has to be repeated after the module is invoked.

Task 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
remains the same.

Example 1

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

Example 2

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

Example 3

Input: @ints = (0, 3, 0, 4, 5)
Output: (0, 0, 3, 0, 0)

Discourse Upon the Topic

Two approaches come to mind: we could insert all the zeroes where required and then truncate the list to its original length; or we could walk down the list, inserting one zero at a time and lopping off the right-most element each time. The first approach will double the space required for the list. The second will take no extra space, but needs a little more care in bookkeeping.

First, let's try substituting every occurrence of 0 with a pair of zeros:

map { $_ || (0,0) } @ints 

This concise little tidbit exploits two features of Perl. First, 0 is a false value and all other numbers are true-ish. That means that every time $_ is non-zero, it will be true, so the expression will return $_ itself and not evaluate the right side of the || operation. When $_ is zero, the left side is false, and the right side gets evaluated. We've cleverly made the right side be a pair of zeros. Perl does not build an array of arrays from this; it flattens the list.

So now we have a list where every 0 has been doubled. It is too long. We can truncate it by taking a slice that's as long as the original list. To do that, we'll take the result of map as an array and apply an index range to it.

(map { $_ || (0,0) } @ints)[0 .. $#ints]

The other approach would be to walk along the list and modify it explicitly each time we find a zero. Let's do this a couple of ways. First, let's copy input to output and add the zero in the process of copying:

sub dz_A(@ints)
{
    my $maxLen = @ints;
    my @output;
    while ( @output < $maxLen )
    {
        push @output, shift @ints;
        push @output, 0 if ( $output[-1] == 0 && @output < $maxLen );
    }
    return \@output;
}

A few Perl notes: in @output < $maxLen, we're exploiting the fact that naming an array in a scalar context returns the length of the array. Instead of tracking an index to move along the input, we're consuming the input with a shift operation. And finally, we can index from the end of @output with -1 to look at the number we just moved, avoiding a temporary variable.

The other strategy I considered for this solution is to modify the list in place. Each time we find a zero, splice an extra zero into the list, and pop off the right end of the list to keep it the same length.

sub dz_B(@ints)
{
    for (my $i = 0 ; $i <= $#ints; $i++ )
    {
        if ( $ints[$i] == 0 )
        {
            # Insert a zero and advance i past it
            splice(@ints, $i++, 0, 0);
            pop @ints; # Maintain the length;
        }
    }
    return \@ints;
}

Notice that we used post-increment of $i to move the index ahead to the next value in @ints instead of processing the newly-inserted zero in the next loop iteration.

Final thoughts

If 1978 is ancient history, pretend I referenced Goo Goo Dolls "Slide" from 2002.