谁能编一个计算器给我?(用pascal,+-*⼀都行)

2025-03-13 21:52:48
推荐回答(2个)
回答1:

去年编的 应该没错吧。。。带次方和括号的 除号是整除 带负数 有优先级
反正TYVJ P1403能过
计算过程中不要超过longint就行(不够改int64大点)

var
st:string;
i,pn,pf,t,q:longint;
f:array[0..1000] of char;
n:array[1..1000] of longint;

function f1(ch:char):integer;
begin
if (ch='(') then exit(0);
if (ch='+') or (ch='-') then exit(1);
if (ch='*') or (ch='/') then exit(2);
if ch='^' then exit(3);
end;

function suan(x1,x2:longint;ch:char):longint;
var
t,i:longint;
begin
if ch='+' then exit(x1+x2);
if ch='-' then exit(x1-x2);
if ch='*' then exit(x1*x2);
if ch='/' then exit(x1 div x2);
if ch='^' then
begin
t:=1;
for i:=1 to x2 do t:=t*x1;
exit(t);
end;
end;

procedure pop;
var
x1,x2,x:longint;
ch:char;
begin
ch:=f[pf];dec(pf);
x2:=n[pn];dec(pn);
x1:=n[pn];dec(pn);
x:=suan(x1,x2,ch);
inc(pn);
n[pn]:=x;
end;

begin
readln(st);
pn:=0;
pf:=0;
i:=1;
while i<=length(st) do
begin
if (st[i]>='0') and (st[i]<='9') then
begin
t:=0;if st[i]='-' then begin q:=-1; i:=i+1; end else q:=1;
while (i<=length(st)) and (st[i]>='0') and (st[i]<='9') do
begin
t:=t*10+ord(st[i])-48;
i:=i+1;
end;
pn:=pn+1;
n[pn]:=q*t;
end
else
begin
if st[i]='(' then
begin
pf:=pf+1;
f[pf]:=st[i];
end
else
if st[i]=')' then
begin
while f[pf]<>'(' do
pop;
pf:=pf-1;
end
else
if (pf=0) or (f1(st[i])>f1(f[pf])) then
begin
pf:=pf+1;
f[pf]:=st[i];
if pn=0 then begin pn:=pn+1;n[pn]:=0;end;
end
else
begin
while (pf>0) and (f1(st[i])<=f1(f[pf])) do
pop;
pf:=pf+1;
f[pf]:=st[i];
end;
i:=i+1;
end;
end;
for i:=pf downto 1 do
if (f[pf]<>'(') and (f[pf]<>')') and (pf>0) and (pn>1) then pop;
writeln(n[1]);
end.

纯自创 哪边看不懂问我
这如果再遇上抄袭的就假了

回答2:

+-*/,,外带n的k次方,不过没用高精。

var a:array[1..1000] of longint;
c1,c:array[1..100] of char;
ss,l,r,i,j,k:longint;
n,s:string;
begin
readln(n);n:=n+'.';
l:=1;r:=0;k:=0;
for i:=1 to length(n) do
if not(n[i]in['0'..'9']) then begin
r:=i-1;
s:=copy(n,l,r-l+1);
inc(k);
val(s,a[k]);
l:=i+1;
s:='';
c[k]:=n[i];end;
i:=0;
while iif c[i]='^' then begin
ss:=1;
for j:=1 to a[i+1] do
ss:=ss*a[i];a[i]:=ss;
for j:=i+1 to k-1 do
a[j]:=a[j+1];
for j:=i to k-1 do
c[j]:=c[j+1];
k:=k-1;i:=i-1;
end;end;
i:=0;
while iif c[i]='*' then begin
a[i]:=a[i+1]*a[i];
for j:=i+1 to k-1 do
a[j]:=a[j+1];
for j:=i to k-1 do
c[j]:=c[j+1];
k:=k-1;i:=i-1;end
else if c[i]='/' then begin
a[i]:=a[i] div a[i+1];
for j:=i+1 to k-1 do
a[j]:=a[j+1];
for j:=i to k-1 do
c[j]:=c[j+1];i:=i-1;
k:=k-1;end;end;
i:=0;
while iif c[i]='+' then begin
a[i]:=a[i+1]+a[i];
for j:=i+1 to k-1 do
a[j]:=a[j+1];
for j:=i to k-1 do
c[j]:=c[j+1];
k:=k-1;i:=i-1;end
else if c[i]='-' then begin
a[i]:=a[i]-a[i+1];
for j:=i+1 to k-1 do
a[j]:=a[j+1];
for j:=i to k-1 do
c[j]:=c[j+1];
k:=k-1;i:=i-1;
end;end;
writeln(a[1]);
end.