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

лаба №1 крэс-05 / lab1 / Lagrange (готовый)

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

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,0,-2,1,0,-1,2,0,0);

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

Var
a,b,c,d:Array[0..k]of Real;


{}
Procedure Osi;
Var
i:Integer;
s:String[2];
Begin
SetColor(13);
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-5,y0-10,s);
str(-(i-x0) div dx,s);
OutTextXY(GetMaxX-i-5,y0-10,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,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,f,g,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
m[i]:=(f[i]-h[i+1]*m[i+1])/g[i];

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,'e:\programs\pascal\bgi');
dx:=GetMaxX Div k;dy:=GetMaxY Div 10;p:=0.001;
x0:=GetMaxX Div 2;
y0:=GetMaxY Div 2;
Osi;
MakeSplain;
x:=-4;
Repeat
y:=Splain(x);
PutPixel(x0+Round(dx*x),y0-Round(dy*y),15);
PutPixel(x0+Round(dx*x),y0-Round(dy*y),14);
x:=x+p;
Until x>4;
ReadKey;
CloseGraph;
End.
Соседние файлы в папке lab1