求助：perl hash中多元键和值的问题

小猪Gina

回复 9# kk861123
嗯，代码确实很简单，而且也比较好用。不过出了点小问题，比如文件：
a1           +               1           3
a1           +               6           8
a1           -               2           4
a1           -               5           6
a1           -               3           5
a1           -               7           8
a2           +               3           7
a2           -               1           5
a2           +               4           6
a2           -               7           9
a1           +               4           5
a1           +               2           5
期望结果：
a1 + 1 3 2 5 4 5 6 8
a1 - 2 4 3 5 5 6 7 8
a2 + 3 7 4 6
a2 - 1 5 7 9

您的运行结果：
a1        +        1        2        3        4        5        5        6        8
a1        -        2        3        4        5        5        6        7        8
a2        +        3        4        6        7
a2        -        1        5        7        9

另外还有个小问题，就如上面我们看到的结果中
a1 + 1 3 2 5 4 5 6 8
a1 - 2 4 3 5 5 6 7 8
a2 + 3 7 4 6
a2 - 1 5 7 9
它就是有重叠的部分，怎样将它们合并到一起，期望得到：
a1 + 1 5 6 8
a1 - 2 6 7 8
a2 + 3 7
a2 - 1 5 7 9

就像许多小线段，有重叠部分的就组合到一起，相当于数学中的求AUB吧。
谢谢您~


   

小猪Gina

     额。。

小猪Gina

回复 10# mcshell
那个。。。您代码对我而言有点深奥，可以稍加注释么？麻烦您了。。谢谢~


   

小猪Gina

回复 10# mcshell
您的运行结果和九楼是一样的，没有得到期待结果。。。


   

mcshell

回复 14# 小猪Gina
那更简单一些。。。。

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use Data::Dumper;
   
5. my %hash;
   
6. my $title;
   
7. while(<DATA>){
   
8.     if(/(\w+\s+(?:\+|-))\s+(\d+\s+\d+)/){
   
9.         push @{$hash{$1}},$2;
   
10.     }else{
    
11.         $title = $_;
    
12.     }
    
13. }
    
14. map{print "$_\t";print join("\t",sort{$a cmp $b}@{$hash{$_}});print "\n"}sort keys %hash;
    
15. 
    
16. __DATA__
    
17. a1           +               1           3
    
18. a1           +               6           8
    
19. a1           -               2           4
    
20. a1           -               5           6
    
21. a1           -               3           5
    
22. a1           -               7           8
    
23. a2           +               3           7
    
24. a2           -               1           5
    
25. a2           +               4           6
    
26. a2           -               7           9
    
27. a1           +               4           5
    
28. a1           +               2           5
    

复制代码

小猪Gina

回复 15# mcshell
厉害~
得出了
a1 + 1 3 2 5 4 5 6 8
a1 - 2 4 3 5 5 6 7 8
a2 + 3 7 4 6
a2 - 1 5 7 9
这个结果，那下一步怎么把它们连在一起呢？
您的代码我还在看，努力弄懂中~谢谢您了~

   

小猪Gina

my %hash=();
my @arrays = <IN>;
my @lie = sort {(split /\s+/,$a)[2] <=> (split /\s+/,$b)[2] }@arrays;

for (my $i=0;$i<=$#lie;$i++) {
        my @line=split(/\s+/,$lie[$i]);
        my($name,$direction,$start,$end)=("$line[0]","$line[1]","$line[2]","$line[3]");
        if (defined($hash{$name}{$direction})) {
                my @tmp=(@{$hash{$name}{$direction}},$start,$end);
                $hash{$name}{$direction}=\@tmp;
        }else{
                $hash{$name}{$direction}=[$start,$end];
        }   
}

foreach my $n (sort keys %hash) {
        foreach my $d (sort keys %{$hash{$n}} ) {
                for (my $j=0; $j<=$#{$hash{$n}{$d}}-2; $j=$j+2) {
                        if (${$hash{$n}{$d}}[$j+1]>=${$hash{$n}{$d}}[$j+2]) {
                                ${$hash{$n}{$d}}[$j+1]<=${$hash{$n}{$d}}[$j+3] ? (delete ${$hash{$n}{$d}}[$j+1] and delete ${$hash{$n}{$d}}[$j+2]) : (delete ${$hash{$n}{$d}}[$j+2] and delete ${$hash{$n}{$d}}[$j+3]);
                        }
                }
                print "$n $d @{$hash{$n}{$d}}\n";
        }
}
这个代码可以得到正确结果，可是有问题，就是运行到删掉的元素那个位置时会报错。。。。

