新手在线求助！比较两个文件符合条件的输出到第三个文件。

54red

刚接触perl
现在编写程序就会简单的
open（）
my %hash
while()
print
close

求高人指点一下面程序！！！先谢过！

问题是：

表1：
chr1        53662616        513
chr1        53662617        524
chr1        53662618        526
chr1        53662619        530
chr1        53662620        530
chr1        53662621        530
chr1        53662622        511
chr3        48895204        3550
chr3        48896063        598
chr3        48896633        1521
chr3        48897059        3438
chr3        48900091        4553

表2：
chr1        CPT2        53662616        53679267
chr2        ACADL        211053685        211089987
chr3        SLC25        48895143        48936227
chr3        ACAD9        128598535        128631450

输出：
chr1        CPT2         XXX   YYY  
chr2        ACADL        XXX YYY  
chr3        SLC25A20   XXX YYY       
chr3        ACAD9        XXX YYY
XXX：
统计表1中符合条件的个数
条件 ：表1的第一列和表2的第一列相同，并且表1的第二列在表2的3,4列区间里
YYY：
为符合上述条件的所有表1第三列的加和。

54red

自己顶一顶

54red

继续顶

104359176

学生物的弟兄们，Perl 还没让学毕业，就赶鸭子上架干活了，真是同情！

这个要用到这个特性：

1. Extracting a Range of Lines
   
2. #-----------------------------
   
3. while (<>) {
   
4.     if (/BEGIN PATTERN/ .. /END PATTERN/) {
   
5.         # line falls between BEGIN and END in the
   
6.         # text, inclusive.
   
7.     }
   
8. }
   
9. 
   
10. while (<>) {
    
11.     if ($FIRST_LINE_NUM .. $LAST_LINE_NUM) {
    
12.         # operate only between first and last line, inclusive.
    
13.     }
    
14. }
    
15. #-----------------------------
    
16. while (<>) {
    
17.     if (/BEGIN PATTERN/ ... /END PATTERN/) {
    
18.         # line is between BEGIN and END on different lines
    
19.     }
    
20. }
    
21. 
    
22. while (<>) {
    
23.     if ($FIRST_LINE_NUM ... $LAST_LINE_NUM) {
    
24.         # operate only between first and last line, but not same
    
25.     }
    
26. }
    
27. #-----------------------------
    
28. # command-line to print lines 15 through 17 inclusive (see below)
    
29. perl -ne 'print if 15 .. 17' datafile
    
30. 
    
31. # print out all <XMP> .. </XMP> displays from HTML doc
    
32. while (<>) {
    
33.     print if m#<XMP>#i .. m#</XMP>#i;
    
34. }
    
35.    
    
36. # same, but as shell command
    
37. # perl -ne 'print if m#<XMP>#i .. m#</XMP>#i' document.html
    
38. #-----------------------------
    
39. # perl -ne 'BEGIN { $top=3; $bottom=5 }  print if $top .. $bottom' /etc/passwd        # previous command FAILS
    
40. # perl -ne 'BEGIN { $top=3; $bottom=5 } \
    
41. #     print if $. == $top .. $. ==     $bottom' /etc/passwd    # works
    
42. # perl -ne 'print if 3 .. 5' /etc/passwd   # also works
    
43. #-----------------------------
    
44. print if /begin/ .. /end/;
    
45. print if /begin/ ... /end/;
    
46. #-----------------------------
    
47. while (<>) {
    
48.     $in_header =   1  .. /^$/;
    
49.     $in_body   = /^$/ .. eof();
    
50. }
    
51. #-----------------------------
    
52. %seen = ();
    
53. while (<>) {
    
54.     next unless /^From:?\s/i .. /^$/;
    
55.     while (/([^<>(),;\s]+\@[^<>(),;\s]+)/g) {
    
56.         print "$1\n" unless $seen{$1}++;
    
57.     }
    
58. }
    
59. #-----------------------------
    
60. 
    

复制代码

这是一个教程：
perlexample.chm (347.96 KB, 下载次数: 4)

2015-06-10 17:06 上传

点击文件名下载附件
perlsample

104359176

1. #!perl
   
2. 
   
3. use 5.016;
   
4. # 这个模块是为了把多个外置文本放在一个文件中
   
