I'm trying to write a recursive function so that it calculates the sum of the products of the combinations of values in a dynamic array. Right now I've been trying to make it work for a simpler case, but I really don't quite understand the structure I should follow for a recursive function. In this case there's supposed to be the sum of 28 two factor products, resulting 1.4
Sub SuPC()
Dim k As Long
Dim s As Long
Dim i As Long
Dim j As Long
k = 8
s = 2
HSum i, j, s, k
End Sub
Function HSum(i As Long, j As Long, s, k) As Double
Dim P As Variant
Dim z() As Double
Dim Tot As Double
ReDim z(0 To (k * s) - 1)
P = Array(1 / 2, 1 / 3, 1 / 4, 1 / 5, 1 / 6, 1 / 7, 1 / 8, 1 / 9)
If i <= k Then
HSum i + 1, j, s, k
If j <= s Then
HSum i, j + 1, s, k
If z(i) = 0 Then z(i) = 1
z(i) = P(j) * z(i)
End If
Tot = z(i) + Tot
End If
Range("J11") = Tot
End Function
If s and k were low fixated values, I could use For loops but the point is for them to be variable.
You should try to use tail recursion as this is just a sum of the products,
see here an example for tail recursion factoring.
Public Function fact_tail(n As Double) As Double
'Tail Recursion
'fact 4 = 4 * fact 3
' = 4* 3 * fact 2
' = 4* 3 * 2 * fact 1
' = 4* 3 * 2 * 1
'fact 4 = go(4, 1)
' = go((n - 1), (a * n))
' = go((4-1),(1*4))
' = go(3, 4)
' = go(3-1, 3*4)
' = go(2, 12)
' = go(2-1, 12*2)
' = go(1, 24)
' = 4* 3 * 2 * 1 = 24
fact_tail = go_fact(n, 1)
End Function
Private Function go_fact(n, a)
If n <= 1 Then
go_fact = a
Else
go_fact = go_fact((n - 1), (a * n))
End If
End Function
Related
I have the following function that when I run it says #value! error.
I would appreciate any help.
Function Bootstrap(S As Object, Z As Object, L As Double)
Dim j As Integer
Dim a() As Double
Dim b() As Double
Dim n As Integer
Dim Q() As Double
Dim sum As Double
Dim P As Double
ReDim a(1 To n)
ReDim b(1 To n)
ReDim Q(1 To n)
dt = 1
sum = 0
Q(0) = 0
For j = 1 To n - 1
S.Cells(j, 1).Value = a(j)
Z.Cells(j, 2).Value = b(j)
P = Z(j) * (L * Q(j-1) - (L + dt * a(n) * Q(j))
sum = sum + P
Next j
Bootstrap = sum
End Function
Bootstrapping function calculates the following value
In fact I am trying to calculate this formula
Q(t,Tn)=(∑(j=1)to(n-1) Z(t,Tj)[LQ(t,Tj-1)-(L+dtSn)Q(t,Tj)]/[Z(t,Tn)(L+dt*Sn)] +(Q(t,Tn-1)L)/(L+dtSn)
Inputs given are[S1 ,S2,….Sn ],[Z(t,T1),Z(t,T2)…..Z(t,Tn)]and and L=0.4
Try this code : entered as =Bootstrap(A1:B1,A2:B2,0.4)
I have corrected the following
- Assigning the ranges to variants
- defining dt as double
- Dim Q() as 0 to n
- using A() and b() in the formula
- the input ranges are rows not columns
Function Bootstrap(S As Range, Z As Range, L As Double) As Double
Dim j As Integer
Dim a As Variant
Dim b As Variant
Dim n As Integer
Dim Q() As Double
Dim sum As Double
Dim P As Double
Dim dt As Double
n = Application.WorksheetFunction.Max(S.Columns.Count, Z.Columns.Count)
a = S.Value
b = Z.Value
dt = 1
sum = 0
ReDim Q(0 To n)
Q(0) = 0
For j = 1 To n - 1
P = b(1, j) * (L * Q(j - 1)) - (L + dt * a(1, j) * Q(j - 1))
sum = sum + P
Q(j) = sum
Next j
Bootstrap = sum
End Function
Take the habit to format and increment your code, especially before posting it!
You need to type the output of the function (on the line of the function name)
A parenthesis is missing from the line P = Z(j) * (L*Q(j-1)-(L+ dt * a(n) * Q(j))
n is empty (and so are a, b and Q) when you try to redim your arrays, so you need to define them!
Z(j) will also give you an error, because it is a Range, you need Z.Cells(i,j)
Try this :
Function Bootstrap(S As Range, Z As Range, L As Double) As Double
Dim j As Integer
Dim a() As Double
Dim b() As Double
Dim n As Integer
Dim Q() As Double
Dim sum As Double
Dim P As Double
n = Application.WorksheetFunction.Max(S.Columns.count, Z.Columns.count)
a = S.Value
b = Z.Value
dt = 1
sum = 0
ReDim Q(1 To n)
Q(0) = 0
'Q(1) = "??"
For j = 1 To n - 1
P = b(1, j) * (L * Q(j - 1)) - (L + dt * a(1, j) * Q(j - 1))
sum = sum + P
Q(j) = sum
Next j
Bootstrap = sum
End Function
I have issue with an Excel worksheet that contains the formula:
=Spline($D$9:$D$34,$J$9:$J$34,$D43)
Sheet works fine until I open this sheet on network drive and save it on local drive. Then this formula throws #NAME? error. Strange is, that error is gone when I click on line with formula to edit it and press enter (nothing changes in formula).
Have someone met similar issue?
I just found another information. Formula spline is defined in VBA module, not internal in Excel. It looks like. But issue is still here.
Function spline(periodcol As Range, ratecol As Range, x As Range)
Dim period_count As Integer
Dim rate_count As Integer
period_count = periodcol.Rows.Count
rate_count = ratecol.Rows.Count
If period_count <> rate_count Then
spline = "Error: Range count does not match"
GoTo endnow
End If
ReDim xin(period_count) As Single
ReDim yin(period_count) As Single
Dim c As Integer
For c = 1 To period_count
xin(c) = periodcol(c)
yin(c) = ratecol(c)
Next c
Dim n As Integer
Dim i, k As Integer
Dim p, qn, sig, un As Single
ReDim u(period_count - 1) As Single
ReDim yt(period_count) As Single
n = period_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(n) = (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
Dim klo, khi As Integer
Dim h, b, a As Single
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
spline = y
endnow:
End Function
Try to add:
Application.Volatile
to your VBA code. Add this just below the Function statement to force a renewed calculation as soon as anything changes.
I use vba on excel 2007, OS: windows vista, to make calculation using kinematic wave equation in finite difference scheme. But, when it runs the run-time 5 (invalid procedure call or arguments) message appears. I really don't what is going wrong. Anyone can help?
Sub kwave()
Dim u(500, 500), yy(500, 500), alpha, dt, dx, m, n, so, r, f, X, L, K As Single
Dim i, j As Integer
dx = 0.1
dt = 0.01
L = 10
m = 5 / 3
r = 1
f = 0.5
n = 0.025
so = 0.1 'this is slope
alpha = 1 / n * so ^ 0.5
X = 0
For i = 0 To 100
Cells(i + 1, 1) = X
u(i, 1) = L - so * X
X = X + dx
Cells(i + 1, 2) = u(i, 1)
Next i
For j = 0 To 100
For i = 1 To 100
'predictor step
u(i, j + 1) = u(i, j) - alpha * dt / dx * (u(i + 1, j) ^ m - u(i, j) ^ m) + (r - f) * dt
'corrector step
K = u(i, j + 1) ^ m - u(i - 1, j + 1) ^ m '<<<<----- RUNTIME ERROR 5 HAPPENS AT THIS LINE
yy(i, j + 1) = 0.5 * ((yy(i, j) + u(i, j + 1)) - alpha * dt / dx * K + (r - f) * dt)
Next i
Next j
End Sub
You are declaring the variables wrong- the array should store a double/single but it is defaulting to a variant. See this article.
http://www.cpearson.com/excel/declaringvariables.aspx -
"Pay Attention To Variables Declared With One Dim Statement
VBA allows declaring more than one variable with a single Dim
statement. I don't like this for stylistic reasons, but others do
prefer it. However, it is important to remember how variables will be
typed. Consider the following code:
Dim J, K, L As Long You may think that all three variables are
declared as Long types. This is not the case. Only L is typed as a
Long. The variables J and K are typed as Variant. This declaration is
functionally equivalent to the following:
Dim J As Variant, K As Variant, L As Long You should use the As Type
modifier for each variable declared with the Dim statement:
Dim J As Long, K As Long, L As Long "
Additionally, when i = 99 and j = 10, u(99,11), which is j+1, produces a negative number. Note that this does not fully cause the problem though, because you can raise negative numbers to exponents. Ex, -5^3 = -125
I have a function that only call the spline function when something happens..in this case when a division is less than zero..the inputs for the function is the same that for the spline function(called CUBIC), the spline was tested and works well when I call it direct! someone can help me?...follows a party of the code
Function NDF6(T As Variant, dias As Variant, taxas As Variant)
If T <= dias(1) Then
NDF6 = taxas(1)
Exit Function
End If
If T >= dias(tam) Then
NDF6 = taxas(tam)
Exit Function
End If
For i = 1 To tam
If T <= dias(i) Then
If taxas(i) / taxas(i - 1) < 0 Then
Call CUBIC(T, dias, taxas)
Else
i0 = ((taxas(i - 1) * dias(i - 1)) / 360) + 1
i1 = ((taxas(i - 1) * dias(i - 1)) / 360) + 1
irel = i1 / i0
i2 = irel ^ ((T - dias(i - 1)) / (dias(i) - dias(i - 1)))
i2rel = i2 * i0
i2real = i2rel - 1
NDF6 = i2real * (360 / T)
End If
Public Function CUBIC(x As Variant, input_column As Variant, output_column As Variant)
The function returns a zero value when I call the cubic function. The inputs are a cell with a value with a value equivalent a day and two arrays(DUONOFF and ONOFF) equivalent a days and rates, I call the function like:
NDF6(512,DUONOFF,ONOFF)
follows the CUBIC function
Public Function CUBIC(x As Variant, input_column As Variant, output_column As Variant)
'Purpose: Given a data set consisting of a list of x values
' and y values, this function will smoothly interpolate
' a resulting output (y) 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 = "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(N) = (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 = y
out:
End Function
First off, here's my code:
Sub SimulatePortfolio()
Dim lambda As Double
Dim num As Integer
Dim cycles As Long
Column = 12
q = 1.5
lambda = 0.05
cycles = 100000
Dim data(1 To 100000, 1 To 10) As Integer
Dim values(1 To 10) As Double
For i = 1 To 10
values(i) = 0
Next i
temp = lambda
For i = 1 To cycles
lambda = temp
num = 10
t = 0
Dim temps(1 To 10) As Integer
For k = 1 To 10
temps(k) = 1000
Next k
Do While (t < 10 And num > 0)
t = t + tsim(lambda, num)
For j = 1 To 10
If (j > t) Then
temps(j) = temps(j) - 50
End If
Next j
num = num - 1
If (num <= 0) Then
Exit Do
End If
lambda = lambda * q
Loop
For l = 1 To 10
values(l) = values(l) + temps(l)
data(i, l) = temps(l)
Next l
Next i
For i = 1 To 10
Cells(i + 1, Column) = values(i) / cycles
'Problem occurs on this line:
Cells(i + 1, Column + 1).Value = Application.WorksheetFunction.Var(Application.WorksheetFunction.Index(data, i, 0))
Next i
End Sub
Function tsim(lambda As Double, num As Integer) As Double
Dim v As Double
Dim min As Double
Randomize
min = (-1 / lambda) * Log(Rnd)
For i = 1 To (num - 1)
Randomize
v = (-1 / lambda) * Log(Rnd)
If (min > v) Then
min = v
End If
Next i
tsim = min
End Function
When I set the value for cycles to 10000, it runs fine without a hitch. When I go to 100000 cycles, it gets an Error 13 at the indicated line of code.
Having been aware that Application.Tranpose is limited to 65536 rows with variants (throwing the same error) I tested the same issue with Index
It appears that Application.WorksheetFunction.Index also has a limit of 65536 rows when working with variants - but standard ranges are fine
So you will need to either need to dump data to a range and work on the range with Index, or work with two arrays
Sub Test()
Dim Y
Dim Z
'works in xl07/10
Debug.Print Application.WorksheetFunction.Index(Range("A1:A100000"), 1, 1)
Y = Range("A1:A65536")
`works
Debug.Print Application.WorksheetFunction.Index(Y, 1, 1)
'fails in xl07/10
Z = Range("A1:A65537")
Debug.Print Application.WorksheetFunction.Index(Z, 1, 1)
End Sub