Sulprobil
Search…
Rww
Special cases may require special non-equidistant but stepwise constant distributions. These could be created with this function rww().
Please read my Disclaimer.
1
Function rww(ParamArray w() As Variant) As Double
2
'Produces random numbers with defined widths & weights
3
'06/08/2004 by Bernd Plumhoff. rww expects a vector of n random widths and
4
'weightings of type double and returns a random number of type double. 'This random number will lie in the given n-width-range of the
5
'(0,1)-intervall with the given likelihood of the n weightings.
6
'Examples:
7
'a) rww(1,0,1,1,8,0) will return a random number between 0.1 and 0.2
8
'b) rww(5,2,5,1) will return a random number between 0 and 0.5 twice as
9
' often as a random number between 0.5 and 1.
10
'c) rww(1/3,0,1/3,1,1/3,0) will return a random number between
11
' 0.33333333333333 and 0.66666666666666.
12
'd) rww(5,15.4,3,7.7,2,0) would return a random value between
13
' 0 and 0.8, first 5 deciles with double likelihood than decile 6-8.
14
15
Dim i As Long
16
Dim swidths As Double
17
Dim sw As Double
18
19
If (UBound(w) + 1) Mod 2 <> 0 Then
20
rww = -2 'No even number of arguments: Error
21
Exit Function
22
End If
23
24
ReDim swidthsi(0 To (UBound(w) + 1) / 2 + 1) As Double
25
ReDim swi(0 To (UBound(w) + 1) / 2 + 1) As Double
26
ReDim weights(0 To (UBound(w) + 1) / 2) As Double
27
ReDim widths(0 To (UBound(w) + 1) / 2) As Double
28
29
swidths = 0#
30
sw = 0#
31
swi(0) = 0#
32
swidthsi(0) = 0#
33
For i = 0 To (UBound(w) - 1) / 2
34
If w(2 * i) < 0# Then 'A negative width is an error
35
rww = -3#
36
Exit Function
37
End If
38
widths(i) = w(2 * i)
39
swidths = swidths + widths(i)
40
swidthsi(i + 1) = swidths
41
If w(2 * i + 1) < 0# Then 'A negative weight is an error
42
rww = -1#
43
Exit Function
44
End If
45
weights(i) = w(2 * i + 1)
46
If widths(i) > 0# Then
47
sw = sw + weights(i)
48
End If
49
swi(i + 1) = sw
50
Next i
51
rww = sw * Rnd
52
'i = (UBound(w) - 1) / 2 + 1 'i already equals (UBound(w) - 1) /
53
'2 + 1, you may omit this statement.
54
Do While rww < swi(i)
55
i = i - 1
56
Loop
57
58
rww = (swidthsi(i) + (rww - swi(i)) / weights(i) * widths(i)) / swidths
59
60
End Function
Copied!
Last modified 1yr ago
Copy link