Perl Weekly Challenge: Week 119
Challenge 1:
Swap Nibbles
You are given a positive integer
$N.Write a script to swap the two nibbles of the binary representation of the given number and print the decimal number of the new binary representation.
A nibble is a four-bit aggregation, or half an octet.
To keep the task simple, we only allow integer less than or equal to 255.
Example
Input: $N = 101
Output: 86
Binary representation of decimal 101 is 1100101 or as 2 nibbles (0110)(0101).
The swapped nibbles would be (0101)(0110) same as decimal 86.
Input: $N = 18
Output: 33
Binary representation of decimal 18 is 10010 or as 2 nibbles (0001)(0010).
The swapped nibbles would be (0010)(0001) same as decimal 33.
In Raku you can convert a string to a number in a particular base with the .base() method.
my $n = $N.base(2);
To get a proper division into nibbles, the number of binary digits must be a multiple of 8. (we need an even number of nibbles to swap.) If it isn't, this code pads the front with extra 0's until it is.
if $n.chars !%% 8 {
$n = 0 x (8 - $n.chars % 8) ~ $n;
}
This next line looks complicated but it isn't really. From left to right: .comb() splits
$n into an array of nibbles. .reverse() swaps them. This would be incorrect if we had
more than 2 nibbles but the spec guarantees $N will be 255 or less. .join() joins the array
back into a string and .parse-base() converts that string back into a (base 10) number again. Finally
.say() prints the answer.
$n.comb(4).reverse.join.parse-base(2).say;
In Perl we use sprintf() to convert to binary.
my $n = sprintf "%b", $N;
0-padding works the same as with Raku.
if ((length $n) % 8 != 0) {
$n = 0 x (8 - (length $n) % 8) . $n;
}
This line has to be read from right to left. unpack '(A4)*' splits $n into nibbles. reverse() swaps them.
join(q{}) joins them up. I've expressed my annoyance about this before but to convert a binary string back to decimal, you need oct() which is not intuitive at all. And the string needs to be prefixed with 0b to be recognized as binary. say() as in Raku, prints the result.
say oct '0b' . join q{}, reverse (unpack '(A4)*', $n);
Challenge 2:
Sequence Without 1-on-1
Write a script to generate sequence starting at 1. Consider the increasing sequence of integers which contain only 1’s, 2’s and 3’s, and do not have any doublets of 1’s like below. Please accept a positive integer
$Nand print the$Nthterm in the generated sequence.1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, …
Example
Input: $N = 5
Output: 13
Input: $N = 10
Output: 32
Input: $N = 60
Output: 2223
I know there must be a proper formula for this sequence and I tried and tried to figure it out but I guess it is just beyond my mathematical abilities so I took the easy way out and just counted up the numbers from 1 onwards checking each one for the desired characteristics and stopping when I found the $Nth one.
In Perl I begin by setting two counters. $n is a candidate to test. $nth is the number of matches we've found
so far.
my $n = 0;
my $nth = 0;
We increase $n by 1 successively. (So the first number we test is actually 1.)
while (++$n) {
A match will consist only of the digts 1, 2 or 3 and will not start with 11.
if ( $n =~ /^ [1-3]+ $/x && $n !~ /^ 11/x ) {
If the match was successful, $nth is incremented. If $nth equals $N, we have our answer. We
can print it and exit the loop and thereby, the script.
if (++$nth == $N) {
say $n;
last;
}
}
If not, we go through the loop again.
}
In Raku we can do this far more concisely; in fact as a one-liner. We start off with a list of all integers from 1.
Such an infinite list doesn't require an infinite amount of memory because Raku has "lazy lists" whose values only
pop into existence when they are actually used. Then we .grep() through this list for numbers that match the
criteria. [@*ARGS[0] - 1] is the Nth value (taking N from the command line) and .say() prints it.
(1 .. *).grep({ /^ <[1 .. 3]>+ $/ && !/^ 11/ })[@*ARGS[0] - 1].say