高分求解一道算法题!(300分)

  • 主题发起人 主题发起人 xujiancai
  • 开始时间 开始时间
X

xujiancai

Unregistered / Unconfirmed
GUEST, unregistred user!
小时候常玩一种游戏,可以四人玩,每人在扑克牌中随机抽出1张牌,共4张牌,分别可能是1--10,然后使用这4张牌计算24,每张牌只可用1次,使用加、减、乘、除四种运算。如四张牌为 7,8,9,10,则可以这样计算 8×9/(10-7)=24;如四张牌为2,2,3,3,则可以这样计算:(2+2)×(3+3)=24; 如5,5,2,1则可以这样运算:5×5+1-2。
现在要求编写一个程序,让用户输入4个数(1--10),然后输出所有能计算出24的式子。
 
unit Unit7;

interface

uses
Windows, Messages, SysUtils, StrUtils,Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm7 = class(TForm)
Button1: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
Function Calc(x1,x2,x3,x4:Integer;oper1,oper2,oper3:char):double;overload;
end;

var
Form7: TForm7;
oper:array[0..3] of char =('+','-','x','/');

implementation

{$R *.dfm}

procedure TForm7.Button1Click(Sender: TObject);
var
i,j,k,l,n1,n2,n3,count:Integer;
exp:string;
v:double;
begin
count:=0 ;
for i := 1 to 10 do
for j := 1 to 10 do
for k := 1 to 10 do
for l := 1 to 10 do
for n1 := 0 to 3 do
for n2 := 0 to 3 do
for n3 := 0 to 3 do
begin
exp:=inttostr(i)+oper[n1]+inttostr(j)+oper[n2]+inttostr(k)+oper[n3]+inttostr(l);
v:=Calc(i,j,k,l,oper[n1],oper[n2],oper[n3]);
if (v>=24) and (v<24.00000001) then
begin
inc(count);
memo1.Lines.Add(exp+'=24') ;
Label1.Caption:=inttostr(count);
end;
end;

end;

function TForm7.Calc(x1,x2,x3,x4:Integer;oper1,oper2,oper3:char):double;
var
v:double;
begin
case oper1 of
'+':v:=x1+x2;
'-':v:=x1-x2;
'x':v:=x1*x2;
'/':v:=x1/x2;
end;

case oper2 of
'+':v:=v+x3;
'-':v:=v-x3;
'x':v:=v*x3;
'/':v:=v/x3;
end;

case oper3 of
'+':v:=v+x4;
'-':v:=v-x4;
'x':v:=v*x4;
'/':v:=v/x4;
end;

result:=v;
end;

end.
运算顺序从左至右
 
楼上的解有问题,居然算不出来 2,2,3,3, 也算不出来7,8,9,10。
 
有11种括号方式没算进去嘛
 
只是提供一种思路,要把运算顺序考虑进去也简单:
unit Unit7;

interface

uses
Windows, Messages, SysUtils, StrUtils,Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm7 = class(TForm)
Button1: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
Function Calc(x1,x2,x3,x4:Integer;oper1,oper2,oper3:char;operseq:integer):double;overload;
end;

var
Form7: TForm7;
oper:array[0..3] of char =('+','-','x','/');

implementation

{$R *.dfm}

procedure TForm7.Button1Click(Sender: TObject);
var
i,j,k,l,n1,n2,n3,operseq,count:Integer;
exp:string;
v:double;
begin
count:=0 ;
for i := 1 to 10 do
for j := 1 to 10 do
for k := 1 to 10 do
for l := 1 to 10 do
for n1 := 0 to 3 do
for n2 := 0 to 3 do
for n3 := 0 to 3 do
for operseq := 0 to 3 do
begin
v:=Calc(i,j,k,l,oper[n1],oper[n2],oper[n3],operseq);
if (v>=24) and (v<24.00000001) then
begin
case operseq of
0:exp:='(('+inttostr(i)+oper[n1]+inttostr(j)+')'+oper[n2]+inttostr(k)+')'+oper[n3]+inttostr(l);
1:exp:='('+inttostr(i)+oper[n1]+inttostr(j)+')'+oper[n2]+'('+inttostr(k)+oper[n3]+inttostr(l)+')';
2:exp:=inttostr(i)+oper[n1]+'(('+inttostr(j)+oper[n2]+inttostr(k)+')'+oper[n3]+inttostr(l)+')';
3:exp:='('+inttostr(i)+oper[n1]+'('+inttostr(j)+oper[n2]+inttostr(k)+'))'+oper[n3]+inttostr(l);
end;
inc(count);
memo1.Lines.Add(exp+'=24') ;
Label1.Caption:=inttostr(count);
end;
end;

