Perl Weekly Challenge: Week 70

Challenge 1:

Character Swapping

You are given a string $S of size $N.

You are also given swap count $C and offset $O such that $C >= 1, $O >= 1, $C <= $O and $C + $O <= $N.

Write a script to perform character swapping like below:

$S[ 1 % $N ] <=> $S[ (1 + $O) % $N ]
$S[ 2 % $N ] <=> $S[ (2 + $O) % $N ]
$S[ 3 % $N ] <=> $S[ (3 + $O) % $N ]
...
...
$S[ $C % $N ] <=> $S[ ($C + $O) % $N ]

Example 1:

Input:
    $S = 'perlandraku'
    $C = 3
    $O = 4

Character Swapping:
    swap 1: e <=> n = pnrlaedraku
    swap 2: r <=> d = pndlaerraku
    swap 3: l <=> r = pndraerlaku

Output:
    pndraerlaku

This one was fairly straightforward. Once you have all the parameters set up, all you need to do is a series of swaps. I converted the string into an array to make swapping elements slightly easier and then joined it back up into a string in the end. The temporary variables $a and $b aren't strictly necessary but they make the code a bit more legible and avoid needless extra calculations.

 my @chars = split //, $S;
 for my $i (1 .. $C) {
     my $a = $i % $N;
     my $b = ($i + $O) % $N;
     my $temp = $chars[$a];
     $chars[$a] = $chars[$b];
     $chars[$b] = $temp;
 }

 say join q{}, @chars;

(Full code on Github.)

And this is the Raku version.

 my @chars = $S.comb;

 for 1 .. $C -> $i {
     my $a = $i % $N;
     my $b = ($i + $O) % $N;
     my $temp = @chars[$a];
     @chars[$a] = @chars[$b];
     @chars[$b] = $temp;
 }

 @chars.join(q{}).say;

(Full code on Github.)

Challenge 2:

Gray Code Sequence

You are given an integer 2 <= $N <= 5.

Write a script to generate $N-bit gray code sequence.

2-bit Gray Code Sequence

[0, 1, 3, 2]

To generate the 3-bit Gray code sequence from the 2-bit Gray code sequence, follow the step below:

2-bit Gray Code sequence
[0, 1, 3, 2]

Binary form of the sequence
a) S1 = [00, 01, 11, 10]

Reverse of S1
b) S2 = [10, 11, 01, 00]

Prefix all entries of S1 with '0'
c) S1 = [000, 001, 011, 010]

Prefix all entries of S2 with '1'
d) S2 = [110, 111, 101, 100]

Concatenate S1 and S2 gives 3-bit Gray Code sequence
e) [000, 001, 011, 010, 110, 111, 101, 100]

3-bit Gray Code sequence
[0, 1, 3, 2, 6, 7, 5, 4]

Example

Input: $N = 4

Output: [0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]

I read the article linked in the spec and it was pretty hard for me to wrap my head around but luckily a step by step algorithm is given in that same spec so implementing it was easy.

The initial values of @code are those for 2-bit gray codes.

 my @code = (0, 1, 3, 2);

If $N = 2 we can skip all calculations and just use the values for @code if we already have. If $N > 2...

 if ($N > 2) {
     for my $i (3 .. $N) {

It's annoying that Perl doesn't have a handy builtin function for converting numbers to binary. Yes it can be done as shown below but it seems like the kind of practical feature an all-purpose hackers toolkit like Perl ought to have.

One problem I ran into with sprintf() was that it doesn't by default output a fixed number of digits. You can get around that with the lesser-known * flag. Specifically we want leading 0's. We can get those with the 0 flag.

         my @s1 = map { sprintf('%0*b', $i - 1, $_); } @code;

Reversing an array is as simple as it should be.

         my @s2 = reverse @s1;

For the next steps we have to concatanate 0 or 1 to our binary values. I took the opportunity at this time to add a leading 0b to each number. This signals to Perl that we are indeed dealing with a binary number and not just a string that happens to be made up of 1's and 0's. This is important for the next step.

         @s1 = map { "0b0$_"; } @s1; 
         @s2 = map { "0b1$_"; } @s2;

To convert a binary number back to a decimal, we use the...oct() function. Huh? Yeah it doesn't make sense to me either. The fact that perl has oct() (and hex()) makes the absence of a bin() or a general base conversion function even more inexplicable.

         @code = map { oct $_; } @s1, @s2;
     }
 }

I made the output a little more complicated than strictly necessary in order to match that in the spec.

 say q{[}, (join q{, }, @code), q{]};

(Full code on Github.)

The Raku version works the same way.

 my @code = (0, 1, 3, 2);

 if $N > 2 {
     for 3 .. $N -> $i {
         my @s1 = @code.map({ sprintf('%0*b', $i - 1, $_); });
         my @s2 = @s1.reverse;
         @s1 = @s1.map({ "0b0$_"; }); 
         @s2 = @s2.map({ "0b1$_"; });

The only gotcha—and this keeps tripping me up—is that Raku unlike Perl doesn't "flatten" arrays when you push them onto another array. If you want the elements of @s2 pushed rather than @s2 itself, you need to remember the |.

One more thing to note here is to convert the binary numbers back to decimal, we use the + operator rather than oct(). It's different but not really much of an improvement IMO.

         @code = @s1.push(| @s2).map({ +$_; });
     }
 }

 say q{[}, @code.join(q{, }), q{]};

(Full code on Github.)