Perl, объединяющий 2 файла CSV линию за линией с первичным ключом

Что убивает производительность, так это этот код, который конкатенирует миллионы раз.

$OUTSTRING.=$outstring."\n";

....

foreach my $key (sort { $a <=> $b } keys %line_for){
    $OUTSTRING.= $file1array[$line_for{$key}]."\n";
}

Если вы хотите записывать в выходной файл только один раз, накапливайте результаты в массиве, а затем выводите их в самом конце, используя join. Или, что еще лучше, включите новые строки в результаты и запишите массив напрямую.

Чтобы увидеть, как конкатенация не масштабируется при обработке больших данных, поэкспериментируйте с этим демонстрационным скриптом. Когда вы запускаете его в режиме concat, все начинает значительно замедляться после пары сотен тысяч конкатенаций - я сдался и убил скрипт. Для сравнения, простая печать массива из миллиона строк заняла на моей машине меньше минуты.

# Usage: perl demo.pl 50 999999 concat|join|direct
use strict;
use warnings;

my ($line_len, $n_lines, $method) = @ARGV;
my @data = map { '_' x $line_len . "\n" } 1 .. $n_lines;

open my $fh, '>', 'output.txt' or die $!;

if ($method eq 'concat'){         # Dog slow. Gets slower as @data gets big.
    my $outstring;
    for my $i (0 .. $#data){
        print STDERR $i, "\n" if $i % 1000 == 0;
        $outstring .= $data[$i];
    }
    print $fh $outstring;
}
elsif ($method eq 'join'){        # Fast
    print $fh join('', @data);
}
else {                            # Fast
    print $fh @data;
}

Если вы хотите слиться, вам действительно нужно слияние. Прежде всего вам нужно отсортировать данные по ключу, а затем объединить! Вы превзойдете даже MySQL по производительности. У меня большой опыт работы с этим.

Вы можете написать что-нибудь в этом роде:

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

use Text::CSV_XS;
use autodie;

use constant KEYPOS => 4;

die "Insufficient number of parameters" if @ARGV < 2;
my $csv = Text::CSV_XS->new( { eol => $/ } );
my $sortpos = KEYPOS + 1;
open my $file1, "sort -n -k$sortpos -t, $ARGV[0] |";
open my $file2, "sort -n -k$sortpos -t, $ARGV[1] |";
my $row1 = $csv->getline($file1);
my $row2 = $csv->getline($file2);
while ( $row1 and $row2 ) {
    my $row;
    if ( $row1->[KEYPOS] == $row2->[KEYPOS] ) {    # merge rows
        $row  = [ map { $row1->[$_] || $row2->[$_] } 0 .. $#$row1 ];
        $row1 = $csv->getline($file1);
        $row2 = $csv->getline($file2);
    }
    elsif ( $row1->[KEYPOS] < $row2->[KEYPOS] ) {
        $row  = $row1;
        $row1 = $csv->getline($file1);
    }
    else {
        $row  = $row2;
        $row2 = $csv->getline($file2);
    }
    $csv->print( *STDOUT, $row );
}

# flush possible tail
while ( $row1 ) {
    $csv->print( *STDOUT, $row1 );
    $row1 = $csv->getline($file1);
}
while ( $row2 ) {
    $csv->print( *STDOUT, $row2 );
    $row2 = $csv->getline($file1);
}
close $file1;
close $file2;

Перенаправить вывод в файл и измерить.

Если вам нравится больше здравомыслия в отношении аргументов сортировки, вы можете заменить часть открытия файла на

(open my $file1, '-|') || exec('sort',  '-n',  "-k$sortpos",  '-t,',  $ARGV[0]);
(open my $file2, '-|') || exec('sort',  '-n',  "-k$sortpos",  '-t,',  $ARGV[1]);

Если предположить, что каждый ваш файл занимает около 20 байт, то его размер составит около 20 МБ, что не слишком много. Поскольку вы используете хэш, временная сложность не кажется проблемой.

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

Чтение нескольких строк за раз также должно помочь. Но не слишком сильно, я думаю, всегда будет чтение вперед за сценой.

Я не вижу ничего, что мне показалось бы явно медленным, но я бы внес следующие изменения:

• Во-первых, я бы удалил переменную @ file1array . Вам это не нужно; просто сохраните саму строку в хеше:

   while () {
  чавкать;
   $ line_for {read_csv_string ($ _, $ position)} = $ _;
  }
  

• Во-вторых, хотя это не должно иметь большого значения для perl, я бы не стал постоянно добавлять $ OUTSTRING . Вместо этого сохраните массив строк вывода и нажимайте на него каждый раз. Если по какой-то причине вам все еще нужно вызвать write_line с массивной строкой, вы всегда можете использовать join ('', @OUTLINES) в конце.

• Если write_line не использует syswrite или что-то подобное низкоуровневого, а использует print или другие вызовы на основе stdio, то вы не не сохраняет записи на диск, создавая выходной файл в памяти. Следовательно, вы можете вообще не создавать свой вывод в памяти, а вместо этого просто записывать его по мере создания. Конечно, если вы используете syswrite , забудьте об этом.

• Поскольку очевидно, что нет ничего медленного, попробуйте ввести Devel :: SmallProf в свой код. Я обнаружил, что это лучший профилировщик Perl для создания таких "О! Это медленная линия!" идеи.

Я бы сохранил каждую запись в хеше, ключи которого являются первичными ключами. Значение данного первичного ключа - это ссылка на массив значений CSV, где undef представляет неизвестное значение.

use 5.10.0;  # for // ("defined-or")
use Carp;
use Text::CSV;

sub merge_csv {
  my($path,$record) = @_;

  open my $fh, "<", $path or croak "$0: open $path: $!";

  my $csv = Text::CSV->new;
  local $_;
  while (<$fh>) {
    if ($csv->parse($_)) {
      my @f = map length($_) ? $_ : undef, $csv->fields;
      next unless @f >= 1;

      my $primary = pop @f;
      if ($record->{$primary}) {
        $record->{$primary}[$_] //= $f[$_]
          for 0 .. $#{ $record->{$primary} };
      }
      else {
        $record->{$primary} = \@f;
      }
    }
    else {
      warn "$0: $path:$.: parse failed; skipping...\n";
      next;
    }
  }
}

Ваша основная программа будет напоминать

my %rec;
merge_csv $_, \%rec for qw/ file1 file2 /;

Модуль Data :: Dumper показывает, что полученный хэш с учетом простых входных данных из вашего вопроса равен

$VAR1 = {
  '42' => [
    'one',
    'two',
    'three',
    'four'
  ]
};