Cubic Spline VBA code

[jimmyvba]

Hi Guys,

I have been searching the net for a piecewise cubic spline fitting vba code in which I can specify the knots in the curve. Does anyone have it available? I have had no luck finding it so far. All I get is cubic spline codes without having the flexibility to do it piecewise.

I am basically trying to fit the term structure of US interest rates using this interpolation method.

Thanks.

 

[shg]

Here's what I use.

Function CubicSpline(r As Range, _
                     m As Long, _
                     iType As Long) As Variant
    ' shg 2009-0203
    
    ' UDF wrapper for adCubicSpline
    ' See adCubicSpline for an explanation of m and iType

    Dim y()     As Double
    Dim cell    As Excel.Range
    Dim i       As Long

    ReDim y(0 To r.Count - 1)
    
    For Each cell In r
        y(i) = cell.Value
        i = i + 1
    Next cell
    
    ' return the result as a column vector
    CubicSpline = WorksheetFunction.Transpose(adCubicSpline(y, m, iType))
End Function

Function adCubicSpline(y() As Double, _
                       m As Long, _
                       iType As Long) As Double()
    ' shg 2009-0203
    '     2011-0803 modestly restructured
    
    ' Returns a zero-based array containing m points on each segment
    ' of the cubic spline determined by the control points in y()

    ' y() contains (by definition) n + 1 points: y(0), y(1), ..., y(n)
    ' The n + 1 points define n segments.

    '   iType Description                        Points Returned
    '     1   Open (natural) spline              1 + m * n
    '     2   Closed spline w/o closing segment  1 + m * n
    '     3   Closed spline w/ closing segment   1 + m * (n + 1)
    '     4   Tangent spline                     1 + m * (n - 2)

    ' For a Tangent spline, the end points define the tangents at the
    ' first interior points, and the first and last segments are not
    ' included in the spline.

    Dim n       As Long         ' number of segments
    
    Dim Di()    As Double       ' segment derivatives
    Dim a       As Double       ' cubic coefficient
    Dim b       As Double       ' cubic coefficient
    Dim c       As Double       ' cubic coefficient
    Dim d       As Double       ' cubic coefficient
    
    Dim ad()    As Double       ' zero-based output array
    Dim k       As Long         ' index to ad()
    Dim t       As Double       ' segment interpolation parameter

    Dim i       As Long         ' index to segments
    Dim iLB     As Long         ' lower bound of segments [0|1]
    Dim iUB     As Long         ' upper bound of segments [n-2|n-1|n]
    Dim ip1     As Long         ' "i plus 1"
    Dim j       As Long         ' index to point along segment
    
    n = UBound(y)
    
    ' get the derivatives
    CubicSplineDi y, iType, Di

    Select Case iType
        Case 1    ' Open
            ' return n * m + 1
            ReDim ad(0 To n * m)
            iLB = 0
            iUB = n - 1

        Case 2    ' Closed w/ no closing segment
            ' return n * m + 1 points
            ReDim ad(0 To n * m)
            iLB = 0
            iUB = n - 1

        Case 3    ' Closed w/ closing segment
            ' return m more points (segment that closes the first and last point)
            ReDim ad(0 To (n + 1) * m)
            iLB = 0
            iUB = n

        Case 4    ' Tangent
            ' return 2 * m fewer points (skip first and last segments)
            ReDim ad(0 To (n - 2) * m)
            iLB = 1
            iUB = n - 2

        Case Else
            MsgBox "Undefined Type: " & iType, vbOKOnly, "SplineSeg"
            Exit Function
    End Select

    For i = iLB To iUB
        ip1 = i + 1
        If ip1 > n Then ip1 = 0 ' only applicable when iUB = n
        
        ' get coefficients from derivative
        a = y(i)
        b = Di(i)
        c = 3 * (y(ip1) - y(i)) - 2 * Di(i) - Di(ip1)
        d = 2 * (y(i) - y(ip1)) + Di(i) + Di(ip1)

        ' compute the spline points
        For j = 0 To m - 1
            t = j / m
            ad(k) = a + (b + (c + d * t) * t) * t
            k = k + 1
        Next j
    Next i
    
    ' add the last point, set the output, and exit
    ad(k) = a + b + c + d
    adCubicSpline = ad
End Function

