perl遞歸問題

riverlee2008

有個(gè)文件,兩列,第一列是子節(jié)點(diǎn),第二列表示父親幾點(diǎn),程序出來就是一個(gè)樹(有向無環(huán)圖,如下圖), 想做的事情是給定一個(gè)節(jié)點(diǎn),想找出它的所有子孫節(jié)點(diǎn), 程序已經(jīng)實(shí)現(xiàn),通過遞歸,對(duì)于樹中較底層的結(jié)點(diǎn),獲取子孫節(jié)點(diǎn)沒有問題, 但對(duì)于樹中較上層的節(jié)點(diǎn),遞歸出現(xiàn) Deep recursion on subroutine "main::findnodes",內(nèi)存飆到48G以上(本機(jī)內(nèi)存大小48G), 且遞歸次數(shù)超過140000000次多.

現(xiàn)將程序和數(shù)據(jù)文件附上,忘論壇內(nèi)高手指點(diǎn)指點(diǎn),或者給個(gè)別的思路(詳細(xì)程序數(shù)據(jù)見附件).

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. #構(gòu)建一個(gè)變量用來記錄其所有的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. 
    

復(fù)制代碼

ask_help_CU.tar.bz2 (55.38 KB, 下載次數(shù): 75)

2010-05-13 21:27 上傳

點(diǎn)擊文件名下載附件
測(cè)試數(shù)據(jù)

riverlee2008

路過要回帖的啊~~

iamlimeng

我想樓主的程序本身應(yīng)該沒問題，而是因?yàn)閿?shù)據(jù)的問題，造成死循環(huán)，大量消耗內(nèi)存，最終死機(jī)。

寫了段代碼，查出有重復(fù)數(shù)據(jù)：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>;

復(fù)制代碼

刪除重復(fù)的錯(cuò)誤數(shù)據(jù)，程序運(yùn)行正常！

riverlee2008

回復(fù) 3# iamlimeng

    多謝指出問題，我看看去，繼續(xù)關(guān)注～

riverlee2008

回復(fù) 3# iamlimeng


    驗(yàn)證完畢，多謝3樓道兄弟～

liyangole

能給出原文件的例子嗎？我也練習(xí)練習(xí)

liyangole

附件的 原文件下載后不對(duì)啦。請(qǐng)LZ傳一個(gè)原文件。

liyangole

ok,好了，下載后改了后綴，哈哈

liyangole

路過 學(xué)習(xí)中。

liyangole

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

還有 lz 能否講講 sub findnodes 實(shí)現(xiàn)的說明，小弟不勝感激！