Страницы: 1
RSS
Интерполяция кривой Акима: вывод массива из VBA
 
Доброе всем!
Пытаюсь разобраться со сторонним макросом, который взял на
https://quantmacro.wordpress.com/2015/09/01/akima-spline-interpolation-in-excel/

В общем это интерполяция кривой Акима. Исходников автор вроде не приложил, но по картинке перенабрал эту функцию.
что получилось у автора


Что получилось у меня


Никак не пойму как у автора код
Код
akima = output
выводит данные в столбец?
Ставил точку останова и смотрел массив "output".
Во первых непонятно зачем массив сделан двумерным. Зачем нулевой элемент массива тоже нуль (похоже он и выводится).
Если брать тупо и выводить в ячейку (1,1), то он выводит. Но надо как то заполнять весь столбец.
Возможно версия эксель у меня и автора разная и поэтому такой вывод не работает?
 
Картинки это хорошо, но без файла (примера) как-то непонятно!
Изменено: Nordheim - 22.05.2017 13:13:03
"Все гениальное просто, а все простое гениально!!!"
 
Код
'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 вывести в ячейки правильно.
Страницы: 1
Наверх