Поиск индексов непустых полей в текстовых файлах

Question

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

Например, строка может выглядеть как

,,10.3,,,,5.2,3.1,,,,,,,

в этом случае я хочу получить вывод

2,10.3,6,5.2,7,3.1

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

Answer 1

Я еще не тестировал, но я бы предположил

my $line = ",,10.3,,,,5.2,3.1,,,,,,,";
my $index = 0;
print join ",",
    map {join ",", @$_}
    grep $_->[1],
    map {[$index++, $_]}
    split ",", $line;

быстрее, чем некоторые расширенные регулярные выражения.

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

Что-то вроде этого не может быть слишком медленным, хотя:

my ($i, @vars);

while ($line =~ s/^(,*)([^,]+)//) {
    push @vars, $i += length($1), $2;
}

print join ",", @vars;

Возможно, вы могли бы опустить первую группу захвата и использовать pos() для разработки индекса.

Вот сравнение двух моих предложений и греха с 1М итерациями:

           Rate flesk1    sin flesk2
flesk1  87336/s     --    -8%   -27%
sin     94518/s     8%     --   -21%
flesk2 120337/s    38%    27%     --

Похоже, мое регулярное выражение работает лучше, чем я думал.

Answer 2

Использование регулярного выражения (хотя я уверен, что это может быть проще):

s/(?(?=,+)((?:,(?{ ++$i }))+)|(?<no_comma>[^,]+,?)(?{ ++$i }))/defined $+{no_comma} ? $i . qq[,] . $+{no_comma} : qq[]/ge;

Пояснение:

s/PATTERN/REPLACEMENT/ge              # g -> Apply to all occurrences
                                      # e -> Evaluate replacement as a expression.
(?
  (?=,+)                              # Check for one or more commas.
  ((?:,(?{ ++$i }))+)                 # If (?=,+) was true, increment variable '$i' with each comma found.                
  |
  (?<no_comma>[^,]+,?)(?{ ++$i })     # If (?=,+) was false, get number between comma and increment the $i variable only once.
)
defined $+{no_comma}                  # If 'no_comma' was set in 'pattern' expression...
$i . qq[,] . $+{no_comma}             # insert the position just before it.
qq[]                                  # If wasn't set, it means that pattern matched only commas, so remove then.

---

Мой тест:

Содержимое script.pl:

use warnings;
use strict;

while ( <DATA> ) { 
    our $i = -1; 
    chomp;
    printf qq[Orig = $_\n];
    s/(?(?=,+)((?:,(?{ ++$i }))+)|(?<no_comma>[^,]+,?)(?{ ++$i }))/defined $+{no_comma} ? $i . qq[,] . $+{no_comma} : qq[]/ge;
#    s/,\Z//;
    printf qq[Mod = $_\n\n];

}

__DATA__
,,10.3,,,,5.2,3.1,,,,,,,
10.3,,,,5.2,3.1,,,,,,,
,10.3,,,,5.2,3.1
,,10.3,5.2,3.1,

Запустите скрипт как:

perl script.pl

И вывод:

Orig = ,,10.3,,,,5.2,3.1,,,,,,,
Mod = 2,10.3,6,5.2,7,3.1,

Orig = 10.3,,,,5.2,3.1,,,,,,,
Mod = 0,10.3,4,5.2,5,3.1,

Orig = ,10.3,,,,5.2,3.1
Mod = 1,10.3,5,5.2,6,3.1

Orig = ,,10.3,5.2,3.1,
Mod = 2,10.3,3,5.2,4,3.1,

Как видите, последняя запятая. Я не знаю, как удалить его без дополнительного регулярного выражения, просто раскомментируйте s/,\Z//; в предыдущем коде.

Answer 3

Возможно, вы сможете смешивать и сопоставлять регулярное выражение и код -

$line =~ /(?{($cnt,@ary)=(0,)})^(?:([^,]+)(?{push @ary,$cnt; push @ary,$^N})|,(?{$cnt++}))+/x
and print join( ',', @ary);

расширен -

$line =~ /
  (?{($cnt,@ary)=(0,)})
  ^(?:
      ([^,]+) (?{push @ary,$cnt; push @ary,$^N})
    | , (?{$cnt++})
   )+
/x
and print join( ',', @ary);

некоторые тесты

С небольшим изменением flesk и sln (ищите fleskNew и slnNew),
победителем становится fleskNew при удалении оператора подстановки.

code -

use Benchmark qw( cmpthese ) ;
$samp = "x,,10.3,,q,,5.2,3.1,,,ghy,g,,l,p";
$line = $samp;

