заменить 4-й столбец из последнего, а также одновременно выбрать уникальное значение из 3-го столбца

У меня есть два файла, оба они разделены каналом.

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

детали первого файла:

1|alpha|s3.3|4|6|7|8|9

2|beta|s3.3|4|6|7|8|9

20|charlie|s3.3|4|6|7|8|9

6|romeo|s3.3|4|6|7|8|9

Вторая информация о файле:

a1|a2|**bob**|a3|a4|a5|a6|a7|a8|**1**|a10|a11|a12

a1|a2|**ray**|a3|a4|a5|a6|a7|a8||a10|a11|a12

a1|a2|**kate**|a3|a4|a5|a6|a7|a8|**20**|a10|a11|a12

a1|a2|**bob**|a3|a4|a5|a6|a7|a8|**6**|a10|a11|a12

a1|a2|**bob**|a3|a4|a5|a6|a7|a8|**45**|a10|a11|a12

Мое требование здесь - найти уникальные значения из 3-го столбца, а также заменить 4-й столбец из последнего. 4-й столбец от последнего может иметь/не иметь числового номера. Этот номер также появится в первом поле первого файла. Мне нужно заменить (второй файл) это число соответствующим значением, которое появляется во втором столбце первого файла.

ожидаемый результат:

уникальная строка: Рэй Кейт Боб

a1|a2|bob|a3|a4|a5|a6|a7|a8|**alpha**|a10|a11|a12

a1|a2|ray|a3|a4|a5|a6|a7|a8||a10|a11|a12

a1|a2|kate|a3|a4|a5|a6|a7|a8|**charlie**|a10|a11|a12

a1|a2|bob|a3|a4|a5|a6|a7|a8|**romeo**|a10|a11|a12

a1|a2|bob|a3|a4|a5|a6|a7|a8|45|a10|a11|a12

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

awk -F'|' '{a[$3]++}END{for(i in a){print i}}' filename

Я бы не хотел читать второй файл дважды, сначала выбрать уникальную строку, а второй раз заменить 4-й столбец из последнего, так как размер файла огромен. Это будет около 500 МБ, и таких файлов много.

В настоящее время я использую модуль perl (Text::CSV) для чтения первого файла (этот файл имеет небольшой размер) и загрузки первых двух столбцов в хеш, рассматривая первый столбец как ключ, а второй как значение. затем прочитайте второй файл и замените столбец n-4 хэш-значением. Но это кажется трудоемким, так как парсинг Text::CSV кажется медленным.

Любое решение awk/perl с учетом скорости было бы очень полезно :)

Примечание. Не обращайте внимания на звездочки ** вокруг текста, они просто подчеркивают, что они не являются частью данных.

ОБНОВЛЕНИЕ: код

#!/usr/bin/perl
use strict;
use warnings;
use Scalar::Utils;
use Text::CSV;
my %hash;
my $csv = Text::CSV->new({ sep_char => '|' });

my $file = $ARGV[0] or die "Need to get CSV file on the command line\n";

open(my $data, '<', $file) or die "Could not open '$file' $!\n";
while (my $line = <$data>) {
    chomp $line;

    if ($csv->parse($line)) {

        my @fields = $csv->fields();
        $hash{$field[0]}=$field[1];

    } else {
        warn "Line could not be parsed: $line\n";
    }
}
close($data);

my $csv = Text::CSV->new({ sep_char => '|' , blank_is_undef => 1 , eol => "\n"});
my $file2 = $ARGV[1] or die "Need to get CSV file on the command line\n";

open ( my $fh,'>','/tmp/outputfile') or die "Could not open file $!\n";
open(my $data2, '<', $file2) or die "Could not open '$file' $!\n";
while (my $line = <$data2>) {
    chomp $line;

    if ($csv->parse($line)) {

        my @fields = $csv->fields();
        if (defined ($field[-4]) && looks_like_number($field[-4]))
        {
            $field[-4]=$hash{$field[-4]};
        }

        $csv->print($fh,\@fields); 
    } else {
        warn "Line could not be parsed: $line\n";
    }
}
close($data2);
close($fh);

person chidori    schedule 31.03.2014    source источник
comment
Ре. Парсинг Text::CSV кажется медленным. Вы уверены, что проблема связана с Text::CSV, а не с вашим кодом? (вы ничего не показали, поэтому я не могу сказать)   -  person ThisSuitIsBlackNot    schedule 31.03.2014
comment
Кроме того, если Text::CSV действительно является узким местом, установка Text:: CSV_XS должен повысить производительность. Если Text::CSV_XS установлен, use Text::CSV; будет автоматически использовать версию XS.   -  person ThisSuitIsBlackNot    schedule 31.03.2014
comment
Вам нужно распечатать любые уникальные значения из третьего столбца, но обновить столбец с четвертого по последний в любой строке, где он соответствует значению из первого столбца в первом файле? Или только обновлять строки, которые дают вам уникальное значение для третьего столбца?   -  person Etan Reisner    schedule 31.03.2014
comment
3-й столбец и 4-й из последнего столбца не зависят друг от друга. Мне нужно прочитать файл, но я должен выполнить две операции одновременно. Один выбирает уникальные строки из 3-го столбца и заменяет 4-й из последнего столбца   -  person chidori    schedule 31.03.2014
comment
@ThisSuitIsBlackNot обновил мой Perl-код, используя Text::CSV   -  person chidori    schedule 31.03.2014
comment
Обычно для чтения из файла с Text::CSV используется getline, а не parse: while (my $row = $csv->getline($fh)) { ... }. В этом случае $row является ссылкой на массив, поэтому вы можете получить доступ к первому полю с помощью $row->[0] и получить все поля с помощью @$row. Я не тестировал его, поэтому не уверен, будет ли это иметь существенное значение для скорости или нет.   -  person ThisSuitIsBlackNot    schedule 31.03.2014
comment
Если вы установите параметр auto_diag для метода new, ошибка будет отображаться автоматически, если строка не может быть проанализирована с помощью getline, поэтому вам не нужно добавлять кучу операторов or die ...: my $csv = Text::CSV->new({ sep_char => '|', auto_diag => 1 });   -  person ThisSuitIsBlackNot    schedule 31.03.2014
comment
Вы знаете, что определили два объекта $csv? С разными вариантами.   -  person TLP    schedule 31.03.2014
comment
Я провел приблизительный тест, и использование getline значительно быстрее, чем parse.   -  person ThisSuitIsBlackNot    schedule 31.03.2014


