类似计算加减乘除二十四的算法

(*// 标题:类似计算加减乘除二十四的算法
说明:参考 http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=422
修改:Zswang
日期:2003-03-17
支持:wjhu111@21cn.com
//*)
///////Begin Source
function SearchExpression(mNumbers: array of Integer;
mDest: Integer): string;
const
cPrecision = 1E-6;
var
vNumbers: array of Extended;
vExpressions: array of string;
vLength: Integer;
function fSearchExpression(mLevel: Integer): Boolean;
var
I, J: Integer;
A, B: Extended;
vExpA, vExpB: string;
begin
Result := True;
if (mLevel <= 1) and (Abs(vNumbers[0] - mDest) <= cPrecision) then Exit;
for I := 0 to mLevel - 1 do begin
for J := I + 1 to mLevel - 1 do begin
A := vNumbers;
B := vNumbers[J];
vNumbers[J] := vNumbers[mLevel - 1];
vExpA := vExpressions;
vExpB := vExpressions[J];
vExpressions[J] := vExpressions[mLevel - 1];
vExpressions := '(' + vExpA + '+' + vExpB + ')';
vNumbers := A + B;
if fSearchExpression(mLevel - 1) then Exit;
vExpressions := '(' + vExpA + '-' + vExpB + ')';
vNumbers := A - B;
if fSearchExpression(mLevel - 1) then Exit;
vExpressions := '(' + vExpB + '-' + vExpA + ')';
vNumbers := B - A;
if fSearchExpression(mLevel - 1) then Exit;
vExpressions := '(' + vExpA + '*' + vExpB + ')';
vNumbers := A * B;
if fSearchExpression(mLevel - 1) then Exit;
if B <> 0 then begin
vExpressions := '(' + vExpA + '/' + vExpB + ')';
vNumbers := A / B;
if fSearchExpression(mLevel - 1) then Exit;
end;
if A <> 0 then begin
vExpressions := '(' + vExpB + '/' + vExpA + ')';
vNumbers := B / A;
if fSearchExpression(mLevel - 1) then Exit;
end;
vNumbers := A;
vNumbers[J] := B;
vExpressions := vExpA;
vExpressions[J] := vExpB;
end;
end;
Result := False;
end;
var
I: Integer;
begin
vLength := Length(mNumbers);
SetLength(vNumbers, vLength);
SetLength(vExpressions, vLength);
for I := 0 to vLength - 1 do begin
vNumbers := mNumbers;
vExpressions := IntToStr(mNumbers);
end;
if fSearchExpression(vLength) then
Result := vExpressions[0]
else Result := '';
vNumbers := nil;
vExpressions := nil;
end;
///////End Source
///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := SearchExpression([5, 5, 5, 1], 24);
end;
///////End Demo