Выполнение работы

Попробуем реализовать данный метод прямо на листе Excel, то есть, не используя программы VBA, а потом тот же алгоритм запишем программно на VBA.

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

На пустом листе делаем заготовку таблицы, которая нам потребуется для реализации метода. Это заголовок таблицы с именем метода и заголовки столбцов для каждой из точек, которые надо вычислять, а так же столбец со значениями ошибки (рис.8). Исходные данные будем вводить в ячейки первой строки для столбцов «Х» левой и правой границах исследуемого интервала. Поэтому отметим их светло-зеленым цветом фона, чтобы помнить о необходимости ввода этих данных перед расчетом.

Рис. 5. Заголовок таблицы для реализации метода деления отрезка пополам

Далее начнем заполнять остальные ячейки формулами. В первую очередь вычислим значения «Y» по модельной функции, созданной на прошлом занятии «My_fun». Для этого встаем в первую ячейку столбца «Y» для левой границы и вызываем мастера функций кнопкой , далее выбираем категорию функций – «Определенные пользователем» и среди них находим созданную нами модельную функцию. В ячейке должна быть получена следующая запись – =My_fun(A4). Если вами была создана функция с другим именем, тогда вместо My_fun должно стоять имя вашей функции. Теперь эту ячейку мы можем просто скопировать в столбцы «Y» для средних точек и правой границы. Для этого копируем ячейку либо комбинацией клавиш [Ctrl+C] или воспользовавшись командой меню или пиктограммой «Копировать». Потом вставляем копии в нужные ячейки с помощью команды «Вставить» через комбинацию клавиш [Ctrl+V] либо через меню или панели инструментов.

Так как значений в ячейках столбцов «Х1» и «Х2» нет, то ответ будет вычислен от нулевого значения параметра, что даст для нашей функции ошибку #ЗНАЧ. Чтобы от нее избавиться вычислим данные значения по следующим формулам – =A4+(E4-A4)*0,39 и =A4+(E4-A4)*0,61 соответственно для Х1 и Х2. В последнем столбце таблицы вычисляем значение ошибки следующим выражением – =ABS(E4-A4). В формулах адреса А4 и Е4 соответствуют ячейкам столбцов «Х» левой и правой границ. На этом этапе мы получили полную строку информации.

Теперь надо ввести формулы вычисления новых значений Х для следующей итерации в ячейки, которые на первой итерации были заполнены исходными данными. Левая граница вычисляется по следующему выражении – =ЕСЛИ(D4>F4<0;A4;C4), где D4 и F4 указывают на адреса ячеек со значениями функции «Y» для первой и второй средних точек, а А4 и С4 – адреса значения «Хл» «Х1». Для выражения правой границы используем тоже условие, так как иначе могут возникнуть противоречия в решении при равенстве значений средних точек. Выражение «Х» для правой границы будет иметь вид – =ЕСЛИ(D4>F4;E4;F4), где E4 и А4 – адреса значения «Х2» «Хпр». Из формул видно, если у нас точка «Х1» больше «Х2» тогда левая граница остается неизменной, а правая смещается в точку «Х2» и наоборот если «Х2» больше то меняет значение левая граница на «Х1».

Остальные формулы этой строки можно просто скопировать из предыдущей строки. Для этого выделяем сначала пять ячеек от «Y» для левой точки до «Y» второй средней точки и растягиваем за угол на следующую строку. Повторяем эту же операцию и для двух последних ячеек первой строки («Y» для правой точки и ошибку). Теперь наша строка для итераций готова и ее можно просто копировать нужное число раз, пока значение ошибки не станет меньше заданного значения. При ошибке 0,01 получаем результат, показанный на рис.6.

Рис.6. Результат вычисления корня модельной функции.

Как видим по результатам, на каждой итерации ошибка уменьшается несколько больше чем на треть исходного интервала.

Теперь реализуем эту же задачу еще двумя способами:

