in reply to Peeling the Peelings

Thanks for all your comments.

After reading the posts - especially the benchmarks, it seems that the code is not as bad as I thought. However just by looking at it once again and looking at the "80% speedup" for the level 0 case, I came with 2 improvements: 

sub get_proparg {
  my $propstr = shift;                     # get the property string
  my $level   = shift || return $propstr;  # get the level we want to 
+extract
  my $cnt;                                 # initialize counter

  if($level == -1) {           # special case, get the innermost argum
+ent
    $propstr =~ /\(([^\(\)]+)\)+/;
    return $1;
  } else {                     # get whatever argument $level indicate
+s
    for($cnt = 0;$cnt<$level; $cnt++) {
      $propstr =~ /\((.+)\)/;
      $propstr = $1;
    }
    return $propstr;
  }
}

[download]
Should perform slightly better now, esp. for the level 0 case (which unfortunatedly is rare).

Bye
 PetaMem     All Perl:   MT, NLP, NLU

Replies are listed 'Best First'.
Re: Re: Peeling the Peelings
by bobn (Chaplain) on Jul 02, 2003 at 05:40 UTC
    Sorry, dude, I still 0wn y0u! ;-)
    Read more... (3 kB)
    Results: 
    Benchmark: timing 25000 iterations of mine-elegant, mine-less-elegant,
+ original, original++...
mine-elegant:  8 wallclock secs ( 8.20 usr +  0.00 sys =  8.20 CPU) @ 
+3048.78/s (n=25000)
mine-less-elegant:  6 wallclock secs ( 5.64 usr +  0.01 sys =  5.65 CP
+U) @ 4424.78/s (n=25000)
  original:  9 wallclock secs ( 9.29 usr +  0.00 sys =  9.29 CPU) @ 26
+91.07/s (n=25000)
original++:  9 wallclock secs ( 9.33 usr +  0.00 sys =  9.33 CPU) @ 26
+79.53/s (n=25000)

Benchmark: timing 25000 iterations of mine-elegant, mine-less-elegant,
+ original, original++...
mine-elegant:  9 wallclock secs ( 8.67 usr +  0.00 sys =  8.67 CPU) @ 
+2883.51/s (n=25000)
mine-less-elegant:  8 wallclock secs ( 6.11 usr +  0.05 sys =  6.16 CP
+U) @ 4058.44/s (n=25000)
  original:  9 wallclock secs ( 8.67 usr +  0.01 sys =  8.68 CPU) @ 28
+80.18/s (n=25000)
original++:  9 wallclock secs ( 8.72 usr +  0.01 sys =  8.73 CPU) @ 28
+63.69/s (n=25000)

Benchmark: timing 25000 iterations of mine-elegant, mine-less-elegant,
+ original, original++...
mine-elegant:  9 wallclock secs ( 8.40 usr +  0.00 sys =  8.40 CPU) @ 
+2976.19/s (n=25000)
mine-less-elegant:  6 wallclock secs ( 5.22 usr +  0.02 sys =  5.24 CP
+U) @ 4770.99/s (n=25000)
  original:  9 wallclock secs ( 8.33 usr +  0.00 sys =  8.33 CPU) @ 30
+01.20/s (n=25000)
original++:  8 wallclock secs ( 7.88 usr +  0.02 sys =  7.90 CPU) @ 31
+64.56/s (n=25000)

    [download]


    --Bob Niederman, http://bob-n.com
[reply]
[d/l]
[select]
      Hehe - you actually do. ++

      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)
      I guess I'll trade that performance loss against readability. But thanks for the Ideas I could borrow and reuse.

      Bye
       PetaMem           All Perl:   MT, NLP, NLU

[reply]
[d/l]
        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

[reply]
[d/l]
[select]
        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
[reply]
[d/l]
      Bow down. ;)
      Read more... (959 Bytes)
          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]
      Read more... (1187 Bytes)
      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

      Here's another take with cached pregenerated regexes to remove the loop. It performs exactly the same as my simpler version, to the point that they sometimes achieve the exact same iterations/sec. 
      
    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]
      It needs my %rx_hash; at the top of the script somewhere of course.

      Makeshifts last the longest.

[reply]
[d/l]
[select]
        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
[reply]
[d/l]

In Section Seekers of Perl Wisdom