Two random numbers sticking together - excel

I'm trying to write a function that changes 3 coordinates and 3 velocities in a loop using random numbers.
Although he generated numbers seem random enough. The two last values never drift apart, while the first one does go its own way.
This is the function, I will also link the excel workbook, so you can see it in action
(it's a animated colorbox using RGB and sliders for the values. Just run the 'color' sub
Function variate(ByRef x_origin As Double, ByRef y_origin As Double, ByRef offset_x As Double, ByRef offset_y As Double, Optional ByRef z_origin As Double, Optional ByRef offset_z As Double, Optional xyz_bounds) As Variant
'this function adds random number to each of the origins
'the offset is the 'drift' the object has (or velocity)
'calculate a random number
'if the number is going in the same direction, speed up
'otherwise slow down
Dim new_origin_x As Double
Dim new_origin_y As Double
Dim new_origin_z As Double
Dim velocity_x As Double
Dim velocity_y As Double
Dim velocity_z As Double
Dim speed_x As Double
Dim speed_y As Double
Dim speed_z As Double
Dim random_number_x As Double
Dim random_number_y As Double
Dim random_number_z As Double
Dim random_speed_x As Double
Dim random_speed_y As Double
Dim random_speed_z As Double
'calculate a random with the seed and make it between -0.5 and 0.5
Randomize
random_number_x = Rnd(Range("x_fact").Value) - 0.5
Randomize
random_number_y = Rnd(Range("y_fact").Value) - 0.5
Randomize
random_number_z = Rnd(Range("z_fact").Value) - 0.5
'for the speed
Randomize
random_speed_x = Rnd(1) - 0.5
Randomize
random_speed_y = Rnd(1) - 0.5
Randomize
random_speed_z = Rnd(1) - 0.5
'see how much there is a speed up
'what point would we be at with the current speed
'that is the distance travelled in time, but the time is 1 'unit' ...
'and let's add some randohohomnessss
speed_x = offset_x + (random_speed_x / Range("x_rem").Value)
speed_y = offset_y + (random_speed_y / Range("y_rem").Value)
speed_z = offset_z + (random_speed_z / Range("z_rem").Value)
'so new origin is new_origin_x = x_origin + offset_x
'but than we've travelled at the same speed, with directional changes
'we're probably not even moving
'so add some randomness to act as 'live'
new_origin_x = x_origin + offset_x + (random_number_x / Range("x_fact").Value)
new_origin_y = y_origin + offset_y + (random_number_y / Range("y_fact").Value)
new_origin_z = y_origin + offset_z + (random_number_z / Range("z_fact").Value)
'variate = [{new_origin_x;new_origin_y};{speed_x;speed_y}]
'variate = [{new_origin_x;new_origin_z};{speed_x;speed_z}]
'see if boundaries are requested and if so, not met
'should be: going to meet at the current speed
If Not IsMissing(xyz_bounds) Then
Dim distant_from_bounds_x
Dim distant_from_bounds_y
Dim distant_from_bounds_z
Dim future_pos_x
Dim previous_dist_x
Dim previous_dist_y
Dim previous_dist_z
future_pos_x = new_origin_x + 3 * speed_x
Dim future_pos_y
future_pos_y = new_origin_y + 3 * speed_y
Dim future_pos_z
future_pos_z = new_origin_z + 3 * speed_z
distant_from_bounds_x = xyz_bounds / 2 - Abs(future_pos_x - xyz_bounds / 2)
distant_from_bounds_y = xyz_bounds / 2 - Abs(future_pos_y - xyz_bounds / 2)
distant_from_bounds_z = xyz_bounds / 2 - Abs(future_pos_z - xyz_bounds / 2)
previous_dist_x = xyz_bounds / 2 - Abs((x_origin + 3 * speed_x) - xyz_bounds / 2)
previous_dist_y = xyz_bounds / 2 - Abs((y_origin + 3 * speed_y) - xyz_bounds / 2)
previous_dist_z = xyz_bounds / 2 - Abs((z_origin + 3 * speed_z) - xyz_bounds / 2)
'slow down
If (distant_from_bounds_x < 10) And (distant_from_bounds_x - previous_dist_x < 0) Then
speed_x = speed_x - speed_x / 3
If Abs(speed_x) < 1.5 Then speed_x = -speed_x * 2.9
End If
If distant_from_bounds_y < 10 And (distant_from_bounds_y - previous_dist_y < 0) Then
speed_y = speed_y - speed_y / 3
If Abs(speed_y) < 1.5 Then speed_y = -speed_y * 2.9
End If
If distant_from_bounds_z < 10 And (distant_from_bounds_z - previous_dist_z < 0) Then
speed_z = speed_z - speed_z / 3
If Abs(speed_z) < 1.5 Then speed_z = -speed_z * 2.9
End If
'speedlimits
If Abs(speed_x) > 9 Then speed_x = speed_x - Abs(speed_x / 4)
If Abs(speed_y) > 9 Then speed_y = speed_y - Abs(speed_y / 4)
If Abs(speed_z) > 9 Then speed_z = speed_z - Abs(speed_z / 4)
End If
'return the values and the new velocity to add some more stuff
x_origin = new_origin_x
y_origin = new_origin_y
z_origin = new_origin_z
offset_x = speed_x
offset_y = speed_y
offset_z = speed_z
End Function
Any suggestions would be greatly appreciated !

If you can excuse my abrasiveness, you are misusing the generator:
1) At the beginning of your function, include the line
Rnd(-1)
That is how you seed the generator.
2) Remove all your Randomize calls as they are ruining the statistical properties of the generator. I think that is the cause of your problems. You can have one Randomize call directly after Rnd(-1) above, but I think it's nice to have the same sequence generated for tractability.
3) There is no need to have a parameter in your Rnd() calls (other than the first step), as the default behaviour is to return a number in the range [0, 1). In fact this could be causing your problems, since a negative parameter value re-seeds the generator!
4) Investigate the effects of doing the above. But be aware that the VBA random sequence is a linear congruential generator of the form next = ((c * prev) mod b) + a where a, b and c are constants, prev is the previous random number and next the generated one. (As a final flourish, the integer values next and prev are scaled to floating point numbers). You can see that there is possible autocorrelation in the sequence since when prev is small, the modulus will have no effect. You can but hope that the engineers at Microsoft have assigned a large value to c to circumvent this effect. This autocorrelation can cause "sticking" when using random numbers in a multidimensional situation.
(4) could therefore be causing your problem, and if it is, you need to switch to another generator. Let me know and we can make some suggestions on that front.

