piclist 2002\08\14\170439a >
Thread: Random sequence
www.piclist.com/techref/microchip/math/index.htm?key=random
picon face BY : Mike Singer email (remove spam text)

part 0 46 bytes
This is a multi-part message in MIME format.

part 1 4644 bytes content-type:text/plain; (decoded 7bit)

Brendan Moran wrote:
.
.
> Sounds like we basically had the same idea.
>
> >Brendan Moran wrote:
> > > Has anyone considered making normalized dice?
.
.

Brendan,
I've made just for fun a simple program in Excel XP
showing how my idea works. Attached file: Excel XP
book Russian version may not work with English Excel.
And there is a virus risk during transmission, so
I pasted code below. If someone is interested in 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).

       Mike.
----------------------



'   RE: [PIC] Random sequence
'   How to get randomly-biased dice number.
'
'   1. Associate six registers with six dice numbers.
'   2. Init them with lngRegMaxValue/2.
'   3. On each loop subtract 5 from  that register which
'      number was hit until it reached 0, of course.
'      And add 1 to other registers until they reached 255.
'   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 = 255
Private Const lngNumberOfSteps  As Long = 1000

Private Sub Worksheet_Activate()
  Dim i As Long

   Cells.Select
   Selection.ClearContents       '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"

 ' Register associated with the Dice number 1
 Cells(2, 1) = "Reg1"
 ' Register associated with the Dice number 2
 Cells(2, 2) = "Reg2"
 ' Register associated with the Dice number 3
 Cells(2, 3) = "Reg3"
 ' Register associated with the Dice number 4
 Cells(2, 4) = "Reg4"
 ' Register associated with the Dice number 5
 Cells(2, 5) = "Reg5"
 ' Register associated with the Dice number 6
 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"
 ' Number of hitts of the Dice number 1
 Cells(2, 10) = "HitsD1"
 ' Number of hitts of the Dice number 2
 Cells(2, 11) = "HitsD2"
 ' Number of hitts of the Dice number 3
 Cells(2, 12) = "HitsD3"
 ' Number of hitts of the Dice number 4
 Cells(2, 13) = "HitsD4"
 ' Number of hitts of the Dice number 5
 Cells(2, 14) = "HitsD5"
 ' Number of hitts of the Dice number 6
 Cells(2, 15) = "HitsD6"

 Cells(3, 1) = Int(lngRegMaxValue / 2) + 1
 Cells(3, 2) = Cells(3, 1)
 Cells(3, 3) = Cells(3, 1)
 Cells(3, 4) = Cells(3, 1)
 Cells(3, 5) = Cells(3, 1)
 Cells(3, 6) = Cells(3, 1)
 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(lngRow - 1, i) - 5
        If Cells(lngRow, i) < 0 Then Cells(lngRow, i) = 0
     Else
        Cells(lngRow, i) = Cells(lngRow - 1, i) + 1
        If Cells(lngRow, i) > lngRegMaxValue Then
           Cells(lngRow, i) = lngRegMaxValue
        End If
     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(lngRow - 1, 9 + i))
  Next i

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




part 2 12646 bytes content-type:application/x-compressed; (decode)

part 3 105 bytes
--
http://www.piclist.com hint: To leave the PICList
.....piclist-unsubscribe-requestspamspamSTOPspammitvma.mit.edu


<000001c243d5$c207eeb0$62c6fea9@crimea.com>

In reply to: <5.1.0.14.0.20020814014017.036a1cc8@shawmail.cg.shawcable.net>
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...