Re: Actual Lottery Stuff. WOW eh?

"Abraxas" <dontbother@xxxxxxxxxx> wrote:
"Michael Harrington" <mikharr@xxxxxxxxxxx> wrote
"Abraxas" <dontbother@xxxxxxxxxx> wrote
"Michael Harrington" <mikharr@xxxxxxxxxxx> wrote


This generates and stores 1,000,000 quick picks with
no duplicates. It then prints the first 30 to screen
converting index numbers into actual 6/49 lotto tickets.
Takes about 6 seconds on my machine.

Private Sub Command1_Click()


Dim Barrel(1 To 13983816) As Long, i As Long
Dim j As Long, pick As Long, drawn As Long
Dim a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, iter As Long
Dim Chosen(1 To 13983816) As Boolean



For i = 1 To 13983816
Barrel(i) = i

Next i

For j = 13983816 To 1283816 Step -1 ' we can lower this as
desired
drawn = Int(Rnd * j) + 1
pick = Barrel(drawn)
Barrel(drawn) = Barrel(j)
Barrel(j) = pick
Chosen(pick) = True
'Print pick

Next j

i = 0
For a = 1 To 44
For b = a + 1 To 45
For c = b + 1 To 46
For d = c + 1 To 47
For e = d + 1 To 48
For f = e + 1 To 49
i = i + 1
If Chosen(i) = True And iter < 30 Then
Print a, b, c, d, e, f
iter = iter + 1
End If

Next f, e, d, c, b, a

Print i 'check for 13983816

End Sub


Thanks again Michael. I incorporated much of your code into
some existing code of my own...with a few modifications here &
there. Result? A pretty handy little app that will generate
any quantity of random lines requested by the user (with no
duplicates--verified!) and save them to a text file. Pretty
darn quick too...over 11,000 lines a second on my machine.
Producing the fabled 9,841,209 random lines takes a little
over 14 minutes. (3 ghz cpu, 1 gig RAM, XP)

I thought that all sounded like lots of fun, so I wrote
a program which does the same thing using a different method.
It generates all the combinations serially and decides whether
to use each one by comparing a random number to the proportion
needed to fulfill the sample size in the remaining ones.
My machine is slower (2.7Ghz, I think), my program is
generalized to do any single-barrel game, and I run it in
the environment instead of making an executable, so maybe
that's why it takes longer to do 9,841,209 random lines
with a guarantee of no duplicates--
it takes 187 sec ....oops...you said minutes... never mind that.

I have a suggestion. I believe a lot of time is wasted by
using the text file statements. (Not to mention those ugly
for..next things.) Creating a record with CR/LF and using
the put statement with a binary file gives the same result.

Here's the whole form file in case you care <yuk yuk>...
Ignore the thing that selects combinations by
generating a normally distributed variable, because it
isn't likely to work for a sample bigger than half the total.
Calls to function nextselection and the test of
its return value are commented out.

I don't know why it says VERSION 5.00. I'm using VB6
in Visual Studio.

