[技术讨论] 玩Perl的还活着吗？出个锻炼题：给出两堆数，找出和相同的组合

523066680

其实我刚刚写出来。

实际应用举例：你出了N批货给不同客户，有的客户是一批货分好几次转账付款，有些客户是几批货合并为1个款项转账付款。
但是这些客户一直没有找你对账，有的货款还未收到，他们的付款人姓名也不是其本人，难以分辨哪一笔相对应。通过程序筛出配对的组合，可以辅助判断

俩数组：
@numa = qw/
1
14
72
24
53
66
77
8
/;

@numb = qw/123 344 22 77/;

求出的他们之中，和相同的部分，包括单个元素等于另一个数组多个元素相加的情况：

───────────────────────┐
200                                           │
        A -> 1,72,53,66,8                     │
        B -> 123,77                           │
145                                           │
        A -> 1,14,53,77                       │
        B -> 123,22                           │
99                                            │
        A -> 1,24,66,8 | 14,24,53,8 | 14,77,8 │
        B -> 22,77                            │
77                                            │
        A -> 24,53 | 77                       │
        B -> 77                               │
123                                           │
        A -> 14,24,77,8                       │
        B -> 123                              │
22                                            │
        A -> 14,8                             │
        B -> 22                               │
───────────────────────┘

Linuxer

题目看着挺难的，，，目前perl还停留在helloworld阶段。

CrLf

Mark,let me think.

523066680

直接贴代码了。
思路就是通过组合方法，递归列出两列数各自的组合情况，将每一个组合的合计存储到
%A， %B 哈希表中，然后遍历%A %B 把同类项并排列出。如果是对小范围随机数据
进行匹配，相同的情况可能会很多。但实际应用中，合计金额的独立性会强很多。

use IO::Handle;
STDOUT->autoflush(1);
my (@cupa, @cupb);
my (@numa, @numb);
my (%A, %B);
@numa = qw/
1
14
72
24
53
66
77
8
/;

@numb = qw/123 344 22 77/;

&func(\@cupa, \@numa, \%A);
&func(\@cupb, \@numb, \%B);
my ($fa, $fb);
foreach $fa (keys %A) {
    foreach $fb (keys %B) {
        if ($fa == $fb) {
            print $fa, "\n",
                "\tA -> ", 
                join(" | ", @{$A{$fa}}),
                "\n\tB -> ",
                join(" | ", @{$B{$fb}}),
                "\n";
        }
    }
}

sub func { 
    my ($a, $b, $h) = (shift, shift, shift);
    my @ar;
    my @br;
    my $i;
    my $sum=0;
    my $allnum="";
    if (scalar(@{$a}) > 0) {
        foreach (@{$a}) {
            $sum += $_;
        }
        $allnum = join(",",@{$a});
        push @{$h->{$sum}}, $allnum;
    }
    foreach $i (0..$#{$b}) {
        @ar=(@{$a}, $b->[$i]);
        @br=@{$b}[$i+1..$#{$b}];
        &func(\@ar, \@br, $h);
    }
}
复制代码

523066680

用Win32::OLE 操作EXCEL 进行数据连线的东西也写好了
首先进行一一匹配，然后才对剩下的数据进行组合匹配，尽量使用元素较少的组合进行连线：
（以下数据纯属虚构）

523066680

真的没有人玩perl啊？

y6cmE

呵呵，以前工作上有要用到类似的情况，也写过一个简单的Perl Script：

use Math::Combinatorics;
#sum.pl by y6cmE 9044185@qq.com
$|=1;
print "请输入要计算的合计数：";
my $C=<>;
chomp $C;
print "请输入要匹配一次或多次，一次为1，多次为其它数，如2：";
my $B=<>;
chomp $B;
print "请输入最少几个数开始匹配，如1：";
my $X=<>;
chomp $X;
print "请输入最多几个数结束匹配，如9：";
my $Y=<>;
chomp $Y;
open(C,">结果.txt") or die;
open(A,"数组.txt") or die;
while(my $line=<A>){
	chomp $line;
	push(@N,$line);
}
close A;
foreach my $p($X..$Y){
	my $combinat=Math::Combinatorics->new(count=>$p,data=>[@N]);
	while(my @combo=$combinat->next_combination){
		my $num=0;
		foreach my $o(@combo){
			$num=$num+$o;
		}
		if($num eq $C){
			print "@combo\n";
			print C "@combo\n";
			if($B == 1){
				close C;
				<>;
				exit;
			}
		}
	}
}
close C;
<>;
复制代码