I was creating a critical value approximator of American style options. I was getting the error "#Value!" only after around 40 loops (kept track with a counter).
After some trial and error I realized it came from the part of the loop calling the BlackScholes pricing function. In theory I want to run through a range of values iteratively for the spot price while keeping the other variables fixed in a Black Scholes European price calculation. After tinkering around I reduced the issue to the fact that after the first loop it was no longer calculating Black Scholes the way it would if I just used the value on that iteration and the value I was getting was just increasing by 1, then crapping out after 40 loops of wrong values for some non obvious reason.
So below I truncated the code to a very simple skeleton which is the essence of my problem. Any help would be appreciated.
Function Looper(S As Double, K As Double, r As Double, t As Double, q As Double, Vol As Double) As Double
Dim i As Double
For i = 100 To 150 Step 1#
MsgBox i
MsgBox BS(i, K, r, t, q, Vol, "Call") 'After the first loop the values are wrong,
'What I'd like is, BS(100,...), BS(101,...),BS(102,...) which it is not.
'Not sure what it's actually calculating, since the values are way off
Next i
End Function
Public Function BS(S As Double, K As Double, r As Double, t As Double, q As Double, Vol As Double, CP As String) As Double
Dim volrootime As Double
Dim d1 As Double
Dim d2 As Double
Dim DiscF As Double
Dim DivF As Double
Dim topline1 As Double
Dim topline2 As Double
Dim topline As Double
Dim Price As Double
t = t / 365
r = r / 100
q = q / 100
DiscF = Exp(-r * t)
DivF = Exp(-q * t)
volrootime = (t ^ 0.5) * Vol
topline1 = Log(S / K)
topline2 = ((r - q) + ((Vol ^ 2) / 2)) * t
topline = topline1 + topline2
d1 = topline / volrootime
d2 = d1 - volrootime
If CP = "Call" Then
' Theta is in terms of Calendar days, changing the denominator to 252 changes it to trading days
Price = (S * DivF * Bign(d1)) - (K * DiscF * Bign(d2))
Else
' Theta is in terms of Calendar days, changing the denominator to 252 changes it to trading days
Price = K * DiscF * Bign(-d2) - S * DivF * Bign(-d1)
End If
BS = Price
End Function
The values of r, t, q change each time the BS function is called. If they must stay constant, you should use ByVal in the BS function declaration like this:
BS(S As Double, K As Double, ByVal r As Double, ByVal t As Double, ByVal q As Double, ...
By default, the parameters are passed by reference and any change in the called function are reflected in the calling function.
By the way, in this example, I wouldn't use messageboxes when debugging but instead use debug.print like this:
Debug.Print "i=" & i & vbTab & "BS=" & BS(i, K, r, t, q, Vol, "Call")
The print is made in the window opened by pressing Ctl + G (Go To).
Related
This is my first post on stackoverflow so sorry in advance for anything I may have messed up, but for a project I am doing a simulator for projectile motion. I am only a beginner programmer and dont have much experience with charts, but there aren't any youtube videos that I find helpful.
The chart is plotting vertical displacement against horizontal displacement, and should look like an inverted parabola but it doesn't look anything like what it should.
I am struggling to set axis intervals correctly, each time the line should start from the origin but the x axis contains negative values for displacement, something which should definitely not be occurring. Each time a different simulation is done the axis should change so that each interval in the x axis is something along the lines of a tenth of the total range of the projectile.
Anything that could point me in the right direction would be incredibly useful.
Code:
Public Sub CreateDiagram(ByVal flightRange As Double, ByVal totalTime As Double, ByVal velocity
As Double, ByVal angle As Double, ByVal elevation As Double, ByVal heightOfProjectile As Double)
Chart1.Titles.Add("Projectile Motion")
Chart1.ChartAreas.Clear()
Chart1.ChartAreas.Add("Default")
Dim xAxisInterval As Integer = CInt(totalTime / 10)
Dim yAxisInterval As Integer = CInt(heightOfProjectile / 10)
With Chart1.ChartAreas("Default")
.AxisX.Interval() = xAxisInterval
.AxisY.Interval() = yAxisInterval
End With
Chart1.Series.Add("projection")
Chart1.Series("projection").Color = Color.Black
Chart1.Series("projection").ChartType = DataVisualization.Charting.SeriesChartType.Line
For x = 0 To totalTime Step 0.1
Dim xPos As Double = findXLocation(velocity, angle, x)
Dim yPos As Double = findYLocation(velocity, angle, x, elevation)
Chart1.Series("projection").Points.AddXY(xPos, yPos)
Next
End Sub
EDIT: findXLocation and findYLocation code:
Public Function findYLocation(ByVal velocity As Double, ByVal angle As Double, ByVal time As Double, ByVal elevation As Double) As Double
Dim y As Double
y = elevation + findVerticalVelocity(velocity, angle) - ((0.5 * gConstant) * (time ^ 2))
y = Math.Round(y, 1)
If y < 0 Then
y = 0
End If
Return y
End Function
Public Function findXLocation(ByVal velocity As Double, ByVal angle As Double, ByVal time As Double) As Double
Dim x As Double
x = findHorizontalVelocity(velocity, angle) * time
x = Math.Round(x, 1)
If x < 0 Then
x = 0
End If
Return x
End Function
If you want to explicitly set the minimum value of the X Axis you can use Axis.Minimum. In your case you would use it as Chart1.ChartAreas("Default").AxisX.Minimum = SomeValue
Note that when you set the minimum in this way the axis will stop automatically rescaling.
If you want the minimum to always be zero when all x-values are positive, have a look at Axis.IsStartedFromZero
I hope i understood your question correctly because you mention intervals, but seem to be talking about the minimum value of your x axis.
As a further comment on your code unrelated to the question; it is unnecessary and inefficient to remove the ChartArea every time you want to update the graph, same goes for the Series. Doing this will result in having to re-format the chart on every update (like you are in fact doing with the series).
It suffices to call YourSeries.Points.Clear() and to then add the new points. This way you don't have to re-specify the series color and chartype on each update.
EDIT:
I also see that you round the x position to one decimal, presumably to prevent the x-axis from having long ugly numbers on it. However, a better way to do this is to specify a format for the axis:
chart1.ChartAreas.FirstOrDefault.AxisX.LabelStyle.Format = "{0:0.0}" in your case. This way your series will still store the exact value, but only one decimal will be displayed.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 3 years ago.
Improve this question
Here is my code for a bisection method. If I input 4 and 5 the program loops infinitely. There is a problem with it running.
Sub TheBisectionMethod1()
Dim a, b As Double 'Taking two variables, A and B
Console.Write(vbLf & "Input A: ")
a = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for A
Console.Write(vbLf & "Input B: ")
b = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for B
line1:
Dim c As Double
c = (a + b) / 2 'declearing variable c for the sum of half of the user entered values
If ((Math.Abs(func(c))) < 0.0001) Then 'in flow chart the value of C remians unchange so the program will not run, so it will run if i is >0.0001
Console.Write(vbLf & "C : {0}", c)
ElseIf (Math.Sign(func(c)) = Math.Sign(func(a))) Then
Console.WriteLine("Hello")
a = c
GoTo line1
ElseIf (Math.Sign(func(c)) <> Math.Sign(func(a))) Then
b = c
GoTo line1
End If
End Sub
Function func(x As Double) As Double
Dim y As Double
y = x ^ 2 - 2
Return y
End Function
Don't use a GoTo. There's no need. Also, remove the user interaction from the method that does the actual work. Read the data in one place, pass it to a method (usually a Function rather than a Sub) that does the work and returns a result, and then show the result to the user after the function ends.
That makes this question tricky, because the only result we see in the original code is writing "Hello" to the Console, and that's clearly just a debugging statement. What do you want this code to do? (I'm gonna assume you mean this)
Function Bisect(a as Double, b As Double) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = func(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(func(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = func(c)
End While
Return c
End Function
Function func(x As Double) As Double
Return x ^ 2 - 2
End Function
And really, it should look like this:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = f(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = f(c)
End While
Return c
End Function
and be called like this:
Bisect(a, b, Function(x) x ^ 2 - 2)
Also, the algorithm here is slightly off based the wikipedia article. This is more precise:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim TOL As Double = 0.0001
Dim MaxSteps As Integer = 1000
Dim c As Double = (a + b) / 2
While Math.Abs(f(c)) >= TOL AndAlso (b-a)/2 >= TOL AndAlso MaxSteps > 0
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
MaxSteps -= 1
c = (a + b) / 2
End While
If MaxSteps = 0 Then
Throw New ArgumentException("The bisection fails to converge within the allowed time for the supplied arguments.")
End If
Return c
End Function
I bring it up, because the complaint in the original question is this:
the program loops infinently[sic]
and one of the tenants of the algorithm is it's not guaranteed to converge, hence the step counter.
Finally, this looks to me like it might do well as a recursive function. Recursion can improve things here because we can rely on the call stack overflowing rather than needing to implement a step counter:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
If Math.Abs(f(c)) < TOL OrElse (b-a)/2 < TOL Then Return c
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
Return Bisect(c, b, f)
Else
Return Bisect(a, c, f)
End If
End Function
Of course, catching that StackOverflowException is a trick in itself, so you may still want that step counter. But I need to leave something for you to do yourself.
This also helps demonstrate part of why I recommend removing all user I/O from the Bisect() method. If this method were also responsible for talking to the end user, it would not be possible to even consider the recursive option, where the code is clearly far shorter and simpler than any of the others.
I've become very interested in creating custom functions in Excel using VBA lately, because custom functions can save tremendous amounts of time. As I a used to Java and not VBA, I'm currently having a little trouble with some operators (such as the lack of += ) and Arrays.
However, my latest function, which is a little more complex than the ones I previously created, doesn't want to work.
The functions goal is to calculate the Shareholder Value, given both a Cash-Inflow and Cash-Outflow as Range, interest rates and the equity ratio.
So what the function is supposed to do is:
Calculate all relevant variables (WACC etc)
Calculate the sum of the discounted Cashflows (In- and Outflow) from the Range-Objecs
Calculate the Shareholder Value with using the previously calculated variables
My Code:
Function SHV(CashInflow As Range, CashOutflow As Range, EKZins As Double, FKZins As Double, EKQuote As Double)
Dim DCIF As Double
Dim DCOF As Double
Dim FKQ As Double
Dim FKZ As Double
Dim FKZF As Double
Dim EKZF As Double
Dim GKZ As Double
Dim GKZF As Double
Dim ER As Double
Dim RV As Double
Dim n As Integer
Dim i As Integer
DCIF = 0
DCOF = 0
FKQ = 1 - EKQuote
FKZF = 1 + FKZins
EKZF = 1 + EKZins
GKZ = (FKQ * FKZins + EKQuote * EKZins) / (FKQ / EKQuote)
GKZF = GKZ + 1
n = CashInflow.Count
For i = 1 To n
DCIF = DCIF + ((CashInflow(CashInflow.Row, i) * GKZF ^ i))
DCOF = DCOF + ((CashOutflow(CashOutflow.Row, i) * FKZF ^ i))
Next i
ER = CashInflow(CashInflow.Row, n) / GKZ
RV = CashOutflow(CashOutflow.Row, n) / FKZ
SHV = (DCIF + ER) - (DCOF + RV)
End Function
I hope somebody will be able to help.
I need to use Newton's method on closures.
Function f (x as Double, y as Double) as Double
f = x^3-y
End Function
I get the value of y from a cell and then I would like to find out when f is zero. In the toy example above, if the cell contains y=8, then I would expect Newton's method to find a solution close to x=2.
My solution was to make a newton_solve_f function:
Function newton_solve_f (y as Double as Double) as Double
Dim x as Double
x = 0 'initial guess for x
'do Newton's method to find x
...
newton_solve_f = x
End Function
so in effect, I copy paste my code for Newton's method (taken from here) into newton_solve_f.
The problem is that I have several such fs (some with more than two arguments), and it would be really neat if I didn't have to make a separate almost identical newton_solve_f for every one of them.
How would you solve this in VBA?
In Python, for example, it's possible to solve this problem as follows:
def f(y):
def g(x):
return x^3-y
return g
def newton_solve(f):
#do newton's method on f(x)
newton_solve(f(3))
Here f(3) is a function, a closure of one variable. (The closure example on wikipedia is almost identical to this one.)
ps. I know Newton's method also needs the (partial) derivative of f, I'm actually doing something that's more like the secant method, but that's irrelevant for what I'm asking about
Closures are not part of VBA. But you can use static variables within a method scope. They cannot be used outside the method. If you want a variable to visible outside, then you have to use global variable. Preferable declare it public in a module.
We cannot define function inside function in VB. Tried to convert the code given in the link you have mentioned. I hope it helps you. Not well versed with php, but you can see the approach below and make changes accordingly.
Sub Test()
Dim x As Double
Dim y As Double
Dim z As Double
x = Cells(1, 1).Value
y = Cells(1, 2).Value
z = NewtRap("Fun1", "dFun1", x, y)
Cells(1, 3).Value = z
End Sub
Private Function NewtRap(fname As String, dfname As String, x_guess As Double, y_value As Double) As Double
Dim cur_x As Double
Dim Maxiter As Double
Dim Eps As Double
Maxiter = 500
Eps = 0.00001
cur_x = x_guess
For i = 1 To Maxiter
If (fname = "Fun1") Then
fx = Fun1(cur_x)
ElseIf (fname = "dFun1") Then
fx = dFun1(cur_x)
ElseIf (fname = "f") Then
fx = f(cur_x, y_value)
End If
If (dfname = "Fun1") Then
fx = Fun1(cur_x)
ElseIf (dfname = "dFun1") Then
fx = dFun1(cur_x)
ElseIf (dfname = "f") Then
fx = f(cur_x, y_value)
End If
If (Abs(dx) < Eps) Then Exit For
cur_x = cur_x - (fx / dx)
Next i
NewtRap = cur_x
End Function
Function f(x As Double, y As Double) As Double
f = x ^ 3 - y
End Function
Function Fun1(x As Double) As Double
Fun1 = x ^ 2 - 7 * x + 10
End Function
Function dFun1(x As Double) As Double
dFun1 = 2 * x - 7
End Function
So to first summarise: You want to create a function that will find (using Newton-Raphson method) the roots of a function. You already have this written and working for certain functions but would like help expanding your code so it will work with a variety of functions with varying numbers of parameters?
I think you first need to think about what input functions you want it to cover. If you are only dealing with polynomials (as your example suggests), this should be fairly straightforward.
You could have general functions of:
Function fnGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double
fnGeneralCase = a1*x^3 + a2*x^2 + a3*x + b1*y^3 + b2*y^2 + b3*y + c1*z^3 + c2*z^2 + c3*z + w
End Function
Function fnDerivGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double
fnDerivGeneralCase = a1*3*x^2 + a2*2*x + a3 + b1*3*y^2 + b2*2*y + b3 + c1*3*z^2 + c2*2*z + c3
End Function
And just set the inputs to zero when you don't need them (which will be for the majority of the time).
So for your example calling:
answer = fnGeneralCase(guess, 0, 0, -8, 1, 0, 0, 0, 0, 0, 0, 0, 0)
basically gives:
function = x^3-8
If you want to include more than polynomials, this will get more complicated but you could still use the above approach...
This seems to be asking 2 related questions:
how to pass a function as an argument in vba.
how to create a closure out of an existing function.
Unfortunately neither of these are really supported, however,
for 1 you can generally work around this by passing a string function name and using 'Application.Run' to invoke the function.
2 is trickier if you have lots of functions with different numbers of parameters, but for a set number of parameters you could add extra parameters to the newton_solve function or maybe use global variables.
e.g.
Public Function f(x as Double, y as Double) as Double
f = x^3-y
End Function
Function newton_solve_f (function_name as String, y as Double) as Double
Dim x as Double
x = 0 'initial guess for x
'do Newton's method to find x
...
' invoke function_name
x = Application.Run(function_name, x, y)
...
newton_solve_f = x
End Function
Assuming f is in a module called 'Module1' you can call this with:
x = newton_solve('Module1.f', 3)
Note that the function you want to call must be public.
EDIT: People pointed out that I was using Integer instead of Long...when I changed it, the formula returned 0...so it is still failing.
I have the following code
Public Function BreakEven(currenttier As Double, currentrate As Double, nexttier As Double, nextrate As Double) As Double
Dim x As Long
Dim y As Long
x = currentrate * currenttier
y = nexttier * nextrate
If currenttier >= nexttier Then
MsgBox "currenttier must be less than nexttier"
Else
Do Until (x = y)
currenttier = currenttier + 1
x = currentrate * currenttier
Loop
End If
BreakEven = currenttier
End Function
The purpose is to find the breakeven point in a cost structure, where a certain value (currenttier and nexttier) gives a corresponding interest rate. The interest rate changes when you reach the next tier...this calculates at what point in the lower tier, are you better off paying for the next tier (to reap the benefit of the 2nd tiers interest rate)
This code works fine when I use the numbers 100,000 and 200,000 (rates, but fails when it is upgraded to 1.5 mil to 2 mil (returns #VALUE)....I've tried changing the Do Until from X=y to include a wider margin for error (+-100)...yet it still seems to fail. Any ideas as to why.
The If statement is so that the loop doesn't enter an infinite loop and break excel.
VBA integers are 16 bit with a maximum value of 32767. I kid you not!
Use a Long instead. This will be good for just over 2 billion.
Integer max value is 2,147,483,647
so when you multiply 2 million by 1.5 mil for example the number goes beyond that.
Try using Big INt or Long
Try this code
Public Function BreakEven(currenttier As Double, currentrate As Double, nexttier As Double, nextrate As Double) As Double
Dim x As Double
Dim y As Double
x = currentrate * currenttier
y = nexttier * nextrate
If currenttier >= nexttier Then
MsgBox "currenttier must be less than nexttier"
Exit Function
---- or any other action----
Else
Do while x < y
currenttier = currenttier + 1
x = currentrate * currenttier
Loop
End If
BreakEven = currenttier
End Function