I wonder ... if all you were doing was some transliteration why would you bother with the lines at all? Read and process say 64 KB at once. As I said, not sure this is doable in your case.

Second ... why would you spend time "figuring out reasonable character classes? If you have the mapping hash, just build the tr/// out of it. I just tried to benchmark the difference between tr/a-z/A-Z/ and tr/abcdef...xyz/ABCDEF...ZYX/ and the later actually came out a tiny little bit faster. So you could either have the tr/// generated from the hash and copy the result into the script or use string eval to define a subroutine to do the transliteration.  my $sub = eval 'sub { my $x = shift(); $x=~ tr/' . join('', keys %h) . '/' . join('', values %h) . '/; return $x}'; or something. If the loop is simple enough you could eval the whole loop so that you do not waste time by the subroutine call for each line. Or am I missing something?

I wonder ... if all you were doing was some transliteration why would you bother with the lines at all?

Good point. I now have the code altered in test to use sysread to read in 128KB at a time, and there is definitely a boost there. Probably roll that into prod with the next release. Thanks!

why would you spend time "figuring out reasonable character classes? If you have the mapping hash, just build the tr/// out of it.

I started there, actually, with code that looks something like this:

my %rot = (
  'A' => 'N','B' => 'O','C' => 'P','D' => 'Q','E' => 'R','F' => 'S',
  'G' => 'T','H' => 'U','I' => 'V','J' => 'W','K' => 'X','L' => 'Y',
  'M' => 'Z','N' => 'A','O' => 'B','P' => 'C','Q' => 'D','R' => 'E',
  'S' => 'F','T' => 'G','U' => 'H','V' => 'I','W' => 'J','X' => 'K',
  'Y' => 'L','Z' => 'M','a' => 'n','b' => 'o','c' => 'p','d' => 'q',
  'e' => 'r','f' => 's','g' => 't','h' => 'u','i' => 'v','j' => 'w',
  'k' => 'x','l' => 'y','m' => 'z','n' => 'a','o' => 'b','p' => 'c',
  'q' => 'd','r' => 'e','s' => 'f','t' => 'g','u' => 'h','v' => 'i',
  'w' => 'j','x' => 'k','y' => 'l','z' => 'm',
);

my ($tr_a, $tr_b);
for (keys %rot) { $tr_a.=$_; $tr_b.=$rot{$_} }

print "tr/$tr_a/$tr_b/;\n";
[download]

However, I wasn't kidding when I said that ROT-13 is a simplified case of the actual problem! I spent some time finding the char classes, not for runtime efficiency, but for readability/maintainability. There's a reasonable chance of the rules changing, and a tr/// with 300-or-so-char clauses is mighty unreadable.

The string eval is an interesting solution, and one I will have to play around with -- unfortunately, it won't be allowed in prod without an exception filing (string evals are against our coding standards), so there will have to be significant benefit to get it approved. Still, something I hadn't considered, so I thank you for that...

<–radiant.matrix–>
A collection of thoughts and links from the minds of geeks
The Code that can be seen is not the true Code
I haven't found a problem yet that can't be solved by a well-placed trebuchet

His string eval was missing calls to quotemeta. I fixed this, added a few more solutions, and reran the benchmarks. They show that:

• Without using eval (rot13dynre), your task can be accomplished in 2/3rd of the time it currently takes (rot13splitmap).

  my %rot;
  @rot{'A'..'M'} = ('N'..'Z');
  @rot{'N'..'Z'} = ('A'..'M');
  @rot{'a'..'m'} = ('n'..'z');
  @rot{'n'..'z'} = ('a'..'m');
  
  my $chars_to_change = join('', map quotemeta, keys %rot);
  
  sub rot13dynre {
     local $_ = @_ ? $_[0] : $_;
     s/([$chars_to_change])/$rot{$1}/g;
     return $_;
  }
  [download]

