Смекни!
smekni.com

Інтерполювання функцій за формулою Лагранжа (стр. 2 из 2)

procedure riv(a:poli;var b:poli);

procedure vvid(n:integer;var a:poli);

function poper(a:poli;m:integer):integer;

procedure vyvid(a:poli);

procedure fvyvid(a:poli);

function maxi(n,m:integer):integer;

function mini(n,m:integer):integer;

function znach(a:poli;x:real):real;

procedure suma(a,b:poli;var c:poli);

procedure dobchy(a:poli;r:real;var c:poli);

procedure pidvst(a:poli;n:integer;var c:poli);

procedure dobutok(a,b:poli;var c:poli);

procedure dilen(a,b:poli;var c,c1:poli);

procedure zerod;

implementation

procedure zerod;

var i:integer;

begin

for i:=0 to 100 do begin zero[i]:=0;od[i]:=0;end;

od[0]:=1;

end;

function stepin(a:poli):integer;

{визначення степеня многочлена}

var i:integer;

begin

i:=100;

while ((a[i]=0) and (i>=0)) do i:=i-1;

stepin:=i;

end;

function znach(a:poli;x:real):real;

var i,n:integer;

s,st:real;

begin

s:=a[0];

st:=1;

n:=stepin(a);

for i:=1 to n do

begin

st:=st*x;

s:=s+st*a[i];

end;

znach:=s;

end;

procedure riv(a:poli;var b:poli);

{присвоення одному многочлену значення iншого}

var i:integer;

begin

for i:=0 to 100 do b[i]:=a[i];

end;

procedure vvid(n:integer;var a:poli);

{ввiдмногочлена}

var i:integer;

begin

for i:=100 downto n+1 do a[i]:=0;

writeln('вводьтемногочлен');

for i:=n downto 1 do

begin

write('x^',i:2,'*');

read(a[i]);

write('+');

end;

read(a[0]);

end;

function poper(a:poli;m:integer):integer;

{визначення молодшого на 1 коефiцiента многочлена пiсля m}

var i:integer;

begin

i:=m-1;

while (a[i]=0)and(i>=0) do i:=i-1;

poper:=i;

end;

procedure vyvid(a:poli);

{вивiдмногочлена}

var i,n:integer;

begin

n:=stepin(a);

writeln;

if ((n>0)or(a[0]<>0)) then

begin

i:=n;

while ((i>=1)and(poper(a,i)>-1)) do

begin

if (a[i]<>0) then begin

if (i>1) then

write(a[i]:5:2,'x^',i:2)

else write(a[i]:5:2,'x');

if (a[poper(a,i)]>0) then write('+') ;

end;

i:=i-1;

end;

if (i>1) then write(a[i]:5:2,'x^',i:2)

else

if(i=1) then write(a[i]:5:2,'x')

else

write(a[i]:5:2);

end

else

write('0');

end;

procedure fvyvid(a:poli);

{вивiдмногочленавфайл}

var i,n:integer;

begin

n:=stepin(a);

writeln(fi);

if ((n>0)or(a[0]<>0)) then

begin

i:=n;

while ((i>=1)and(poper(a,i)>-1)) do

begin

if (a[i]<>0) then begin

if (i>1) then

write(fi,a[i]:5:3,'x^',i:2)

else write(fi,a[i]:5:3,'x');

if (a[poper(a,i)]>0) then write(fi,'+') ;

end;

i:=i-1;

end;

if (i>1) then write(fi,a[i]:5:3,'x^',i:2)

else

if(i=1) then write(fi,a[i]:5:3,'x')

else

write(fi,a[i]:5:3);

end

else

write(fi,'0');

end;

function maxi(n,m:integer):integer;

begin

if(n>=m) then maxi:=n else maxi:=m;

end;

function mini(n,m:integer):integer;

begin

if(n<=m) then mini:=n else mini:=m;

end;

procedure suma(a,b:poli;var c:poli);

{сума 2 многочленiв}

var i,na,nb,nab,nba:integer;

begin

na:=stepin(a);

nb:=stepin(b);

