主题:201溢出问题
program point24;
uses crt;
const number:set of char=['0'..'9'];
op:set of char=['=','-','*','/','(',')'];
var t,times,score:integer;
procedure print(s:string);
var len,l:integer;
begin
len:=length(s);
for l:=1 to len do
begin
write(copy(s,l,1));
delay(10);
end;
writeln();
end;
{------------------------------}
function deal(expression:string):integer;
var
sp:array[1..100] of char;
sn:array[1..100] of integer;
t,tp,n,tn:integer;
function can_cal(ch:char):boolean;
begin
if (ch='#') or (ch=')') or ((sp[tp] in ['*','/']) and (ch in ['+','-']))
then can_cal:=true else can_cal:=false;
end;
procedure cal;
begin
case sp[tp] of
'+':sn[tn-1]:=sn[tn-1]+sn[tn];
'-':sn[tn-1]:=sn[tn-1]-sn[tn];
'*':sn[tn-1]:=sn[tn-1]*sn[tn];
'/':sn[tn-1]:=sn[tn-1] div sn[tn];
end;
dec(tn);
dec(tp);
end;
begin
write(expression+'=');
expression:=expression+'#';
tn:=0;
tp:=1;
sp[1]:='#';
t:=1;
repeat
if expression[t] in number then
begin
n:=0;
repeat
n:=n*10+ord(expression[t])-48;
inc(t);
until not (expression[t] in number);
inc(tn);
sn[tn]:=n
end
else begin
if (expression[t]='(') or not can_cal(expression[t]) then
begin
inc(tp);
sp[tp]:=expression[t];
inc(t);
end
else if expression[t]=')' then
begin
while sp[tp]<>'(' do cal;
dec(tp);
inc(t);
end
else cal;
end;
until (expression[t]='#') and (sp[tp]='#');
writeln(sn[1]);
deal:=sn[1];
readln;
end;
{------------------------------}
procedure com_deal(a1,a2,a3,a4:integer);
var sign:array[1..5] of char=('+','-','*','/',' ');
num:array[1..5] of integer;
loop,i,j,k,l:integer;
flag:longint;
function calc(a,b,c:integer):longint;
begin
case sign[c] of
'+':calc:=a+b;
'-':calc:=a-b;
'*':calc:=a*b;
'/':
begin
if (a>b) and (b<>0) then calc:=a div b;
end;
end;
end;
procedure add(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(a,b,i);
sum2:=calc(sum1,c,j);
sum3:=calc(sum2,d,k);
if(sum3=24) then
begin
inc(flag);
writeln('(','(',a,sign[i],b,')',sign[j],c,')',sign[k],d,'=',sum3);
end;
end;
procedure add1(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(a,b,i);
sum2:=calc(c,d,k);
sum3:=calc(sum1,sum2,j);
if(sum3=24)then
begin
inc(flag);
writeln('(',a,sign[i],b,')',sign[j],'(',c,sign[k],d,')','=',sum3);
end;
end;
procedure add2(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(b,c,j);
sum2:=calc(a,sum1,i);
sum3:=calc(sum2,d,k);
if(sum3=24)then
begin
inc(flag);
writeln('(',a,sign[i],'(',b,sign[j],c,')',')',sign[k],d,'=',sum3);
end;
end;
procedure solve(a,b,c,d:integer);
var i,j,k:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to 4 do
begin
add(a,b,c,d,i,j,k);
add1(a,b,c,d,i,j,k);
add2(a,b,c,d,i,j,k);
end;
end;
begin
num[1]:=a1;
num[2]:=a2;
num[3]:=a3;
num[4]:=a4;
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to 4 do
for l:=1 to 4 do
if not (i=j)and not (i=k)and not (i=l)and not (j=k)and not (k=l)and not (j=l) then
solve(num[i],num[j],num[k],num[l]);
if(flag=0) then
writeln('It seemed that didn''t have the answer.');
readln;
end;
{------------------------------}
procedure play;
var a1,a2,a3,a4,loop,score:integer;
expression:string;
begin
randomize();
a1:=trunc(random(9)+1);
a2:=trunc(random(9)+1);
a3:=trunc(random(9)+1);
a4:=trunc(random(9)+1);
writeln('>>',':',a1,' ',a2,' ',a3,' ',a4);
write('Input the expression:');
readln(expression);
if deal(expression)=24 then
begin
inc(score);
write('Good! Score you got:',score);
for loop:=1 to score do write('Y');
end
else begin
write('Score you got:',score);
writeln('Miss!Let computer help you:');
readln;
com_deal(a1,a2,a3,a4);
end;
end;
begin
score:=0;
clrscr;
write('Set time:');
readln(times);
for t:=1 to times do
begin
play;
readln;
end;
end.
这是一个24点的小游戏,虽然可以运行但是达不到预期效果(效果:随机产生4个1~10不包括10的随机数,玩家利用“+”,“-”‘,“*”,“/”,“(”,“)”输入表达式,计算机将表达式处理输出结果,如果等于24,玩家赢,若不等则输出计算机输出正确的计算过程(这个过程采用的是穷举法,运行上代码后运行到这个过程后显示溢出(exitcode 201)但是始终找不到是那部分溢出)。
请高手帮忙
uses crt;
const number:set of char=['0'..'9'];
op:set of char=['=','-','*','/','(',')'];
var t,times,score:integer;
procedure print(s:string);
var len,l:integer;
begin
len:=length(s);
for l:=1 to len do
begin
write(copy(s,l,1));
delay(10);
end;
writeln();
end;
{------------------------------}
function deal(expression:string):integer;
var
sp:array[1..100] of char;
sn:array[1..100] of integer;
t,tp,n,tn:integer;
function can_cal(ch:char):boolean;
begin
if (ch='#') or (ch=')') or ((sp[tp] in ['*','/']) and (ch in ['+','-']))
then can_cal:=true else can_cal:=false;
end;
procedure cal;
begin
case sp[tp] of
'+':sn[tn-1]:=sn[tn-1]+sn[tn];
'-':sn[tn-1]:=sn[tn-1]-sn[tn];
'*':sn[tn-1]:=sn[tn-1]*sn[tn];
'/':sn[tn-1]:=sn[tn-1] div sn[tn];
end;
dec(tn);
dec(tp);
end;
begin
write(expression+'=');
expression:=expression+'#';
tn:=0;
tp:=1;
sp[1]:='#';
t:=1;
repeat
if expression[t] in number then
begin
n:=0;
repeat
n:=n*10+ord(expression[t])-48;
inc(t);
until not (expression[t] in number);
inc(tn);
sn[tn]:=n
end
else begin
if (expression[t]='(') or not can_cal(expression[t]) then
begin
inc(tp);
sp[tp]:=expression[t];
inc(t);
end
else if expression[t]=')' then
begin
while sp[tp]<>'(' do cal;
dec(tp);
inc(t);
end
else cal;
end;
until (expression[t]='#') and (sp[tp]='#');
writeln(sn[1]);
deal:=sn[1];
readln;
end;
{------------------------------}
procedure com_deal(a1,a2,a3,a4:integer);
var sign:array[1..5] of char=('+','-','*','/',' ');
num:array[1..5] of integer;
loop,i,j,k,l:integer;
flag:longint;
function calc(a,b,c:integer):longint;
begin
case sign[c] of
'+':calc:=a+b;
'-':calc:=a-b;
'*':calc:=a*b;
'/':
begin
if (a>b) and (b<>0) then calc:=a div b;
end;
end;
end;
procedure add(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(a,b,i);
sum2:=calc(sum1,c,j);
sum3:=calc(sum2,d,k);
if(sum3=24) then
begin
inc(flag);
writeln('(','(',a,sign[i],b,')',sign[j],c,')',sign[k],d,'=',sum3);
end;
end;
procedure add1(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(a,b,i);
sum2:=calc(c,d,k);
sum3:=calc(sum1,sum2,j);
if(sum3=24)then
begin
inc(flag);
writeln('(',a,sign[i],b,')',sign[j],'(',c,sign[k],d,')','=',sum3);
end;
end;
procedure add2(a,b,c,d,i,j,k:longint);
var sum1,sum2,sum3:longint;
begin
sum1:=calc(b,c,j);
sum2:=calc(a,sum1,i);
sum3:=calc(sum2,d,k);
if(sum3=24)then
begin
inc(flag);
writeln('(',a,sign[i],'(',b,sign[j],c,')',')',sign[k],d,'=',sum3);
end;
end;
procedure solve(a,b,c,d:integer);
var i,j,k:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to 4 do
begin
add(a,b,c,d,i,j,k);
add1(a,b,c,d,i,j,k);
add2(a,b,c,d,i,j,k);
end;
end;
begin
num[1]:=a1;
num[2]:=a2;
num[3]:=a3;
num[4]:=a4;
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to 4 do
for l:=1 to 4 do
if not (i=j)and not (i=k)and not (i=l)and not (j=k)and not (k=l)and not (j=l) then
solve(num[i],num[j],num[k],num[l]);
if(flag=0) then
writeln('It seemed that didn''t have the answer.');
readln;
end;
{------------------------------}
procedure play;
var a1,a2,a3,a4,loop,score:integer;
expression:string;
begin
randomize();
a1:=trunc(random(9)+1);
a2:=trunc(random(9)+1);
a3:=trunc(random(9)+1);
a4:=trunc(random(9)+1);
writeln('>>',':',a1,' ',a2,' ',a3,' ',a4);
write('Input the expression:');
readln(expression);
if deal(expression)=24 then
begin
inc(score);
write('Good! Score you got:',score);
for loop:=1 to score do write('Y');
end
else begin
write('Score you got:',score);
writeln('Miss!Let computer help you:');
readln;
com_deal(a1,a2,a3,a4);
end;
end;
begin
score:=0;
clrscr;
write('Set time:');
readln(times);
for t:=1 to times do
begin
play;
readln;
end;
end.
这是一个24点的小游戏,虽然可以运行但是达不到预期效果(效果:随机产生4个1~10不包括10的随机数,玩家利用“+”,“-”‘,“*”,“/”,“(”,“)”输入表达式,计算机将表达式处理输出结果,如果等于24,玩家赢,若不等则输出计算机输出正确的计算过程(这个过程采用的是穷举法,运行上代码后运行到这个过程后显示溢出(exitcode 201)但是始终找不到是那部分溢出)。
请高手帮忙