讨论 / 为啥我的程序有“栈错误”??
abcwuhang 2009-09-05 00:38:00
点我顶贴 收藏 删除
program rq483;

var a,b,c:string;

procedure print(l,r:string[1]);

var st:string;

begin

st:=a;

if l=’+’ then if b[1]=’-’ then st:=st+b

else st:=st+’+’+b

else if b[1]=’-’ then st:=st+’+’+copy(b,2,length(b))

else st:=st+’-’+b;

if r=’+’ then if b[1]=’-’ then st:=st+c

else st:=st+’+’+c

else if b[1]=’-’ then st:=st+’+’+copy(c,2,length(c))

else st:=st+’-’+c;

writeln(st);

halt;

end;

function check(x:string):string;

begin

while copy(x,1,2)=’--’ do

delete(x,1,2);

while copy(x,1,2)=’+-’ do

delete(x,1,1);

while copy(x,1,2)=’-+’ do

delete(x,2,2);

while pos(’+’,x)>0 do

delete(x,pos(’+’,x),1);

while (x[1]=’0’) and (length(x)>1) do

delete(x,1,1);

check:=x;

end;

function minus(x,y:string):string;

forward;

function plus(x,y:string):string;

var jinwei,j,k:shortint;

z:string;

begin

if x=’0’ then exit(check(y));

if y=’0’ then exit(check(x));

if x[1]=’-’ then exit(check(minus(y,x)));

if y[1]=’-’ then exit(check(minus(x,y)));

while length(x)<length(y) do

insert(’0’,x,0);

while length(y)<length(x) do

insert(’0’,y,0);

jinwei:=0;

z:=x;

for j:=length(x) downto 1 do

begin

k:=ord(x[j])-ord(’0’)+ord(y[j])-ord(’0’)+jinwei;

z[j]:=chr(k mod 10+ord(’0’));

jinwei:=k div 10;

end;

if jinwei>0 then insert(’1’,z,0);

plus:=check(z);

end;

function minus(x,y:string):string;

var jiewei,j,k:shortint;

z:string;

begin

if x=y then exit(’0’);

if x=’0’ then exit(check(’-’+y));

if y=’0’ then exit(check(x));

if x[1]=’-’ then exit(check(’-’+plus(y,x)));

if y[1]=’-’ then exit(check(plus(x,y)));

while length(x)<length(y) do

insert(’0’,x,0);

while length(y)<length(x) do

insert(’0’,y,0);

jiewei:=0;

z:=x;

for j:=length(x) downto 1 do

begin

k:=ord(x[j])-ord(y[j])-jiewei;

if k<0 then

begin

jiewei:=1;

k:=k+10;

end

else jiewei:=0;

z[j]:=chr(k mod 10+ord(’0’));

end;

if jiewei>0 then insert(’-’,z,0);

minus:=check(z);

end;

begin

readln(a);

while pos(’ ’,a)>0 do

delete(a,pos(’ ’,a),1);

readln(b);

while pos(’ ’,b)>0 do

delete(b,pos(’ ’,b),1);

readln(c);

while pos(’ ’,c)>0 do

delete(c,pos(’ ’,c),1);

if plus(plus(a,b),c)=’4’ then print(’+’,’+’);

if minus(plus(a,b),c)=’4’ then print(’+’,’-’);

if plus(minus(a,b),c)=’4’ then print(’-’,’+’);

if minus(minus(a,b),c)=’4’ then print(’-’,’-’);

writeln(’no’);

end.

#1 webeskycn@2009-09-04 21:53:00
回复 删除
我的超长代码- -!

program tgmm;

var

i:byte;

a,b,c:int64;

code:integer;

sa,sb,sc:string;

procedure pro;

begin

val(sa,a,code);

val(sb,b,code);

val(sc,c,code);

for i:=1 to 4 do

case i of

1:if (a+b+c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(a,’+’,b,’+’,c);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(a,b,c);

halt;

end;

if (b>0)and(c<0) then

begin

writeln(a,’+’,b,c);

halt;

end;

if (b<0)and(c>0) then

begin

writeln(a,b,’+’,c);

halt;

end;

end;

2:if (a+b-c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(a,’+’,b,’-’,c);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(a,’+’,b,’+’,abs(c));

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(a,b,’-’,c);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(a,b,’+’,c);

halt;

end;

end;

3:if (a-b+c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(a,’-’,b,’+’,c);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(a,’-’,b,c);

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(a,’+’,abs(b),’+’,c);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(a,’+’,b,c);

halt;

end;

end;

4:if (a-b-c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(a,’-’,b,’-’,c);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(a,’-’,b,’+’,abs(c));

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(a,’+’,abs(b),’-’,c);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(a,’+’,abs(b),’+’,abs(c));

halt;

end;

end;

end;

writeln(’no’);

end;

procedure pro1;

begin

for i:=1 to 4 do

case i of

1:if (a+b+c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(sa,’+’,sb,’+’,sc);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(sa,sb,sc);

halt;

end;

if (b>0)and(c<0) then

begin

writeln(sa,’+’,sb,sc);

halt;

end;

if (b<0)and(c>0) then

begin

writeln(sa,sb,’+’,sc);

halt;

end;

end;

2:if (a+b-c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(sa,’+’,sb,’-’,sc);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(sa,’+’,sb,’+’,copy(sc,2,length(sc)));

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(sa,sb,’-’,sc);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(sa,sb,’+’,copy(sc,2,length(sc)));

halt;

end;

end;

3:if (a-b+c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(sa,’-’,sb,’+’,sc);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(sa,’-’,sb,sc);

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(sa,’+’,copy(sb,2,length(sb)),’+’,sc);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(sa,’+’,copy(sb,2,length(sb)),sc);

halt;

end;

end;

4:if (a-b-c)=4 then

begin

if (b>=0)and(c>=0) then

begin

writeln(sa,’-’,sb,’-’,sc);

halt;

end;

if (b>=0)and(c<0) then

begin

writeln(sa,’-’,sb,’+’,copy(sc,2,length(sc)));

halt;

end;

if (b<0)and(c>=0) then

begin

writeln(sa,’+’,copy(sb,2,length(sb)),’-’,sc);

halt;

end;

if (b<0)and(c<0) then

begin

writeln(sa,’+’,copy(sb,2,length(sb)),’+’,copy(sc,2,length(sc)));

halt;

end;

end;

end;

writeln(’no’);

end;

begin {main}

readln(sa);

readln(sb);

readln(sc);

if (length(sa)<=18)and(length(sb)<=18)and(length(sb)<=18) then

pro

else

begin

val(copy(sa,(length(sa)-18),length(sa)),a,code);

val(copy(sb,(length(sb)-18),length(sb)),b,code);

val(copy(sc,(length(sc)-18),length(sc)),c,code);

if sa[1]=’-’ then a:=-a;

if sb[1]=’-’ then b:=-b;

if sc[1]=’-’ then c:=-c;

pro1;

end;

end.

#2 zrp@2009-09-05 00:38:00
回复 删除
意思是您牛死递归了
查看更多回复
提交回复