laurent_r

These are some answers to the Week 55 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task # 1: Flipping Binary Numbers

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.

There may be an analytical solution. For example, we may look for the longest sequence of 0s. But that’s not guaranteed to produce the maximum number of 1s. For example, the longest sequence of 0 may be 00000. But if we have somewhere else the sequence, 000010000, then is would be better to flip that sequence. It seems quite difficult to automatize the analysis. Especially, it seems difficult to make sure that we find all maximum index pairs. So we’ll use brute force: try all possibilities and pick up the best one(s).

Flipping Binary Numbers in Perl

The brute force algorithm is quite straight forward. We use nested loops to iterate over every possible $left-$right pair and store the index pair and the resulting string into an array (with the index being the number of 1s). Then, we just pick up the items with the highest array subscript:

use strict;
use warnings;
use feature "say";

sub flip {
    my $bin_nr = shift;
    die "Please supply a binary string." 
        unless $bin_nr =~ /^[01]*$/;
    my @chars = split //, $bin_nr;
    my @result;
    for my $left (0..$#chars) {
        for my $right ($left..$#chars) {
            my @tmp_chars = @chars;
            for my $i ($left..$right) {
                $tmp_chars[$i] = $chars[$i] ? 0 : 1;
            }
            my $count = scalar grep $_ == 1, @tmp_chars;
            $result[$count] .= "$left-$right: @tmp_chars\n";
        }
    }
    return $result[-1];
}
say flip shift // "01011" ;

Running the program a couple of times produces the following output:

$ perl binstr.pl 01001110000011
7-11: 0 1 0 0 1 1 1 1 1 1 1 1 1 1

$ perl binstr.pl 010011100010011
7-12: 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1

Flipping Binary Numbers in Raku

We just use the same brute-force algorithm in Raku:

use v6;

sub flip ($bin-nr) {
    my @chars = $bin-nr.comb;
    my @result;
    for 0..@chars.end -> $left {
        for $left..@chars.end -> $right {
            my @tmp-chars = @chars;
            for $left..$right -> $i {
                @tmp-chars[$i] = @chars[$i] == 1  ?? 0 !! 1;
            }
            my $count = [+] @tmp-chars;
            @result[$count] ~= "$left-$right: @tmp-chars[]\n";
        }
    }
    return @result[*-1];
}
sub MAIN (Str $in where $in ~~ /^ <[01]>+ $/ = "01011") {
    say flip $in;
}

Running this program with the same input binary strings displays the same output as before:

$ perl6 binstr.p6 01001110000011
7-11: 0 1 0 0 1 1 1 1 1 1 1 1 1 1

$ perl6 binstr.p6 010011100010011
7-12: 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1

Task 2: Wave Arrays

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.

Since we want to find all possible wave arrays, we’ll need to explore all possibilities, and we need again brute force. The pure brute force algorithm would be to generate all permutations and retain those matching the wave criteria. We can use an improved brute-force solution that builds only the permutations whose beginning matches the wave criteria, thereby reducing significantly the number of possibilities to explore.

Wave Arrays in Perl

To build the permutations, we use the add_1_item recursive subroutine that is called with three arguments: a mode, the input values and the output values. The mode is a flip-flop Boolean variable that tells us if the next item should be greater than the previous one (or equal), or if it should be less. Each time we add an item, we flip $mode from 1 to 0 or vice-versa. The add_1_item subroutine picks each of the input values, adds it to the output if the wave criteria is met, and it calls itself recursively. Note that our first implementation simply printed each result when found. But that did not work properly when there was some duplicate values in the input, as it would print several times the same wave sequences (which is probably undesired). Therefore, we’ve put the outcome in the %results hash to remove duplicate wave sequences before printing them.

use strict;
use warnings;
use feature "say";

my %results;

sub add_1_item {
    my ($mode, $input, $output) = @_;
    unless (@$input) {
        $results{"@$output"} = 1;
        return;
    }
    my $last = $output->[-1];
    for my $i (0..$#$input) {
        if ($mode == 0) {
            next if $input->[$i] > $last;
            add_1_item(1, [@$input[0..$i-1, $i+1..$#$input]], 
                [@$output, $input->[$i]]);

        } else {
            next if $input->[$i] < $last;
            add_1_item(0, [@$input[0..$i-1, $i+1..$#$input]], 
                [@$output, $input->[$i]]);
        }
    }
}
my @in = (1, 2, 3, 4);
@in = @ARGV if defined $ARGV[0];
for my $i (0..$#in) {
    add_1_item(0, [@in[0..$i-1, $i+1..$#in]], [$in[$i]]);
}
say for sort keys %results;

We display here two sample runs:

$ perl wave.pl 1 2 3 4
2 1 4 3
3 1 4 2
3 2 4 1
4 1 3 2
4 2 3 1

$ perl wave.pl  3 4 5 2 1
2 1 4 3 5
2 1 5 3 4
3 1 4 2 5
3 1 5 2 4
3 2 4 1 5
3 2 5 1 4
4 1 3 2 5
4 1 5 2 3
4 2 3 1 5
4 2 5 1 3
4 3 5 1 2
5 1 3 2 4
5 1 4 2 3
5 2 3 1 4
5 2 4 1 3
5 3 4 1 2

Wave Arrays in Raku

This is a port to Raku of the previous Perl program:

use v6;

my SetHash $results;

sub add_1_item ($mode, @input, @output) {
    unless @input.elems {
        $results{"@output[]"}++;
        return;
    }

    my $last = @output[*-1];
    for 0..@input.end -> $i {
        if ($mode == 0) {
            next if @input[$i] > $last;
            add_1_item(1, @input[0..$i-1, $i+1..@input.end].flat, 
                (@output, @input[$i]).flat);

        } else {
            next if @input[$i] < $last;
            add_1_item(0, @input[0..$i-1, $i+1..@input.end].flat, 
                (@output, @input[$i]).flat);
        }
    }
}

my @in = 1, 2, 3, 4;
@in = @*ARGS if @*ARGS.elems > 0;
for 0..@in.end -> $i {
    my @out = @in[$i],;
    add_1_item(0, @in[0..$i-1, $i+1..@in.end].flat, @out);
}
.say for $results.keys.sort;

This is the output for two sample runs:

$ perl6 wave.p6  3 4 2 1
2 1 4 3
3 1 4 2
3 2 4 1
4 1 3 2
4 2 3 1

$ perl6 wave.p6   3 4 5 2 1
2 1 4 3 5
2 1 5 3 4
3 1 4 2 5
3 1 5 2 4
3 2 4 1 5
3 2 5 1 4
4 1 3 2 5
4 1 5 2 3
4 2 3 1 5
4 2 5 1 3
4 3 5 1 2
5 1 3 2 4
5 1 4 2 3
5 2 3 1 4
5 2 4 1 3
5 3 4 1 2

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, April 19, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.