Flipping the Raku Wave

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

Challenge #55.1: Flip Binary

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:

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 1s 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:

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 1s 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 1s 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]

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

[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

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:

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.

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

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

And that's it.