В рабочей книге differentiation.xls представлен вариант реализации рассмотренных методов.

Задание узлов реализовано с помощью диалогового окна. Выбор метода дифференцирования осуществляется программно в зависимости от расположения узлов (равномерного или неравномерного).



Исходные данные задаются с помощью ссылок на ячейки электронной таблицы.

При запуске вычислительной процедуры осуществляется проверка корректности исходных данных.

Полученные значения производных выводятся в ячейки электронной таблицы (необходимо указать диапазон).

Листнинг

Private Sub solve_Click()
Dim arr_x As Range, arr_y As Range, arr_d As Range
Dim s As String, r As String, num As Integer, h As Double
Dim x() As Double, y() As Double

'Проверка заполения полей формы
If x_array.Value = "" Or y_array.Value = "" Or diff_array.Value = "" Then
Err_msg = "Заполните все поля формы"
GoTo ErrHandler
End If

'Проверка корректности заплонения диапазона х
Error_msg = "Поле 'x' должно содержать диапазон"
On Error GoTo ErrHandler
Set arr_x = Range(x_array.Value)

'Проверка корректности заплонения диапазона y
Error_msg = "Поле 'y' должно содержать диапазон"
On Error GoTo ErrHandler
Set arr_y = Range(y_array.Value)

'Проверка корректности заплонения поля "Производная"
Error_msg = "Поле 'Производная' должно содержать ссылку на ячейку"
On Error GoTo ErrHandler
Set arr_d = Range(diff_array.Value)

If arr_y.Columns.Count > arr_y.Rows.Count Then
num = arr_y.Columns.Count
Else
num = arr_y.Rows.Count
End If

'Заполнение массивов x() и y() исходными данными
ReDim x(num)
ReDim y(num)
For i = 1 To num
x(i) = arr_x.Cells(i)
y(i) = arr_y.Cells(i)
Next i

'ravn =1, если х-равноотстоящие
'ravn =0, если х расположены неравномерно
h = x(num) - x(num - 1)
ravn = 1
For i = num - 1 To 2 Step -1
a = Round(x(i) - x(i - 1), 6)
If a <> Round(h, 6) Then
ravn = 0
Exit For
End If
Next i

If ravn Then 'eсли х равноотстоящие
Call differencial(y(), h, num)
Else 'eсли х расположены неравномерно
Call lagrange_diff(x(), y(), num)
End If

'вывод результатов
For i = 1 To num
If arr_y.Columns.Count > arr_y.Rows.Count Then
arr_d.Cells(1, i) = d(i)
Else
arr_d.Cells(i) = d(i)
End If
Next i
Me.Hide
Exit Sub

ErrHandler:
MsgBox Error_msg
End Sub

'/////////////////////////////////////////////////////////////////
'Процедура вычисляет вектор значений производной
'таблицы данных с равноотстоящим шагом по х
'////////////////////////////////////////////////////////////////
'y() - входной массив значений функции
'h - шаг по х
'n - количество точек таблицы данных и значений производной
'd() - найденный массив значений производной
'////////////////////////////////////////////////////////////////

Private Sub differencial(y() As Double, h As Double, n As Integer)
ReDim d(n)
d(1) = (-y(3) + 4 * y(2) - 3 * y(1)) / (2 * h)
d(n) = (3 * y(n) - 4 * y(n - 1) + y(n - 2)) / (2 * h)
For i = 2 To n - 1
d(i) = (y(i + 1) - y(i - 1)) / (2 * h)
Next i
End Sub

'/////////////////////////////////////////////////////////////////
'Процедура вычисляет вектор значений производной
'по таблице данных.
'Метод основан на интерполяции полиномом Лагранжа по трем точкам
'////////////////////////////////////////////////////////////////
'х() - входной массив значений аргумента
'y() - входной массив значений функции
'n - количество точек таблицы данных и значений производной
'd() - найденный массив значений производной
'////////////////////////////////////////////////////////////////

Private Sub lagrange_diff(x() As Double, y() As Double, n As Integer)
ReDim d(n)
For i = 1 To n
m = i - 1
If i = 1 Then m = 1
If i = n Then m = n - 2
d1 = (2 * x(i) - x(m + 1) - x(m + 2)) / ((x(m) - x(m + 1)) * (x(m) - x(m + 2)))
d2 = (2 * x(i) - x(m) - x(m + 2)) / ((x(m + 1) - x(m)) * (x(m + 1) - x(m + 2)))
d3 = (2 * x(i) - x(m) - x(m + 1)) / ((x(m + 2) - x(m)) * (x(m + 2) - x(m + 1)))
d(i) = d1 * y(m) + d2 * y(m + 1) + d3 * y(m + 2)
Next i
End Sub

Пример

Дана таблица, содержащая данные о плотности воздуха при различных температурных режимах. Построить таблицу производных плотности по температуре.

Решение