В общем это интерполяция кривой Акима. Исходников автор вроде не приложил, но по картинке перенабрал эту функцию. что получилось у автора
Что получилось у меня
Никак не пойму как у автора код
Код
akima = output
выводит данные в столбец? Ставил точку останова и смотрел массив "output". Во первых непонятно зачем массив сделан двумерным. Зачем нулевой элемент массива тоже нуль (похоже он и выводится). Если брать тупо и выводить в ячейку (1,1), то он выводит. Но надо как то заполнять весь столбец. Возможно версия эксель у меня и автора разная и поэтому такой вывод не работает?
'https://quantmacro.wordpress.com/2015/09/01/akima-spline-interpolation-in-excel/
Option Explicit
Option Base 1
Public Function akima(know_y As Variant, know_x As Variant, interp_values As Variant) As Variant
Dim n As Integer: n = know_x.Count
Dim ii As Integer: ii = 1
ReDim m(n + 3) As Double
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
'X shift data by +2 in the array and compute the secants X'
'X also calculate extrapolated end point secants X'
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
For ii = 1 To n - 1
m(ii + 2) = (know_y(ii + 1) - know_y(ii)) / (know_x(ii + 1) - know_x(ii))
Next ii
m(2) = 2 * m(3) - m(4): m(1) = 2 * m(2) - m(3)
m(n + 2) = 2 * m(n + 1) - m(n): m(n + 3) = 2 * m(n + 2) - m(n + 1)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
'X Calculate slope at each data point X'
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
Dim a As Double: Dim b As Double: ReDim t(n) As Double
For ii = 1 To n
a = Abs(m(ii + 3) - m(ii + 2))
b = Abs(m(ii + 1) - m(ii))
If (a + b) <> 0 Then
t(ii) = (a * m(ii + 1) + b * m(ii + 2)) / (a + b)
Else
t(ii) = 0.5 * (m(ii + 2) + m(ii + 1))
End If
Next ii
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
'X For each value we wish to interpolate locate the X'
'X spline segment and calculate thecoefficient X'
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
Dim intTop As Integer: Dim intBottom As Integer: Dim intMiddle As Integer
ReDim output(interp_values.Count, 1) As Variant
For ii = 1 To interp_values.Count
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
'X Binary (bisection) search for the interpol. interval for x X'
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
intBottom = 1: intTop = n
While (intTop - intBottom) > 1
intMiddle = Fix(0.5 * (intBottom + intTop))
If know_x(intMiddle) > interp_values(ii) Then
intTop = intMiddle
Else
intBottom = intMiddle
End If
Wend
b = know_x(intTop) - know_x(intBottom)
If b = 0 Then
akima = "Bad x input"
End If
a = interp_values(ii) - know_x(intBottom)
output(ii, 1) = know_y(intBottom) + t(intBottom) * a + (3 * m(intBottom + 2) - _
2 * t(intBottom) - t(intBottom + 1)) * a * a / b + (t(intBottom) + t(intBottom + 1) - _
2 * m(intBottom + 2)) * a * a * a / (b * b)
Next ii
akima = output
End Function
С массивом немного разобрался.
Код
Option Base 1
Забыл поставить. Теперь массив нормальный, без нулевой позиции. Вычисления правильные. Осталось массив output вывести в ячейки правильно.