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

You are given a binary number
Choose two indices
For example, given the binary number - 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 (
Continuing our example, note that we had three pairs |

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

:

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

[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:

File: flip-binary (partial)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]
}

[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]
}

[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:

File: flip-binary (partial)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;
}
}

[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:

File: flip-binary (partial)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]

[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.

Any array
For example, given the array
Write a script to print all possible wave arrays for an integer array ## Notes:
When considering |

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]
}

[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:

File: wave-array-plain (partial)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]
}

[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
```

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.

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;
}

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

And that's it.