16. Вычисление суммы. Рекуррентные формулы.

Условие задачи: Для x, изменяющегося в интервале от x0 до xk с шагом h, вычислить значения бесконечной суммы y(x) с точностью e=0.00001.

Решение:1 Разработка интерфейса

На рабочий лист вставляем рисунок. Позднее с этим рисунком свяжем макрос. Активизируем страницу «Вид», щелкаем по кнопке «Макросы». В диалоговом окне вводим имя макроса «Макрос2». Открывается окно VBA

Активизируем пункт меню Insert, выбираем команду UserForm. Размещаем на форме визуальные компоненты, образующие интерфейс нашего приложения.

2 Разрабатываем сценарий работы:

• Выполнить щелчок по рисунку.

• В открывшейся форме в поле ввода «начальное значение» ввести число, например, -1, в поле ввода «шаг» ввести число, например, 0,1, в поле ввода «Конечное значение» ввести число, например, -0,8

• Выполнить щелчок по кнопке «ОК».

Текст приложения: Sub Макрос2() : UserForm1.Show : End Sub

Private Sub CommandButton1_Click()

Dim xh, xk, dx, e, y, u As Double : Dim s As String

Dim i, n As Integer

Range("A1:B30").Select

Selection.NumberFormat = "0.00"

xh = CCur(TextBox1.Text)

dx = CCur(TextBox2.Text)

xk = CCur(TextBox3.Text)

Range("A1").Cells = "x"

Range("B1").Cells = "y"

e = 0.000001: n = 1

For x = xh To xk Step dx

y = 0: i = 0: u = 1

While Abs(u) > e : y = y + u : u = (x) ^ 2 / (i + 1) * u : i = i + 1

Wend : n = n + 1

Range("A" & Format(n, "###0")).Cells = x

Range("B" & Format(n, "###0")).Cells = y : Next x

Range("A1:B" & Format(n, "###0")).Select ActiveSheet.Shapes.AddChart.Select

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

End Sub

4. Назначим рисунку на рабочем листе Макрос2. Правый щелчок по рисунку. Из меню выбираем «Назначить макрос». В диалоговом окне указываем Макрос2.

Контрольный пример

5. Вводим исходные данные. Закрываем экранную форму и видим результат.

17. Вычисление чисел Фибоначчи.

Данная программа реализует рекуррентные соотношения, определяющие вычисление чисел Фибоначчи:

F₁ = 1; F₂ = 2; для остальных: k = 3...20, F_k = F_k-2 + F_k-1

Public Sub Fib()

‘Числа Фибоначчи!

ThisWorkbook.Sheets(2).Activate

Range("A1") = 1: Range("A2") = 2

Range("A3:A20").Formula = "=R[-2]+R[-1]"

End Sub

Здесь используются относительные ссылки в формате R1C1. При задании ссылки в формуле задано смещение по строкам, а столбец опущен, что по умолчанию предполагает использование столбца

Public Sub AddChart()

Dim MySh As Worksheet : Dim CHOS As ChartObjects

Dim CHO As ChartObject

Set MySh = ThisWorkbook.Worksheets(3)

With MySh

Set myRange = .Range("A1"): With myRange

.Value ="Числа Фибоначчи": .Offset(1, 0).FormulaR1C1 = "1"

.Offset(2, 0).FormulaR1C1 = “2"

.Offset(3, 0).FormulaR1C1 = "=R[-2]C +R[-1]C"

.Offset(3, 0).Select: Selection.AutoFill Destination:=Range("A4:A10"), Type:=xlFillDefault

End With 'Добавление диаграммы

Set CHOS =.ChartObjects: Set CHO = CHOS.Add(50,50,250,200)

CHO.Chart.ChartWizard Source:=.Range("A2:A10"), _

Gallery:=xlLine, Title:="Числа Фибоначчи":End With: End Sub

Макрос, полученный с помощью MacroRecorder:

Sub Fib1()

ActiveCell.FormulaR1C1 = "1"

Range("A2").Select

ActiveCell.FormulaR1C1 = "2"

