laurent_r

These are some answers to the Week 107 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (April 11, 2021). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Self-Descriptive Numbers

Write a script to display the first three self-descriptive numbers. As per Wikipedia, the definition of Self-descriptive Number is:

In 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.

For 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

The process of computing self-descriptive numbers can become very slow as the base becomes large. Although this is not really necessary for computing only the first 3 self-descriptive numbers, we can include some simple performance optimization. The Wikipedia article states that a self-descriptive number in base b must be a multiple of that base (or equivalently, that the last digit of the self-descriptive number must be 0). So we can skip the check for any integer whose representation in a given base doesn’t end with 0. Also, all self-descriptive numbers have digit sums equal to their base. We can filter out those that don’t match these two conditions.

Some further optimizations (when the base is larger than or equal to 7) are possible as described in my blog post of Jan. 19, 2020 on the same subject. They are not needed here.

Self-Descriptive Numbers in Raku

We iterate on bases from 2 to infinity (and exit the loop when we reach the target number of self-descriptive numbers). Then, for a given base, we loop over all integers having a number of digits equal to the base. For each such integer, we filter out those not ending with 0 or whose digit sum is not equal to the base. For the integers not filtered out, we check that each digit d at position n counts how many instances of digit n are in such integer.

use v6;
constant MAX = 4;

my $*count = 0;
for 2..Inf -> $base {
    check-self-desc($base);
    last if $*count >= MAX;
}   

sub check-self-desc (Int $base) {
    my $found = False;
    for $base ** ($base -1) .. $base ** $base -1 -> $num {
        my $num-in-b = $num.base($base);
        next unless $num-in-b ~~ /0$/;
        my @digits = $num-in-b.comb;
        next if $base != [+] @digits;
        my $success = True;
        for 0..$base - 1 -> $rank {
            if (+ $num-in-b.indices($rank) != @digits[$rank]) {
                $success = False;
                last;
            }
        }
        if $success {
            say "Number in base $base: $num-in-b; decimal: $num";
            $*count++;
            $found = True;
            return if $*count >= MAX;
        }   
    }
    say "No self-descriptive number for base $base" unless $found;
}

This program displays the following output:

$ raku self-descr.raku
No self-descriptive number for base 2
No self-descriptive number for base 3
Number in base 4: 1210; decimal: 100
Number in base 4: 2020; decimal: 136
Number in base 5: 21200; decimal: 1425

I wanted to investigate a bit more and decided to change MAX to 4 and to measure the process duration:

$ time raku self-descr.raku
No self-descriptive number for base 2
No self-descriptive number for base 3
Number in base 4: 1210; decimal: 100
Number in base 4: 2020; decimal: 136
Number in base 5: 21200; decimal: 1425
No self-descriptive number for base 6
Number in base 7: 3211000; decimal: 389305

real    0m5,684s
user    0m0,031s
sys     0m0,030s

So it takes about 5.7 seconds. If we comment out the two performance optimizations described above, we get the following result:

$ time raku self-descr.raku
No self-descriptive number for base 2
No self-descriptive number for base 3
Number in base 4: 1210; decimal: 100
Number in base 4: 2020; decimal: 136
Number in base 5: 21200; decimal: 1425
No self-descriptive number for base 6
Number in base 7: 3211000; decimal: 389305

real    0m17,857s
user    0m0,015s
sys     0m0,031s

So, about 17.9 seconds without the performance enhancement, the optimizations are worth the effort.

Self-Descriptive Numbers in Perl

This is a port of the above Raku program to Perl. Since Perl doesn’t have any built-in function to convert numbers to a given base, we have to implement our own to_base_b subroutine.

use strict;
use warnings;
use feature qw /say/;
use constant DIGITS => ('0'..'9', 'A'..'Z');
use constant MAX => 3;
my $count = 0;

sub to_base_b { # Converts decimal number to base b string
    my($dec, $base) = @_;
    my @digits;
    while ($dec) {
        unshift @digits, (DIGITS)[$dec % $base];
        $dec = int($dec/$base);
    }
    return join "", @digits;
}

sub check_self_desc {
    my $base = shift;
    for my $num ($base ** ($base -1) .. $base ** $base -1) {
        my $num_in_b = to_base_b ($num, $base);
        next unless $num_in_b =~ /0$/;
        my @digits = split //, $num_in_b;
        my $sum = 0;
        $sum += $_ for split //, $num_in_b;
        next if $sum != $base;
        my $success = 1;
        for my $rank (0..$base - 1) {
            my $nb_digits = $digits[$rank];
            my $num_occ = $num_in_b =~ s/$rank/$rank/g;
            if ($num_occ != $nb_digits) {
                $success = 0;
                last;
            }
        }
        if ($success) {
            say "Number in base $base: $num_in_b; decimal: $num" ;
            $count++;
            return if $count >= MAX;
        }
    }
}

for my $base (2..10) {
    check_self_desc($base);
    last if $count >= MAX;
}

Output:

$ perl self-descr.pl
Number in base 4: 1210; decimal: 100
Number in base 4: 2020; decimal: 136
Number in base 5: 21200; decimal: 1425

Task 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 task is not entirely clear. Maybe we are asked to load a class and introspect the available methods, but I’ll consider it is more probable that we’re supposed to parse the file and list the methods defined in it. I’ll also suppose that we should look for methods in the programming language in which they are defined; in other words, we’ll be looking for Raku methods in Raku and Perl methods in Perl, although we could obviously perform cross-language searches (for example, use Raku to look for methods in a Perl module, or vice-versa).

List Methods in Raku

Raku methods are defined with the method keyword. Raku identifiers can contain alphanumeric characters, plus - dashes and ' single quotes. In addition we should avoid finding the method keyword somewhere in a comment. We’ll be looking for the method keyword as the first thing in a code line (except for possible space characters) and capture the identifier coming immediately after.

use v6;

sub MAIN (Str $file-name) {
     for $file-name.IO.lines -> $line {
        say ~$0 if $line ~~ /^\s* method \s+ (<[-'\w]>+)/;
    }
}

Example output:

$ ./raku find-methods.raku linked_list.raku
make-array
gist

List Methods in Perl

In Perl, methods use the sub keyword.

use strict;
use warnings;
use feature qw /say/;

while (<>) {
    say $1 if /^\s*sub\s+(\w+)/;
}

Output:

$ echo 'package Calc;
>
> use strict;
> use warnings;
>
> sub new { bless {}, shift; }
> sub add { }
> sub mul { }
>
sub div { }
>
> 1; '  |  perl  find-methods.pl
new
add
mul
div

Of course, this is so simple that a Perl one-liner would make sense:

$ echo 'package Calc;
>
> use strict;
> use warnings;
>
> sub new { bless {}, shift; }
> sub add { }
> sub mul { }
> sub div { }
>
> 1;'  |  perl -nE 'say $1 if /^\s*sub\s+(\w+)/;'
new
add
mul
div

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, April 18, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.