Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
21
Добавлен:
09.12.2013
Размер:
3 Кб
Скачать
Program Lagrange;
 uses  crt,graph;
 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);
 {      x:array [0..n] of real=(0, 1, 2, 3, 4, 5, 6, 7, 8);}

 var driver,mode:integer;
     h_x,h_y,x_0,y_0:integer;
     i:integer;
     hx,ky,x1,y1,y2,x_,y_,y_2,x0:real;
     xg,yg,yg2:integer;

 function Lagr(x_:real):real;
  var i,j:integer;
      l,p:real;
   begin
    l:=0;
    for i:=0 to n do
     begin
      p:=y[i];
      for j:=0 to n do
       begin
        if i<>j then p:=p*(x_-x[j])/(x[i]-x[j]);
       end;
      l:=l+p;
     end;
    lagr:=l;
   end;

  function Spline(x_:real):real;
   {var i,j:integer;
       m,h,g,f, a,b,c,d:array [0..n] of real;
    begin
     m[0]:=0; m[n]:=0;
     for i:=1 to n do h[i]:=1;
     g[1]:=(h[3]+h[2])/2;
     f[1]:=6*(y[2]-2*y[1]+y[0]);
     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]-2*y[i]+y[i-1])-f[i-1]/g[i-1];
      end;
     m[n-1]:=f[n-1]/g[n-1];
     j:=1;
     while j<=n-2 do
      begin
       i:=n-1-j;
       m[i]:=(f[i]-h[i+1]*m[i+1])/g[i];
       j:=j+1;
      end;
     for i:=1 to n do
      begin
       a[i]:=m[i-1]/6;
       b[i]:=m[i]/6;
       c[i]:=y[i-1]-m[i-1]*sqr(h[i])/6;
       d[i]:=y[i]-m[i]*sqr(h[i])/6;
      end;
     i:=trunc(x_)+4;
     if i<>0 then
       Spline:=a[i]*sqr(x[i]-x_)*(x[i]-x_)+b[i]*sqr(x_-x[i-1])*(x_-x[i-1])+
               c[i]*(x[i]-x_)+d[i]*(x_-x[i-1])
             else Spline:=y[0];
    end;}
    var m:array [0..n] of real;
        h,i:integer;
        y1:real;
     begin
      h:=1;
{      m[0]:=(4*y[1]-y[2]-3*y[0])/2;
      m[n]:=(3*y[n]+y[n-2]-4*y[n-1])/2;}

      m[0]:=(-11*y[0]+18*y[1]-9*y[2]+2*y[3])/6;
      m[n]:=(11*y[n]-18*y[n-1]+9*y[n-2]-2*y[n-3])/6;
      for i:=1 to n-1 do m[i]:=(y[i+1]-y[i-1])/2;
      i:=trunc(x_)+4;
      if i=0 then y1:=y[0]
             else begin
      y1:=sqr(x[i+1]-x_)*(2*(x_-x[i])+h)*y[i];
      y1:=y1+sqr(x_-x[i])*(2*(x[i+1]-x_)+h)*y[i+1];
      y1:=y1+sqr(x[i+1]-x_)*(x_-x[i])*m[i];
      y1:=y1+sqr(x_-x[i])*(x_-x[i+1])*m[i+1];
       end;
      Spline:=y1;
     end;



  begin
   driver:=detect;
   initgraph(driver, mode, 'm:\bgi');
   setcolor(white);
   {OSI}
   line(getmaxX div 2, 0,getmaxX div 2, getmaxY);
   line(0, getmaxY div 2, getmaxX, getmaxY div 2);
   h_x:=getmaxX div 10;
   h_y:=getmaxY div 6;
   x_0:=4;
   for i:=0 to 9 do line(x_0+i*h_x,(getmaxY div 2)-3,x_0+i*h_x,(getmaxY div 2)+3);
   y_0:=2;
   for i:=0 to 5 do line((getmaxX div 2)-3,y_0+h_y*i,(getmaxX div 2)+3,y_0+h_y*i);
   {Grafik}
   hx:=1/63;
   ky:=1/79;
   x0:=-4;
   for i:=0 to 8*63 do
    begin
     x1:=x0+hx*i;
     y1:=Lagr(x1);
     y2:=Spline(x1);
     x_:=x1*63+(getmaxX div 2);
     y_:=-y1*79+(getmaxY div 2);
     y_2:=-y2*79+(getmaxY div 2);
     xg:=round(x_);
     yg:=round(y_);
     yg2:=round(y_2);
     delay(50);
     putpixel(xg,yg,yellow);
     putpixel(xg,yg2,white);
    end;
   readln;
   closegraph;
  end.
Соседние файлы в папке лаба №1 крэс-05