This is my response to the Perl Weekly Challenge #114.
$N.
Palindrome Number higher
than the given integer $N.
Input: $N = 1234
Output: 1331
Input: $N = 999
Output: 1001
We have handled palindromic numbers before in the weekly challenges. See Palindromic Stack with Raku and Perl (Challenge 095.1: Palindrome Number) for the last one.
File: next-palindrome-number
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v($verbose)); # [1]
for $N + 1 .. Inf -> $candidate # [2]
{
say ": Candidate $candidate" if $verbose;
if $candidate eq $candidate.flip # [3]
{
say $candidate; # [4]
exit; # [4a]
}
}
[1] Ensure a positive integer.
[2] Start with the very next number ($N + 1), and go on indefinitely.
[3]
TIs the number palindromic?. We use flip to reverse
a string. (Note that reverse will reverse the order of items in
an array, list etc.) Note the use of string comparison eq to ensure that
leading zeroes (after the flip) are retained. Also note that this does not really matter
here, as stripping them away will give a shorter string - which cannot be
palindromic.
[4] print the number, and exit [4a].
See
docs.raku.org/routine/flip for more information about flip.
See
docs.raku.org/routine/reverse for more information about reverse.
Running it:
$ ./next-palindrome-number 1234
1331
$ ./next-palindrome-number 999
1001
With verbose mode:
$ ./next-palindrome-number -v 1234
: Candidate 1235
: Candidate 1236
…
: Candidate 1330
: Candidate 1331
1331
$ ./next-palindrome-number -v 999
: Candidate 1000
: Candidate 1001
1001
#! /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 "Specify a positive integer";
die "Not a positive integer" unless $N =~ /^[1-9]\d*$/;
while ($N++) # [1]
{
say ": Candidate $N" if $verbose;
if ($N eq reverse($N)) # [2]
{
say $N;
exit;
}
}
[1] Perl does not have an infinity value, but we can count up like this.
[2] Note that reverse works on strings as well as lists (as opposed
to in Raku).
Running it gives the same result as the Raku version:
$ ./next-palindrome-number-perl 1234
1331
$ ./next-palindrome-number-perl 999
1001
$ ./next-palindrome-number-perl -v 999
: Candidate 1000
: Candidate 1001
1001
$N.
$N.
Input: $N = 3
Output: 5
Binary representation of $N is 011. There are two 1 bits. So the next
higher integer is 5 having the same the number of 1 bits i.e. 101.
Input: $N = 12
Output: 17
Binary representation of $N is 1100. There are two 1 bits. So the next
higher integer is 17 having the same number of 1 bits i.e. 10001.
We have handled binary numbers before as well. See Counting Water with Raku and Perl (Challenge 079.1: Count Bit Set) for the last one.
File: higher-integer-set-bits
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v($verbose)); # [1]
my $ones = $N.fmt('%b').comb.sum; # [2]
if $verbose
{
say ": Initial value: $N (binary: { $N.fmt('%b') })";
say ": - Number of one bits: $ones";
}
for $N + 1 .. Inf -> $candidate # [3]
{
say ": Candidate $candidate (binary: { $candidate.fmt('%b') })" if $verbose;
if $candidate.fmt('%b').comb.sum == $ones # [4]
{
say $candidate; # [4a]
exit; # [4b]
}
}
[1] Ensure a positive integer (again).
[2] Convert the (decimal) number to binary (fmt('%b')), split
it into indididual digits (comb) and count the number of ones (with
sum - as zeroes does not add up to anything).
[3] Start with the very next number, and go on to infinity.
[4] Does the current candidate have the same number of ones? If so print it [4a] and exit [4b].
See
docs.raku.org/routine/fmt
more information about fmt.
Running it:
$ ./higher-integer-set-bits 3
5
$ ./higher-integer-set-bits 12
17
With verbose mode:
$ ./higher-integer-set-bits -v 3
: Initial value: 3 (binary: 11)
: - Number of one bits: 2
: Candidate 4 (binary: 100)
: Candidate 5 (binary: 101)
5
$ ./higher-integer-set-bits -v 12
: Initial value: 12 (binary: 1100)
: - Number of one bits: 2
: Candidate 13 (binary: 1101)
: Candidate 14 (binary: 1110)
: Candidate 15 (binary: 1111)
: Candidate 16 (binary: 10000)
: Candidate 17 (binary: 10001)
17
Looking good.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use List::Util qw/sum/;
use Getopt::Long;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = $ARGV[0] // die "Specify a positive integer";
die "Not a positive integer" unless $N =~ /^[1-9]\d*$/;
my $ones = sum(split(//, sprintf('%b', $N)));
if ($verbose)
{
say ": Initial value: $N (binary: ", sprintf('%b', $N) , ")";
say ": - Number of one bits: $ones";
}
while ($N += 1)
{
say ": Candidate $N (binary: ", sprintf('%b', $N), ")" if $verbose;
if (sum(split(//, sprintf('%b', $N))) == $ones)
{
say $N;
exit;
}
}
Running it gives the same result as the Raku version:
$ ./higher-integer-set-bits-perl 3
5
$ ./higher-integer-set-bits-perl 12
17
$ ./higher-integer-set-bits-perl -v 3
: Initial value: 3 (binary: 11)
: - Number of one bits: 2
: Candidate 4 (binary: 100)
: Candidate 5 (binary: 101)
5
$ ./higher-integer-set-bits-perl -v 12
: Initial value: 12 (binary: 1100)
: - Number of one bits: 2
: Candidate 13 (binary: 1101)
: Candidate 14 (binary: 1110)
: Candidate 15 (binary: 1111)
: Candidate 16 (binary: 10000)
: Candidate 17 (binary: 10001)
17
And that's it.