· Первым – построим макрокоманду, которая будет строить решение задачи непосредственно на листе для заданных там условий. Например, мы указываем начальные точки и записываем в определенную ячейку исследуемую функцию, для которой надо найти максимум.

· Вторым – создадим непосредственно функцию пользователя, которая сразу же возвращает точку экстремума для записанной программно функции.

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

Определим структуру листа, где будем реализовываться макрос. Для этого подготовим лист следующим образом (рис.7). Светло-зеленые ячейки используем для ввода данных. Ниже, под заголовками «Х» и «Y» зарезервируем ячейку для текущего значения «Х» и ячейку, куда собственно запишем саму функцию «Y». Чтобы сравнить результаты расчетов, в качестве функции используем нашу модельную функцию «My_fun».

Рис. 7. Образец заготовки для макроса

Здесь надо отметить, что верхний заголовок «Метод золотого сечения» отформатирован горизонтально как – «по центру выделения», а не с использованием объединения ячеек. Это нам будет необходимо для правильного обращения к ячейкам листа относительно активной, которой у нас будет первая ячейка листа.

Теперь все готово для написания программы. Переходим в VBA и начинаем писать сам макрос. Сначала создаем заготовку для подпрограммы (макроса) с именем «Zol_Sech», которая должна быть Sub и Public. Чтобы не создавать много программ в одном модуле, можно предварительно создать еще один «Module2», и уже в него вставить сам макроса.

Теперь начинаем писать сам макрос. Первая операция, которая должна быть выполнена – это получить с листа исходные данные по Х на границах области поиска экстремума и точность решения «erf». Для обращения к ячейкам листа воспользуемся свойством Offset, которое позволяет получить значение из ячейки указанной относительным смещением от текущей в данный момент ячейки. Этот подход существенно упрощает операции работы с листом и исключает постоянные пересчеты листа при смене активной ячейки, если на нем имеются еще другие формулы. Поэтому первоначально определяем нашу активную ячейку с координатами 1,1, что соответствует первой ячейке листа.

ActiveSheet.Cells(1, 1).Select

Использование объекта ActiveSheet позволяет использовать данный макрос для любого листа, который является в данный момент активным и имеет показанную выше структуру оформления. Теперь мы можем получить значения границ интервала и погрешность вычисления по следующим командам:

XL = ActiveCell.Offset(1, 1)

XR = ActiveCell.Offset(1, 3)

Erf = ActiveCell.Offset(1, 5)

Данный оператор находит ячейку относительно выбранной выше смещением на указанное число строк и столбцов соответственно. Так для левой границы от ячейки (1,1) надо переместиться на строку вниз (+1) и на столбец вправо (+1). Знаки «+» можно опустить. Получив исходные данные, можем переходить к вычислениям. Теперь переходим к вычислениям – вычисляем значения нашей функции на левой и правой границах, затем определяем первые две точки внутри интервала и значения функций в них и проверяем наличия экстремума внутри интервала:

ActiveCell.Offset(3, 2) = XL

YL = ActiveCell.Offset(3, 3)

ActiveCell.Offset(3, 2) = XR

YR = ActiveCell.Offset(3, 3)

X1=XL+(XR-XL)*0.39

ActiveCell.Offset(3, 2) = X1

Y1 = ActiveCell.Offset(3, 3)

X2=XL+(XR-XL)*0.61

ActiveCell.Offset(3, 2) = X2

Y2 = ActiveCell.Offset(3, 3)

If (Y1 > YL and Y1 > YR) and (Y2 > YL and Y2 > YR) Then

(Здесь будет записан основной код программы)

else

MsgBox "Максимума в заданном интервале нет"

Exit Sub

End If

Операции вычисления значений функции однотипны – первым оператором переносим значение параметра «Х» в ячейку для текущего «Х». Excel автоматически пересчитывает значение функции в ячейке под «Y». Следующим оператором получаем значение функции в «Y». Проверка на наличие максимума внутри интервала выполняется проверкой что Y1 и Y2 больше YL и YR.

