24小时热门版块排行榜

返回列表

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

淡蓝幽香

新虫 (初入文坛)

应助: 0 (幼儿园)
金币: 243.5
散金: 1
帖子: 24
在线: 16.8小时
虫号: 644125
注册: 2008-11-03
专业: 生物信息学

[交流] perl程序继续中，脸红贴上自写程序，求拍砖。已有2人参与

首先，大力感谢cdtits 同学在另外一个帖子提供的帮助，下面的程序有涉及部分。

本人有如下两个文件：
Doc1
1       NA1       0       0       1
1       NA2       0       0       2
1       295       NA1       NA2       2
1       NA5       0       0       1
1       4       NA5       295       1
1       36       NA6       100       2
1       NA6       0       0       1
1       155       NA6       100       2
1       NA7       4       36       2
2       NA8       0       0       1
2       NA10       0       0       1
2       NA11       0       0       2
2       99       NA8       NA9       2
2       8       NA10       NA11       1
2       390       8       99       1
3       NA12       0       0       1
3       NA13       0       0       2
3       753       NA12       NA13       2
3       NA14       0       0       1
3       9       NA14       753       1
3       NA15       0       0       1
3       NA16       0       0       2
3       186       NA14       753       2
3       722       NA15       NA16       1
3       397       722       186       1
3       396       722       186       1

Doc2
295       2908       2       0

186       2612       3       1

722       2827       1       0

753       8601       3       na

100       1881       na       na

4       6358       2       0

155       4627       2       0

99       2996       2       0

1．两个文件的关系：
Doc2中的每一行的第一列数字项，都分别对应Doc1每一行的第二，第三，或者第四列纯数字项。

2．文件特点描述：
所有文件的列之间，都用制表符分隔
Doc1，每一行的第一列都是数字；第二，三，四列可能是数字，也可能是NAi（i代表数字）的组合；第五列是数字或者na。
Doc2，每一行的第一列均为纯数字，最多不超过三位数；第二列也是纯数字，都是固定的四位数；第三列和第四列要么是个位数字，要么就是na。
3．目的：
      在Doc1的每一行第二，三，四列的纯数字项中，分别找到他们各自在Doc2对应数据。用Doc2的第二列数据去取代在Doc1 中的原始数据。要把Doc2 中得最后两项补到Doc1后面。其中这部分的补充决定权在与Doc1的第二列（见另部分例子）。
如：       doc1的第三行：1       295       NA1       NA2       2
      在doc2中对应的行是295       2908       2       0
      结果是：       1       2908       NA1       NA2       2       2（此处用4个制表符分隔）0
另：       doc1       1       4       NA5       295       1；doc2       4       6358       2       0
结果是：       1       6358       NA5       2908       1       2       0

很惭愧地贴上我写的程序，求帮助，求批评，求指正：另外，怎样修改程序，才能让它跑起来更快呢？
use strict;
use warnings;

my $outfile = "o.txt";
open (OUT, ">$outfile"

or die("cannot open file"

;

my $A = "A.txt";
open(IN, "<$a"

;

my $C = "C.txt";
open(C, "<$C"

;

my %code;
my $num = 0;

while (my $l =
{
            $l =~ s/^\s+//g;
         $l =~ s/\s+$//g;
         next if !length($l);
         my($key, $value) = split (/\t/,$l,2);
         $code{$key} = $value;
}

close C;

my $value;
while (my $line =
{
         $line  =~ s/^\s+//g;
         $line  =~ s/\s+$//g;
         next if !length($line);
         $line =~ /^\d+\t(\w+\d+|\d+)\t(\w+\d+|\d+)\t(\w+\d+|\d+)\t.+/g;
         my ($m1,$m2,$m3)=($1,$2,$3);

         for my $key (keys %code)
         {
                  if ($m1 =~ /^\d+$/ && $key == $m1 )
                  {
                        my ($v1,$v2) = split(/\t/,$code{$key},2);
                        $line =~ s/$m1/$v1/;
                        my ($d1,$d2) = (/\t/,$v2,2);
                        print OUT "$line\t$d1\t\t\t\t$d2\n";
                  }
                  elsif($m2 =~ /^\d+$/ && $key == $m2)
{
                        my ($v1,$v2) = split(/\t/,$code{$key},2);
                        $line =~ s/$m2/$v1/;
                        print OUT $line."\n";
                  }
                  elsif($m3 =~ /^\d+$/ && $key == $m3)
{
                        my ($v1,$v2) = split(/\t/,$code{$key},2);
                        $line =~ s/$m3/$v1/;
                        print OUT $line."\n";
                  }
#头大，写不下去了。。。。错误好多。。。。
         }
}
      close IN;
close OUT;

回复此楼

1楼2012-07-10 04:33:22

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

淡蓝幽香

新虫 (初入文坛)

应助: 0 (幼儿园)
金币: 243.5
散金: 1
帖子: 24
在线: 16.8小时
虫号: 644125
注册: 2008-11-03
专业: 生物信息学

引用回帖:

3楼: Originally posted by jackie1179 at 2012-07-10 10:42:40
给你写了个，希望能帮到你，另外你有一点说的不是很清楚，如果Doc1的第二列在Doc2中未匹配，而其他列有匹配，要在其后补充吗？本代码不进行补充。

#!/usr/bin/perl -w

unless (@ARGV) {
die "Argumen ...

非常感谢哦。

关于你提到的：Doc1的第二列在Doc2中未匹配，而其他列有匹配，要在其后补充吗？

这个不用补充，只有Doc1第一列，在找到Doc2中的匹配项后，需要补充。Doc1的其他列都不用

赞一下

回复此楼

5楼2012-07-10 19:49:53

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

相关版块跳转我要订阅楼主淡蓝幽香的主题更新

返回列表

24小时热门版块排行榜

淡蓝幽香

[交流] perl程序继续中，脸红贴上自写程序，求拍砖。已有2人参与

» 收录本帖的淘帖专辑推荐

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:

淡蓝幽香