Perl регулярное выражение вместо хэша

Question

Есть ли эффективный способ замены набора строк, используя значения из хэша Perl?

Например,

$regex{foo} = "bar";
$regex{hello} = "world";
$regex{python} = "perl";

open(F, "myfile.txt");
while (<F>) {
      foreach $key (keys %regex) {
            s/$key/$regex{$key}/g;
      }
}
close(F);

Есть ли способ выполнить вышеперечисленное в Perl?

Answer 1

Первый вопрос: вы уверены, что у вас есть неэффективно ?

Во-вторых, наиболее очевидным следующим шагом было бы объединить все в одно регулярное выражение:

my $check = join '|', keys %regex;

И тогда вы можете сделать замену как:

s/($check)/$regex{$1}/g;

Это все еще может быть "медленным" с достаточным перекрытием клавиш, когда движок регулярных выражений должен постоянно перепроверять одни и те же буквы. Вы можете использовать что-то вроде Regexp :: Optimizer , чтобы устранить наложение. Но стоимость оптимизации может быть больше, чем просто выполнение всего, в зависимости от того, сколько изменений (ключ / значения в вашем хэше) и сколько строк вы модифицируете. Преждевременная оптимизация--!

Обратите внимание, что ваш пример кода ничего не делает с текстом после подстановки. Он не изменит файл на месте, поэтому я предполагаю, что вы обрабатываете его отдельно.

Answer 2

Чтобы доказать смысл eval, а также из любопытства, я провел несколько тестов с кодом ОП против подхода $regex{$1} против подхода eval.

Прежде всего, тамкажется, мало смысла в том, чтобы собрать все возможные токены в (token|token|...) выражении соответствия.Perl должен проверить против всех лексем сразу - это спорно, насколько более эффективным, чем это просто проверка каждого маркера в то время, и делать замену с закодированного значением

Во-вторых, делает $regex{$1} средства.ключ хеш-карты извлекается при каждом совпадении.

В любом случае, вот некоторые числа (запустил это на клубничном 5.12, с 4 МБ файлом из 100К строк):

1. $regex{$1}заход на посадку занимает 6 секунд (5 секунд с / ход вместо / g)
2. заход на посадку tie занимает 10 секунд
3. заход на посадку OPзанимает чуть менее 1 секунды (с / go вместо / g)
4. Подход eval занимает менее 1 секунды (быстрее, чем код OP)

Это подход eval:

$regex{foo} = "bar";
$regex{hello} = "world";
$regex{python} = "perl";
$regex{bartender} = "barista";

$s = <<HEADER;
\$start = time;
open(F, "myfile.txt");
while (<F>) {
HEADER

foreach $key (keys %regex) {
   $s .= "s/$key/$regex{$key}\/go;\n"
}

$s .= <<FOOTER;
print \$_;
}
close(F);
print STDERR "Elapsed time (eval.pl): " . (time - \$start) . "\r\n";
FOOTER

eval $s;

Answer 3

Определите регулярное выражение, соответствующее любой из клавиш.

$regex = join("|", map {quotemeta} keys %regex);

Замените любое совпадение $regex на $regex{$1}.

s/($regex)/$regex{$1}/go;

Опустите модификатор o, если$regex изменяется во время выполнения программы.

Обратите внимание, что если есть ключи, являющиеся префиксом другого ключа (например, f и foo), то, что произойдет первым в объединенном регулярном выражении, будетрассматривается как совпадение (например, f|foo соответствует f, но foo|f соответствует foo в foobar).Если это может произойти, вам может понадобиться отсортировать keys %regex в зависимости от того, в каком матче вы хотите выиграть.(Спасибо ysth за указание на это.)

Answer 4

Начало:

#!/usr/bin/perl
use strict;
use Tie::File;

my %tr=(   'foo' => 'bar',
            #(...)
        );
my $r =join("|", map {quotemeta} keys %tr);
$r=qr|$r|;

с использованием больших файлов:

tie my @array,"Tie::File",$ARGV[0] || die;
for (@array) { 
    s/($r)/$tr{$1}/g;
}
untie @array;

с использованием небольших файлов:

open my $fh,'<',$ARGV[0] || die;
local $/ = undef;
my $t=<$fh>;
close $fh;
$t=~s/($r)/$tr{$1}/g;
open $fh,'>',$ARGV[0] || die;
print $fh $t;
close $fh;

Answer 5

То, что у вас есть, работает как есть, поэтому неясно, какой у вас запрос.

Один улов: у отправленного вами кода могут возникнуть проблемы с двойными заменами в зависимости от содержимого %regex и / или $_.Например,

my %regex = (
   foo => 'bar',
   bar => 'foo',
);

Решение состоит в том, чтобы переместить foreach в шаблон, так сказать.

my $pat =
   join '|',
    map quotemeta,  # Convert text to regex patterns.
     keys %regex;

my $re = qr/$pat/;  # Precompile for efficiency.

my $qfn = 'myfile.txt'
open(my $fh, '<', $qfn) or die "open: $qfn: $!";
while (<$fh>) {
   s/($re)/$regex{$1}/g;
   ... do something with $_ ...
}

Answer 6

perl -e '                                                         \
          my %replace =  (foo=>bar, hello=>world, python=>perl);  \
          my $find    =  join "|", sort keys %replace;            \
          my $str     =  "foo,hello,python";                      \
          $str        =~ s/($find)/$replace{$1}/g;                \
          print "$str\n\n";                                       \
        '

Что-то, что вы, возможно, захотите рассмотреть, - это не построчная обработка файла, а обработка всего файла сразу и использование модификатора /s в регулярном выражении для однострочного режима.

Answer 7

Это старый вопрос, поэтому я удивлен, что никто еще не предложил очевидного: предварительно скомпилируйте каждое из регулярных выражений (то есть ключи хеша).

$regex{qr/foo/} = 'bar';
$regex{qr/hello/} = 'world';
$regex{qr/python/} = 'perl';

open(F, "myfile.txt");
while (<F>) {
      foreach $key (keys %regex) {
            s/$key/$regex{$key}/g;
      }
}
close(F);

или для (ИМО) большей читаемости:

%regex = (
    qr/foo/    => 'bar',
    qr/hello/  => 'world',
    qr/python/ => 'perl',
);

Если вы знаете, что в каждой строке ввода может быть только одно возможное совпадение, тогда пропуск оставшихся регулярных выражений с помощью last после успешного совпадения также поможет, если имеется много ключей. например внутри цикла for:

s/$key/$regex{$key}/g && last;