Вычислитель математических формул
Вот что я обнаружил несколько дней назад при просмотре зарубежных источников:
FORMULA должна быть стокой, содержащей формулу. Допускаются переменные x, y и z, а также операторы, перечисленные ниже. Пример:
sin(x)*cos(x^y)+exp(cos(x)) |
Использование:
uses EVALCOMP; var calc: EVALVEC ; (evalvec - указатель на объект, определяемый evalcomp) FORMULA: string;
begin FORMULA:='x+y+z'; new (calc,init(FORMULA)); (Построение дерева оценки) writeln ( calc^.eval1d(7) ) ; (x=7 y=0 z=0; result: 7) writeln ( calc^.eval2d(7,8) ) ; (x=7 y=8 z=0; result: 15) writeln ( calc^.eval3d(7,8,9) ) ; (x=7 y=8 z=9; result: 24) dispose(calc,done); (разрушение дерева оценки) end. |
Допустимые операторы:
x <l;> y ; Логические операторы возвращают 1 в случае истины и 0 если ложь. x <l;= y x >= y x > y x <l; y x = y x + y x - y x eor y ( исключающее или ) x or y x * y x / y x and y x mod y x div y x ^ y ( степень ) x shl y x shr y not (x) sinc (x) sinh (x) cosh (x) tanh (x) coth (x) sin (x) cos (x) tan (x) cot (x) sqrt (x) sqr (x) arcsinh (x) arccosh (x) arctanh (x) arccoth (x) arcsin (x) arccos (x) arctan (x) arccot (x) heavy (x) ; 1 для положительных чисел, 0 для остальных sgn (x) ; 1 для положительных чисел, -1 для отрицательных и 0 для нуля frac (x) exp (x) abs (x) trunc (x) ln (x) odd (x) pred (x) succ (x) round (x) int (x) fac (x) ; x*(x-1)*(x-2)*...*3*2*1 rnd ; Случайное число в диапазоне [0,1] rnd (x) ; Случайное число в диапазоне [0,x] pi e |
unit evalcomp; interface type fun= function(x,y:real):real; evalvec= ^evalobj;
evalobj= object
f1,f2:evalvec;
f1x,f2y:real;
f3:fun;
function eval:real;
function eval1d(x:real):real;
function eval2d(x,y:real):real;
function eval3d(x,y,z:real):real;
constructor init(st:string);
destructor done;
end;
var evalx,evaly,evalz:real;implementation var analysetmp:fun; function search (text,code:string; var pos:integer):boolean; var i,count:integer; flag:boolean;
newtext:string;
beginif length(text)<l;length(code) then begin search:=false; exit; end;
flag:=false;
pos:=length(text)-length(code)+1;
repeat
if code=copy(text,pos,length(code))
then flag:=true
else dec(pos);
if flag
then
begin
count:=0;
for i:= pos+1 to length(text) do
begin
if copy(text,i,1) = '(' then inc(count);
if copy(text,i,1) = ')' then dec(count);
end;
if count<l;>0
then
begin
dec(pos);
flag:=false;
end;
end;
until (flag=true) or (pos=0);
search:=flag;
end;function myid(x,y:real):real; begin myid:=x;
end;function myunequal(x,y:real):real; begin if x<>y then
myunequal:=1
else
myunequal:=0;
end;function mylessequal(x,y:real):real; begin if x<=y then
mylessequal:=1
else
mylessequal:=0;
end;function mygreaterequal(x,y:real):real; begin if x>=y then
mygreaterequal:=1
else
mygreaterequal:=0;
end;function mygreater(x,y:real):real; begin if x>y then
mygreater:=1
else
mygreater:=0;
end;function myless(x,y:real):real; begin if x<y then
myless:=1
else
myless:=0;
end;function myequal(x,y:real):real; begin if x=y then
myequal:=1
else
myequal:=0;
end;function myadd(x,y:real):real; begin myadd:=x+y;
end;function mysub(x,y:real):real; begin mysub:=x-y;
end;function myeor(x,y:real):real; begin myeor:=trunc(x) xor trunc(y);
end;function myor(x,y:real):real; begin myor:=trunc(x) or trunc(y);
end;function mymult(x,y:real):real; begin mymult:=x*y;
end;function mydivid(x,y:real):real; begin mydivid:=x/y;
end;function myand(x,y:real):real; begin myand:=trunc(x) and trunc(y);
end;function mymod(x,y:real):real; begin mymod:=trunc(x) mod trunc(y);
end;function mydiv(x,y:real):real; begin mydiv:=trunc(x) div trunc(y);
end;function mypower(x,y:real):real; begin if x=0 then
mypower:=0
else
if x>0 then
mypower:=exp(y*ln(x))
else
if trunc(y)<>y then
begin
writeln (' Немогу вычислить x^y ');
halt;
end
else
if odd(trunc(y))=true then
mypower:=-exp(y*ln(-x))
else
mypower:=exp(y*ln(-x))
end;function myshl(x,y:real):real; begin myshl:=trunc(x) shl trunc(y);
end;function myshr(x,y:real):real; begin myshr:=trunc(x) shr trunc(y);
end;function mynot(x,y:real):real; begin mynot:=not trunc(x);
end;function mysinc(x,y:real):real; begin if x=0 then mysinc:=1
elsemysinc:=sin(x)/x
end;function mysinh(x,y:real):real; begin mysinh:=0.5*(exp(x)-exp(-x)) end; function mycosh(x,y:real):real; begin mycosh:=0.5*(exp(x)+exp(-x)) end; function mytanh(x,y:real):real; begin mytanh:=mysinh(x,0)/mycosh(x,0) end; function mycoth(x,y:real):real; begin mycoth:=mycosh(x,0)/mysinh(x,0) end; function mysin(x,y:real):real; begin mysin:=sin(x) end; function mycos(x,y:real):real; begin mycos:=cos(x) end; function mytan(x,y:real):real; begin mytan:=sin(x)/cos(x) end; function mycot(x,y:real):real; begin mycot:=cos(x)/sin(x) end; function mysqrt(x,y:real):real; begin mysqrt:=sqrt(x) end; function mysqr(x,y:real):real; begin mysqr:=sqr(x) end; function myarcsinh(x,y:real):real; begin myarcsinh:=ln(x+sqrt(sqr(x)+1)) end; function mysgn(x,y:real):real; begin if x=0 then mysgn:=0
elsemysgn:=x/abs(x)
end;function myarccosh(x,y:real):real; begin myarccosh:=ln(x+mysgn(x,0)*sqrt(sqr(x)-1)) end; function myarctanh(x,y:real):real; begin myarctanh:=ln((1+x)/(1-x))/2 end; function myarccoth(x,y:real):real; begin myarccoth:=ln((1-x)/(1+x))/2 end; function myarcsin(x,y:real):real; begin if x=1 then myarcsin:=pi/2
elsemyarcsin:=arctan(x/sqrt(1-sqr(x)))
end;function myarccos(x,y:real):real; begin myarccos:=pi/2-myarcsin(x,0) end; function myarctan(x,y:real):real; begin myarctan:=arctan(x); end; function myarccot(x,y:real):real; begin myarccot:=pi/2-arctan(x) end; function myheavy(x,y:real):real; begin myheavy:=mygreater(x,0) end; function myfrac(x,y:real):real; begin myfrac:=frac(x) end; function myexp(x,y:real):real; begin myexp:=exp(x) end; function myabs(x,y:real):real; begin myabs:=abs(x) end; function mytrunc(x,y:real):real; begin mytrunc:=trunc(x) end; function myln(x,y:real):real; begin myln:=ln(x) end; function myodd(x,y:real):real; begin if odd(trunc(x)) then myodd:=1
elsemyodd:=0;
end;function mypred(x,y:real):real; begin mypred:=pred(trunc(x)); end; function mysucc(x,y:real):real; begin mysucc:=succ(trunc(x)); end; function myround(x,y:real):real; begin myround:=round(x); end; function myint(x,y:real):real; begin myint:=int(x); end; function myfac(x,y:real):real; var n : integer; r : real;
beginif x<0 then begin writeln(' Немогу вычислить факториал '); halt; end; if x = 0 then myfac := 1 else begin
r := 1;
for n := 1 to trunc ( x ) do
r := r * n;
myfac:= r;
end;
end;function myrnd(x,y:real):real; begin myrnd:=random; end; function myrandom(x,y:real):real; begin myrandom:=random(trunc(x)); end; function myevalx(x,y:real):real; begin myevalx:=evalx; end; function myevaly(x,y:real):real; begin myevaly:=evaly; end; function myevalz(x,y:real):real; begin myevalz:=evalz; end; procedure analyse (st:string; var st2,st3:string); label start; var pos:integer;
value:real;
newterm,term:string;
beginterm:=st; start: if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
newterm:='';
for pos:= 1 to length(term) do
if copy(term,pos,1)<>' ' then newterm:=newterm+copy(term,pos,1);
term:=newterm;
if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
val(term,value,pos);
if pos=0 then begin
analysetmp:=myid;
st2:=term;
st3:='';
exit;
end;
if search(term,'<>',pos) then begin
analysetmp:=myunequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'<=',pos) then begin
analysetmp:=mylessequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>=',pos) then begin
analysetmp:=mygreaterequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>',pos) then begin
analysetmp:=mygreater;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'<',pos) then begin
analysetmp:=myless;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'=',pos) then begin
analysetmp:=myequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'+',pos) then begin
analysetmp:=myadd;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'-',pos) then begin
analysetmp:=mysub;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'eor',pos) then begin
analysetmp:=myeor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'or',pos) then begin
analysetmp:=myor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'*',pos) then begin
analysetmp:=mymult;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'/',pos) then begin
analysetmp:=mydivid;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'and',pos) then begin
analysetmp:=myand;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'mod',pos) then begin
analysetmp:=mymod;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'div',pos) then begin
analysetmp:=mydiv;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'^',pos) then begin
analysetmp:=mypower;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'shl',pos) then begin
analysetmp:=myshl;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'shr',pos) then begin
analysetmp:=myshr;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if copy(term,1,1)='(' then begin
term:=copy(term,2,length(term)-2);
goto start;
end;
if copy(term,1,3)='not' then begin
analysetmp:=mynot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sinc' then begin
analysetmp:=mysinc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='sinh' then begin
analysetmp:=mysinh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='cosh' then begin
analysetmp:=mycosh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='tanh' then begin
analysetmp:=mytanh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='coth' then begin
analysetmp:=mycoth;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sin' then begin
analysetmp:=mysin;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cos' then begin
analysetmp:=mycos;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='tan' then begin
analysetmp:=mytan;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cot' then begin
analysetmp:=mycot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sqrt' then begin
analysetmp:=mysqrt;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sqr' then begin
analysetmp:=mysqr;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,7)='arcsinh' then begin
analysetmp:=myarcsinh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccosh' then begin
analysetmp:=myarccosh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arctanh' then begin
analysetmp:=myarctanh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccoth' then begin
analysetmp:=myarccoth;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,6)='arcsin' then begin
analysetmp:=myarcsin;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccos' then begin
analysetmp:=myarccos;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arctan' then begin
analysetmp:=myarctan;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccot' then begin
analysetmp:=myarccot;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,5)='heavy' then begin
analysetmp:=myheavy;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='sgn' then begin
analysetmp:=mysgn;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='frac' then begin
analysetmp:=myfrac;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='exp' then begin
analysetmp:=myexp;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='abs' then begin
analysetmp:=myabs;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,5)='trunc' then begin
analysetmp:=mytrunc;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,2)='ln' then begin
analysetmp:=myln;
st2:=copy(term,3,length(term)-2);
st3:='';
exit;
end;
if copy(term,1,3)='odd' then begin
analysetmp:=myodd;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='pred' then begin
analysetmp:=mypred;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='succ' then begin
analysetmp:=mysucc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,5)='round' then begin
analysetmp:=myround;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='int' then begin
analysetmp:=myint;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='fac' then begin
analysetmp:=myfac;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='rnd' then begin
analysetmp:=myrnd;
st2:='';
st3:='';
exit;
end;
if copy(term,1,3)='rnd' then begin
analysetmp:=myrandom;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='x' then begin
analysetmp:=myevalx;
st2:='';
st3:='';
exit;
end;
if term='y' then begin
analysetmp:=myevaly;
st2:='';
st3:='';
exit;
end;
if term='z' then begin
analysetmp:=myevalz;
st2:='';
st3:='';
exit;
end;
if (term='pi') then begin
analysetmp:=myid;
str(pi,st2);
st3:='';
exit;
end;
if term='e' then begin
analysetmp:=myid;
str(exp(1),st2);
sst3:='';
exit;
end;
writeln(' ВНИМАНИЕ : НЕДЕКОДИРУЕМАЯ ФОРМУЛА ');
analysetmp:=myid;
st2:='';
st3:='';
end;function evalobj.eval:real; var tmpx,tmpy:real; begin if f1=nil then
tmpx:=f1x
else
tmpx:=f1^.eval;
if f2=nil then
tmpy:=f2y
else
tmpy:=f2^.eval;
eval:=f3(tmpx,tmpy);
end;function evalobj.eval1d(x:real):real; begin evalx:=x; evaly:=0; evalz:=0; eval1d:=eval; end; function evalobj.eval2d(x,y:real):real; begin evalx:=x; evaly:=y; evalz:=0; eval2d:=eval; end; function evalobj.eval3d(x,y,z:real):real; begin evalx:=x; evaly:=y; evalz:=z; eval3d:=eval; end; constructor evalobj.init(st:string); var st2,st3:string; error:integer;
beginf1:=nil; f2:=nil; analyse(st,st2,st3); f3:=analysetmp; val(st2,f1x,error); if st2='' then begin f1x:=0;
error:=0;
end;if error<>0 then new (f1,init(st2));
val(st3,f2y,error);if st3='' then begin f2y:=0;
error:=0;
end;if error<>0 then new (f2,init(st3));
end;destructor evalobj.done; begin if f1<>nil then dispose(f1,done);
if f2<>nil thendispose(f2,done);
end;end. |
[000159]