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

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: 

my %functions = ();

$functions{ 1 } = sub { 
  $_[0] =~ s/\){1}$//o;  
  $_[0] =~ s/^(\w+\(){1}//o;
  return $_[0];
};
$functions{ 2 } = sub { 
  $_[0] =~ s/\){2}$//o;  
  $_[0] =~ s/^(\w+\(){2}//o;
  return $_[0];
};
$functions{ 3 } = sub { 
  $_[0] =~ s/\){3}$//o;  
  $_[0] =~ s/^(\w+\(){3}//o;
  return $_[0];
};
$functions{ 4 } = sub { 
  $_[0] =~ s/\){4}$//o;  
  $_[0] =~ s/^(\w+\(){4}//o;
  return $_[0];
};
$functions{ 5 } = sub { 
  $_[0] =~ s/\){5}$//o;  
  $_[0] =~ s/^(\w+\(){5}//o;
  return $_[0];
};
$functions{ 6 } = sub { 
  $_[0] =~ s/\){6}$//o;  
  $_[0] =~ s/^(\w+\(){6}//o;
  return $_[0];
};

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

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

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

[download]
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

Replies are listed 'Best First'.
Re: Re: Re: Re: Re: Peeling the Peelings
by diotalevi (Canon) on Jul 02, 2003 at 19:49 UTC

    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.

[reply]
      I think I understand what you mean about creating the matching expressions on the fly - but that would remove the speed gain from creating all the anonymous functions at compile time and then calling them as needed.

      If I have misunderstood please could you post some code to demonstrate. (PS I have revised my code - see above. That wretched \o is gone - nice posting on it ++).

      --tidiness is the memory loss of environmental mnemonics

[reply]
[d/l]
Re: Re: Re: Re: Re: Peeling the Peelings
by bobn (Chaplain) on Jul 02, 2003 at 15:51 UTC
    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
[reply]
      I believe I have addressed your concerns with this: 
      [%# Run this through tpage - from Template %]

[% debug = 0 %]

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


my %functions = ();


[% FOR level = numbers -%]
$functions{ [% level %] } = sub { 
  my $string = shift;

  [% IF debug %]my $warn = "running [% level %] on '$string'";[% END %
+]

  $string =~ s/[% end %]{[% level %]}$//;  
  $string =~ s/^([% start %]){[% level %]}//;

  [% IF debug %]warn "$warn to produce '$string'\n\n";[% END %]
  return $string;
};
[% END -%]


$functions{-1} = sub {
  my $string = shift;
  $string =~ m/\(([^()]+)\)+/;

  [% IF debug %]warn "running -1 on $string to produce '$1'\n";[% END 
+%]

  return $1;
};

sub get_proparg_evdb {
 my $string = shift;
 my $level  = shift || return $string;

 return &{$functions{ $level }}( $string ) 
   || die 'Add universal function here';
}

      [download]

      I also wrote the following test code which should check that the function is behaving as it should: 

      # Test the function against another with known good results.
for (@data) {
  my @args = split;

  my @copy = @args;

  my $A = get_proparg( @args );
  my $B = get_proparg_evdb( @args );

  unless ( $A eq $B ) {

    warn "function wrong for '$args[1]'\n";
    warn "A is '$A'\nB is '$B'\n\n";

  }

  warn "array messed up\n" unless join(' ',@copy) eq join(' ',@args);

}

      [download]

      I took into account the uselessness of \o (thank you diotalevi) and also removed the case == -1 check by creating a function for it. Interestingly the results are now even better: 

                  Rate m-elegant       ori     ori++      evdb
m-elegant 1797/s        --       -6%      -11%      -36%
ori       1914/s        7%        --       -5%      -32%
ori++     2016/s       12%        5%        --      -28%
evdb      2818/s       57%       47%       40%        --

      [download]

      If I have misunderstood your critique please let me know. As you can see you can set debug = 1 in the template stuff to enable messages during the run that shows that all cases are being used.

      --tidiness is the memory loss of environmental mnemonics

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom