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

Богдан / Lagrange 2

.pas
Скачиваний:
23
Добавлен:
09.12.2013
Размер:
3 Кб
Скачать
☆
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.
Соседние файлы в папке Богдан