Logo GenDocs.ru

Поиск по сайту:  


Загрузка...

Интерполяция алгебраических многочленов методами Ньютона и Лагранжа - файл текст программы.doc


Загрузка...
Интерполяция алгебраических многочленов методами Ньютона и Лагранжа
скачать (92.9 kb.)

Доступные файлы (7):

1.pas
EGAVGA.BGI
o_prog.txt1kb.10.11.2004 23:10скачать
отчет.doc172kb.11.06.2007 18:03скачать
содержание .doc21kb.11.06.2007 17:50скачать
текст программы.doc74kb.17.02.2005 23:22скачать
титульный лист.doc21kb.11.06.2007 18:01скачать

текст программы.doc

Реклама MarketGid:
Загрузка...
Текст программы
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.


Скачать файл (92.9 kb.)

Поиск по сайту:  

© gendocs.ru
При копировании укажите ссылку.
обратиться к администрации
Рейтинг@Mail.ru