piclist 2002\08\19\091223a >
www.piclist.com/techref/microchip/math/index.htm?key=random
BY : Mike Singer email (remove spam text)

Brendan,
I beg your pardon, I can't concentrate myself on all
these "uniformity" questions now.
I've slightly modified VB example. If someone want to
run it, he could paste the code into Excel sheet
VB module. (Open VBA editor, click Sheet1). It will
work on activating the sheet (just open another sheet
About correlation between "uniformity" and initial
registers' values: qualitative assessment is obvious:
The more initial values - the more randomness (less
uniformity) since relative difference between registers
will be smaller. When uniformity or randomness are
" good enough " -I don't know, it depends upon applications.
Maybe experimental way is better then trying to formalize
the problem. As for me, I can't even recall now all these
abstract math words to do it.
As James Newton wrote: "In fact, I've been spending
a lot of time thinking about why this (PBK) project
bothers me so much and others have not....". I'm thinking
about it too. I can't make myself not to post one more
message on this topic. I've some ideas, constructive, I
hope.

Mike.

---------------------------------------------------------

'   RE: [PIC] Random sequence
'   How to get randomly-biased dice number (08-19-2002).
'
'   1. Associate six registers with six dice numbers.
'   2. Init them with lngReg1InitValue...lngReg6InitValues
'        respectively.
'   3. On each loop subtract 5 from the register which
'      number was hit.
'      And add 1 to other registers.
'      If values < 1 or > lngRegMaxValue were reached -
'   4. Get Sum of the registers.
'   5. Get random value from 1 to the Sum.
'   6. Summarize register values until this sum reached
'      previous "The Sum". Last register's number involved
'      with this summarizing is the "randomly-biased dice
'      number".
'   7. Go to "3."

Option Explicit

Private Const lngRegMaxValue  As Long = 1000
Private Const lngReg1InitValue  As Long = 15
Private Const lngReg2InitValue  As Long = 15
Private Const lngReg3InitValue  As Long = 15
Private Const lngReg4InitValue  As Long = 15
Private Const lngReg5InitValue  As Long = 15
Private Const lngReg6InitValue  As Long = 15

Private Const lngNumberOfSteps  As Long = 1000

Private Sub Worksheet_Activate()
Dim i As Long

Cells.Select
Selection.Delete Shift:=xlUp       'Clear Worksheet
Range("A1").Select

SetInitialValues

For i = 4 To lngNumberOfSteps
RefreshRegs i
Cells(i, 7) = GetRegSum(i)
Cells(i, 8) = GetRndOfSum(i)
Cells(i, 9) = GetDiceNumber(i)
RefreshHits i
Next i
End Sub

Private Sub SetInitialValues()

Cells(1, 1) = "Biased Dice"

' Registers associated with the Dice numbers 1...6
Cells(2, 1) = "Reg1"
Cells(2, 2) = "Reg2"
Cells(2, 3) = "Reg3"
Cells(2, 4) = "Reg4"
Cells(2, 5) = "Reg5"
Cells(2, 6) = "Reg6"

' Sum of the previous six cells
Cells(2, 7) = "RegSum"

' Random value from 1 to previous cell value
Cells(2, 8) = "RndOfSum"

' Dice number that was hitted
Cells(2, 9) = "Dice"

' Numbers of hitts of the Dice numbers 1...6
Cells(2, 10) = "HitsD1"
Cells(2, 11) = "HitsD2"
Cells(2, 12) = "HitsD3"
Cells(2, 13) = "HitsD4"
Cells(2, 14) = "HitsD5"
Cells(2, 15) = "HitsD6"

' Place init values
Cells(3, 1) = lngReg1InitValue
Cells(3, 2) = lngReg2InitValue
Cells(3, 3) = lngReg3InitValue
Cells(3, 4) = lngReg4InitValue
Cells(3, 5) = lngReg5InitValue
Cells(3, 6) = lngReg6InitValue

Cells(3, 7) = GetRegSum(3)
Cells(3, 8) = GetRndOfSum(3)
Cells(3, 9) = GetDiceNumber(3)

RefreshHits 3
End Sub

Private Function GetRegSum( _
lngRow As Long) As Long
Dim i As Long
For i = 1 To 6
GetRegSum = GetRegSum + Cells(lngRow, i)
Next i
End Function

Private Function GetRndOfSum( _
lngRow As Long) As Long
GetRndOfSum = Int(Rnd * Cells(lngRow, 7)) + 1
End Function

Private Function GetDiceNumber( _
lngRow As Long) As Long
Dim i As Long, lngTmpSum As Long

For i = 1 To 6
lngTmpSum = lngTmpSum + Cells(lngRow, i)
If lngTmpSum >= Cells(lngRow, 8) Then
GetDiceNumber = i
Exit Function
End If
Next i
End Function

Private Sub RefreshRegs(lngRow As Long)
Dim i As Long

For i = 1 To 6
If i = Cells(lngRow - 1, 9) Then
Cells(lngRow, i) = Cells(lngLastNonDiscardedRow, i) - 5
Else
Cells(lngRow, i) = Cells(lngLastNonDiscardedRow, i) + 1
End If
Next i
End Sub

lngRow As Long)
Dim i As Long

For i = 1 To 6
If Cells(lngRow, i) < 1 Or Cells(lngRow, i) > lngRegMaxValue Then
Rows(lngRow).Interior.ColorIndex = 15
Cells(lngRow, i).Font.ColorIndex = 2
Cells(lngRow, i).Interior.ColorIndex = 3
Exit Sub
End If
Next i
End Sub

Private Sub RefreshHits(lngRow As Long)
Dim i As Long

For i = 1 To 6
Cells(lngRow, 9 + i) = Val(Cells(lngLastNonDiscardedRow, 9 + i))
Next i

Cells(lngRow, 9 + Val(Cells(lngRow - 1, 9))) = _
Cells(lngRow, 9 + Val(Cells(lngRow - 1, 9))) + 1
End Sub

'
'
'

--
http://www.piclist.com hint: To leave the PICList
piclist-unsubscribe-requestmitvma.mit.edu

<000201c24782\$9a546d20\$62c6fea9@crimea.com> 7bit