Excel. Долгая дорога оцифровки. Часть 8. Обратная функция
Иногда требуется произвести определение значения аргумента (X) в зависимости от известного значения функции (Y).
Ввиду особенностей оцифровки есть два основных варианта решения данного вопроса
Вариант 1. Если сохранены данные "снятия точек", и зависимость монотонна как на рисунке выше, то самым простым решением является поменять снятые точки Х и Y и создать новый макрос.
Вариант 2. Решение задачи Y(x) - Yзад = 0, что так же может выполняться разными способами.
Существует множество численных решение данной задачи: метод половинного деления, метод Ньютона, метод... в общем методов достаточно много, и все несложно реализуются, например вот макрос поиска решения Y_ot_X(x) - Yзад = eps. методом половинного деления Где Y_ot_X(x) - известный макрос расчёта простой функции, а eps - точность поиска решения.
Public Function X_po_Y_polovin(Y As Single) As Single
Dim Xmin As Single: Xmin = 0 ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 350 ' Максимальная граница поиска
Dim Xisk As Single ' Переменное значение искомого Х
Dim dX As Single: dX = 0.00001 ' Точность поиска по X
Dim dY As Single: dY = 0.00001 ' Точность поиска по Y
Do While (Xmax - Xmin) > dX
Xisk = (Xmax + Xmin) / 2
If Abs(Y_ot_X(Xisk) - Y) < dY Then Exit Do
If (Y_ot_X(Xmin) - Y) * (Y_ot_X(Xisk) - Y) < 0 Then
Xmax = Xisk
Else
Xmin = Xisk
End If
Loop
X_po_Y_polovin = Xisk
End Function
Казалось бы, для функции зависимой от двух параметров не сложно написать аналогичную функцию (и это так). Только вот работать она (обратная функция через половинное деление или фактически любого другого численного метода) будет не всегда.
Вот так выглядит макрос выполняющий поиск решения при помощи метода половинного деления для функции 2-х аргументов.
' НТД ТЭЦ12 ПТ9 Диаграмма режимов 2ст.режим нижний график
' Определение Nф по N и Qт
Public Function НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС(Nф As Single, Qт As Single) As Single
Dim Xmin As Single: Xmin = 0# ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 200# ' Максимальная граница поиска
Dim Xisk As Single ' Переменное значение искомого Х
Dim dX As Single: dX = 0.001 ' Точность поиска по X
Dim dY As Single: dY = 0.001 ' Точность поиска по Y
' Обязательно проверка выхода за границы.
If Qт > НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, 0) Then
НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС = 0
Else
Do While (Xmax - Xmin) > dX
Xisk = (Xmax + Xmin) / 2
If Abs(НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xisk) - Qт) < dY Then Exit Do
If (НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xmin) - Qт) * (НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xisk) - Qт) < 0 Then
Xmax = Xisk
Else
Xmin = Xisk
End If
НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС = Xisk
Loop
End If
End Function
Рассмотрим диаграмму зависимости от двух аргументов Qт = f(Nт, Qтmax). И наша задача определить значение Qтmax при известных Qт и Nт. Макрос поиска с помощью половинного деления приведён выше.
И вот тут начинается особенность оцифровки - мы можем с уверенностью сказать и проверить значение функции только в области представленного графика. Т.е. проще говоря - данных о значениях при Qпmax = 120 и Nт < 39 у нас нет. В этой зоне имеет место экстраполяция данных, и как поведёт функция при экстраполяции зависит от того как мы провели оцифровку. В данном случае (данной номограммы) особого влияния может и не будет, но есть варианты, что экстраполированная с помощью полинома функция искривиться и значение при Qпmax = 120 и Nт = 20 будет больше чем при Qпmax = 0 и Nт = 20. Т.е. и метод половинного деления отработает не верно.
Поэтому два простых правила:
1. При проведении оцифровки внимательно относитесь к экстраполяции. В идеале - кусочная интерполяция с использованием линейной интерполяции для начала и окончания графика.
2. Если расчётов мало - используйте метод перебора.
Public Function X_po_Y_perebor(Y As Single) As Single
Dim Xmin As Single: Xmin = 0 ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 350 ' Максимальная граница поиска
Dim dX As Single: dX = 0.001 ' Шаг поиска
Dim dY As Single: dY = 0.00001 ' Точность поиска
Dim Xisk As Single ' Переменное значение искомого Х
For Xisk = Xmin To Xmax Step dX
If Abs(Y_ot_X(Xisk) - Y) < dY Then
X_po_Y_perebor = Xisk
Exit For
Else
X_po_Y_perebor = 0
End If
Next Xisk
End Function
Да, это самый простейший вариант. Требует значительно больше машинного времени по сравнению с численными методами, но, как правило, лишён влияния экстраполяции.
Пример перебора для функции двух аргументов
fun_TEC25_PT60_Prez_G0poGsd(N, i) - известная ф-я поиска Gо по N и Gsd
G0 - известно
N - известно
Gsd - требуется найти
For i = 0 To 300 Step 0.01 - ищу от 0 до 300 с шагом 0,01
< 0.1 - достаточная (для примера) точность поиска.
Public Function fun_TEC25_PT60_Prez_Gsd_poG0N(G0 As Single, N As Single) As Single
Dim i As Single
fun_TEC25_PT60_Prez_Gsd_poG0N = 0 'Если решение не будет найдено - будет выведен 0
For i = 0 To 300 Step 0.01
If Abs(fun_TEC25_PT60_Prez_G0poGsd(N, i) - G0) < 0.1 Then
fun_TEC25_PT60_Prez_Gsd_poG0N = i
Exit For
End If
Next i
End Function
Поиск всех корней уравнения, заданного таблично
Отдельной темой является поиск решения для функции заданной таблично. Для этого не обязательно переводить эту функцию в макрос. Вариант решения ниже:
Option Base 1 ' Иначе смотреть корень с второго элемента
Function РешенУравн(МассивX, МассивY)
' Возвращает корень(корни) уравнения Y(X) = 0
' МассивX - монотонно или возрастает, или убывает
Dim Xs() As Double, Ys() As Double, XEs() As Double, Num, N As Long, M As Long, K As Long
МассивX = МассивX
МассивY = МассивY
ReDim Xs(2 ^ 10), Ys(2 ^ 10), XEs(2 ^ 8)
For Each Num In МассивX
K = K + 1: Xs(K) = Num
Next
N = K: K = 0
For Each Num In МассивY
K = K + 1: Ys(K) = Num
Next
If K <> N Then Exit Function' если длина МассивY <> длине МассивX
For K = 1 To N - 1
If Ys(K) = 0 Then
M = M + 1: XEs(M) = Xs(K)
Else
If Ys(K) * Ys(K + 1) < 0 Then
M = M + 1
XEs(M) = (Ys(K) * Xs(K + 1) - Xs(K) * Ys(K + 1)) / _
(Ys(K) - Ys(K + 1))
End If
End If
Next
If K = N Then
If Ys(N) = 0 Then
M = M + 1: XEs(M) = Xs(N)
End If
End If
If M = 1 Then
РешенУравн = XEs(1)
ElseIf M > 1 Then
ReDim Preserve XEs(M) ' если корней несколько - массив
РешенУравн = WorksheetFunction.Transpose(XEs)
Else ' корней в диапазоне МассивX нет
РешенУравн = CVErr(xlErrNA)
End If
Exit Function
End Function 'РешенУравн'
Макрос не мой. Взят из открытых источников на просторах интернета, но первоисточник у меня не сохранился (к моему огорчению - стараюсь всегда указывать авторов).
=======================
dixi
За сим тему оцифровки считаю на 80% закрытой. Всегда есть то, что относится к конкретной работе, и не всегда подлежит огласке. Если будут вопросы - постараюсь ответить. В меру знаний естественно.
Для тех кто считает что "не надо изобретать велосипед" - прошу привести примеры подобного в свободном бесплатном доступе. Я знаю (встречался) с платными надстройками, о бесплатных не в курсе. Буду рад расширить кругозор.
Тех кто считает что "надо пользоваться пайтоном/матлабом/маткадом/... Ибо там всё есть и проще" хочу огорчить - придя на работу у Вас не всегда есть эти мат.пакеты. Вы не всегда имеете возможность их установки (хоть лицензия, хоть пиратка, хоть триал). Просто запрет компании. И при этом задача должна быть решена. И решена ни один или два раза. Вы можете распечатать и ползать с карандашом и линейкой по диаграммам. А можете перевести в цифру. Как показала практика - оцифровка вполне реализуется, и на 100% работа может быть выполнена в Excel. Без дополнительных надстроек. И даже если Вы решили задачу на своём, личном компе - остаётся вопрос передачи расчёта заказчику, или в вышестоящую инстанцию.
Ну а в следующий раз будем строить стрелочки на рисунках :)