Perl Weekly Challenge: Week 107
Challenge 1:
Self-Descriptive Numbers
Write a script to display the first three self-descriptive numbers. As per wikipedia, the definition of
Self-descriptive NumberisIn mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b−1) counts how many instances of digit n are in m.
Example
1210 is a four-digit self-descriptive number:
position 0 has value 1 i.e. there is only one 0 in the number
position 1 has value 2 i.e. there are two 1 in the number
position 2 has value 1 i.e. there is only one 2 in the number
position 3 has value 0 i.e. there is no 3 in the number
Output
1210, 2020, 21200
Actually Mohammed made a mistake; this problem was already set once before in week 43 of the challenge so I thought I would be able to just reuse the solution I gave then. Unfortunately, it looks like I got it wrong that time so I had to do it again. I'll show you the Raku version first.
The basic idea is to do a search through all the numbers and select the first three which are self-descriptive.
sub MAIN() {
my @sdns;
for 4 .. 5 -> $base {
We can do a more efficient search by restricting it to base 4 and base 5 numbers. We know from the information provided on the wikipedia page mentioned in the spec that the first three self-descriptive numbers will be in either of those bases.
for 10 ** ($base - 2) ..^ 10 ** ($base - 1) -> $i {
Furthermore from the wikipedia page we also know that answers will have a length of $base - 1 base-10 digits so we can optimize yet further by restricting our search to those numbers.
my $n = $i.base($base);
However we want to actually look at base-4 or base-5 numbers not base-10 so we do a conversion here.
if is_sdn($n) {
@sdns.push($n);
}
if (@sdns.elems == 3) {
last;
}
If we have a valid self-descriptive number we add it to the list and once we have three in the list we stop...
}
}
@sdns.join(q{, }).say;
}
...and print the results.
This function determines if a number is self-descriptive.
sub is_sdn(Str $n) {
if !is_harshad($n) {
return False;
}
One more fact about self-descriptive numbers we can use to our advantage is that they are all Harshad numbers. So we can automatically discard any input which is not a Harshad number. The check looks like this:
sub is_harshad(Str $n) {
return $n % $n.comb.sum == 0;
}
Back to is_sdn(). This code counts how many instances of each digit we have and if they are in the right positions,
We return true or false accordingly.
my @digits = $n.comb;
my %count;
for 0 ..^ @digits.elems -> $i {
%count{ @digits[$i] }++;
}
for 0 ..^ @digits.elems -> $i {
if %count{$i}:!exists {
next;
}
if %count{$i} != @digits[$i] {
return False;
}
}
return True;
}
As usual, Perl requires more code to add functionality which is built in to Raku. Here for example, is a function to convert into a particular base.
sub base {
my ($number, $base) = @_;
my @digits = (0 .. 9, 'A' .. 'Z');
my @result;
while ($number > ($base - 1)) {
my $digit = $number % $base;
push @result, $digits[$digit];
$number /= $base;
}
push @result, $digits[$number];
return join '', reverse @result;
}
This is our check for Harshad number status.
sub is_harshad {
my ($n) = @_;
my $total = 0;
my @digits = split //, $n;
for my $digit (@digits) {
$total += $digit;
}
return @digits == $total;
}
Armed with these helper functions, is_sdn() is the same as in Raku.
sub is_sdn {
my ($n) = @_;
if (!is_harshad($n)) {
return undef;
}
my @digits = split //, $n;
my %count;
for my $i (0 .. scalar @digits - 1) {
$count{ $digits[$i] }++;
}
for my $i (0 .. scalar @digits - 1) {
if (!exists $count{$i}) {
next;
}
if ($count{$i} != $digits[$i]) {
return undef;
}
}
return 1;
}
The main algorithm is also the same as in Raku.
my @sdns;
for my $base (4 .. 5) {
for my $i (10 ** ($base - 2) .. 10 ** ($base - 1) - 1) {
my $n = base($i, $base);
if (is_sdn($n)) {
push @sdns, $n;
}
if (scalar @sdns == 3) {
last;
}
}
}
say join q{, }, @sdns;
Challenge 2:
List Methods
Write a script to list methods of a package/class.
Example
package Calc;
use strict;
use warnings;
sub new { bless {}, shift; }
sub add { }
sub mul { }
sub div { }
1;
Output
BEGIN
mul
div
new
add
The subroutines in a Perl5 package (or methods in a class. They are the same thing in Perl.) are listed in a symbol table
which is just a plain old hash. It can be accessed as the package name followed by ::. like this:
for my $key (sort keys %Calc::) {
say $key;
}
In Raku, there is a .^methods() method every object has. It can be accessed like this:
for Calc.^methods -> $method {
say $method;
}