ВВЕДЕНИЕ

В данный момент существует много программ для решения уравнений, вычисления интегралов и дифференциалов: MathCAD, MATLAB, и т.д. Они имеют высокую точность вычисления, высокую функциональность, но имеют и свои недостатки. Главные из них – сложный непонятный интерфейс, высокая многофункциональность недоступна рядовому пользователю.
Рынок нуждается в более простых аналогах приведенных выше программ. Созданный программный продукт способен решать уравнения с одной переменной методом Ньютона (касательных). Он прост в эксплуатации, имеет интуитивно понятный интерфейс и способен выстраивать график уравнения, что является очень важным для пользователя.
Программа будет полезна всем, как студентам высших учебных заведений, так и школьникам.

1. ПОСТАНОВКА ЗАДАЧИ

Цель создания программного продукта
Главной целью работы является разработка программы способной решать уравнения с одной переменной методом Ньютона (касательных), что должно являться пособием для студентов высших учебных заведений и для учащихся математических классов среднеобразовательных школ в снижении ненужной нагрузки, связанной с многочисленными массивами вычислений.

1.2. Постановка задачи

В данном программном продукте необходимо реализовать решение двух видов уравнений: y(x) =aЧln(bЧx), y(x) =ax2+bx+c. Вместо коэффициентов должны использоваться параметры a, b, c, которые принимают значения, вводимые пользователем. Для нахождения корней, обязательным является указание промежутков, на которых определена функция, поэтому пользователь обязательно вводит промежутки функции m, n. Метод Ньютона является итерационным методом, следовательно, должна указываться погрешность вычисления ε. Обязательным является построение графика выбранной функции на заданном промежутке.

2. МАТЕМЕТИЧЕСКАЯ МОДЕЛЬ

Дисциплина "Численные методы" содержит набор методов и алгоритмов приближенного (численного) решения разнообразных математических задач, для которых точное аналитическое решение либо не существует, либо слишком сложно для использования на практике. При численном решении задач всегда возникает погрешность.
Выделяют абсолютную и относительную погрешность. Пусть р – точное значение искомого ответа, а p – приближённое значение, полученное с помощью численного метода.
Тогда  – абсолютная погрешность,
 – относительная погрешность.
На первом этапе необходимо найти отрезок [a,b], на котором функция имеет ровно один корень. На втором этапе происходит уточнение корня на отрезке с заданной точностью с помощью одного из численных методов.
Метод, реализуемый в РУОП, называется методом Ньютона. Другое название метода – метод касательных.
Начальное условие:
Дано:
уравнение f(x) =0,
где f(x) ÎC'' [m,n], f(m) ×f(n) <0,
f'(x) и f''(x) знакопостоянны на отрезке [m,n] ;
точность e.
Найти: решение уравнения с заданной точностью.
Пусть корень  где  – некоторое приближение к корню,  – необходимая поправка. Разложим f(x) линейно в ряд Тейлора в окрестности xn (что соответствует замене функции в точке на касательную):
f(ξ) =0=f(xi+hi) ≈f(xi) +f'(xi) ×hi.
Отсюда:
.
Закон получения приближений к корню:
(2.1)
Начальное приближение x0 выбирается из условия:
. (2.2)

x

f(x)

m

n

Графическая иллюстрация метода приведена на рисунке 2.1. Начальная точка в этом случае совпадает с n.
Рисунок 2.1. – Метод Ньютона
Идея метода заключается в том, что последовательность приближений к корню строится путем проведения касательных к графику функции и нахождения их точек пересечения с осью ОХ.
Алгоритм метода.
Шаг 1. Найти первое приближение к корню x0 по формуле (2.2).
Шаг 2. Находить следующие приближения к корню по формуле (2.1), пока не выполнится условия окончания:
|xi-xi+1|<e.
Последнее найденное приближение и будет корнем.

3. ОПИСАНИЕ И ОБОСНОВАНИЕ ВЫБОРА МЕТОДА РЕШЕНИЯ

Для обоснования выбора метода Ньютона для нахождения корней уравнений с одной переменной рассмотрим два другие итерационные метода.

3.1. Метод половинного деления

