123456789 = 100加入+ - * /个数不限使上面得表达式成立，编程实现求出所有答案(100分)

{
名称: 在数字串中插入四则运算符穷举表达式以得到给定值的算法
作者: creation_zy
说明: 采用"边穷举边计算"思路的算法，有除零检查功能，用一个开关变量控制是否强制
在相邻的数字之间插入运算符。
}
type
TOpts=(opNone,opAdd,opMinus,opMul,opDiv);
TValRec=record
Valueouble;
IsEmpty:Boolean;
Opt:TOpts;
end;
PValRec=^TValRec;
TA2ValRec=array[0..1] of array of TValRec;
TOutputFunc=procedure (Text:String);
const
Operators:array[TOpts]of String=('','+','-','*','/');
function EnumAllExpr(const NumStr:String;
AimNum:Integer;
NumSpace:Boolean;OutFunc:TOutputFunc;out SearchCount:Integer):Integer;
var
NumStrLen:Integer;
Vals:TA2ValRec;
Nums:array of Int64;
Opts:array of TOpts;
function CalALevel(Level:Integer;CurNum:Int64;Opt:TOpts):Boolean;
var
p0,p1,p2,p3ValRec;
begin
Result:=true;
p0:=@Vals[0,Level];
p1:=@Vals[1,Level];
p2:=@Vals[0,Level+1];
p3:=@Vals[1,Level+1];
if p0.IsEmpty then
//第一个变量为空
begin
p2.Value:=CurNum;
p2.IsEmpty:=false;
p2.Opt:=Opt;
p3.IsEmpty:=true;
end
else
if p1.IsEmpty then
//第二个变量为空——只有一个有效变量及操作符
begin
if Opt in [opNone,opAdd,opMinus] then
begin
case p0.Opt of
opAdd: p2.Value:=p0.Value+CurNum;
opMinus: p2.Value:=p0.Value-CurNum;
opMul: p2.Value:=p0.Value*CurNum;
opDiv:
begin
if CurNum=0 then
begin
Result:=false;
exit;
end;
p2.Value:=p0.Value/CurNum;
end;
end;
p2.IsEmpty:=false;
p2.Opt:=Opt;
p3.IsEmpty:=true;
end
else
begin
p2.IsEmpty:=false;
if p0.Opt in [opAdd,opMinus] then
begin
p2.Value:=p0.Value;
p2.Opt:=p0.Opt;
p3.Value:=CurNum;
p3.IsEmpty:=false;
p3.Opt:=Opt;
end
else
begin
case p0.Opt of
opMul: p2.Value:=p0.Value*CurNum;
opDiv:
begin
if CurNum=0 then
begin
Result:=false;
exit;
end;
p2.Value:=p0.Value/CurNum;
end;
end;
p2.Opt:=Opt;
p3.IsEmpty:=true;
end;
end;
end
else
begin
//有两个有效变量及操作符
if Opt in [opNone,opAdd,opMinus] then
begin
case p0.Opt of
opAdd:
begin
case p1.Opt of
opMul: p2.Value:=p0.Value+p1.Value*CurNum;
opDiv:
begin
if CurNum=0 then
begin
Result:=false;
exit;
end;
p2.Value:=p0.Value+p1.Value/CurNum;
end;
end;
end;
opMinus:
begin
case p1.Opt of
opMul: p2.Value:=p0.Value-p1.Value*CurNum;
opDiv:
begin
if CurNum=0 then
begin
Result:=false;
exit;
end;
p2.Value:=p0.Value-p1.Value/CurNum;
end;
end;
end;
end;
p2.IsEmpty:=false;
p2.Opt:=Opt;
p3.IsEmpty:=true;
end
else
begin
p2.Value:=p0.Value;
p2.IsEmpty:=false;
p2.Opt:=p0.Opt;
case p1.Opt of
opMul: p3.Value:=p1.Value*CurNum;
opDiv:
begin
if CurNum=0 then
begin
Result:=false;
exit;
end;
p3.Value:=p1.Value/CurNum;
end;
end;
p3.IsEmpty:=false;
p3.Opt:=Opt;
end;
end;
end;
function MyStrToInt64(StartPos,EndPos:Integer):Int64;
var
i:Integer;
begin
Result:=0;
for i:=StartPos to EndPosdo
Result:=Result*10+Byte(NumStr)-Byte('0');
end;
procedure ShowResult(Level:Integer);
var
i:Integer;
Str:String;
begin
if @OutFunc=nil then
exit;
Str:='';
for i:=0 to Leveldo
begin
Str:=Str+IntToStr(Nums);
if i<Level then
Str:=Str+Operators[Opts];
end;
OutFunc(Str);
end;
proceduredo
After(StartPos,LastPos,Level:Integer);
var
nxt:Integer;
CurNum:Int64;
j:TOpts;
begin
if LastPos=NumStrLen then
begin
if Vals[0,Level].IsEmpty then
CurNum:=MyStrToInt64(1,LastPos)
else
CurNum:=MyStrToInt64(StartPos,NumStrLen);
if CalALevel(Level,CurNum,opNone) then
begin
Inc(SearchCount);
Nums[Level]:=CurNum;
if Abs(Vals[0,Level+1].Value-AimNum)<=0.000001 then
begin
Inc(Result);
ShowResult(Level);
end;
end;
end
else
begin
nxt:=LastPos+1;
if not NumSpace then
{ opNone }
do
After(StartPos,nxt,Level);
{ + - * / }
CurNum:=MyStrToInt64(StartPos,LastPos);
Nums[Level]:=CurNum;
for j:=opAdd to High(TOpts)do
begin
if not CalALevel(Level,CurNum,j) then
continue;
Opts[Level]:=j;
do
After(nxt,nxt,Level+1);
end;
end;
end;
var
i:Integer;
begin
Result:=0;
SearchCount:=0;
NumStrLen:=Length(NumStr);
for i:=Low(Vals) to High(Vals)do
SetLength(Vals,NumStrLen+1);
SetLength(Nums,NumStrLen);
SetLength(Opts,NumStrLen);
Vals[0,0].IsEmpty:=true;
Vals[1,0].IsEmpty:=true;
do
After(1,1,0);
for i:=Low(Vals) to High(Vals)do
SetLength(Vals,0);
SetLength(Nums,0);
SetLength(Opts,0);
end;


