 |
Комплектация и загрузка программы
|
|
|
|
Комплектация
Папка my_stuff, в которой содержится:
– RUOP. exe – основной файл программы;
– help. asc – файл с методологической информацией;
– m_n. txt – файл, содержащий значения промежутков m и n;
– a_b_c. txt – файл, содержащий значения параметров a, b, c;
– E. txt – файл, содержащий значение погрешности E;
– egavga. bgi – файл для работы с графикой;
– keyrus. com – файл для работы с русским языком;
– trip. chr – файл, содержащий русский шрифт.
Порядок инсталляции и запуск программы
Требуется скопировать папку my_stuff с содержащимися в ней файлами в папку “c: \temp\”. Для запуска программы необходимо запустить файл RUOP. exe, расположенный в папке my_stuff.
При копировании программы в иную папку, невозможными становятся работа "Справки" загрузка и автоматическое сохранение информации в файлы.
ТЕСТОВЫЕ ПРИМЕРЫ
Тестовые примеры необходимы пользователю для того, чтобы узнать возможности, которые предоставляет данный программный продукт или протестировать его на правильность решения уравнений.
Тестовые примеры для решения уравнения вида y(x) =a*ln(b*x) приводятся в таблице 6.1.
Таблица 7.1. Тестовые примеры для уравнения вида y(x) =a*ln(b*x)
| m | n | a | b | E | Результат |
| 1 | 10 | 1 | 0.5 | 0.01 | 2 |
| -20 | -0.01 | 9 | -2 | 0.01 | -0.2 |
| 9 | 14 | 100 | 1 | 0.01 | Уравнение не имеет корней |
Тестовые примеры для решения уравнения вида y(x) =a*x^2+b*x+c приводятся в таблице 6.2.
Таблица 7.2. Тестовые примеры для уравнения вида y(x) =a*x^2+b*x+c
| m | n | a | b | c | E | Результат |
| -10 | 10 | 5 | 29 | 3 | 0.01 | -0.1054 |
| -10 | 10 | 0 | 4 | 10 | 0.01 | -2.5 |
| 5 | 20 | 5 | 29 | 4 | 0.01 | Уравнение не имеет |
При введении в программу данных, не отвечающих требованиям типу, будет появляться сообщение "Ошибка ввода", пока не будут введены правильные данные, соответствующие требованиям программы.
|
|
|
Если уравнение не имеет корней, то построение графика и сохранение данных, результатов становиться невозможным.
При введении в программу данных, отвечающих требованиям, будут появляться сопроводительные сообщения (советы) по дальнейшим вариантам продолжения.
Если уравнение имеет корень, то построение графика и сохранение данных, результатов становится возможным.
ВЫВОДЫ
В процессе создания была написана программа, осуществляющая решение уравнения с одной переменной методом Ньютона (касательных). Программа способна решать два вида уравнений, а также выстраивать график по вводимым данным.
В программе реализована работа с графикой и с файлами, имеет интуитивно понятный интерфейс, реализована возможность справки.
Корректная работа программы обеспечивается строгим следованием методическим указаниям, а также надёжной системой проверки промежуточных результатов в ходе выполнения самой программы.
Однако ощутимыми недостатками являются расчёт результатов всего для двух функций и отсутствие касательных к графику при построении графика функции, устранение которых планируется в ближайшее время.
В целом получившийся программный продукт является отличным пособием для студентов высших учебных заведений и для учащихся математических классов среднеобразовательных школ.
ПЕРЕЧЕНЬ ИСПОЛЬЗОВАННОЙ ЛИТЕРАТУРЫ
1. Фаронов В.В. "Turbo Pascal 7.0. Начальный курс": учебное пособие. – М.: Кнорус, 2006. – 576 с.
2. Сухарёв М. Turbo Pascal 7.0. Теория и практика программирования. – СПб: "Наука и техника", 2003. – 576 с.
3. Методические указания по оформлению студенческих работ для студентов специальностей 080403 "Программное обеспечение автоматизированных систем", 080404 "Интеллектуальные системы принятия решений", 050103 "Экономическая кибернетика"; Утверждено на заседании учёного совета ДонГИИИ протокол № 7 от 23.02. 2004 г. – Донецк: ДонГИИИ, 2004, 46 с.
|
|
|
Приложение А
ТЕХНИЧЕСКОЕ ЗАДАНИЕ
А.1 Общие сведения
Полное название программного продукта: "Численные методы. Решение уравнений с одной переменной методом Ньютона (касательных)". Её условное обозначение РУОП. Работа выполняется студентом 1-го курса Донецкого государственного института искусственного интеллекта (ДонГИИИ), факультета СКИТ, группы СУА-05, Николаевым Алексеем Сергеевичем.
Основанием для разработки РУОП является задание, выданное кафедрой Программного обеспечения интеллектуальных систем (ПОИС).
Плановый срок начала работы: 17 февраля 2006 года.
Дата защиты работы: 22 мая 2006 года.
А.2 Назначения и цели создания программы
Данная программа создана как учебное пособие для студентов высших учебных заведений и для учащихся математических классов среднеобразовательных школ. Позволяет решать уравнения вида y(x) =a×ln(b×x) и y(x) =ax2+bx+c методом Ньютона (касательных).
А.3 Требования к программному продукту
А.3.1. Общие требования
Программа должна выполнять следующие требования:
1) решать два вида уравнений: y(x) =a×ln(b×x) и y(x) =ax2+bx+c методом Ньютона (касательных);
2) поддержку графического меню, состоящего из пяти пунктов:
– помощь и справочная информация;
– y(x) =a×ln(b×x);
– y(x) =a×x^2+b×x+c;
– построение графика;
– выход;
3) по вводимым значениям промежутков уравнения и по вводимым значениям коэффициентов уравнения:
– вычислять корень уравнения в зависимости от вводимых данных;
– выстраивать график уравнения, отмечая, на оси абсцисс, промежуточные корни уравнения, выводить значение корня уравнения.
А.3.2. Функциональные требования
Для реализации программного продукта необходимо разработать:
1) поддержку файлов, предоставление возможности решать пользователю самому, вводить начальные данные из файла или с клавиатуры, необходимость сохранения данных и полученных результатов в файлы;
2) систему справочной информации по реализуемому в РУОП методу Ньютона.
А.3.2. Требования к техническому обеспечению
Рекомендуемые характеристики аппаратных средств:
– КПУ: i486;
– ОЗУ: 4 мб;
|
|
|
– видеоадаптер VGA, EGA;
– монитор: VGA, EGA;
– клавиатура;
– свободное дисковое пространство – около 100 килобайт.
А.3.3. Требования к программному обеспечению
Для успешной загрузки программы требуется наличие операционной системы MS DOS 6.0.
А.3.5. Требования к организационному обеспечению
Организационное обеспечение включает в себя пояснительную записку с приложениями: техническое задание, руководство пользователя, экранные формы, тексты программы.
Приложение Б
РУКОВОДСТВО ПОЛЬЗОВАТЕЛЯ
Главное меню появляется после титульного листа. Меню состоит из пяти пунктов. Скроллинг осуществляется клавишами "z" и "x". Вход в подменю осуществляется клавишей "Enter".
В пункте "Справка" содержится методологическая информация по методу Ньютона.
В пункте "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: \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: ='Cправка';
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.
|
|
|
