Интерполяция точек графика сплайном Акимы 2022.12.14 - Akima interp

Пользователь geo-prog разместил новый ресурс:

Интерполяция точек графика сплайном Акимы - Возможность получения значения Y с диаграммы по заданному Х. + табуляция.

Узнать больше об этом ресурсе...

 

Пользователь geo-prog обновил ресурс Интерполяция точек графика сплайном Акимы новой записью:

Исправлен небольшой глюк с диаграммой.

Узнать больше об этом обновлении...

 

geo-prog, замени:

Код:

    For ii = 1 To 1
       ...
        output(ii, 1) = ...
    Next ii

на

Код:

    ...
    output(1, 1) = ...

Никакой цикл здесь не нужен. Я вообще не уверен, что нужен массив, тем более размерностью [1][1].

 

остатки предыдущих экскрементов.
делаю по принципу - лишь бы работало. а за 1 или 0.1 миллисекунды - да, побарабану. я не профессиональный программист

--- Сообщения объединены, 16 дек 2022, Оригинальное время сообщения: 16 дек 2022 ---

ячейку D4 лучше заменить формулой "=ОКРУГЛВВЕРХ((D6-D5)/D7;0)"

 

Переписал функцию в полноценный фильтр:

Код:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
Option Base 0

Public Function Akima(know_y As Variant, know_x As Variant, interp_values As Variant) As Variant

    Dim i As Integer
    Dim k As Integer
    Dim l As Integer
    Dim n As Integer
    Dim xt As Double
    Dim dx As Double
    Dim dy As Double
    Dim a As Double
    Dim b As Double
    Dim fx As Double
    Dim v As Double
    Dim m(5) As Double
    Dim t(2) As Double

    n = UBound(know_x)
    k = 0
    For i = 0 To n - 2
        xt = know_x(k)
        If xt < interp_values Then
            k = i
        End If
    Next i
    If k < 2 Then
        For i = (2 - k) To 4
            l = k + i - 2
            dx = know_x(l + 1) - know_x(l)
            dy = know_y(l + 1) - know_y(l)
            m(i) = 0
            If dx > 0 Then
                m(i) = dy / dx
            End If
        Next i
        For i = (1 - k) To 0 Step -1
            m(i) = 2 * m(i + 1) - m(i + 2)
        Next i
    Else
        If k > n - 4 Then
            For i = 0 To (n - k)
                l = k + i - 2
                dx = know_x(l + 1) - know_x(l)
                dy = know_y(l + 1) - know_y(l)
                m(i) = 0
                If dx > 0 Then
                    m(i) = dy / dx
                End If
            Next i
            For i = (n - k + 1) To 4
                m(i) = 2 * m(i - 1) - m(i - 2)
            Next i
        Else
            For i = 0 To 4
                l = k + i - 2
                dx = know_x(l + 1) - know_x(l)
                dy = know_y(l + 1) - know_y(l)
                m(i) = 0
                If dx > 0 Then
                    m(i) = dy / dx
                End If
            Next i
        End If
    End If
    For i = 0 To 1
        If m(i + 2) > m(i + 3) Then
            a = m(i + 2) - m(i + 3)
        Else
            a = m(i + 3) - m(i + 2)
        End If
        If m(i) > m(i + 1) Then
            b = m(i) - m(i + 1)
        Else
            b = m(i + 1) - m(i)
        End If
        If (a + b) > 0 Then
            t(i) = (a * m(i + 1) +  b * m(i + 2)) / (a + b)
        Else
            t(i) = (m(i + 1) +  m(i + 2)) / 2
        End If
    Next i
    dx = interp_values - know_x(k)
    dy = know_x(k + 1) - know_x(k)
    fx = 0
    If dy > 0 Then
        fx = dx / dy
    End If
    v = know_y(k) + t(0) * dx + (3 * m(2) - 2 * t(0) - t(1)) * dx * fx + (t(0) + t(1) - 2 * m(2)) * dx * fx * fx
    Akima = v
End Function

Проверять нечем, так что тестируйте. Вызов без всяких кнопок:

Код:

=Akima(B3:B20;A3:A20;25,5)