Related

Get random number between two doubles

How to generate random number between 35.9 and 37.2?
Seems like I can generate Integer like this:
Int ((37-35+1) * Rnd + 35)
But how to do the same with doubles and get double value?
This works for me :
Sub Bouton1_Cliquer()
Dim r As Double
Randomize
r = (35.9 - 37.2) * Rnd + 37.2
End Sub
You can try this:
CDbl(WorksheetFunction.RandBetween(359, 372) / 10)
You can use :
Dim mRand As Double
mRand = 35.9 + Rnd * 1.3
(1.3 because 37.2-35.9 = 1.3)
Or between 2 values a and b (b>a) :
Dim mRand As Double, a As Double, b As Double
mRand = a + Rnd * (b-a)

Excel VBA function terminates after first loop of for/next loop without finishing function

I just wrote this code to perform an iterative calculation. It finds the X,Y coordinates where an unknown parabola is tangent to a known circle. It is based on other iterative functions I've written that have worked flawlessly. I'm stumped as to what the issue is. Here is the code:
Public Function Jext(PA As Double, Xcl As Double, Ycl As Double, Ctr As Double, Rnl As Double, Finl As Double) As Double
Pi = 3.14159265358979
tol = 0.00000001
Dim x(20) As Double
Dim Yc(20) As Double
Dim Yp(20) As Double
Dim A(20) As Double
Dim Diff(20) As Double
Dim It As Integer
Dim hF As Double
Dim Sf As Double
'Xcl is the horizontal position of the root radius center line
'Ycl is the vertical position of the root radius center line
'Ctr is root radius. It's an approximation of the trochoid and is typically the cutter tip radius
'Rnl is the radius to the point where the load line intersects the tooth centerline. It is the apex of the parabola
'x is the horizontal position that is common to the parabola and circle. It is the independent variable
'Yc is the vertical position on the circle at point x
'Yp is the vertical position on the parabola at point x
'A is the leading term of the parabolic equation
'Diff is the calculated difference in vertical positions of circle and parabola
'Set initial guess values. x(0) is 5% of the radius (left edge of circle) and x(1) is 95% of the radius(bottom of the circle)
x(0) = (Xcl - Ctr) + 0.05 * Ctr
x(1) = (Xcl - Ctr) + 0.95 * Ctr
Yc(0) = Ycl - (Ctr ^ 2 - (x(0) - Xcl) ^ 2) ^ 0.5
Yc(1) = Ycl - (Ctr ^ 2 - (x(1) - Xcl) ^ 2) ^ 0.5
A(0) = Tan(WorksheetFunction.Acos((Xcl - x(0)) / Ctr) + Pi / 2) / (2 * x(0))
A(1) = Tan(WorksheetFunction.Acos((Xcl - x(1)) / Ctr) + Pi / 2) / (2 * x(1))
Yp(0) = A(0) * x(0) ^ 2 + Rnl
Yp(1) = A(1) * x(1) ^ 2 + Rnl
Diff(0) = Yp(0) - Yc(0)
Diff(1) = Yp(1) - Yc(1)
For It = 1 To 19 Step 1
x(It + 1) = x(It) - (Diff(It) - 0) * (x(It - 1) - x(It)) / (Diff(It - 1) - Diff(It))
Yc(It + 1) = Ycl - (Ctr ^ 2 - (x(It + 1) - Xcl) ^ 2) ^ 0.5
A(It + 1) = Tan(WorksheetFunction.Acos((Xcl - x(It + 1)) / Ctr) + Pi / 2) / (2 * x(It + 1))
Yp(It + 1) = A(It + 1) * x(It + 1) ^ 2 + Rnl
Diff(It + 1) = Yp(It + 1) - Yc(It + 1)
If Abs(Diff(It + 1)) < tol Then Exit For
Debug.Print Diff(It + 1)
Next It
hF = Rnl - Yp(t + 1)
Sf = 2 * x(t + 1)
Jext = 1 / (Cos(Finl) / Cos(PA) * (6 * hF / Sf ^ 2 - Tan(Finl) / Sf))
End Function
I put a stop at the "Next It" line to check the values as it went through the iterative loops. When I execute the code, all of the values are as expected and the value of Abs(Diff(It+1)) is not small enough to exit the for loop in the IF statement. I put the Debug.Print statement in there to make sure it was getting that far in the code and it did print Diff(It+1). So it executes everything to that point. Then when I continue the function it just stops and returns a #VALUE error in the spreadsheet. I've no idea why it won't continue the for loop. Anyone see something I've missed?

