Robbie Hatley's Perl Solutions to The Weekly Challenge #197

This is my first post to my first blog on a brand new blogger acct; this seems as good a place to start as any.

For those not familiar with "The Weekly Challenge", it is a weekly programming puzzle, usually with two parts, cycling every Sunday. You can find it here:

The Weekly Challenge

This week (2022-12-25 through 2022-12-31) is weekly challenge #197.

Part 1 is a simple task of moving all zeros in an array to the end without disturbing the order of the non-zero elements.

Of course this could be done by simply copying all non-zero elements to a second array, then padding the end of the output array with sufficient zeros. But that felt like cheating, so I took a completely different approach and spliced-out the zeros (using "splice") and tacked them on the end (also using "splice") so that I could edit the array in-situ with no need for multiple arrays, like so:

for (@lists){
   my @list = @{$_};                        # Input.
   my $z;                                   # A placeholder for a 0.
   say '';                                  # Print blank line.
   say "Input  = (@list)";                  # Announce input.
   for ( my $i = 0 ; $i <= $#list ; ++$i ){ # Riffle through list.
      last if 0 == sum0(@list[$i..$#list]); # Stop if all remaining elements are 0.
      if ( 0 == $list[$i] ){                # If we find a 0,
         $z = splice @list, $i, 1;          # splice it from current position
         splice @list, @list, 0, $z;        # and paste it on end.
         --$i;}}                            # Back-up one spot,
                                            # because we altered current location.
   say "Output = (@list)";}                 # Print output.

Part 2 I found much more problematic, however. It asks the programmer to do a "Wiggle Sort" on an array, but defines "Wiggle Sort" in a non-standard way. Normally, "Wiggle Sort" means to arrange elements of an array "a" such that "a[0] <= a[1] >= a[2] <= a[3] => a[4]...". However, challenge 197-2 defines "Wiggle Sort" differently: "a[0] < a[1] > a[2] < a[3] > a[4]...". This version, which I'll call "Strong Wiggle Sort", is not only non-deterministic (multiple valid sort orders may exist), but some arrays can not be sorted by Strong Wiggle Sort. For example, (1,1,1,1,1) has no valid Strong Wiggle Sortings.

But I did my best, and the approach I came up with looks like this:

# Main body of script:
ARRAY : for (@arrays){                               # For each input array.
   my @array = @{$_};                                # Current input array.
   say '';                                           # Print blank line.
   say "Input  = (@array)";                          # Print input.
   my $flag = 1;                                     # We have work to do.
   my $shifts = 0;                                   # How many shifts have we worked?
   while ( $flag ){                                  # Loop while we have work to do.
      if ( $shifts >=1000 ){                         # But if we've worked 1000 shifts,
         say "timed out";                            # and yet the work still ain't done,
         next ARRAY;}                                # then give up.
      ++$shifts;                                     # Yet another work shift.
      $flag = 0;                                     # Work is done, maybe?
      for ( my $i = 0 ; $i <= $#array - 1 ; ++$i ){  # For each index pair:
         if ( $i % 2 ){                              # If (odd,even) pair:
            if ( $array[$i] <= $array[$i+1] ){       # If pair isn't downward-trending,
               $flag = 1;                            # work's not done.
               my $temp = $array[$i];                # swap
               $array[$i] = $array[$i+1];            # swap
               $array[$i+1] = $temp;}}               # swap
         else {                                      # Else if (even,odd) pair:
            if ( $array[$i] >= $array[$i+1] ){       # If pair isn't upward-trending,
               $flag = 1;                            # work's not done.
               my $temp = $array[$i];                # swap
               $array[$i] = $array[$i+1];            # swap
               $array[$i+1] = $temp;}}}}             # swap
   say "Output = (@array)";}                         # Print output.

That works, at least for some inputs. But it's mathematically impossible to come up with a program that works for all inputs. (If it had been "Weak Wiggle Sort", that would have been a different story.)

That's it for this week's "Weekly Challenge". But I'm sure I'll have much more to say in the future, not just on these Weekly Challenges, but on other things programming-related. (I do write about other topics in other blogs, but this one is goign to be about programming only.)

-- 
Cheers,
Robbie Hatley