Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных)
В пункте "Справка" содержится методологическая информация по методу Ньютона.
В пункте "y(x) =a*ln(b*x)" осуществляется решение уравнения y(x) =a*ln(b*x) по вводимым параметрам, промежуткам и погрешности. В пункте осуществляется загрузка данных из файлов и сохранение данных в файлы по желанию пользователя.
В пункте "y(x) =a*x^2+b*x+c" осуществляется решение уравнения y(x) =a*x^2+b*x+c по вводимым параметрам, промежуткам и погрешности. В пункте осуществляется загрузка данных из файлов и сохранение данных в файлы по желанию пользователя.
В пункте "Построение графика" осуществляется построение графика по вводимым в уравнение данным.
В пункте "Выход" осуществляет выход из программы.
Приложение В
ЭКРАННЫЕ ФОРМЫ
Рисунок В.1 – Заставка, титульная страница
Рисунок В.2 – Меню
Рисунок В.3 – Общий вид окна "y(x) =a*ln(b*x)"
Рисунок В.4 – Общий вид окна "y(x) =a*x^2+b*x+c"
Рисунок В.5 – График функции y(x) =1*ln(0.5*x) на промежутке [1; 10]
Рисунок В.6 – График функции y(x) =5*sqr(x) +29*x+3 на промежутке [-10; 10]
Приложение Г
ЛИСТИНГ ПРОГРАММЫ
program Restorant;
uses CRT, Graph;
var a, b, c, m, n: real;
number, i: byte;
mass: array [1. . 20] of real;
{***************************************************************************}
procedure title;
begin
textcolor(2);
writeln (' Министерство образования Украины');
writeln (' Донецкий государственный институт искусственного интеллекта');
writeln;
writeln (' Кафедра ПОИС');
writeln;
writeln;
writeln (' Курсовая работа');
writeln (' По курсу "АЯ и П"');
writeln (' На тему: "Решение нелинейных уравнений методом Ньютона');
writeln (' (методом секущих)" ');
writeln;
writeln;
writeln (' Выполнил: ');
writeln (' Студент группы СУА-05');
writeln (' Николаев А.С. ');
writeln (' Проверил: ');
writeln (' cт. преп. кафедры ПОИС');
writeln (' Бычкова Е.В. ');
writeln (' асс. кафедры ПОИС');
writeln (' Волченко E. B. ');
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: tempmy_stuffm_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: tempmy_stuffa_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: tempmy_stuffE. 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: tempmy_stuffm_n. txt');
{$I-} ReWrite (f); {$I+}
mistake: =IOResult;
If mistake <> 0 then WriteLn ('Каталога для сохранения не существует') else
begin
Write (f, m, n); Close (f);
Assign (f, 'c: tempmy_stuffa_b_c. txt');
ReWrite (f); If number = 1 then Write (f, a, b) else
Write (f, a, b, c); Close (f);
Assign (f, 'c: tempmy_stuffE. txt');
ReWrite (f); Write (f, E); Close (f);
Assign (f, 'c: tempmy_stuffx. 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 >