Excel. Долгая дорога оцифровки. Часть 3. Апроксимация простых графиков полиномом средствами Excel
Итак, мы имеем набор точек XY и нам требуется определить значение между заданными (опорными) точками. Начнём с самого простого варианта - набор точек позволяет найти уравнение полиномиального вида, которое с достаточной нам точностью описывает поведение функции с учётом имеющихся точек. Это будет в 90% апроксимация т.к. помним про погрешности связанные со снятием точек. Т.е. значения полученные по данной функции будут отличаться от заданных изначально. Кроме вариантов при степени полинома на 1 меньше количества точек (например полином 5-й степени, а известных точек 6-ть).
Стоит учитывать, что описанный ниже способ подходит только в ограниченном количестве случаев:
- требует заказчик;
- зависимость явно полиномиальная.
Итак, в общем случае всё сводится к пяти шагам:
1. По имеющимся данным построить точечный график.
2. По построенным точкам выполнить построение линии тренда.
3. Подобрать степень полиномиальной зависимости таким образом, чтобы внешний вид (прохождение около/через заданные точки) соответствовал изначальному графику (тот что был на картинке). Проверить, возможно полином не лучший вариант.
4. Отобразить уравнение линии тренда на диаграмме и, если зависимость полиномиальная, становить формат чисел "Экспоненциальный" Число знаков - не менее 3х знаков.
5. Скопировать полученное уравнение и использовать в дальнейшем.
Есть ли способы без построения? Естественно есть (о них чуть подальше), но не видя как расположена линия тренда можно нарваться на неприятности.
Ещё одно заблуждение - "чем больше степень полинома, тем точнее". К сожалению, если по оси Х значения в десятках тысяч, а по оси Y в единицах фактически не реально найти полином выше 5-й степени. Точнее определить с достаточной достоверностью его коэффициенты (просто не хватает 15-ти знаков).
Определение коэффициентов полинома.
Как видно на скриншоте выше извлечение коэффициентов полинома происходит совсем не сложно.
=ИНДЕКС(ЛИНЕЙН(F4:F13;E4:E13^{1;2;3;4;5;6});1;7)
где {1;2;3;4;5;6} - степень полинома, 7 - порядковый номер коэффициента.
И об этом написано в многих местах. Но вот то что не написано - извлечённые таким способом иногда не совсем соответствуют коэф-ам уравнения на диаграмме, а иногда совсем не соответствуют.
Это внутренняя математика Excel и может быть вызвано целым рядом причин. Основные:
- Значительный разрыв исходных данных. Например есть несколько сот снятых точек от 0 до 10, затем отсутствие снятых точек от 10 до 20, затем несколько сот точек с 20 до 50.
- Значительные степени чисел (как на скрине выше).
Выходом из данной ситуации является следующий макрос-костыль который забирает данные из указанного диапазона ( в примере - "B2:B6" Данные Х и "C2:C6" - Данные Y), строит график, на графике строит линию тренда с заявленной степенью (в примере вторая - Order = 2), копирует строку уравнения, распарсивает её и выкидывает в столбец ( в примере - начиная с ячейки E2 и вниз) коэффициенты полин.уравнения. Построенный график удаляется...
Sub Polynomial()
Dim rX As Range
Dim rY As Range
Dim rOut As Range
Dim dataLabelText As String
Dim coefficients As Variant
Set rX = ActiveSheet.Range("B2:B6") ' Данные Х
Set rY = ActiveSheet.Range("C2:C6") ' Данные Y
Set rOut = ActiveSheet.Range("E2") ' Место выгрузки коэф-в
dataLabelText = Извлечение_Полинома(rX, rY)
coefficients = Извлечение_коэффициентов(dataLabelText)
With rOut.Resize(UBound(coefficients, 1) + 1, UBound(coefficients, 2))
'назначаем формат для избежания ошибок при вставке получившихся формул
.NumberFormat = "#.####E+00"
.Value = coefficients
End WithEnd Sub
Private Function Извлечение_коэффициентов(dataLabelText As String) As Variant
Dim i As Integer
Dim rez() As Variant, txt As Variant
txt = Split(dataLabelText, "x")
ReDim rez(LBound(txt) To UBound(txt), 1 To 2)
For i = LBound(txt) To UBound(txt)
txt(i) = Right(txt(i), IIf(i = LBound(txt), (Len(txt(i)) - 2), (Len(txt(i)) - 1)))
rez(i, 1) = i: rez(i, 2) = txt(i)
Next i
Извлечение_коэффициентов = rez
End Function
Function Извлечение_Полинома(rX As Range, rY As Range) As String
Dim MyChart As Chart
Dim text As String
Dim dt As Date
Set MyChart = ActiveSheet.Shapes.AddChart2(, , , , 450, 300).Chart
With MyChart
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = rX
.SeriesCollection(1).Values = rY
.ChartType = xlXYScatter
.FullSeriesCollection(1).Trendlines.Add
With .FullSeriesCollection(1).Trendlines(1)
.Type = xlPolynomial
.Order = 2 ' Указываем степень полинома
.DisplayEquation = True
.DataLabel.NumberFormat = "#.####E+00"
dt = Now
DoEvents ' Задержка. См. ниже
DoEvents ' Задержка. См. ниже
Do
If .DataLabel.text <> "" Then Exit Do
If dt < Now - TimeSerial(0, 1, 0) Then Exit Do
For i = 1 To 100: DoEvents: Next
Loop
text = .DataLabel.text
End With
End With
Извлечение_Полинома = text
MyChart.Parent.Delete
End Function
Т.е. делает то, что можно сделать и руками с наглядным выбором вида апроксимации.
Быстрое определение искомого Y по заданному X.
Если Вы уверены в своём глазомере, не боитесь подводных камней и хотите быстро получить значение, то можно воспользоваться вот таким макросом.
Сокращённый вид макроса за авторством БМВ расположен ниже. Расширенный частично на скрине выше. Он понадобится нам в следующем посте, когда будем делать макрос по созданию макросов ), и там будет представлен полностю.
Public Function polinomEx(xVal As Range, yVal As Range, X As Single, stepen As Integer)
Dim I As Integer
Dim Seria
Seria = Array(1, 2, 3, 4, 5, 6, 7)
If stepen > 7 Then stepen = 7
If xVal.Count < stepen + 1 Then stepen = xVal.Count - 1
polinomEx = 0#
ReDim Preserve Seria(stepen - 1)
For I = 1 To stepen + 1
polinomEx = polinomEx + _
(X ^ (stepen + 1 - I)) * _
Application.Index(WorksheetFunction.LinEst(yVal, _
IIf(stepen = 1, xVal, Application.Power(xVal, Seria)), _
True, True), 1, I)
Next I
End Function
Т.е. в функцию передаются столбцы исходных данных, значение Х, при котором требуется найти Y и степень полинома линии тренда.
И да, все заметили что посредством макроса есть возможность построить полином 7-й степени, тогда как линия тренда позволяет выполнять это только до 6-й?
Дальнейшее использование уравнения апроксимации.
Существует всего два подхода:
- Хранить исходные данные на листе. Или в виде таблицы, или в виде уравнения в ячейке.
- Хранить уравнение в виде макроса.
Первый подход удобен при разовом использовании. Если возможно неоднократное использование зависимости, или возможна её модификация, или зависимостей больше десятка - макрос предпочтительнее.
О том как делать макросы для простых графиков, в том числе и в автоматизированном режиме, расскажу в следующий раз.
===========
Краткий план:
Теория вкратце [ Часть 1. ]
Забираем данные с листа. [ Часть 2. ]
Апроксимация простых графиков полиномом средствами Excel [ Часть 3.] Этот пост
Макрос по созданию макросов апроксимации простых графиков полиномом [ Часть 4.]
Апроксимация графиков двух аргументов полиномом [ Часть 5.]
Кусочная интерполяция простых графиков [ Часть 6.]