Perl - проблема с разбиением столбцов в текстовом файле с разделителями табуляции и заменой столбцов новыми значениями

Question

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

COLUMN1:                                              
dip:DIP-41935N|refseq:NP_056092|uniprotkb:Q96PU5    

COLUMN2:    dip:DIP-48957N|uniprotkb:P49281

Я хочу, чтобы они просто содержали идентификационный номер в конце каждого столбца, поэтому я хочу, чтобы они были следующими:

COLUMN1:        Q96PU5          

COLUMN 2:       P49281

Я разделил строки на вкладке, чтобы получить отдельные столбцы. Затем разделите первые 2 столбца, чтобы получить требуемый идентификационный номер ($ prot_id). Затем я попытался подставить идентификатор для содержимого столбцов 1 и 2. Однако вывод в измененном файле не соответствует ожиданиям. Вместо этого это выглядит примерно так:

  COLUMN1:                                           
Q96PU5|refseq:NP_056092|uniprotkb:Q96PU5    

COLUMN 2:
P49281|uniprotkb:P49281

Только первая часть столбцов была заменена. Я играл с этим часами и не могу понять, что я делаю неправильно. Любая помощь с благодарностью. Мой код выглядит следующим образом:

#!/usr/bin/perl  

use warnings;
use strict;


my $file = 'DIP.txt';

open(INFILE, $file) or die "Can't open file: $!\n";
open(my $outfile, '>', 'DIP_changed.txt'); 
my @lines = <INFILE>;


foreach $_ (@lines) {
    my @columns = split('\t', $_);

            my $col1 = $columns[0];
            my $col2 = $columns[1];


            my @split_col1 = split ('uniprotkb:', $col1);
            my @split_col2 = split ('uniprotkb:', $col2);

            my $prot_id1 = $split_col1[length(@split_col1)];
            my $prot_id2 = $split_col2[length(@split_col2)];

            print $prot_id1, "\n";

             s/$col1/$prot_id1/;
             s/$col2/$prot_id2/;

            print {$outfile} $_; 
}



exit;

Answer 1

Уже есть несколько достойных ответов, но я бы хотел показать вам более простое решение. Этот скрипт вы бы использовали так:

$ script.pl DIP.txt > DIP_changed.txt

А сам скрипт действительно просто:

while (<>) {
    s/\S+uniprotkb:(\S+)/$1/;
    s/\S+uniprotkb:(\S+)/$1/;
    print;
}

Это не должно быть сложнее, чем это.

Answer 2

Ответ Рэтсбейна был довольно хорошим, но вы, вероятно, захотите узнать после нескольких часов работы , почему вы получили ответ, который сделали Причина в том, что в $ col1 была труба. Это «ИЛИ» в регулярном выражении. Поэтому, когда вы пытались заменить регулярное выражение $ col1, вы выполняли поиск и заменяли более

dip:DIP-41935N|refseq:NP_056092|uniprotkb:Q96PU5

Теперь, как регулярное выражение, чему оно соответствует? Это соответствует только

dip:DIP-41935N

так что - это то, что заменили!

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

Answer 3

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

use warnings;
use strict;


my $file = 'DIP.txt';

open my $in_fh, '<', $file or die $!;
open my $out_fh, '>', 'new' . $file or die $!;

while ( <$in_fh> ) {
    chomp;
    next unless length $_; # Skip blank lines.
    my ( @columns ) = split /\s+/, $_; # Split on whitespace (you may prefer \t).
    foreach my $column ( @columns ) {
        ( $column ) = $column =~ m{([^:]+)$};
    }
    local $" = "\t";
    print $out_fh "@columns\n";
}

Во-первых, используется версия с тремя аргументами open как для входного файла, так и для выходного файла. Это хорошая привычка. Далее он использует лексические файловые дескрипторы вместо старых файловых дескрипторов файлового глобуса. Лексикалы автоматически закрываются, когда они выходят из области видимости и не становятся частью глобальной таблицы символов.

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

Тогда я разделился на пустое место. Вы можете разделить на вкладки. Если в столбцах нет встроенных пробелов, то так или иначе работает. Затем я перебираю два столбца, сопоставляя и получая из каждого элемента в конце столбца, который не является двоеточием. Или другой способ выразить это, все, что следует за последним двоеточием. Я записываю результат обратно в переменную $ column, которая создает псевдоним соответствующего элемента в @columns. Таким образом, когда я закончу, @columns хранит только мои снимки.

Наконец, после обработки двух столбцов мы локализуем $ ", присваивая ему символ табуляции. Таким образом, когда мы печатаем два столбца, заключая @columns в кавычки, интерполяция автоматически вставляет символ табуляции между столбцами снова. Если вы предпочитаете другого персонажа, теперь вы знаете, где его поменять.

Затем цикл while переходит к следующей строке. Любые пустые строки будут пропущены.

см. Perldoc open, perlretut, perlvar и perlop для объяснения трех-аргументного открытия, а также лексических файловых дескрипторов, объяснения регулярных выражений, специальных переменных Perl, таких как $ ", и того, как работает квотная интерполяция.

Хороший вопрос!

Answer 4

Попробуйте что-то вроде этого:

Это аккуратная идиома Perl - сопоставьте строку с регулярным выражением, как это

$columns[0]=~/:((\w|\d)*)$/;

(обратите внимание, что в скобках указаны два атома) и присвойте результаты совпадений (независимо от 1-го, 2-го и т. Д. Атомов) массиву или набору скалярных переменных список массивов, например:

($columns[0]) = $columns[0]=~/:((\w|\d)*)$/;

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

#!/usr/bin/perl  

use warnings;
use strict;

my $file = 'DIP.txt';

open(INFILE, $file) or die "Can't open file: $!\n";
open(my $outfile, '>', 'DIP_changed.txt');


foreach my $line (<INFILE>) {
    print "The input line is $line\n";
    my @columns = split('\t', $line);

    ($columns[0]) = $columns[0]=~/:((\w|\d)*)$/;
    ($columns[1]) = $columns[1]=~/:((\w|\d)*)$/;

    printf  "The output line is  %s\n", join ',', @columns;
    printf  $outfile join ',', @columns;

    }