Coverage of a List of Lotto Tickets

[Paul Black]

Hi,

I found this Code the Other Day and thought I would give it a go.
Unfortunately, after it had Run, it Produced No Information at All (
Just a Blank Screen ). I also Tried Running it with "num = 14" (
Without the Quotes ) and Still got Nothing.
I Wonder if Anyone can Help Please.

All the Best
Paul



Message 2 in thread
From: Tom Ogilvy
Subject: Re: Coverage of a list of Lotto tickets


View this article only
Newsgroups: microsoft.public.excel.programming
Date: 2001-02-03 09:11:32 PST


Here is a brute force approach that took about 13 minutes on a Celeron
300
This didn't write the combinations, but could easily be adpated to do
that
(of course then you are talking a major increase in time).

Sub GenNumbers()
Dim start As Double
start = Timer
Dim lngCount(0 To 6) As Long
varray = Array(1, 2, 5, 6, 7, 9)
Dim r As Long
num = 49
For i = 1 To num - 5
For j = i + 1 To num - 4
For k = j + 1 To num - 3
For l = k + 1 To num - 2
For m = l + 1 To num - 1
For n = m + 1 To num
r = r + 1
If True Then
icnt = 0
For s = 0 To 5
If i = varray(s) Then icnt = icnt + 1
If j = varray(s) Then icnt = icnt + 1
If k = varray(s) Then icnt = icnt + 1
If l = varray(s) Then icnt = icnt + 1
If m = varray(s) Then icnt = icnt + 1
If n = varray(s) Then icnt = icnt + 1
Next
lngCount(icnt) = lngCount(icnt) + 1
End If
Next
Next
Next
Next
Next
Next
Debug.Print r
lngsum = 0
For s = 0 To 6
If s >= 3 Then lngsum = lngsum + lngCount(s)
Debug.Print s & " Matches: " & lngCount(s)
Next
Debug.Print "At least 3 matches " & lngsum
Debug.Print (Timer - start) / 60 & " minutes"
End Sub


Produced
13983816
0 Matches: 6096454
1 Matches: 5775588
2 Matches: 1851150
3 Matches: 246820
4 Matches: 13545
5 Matches: 258
6 Matches: 1
At least 3 matches 260624
12.3773151041667 minutes

Regards,
Tom Ogilvy

 

[Tom Ogilvy]

It produces output to the immediate window. You have to go into the VBE to
see it (Alt + F11), then under the View menu, select immediate window.

 

[Paul Black]

Brilliant Tom, Thanks Very Much.

All the Best
Paul

 

[paul_black27]

Hi Tom,

Is it Possible to Adapt the Macro to Include Five and the Bonus Total
Please.
I have Tried Setting up Another Variable and then Using num - 6 But to
NO Avail.
Out of Interest, why are the Values in varray = Array(1, 2, 5, 6, 7, 9)
these, can they not be 1,2,3,4,5 & 6.

Thanks in Advance.
Have a Good Weekend.
All the Best
Paul

 

[Tom Ogilvy]

Array(1,2,3,4,5,6) is the number to be checked. It can be any 6 digit
number that conforms to a valid lottery number as the results would be the
same for each valid number. First five listed are the 5 non-repeatable
numbers and the last is the bonus number.

Set the number of valid numbers for the 5 first numbers and the bonus number

num =
num1 = ' bonus number

This took about 20 minutes to run on a fast machine (set up for the
MegaMillions - first 5 is out of 52 and bonus number is out of 52). Not
sure what you want it for - as you can probably solve for the answers it
gives using combinatorial concepts/formulas. It does generate the actual
numbers that match, but it doesnt' record them anywhere. You could modify
it to do that, but it would take even longer to run.

+ 1 means the bonus number was matched
+ 0 means the bonus number was not matched.


Sub GenNumbers()
Dim start As Double
start = Timer
Dim lngCount(0 To 5, 0 To 1) As Long
' Number to be checked
varray = Array(1, 2, 3, 4, 5, 6)
Dim r As Long
num = 52 ' largest number for first 5
num1 = 52 ' largest number for bonus number
For i = 1 To num - 4
For j = i + 1 To num - 3
For k = j + 1 To num - 2
For l = k + 1 To num - 1
For m = l + 1 To num - 0
For n = 1 To num1
r = r + 1
If True Then
icnt = 0
For s = 0 To 4
If i = varray(s) Then icnt = icnt + 1
If j = varray(s) Then icnt = icnt + 1
If k = varray(s) Then icnt = icnt + 1
If l = varray(s) Then icnt = icnt + 1
If m = varray(s) Then icnt = icnt + 1
Next
If n <> varray(s) Then
lngCount(icnt, 0) = lngCount(icnt, 0) + 1
Else
lngCount(icnt, 1) = lngCount(icnt, 1) + 1
End If
End If
Next
Next
Next
Next
Next
Next
Debug.Print "Total possibilities: " & r
lngsum = 0
For s = 5 To 0 Step -1
Debug.Print s & " + 1 " & lngCount(s, 1)
Debug.Print s & " + 0 " & lngCount(s, 0)
Next

Debug.Print (Timer - start) / 60 & " minutes"
End Sub

 

[paul_black27]

Thanks Very Much Tom,

I am Trying to Teach myself VBA, and thought that this would be a good
Exercise to see how Information can be Manipulated.
The First Macro has Everything that I Want Except it Doesn't Include
Five and the Bonus. The Bonus is NOT Relevant for Any of the Other
Numbers.
I will Use the Two Macros Listed and Try to Create One Macro that will
Produce Exactly the Same Results as the First Macro But with Five and
the Bonus Included.

