const
y0 = 0.25; n = 5;
nt = 10;
nl = 4;hl = 5;
epsilon = 0.000001; x0 = 2;
type
mass = array[0..2*nl] of real;
var
x, y: array [0..2 * nt] of real;
T, h: real;
Xl, Yl:mass;
kl, kolit: integer;
tl, zl: real;
fp, ft,filerez: text;
tx: string;
function polynom(t: real): real;
begin
polynom := 2 * (t * t * t * t) - t * t * t - 8;
end;
function phi(x:real):real;
begin
phi:=x+polynom(x);
end;
procedure Iter(a,b:real;var x2,y2:real; var flag:Boolean);
var
x0,x1,y0,y1:real;
begin
kolit:=kolit+1;
x0:=a;y0:=phi(x0);
x1:=b;y1:=phi(x1);
x2:=(x1*y0-y1*x0)/((x1-x0)-(y1-y0));
y2:=phi(x2);
flag:=(y0-x0)*(y2-x2)>0;
end;
procedure Vegstein(a,b,eps:real; var x:real);
var
xz,yz:real;
prizn:Boolean;
begin
repeat
Iter(a,b,xz,yz,prizn);
if prizn then a:=xz else b:=xz;
until abs(xz - yz) < eps;
writeln('корень===',xz);
x:=xz;
end;
function Fs(x, t: real): real;
begin
if x > t then x := x - t * (trunc(x / t));
if (x > 0) and (x < 1) then
result := 1
else if (x >= 1) and (x <= t) then
result := (t - x) / (t - 1);
end;
function f(x, y: real): real;
begin
result := 0.1*x*x - 2*x*y + (1+n/10) * Fs(x, T)
end;
function Euiler(x0,y0,h:real):real;
begin
Euiler:=y0+h*F(x0,y0);
end;
//procedure Integr(x0,y0,h:real;nt:integer;var V,U:mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{h- шаг интегрирования, N- число точек интегрирования}
{V –дискретные значения аргумента}
{U- численные значения решения диф. уравнения }
procedure Integr(x0,y0,h:real;N:integer;var V,U:mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{var
j:integer;
begin
x[0]:=x0;y[0]:=y0;
for j:=1 to nt do
begin
x[j]:=x0+j*h;
y[j]:=Euiler(x[j-1],y[j-1],h);
writeln(j,x[j],y[j]);
end;
end;}
var
j:integer;
begin
V[0]:=x0;U[0]:=y0;
for j:=1 to N do
begin
V[j]:=x0+j*h;
U[j]:=Euiler(V[j-1],U[j-1],h);
writeln(j,V[j],U[j]);
end;
end;
{============================================= }
procedure minmax(nt:integer;A:mass;var maxA,minA:real);
{вычисление наиб и наим значений в массиве}
var
j:integer;
begin
maxA:=A[0];minA:=A[0];
for j:=1 to N do
begin
if A[j]> maxA then maxA:=A[j];
if A[j]< minA then minA:=A[j];
end;
writeln('max=',maxA:10:28,'min=':10,minA:10:4);
end;
{================================================}
function discret(t:real):real;{превращение дискретной функции}
{ в функцию непрерывного аргумента для сеточной функции}
{ вчисленной в N точках равномерной сетки с шагом Hint на [0, T] }
{и заданной в массиве U- глобальном в процедуре }
begin
discret:=y[round(t/h)];
end;
{в раздел операторов: после вычисления корня уравнения }
{++++++++++++++++++++++++++++++++++++++++++++++++++++}
function Lagrange(nl: integer; Xl, Yl: mass; tl: real): real;
var
p, z: real;
k, j: integer;
begin
z := 0;
for k := 0 to nl do
begin
p := 1;
for j := 0 to nl do
begin
if k <> j then
p := p * (tl - Xl[j]) / (Xl[k] - Xl[j]);
end;
z := z + Yl[k] * p;
end;
Lagrange := z;
end;
begin
assign(fp, 'out_eiler.txt');
rewrite(fp);
Vegstein(1, 3, epsilon, T);
h := T / nt;
writeln;
//h:=2*T/n;{шаг интегрирования}
{=================интегрирование====================}
Integr(x0,y0,h,nt,X,Y);
{========запись данных в файл==============}
assign(filerez,'c:\work\rezult');
rewrite(filerez);
for j:=0 to nt do
writeln(filerez,j:4,' ',x[j]:10:2,y[j]:12:-2);
close(filerez);
writeln('Lagrange points:');
for kl := 0 to nl do
begin
xl[kl] := X[kl * 5];yl[kl] := Y[kl * 5];
writeln(xl[kl]:10:3, yl[kl]:10:3);
end;
writeln;
writeln('Lagrange:');
for kl := 0 to 19 do
begin
tl := xl[0] + ((xl[nl] - xl[0]) * kl / 19);
zl := Lagrange(nl, Xl, Yl, tl);
writeln(tl:9:4, zl:14:6);
end;
close(fp);
end.
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.