找出所有组合

xiumu2280

  不行啊····
你可以删去试试··回复 10# pony2001mx


   

pony2001mx

xiumu2280，谢谢回复，确实是不行的。

我最后再问您三个小问题，
1）关于$ori = dclone($ori_o)语句，我觉得all_result($ori, $data)反复循环不会执行下面的$ori = dclone($ori_o)语句的。当然我的理解肯定不对，请您简单告诉我为什么不循环执行all_result($ori, $data)了。

2）my $e_l = join "",@{$ori_o->[-1]}可以写成my $e_l = join "",@{$ori_o->[2]}吧？

3）36行的return可以省略吗？

非常谢谢！！

ntwarren

回复 1# pony2001mx
试下这个吧：

open DATA,"<","yourfile";

my @data =map {chomp;[split /\s+|-/,$_]}<DATA>;

for my $row (@data){
    if($row->[1] == 1){
        push @arr, $row;
        recursive_get($row,1);
        pop @arr;
    }
}

sub show_result {
    print $arr[0]->[0]," ";
    for(@arr){
        print $_->[1],"-",$_->[2],",";
    }
    print " ";
    for(@arr){
        print $_->[3];
    }
    print "\n";
}

sub recursive_get{
    my $parentrow = shift;
    my $level= shift;

    if($parentrow->[2] == 100){
        show_result;
        return 0;
    }
    for (my $i = 0; $i< @data;$i++){
        if(($data[$i]->[0] eq $parentrow->[0]) && ($data[$i]->[1] == ($parentrow->[2] + 1))){
            push @arr, $data[$i];
  
            recursive_get($data[$i],$level+1);

            pop @arr;
        }
    }
}







   

ntwarren

回复 1# pony2001mx

用这个会简洁一些：
open DATA,"<","yourfile";

my @data =map {chomp;[split /\s+|-/,$_]}<DATA>;

for my $row (@data){
    if($row->[1] == 1){
        push @arr, $row;
        recursive_get($row,1);
        pop @arr;
    }
}

sub show_result {
    print $arr[0]->[0]," ";
    for(@arr){
        print $_->[1],"-",$_->[2],",";
    }
    print " ";
    for(@arr){
        print $_->[3];
    }
    print "\n";
}

sub recursive_get{
    my $parentrow = shift;
    my $level= shift;

    if($parentrow->[2] == 100){
        show_result;
        return 0;
    }
    for my $row (@data){
        if(($row->[0] eq $parentrow->[0]) && ($row->[1] == ($parentrow->[2] + 1))){
            push @arr, $row;
            recursive_get($row,$level+1);
            pop @arr;
        }
    }
}





   

xiumu2280

你可以看ntwarren的代码，意思一样  但是数据结构上简单多了

1.最终所有的all_result()都会有一个返回的结果。其实是每次all_result()全部深层执行完，再运行的$ori = dclone($ori_o)。因为每次的$ori_o都是下一组符合标准的元素，所以并不会不停的执行下去。这就是写了一个  递归。
2.没问题
3.可以省略，但是没有return的sub感觉很怪···

1. http://baike.baidu.com/view/96473.htm?fr=aladdin

复制代码

回复 12# pony2001mx


   

pony2001mx

非常谢谢ntwarren和xiumu2280！！
我不是计算机专业，但你们的code确实使我产生了极大兴趣。谢谢。

Perl_Er

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use utf8;
   
5. use Data::Dumper;
   
6. use v5.10;
   
7. 
   
8. my %hash;
   
9. my %hash0;
   
10. 
    
11. while (<DATA>) {
    
12. 
    
13.     my @array = split;
    
14. 
    
15.     if ( $array[1] =~ /^1/ ) {
    
16.         $hash{ $array[0] }{ $array[1] } = undef;
    
17.     }
    
18. 
    
19.     $hash0{ $array[0] }{ $array[1] }{ $array[2] } = undef;
    
20. 
    
21. }
    
22. 
    
23. sub analyse_contig_tree_recursively {
    
24.     my $it        = shift;
    
25.     my $TAXA_TREE = shift;
    
26.     foreach ( sort keys %{$TAXA_TREE} ) {
    
27. 
    
28.         my @i = split( /-/, $it );
    
29.         my @j = split( /-/, $_ );
    
30. 
    
31.         if ( ref $TAXA_TREE->{$_} eq 'HASH' ) {
    
32.             if ( $i[0] - 1 == $j[1] ) {
    
33.                 $TAXA_TREE->{$_}{$it} = undef;
    
34.                 analyse_contig_tree_recursively( $it, $TAXA_TREE->{$_} );
    
35.             }
    
36.             analyse_contig_tree_recursively( $it, $TAXA_TREE->{$_} );
    
37.             next;
    
38.         }
    
39. 
    
40.         if ( $i[0] - 1 == $j[1] ) {
    
41.             $TAXA_TREE->{$_}{$it} = undef;
    
42.             analyse_contig_tree_recursively( $it, $TAXA_TREE->{$_} );
    
43.             next;
    
44.         }
    
45.     }
    
46. }
    