Процедуру поиска экстремума записываем между оператором if и else, но предварительно здесь, же надо подготовить печать таблицы расчетных данных и вывести результаты первых вычислений. Задаем в переменной i смещение от активной ячейки до первой строки таблицы расчетных данных и затем выводим все данные в первую строку таблицы, затем увеличиваем смещение на 1:

i = 7

ActiveCell.Offset(i, 0) = XL

ActiveCell.Offset(i, 1) = YL

ActiveCell.Offset(i, 2) = X1

ActiveCell.Offset(i, 3) = Y1

ActiveCell.Offset(i, 4) = X2

ActiveCell.Offset(i, 5) = Y2

ActiveCell.Offset(i, 6) = XR

ActiveCell.Offset(i, 7) = YR

ActiveCell.Offset(i, 8) = Abs(XR - XL)

i = i + 1

Вводим саму процедуру поиска экстремума. Цикл проверки точности решения реализуется через Do … Loop с условием Until abs(XR-XL)<Erf. Затем проверяем какая из функций (Y1 и Y2) больше и уменьшаем интервал отбрасывая левый или правый подинтервалы. Здесь надо правильно выполнить операции переопределения переменных, чтобы случайно не приравнять их все либо к Х1 или к Х2.

Do

If Y1 > Y2 Then

XR=X2

X2=X1: Y2=Y1

X1=XL+(XR-XL)*0.39

ActiveCell.Offset(3, 2) = X1

Y1 = ActiveCell.Offset(3, 3)

Else

XL=X1

X1=X2: Y1=Y2

X2=XL+(XR-XL)*0.39

ActiveCell.Offset(3, 2) = X2

Y2 = ActiveCell.Offset(3, 3)

End If

Loop Until abs(XR-XL)<Erf

Для печати таблицы внутри цикла надо повторить команды вывода данных в ячейки таблицы перед оператором Loop.

ActiveCell.Offset(i, 0) = XL

ActiveCell.Offset(i, 1) = YL

ActiveCell.Offset(i, 2) = X1

ActiveCell.Offset(i, 3) = Y1

ActiveCell.Offset(i, 4) = X2

ActiveCell.Offset(i, 5) = Y2

ActiveCell.Offset(i, 6) = XR

ActiveCell.Offset(i, 7) = YR

ActiveCell.Offset(i, 8) = Abs(XR - XL)

i = i + 1

Теперь остается подготовить печать результатов решения. Ответом нашего решения должна стать точка с максимальным значением, поэтому вводим следующий код

If Y1 > Y2 Then

X = X1: Y = Y1

Else

X = X2: Y = Y2

End If

MsgBox "Экстремум функции получаем в Х=" & X & _

"Значение функции в точке экстремума " & Y

Теперь сохраняем результаты работы и переходим на рабочий лист, вносим необходимые данные по интервалу поиска и точность решения. После этого запускаем макрос, используя комбинацию горячих клавиш [Alt+F8], выбираем имя созданного макроса. В нашем случае это «Zol_Sech» и нажимаем кнопку «Выполнить». В результате работы макроса мы получаем следующую таблицу (рис.8).

Рис.8. Результат работы макроса «Zol_Sech»

Как можно оптимизировать нашу программу? Реально в ней имеются два фрагмента, которые встречаются по нескольку раз. Это вычисление значения функции для данного значения Х и вывод данных в таблицу. Их можно перенести в подпрограммы. Попробуем сделать соответствующие изменения.

Создадим подпрограмму (Sub) с именем «WriteTab» и сделаем ее «Private», чтобы не видеть ее среди макросов. Перенесем в нее строки вывода расчетных данных на лист и получим следующий фрагмент программы:

Private Sub WriteTab ()

ActiveCell.Offset(i, 0) = XL

ActiveCell.Offset(i, 1) = YL

ActiveCell.Offset(i, 2) = X1

ActiveCell.Offset(i, 3) = Y1

