Курсовая работа - Интерполяция алгебраических многочленов методами Ньютона и Лагранжа / текст / текст программы
.docТекст программы
Program KursF;
uses crt, graph;
const
Men=4;
Menu:ARRAY [1..Men] of string = ('Metod Logranzha',
'Metod Nyutona',
'O programme',
'Exit (ESC)');
var
NM,DF,CIM,DK :CHAR;
K,K1,MAX,I,N :INTEGER;
REZ :BOOLEAN;
O :TEXT;
{---------------------------------------------}
Procedure Oprog;
BEGIN
textbackground(0);
textcolor(2);
ASSIGN (O,'a:\O_PROG.txt');
RESET (O);
WHILE NOT EOF (O) DO
BEGIN
READ (O,CIM);
WRITE (CIM);
DELAY (12000)
END;
CLOSE (O);
READLN;
END;
{---------------------------------------------}
Procedure lograng;
var
g, a, H, J1, b: real;
k, i, n, n1, j, Gd, Gm, ii, e1, f1: integer;
Y, X, z, z1: array [1..50] of real;
begin
repeat
clrscr;
write('Vvedite kolichestvo tochek: ');
readln(n);
if n<=0 then
begin
writeln;
write('Vvodit nado polozhitelnoe chislo! Nazhmite Enter');
readln;
end;
until n>0;
writeln;
for i:=1 to n do
begin
Write('vvedite x',i,': '); Readln(X[i]);
Write('vvedite y',i,': '); Readln(Y[i]);
writeln;
end;
write(' Vvedite x*:'); Readln(a);
H:=0;
for k:=1 to n do
begin
J1:=1;
for i:=1 to n do
begin
if i<>k then
J1:=J1*((a-x[i])/(x[k]-x[i]));
end;
H:=H+Y[k]*J1;
end;
writeln;
write(' Otvet f(x*)=');
textcolor(18);
writeln(H:5:3);
writeln;
textcolor(15);
write(' Nazhmite Enter');
readln;
Gd:=Detect;
InitGraph(Gd, Gm, 'a:\');
if GraphResult<>grOk then
begin
writeln('Oshibka grafiki!');
readln;
halt(1);
end;
ClearDevice;
a:=-5;
ii:=0;
{vichislenie koordinat tochek grafika}
while a<=5 do
begin
H:=0;
for k:=1 to n do
begin
J1:=1;
for i:=1 to n do
begin
if i<>k then
J1:=J1*((a-x[i])/(x[k]-x[i]));
end;
H:=H+Y[k]*J1;
end;
inc(ii);
z[ii]:=H;
z1[ii]:=a;
a:=a+0.2;
end;
ii:=1;
a:=-5;
setcolor(2);
{postroenie tochek grafika}
while a<4.8 do
begin
inc(ii);
e1:=round(20*z1[ii]+320);
f1:=round(280-20*z[ii]);
a:=a+0.2;
if (e1<=20) or (e1>=620) or (f1<=20) or (f1>=460) then
continue;
circle(e1, f1, 2);
end;
setcolor(15);
{postroenie chertok gorizontalnoy osi}
outtextxy(337, 287, '1');
j:=-14; n:=268; n1:=5; i:=20;
while i<600 do
begin
i:=i+20;
if j=0 then
begin
inc(j);
continue;
end;
setcolor(15);
outtextxy(i-3, 277, '|');
inc(j);
if j>-1 then
begin
n:=284;
n1:=2;
end;
end;
{postroenie chertok gorizontalnoy osi}
j:=-8; n:=330; n1:=5; i:=460;
while i>40 do
begin
i:=i-20;
if j=0 then
begin
inc(j);
continue;
end;
setcolor(15);
outtextxy(317, i-3, '-');
inc(j);
if j>-1 then
begin
n:=310;
n1:=2;
end;
end;
{postroenie liniy osey i ih oboznacheniy}
line(615, 285, 620, 280);
line(615, 275, 620, 280);
outtextxy(620, 290, 'X');
line(315, 25, 320, 20);
line(325, 25, 320, 20);
outtextxy(305, 10, 'Y');
outtextxy(310, 287, '0');
line(20, 280, 620, 280);
line(320, 460, 320, 20);
outtextxy(500, 450, 'Press Enter');
readln;
CloseGraph;
end;
{---------------------------------------------}
Procedure Nyuton;
var
s, s1, p, p1, xx, H, J1, a: real;
k, i, n, j, Gd, Gm, ii, e1, f1, n1: integer;
x, y, z, z1: array [1..50] of real;
label
l;
begin
repeat
clrscr;
write('Vvedite kolichestvo tochek: ');
readln(n);
if n<=0 then
begin
writeln;
write('Vvodit nado polozhitelnoe chislo! Nazhmite Enter');
readln;
end;
until n>0;
writeln;
for i:=1 to n do
begin
Write('vvedite x',i,': '); Readln(x[i]);
Write('vvedite y',i,': '); Readln(y[i]);
writeln;
end;
write(' Vvedite x*:'); Readln(xx);
s:=y[1];
for i:=2 to n do
begin
p:=1; s1:=0;
for j:=1 to i do
begin
if j=i then
goto l;
p:=p*(xx-x[j]);
l:
p1:=1;
for k:=1 to i do
begin
if j<>k then
p1:=p1*(x[j]-x[k]);
end;
p1:=y[j]/p1; s1:=s1+p1;
end;
p:=p*s1; s:=s+p;
end;
writeln;
write(' Otvet f(x*)=');
textcolor(18);
writeln(s:5:3);
writeln;
textcolor(15);
write(' Nazhmite Enter');
readln;
Gd:=Detect;
InitGraph(Gd, Gm, 'a:\');
if GraphResult<>grOk then
begin
writeln('Oshibka grafiki!');
readln;
halt(1);
end;
ClearDevice;
a:=-5;
ii:=0;
{vichislenie koordinat tochek grafika}
while a<=5 do
begin
H:=0;
for k:=1 to n do
begin
J1:=1;
for i:=1 to n do
begin
if i<>k then
J1:=J1*((a-x[i])/(x[k]-x[i]));
end;
H:=H+Y[k]*J1;
end;
inc(ii);
z[ii]:=H;
z1[ii]:=a;
a:=a+0.2;
end;
ii:=1;
a:=-5;
setcolor(2);
{postroenie tochek grafika}
while a<4.8 do
begin
inc(ii);
e1:=round(20*z1[ii]+320);
f1:=round(280-20*z[ii]);
a:=a+0.2;
if (e1<=20) or (e1>=620) or (f1<=20) or (f1>=460) then
continue;
circle(e1, f1, 2);
end;
setcolor(15);
{postroenie chertok gorizontalnoy osi}
j:=-14; n:=268; n1:=5; i:=20;
while i<600 do
begin
i:=i+20;
if j=0 then
begin
inc(j);
continue;
end;
setcolor(15);
outtextxy(i-3, 277, '|');
inc(j);
if j>-1 then
begin
n:=284;
n1:=2;
end;
end;
outtextxy(337, 287, '1');
{postroenie chertok gorizontalnoy osi}
j:=-8; n:=330; n1:=5; i:=460;
while i>40 do
begin
i:=i-20;
if j=0 then
begin
inc(j);
continue;
end;
setcolor(15);
outtextxy(317, i-3, '-');
inc(j);
if j>-1 then
begin
n:=310;
n1:=2;
end;
end;
{postroenie liniy osey i ih oboznacheniy}
line(615, 285, 620, 280);
line(615, 275, 620, 280);
outtextxy(620, 290, 'X');
line(315, 25, 320, 20);
line(325, 25, 320, 20);
outtextxy(305, 10, 'Y');
outtextxy(310, 287, '0');
line(20, 280, 620, 280);
line(320, 460, 320, 20);
outtextxy(500, 450, 'Press Enter');
readln;
CloseGraph;
end;
{---------------------------------------------}
Procedure Win (X1,Y1,X2,Y2,R,Back,Text_Col:INTEGER;
Stroka:STRING);
VAR
i,j,k:INTEGER;
BEGIN
Window (X1,Y1,X2,Y2);
TextBackGround (Black);
CLRSCR;
TextColor (Text_Col);
K:=LENGTH (Stroka);
IF ODD (K)
THEN
INC (K);
IF R=1
THEN
BEGIN
GotoXY (2,1);
WRITE (#218);
GotoXY (X2-X1,1);
WRITE (#191);
GotoXY (2,Y2-Y1+1);
WRITE (#192);
GotoXY (X2-X1,Y2-Y1+1);
WRITE (#217);
GotoXY (3,1);
FOR i:=2 TO X2-X1-2 DO
WRITE (#196);
IF K<(X2-X1)
THEN
BEGIN
GotoXY ((X2-X1-K) DIV 2+1,1);
WRITE (Stroka)
END;
FOR i:=2 TO Y2-Y1 DO
BEGIN
GotoXY (2,i);
WRITE (#179);
GotoXY (X2-X1,i);
WRITE (#179)
END;
GotoXY (3,Y2-Y1+1);
FOR i:=3 TO X2-X1-1 DO
WRITE (#196)
END;
IF R=2
THEN
BEGIN
GotoXY (2,1);
WRITE (#201);
GotoXY (X2-X1,1);
WRITE (#187);
GotoXY (2,Y2-Y1+1);
WRITE (#200);
GotoXY (X2-X1,Y2-Y1+1);
WRITE (#188);
GotoXY (3,1);
FOR i:=2 TO X2-X1-2 DO
WRITE (#205);
IF K < (X2-X1)
THEN
BEGIN
GotoXY ((X2-X1-K) DIV 2+1,1);
WRITE (Stroka)
END;
FOR i:=2 TO Y2-Y1 DO
BEGIN
GotoXY (2,i);
WRITE (#186);
GotoXY (X2-X1,i);
WRITE (#186)
END;
GotoXY (3,Y2-Y1+1);
FOR i:=3 TO X2-X1-1 DO
WRITE (#205)
END
END;
{---------------------------------------------}
BEGIN
WHILE TRUE DO
BEGIN
TextBackGround (8);
CLRSCR;
Window (16,3,65,7);
TextBackGround (2);{–ўҐв ¤ЇЁбЁ}
CLRSCR;
TextColor (7);
GotoXY (3,2);
WRITE (' Programma interpolirovaniya algebraicheskih ');
GotoXY (3,4);
WRITE (' mnogochlenov metodami Lagranzha i Nyutona ');
Max:=0;
FOR i:=1 TO Men DO
IF Max < LENGTH (MENU [i] )
THEN
Max:=LENGTH (MENU [i] );
K1:=(80-Max) DIV 2;
Win (K1,11,Max+k1+10,11+Men+2,1, 15,white,' MENU ');
N:=10 DIV 2;
FOR i:=1 TO Men DO
BEGIN
GotoXY (N,i+2);
WRITE ('',menu[i],'')
END;
K:=1;
GotoXY (N,K+2);
TextBackGround (2);{–ўҐв Єгаб®а }
WRITE ('',Menu[K],'');
REPEAT
DF:=READKEY;
IF ORD (DF) = 0
THEN
BEGIN
DF:=READKEY;
CASE DF OF
#80 : BEGIN
GotoXY (N,K+2);
TextBackGround (0);{–ўҐв Єгаб®а }
WRITE ('',Menu[K],'');
IF K=Men
THEN
K:=1
ELSE
INC (K);
GotoXY (N,K+2);
TextBackGround (2);{–ўҐв Єгаб®а }
WRITE ('',Menu[K],'')
END;
#72 : BEGIN
GotoXY (N,K+2);
TextBackGround (0);{–ўҐв Єгаб®а }
WRITE ('',Menu[K],'');
IF K=1
THEN
K:=Men
ELSE
DEC (K);
GotoXY (N,K+2);
TextBackGround (2);{–ўҐв Єгаб®а }
WRITE ('',Menu[K],'')
END
END
END;
UNTIL (DF=#13) OR (DF=#27);
Window (1,1,80,25);
TextBackGround(7);{–ўҐв ўлў®¤ }
CLRSCR;
CASE DF OF
#13 :BEGIN
CASE K OF
1:begin
textbackground(0);
Lograng;
end;
2:begin
textbackground(0);
Nyuton;
end;
3:Oprog;
4:Begin
Window (1,1,80,25);
TextBackGround (8);
CLRSCR;
EXIT
END
END
END;
#27:BEGIN
Window (1,1,80,25);
TextBackGround (8);
CLRSCR;
EXIT
END
END
End;
DF:=READKEY;
Window (1,1,80,25);
TextBackGround (2);
CLRSCR;
END.