【中级擂台】24点算法!不能用C只能用Delphi!

Question

在算法论坛看到很多讨论24点算法的帖子，全部都是用C写的，大家能不能用delphi写出同样的算法。

Answer 1

用C写的，大家能不能用delphi写出同样的算法
看看语法，然后翻译就行了

Answer 2

faint
要转换还不简单……
哪怕是FORTRAN或者ADA，COBOL，都是可以做的……

Answer 3

myling(阿德):
看见你的1点信誉就有删除你的冲动……

Answer 4

在C里用到的有些Func在Delphi里是要自已写的，而不是简单的翻译就可以的。
而且既然这么简单的话，还没有一个人翻译过来贴上来的。

Answer 5

C与Delphi有多大区别？？？不就是北京话和上海话的区别吗？？？只是写法不同，但是表达的内容是一样的！！！关键在于匿名不明白24点的算法，如果不明白用什么语言你都写不出来！！！

Answer 6

(*//
标题:类似计算加减乘除二十四的算法
说明:参考http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=422
修改:Zswang
日期:2003-03-17
支持:[email protected]
//*)///////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[I];
        B := vNumbers[J];
        vNumbers[J] := vNumbers[mLevel - 1];        vExpA := vExpressions[I];
        vExpB := vExpressions[J];
        vExpressions[J] := vExpressions[mLevel - 1];        vExpressions[I] := '(' + vExpA + '+' + vExpB + ')';
        vNumbers[I] := A + B;
        if fSearchExpression(mLevel - 1) then Exit;
        vExpressions[I] := '(' + vExpA + '-' + vExpB + ')';
        vNumbers[I] := A - B;
        if fSearchExpression(mLevel - 1) then Exit;
        vExpressions[I] := '(' + vExpB + '-' + vExpA + ')';
        vNumbers[I] := B - A;
        if fSearchExpression(mLevel - 1) then Exit;
        vExpressions[I] := '(' + vExpA + '*' + vExpB + ')';
        vNumbers[I] := A  *  B;
        if fSearchExpression(mLevel - 1) then Exit;
        if B <> 0 then begin
          vExpressions[I] := '(' + vExpA + '/' + vExpB + ')';
          vNumbers[I]  :=  A  /  B;
          if fSearchExpression(mLevel - 1) then Exit;
        end;
        if A <> 0 then begin
          vExpressions[I] := '(' + vExpB + '/' + vExpA + ')';
          vNumbers[I] := B / A;
          if fSearchExpression(mLevel - 1) then Exit;
        end;
        vNumbers[I] := A;
        vNumbers[J] := B;
        vExpressions[I] := vExpA;
        vExpressions[J] := vExpB;
      end;
    end;
    Result := False;
  end; { fSearchExpression }var
  I: Integer;
begin
  vLength := Length(mNumbers);
  SetLength(vNumbers, vLength);
  SetLength(vExpressions, vLength);
  for I := 0 to vLength - 1 do begin
    vNumbers[I] := mNumbers[I];
    vExpressions[I] := IntToStr(mNumbers[I]);
  end;
  if fSearchExpression(vLength) then
    Result := vExpressions[0]
  else Result := '';
  vNumbers := nil;
  vExpressions := nil;
end; { SearchExpression }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := SearchExpression([7, 7, 4, 4], 24);
end;
///////End Demo

Answer 7

zswangII(伴水清清)(职业清洁工) 
达到算法的功能，但还有些地方需要完善。
1.输入1，2，3，4而返回的表达式为(((1+2)+3)*4)没有将多余的括号去掉。
2.没有将所有的表达式列出。
3.在将所有的表达式列出后，将重复的表达式过滤等。

Answer 8

我将代码稍微改了一下，列出所有表达式：
function CheckExpression(vExpS: String): String;
var
  vLengthExpS:Integer;
begin
  vLengthExpS:=Length(vExpS);
  Result:=Copy(vExps,2,vLengthExps-2);
end;procedure TForm1.SearchExpression(mNumbers: array of Integer;
  mDest: Integer);
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[I];
        B := vNumbers[J];
        vNumbers[J] := vNumbers[mLevel - 1];        vExpA := vExpressions[I];
        vExpB := vExpressions[J];
        vExpressions[J] := vExpressions[mLevel - 1];        vExpressions[I] := '(' + vExpA + '+' + vExpB + ')';
        vNumbers[I] := A + B;
        if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        vExpressions[I] := '(' + vExpA + '-' + vExpB + ')';
        vNumbers[I] := A - B;
        if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        vExpressions[I] := '(' + vExpB + '-' + vExpA + ')';
        vNumbers[I] := B - A;
        if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        vExpressions[I] := '(' + vExpA + '*' + vExpB + ')';
        vNumbers[I] := A  *  B;
        if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        if B <> 0 then begin
          vExpressions[I] := '(' + vExpA + '/' + vExpB + ')';
          vNumbers[I]  :=  A  /  B;
          if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        end;
        if A <> 0 then begin
          vExpressions[I] := '(' + vExpB + '/' + vExpA + ')';
          vNumbers[I] := B / A;
          if fSearchExpression(mLevel - 1) then Memo1.Lines.Add(CheckExpression(vExpressions[0]));
        end;
        vNumbers[I] := A;
        vNumbers[J] := B;
        vExpressions[I] := vExpA;
        vExpressions[J] := vExpB;
      end;
    end;
    Result := False;
  end; { fSearchExpression }var
  I: Integer;
begin
  vLength := Length(mNumbers);
  SetLength(vNumbers, vLength);
  SetLength(vExpressions, vLength);
  for I := 0 to vLength - 1 do begin
    vNumbers[I] := mNumbers[I];
    vExpressions[I] := IntToStr(mNumbers[I]);
  end;
  if fSearchExpression(vLength) then
    Memo1.Lines.Add( vExpressions[0]);  vNumbers := nil;
  vExpressions := nil;
end; { SearchExpression }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  SearchExpression([1, 2, 3, 4], 24);
  if Memo1.Lines.Count>0 then
    showmessage('成功计算出结果，请核对!')
  else
    showmessage('不能计算出结果，请重新出题!');
end;

Answer 9

本人写的24点程序
http://bbs.2ccc.com/uploads/fj218/card24.rar