Место Delphi в современном программировании

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);

st3:='';

exit;

end;

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;

begin

f1:=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 then

dispose(f2,done);

end;

end.

 

unit Integration;

 

interface

uses evalcomp;

 

function f(x:real):real;

function TrapezeInt(a,b:Double; eps: Double; StrF: string): Double;

function SquareInt(a,b:Double; eps: Double; StrF: string): Double;

function SimpsonInt(a,b:Double; eps: Double; StrF: string): Double;

function BodeInt(a,b:Double; eps: Double;StrF:string): Double;

function UeddlsInt(a,b:Double; n: Integer;StrF:string): Double;

function returnY(a:Double;StrF:string): Double;

 

implementation

  var

  calc:EVALVEC;

  FORMULA: string;

 

function f(x:real):real;

begin

f:=calc^.eval1d(x);

end;

function returnY(a:Double;StrF:string): Double;

begin

   FORMULA:=StrF;

   new (calc,init(FORMULA));

   Result:=f(a+1);

    dispose(calc,done);

end;

// Вычисление интеграла методом Уэддля

function UeddlsInt(a,b:Double; n: integer;StrF:string): Double;

var

 

  h,s,z: real; i: integer;

  const k: array [1..7] of real = (3/10,15/10,3/10,18/10,3/10,15/10,3/10);

begin

  FORMULA:=StrF;

  new (calc,init(FORMULA));

h:=(b-a)/n;

s:=0;

z:=h/6;

for i:=1 to n do s:=s+k[1]*f(a+i*h-6*z)+k[2]*f(a+i*h-5*z)+k[3]*f(a+i*h-4*z)+k[4]*f(a+i*h-3*z)+k[5]*f(A+i*h-2*z)+k[6]*F(a+i*h-z)+k[7]*F(a+i*h);

s:=s*z;

Result:=s;

dispose(calc,done);

end;

 

 

// метод Боде

function BodeInt(a,b:Double; eps: Double;StrF:string): Double;

var

h,s,sum1,z: real;

i,n: integer;

begin

  FORMULA:=StrF;

  new (calc,init(FORMULA));

  s:=0; n:=1;

    repeat

      sum1:=s;

      n:=n*2;

      h:=(b-a)/n;

      z:=h/4;

      for i:=1 to n do

      s:=s+(7*f(a-4*z)+32*f(a+i*h-3*z)+12*f(a+i*h-2*z)+32*f(a+i*h-z)+7*f(a+i*h));

      s:=s*2*z/45;

    until abs(sum1-s)<eps;

  Result:=s;

  dispose(calc,done);

end;

 

//метод прямоугольников

function SquareInt(a,b:Double; eps: Double; StrF:string): Double;

 

  var

  i, n: Integer;

    h, s1, s2 : Double;

begin

   FORMULA:=StrF;

    new (calc,init(FORMULA));

    n := 1;

    h := b-a;

    s2 := h*f((a+b)/2);

    repeat

        n := 2*n;

        s1 := s2;

        h := h/2;

        s2 := 0;

        i := 1;

        repeat

            s2 := s2+f(a+h/2+h*(i-1));

            i := i+1;

        until  not (i<=n);

        s2 := s2*h;

    until  not (Abs(s2-s1)>3*eps);

    Result := s2;

    dispose(calc,done);

  end;

 

//Метод трапеций

function TrapezeInt(a,b:Double; eps: Double; StrF: string): Double;

var

  S, x, base: Double;

  i, n: Integer;

begin

  FORMULA:=StrF;

  new (calc,init(FORMULA));

 

  base := b - a;

  Result := (f(a) + f(b)) / 2 * base;

  n := 1;

  repeat

    S := Result;

    base := base / 2;

    n := n * 2;

    Result := Result / 2;

    for i := 1 to n div 2 do

    begin

      x := a + base * (i * 2 - 1);

      Result := Result + f(x) * base;

    end;

  until abs(S - Result) <= eps;

  dispose(calc,done);

end;

 

 

//Метод парабол

function SimpsonInt(a,b:Double; eps: Double; StrF: string): Double;

  var

    h, x, s, s1, s2, s3, sign: double;

begin

   FORMULA:=StrF;

  new (calc,init(FORMULA));

  if (a = b) then

    begin

      Result := 0; exit

    end;

 

  if (a > b) then

    begin

      x := a; a := b; b := x; sign := -1

    end

   else sign:=1;

 

  h := b - a; s := f(a) + f(b); s2 := s;

 

  repeat

    s3 := s2; h := h/2; s1 := 0; x := a + h;

    repeat

      s1 := s1 + 2*f(x); x := x + 2*h;

    until (not(x < b));

    s := s + s1; s2 := (s + s1)*h/3; x := abs(s3 - s2)/15

  until (not(x > eps));

 

  Result := s2*sign;

  dispose(calc,done);

  end;

end.