Perl Backfill Challenge: Shift to low gear, a fifty dollar fine my friend!

Posted on by

I’m making another entry backfilling the challenges I missed while my mother was dying; I’m doing these in her honor.

Perl Weekly Challenge 297‘s tasks were “Contiguous Array” and “Semi-Ordered Permutation”.

I thought about what music I should pick, and “semi” jumped out at me. Semi makes me think trucks, and trucks make me think of Thirty Thousand Pounds of Bananas.

Task 2: Semi-Ordered Permutation

You are given permutation of $n integers, @ints.

Write a script to find the minimum number of swaps needed to make the @ints a semi-ordered permutation.

A permutation is a sequence of integers from 1 to n of length n containing  each number exactly once.
A permutation is called semi-ordered if the first number is 1 and the last number equals n.

You are ONLY allowed to pick adjacent elements and swap them.

Example 1

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

Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)

Example 2

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

Swap 4 <=> 1 => (2, 1, 4, 3)
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)

Example 3

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

Already a semi-ordered permutation.

Approach

This is basically a bubble sort, except… we’re only sorting the highest and lowest values. And, since the output requested is the number of swaps needed, not the swaps themselves, we can cheat: in Example 2, note that it takes two swaps to bubble 1 down from position 2 to position 0. But the effect is the same as if we snipped the 1 out of position 2 and inserted it at position 0, and just counted that as two swaps. Then, with 4 in position 2 and it needing to be at position 3, we can see that it will take one more swap to move it to where we need it.

Let’s walk through this algorithm with an example of our own to see if it works. Let’s say we have (5, 4, 3, 2, 1). To move the 1 from position 4 to position 0 will take (4 - 0) = 4 swaps, yielding (1) + (5, 4, 3, 2) = (1, 5, 4, 3, 2). Then to move 5 from position 1 to position 4 will take (4 - 1) = 3 swaps, yielding (1, 4, 3, 2) + (5) = (1, 4, 3, 2, 5). This totals to seven swaps.

Let’s walk through the actual swaps and see if our counting method works:

Start:          (5, 4, 3, 2, 1)
Swap 2 <=> 1 => (5, 4, 3, 1, 2)
Swap 3 <=> 1 => (5, 4, 1, 3, 2)
Swap 4 <=> 1 => (5, 1, 4, 3, 2)
Swap 5 <=> 1 => (1, 5, 4, 3, 2)
Swap 5 <=> 4 => (1, 4, 5, 3, 2)
Swap 5 <=> 3 => (1, 4, 3, 5, 2)
Swap 5 <=> 2 => (1, 4, 3, 2, 5)

If we count up the swaps, we get seven.

Although, do we even need to make the physical movement of the 1? The number of swaps to move the 1 will always be the number of its initial position in the array, because we need to move it to position 0. But will the number of swaps to move n be its starting position (nstart) subtracted from it’s ending position (nend) minus 1? No, it won’t. If the largest integer is already to the right of the 1, it won’t get moved to the right bubbling the 1 into the first position, so we don’t need to subtract 1.

So, if we loop through the array and find the positions $pos_one and $pos_n (where $n = length(@ints)), then if $pos_one < $pos_n, the output is $pos_one + ($n-1) - $pos_n, otherwise, the output is $pos_one + ($n-1) - $pos_n - 1.

Raku

