ВВЕДЕНИЕ
В данный момент существует много программ для решенияуравнений, вычисления интегралов и дифференциалов: 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)
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) /> />
Графическая иллюстрация метода приведена на рисунке 2.1. Начальная точка в этомслучае совпадает с n.
Рисунок 2.1. – Метод Ньютона
Идея метода заключается в том, что последовательностьприближений к корню строится путем проведения касательных к графику функции инахождения их точек пересечения с осью ОХ.
Алгоритм метода.
Шаг 1. Найти первое приближение к корню x0 по формуле (2.2).
Шаг 2. Находить следующие приближения к корню по формуле (2.1),пока не выполнится условия окончания:
|xi-xi+1|
Последнее найденное приближение и будет корнем.
3. ОПИСАНИЕ И ОБОСНОВАНИЕ ВЫБОРА МЕТОДА РЕШЕНИЯ
Для обоснования выбора метода Ньютона для нахождения корнейуравнений с одной переменной рассмотрим два другие итерационные метода. 3.1. Метод половинного деления
Другое название метода – метод дихотомии.
Дано:
уравнение f(x) =0,
где f(x) ÎC [m,n],f(m) ×f(n)
точность 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)
3. Если f(c) ×f(b)
Шаг 3. Проверяется условие |a-b|3.2. Метод итераций
Дано:
уравнение f(x) =0,
где f(x) ÎC' [m,n],f(m) ×f(n)
f'(x) знакопостоянна на отрезке [a,b];
точность e.
Найти: решение уравнения с заданной точностью.
Идея метода заключается в том, что от уравнения f(x) =0переходим с помощью равносильных преобразований к уравнению вида x=φ(x).Т.е. задача сводится к нахождению абсциссы ξ точки пересечения двух графиковфункции (см. рис.2). В общем случае φ(x) =x-f(x) *C.
/>
Рисунок 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|
Последнее найденное приближение и будет корнем.
3.3. Обоснование выбора метода
При рассмотрении обоих методов видно, что скоростьсходимости метода Ньютона (касательных) выше скорости сходимости метода секущих(хорд) и метода итераций, следовательно, оптимальным для реализации в программеявляется метод Ньютона.
4. ОБОСНОВАНИЕ ВЫБОРА ЯЗЫКА ПРОГРАММИРОВАНИЯ
Реализация поставленной задачи совершается на языке программированияTurbo Pascal 7.0.
Система программирования Turbo Pascal, разработаннаяамериканской корпорацией Borland, остаётся одной из самых популярных системпрограммирования в мире. Этому способствует простота лежащая в основе языкапрограммирования Pascal, а также поддержка графического и текстового режимов,что делает Turbo Pascal мощной современной профессиональной системойпрограммирования.
5. ОПИСАНИ ПРОГРАММНОЙ РЕАЛИЗАЦИИ5.1 Информационные потоки
Для наглядности работы программы, движению информации ивзаимодейстия програмной части с аппаратной, разработана схема информационныхпотоков (рисунок 5.1).
/>
ПРОГРАММА
/>
Рисунок 5.1 – Схема информационных потоков
/> />
Рисунок 5.1 – Схема информационных потоков (продолжение)
Условные обозначения: /> />
– Данные, ввидение которых возможно
как из файлов, расположенных на
жёстком диске, так и с клавиатуры;
–Данные, выводимые на экран;
Данные, вводимые из файла. 5.2. Описание функционирования программы
При запуске программы на экране появляется титульный лист,отображающий информацию о студенте; далее загружается меню программы, состоящееиз пяти пунктов:
/>
Рисунок 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, передаётся как параметр в procedureeat (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 () – предоставляет пользователюнепосредственную методологическую помощь.
5.4. Схема взаимодействия процедур программы
Для наглядности работы подпрограмм программы необходимоизобразить в виде схемы их взаимодействие между собой. Взаимодействиеподпрограмм изображено на рисунке 5.3.
/>
Рисунок 5.3 – Взаимодействие процедур программы
Условные обозначения:
– запуск процедуры на которую указывает стрелка, из процедурыиз которой она исходит.
5.5. Перечень обозначений5.5.1 Обозначения вводимых данных
m, n – промежутки функции;
a, b, c – коэффициенты уравнения, представленные в видепараметров;
E – погрешность, аналог ε в разделе «Описанииматематической модели» и в разделе «Описание (и обоснование выбора) методарешения».
5.5.2 Обозначения выводимых данных
y(x) =a*ln(b*x), y(x) =a*x^2+b*x+c – уравнения используемыев программе;
x – неизвестная, корень уравнения;
ln – логарифм;
x^2 – неизвестная x в степени 2.
5.6 Входные и выходные данные
5.6.1 Входные данные
y(x) =a*ln(b*x), y(x) =a*x^2+b*x+c – функция;
m, n: real – левый и правый промежутки функциисоответственно;
a, b, c: real – параметры, коэффициенты уравнения;
E: real – погрешность;
«Помощь и справочная информация».
5.6.2 Выходные данные
x1: real – значение корня уравнения;
st: string – текстовые сообщения, возникающие в процессевыполнения программы (ошибки и варианты дальнейшего продолжения).
5.6.3 Промежуточные данные
Bool_of: Boolean – определяет цикл выполнения алгоритмарешения;
mass: real – массив [1… 20];
number: byte – глобальная переменная, номер функции;
code_of: byte – переменная, отвечающая за необходимостьпоиска корня уравнения;
root: real – разность приближений. 5.7. Алгоритм решения задачи5.7.1. Алгоритм нахождения корня уравнения y(x) =a×ln(b×x)
Алгоритм решения уравнения вида y(x) =a×ln(b×x) приводитсяна рисунке 5.4.
выполнять
/>
/>выполнять
если (a = 0) то
/>вывод
number: =0;
иначе
выполнять
i: =1; если (a*ln(b*m) *(-a/sqr(m))) > 0 то
mass [i]: =m;
code_of: =1;
иначе
Рисунок 5.4 – Алгоритм решения уравнения вида y(x) =a×ln(b×x)
/>
если (a*ln(b*n)*(-a/sqr(n))) > 0 то
mass [i]: =n;
code_of: =1;
иначе
вывод
number: =0; code_of:=0;
если (code_of =1) то
выполнять
x1: =mass [i] -a*ln(b*mass [i]) /
(a/mass [i]);
root: =Abs (x1-mass [i]);
i: =i+1;
mass [i]: =x1;
пока (root
если (x1 n)то
вывод
number: =0; code_of: =0;
вывод
Рисунок 5.4 – Алгоритм решения уравнения вида y(x) =a×ln(b×x)(продолжение)
5.7.2. Алгоритм нахождения корня уравнения y(x) =a×x2+b×x+c
Алгоритм решения уравнения вида y(x) =a×x2+b×x+cприводится на рисунке 5.5.
выполнять
/>
ввод
если (a = 0) и (b = 0) и (c = 0) то
вывод
number: =0;
иначе
выполнять
i: =1;
если (a*sqr(m) +b*m+c) *(2*a) >= 0 то
mass [i]: =m;
code_of: =1;
иначе
Рисунок 5.5 – Алгоритм решения уравнения вида y(x) =a×x2+b×x+c
/>
если (a*sqr(n) +b*n+c) *(2*a) >= 0 то
mass [i]: =n;
code_of: =1;
иначе
вывод
number: =0; code_of:=0;
если (code_of =1) то
выполнять
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;
пока (root
если (x1 n)то
вывод
number: =0; code_of: =0;
вывод
Рисунок 5.5 – Алгоритм решения уравнения вида y(x) =a×x2+b×x+c(продолжение)
Алгоритмы решения уравнений рис.5.4 и рис.5.5 соответствуютprocedure equation_1 и procedure equation_2 в программе соответственно.
6. КОМПЛЕКТАЦИЯ И ЗАГРУЗКА ПРОГРАММЫ6.1. Комплектация
Папка 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 – файл, содержащий русский шрифт. 6.2. Порядок инсталляции и запуск программы
Требуется скопировать папку my_stuff с содержащимися в нейфайлами в папку “c: \temp\”. Для запуска программы необходимо запустить файлRUOP. exe, расположенный в папке my_stuff.
При копировании программы в иную папку, невозможнымистановятся работа «Справки» загрузка и автоматическое сохранение информациив файлы.
7. ТЕСТОВЫЕ ПРИМЕРЫ
Тестовые примеры необходимы пользователю для того, чтобыузнать возможности, которые предоставляет данный программный продукт илипротестировать его на правильность решения уравнений.
Тестовые примеры для решения уравнения вида 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+cm n a b c E Результат -10 10 5 29 3 0.01 -0.1054 -10 10 4 10 0.01 -2.5 5 20 5 29 4 0.01 Уравнение не имеет
При введении в программу данных, не отвечающих требованиям типу,будет появляться сообщение «Ошибка ввода», пока не будут введеныправильные данные, соответствующие требованиям программы.
Если уравнение не имеет корней, то построение графика исохранение данных, результатов становиться невозможным.
При введении в программу данных, отвечающих требованиям,будут появляться сопроводительные сообщения (советы) по дальнейшим вариантампродолжения.
Если уравнение имеет корень, то построение графика исохранение данных, результатов становится возможным.
ВЫВОДЫ
В процессе создания была написана программа, осуществляющаярешение уравнения с одной переменной методом Ньютона (касательных). Программаспособна решать два вида уравнений, а также выстраивать график по вводимымданным.
В программе реализована работа с графикой и с файлами, имеетинтуитивно понятный интерфейс, реализована возможность справки.
Корректная работа программы обеспечивается строгимследованием методическим указаниям, а также надёжной системой проверкипромежуточных результатов в ходе выполнения самой программы.
Однако ощутимыми недостатками являются расчёт результатоввсего для двух функций и отсутствие касательных к графику при построенииграфика функции, устранение которых планируется в ближайшее время.
В целом получившийся программный продукт является отличнымпособием для студентов высших учебных заведений и для учащихся математическихклассов среднеобразовательных школ.
ПЕРЕЧЕНЬ ИСПОЛЬЗОВАННОЙ ЛИТЕРАТУРЫ
1. Фаронов В.В.«Turbo Pascal 7.0. Начальный курс»: учебное пособие. – М.: Кнорус,2006. – 576 с.
2. Сухарёв М. TurboPascal 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)
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
ly: =0;
y: =yn;
Repeat
If ly
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
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»
WriteLn ('Нажмите «Ввод» для подолжения'); ReadLn;
end else
If (m 0) or (m = 0) or (n = 0) then
begin
WriteLn ('«m» и «n» должны быть одногознака и неравные 0');
WriteLn ('Нажмите «Ввод» для продолжения'); ReadLn;
end;
Until (((m 0) and (n> 0))) and (m
Repeat
WriteLn ('Введите коэффициенты уравнения «a»,«b»');
load_file_2;
If m*b
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
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
If (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 = 1then 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»
Until (m
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');
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
If (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 = 1then 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.