VERSION 5.00
Begin VB.Form frmSample
Caption = "pick yer sample"
ClientHeight = 3255
ClientLeft = 60
ClientTop = 450
ClientWidth = 4035
LinkTopic = "Form2"
ScaleHeight = 3255
ScaleWidth = 4035
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtSampSize
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1425
TabIndex = 14
Text = "1000000"
Top = 960
Width = 1185
End
Begin VB.CommandButton cmdSample
Caption = "Do It"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2880
TabIndex = 12
Top = 1920
Width = 1080
End
Begin VB.TextBox txtOutOf
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 1860
TabIndex = 3
Text = "49"
Top = 375
Width = 435
End
Begin VB.TextBox txtChoose
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 735
TabIndex = 2
Text = "6"
Top = 375
Width = 405
End
Begin VB.TextBox txtOutFile
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1425
TabIndex = 0
Text = "c:\stuff\combsamp.dat"
Top = 1365
Width = 2520
End
Begin VB.Label lblCombs
BorderStyle = 1 'Fixed Single
Height = 345
Left = 2370
TabIndex = 15
Top = 375
Width = 1620
End
Begin VB.Label Label8
Caption = "Sample size"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 120
TabIndex = 13
Top = 960
Width = 1350
End
Begin VB.Label lblElapsed
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 390
Left = 2520
TabIndex = 11
Top = 2805
Width = 1455
End
Begin VB.Label Label4
Caption = "Elapsed time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1110
TabIndex = 10
Top = 2835
Width = 1410
End
Begin VB.Label Label6
Caption = "selected"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1575
TabIndex = 9
Top = 2235
Width = 1050
End
Begin VB.Label lblSelected
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 120
TabIndex = 8
Top = 2265
Width = 1380
End
Begin VB.Label Label5
Caption = "generated"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1560
TabIndex = 7
Top = 1815
Width = 1215
End
Begin VB.Label lblProgress
BorderStyle = 1 'Fixed Single
Caption = "175999999"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 6
Top = 1815
Width = 1395
End
Begin VB.Label Label3
Caption = "Out of"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1230
TabIndex = 5
Top = 420
Width = 630
End
Begin VB.Label Label2
Caption = "Pick"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 4
Top = 420
Width = 480
End
Begin VB.Label Label1
Caption = "Output File"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 105
TabIndex = 1
Top = 1410
Width = 1185
End
End
Attribute VB_Name = "frmSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdSample_Click()
Dim lngChoose As Long 'balls picked
Dim lngOutOf As Long 'balls in game
'Number of combinations
Dim dblSample As Double '... to select
Dim dblCombs As Double '...in game
Dim dblTried As Double '...generated so far in loop
Dim dblUsed As Double '...selected
Dim dblNotTried As Double '...remaining to be generated
Dim dblWanted As Double '...needed to complete sample
Dim dblNextOut As Double '...serial of next one to be selected
Dim lngProgress As Long '...number generated since last status report
Dim strOutfile As String 'File name from text box
Dim intOutfile As Integer
Dim strComb As String 'Output record
Dim intRecLen As Integer ' its size
Dim dblRecordPlace As Double 'file position for next record
Dim combo() As Long 'the generated combination
Dim dblStartTime As Double 'time this sucker for the hell of it
Dim dblProb As Double 'a random number compared to needed/left
Dim dblYesNo As Double 'needed/left, -1 after needed=0

lngChoose = Val(txtChoose.Text)
lngOutOf = Val(txtOutOf.Text)
dblSample = Val(txtSampSize.Text)
dblCombs = calc(lngChoose, lngOutOf) 'find size of universe
lblCombs.Caption = dblCombs

dblNotTried = dblCombs 'decrement in loop
dblWanted = dblSample

strOutfile = txtOutFile.Text
If Dir(strOutfile) <> "" Then
Kill strOutfile
End If
intOutfile = FreeFile
Open strOutfile For Binary As intOutfile
intRecLen = 3 * lngChoose + 1

strComb = Space$(intRecLen)
Mid$(strComb, intRecLen - 1, 1) = Chr(13)
Mid$(strComb, intRecLen, 1) = Chr$(10)
Randomize

' decide which combination to select first
'dblNextOut = nextselection(dblNotTried, dblWanted, dblTried)
' use that to select a combination by normal distribution

dblStartTime = Timer
dblRecordPlace = 1

Do While dblNotTried > 0
dblTried = getnextcomb(combo(), lngOutOf, lngChoose)
lngProgress = lngProgress + 1
If lngProgress = 1000 Then
lngProgress = 0
lblProgress.Caption = dblTried
lblSelected.Caption = dblUsed
DoEvents
End If
dblNotTried = dblNotTried - 1
dblProb = Rnd
If dblWanted = 0 Then
dblYesNo = -1 'got all we want; make sure no more get out
Else
dblYesNo = dblWanted / dblNotTried 'proportion needed from here on
End If
If dblProb <= dblYesNo Then
' comment that one if using normal distribution
'If dblTried = dblNextOut Then
' that uses record selected by normal distribution
'
dblUsed = dblUsed + 1
For j = 1 To lngChoose
Mid$(strComb, 3 * j - 2, 2) = Right$(Str$(100 + combo(j)), 2)
Next j
Put #intOutfile, dblRecordPlace, strComb
dblRecordPlace = dblRecordPlace + intRecLen
dblWanted = dblWanted - 1
'dblNextOut = nextselection(dblNotTried, dblWanted, dblTried)
' use that if selecting by normal distribution
End If
Loop

