program Calculator;
uses crt;
label lb1,lb2,lb3,lb4;
type
posi = (left,right);
func = (log,lnE,pow,add,divide,multiply,sub,sn,cs,tg,ctg,arctg,arcctg,
arcsin,arccos,sh,ch,th,cth,none);
lg = record
a:integer;
b:integer;
end;
funct = record
fun: func;
val1,val2: real;
end;
var
inS,outS,s:string;
f: func;
a,b:real;
i,l,pogr:integer;
function GetNumber(s:string):integer;
var
k:integer;
begin
k:=0;
while pos('(',s)<>0 do
begin
delete(s,pos('(',s),1);
delete(s,pos(')',s),1);
k:=k+1;
end;
GetNumber:=k;
end;
function IsDigit(s:string):boolean;
var
t:boolean;
i:integer;
begin
t:=true;
for i:=1 to length(s) do
if not (s[i] in ['0'..'9','.']) then
t:=false;
isDigit:=t;
end;
function GetFuncFromName(s:string):func;
var
f:func;
begin
f:=none;
if s='log' then f:=log;
if s='ln' then f:=lnE;
if s='^' then f:=pow;
if s='+' then f:=add;
if s='/' then f:=divide;
if s='*' then f:=multiply;
if s='-' then f:=sub;
if s='sin' then f:=sn;
if s='cos' then f:=cs;
if s='tg' then f:=tg;
if s='ctg' then f:=ctg;
if s='arctg' then f:=arctg;
if s='arcctg' then f:=arcctg;
if s='arcsin' then f:=arcsin;
if s='arccos' then f:=arccos;
if s='sh' then f:=sh;
if s='ch' then f:=ch;
if s='th' then f:=th;
if s='cth' then f:=cth;
GetFuncFromName:=f;
end;
function GetSkobFunc(s:string;Num:integer):string;
var
i,j,k,l:integer;
res:real;
begin
j:=Num;
i:=1;
while j<>0 do
begin
if s[i]='(' then j:=j-1;
i:=i+1;
end;
k:=1;
for j:=i to length(s) do
begin
if s[j]='(' then
k:=k+1;
if s[j]=')' then
break;
end;
for j:=i to length(s) do
begin
if s[j]=')' then k:=k-1;
if k=0 then break;
end;
GetSkobFunc:=copy(s,i,j-i);
end;
function GetNumberFunc(s:string):integer;
var
i,k:integer;
begin
k:=0;
for i:=1 to length(s) do
if ((s[i-1] in ['0'..'9',')','(']) and (s[i]='-')) or (s[i]='^') or (s[i]='/') or (s[i]='+') or (s[i]='*')
or ( (s[i] in ['a'..'z']) and (not (s[i-1] in ['a'..'z'])) )
or ( (s[i] in ['A'..'Z']) and (not (s[i-1] in ['A'..'Z'])) ) then
k:=k+1;
GetNumberFunc:=k;
end;
function GetLegthVal(s:string;index:integer;p:posi):integer;
var
k:integer;
begin
k:=0;
if p=left then
for i:=index-1 downto 1 do
if (s[i] in ['0'..'9','.',')','(']) or ((s[i]='-') and (not (s[i-1] in ['0'..'9',')','(','e']))) then
k:=k+1
else
break;
if p=right then
for i:=index+1 to length(s) do
if (s[i] in ['0'..'9','.','(',')']) or ( (i=index+1) and (s[i+1] in ['0'..'9','(',')','e']) ) then
k:=k+1
else
break;
GetLegthVal:=k;
end;
function GetVal(s:string;index:integer;p:posi):real;
var
i,k:integer;
a:real;
x:integer;
s1:string;
begin
s1:='';
if p=left then
begin
for i:=index-1 downto 1 do
if (s[i] in ['0'..'9','.',')']) or ((s[i]='-') and (not (s[i-1] in ['0'..'9',')','(','e']))) then
begin
if s[i]<>')' then
s1:=s[i]+s1;
end
else
break;
end
else
for i:=index+1 to length(s) do
if (s[i] in ['0'..'9','.','(']) or ( (i=index+1) and (s[i]='-') and (s[i+1] in ['0'..'9','(',')','e']) ) then
begin
if s[i]<>'(' then
s1:=s1+s[i];
end
else
break;
val(s1,a,x);
GetVal:=a;
end;
function GetValLg(s:string;index:integer):real;
var
i,j:integer;
a:real;
s1:string;
begin
s1:='';
for i:=index+1 to length(s) do
if s[i]='_' then
break;
for j:=i+1 to length(s) do
if s[j] in ['0'..'9','.'] then
s1:=s1+s[j]
else break;
val(s1,a,i);
GetValLg:=a;
end;
function GetResFunc(f: funct):real;
begin
GetResFunc:=0;
with F do
begin
case fun of
tg: GetResFunc:=sin(val2)/cos(val2);
log: GetResFunc:=ln(val2)/ln(val1);
sn: GetResFunc:=sin(val2);
cs: GetResFunc:=cos(val2);
ctg: GetResFunc:=cos(val2)/sin(val2);
pow: GetResFunc:=exp( val2*ln(val1) );
add: GetResFunc:=val1+val2;
divide: GetResFunc:=val1/val2;
multiply: GetResFunc:=val1*val2;
sub: GetResFunc:=val1-val2;
lnE: GetResFunc:=ln(val2);
end;
end;
end;
function ClearStr(s:String):string;
var
i,k,o,p:integer;
j:char;
s1:string;
begin
k:=0;
j:=s[pos('.',s)+1];
for i:=pos('.',s)+1 to length(s) do
if s[i]=j then k:=k+1
else break;
if k>pogr then
begin
delete(s,pos('.',s)+4,length(s));
if j='9' then
begin
val(copy(s,1,pos('.',s)-1),i,o);
i:=i+1;
str(i,s);
end;
while s[length(s)]='0' do
delete(s,length(s),1);
if s[length(s)]='.' then
delete(s,length(s),1);
if (s[1]='-') and (s[2]='0') then
delete(s,1,1);
end;
ClearStr:=s;
end;
function RealToStr(a:string):string;
var
i,j:integer;
s,s1:string;
t:boolean;
begin
t:=false;
s:='';
s1:='';
while a[1]=' ' do
delete(a,1,1);
for i:=1 to length(a) do
if a[i]in ['0'..'9','.','-'] then
begin
if a[i]<>'.' then
s:=s+a[i];
end
else
break;
for i:=length(a) downto 1 do
if a[i] in ['1'..'9'] then
s1:=s1+a[i]
else
break;
val(s1,i,j);
if a[pos('E',a)+1]='+' then
begin
if s[1]<>'-' then
insert('.',s,i+2)
else
insert('.',s,i+3);
end
else
begin
if s[1]='-' then
begin
delete(s,1,1);
t:=true;
end;
j:=i;
while j<>1 do
begin
s:='0'+s;
j:=j-1;
end;
s:='0.'+s;
if t then s:='-'+s;
end;
while s[length(s)]='0' do
delete(s,length(s),1);
if s[length(s)]='.' then
delete(s,length(s),1);
RealToStr:=ClearStr(s){s};
end;
function Result(s:string):string;
var
i,k,l:integer;
a:real;
res:real;
f:funct;
s1,s2:string;
begin
i:=1;
while GetNumberFunc(s)<>0 do
begin
if copy(s,i,2)='tg' then
begin
with f do
begin
fun:=tg;
val2:=Getval(s,i+1,right);
end;
str(GetResFunc(f),s1);
s1:=RealToStr(s1);
delete(s,i,getLegthVal(s,i+1,Right)+2);
insert({copy(s1,1,length(s1)-8)}s1,s,i);
i:=0;
end;
if copy(s,i,3)='log' then
begin
with f do
begin
fun:=log;
val1:=GetVal(s,i+2,right);
val2:=getvallg(s,i+2);
str(val2,s2);
end;
str(GetResFunc(f),s1);
s1:=RealToStr(s1);
delete(s,i,getLegthVal(s,i+2,Right)+length(s2)+3);
insert({copy(s1,1,length(s1)-8)}s1,s,i);
i:=0;
end;
if (copy(s,i,3)='sin') or (copy(s,i,3)='cos') or (copy(s,i,3)='ctg') then
begin
with f do
begin
fun:=GetFuncFromName(copy(s,i,3));
val2:=GetVal(s,i+2,right);
end;
str(GetResFunc(f),s1);
s1:=RealToStr(s1);
delete(s,i,getLegthVal(s,i+2,Right)+3);
insert({copy(s1,1,length(s1)-8)}s1,s,i);
i:=0;
end;
if copy(s,i,2)='ln' then
begin
with f do
begin
fun:=lnE;
val2:=GetVal(s,i+1,right);
end;
str(GetResFunc(f),s1);
s1:=RealToStr(s1);
delete(s,i,getLegthVal(s,i+1,Right)+2);
insert({copy(s1,1,length(s1)-8)}s1,s,i);
i:=0;
end;
if ( ( ( (s[i]='-') and (s[i-1] in ['0'..'9',')','(','e']) ) or (s[i]='+') ) and (pos('^',s)=0) and
(pos('*',s)=0) and (pos('/',s)=0) )
or ( ((s[i]='*') or (s[i]='/')) and (pos('^',s)=0) ) or (s[i]='^') then
begin
with f do
begin
fun:=GetFuncFromName(s[i]);
val1:=GetVal(s,i,left);
val2:=GetVal(s,i,right);
end;
l:=GetLegthVal(s,i,left);
str(GetResFunc(f),s1);
s1:=RealToStr(s1);
delete(s,i-l,l+getLegthVal(s,i,Right)+1);
insert({copy(s1,1,length(s1)-8)}s1,s,i-l);
i:=0;
end;
i:=i+1;
end;
Result:=s;
end;
function GetPosSkob(s:string;number:integer;p:posi):integer;
var
i,j,k,l,h,o:integer;
res:real;
begin
j:=Number;
i:=1;
while j<>0 do
begin
if s[i]='(' then j:=j-1;
i:=i+1;
end;
h:=i-1;
k:=1;
for j:=i to length(s) do
begin
if s[j]='(' then
k:=k+1;
if s[j]=')' then
break;
end;
for j:=i to length(s) do
begin
if s[j]=')' then k:=k-1;
if k=0 then break;
end;
if p=left then getposSkob:=h
else GetPosSkob:=j;
end;
function ReplaseConst(s:string):string;
var
i:integer;
t:boolean;
s1:string;
begin
i:=0;
t:=False;
while t<>true do
begin
if pos('pi',s)>0 then
begin
i:=pos('pi',s);
delete(s,i,2);
str(pi,s1);
insert(RealToStr(s1),s,i);
end
else
T:=true;
if pos('e',s)>0 then
begin
i:=pos('e',s);
delete(s,i,1);
str(exp(1),s1);
insert(RealToStr(s1),s,i);
T:=False;
end;
end;
ReplaseConst:=s;
end;
function resultSkob(s:string):string;
var
i,r,l,o:integer;
s1:string;
label lb1;
begin
i:=1;
while GetNumber(s)<>0 do
begin
i:=GetNumber(s);
l:=getPosSkob(s,i,left);
r:=getPosSkob(s,i,right);
s1:=ResultSkob(GetSkobFunc(s,i));
delete(s,l,r-l+1);
insert(s1,s,l);
end;
lb1:
ResultSkob:=result(s);
end;
function replaseX(s,n:string):string;
var
i:integer;
begin
while pos('x',s)<>0 do
begin
i:=pos('x',s);
delete(s,i,1);
insert(n,s,i);
end;
ReplaseX:=s;
end;
begin
ClrScr;
writeln('Enter pogr: ');
readln(pogr);
writeln('Use x: ');
readln(ins);
if (ins[1]='n') or (ins[1]='N') then
begin
lb4:
writeln('Enter, if want exit then enter Exit: ');
readln(ins);
if copy(ins,2,2)='xi' then
goto lb1
else
writeln(ResultSkob(ReplaseConst(ins)));
goto lb4;
end
else
begin
writeln('Enter with x: ');
readln(ins);
s:=ins;
lb2:
writeln('Enter x. If want exit, then enter Exit: ');
readln(outs);
ins:=s;
if copy(outs,2,2)='xi' then
goto lb1
else
begin
writeln(ResultSkob(ReplaseConst(replaseX(ins,outs))));
goto lb2;
end;
end;
lb1:
end.