Thanks Again Tom.
All the Best
Paul

 

[Tom Ogilvy]

I understand you want to check the matches for the first five numbers and
ignore the 6th or bonus number. then
Here is an answer if you want to check your work.











Sub GenNumbers()
Dim start As Double
start = Timer
Dim lngCount(0 To 6) As Long
varray = Array(1, 2, 3, 4, 5, 6)
Dim r As Long
num = 49
' For i = 1 To num - 5
For j = i + 1 To num - 4
For k = j + 1 To num - 3
For l = k + 1 To num - 2
For m = l + 1 To num - 1
For n = m + 1 To num
r = r + 1
If True Then
icnt = 0
For s = 0 To 4 '5
' If i = varray(s) Then icnt = icnt + 1
If j = varray(s) Then icnt = icnt + 1
If k = varray(s) Then icnt = icnt + 1
If l = varray(s) Then icnt = icnt + 1
If m = varray(s) Then icnt = icnt + 1
If n = varray(s) Then icnt = icnt + 1
Next
lngCount(icnt) = lngCount(icnt) + 1
End If
Next
Next
Next
Next
Next
' Next
Debug.Print r
lngsum = 0
For s = 0 To 6
If s >= 3 Then lngsum = lngsum + lngCount(s)
Debug.Print s & " Matches: " & lngCount(s)
Next
Debug.Print "At least 3 matches " & lngsum
Debug.Print (Timer - start) / 60 & " minutes"
End Sub

1906884
0 Matches: 1086008
1 Matches: 678755
2 Matches: 132440
3 Matches: 9460
4 Matches: 220
5 Matches: 1
6 Matches: 0
At least 3 matches 9681
0.176640624999952 minutes

 

[paul_black27]

Hi Tom,

Thanks for the Reply.
I Don't think I Explained Clearly Enough what I am Hoping to Achieve.
I think if this Exercise can be Achieved, it will make it a Lot Clearer
for me to Understand the Concepts of Number Manipulation Within Code.
The Results Should be for a 6 from 49 with One Bonus Number Drawn which
is ONLY Relevant for the Match 5 :-

0 Matches ( NO Bonus ) Totals = 6,096,454
1 Matches ( NO Bonus ) Totals = 5,775,588
2 Matches ( NO Bonus ) Totals = 1,851,150
3 Matches ( NO Bonus ) Totals = 246,820
4 Matches ( NO Bonus ) Totals = 13,545
5 Matches ( NO Bonus ) Totals = 252
5 + The Bonus Number Totals = 6
6 Matches ( NO Bonus ) Totals = 1
Total = 13,983,816

Thanks for ALL your Help and Time.
All the Best
Paul

 

[Tom Ogilvy]

If the bonus is just a 7th number drawn from the 49, then this builds the
results you show. A special condition requires special code.

Sub GenNumbers()
Dim start As Double
start = Timer
Dim lngCount(0 To 7) As Long
varray = Array(1, 2, 3, 4, 5, 6, 7)
Dim r As Long
num = 49
For i = 1 To num - 5
For j = i + 1 To num - 4
For k = j + 1 To num - 3
For l = k + 1 To num - 2
For m = l + 1 To num - 1
For n = m + 1 To num
r = r + 1
If True Then
icnt = 0
bBonus = False
For s = 0 To 6
If s <> 6 Then
If i = varray(s) Then icnt = icnt + 1
If j = varray(s) Then icnt = icnt + 1
If k = varray(s) Then icnt = icnt + 1
If l = varray(s) Then icnt = icnt + 1
If m = varray(s) Then icnt = icnt + 1
If n = varray(s) Then icnt = icnt + 1
Else
If i = varray(s) Or j = varray(s) Or _
k = varray(s) Or l = varray(s) Or _
m = varray(s) Or n = varray(s) Then
bBonus = True
End If
End If
Next
If icnt < 5 Then
lngCount(icnt) = lngCount(icnt) + 1
ElseIf icnt = 5 And Not bBonus Then
lngCount(icnt) = lngCount(icnt) + 1
ElseIf (icnt = 5 And bBonus) Or _
icnt = 6 Then
lngCount(icnt + 1) = lngCount(icnt + 1) + 1
End If
End If
Next
Next
Next
Next
Next
Next
Debug.Print r
lngsum = 0
For s = 0 To 7
If s >= 3 Then lngsum = lngsum + lngCount(s)
If s <= 5 Then
Debug.Print s & " Matches (no bonus): " & lngCount(s)
ElseIf s = 6 Then
Debug.Print s & " Matches (With bonus): " & lngCount(s)
Else
Debug.Print s - 1 & " Matches (no bonus): " & lngCount(s)
End If

Next
Debug.Print "At least 3 matches " & lngsum
Debug.Print (Timer - start) / 60 & " minutes"
End Sub

Produces:
13983816
0 Matches (no bonus): 6096454
1 Matches (no bonus): 5775588
2 Matches (no bonus): 1851150
3 Matches (no bonus): 246820
4 Matches (no bonus): 13545
5 Matches (no bonus): 252
6 Matches (With bonus): 6
6 Matches (no bonus): 1
At least 3 matches 260624
2.39019791666663 minutes

 

[paul_black27]

Hi Tom,

It Works like a Dream.

Thanks for ALL your Help and Time.
All the Best
Paul