求 一个 perl 递归算法

zxp209

大家好！

想实现一个递归功能，想了半天没能想出来，高手可能一下子就实现了。

需求是这样的 假如有两个数组 @arr1=(1,1,2),@arr2(2,4,3)

我想遍历@arr1作为根，最后实现类似oracle 的connect by

两列：
root_id   id
1           2
1           4
2           3


想要的效果是打印如下内容：（root_id 和id的所有关系都打印出来）
1,2
1,2,3
1,4
2,3

当然，这只有3个元素的数组，道理是一样的。

谁帮我想想啊，我写了半天也不能实现。。。郁闷至极.......
先谢谢了。

zxp209

下面是我写的不能实现的脚本。

use strict;
my (@arr1,@arr2,$cc)
@arr1=(1,1,1,2,5,5,7);
@arr2=(2,3,4,5,6,7,;

for(my $j=1;$j<@arr1;$j++){
        recursion($_);
}


sub recursion
{
        my $var = shift;
for(my $i=1;$i<@arr1;$i++){
        if($_ = $var){
                $cc.=$_.','.$arr2[$i];
                print $cc;
                if($_  ne $arr2[$i]){
                        recursion($arr2[$i]);
                }
               
        }
}
}

jason680

回复 1# zxp209

same question ??
http://bbs.chinaunix.net/forum.p ... mp;fromuid=25526646
   

zxp209

回复 3# jason680


    是的，大概的需求是这样的，找到所有的通路，我先看看哈，谢谢你拉。

jason680

回复 4# zxp209

be careful loop issue
root_id   id
1           2
1           4
2           3
3           1

zxp209

那个看不太懂，能不能写个能测试的？

zxp209

回复 3# jason680


    如果我要在这个基础上，添加一些测试数据，比如我一楼上说的，那我应该怎么实现呢？

    my %hash1;
    map {
            /(\S+)\s+(\S+)/;
            push @{$hash1{$1}},$2;
    } <DATA>;

    map{
            print "===path of $_===\n";
            print $_,"\n";
            f(undef,$_);
    } (keys %hash1);

    sub f{
            my ($s,$t) = (@_);
            map{
                    print $s,$t,$_,"\n";
                    f($s.$t,$_);
             }@{$hash1{$t}};
    }

zxp209

回复 5# jason680


    是的，数据里边是有环路，用oracle connect by nocycle 可以屏蔽错误，perl目前还不知道怎么处理呢。

zxp209

回复 8# zxp209


    兄台，能帮下忙吗？

应该怎么实现啊？他们的代码都看不太懂。。。

jason680

回复 8# zxp209

$ cat connect_id.pl
use strict;
use warnings;

my %hConnect;

# read data
while(<DATA>){
   next if(m/^\s*#/);
   if(m/(\S+)\s+(\S+)/){
     push @{$hConnect{$1}},$2;
   }
}

foreach(sort {$a <=> $b} keys %hConnect){
  print "===path of $_===\n";
  my %hLoop = ();
  foreach( next_connect("$_", $_, %hLoop)){
    print "$_\n";
  }
}

sub next_connect{
  my ($sString, $sID, %hLoop) = @_;
  #my %hLoop = %{$rhLoop};
  my @aData = ();

  # check next
  return $sString if(! exists $hConnect{$sID});

  # loop check
  return "$sString(loop,stop)" if(exists $hLoop{$sID});

  $hLoop{$sID} = 1;
  # we got the many "next id"
  foreach my $sNext (@{$hConnect{$sID}}){
      push @aData, next_connect("$sString,$sNext", $sNext, %hLoop);
  }
  return @aData;
}
__DATA__
#root_id   id
1           2
1           9
2           3
2           4
3           1
3           9
4           1
4           9

$ perl connect_id.pl
===path of 1===
1,2,3,1(loop,stop)
1,2,3,9
1,2,4,1(loop,stop)
1,2,4,9
1,9
===path of 2===
2,3,1,2(loop,stop)
2,3,1,9
2,3,9
2,4,1,2(loop,stop)
2,4,1,9
2,4,9
===path of 3===
3,1,2,3(loop,stop)
3,1,2,4,1(loop,stop)
3,1,2,4,9
3,1,9
3,9
===path of 4===
4,1,2,3,1(loop,stop)
4,1,2,3,9
4,1,2,4(loop,stop)
4,1,9
4,9