Flipping the Raku Wave

[66] Published 9. April 2020.

This is my response to the Perl Weekly Challenge #55.

Challenge #55.1: Flip Binary

You are given a binary number B, consisting of N binary digits 0 or 1 : s0, s1, …, s(N-1). Choose two indices L and R such that 0 ≤ L ≤ R < N and flip the digits s(L), s(L+1), …, s(R). By flipping, we mean change 0 to 1 and vice-versa. For example, given the binary number 010 , the possible flip pair results are listed below: L=0, R=0 the result binary: 110

L=0, R=1 the result binary: 100

L=0, R=2 the result binary: 101

L=1, R=1 the result binary: 000

L=1, R=2 the result binary: 001

L=2, R=2 the result binary: 011 Write a script to find the indices (L,R) that results in a binary number with maximum number of 1s. If you find more than one maximal pair L,R then print all of them. Continuing our example, note that we had three pairs (L=0, R=0), (L=0, R=2), and (L=2, R=2) that resulted in a binary number with two 1s, which was the maximum. So we would print all three pairs.

We start with validating the input, and I have used a custom type with subset :

subset Binary of Int where * ~~ /^*$/; # [1] unit sub MAIN (Binary $binary, :$verbose); # [2]

File: flip-binary (partial)

[1] A custom type that only allows binary numbers. The of Int part can be skipped as it only gives redundant information in this case (and I have done so). (On the other hand, it may make the code easier to read by a human.)

[2] Apply the custom type on the input argument.

We need a helper procedure to flip the digits:

sub flip-binary (Binary $number is copy, $l, $r) # [3] { for $l .. $r -> $index # [4] { $number.substr-rw($index,1) = $number.substr($index,1) eq "1" ?? "0"!! "1"; # [5] } return $number; # [6] }

File: flip-binary (partial)

[3] Note the is copy , so that we can change the value. Procedure arguments are read only by default.

[4] For each position within the range given by L and R,

[5] • flip the digit. Note that substr works on strings, so I have used quotes around the digits. Also note that substr is read only, so I have used substr-rw to change the value.

[6] Return the modified number.

See docs.raku.org/routine/substr for more information about substr .

See docs.raku.org/routine/substr-rw for more information about substr-rw .

And another helper procedure to count the number of 1 s in a (binary) number:

