100 random lines coverage
Michael
verified yet!
Private Sub Command1_Click()
Dim TheLines(1 To 100, 1 To 49) As Boolean
Dim i As Long, j As Long, k As Long
Dim pick As Integer, clashes As Integer
Dim clashsums(0 To 6) As Integer
Dim hit As Integer, covered As Long
Dim t1 As Date, t2 As Date
Dim OverLapDeducts(0 To 6) As Long
'Each Line covers 260624 draws
'The Following are to be deducted if any two
'lines have 0,1,2,3,4,5,6 numbers in common
OverLapDeducts(0) = 400: OverLapDeducts(1) = 4100
OverLapDeducts(2) = 16716: OverLapDeducts(3) = 39544
OverLapDeducts(4) = 78584: OverLapDeducts(5) = 145824
OverLapDeducts(6) = 260624
'Load TheLines
For i = 1 To 100
hit = 0
Do Until hit = 6
pick = Int(Rnd * 49) + 1
If TheLines(i, pick) = False Then
hit = hit + 1
TheLines(i, pick) = True
End If
Loop
Next i
'Send 100 random lines to output
For i = 1 To 100
'Debug.Print
For j = 1 To 49
If TheLines(i, j) = True Then
'Debug.Print j;
End If
Next j, i
t1 = Timer
covered = 100 * 260624 'initialize
'Now every Line must be compared with
'all other Lines to find which numbers
'they may have in common. Then the
'OverLapDeducts can be applied
For i = 1 To 99
For j = i + 1 To 100
clashes = 0
For k = 1 To 49 'testing for clashes
If TheLines(i, k) = True And TheLines(j, k) = True Then
clashes = clashes + 1
End If
Next k
clashsums(clashes) = clashsums(clashes) + 1
Next j, i
'Now apply deductions
For i = 0 To 6
covered = covered - clashsums(i) * OverLapDeducts(i)
Next i
Print "covered =:"; covered, 100 * covered / 13983816; "%"
t2 = Timer
Print (t2 - t1) * 1000; " millisecs"
End Sub
Honest John
It won't work Michael, the more tickets you have, the more tangled it
becomes.
I tried it by working on the coverage of each triple, ie 1 2 3 covers
15,180 and working down from there but it all falls apart before long.
Thinking about it, if it did work then you'd be able to predict the
structure of any wheel by simple maths, and you can't.
Michael
"Honest John" <kestre...@ntlworld.com> wrote in message
news:1NGdnbtQd6t...@giganews.com...
John, not sure if we are on the same wavelength.
In no way is this small snippet supposed to be a full blown
covering program! During the last thread you said make my
code work for 2 lines. Well it now works for 100. You said
make it accept user input. Well I provided 100 random lines
for demonstration purposes. The user can easily replace these
with his own lines. I just needed to know if the results given
are correct and is the time taken competitive?
Cheers Mick.
Honest John
No, the results won't be correct. Been there and done that, I could have
been doing wrong of course or missing something simple ?
Michael
But have you run the code? Have you unremmed my "send to debug"
code and checked the 100 random against CoverMaster? For accuracy
and for speed?
Cheers Mick
Michael
"Michael" <mik...@bigpond.com> wrote in message
news:FLwMl.9251$y61....@news-server.bigpond.net.au...
Should get 100% coverage.
The above code does NOT work!
Back to the drawing board!
Cheers Mick.
Honest John
There's no need to, I can see it won't work, I tried that route myself.
John
Honest John
You may be barking up the right tree. It just got too complicated for me.
It's a bit like predicting gravitational paths, two objects no problem
but the more you throw in the mix the more they all interact and it just
gets ridiculously complicated !
John
ORiON
> Michael wrote:
>> "Michael" <mik...@bigpond.com> wrote in message
>> news:FLwMl.9251$y61....@news-server.bigpond.net.au...
>>> "Honest John" <kestre...@ntlworld.com> wrote in message
>>> and for speed?
>>>
>>> Cheers Mick
>>>
>> Just downloaded the 163 world record wheel.
>> Should get 100% coverage.
>> The above code does NOT work!
>> Back to the drawing board!
>> Cheers Mick.
>>
>
> You may be barking up the right tree. It just got too complicated for me.
>
> It's a bit like predicting gravitational paths, two objects no problem
> but the more you throw in the mix the more they all interact and it just
> gets ridiculously complicated !
>
> John
...for as long as you compare Unique Items this is perfect!
or an improved Inclusion-exclusion principle!
An algorithm already exists.
A Google search can prove that.
ORiON
Your effort is valiant!
Some help...
Web pages & eBooks on covering designs...
http://members.tripod.com/~POTM/LOTTERY/problem.short.html
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=70044&lngWId=1
http://lotterygambling.phpbbnow.com/viewtopic.php?t=303
Other:
http://www.dmoz.org/Science/Math/Combinatorics/Design_Theory/
Books:
http://books.google.com/books?id=g6LDYlJ36CgC&pg=PA401&source=gbs_selected_pages&cad=0_1#PPA324,M1
http://www.jjj.de/fxt/fxtbook.pdf <--- SPECIAL ATTENTION
The Tomes of Delphi: Algorithms and Data Structures
http://rapidshare.com/files/198370947/Algorithms_and_Data_1.zip
Data Structures And Algorithms Using Visual Basic .Net - Cambridge
University Press.
http://rapidshare.com/files/135716220/Data_Structures.rar.html
C++DataStructures
http://rapidshare.com/files/169177644/C__PlusDataStructures-www.warezwitch.com-.rar
Pass: www.warezwitch.com
Honest John
Can it calculate covering % without iterations ?
I had a gut feeling it could be done but couldn't see a simple way of
calculating. Sometimes you can't see the woods for trees :-)
John
Michael
"ORiON" <or...@cnn.com> wrote in message news:gtv2q5$9gi$3...@aioe.org...
Thanks Orion, for the links. I just downloaded the fxtbook.pdf.
Looks understandable at my level, at first glance.
Hard to get good help on set covering. Some kindly soul at
sci.op-research once offered to bring me up to speed on Tabu
Search. For a lazy $300 per hour over say 40 hours!
Cheers Mick.
Cheers Mick.
Michael
http://homepage.ntlworld.com/honest.john/
Time taken about 30 secs. Downside is, it takes the same time
for coverage provided by one line as it does for 163 lines.
Orion's links have convinced me to brush up on C# or C++
and switch to Bit Arrays for set covering. I'll repost if I get
a 100 times increase in speed.
Cheers Mick
Private Sub Command1_Click()
Dim TheLines(1 To 163, 1 To 6) As Long
Dim TriplesArray(1 To 47, 2 To 48, 3 To 49) As Boolean
Dim TheDraw(1 To 6) As Long
Dim i As Long, j As Long, k As Long
Dim a As Long, b As Long, c As Long
Dim d As Long, e As Long, f As Long
Dim pick As Long, lineno As Long
Dim matchfound As Boolean
Dim fileno As Long, sum As Long
Dim t1 As Date, t2 As Date
'XXXXXXXXXXXXX Load The Wheel XXXXXXXXXXXXXXXXXXXXXX
fileno = FreeFile
Open "C:\Documents and Settings\Michael\Desktop\Wheel.txt" For Input As
fileno
For i = 1 To 163
For j = 1 To 6
Input #1, pick
TheLines(i, j) = pick
Next j, i
Close #fileno
t1 = Timer
'XXXXXXXXXXXXX Load The TriplesArray XXXXXXXXXXXXXXXXXXXXXX
For lineno = 1 To 163 '
For i = 1 To 4
For j = i + 1 To 5
For k = j + 1 To 6
TriplesArray(TheLines(lineno, i), TheLines(lineno, j), _
TheLines(lineno, k)) = True
Next k, j, i, lineno
'XXX Cycle through and seek a triple for each draw XXXXXXXXXXXXXXXX
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
TheDraw(1) = a: TheDraw(2) = b: TheDraw(3) = c
TheDraw(4) = d: TheDraw(5) = e: TheDraw(6) = f
matchfound = False 'reset
For i = 1 To 4
If matchfound = True Then Exit For 'no need to
continue
For j = i + 1 To 5
For k = j + 1 To 6
If matchfound = True Then Exit For
If TriplesArray(TheDraw(i), TheDraw(j), TheDraw(k))
_
= True Then
matchfound = True
sum = sum + 1
End If
Next k, j, i
Next f, e, d, c, b, a
Print sum; " Covered"
t2 = Timer
Print (t2 - t1); " seconds"
End Sub
colin.fa...@gmail.com
> The following code verifies the record 163 line wheel found athttp://homepage.ntlworld.com/honest.john/
Michael
Many thanks for the code. I find it very interesting to see how
someone else goes about tackling the tasks in this area of interest -
not much if anything is published.
I got around to testing your code in VB 2008 or Dot Net, whatever, and
I believe you do yourself an injustice. On my old 1.8 Ghz desktop it
gallops along and crosses the line in 4 sec. On a faster 3 Ghz it
should do it in about 2.4 secs.
I thought I'd better put this up in case someone runs their code
before testing yours and uses your time as a reference.
I look forward to your success in getting it under the 1 sec mark. In
the meantime we'll just have to say all kudos to King John.
Regards
Colin Fairbrother
www.lottoposter.com
Honest John
You'll gain much time if you test the triples at first opportunity and
bail out on a hit, ie
For a = 1 To 44
For b = a + 1 To 45
For c = b + 1 To 46
If TriplesArray(A,B,C)// Continue with next c
Obviously no use if you want count how many hits but if you're just
checking for full coverage then that's the way to go.
ga...@justservices.com
>
> - Show quoted text -
Yeah, what John just said!
And if ya don't like it, just add another 1.
Kestrel rules! ;)
g
colin.fa...@gmail.com
>
> - Show quoted text -
That's it. Any further discussion and contributions by at least me on
this topic will be at http://groups.google.com/group/lottogroup/browse_thread/thread/554f01396f765b87
When serious work is mocked and belittled it's time to take stock.
Until now this thread and its predecessor have been relatively free of
spurious content. I'm not against free speech and a bit of rough and
tumble in use-net message boards but give over - there is a limit.
Just importing a cover file alone is full of traps with if a space is
used a combination of single or double spaces on a line not to mention
the variety of other delimiters that can be used.
Idiots just can't help being spoilers.
Colin
Honest John
gARY wasn't mocking anything, gARY was just being gARY, I think...
Honest John
I was asked to sign in when I clicked reply so I headed back here.
Colin said :
> When I try it instead of 13,983,816 I get 5,976,096.
> Regards
> Colin Fairbrother
That's because you're jumping out early, skipping the combinations that
are covered. It's trivial to fix, just subtract the uncovered
combinations form the total combinations once you're done.
You need to exit the other loops in a similar fashion as soon as you hit
a covered triple.
Michael
Takes just 1 second to verify the 163 line wheel now.
Would not take much longer for a 1000 lines.
private void button1_Click(object sender, EventArgs e)
{
int[,] TheLines = new int[164, 7]; //holds 164*7 elements
//the 0'th Line and all 0' th elements are un used
//See page 663 Peek() Read() ReadLine() ReadToEnd()
string path = @"C:\Documents and
Settings\Michael\Desktop\Wheel.txt";
StreamReader textIn =
new StreamReader(
new FileStream(path, FileMode.OpenOrCreate,
FileAccess.Read));
int idx = 1;
while (idx < 164)
//THERE ARE DOUBLE SPACES BETWEEN SOME NUMBERS IN .txt
{
string row = textIn.ReadLine();
//string[] columns = row.Split(' ',
StringSplitOptions.RemoveEmptyEntries);
row = row.Trim();
row = row.Replace(" ", " ");//get rid of double spaces
string[] columns = row.Split(' ');//redeclare in case size
changes
for (int j = 1; j < 7; j++)
TheLines[idx, j] = Convert.ToInt32(columns[j - 1]);
idx++;
}
textIn.Close();
textIn.Dispose();//Good practice
DateTime beginTime = DateTime.Now;//start timer
Boolean[,,] TriplesArray = new Boolean[50,50,50];
//XXXXXXXXXXXXX Load The TriplesArray XXXXXXXXX
for (int lineno = 1; lineno < 164; lineno++) //43C3 * 6C3
for (int i = 1; i < 5; i++)
for (int j = i+1; j< 6; j++)
for (int k = j + 1; k < 7; k++)
{
TriplesArray[TheLines[lineno, i],
TheLines[lineno, j],
TheLines[lineno, k]] = true;
}
int ct =0;
//XXX Cycle through and seek a triple for each draw XXXXX
for (int i = 1; i < 45; i++)
for (int j = i + 1; j < 46; j++)
for (int k = j + 1; k < 47; k++)
for (int l = k + 1; l < 48; l++)
for (int m = l + 1; m < 49; m++)
for (int n = m + 1; n < 50; n++)
{
if (TriplesArray[i, j, k]) continue;
if (TriplesArray[i, j, l]) continue;
if (TriplesArray[i, j, m]) continue;
if (TriplesArray[i, j, n]) continue;
if (TriplesArray[i, k, l]) continue;
if (TriplesArray[i, k, m]) continue;
if (TriplesArray[i, k, n]) continue;
if (TriplesArray[i, l, m]) continue;
if (TriplesArray[i, l, n]) continue;
if (TriplesArray[i, m, n]) continue;
if (TriplesArray[j, k, l]) continue;
if (TriplesArray[j, k, m]) continue;
if (TriplesArray[j, k, n]) continue;
if (TriplesArray[j, l, m]) continue;
if (TriplesArray[j, l, n]) continue;
if (TriplesArray[j, m, n]) continue;
if (TriplesArray[k, l, m]) continue;
if (TriplesArray[k, l, n]) continue;
if (TriplesArray[k, m, n]) continue;
if (TriplesArray[l, m, n]) continue;
ct++;
}
Console.WriteLine(ct + " uncovered");
DateTime endTime = DateTime.Now;
Console.WriteLine(endTime - beginTime + " seconds");
}
Honest John
Don't have the line :
if (TriplesArray[i, j, k]) continue;
inside the n loop, you can test this within the k loop and 'continue'
with k if you get a hit.
Likewise for others. The only tests you want in the n loop are the ones
that involve n :
if (TriplesArray[i, j, n]) continue;
if (TriplesArray[i, k, n]) continue;
if (TriplesArray[i, l, n]) continue;
if (TriplesArray[i, m, n]) continue;
if (TriplesArray[j, k, n]) continue;
if (TriplesArray[j, l, n]) continue;
if (TriplesArray[j, m, n]) continue;
if (TriplesArray[k, l, n]) continue;
if (TriplesArray[k, m, n]) continue;
if (TriplesArray[l, m, n]) continue;
The other ten triples can be tested earlier.
Michael
Thanks John. 0.25 seconds to check the 163 line
wheel now. I notice, paradoxically ( on the surface )
that it takes longer to check 1 line than the entire 163.
Cheers Mick.
int idx = 1;
idx++;
}
textIn.Close();
textIn.Dispose();//Good practice
//XXXXXXXXXXXXX Load The TriplesArray XXXXXXXXXXXXXXXXXXXXXX
for (int lineno = 1; lineno < 164; lineno++) //43C3 * 6C3
for (int i = 1; i < 5; i++)
for (int j = i + 1; j < 6; j++)
for (int k = j + 1; k < 7; k++)
{
TriplesArray[TheLines[lineno, i],
TheLines[lineno, j],
TheLines[lineno, k]] = true;
}
int ct = 0;
//XXX Cycle through and seek a triple for each draw XXXXX
for (int i = 1; i < 45; i++)
{
for (int j = i + 1; j < 46; j++)
{
for (int k = j + 1; k < 47; k++)
{
if (TriplesArray[i, j, k]) continue;
for (int l = k + 1; l < 48; l++)
{
if (TriplesArray[i, j, l]) continue;
if (TriplesArray[i, k, l]) continue;
if (TriplesArray[j, k, l]) continue;
for (int m = l + 1; m < 49; m++)
{
if (TriplesArray[i, j, m]) continue;
if (TriplesArray[i, k, m]) continue;
if (TriplesArray[i, l, m]) continue;
if (TriplesArray[j, k, m]) continue;
if (TriplesArray[j, l, m]) continue;
if (TriplesArray[k, l, m]) continue;
for (int n = m + 1; n < 50; n++)
{
if (TriplesArray[i, j, n]) continue;
if (TriplesArray[i, k, n]) continue;
if (TriplesArray[i, l, n]) continue;
if (TriplesArray[i, m, n]) continue;
if (TriplesArray[j, k, n]) continue;
if (TriplesArray[j, l, n]) continue;
if (TriplesArray[j, m, n]) continue;
if (TriplesArray[k, l, n]) continue;
if (TriplesArray[k, m, n]) continue;
if (TriplesArray[l, m, n]) continue;
ct++;
Honest John
The more triples covered, the quicker the test. One thing I didn't do
with CM is try sorting the wheel (or the triples therein) for an optimum
test time. Obviously the more times you hit a triple on the k loop, the
quicker you're all done.