perl递归问题

riverlee2008

有个文件,两列,第一列是子节点,第二列表示父亲几点,程序出来就是一个树(有向无环图,如下图), 想做的事情是给定一个节点,想找出它的所有子孙节点, 程序已经实现,通过递归,对于树中较底层的结点,获取子孙节点没有问题, 但对于树中较上层的节点,递归出现 Deep recursion on subroutine "main::findnodes",内存飙到48G以上(本机内存大小48G), 且递归次数超过140000000次多.

现将程序和数据文件附上,忘论坛内高手指点指点,或者给个别的思路(详细程序数据见附件).

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. ###############################
   
7. #usage
   
8. #test1:  perl findoffspring.pl do_ontology_926.txt DOID:3211
   
9. #test2:  perl findoffspring.pl do_ontology_926.txt DOID:4
   
10. #test1 work fine, but test2 didnot work fine, where DOID:4 is the top node in the tree
    
11. my($child2parentfile,$searchnode) = @ARGV;
    
12. 
    
13. 
    
14. #child id 2 parent id
    
15. #"do_id","parent_do_id"
    
16. my %parent2child;
    
17. my %doids;
    
18. open(IN,$child2parentfile) or die $!;
    
19. <IN>;#skip the header
    
20. while(<IN>){
    
21.         s/[\r\n"]//g;
    
22.         my($c,$p) = split "\t";
    
23.         $parent2child{$p}->{$c}=1;
    
24.         $doids{$c}=1;
    
25.         $doids{$p}=1;
    
26. }       
    
27. 
    
28. print "DO num:",scalar keys %doids,"\n";
    
29. 
    
30. 
    
31. #######################################
    
32. #构建一个变量用来记录其所有的offspring
    
33. my $rr={};
    
34. findnodes("DOID:4",\%parent2child,$rr);
    
35. 
    
36. print join "\n",(keys %{$rr});
    
37. 
    
38. #use recursion to find the offspring nodes
    
39. #here  defined the variable to see how many time we call the findnodes
    
40. my $count=0;
    
41. sub findnodes{
    
42.         my($search,$ref,$resultref)=@_;
    
43.         $count++;
    
44.         if($count % 20000 ==0){
    
45.                 print "recursion:",$count,"\n";
    
46.         }
    
47.         if(exists($ref->{$search})){
    
48.                 foreach my $node(keys %{$ref->{$search}}){
    
49.                         $resultref->{$node}=1;
    
50.                         findnodes($node,$ref,$resultref);
    
51.                 }
    
52.         }else{
    
53.                 return $resultref;
    
54.         }
    
55. }
    
56. 
    

复制代码

ask_help_CU.tar.bz2 (55.38 KB, 下载次数: 75)

2010-05-13 21:27 上传

点击文件名下载附件
测试数据

riverlee2008

路过要回帖的啊~~

iamlimeng

我想楼主的程序本身应该没问题，而是因为数据的问题，造成死循环，大量消耗内存，最终死机。

写了段代码，查出有重复数据：DOID:833,DOID:833,duplicated

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. my %p2c;
   
7. my $child2parentfile = "do_ontology_926.txt";
   
8. open(IN,$child2parentfile) or die $!;
   
9. <IN>;#skip the header
   
10. my @lines = <IN>;
    
11. close IN;
    
12. foreach(@lines){
    
13.         s/[\r\n"]//g;
    
14.         my($c,$p) = split "\t";
    
15.         $p2c{$p}{$c}++;
    
16. }
    
17. 
    
18. foreach(@lines){
    
19.         s/[\r\n"]//g;
    
20.         my($c,$p) = split "\t";
    
21.         if ($p2c{$p}{$c} > 1) { print "$c,$p,$p2c{$p}{$c}\n"; }
    
22.         if ($p2c{$p}{$c} && $p2c{$c}{$p}) { print "$c,$p,duplicated\n"; }
    
23. }
    
24. 
    
25. <STDIN>;

复制代码

删除重复的错误数据，程序运行正常！

riverlee2008

回复 3# iamlimeng

    多谢指出问题，我看看去，继续关注～

riverlee2008

回复 3# iamlimeng


    验证完毕，多谢3楼道兄弟～

liyangole

能给出原文件的例子吗？我也练习练习

liyangole

附件的 原文件下载后不对啦。请LZ传一个原文件。

liyangole

ok,好了，下载后改了后缀，哈哈

liyangole

路过 学习中。

liyangole

<IN>;#skip the header？？
作用：skip the header?

还有 lz 能否讲讲 sub findnodes 实现的说明，小弟不胜感激！