To 数据结构版主 creation-zy, 张剑波 ===算法问题(200分)

大哥，您上面的代码好像没有使用新技术嘛。
for i:=EndPosdo
wn to 0do
begin
sub:=Remain-A;
if Sub>=0 then
begin
//可以加入该元素
....
end
else
ReplaceResult(Remain);
//不能加入该元素,尝试加入解 //*********
end;

至于您的将while并入for循环的改进，我觉得必要性不大，因为分开和合并的本质是相同
的——改变循环的实际起点。而上面倒数第二行我认为有问题，因为即使sub:=Remain-A;
为负数，您的算法也要进行一次函数调用“ReplaceResult(Remain);”——我认为此处的这
个调用是多余的。——在我将它删除之后，在Num=20，Sum=23456789的情况下和我的算法耗
时相当。

to creation-zy 兄：
我的程序哪里是为了提高效率啊？只是为了提高可读性和使它更简洁而已。[]
既然那个查表法会有系统差异，就暂时搁置起来了，
我现在正在尝试新的办法，不过都是又臭又长。[]
至于那个 ReplaceResult(Remain) 是手误的缘故，确实没有必要用了。
程序曾经修改过,因为有：
if i>0
then
FindSerial(i-1,sub) //继续向下
else
ReplaceResult(sub);
//尝试加入解 ********
呵呵。(我原来不是这样实现的)
也许上面的错误还有些，让我再看看。[]

to creation-zy兄：
搞了很长时间，我才看出来那个 "挑选的元素必须小于余下的差值" 的约束条件是这样的软弱，
用我的那个算法程序就很容易看出来，将QuickSort(0,Num-1);
去除，在大部分情况下，
就可以发现两者的速度居然只相差不到10倍！真令人沮丧。[]
所以，对于那个
n:=LeftCount;
while n>=0do
//寻找最高的起点
begin
if A[n]>LeftSum then
Dec
else
break;
end;
来说，即使差表法可以一个CPU周期找到结果，也不可能将速度提高2倍。
所以，提高速度的办法只能用找新约束条件
或者抛弃穷举的思路，采用其他的结构才行。

to creation-zy兄：(先谢谢您！)
sorry，下午又想到一些东西，忍不住又要讲几句：
我上面的概率是所有元素的和(总体和)的概率分布，
实际上他们总体和的数学期望应该在:50*5000000/2=125000000 左右，
实际上您选用123456789就非常接近那个极限了，差不多所有元素都要用到的,
所以要很长时间进行搜索----假如目标数用60000000就好了。[]
部分和的分布规律我还想不出来，但是可以通过概率曲线进行拟和。
然后可以大概的获得一个初始较优解，然后选用合适的遗传算法逼近最优解，
这样就应该可以比较好的提高效率了。[]

to creation-zy兄：
我找到问题的症结了！可以根据概率调整一下，修改后的程序如下：
const
Num = 50;
//50个元素
MinValue = 0;
MaxValue = 5000000;
//最大50000
Sum = 123456789;
//最终结果
var
LastRemain : Integer;
//保存当前的最小差值
A : Array [0..Num-1] of Integer;
//元素
Valid, //当前可用元素
Final : Array [0..Num-1] of Boolean;
//最终结果
procedure QuickSort(Lo,Hi:Integer);
//对初始元素排序
var
mid,temp,
H,L:Integer;
begin
H:=Hi;
L:=Lo;
mid:=(A[H]+A[L]) div 2;
repeat
while A[L]<middo
Inc(L);
while A[H]>middo
Dec(H);
if L<=H then

begin
temp:=A[L];
A[L]:=A[H];
A[H]:=temp;
Inc(L);
Dec(H);
end;
until L>H;
if H>Lo then
QuickSort(Lo,H);
if L<Hi then
QuickSort(L,Hi);
end;

procedur ReplaceResult(NewRemain:Integer);
//保存当前的最优组
begin
if LastRemain<=NewRemain then
exit;
MoveMemory(@Final[0],@Valid[0],Num);
LastRemain:=NewRemain;
end;

procedure FindSerial(EndPos,Remain:Integer);
var
i, //循环变量
sub : Integer;
//差值
begin
for i:=EndPosdo
wn to 0do
begin
sub:=Remain-A;
if Sub>=0
then
begin
//可以加入该元素
Valid:=True;
if (Sub>0)
then
begin
//没有到最理想的情况
if i>0
then
FindSerial(i-1,sub) //继续向下
else
ReplaceResult(sub);
//尝试加入解
end
else
begin
//到达最理想的情况
ReplaceResult(0);
Abort;
//退出递归循环
end;
Valie:=False;
end;
end;
end;

procedure ResetDatas;
begin
FillChar(Valid,SizeOf(Valid),0);
//都未用标志
FillChar(Final,SizeOf(Final),0);
//都未用标志
LastRemain:=Sum;
//最初剩余值为最大可能值
end;

