This is my response to The Weekly Challenge #297.
@binary.
0 and 1.
Input: @binary = (1, 0)
Output: 2
(1, 0) is the longest contiguous subarray with an equal number of 0
and 1.
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.
Input: @binary = (0, 0, 0, 0, 0)
Output: 0
Input: @binary = (0, 1, 0, 0, 1, 0)
Output: 4
Brute force seems the best way, where we try (almost) all possible combinations of start and stop positions in the array.
File: contiguous-array
#! /usr/bin/env raku
subset BinaryDigit of Int where * eq any(0,1); # [1a]
unit sub MAIN (*@binary where @binary.elems >= 1
&& all(@binary) ~~ BinaryDigit, # [1]
:v(:$verbose));
my $end = @binary.end; # [2]
my $max = 0; # [3]
for 0 .. $end -> $start # [4]
{
for $end ... $start -> $stop # [5]
{
my $size = $stop - $start + 1; # [6]
say ": Slice: [$start..$stop] Size: $size Values: \
({ @binary[$start..$stop].join(",") })" if $verbose;
if $size <= $max # [7]
{
say ": - Skipping the rest of the inner loop (size too small)"
if $verbose;
last; # [7a]
}
unless $size %% 2 # [8]
{
say ": - Uneven size ($size) - Skipped" if $verbose;
next; # [8a]
}
my $equal = $size == @binary[$start..$stop].sum * 2; # [9]
if $equal && $size > $max # [10]
{
$max = $size; # [10b]
say ": - Equal -> New Maximum: $max" if $verbose;
}
elsif $verbose
{
say ": - Equal: $equal";
}
}
}
say $max; # [11]
[1] Ensure that we get at least one element, and that they
are of the «BinaryDigit» custom type set up with subset [1a].
See docs.raku.org/routine/subset for more information about subset.
[2] Get the index of the last element, to be used as the upper boundary in the loops.
[3] The current «longest contiguous subarray», or max for short.
[4] Start at the beginning (index 0), going all the way to the end.
[5] Stop (as in stop the subarray) at the end, going all the way down to the current start position. This allows us the optimisation in [7].
[6] Get the size of the current subarray.
[7] Skip the rest of the inner loop [7a] if we have a subarray that is smaller than the current max value. This is the "almost" part from the preamble.
[8] Skip the current subarray if it has an odd number of elements, using
the divisibility operator %% and the number 2.
See docs.raku.org/routine/%% for more information about %%.
[9] Even number of 0s and 1s? Get the subarray, add the values
together (with sum) and double that to compensate for the same number
of 0s. Do we have the correct size? if so, we have a match.
[10] If we have a new candidate, and it is longer than the previous maximum, set the new maximum [10a].
[11] Print the result.
Note that the verbose mode code makes the program much longer than it needs to be.
Running it:
$ ./contiguous-array 1 0
2
$ ./contiguous-array 0 1 0
2
$ ./contiguous-array 0 0 0 0 0
0
$ ./contiguous-array -v 0 1 0 0 1 0
0
Looking good.
With verbose mode:
$ ./contiguous-array -v 1 0
: Slice: [0..1] Size: 2 Values: (1,0)
: - Equal -> New Maximum: 2
: Slice: [0..0] Size: 1 Values: (1)
: - Skipping the rest of the inner loop (size too small)
: Slice: [1..1] Size: 1 Values: (0)
: - Skipping the rest of the inner loop (size too small)
2
$ ./contiguous-array -v 0 1 0
: Slice: [0..2] Size: 3 Values: (0,1,0)
: - Uneven size (3), skipped
: Slice: [0..1] Size: 2 Values: (0,1)
: - Equal: True - New Maximum: 2
: Slice: [0..0] Size: 1 Values: (0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [1..2] Size: 2 Values: (1,0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [2..2] Size: 1 Values: (0)
: - Skipping the rest of the inner loop (size too small)
2
$ ./contiguous-array -v 0 0 0 0 0
: Slice: [0..4] Size: 5 Values: (0,0,0,0,0)
: - Uneven size (5) - Skipped
: Slice: [0..3] Size: 4 Values: (0,0,0,0)
: - Equal: False
: Slice: [0..2] Size: 3 Values: (0,0,0)
: - Uneven size (3) - Skipped
: Slice: [0..1] Size: 2 Values: (0,0)
: - Equal: False
: Slice: [0..0] Size: 1 Values: (0)
: - Uneven size (1) - Skipped
: Slice: [1..4] Size: 4 Values: (0,0,0,0)
: - Equal: False
: Slice: [1..3] Size: 3 Values: (0,0,0)
: - Uneven size (3) - Skipped
: Slice: [1..2] Size: 2 Values: (0,0)
: - Equal: False
: Slice: [1..1] Size: 1 Values: (0)
: - Uneven size (1) - Skipped
: Slice: [2..4] Size: 3 Values: (0,0,0)
: - Uneven size (3) - Skipped
: Slice: [2..3] Size: 2 Values: (0,0)
: - Equal: False
: Slice: [2..2] Size: 1 Values: (0)
: - Uneven size (1) - Skipped
: Slice: [3..4] Size: 2 Values: (0,0)
: - Equal: False
: Slice: [3..3] Size: 1 Values: (0)
: - Uneven size (1) - Skipped
: Slice: [4..4] Size: 1 Values: (0)
: - Uneven size (1) - Skipped
0
$ ./contiguous-array -v 0 1 0 0 1 0
: Slice: [0..5] Size: 6 Values: (0,1,0,0,1,0)
: - Equal: False
: Slice: [0..4] Size: 5 Values: (0,1,0,0,1)
: - Uneven size (5) - Skipped
: Slice: [0..3] Size: 4 Values: (0,1,0,0)
: - Equal: False
: Slice: [0..2] Size: 3 Values: (0,1,0)
: - Uneven size (3) - Skipped
: Slice: [0..1] Size: 2 Values: (0,1)
: - Equal: True - New Maximum: 2
: Slice: [0..0] Size: 1 Values: (0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [1..5] Size: 5 Values: (1,0,0,1,0)
: - Uneven size (5) - Skipped
: Slice: [1..4] Size: 4 Values: (1,0,0,1)
: - Equal: True - New Maximum: 4
: Slice: [1..3] Size: 3 Values: (1,0,0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [2..5] Size: 4 Values: (0,0,1,0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [3..5] Size: 3 Values: (0,1,0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [4..5] Size: 2 Values: (1,0)
: - Skipping the rest of the inner loop (size too small)
: Slice: [5..5] Size: 1 Values: (0)
: - Skipping the rest of the inner loop (size too small)
4
$n integers, @ints.
@ints a semi-ordered permutation.
Input: @ints = (2, 1, 4, 3)
Output: 2
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)
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)
Input: @ints = (1, 3, 2, 4, 5)
Output: 0
Already a semi-ordered permutation.
Let us try to be clever. We do not actually have to swap anything, just count the swapping distance.
File: semi-ordered-permutation-fail
#! /usr/bin/env raku
subset PosInt of Int where * > 0; # [1]
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt, # [1a]
:v(:$verbose));
my $n = @ints.elems; # [2]
say ": n:$n" if $verbose;
die "Duplicates" unless [<] @ints.sort; # [3]
die "Missing zero" unless @ints.min == 1; # [4]
die "Missing n" unless @ints.max == $n; # [5]
my $one-index = @ints.first(1, :k); # [6]
my $n-index = @ints.first($n, :k); # [7]
my $one-moves = $one-index; # [8]
my $n-moves = $n - $n-index - 1; # [9]
say ": 1 at index $one-index requires $one-moves moves" if $verbose;
say ": $n at index $n-index requires $n-moves moves" if $verbose;
say $one-moves + $n-moves; # [18]
[1] At least one element, and they must all be positive integers.
[2] Get the n value.
[3] Use the Reduction Metaoperator
[] in combination with < on the sorted inout to ensure that
we do not have duplicate values.
See
docs.raku.org/language/operators#Reduction_metaoperators for more
information about the Reduction Metaoperator [].
There are many ways to ascertain uniqueness. Here are some:
See docs.raku.org/routine/unique for more information about unique.
See docs.raku.org/routine/repeated for more information about repeated.
[4] The lowest value must be 1,
[5] and the highest n. We have now ensured that all the integers
1..n are present.
[6] Get the location (index) of the first (and only) 1.
Note the :k adverb that gives us the position instead of the value.
See docs.raku.org/routine/first for more information about first.
[7] The same for n.
[8] The number of moves (swaps) required to get the 1 to the front.
[9] The number of moves get the n to the end.
[10] Print the sum.
Running it:
$ ./semi-ordered-permutation-fail 2 1 4 3
2
$ ./semi-ordered-permutation-fail 2 4 1 3
4
$ ./semi-ordered-permutation-fail 1 3 2 4 5
0
The second example is wrong. Let us have a look at it with verbose mode:
$ ./semi-ordered-permutation-fail -v 2 4 1 3
: n:4
: 1 at index 2 requires 2 moves
: 4 at index 1 requires 2 moves
4
The problem is that the highest value (4) is to the left of the lowest value (1), and when we swap them - we change the positions on both, in that single swap operation.
Compensating for that is easy:
File: semi-ordered-permutation-count
#! /usr/bin/env raku
subset PosInt of Int where * > 0;
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my $n = @ints.elems;
say ": n:$n" if $verbose;
die "Duplicates" unless [<] @ints.sort;
die "Missing zero" unless @ints.min == 1;
die "Missing n" unless @ints.max == $n;
my $one-index = @ints.first(1, :k);
my $n-index = @ints.first($n, :k);
my $one-moves = $one-index;
my $n-moves = $n - $n-index - 1;
my $wrong-order = $one-index > $n-index; # [1]
if $verbose
{
say ": 1 at index $one-index requires $one-moves moves";
say ": $n at index $n-index requires $n-moves moves";
say ": Compensate for wrong order '$n <=> 1' by subtracting 1 move"
if $wrong-order;
}
say $one-moves + $n-moves - $wrong-order; # [2]
[1] Are the 1 and n in the wrong order?
[2] Compensate for the wrong order. Note that the Boolean values true
and false are coerced to 1 and 0 in numeric context.
$ ./semi-ordered-permutation-count -v 2 1 4 3
: n:4
: 1 at index 1 requires 1 moves
: 4 at index 2 requires 1 moves
2
$ ./semi-ordered-permutation-count -v 2 4 1 3
: n:4
: 1 at index 2 requires 2 moves
: 4 at index 1 requires 2 moves
: Compensate for wrong order '4 <=> 1' by subtracting 1 move
3
$ ./semi-ordered-permutation-count -v 1 3 2 4 5
: n:5
: 1 at index 0 requires 0 moves
: 5 at index 4 requires 0 moves
0
Note that this program does not actually swap anything, so the final order of the list is unknown. If that is a problem, here is that final order:
File: semi-ordered-permutation-show
#! /usr/bin/env raku
subset PosInt of Int where * > 0;
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my $n = @ints.elems;
say ": n:$n" if $verbose;
die "Duplicates" unless [<] @ints.sort;
die "Missing zero" unless @ints.min == 1;
die "Missing n" unless @ints.max == $n;
my $one-index = @ints.first(1, :k);
my $n-index = @ints.first($n, :k);
my $one-moves = $one-index;
my $n-moves = $n - $n-index - 1;
my $wrong-order = $one-index > $n-index;
if $verbose
{
say ": 1 at index $one-index requires $one-moves moves";
say ": $n at index $n-index requires $n-moves moves";
say ": Compensate for wrong order '$n <=> 1' by subtracting 1 move"
if $wrong-order;
@ints.splice(max($one-index, $n-index), 1); # [1]
@ints.splice(min($one-index, $n-index), 1); # [2]
@ints.push($n).unshift(1); # [3]
say ": Semi Ordered Permutation: ({ @ints.join(",") })";
}
say $one-moves + $n-moves - $wrong-order;
[1] Extract the value with the highest index first, so that we do not change the index of the other one.
[2] Then extract the other one.
[3] Add n at the end (with push) and 1 at the beginning
(with unshift).
The examples work out:
$ ./semi-ordered-permutation-show -v 2 1 4 3
: n:4
: 1 at index 1 requires 1 moves
: 4 at index 2 requires 1 moves
: Semi Ordered Permutation: (1,2,3,4)
2
$ ./semi-ordered-permutation-show -v 2 4 1 3
: n:4
: 1 at index 2 requires 2 moves
: 4 at index 1 requires 2 moves
: Compensate for wrong order '4 <=> 1' by subtracting 1 move
: Semi Ordered Permutation: (1,2,3,4)
3
$ ./semi-ordered-permutation-show -v 1 3 2 4 5
: n:5
: 1 at index 0 requires 0 moves
: 5 at index 4 requires 0 moves
: Semi Ordered Permutation: (1,3,2,4,5)
0
You may have noticed that I still did not really swap anything. We can of course do it the hard way, which is not really that hard:
File: semi-ordered-permutation-swap
#! /usr/bin/env raku
subset PosInt of Int where * > 0;
unit sub MAIN (*@ints is copy where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my $n = @ints.elems;
say ": n:$n" if $verbose;
die "Duplicates" unless [<] @ints.sort;
die "Missing zero" unless @ints.min == 1;
die "Missing n" unless @ints.max == $n;
my $swaps = 0; # [1]
while @ints[0] != 1 # [2]
{
my $one-index = @ints.first(1, :k); # [3]
$swaps++; # [4]
@ints[$one-index -1, $one-index] = @ints[$one-index, $one-index -1]; # [5]
say ": swap 1 #$swaps: index { $one-index - 1 } and $one-index -> \
({@ints.join(",")})" if $verbose;
}
while @ints[$n -1] != $n # [6]
{
my $n-index = @ints.first($n, :k); # [7]
$swaps++;
@ints[$n-index +1, $n-index] = @ints[$n-index, $n-index +1]; # [8]
say ": swap $n #$swaps: index { $n-index - 1 } and $n-index -> \
({@ints.join(",")})" if $verbose;
}
say $swaps; # [9]
[1] The number of swaps, initially none.
[2] As long as the the first value is not 1:
[3] • Get the index of the 1.
[4] • Add the swap to the count.
[5] • Swap the 1 with the value to the left of it.
[6] As long as the last value is not n:
[7] • Get the index.
[8] • Swap the n with the value to the right of it.
[9] Print the result.
An example:
$ ./semi-ordered-permutation-swap -v 5 4 3 2 1
: n:5
: swap 1 #1: index 3 and 4 -> (5,4,3,1,2)
: swap 1 #2: index 2 and 3 -> (5,4,1,3,2)
: swap 1 #3: index 1 and 2 -> (5,1,4,3,2)
: swap 1 #4: index 0 and 1 -> (1,5,4,3,2)
: swap 5 #5: index 0 and 1 -> (1,4,5,3,2)
: swap 5 #6: index 1 and 2 -> (1,4,3,5,2)
: swap 5 #7: index 2 and 3 -> (1,4,3,2,5)
7
It is possible to optimise this. We do not have to call
first all the time, as we know the new position after the first swap.
#! /usr/bin/env raku
subset PosInt of Int where * > 0;
unit sub MAIN (*@ints is copy where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my $n = @ints.elems;
say ": n:$n" if $verbose;
die "Duplicates" unless [<] @ints.sort;
die "Missing zero" unless @ints.min == 1;
die "Missing n" unless @ints.max == $n;
my $swaps = 0;
my $one-index = @ints.first(1, :k); # [1]
for (1 .. $one-index).reverse -> $index # [2]
{
$swaps++;
@ints[$index -1, $index] = @ints[$index, $index -1]; # [3]
say ": swap 1 #$swaps: index { $index - 1 } and $index -> \
({@ints.join(",")})" if $verbose;
}
my $n-index = @ints.first($n, :k); # [1n]
for $n-index .. $n -2 -> $index # [2n]
{
$swaps++;
@ints[$index +1, $index] = @ints[$index, $index +1]; # [3n]
say ": swap $n #$swaps: index { $index - 1 } and $index -> \
({@ints.join(",")})" if $verbose;
}
say $swaps;
[1] Move the index obtaining out of the loop.
[2] Swap the 1 as many times as required. Using the Sequence Operator
like $one-index ... 1 to count down would work, except when
$one-index is 1; then it would count up and give us
(0,1). The nice thing about the Range Operator .. is that is will
give us nothing if we try to get it to count down. Which is exactly what we
want.
[3] Swap.
Running it gives the expected result, here with verbose mode:
$ ./semi-ordered-permutation -v 2 1 4 3
: n:4
: swap 1 #1: index 0 and 1 -> (1,2,4,3)
: swap 4 #2: index 1 and 2 -> (1,2,3,4)
2
$ ./semi-ordered-permutation -v 2 4 1 3
: n:4
: swap 1 #1: index 1 and 2 -> (2,1,4,3)
: swap 1 #2: index 0 and 1 -> (1,2,4,3)
: swap 4 #3: index 1 and 2 -> (1,2,3,4)
3
$ ./semi-ordered-permutation -v 1 3 2 4 5
: n:5
0
Some more, just for fun:
$ ./semi-ordered-permutation -v 5 2 3 4 1
: n:5
: swap 1 #1: index 3 and 4 -> (5,2,3,1,4)
: swap 1 #2: index 2 and 3 -> (5,2,1,3,4)
: swap 1 #3: index 1 and 2 -> (5,1,2,3,4)
: swap 1 #4: index 0 and 1 -> (1,5,2,3,4)
: swap 5 #5: index 0 and 1 -> (1,2,5,3,4)
: swap 5 #6: index 1 and 2 -> (1,2,3,5,4)
: swap 5 #7: index 2 and 3 -> (1,2,3,4,5)
7
$ ./semi-ordered-permutation -v 9 8 7 6 5 4 3 2 1
: n:9
: swap 1 #1: index 7 and 8 -> (9,8,7,6,5,4,3,1,2)
: swap 1 #2: index 6 and 7 -> (9,8,7,6,5,4,1,3,2)
: swap 1 #3: index 5 and 6 -> (9,8,7,6,5,1,4,3,2)
: swap 1 #4: index 4 and 5 -> (9,8,7,6,1,5,4,3,2)
: swap 1 #5: index 3 and 4 -> (9,8,7,1,6,5,4,3,2)
: swap 1 #6: index 2 and 3 -> (9,8,1,7,6,5,4,3,2)
: swap 1 #7: index 1 and 2 -> (9,1,8,7,6,5,4,3,2)
: swap 1 #8: index 0 and 1 -> (1,9,8,7,6,5,4,3,2)
: swap 9 #9: index 0 and 1 -> (1,8,9,7,6,5,4,3,2)
: swap 9 #10: index 1 and 2 -> (1,8,7,9,6,5,4,3,2)
: swap 9 #11: index 2 and 3 -> (1,8,7,6,9,5,4,3,2)
: swap 9 #12: index 3 and 4 -> (1,8,7,6,5,9,4,3,2)
: swap 9 #13: index 4 and 5 -> (1,8,7,6,5,4,9,3,2)
: swap 9 #14: index 5 and 6 -> (1,8,7,6,5,4,3,9,2)
: swap 9 #15: index 6 and 7 -> (1,8,7,6,5,4,3,2,9)
15
And that's it.