• By using eval (rot13trbuilt), your task can be accomplished in 1/167th of the time it currently takes (rot13splitmap).

  my %rot;
  @rot{'A'..'M'} = ('N'..'Z');
  @rot{'N'..'Z'} = ('A'..'M');
  @rot{'a'..'m'} = ('n'..'z');
  @rot{'n'..'z'} = ('a'..'m');
  
  *rot13builttr = eval 'sub {
     local $_ = @_ ? $_[0] : $_;
     tr{' . join('', map quotemeta, keys   %rot) . '}
       {' . join('', map quotemeta, values %rot) . '};
     return $_;
  }';
  [download]

That should help convince your peers that this limited, well controlled, easily testable use of eval is appropriate here.

Benchmark results:

Benchmark: running rot13builtre, rot13builttr, rot13dynre, rot13dynre2
+, rot13splitmap, rot13substrfor, rot13tr, each for at least 3 CPU sec
+onds...
rot13builtre:    3 wallclock secs ( 3.13 usr +  0.00 sys =  3.13 CPU) 
+@   572.75/s (n=  1795)
rot13builttr:    4 wallclock secs ( 3.17 usr +  0.00 sys =  3.17 CPU) 
+@ 61539.53/s (n=195388)
rot13dynre:      3 wallclock secs ( 3.07 usr +  0.00 sys =  3.07 CPU) 
+@   567.80/s (n=  1746)
rot13dynre2:     3 wallclock secs ( 3.09 usr +  0.00 sys =  3.09 CPU) 
+@   562.70/s (n=  1741)
rot13splitmap:   3 wallclock secs ( 3.29 usr +  0.00 sys =  3.29 CPU) 
+@   364.99/s (n=  1199)
rot13substrfor:  3 wallclock secs ( 3.22 usr +  0.00 sys =  3.22 CPU) 
+@   491.16/s (n=  1584)
rot13tr:         4 wallclock secs ( 3.09 usr +  0.00 sys =  3.09 CPU) 
+@ 61032.31/s (n=188895)

                  Rate rot13splitmap rot13substrfor rot13dynre2 rot13d
+ynre rot13builtre rot13tr rot13builttr
rot13splitmap    365/s            --           -26%        -35%       
+-36%         -36%    -99%         -99%
rot13substrfor   491/s           35%             --        -13%       
+-13%         -14%    -99%         -99%
rot13dynre2      563/s           54%            15%          --       
+ -1%          -2%    -99%         -99%
rot13dynre       568/s           56%            16%          1%       
+  --          -1%    -99%         -99%
rot13builtre     573/s           57%            17%          2%       
+  1%           --    -99%         -99%
rot13tr        61032/s        16622%         12326%      10746%     10
+649%       10556%      --          -1%
rot13builttr   61540/s        16760%         12429%      10836%     10
+738%       10645%      1%           --
[download]

Benchmark:

#!/usr/bin/perl
use strict;
use warnings;

use Benchmark qw( cmpthese );

my %rot;
@rot{'A'..'M'} = ('N'..'Z');
@rot{'N'..'Z'} = ('A'..'M');
@rot{'a'..'m'} = ('n'..'z');
@rot{'n'..'z'} = ('a'..'m');

my $chars_to_change = join('', map quotemeta, keys %rot);

sub rot13splitmap {
   return join '',
          map { exists $rot{$_} ? $rot{$_} : $_ }
          split '',
          @_ ? $_[0] : $_;
}

sub rot13substrfor {
   my $s = @_ ? $_[0] : $_;
   foreach my $i (0..length($s)-1) {
      my $c = substr($s, $i, 1);
      substr($s, $i, 1, $rot{$c})
         if exists $rot{$c};
   }
   return $s;
}

sub rot13tr {
   local $_ = @_ ? $_[0] : $_;
   tr/a-zA-Z/n-za-mN-ZA-M/;
   return $_;
}

*rot13builttr = eval 'sub {
   local $_ = @_ ? $_[0] : $_;
   tr{' . join('', map quotemeta, keys   %rot) . '}
     {' . join('', map quotemeta, values %rot) . '};
   return $_;
}';

