- 论坛徽章:
- 7
|
biru:- #!/usr/bin/perl
- my @files = qw/file1 file2/; # for output
- my ( @I, @data, %data ) = ( [ 0, 1 ], [ 2, 3 ] );
- while (<DATA>) {
- my ( $A, $B, @C ) = ( /^(\w+)/, (split)[ 3, 4, 5 ] );
- push @data, $A if !@data || ( $data[-1] ne $A );
- push @{ $data{$A}{$B} }, [@C];
- }
- my @F = map { open my $f, '>', $_; $f } @files;
- for my $i (@data) {
- for my $j ( keys %{ $data{$i} } ) {
- my @a = sort { $a->[0] <=> $b->[0] } @{ $data{$i}{$j} };
- my @b = shift @a;
- $_->[0] > $b[-1][1] ? push @b, $_ : push @{$b[-1]}, @$_ for @a;
- @b = map {
- [ ( sort { $a <=> $b } @$_ )[ 0, -1, $#$_ / 2, @$_ / 2 ] ]
- } @b[ @b >= 2 ? ( 0, -1 ) : 0 ];
- my @result = @b > 1
- ? map { @_ = @$_; join '_', map { join '-', @{$_}[@_] } @b } @I
- : map { join "\t", @{ $b[0] }[ @$_ ] } @I;
- print { $F[$_] } "$i\t$j\t$result[$_]\n" for 0 .. 1;
- }
- }
- __DATA__
- a.1 1 3 1_b 2 8
- a.2 2 5 1_b 5 9
- a.3 3 6 1_b 4 7
- a.4 2 4 1_b 12 15
- c.1 3 8 1_d 1 7
- c.2 4 8 1_d 6 8
复制代码 |
|