nab:=maxi(na,nb);

for i:=100 downto nab+1 do c[i]:=0;

for i:=nab downto 0 do c[i]:=a[i]+b[i];

end;

procedure dobchy(a:poli;r:real;var c:poli);

{добуток скаляра на многочлен}

var i:integer;

begin

c:=zero;

for i:=0 to stepin(a) do

c[i]:=r*a[i];

end;

procedure pidvst(a:poli;n:integer;var c:poli);

{домноження многочлена на x^n)}

var i:integer;

begin

for i:=stepin(a)+n downto n do

c[i]:=a[i-n];

for i:=stepin(a)+n+1 to 100 do c[i]:=0;

for i:=0 to n-1 do c[i]:=0;

end;

procedure dobutok(a,b:poli;var c:poli);

{добуток 2 многочленiв}

var i:integer;

t,t1,t2:poli;

begin

t:=zero;

for i:=0 to stepin(b) do

begin

t1:=zero;

t2:=zero;

dobchy(a,b[i],t1);

pidvst(t1,i,t2);

suma(t,t2,t);

end;

c:=t;

end;

procedure dilen(a,b:poli;var c,c1:poli);

var n,m,i:integer;

t1,t2,t3,t4,t5:poli;

{дiленнямногочленiвзостачею}

begin

riv(a,t4);

n:=stepin(a);

m:=stepin(b);

riv(zero,t3);

while n>=m do

begin

riv(zero,t5);

riv(zero,t1);

riv(zero,t2);

t5[n-m]:=a[n]/b[m];

suma(c,t5,c);

dobutok(t5,b,t1);

dobchy(t1,-1,t2);

suma(a,t2,a);

n:=stepin(a);

end;

dobutok(c,b,t3);

dobchy(t3,-1,t3);

suma(t4,t3,c1);

end;


Додаток 3

Лістинг програмного модуля

program lagr;

{$M 65520,0,655360}

{побудовамногочленаЛагранжа}

Uses Crt,bibl;

{початок програми}

vari,j,k,n,m:integer;

s,p,q,p1:poli;

t,u,w:real;

x,y:array[1..20] of real;

begin

{створеннякiльцевогонуля zero i кiльцевоi одиницi od}

zerod;

assign(fi,'lagr.txt');

rewrite(fi);

{ввiдвузлiв}

writeln('Введiтьчисловузлiв ');

readln(n);

for i:=1 to n do begin

writeln('Введiть x[',i,'] y[',i,']');

readln(x[i],y[i]); end;

writeln('Введiтьточку iнтерполяцii '); readln(t);

writeln(' x y');

for i:=1 to n do writeln(x[i]:5:2,' ',y[i]:5:2);

writeln(fi,' x y');

for i:=1 to n do writeln(fi,x[i]:5:2,' ',y[i]:5:2);

writeln('Точка iнтерполяцii ',t:5:3);

writeln(fi,'Точка iнтерполяцii ',t:5:3);

s:=zero;

for i:=1 to n do

begin

p:=od;u:=1;

for k:=1 to n do

begin

if (k<>i) then

begin

q:=zero;q[1]:=1;q[0]:=-x[k];

dobutok(p,q,p); u:=u*(x[i]-x[k]);

end;

end;

dobchy(p,y[i]/u,p);

suma(s,p,s);end;

writeln('МногочленЛагранжа '); writeln(fi,'МногочленЛагранжа ');

vyvid(s); fvyvid(s);

writeln; writeln(fi);

w:=znach(s,t);

writeln('Значеннявточцi iнтерполяцii=',w:5:3);

writeln(fi,'Значеннявточцi iнтерполяцii=',w:5:3);

close(fi);

end.

Додаток 4

Результат роботи програми

x y

3.00 4.00

7.00 10.00

1.00 22.00

15.00 26.00

19.00 33.00

Точка iнтерполяцii 13.000

Многочлен Лагранжа

0.004x^ 4-0.183x^ 3+2.768x^ 2-14.087x+25.958

Значення в точцi iнтерполяцii=24.898