program interpol;
uses crt, graph;
const
MAXCOUNT = 30;
type
per = array [0 .. MAXCOUNT] of real;
var
X, y: per;
n, i: integer;
l, D, f: real;
label Lp, Lt;
{Процедура виведення титульного аркуша}
Procedure Titul;
begin
Clrscr;
GoToXY (23,2);
Writeln ('Федеральне агентство з освіти');
GoToXY (22,3);
Writeln ('Тульський державний університет');
GoToXY (28,4);
Writeln ('КАФЕДРА РАДІОЕЛЕКТРОНІКИ');
GoToXY (14,8);
Writeln ('Інтерполяція функції однієї змінної методом Ньютона.');
GoToXY (27,9);
Writeln ('Побудова графіка полінома.');
GoToXY (34,12);
Writeln ('Варіант # 7');
GoToXY (24,17);
Writeln ('Студент гр. 220371 Поляков A. M.');
GoToXY (20,19);
Writeln ('Керівник доцент, K. T. H. Давидов B. B.');
GoToXY (33,23);
Writeln ('Тула, 2008 g.');
readkey;
clrscr;
end;
{Процедура виведення пояснення до програми}
Procedure help;
begin
clrscr;
writeln (Ця програма за значеннями функції f (x) заданої таблично в декількох точках відрізка знаходить її значення в '+
+ Інших точках даного відрізка. Точки з координатами (x i, y i) називаються вузловими точками або вузлами. ');
writeln ('Кількість вузлів в табличній функції має бути дорівнює N = n +1.');
writeln ('Після введення кількості вузлів n (початкова точка (x [0], y [0]) не є вузлом) потрібно вводити вузлові точки +
+ 'Функції. Після цього програма зможе знаходити значення даної функції в інших точках відрізка (x [0] .. x [n ]).');
writeln (Після цього на екран будуть виведений графік полінома. ');
readkey;
clrscr;
end;
{Процедура введення табличних значень}
procedure Enter (var X, y: per);
var
i: integer;
label mp;
begin
mp: for i: = 0 to n do
begin
write ('X [', i, '] ='); readln (x [i]);
write ('y [', i, '] ='); readln (y [i]);
end;
for i: = 0 to n-1 do
if x [i +1]-x [i] <= 0 then
begin
writeln ('Помилка. Повторіть введення.');
goto mp
end;
end;
{Процедура виведення табличних значень}
procedure Print (n: integer; X, y: per); var
i: integer;
begin
for i: = 0 to n do
begin
write (x [i]: 12:6);
end;
writeln;
for i: = 0 to n do
begin
write (y [i]: 12:6);
end;
writeln;
end;
{Функція формули Ньютона}
Function Polinom (n: integer; d: real; X, y: per): real;
var
l: real;
k, i: integer;
p: real;
begin
L: = y [0];
P: = 1;
for k: = 1 to n do begin
P: = P * (DX [k-1]);
for i: = 0 to (nk) do begin
Y [i]: = (y [i +1]-y [i]) / (x [i + k]-x [i]);
end;
L: = L + P * y [0];
end;
POlinom: = l;
end;
{Процедура побудова графіка}
procedure Grafik (n: integer; D: real; X, Y: per; L: real);
const
step = 10;
var
driver, mode: integer;
i: longint;
st: string;
u, k: integer;
begin
writeln ('Введіть крок поділу графіка ");
readln (u);
k: = 26;
driver: = detect;
initgraph (driver, mode ,'');
setcolor (1);
line (320,0,320,480);
line (0,240,640,240);
for i: = 0 to 32 do begin
setlineStyle (1,0,0);
line (0, i * k +6,640, i * k +6);
line (i * k +8,0, i * k +8,480);
end;
setcolor (3);
outtextxy (310,15, 'y');
outtextxy (620,240, 'x');
for i: = 0 to getmaxx div (2 * k) do
begin
str (i * u, st);
outtextxy (getmaxx div 2 + i * (k), getmaxy div 2 + step, st);
str (-i * u, st);
outtextxy (getmaxx div 2-i * k, getmaxy div 2 + step, st);
end;
for i: = 1 to getmaxy div (2 * k) do
begin
str (-i * u, st);
outtextxy (getmaxx div 2 + step, getmaxy div 2 + i * k, st);
str (i * u, st);
outtextxy (getmaxx div 2 + step, getmaxy div 2-i * k, st);
end;
d: =- u * 12;
repeat
d: = d +0.002;
putpixel (round (320 + d * k / u), round (240 + (-POlinom (n, d, x, y)) * k / u), 10);
until d> u * 12;
readkey;
end;
{Основний текст програми}
begin
TextMode (3);
TextBackground (1);
TextColor (14);
Titul;
writeln ('Вивести пояснення до програми?? (Так-1, Ні-0)');
read (f);
if f = 1 then help else
lp: clrscr;
writeln ('Введіть кількість вузлів n (N = n +1)');
read (n);
Enter (X, y);
Print (n, X, y);
repeat
lt: Writeln ('BbBedite X (ot', x [0]: 4:2, 'do', x [n]: 4:2 ,')');
read (d);
if d <x [0] then begin
writeln ('Помилка. x не може бути менше ", x [0]: 4:2);
goto lt; end;
if d> x [n] then begin
writeln ('Помилка. x не може бути більше', x [n]: 4:2);
goto lt; end;
writeln (Polinom (n, d, X, y): 6:3);
writeln ('Знайти значення для іншої точки X? (ДА-1, НІ-0)');
read (f)
until f = 0;
Grafik (n, D, X, Y, l);
readkey;
CloseGraph;
clrscr;
writeln ('Повторити для іншої функції? (Так -1, Ні -0)');
read (f);
if f = 1 then goto lp else end.