根据其他列反转列的顺序

时间:2014-05-22 15:33:59

标签: perl

我正在尝试操作一个大约有100万行的文件。以下是我的示例输入 -

chr1  GeneA  E1  -
chr1  GeneA  E2  -
chr1  GeneA  E3  -
chr1  GeneB  E1  +
chr1  GeneB  E2  +
chr1  GeneB  E3  +
chr1  GeneB  E4  +
chr1  GeneC  E1  -
chr1  GeneC  E2  -
chr2  GeneD  E1  +

如果第4列有“ - ”符号并且行具有相同的第1列和第2列值,我想颠倒第3列的顺序。示例输出 -

chr1  GeneA  E1  -  E3
chr1  GeneA  E2  -  E2
chr1  GeneA  E3  -  E1
chr1  GeneB  E1  +  E1
chr1  GeneB  E2  +  E2
chr1  GeneB  E3  +  E3
chr1  GeneB  E4  +  E4
chr1  GeneC  E1  -  E2
chr1  GeneC  E2  -  E1
chr2  GeneD  E1  +  E1

我正在尝试编写以下步骤 -

  1. 获取第一行并存储在arrayA中。

  2. 选择第二行。

  3. 如果第1列和第2列的值与上一行相同,第5列有“ - ”符号,则在arrayA中按第二行,否则使用反向第3列打印整个arrayA。

  4. 这是我到目前为止所尝试的内容 -

    #!/usr/bin/perl
    open my $first, '<',$ARGV[0] or die "Unable to open input file: $!";
    my @previous=split(/\t/,<$first>);
    
    while (<$first>) {
    
        my @current=split /\t/;
    
        if ($current[1] eq $previous[1] && $current[0] eq $previous[0] && $current[3] eq "-"){
    
            push @previous,[@current];
        }
        else{
            foreach (@previous) {
                print "$_","\t",reverse $previous[0][2];
            }
    
            @previous=@current;
    
        }
    }
    

    它与输入文件相同。你能帮忙使这段代码有效吗?

3 个答案:

答案 0 :(得分:2)

我无法正确理解您的描述和代码,但从您的数据示例中我认为这就是您想要的。

基本上,每行中的第三个字段被复制以形成新的第五个字段。然后,在第一个和第二个字段匹配的每个行序列中,第四个是连字符-,新第五个列的行顺序颠倒过来。

use strict;
use warnings;
use autodie;

open my $fh, '<', 'myfile.txt';

my @block;
my $block_key;

while (<$fh>) {
  next unless /\S/;
  chomp;

  my @row = split /\t/;
  push @row, $row[2];
  my $key = join "\t", @row[0,1,3];

  if ($block_key and $block_key ne $key) {
    print_block(\@block);
    @block = ();
    $block_key = undef;
  }

  push @block, \@row;
  $block_key = $key;
  print_block(\@block) if eof;
}

close $fh;


sub print_block {
  my ($block) = @_;
  if ($block->[0][3] eq '-') {
    $block->[$_][4] = $block->[$#block - $_][4] for 0 .. $#block;
  }
  print join("\t", @$_), "\n" for @block;
}

<强>输出

chr1  GeneA E1  - E3
chr1  GeneA E2  - E2
chr1  GeneA E3  - E1
chr1  GeneB E1  + E1
chr1  GeneB E2  + E2
chr1  GeneB E3  + E3
chr1  GeneB E4  + E4
chr1  GeneC E1  - E2
chr1  GeneC E2  - E1
chr2  GeneD E1  + E1

<强>更新

这是另一个不使用子程序的解决方案。我不确定我是否喜欢它,但你可以自己做出选择。输出与第一个程序的输出相同。

use strict;
use warnings;
use autodie;

open my $fh, '<', 'myfile.txt';

my @block;

while () {

  my $line = <$fh>;
  my @curr;
  if (defined $line) {
    chomp $line;
    @curr = split /\t/, $line;
    push @curr, $curr[2];
  }

  if (@block) {
    if (eof or $curr[0] eq $block[-1][0] and $curr[1] eq $block[-1][1]) {
      if ($block[0][3] eq '-') {
        $block[$_][4] = $block[$#block - $_][4] for 0 .. $#block;
      }
      print join("\t", @$_), "\n" for @block;
      @block = ();
    }
  }

  last if eof;

  push @block, \@curr;
}

close $fh;

答案 1 :(得分:2)

始终在每个脚本的顶部加入use strict;use warnings;

要执行此项目,只需在前两个字段中看到更改后,就需要保留行缓冲区以便稍后处理。这是一个相当常见的编程结构,尤其是当您处理需要以某种方式分组和处理的数据时:

use strict;
use warnings;

my @buffer;

while (<DATA>) {
    chomp;
    my @data = split ' ';
    if (@buffer && ($data[0] ne $buffer[0][0] || $data[1] ne $buffer[0][1])) {
        process_buffer(@buffer);
        @buffer = ();
    }

    push @buffer, [@data, $_];
}

process_buffer(@buffer);

sub process_buffer {
    my @buffer = @_;
    my @col3 = map $_->[2], @buffer;
    @col3 = reverse @col3 if $buffer[0][3] eq '-';
    for my $i (0..$#buffer) {
        print $buffer[$i][-1], "  ", $col3[$i], "\n";
    }
}

__DATA__
chr1  GeneA  E1  -
chr1  GeneA  E2  -
chr1  GeneA  E3  -
chr1  GeneB  E1  +
chr1  GeneB  E2  +
chr1  GeneB  E3  +
chr1  GeneB  E4  +
chr1  GeneC  E1  -
chr1  GeneC  E2  -
chr2  GeneD  E1  +

输出:

chr1  GeneA  E1  -  E3
chr1  GeneA  E2  -  E2
chr1  GeneA  E3  -  E1
chr1  GeneB  E1  +  E1
chr1  GeneB  E2  +  E2
chr1  GeneB  E3  +  E3
chr1  GeneB  E4  +  E4
chr1  GeneC  E1  -  E2
chr1  GeneC  E2  -  E1
chr2  GeneD  E1  +  E1

答案 2 :(得分:1)

使用-创建行缓冲区。

use warnings;
use strict;

my @buf;
while (<DATA>) {
    chomp;
    my @cols = split;
    if ($cols[3] eq '-') {
        push @buf, $_;
    }
    else {
        if (@buf) {
            my @lasts = reverse map { (split)[2] } @buf;
            my $i = 0;
            for my $line (@buf) {
                my @tokens = split /\s+/, $line;
                print join "\t", @tokens, $lasts[$i], "\n";
                $i++;
            }
            @buf = ();
        }
        print join "\t", @cols, $cols[2], "\n";
    }
}

__DATA__
chr1  GeneA  E1  -
chr1  GeneA  E2  -
chr1  GeneA  E3  -
chr1  GeneB  E1  +
chr1  GeneB  E2  +
chr1  GeneB  E3  +
chr1  GeneB  E4  +
chr1  GeneC  E1  -
chr1  GeneC  E2  -
chr2  GeneD  E1  +