in reply to Re: Peeling the Peelings
in thread Peeling the Peelings

Actually, your cosde is a lot slower, once again, go figure: 
#!/usr/bin/perl -w


$|++;
use strict;
use Benchmark;

# my first take - 'mine-less-lgnt' in test.
sub getpropstr
{
    local $_ = shift;
    my $level = shift || 0;
    if ( $level == -1 ) { /([^()]+)\)+$/; return $1 }
    while ( $level-- > 0)
    {
        chop;
        s/^[^(]+\(//;
    }
    return $_;
}

my @data = <DATA>;
chomp @data;

if(1)
{
for (@data)
{
    print "$_\n";
    print getpropstr( split ), "\n" ;
    print get_proparg( split ), "\n" ;
    print prop3( split ), "\n" ;
    print peeln( split ), "\n" ;
}
}

my $count = 15000;

timethese
(
    $count, 
    {
        'mine' => sub { for (@data) { prop3( split ); } },
        'mine-less-lgnt' => sub { for (@data) { getpropstr( split  ); 
+} },
        'his' =>  sub { for (@data) { get_proparg( split ); } },
        'other' =>  sub { for (@data) { peeln( split ); } },
    }
);

# BrowserUK's version 'other' in test
sub peeln {
   local $_ = shift;
   my $n = shift || 0;
   my($c) = (tr[(][]);
   # warn 'Unbalanced parens' unless $o == $c;
   $n = $c if $n == -1;
   m[^ (?: .*? \( .*?){$n} (.+) (?: .*? \) .*?){$n} $]x;
   $1;
}


# original poster's (Fatvamp) 'his' in test
sub get_proparg {
 my $propstr = shift;         # get the property string
 my $level   = shift || 0;    # get the level we want to extract
 my $back    = $propstr;      # Initialize Return value (for case leve
+l=0)
 my $cnt;                     # initialize counter

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

 return $propstr;
}

# my cleaner version 'mine' in test
sub prop3
{
    my $str = shift;
    my $level = shift || 0;
    return $str unless $level;
    my @str = split(/[()]/, $str);
    splice @str, 0, $level;
    my $out = join('(', @str);
    $out .= ')' x ( @str - 1 );
    return $out;
}


__END__
hello(what(is(this(all(about))))) 0
hello(what(is(this(all(about))))) 1
hello(what(is(this(all(about))))) 2
hello(what(is(this(all(about))))) 3
hello(what(is(this(all(about))))) 4
hello(what(is(this(all(about))))) 5
hello(what(is(this(all(about))))) -1

[download]
Results: 
Benchmark: timing 15000 iterations of his, mine, mine-less-lgnt, other
+...
       his:  5 wallclock secs ( 4.94 usr +  0.00 sys =  4.94 CPU) @ 30
+36.44/s (n=15000)
      mine:  5 wallclock secs ( 4.94 usr +  0.01 sys =  4.95 CPU) @ 30
+30.30/s (n=15000)
mine-less-lgnt:  3 wallclock secs ( 3.43 usr +  0.00 sys =  3.43 CPU) 
+@ 4373.18/s (n=15000)
     other: 22 wallclock secs (20.89 usr +  0.03 sys = 20.92 CPU) @ 71
+7.02/s (n=15000)

[download]


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

Replies are listed 'Best First'.
Re:^3: Peeling the Peelings (Best yet?)
by BrowserUk (Patriarch) on Jul 02, 2003 at 11:33 UTC

    UpdateThis version is competely wrong!! It is quick because it does nothing at all. I benchmarked this, but verified the output of a completely different, correct, but much slower piece of code.

    A subtle variation on my last version acheives a worthwhile speedup. It's about 50% quicker than my previous best and over twice as fast as the original.

    I wish there was a way to put a big red cross through the code as well. 

    ## !!! DO NOT USE !!! TOTALLY BOGUS CODE. !!!
sub peel2 {
    my( $s, $n ) = @_;
    my($start, $stop, $p, $q) = (length $s, 0, 0);
    ($start, $stop) = ($p, $q)
        while $p =  1+index( $s, ')', $stop  ) < 0
          and $q =   rindex( $s, '(', $start ) < 0
          and $n--;
    substr $s, $start, $stop - $start;
}

                 Rate            his mine-less-lgnt           buk2    
+      buk3
his             569/s             --           -35%           -45%    
+      -62%
mine-less-lgnt  875/s            54%             --           -15%    
+      -42%
buk2           1026/s            80%            17%             --    
+      -32%
buk3           1502/s           164%            72%            46%    
+        --

    [download]
    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller


[reply]
[d/l]
Re: Re: Re: Peeling the Peelings
by BrowserUk (Patriarch) on Jul 02, 2003 at 10:11 UTC

    As my original attempt was so crap, I thought I'd take another crack. Abandoning any attempt at validation and avoiding the regex engine completely, I came up with this which seems to be about 15% better than the best so far. 

    sub peel {
    my( $s, $n ) = @_;
    my( $start, $stop ) = ( 0, length $s );
    ($start,$stop) = (
        1 + index( $s, '(', $start   ),
           rindex( $s, ')', $stop -1 )

      # reformatting_for_posting error corrected
# Was    ) while $n-- > 0 and index( $s, '(', $start +1 ) > 0;

    ) while $n--    and index( $s, '(', $start +1 ) > 0;
    substr $s, $start, $stop - $start;
}
                 Rate mine-less-lgnt           buk2
mine-less-lgnt  918/s             --           -15%
buk2           1075/s            17%             --

    [download]
    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller


[reply]
[d/l]
      Not bad, but pluggiing it into Aristotle's magic machine (at here) yields: 
      not ok 8 - by substr for case -1
#     Failed test (./t53.pl at line 90)
#          got: 'hello(what(is(this(all(about)))))'
#     expected: 'about'

      [download]
      It's easy to be fast when you don't cover all the cases. ;-P

      --Bob Niederman, http://bob-n.com
[reply]
[d/l]

        Somehow I introduced an error into the code. This is the code that produced the benckmark shown. The difference is the first condition on the while line. I'd did have to reformat the code when pasting to stop it wrapping as I edit my code using lines well over 100 chars. Quite how I managed to add the > 0 in there I can't explain. This does handle all cases. I'll update the original node to reflect the mistake. 

        sub buk2 {
    my( $s, $n ) = @_;
    my( $start, $stop ) = ( 0, length $s );
    ($start,$stop) = (
        1 + index( $s, '(', $start   ),
           rindex( $s, ')', $stop -1 )
    ) while $n-- and index( $s, '(', $start +1 ) > 0;
    substr $s, $start, $stop - $start;
}

        [download]
[reply]
[d/l]
[select]
Re: Re: Re: Peeling the Peelings
by BrowserUk (Patriarch) on Jul 02, 2003 at 09:16 UTC

    Oh well, worth a try:)

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller


[reply]

In Section Seekers of Perl Wisdom