5. use Inline::Files;
   
6. use List::Util qw(reduce sum);
   
7. 
   
8. # 用内嵌文本是为了演示，实际中请使用外置文本
   
9. # my @table_one = read_file $file;
   
10. # 并加载 File::Slurp 模块
    
11. my $table_one = table_array(<TABLEONE>);
    
12. my $table_two = table_array(<TABLETWO>);
    
13. 
    
14. foreach my $line (@$table_two) {
    
15.   my $item = $line->[0];
    
16.   my $from = $line->[2];
    
17.   my $to = $line->[3];
    
18.   my ($xxx, $yyy) = filter_data($table_one, $item, $from, $to);
    
19.   say "$item $line->[1] $xxx $yyy";
    
20. }
    
21. 
    
22. sub filter_data {
    
23.   my ($data, $item, $from, $to) = @_;
    
24.   my @result;
    
25.   foreach my $line (@$data) {
    
26.     next unless $line->[0] eq $item;
    
27.     if ( +$line->[1] >= $from and +$line->[1] <= $to ) {
    
28.       # say $line->[2];
    
29.       push @result, $line->[2];
    
30.     }
    
31.   }
    
32.   my $xxx = scalar @result;
    
33.   # my $yyy = reduce { $a + $b } @result;
    
34.   my $yyy = sum @result;
    
35.   return ($xxx, $yyy);
    
36. }
    
37. 
    
38. sub table_array {
    
39.   my @table = @_;
    
40.   my @array;
    
41.   foreach my $line (@table) {
    
42.     next if $line =~ /^$/;
    
43.     push @array, [ split(/\s+/, $line) ];
    
44.   }
    
45.   return [ @array ];
    
46. }
    
47. 
    
48. __TABLEONE__
    
49. chr1        53662616        513
    
50. chr1        53662617        524
    
51. chr1        53662618        526
    
52. chr1        53662619        530
    
53. chr1        53662620        530
    
54. chr1        53662621        530
    
55. chr1        53662622        511
    
56. chr3        48895204        3550
    
57. chr3        48896063        598
    
58. chr3        48896633        1521
    
59. chr3        48897059        3438
    
60. chr3        48900091        4553
    
61. 
    
62. __TABLETWO__
    
63. chr1        CPT2        53662616        53679267
    
64. chr2        ACADL       211053685       211089987
    
65. chr3        SLC25       48895143        48936227
    
66. chr3        ACAD9       128598535       128631450
    

复制代码

output:

1. chr1 CPT2 7 3664
   
2. chr2 ACADL 0
   
3. chr3 SLC25 5 13660
   
4. chr3 ACAD9 0

复制代码

54red

真不知道如何感谢你了， ！刚用了几天perl,确实很好用，可惜我写的太烂了，只能边做边学了，再次谢谢啦！回复 5# 104359176


   

sunzhiguolu

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. my (%hStat, %hData);
   
6. while (<>){
   
7.     my @aList = split;
   
8.     my $id = splice (@aList, 0, 1);
   
9.     if (@ARGV){
   
10.         push (@{$hStat{$id}}, [@aList]);
    
11.         @{$hData{$id}{$aList[0]}}{"Cnt", "Sum"} = (0) x 2;
    
12.         next;
    
13.     }
    
14.     my $ra = $hStat{$id};
    
15.     next unless ($ra);
    
16.     for (@$ra){
    
17.         if ($_->[1] <= $aList[0] and $_->[-1] >= $aList[0]){
    
18.             $hData{$id}{$_->[0]}{"Cnt"}++;
    
19.             $hData{$id}{$_->[0]}{"Sum"} += $aList[-1];
    
20.         }
    
21.     }
    
22. }
    
23. 
    
24. foreach my $id (sort keys %hData){
    
25.     print join ("\t", $id, $_, @{$hData{$id}{$_}}{"Cnt", "Sum"}), "\n" for keys %{$hData{$id}};
    
26. }

复制代码

perl abc.pl b a
--------------------------------------------------------
chr1    CPT2    7       3664
chr2    ACADL   0       0
chr3    SLC25   5       13660
chr3    ACAD9   0       0

华小飞_Perl

问一下，不是太明白，每条统计的都是针对同一条染色体而言的吗？