Sub CubicSplineDi(y() As Double, iType As Long, Di() As Double)
    ' shg 2009-0203
    
    ' Returns the n+1 derivatives of the cubic spline
    ' connecting the points in 0-based array y()

    ' iType = 1:    Normal spline
    ' iType = 2, 3: Closed spline
    ' iType = 4:    Tangent Spline

    ' Richard Bartels et al: An Introduction Splines for use in Computer Graphics and Geometric Modeling
    ' http://mathworld.wolfram.com/CubicSpline.html
    ' http://math.fullerton.edu/mathews/n2003/CubicSplinesMod.html
    ' http://www.physics.utah.edu/~detar/phys6720/handouts/cubic_spline/cubic_spline/node1.html
    ' http://www.physics.arizona.edu/~restrepo/475A/Notes/sourcea/node35.html

    Dim n       As Long     ' there are n + 1 points
    Dim i       As Long     ' index to points
    Dim adTD()  As Double   ' tri-diagonal matrix
    Dim adRS()  As Double   ' right-side matrix
    Dim v       As Variant

    n = UBound(y)
    ReDim adTD(0 To n, 0 To n)
    ReDim adRS(0 To n, 0 To 0)

    ' main diagonal = 4
    For i = 0 To n
        adTD(i, i) = 4#
    Next i

    ' upper and lower sub-diagonals = 1
    For i = 1 To n
        adTD(i - 1, i) = 1#
        adTD(i, i - 1) = 1#
    Next i

    ' right-side matrix (interior)
    For i = 1 To n - 1
        adRS(i, 0) = 3# * (y(i + 1) - y(i - 1))
    Next i

    Select Case iType
        Case 1  ' open (natural) spline
            ' coeff matrix
            adTD(0, 0) = 2#    ' UL corner
            adTD(n, n) = 2#    ' LR corner
            ' right side matrix
            adRS(0, 0) = 3# * (y(1) - y(0))
            adRS(n, 0) = 3# * (y(n) - y(n - 1))

        Case 2, 3:    ' closed spline
            adTD(0, n) = 1#    ' UR corner
            adTD(n, 0) = 1#    ' LL corner

            adRS(0, 0) = 3# * (y(1) - y(n))
            adRS(n, 0) = 3# * (y(0) - y(n - 1))

        Case 4:    ' tangent spline
            ' 1. for slope at first interior points
            adTD(0, 0) = 0#
            adTD(n, n) = 0#

            adRS(0, 0) = y(1) - y(0)
            adRS(n, 0) = y(n) - y(n - 1)

            ' 2. for curvature at first interior points
            ' adTD(1, 0) = 0#
            adTD(1, 1) = 2#
            '
            adTD(n - 1, n - 2) = 0#
            adTD(n - 1, n - 1) = 2#

            adRS(1, 0) = 3# * (y(2) - y(1))
            adRS(n - 1, 0) = 3# * (y(n) - y(n - 1))
    End Select

    'dbpMat "adTD and adRS", adTD, adRS

    ' only a variant can receive the result of MMULT
    v = WorksheetFunction.MMult(WorksheetFunction.MInverse(adTD), adRS)
    
    ReDim Di(0 To n)
    For i = 0 To n
        Di(i) = v(i + 1, 1)
    Next i
End Sub

 

[jimmyvba]

Hey thanks a ton shg..

Let me go thriough the code/function to understand how I specify the knots in it and use it first. I will come back to you in case I have any doubts regarding it...

You saved me big time!!!

Thanks again.

 

[shg]

You're welcome.

 

[jimmyvba]

hey shg,

I was trying to understand the code that you sent. Could you help me out with how to use the udf?

Lets say this is the treasury curve for today -

Tenor	Mid Yield
0.083	0.048
0.250	0.048
0.500	0.068
1.000	0.104
2.000	0.304
3.000	0.618
5.000	1.366
7.000	1.987
10.000	2.595
30.000	3.654

<COLGROUP><COL style="WIDTH: 48pt" span=2 width=64><TBODY>
</TBODY>

and i want to find out yields as implied by the spline for a bunch of tenors like 2.65 and 8.50 etc. How do i make use of the function? the tenor points that are to be used as knots are in bold (2&10).

Thanks again.

 

[shg]

You pass it a number of points and specify the number of points to interpolate between each -- so you would have to pick a number that results in one falling on your 'knot.' To specify one particular intermediate point would require a modification of the code.

Also, I assume you know that a spline is a 1D interpolation; x and y values are interpolated independently.

 

[shg]

I should add that I know nothing of finance applications, or the meaning of knots or tenors.

 

[jimmyvba]

Hey shg...

I have this code that i use for finding out y for any x using the data of x's and y's that i have (in my case it is the yield curve which i pasted above - tenor and yield points)..so this code works as a function where i input the x's and y's and through cubic spline method, i can find out the y for any x. I want to modify the code so that in the function, i can provide two knot points as well in my set of x's. Hope you understand what I am trying to say here..I have been trying to modify the code but without success till now..Could you or anyone help on this? Thanks.