procedure EnhanceFindSer(DestNum:Integer);
var
i, //循环变量
total, //所有和值
temp, //中间变量
OverPlus,HiOverPlus, //调整区间
:Integer;
begin
total:=0;
for i:=0 to Num-1do
Inc(Total,A);
if total>DestNum
then
begin
if Total div 2>=DestNum // 根据概率调整查找方式
then
//正面查找
try FindSerial(Num-1,DestNum);
except end
else
begin
//反面查找
try FindSerial(Num-1,Total-DestNum);
except end;
if LastRemain<>0
then
begin
OverPlus:=0;
HiOverPlus:=LastRemain div 2 +1;

repeat
HiOverPlus:=HiOverPlus * 2;
if HiOverPlus>DestNum then
HiOverPlus:=DestNum;
//防止越界
ResetDatas;
try FindSerial(Num-1,Total-DestNum+HiOverPlus);
except end;
until HiOverPlus>LastRemain;
//获得区间的高端
repeat
temp:=(HiOverPlus)div 2;
try FindSerial(Num-1,Total-DestNum+Temp);
except end;
if temp>LastRemain
then
HiOverPlus:=temp
else
OverPlus:=temp;
until HiOverPlus=OverPlus+1;
//逐步逼近最优解
if temp<LastRemain then
//最后调整防止temp<>LastRemain情况
try
ResetDatas;
FindSerial(Num-1,Total-DestNum+HiOverPlus);
except
end;
end;
//LastRemain<>0 end
for i:=0 to Num-1do
Find:=not Find;
//翻转结果
end;
end
else
FillChar(Final,SizeOf(Final),1);
end;

procedure Init;
//初始化
var
i:Integer;
begin
Randomize;

for i:=0 to Num-1do
//初始化元素值
A:=MinValue+Randomize(MaxValue-MinValue+1);
ResetDatas;
end;

procedure TForm1.WriteResult;
//写出结果
var
s:String;
i,total:Integer;
begin
s:='';
total:=0;
for i:=0 to Num-1do
if Final then

begin
s:=s+IntToStr(A)+#9;
total:=total+A;
end;
Memo1.Text:=S+'Total: '+IntToStr(Total);
end;

procedure TForm1.Button1Click(Sender:TObject);
var
i:Integer;
bt,etWord;
begin
bt:=GetTickCount;
Init;
QuickSort(0,Num-1);
EnhanceFindSer(Sum);
WriteResult;
et:=GetTickCount;
ShowMessage(IntToStr(et-bt));
end;

其实那个约束条件"挑选的元素必须小于余下的差值"在所求值很小的时候还是很有用的，
只是在 ∑(A)/4附近和所求值较大时才比较差而已。
所以可以分成两段，然后进行求解。这样搜索就可以很快了，也许不寻找更好的办法了。
根据在我测试10万种情况下可以获得所有最优解，
但是本算法是根据概率调整出来的，所以还是有非常糟糕情况的概率出现的，
但一定不会万分之一。 []
可怜的findbug，帖子变成我的草稿纸了，您的问题非常好，把我困绕了好几天，
以至于无法忘怀，但愿这样可以完成了。[]

几乎每个老师讲分支定界的时候都会拿这题当例题。

to LeeChange 这么说您是知识很渊博的罗？那么为什么会把
我的"穷举每一可能的情况"说成是"穷举法"呢？
看来您对软计算方法还不太熟悉啊。[]

to DarwinZhang:
大侠您教训的是,在下一定好好补习补习.
其实,在这里看数据结构的帖子有个感想,就是对于算法的名称描述的混乱.有时候大家都坚持自己
的算法更好,可仔细一看,除了名称不一样,实质上都是一回事.比如我原以为背包问题和0-1背包问题
不是一回事,但那天有位大虾则认为是一回事.
呵呵，也许各位大侠看的书上的说法就不一样吧,估计谁也不会去说服谁.至于"穷举每一可能的情况"
算什么方法,可能也没必要争下去了.

深深佩服各位大侠的造诣.............

在初始时，将待选数排一次序，再计算就方便得多了

我有极简单的算法，效率很高，但内存消耗大：
const
maxn = 50;
maxv = 5000000;
var
i,k,n,v:longint;
volume:array[1..maxn] of longintr;
h:array[0..maxv] of boolean;
begin
randomize;
n:=random(30)+20;
for i:=1 to ndo
volume:=random(500000);
fillchar(h,sizeof(h),false);
h[0]:=true;
for i:=1 to ndo
for k:=vdo
wnto volumedo
h[k]:=h[k] or h[k-volume];

i:=v;
while( (i>0) and (not h) )do
dec(i);
writeln(v-i);
end；