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

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;
}

(Full code on Github.)

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;

(Full code on Github.)

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;
}

(Full code on Github.)

In Raku, there is a .^methods() method every object has. It can be accessed like this:

for Calc.^methods -> $method {
    say $method;
}

(Full code on Github.)