I have a code which generates a Probability distribution for the total profit of price using the Monte Carlo Simulation Method.
How does the data in column F and G , display the cumulative distribution of profit ?
I understand that it will compute the cumulative frequency using a range of values which is given
given by Int(Iteration / 20 * i).
but I don't see how it is related to the Probability that Profit >= X in column F.
ie.
if I choose 100 for my iterations ,
then
TP(Int(Iteration / 20 * i))
= TP(Int(100 / 20 * i))
= TP(Int(5 * i))
and so it would only display,
TP(5), TP(10) , TP(15) and TP(20)
if i = 5
TP(Int(Iteration / 20 * i))
= TP(Int(100 / 20 * i))
= TP(Int(5 * 5))
and i get TP(25) which is out of the range.
this is the part of the code I'm confused about :
For i = 1 To 20
Cells(i + 3, 6) = 1 - (0.05 * i)
Cells(i + 3, 7) = TP(Int(Iteration / 20 * i))
Cells(i + 3, 14) = Iteration / 20 * i
Next i
http://www.anthony-vba.kefra.com/vba/vba12.htm
From the code and the data you are providing, there shouldn't be any out of range:
ReDim TP(Iteration) As Double 'Is defined as function of the number of iterations (100 here)
Cells(i + 3, 6) = 1 - (0.05 * i) 'Writes to the F column until row 8
Cells(i + 3, 7) = TP(Int(Iteration / 20 * i)) 'Writes to the G column until row 8
'The maximum value for TP(Int(Iteration / 20 * i)) is 25, below 100
'Actually, this array should be dimensioned in a more direct way like ReDim TP(Int(Iteration / 20 * i)) As Double
If you get an out of bounds error is because the TP array is not dimensioned as it should be: either because you missed the line above (ReDim TP(Iteration) As Double), or because you didn't assign the right value to the variable Iteration (= 100) before doing the aforementioned redimensioning.
Related
The question to be done
I have tried this out.
I have created few functions. I am confused in the remaining ones.
I have made the first function and stored the values of upper, lower and main matrix in my spreadsheet.
Function createFEMatrixDirichlet(a, C, Nx, h, dt)
Dim k As Integer
'Main
For k = 0 To Nx - 1
Cells(k + 2, 2).Value = 1 - dt * (((2 * a) / (h * h)) + x)
Next k
'Lower
For k = 0 To Nx - 2
Cells(k + 2, 1).Value = dt * (a / (h * h))
Next k
'Upper
For k = 0 To Nx - 3
Cells(k + 2, 3).Value = dt * (a / (h * h))
Next k
End Function
Nodes are generated similar way.
Function nodeGeneration(xa, xb, Nx, column)
Dim k As Integer
'Find h
h = (xb - xa) / Nx
'Generate Node
For k = 0 To Nx
Cells(k + 2, column).Value = xa + k * h
Next k
End Function
Initial condition are applied:
Function applyInitialCondition(Nx, column)
Dim k As Integer
For k = 0 To Nx
Cells(k + 2, column).Value = ((Cells(k + 2, 4)) + 2) / 2
Next k
End Function
Now to multiply I am a bit confused. My implementation is that I am trying to make the entire matrix and then multiply. However, there is no luck. Some or the other error pops up.
Also, I have no idea on how to implement the FETimeStep and then create a new subroutine to run the entire code.
Any leads?
Sample Input
I have crated an Array with 500 rows and 10 columns. I am trying to generate an array of Signal strength using the radar range equation. I want to detect two targets at two ranges and I am putting them in the array at a specific point. I have 2 If statements nested within 2 for loops. The for loops work properly, I can't figure out where my If statements are wrong though. All of the values are correct (Hence the msgboxs for the values)
I have tried moving the Signal(i, j) = 0 into an If statement but I wasn't sure how to set the bounds since it is at every other points besides row 50 and 250.
Sub Generate_Power_Amplitude()
'/////////////////////Basic Parameters////////////////////////////
'/////////////////////Step 1//////////////////////////////////////
' Input the parameters of the Radar Range Equation
TotalPower = 10000 '(Watts)
Gain = 3162.27766 '(35 dB of gain)
Wavelength = 0.3 '(meters)
RCS = 15 '(meters^2)
RangeToTarget = 35000 '(meters)
PulseWidth = 1.67 * 10 ^ -6 '(seconds)
Bandwidth = 6 * 10 ^ 5 '(Hertz)
RangeBins = 1 * 10 ^ 3 '(meters)
PRI = 1 * 10 ^ -4 '(seconds)
PRF = 1 * 10 ^ 4 '(Hertz)
PRIDistance = 60000 '(meters)
'//////////////////Targets/////////////////////////////////////////////
'//////////////////Step 2//////////////////////////////////////////////
' Define how many targets and their distance
Target1 = 25000 '(meters)
Target2 = 125000 '(meters)
'/////////////////Operations//////////////////////////////////////////
RadarRangeNumerator = TotalPower * Gain ^ 2 * Wavelength ^ 2 * RCS
RadarRangeDenomenator = (4 * 3.1415926) ^ 3 * RangeToTarget ^ 4
RelativePower = RadarRangeNumerator / RadarRangeDenomenator
PowerAmplitude = RelativePower ^ 0.5
RelativePower1 = RadarRangeNumerator / ((4 * 3.1415926) ^ 3 * Target1 ^ 4)
RelativePower2 = RadarRangeNumerator / ((4 * 3.1415926) ^ 3 * Target2 ^ 4)
PowerAmp1 = RelativePower1 ^ 0.5
PowerAmp2 = RelativePower2 ^ 0.5
Dim Signal(500, 10)
For i = 1 To 500
For j = 1 To 10
If i = 50 Then
Signal(50, j) = PowerAmp1
ElseIf i = 250 Then
Signal(250, j) = PowerAmp2
End If
Signal(i, j) = 0
Next j
Next i
MsgBox Signal(50, 1)
MsgBox Signal(250, 1)
End Sub
I got the msgboxes to give the right values and this is the new For Loop, there is a comment below, as I said I feel this will eventually break and if there is a right way to do this let me know.
Dim Signal(500, 10)
For i = 1 To 500
For j = 1 To 10
If i = 500 Then
Signal(50, j) = PowerAmp1
Signal(250, j) = PowerAmp2
End If
Signal(i, j) = 0
Next j
Next i
This may be too simple of an answer but it seems like you just need to loop using the Ubound and Lbound tools. Here's an example with your code where you set the limits based on the Array size:
Dim Signal(500, 10)
For i = Lbound(Signal,1) To Ubound(Signal,1)
For j = LBound(Signal,2) To UBound(Signal,2)
If i = Ubound(Signal,1) Then
'This part confuses me:
Signal(50, j) = PowerAmp1
Signal(250, j) = PowerAmp2
End If
Signal(i, j) = 0
Next j
Next i
If all you ever want to do is insert the values for 50 and 250 into an array, then you don't need to set all the values to zero. In VBA, all variable values are initialized to zero including elements of an array. So this will produce the exact same result as your code:
Dim Signal(1 To 500, 1 To 10)
Signal(50, j) = PowerAmp1
Signal(250, j) = PowerAmp2
And, by the way, notice that I'm specifically stating the dimension range of the array. VBA will default to a zero-based array -- meaning your definition produced an array from 0 to 500, i.e. 501 elements.
#PGSystemTester is exactly correct in relating your loop bounds directly to the array bounds. This is a very common practice and can save you lots of heartache later on.
Dim Signal(1 To 500, 1 To 10)
For i = LBound(Signal, 1) To UBound(Signal, 1)
For j = LBound(Signal, 2) To UBound(Signal, 2)
If i = 500 Then
Signal(50, j) = PowerAmp1
Signal(250, j) = PowerAmp2
End If
Signal(i, j) = 0
Next j
Next i
Your next step may be to calculate the power at a series of stepped ranges to each target. Keep in mind that to define a variable number of steps -- array elements in this case -- you'll have to use ReDim
Const RANGE_STEPS As Long = 1000
Dim Signal As Variant
ReDim Signal(1 To RANGE_STEPS, 1 To 10)
If you're using the UBound and LBound functions, your loop remains exactly the same.
While running this code to randomize some values I find that the all the cells have the same number. I believe I'm missing a standard concept but I can't seem to wrap my head around the issue.
Randomize
LWeekDay = Int((400 - 150 + 1) * Rnd + 200)
LWeekEnd = Int((600 - 200 + 1) * Rnd + 200)
For Y = 3 To 10
For X = 2 To 8
Cells(Y, X) = LWeekDay
Next X
Next Y
You are currently only calculating LWeekDay once, and then using that value for every cell.
I assume you want to assign a new value every time through the loop:
Randomize
For Y = 3 To 10
For X = 2 To 8
LWeekDay = Int((400 - 150 + 1) * Rnd + 200)
LWeekEnd = Int((600 - 200 + 1) * Rnd + 200)
Cells(Y, X) = LWeekDay
Next X
Next Y
I have a for loop (the last loop in the code below) which fills some arrays with values through some computations.
However, for some reason, once i=5 it jumps back up to the top of the loop (the x+h part) without going through the rest of the loop.
While x < xmax
If x + h < xmax Then 'If the step is going to overshoot the desired xmax
x = x + h 'make h adequately smalller
Else
h = xmax - x
x = xmax
End If
'k(Order #, equation #)
For j = 1 To 6 'First to 6th order
'temp=riddersmethodT(temp) 'Calculate temperature of mixture
FT = 0
rho(0) = 0 'Setting FT and rho_av to 0 to be re-calculated
For i = 1 To 7
rho(0) = rho(0) + rho(i) * Y4(i) 'Calculate average density of mixture
FT = FT + Y4(i)
vol_F = vol_F + Y4(i) * MW(i) / rho(i) 'Calculating the total volumetric flowrate (m^3/s)
Next i
rho(0) = rho(0) / FT
For i = 1 To 8 'Calculating all of the k(1) values for eq 1 to 8
k(j, i) = AllODES(x, Y4, i, j, k, h, temp, diameter, vol_F, rho(0))
Next i
Next j
For i = 1 To 8
Y4Old(i) = Y4(i) 'Saving old y4 values to calc delta0
Y4(i) = Y4(i) + h * (k(1, i) * (37 / 378) + k(3, i) * (250 / 621) + k(4, i) * (125 / 594) + k(6, i) * (512 / 1771))
Y5(i) = Y4(i) + h * (k(1, i) * (2825 / 27648) + k(3, i) * (18575 / 48384) + k(4, i) * (13525 / 55296) + k(5, i) * (277 / 14336) + k(6, i) * (0.25))
delta0(i) = error
delta1(i) = Abs(Y5(i) - Y4(i))
delRatio(i) = Abs(delta0(i) / delta1(i)) 'Ratio of errors; careful of getting zeroes!
Next i
I don't understand how this can be possible seeing as i is not being manipulated within that loop. If you have any insight, please let me know!
My guess is that your final loop over i has a divide by zero somewhere. You could handle errors in your loop using something like the following:
Sub yourSub()
For i = 1 To 8
On Error GoTo ErrorHandler:
Y4Old(i) = Y4(i)
'Saving old y4 values to calc delta0
Y4(i) = Y4(i) + h * (k(1, i) * (37 / 378) + k(3, i) * (250 / 621) + k(4, i) * (125 / 594) + k(6, i) * (512 / 1771))
Y5(i) = Y4(i) + h * (k(1, i) * (2825 / 27648) + k(3, i) * (18575 / 48384) + k(4, i) * (13525 / 55296) + k(5, i) * (277 / 14336) + k(6, i) * (0.25))
delta0(i) = error
delta1(i) = Abs(Y5(i) - Y4(i))
delRatio(i) = Abs(delta0(i) / delta1(i)
Next i
Cleanup:
' do cleanup here
Exit Sub
ErrorHandler:
' handle error here
Resume Cleanup
End Sub
But it would be best to fix your match which is allowing a division by zero in the first place.
I was running tests on my software today and found that some of the values it was producing weren't correct.
I decided to step through the code and noticed that the variables I had assigned to textbox values on my userform when hovered over said empty, even though when hovering over the textbox assigned to it, the value inputted by the user showed.
For Example,
n = BiTimeSteps_TextBox.Value
when hovered over
n = empty
even though
BiTimeSteps_TextBox.Value = 2
when hovered over.
So say I have a formula shortly after that says
d = n*2 ,
n when hovered over says empty and d is made 0 when it shouldn't be.
Someone told me if I switch it around to
BiTimeSteps_TextBox.Value = n
it should be recognised but it is still not.
What could possibly be causing this?
See full code below: (it aims to price options using the binomial tree pricing method)
S = BiCurrentStockPrice_TextBox.Value
X = BiStrikePrice_TextBox.Value
r = BiRisk_Free_Rate_TextBox.Value
T = BiexpTime_TextBox.Value
Sigma = BiVolatility_TextBox.Value
n = BiTimeSteps_TextBox.Value
Dim i, j, k As Integer
Dim p, V, u, d, dt As Double
dt = T / n ' This finds the value of dt
u = Exp(Sigma * Sqr(dt)) 'formula for the up factor
d = 1 - u 'formula for the down factor
'V value of option
'array having the values
Dim bin() As Double 'is a binomial arrays, it stores the value of each node, there is a loop
'work out the risk free probability
p = (1 + r - d) / (u - d)
'probability of going up
ReDim bin(n + 1) As Double
'it redims the array, and n+1 is used because it starts from zero
'------------------------------------------------------------------------------------------------------------------------------
''European Call
If BiCall_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, (u ^ (n - i)) * (d ^ i) * S - X)
'It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
'european put
If BiPut_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, X - (S * (u * (n - i)) * (d * i)))
' European Put- It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
For k = 1 To n 'backward column loop
For j = 1 To (n - k + 1) 'loop down the column loop
bin(j) = (p * bin(j) + (1 - p) * bin(j + 1)) / (1 + r)
Cells(j + 19, n - k + 2) = bin(j)
'' print the values along the column, view of tree
Next j
Next k
Worksheets("Binomial").Cells(17, 2) = bin(1) ' print of the value V
BiOptionPrice_TextBox = bin(1)