I’ve been doing the Perl Weekly
Challenges. The
latest
involved an obscure class of number and a self-consistent string
format. (Note that this is open until 7 March 2021.)
TASK #1 › Rare Numbers
You are given a positive integer $N.
Write a script to generate all Rare numbers of size $N if exists. Please checkout the page for more information about it.
I don't really recommend that you look at that page; the guy may be
mathematically competent, but nobody should ever have told him how to
change text colour or increase font size.
But anyway, this is clearly a large search space, so I'll take him at
his word and use the optimisations he gives.
sub rn {
my $d=shift;
my @out;
my $mxm=10**($d-2)-1;
The first digit has to have one of these values.
foreach my $a (2,4,6,8) {
And the final digit, one of these.
foreach my $q (0,2,3,5,7,8) {
Then we can constrain on possible combinations.
if ($a==2 && $q!=2) {
next;
}
if ($a==4 && $q!=0) {
next;
}
if ($a==6 && $q!=0 && $q!=5) {
next;
}
if ($a==8 && $q!=2 && $q!=3 && $q!=7 && $q!=8) {
next;
}
If we're dealing with just two digits, that's it for eliminating
candidates, so on to the final check.
if ($d==2) {
my $t="$a$q";
if (is_rare($t)) {
push @out,$t;
}
I couldn't be bothered to do the three-digit case, and there aren't
any valid answers of three digits anyway (by inspection at
OEIS). So we move straight on to longer examples.
} else {
Iterate over all middle values. (I could have made this faster by
taking only valid second and penultimate digits, then filling in any
remaining middle digits for the 5+-digit case, but I was getting very
bored by this point. So if you actually have a use for this code,
there's an optimisation for you.)
foreach my $middledigits (map {sprintf('%0'.($d-2).'d',$_)} 0..$mxm) {
my $b=substr($middledigits,0,1);
my $p=substr($middledigits,-1,1);
More constraints on these digit combinations.
if ($a==2 && $b!=$p) {
next;
}
if ($a==4 && abs($b-$p)%2 != 0) {
next;
}
if ($a==6 && abs($b-$p)%2 != 1) {
next;
}
if ($a==8) {
if ($q==2 && $b+$p != 9) {
next;
} elsif ($q==3 && $b-$p != 7 && $p-$b != 3) {
next;
} elsif ($q==7 && $b+$p != 1 && $b+$p != 11) {
next;
} elsif ($q==8 && $b!=$p) {
next;
}
}
Finally, test for rare-ness.
my $t="$a$middledigits$q";
if (is_rare($t)) {
push @out,$t;
}
}
}
}
}
return \@out;
}
And that rarity test is to reverse, check that the number is larger
than its reverse, then check that the difference and the sum are both
perfect squares.
sub is_rare {
my $t=shift;
my $d=join('',reverse(split '',$t));
if ($d >= $t) {
return 0;
}
foreach my $c ($t+$d,$t-$d) {
No perfect square ends with these digits, and checking that is faster
than actually taking the square root if we don't have to.
if ($c =~ /[2378]$/) {
return 0;
}
my $s=int(sqrt($c));
unless ($s*$s==$c) {
return 0;
}
}
return 1;
}
So that's that. It's basically the same in other languages, though
Rust makes the transitions between string and integer relatively hard
work and Ruby makes it very easy.
This seemed like a long enough task to be worth a timing test, so I
did. In each case, the test was run on the same unloaded system,
running the program twice and timing the second run. Perl took 132
seconds; Python 151; Ruby 211; and naïve Rust (compiling at the start
of the run and leaving all debug info in place) 177. When I set the
Rust code to optimise for release, it still compiled in less than a
second, and the execution time dropped to 17 seconds flat.
I don't know how long Raku would have taken; I gave up after half an
hour (1800 seconds). Even with all the optimisations turned on. Maybe
modern Raku is faster than the version in Debian/stable (Rakudo
2018.12, compiled 9 January 2019).
TASK #2 › Hash-counting String
You are given a positive integer $N.
Write a script to produce Hash-counting string of that length.
The definition of a hash-counting string is as follows:
- the string consists only of digits 0-9 and hashes, ‘#’
- there are no two consecutive hashes: ‘##’ does not appear in your string
- the last character is a hash
- the number immediately preceding each hash (if it exists) is the position of that hash in the string, with the position being counted up from 1
It can be shown that for every positive integer N there is exactly one such length-N string.
I'll take your word for it, but this does mean that a depth-first
search is an obvious solution. I represent the string as the series of
integers that will lie in it, with an initial "#" shown as a value
of 1. In Raku:
sub hcs($n) {
my @s;
my @t;
while (1) {
@s=();
my $l=0;
If we have a candidate stub, load it into @s
and calculate its
current length.
if (@t.elems) {
@s=(pop @t).flat;
$l=sum(map {($_==1 ?? 0 !! chars($_))+1}, @s);
}
If that's the target length, that valid answer must be the only one,
so drop out with it. If it's longer than the target, no point in
extending it further.
if ($l==$n) {
last;
}
if ($l > $n) {
next;
}
If we're still here, it's shorter than the target, so work out
possible extensions. Most of the time there will only be one, which
keeps the search space conveniently small: if you have "#3#" then the
only possible extension is "5#". But an empty string can be extended
to make "#" or "2#"; a 7-character string can be extended by "9#" or
"10#"; and so on at ~100 characters, ~1000, etc.
my $c=$l;
while (1) {
my $tt=($c==1 ?? 0 !! chars($c))+$l+1;
if ($c==$tt) {
my @k=(@s».List.flat);
push @k,$c;
push @t,@k;
}
if ($c > $tt) {
last;
}
$c++;
}
}
return join('',map {($_==1 ?? '' !! $_) ~ '#'}, @s);
}
and the other languages look basically similar.
Full code on
github.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.