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. Без дополнительных надстроек. И даже если Вы решили задачу на своём, личном компе - остаётся вопрос передачи расчёта заказчику, или в вышестоящую инстанцию.

Ну а в следующий раз будем строить стрелочки на рисунках :)