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

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() отработать индекс.

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

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

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

Answer 2

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

$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 (lo ok для fleskNew и slnNew),
Победителем является fleskNew, когда оператор замещения удален.

код -

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 в линии Replacment и отделка (все-в-одном) решение.

аберрации:

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

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

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

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

код -

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%  -- 

Answer 3

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

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//; в предыдущем коде.