47. 
    
48. sub traverse (&$@) {
    
49.     my ( $do_it, $data, @path ) = @_;
    
50. 
    
51.     # iterate
    
52.     foreach my $key ( sort keys %$data ) {
    
53. 
    
54.         # handle sub-tree
    
55.         if ( ref( $data->{$key} ) eq 'HASH' ) {
    
56.             &traverse( $do_it, $data->{$key}, @path, $key );
    
57.             next;
    
58.         }
    
59. 
    
60.         # handle leave
    
61.         if ( defined( $data->{$key} ) ) {
    
62.             if ( $data->{$key} =~ /100$/ ) {
    
63.                 $do_it->( $data->{$key}, @path, $key );
    
64.             }
    
65.             else {
    
66.                 next;
    
67.             }
    
68.         }
    
69.         else {
    
70.             if ( $key =~ /100$/ ) {
    
71.                 $do_it->( @path, $key );
    
72.             }
    
73.             else {
    
74.                 next;
    
75.             }
    
76.         }
    
77.     }
    
78. }
    
79. 
    
80. foreach my $a ( sort keys %hash0 ) {
    
81.     foreach my $b ( sort keys %{ $hash0{$a} } ) {
    
82.         &analyse_contig_tree_recursively( $b, $hash{$a} );
    
83.     }
    
84. }
    
85. 
    
86. #print Dumper \%hash0;
    
87. 
    
88. traverse {
    
89.     my ($it, @rest) = @_;   
    
90.     my @col3;
    
91.     foreach(@rest){
    
92.         push @col3, keys $hash0{$it}{$_};
    
93.     }
    
94.     say $it, " @rest", " @col3";
    
95. } \%hash;
    
96. 
    
97. __DATA__
    
98. a   1-30      A
    
99. a   9-30      B
    
100. a   31-70    D
     
101. a   31-100  F
     
102. a   71-100  U
     
103. b   1-50      J
     
104. b   1-90      K
     
105. b   51-100   JK
     
106. c   1-20      ll
     
107. c   21-99     L

复制代码

回复 1# pony2001mx


   

pony2001mx

谢谢Perl_Er！对我是很好的学习机会。

pony2001mx

回复 17# Perl_Er


    谢谢Perl_Er！对我是很好的学习机会。

翠微剑歌

花时间写了一下，这是我的思路。

1. use strict;
   
2. 
   
3. my @data = map {chomp;[split /\s+|-/,$_]} @_ = <DATA>;
   
4. my $hash;
   
5. $hash->{$_->[0]}->{$_->[1]}->{$_->[2]} = $_->[3] for (@data);
   
6. 
   
7. for my $k1 (sort keys %{$hash}) {
   
8.         &search($k1, "1", []);
   
9. }
   
10. 
    
11. sub search {
    
12.         my ($k1, $k2, $path) = @_;
    
13.         for my $k3 (sort {$a <=> $b} keys %{$hash->{$k1}->{$k2}}) {
    
14.                 push @{$path}, [$k2, $k3];
    
15.                 if ($k3 eq '100') {
    
16.                         my $s1 = join ",", map { join "-", @{$_} } @{$path};
    
17.                         my $s2 = join "", map {$hash->{$k1}->{$_->[0]}->{$_->[1]}} @{$path};
    
18.                         print "$k1\t$s1\t$s2\n";
    
19.                         pop @{$path};
    
20.                         last;
    
21.                 } else {
    
22.                         &search($k1, $k3+1, $path) if (exists $hash->{$k1}->{$k3+1});
    
23.                         pop @{$path};
    
24.                 }
    
25.         }
    
26. }
    
27. 
    
28. __DATA__
    
29. a   1-30      A
    
30. a   9-30      B
    
31. a   31-70    D
    
32. a   31-100  F
    
33. a   71-100  U
    
34. b   1-50      J
    
35. b   1-90      K
    
36. b   51-100   JK
    
37. c   1-20      ll
    
38. c   21-99     L

复制代码