小猪Gina

谢谢另一个大侠的帮助，已经解决了，代码如下：
my %hash=();
my @arrays = <IN>;
my @lie = sort {(split /\s+/,$a)[2] <=> (split /\s+/,$b)[2] }@arrays;

for (my $i=0;$i<=$#lie;$i++) {
        my @line=split(/\s+/,$lie[$i]);
        my($name,$direction,$start,$end)=("$line[0]","$line[1]","$line[2]","$line[3]";
        if (defined($hash{$name}{$direction})) {
                my @tmp=(@{$hash{$name}{$direction}},$start,$end);
                $hash{$name}{$direction}=\@tmp;
        }else{
                $hash{$name}{$direction}=[$start,$end];
        }   
}

foreach my $n (sort keys %hash) {
        foreach my $d (sort keys %{$hash{$n}} ) {
                for (my $j=$#{$hash{$n}{$d}}; $j>=3; $j=$j-2) {
                        if (${$hash{$n}{$d}}[$j-1]<=${$hash{$n}{$d}}[$j-2]) {
                                ${$hash{$n}{$d}}[$j]<=${$hash{$n}{$d}}[$j-2] ? (splice(@{$hash{$n}{$d}},$j,1) and splice(@{$hash{$n}{$d}},$j-1,1))splice(@{$hash{$n}{$d}},$j-1,1) and splice(@{$hash{$n}{$d}},$j-2,1));
                        }
                }
                print "$n $d @{$hash{$n}{$d}}\n";
        }
}
貌似太过臃肿，希望有大侠能帮我简化一下，感激~

yinyuemi

回复 16# 小猪Gina

1. #!/user/bin/env perl
   
2. use strict;
   
3. my %hash;
   
4. map{
   
5.         my @data = split /\s+/,$_;
   
6.         push @{$hash{join "\t",@data[0,1]}},[@data[2,3]]
   
7. }<DATA>;
   
8. 
   
9. foreach my $key (sort keys %hash){
   
10.         my @output=();
    
11.         map{
    
12.                 my ($start,$end) = @{$_};
    
13.                 @output = ($start,$end) if ! @output;
    
14.                 $output[-1] < $start ? push(@output,($start,$end)) :
    
15.                         $output[-1] < $end ? $output[-1] =  $end : "" ;
    
16.                 $output[0] > $end ? splice(@output,0,0,($start,$end)) :       
    
17.                         $output[0] > $start ? $output[0] = $start : "";
    
18.         }sort{$a->[0] <=> $b->[0]}@{$hash{$key}};
    
19.         print $key,"\t","@output";
    
20.         print "\n";
    
21. }
    
22. __DATA__
    
23. a1           +               1           3
    
24. a1           +               6           8
    
25. a1           -               2           4
    
26. a1           -               5           6
    
27. a1           -               3           5
    
28. a1           -               7           8
    
29. a2           +               3           7
    
30. a2           -               1           5
    
31. a2           +               4           6
    
32. a2           -               7           9
    
33. a1           +               4           5
    
34. a1           +               2           5
    

复制代码

1. a1 +    1 5 6 8
   
2. a1 -    2 6 7 8
   
3. a2 +    3 7
   
4. a2 -    1 5 7 9

复制代码

rubyish

简化一下:

1. #!/usr/bin/perl -l
   
2. my %h;
   
3. /(\w+)\s+([+-])\s+(.*)/ and push @{$h{"$1 $2"}}, map [split],
   
4.         $3 =~ /(\d+\s+\d+)/g while <DATA>;
   
5. for my $k ( sort keys %h ) {
   
6.     my ( @a, @t );
   
7.     @t && $t[1] >= $_->[0]
   
8.       ? do { $t[1] = $t[1] > $_->[1] ? $t[1] : $_->[1] }
   
9.       : do { push @a, [@t]; @t = @$_ }
   
10.       for sort { $a->[0] <=> $b->[0] } @{$h{$k}};
    
11.     print join ' ', $k, map @$_, @a, [@t];
    
12. }
    
13. __DATA__
    
14. a1           +               1           3
    
15. a1           +               6           8
    
16. a1           -               2           4
    
17. a1           -               5           6
    
18. a1           -               3           5
    
19. a1           -               7           8
    
20. a2           +               3           7
    
21. a2           -               1           5
    
22. a2           +               4           6
    
23. a2           -               7           9
    
24. a1           +               4           5
    
25. a1           +               2           5

复制代码