Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
09.12.2013
Размер:
2 Кб
Скачать
{Џа®Ја ¬¬  Ї®бв஥­Ёп Ї®«Ё­®¬  ‹ Ја ­¦  Ё ‘Ї« ©­ 
ђ Ў®вг ўлЇ®«­Ё«Ё ‹лвЄЁ­ Џ.‚., ‹г§Ё­ Њ.Њ. Ја Ђ’-01-2}
program Interpolition;
uses graph;
const n=8;
var x,y:array[0..n]of real;
   i,j,sp,t,m,b:integer;
   w:real;

function lagr(x1:real):real;
   var i,j:integer;
   ln,q,p:real;
  begin
     ln:=0;
     for i:=0 to n do
     begin
       q:=1;
       p:=1;
        for j:=0 to n do
         begin
           if not (i=j) then p:=p*(x1-x[j]);
           if not (i=j) then q:=q*(x[i]-x[j]);
          end;
       ln:=ln+y[i]*p/q;
     end;
   lagr:=ln;
  end;

function spline(x1:real):real;
var MM,H,GG,FF,AA,BB,CC,DD:array[0..n]of real;
    U:real;
    ii,l,j,i,k:integer;
begin
   MM[0]:=0;
   MM[n]:=0;
   i:=1;
   while i<=n do
      begin
         H[i]:=X[i]-X[i-1];
         i:=i+1;
      end;
   GG[1]:=2*(H[1]+H[2]);
   FF[1]:=6*((y[2]-y[1])/H[2]-(y[1]-y[0])/H[1]);
   i:=2;
   while i<=(n-1) do
      begin
         GG[i]:=2*(H[i]-H[i+1])-sqr(H[i])/GG[i-1];
         FF[i]:=6*((y[i+1]-y[i])/H[i+1]-(y[i]-y[i-1])/H[i])-FF[i-1]*H[i-1]/GG[i-1];
         i:=i+1;
      end;
   MM[N-1]:=FF[N-1]/GG[N-1];
   j:=1;
   while j<=(n-2) do
      begin
         i:=n-1-j;
         MM[i]:=(FF[i]-H[i+1]*MM[i+1])/GG[i];
         j:=j+1
      end;
   i:=1;
   while i<=N do
      begin
         AA[i]:=MM[i-1]/(6*H[i]);
         BB[i]:=MM[i]/(6*H[i]);
         CC[i]:=(Y[i-1]-(1/6)*MM[i-1]*sqr(H[i]))/H[i];
         DD[i]:=(Y[i]-(1/6)*MM[i]*sqr(H[i]))/H[i];
         i:=i+1;
      end;
   U:=x[i]+(x[i+1]-x[i])/2;
   i:=1;
   j:=N+1;
   L:=1;
   while L<=2 do
      begin
         k:=trunc((i+j)/2);
         if u>=X[k] then i:=k else j:=k;
         if J>i+1 then l:=l-1;
         L:=l+1;
      end;
    k:=j;
    {ii:=4+trunc(x1);}
    spline:=AA[i]*sqr(X[i]-x1)*(X[i]-x1)+BB[i]*sqr(x1-X[i-1])*(x1-X[i-1])+CC[i]*(X[i]-x1)+DD[i]*(x1-X[i-1]);
   end;

begin
    for i:=0 to n do x[i]:=-4+i;
    y[0]:=0;
    y[1]:=0;
    y[2]:=1;
    y[3]:=0;
    y[4]:=0;
    y[5]:=0;
    y[6]:=-1;
    y[7]:=0;
    y[8]:=0;

    m:=detect;
    initgraph(m,b,'d:\bormanpascal\bgi');
    line(360,0,360,340);
    line(0,170,720,170);
    for i:=50 to 700 do
    begin
      t:=round(-170*(lagr(6*i/360-6))/4+170);
      putpixel(i,t,3);
      sp:=round(-170*(spline(6*i/360-6))/4+170);
      putpixel(i,sp,4);
    end;
 readln;
 closegraph;
end.
Соседние файлы в папке лаба №1 крэс-05