*rot13builtre = eval 'sub {
   local $_ = @_ ? $_[0] : $_;
   s{([' . join('', map quotemeta, keys %rot) . '])}
    {$rot{$1}}g;
   return $_;
}';

sub rot13dynre {
   local $_ = @_ ? $_[0] : $_;
   s/([$chars_to_change])/$rot{$1}/g;
   return $_;
}

{
   my $re = qr/[$chars_to_change]/;

   sub rot13dynre2 {
      local $_ = @_ ? $_[0] : $_;
      s/($re)/$rot{$1}/g;
      return $_;
   }
}

our $data;
{
   local $/;
   $data = <DATA>;
}

cmpthese(-3, {
  rot13splitmap  => 'my $rv = rot13splitmap ($data); 1',
  rot13substrfor => 'my $rv = rot13substrfor($data); 1',
  rot13tr        => 'my $rv = rot13tr       ($data); 1',
  rot13builttr   => 'my $rv = rot13builttr  ($data); 1',
  rot13builtre   => 'my $rv = rot13builtre  ($data); 1',
  rot13dynre     => 'my $rv = rot13dynre    ($data); 1',
  rot13dynre2    => 'my $rv = rot13dynre2   ($data); 1',
});

__DATA__
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Vivamus
luctus nulla sed tellus. Sed vitae sapien in elit vestibulum faucibus.
Maecenas sollicitudin, magna quis vestibulum convallis, ligula nulla
fringilla augue, nec rutrum dolor quam vel justo. Vivamus nisi odio,
ullamcorper sed, venenatis id, imperdiet eleifend, neque. Vivamus
justo felis, euismod in, convallis auctor, egestas id, purus. In
rutrum nisi in lectus. Aliquam elementum placerat dui. Integer ut pede
sit amet magna pulvinar placerat. Maecenas massa lorem, lobortis ut,
adipiscing at, suscipit nec, lectus. Curabitur mattis adipiscing sem.
Mauris pharetra vehicula eros. Sed pellentesque elit laoreet augue.
Cras non tellus. Quisque volutpat lectus in sem. Fusce vulputate justo
ut pede. Aliquam ante pede, tempor in, dictum in, blandit eu, sapien.
Morbi vestibulum, metus eu auctor vulputate, nulla lectus condimentum
nisi, ac pulvinar ligula nunc in felis. Curabitur id orci ac est
luctus molestie.
[download]

Update: Reorganization for clarity.

The string eval is an interesting solution, (snip)... unfortunately, it won't be allowed in prod ...

There is nothing wrong with string eval when you have complete control over what's going into it, and there's no real speed issue if it's a 'do once' thing where you use the results many times, and it sounds like that's how you will use it. And it's the only way to dynamically get things into tr/// so you can initialize it from, e.g., a hash, instead of hardcoding the tr/// translations (except as Jenda notes above, by generating the script itself, which is essentially the same thing as an eval anyway).

Yep, trying to update the tr/// would be a nightmare if it were this long. I don't know your code, but I thought maybe the best solution would be to keep the "source" of the transformation in the mapping hash (or in an external file) and then either regenerate the tr/// each time you make changes or each time you start the script.

I understand the worries about string eval, but in this case it is gonna be safe. There will be no stuff comming from outside of the script in the evaled string so you are not loosing any security by this. Plus you may test that all the keys and values in the hash are single characters and escape the specials.

I think the tr/// syntax could be improved. It's fine if the list of transliterated characters is fairly short, but as it gets longer it's hard to keep the two lists in sync. I think it need's an /x modifier ;-) Maybe like this: tr/a-z => A-Z , +- => -+, 0-9 => 1275489603/x

Jenda


Support Denmark! Defend the free world!

In perl6, this would Just Work:

$string.trans(%rot);     # perl6 version of tr///
[download]

Which I think is quite cool. :-)

duff