使用样例：
procedure Output(Text:String);
begin
Form1.Memo1.Lines.Add(Text);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AimNum,n,SearchCount:Integer;
TWord;
NumStr:String;
begin
Memo1.Text:='';
try
AimNum:=StrToInt(Edit2.Text);
except
exit;
end;
NumStr:=Edit1.Text;
for n:=1 to Length(NumStr)do
if not (NumStr[n] in ['0'..'9']) then
exit;
Memo1.Lines.Add(Format('NumStr: %s AimNum: %d',[Edit1.Text,AimNum]));
Memo1.Lines.Add('');
Application.ProcessMessages;
Memo1.Lines.begin
Update;
T:=GetTickCount;
try
n:=EnumAllExpr(NumStr,AimNum,CheckBox1.Checked,@Output,SearchCount);
except
n:=0;
end;
T:=GetTickCount-T;
Memo1.Lines.EndUpdate;
Memo1.Lines.Add('');
Memo1.Lines.Add(Format('ValidCount: %d SearchCount: %d Time: %.3fs',
[n,SearchCount,T*0.001]));
end;

性能测试：
环境： PIII 1G 256M SDRAM Windows 2000
1: //标准测试——9位
NumStr: 123456789 AimNum: 100
123+45-67+8-9
123+4-5+67-89
123+4*5-6*7+8-9
...
1/2*34-5+6-7+89
1/2*3/4*56+7+8*9
1/2/3*456+7+8+9
ValidCount: 101 SearchCount: 390625 Time: 0.120s
2: //高负荷测试——11位
NumStr: 12345678901 AimNum: 100
123+45+6+7+8-90+1
123+45-67+89*0-1
123+45-67+8-9+0*1
123+45-67+8-9+0/1
123+45-67+8-9-0*1
123+45-67+8-9-0/1
123+45-67+8-9*1
...
1/2/3*45*6+7*8-9*0-1
1/2/3*4*5*6+7+8*9+1
1/2/3*4*5*6+7+8*9+0+1
1/2/3*4*5*6+7+8*9-0+1
1/2/3/4*567*8-90+1
ValidCount: 1929 SearchCount: 8203125 Time: 2.774s
因为采用了新的思路，实现了前面已知结果的保存和重用，极大程度的避免了重复算。本
算法的速度在高速表达式求值算法的基础上又提高了好几倍。

楼主好象失踪了！楼上的几位到我这来领分把！
条件：建议楼上的几位留下QQ：）