end;

//假设运算符是#
//operseq=0 ((i#j)#k)#l
//operseq=1 (i#j)#(k#l)
//operseq=2 i#((j#k)#l)
//operseq=3 (i#(j#k))#l
function TForm7.Calc(x1,x2,x3,x4:Integer;oper1,oper2,oper3:char;operseq:integer):double;
var
v,vv:double;
begin
try //捕获除数为0的情况
case operseq of
0: //operseq=0 ((i#j)#k)#l
begin
case oper1 of
'+':v:=x1+x2;
'-':v:=x1-x2;
'x':v:=x1*x2;
'/':v:=x1/x2;
end;

case oper2 of
'+':v:=v+x3;
'-':v:=v-x3;
'x':v:=v*x3;
'/':v:=v/x3;
end;

case oper3 of
'+':v:=v+x4;
'-':v:=v-x4;
'x':v:=v*x4;
'/':v:=v/x4;
end;
result:=v;
end;
1: //operseq=0 (i#j)#(k#l)
begin
case oper1 of
'+':v:=x1+x2;
'-':v:=x1-x2;
'x':v:=x1*x2;
'/':v:=x1/x2;
end;

case oper3 of
'+':vv:=x3+x4;
'-':vv:=x3-x4;
'x':vv:=x3*x4;
'/':vv:=x3/x4;
end;

case oper2 of
'+':v:=v+vv;
'-':v:=v-vv;
'x':v:=v*vv;
'/':v:=v/vv;
end;

result:=v;
end;
2: //operseq=2 i#((j#k)#l)
begin
case oper2 of
'+':v:=x2+x3;
'-':v:=x2-x3;
'x':v:=x2*x3;
'/':v:=x2/x3;
end;

case oper3 of
'+':v:=v+x4;
'-':v:=v-x4;
'x':v:=v*x4;
'/':v:=v/x4;
end;

case oper1 of
'+':v:=x1+v;
'-':v:=x1-v;
'x':v:=x1*v;
'/':v:=x1/v;
end;

result:=v;
end;
3: //operseq=3 (i#(j#k))#l
begin
case oper2 of
'+':v:=x2+x3;
'-':v:=x2-x3;
'x':v:=x2*x3;
'/':v:=x2/x3;
end;

case oper1 of
'+':v:=x1+v;
'-':v:=x1-v;
'x':v:=x1*v;
'/':v:=x1/v;
end;

case oper3 of
'+':v:=v+x4;
'-':v:=v-x4;
'x':v:=v*x4;
'/':v:=v/x4;
end;

result:=v;
end;
end

except on E: Exception do result:=-1;
end;
end;
end.
 
游戏也玩过。帮助顶
 
纯sql实现24算法
http://spaces.msn.com/zhenxin0603/blog/cns!A7EBA72EFE1604C5!112.entry
 
// 经典的小算法,以前摘自网络,原作者不详
[blue]function[/blue] SearchExpression(mNumbers: array of Integer;
mDest: Integer): string;
const
cPrecision = 1E-6;
var
vNumbers: array of Extended;
vExpressions: array of string;
vLength: Integer;
[blue]function[/blue] 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;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := SearchExpression([4, 5, 6, 7], 24);
end;
 
http://www.nanhoo.com/ip/ip.asp
 
用遗传算法吧
 
多人接受答案了。
 
后退
顶部