Rearrange equation to solve for a different variable

I am looking at VBA code (function) written by someone else.
Here is the code:
Function EuropeanDelta(StrikePrice, MarketPrice, Volatility, InterestRate As Double, PC As String, ValueDate, ExpiryDate As Date, Optional PriceOrYield As String = "P") As Double
Rem Declare our working variables
Dim r As Double
Dim d1 As Double
Dim d2 As Double
Dim t As Double
Dim SqT As Double
Rem End of variable declaration
If PriceOrYield = "Y" Then
MarketPrice = 100 - MarketPrice
StrikePrice = 100 - StrikePrice
If PC = "C" Then
PC = "P"
Else
PC = "C"
End If
End If
Rem Initiase our working variables
t = (ExpiryDate - ValueDate) / 365
SqT = Sqr(t)
r = Application.WorksheetFunction.Ln(1 + InterestRate)
d1 = (Application.WorksheetFunction.Ln(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * SqT)
Rem Quick logic to deal with Calls or Puts
If PC = "C" Then
EuropeanDelta = Exp(-r * t) * Application.WorksheetFunction.NormSDist(d1)
Else
EuropeanDelta = -Exp(-r * t) * Application.WorksheetFunction.NormSDist(-d1)
End If
If PriceOrYield = "Y" Then
EuropeanDelta = EuropeanDelta * -1
End If
End Function
The whole problem is based around the line for "d1". I would like to re-organise to solve for "StrikePrice". I have tried writing it out mathematically and then re-arranging, then swapping back to VBA.
#duffymo is correct, but am giving the answer directly in terms of VBA code
' d1 = (Log(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * Sqr(t))
'
' Volatility * Sqr(t) * d1 = Log(MarketPrice / StrikePrice) + Volatility^2 * t/2
'
' Log(MarketPrice / StrikePrice) = Volatility * Sqr(t) * d1 - Volatility^2 * t/2
'
' MarketPrice / StrikePrice = Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
'
StrikePrice = MarketPrice / Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
Other Notes :
For brevity replace Application.WorksheetFunction.Ln() with Log()
There is no need cache SqT = Sqr(t) since it is only used once.
For clarity replace Volatility*Volatility with Volatility^2 as internally it does the same thing.
This is just algebra - high school math.
Take it in steps. Make sure you do the same operation to both sides to make sure that equality still holds.
Here's your starting equation:
d = {ln(m/s) + v*v*t/2}/(v*sqrt(t))
Multiply both sides by the denominator of the RHS:
d*v*sqrt(t) = ln(m/s) + v*v*t/2
Subtract v*v*t/2 from both sides:
(d*v*sqrt(t) - v*v*t/2) = ln(m/s)
Apply the exponential function to both sides, noting that exp(ln(x)) = x:
exp(d*v*sqrt(t) - v*v*t/2) = m/s
Multiply both sides by s:
s*exp(d*v*sqrt(t) - v*v*t/2) = m
Divide both sides by exp(d*v*sqrt(t) - v*v*t/2) to get the desired result:
s = m/exp(d*v*sqrt(t) - v*v*t/2)
Let's see if this function makes sense.
At t = 0 the denominator exp(0) = 1, so the strike price is equal to the market price.
As t -> infinity, we hope that the denominator gets large so s -> zero. L'Hospital's Rule will help here.

#value! error in UDF when doing simple division

When doing a simple division problem with some defined variables I am getting the #value error in a UDF. The variables are all defined as doubles.
Apologies in advance as I am a mechanical engineer by trade so my coding is very amateur. I have a design book I use in excel that can end up being many columns long so to avoid this I am trying to code some UDFs to eliminate the all the cells just doing calculations for other cells. With that, I have run into an issue that I have in my calculations as soon as I start to try to divide variables.
In the code, I am not getting an issue until the Cx dim. I noted out everything starting at SFA_Radians and set the function to output each variable. All is good and expected values until reaching Cx. No matter what I do it seems if I am dividing by a variable I get the #VALUE error. Any help is much appreciated.
Function RADEFFECTSF(SFA As Range, FacetAngle As Range, FacetRadius As Range) As Variant
Dim Slope1 As Double
Dim Slope2 As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim b1 As Double
Dim b2 As Double
Dim SFA_Radians As Double
Dim FacetAngle_Radians As Double
Dim Pi As Double
Dim Cx As Double
Dim Cy As Double
Dim CalcArray() As Double
Dim i As Long
Pi = Application.WorksheetFunction.Pi()
ReDim CalcArray(1 To SFA.Cells.Count)
For i = 1 To SFA.Cells.Count
SFA_Radians = SFA(i) * Pi / 180
FacetAngle_Radians = FacetAngle(i) * Pi / 180
Slope1 = -Tan(SFA_Radians)
Slope2 = Tan(FacetAngle_Radians)
X1 = FacetRadius(i) * Sin(SFA_Radians)
Y1 = FacetRadius(i) * Cos(SFA_Radians)
b1 = Y1 - (Slope1 * X1)
X2 = -FacetRadius(i) * Sin(FacetAngle_Radians)
Y2 = FacetRadius(i) * Cos(FacetAngle_Radians)
b2 = Y2 - (Slope2 * X2)
Cx = (b2 - b1) / (Slope1 - Slope2)
Cy = (Slope1 * (Cx / (b1))) + b1
CalcArray(i) = Cy - (FacetRadius(i) * Cos(SFA_Radians))
Next i
RADEFFECTSF = CalcArray()
End Function
I already try your code on some sample data and it works:
SAMPLE
From my experience (I am engineer too), most probably some of the data you are importing on the range aren´t numbers. Check it.
The Slope1 - Slope2 value, you can get 0 so place a condition. Same comment for b1.
Check line by line writing the values you are getting in a additional range to see exactly where it is failing, just keeping remaining code as a comment.F.e.
Function RADEFFECTSF(SFA As Range, FacetAngle As Range, FacetRadius As Range) As Variant
...
Pi = 4 * Atn(1)
ReDim CalcArray(1 To SFA.Cells.Count)
For i = 1 To SFA.Cells.Count
SFA_Radians = SFA(i) * Pi / 180
FacetAngle_Radians = FacetAngle(i) * Pi / 180
Slope1 = -Tan(SFA_Radians)
Slope2 = Tan(FacetAngle_Radians)
X1 = FacetRadius(i) * Sin(SFA_Radians)
CalcArray(i) = X1 'This line is just to return the data X1
'Y1 = FacetRadius(i) * Cos(SFA_Radians)
'b1 = Y1 - (Slope1 * X1)
'X2 = -FacetRadius(i) * Sin(FacetAngle_Radians)
'Y2 = FacetRadius(i) * Cos(FacetAngle_Radians)
'b2 = Y2 - (Slope2 * X2)
'If Slope1 <> Slope2 then
'Cx = (b2 - b1) / (Slope1 - Slope2)
'Else
'Place what it is expected when Slope1=Slope2
'End If
'Cy = (Slope1 * (Cx / (b1))) + b1
'CalcArray(i) = Cy - (FacetRadius(i) * Cos(SFA_Radians))
Next i
RADEFFECTSF = CalcArray()
End Function
Check that X1 is the one expected... and so on. Then you can find which one is the code line introducing the unexpected value.
Sorry to give that one as reply, but still I can´t make comments.

VBA : For loop exiting without returning the value

I have the following piece for code to simulate stock prices using stochastic process
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * 252, 0)
ReDim stock(per)
stock(1) = s0
dt = 1 / 252
For i = 1 To per
stock(i + 1) = stock(i) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
In this code, I ran debugging by placing a break point at Next and the entire For loop is working absolutely fine. The problem is after completing the loop the function exits and #VALUE! error is displayed in the cell.
I am not able to figure out what is wrong with this code.
Will be thankful if anyone can help me with it.
Try this:
Const n As Integer = 252
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * n, 0)
ReDim stock(per)
stock(0) = s0 ' First item in the array has index 0
dt = 1# / n ' Avoid integer division, 1/252 = 0
For i = 1 To per
'Each stock depends on the previous stock value:
stock(i) = stock(i - 1) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
I saw two issues and one suggestion.
One is the array stock goes from 0..252 but you assign values to 1..253 so it crashes.
Also there is a possible integer division resulting in dt=0.0. I updated the definition to make the intent clear that the division is to be done after the conversion from integer to double. Lastly, I moved the magic number 252 to a constant.

Resources