Другое название метода – метод дихотомии.
Дано:
уравнение f(x) =0,
где f(x) ÎC [m,n], f(m) ×f(n) <0;
точность e.
Найти: решение уравнения с заданной точностью.
Другими словами, необходимо найти нуль функции на отрезке с заданной точностью. При этом функция непрерывна и в концах отрезка принимает значения разных знаков.
Алгоритм метода:

Шаг 1. Отрезок делится пополам. Находится точка с: = (b+a) /2 (см. рисунок 3.1).
f(x)
 
f(n)
0mkn
x
f(m)
Рисунок 3.1. – Метод половинного деления
Шаг 2. Проверяются следующие условия.
1. Если f(c) =0 – корень найден.
2. Если f(a) ×f(c) <0 – корень на [a,c], поэтому b: =c.
3. Если f(c) ×f(b) <0 – корень на [c,b], поэтому a: =c.
Шаг 3. Проверяется условие |a-b|<ε. Если условие выполнено, то считается, что корень найден. В этом случае он принимается равным а (хотя можно принять его равным b или даже (a+b) /2). Иначе переход к шагу 1.

3.2. Метод итераций

Дано:
уравнение f(x) =0,
где f(x) ÎC' [m,n], f(m) ×f(n) <0,
f'(x) знакопостоянна на отрезке [a,b] ;
точность e.
Найти: решение уравнения с заданной точностью.
Идея метода заключается в том, что от уравнения f(x) =0 переходим с помощью равносильных преобразований к уравнению вида x=φ(x).Т. е. задача сводится к нахождению абсциссы ξ точки пересечения двух графиков функции (см. рис.2). В общем случае φ(x) =x-f(x) *C.

х

у

у=х

у=j(х)

ξ

Рисунок 3.2. – Корень уравнения
Точка ξ, для которой выполняется ξ= φ(ξ), называется неподвижной точкой процесса итераций. Очевидно, что эта точка является корнем уравнения f(x) =0.
Константа С подбирается таким образом, чтобы функция φ(x) удовлетворяла условиям сходимости метода итераций:
1)  – является непрерывной и дифференцируемой на [m,n] ;
2) значения ;
3)  для .
Если , то С нужно выбирать так, чтобы  и  для .
Метод состоит в построении последовательности приближений к корню. В качестве начального приближения выбирается любая точка x0Î [a,b]. Для определенности можно брать середину отрезка [a,b]. В качестве формулы получения последующих приближений выступает сама φ(x):
Алгоритм метода:
Шаг 1. Найти первое приближение к корню x0 как середину отрезка [m,n].
Шаг 2. Находить следующие приближения к корню по формуле, пока не выполнится условия окончания:
|xi - xi+1|<e.
Последнее найденное приближение и будет корнем.
3.3. Обоснование выбора метода
При рассмотрении обоих методов видно, что скорость сходимости метода Ньютона (касательных) выше скорости сходимости метода секущих (хорд) и метода итераций, следовательно, оптимальным для реализации в программе является метод Ньютона.

4. ОБОСНОВАНИЕ ВЫБОРА ЯЗЫКА ПРОГРАММИРОВАНИЯ

Реализация поставленной задачи совершается на языке программирования Turbo Pascal 7.0.
Система программирования Turbo Pascal, разработанная американской корпорацией Borland, остаётся одной из самых популярных систем программирования в мире. Этому способствует простота лежащая в основе языка программирования Pascal, а также поддержка графического и текстового режимов, что делает Turbo Pascal мощной современной профессиональной системой программирования.

5. ОПИСАНИ ПРОГРАММНОЙ РЕАЛИЗАЦИИ

5.1 Информационные потоки

Для наглядности работы программы, движению информации и взаимодейстия програмной части с аппаратной, разработана схема информационных потоков (рисунок 5.1).

Подсказки при вводе данных

Сообщение об ошибке ввода

Входные данные

Ввод промежутков

Ввод параметров

Ввод погрешности

Блок вывода результатов на экран

Выбор уравнения

Блок вычислений

Варианты сохранения результатов

Значение корня уравнения

Варианты продолжения

1

2

ПРОГРАММА
 

Рисунок 5.1 – Схема информационных потоков

Блок построения графика

Блок помощи и справочной информации

Файл справочной информации

График

Помощь и справочная информация

