- 论坛徽章:
- 307
|
本帖最后由 sunzhiguolu 于 2016-06-21 13:48 编辑
回复 42# little_joe
用这个处理一下你的实际文件, 应该没啥问题了.- #!/usr/bin/perl
- use strict;
- use warnings;
- sub collect_data{
- my (%ha, %hFilt, $id);
- open (my $fhA, '<', shift);
- while (defined (local $_ = <$fhA>)){
- if (/\A([a-z]\S+)/i){
- %hFilt = () if (!exists $ha{$1});
- $id = $1;
- next;
- }
- push (@{$ha{$id}}, $1) if (/\A\s*(\d+)/ and !$hFilt{$1}++);
- }
- close ($fhA);
- \%ha;
- }
- sub compare{
- my ($id, $rh, @aData) = (@_);
- my %hStat;
- foreach my $v (@{$rh->{$id}}){
- foreach my $V (grep {$v >= $_->[0] && $v <= $_->[2]} @aData){
- my ($cnt, $leng) = (0, $v - $V->[0] + 1);
- if ((local $_ = substr ($V->[1], 0, $leng)) =~ /-/){
- $cnt = s/-//g;
- $cnt += length ($1) if (substr ($V->[1], $leng - 2, 1) eq '-' and substr ($V->[1], $leng) =~ /\A(-+)/);
- }
- my @aChars = split (//, $V->[4]);
- next if ($aChars[$v - $V->[0] + $cnt] eq '-');
- $hStat{$aChars[$v - $V->[0] + $cnt]}++;
- }
- }
- if (%hStat){
- print "$id\t";
- print "$_:$hStat{$_}\t" for keys %hStat;
- print "\n";
- }
- }
- my $rha = collect_data (shift);
- open (my $fh, '<', shift);
- my ($Flag, $Offset, $ID, @aData) = 0;
- while (defined (local $_ = <$fh>)){
- next if (/\A\s*\z/ or !/\A(?:Query|Sbjct)/);
- if (/\AQuery=\h+(\S+)/){
- compare ($ID, $rha, splice (@aData)) if (@aData);
- exists ($rha->{$1}) ? do {($ID, $Flag, $Offset) = ($1, 1, -1)} : ($Flag = 0);
- next;
- }
- next if (!$Flag);
- if (/\A(Query|Sbjct)\h+(\d+)\h+(\H+)\h+(\d+)/){
- push (@{$aData[$1 eq "Query" ? ++$Offset : $Offset]}, $2, $3, $4);
- }
- }
- close ($fh);
- compare ($ID, $rha, splice (@aData)) if ($Flag);
复制代码 |
|