transfixed but not dead!

The Last of the Careless Men blog kindly referred to my Euler blog post from last week.

The blog post brought to my attention the Euler Benchmark Suite. To quote from the Readme:

The Euler Benchmark Suite aims at comparing language speeds for the Euler

So I was curious to see what Euler 4 in Perl5 looked like.

use strict; use warnings;

my $max = 0;
for my $a ( 100..999 ){
    for my $b ( $a..999 ){
        my $product = $a * $b;

        $max = $product if $product > $max
                       and $product eq reverse $product;
    }
}

print "$max\n";

At first glance this doesn’t look as “elegant” as the functional code I posted last week.

However remember this code was optimised for speed! It comes it at 3.5 times faster than even this slightly more optimised version of last weeks functional code (see below, which now comes it at around 0.48s here):

say max
    grep { $_ eq reverse $_ }
    map {
        my $x = $_;
        map { $x * $_ } $x .. 1000;
    } 100..1000;

Another thing of interest from the blog post was the Perl6 example. Like with Ruby example its definitely easier to grok things going in a chain from left to right, ie. just like how we read english text.

autobox to the rescue!

use autobox::Core;

[1..1000]->map( sub{ my $x = $_; map { $x * $_ } $x..1000 } )->grep( sub{ $_ eq reverse $_ } )->max->say;

Not bad. And comes in at respectabe average of 1.25s. However having that extra map within the map method is not too elegant.

Luckily autobox is extensible! So lets add a Cartesian Product method to autobox:

use autobox::Core;

sub autobox::Core::ARRAY::product {
    my $a = shift;
    my @c = map { [ $_ ] } @$a;

    for my $b (@_) {
        @c = map { my $x = $_; map { [ $x, @$_ ] } @c } @$b;
    }

    return \@c;
}

[1..1000]->product( [1..1000] )->map( sub{ $_->[0] * $_->[1] } )->grep( sub{ $_ eq reverse $_ } )->max->say;

Now thats really nice. Now if future versions of Perl can provide a mechanism to allow for blocks (ie. anonymous subs) to passed more seamlessly, say like

[1..1000]->product( [1..1000] )->map(){ $_->[0] * $_->[1] }->grep(){ $_ eq reverse $_ }->max->say;

# or even

[1..1000]->product( [1..1000] )->map{ $_->[0] * $_->[1] }->grep{ $_ eq reverse $_ }->max->say;

Then we’re really cooking!

/I3az/

This post is in memory of Colin. My Father-in-law and a fellow blogger who suddenly and unexpectedly passed away yesterday. RIP

Well if you hadn’t heard of Stackoverflow when i mentioned about it last month then chances are you’ve definitely not heard of RefactorMyCode either.

Its yet another interesting and engrossing site which I stumbled across in the past year, funnily enough after hearing about it from an answer to a Stackoverflow question.

The premise of the site is if you have some working code that you’re not totally happy with then offer it up for code review with the hope someone can help refactor it.

The Perl section could do with some more input and engagement. But don’t just stop there because seeing how snippets of code in other languages are refactored is also a good learning experience.

/I3az/

On use Perl; the other day revdiablo asked whether there were Anonymous objects as easily as hashrefs? any where within Moose or sitting (hiding!) on CPAN.

Well the answers posted gave a yes for both Moose & CPAN.

Here is my twist on things using something already on CPAN which uses Moose and its Class::MOP foundations: MooseX::SingletonMethod.

With this we can easily create anonymous singleton objects like so:

{
    package Anonyject;
    use MooseX::SingletonMethod;
}

my @dingfirsts;
for my $line ( 1..10 ) {
    push @dingfirsts, Anonyject->new->add_singleton_methods(
        ding => sub { 'ding' x $line },
        dong => sub { 'dong' x $line },
        line => sub { $line },
    )
}

for (@dingfirsts) {
    say "First ", $_->ding, " on line ", $_->line;
}

We can show that each of these objects created have unique anonymous classes using Moose introspection:

for (@dingfirsts) {
    say $_->line, ': ', ( $_->meta->class_precedence_list )[0];
}

# outputs
# => 1: Class::MOP::Class::__ANON__::SERIAL::2
# => 2: Class::MOP::Class::__ANON__::SERIAL::3
# => 3: Class::MOP::Class::__ANON__::SERIAL::4
# => 4: Class::MOP::Class::__ANON__::SERIAL::5
# => 5: Class::MOP::Class::__ANON__::SERIAL::6
# => 6: Class::MOP::Class::__ANON__::SERIAL::7
# => 7: Class::MOP::Class::__ANON__::SERIAL::8
# => 8: Class::MOP::Class::__ANON__::SERIAL::9
# => 9: Class::MOP::Class::__ANON__::SERIAL::10
# => 10: Class::MOP::Class::__ANON__::SERIAL::11

The rest of the class chain upwards for each of these objects is:
Anonyject >> Class::MOP::Class::__ANON__::SERIAL::1 >> Moose::Object

So you can add methods or attributes to Anonyject class and they will be available to all the anonymous objects created.

NB. Class::MOP::Class::__ANON__::SERIAL::1 is where the MooseX::Singleton methods live.

So for more proof in the singleton pudding:

my $obj1 = Anonyject->new->add_singleton_methods(
    ding => sub { "wing" },
    dong => sub { "wong" },
    line => sub { 23_939 },
);

my $obj2 = Anonyject->new->add_singleton_methods(
    something => sub { "else" },
);

say $obj1->ding;      # Says "wing"
say $obj2->something; # Says "else"

say $obj1->something; # Should break and now does
say $obj1->broken;    # Breaks properly
say $obj2->dong;      # And also breaks properly

And all these objects are easily extensible:

# add dingdong just to $obj2
$obj2->meta->add_method( dingdong => sub { 'dingdong!' } );
say $obj2->dingdong;   # "dingdong!"

# add bang to all anonymous Anonyject objects
Anonyject->meta->add_method(
    bang => sub { 'bang ' . ( $_[0]->meta->class_precedence_list )[0] }
);
say $obj1->bang;       # "bang Class::MOP::Class::__ANON__::SERIAL::12"
say $obj2->bang;       # "bang Class::MOP::Class::__ANON__::SERIAL::13"

/I3az/