writeln ('За курсом "АЯ та П"');
writeln ('На тему: "Рішення нелінійних рівнянь методом Ньютона');
writeln ('(методом січних) "');
writeln;
writeln;
writeln ('Виконав:');
writeln ('Студент групи СУА-05');
writeln ('Миколаїв А.С.');
writeln ('Перевірив:');
writeln ('cт. преп. кафедри поїсом');
writeln ('Бичкова Є.В.');
writeln ('ас. кафедри поїсом');
writeln ('Волченко EB');
writeln;
writeln ('2005');
writeln;
writeln;
textcolor (red);
writeln ('Натисніть "Введення" для продовження "');
textcolor (lightgray); Readln;
end;
{************************************************* **************************}
procedure pro; FORWARD;
{************************************************* **************************}
procedure graphica;
var d, r, e: integer;
begin
d: = detect;
InitGraph (d, r,'');
e: = GraphResult;
if e <> grOK then WriteLn (GraphErrorMsg (e)) else pro;
end;
{************************************************* **************************}
procedure setka (yn: integer; y2: real);
var x, y, cross, dcross: integer;
lx, ly, dlx, dly: real;
st: string;
begin
If abs (m) <abs (n) then
dlx: = Abs (n/6.25) else dlx: = Abs (m/6.25);
dly: = y2 / ((yn-110) / 40);
dcross: = 0;
lx: = 6 * dlx;
SetColor (LightGray);
For cross: = 1 to 7 do
begin
Str (lx: 0: 1, st);
If lx> = 0 then
OutTextXY (535-dcross, yn +7, st) else
OutTextXY (525-dcross, yn +7, st);
lx: = lx-2 * dlx;
dcross: = dcross +80;
end;
x: = 80;
Repeat
SetLineStyle (DottedLn, 0, NormWidth);
Line (x, yn-3, x, 110); Line (x, yn +3, x, 360);
SetLineStyle (SolidLn, 0, NormWidth);
Line (x, yn-3, x, yn +3);
x: = x +40;
Until x = 600;
ly: = 0;
y: = yn;
Repeat
If ly> 0 then
begin
Line (317, y, 323, y);
Str (ly: 0: 1, st);
OutTextXY (295, y +7, st);
end;
ly: = ly + dly;
SetLineStyle (DottedLn, 0, NormWidth);
Line (323, y, 570, y); Line (70, y, 317, y);
SetLineStyle (SolidLn, 0, NormWidth);
y: = y-40;
Until (y <110);
ly: = 0;
y: = yn;
Repeat
If ly <0 then
begin
Line (317, y, 323, y);
Str (ly: 0: 1, st);
OutTextXY (285, y +7, st);
end;
ly: = ly-dly;
SetLineStyle (DottedLn, 0, NormWidth);
Line (323, y, 570, y); Line (70, y, 317, y);
SetLineStyle (SolidLn, 0, NormWidth);
y: = y +40;
Until (y> 360);
end;
{************************************************* **************************}
{************************************************* **************************}
procedure groffunc;
var l, y0: integer;
y1, y2, x, y, mx, my: real;
gr, grand: string;
{************************************************* **************************}
function f (x: real): real;
begin
Case number of
1: f: = a * ln (b * x);
2: f: = a * sqr (x) + b * x + c;
end;
end;
{************************************************* **************************}
begin
If number = 0 then OutTextXY (300, 20, 'Введіть спочатку дані в рівняння!') Else
begin
ClearDevice;
SetBKColor (black);
case number of
1: grand: = ('y (x) =* ln (* x)');
2: begin grand: = ('y (x) =* sqr (x) + * x +');
str (c: 0: 2, gr); insert (gr, grand, 17); end;
end;
str (b: 0: 2, gr); insert (gr, grand, (6 + number * 4));
str (a: 0: 2, gr); insert (gr, grand, 6);
OutTextXY (300, 40, grand);
y1: = 0; y2: = 0;
x: = m;
Repeat
y: = f (x);
if y <y1 then y1: = y;
if y> y2 then y2: = y;
x: = x +0.01;
Until (x> = n);
my: = 250/abs (y2-y1);
If (abs (m)> abs (n)) then mx: = 250/abs (m) else
mx: = 250/abs (n);
y0: = 360-abs (Round (y1 * my));
setka (y0, y2);
SetColor (blue);
Line (320, 360, 320, 90);
Line (70, y0, 590, y0);
Line (320, 90, 317, 93); Line (320, 90, 323, 93);
Line (590, y0, 587, y0-3); Line (590, y0, 587, y0 +3);
OutTextXY (595, y0-5, 'x'); OutTextXY (315, 80, 'y');
OutTextXY (400, 450, 'Натисніть "Введення" для виходу ");
If Abs (m)> Abs (n) then y1: = Abs (m) else y1: = Abs (n);
SetColor (Red);
str (mass [i]: 5: 4, grand);
OutTextXY (300 + Round ((250/y1) * mass [i]), 400, grand);
Line (320 + Round ((250/y1) * mass [i]), y0, 320 + Round ((250/y1) * mass [i]), 390);
For l: = 1 to i-1 do
begin
SetColor (2 + l);
Line (320 + Round ((250/y1) * mass [l]), y0 +10, 320 + Round ((250/y1) * mass [l]), y0-10);
end;
x: = m;
Repeat
y: = f (x);
PutPixel (320 + Round (x * mx), y0-Round (y * my), 15);
x: = x +0.01;
Until (x> = n);
ReadLn;
pro;
end;
end;
{************************************************* **************************}
{************************************************* **************************}
procedure load_file_1;
var mistake: byte;
k: char;
st: string;
f: text;
begin
Repeat
If number = 1 then
WriteLn ('Введіть проміжки [m, n] одного знаку') else
WriteLn ('Введіть проміжки [m, n]');
WriteLn ('Натисніть "1" для введення даних з клавіатури');
WriteLn ('Натисніть "2" для введення даних з файлу');
k: = ReadKey;
Case k of
'1 ': Begin
WriteLn ('Введення:');
{$ I-}
ReadLn (m, n);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Помилка введення');
end;
'2 ': Begin
WriteLn ('Натисніть "1" для вказівки розташування свого файлу');
WriteLn ('Натисніть "2" для введення з файлу, створеного автоматично');
k: = ReadKey;
If k = '1 'then begin
WriteLn ('Введіть шлях до файлу з розширенням. Txt');
ReadLn (st);
Assign (f, st);
end else
If k = '2 'then assign (f,' c: \ temp \ my_stuff \ m_n. Txt ');
{$ I-}
Reset (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then
WriteLn ('Немає файлу не існує') else
begin
{$ I-}
Read (f, m, n);
{$ I +}
mistake: = IOResult; Close (f); If mistake <> 0 then
WriteLn ('Інформація у файлі не відповідає потрібному типу') else
begin
WriteLn (m: 0: 2);
WriteLn (n: 0: 2);
end;
end; WriteLn ('Натисніть "Введення для продовження"'); ReadLn;
end;
end;
Until mistake = 0;
end;
{************************************************* **************************}
procedure load_file_2;
var mistake: byte;
k: char;
st: string;
f: text;
begin
Repeat
WriteLn ('Натисніть "1" для введення з клавіатури');
WriteLn ('Натисніть "2" для введення даних з файлу');
k: = ReadKey;
Case k of
'1 ': Begin
WriteLn ('Введення:');
If number = 1 then {$ I-} ReadLn (a, b) {$ I +} else
If number = 2 then {$ I-} ReadLn (a, b, c) {$ I-};
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Помилка введення');
end;
'2 ': Begin
WriteLn ('Натисніть "1" для вказівки розташування свого файлу');
WriteLn ('Натисніть "2" для введення з файлу, створеного автоматично');
k: = ReadKey;
If k = '1 'then begin
WriteLn ('Введіть шлях до файлу розширенням. Txt');
ReadLn (st);
assign (f, st);
end else
If k = '2 'then assign (f,' c: \ temp \ my_stuff \ a_b_c. Txt ');
{$ I-}
Reset (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then
WriteLn ('Немає файлу не існує') else
begin
If number = 1 then {$ I-} Read (f, a, b) {$ I +} else
{$ I-} Read (f, a, b, c); {$ I +}
mistake: = IOResult; Close (f); If mistake <> 0 then
WriteLn ('Інформація у файлі не відповідає потрібному типу') else
begin
WriteLn (a: 0: 2);
WriteLn (b: 0: 2);
If number = 2 then WriteLn (c: 0: 2);
end;
end; WriteLn ('Натисніть "Введення для продовження"'); ReadLn;
end;
end;
Until mistake = 0;
end;
{************************************************* **************************}
procedure load_file_3 (var E: real);
var mistake: byte;
k: char;
st: string;
f: text;
begin
Repeat
WriteLn ('Натисніть "1" для введення даних з клавіатури');
WriteLn ('Натисніть "2" для введення даних з файлу');
k: = ReadKey;
Case k of
'1 ': Begin
WriteLn ('Введення:');
{$ I-}
ReadLn (E);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Помилка введення');
end;
'2 ': Begin
WriteLn ('Натисніть "1" для вказівки розташування свого файлу');
WriteLn ('Натисніть "2" для введення з файлу, створеного автоматично');
k: = ReadKey;
If k = '1 'then begin
WriteLn ('Введіть шлях до файлу з розширенням. Txt');
ReadLn (st);
assign (f, st);
end else
If k = '2 'then assign (f,' c: \ temp \ my_stuff \ E. txt ');
{$ I-}
Reset (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then
WriteLn ('Немає файлу не існує') else
begin
{$ I-}
Read (f, E);
{$ I +}
mistake: = IOResult; Close (f); If mistake <> 0 then
WriteLn ('Інформація у файлі не відповідає потрібному типу') else
begin
WriteLn (E: 0: 3);
end;
end; WriteLn ('Натисніть "Введення для продовження"'); ReadLn;
end;
end;
Until mistake = 0;
end;
{************************************************* **************************}
procedure save_file (E: real);
var k: char;
mistake: byte;
f: text;
st: string;
begin
Repeat
WriteLn ('Якщо хочете зберегти дані та результати натисніть "1"');
WriteLn ('Якщо не хочете зберігати дані та результати натисніть "2"');
k: = ReadKey;
Case k of
'1 ': Begin
WriteLn ('Якщо хочете зберегти дані в зазначені вами файли натисніть "1"');
WriteLn ('Якщо хочете, щоб збереження відбулося автоматично натисніть "2"');
k: = ReadKey;
If k = '1 'then begin
Repeat
WriteLn ('Введіть шлях та ім'я файлу c для збереження проміжків [m, n]');
ReadLn (st);
Assign (f, st);
{$ I-}
ReWrite (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Файл не може бути створений') else
begin
Write (f, m: 3, n: 3); Close (f); WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end;
Until mistake = 0;
Repeat
If number = 1 then
WriteLn ('Введіть шлях та ім'я файлу для збереження коефіцієнтів "a", "b"')
else
If number = 2 then
WriteLn ('Введіть шлях та ім'я файлу для збереження коефіцієнтів "a", "b", "c"');
ReadLn (st);
Assign (f, st);
{$ I-}
ReWrite (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Файл не може бути створений') else
begin
If number = 1 then begin
Write (f, a: 3, b: 3); Close (f); WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end else
If number = 2 then begin
Write (f, a: 3, b: 3, c: 3); Close (f); WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end;
end;
Until mistake = 0;
Repeat
WriteLn ('Введіть шлях та ім'я файлу для збереження похибки "Е"');
ReadLn (st);
Assign (f, st);
{$ I-}
ReWrite (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Файл не може бути створений') else
begin
Write (f, E: 3); Close (f); WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end;
Until mistake = 0;
Repeat
WriteLn ('Введіть шлях та ім'я файлу для збереження кореня');
ReadLn (st);
Assign (f, st);
{$ I-}
ReWrite (f);
{$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Файл не може бути створений') else
begin
Write (f, mass [i]: 3); Close (f); WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end;
Until mistake = 0;
end else
If k = '2 'then begin
Assign (f, 'c: \ temp \ my_stuff \ m_n. Txt');
{$ I-} ReWrite (f); {$ I +}
mistake: = IOResult;
If mistake <> 0 then WriteLn ('Каталога для збереження не існує') else
begin
Write (f, m, n); Close (f);
Assign (f, 'c: \ temp \ my_stuff \ a_b_c. Txt');
ReWrite (f); If number = 1 then Write (f, a, b) else
Write (f, a, b, c); Close (f);
Assign (f, 'c: \ temp \ my_stuff \ E. txt');
ReWrite (f); Write (f, E); Close (f);
Assign (f, 'c: \ temp \ my_stuff \ x. txt');
ReWrite (f); Write (f, mass [i]); Close (f);
WriteLn ('Інформація збережена. Натисніть "Введення"'); ReadLn;
end;
end;
end;
'2 ': Mistake: = 0;
end;
Until mistake = 0;
end;
{************************************************* **************************}
{************************************************* **************************}
procedure equation_1;
var mistake, code_of: byte;
E, x1, root: real;
bool_of: boolean;
k: char;
{************************************************* **************************}
begin
closegraph;
bool_of: = false;
Repeat
number: = 1;
clrscr;
WriteLn ('Рівняння виду: y (x) = a * ln (b * x)');
Repeat
load_file_1;
If m> n then begin
WriteLn ('Введіть "m" <"n"');
WriteLn ('Натисніть "Введення" для подолженія'); ReadLn;
end else
If (m <0) and (n> 0) or (m = 0) or (n = 0) then
begin
WriteLn ('"m" і "n" повинні бути одного знака і нерівні 0');
WriteLn ('Натисніть "Введення" для продовження'); ReadLn;
end;
Until (((m <0) and (n <0)) or ((m> 0) and (n> 0))) and (m <= n);
Repeat
WriteLn ('Введіть коефіцієнти рівняння "a", "b"');
load_file_2;
If m * b <= 0 then begin
WriteLn ('спробуйте "b" іншого знака і нерівне 0');
WriteLn ('Натисніть "Введення" для продовження'); ReadLn;
end;
Until m * b> 0;
If a = 0 then begin
WriteLn ('Все "x" на проміжку [', m: 0: 1, ';', n: 0: 1, '] - рішення рівняння');
number: = 0; end else
begin
Repeat
WriteLn ('Введіть похибка "E"');
load_file_3 (E);
If E <= 0 then begin WriteLn ('Введіть "Е" більше 0');
WriteLn ('Натисніть "Введення" для продовження "');
end;
Until E> 0;
i: = 1;
If (a * ln (b * m) * (-a/sqr (m)))> 0 then begin mass [i]: = m; code_of: = 1 end else
If (a * ln (b * n) * (-a/sqr (n)))> 0 then begin mass [i]: = n; code_of: = 1 end else
begin WriteLn ('Рівняння не має коренів'); number: = 0; code_of: = 0; end;
If code_of = 1 then
begin
Repeat
x1: = mass [i]-a * ln (b * mass [i]) / (a ​​/ mass [i]);
root: = Abs (x1-mass [i]);
i: = i +1;
mass [i]: = x1;
Until root <E;
If (x1 <m) or (x1> n) then
begin WriteLn ('Рівняння не має коренів'); number: = 0; code_of: = 0; end else
WriteLn ('Коренем рівняння y (x) =', a: 0: 1, '* ln (', b: 0: 1, '* x) є:', x1: 5: 4);
end;
end;
WriteLn ('Натисніть "Введення"'); ReadLn; If code_of = 1 then save_file (E) else
WriteLn ('Так як рівняння не має коренів, то збереження не виконується');
WriteLn ('Якщо хочете вийти, то натисніть "ESC"');
WriteLn ('Якщо хочете ввести інші дані, то натисніть "Введення"');
k: = ReadKey;
code_of: = ord (k);
case code_of of
27: begin
bool_of: = true; graphica;
end;
13: bool_of: = false;
end;
Until bool_of;
end;
{************************************************* **************************}
{************************************************* **************************}
procedure equation_2;
var mistake, code_of: byte;
E, x1, root: real;
bool_of: boolean;
k: char;
{************************************************* **************************}
begin
closegraph;
bool_of: = false;
Repeat
number: = 2;
clrscr;
WriteLn ('Рівняння виду: y (x) = a * x ^ 2 + b * x + c');
Repeat
load_file_1;
If m> n then WriteLn ('Введіть "m" <"n"');
Until (m <= n);
WriteLn ('Введіть коефіцієнти рівняння "a", "b", "c"');
load_file_2;
If (a = 0) and (b = 0) and (c = 0) then begin
WriteLn ('Все "х" на проміжку [', m: 0: 1, ';', n: 0: 1, '] - рішення рівняння');
number: = 0; end else
begin
Repeat
WriteLn ('Введіть похибка "Е"');
load_file_3 (E);
If E <= 0 then begin WriteLn ('Введіть E> 0');
WriteLn ('Натисніть "Введення" для продовження');
end;
Until E> 0;
i: = 1;
If (a * sqr (n) + b * n + c) * (2 * a)> = 0 then begin mass [i]: = n; code_of: = 1 end else
If (a * sqr (m) + b * m + c) * (2 * a)> = 0 then begin mass [i]: = m; code_of: = 1 end else
begin WriteLn ('Рівняння не має коренів'); number: = 0; code_of: = 0; end;
If code_of = 1 then
begin
Repeat
x1: = mass [i] - ((a * sqr (mass [i]) + b * mass [i] + c) / (2 * a * mass [i] + b));
root: = Abs (x1-mass [i]);
i: = i +1;
mass [i]: = x1;
Until (root <E);
If (x1 <m) or (x1> n) then
begin WriteLn ('Рівняння не має коренів'); number: = 0; code_of: = 0; end else
WriteLn ('Коренем рівняння y (x) =', a: 0: 1, '* x ^ 2 +', b: 0: 1, '* x +', c: 0: 1, 'є:', x1: 0: 4);
end;
end;
WriteLn ('Натисніть "Введення"'); ReadLn; If code_of = 1 then save_file (E) else
WriteLn ('Так як рівняння не має коренів, то збереження не виконується');
WriteLn ('Якщо хочете вийти, то натисніть "ESC"');
WriteLn ('Якщо хочете ввести інші дані, то натисніть "Введення"');
k: = ReadKey;
code_of: = ord (k);
case code_of of
27: begin
bool_of: = true; graphica;
end;
13: bool_of: = false;
end;
Until bool_of;
end;
{************************************************* **************************}
procedure key (p1: byte);
Var y1, y2: integer;
name: string;
i: byte;
begin
ClearDevice;
SetColor (white);
OutTextXY (250, 435, '"Введення" - вхід "z", "x" - переміщення по меню');
y1: = 15;
y2: = 70;
for i: = 1 to 5 do
begin
Setcolor (blue);
Rectangle (16, y1-1, 251, y2-1);
RecTangle (17, y1-2, 252, y2-2);
RecTangle (18, y1-3, 253, y2-3);
SetFillStyle (1, lightblue);
Bar (15, y1, 250, y2);
case i of
1: Name: = 'Довідка';
2: Name: = 'y = a * ln (b * x)';
3: Name: = 'y = a * x ^ 2 + b * x + c';
4: Name: = 'Побудова графіка';
5: Name: = 'Вихід';
end;
SetColor (white);
OutTextXY (45, y1 +25, Name);
y1: = 20 + y2;
y2: = 75 + y2;
end;
SetColor (white);
p1: = p1-1;
Rectangle (18, 19 +75 * p1, 246, 66 +75 * p1);
end;
{************************************************* **************************}
procedure help;
var st: string;
f: text;
y: integer;
mistake: byte;
begin
ClearDevice;
Assign (f, 'c: \ temp \ My_stuff \ help. Asc');
{$ I-}
Reset (f);
{$ I +}
mistake: = IOResult; SetTextStyle (0, 0, 0);
If mistake <> 0 then OutTextXY (250, 220, 'Немає файлу не існує') else
begin
y: = 0;
Repeat
y: = 15 + y;
ReadLn (f, st);
OutTextXY (45, y, st);
Until EOf (f);
Close (f);
end;
OutTextXY (400, 450, 'Натисніть "Введення" для виходу ");
ReadLn; pro;
end;
{************************************************* **************************}
procedure eat (p2: byte; var bool: boolean);
begin
if p2 = 1 then help else
if p2 = 2 then equation_1 else
if p2 = 3 then equation_2 else
if p2 = 4 then groffunc else
if p2 = 5 then bool: = true;
end;
{************************************************* **************************}
procedure pro;
var p, code: byte;
k: char;
bool: boolean;
begin
ClearDevice;
p: = 1;
key (p);
bool: = false;
repeat
SetBKColor (lightgray);
SetTextStyle (1, 0, 4); SetColor (blue);
OutTextXY (390, 130, 'МЕНЮ');
SetTextStyle (0, 0, 0);
k: = ReadKey;
code: = ord (k);
Case code of
122: begin
p: = p-1; if p = 0 then p: = 5;
key (p);
end;
120: begin
p: = p +1; if p = 6 then p: = 1;
key (p);
end;
13: eat (p, bool);
end;
until bool;
CloseGraph;
end;
{************************************************* **************************}
begin
title;
number: = 0;
graphica;
end.