As others have said, you need to provide a better explanation of what you are really trying to do, with some real input and real output. But if I take this as the basic goal:
Is there a compact one liner for: "Change string at pos (onePos) if pos (onePos) =~ /this/ and change pos (otherPos) if pos (otherPos) =~ /that/ "?
then maybe you don't really want to use tr///. It sounds like you want to avoid a nested loop (foreach string { foreach pos { ... }}), but if you insist on using tr/// (which also requires using substr), there's no other way.
You could avoid the nested loop by using s/// instead. I don't know whether that would end up being faster than a nested loop with tr/// and substr, but it might be worth a try.
In any case, the hard part is that you need to define in advance what mappings go with each character position. In a solution with s///, it might go like this:
#!/usr/bin/perl
use strict;
my @repl_map;
$repl_map[1] = { a => 'k', b => 'l', c => 'm' };
$repl_map[4] = { x => 'i', y => 'j', z => 'k' };
# positions 0,2,3 are undef (to be left unchanged)
# positions >=5 (if present) will also be unchanged
my $match = "^("; # note "^" to anchor match at offset 0
my $replc = "";
my $captr = 1;
for my $pos ( 0 .. $#repl_map ) {
if ( not defined( $repl_map[$pos] )) {
$match .= ".";
}
else {
warn sprintf( " mapping at pos %d: %s\n", $pos,
join( ", ", map { "$_ => $repl_map[$pos]{$_}" }
keys %{$repl_map[$pos]} ));
$match .= ")([" .
join("", sort keys %{$repl_map[$pos]}) .
"])(";
$replc .= sprintf( "\$%d\$repl_map[%d]{\$%d}",
$captr, $pos, $captr+1 );
$captr += 2;
}
}
chop $match; # remove trailing "("
warn " match: $match; replc: $replc\n\n";
my @strings = qw/aaaxxx bbbyyy ccczzz/;
print "BEFORE: @strings\n";
for ( @strings ) {
eval "s/$match/$replc/";
}
print "AFTER: @strings\n";
(updated to simplify the initialization of @repl_map)
I stuck the "warn" statements in there just to report how things are being set up. The STDERR output is:
mapping at pos 1: c => m, a => k, b => l
mapping at pos 4: y => j, x => i, z => k
match: ^(.)([abc])(..)([xyz]); replc: $1$repl_map[1]{$2}$3$repl_map[
+4]{$4}
and the STDOUT output is:
BEFORE: aaaxxx bbbyyy ccczzz
AFTER: akaxix blbyjy cmczkz
UPDATE: There's an important "side-effect" difference between the "single-loop s///" and "nested-loop tr///" approaches:
With s///, if the initial mapping for editable positions does not account for all possible characters that might occur at each position, then some input strings will not match, and these will not be changed at all. In the script above, input strings like "aaa123" and "ABCxyz" will remain completely as-is (digits and upper-case letters won't match the given mappings, even though part of the string does match).
With tr/// and substr in a nested loop, the mapping conditions could match at some positions and not at others, so input strings having some "unmapped" content would be partially changed.
The choice of approach may depend more on how you should handle errors and "boundary conditions", rather than benchmark speed. |