perl - 在 perl 中使用指向文件中行的指针

Question

我正在尝试在 perl 中使用某种指针，以便我可以查看按字母顺序排序的两个文件中的两个，并匹配两个文件中的内容(如果它们在第一列中具有相同的名称)。我搜索每个文件的方式是查看第一列中哪些行按字母顺序排列较低，然后将该文件上的指针移动到下一行。有点类似于归并排序中的指针。下面的代码是我想要的示例。

使用这两个文件。

设置1

 apple  17  20
 boombox  23  29
 carl  25  29
 cat  22  33
 dog  27  44

设置2

 ants  yes
 boombox  no
 carl  yes
 dentist  yes
 dice  no
 dog  no

我可以制作一个执行类似操作的脚本

($name, $affirmation) = first line in set2; #part I'm confused about I just kind of need some sort of command of something that will do this
while (<>){
        @set1 = split;
        while ($name < set1[0]){
             ($name, $affirmation) = next line in set2;  # part i'm confused about I just kind of need some sort of command of something that will do this
        }
        if ($name = $set[0]{
               print @set1, $affirmation;
        }

这就是我运行它的方式

./script.txt set1

我最终会得到

boombox  23  29  no
carl  25  29  yes
dog  27  44  no

.

.

编辑:

我在一些答案中尝试了一些代码，看看是否可以从中生成一些功能代码，但我似乎遇到了问题，并且答案中的一些语法我无法理解，所以我有弄清楚如何调试或解决这个问题很麻烦。

这是我使用以下两个文本文件的具体示例

文本.txt

Apples 0       -1      -1      0       0       0       0       -1 
Apricots 0       1      1      0       0       0       0       1
Fruit        0       -1      -1      0       0       0       0       -1
Grapes        0       -2      -1      0       0       0       0       -2
Oranges   0       1      1      0       0       0       0       -1
Peaches  0       -2      -1      0       0       0       0       -2

text2.txt

Apples      CHR1    +       1167628 1170420 1       1       N
Apricots      CHR1    -       2115898 2144159 1       1       N
Oranges       CHR1    -       19665266        19812066        1       1      N
Noidberry     CHR1    -       1337728 1329993 1       1       N
Peaches       CHR1    -       1337275 1342693 1       1       N

还有这个脚本脚本.pl

#!/usr/bin/perl
use warnings;
my $file_1 = $ARGV[0];
my $file_2 = $ARGV[1];

open my $fh1, '<', $file_1 or die "Can't open $file_1: $!";
open my $fh2, '<', $file_2 or die "Can't open $file_2: $!";

open(my $single, '>', 'text.txt');
open(my $deep, '>', 'text2.txt');
OUTER: while (my $outer = <$fh1>){
        chomp $outer;
        @CopyNumber = split(' ', $outer);
        ($title, $title2) = split('\|', $CopyNumber[0]);
        #print 'title: ',$title,' title2: ',$title2,"\n";
        my $numLoss = 0;
        my $deepLoss = 0;
        for ($i = 1; $i <= $#CopyNumber; $i++){
                #print "$CopyNumber[$i], $#CopyNumber, $i, \n";
                if ($CopyNumber[$i] < 0){
                        $numLoss = $numLoss + 1;
                        if ($CopyNumber[$i] <-1){
                                $deepLoss = $deepLoss + 1;
                        }
                }
        }
        if ($GeneSym and (($GeneSym cmp $title)==0)){ #or (($GeneSym cmp $title2)==0))){
                print $single $Chrom,"\t",$Start,"\t",$Stop,"\t",$numLoss/$#CopyNumber,"\n";
                print $deep $Chrom,"\t",$Start,"\t",$Stop,"\t",$deepLoss/$#CopyNumber,"\n";
                next OUTER;
        }

        INNER: while (my $inner = <$fh2>){
                ($GeneSym, $Chrom, $Strand, $Start, $Stop, $MapId, $TotalMap, $AbnormalMerge, $Overlap) = split(' ', $inner);
                $Chrom =~ s/CHR/hs/ee;
                my $cmp = ($GeneSym cmp $title);
                next OUTER if $cmp < 0;
                if ($cmp==0){ #or (($GeneSym cmp $title2)==0)){
                        print $single $Chrom,"\t",$Start,"\t",$Stop,"\t",$numLoss/$#CopyNumber,"\n";
                        print $deep $Chrom,"\t",$Start,"\t",$Stop,"\t",$deepLoss/$#CopyNumber,"\n";
                        next OUTER;
                }
        }
}

如果我运行 ./script.pl text.txt text2.txt 我应该将其打印到 Number.txt

//对应text2.txt的第2,4,5列，最后一列为数字小于0的列的百分比

hs1     1167628     1170420    0.375 //For Apples
hs1     2115898     2144159    0 //For Apricots
hs1     19665266    19812066   0.125 //For Oranges
hs1     1337275     1342693    0.375 //For Peaches

相反，我得到了这个

hs1     1167628 1170420 0.375
hs1     2115898 2144159 0
hs1     1337275 1342693 0.375

所以我只是收到一个错误

hs1     19665266    19812066   0.125 //For Oranges

未打印

Answer 1

正如您所说，使用:使用cmp进行比较，将行分成两个术语。

对于FILE1文件的每一行，遍历FILE2文件的行，当找到匹配时退出。一旦 FILE2 超出按字母顺序移动到 FILE1 的下一行。

use warnings 'all';
use strict;

sub process {
   my ($name, $affirm_1, $affirm_2) = @_;
   print "$name $affirm_1 $affirm_2\n";
}

my $file_1 = 'set1.txt';
my $file_2 = 'set2.txt';

open my $fh1, '<', $file_1 or die "Can't open $file_1: $!";
open my $fh2, '<', $file_2 or die "Can't open $file_2: $!";

my ($name_2, $affirm_2);
FILE1: while (my $line1 = <$fh1>) {
    chomp $line1;
    my ($name_1, $affirm_1) = split ' ', $line1, 2;

    if ($name_2) {
        my $cmp = $name_1 cmp $name_2;
        next FILE1 if $cmp < 0;
        if ($cmp == 0) {
            process($name_1, $affirm_1, $affirm_2);
            next FILE1;
        }
    }

    FILE2: while (my $line2 = <$fh2>) {
        chomp $line2;
        ($name_2, $affirm_2) = split ' ', $line2, 2;
        my $cmp = $name_1 cmp $name_2;
        next FILE1 if $cmp < 0;
        if ($cmp == 0) {
            process($name_1, $affirm_1, $affirm_2);
            next FILE1;
        }
    }
}

对一些剩余细节的评论。

一旦 FILE2 行“超出”，在 FILE1 的下一次迭代中，我们需要先检查该行，然后再输入 FILE2循环以迭代其剩余行。对于第一个 FILE1 行，$name_2 仍然是 undef，因此 if ($name_2)。

---

已更新已编辑的帖子。

use warnings 'all';
use strict;

sub process_line {
    my ($single, $deep, $rline, $GeneSym, $Chrom, $Start, $Stop) = @_;
    my ($numLoss, $deepLoss) = calc_loss($rline);
    $Chrom =~ s/CHR/hs/;
    print $single (join "\t", $Chrom, $Start, $Stop, $numLoss/$#$rline), "\n";
    print $deep   (join "\t", $Chrom, $Start, $Stop, $deepLoss/$#$rline), "\n";
}

sub calc_loss {
    my ($rline) = @_; 
    my ($numLoss, $deepLoss) = (0, 0); 
    for my $i (1.. $#$rline) {
        $numLoss  += 1  if $rline->[$i] < 0;
        $deepLoss += 1  if $rline->[$i] < -1; 
    }   
    return $numLoss, $deepLoss;
}

my ($Number,  $NumberDeep) = ('Number.txt', 'NumberDeep.txt');
open my $single, '>', $Number      or die "Can't open $Number: $!";
open my $deep,   '>', $NumberDeep  or die "Can't open $NumberDeep: $!";

my ($file_1, $file_2) = ('set1_new.txt', 'set2_new.txt');    
open my $fh1, '<', $file_1 or die "Can't open $file_1: $!";
open my $fh2, '<', $file_2 or die "Can't open $file_2: $!";

my ($GeneSym, $Chrom, $Strand, $Start, $Stop, 
    $MapId, $TotalMap, $AbnormalMerge, $Overlap);

FILE1: while (my $line1 = <$fh1>) {
    next if $line1 =~ /^\s*$/;
    chomp $line1;

    my @line = split ' ', $line1;

    if ($GeneSym) {
        my $cmp = $line[0] cmp $GeneSym;
        next FILE1 if $cmp < 0;
        if ($cmp == 0) {
            process_line($single, $deep, \@line,
                         $GeneSym, $Chrom, $Start, $Stop);
            next FILE1;
        }   
    }   

    FILE2: while (<$fh2>) {
        next if /^\s*$/;
        chomp;
        ($GeneSym, $Chrom, $Strand, $Start, $Stop, 
             $MapId, $TotalMap, $AbnormalMerge, $Overlap) = split;
        my $cmp = $line[0] cmp $GeneSym;
        next FILE1 if $cmp < 0;
        if ($cmp == 0) {
            process_line($single, $deep, \@line,
                         $GeneSym, $Chrom, $Start, $Stop);
            next FILE1;
        }
    }
}

这会使用给定的示例文件生成所需的输出。采用了一些捷径，请告诉我评论是否有帮助。这里有一些

• 应该添加很多错误检查。

• 我假设按原样使用 FILE1 的第一个字段。否则需要进行更改。

• 处理分为两个函数，计算是分开的。这是没有必要的。

• $#$rline 是 $rline arrayref 最后一个元素的索引。如果语法太多，难以忍受，请使用 @$rline - 1，例如 (0..@$rline-1)

对问题中发布的代码的一些评论:

• 始终，始终，请使用警告；(并使用严格；)

• 索引上的循环最好这样写foreach my $i (0..$#array)

• 正则表达式修饰符 /ee 非常复杂。这里完全没有必要。