Оптимизация скрипта для более быстрой обработки в Perl
open( FH, 'MAH' ) or die "$!";
while ( $lines = <FH> ) {
$SSA = substr( $lines, 194, 9 );
open( FH1, 'MAH2' ) or die "$!";
while ( $array1 = <FH1> ) {
@fieldnames = split( /\|/, $array1 );
$SSA1 = $fieldnames[1];
$report4 = $fieldnames[0];
if ( $SSA =~ /$SSA1/ ) {
$report5= $report4;
}
}
}
Я пытаюсь найти значение SSA, взятое из файла MAH, и найти это значение в файле MAH2. Если обнаружено присвоение значения report4, и я могу получить результат, но его обработка занимает много времени. Есть ли способ оптимизировать код, чтобы он завершился быстро?
В каждом из моих файлов 300 000 записей, а размер файла - 15 мб. В настоящее время обработка занимает 5 часов
4 ответа
Создайте справочную таблицу.
my $foo_qfn = 'MAH';
my $bar_qfn = 'MAH2';
my %foos;
{
open(my $fh, '<', $foo_qfn)
or die("Can't open \"$foo_qfn\": $!\n");
while ( my $foo_line = <$fh> ) {
my $ssa = substr($foo_line, 194, 9);
$foos{$ssa} = $foo_line;
}
}
{
open(my $fh, '<', $bar_qfn)
or die("Can't open \"$bar_qfn\": $!\n");
while ( my $bar_line = <$fh> ) {
chomp($bar_line);
my ($report4, $ssa) = split(/\|/, $bar_line);
my $foo_line = $foos{$ssa};
...
}
}
Ваш исходный код занял время, косвенно пропорциональное количеству foos, умноженному на количество полос (O(N*M)).
Это займет время, косвенно пропорциональное наибольшему из числа foos и числа баров (O(N+M)).
Другими словами, это должно быть более чем в 100000 раз быстрее. Мы говорим о секундах, а не о часах.
Если ваша задача - просто найти записи в file2, которые соответствуют записям в file1 по полю SSA, есть другой способ сделать это, который может быть быстрее и проще, чем классический подход хеш-таблицы поиска.
Вы можете использовать регулярное выражение, созданное из записей в file1, для синтаксического анализа, сопоставления и извлечения из file2 за один проход. Да, Perl может обрабатывать регулярные выражения с 300000 изменений! :) Это разумно только в Perl, движки регулярных выражений которого могут строить деревья чередования. (5.10+ Вы могли использовать Regexp::Assemble до этого.)
## YOUR CODE ##
open( FH, 'MAH' ) or die "$!";
while ( $lines = <FH> ) {
$SSA = substr( $lines, 194, 9 );
open( FH1, 'MAH2' ) or die "$!";
while ( $array1 = <FH1> ) {
@fieldnames = split( /\|/, $array1 );
$SSA1 = $fieldnames[1];
$report4 = $fieldnames[0];
if ( $SSA =~ /$SSA1/ ) {
$report5= $report4;
}
}
}
Как регулярное выражение:
our $file1 = "MAH";
our $file2 = "MAH2";
open our $fh1, "<", $file1 or die $!;
our $ssa_regex = "(?|" .
join( "|",
map join("", "^([^|]*)[|](", quotemeta($_), ")(?=[|])"),
map substr( $_, 194, 9 ),
<$fh1> ) .
")"
;
close $fh1;
open our $fh2, "<", $file2 or die $!;
our @ssa_matches = do { local $/; <$fh2> =~ m/$ssa_regex/mg; };
close $fh2;
undef $ssa_regex;
die "match array contains an odd number of entries??\n" if @ssa_matches % 2;
while (@ssa_matches) {
my($report4, $SSA1) = splice @ssa_matches, 0, 2;
## do whatever with this information ##
}
Давайте разберемся с этим некоторыми комментариями.
Прочтите file1 и создайте регулярное выражение.
our $file1 = "MAH";
our $file2 = "MAH2";
# open file1 as normal
open our $fh1, "<", $file1 or die $!;
# build up a regular expressions that will match all of the SSA fields
our $ssa_regex =
# Start the alternation reset group. This way you always have $1
# and $2 regardless of how many groups or total parens there are.
"(?|" .
# Join all the alternations together
join( "|",
# Create one regex group that will match the beginning of the line,
# the first "record4" field, the | delimiter, the SSA, and then
# make sure the following character is the delimiter. [|] is
# another way to escape the | character that can be more clear
# than \|.
# Escape any weird characters in the SSA with quotemeta(). Omit
# this if plain text.
map join("", "^([^|]*)[|](", quotemeta($_), ")(?=[|])"),
# Pull out the SSA value with substr().
map substr( $_, 194, 9 ),
# Read all the lines of file1 and feed them into the map pipeline.
<$fh1> ) .
# Add the closing parethesis for the alternation reset group.
")"
;
# Close file1.
close $fh1;
Прочтите файл file2 и примените регулярное выражение.
# Open file2 as normal.
open our $fh2, "<", $file2 or die $!;
# Read all of file2 and apply the regex to get an array of the wanted
# "record4" field and the matching SSA.
our @ssa_matches =
# Using a do{} block lets do the undef inline.
do {
# Undefine $/ which is the input record seperator which will let
# us read the entire file as a single string.
local $/;
# Read the file as a single string and apply the regex, doing a global
# multiline match. /m means to apply the ^ assertion at every line,
# not just at the beginning of the string. /g means to perform and
# return all of the matches at once.
<$fh2> =~ m/$ssa_regex/mg;
};
# Close file2 as normal.
close $fh2;
# Clear the memory for the regex if we don't need it anymore
undef $ssa_regex;
# Make sure we got pairs
die "match array contains an odd number of entries??\n" if @ssa_matches % 2;
# Now just iterate through @ssa_matches two at a time to do whatever
# you wanted to do with the matched SSA values and that "record4"
# field. Why is it record4 if it's the first field?
while (@ssa_matches) {
# Use splice() to pull out and remove the two values from @ssa_matches
my($report4, $SSA1) = splice @ssa_matches, 0, 2;
## do whatever with this information ##
}
Регулярное выражение можно было бы еще больше сжать, если мы будем педантичны.
our $ssa_regex = "^([^|]*)[|](" .
join( "|",
map quotemeta($_),
map substr( $_, 194, 9 ),
<$fh1> ) .
")(?=[|])"
;
Я не гарантирую, что этот способ лучше или быстрее, чем любой другой, но это способ сделать это с меньшим количеством шагов.
ikegami уже указал на гораздо лучший подход к хранению одного файла в качестве таблицы поиска. Но позвольте мне высказать некоторые мои наблюдения, и, возможно, они тоже могут быть применимы.
Этим выражением мы рассматриваем $SSA1 как регулярное выражение:
$SSA =~ /$SSA1/
Мне редко удается хранить регулярные выражения в файлах ... возможно, вы имеете в виду поиск по подстрокам вместо того, чтобы рассматривать $SSA1 как регулярное выражение? если это так, это, вероятно, может быть:
index($SSA, $SSA1) >= 0
OTOH в том же if-выражении реакция после успешного совпадения:
$report5 = $report4
когда в одном и том же внутреннем цикле есть несколько успешных совпадений, один и тот же оператор выполняется несколько раз, что означает, что $report5 сохраняет что-то, соответствующее последнему совпадению.
Если от MAH2 ожидается не более одного совпадения, возможно, добавление «последнего» для выхода из внутреннего цикла.
if ( index($SSA, $SSA1) >= 0 ) {
$report5 = $report4;
last;
}
в зависимости от того, где находится матч в MAH2, это может срезать некоторые углы. Хотя это останавливает цикл при первом совпадении, а не при последнем совпадении ... что означает, что это не прямая замена вашей исходной трески. Если это все еще соответствует вашей цели, возможно, его можно использовать.
Однако в качестве «вывода» этой части программы $report5 используется только один раз для данной части кода, а это означает, что из всех 9 миллиардов iteartion, которые мы делаем, действительно имеет значение только одно совпадение - возможно, также имеет смысл внешний цикл (опять же, это может быть не то, что вам нужно.)
При работе с большими файлами настоятельно рекомендуется использовать модуль Tie :: File, так как вы можете работать с файлом прямо с диска. Избегайте такой загрузки всего файла в память, что сэкономит ваше время и повысит производительность.