laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on November, 27, 2022 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Binary Flip

You are given a positive integer, $n.

Write a script to find the binary flip.

Example 1

Input: $n = 5
Output: 2

First find the binary equivalent of the given integer, 101.
Then flip the binary digits 0 -> 1 and 1 -> 0 and we get 010.
So Binary 010 => Decimal 2.

Example 2

Input: $n = 4
Output: 3

Decimal 4 = Binary 100
Flip 0 -> 1 and 1 -> 0, we get 011.
Binary 011 = Decimal 3

Example 3

Input: $n = 6
Output: 1

Decimal 6 = Binary 110
Flip 0 -> 1 and 1 -> 0, we get 001.
Binary 001 = Decimal 1

In theory, we should probably use the binary operators to solve this problem. In practice, it will be easier (and also faster), both in Raku and in Perl, to convert the input integer into a binary string, perform the binary flip as a string operation, and then convert the resulting binary string into an integer.

Binary Flip in Raku

We can use the built-in base method to convert the input integer into a binary string, and the built-in parse-base method to perform the opposite conversion. Then we use the tr/// in-place transliteration operator to transform 0s into 1s and vice-versa.

sub flip (Int $n) {
    my $bin = $n.base(2);
    $bin ~~ tr/10/01/;
    return $bin.parse-base(2);
}

for 5, 4, 6 -> $test {
    say "$test => ", flip($test);
}

This program displays the following output:

$ raku ./bin-flip.raku
5 => 2
4 => 3
6 => 1

This program is so simple that it can easily be coded as a Raku one-liner:

$ raku -e 'say (TR/10/01/ given (+@*ARGS[0]).base(2)).parse-base(2);' 5
2

$ raku -e 'say (TR/10/01/ given (+@*ARGS[0]).base(2)).parse-base(2);' 4
3

$ raku -e 'say (TR/10/01/ given (+@*ARGS[0]).base(2)).parse-base(2);' 6
1

Binary Flip in Perl

In Perl, we can use sprintf to convert the input integer into a binary string, and oct for the reverse conversion. The oct function:

Interprets EXPR as an octal string and returns the corresponding value. (If EXPR happens to start off with “0x”, interprets it as a hex string. If EXPR starts off with “0b”, it is interpreted as a binary string.)

So we only need to prefix the flipped string with 0b. And we use the tr/// operator to perform the binary flip:

use strict; use warnings; use feature qw/say/;

sub flip {
    my $bin = sprintf "%b", shift;
    $bin =~ tr/10/01/;
    return oct("0b" . $bin);
}

for my $test (5, 4, 6) {
    say "$test => ", flip($test);
}

This program displays the following output:

$ perl ./bin-flip.pl
5 => 2
4 => 3
6 => 1

Task 2: Equal Distribution

You are given a list of integers greater than or equal to zero, @list.

Write a script to distribute the number so that members are same. If you succeed then print the total moves otherwise print -1.

Please follow the rules (as suggested by Neils van Dijke (2022-11-21 13:00):

>1) You can only move a value of ‘1’ per move >2) You are only allowed to move a value of ‘1’ to a direct neighbor/adjacent cell

Example 1:

Input: @list = (1, 0, 5)
Output: 4

Move #1: 1, 1, 4
(2nd cell gets 1 from the 3rd cell)

Move #2: 1, 2, 3
(2nd cell gets 1 from the 3rd cell)

Move #3: 2, 1, 3
(1st cell get 1 from the 2nd cell)

Move #4: 2, 2, 2
(2nd cell gets 1 from the 3rd cell)

Example 2:

Input: @list = (0, 2, 0)
Output: -1

It is not possible to make each same.

Example 3:

Input: @list = (0, 3, 0)
Output: 2

Move #1: 1, 2, 0
(1st cell gets 1 from the 2nd cell)

Move #2: 1, 1, 1
(3rd cell gets 1 from the 2nd cell)

First, it should be pretty obvious that there is a solution if and only if the sum of the digits of the input list is evenly divisible by the number of items in the list. Thus, in the second example provided with the task, there is no solution because the sum of the list elements is 2, which is not a multiple of 3, the number of items in the list.

Second, the final solution will have all their elements set to the average of the list items. For instance, in the case of example 1, all elements of the final list are equal to 2, i.e. (1 + 0 + 5) / 3.

Finally, the least number of moves to equalize (1, 0, 5) is the same as the least number of moves to equalize (5, 0, 1) (it is sort of commutative). This means that we can always start from the left and move to the right (and don’t need to try in the other direction). So, if we start from the left, we need to add 1 to 1 to get the target value of 2. For this move to be legal, we need to carry over the change, i.e. subtract 1 from the next value, and, after this first move, we get (2, -1, 5). We don’t care about temporary negative values, and we can see that we’ll need three additional moves to get the center value to 2. At that point, the most right value will have been decremented 3 times and will be equal to 2. Job done, we need in total 4 moves. We only need to generalize this to any number of items.

Equal Distribution in Raku

We simply implement the process described in the comments on the task description just above.

sub equalize (@nums is copy) {
    my $sum = [+] @nums;
    return -1 if $sum % @nums.elems;
    my $target = $sum / @nums.elems;
    my $count = 0;
    my $carry = 0;
    for @nums <-> $num {
        $num -= $carry;
        $carry = $target - $num;
        $count += $carry.abs;
    }
    return $count;
}

for <1 0 5>, <0 2 0>, <0 3 0>, <3 0 3>, <2 2 2>, 
    <1 0 5 2>, <2 5 0 1>, <1 0 5 3>, <6 0 0> -> @test {
    say @test, " \t -> ", equalize @test;
}

This program displays the following output:

$ raku ./equal-dist.raku
(1 0 5)          -> 4
(0 2 0)          -> -1
(0 3 0)          -> 2
(3 0 3)          -> 2
(2 2 2)          -> 0
(1 0 5 2)        -> 4
(2 5 0 1)        -> 4
(1 0 5 3)        -> -1
(6 0 0)          -> 6

Equal Distribution in Perl

We also simply implement the process described above in the discussion of the task.

use strict;
use warnings;
use feature qw/say/;


sub equalize {
    my @nums = @{$_[0]};
    my $sum = 0;
    $sum += $_ for @nums;
    return -1 if $sum % scalar @nums;
    my $target = $sum / scalar @nums;
    my $count = 0;
    my $carry = 0;
    for my $num (@nums) {
        $num -= $carry;
        $carry = $target - $num;
        $count += abs $carry;
    }
    return $count;
}
for my $test ([<1 0 5>], [<0 2 0>], [<0 3 0>], 
              [<3 0 3>], [<2 2 2>], [<1 0 5 2>], 
              [<2 5 0 1>], [<1 0 5 3>], [<6 0 0>]) {
    say "@$test\t -> ", equalize $test;
}

This program displays the following output:

$ perl ./equal-dist.pl
1 0 5    -> 4
0 2 0    -> -1
0 3 0    -> 2
3 0 3    -> 2
2 2 2    -> 0
1 0 5 2  -> 4
2 5 0 1  -> 4
1 0 5 3  -> -1
6 0 0    -> 6

Wrapping up

The next week Perl Weekly Challenge will 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 December 4, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.