1D Linear Interpolation & Extrapolation in VBA
Here we provide the sample code for two equivalent methods for performing 1D linear interpolation and extrapolation in Excel/VBA.
The first, 'standard' method
uses the approach found in most resources, e.g.
Wikipedia. The second method
computes the equation of the line in the relevant segment [(x0, y0), (x1, y1)
]
then evaluates the equation at the desired query point.
Standard Method
Private Function interp1D(ByVal x As Variant, ByVal y As Variant, ByVal xi As Variant, Optional ByVal extrapolate As Boolean = False) As Variant
' Performs 1D linear interpolation, with optional linear extrapolation.
' Inputs:
' x - 1D array of independent variable sample points.
' y - 1D array of corresponding values.
' xi - 1D array of query points.
' extrapolate - Boolean flag for linear extrapolation.
' Output:
' A 1D array of interpolated/extrapolated values, with the same dimensions as xi.
Dim n As Long, ni As Long
Dim yi() As Variant
' Verify that x and y have equal number of elements.
If UBound(x) <> UBound(y) Then
interp1D = CVErr(xlErrValue)
Exit Function
End If
' Get max dims.
n = UBound(x)
ni = UBound(xi)
' Initialise output array.
ReDim yi(1 To ni)
' Loop over query points and interpolate/extrapolate.
For i = 1 To ni
If xi(i) < x(1) Then
If extrapolate Then
' How I think about extrapolation off the left-hand end of a range.
yi(i) = y(1) + (xi(i) - x(1)) * ((y(2) - y(1)) / (x(2) - x(1)))
Else
yi(i) = CVErr(xlErrNA)
End If
ElseIf xi(i) >= x(1) And xi(i) <= x(n) Then
' Interpolate.
For j = 1 To n - 1
If xi(i) >= x(j) And xi(i) <= x(j + 1) Then
' How I think about interpolation.
yi(i) = y(j) + (xi(i) - x(j)) * ((y(j + 1) - y(j)) / (x(j + 1) - x(j)))
Exit For
End If
Next j
Else
If extrapolate Then
' How I think about extrapolation off the right-hand end of a range.
yi(i) = y(n) + (xi(i) - x(n)) * ((y(n) - y(n - 1)) / (x(n) - x(n - 1)))
Else
yi(i) = CVErr(xlErrNA)
End If
End If
Next i
interp1D = yi
End Function
Private Function rowRangeToArray(rng As Range) As Variant
Dim data() As Variant
Dim i As Long
ReDim data(1 To rng.Columns.Count)
For i = 1 To rng.Columns.Count
data(i) = rng(1, i).Value
Next i
rowRangeToArray = data
End Function
Private Function colRangeToArray(rng As Range) As Variant
Dim data() As Variant
Dim i As Long
ReDim data(1 To rng.Rows.Count)
For i = 1 To rng.Rows.Count
data(i) = rng(i, 1).Value
Next i
colRangeToArray = data
End Function
Public Function interp1DRange(xRange As Range, yRange As Range, xiRange As Range, extrapolate As Boolean) As Variant
' Convert input ranges to 1D VB arrays.
Dim x() As Variant
Dim y() As Variant
Dim xi() As Variant
If xRange.Rows.Count = 1 Then
x = rowRangeToArray(xRange)
Else
x = colRangeToArray(xRange)
End If
If yRange.Rows.Count = 1 Then
y = rowRangeToArray(yRange)
Else
y = colRangeToArray(yRange)
End If
If xiRange.Rows.Count = 1 Then
xi = rowRangeToArray(xiRange)
Else
xi = colRangeToArray(xiRange)
End If
' Call interp1D function and return result with same orientation as inputs.
Dim result As Variant
result = interp1D(x, y, xi, extrapolate)
' Transpose if inputs were columns.
If xRange.Columns.Count = 1 Then
result = Application.Transpose(result)
End If
interp1DRange = result
End Function
Second Method
Note that only the interp1D
private function definition is provided. All other
definitions remain unchanged.
Private Function interp1D(ByVal x As Variant, ByVal y As Variant, ByVal xi As Variant, Optional ByVal extrapolate As Boolean = False) As Variant
' Performs 1D linear interpolation, with optional linear extrapolation.
' Inputs:
' x - 1D array of independent variable sample points.
' y - 1D array of corresponding values.
' xi - 1D array of query points.
' extrapolate - Boolean flag for linear extrapolation.
' Output:
' A 1D array of interpolated/extrapolated values, with the same dimensions as xi.
Dim n As Long, ni As Long
Dim yi() As Variant
' Verify that x and y have equal number of elements.
If UBound(x) <> UBound(y) Then
interp1D = CVErr(xlErrValue)
Exit Function
End If
' Get max dims.
n = UBound(x)
ni = UBound(xi)
' Initialise output array.
ReDim yi(1 To ni)
' Loop over query points and interpolate/extrapolate.
' In both cases we take the given segment of x and y, work out the equation of the
' line that would pass through (x0, y0) and (x1, y1), then evaluate at the target
' point.
For i = 1 To ni
If xi(i) < x(1) Then
If extrapolate Then
dy = y(2) - y(1)
dx = x(2) - x(1)
m = dy / dx
b = y(1) - m * x(1)
yi(i) = m * xi(i) + b
Else
yi(i) = CVErr(xlErrNA)
End If
ElseIf xi(i) >= x(1) And xi(i) <= x(n) Then
' Interpolate.
For j = 1 To n - 1
If xi(i) >= x(j) And xi(i) <= x(j + 1) Then
dy = y(j + 1) - y(j)
dx = x(j + 1) - x(j)
m = dy / dx
b = y(j) - m * x(j)
yi(i) = m * xi(i) + b
Exit For
End If
Next j
Else
If extrapolate Then
dy = y(n) - y(n - 1)
dx = x(n) - x(n - 1)
m = dy / dx
b = y(n) - m * x(n)
yi(i) = m * xi(i) + b
Else
yi(i) = CVErr(xlErrNA)
End If
End If
Next i
interp1D = yi
End Function