ActiveCell.Offset(i, 4) = X2

ActiveCell.Offset(i, 5) = Y2

ActiveCell.Offset(i, 6) = XR

ActiveCell.Offset(i, 7) = YR

ActiveCell.Offset(i, 8) = Abs(XR - XL)

i = i + 1

End Sub

И заменяем эти строки в основной программе обращение к подпрограмме по ее имени «WriteTab». Но чтобы она заработала надо обеспечить доступ к переменным, которые должны быть распечатаны. Для этого первой строкой в модуле должна быть написана следующая строка:

Public X, X12, X2, Y, Y1, Y2, i

Она определяет перечень общих переменных для всего модуля, таким образом, они становятся видимыми во всех подпрограммах модуля.

Теперь создадим вторую подпрограмму, но она должна возвратить в основную программу наличие функции в заданной точке. Создаем функцию с именем «Solve_Y» и перенесем в нее строки заполнения данными текущего Х и считывания Y. Так как это функция, то входным параметром будет Х, назовем этот параметр именем «ХХ»:

Private Function Solve_Y(XХ)

ActiveCell.Offset(3, 2) = X

Solve_Y = ActiveCell.Offset(3, 3)

End Function

Теперь делаем копию всего текста макроса Zol_Sech, переименовываем его в Zol_Sech1 и заменяем скопированные в подпрограммы строки на обращения к этим подпрограммам. Окончательно программа выглядит так:

Public Sub Zol_Sech1()

ActiveSheet.Cells(1, 1).Select

XL = ActiveCell.Offset(1, 1)

XR = ActiveCell.Offset(1, 3)

Erf = ActiveCell.Offset(1, 5)

YL = Solve_Y(XL)

YR = Solve_Y(XR)

X1 = XL + (XR - XL) * 0.39

Y1 = Solve_Y(X1)

X2 = XL + (XR - XL) * 0.61

Y2 = Solve_Y(X2)

If (Y1 > YL And Y1 > YR) And (Y2 > YL And Y2 > YR) Then

i = 7

WriteTab

Do

If Y1 > Y2 Then

XR = X2

X2 = X1: Y2 = Y1

X1 = XL + (XR - XL) * 0.39

Y1 = Solve_Y(X1)

Else

XL = X1

X1 = X2: Y1 = Y2

X2 = XL + (XR - XL) * 0.39

Y2 = Solve_Y(X2)

End If

WriteTab

Loop Until Abs(XR - XL) < Erf

If Y1 > Y2 Then

X = X1: Y = Y1

Else

X = X2: Y = Y2

End If

MsgBox "Экстремум функции получаем в Х=" & X & vbCr & _

"Значение функции в точке экстремума " & Y

Else

MsgBox "Максимума в заданном интервале нет"

Exit Sub

End If

End Sub

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

Создаем новый модуль «Module3» и в нем создаем функцию «GoldS». Функция имеет три формальных параметра «Х1», «Х2» и «erf», которые записываем в заголовок функции между скобками. Пишем саму программу:

Public Function GoldS(XL, XR, Erf)

If Erf =0 Then Erf=0.01

DL = Difr(XL): DR = Difr(XR)

If DL * DR > 0 Then

MsgBox "В выбранном интервале от" & vbCr & _

XL & " до " & XR & " экстремума нет" & vbCr & _

"Измените интервал поиска !!!", _

vbCritical + vbOKOnly

GoldS = 7777

Exit Function

End If

If DL > 0 And DR < 0 Then

Km = 1

Else

Km = -1

End If

X1 = XL + (XR - XL) * 0.39: Y1 = My_Fun(X1)

X2 = XL + (XR - XL) * 0.61: Y2 = My_Fun(X2)

Do

If Km * Y1 > Km * Y2 Then

XR = X2: X2 = X1: Y2 = Y1

X1 = XL + (XR - XL) * 0.39: Y1 = My_Fun(X1)

Else

