RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate self-descriptive numbers.

Solution

use strict;
use warnings;
use Thread; 
use boolean;
use constant SDN_COUNT => 3;
use constant THREAD_COUNT => 4;
use constant RANGE_SIZE => 10_000;

sub self_describing{
    my($i) = @_;
    my @digits = split(//, $i);
    for my $x (0 .. @digits - 1){
        my $count = 0;
        for my $j (0 .. @digits - 1){
            $count++ if($digits[$j] == $x);
            return false if($count > $digits[$x]);
        }
        return false if($count != $digits[$x]);
    }
    return true;
}

sub self_describing_number{
    my($start, $end) = @_;  
    my @r = (); 
    for(my $i = $start; $i < $end; $i++){
        push @r, [length($i), $i] if(self_describing($i));  
    }   
    return \@r;  
}

MAIN:{
    my @threads; 
    my $count = 0; 
    my $lower = 1; 
    my $upper = RANGE_SIZE; 
    do{
        for(0..(THREAD_COUNT - 1)){  
            my $t = Thread->new(\&self_describing_number, ($lower, $upper));
            push @threads, $t;  
            $lower = $upper + 1;  
            $upper = $lower +  RANGE_SIZE;  
        }  
        foreach my $t (@threads){  
            my $sdns = $t->join();                 
            foreach my $sdn (@{$sdns}){ 
                print "Base " . $sdn->[0] . ":" .  $sdn->[1] . "\n" if $count < SDN_COUNT; 
                $count++;  
            }  
        }   
        @threads = ();   
    } while($count < SDN_COUNT);
}

Sample Run

$ perl perl/ch-1.pl
Base 4:1210
Base 4:2020 
Base 5:21200

Notes

Part 1 this week is repeated from Challenge 043. In order to provide something fresh for the same problem I modified the previous code to be multi-threaded.

Part 2

Write a script to list methods of a package/class.

Solution

use strict;
use warnings;

sub analyze{
    my($file) = @_;
    my @subs;
    my @uses; 
    my @subroutines;
    my $subs = `perlanalyst $file --analysis Sub`;
    $subs =~ s/$file://;
    @subs = split(/\n/, $subs);   
    my $uses = `perlanalyst $file --analysis Use`;
    $uses =~ s/$file://;
    @uses = split(/\n/, $uses);   
    for my $s (@subs){
        $s =~ s/\s+//;
        my @fields = split(/:/, $s); 
        push @subroutines, $fields[1] if(length($s) > 0); 
    }
    push @subroutines, "BEGIN" if(@uses); 
    return @subroutines; 
}

MAIN:{
    my $FILE = $ARGV[0];
    my @subroutines = analyze($FILE);
    print join("\n", sort {$a cmp $b} @subroutines) . "\n"; 
}

Sample Run

$ perl perl/ch-2.pl perl/Calc.pm 
BEGIN
DESTROY
add
div
mul
new

Notes

Getting a list of methods can mostly be done via just some plain analysis of the code. Rather than re-invent the wheel I am using a module, Perl::Analysis::Static, to do that for me. This is a pretty neat tool but has been left in an alpha state. The most stable way to use it is via the command line instead of its incomplete API. In this code I call the perlanalyst command and then parse the output.

If given a BEGIN block or if use-ing a module Perl will execute a BEGIN at compile time. I would argue that this is out of scope for this challenge. However, as given in the problem statement we are expected to catch this it seems. I do this by inspecting the perlanalyst output for use lines. I could have done a few other things as well but decided not to do more with this since it seems like a funny requirement anyway!

References

Challenge 107

Challenge 043

Perl::Analysis::Static