Close intOutfile
lblElapsed.Caption = Int(Timer - dblStartTime + 0.5)
lblProgress.Caption = dblTried
lblSelected.Caption = dblUsed

End Sub

Function nextselection(available As Double, needed As Double, tried As Double) As Double
'available: number of combinations yet to be generated
'needed: number of combinations still wanted for sample
'tried: current record number

'this generates a normally distributed random variable
'with mean=1, multiplies it by the average number of
'combinations needed between selections in the remaining
'combinations, and adds that to current count.
'(example: we need every 14th record for 1000000 out of 13983816
' the adder can be 0 (changed to 1) through 27. This many combs
' less 1 will be bypassed to get to the next one we want.
Dim k As Long
Dim dblRand As Double 'sum of 12 rnd returns
Dim dblSelected As Double 'next record to use

If needed = 0 Then
nextselection = tried + available + 1
Exit Function
End If

For k = 1 To 12
dblRand = dblRand + Rnd
Next k

adder = Int((dblRand / 6) * (available / needed) + 0.5)
If adder = 0 Then
adder = 1 'we already used the current combination
End If
dblSelected = tried + adder

If dblSelected > tried + available Then
' selected combo doesn't exist; try again
dblSelected = nextselection(available, needed, tried)
End If
nextselection = dblSelected
End Function
Function getnextcomb(intSet() As Long, outof As Long, Take As Long) As Long
'intset(): the generated combination
'outof: highest number in game
'take: number drawn

'This function generates the next combination
'It has to run to the last combination before a restart.
' (to change that, put statics in module level
' and write a function to set started=false,
' or make started an argument.)
Static where As Integer
Static started As Boolean
Static combs As Long
Dim i As Integer
Dim current As Integer

'set up first combination: e.g., 1,2,3,4,5,5 (yes, 5,5)
'set position index to last one, i.e., the second 5
'initialize counter
If started <> True Then
started = True
ReDim intSet(Take)
For i = 1 To Take - 1
intSet(i) = i
Next i
intSet(Take) = Take - 1
where = Take
combs = 0
End If

'variable where: by example...
'initial comb is 1,2,3,4,5,5 where is 6
'loop adds 1 to sixth one until it hits 50,
'at 50, four times through loop
' where =5, comb is 1,2,3,4,5,49, not output
' comb changes to 1,2,3,4,6,49 not output, where=6
' comb goes to 1,2,3,4,6,6 not output
' comb goes to 1,2,3,4,6,7, output
'later...after 1,2,3,4,48,49, where=5,where=4, comb 1,2,3,5,48,49,
' then 1,2,3,5,5,49, then 1,2,3,5,6,49, then 1,2,3,5,6,6,
' then 1,2,3,5,6,7 returned
'
Do
current = intSet(where) + 1 'increase one of the numbers
If current > outof - where + Take Then
where = where - 1
Else
intSet(where) = current
If where = Take Then
combs = combs + 1
getnextcomb = combs
Exit Function
Else
where = where + 1
intSet(where) = current
End If
End If
If where = 0 Then
getnextcomb = 0
started = False
Exit Function
End If
Loop
End Function

Function calc(pick As Long, outof As Long) As Double
Dim N As Double
Dim choose As Double
Dim i As Double
Dim logs1 As Double
Dim logs2 As Double

logs2 = 0
logs1 = 0
N = outof
choose = pick

For i = 1 To choose
logs1 = logs1 + Log(i)
Next i
For i = N - choose + 1 To N
logs2 = logs2 + Log(i)
Next i
calc = Int(Exp(logs2 - logs1) + 0.5)

End Function

.