Блок выхода из программы

1

2

Рисунок 5.1 – Схема информационных потоков (продолжение)
Условные обозначения:

– Данные, ввидение которых возможно
как из файлов, расположенных на
жёстком диске, так и с клавиатуры;
–Данные, выводимые на экран;
Данные, вводимые из файла.

5.2. Описание функционирования программы

При запуске программы на экране появляется титульный лист, отображающий информацию о студенте; далее загружается меню программы, состоящее из пяти пунктов:

МЕНЮ

ЗАСТАВКА

Справка

y(x)=a*ln(b*x)

y(x)=a*x^2+b*x+c

Построение графика

ВХОД

МЕНЮ

ВЫХОД

Рисунок 5.2 – Схема функционирования программы
– Справка
– y(x) =a*ln(b*x)
– y(x) =a*x^2+b*x+c
– Построение графика
– Выход
Пункт "Справка" включает в себя информацию о методе Ньютона. Пункты "y(x) =a*ln(b*x)" и "y(x) =a*x^2+b*x+c" представляют собой решения уравнений, где задаются промежутки m и n, параметры a, b(, c), погрешность E и выполняется сохранение в файлы. Пункт "Построение графика" строит график выбранного уравнения в зависимости от введённых параметров и промежутков. Пункт "Выход" – выход из программы. Схема функционирования представлена на рисунке 5.2.

5.3. Описание процедур и функций программы

Procedure title () – выводит титульную страницу на экран монитора;
Procedure graphica () – инициализирует графику.
Procedure pro () – содержит в себе переменную р, которая отвечает за номер выделяемой кнопки, передаётся как параметр в procedure key (p) и в procedure eat (p, bool), а также содержит в себе переменную bool, отвечающую за цикл в рамках procedure pro, передаётся как параметр в procedure eat (p2, bool);
Procedure eat (p2: byte; var bool: boolean) – в зависимости от параметра p2 выполняет один из пяти вариантов дальнейших действий программы. Переменная bool передаётся как параметр обратно в procedure pro;
Procedure key (p1: byte) – выстраивает графическую картинку меню в зависимости от параметра р1;
Procedure equation_1 () – решение уравнения вида y(x) =aЧln(bЧx). Переменная Е (погрешность) принимается как параметр из procedure load_file_3 (E), передаёт переменную Е как параметр в procedure save_file (E);
Procedure equation_2 () – решение уравнения вида y(x) =aЧx2+bЧx+c. Переменная Е (погрешность) принимается как параметр из procedure load_file_3 (E), переменная Е передаётся как параметр в procedure save_file (E);
Procedure load_file_1 () – загружает переменные m и n (промежутки функции) из файла, либо обеспечивает их ввод с клавиатуры, в зависимости от желания пользователя. m, n – глобальные переменные в рамках программы;
Procedure load_file_2 () – загружает переменные a и b либо a, b, c (в зависимости от вида функции) (коэффициенты уравнения) из файла, либо обеспечивает их ввод с клавиатуры, в зависимости от желания пользователя. a, b, c – глобальные переменные в рамках программы;
Procedure load_file_3 (var E: real) – загружает переменную Е (погрешность функции) из файла, либо обеспечивает их ввод с клавиатуры, в зависимости от желания пользователя. Е передаётся как параметр и принимается как переменная в procedure equation_1 и equation_2;
Procedure save_file (E: real) – сохраняет переменные a, b, (c,) m, n – глобальные в рамках программы в файлы либо не сохраняет, сохраняет переменную Е в виде параметра в файл, либо не сохраняет;
Procedure groffunc () – выстраивает график по значениям глобальных в рамках программы переменных a, b, (c,) m, n, с отмеченными на оси х приближениями и корнем уравнения. Содержит в себе function f (x: real): real, высчитывающую значение одной из функций в зависимости от аргумента х. Переменные у0 (масштаб) и у2 (максимальное значение функции) передаются в виде параметров в procedure setka (y0, y2);
Procedure setka (yn: integer; y2: real) – выстраивает координатную сетку и оцифровку осей x и y в зависимости от глобальных в рамках программы переменных m, n и параметров yn и y2;
Procedure help () – предоставляет пользователю непосредственную методологическую помощь.

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.