Perl Weekly Challenge 107.

My solutions (task 1a, task 1 and task 2) to the The Weekly Challenge - 107.

Task 1: Self-descriptive Numbers

Submitted by: Mohammad S Anwar

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

Output:

1210, 2020, 21200

My first attempt is just brute force. Try all numbers in sequence and test for self-describing.

# Perl weekly challenge 107
# Task 1: Self-descriptive Numbers
# Brute force solution.
#
# See https://wlmb.github.io/2021/04/05/PWC107/#task-1-self-descriptive-numbers
use strict;
use warnings;
use v5.12;
use List::Util qw(all);
die 'Use: ./ch1a.pl howmany' unless @ARGV;
my $howmany=shift @ARGV;
for my $n(0..10**10-1){ # number of digits <=10
    if(check($n)){
	say $n;
	--$howmany;
	last if $howmany<=0;
    }
}

sub check {
    my $number=shift;
    my @digits=split '',$number;
    my @need=(0)x@digits;
    my @have=(0)x@digits;
    map {$need[$_]=$digits[$_]; $have[$digits[$_]]++} 0..@digits-1;
    return all {$need[$_]==$have[$_]} 0..@digits-1;
}

Examples:

./ch-1a.pl 4

Results:

1210
2020
21200
3211000

This becomes very slow after the first few results.

In my second attempt I construct the numbers a digit at a time and use a simple property of self descriptive numbers: the sum of its digits is its base. I use letters to allow bases up to 26. To allow very large numbers, I represent them as an array of its digits. For each position the lowest bound is the number of previous apparitions of the corresponding digit. The upper bound is determined by the base and the current sum of digits.

# Perl weekly challenge 107
# Task 1: Self-descriptive Numbers
# Use some properties to accelerate their generation
# Use letter to go beyond base 10
#
# See https://wlmb.github.io/2021/04/05/PWC107/#task-1-self-descriptive-numbers
use strict;
use warnings;
use v5.12;
use List::Util qw(all);

die 'Use: ./ch1.pl howmany' unless @ARGV;
my $howmany=shift @ARGV;
exit unless $howmany > 0;
my @results;
my $largest_base=36; #allows ten decimal digits and 26 letters
my @letter_from_digit=(0..9,'a'..'z');
my $base=1;
 RESULT:
    while($howmany>@results){
	++$base;
	last RESULT if $base>$largest_base;
	for my $firstdigit(1..$base-1){
	    my $have=[(0)x$base]; # initialize count of digits in number
	    $have->[$firstdigit]++;
	    try([$firstdigit],0,$base, $firstdigit, $have);
	    last RESULT if @results==$howmany;
	}
}
my $n=1;
foreach(@results){
    say sprintf("%2d- Base %2d:  %s", $n++, scalar @$_,
		join('', map {$letter_from_digit[$_]} @$_));
}
sub try {
    my ($current,$position,$base, $sum, $had)=@_;
    if($position==$base-1){
	push @results, $current if check($current);
	return;
    }
    ++$position; # new position
    for my $digit($had->[$position]..$base-$sum){
	my $have=[@$had]; # copy
	$have->[$digit]++;
	try([(@$current,$digit)], $position, $base, $sum+$digit, $have);
    }
}

sub check {
    my $number=shift;
    my @digits=@$number;
    my @need=(0)x@digits;
    my @have=(0)x@digits;
    map {$need[$_]=$digits[$_]; $have[$digits[$_]]++} 0..@digits-1;
    return all {$need[$_]==$have[$_]} 0..@digits-1;
}

./ch-1.pl 12

Results:

 1- Base  4:  1210
 2- Base  4:  2020
 3- Base  5:  21200
 4- Base  7:  3211000
 5- Base  8:  42101000
 6- Base  9:  521001000
 7- Base 10:  6210001000
 8- Base 11:  72100001000
 9- Base 12:  821000001000
10- Base 13:  9210000001000
11- Base 14:  a2100000001000
12- Base 15:  b21000000001000

This version is much faster than the previous one, but the time explodes for large bases. Though, it took my laptop less than a minute doing base 14 and a few minutes for base 15. I wanted to reach these cases, as they are the first with digits larger than 9.

Task 2: List Methods

Submitted by: Mohammad S Anwar

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

First I make me a package.

package Calc;

use strict;
use warnings;

sub new { bless {}, shift; }
sub add { }
sub mul { }
sub div { }
our $scalar;
our @array;
our %hash;

1;

This is similar to the example, but with some class data besides the methods.

Then I feed the package to the following program, which loads it and examines its symbol table, printing anything that seems like a subroutine. I’m not too confident in my knowledge of symbol tables, so this is an opportunity for learning.

# Perl weekly challenge 107
# Task 2: List Methods
#
# See https://wlmb.github.io/2021/04/05/PWC107/#task-2-list-methods
use strict;
use warnings;
use v5.12;

no strict "refs"; # don't be that strict
die 'Use: ./ch-2.pl package [other package] [...]' unless @ARGV;
foreach my $package(@ARGV){
    eval "require $package";
    die $@ if $@;
    say "Methods of $package";
    foreach my $key(sort keys %{"${package}::"}){
	say "\t$key" if defined &{"${package}::$key"};
    }
}

Examples:

perl -Mlib=. ./ch-2.pl Calc

Results:

Methods of Calc
	add
	div
	mul
	new

Notice that the BEGIN results from the example in the task description is not printed, as I guess it is not methods (it seems not to be recognized as code). I added a few package variables to the example. They are not listed in the results either. I had to run this example with the -Mlib switch so the Calc package could be found.

Now I test the program on one of my real installed packages:

./ch-2.pl Photonic::LE::NR2::EpsL

Results:

Methods of Photonic::LE::NR2::EpsL
	BUILD
	DESTROY
	_converged
	_epsA
	_epsB
	_epsL
	_nh
	_nhActual
	_u
	converged
	epsA
	epsB
	epsL
	evaluate
	meta
	new
	nh
	nhActual
	nr
	smallE
	u

It did find the package and found its public and private methods. I was not sure what to expect, as that package is based in Moose, but the results seem reasonable.

Written on April 5, 2021