|
|
|
Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных) |
|
|
БОЛЬШАЯ ЛЕНИНГРАДСКАЯ БИБЛИОТЕКА - РЕФЕРАТЫ - Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных)
Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных)
54 ВВЕДЕНИЕВ данный момент существует много программ для решения уравнений, вычисления интегралов и дифференциалов: 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] ; точность . Найти: решение уравнения с заданной точностью. Пусть корень где - некоторое приближение к корню, - необходимая поправка. Разложим 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) <0; точность . Найти: решение уравнения с заданной точностью. Другими словами, необходимо найти нуль функции на отрезке с заданной точностью. При этом функция непрерывна и в концах отрезка принимает значения разных знаков. Алгоритм метода: Шаг 1. Отрезок делится пополам. Находится точка с: = (b+a) /2 (см. рисунок 3.1). f(x) f(n) 0mknxf(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] ; точность . Найти: решение уравнения с заданной точностью. Идея метода заключается в том, что от уравнения 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, передаётся как параметр в 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 () - предоставляет пользователю непосредственную методологическую помощь. 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 < E); если (x1 < m) или (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 < E); если (x1 < m) или (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+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; begintextcolor(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; begind: =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; beginIf abs (m) < abs (n) thendlx: =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 dobeginStr (lx: 0: 1, st); If lx >=0 thenOutTextXY (535-dcross, yn+7, st) elseOutTextXY (525-dcross, yn+7, st); lx: =lx-2*dlx; dcross: =dcross+80; end; x: =80; RepeatSetLineStyle (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; RepeatIf ly > 0 thenbeginLine (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; RepeatIf ly < 0 thenbeginLine (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; beginCase number of1: f: =a*ln(b*x); 2: f: =a*sqr(x) +b*x+c; end; end; {***************************************************************************}beginIf number=0 then OutTextXY(300, 20, 'Введите сначала данные в уравнение!!! ') elsebeginClearDevice; SetBKColor (black); case number of1: 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; Repeaty: =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) elsemx: =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 dobeginSetColor (2+l); Line (320+Round ((250/y1) *mass [l]), y0+10, 320+Round ((250/y1) *mass [l]), y0-10); end; x: =m; Repeaty: =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; beginRepeatIf number = 1 thenWriteLn (' Введите промежутки [m, n] одного знака') elseWriteLn (' Введите промежутки [m, n] '); WriteLn ('Нажмите "1" для ввода данных с клавиатуры'); WriteLn ('Нажмите "2" для ввода данных из файла'); k: =ReadKey; Case k of'1': beginWriteLn (' Ввод: '); {$I-}ReadLn (m, n); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Ошибка ввода'); end; '2': beginWriteLn (' Нажмите "1" для указания расположения своего файла'); WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически'); k: =ReadKey; If k = '1' then beginWriteLn ('Введите путь к файлу с расширением. txt'); ReadLn (st); Assign (f, st); end elseIf k = '2' then assign (f, 'c: \temp\my_stuff\m_n. txt'); {$I-}Reset (f); {$I+}mistake: =IOResult; If mistake <> 0 thenWriteLn ('Файла не существует') elsebegin{$I-}Read (f, m, n); {$I+}mistake: =IOResult; Close (f); If mistake <> 0 thenWriteLn ('Информация в файле не соответствует нужному типу') elsebeginWriteLn (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; beginRepeatWriteLn ('Нажмите "1" для ввода с клавиатуры'); WriteLn ('Нажмите "2" для ввода данных из файла'); k: =ReadKey; Case k of'1': beginWriteLn (' Ввод: '); If number = 1 then {$I-} ReadLn (a, b) {$I+} elseIf number = 2 then {$I-} ReadLn (a, b, c) {$I-}; mistake: =IOResult; If mistake <> 0 then WriteLn ('Ошибка ввода'); end; '2': beginWriteLn (' Нажмите "1" для указания расположения своего файла'); WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически'); k: =ReadKey; If k = '1' then beginWriteLn ('Введите путь к файлу расширением. txt'); ReadLn (st); assign (f, st); end elseIf k = '2' then assign (f, 'c: \temp\my_stuff\a_b_c. txt'); {$I-}Reset (f); {$I+}mistake: =IOResult; If mistake <> 0 thenWriteLn ('Файла не существует') elsebeginIf number = 1 then {$I-} Read (f, a, b) {$I+} else{$I-} Read (f, a, b, c); {$I+}mistake: =IOResult; Close (f); If mistake <> 0 thenWriteLn ('Информация в файле не соответствует нужному типу') elsebeginWriteLn (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; beginRepeatWriteLn ('Нажмите "1" для ввода данных с клавиатуры'); WriteLn ('Нажмите "2" для ввода данных из файла'); k: =ReadKey; Case k of'1': beginWriteLn (' Ввод: '); {$I-}ReadLn (E); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Ошибка ввода'); end; '2': beginWriteLn (' Нажмите "1" для указания расположения своего файла'); WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически'); k: =ReadKey; If k = '1' then beginWriteLn ('Введите путь к файлу с расширением. txt'); ReadLn (st); assign (f, st); end elseIf k = '2' then assign (f, 'c: \temp\my_stuff\E. txt'); {$I-}Reset (f); {$I+}mistake: =IOResult; If mistake <> 0 thenWriteLn ('Файла не существует') elsebegin{$I-}Read (f, E); {$I+}mistake: =IOResult; Close (f); If mistake <> 0 thenWriteLn ('Информация в файле не соответствует нужному типу') elsebeginWriteLn (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; beginRepeatWriteLn (' Если хотите сохранить данные и результаты нажмите "1"'); WriteLn (' Если не хотите сохранять данные и результаты нажмите "2"'); k: =ReadKey; Case k of'1': beginWriteLn (' Если хотите сохранить данные в указанные вами файлы нажмите "1"'); WriteLn (' Если хотите, чтобы сохранение произошло автоматически нажмите "2"'); k: =ReadKey; If k = '1' then beginRepeatWriteLn ('Введите путь и имя файла c для сохранения промежутков [m, n] '); ReadLn (st); Assign (f, st); {$I-}ReWrite (f); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Файл не может быть создан') elsebeginWrite (f, m: 3, n: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn; end; Until mistake = 0; RepeatIf number = 1 thenWriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b"') elseIf number = 2 thenWriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b", "c"'); ReadLn (st); Assign (f, st); {$I-}ReWrite (f); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Файл не может быть создан') elsebeginIf number = 1 then beginWrite (f, a: 3, b: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn; end elseIf number = 2 then beginWrite (f, a: 3, b: 3, c: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn; end; end; Until mistake = 0; RepeatWriteLn ('Введите путь и имя файла для сохранения погрешности "Е"'); ReadLn (st); Assign (f, st); {$I-}ReWrite (f); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Файл не может быть создан') elsebeginWrite (f, E: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn; end; Until mistake = 0; RepeatWriteLn ('Введите путь и имя файла для сохранения корня'); ReadLn (st); Assign (f, st); {$I-}ReWrite (f); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Файл не может быть создан') elsebeginWrite (f, mass [i]: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn; end; Until mistake = 0; end elseIf k = '2' then beginAssign (f, 'c: \temp\my_stuff\m_n. txt'); {$I-} ReWrite (f); {$I+}mistake: =IOResult; If mistake <> 0 then WriteLn ('Каталога для сохранения не существует') elsebeginWrite (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) elseWrite (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; {***************************************************************************}beginclosegraph; bool_of: =false; Repeatnumber: =1; clrscr; WriteLn (' Уравнение вида: y(x) =a*ln(b*x) '); Repeatload_file_1; If m > n then beginWriteLn ('Введите "m" < "n" '); WriteLn ('Нажмите "Ввод" для подолжения'); ReadLn; end elseIf (m < 0) and (n >0) or (m = 0) or (n = 0) thenbeginWriteLn ('"m" и "n" должны быть одного знака и неравные 0'); WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn; end; Until (((m < 0) and (n < 0)) or ((m > 0) and (n > 0))) and (m <= n); RepeatWriteLn ('Введите коэффициенты уравнения "a", "b"'); load_file_2; If m*b <= 0 then beginWriteLn ('попробуйте ввести "b" другого знака и неравное 0'); WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn; end; Until m*b > 0; If a = 0 then beginWriteLn ('Все "x" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения'); number: =0; end elsebeginRepeatWriteLn ('Введите погрешность "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 elseIf (a*ln(b*n) *(-a/sqr(n))) > 0 then begin mass [i]: =n; code_of: =1 end elsebegin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end; If code_of = 1 thenbeginRepeatx1: =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) thenbegin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end elseWriteLn ('Корнем уравнения 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) elseWriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется'); WriteLn ('Если хотите выйти, то нажмите "ESC"'); WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"'); k: =ReadKey; code_of: =ord (k); case code_of of27: beginbool_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; {***************************************************************************}beginclosegraph; bool_of: =false; Repeatnumber: =2; clrscr; WriteLn (' Уравнение вида: y(x) =a*x^2+b*x+c'); Repeatload_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 beginWriteLn ('Все "х" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения'); number: =0; end elsebeginRepeatWriteLn ('Введите погрешность "Е"'); 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 elseIf (a*sqr(m) +b*m+c) *(2*a) >= 0 then begin mass [i]: =m; code_of: =1 end elsebegin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end; If code_of = 1 thenbeginRepeatx1: =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) thenbegin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end elseWriteLn ('Корнем уравнения 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) elseWriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется'); WriteLn ('Если хотите выйти, то нажмите "ESC"'); WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"'); k: =ReadKey; code_of: =ord (k); case code_of of27: beginbool_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; beginClearDevice; SetColor (white); OutTextXY (250, 435, '"Ввод" - вход "z", "x" - перемещение по меню'); y1: =15; y2: =70; for i: =1 to 5 dobeginSetcolor (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 of1: 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; beginClearDevice; 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, 'Файла не существует') elsebeginy: =0; Repeaty: =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); beginif p2=1 then help elseif p2=2 then equation_1 elseif p2=3 then equation_2 elseif p2=4 then groffunc elseif p2=5 then bool: =true; end; {***************************************************************************}procedure pro; var p, code: byte; k: char; bool: boolean; beginClearDevice; p: =1; key (p); bool: =false; repeatSetBKColor(lightgray); SetTextStyle (1, 0, 4); SetColor (blue); OutTextXY (390, 130, 'МЕНЮ'); SetTextStyle (0, 0, 0); k: =ReadKey; code: =ord (k); Case code of122: beginp: =p-1; if p=0 then p: =5; key (p); end; 120: beginp: =p+1; if p=6 then p: =1; key (p); end; 13: eat (p, bool); end; until bool; CloseGraph; end; {***************************************************************************}begintitle; number: =0; graphica; end.
|
|
|
НОВОСТИ |
|
|
Изменения |
|
Прошла модернизация движка, изменение дизайна и переезд на новый более качественный сервер |
|