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
--
Regards,
Tom Ogilvy
wrote in message
ups.com...
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 wrote:
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
--
Regards,
Tom Ogilvy
wrote in message
oups.com...
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
Paul Black wrote:
Brilliant Tom, Thanks Very Much.
All the Best
Paul
"Tom Ogilvy" wrote in message
...
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.
--
Regards,
Tom Ogilvy
"Paul Black" wrote in message
. ..
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: 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
wrote in message
...
Hi all,
When we play a lotto ticket, for a 6/49 game
this ticket covers "at least 3" chances,
for 6 if 6 = (6c6)*(43c0)=1*1= 1
for 5 if 6 = (6c5)*(43c1)=6*43= 258
for 4 if 6 = (6c4)*(43c2)=15*903= 13,545
for 3 if 6 = (6c3)*(43c3)=20*12341= 246,820
-----------------------------------------------
For a total of 260,624 combinations
from the population of 49c6= 13,983,816 combinations.
My question is:
How can I calculate the coverage for a list of tickets?
I imagine some use of a "dynamic programming table"
of the binomial coefficients shall do the job
but I'm not that familiar with such a process.
Any help for the construction of the above function
will be greatly appreciated.
Kind regards
MrQ
Sent via Deja.com
http://www.deja.com/