with Raku and Perl

This is my response to the Perl Weekly Challenge #119.

You are given a positive integer

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 1:

`$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 1:

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.

treating the values as strings, and applying substring selection is the most efficient way of doing this (from a programmer point of view).

File: swap-nibbles#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0 && $N <= 255, :v(:$verbose)); # [1]
my $binary = $N.fmt('%08b'); # [2]
my $swapped = $binary.substr(4) ~ $binary.substr(0,4); # [3]
if $verbose
{
say ": Binary: $binary";
say ": Swapped: $swapped (binary)";
}
say $swapped.parse-base(2); # [4]

[1] Ensure a positive integer in the range 1 .. 255.

[2] Get the binary representation (with `fmt`

) as an
8-bit number. Note the leading zero, which gives us a zero padded value of length 8;
e.g. `00010010`

for 18.

[3] Get the second half and the first half (both with
`substr`

), and glue them together (with the string concatenation operator
`~`

).

[4] Convert the number from binary (the «2» part) to decimal (or rather, whatever Raku uses internally).

See
docs.raku.org/routine/fmt
more information about `fmt`

.

See
docs.raku.org/routine/substr
for more information about `substr`

.

See
docs.raku.org/routine/~ for more
information about the string concatenation operator `substr`

.

See
docs.raku.org/routine/parse-base
for more information about `parse-base`

.

Running it:

$ ./swap-nibbles 101
86
$ ./swap-nibbles 18
33

Looking good.

With verbose mode:

$ ./swap-nibbles -v 101
: Binary: 01100101
: Swapped: 01010110 (binary)
86
$ ./swap-nibbles -v 18
: Binary: 00010010
: Swapped: 00100001 (binary)
33

We can make it shorter (practically a one liner), with `with`

:

#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0 && $N <= 255);
say ($_.substr(4) ~ $_.substr(0,4)).parse-base(2) with $N.fmt('%08b'); # [1]

[1] The trick with `with`

is that it sets the topic variable
(i.e. `$_`

) to the given expression for the affixed block.

See
docs.raku.org/language/control#index-entry-control_flow_with
for more information about `with`

.

Running it gives the same result as for the previous version (except that verbose mode has gone, as there are no intermediary variables to be verbose about):

$ ./swap-nibbles-with 101
86
$ ./swap-nibbles-with 18
33

#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = $ARGV[0] // "";
die "Please specify an integer in the range 1..255"
if $N !~ /^[1-9]\d*$/ || $N > 255;
my $binary = sprintf('%08b', $N);
my $swapped = substr($binary, 4) . substr($binary, 0, 4);
if ($verbose)
{
say ": Binary: $binary";
say ": Swapped: $swapped (binary)";
}
say oct("0b" . $swapped); # [1]

[1] The «oct» call does support octal numbers, but can be used on binary values as well if prefixed with «0b».

Running it gives the same result as the Raku version:

$ ./swap-nibbles-perl 18
33
$ ./swap-nibbles-perl 101
86
$ ./swap-nibbles-perl -v 18
: Binary: 00010010
: Swapped: 00100001 (binary)
33
$ ./swap-nibbles-perl -v 101
: Binary: 01100101
: Swapped: 01010110 (binary)
86

We could have used bitwise operations here; something like this (in quasi code):

(($N bitwise-and 11110000) right-shift-4)
bitwise-or
(($N bitwise-and 00001111) left-shift-4)

The right and left shift operators have not been implemented yet in Raku.

But we can do this bit (pun intended) in Perl:

File: swap-nibbles-bitwise-perl#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = $ARGV[0] // "";
die "Please specify an integer in the range 1..255"
if $N !~ /^[1-9]\d*$/ || $N > 255;
my $swapped = (($N & 15) << 4) | (($N & 241) >> 4);
if ($verbose)
{
say ": Binary: ", sprintf('%08b', $N);
say ": Swapped: ", sprintf('%08b', $swapped), " (binary)";
}
say $swapped;

Note that the bitwise operations operate on integers (or rather, whatever Perl uses internally), so that we do not have to mess about with numeric conversion. Except for the verbose output, as a nicety.

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

`$N`

and print the `$Nth`

term 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

The number system is unlike anything seen in nature (so to speak), so manual addition (with carrying) is the thing. If the digit is «1» or «2», we add one. Else (it is «3»), we set the carrying flag (called «$add») and the current digit to «1». The final rule about double 1s is handled separately, at the end.

File: seq-without-seq#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my $seq := gather # [1]
{
my $current = 1; # [2]
take 1; # [2a]
loop # [3]
{
my $new = "";
my $add = True;
for $current.comb.reverse -> $digit is copy
{
if $add
{
if $digit <= 2
{
$digit++;
$add = False;
}
else { $digit = 1; }
}
$new = $digit ~ $new;
}
$new = "1$new" if $add;
$current = $new;
take $current unless $current ~~ /11/; # [4]
}
}
say ": Sequence: ", $seq[^$N].join(', ') if $verbose;
say $seq[$N-1];

[1] Using `gather`

/`take`

to collect
the values (a sequence) looks like a good idea.

[2] The first value is «1». Return it (with `take`

).

[3] For every value after the first one, start with the previous one (in «$current») and
add 1 to the rightmost digit (`$current.comb.reverse`

) and work to the left with
carrying.

[4] Skip values with double 1s. (As in, do not return them.)

See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
`gather`

/`take`

.

Running it:

$ ./seq-without-seq 5
13
$ ./seq-without-seq 10
32
$ ./seq-without-seq 60
2223

We got the same result as the page linked to in the challenge.

With verbose mode:

$ ./seq-without-seq -v 5
: Sequence: 1, 2, 3, 12, 13
13
$ ./seq-without-seq -v 10
: Sequence: 1, 2, 3, 12, 13, 21, 22, 23, 31, 32
32
$ ./seq-without-seq -v 60
: Sequence: 1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, 132,
133, 212, 213, 221, 222, 223, 231, 232, 233, 312, 313, 321, 322, 323, 331,
332, 333, 1212, 1213, 1221, 1222, 1223, 1231, 1232, 1233, 1312, 1313, 1321,
1322, 1323, 1331, 1332, 1333, 2121, 2122, 2123, 2131, 2132, 2133, 2212,
2213, 2221, 2222, 2223
2223

Here is a version with a conventional array instead of the
`gather`

/`take`

Sequence. Also note
the

#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my @seq = 1;
my $current = 1;
while @seq.elems < $N
{
my $new = "";
my $add = True;
for $current.comb.reverse -> $digit is copy
{
if $add
{
if $digit <= 2
{
$digit++;
$add = False;
}
else
{
$digit = 1;
}
}
$new = $digit ~ $new;
}
$new = "1$new" if $add;
$current = $new;
@seq.push: $current unless $current.contains('11');
## -> https://docs.raku.org/routine/contains
}
say ": Sequence: ", @seq[^$N].join(', ') if $verbose;
say @seq[$N-1];

[1] Note the use of `contains`

instead of the original
Regex.

See
docs.raku.org/routine/contains
for more information about `contains`

.

Running it gives the same result as above.

The challenge asked for a sequence, and we did provide that - as shown with verbose mode in
the two programs above. But we do not *actually* need it. Here is a version that does
not generate a sequence at all, just the current value (and an index counter).

#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
my $count = 1;
my $current = 1;
while $count < $N
{
my @digits = $current.comb.reverse;
my $new = "";
my $add = True;
for $current.comb.reverse -> $digit is copy
{
if $add
{
if $digit <= 2
{
$digit++;
$add = False;
}
else
{
$digit = 1;
}
}
$new = $digit ~ $new;
}
$new = "1$new" if $add;
$current = $new;
$count++ unless $current.contains('11');
}
say $current;

Note that verbose mode has gone, as we do not have a sequence laying about to be verbose about. (We could have printed the index and current value inside the loop, and feel free to do that.)

#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my $N = $ARGV[0] // "";
die "Please specify a positive integer" if $N !~ /^[1-9]\d*$/;
my $count = 1;
my $current = 1;
while ($count < $N)
{
my @digits = split(//, reverse($current));
my $new = "";
my $add = 1;
for my $digit (split(//, reverse($current)))
{
if ($add)
{
if ($digit <= 2)
{
$digit++;
$add = 0;
}
else
{
$digit = 1;
}
}
$new = $digit . $new;
}
$new = "1$new" if $add;
$current = $new;
$count++ unless $current =~ /11/;
}
say $current;

Running it gives the same result as the Raku versions:

$ ./seq-without-single-perl 5
13
$ ./seq-without-single-perl 10
32
$ ./seq-without-single-perl 60
2223

And that's it.