Богдан / LAGR2

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.