Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Богдан / LAGR2

.PAS
Скачиваний:
20
Добавлен:
09.12.2013
Размер:
3.55 Кб
Скачать
Program lab1;

Uses Crt,Graph;

Const
k=8;
xi:Array[0..k]Of Integer=(-4,-3,-2,-1,0,1,2,3,4);
yi:Array[0..k]Of Integer=(0,2,0,0,-3,0,0,2,0);

Var Gd,Gm,i,x0,y0,dx,dy:Integer;
x,y,p:Real;

Var
a,b,c,d,mz,f,g:Array[0..k]of Real;
Function Lg(x:Real):Real;
Var
i,j:Byte;
P1,P2,f:Real;

Begin
f:=0;
For i:=0 to k Do
Begin
P1:=1;
P2:=1;
For j:=0 To k Do
If j<>i Then
Begin
P1:=P1*(X-Xi[j]);
P2:=P2*(Xi[i]-Xi[j]);
End;
f:=f+(P1/P2)*yi[i];
End;
Lg:=F;
End;

Procedure Osi;
Var
i:Integer;
s:String[4];
Begin
SetColor(5);
Line(x0,0,x0,GetMaxY);
Line(0,y0,GetMaxX,y0);
i:=x0;
Repeat
Line(i,y0+3,i,y0-3);
Line(GetMaxX-i,y0+3,GetMaxX-i,y0-3);
str((i-x0) div dx,s);
OutTextXY(i-2,y0-16,s);
str(-(i-x0) div dx,s);
OutTextXY(GetMaxX-i-3,y0-16,s);
i:=i+DX;
Until (i-x0) div dx >4;

i:=y0;
Repeat
Line(x0-3,i,x0+3,i);
Line(x0-3,GetMaxY-i,x0+3,GetMaxY-i);
If i<>y0 Then
Begin
str(-(i-y0) div dy,s);
OutTextXY(x0+5,i,s);
str((i-y0) div dy,s);
OutTextXY(x0+5,GetMaxY-i,s);
End;
i:=i+Dy;
Until i>=GetMaxY;
End;


Procedure MakeSplain;
Var
i,j:Byte;
h,m:Array[0..k]of Real;
Begin

For i:=1 To k Do
h[i]:=xi[i]-xi[i-1];
g[1]:=2*(h[1]+h[2]);
f[1]:=6*((yi[2]-yi[1])/h[2]-(yi[1]-yi[0])/h[1]);
For i:=2 To k-1 Do
Begin
g[i]:=2*(h[i]+h[i+1])-sqr(h[i])/g[i-1];
f[i]:=6*((yi[i+1]-yi[i])/h[i+1]
-(yi[i]-yi[i-1])/h[i])
-f[i-1]*h[i-1]/g[i-1];
End;


m[0]:=0;m[k]:=0;
For i:=k-1 DownTo 1 Do
begin
m[i]:=(f[i]-h[i+1]*m[i+1])/g[i];
mz[i]:=m[i];
end;
For i:=1 To k Do
Begin
a[i]:=m[i-1]/(6*h[i]);
b[i]:=m[i]/(6*h[i]);
c[i]:=(yi[i-1]-(m[i-1]*sqr(h[i]))/6)/h[i];
d[i]:=(yi[i]-(m[i]*sqr(h[i]))/6)/h[i];
End;

End;

Function Splain(x:Real):Real;
Var
N:byte;
s:String[1];
Begin

n:=1;
For i:=0 To k-1 Do
If x>=xi[i] Then N:=i+1;

Splain:=a[N]*Sqr(xi[N]-x)*(xi[N]-x)
+b[N]*Sqr(x-xi[N-1])*(x-xi[N-1])
+c[N]*(xi[N]-x)
+d[N]*(x-xi[N-1]);
End;

Begin
DetectGraph(Gd,Gm);
InitGraph(Gd,Gm,'D:\bp\bgi');
dx:=GetMaxX Div k;dy:=GetMaxY Div 10;
p:=0.001;
x0:=GetMaxX Div 2;
y0:=GetMaxY Div 2;
Osi;
MakeSplain;
readkey;
x:=-4;
Repeat
y:=Lg(x);
PutPixel(x0+Round(dx*x),y0-Round(dy*y),7);
y:=splain(x);
PutPixel(x0+Round(dx*x),y0-Round(dy*y),9);
x:=x+p;
Until x>4;
ReadKey;
CloseGraph;

writeln;
for i:=0 to 8 do
begin
write(' x=',xi[i],', m[',i,']=');
writeln(mz[i]:2:2);
end;
readkey;
writeln;
For i:=1 To k Do
Begin
writeln('splain[',i,']: (',a[i]:2:2,')(x[i]-x)^3+(',b[i]:2:2,')(x-x[i-1])^3+('
,c[i]:2:2,')(x[i]-x)+(',d[i]:2:2,')(x-x[i-1]');
writeln;
End;


readkey;
End.
Соседние файлы в папке Богдан