perl 根据其他列反转列的顺序

jucafojl  于 2023-06-23  发布在  Perl
关注(0)|答案(3)|浏览(192)

我试图操作一个大约有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中。
1.坐第二排。
1.如果列1和2具有与前一行相同的值,并且列5具有“-”符号,则按下arrayA中的第二行,否则打印具有反向列3的整个arrayA。
以下是我到目前为止所尝试的:

#!/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;
    }
}

它给出了与输入文件相同的结果。你能帮我把这段代码写出来吗?

ukxgm1gy

ukxgm1gy1#

在每个脚本的顶部始终包含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
t30tvxxf

t30tvxxf2#

我无法理解您的描述和代码,但从您的数据示例中,我认为这是您想要的。
基本上,复制每行中的第三个字段以形成新的第五个字段。然后,在第一个和第二个字段匹配且第四个字段是连字符-的每个行序列中,新的第五列的行顺序被颠倒。

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;
h7appiyu

h7appiyu3#

-创建行缓冲区。

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  +

相关问题