Ответы (3)


Используйте getline вместо parse, это намного быстрее. Ниже приведен более идиоматический способ выполнения этой задачи. Обратите внимание, что вы можете повторно использовать один и тот же объект Text::CSV для нескольких файлов.

#!/usr/bin/perl

use strict;
use warnings;
use 5.010;

use Text::CSV;

my $csv = Text::CSV->new({
    auto_diag      => 1,
    binary         => 1,
    blank_is_undef => 1,
    eol            => $/,
    sep_char       => '|'
}) or die "Can't use CSV: " . Text::CSV->error_diag;

open my $map_fh, '<', 'map.csv' or die "map.csv: $!";

my %mapping;
while (my $row = $csv->getline($map_fh)) {
    $mapping{ $row->[0] } = $row->[1];
}

close $map_fh;

open my $in_fh, '<', 'input.csv' or die "input.csv: $!";
open my $out_fh, '>', 'output.csv' or die "output.csv: $!";

my %seen;
while (my $row = $csv->getline($in_fh)) {
    $seen{ $row->[2] } = 1;

    my $key = $row->[-4];
    $row->[-4] = $mapping{$key} if defined $key and exists $mapping{$key};
    $csv->print($out_fh, $row);
}

close $in_fh;
close $out_fh;

say join ',', keys %seen;

map.csv

1|alpha|s3.3|4|6|7|8|9
2|beta|s3.3|4|6|7|8|9
20|charlie|s3.3|4|6|7|8|9
6|romeo|s3.3|4|6|7|8|9

input.csv

a1|a2|bob|a3|a4|a5|a6|a7|a8|1|a10|a11|a12
a1|a2|ray|a3|a4|a5|a6|a7|a8||a10|a11|a12
a1|a2|kate|a3|a4|a5|a6|a7|a8|20|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|6|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|45|a10|a11|a12

output.csv

a1|a2|bob|a3|a4|a5|a6|a7|a8|alpha|a10|a11|a12
a1|a2|ray|a3|a4|a5|a6|a7|a8||a10|a11|a12
a1|a2|kate|a3|a4|a5|a6|a7|a8|charlie|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|romeo|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|45|a10|a11|a12

СТАНДАРТНЫЙ ВЫВОД

kate,bob,ray
person ThisSuitIsBlackNot    schedule 31.03.2014
comment
Спасибо, я могу получить желаемый результат, но когда дело доходит до скорости, использование традиционного сплит-подхода кажется более быстрым. Использование модуля Text::CSV работает медленно, хотя он имеет больший контроль над CSV-файлом. - person chidori; 01.04.2014
comment
@chidori split будет быстрее, но если есть вероятность того, что поле может содержать разделитель (сейчас или когда-нибудь в будущем), Text::CSV - это то, что нужно. - person ThisSuitIsBlackNot; 01.04.2014

Вот вариант, который не использует Text::CSV:

use strict;
use warnings;

@ARGV == 3 or die 'Usage: perl firstFile secondFile outFile';

my ( %hash, %seen );
local $" = '|';

while (<>) {
    my ( $key, $val ) = split /\|/, $_, 3;
    $hash{$key} = $val;
    last if eof;
}

open my $outFH, '>', pop or die $!;

while (<>) {
    my @F = split /\|/;
    $seen{ $F[2] } = undef;
    $F[-4] = $hash{ $F[-4] } if exists $hash{ $F[-4] };
    print $outFH "@F";
}

close $outFH;

print 'unique string : ', join( ' ', reverse sort keys %seen ), "\n";

Использование командной строки: perl firstFile secondFile outFile

Содержимое outFile из ваших наборов данных (звездочки удалены):

a1|a2|bob|a3|a4|a5|a6|a7|a8|alpha|a10|a11|a12
a1|a2|ray|a3|a4|a5|a6|a7|a8||a10|a11|a12
a1|a2|kate|a3|a4|a5|a6|a7|a8|charlie|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|romeo|a10|a11|a12
a1|a2|bob|a3|a4|a5|a6|a7|a8|45|a10|a11|a12

СТАНДАРТНЫЙ ВЫВОД:

unique string : ray kate bob

Надеюсь это поможет!

person Kenosis    schedule 31.03.2014
comment
Спасибо, действительно помогает. - person chidori; 01.04.2014

person    schedule
comment
Спасибо, это хорошо, но мне нужно поместить в код Perl, если я обратная косая черта все символы $ все равно Perl жалуется ... не могли бы вы помочь мне поместить это в код Perl - person chidori; 01.04.2014
comment
@chidori Я бы не стал использовать awk внутри perl. perl достаточно мощный, чтобы сделать все это достаточно эффективно. Это было просто альтернативное решение. - person jaypal singh; 01.04.2014