Range("A3").Select

ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C"

Range("A3").Select

Selection.AutoFill Destination:=Range("A3:A20"), Type:=xlFillDefault: Range("A3:A20").Select: End Sub

18. Нахождение «сигнальной» матрицы В = sign(A).

Сигнальная матрица имеет ту же размерность, что и матрица, являющаяся аргументом. Ее возможные значения (1, 0, -1) определяются знаком соответствующего элемента матрицы A.

Bij =1; Если Aij > 0

Bij =0; Если Aij =0

Bij = -1; Если Aij <0

Введем матрицу A в ячейки B18:D20.

Дадим ей имя: "MatrA".

Выделим область ячеек F18:H20 для матрицы B.

Дадим ей имя: "MatrB".

Вводим формулу над массивами:

{=ЕСЛИ(MatrA > 0; 1; ЕСЛИ(MatrA = 0; 0; -1))}

Макрос:

Sub Signatura()

Range("A1:C4").Select

ActiveWorkbook.Names.Add

Name:="a", RefersToR1C1:="=Лист6!R1C1:R4C3” ActiveWorkbook.Names("a").Comment = ""

Range("F1:H5").Select ActiveWorkbook.Names.Add Name:="b", RefersToR1C1:="=Лист6!R1C6:R5C8"

ActiveWorkbook.Names("b").Comment = ""

Range("A1").Select

ActiveCell.FormulaR1C1 = "12"

Range("B1").Select

ActiveCell.FormulaR1C1 = "-10"

Range("C1").Select

ActiveCell.FormulaR1C1 = "11"

Range("A2").Select

ActiveCell.FormulaR1C1 = "-6"

Range("B2").Select

ActiveCell.FormulaR1C1 = "0"

Range("G1").Select

Selection.ApplyNames Names:="b", IgnoreRelativeAbsolute:=True, _

UseRowColumnNames:=True, OmitColumn:=True, OmitRow:=True, Order:=1, _

AppendLast:=False

Range("F1").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-5]>0,1,IF(RC[-5]=0,0,-1))"

Selection.AutoFill Destination:=Range("F1:H1"), Type:=xlFillDefault

Range("F1:H1").Select

Selection.AutoFill Destination:=Range("F1:H4"), Type:=xlFillDefault

Range("F1:H4").Select

End Sub

Программа:

Sub matAB()

Dim a(3, 3) As Integer : Dim b(3, 3) As Integer

Dim i, j As Integer : Dim s1, s2 As String

For i = 1 To 3 : For j = 1 To 3 : If j = 1 Then

s1 = "F" & Format(i, "###0")

s2 = "A" & Format(i, "###0") : End If

If j = 2 Then

s1 = "G" & Format(i, "###0")

s2 = "B" & Format(i, "###0") : End If

If j = 3 Then

s1 = "H" & Format(i, "###0")

s2 = "C" & Format(i, "###0") : End If

a(i, j) = Range(s2).Cells

If a(i, j) > 0 Then: b(i, j) = 1: Else

If a(i, j) = 0 Then: b(i, j) = 0: Else: b(i, j) = -1: End If

End If: Range(s1).Cells = b(i, j): Next: Next: End Sub

19. Решение уравнений вида f(x) = 0. Метод Ньютона.

Его отличие от метода хорд состоит в том, что на k-итерации проводится касательная к кривой y=f(x) при x=x₀ и ищется точка пересечения касательной с осью х. При этом не обязательно задавать АВ, содержащий корень уравнения. Достаточно найти лишь некоторые начальные приближения корня x=x₀. При x=а f’(x)*f ’’(x)<0 – функция убывающая и f’(x)*f ’’(x)>0- функция возрастающая.

Расчетная формула Ньютона имеет вид:

Вычисления ведутся до тех пор, пока |x_n-x_n-1|<E

Функция вычисления f(x):

Function f(x)

f = 2 * x ^ 4 - 3 * x ^ 3 - 4 * x ^ 2 + 5 * x - 6

End Function

Функция вычисления первой производной f(x) :

Function f1(x1)

