Chinaunix

标题: 关于perl的排列组合问题 [打印本页]
作者: venturexu    时间: 2006-10-10 17:55
标题: 关于perl的排列组合问题
今天碰到一个问题,特来请教
有8个数,(01,13,15,18,33,55,99,109),从中取出4个,列出所有的组合,组合中不能有重复的,就是说01,13,15,18和18,13,15,01算一种,大家看看这个怎么弄,我查了很多算法,没有想到好的办法.
作者: flw    时间: 2006-10-10 18:35
刚写了一个，不太好。估计用 map 可以在 3 行之内搞定。
  1. use strict;
  2. use warnings;

  4. sub foo($$$);

  6. my @array = (01,13,15,18,33,55,99,109);

  8. foo(\@array, 4, []);

  10. sub foo($$$){
  11.     my ($rarry, $level, $result) = @_;

  13.     unless($level){
  14.         print join ',', @$result, "\n";
  15.         return;
  16.     }

  18.     foreach my $i (0..@$rarry-1){
  19.         push @$result, $rarry->[$i];
  20.         foo( [@$rarry[0..$i-1], @$rarry[$i+1..$#$rarry]], $level-1, $result );
  21.         pop @$result;
  22.     }
  23. }
复制代码
作者: shucho    时间: 2006-10-10 19:39
我运行了一下，发现有重复的
作者: shihyu    时间: 2006-10-10 20:01
这是使用 Recursive call 去写吗??
sub foo($$$){

}

可以写成下面那样吗??
sub foo{
}

($$$) 加上这用意为什么??? 是因为前面有sub foo($$$); 宣告吗??

foo(\@array, 4, []); #  参数 [] 是什么意思???

谢谢
作者: flw    时间: 2006-10-10 21:08
原帖由 shucho 于 2006-10-10 19:39 发表
我运行了一下，发现有重复的

没有的。
作者: flw    时间: 2006-10-10 21:09
原帖由 shihyu 于 2006-10-10 20:01 发表
这是使用 Recursive call 去写吗??
sub foo($$$){

}

可以写成下面那样吗??
sub foo{
}

($$$) 加上这用意为什么??? 是因为前面有sub foo($$$); 宣告吗??

foo(\@array, 4, []); #  参数 [] 是什么意 ...

sub foo($$$) 这个是原型，参见 perldoc perlsub
原型的作用是在调用时进行强制性的参数检查。不过调用时前面加 & 可以规避检查。
[] 是匿名数组。
作者: shucho    时间: 2006-10-10 21:31
原帖由 flw 于 2006-10-10 21:08 发表

没有的。



  2. use strict;
  3. use warnings;

  5. sub foo($$$);

  7. my @array = (01,13,15,18);

  9. foo(\@array, 4, []);

  11. sub foo($$$){
  12.     my ($rarry, $level, $result) = @_;

  14.     unless($level){
  15.         print join ',', @$result, "\n";
  16.         return;
  17.     }

  19.     foreach my $i (0..@$rarry-1){
  20.         push @$result, $rarry->[$i];
  21.         foo( [@$rarry[0..$i-1], @$rarry[$i+1..$#$rarry]], $level-1, $result );
  22.         pop @$result;
  23.     }
  24. }
复制代码


如果是4个元素的数组，那么应该只有一种组合，但是如果运行一下，会发现
$ perl prog | wc -l
      24
这应该不对吧
作者: flw    时间: 2006-10-10 22:08
哦，我搞成排列了，不是组合。
作者: shucho    时间: 2006-10-10 22:19
我想到一个很笨的办法。

一开始还是做排列组合，定义中间结果为一个HASH, 数据结构为：
HASH =
{
[01,13,15,18] => 6, ## 6 = 0+1+2+3，为下标的和
[13,01,15,18] => 6, ## 6 = 1+0+2+3, 同上
[...] => N,
...,
...
}
然后反转一下HASH，这样就得到了最终结果(values HASH)
虽然很土，但是应该奏效。

我看了一下算法书，可能是图论(有向图)或者计算几何(多边形)的内容，不过我不是学计算机的，不是很清楚，别笑我

[ 本帖最后由 shucho 于 2006-10-10 22:20 编辑 ]
作者: shihyu    时间: 2006-10-10 22:56
原帖由 shucho 于 2006-10-10 22:19 发表
我想到一个很笨的办法。

一开始还是做排列组合，定义中间结果为一个HASH, 数据结构为：
HASH =
{
[01,13,15,18] => 6, ## 6 = 0+1+2+3，为下标的和
[13,01,15,18] => 6, ## 6 = 1+0+2+3, 同上
[.. ...





6 = 0+1+2+3
6 = 1+0+2+3

用组数组存放组合数总和如果又出现一样总和就不要

  1. sub foo($$$){

  3. 我是觉得可以在这里面直接判断 用 if + 数组判断
  4. }
复制代码

[ 本帖最后由 shihyu 于 2006-10-10 22:58 编辑 ]
作者: shucho    时间: 2006-10-10 23:13
恩，好办法
作者: orangetouch    时间: 2006-10-11 14:05
  1. my @a=sort { $a <=> $b } (01,13,15,18,33,55,99,109);
  2. my @r;
  3. map { $r[0] = $_; map { $r[1] = $_; map { $r[2] = $_; map { $r[3] = $_; print join(',', @a[@r]), "\n" } ($_ + 1 ... scalar @a - 1) } ($_ + 1 ... scalar @a - 2) } ($_ + 1 ... scalar @a - 3) }(0 ... scalar @a - 4);
复制代码
作者: venturexu    时间: 2006-10-11 14:29
果然是牛人,学了很长时间perl,现在看来还是才疏学浅,以后还得勤加学习.
作者: shucho    时间: 2006-10-11 14:54
Cool! 能不能讲解一下，有点看不懂
作者: vity    时间: 2006-10-11 23:17
简单的递归不好使吗？
作者: venturexu    时间: 2006-10-12 11:05
标题: 回复 2楼 flw 的帖子
flw老大,你这个有重复的问题.
我查了一下,里边有1,13,15,18,还有13,1,15,18,这两个是重复的
作者: flw    时间: 2006-10-12 11:07
原帖由 venturexu 于 2006-10-12 11:05 发表
flw老大,你这个有重复的问题.
我查了一下,里边有1,13,15,18,还有13,1,15,18,这两个是重复的

是有重复的。
我解题的时候当成是排列了，楼主要的是组合。
作者: yhsmengdi    时间: 2006-10-12 11:12
标题: 我也来一个

  2. #!/usr/bin/perl

  4. print "Content-type: text/html\n\n";

  6. my @arry = ('01','13','15','18','33','55','99','109');
  7. my $count = 0;
  8. &foo(\@arry,4,0,'');

  10. sub foo{
  11. #--------------------------------------
  12. # add by Miles at 2006-10-12
  13. # 打印从数组中去num个数的组合
  14. #param $arry 数组
  15. # param $num 组合的个数
  16. # param $begin 起始数组的下标
  17. # param $str 已经获取的排列的内容
  18. # return null
  19. #
  20. #
  21.     my ($arry,$num,$begin,$str) = @_;
  22.     my $len = $#arry - $num + 1;
  23.     if ($len>=0 && $num && ($len >= $begin))
  24.     {
  25.        $num--;
  26.        for my $k ($begin..$len)
  27.        {
  28.           my $tmp = $str." $arry[$k] ";
  29.           &foo($arry,$num,($k+1),$tmp) if $num;
  30.           print "$tmp \n" unless $num;
  31.        }
  32.     }
  33. }



复制代码


这是简单的用递归实现的。还是用map的写的比较省字。赫赫
map 一直不会用，学习。。。。。。

[ 本帖最后由 yhsmengdi 于 2006-10-12 11:24 编辑 ]
作者: apile    时间: 2006-10-12 20:31
map就是
对Array 一个一个处理..然後产生新的array...

不难..
只是看了会觉得很复杂...
advance perl programming 多看看..里面有很多不错的例子..
perldoc里面也有..
作者: fengc    时间: 2006-10-13 07:08
去 http://bbs.loveunix.net/viewthre ... p;extra=&page=2 看看吧。
我以前在那儿贴过源程序。



欢迎光临 Chinaunix (http://bbs.chinaunix.net/) Powered by Discuz! X3.2