求一种快速排列组合的方法(条件较高)(100)

R

Rik

Guest
#1
问题:选x个小数(均为小数点后1位),要求排列出所有可能,使这x个数相加得25.0的情况,且必须考虑以下条件:1.最小值1.02.x>=5,x<=103.假设x取5,设这5个数分别为A1,A2,A3,A4,A5,必须使A1<A2<A3,A3>A4>A5,即靠近中间的数字取值最大,两边的数字取值较小。(同样适用于x=6,的情况,当x=6时不要求A3必须=A4想了想没有想出来,请教一下各位分数点少了,可再开帖加分
 
R

Rik

Guest
#2
您好,全排列确实可以,只是效率太慢,6分钟的计算时间太长了,如果按条件,减少循环次数,应该会好一些。不知道还有没有什么好办法
 
F

forgot2002

Guest
#3
既然是要求全部排列,那么没有什么优化的思路可走,以X=5为例考虑到等式左右两边都×10,结果是一样的,命题可以改为5个整数相加等于250的情况假设5个数的的大小排列是a1<=a2<=a3<=a4<a5(注意,这里的a1到a5不是对应命题要求的A1到A5的顺序,但结果是一样的),那么不允许出现a1=a2=a3或者a2=a3=a4的情况全排列算法如下(其实很快,在我的5年老爷机上不到6分钟的时间罗列了627905种可能):procedure TForm1.Button1Click(Sender: TObject);var i, a1, a2, a3, a4, a5: Integer;
s: string;
begin
i := 0;
for a1 := 10 to 49do
begin
for a2 := 10 to 59do
begin
for a3 := 11 to 76do
begin
for a4 := 11 to 109do
begin
for a5 := 52 to 208do
begin
if a1 + a2 + a3 + a4 + a5 = 250 then
begin
if ((a1 <= a2) and (a2 <= a3) and (a3 <= a4) and (a4 < a5)) and (not (((a1 = a2) and (a2 = a3)) or ((a2 = a3) and (a3 = a4)))) then
begin
i := i + 1;
s := inttostr(a1) + '->' + inttostr(a2) + '->' + inttostr(a3) + '->' + inttostr(a4) + '->' + inttostr(a5);
ListBox1.Items.add(s);
end;
end;
end;
end;
end;
end;
end;
showmessage('共'+inttostr(i)+'种情况');
end;
可能有更优化的算法但我不知道,欢迎指正。
 
Z

znxia

Guest
#4
用递归先求出合计值为25的所有可能性,再判断是否满足其它条件。请参考:http://www.delphibbs.com/delphibbs/dispq.asp?lid=3946254
 
R

Rik

Guest
#5
znxia,感谢你提出的方法,但是在我测试后,当N取5时,运算量就已经大到无法忍受了,不知道还有别的办法吗?
 
L

liuls

Guest
#6
3.假设x取5,设这5个数分别为A1,A2,A3,A4,A5,必须使A1<A2<A3,A3>A4>A5,即靠近中间的数字取值最大,两边的数字取值较小.===================>是不是可以出现 A1 = A4 or A1 = A5;
A2 = A4 or A2 = A5...?
 
Z

znxia

Guest
#7
可以把你测试的代码贴出来吗?我测试时感觉速度还好啊。下面是改进的,50个数当中取8个数相加结果为40,运行1秒钟出结果。uses Math;procedure TForm1.Button1Click(Sender: TObject);Const N=50;
M=8;
X=40;Var NumArr:array [0..N-1] Of Integer;
K:Integer;
MinNum,MaxNum:Double;
Function GetNextNum(StarIndex,Count:Integer;
NeedVal:Integer;
LastStr:String):Boolean;
Var K2:Integer;
begin
K2:=StarIndex;
While K2<= (N-Count)do
begin
if Count=1 then
begin
IF NumArr[K2]=NeedVal then
begin
System.Delete(LastStr,1,1);
Memo1.Lines.Add( LastStr+','+IntToStr(NumArr[K2]) );
end;
end else
begin
if ((Count-1)*MinNum < (NeedVal-NumArr[K2])) and ( (Count-1)*MaxNum > (NeedVal-NumArr[K2]) ) then
GetNextNum( K2+1, Count-1, NeedVal-NumArr[K2], LastStr+','+IntToStr(NumArr[K2]) );
end;
Inc(K2);
end;
end;
begin
For K:=LOW(NumArr) TO High(NumArr)do
NumArr[K]:=K+1;
MinNum:= NumArr[0];
MaxNum:= NumArr[0];
For K:=LOW(NumArr) TO High(NumArr)do
begin
MinNum:= Min(MinNum,NumArr[K]);
MaxNum:= Max(MaxNum,NumArr[K]);
end;
GetNextNum( 0, M, X, '');
caption:=datetimetostr(now);
end;
 
R

Rik

Guest
#9
znxia,因为我需要的是小数点后一位数的,比如说取6个数,相加得25.0,建于你的思路,既扩大10倍,将小数变为整数,不取0,第一种可能就是1,1,1,1,1,245。因此取N=245;
M=6;
X=250;这个效率就。。。。
 
Z

znxia

Guest
#10
组合的可能性越多,则计算的时间就越长。在我的方法中,如果对你的数据进行了从小到大的排序,就可以加快速度。
 
L

liuls

Guest
#11
// 我的方法是这样, 还没调试出来~~ procedure TForm1.btn1Click(Sender: TObject);var SmallValue: Integer;
SumValue: Integer;
NumsCount: Integer;
Nums: array of Integer;
iCount: Integer;
MidIndex1, MidIndex2: Integer;
I, iValue, iIndex: Integer;
Sum: Integer;
TmpStr: string;
IsFirst, CheckResult: Boolean;
function CheckCond(const AIndex, AValue: Integer): Boolean;
var J: Integer;
Index2: Integer;
begin
Result := True;
// 已经 > 250 了 Sum := 0;
for J := 0 to AIndexdo
Inc(Sum, Nums[J]);
if Sum + AValue > SumValue then
begin
Result := False;
Exit;
end;
// 是否满足排列条件 if AIndex <= MidIndex1 then
begin
for J := 0 to AIndex -1do
if Nums[J] >= AValue then
begin
Result := False;
Break;
end;
end else
begin
if MidIndex2 <> -1 then
Index2 := MidIndex2 else
Index2 := MidIndex1;
if AIndex >= Index2 then
begin
for J := Index2 to AIndex -1do
if (Nums[J] <= AValue) then
begin
Result := False;
Break;
end;
end;
end;
end;
begin
SumValue := 250;
SmallValue := 10;
NumsCount := 5;
iCount := 0;
if Odd(NumsCount) then
begin
MidIndex1 := NumsCount div 2;
MidIndex2 := -1;
end else
begin
MidIndex1 := NumsCount div 2 - 1;
MidIndex2 := MidIndex1 -1 + 1;
end;
SetLength(Nums, NumsCount);
for iIndex := 0 to NumsCount -1do
Nums[iIndex] := SmallValue;
IsFirst := True;
iIndex := 0;
while iIndex < NumsCountdo
begin
if Nums[0] >= SumValue - 1 then
Break;
if iIndex > 0 then
iValue := Nums[iIndex] + 1 else
if not IsFirst then
iValue := Nums[iIndex] + 1 else
// if iIndex = 0 then
iValue := Nums[iIndex];
while Truedo
begin
CheckResult := CheckCond(iIndex, iValue);
if not CheckResult or (Sum > SumValue) then
begin
// Dec(iIndex);
if iIndex >= 0 then
Nums[iIndex] := Nums[iIndex] + 1;
Break;
end else
if CheckResult then
begin
Nums[iIndex] := iValue;
Inc(iIndex);
if iIndex < NumsCount then
Nums[iIndex] := SmallValue;
Break;
end;
end;
if (iIndex >= NumsCount -1) or (Sum > SumValue) then
begin
// 输出序列 Sum := 0;
TmpStr := '';
for I := 0 to NumsCount -1do
begin
Inc(Sum, Nums);
if TmpStr <> '' then
TmpStr := TmpStr + ',';
TmpStr := TmpStr + FloatToStr(Nums / 10);
end;
if Sum = 250 then
begin
Inc(iCount);
Memo1.Lines.Add('第' + IntToStr(iCount) + '条:' + TmpStr);
end;
Application.ProcessMessages;
// 返回 0, 继续 iIndex := 0;
IsFirst := False;
end;
end;
// 清除动态数组 Nums := nil;
end;