piclist 2002\08\19\091223a >
Thread: Random sequence
www.piclist.com/techref/microchip/math/index.htm?key=random
picon face 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
and then return to this one). Folks I really need
your feedback(I like hotter :-)
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 -
'       discard this cast (shadow this row in the Excel sheet).
'   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 lngLastNonDiscardedRow As Long

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
     DiscardRowIfBeyondTheBounds (i)
   Next i
End Sub

Private Sub SetInitialValues()

 lngLastNonDiscardedRow = 3

 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

Private Sub DiscardRowIfBeyondTheBounds( _
  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
        Cells(lngRow, 16) = "Discarded"
        Exit Sub
     End If
  Next i
  lngLastNonDiscardedRow = lngRow
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-requestRemoveMEspamspamBeGonemitvma.mit.edu


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

In reply to: <021201c2447f$9877f950$199f42d8@czhang>
See also: www.piclist.com/techref/microchip/math/index.htm?key=random
Reply You must be a member of the piclist mailing list (not only a www.piclist.com member) to post to the piclist. This form requires JavaScript and a browser/email client that can handle form mailto: posts.
Subject (change) Random sequence

month overview.

new search...