cmpthese( -5, {

    flesk1 => sub{
                    $index = 0;
                    join ",",
                       map {join ",", @$_}
                       grep $_->[1],
                       map {[$index++, $_]}
                       split ",", $line;
           },

    flesk2 => sub{
              ($i, @vars) = (0,);
              while ($line =~ s/^(,*)([^,]+)//) {
                  push @vars, $i += length($1), $2;
              }
              $line = $samp;
           },

    fleskNew => sub{
              ($i, @vars) = (0,);
              while ($line =~ /(,*)([^,]+)/g) {
                  push @vars, $i += length($1), $2;
              }
           },

    sln1 => sub{
              $line =~ /
                 (?{($cnt,@ary)=(0,)})
                 ^(?:
                     ([^,]+) (?{push @ary,$cnt; push @ary,$^N})
                   | , (?{$cnt++})
                  )+
               /x
           },

    slnNew => sub{
              $line =~ /
                 (?{($cnt,@ary)=(0,)})
                 (?:
                     (,*) (?{$cnt += length($^N)})
                     ([^,]+) (?{push @ary, $cnt,$^N})
                   )+
               /x
           },

} );

числа -

            Rate   flesk1     sln1   flesk2   slnNew fleskNew
flesk1   20325/s       --     -51%     -52%     -56%     -60%
sln1     41312/s     103%       --      -1%     -10%     -19%
flesk2   41916/s     106%       1%       --      -9%     -17%
slnNew   45978/s     126%      11%      10%       --      -9%
fleskNew 50792/s     150%      23%      21%      10%       --

некоторые тесты 2

Добавляет встроенную замену и обрезку Birei (все в одном)решение.

Аббревиатуры:

Flesk1 изменен для удаления окончательного «соединения», поскольку он не включен в
других решений регулярных выражений.Это дает ему шанс лучше на скамейке.

Бирей отклоняется на скамейке, поскольку это изменяет исходную строку, чтобы быть окончательным решением.
Этот аспект не может быть удален.Разница между Birei1 и BireiNew заключается в том, что новый
удаляет последний ','.

Flesk2, Birei1 и BireiNew имеют дополнительные накладные расходы на восстановление исходной строки
из-за оператора подстановки.

Победитель по-прежнему выглядит как FleskNew ..

code-

use Benchmark qw( cmpthese ) ;
$samp = "x,,10.3,,q,,5.2,3.1,,,ghy,g,,l,p";
$line = $samp;

cmpthese( -5, {

    flesk1a => sub{
                $index = 0;
                map {join ",", @$_}
                   grep $_->[1],
                   map {[$index++, $_]}
                   split ",", $line;
       },

    flesk2 => sub{
          ($i, @vars) = (0,);
          while ($line =~ s/^(,*)([^,]+)//) {
              push @vars, $i += length($1), $2;
          }
          $line = $samp;
       },

    fleskNew => sub{
          ($i, @vars) = (0,);
          while ($line =~ /(,*)([^,]+)/g) {
              push @vars, $i += length($1), $2;
          }
       },

    sln1 => sub{
          $line =~ /
             (?{($cnt,@ary)=(0,)})
             ^(?:
                 ([^,]+) (?{push @ary,$cnt; push @ary,$^N})
               | , (?{$cnt++})
              )+
           /x
       },

    slnNew => sub{
          $line =~ /
             (?{($cnt,@ary)=(0,)})
             (?:
                 (,*) (?{$cnt += length($^N)})
                 ([^,]+) (?{push @ary, $cnt,$^N})
             )+
           /x
       },


    Birei1 => sub{
          $i = -1;
          $line =~
          s/
           (?(?=,+)
               ( (?: , (?{ ++$i }) )+ )
             | (?<no_comma> [^,]+ ,? ) (?{ ++$i })
           )
          /
          defined $+{no_comma} ? $i . qq[,] . $+{no_comma} : qq[]
          /xge;

          $line = $samp;
       },

    BireiNew => sub{
          $i = 0;
          $line =~ 
          s/
            (?: , (?{++$i}) )*
            (?<data> [^,]* )
            (?: ,*$ )?
            (?= (?<trailing_comma> ,?) )
          /
            length $+{data} ? "$i,$+{data}$+{trailing_comma}" : ""
          /xeg;

          $line = $samp;
       },

} );

результаты -

            Rate BireiNew   Birei1  flesk1a   flesk2     sln1   slnNew fleskNew
BireiNew  6030/s       --     -18%     -74%     -85%     -86%     -87%     -88%
Birei1    7389/s      23%       --     -68%     -82%     -82%     -84%     -85%
flesk1a  22931/s     280%     210%       --     -44%     -45%     -51%     -54%
flesk2   40933/s     579%     454%      79%       --      -2%     -13%     -17%
sln1     41752/s     592%     465%      82%       2%       --     -11%     -16%
slnNew   47088/s     681%     537%     105%      15%      13%       --      -5%
fleskNew 49563/s     722%     571%     116%      21%      19%       5%       --