В данной теме попробую подобрать набор информации и ответов на вопросы:
Как найти промежуточные значения между заданными?
Как найти максимум функции заданной таблично?и т.д.
Понятия Аппроксимация, Интерполяция и Экстраполяция гуглятся желающими самостоятельно.Аппроксимация – под аппроксимационной кривой подразумевается некий полином (как правило, но не обязательно), график которого проходит наиболее близко к известным точкам (степень близости определяется по некоторому закону, как правило методу наименьших квадратов). При этом в известных значениях значения функции не обязательно совпадают с заданными значениями (в общем случае f(Xi) ≠ Yi).
Интерполяция – нахождение неизвестных промежуточных значений некоторой функции, по имеющемуся дискретному набору ее известных значений определенным способом. При этом в известных значениях значения функции совпадают с заданными значениями. Под интерполяционной кривой подразумевается некий полином (в нашем случае), график которого проходит через все известные точки.
Две особенности интерполяции:
- для получения полинома степени «n» требуется «n+1» заданная точка (например, полином первой степени f(x)=a·x+b требует две известные точки, или проще – линия строится по двум точкам, парабола по трём и т.д.);
- применение интерполяции методом «ближайшего соседа» в общем случае недопустимо.
Экстраполяция – особый тип аппроксимации, при котором функция аппроксимируется вне заданного интервала, а не между заданными значениями.
Часть 1. Аппроксимация с использованием встроенного функционалаНачнём с аппроксимации без использования макросовДля начала - самый простой вариант:
1. Построить точечный график по имеющимся точкам;
2. На график добавить линию тренда с отображением уравнения на диаграмме;
3. Подобрать вид уравнения (степень полинома, вид уравнения...) который нравится/наиболее адекватно по субъективному восприятию отражает тенденцию изменения зависимости;
4. Скопировать уравнение линии тренда в ячейку и заменить "
х" на "
*А1^", где А1 - адрес ячейки в которой содержится значение аргумента, по которому требуется определить значение функции.
5. Пользоваться...
Если лень копировать уравнение с диаграммы, и хочется получить коэфф-ты полиномов, то можно сделать вот так:
Внимание! Не всегда коэфф-ты найденные нижеописанными способами будут соответствовать коэ-там на уравнении. Но об этом в 4-й части..
Аппроксимация полиномом
| Код |
|---|
Определение коэффициентов линейного уравнения
y=ax+b
b= 1.397235 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7;1);1;2)
a= -0.027554 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7;1);1;1)
Определение коэффициентов квадратичного уравнения
y=ax2+bx+c
c= 1.662612 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2};);1;3)
b= -0.071047 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2};);1;2)
a= 0.000849 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2};);1;1)
Определение коэффициентов кубического уравнения
y=ax3+bx²+cx+d
d= 1.872900 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2;3};);1;4)
c= -0.132192 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2;3};);1;3)
b= 0.004066 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2;3};);1;2)
a= -0.000042 =ИНДЕКС(ЛИНЕЙН($B$2:$B$7;$A$2:$A$7^{1;2;3};);1;1)
|
Поиск коэффициентов для степеней аппроксимирующего полинома бОльших степений аналогичен.
Аппроксимация степенной функцией
| Код |
|---|
Коэф-ты уравнения
y = а · Х ^ m
m = -0.6320 =ИНДЕКС(ЛИНЕЙН(E3:E8;D3:D8);1)
A = 1.1596 =ИНДЕКС(ЛИНЕЙН(E3:E8;D3:D8);2)
a = 3.1888 =EXP(H4)
|
| Код |
|---|
Коэф-ты уравнения
y = а · ln(x) + b
a = -0.4676 =ИНДЕКС(ЛИНЕЙН(B3:B8;D3:D8);1)
b = 2.0017 =ИНДЕКС(ЛИНЕЙН(B3:B8;D3:D8);2)
|
Преимуществом будет отсутствие необходимости использования ячеек листа. Макросы сохранённые в надстройку позволяют пользоваться ими без импорта в лист ну и т.д...
Недостатком - отсутствие визуализации решения.
Макрос Нумбер раз. Основной. Он собственно и находит все коэффициенты полинома.
Скрытый текст |
|---|
| Код |
|---|
' На выходе - коэффициенты полинома. Число точек исходных данных должно быть минимум на одну больше, чем заданная степень полинома.
Public Sub Linia_trenda(ByRef Y() As Double, ByRef X() As Double, ByVal PolyStep As Integer, ByRef c() As Double, Optional ByRef r2 As Double)
Dim stepen As Long
' Ввожу проверку не превышения степени массива
If (UBound(Y) - LBound(Y) - 1) < PolyStep Then
stepen = UBound(Y) - LBound(Y)
Else
stepen = PolyStep
End If
' Объявляю переменные, создаю матрицы под размер данных и степень полинома.
Dim X1() As Double, Y1() As Double
ReDim X1(LBound(Y) To UBound(Y), 1 To stepen) As Double
ReDim Y1(LBound(Y) To UBound(Y), 1 To 1) As Double
ReDim c(1 To stepen + 1) As Double
' Заполню массив Х в соответствии со степенью уравнения.
For i = LBound(X) To UBound(X)
Y1(i, 1) = Y(i)
X1(i, 1) = X(i)
For N = 2 To stepen
X1(i, N) = X1(i, 1) ^ N
Next N
Next i
' Нахожу уравнение.
Dim Coefs As Variant
Coefs = WorksheetFunction.LinEst(Y1, X1, True, True)
' Вытаскиваю коэффициенты полинома.
For i = 1 To stepen + 1
c(i) = Coefs(1, i)
Next i
' Вытаскиваю величину достоверности аппроксимации.
r2 = Coefs(3, 1)
End Sub
|
|
Макрос нумбер 2. Необязательный. Подготовка исходных данных. Ввиду того что у меня данные могут браться из разных мест я их привожу к единому виду. Не стал выкидывать, ибо у меня 100% всё работает в такой связке, посему пускай будет.
Скрытый текст |
|---|
| Код |
|---|
' Подпрограмма переопределения значений исходных данных
Function Подготовка_данных(Xvh As Variant, Yvh As Variant, _
Xvih() As Double, Yvih() As Double) As Variant
Dim NumYRows As Long, I As Long
If TypeName(Xvh) = "Range" Then
' Если данные взяты с листа эксель
NumXRows = Xvh.Count
NumYRows = Yvh.Count
If NumXRows <> NumYRows Then MsgBox "Число Х и У не равно!"
ReDim Xvih(0 To NumXRows - 1)
ReDim Yvih(0 To NumXRows - 1)
If Xvh.Count = UBound(Xvh.Value2) Then
' Если данные X в столбцах
For I = 1 To NumXRows
Xvih(I - 1) = Xvh(I, 1).Value2
Next I
Else
' Если данные X в строках
For I = 1 To NumXRows
Xvih(I - 1) = Xvh(1, I).Value2
Next I
End If
If Yvh.Count = UBound(Yvh.Value2) Then
' Если данные Y в столбцах
For I = 1 To NumYRows
Yvih(I - 1) = Yvh(I, 1).Value2
Next I
Else
' Если данные Y в строках
For I = 1 To NumYRows
Yvih(I - 1) = Yvh(1, I).Value2
Next I
End If
Else
' Если данные переданы из функции
NumXRows = UBound(Xvh) + 1 : NumYRows = UBound(Yvh) + 1
ReDim Xvih(0 To NumXRows - 1) : ReDim Yvih(0 To NumXRows - 1)
For I = 0 To NumXRows - 1
Xvih(I) = Xvh(I): Yvih(I) = Yvh(I)
Next I
End If
End Function
|
|
Макрос 3. Получение значения в указанной промежуточной точке. Большой вариант.Скрытый текст |
|---|
| Код |
|---|
' Аппроксимация для всего массива исходных данных
' В подпрограмму передаются все заданные точки,
' и аппроксимация ведётся по всем точкам!
' Xish - массив данных по оси Х
' Yish - массив данных по оси Y
' Xisk - заданное значение Х, при котором требуется поиск соответствующего Y
' tipApr - признак аппроксимации.
' P - полиномом y = а · x^stepen + b · x^stepen-1 + ... + c
' S - степенной функцией y = а · Х ^ m
' L - логарифмической функцией y = а · ln(x)^stepen + b · ln(x)^stepen-1+ ... + c
' E - экспоненциальной ф-й y = c *e ^(b * x)
' stepen - степень аппроксимирующего полинома или степень Х.
Public Function approx(Xish As Variant, Yish As Variant, _
ByVal Xisk As Double, _
Optional ByVal tipApr As String = "P", _
Optional ByVal stepen As Double = 1) As Variant
Dim i As Integer
Dim X() As Double
Dim Y() As Double
Dim Rez(0 To 8)
Dim cd() As Double
Подготовка_данных Xish, Yish, X, Y
Select Case tipApr
Case "P" ' полиномиальная аппроксимация y = а1 · x^stepen + a2 · ln(x)^stepen-1 + ... + an
stepen = Int(stepen)
If stepen < 1 Then stepen = 1
If stepen > 7 Then stepen = 7
If (UBound(Y) - LBound(Y)) < stepen Then
stepen = UBound(Y) - LBound(Y)
End If
Rez(0) = 0#
Linia_trenda Y, X, stepen, cd
For i = 1 To stepen + 1
Rez(0) = Rez(0) + cd(i) * Xisk ^ (stepen - i + 1)
Rez(i) = cd(i) ' Вывод коэффициентов a1...an
Next i
approx = Rez
Case "S" ' Степенная аппроксимация y = а · Х ^ m
For i = LBound(Y) To UBound(Y)
X(i) = WorksheetFunction.Ln(X(i))
Y(i) = WorksheetFunction.Ln(Y(i))
Next i
Linia_trenda Y, X, 1, cd
Rez(0) = Exp(cd(2)) * Xisk ^ cd(1)
Rez(1) = cd(2) ' Вывод "а"
Rez(2) = cd(1) ' Вывод "m"
approx = Rez
Case "L" ' Логарифмическая аппроксимация
' y = а1 · ln(x)^stepen + a2 · ln(x)^stepen-1+ ... + an
For i = LBound(Y) To UBound(Y)
X(i) = WorksheetFunction.Ln(X(i))
Next i
stepen = Int(stepen)
If stepen < 1 Then stepen = 1
If stepen > 7 Then stepen = 7
If (UBound(Y) - LBound(Y)) < stepen Then
stepen = UBound(Y) - LBound(Y)
End If
Rez(0) = 0
Linia_trenda Y, X, stepen, cd
For i = 1 To stepen + 1
Rez(0) = Rez(0) + cd(i) * WorksheetFunction.Ln(Xisk) ^ (stepen - i + 1)
Rez(i) = cd(i) ' Вывод коэффициентов a1...an
Next i
approx = Rez
Case "E" ' Экспоненциальная аппроксимация y = c *e ^(b * x)
For i = LBound(Y) To UBound(Y)
Y(i) = WorksheetFunction.Ln(Y(i))
Next i
Linia_trenda Y, X, 1, cd
Rez(0) = Exp(cd(2)) * Exp(cd(1) * Xisk)
Rez(1) = Exp(cd(2)) ' Вывод "c"
Rez(2) = cd(1) ' Вывод "b"
approx = Rez
Case Else
approx = "не верно задан тип аппроксимации"
End Select
End Function
|
|
Короткий вариант. Только полином
Скрытый текст |
|---|
| Код |
|---|
' Аппроксимация для всего массива исходных данных полиномом
' В подпрограмму передаются все заданные точки и аппроксимация ведётся по всем точкам!
' Xish - массив данных по оси Х
' Yish - массив данных по оси Y
' Xisk - заданное значение Х, при котором требуется поиск соответствующего Y
' stepen - степень аппроксимирующего полинома.
Public Function polinom(Xish As Variant, Yish As Variant, _
ByVal Xisk As Double, _
Optional ByVal stepen As Integer = 2) As Variant
Dim i As Integer
Dim X() As Double
Dim Y() As Double
Dim cd() As Double
Подготовка_данных Xish, Yish, X, Y
' Ввожу проверку соответствия переданных точек и заданной степени полинома.
' при несоответствии правлю до максимально допустимой
If stepen > 7 Then stepen = 7
If (UBound(Y) - LBound(Y)) < stepen Then
stepen = UBound(Y) - LBound(Y)
End If
polinom = 0#
Linia_trenda Y, X, stepen, cd
For i = 1 To stepen + 1
polinom = polinom + cd(i) * Xisk ^ (stepen - i + 1)
Next i
End Function |
|
Как можно понять "большой вариант" не сложно дорабатывается под требуемые виды аппроксимирующих уравнений. Например у меня сейчас используются:
y = 1/(а · x^stepen + b · x^stepen-1 + ... + c)
y = a + b / x^stepen
y = 1/(а+b·x^stepen)
y = 1/(а+b·1/х)
y = а·x^2+b·1/х+c и т.д ...
За сим первую часть закрываю. Вторая часть будет о кусочной интерполяции ... чуть позже.
В качестве примера набросал простенький.
Что естественно мне не нужно.
