This is my response to the Perl Weekly Challenge #119.
$N.
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.
$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, …
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).
File: seq-without-single
#! /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.