But not that much anymore: ;-)

sub get_proparg_new {
 my $propstr = shift;                     # get the property string
 my $level   = shift || return $propstr;  # get the level we want to e
+xtract

 if($level == -1) {           # special case, get the innermost argume
+nt
   $propstr =~ /\(([^()]+)\)+/;
   return $1;
 } else {                     # get whatever argument $level indicates
   while ($level--) {
     $propstr =~ /\((.+)\)/;
     $propstr = $1;
   }
 }

 return $propstr;
}
[download]

Benchmark: timing 25000 iterations of mine-elegant, mine-less-elegant, original, original++...
mine-elegant:  5 wallclock secs ( 4.61 usr +  0.00 sys =  4.61 CPU) @ 5422.99/s (n=25000)
mine-less-elegant:  2 wallclock secs ( 2.16 usr +  0.00 sys =  2.16 CPU) @ 11574.07/s (n=25000)
  original:  2 wallclock secs ( 2.55 usr +  0.00 sys =  2.55 CPU) @ 9803.92/s (n=25000)
original++:  3 wallclock secs ( 2.32 usr +  0.00 sys =  2.32 CPU) @ 10775.86/s (n=25000)

Bye
 PetaMem     All Perl:   MT, NLP, NLU

Warning: objections have been raised to the following code - see below for the objections and the revised code

Hmm, I think I own you now - this uses code that writes code:

[%# Run this through tpage - from Template %]

[% numbers = [ 1, 2, 3, 4, 5, 6 ] -%]
[%   end   = '\)' -%]
[%   start = '\w+\(' -%]


my %functions = ();

[% FOR level = numbers -%]
$functions{ [% level %] } = sub { 
  $_[0] =~ s/[% end %]{[% level %]}$//o;  
  $_[0] =~ s/^([% start %]){[% level %]}//o;
  return $_[0];
};
[% END -%]

sub get_proparg_evdb {
 $_ = $_[0];
 my $level  = $_[1] || return $_;

 if ($level == -1) {
   m/\(([^()]+)\)+/;
   return $1;
 } 

 return &{$functions{ $level }}( $_ ) 
   || die 'Add universal function here';
}
[download]

This code, when parsed by tpage which comes with Template will create a special function for each of the cases with an optimised regexp in it. These functions are then accessed through a hash.

The complete code that is produced is here:

Read more... (1216 Bytes)
By adding this to the benchmaring stuff above from previous posts using require evdb_functions.pl (or whatever) and Benchmarking you get this (some suggestions omitted for clarity):

             Rate       ori m-elegant     ori++      evdb
ori        6234/s        --      -36%      -40%      -51%
m-elegant  9690/s       55%        --       -7%      -24%
ori++     10373/s       66%        7%        --      -18%
evdb      12690/s      104%       31%       22%        --
[download]

Code that writes code - tip 29 from the pragmatic programmer.

--tidiness is the memory loss of environmental mnemonics

Another useless use of /o. See /o is dead, long live qr//!. Also, your code can be simplified by throwing away the %functions hash and just creating the matching expressions as needed.

UPDATE: This "solution" modifies the @data, such that all entries are case 0, so the benchmarks as run are not valid.

Nice try, though.

IGNORE THE REST OF THIS.

OK, I'm owned. This is pretty slick. update: Yours test fastest. However, my test numbers are way different than befpore anthe OP's best shoit is now *better* than mine - which I don't understand.

--Bob Niederman, http://bob-n.com

That all seems pretty good now, but you can still improve the special case (-1) regexp a little.


$propstr =~ /.*\((.*?)\)/;
[download]

Can't help with anything else, I'm afraid.

Jasper

    Aristotle => sub {
        my $str = shift;
        my $level = shift || return $str;

        $str =~ /.*\((.*?)\)/ and return $1 if $level == -1;

        local $_ = substr $str, 0, -$level;
        /\G.*?\(/gc while $level--;
        return substr $_, pos;
    },
[download]

ok 1 - by Aristotle for case -1
ok 2 - by Aristotle for case 0
ok 3 - by Aristotle for case 1
ok 4 - by Aristotle for case 2
ok 5 - by Aristotle for case 3
ok 6 - by Aristotle for case 4
ok 7 - by Aristotle for case 5
ok 8 - by bobn for case -1
ok 9 - by bobn for case 0
ok 10 - by bobn for case 1
ok 11 - by bobn for case 2
ok 12 - by bobn for case 3
ok 13 - by bobn for case 4
ok 14 - by bobn for case 5
ok 15 - by Fatvamp for case -1
ok 16 - by Fatvamp for case 0
ok 17 - by Fatvamp for case 1
ok 18 - by Fatvamp for case 2
ok 19 - by Fatvamp for case 3
ok 20 - by Fatvamp for case 4
ok 21 - by Fatvamp for case 5
[download]

Benchmark: running Aristotle, Fatvamp, bobn for at least 2 CPU seconds
+...
 Aristotle:  2 wallclock secs ( 2.12 usr +  0.01 sys =  2.13 CPU) @ 25
+239.44/s (n=53760)
   Fatvamp:  2 wallclock secs ( 2.10 usr +  0.00 sys =  2.10 CPU) @ 15
+751.90/s (n=33079)
      bobn:  2 wallclock secs ( 2.05 usr +  0.00 sys =  2.05 CPU) @ 22
+247.80/s (n=45608)
             Rate   Fatvamp      bobn Aristotle
Fatvamp   15752/s        --      -29%      -38%
bobn      22248/s       41%        --      -12%
Aristotle 25239/s       60%       13%        --
1..21
[download]

Update

    Aristotle2 => sub {
        my $str   = shift;
        my $level = shift || return $str;

        $str =~ /.*\((.*?)\)/ and return $1 if $level == -1;

        local $_ = substr $str, 0, -$level;
        my $rx = $rx_hash{$level} ||= do {
            my $rx = join '', '\A', '(?>.*?\()' x $level;
            qr/$rx/;
        };
        m/$rx/g && return substr $_, pos;
    },
[download]

Makeshifts last the longest.

Testing the code before the update, I get:

Benchmark: timing 15000 iterations of Aristotle, Fatvamp, bobn...
 Aristotle:  3 wallclock secs ( 2.47 usr +  0.00 sys =  2.47 CPU) @ 60
+72.87/s (n=15000)
   Fatvamp:  3 wallclock secs ( 3.51 usr +  0.00 sys =  3.51 CPU) @ 42
+73.50/s (n=15000)
      bobn:  3 wallclock secs ( 2.35 usr +  0.00 sys =  2.35 CPU) @ 63
+82.98/s (n=15000)
            Rate   Fatvamp Aristotle      bobn
Fatvamp   4329/s        --      -29%      -33%
Aristotle 6098/s       41%        --       -5%
bobn      6452/s       49%        6%        --
[download]

But I think someone else has sicne posted code, using substr(), that beats us all.

--Bob Niederman, http://bob-n.com