f1 = 8 * x1 ^ 3 - 9 * x1 ^ 2 - 4 * x1 + 5

End Function

Sub kop()

Dim x0, x As Double

Dim s, s1, s2 As String

Range("A1:C20").Select

Selection.NumberFormat = "0.000"

Range("A1").Select

x = Range("A1").Cells

i = 1

Range("A2").Cells = "x"

Range("B2").Cells = "f(x)"

Range("C2").Cells = "f1(x) "

While Abs(f(x)) > 0.01

i = i + 1

x = x - f(x) / f1(x)

s = "A" & Format(i + 1, "###0")

Range(s).Cells = x

s1 = "B" & Format(i + 1, "###0")

s2 = "C" & Format(i + 1, "###0")

Range(s1).Cells = f(x)

Range(s2).Cells = f1(x)

Wend

End Sub

20. Решение уравнений вида f(x) = 0. Метод деления отрезка пополам.

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

Алгоритм:

1. Ввести данные (а, b, е)

2. Если нужная точность достигнута (|b-a|<2е), переходим у пункту 6

3. Взять середину очередного отрезка c=(a+b)/2

4. Если значение функции в точках а и с одного знака (f(а)*f (с)>0), то в качестве следующего отрезка взять другую половину а=с, иначе b=c.

5. Перейти к пункту 2

6. Напечатать ответ (a+b)/2

Private Function fun(x As Double) As Double

fun = x * Cos(x) + 0.9 * Sin(x) - 0.1

End Function

Sub Макрос3()

Dim a As Double, a0 As Double, b As Double, b0 As Double, eps As Double, x As Double, i, n As Integer

eps = CDbl(InputBox("точность"))

Range("B2").Cells = eps

a = CDbl(InputBox("a")) : a0 = a

Range("B3").Cells = a

b = CDbl(InputBox("b")) : b0 = b

Range("B4").Cells = b

x = Del(a, b, eps)

Range("B6").Cells = x

Range("B7").Cells = fun(x)

Range("C2").Cells = eps

Range("C3").Cells = a0

Range("C4").Cells = b0

End Sub

Function Del(a As Double, b As Double, e As Double) As Double

Dim x As Double, n As Integer

If fun(a) * fun(b) <= 0 Then

n = 0: While (b - a) > e: n = n + 1 : x = (a + b) / 2

If fun(a) * fun(x) <= 0 Then

b = x: Else: a = x: End If

Range("B5").Cells = n : Del = (a + b) * 0.5

Wend: Else: MsgBox ("a,b=?")

Exit Function : End If : End Function

21. Решение уравнений вида f(x) = 0. Метод хорд.

Применяется только в том случае, когда f(x) на отрезке [a,b] монотонна и не имеет точек перегиба.

Пусть на [a,b] функция непрерывна, принимает на концах отрезка значения разных знаков.

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

1. f(a)<0, f(b)>0, f’(x)>0, а , f’(х) сохраняет знак, функция возрастает.

2. f(a)>0, f(b)<0, f’(x)>0, а , f’(х)<0 функция убывает.

Суть метода та же самая - построение последовательности вложенных отрезков, содержащих корень. Однако отрезки строятся по-другому. Метод основан на замене f(x) на каждом шаге хордой, пересечение которой с осью х, дает приближение корня.

Рассмотрим случай, когда

f(a)<0, f(b)>0, f(a)>0, f(b)<0,

f’(x)>0, f’’(x)>0 f’(x)<0, f ’’(x)<0

A₀(a, f(a)) и B₀(b, f(b)) ⁽¹⁾

(x₁;y₁) и (x₂;y₂) ⁽²⁾

(x-x₁)/(x₂-x₁)= (y-y₁)/(y₂-y₁) ⁽³⁾

(x-а)/(b-a)= (y-f(a))/(f(b)-f(a)) ⁽⁴⁾

График функции проходит через точки А₀ и В₀. Искомый корень уравнения х нам неизвестен. Вместо него возьмем точку х₁, пересечение хорды А₀В₀ с осью ох - это будет приближенное значение корня.