Sulprobil

Search…

Redw

Suppose you want to simulate teachers who judge pupils. Some teachers do not dare to give extreme grades (assume they give grade 1 for 2% of all cases, grade 2 for 8%, grade 3 for 80%, grade 4 for 8% and grade 5 for 2%). The next teacher is too critical, his distribution is 40%, 30%, 20%, 10% and 0% for grades 1 till 5. Another one only gives grade 4 (60%) and grade 5 (40%). A last one finally offers sort of a “fair” normal distribution (10%, 20%, 40%, 20%, 10%). How do you produce these random numbers which are distributed as mentioned above? Take the following procedure redw() which creates random numbers with equidistant weights. This function would be called with =INT(1+5*redw(10,20,40,20,10)) to simulate the “fair” teacher, for example.

1

Function redw(ParamArray vWeights() As Variant) As Double

2

'Reverse("moc.LiborPlus.www") V0.50 09-Dec-2009 PB

3

'Produces random numbers with equidistant weights. Redw expects a vector of n random

4

'weights of type double and returns a random number of type double. This random

5

'number will lie in the given equidistant n-split-range of the [0,1)-intervall

6

'with the given likelihood of weightings. Examples:

7

'a) redw(0,1,0,0,0,0,0,0,0,0) will return a random number d, 0.1 <= d < 0.2

8

'b) redw(2,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) redw(0,1,0) will return a random number d, 0.333333333333333 <= d < 0.666666666666666.

11

'd) redw(15.4,15.4,15.4,15.4,15.4,7.7,7.7,7.7,0,0) would return a random value between

12

' 0 and 0.8, first 5 deciles with double likelihood than decile 6-8.

13

14

Dim i As Long

15

Dim dw As Double

16

ReDim dwi(0 To UBound(vWeights) + 2) As Double

17

18

dw = 0#

19

dwi(0) = 0#

20

For i = 0 To UBound(vWeights)

21

If vWeights(i) < 0# Then 'A negative weight is an error

22

redw = CVErr(xlErrValue)

23

Exit Function

24

End If

25

dw = dw + vWeights(i) 'Calculate sum of all weights

26

dwi(i + 1) = dw 'Calculate sum of weights till i

27

Next i

28

29

redw = dw * Rnd

30

31

'i = UBound(vWeights) + 1 'i already equals UBound(vWeights) + 1, you may omit this statement.

32

Do While redw < dwi(i)

33

i = i - 1

34

Loop

35

36

redw = (CDbl(i) + (redw - dwi(i)) / vWeights(i)) / (CDbl(UBound(vWeights) + 1))

37

38

End Function

Copied!

Last modified 1yr ago

Copy link