Повышение производительности скрипта поиска файлов Perl

Я недавно заметил, что быстрый сценарий, который я написал на Perl, который был разработан для использования в файлах размером менее 10 МБ, был изменен, переадресован и использован в текстовых файлах размером более 40 МБ со значительными проблемами производительности в пакетной среде.

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

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

my $filename = "$ARGV[0]"; # This is needed for regular batch use 
my $cancfile = "$ARGV[1]"; # This is needed for regular batch use 
my @num =();
open(FILE, "<", "$filename") || error("Cannot open file ($!)");
while (<FILE>)
{
    push (@num, $.) if (/^P\|/)
}
close FILE;

my $start;
my $end;

my $loop = scalar(@num);
my $counter =1;
my $test;

open (OUTCANC, ">>$cancfile") || error ("Could not open file: ($!)");

#Lets print out the letters minus the CANCEL letters
for ( 1 .. $loop )
{
    $start = shift(@num) if ( ! $start );
    $end = shift(@num);
    my $next = $end;
    $end--;
    my $exclude = "FALSE";

    open(FILE, "<", "$filename") || error("Cannot open file ($!)");
    while (<FILE>)
    {
        my $line = $_;
        $test = $. if ( eof );
        if ( $. == $start && $line =~ /^P\|[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\|1I\|IR\|/)
        {
            print OUTCANC "$line";
            $exclude = "TRUECANC";
            next;
        }
        if ( $. >= $start && $. <= $end && $exclude =~ "TRUECANC")
        {
            print OUTCANC "$line";
        } elsif ( $. >= $start && $. <= $end && $exclude =~ "FALSE"){
            print $_;
        }
    }
    close FILE;
    $end = ++$test if ( $end < $start );
    $start = $next if ($next);
}


#Lets print the last letter in the file

my $exclude = "FALSE";

open(FILE, "<", "$filename") || error("Cannot open file ($!)");
while (<FILE>)
{
    my $line = $_;
    if ( $. == $start && $line =~ /^P\|[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\|1I\|IR\|/)
    {
        $exclude = "TRUECANC";
        next;
    }
    if ( $. >= $start && $. <= $end && $exclude =~ "TRUECANC")
    {
        print OUTCANC "$line";
    } elsif ( $. >= $start && $. <= $end && $exclude =~ "FALSE"){
        print $_;
    }
}
close FILE;
close OUTCANC;


#----------------------------------------------------------------

sub message
{
    my $m = shift or return;
    print("$m\n");
}

sub error
{
    my $e = shift || 'unknown error';
    print("$0: $e\n");
    exit 0;
}

person SnazzyBootMan    schedule 29.08.2013    source источник
comment
Что делает сценарий? Каков стандартный ввод и соответствующий ожидаемый результат?   -  person choroba    schedule 29.08.2013
comment
возможно, вы сможете сократить код и углубиться в детали кода ... Таким образом вы получите лучший ответ, и, возможно, вы разберетесь в этом сами :)   -  person lordkain    schedule 29.08.2013
comment
Файл размером 40 Мбайт легко помещается в памяти.   -  person Toto    schedule 29.08.2013
comment
Вы можете попробовать это на Code Review, а не здесь, где это немного больше по теме   -  person Hasturkun    schedule 29.08.2013
comment
exclude, кажется, когда-либо содержит только 2 разных значения, используйте флаг 0/1, чтобы вы могли проверить его значение как логическое, а не путем текстового сопоставления в каждой строке (для удобства обслуживания вы, конечно, можете использовать константы манифеста вместо литералов 0/1) . другой вариант - прочитать файл в режиме slurp ({ local $/ = undef; $fcontent = <FILE>; }, обратите внимание на перенос в новый блок) и сопоставить с $fcontent, перемещаясь между совпадениями, используя привязку \G в вашем регулярном выражении.   -  person collapsar    schedule 29.08.2013
comment
@choroba - скрипт удаляет определенные записи из текстового файла. Каждая запись начинается с P | строка заголовка, но не имеет завершающей (конечной) строки. Чтобы еще больше усложнить, каждая запись содержит различное количество строк. Например: P | 123456789 | 1I | IR | дополнительные данные | 1 | больше данных | 1 | больше данных | 2 | больше данных | 3 | больше данных | 3 | больше данных | 3 | больше данных | 4 | больше данных |. Итак, в этой записи восемь строк, но может быть больше или меньше.   -  person SnazzyBootMan    schedule 29.08.2013


Ответы (1)


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

  • /^P\|/ эквивалентно "P|" eq substr $_, 0, 2.
  • $foo =~ "BAR" может быть -1 != index $foo, "BAR".

Затем есть повторяющийся код. Внесение этого факторинга в подпрограмму не увеличит производительность как таковую, но упростит анализ поведения сценария.

Есть много ненужных строк, таких как "$filename" - $filename достаточно.

Но худшим нарушителем будет следующее:

for ( 1 .. $loop ) {
  ...
  open FILE, "<", $filename or ...
  while (<FILE>) {
    ...
  }
  ...
}

Вам нужно прочитать этот файл только один раз, желательно в массиве. Вы можете перебирать индексы:

for ( 1 .. $loop ) {
  ...
  for my $i (0 .. $#file_contents) {
    my $line = $file_contents[$i];
    ... # swap $. for $i, but avoid off-by-one error
  }
  ...
}

Дисковый ввод-вывод медленный, поэтому кэшируйте, где можете!

Я также вижу, что вы используете переменную $exclude как логическое значение со значениями FALSE и TRUECANC. Почему не 0 и 1, чтобы вы могли использовать их непосредственно в условном выражении?

Вы можете исключить общие тесты в if / elsif:

if    (FOO && BAR) { THING_A }
elsif (FOO && BAZ) { THING_B }

должно быть

if (FOO) {
    if    (BAR) { THING_A }
    elsif (BAZ) { THING_B }
}

Тест $. == $start && $line =~ /^P\|.../ может показаться глупым, потому что $start содержит только номера строк, начинающихся с P|, поэтому здесь может быть достаточно регулярного выражения.

Редактировать

Если я правильно понял сценарий, то следующее должно привести к значительному увеличению производительности:

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

my ($filename, $cancfile) = @ARGV;
open my $fh, "<", $filename or die "$0: Couldn't open $filename: $!";

my (@num, @lines);
while (<$fh>)
{
    push @lines, $_;
    push @num, $#lines if "P|" eq substr $_, 0, 2;
}

open my $outcanc, ">>", $cancfile or die "$0: Couldn't open $cancfile: $!";

for my $i ( 0 .. $#num )
{
    my $start = $num[$i];
    my $end   = ($num[$i+1] // @lines) - 1;
    # pre v5.10:
    # my $end = (defined $num[$i+1] ? $num[$i+1] : @lines) - 1

    if ($lines[$start] =~ /^P[|][0-9]{9}[|]1I[|]IR[|]/) {
        print {$outcanc} @lines[$start .. $end];
    } else {
        print STDOUT     @lines[$start .. $end];
    }
}

Скрипт очищен. Файл кешируется в массиве. Итерируются только те части массива, которые действительно необходимы - мы уменьшились до O (n) по сравнению с предыдущим O (n · m).

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

for (1 .. @num) {
  $start = shift @num unless $next;  # aka "do this only in the first iteration"
  $next = shift @num:
  $end = $next - 1:
  while (<FH>) {
    ...
    $test = $. if eof
    ...
  }
  $end = ++test if $end < $start;
  $start = $next if $next;
}

на самом деле все об обходе возможного undef во втором shift занимает некоторое время. Вместо того, чтобы проверять eof во внутреннем цикле, мы можем просто выбрать номер строки после цикла, поэтому $test нам не понадобится. Тогда получаем:

$start = shift @num;
for my $i (1 .. @num) {
  $end = $num[$i] - 1:

  while (<FH>) { ... }

  $end = $. + 1 if $end < $start;  # $end < $start only true if not defined $num[$i]
  $start = $num[$i] if $num[$i];
}

После перевода $i вниз на единицу мы ограничиваем проблему выхода за пределы только одной точкой:

for my $i (0 .. $#num) {
  $start = $num[$i];
  $end = $num[$i+1] - 1; # HERE: $end = -1 if $i == $#num

  while (<FH>) { ... }
}
$end = $. + 1 if $end < $start;

После замены чтения файла массивом (осторожно, существует разница в единицу между индексом массива и номером строки), мы видим, что последнего цикла чтения файла можно избежать, если мы перетащим эту итерацию в цикл for, потому что мы знать, сколько всего строк. Так сказать делаем

$end = ($num[$i+1] // $last_line_number) - 1;

Надеюсь, мой очищенный код действительно эквивалентен оригиналу.

person amon    schedule 29.08.2013
comment
Я обновил пример очищенного кода, который должен быть быстрее. Поскольку у меня нет тестовых данных, я не уверен, что они верны, поэтому мне пришлось вернуться к подверженным ошибкам неофициальным доказательствам состояния программы. - person amon; 29.08.2013
comment
Думаю, вы действительно правильно поняли сценарий. Я провел несколько тестов на своей машине для разработки, и все работает, как ожидалось. Я хотел бы запустить код для некоторых более крупных файлов и доложить, если все в порядке? Мне также нужно время, чтобы обработать ваши комментарии, спасибо за ваш вдумчивый и подробный вклад. - person SnazzyBootMan; 29.08.2013
comment
Код очень хорошо работает в ActivePerl 5.14.2, но у меня возникают некоторые проблемы с его запуском в Solaris 5.8.4. Это произойдет завтра, прежде чем у меня появится возможность взглянуть на это снова. - person SnazzyBootMan; 29.08.2013
comment
@ user1568538 Я использовал синтаксис, доступный только с 5.10. Вы можете обойти это с помощью my $end = (defined $num[$i+1] ? $num[$i+1] : @num) - 1; - person amon; 29.08.2013
comment
Это ошибка: Обнаружен номер, где ожидался оператор в строке 30 prot_cancel_let_clean_v2.pl, рядом] 1 (Оператор отсутствует перед 1?) Обнаружено пустое слово там, где ожидался оператор в строке 30 prot_cancel_let_clean_v2.pl, рядом с 1I (Оператор отсутствует перед I?) Найден термин Bareword где ожидается оператор в строке 30 prot_cancel_let_clean_v2.pl, рядом] IR (оператор отсутствует перед IR?) синтаксическая ошибка в строке 30 prot_cancel_let_clean_v2.pl, рядом с P [(может быть неконтролируемая многострочная // строка, начинающаяся в строке 28) синтаксическая ошибка в строке 30 prot_cancel_let_clean_v2.pl, рядом с [| - person SnazzyBootMan; 29.08.2013
comment
@ user1568538 В моем скрипте нет даже 30 строк, поэтому я понятия не имею, какой код вы используете. Кажется, что он перепутал то, что находится внутри и вне регулярного выражения. Но мне нужно увидеть точный код, чтобы определить проблему. (Отредактируйте свой вопрос или прокомментируйте со ссылкой pastebin или чем-то еще). - person amon; 29.08.2013
comment
Я добавил пару комментариев и два закрытых дескриптора файлов, которые явно не работали. Код работает с поправками до 5.10. Единственная проблема в том, что он не выводит последнюю запись из файла в STDOUT. Я использую перенаправление для захвата STDOUT, и именно этот выход используется. $ Cancfile - это просто запись того, что было удалено. При тестировании на сервере Solaris время работы сокращается с 12+ часов до нескольких секунд. Замечательный пример, как это сделать, Спасибо! - person SnazzyBootMan; 30.08.2013
comment
@ user1568538 Я обнаружил ошибку: она должна быть my $end = (defined $num[$i+1] ? $num[$i+1] : @lines) - 1; - @num заменена на @lines. - person amon; 30.08.2013
comment
работает так, как ожидалось, с этим изменением, и время работы теперь меньше пяти секунд, отлично! - person SnazzyBootMan; 30.08.2013