Option Base 1
'******************** Cubic_Spline ****************
'
Function cubic_spline(input_column As Range, _
output_column As Range, _
x As Range)
'Purpose: Given a data set consisting of a list of x values
' and y values, this function will smoothly interpolate
' a resulting output value from a given input (x) value

' This counts how many points are in "input" and "output" set of data
Dim input_count As Integer
Dim output_count As Integer
input_count = input_column.Rows.Count
output_count = output_column.Rows.Count
' Next check to be sure that "input" # points = "output" # points
If input_count <> output_count Then
cubic_spline = "Something's messed up! The number of indeces number of output_columnues don't match!"
GoTo out
End If

ReDim xin(input_count) As Single
ReDim yin(input_count) As Single
Dim c As Integer
For c = 1 To input_count
xin(c) = input_column(c)
yin(c) = output_column(c)
Next c
'''''''''''''''''''''''''''''''''''''''
' values are populated
'''''''''''''''''''''''''''''''''''''''
Dim n As Integer 'n=input_count
Dim i, k As Integer 'these are loop counting integers
Dim p, qn, sig, un As Single
ReDim u(input_count - 1) As Single
ReDim yt(input_count) As Single 'these are the 2nd deriv values
n = input_count
yt(1) = 0
u(1) = 0
For i = 2 To n - 1
sig = (xin(i) - xin(i - 1)) / (xin(i + 1) - xin(i - 1))
p = sig * yt(i - 1) + 2
yt(i) = (sig - 1) / p
u(i) = (yin(i + 1) - yin(i)) / (xin(i + 1) - xin(i)) - (yin(i) - yin(i - 1)) / (xin(i) - xin(i - 1))
u(i) = (6 * u(i) / (xin(i + 1) - xin(i - 1)) - sig * u(i - 1)) / p

Next i

qn = 0
un = 0
yt = (un - qn * u(n - 1)) / (qn * yt(n - 1) + 1)
For k = n - 1 To 1 Step -1
yt(k) = yt(k) * yt(k + 1) + u(k)
Next k

''''''''''''''''''''
'now eval spline at one point
'''''''''''''''''''''
Dim klo, khi As Integer
Dim h, b, a As Single
' first find correct interval
klo = 1
khi = n
Do
k = khi - klo
If xin(k) > x Then
khi = k
Else
klo = k
End If
k = khi - klo
Loop While k > 1
h = xin(khi) - xin(klo)
a = (xin(khi) - x) / h
b = (x - xin(klo)) / h
y = a * yin(klo) + b * yin(khi) + ((a ^ 3 - a) * yt(klo) + (b ^ 3 - b) * yt(khi)) * (h ^ 2) / 6

cubic_spline = y
out:
End Function

 

[Juggler_IN]

@shg,

I have this data in two columns A, B in excel : x=1, 2, 3, 4, 5 y=0.75, 0.00, -1.00, 3.00, 4.75

If I have to get 1000 interpolated pairs from the above 5 pairs, how do I use the UDF?

I tried various options but I am not getting the output. Esentially I need help in the exact format of the formula in column C (excel) given that the data is in Col. A, B.

 

[shg]

	A​	B​	C​	D​	E​	F​	G​
1​	x​	y​	​	x'​	y'​	​	​
2​	1​	0.75​		1.00​	0.75​		D2:D102: {=CubicSpline(A2:A6, 25, 1)}
3​	2​	0.00​		1.04​	0.74​		E2:E102: {=CubicSpline(B2:B6, 25, 1)}
4​	3​	-1.00​		1.08​	0.73​
5​	4​	3.00​		1.12​	0.71​
6​	5​	4.75​		1.16​	0.70​
7​				1.20​	0.69​
8​				1.24​	0.68​
9​				1.28​	0.66​
10​				1.32​	0.64​
11​				1.36​	0.63​
12​				1.40​	0.61​
13​				1.44​	0.58​
14​				1.48​	0.56​
15​				1.52​	0.54​
16​				1.56​	0.51​
17​				1.60​	0.48​
18​				1.64​	0.45​
19​				1.68​	0.41​
20​				1.72​	0.37​
21​				1.76​	0.33​
22​				1.80​	0.28​
23​				1.84​	0.23​
24​				1.88​	0.18​
25​				1.92​	0.13​
26​				1.96​	0.06​
27​				2.00​	0.00​
28​				2.04​	-0.07​
100​				4.92​	4.69​
101​				4.96​	4.72​
102​				5.00​	4.75​