Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re: May Thy Closures Be Blessed

by Abigail-II (Bishop)
on Apr 26, 2004 at 16:35 UTC ( #348237=note: print w/ replies, xml ) Need Help??


in reply to Re^2: May Thy Closures Be Blessed
in thread May Thy Closures Be Blessed

Inside Out objects are faster than the closure based - but compared to "traditional" objects, the difference is small:

#!/usr/bin/perl use strict; use warnings; use Benchmark qw /cmpthese/; use Carp; package Class_Closure; sub new { my $class = shift; my %args = @_; my %field = ( name => $args {name} || "abigail", colour => $args {colour} || "pink", age => $args {age} || 100, class => $class, ); bless sub { my $name = shift; my ($package, $filename, $line) = caller; die "Attempt to access private class data " . "for $field{class} at $filename line $line\n" unless UNIVERSAL::isa ($package => __PACKAGE__); die "No such field '$name' at $filename line $line\n" unless exists $field{$name}; die "You can't change the class name at $filename line $line\n +" if $name eq 'class'; $field {$name} = shift if @_; $field {$name} } => $class; } sub name {my $self = shift; $self -> (name => @_)} sub colour {my $self = shift; $self -> (colour => @_)} sub age {my $self = shift; $self -> (age => @_)} sub format { my $self = shift; join " " => $self -> ('name'), $self -> ('colour'), $self -> ('age +'); } package Class_Inside_Out; my %name; my %colour; my %age; sub new { my $key = bless \(my $dummy) => shift; my %args = @_; $name {$key} = $args {name} || "abigail"; $colour {$key} = $args {colour} || "pink"; $age {$key} = $args {age} || 100; $key; } sub name { my $key = shift; $name {$key} = shift if @_; $name {$key}; } sub colour { my $key = shift; $colour {$key} = shift if @_; $colour {$key}; } sub age { my $key = shift; $age {$key} = shift if @_; $age {$key}; } sub format { my $key = shift; join " " => $name {$key}, $colour {$key}, $age {$key}; } package Class_Traditional; sub new { my $class = shift; my %args = @_; bless {name => $args {name} || "abigail", colour => $args {colour} || "pink", age => $args {age} || 100} => $class; } sub name { my $self = shift; $self -> {name} = shift if @_; $self -> {name} } sub colour { my $self = shift; $self -> {colour} = shift if @_; $self -> {colour} } sub age { my $self = shift; $self -> {age} = shift if @_; $self -> {age} } sub format { my $self = shift; join " " => @$self {qw /name colour age/}; } package main; our $obj_c = Class_Closure -> new; our $obj_i = Class_Inside_Out -> new; our $obj_t = Class_Traditional -> new; our @names = ("Larry Wall", "Damian Conway", "Nicholas Clark", "Gurusamy Sarathy", "Chip Salzenberg", "Rafael Garcia-Suarez"); our @colours = qw /red green blue white yellow orange brown purple vio +let/; # # Test. # my $name = $names [rand @names]; my $colour = $colours [rand @colours]; my $age = 1 + int rand 100; foreach my $i ([obj_c => $obj_c], [obj_i => $obj_i], [obj_t => $obj_t] +) { $i -> [1] -> name ($name); $i -> [1] -> colour ($colour); $i -> [1] -> age ($age); die $i -> [0] unless "$name $colour $age" eq $i -> [1] -> format; } our $dummy; cmpthese -1 => { closure => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_c -> name ($n); $obj_c -> colour ($c); $obj_c -> age ($age); $dummy = $obj_c -> format; } }', inside_out => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_i -> name ($n); $obj_i -> colour ($c); $obj_i -> age ($age); $dummy = $obj_i -> format; } }', traditional => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_t -> name ($n); $obj_t -> colour ($c); $obj_t -> age ($age); $dummy = $obj_t -> format; } }', }; __END__ Rate closure inside_out traditional closure 355/s -- -25% -75% inside_out 473/s 33% -- -67% traditional 1436/s 304% 203% --

Abigail


Comment on Re: May Thy Closures Be Blessed
Download Code
Re: Re: May Thy Closures Be Blessed
by eserte (Deacon) on Apr 26, 2004 at 17:43 UTC
    This is probably due to inefficient stringification of the object reference. Maybe the stringified value should be put into the PV portion and POK should be set on while doing Perl_sv_2pv_flags ?
      This is probably due to inefficient stringification of the object reference. Maybe the stringified value should be put into the PV portion and POK should be set on while doing Perl_sv_2pv_flags ?

      I think this evaluation is spot on. If you change the inside-out implementation to something that avoids stringification:

      You get something much more reasonable:

      Rate closure inside_out traditional closure 177/s -- -43% -45% inside_out 313/s 76% -- -3% traditional 321/s 81% 3% --
        Very nice. Big savings because of caching the calculation of stringified value (I get an 18% difference, not a 3%). Unfortunally, this technique can't be used if you are subclassing a class that doesn't coorperate - then you will to call refaddr in each method. That's slower (traditional method being 69% faster), but faster than what I showed before. I would have expected to be able to gain a little more by writing the methods like:
        sub name { my $key = ${+shift}; $name {$key} = shift if @_; $name {$key}; }
        but that doesn't give me any gain (or loss).

        Abigail

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://348237]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2014-08-21 02:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (127 votes), past polls