PWC 235 Steppin' in a Slide Zone
Tags: perl, perlweeklychallenge, pwc
Published: 2023-09-20 12:47:56

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](https://www.youtube.com/watch?v=xRSQ_vHHBEU).

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](https://theweeklychallenge.org/blog/perl-weekly-challenge-235/#TASK1)
```text
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. 
```perl
  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.
```perl
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.
```perl
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.
```perl
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).
```perl
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:
```perl
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.
```text
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:
```perl
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:
```perl
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
```perl
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](https://theweeklychallenge.org/blog/perl-weekly-challenge-235/#TASK2)
```text
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:
```perl
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.
```perl
(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:
```perl
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.
```perl
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"](https://www.youtube.com/watch?v=yP4qdefD2To) from 2002.