3_теориЛеготкина / gfcrfkm / 666

uses graph, crt;
const



N =8;



x:array [0..N] of real =(-4, -3, -2, -1, 0, 1, 2, 3, 4);
y:array [0..N] of real =(0, 2, 0, -1 ,0 ,1 , 0, -2, 0);

var
m, h, g, f:array[0..n] of real;
a, b, c, d:array[1..n] of real;
lk: array[0..N] of real;

w, i, j: word;
kx: real;
ky: real;
xx: real;
xh: real;
xC, yC: word;


procedure InitScreen;

var
gm, gd, errorcode: integer;
begin
gd := VGA; gm := VGAHi;
initgraph( gd, gm, 'c:\bp\bgi');

ClearViewPort;


xC:=Round(getmaxx/2); yC:=Round(getmaxy/2);

kx :=getmaxx/(x[n]-x[0]);
ky :=getmaxx/(x[n]-x[0]);


SetColor(White);
Line(xC, 0, xC, getmaxy);
Line(0, yC, getmaxx, yC);
SetLineStyle(DottedLn, 0, NormWidth);


SetColor(LightGray);
i:=xC;
j:=xC;
while i<=getmaxx do begin
i:=Round(i+kx);
j:=Round(j-kx);
Line(i, 0, i, getmaxy);
Line(j, 0, j, getmaxy);
end;

i:=yC;
j:=yC;
while i+ky<=getmaxy do begin
i:=Round(i+ky);
j:=Round(j-ky);
Line(0, i, getmaxx, i);
Line(0, j, getmaxx, j);
end;
end;

function L(xx: real):real;


var
i, j: word;
sum, Pn1: real;

begin
sum := 0;
for i := 0 to n do begin
Pn1 := 1;
for j := 0 to n do begin
if j <> i then Pn1 := Pn1 * (xx-x[j]);
end;
sum := sum + lk[i]*Pn1;
end;
L:= sum;
end;

function Spline(xx:real): real;


var
i: word;

begin
if (xx < x[0]) or (xx > x[n]) then begin
Spline:=0;
exit;
end;


i := 1;
while xx > x[i] do i:=i+1;


Spline:= a[i]*(x[i]-xx) * (x[i]-xx) * (x[i]-xx) +
b[i]*(xx-x[i-1])*(xx-x[i-1])*(xx-x[i-1]) +
c[i]*(x[i]-xx) + d[i]*(xx-x[i-1]);
end;

procedure PrintSpline;


var
i: word;

begin
WriteLn('Полученные сплайны:');
for i:=1 to n do begin
WriteLn(a[i]:2:2, '*(', x[i]:2:2, ' - x)^3 + ', b[i]:2:2, '*(x - ',
x[i-1]:2:2, ')^3 + ', c[i]:2:2, '*(', x[i]:2:2, ' - x) + ',
d[i]:2:2, '*(x - ', x[i-1]:2:2, ')');
end;
end;





begin

for i := 0 to n do begin
lk[i] := y[i];
for j := 0 to n do begin
if j <> i then lk[i] := lk[i]/(x[i]-x[j]);
end;
end;

for i:=1 to n do
h[i]:= x[i] - x[i-1];

g[1]:= 2*(h[1] + h[2]);
f[1]:= 6*((y[2] - y[1])/h[2] - (y[1] - y[0])/h[1]);

for i:= 2 to n-1 do begin
g[i]:= 2*(h[i] + h[i+1])-sqr(h[i])/g[i-1];
f[i]:= 6*((y[i+1]-y[i])/h[i+1]-(y[i]-y[i-1])/h[i])-f[i-1]*h[i-1]/g[i-1];
end;


m[n-1] := f[n-1]/g[n-1];
for i:=n-2 downto 1 do
m[i] := (f[i] - h[i+1]*m[i+1])/g[i];


for i:=1 to n do begin
a[i] := m[i-1]/(6*h[i]);
b[i] := m[i] / (6*h[i]);
c[i] := (y[i-1] - 1/6 * m[i-1]*sqr(h[i]) ) / h[i];
d[i] := (y[i] - 1/6 * m[i] * sqr(h[i]) ) / h[i];
end;



InitScreen;

xh:=(x[n]-x[0])/getmaxx;
SetLineStyle(SolidLn, 0, NormWidth);


SetColor(blue);
moveto(0, yC);
xx:=x[0];
while xx<=x[n] do begin
lineto(Round(xC+xx*kx), Round(yC-Spline(xx)*ky));
xx:=xx+xh
end;


SetColor(red);
moveto(0, yC);
xx:=x[0];
while xx<=x[n] do begin
lineto(Round(xC+xx*kx), Round(yC-L(xx)*ky));
xx:=xx+xh
end;

SetColor(White);
for i:=0 to n do
Circle(Round(xC+x[i]*kx), Round(yC-y[i]*ky), 3);
readkey;

closegraph;
clrscr;
PrintSpline;
readkey;
clrscr;
end.