sub count-ones (Binary $number) { return $number.comb.grep( * == "1" ).elems; # [7] }

File: flip-binary (partial)

[7] comb splits the number (or string) into individual characters. From this list of characters we select the ones that are equal to "1" with grep . Finally we use elems to count them.

Collecting all the candidates:

my $size = $binary.chars; # [8] my %result; # [9] say ": Binary number $binary with length $size" if $verbose; for ^$size -> $l # [10] { for $l .. $size-1 -> $r # [11] { my $new = flip-binary($binary, $l, $r); # [12] my $count = count-ones($new); # [13] %result{$count}.push("L=$l, R=$r -> $new"); # [14] say ": $binary + L:$l R:$r -> $new C:$count" if $verbose; } }

File: flip-binary (partial)

[8] The length of the number, used in the loops.

[9] We collect all the possible answers here, with the number of 1 s in the flipped number as the key.

[10] Iterate over the indices (for L),

[11] • and again, from the current L-value (for R).

[12] Get the flipped number.

[13] Get the number of 1 s in it.

[14] Save the result. I use a string suitable for output as the value, so that we can save us the trouble of figuring out how to collect three values (L, R, the number). Note that we can push to a hash value, and this gives an array for the given key.

And finally, printing the result:

say ": Hash: { %result.raku }" if $verbose; my $answer = %result.keys.max; # [15] say "The highest number of ones: $answer"; # [16] .say for @(%result{$answer}); # [17]

File: flip-binary (partial)

[15] Get the key with the highest value, which is the number(s) with the highest number of 1 s.

[16] Print it.

[17] We can have more than one solution, print them all.

Running it:

$ raku flip-binary 010 The highest number of ones: 2 L=0, R=0 -> 110 L=0, R=2 -> 101 L=2, R=2 -> 011 $ raku flip-binary 0000 The highest number of ones: 4 L=0, R=3 -> 1111 $ raku flip-binary 1111 The highest number of ones: 3 L=0, R=0 -> 0111 L=1, R=1 -> 1011 L=2, R=2 -> 1101 L=3, R=3 -> 1110

The last one shows that we end up with a result that is worse than the initial number, as we have to at least flip one digit.

Have a go at «verbose mode»:

$ $ raku flip-binary --verbose 1111 : Binary number 1111 with length 4 : 1111 + L:0 R:0 -> 0111 C:3 : 1111 + L:0 R:1 -> 0011 C:2 : 1111 + L:0 R:2 -> 0001 C:1 : 1111 + L:0 R:3 -> 0000 C:0 : 1111 + L:1 R:1 -> 1011 C:3 : 1111 + L:1 R:2 -> 1001 C:2 : 1111 + L:1 R:3 -> 1000 C:1 : 1111 + L:2 R:2 -> 1101 C:3 : 1111 + L:2 R:3 -> 1100 C:2 : 1111 + L:3 R:3 -> 1110 C:3 : Hash: { \ ("0") => $["L=0, R=3 -> 0000"], \ ("1") => $["L=0, R=2 -> 0001", "L=1, R=3 -> 1000"], \ ("2") => $["L=0, R=1 -> 0011", "L=1, R=2 -> 1001", "L=2, R=3 -> 1100"], \ ("3") => $["L=0, R=0 -> 0111", "L=1, R=1 -> 1011", "L=2, R=2 -> 1101", \ "L=3, R=3 -> 1110"] } The highest number of ones: 3 L=0, R=0 -> 0111 L=1, R=1 -> 1011 L=2, R=2 -> 1101 L=3, R=3 -> 1110

I have added some newlines (marked with / ) to make it more readable.

Challenge #55.2: Wave Array

Any array N of non-unique, unsorted integers can be arranged into a wave-like array such that n1 ≥ n2 ≤ n3 ≥ n4 ≤ n5 and so on. For example, given the array [1, 2, 3, 4], possible wave arrays include [2, 1, 4, 3] or [4, 1, 3, 2], since 2 ≥ 1 ≤ 4 ≥ 3 and 4 ≥ 1 ≤ 3 ≥ 2. This is not a complete list. Write a script to print all possible wave arrays for an integer array N of arbitrary length. Notes: When considering N of any length, note that the first element is always greater than or equal to the second, and then the ≤, ≥, ≤, … sequence alternates until the end of the array.

This is easy, with the permutations keyword:

unit sub MAIN (*@integers where all(@integers) ~~ Int, :$verbose); # [1] for @integers.permutations -> @list # [2] { say ": Checking @list[]" if $verbose; say @list if is-wave(@list); # [3] }

File: wave-array-plain (partial)

[1] It isn't possible to apply a type constraint on a slurpy argument (as *@integers ), but we can smartmatch ~~ all the values with an all junction.

[2] For all the permutations,

[3] • print the list if is a wave array.

See docs.raku.org/routine/permutations for more information about permutations .

See docs.raku.org/routine/all for more information about all .

The helper procedure, deciding if the list is a wave array or not:

sub is-wave(@list) # [4] { my $current = @list[0]; # [5] my $greater = False; # [6] for @list[1 .. *] -> $next # [7] { if $greater # [8] { ($current = $next; return False) if $next < $current; # [8a] } else # [9] { ($current = $next; return False) if $next > $current; # [9a] } $current = $next; # [10] $greater = ! $greater; # [11] } return True; # [12] }

File: wave-array-plain (partial)

[4] The list to check.

[5] Get the first value.

[6] The first comparison is lesser than.

[7] Iterate over the rest of the values, from the second one and to the end.

[8] If the comparison is greater, do this one [8a].

[9] If not (it is lesser), do this one instead [9a].

[10] Set the current vale to the new one. Note that we have to do this in [8a] and [9a] because of the return .

[11] Flip the operator before the next value. The note in [10] applies here as well.

[12] If it didn't fail inside the loop, we have a wave array.

Running it:

$ raku wave-array-plain 1 2 3 (2 1 3) (3 1 2) $ raku wave-array-plain 1 2 3 4 (2 1 4 3) (3 1 4 2) (3 2 4 1) (4 1 3 2) (4 2 3 1) $ raku wave-array-plain 1 1 1 (1 1 1) (1 1 1) (1 1 1) (1 1 1) (1 1 1) (1 1 1)

The last one shows an imortant property of permutations : If we give it repeating values, it will give us repetitions:

> <1 2 3>.permutations ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) > <1 1 2>.permutations ((1 1 2) (1 2 1) (1 1 2) (1 2 1) (2 1 1) (2 1 1))

Applying unique doesn't work, as it uses the Value Identity Operator === to compare the values:

> <1 1 2>.permutations.unique ((1 1 2) (1 2 1) (1 1 2) (1 2 1) (2 1 1) (2 1 1))

But we can tell it to use another operator, or even a custom function, to do the comparison with the :with argument. The Equivalence Operator eqv is the right one:

> <1 1 2>.permutations.unique(:with(&[eqv])) ((1 1 2) (1 2 1) (2 1 1))

Note the syntax: & means that the procedure should be taken as a pointer/reference, and not called up front. [eqv] is how we specify an operator as a procedure argument.

See docs.raku.org/routine/unique for more information about unique .

See docs.raku.org/routine/=== for more information about the Value Identity Operator === .

See docs.raku.org/routine/eqv for more information about the Equivalence Operator eqv .

for @integers.permutations.unique (:with(&[eqv])) -> @list

File: wave-array (changes only)

Running it:

$ raku wave-array 1 1 1 (1 1 1) $ raku wave-array 1 2 3 (2 1 3) (3 1 2)

Looking good.

Non-Magic Bonus

It is possible to do it manually, or the hard way, by taking care of the repetition check ourself, if you think that the :with(&[eqv]) part is way too magical:

my %seen; for @integers.permutations -> @list { my $seen = @list.join(","); next if %seen{$seen}; say ": Checking @list[]" if $verbose; say @list if is-wave(@list); %seen{$seen} = True; }

File: wave-array-hash (partial):

Running it gives the same result as «wave-array».

And that's it.