piclist 2002\08\14\170439a >
www.piclist.com/techref/microchip/math/index.htm?key=random
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

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-requestmitvma.mit.edu

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