XL = X1: X1 = X2: Y1 = Y2

X2 = XL + (XR - XL) * 0.61: Y2 = My_Fun(X2)

End If

Loop Until (XR - XL) < Erf

If Y1 > Y2 Then X = X1 Else X = X2

GoldS=Х

End Function

Разберем написанную выше программу. Первая строка исключает ошибку в работе программы, когда «erf» не задается или ошибочно задается 0. Потом через производные в заданных точках проверяем наличие экстремума внутри интервала и определяем тип экстремума (минимум или максимум), задавая коэффициент Km 1 для максимума и -1 для минимума. В случае если экстремума нет, просто выводим число 7777, иначе вычисляем значение параметра Х в точке экстремума.

Проверим результат работы функции. Для этого на любом из листов создадим область для ввода этой функции в виде, показанном на рис.9. Как и ранее в отмеченные цветом ячейки вводим исходные данные. В ячейку под заголовком «Экстремум» вводим подготовленную функцию пользователя GoldS. Формальные параметры функции должны указывать на отмеченные цветом ячейки левой и правой границ и ошибки вычисления. В ячейку подзаголовком «Функция» вводим нашу модельную функцию My_Fun со ссылкой на ячейку с найденным экстремумом.

Попробует сделать решение более универсальным, постараемся избавиться от задания правой границы. Существуют различные варианты нахождения интервала с корнем. Мы воспользуемся следующим – зададим небольшой шаг и начинаем искать интервал, удовлетворяющий нашим условиям, перемещая каждый раз обе границы. Это приводит к поиску корня в небольшом интервале, но с другой стороны, можем оказаться в условии очень долгого поиска интервала.

Используя код созданной функции, реализуем этот вариант. Делам копию кода функции и изменяем ее имя и все внутренние выходы на «GoldS1». Теперь вносим необходимые изменения. Заменяем строки по проверке наличия экстремума на следующий фрагмент кода:

XL = X: H = 10: DL = Difr(XL)

XR = XL + H: DR = Difr(XR)

If Abs(DR) > Abs(DL) Then H = -H

Do

XR = XL + H: DR = Difr(XR)

If DL * DR < 0 Then Exit Do

XL = XR: DL = DR

Loop

If H < 0 Then

X = XL: XL = XR: XR = X

D = DL: DL = DR: DR = D

End If

Сначала задаемся левой границей интервала из формального параметра функции и шагом поиска H=10. Потом находим первое значение правой границы и определяем направление поиска, изменяя при необходимости шаг на обратный. Потом в бесконечном цикле «Do … Loop» находим интервал, который содержит экстремум функции. В этом алгоритме существенное значение имеют левая и правая границы интервала, если поиск интервала шел с отрицательным шагом, то нам надо изменить границы, что и делается в последних строках кода.

Проверим работу этой функций. Дополним строку в таблице (рис.9) еще одной строкой (рис.10). В ячейку под заголовком «Левая граница» вносим необходимое число, а под заголовком «Экстремум» запишем новую функции «GoldS1» со ссылкой на левую границу и ошибку. Под заголовком «Функция» соответственно исследуемую функцию «My_fun» со ссылкой на экстремум. Изменяя значение в левой границе можно убедиться, что функция работает в любых диапазонах.

Основным недостатком данных функций является жесткая привязка к имени исследуемой функции. Чтобы избавиться от этой проблемы воспользуемся следующим приемом. Имя функции будем передавать в подпрограмму как текстовую переменную, что потребует изменения заголовка подпрограммы:

Public Function FDihot3(X1, Erf, Fun As String)

а ее вызов организовывать через следующую строку программы:

Y1 = Application.Run(Fun, X1)

где переменная Fun является формальным параметром функции заданным в заголовке подпрограммы.

Заключение

В результате выполнения работы были разработаны программы для нахождения корней уравнения, которые могут быть использованы в следующих работах и курсах, а так же при выполнении расчетов во время курсовых и дипломных работ.