Perl Weekly Challenge: Week 192
Challenge 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
This could have been a one-liner but I kept it as two to avoid duplication and make things a little clearer,
The first line simply takes the input, $n, and converts it into a binary number.
my $flip = $n.base(2);
You can flip binary digits by combining them with a mask of 1s using the logical exclusive or (XOR) operation. When 1 is XORed with 1 you get 0. 0 XOR 1 gives 1. In Raku numeric XOR is represented by +^. :2 makes its' argument be treated as a binary number. Why does $flip need it when it already is a binary number? For some reason I found it was being treated as a string not a number.
The mask is produced by using the x operator to make a string of 1s equal to the length of $flip.
say (:2($flip) +^ :2(1 x $flip.chars));
You might think that given we are doing an operation on two binary numbers the result will also be a binary number and we will
need something like :10 to convert it back to decimal but apparently something (say?) automatically does it for us.
For Perl, I used sprintf("%b") to convert the input into binary and the misnamed oct() function to convert binary back to decimal. So that oct() knows its' input is a binary number, I prefixed it with 0b first. The XOR operator is ^. The maske is created in the same way as in Raku.
my $flip = sprintf("%b", $n);
say oct '0b' . ($flip ^ (1 x (length $flip)));
Challenge 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 each 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)
At first I thought I was going to have to break out a heavy duty search optimization algorithm such as A* but it turns out the way to solve this challenge is quite straightforward though you do have to be careful all the cases are handled correctly.
In Raku I started by defining a variable to hold the number of moves made.
my $moves;
If you think about it, the list can only be evenly distributed if the sum of the values in the list is a multiple
of the length of the list. I.e. if the list has four elements, they must add up to 4 or 8 or 12 etc or it will never
work. So first we total all the values using.sum() and then check it is a multiple with the !%% operator. This will return true if the sum of the values of @n is not a multiple of its' length. In that case we can just set the result to -1 and stop.
if @n.sum !%% @n.elems {
$moves = -1;
} else {
If it is a multiple, things get more interesting. First we have to know what the multiple is. I don't know why but I chose
to store this in a variable called $balance instead of the more obvious $multiple. We get the value of $balance by dividing
the total value of @n (using the integer division operator div) by the number of elements.
my $balance = @n.sum div @n.elems;
Because @n was received from the command line, it is immutable. We are going to need to change the elements of the list so
I copied @n to a mutable list, @m.
my @m = @n;
When all element of @m are equal to $balance we will have reached our goal. Until then...
until @m.all == $balance {
We keep looping through all the elements. The loop actually goes by index rather than value.
Note the use of .end() which returns the index of the last element so you don't have to keep remembering that, as array indexes
start from 0, it is one less than the number of elements. Trivial, but it is precisely these sort of little conveniences that make
Raku so fun to work with.
for 0 .. @m.end -> $i {
If the value of the element with the current index is 0, there is nothing to be done. We can move on to the next element.
if @m[$i] == 0 {
next;
}
If that element is less than $balance...
elsif @m[$i] < $balance {
If the element to its left (assuming we are not on the first element) is bigger, we decrement its value and increment the current element. The number of moves is also incremented.
if $i > 0 && @m[$i - 1] > @m[$i] {
@m[$i - 1]--;
@m[$i]++;
$moves++;
}
Similarly if the element to the right (assuming we are not on the last element) is bigger, we decrement that one and increment the current element. Once again, the number of moves is incremented.
if $i < @m.end && @m[$i + 1] > @m[$i] {
@m[$i + 1]--;
@m[$i]++;
$moves++;
}
}
If the current element is greater than balance, we do similar operations but in reverse. The current element is decremented and the ones to the left or right are incremented. In each case, the number of moves is incremented.
elsif @m[$i] > $balance {
if $i > 0 && @m[$i - 1] < @m[$i] {
@m[$i - 1]++;
@m[$i]--;
$moves++;
}
if $i < @m.end && @m[$i + 1] < @m[$i] {
@m[$i + 1]++;
@m[$i]--;
$moves++;
}
}
}
We continue looping through the array like this until we have reached our "victory condition" of all elements having
the same value.
}
}
Finally, whatever number of $moves we have is printed.
say $moves;
The major problem with the Perl solution was as is so often the case, needing to replace functionality which is built into Raku.
This function replaces .all().
sub all {
my ($arr, $val) = @_;
for my $elem (@{$arr}) {
if ($elem != $val) {
return undef;
}
}
return 1;
}
And this one replaces .sum().
sub sum {
my ($arr) = @_;
my $total = 0;
for my $elem (@{$arr}) {
$total += $elem;
}
return $total;
}
Finally, here is a replacement for !%%.
sub isEvenlyDivisible {
my ($arr) = @_;
return sum($arr) % (scalar @{$arr}) == 0;
}
Most of the rest was a straightforward translation from Raku.
We don't have to worry about immutability in Perl so there is no need for @m; everything is done to @n.
my $moves;
if (!isEvenlyDivisible(\@n)) {
$moves = -1;
} else {
my $balance = sum(\@n) / scalar @n;
The variable $end is a replacement for .end().
my $end = scalar @n - 1;
until (all(\@n, $balance)) {
for my $i (0 .. $end) {
if ($n[$i] == 0) {
next;
}
elsif ($n[$i] < $balance) {
if ($i > 0 && $n[$i - 1] > $n[$i]) {
$n[$i - 1]--;
$n[$i]++;
$moves++;
}
if ($i < $end && $n[$i + 1] > $n[$i]) {
$n[$i + 1]--;
$n[$i]++;
$moves++;
}
}
elsif ($n[$i] > $balance) {
if ($i > 0 && $n[$i - 1] < $n[$i]) {
$n[$i - 1]++;
$n[$i]--;
$moves++;
}
if ($i < $end && $n[$i + 1] < $n[$i]) {
$n[$i + 1]++;
$n[$i]--;
$moves++;
}
}
}
}
}
say $moves;