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)
Related
I am trying to convert a Mathcad calculation to excel spreadsheet. I am trying to find a variable called kw. I am getting type mismatch error in the line:
INTEG = INTEG + ...
Would someone know why I am getting this error ? I have already spent a lots of time on it but couldn't find the reason. As this work is really important to me, I would like to thank in advance any help/suggestion on it.#
Option Explicit
Dim wp As Double, alpha As Double, w As Double, gama As Double, d As Double
Dim kw As Double, n As Integer, sExp As String, g As Double
'Calculating kw
Sub CalculateKw()
Dim l As Integer
alpha = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H49").Value
gama = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H34").Value
d = ThisWorkbook.Sheets("Environmental Data Input").Range("H4").Value
wp = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H47").Value
kw = 100
For l = 1 To 99
If Err.Number = 0 Then
kw = INTEG(0, kw, 5000)
Else
kw = kw - 1
End If
Next l
ThisWorkbook.Sheets("Sheet1").Range("B1").Value = kw
End Sub
'DEFINITE INTEGRAL from 0 to kw*wp to solve JONSWAP Equation
Function INTEG(n, kw, lBit As Long)
Dim SpectralWidthParameter As Double, dMin As Double, dMax As Double
Dim dW As Double, lW As Long, AAA As String
g = 9.80665
alpha = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H49").Value
gama = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H34").Value
d = ThisWorkbook.Sheets("Environmental Data Input").Range("H4").Value
wp = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H47").Value
dMin = 0
dMax = kw * wp
If w <= wp Then
SpectralWidthParameter = 0.07
Else
SpectralWidthParameter = 0.09
End If
sExp = "(w ^ n) * (((w / _
(Application.WorksheetFunction.Sinh(WaveNumber(0,20,w,d) * d))) ^ 2)*
(alpha * (g ^ 2) * (w ^ (-5)) * (EXP((-5 / 4) * ((w / wp) ^ (-4)))) *
(gama ^ (EXP(-0.5 * (((w - wp) / (SpectralWidthParameter * wp)) ^ 2))))))"
sExp = Replace(sExp, "EXP", "AAA")
dW = (dMax - dMin) / lBit
For lW = 1 To lBit
*INTEG = INTEG + Evaluate(Replace(Replace(sExp, "w", dMin), "AAA", _
"EXP")) * dW + 0.5 * dW * Abs(Evaluate(Replace(Replace(sExp, "w", dMin _
+dW), "AAA", "EXP")) - Evaluate(Replace(Replace(sExp, "w", dMin), _
"AAA", "EXP")))*
dMin = dMin + dW
Next lW
End Function
'BISECTION METHOD TO CALCULATE Wave number k
Function WaveNumber(a, b, w, d)
Dim klow As Double, khigh As Double, kmid As Double, i As Integer
Dim a As Integer, b As Integer
klow = a
khigh = b
kmid = (klow + khigh) / 2
For i = 1 To 100
If SolveFunction(klow, w, d) * SolveFunction(kmid, w, d) < 0 Then
khigh = kmid
kmid = (klow + khigh) / 2
Else
klow = kmid
kmid = (klow + khigh) / 2
End If
Next i
WaveNumber = kmid
End Function
'HELPER FUNCTION(Wave Dispersion Equation)FOR BISECTION METHOD
Function SolveFunction(k, w, d)
SolveFunction = k * Application.WorksheetFunction.Tanh(k * d) - (w ^ 2) _
/ 9.80665
End Function
INTEG = INTEG + Evaluate(....)
"Type mismatch" because your Evaluate expression returned an error. Adding a number to an error variant generates that runtime error.
Basically you shouldn't insert Application.WorksheetFunction.Sinh(...) in the evaluated expression, but just Sinh(...).
Moreover I think that you can re-write your code without using Evaluate, this will make debugging your code easier.
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.
I am trying to run this code to calculate Q(n) at different Tn in the Equation 16.4 in the attached picture.But its not giving me the correct output. I would appreciate any help. Note: delta1=delta2 =...deltan = dt=1 ( I have taken here ) and further divided S term by 10000 just because in the Equation it is in basis point i.e. 100th part of 1 %.
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) = 1
For j = 1 To n - 1
P = (b(1, j) * (L * Q(j - 1) - (L + dt * a(1, n) / 10000) * Q(j))) / (b(1, n) * (L + a(1, n) * dt / 10000)) + Q(n - 1) * L / (L + a(1, n) * dt / 10000)
sum = sum + P
Q(n) = sum
Next j
Bootstrap = sum
End Function
To solve a recursive function you can write it this way, for example
Function Factorial(n as long) as long
If n = 1 Then
Factorial = 1
Else
Factorial = n * Factorial(n-1)
End If
End function
Yes, you can see For...Loop can also do the Factorial calculation, but in your case, its much easier to use recursive solution.
Besides Eq 16.4 is intentionally written as a recursive function. It is not written as a summation function because it is harder to do so. If given to you is a summation function, then you can apply the For...Loop solution.
Hope this helps.
EDIT
Function Q(n as long) as double
If n = 1 Then
Q = 5
Else
Q = Z * ( L * Q_t - (L + d * S) * Q(n-1) ) / ( Z * ( L + d * S ) )
End If
End Function
Notice that the function Q keep calling itself in Q(n-1) when n>1. That is called recursive solution.
(Check the formula. I might copy it wrong)
Im Making a VBA function to calculate an integral using the trapezoidal rule
but how can I apply a function that I created in VBA to Use in a another Function...heres My Code ( the worksheet.function did not work)
Option Explicit
Function funcion(x As Double) As Double
funcion = 3 * (x ^ 3) + 5 * (x ^ 2) - 10 * x + 20
End Function
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
i = 0
sum = 0
Do While (i <= n - 1)
sum = sum + WorksheetFunction.funcion(a + i * h)
i = i + 1
Loop
Sumatoria = sum
End Function
This works :
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
Dim temp As Double
i = 0
sum = 0
Do While (i <= n - 1)
temp = a + i * h
sum = sum + funcion(temp)
i = i + 1
Loop
Sumatoria = sum
End Function
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.