sub SOP(@ints) {
  my $n = @ints.elems;
  my ($pos_one, $pos_n);
  for 0..($n-1) -> $i {
    $pos_one = $i if @ints[$i] == 1;
    $pos_n   = $i if @ints[$i] == $n;
  }
  if ($pos_one < $pos_n) {
    return $pos_one + ($n-1) - $pos_n;
  }
  else {
    return $pos_one + ($n-1) - $pos_n - 1;
  }
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: @ints = (2, 1, 4, 3)
Output: 2

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

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

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

Example 5:
Input: @ints = (3, 1, 6, 4, 5, 7, 2)
Output: 2

Perl

sub SOP(@ints) {
  my $n = scalar(@ints);
  my ($pos_one, $pos_n);
  for my $i (0..($n-1)) {
    $pos_one = $i if $ints[$i] == 1;
    $pos_n   = $i if $ints[$i] == $n;
  }
  if ($pos_one < $pos_n) {
    return $pos_one + ($n-1) - $pos_n;
  }
  else {
    return $pos_one + ($n-1) - $pos_n - 1;
  }
}

View the entire Perl script for this task on GitHub.

Python

Python’s line count is only 9 lines because there aren’t block delimiters.

def sop(ints):
  n = len(ints)
  for i in range(n):
    if ints[i] == 1: pos_one = i
    if ints[i] == n: pos_n   = i
  if pos_one < pos_n:
    return pos_one + (n-1) - pos_n
  else:
    return pos_one + (n-1) - pos_n - 1

View the entire Python script for this task on GitHub.

Elixir

But even with block delimiters, Elixir comes out at 9 lines because Elixir does some of the work for us though the Enum.find_index/2 function, which returns the index of the first element of the first parameter enumerable for which the second parameter fun returns a truthy value. Essentially, we don’t have to loop through the values to find the positions.

def sop(ints) do
  n = length(ints)
  pos_one = Enum.find_index(ints, fn x -> x == 1 end)
  pos_n   = Enum.find_index(ints, fn x -> x == n end)
  cond do
    pos_one < pos_n -> pos_one + (n-1) - pos_n
    true            -> pos_one + (n-1) - pos_n - 1
  end
end

View the entire Elixir script for this task on GitHub.

Task 1: Contiguous Array

You are given an array of binary numbers, @binary.

Write a script to return the maximum length of a contiguous subarray with an equal number of 0 and 1.

Example 1

Input: @binary = (1, 0)
Output: 2

(1, 0) is the longest contiguous subarray with an equal number of 0 and 1.

Example 2

Input: @binary = (0, 1, 0)
Output: 2

(1, 0) or (0, 1) is the longest contiguous subarray with an equal number of 0 and 1.

Example 3

Input: @binary = (0, 0, 0, 0, 0)
Output: 0

Example 4

Input: @binary = (0, 1, 0, 0, 1, 0)
Output: 4

Approach

Ok, I’ll admit that since I’m tackling task 1 second, I want to attack it the same way I attacked task 2: find some way to mathematically cheat and get the count without actually enumerating the subarrays. So I came up with a counter-example to show a bad scenario.

(1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1)

This has a total of five 1s and six 0s. One would think that we could find a subarray that had five each, but we can’t: there’s a run of five 0s in the middle, so if we’re including the 1s on both sides of it, we’re unable to include enough 1s to offset the number of 0s. So the longest subarray is (1, 1, 0, 1, 0, 0).

I’m thinking that there might be some clever way to count up the numbers and get the , but I’m not feeling clever enough to do it.

Ah, but I do feel like there’s a little bit of cleverness I can sneak in: for any subarray of length n, it will only have an equal number of 0 and 1 if the sum of the array is n/2.

Raku

Picking the starting and stopping points for the subarrays was my big choice. Since the subarray needs to have at least two elements, the outer loop which determines the starting point of the subarray doesn’t need to go all the way to the end: it can stop one before the end, since the smallest subarray we can make at that end of the array will have to end at the final element in the inner loop. Similarly, the inner loop should start one further than the current value of the outer loop, so there’s always at least two elements.

sub contiguousArray(@arr) {
  # special case: all 0s or all 1s
  my $len = @arr.elems;
  my $sum = @arr.sum;
  return 0 if $sum == 0 || $sum == $len;
  
  # special case: entire array is equal
  return $len if $sum == $len/2;

  # generate subarrays and check
  my $max = 0;
  for 0 .. @arr.end - 1 -> $i {
    for $i + 1 .. @arr.end -> $j {
      my @subarr = @arr[$i .. $j];
      if (@subarr.sum == @subarr.elems/2) {
        $max = max($max, @subarr.elems);
      }
    }
  }
  return $max;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: @arr = (1, 0)
Output: 2

Example 2:
Input: @arr = (0, 1, 0)
Output: 2

Example 3:
Input: @arr = (0, 0, 0, 0, 0)
Output: 0

Example 4:
Input: @arr = (0, 1, 0, 0, 1, 0)
Output: 4

Example 5:
Input: @arr = (1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1)
Output: 6

Perl

And the Perl solution is pretty much exactly like the Raku solution. The differences are @arr.elems becomes @arr (merely using @arr in a scalar context returns the number of elements in the array), @arr.end becomes $#arr, the for loops put the variable up front, and we need to import the sum and max from a CPAN module.

use List::AllUtils qw( max sum );

sub contiguousArray(@arr) {
  # special case: all 0s or all 1s
  my $len = @arr;
  my $sum = sum @arr;
  return 0 if $sum == 0 || $sum == $len;
  
  # special case: entire array is equal
  return $len if $sum == $len/2;

  # generate subarrays and check
  my $max = 0;
  for my $i ( 0 .. $#arr - 1 ) {
    for my $j ( $i + 1 .. $#arr ) {
      my @subarr = @arr[$i .. $j];
      if (sum(@subarr) == scalar(@subarr)/2) {
        $max = max($max, scalar @subarr);
      }
    }
  }
  return $max;
}

View the entire Perl script for this task on GitHub.

Python

Python pares things down a little, and we need to remember that range returns a sequence that goes up to but does not include the stop value, but otherwise it’s pretty much the same.

def contiguous_array(arr):
  # special case: all 0s or all 1s
  alen = len(arr)
  asum = sum(arr)
  if asum == 0 or asum == alen: return 0
  
  # special case: entire array is equal
  if asum == alen/2: return alen

  # generate subarrays and check
  amax = 0
  for i in range(alen - 1):
    for j in range(i+1, alen):
      subarr = arr[i:j]
      if (sum(subarr) == len(subarr)/2):
        amax = max(amax, len(subarr))
  return amax

View the entire Python script for this task on GitHub.

Elixir

I really wish I could have done the two special cases as Guards, but the problem is that I need Enum.sum/1 and it’s not available as a guard. So I set up cond do block to handle them and, if neither applies, pass the array into a double Enum.reduce/3 loop to produce the subarrays.

def contiguous_array(arr) do
  len = length(arr)
  sum = Enum.sum(arr)
  cond do
    # special case: all 0s or all 1s
    sum == 0 or sum == len -> 0
    # special case: entire array is equal
    sum == len/2 -> len
    # generate subarrays and check
    true ->
      Enum.reduce(0 .. len-2, 0, fn i, max ->
        Enum.reduce(i+1 .. len-1, max, fn j, max ->
          subarr = Enum.slice(arr, i..j)
          sublen = length(subarr)
          if Enum.sum(subarr) == sublen/2, do:
            Enum.max([max, sublen]), else: max
        end)
      end)
  end
end

View the entire Elixir script for this task on GitHub.

Here’s all my solutions in GitHub: https://github.com/packy/perlweeklychallenge-club/tree/challenge-297-packy-anderson/challenge-297/packy-anderson

Leave a Reply