Ok, I can't provide all the necessary source code to make the tables. Problem is my iterative process of design. I used my old hand evaluator to process results to create my new one. And the code to make old evalutor is burried in old builds, and is an extremely confusing network of functions. That being said...i'll show u the design process I used. If you have access to any sort of 7 card evaluator, u can sub that for mine, and it may work (u may have to adjust for how card numbers & suits are represnted).
Private Sub Create_tables()
'this is the main function to create all the tables
Dim table1(7314320), table1A(7314320), table2(), table2A(), table2B() As Int32
Dim table3(), table3A(), table3B(), table4(), table4A() As Int32
Dim HR() As Int32
Call Table1_SP(table1A) 'Table1_Starting Points
'New arrays are initalized big, then redimmed to size needed
table2A = New Int32(10000000) {}
Call Table2_UI(table2A) 'Table2_Unique Indexes
table3A = New Int32(10000000) {}
Call Table3_UI(table3A) 'Table2_Unique Index)es
'Finds starting position in table in table 2A*52 = SP in table 2
Table1_main(table1A, table2A, table1)
table2B = New Int32(table2A.GetUpperBound(0) * 52 + 52) {}
Table2_UI_Four_to_five(table2A, table2B)
table2 = New Int32(table2B.GetUpperBound(0)) {}
Table2_Main(table2, table2B, table3A)
table3B = New Int32(table3A.GetUpperBound(0) * 52 + 52) {}
Table3_UI_five_to_six(table3A, table3B)
table4A = New Int32(10000000) {}
Call Table4A_UI(table3B, table4A)
table3 = New Int32(table3B.GetUpperBound(0)) {}
Table3_Main(table3, table3B, table4A)
table4 = New Int32(table4A.GetUpperBound(0) * 52 + 52) {}
Table4_main(table4, table4A)
HR = New Int32() {}
Call supertable(HR, table1, table2, table3, table4)
End Sub
Private Sub Table1_SP(ByRef table1A() As Int32)
Dim c1, c2, c3, c4 As Int32 'counters
Dim Index As Int32
Dim OC(3) As Int32
For c1 = 0 To table1A.GetUpperBound(0)
table1A(c1) = -1
Next c1
For c1 = 1 To 52
For c2 = 1 To 52
For c3 = 1 To 52
For c4 = 1 To 52
Select Case c1
Case c2, c3, c4
Continue For
End Select
Select Case c2
Case c3, c4
Continue For
End Select
Select Case c3
Case c4
Continue For
End Select
Index = c1 * 140660 - c2 * 2704 + c3 * 52 - c4
table1A(Index) = FourCard_Lexograph(New Int32() {c1, c2, c3, c4})
Next c4
Next c3
Next c2
Next c1
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table1A.bin", OpenMode.Binary)
FilePut(7, table1A, 1)
FileClose(7)
End Sub
Private Sub Table1_main(ByRef table1A() As Int32, ByRef table2A() As Int32, ByRef Table1() As Int32)
Dim c1 As Int32
Dim length As Int32
Dim value As Int32
For c1 = 0 To Table1.GetUpperBound(0)
Table1(c1) = -1
Next
'put starting point into table 1
'Link 4 card UIs in table1 and table2, with table 2's index
length = table2A.GetUpperBound(0)
For c1 = 0 To table1A.GetUpperBound(0)
value = table1A(c1)
If value = -1 Then Continue For
Table1(c1) = Search_Array(table2A, length, value) * 52
Next c1
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table1.bin", OpenMode.Binary)
FilePut(7, Table1, 1)
FileClose(7)
End Sub
Private Sub Table2_UI(ByRef Table2A() As Int32)
Dim c1, c2, c3, c4, c5 As Int32 'counters
Dim value As Int32
'''''''' Code to make table 2A (unique Indexes) ''''''''
''' Generate all four card UIs
For c1 = 0 To Table2A.GetUpperBound(0)
Table2A(c1) = -1
Next c1
For c1 = 1 To 49
For c2 = c1 + 1 To 50
For c3 = c2 + 1 To 51
For c4 = c3 + 1 To 52
value = FourCard_Lexograph(New Int32() {c1, c2, c3, c4})
For c5 = 0 To Table2A.GetUpperBound(0)
Select Case Table2A(c5)
Case value
Exit For
Case -1
Table2A(c5) = value
Exit For
End Select
Next c5
Next c4
Next c3
Next c2
Next c1
Array.Sort(Table2A)
Array.Reverse(Table2A)
For c1 = Table2A.GetUpperBound(0) To 0 Step -1
Select Case Table2A(c1)
Case -1
Continue For
Case Else
ReDim Preserve Table2A(c1)
Exit For
End Select
Next
Array.Reverse(Table2A)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table2A.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, Table2A, 5)
FileClose(7)
End Sub
Private Sub Table2_UI_Four_to_five(ByRef table2A() As Int32, ByRef table2B() As Int32)
''''''Fan out 2As-4UIs, with 5UIs in table 2
Dim c1, c2, h1, h2, h3, h4 As Int32
Dim value As Int32
For c1 = 0 To table2B.GetUpperBound(0)
table2B(c1) = -1
Next
For c1 = 0 To table2A.GetUpperBound(0)
value = table2A(c1)
h1 = (value - 1) \ 283140
value -= h1 * 283140
h2 = (value - 1) \ 4290
value -= h2 * 4290
h3 = (value - 1) \ 65
value -= h3 * 65
h4 = value
For c2 = 1 To 52
Select Case c2
Case h1, h2, h3, h4
Continue For
Case Else
table2B(c1 * 52 + c2) = FiveCard_Lexograph(New Int32() {h1, h2, h3, h4, c2})
End Select
Next c2
Next c1
c1 = table2A.GetUpperBound(0) * 52 + 52
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table2B.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, table2B, 5)
FileClose(7)
End Sub
Private Sub Table2_Main(ByRef Table2() As Int32, ByRef Table2B() As Int32, ByRef table3A() As Int32)
Dim c1 As Int32
Dim length, value As Int32
For c1 = 0 To Table2.GetUpperBound(0)
Table2(c1) = -1
Next
'update table2
length = table3A.GetUpperBound(0)
For c1 = 0 To Table2B.GetUpperBound(0)
If Table2B(c1) = -1 Then Continue For
value = Table2B(c1)
Table2(c1) = Search_Array(table3A, length, value) * 52
Next c1
length = Table2.GetUpperBound(0)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table2.bin", OpenMode.Binary)
FilePut(7, length, 1)
FilePut(7, Table2, 5)
FileClose(7)
End Sub
Private Sub Table3_UI(ByRef Table3A() As Int32)
Dim c1, c2, c3, c4, c5, c6 As Int32 'counters
Dim value As Int32
For c1 = 0 To Table3A.GetUpperBound(0)
Table3A(c1) = -1
Next c1
''''''' Code to make table 3A - Five Card UIs ''''''''
For c1 = 1 To 48
For c2 = c1 + 1 To 49
For c3 = c2 + 1 To 50
For c4 = c3 + 1 To 51
For c5 = c4 + 1 To 52
value = FiveCard_Lexograph(New Int32() {c1, c2, c3, c4, c5})
For c6 = 0 To Table3A.GetUpperBound(0)
Select Case Table3A(c6)
Case value
Exit For
Case -1
Table3A(c6) = value
Exit For
End Select
Next c6
Next c5
Next c4
Next c3
Next c2
Next c1
Array.Sort(Table3A)
Array.Reverse(Table3A)
For c1 = Table3A.GetUpperBound(0) To 0 Step -1
Select Case Table3A(c1)
Case -1
Continue For
Case Else
ReDim Preserve Table3A(c1)
Exit For
End Select
Next
Array.Reverse(Table3A)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table3A.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, Table3A, 5)
FileClose(7)
End Sub
Private Sub Table3_UI_five_to_six(ByRef table3A() As Int32, ByRef table3B() As Int32)
Dim c1, c2, h1, h2, h3, h4, h5 As Int32
Dim value As Int32
For c1 = 0 To table3B.GetUpperBound(0)
table3B(c1) = -1
Next c1
For c1 = 0 To table3A.GetUpperBound(0)
value = table3A(c1)
h1 = (value - 1) \ 18687240
value -= h1 * 18687240
h2 = (value - 1) \ 283140
value -= h2 * 283140
h3 = (value - 1) \ 4290
value -= h3 * 4290
h4 = (value - 1) \ 65
value -= h4 * 65
h5 = value
For c2 = 1 To 52
Select Case c2
Case h1, h2, h3, h4, h5
Continue For
Case Else
table3B(c1 * 52 + c2) = SixCard_Lexograph(New Int32() {h1, h2, h3, h4, h5, c2})
End Select
Next c2
Next c1
c1 = table3A.GetUpperBound(0) * 52 + 52
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table3B.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, table3B, 5)
FileClose(7)
End Sub
Private Sub Table3_Main(ByRef table3() As Int32, ByRef table3B() As Int32, ByRef table4A() As Int32)
Dim c1 As Int32
Dim length, value As Int32
For c1 = 0 To table3.GetUpperBound(0)
table3(c1) = -1
Next
'update table2
length = table4A.GetUpperBound(0)
For c1 = 0 To table3B.GetUpperBound(0)
If table3B(c1) = -1 Then Continue For
value = table3B(c1)
table3(c1) = Search_Array(table4A, length, value) * 52
Next c1
length = table3.GetUpperBound(0)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table3.bin", OpenMode.Binary)
FilePut(7, length, 1)
FilePut(7, table3, 5)
FileClose(7)
End Sub
Private Sub Table4A_UI(ByRef table3B() As Int32, ByRef table4A() As Int32)
Dim c1, c2, value, length As Int32
For c1 = 0 To table4A.GetUpperBound(0)
table4A(c1) = -1
Next c1
c1 = 0
length = table3B.GetUpperBound(0) + 1
For c1 = 0 To table3B.GetUpperBound(0)
value = table3B(c1)
If value = -1 Then Continue For
For c2 = 0 To table4A.GetUpperBound(0)
Select Case table4A(c2)
Case value
Exit For
Case -1
table4A(c2) = value
Exit For
End Select
Next c2
Next c1
Array.Sort(table4A)
Array.Reverse(table4A)
For c1 = table4A.GetUpperBound(0) To 0 Step -1
Select Case table4A(c1)
Case -1
Continue For
Case Else
ReDim Preserve table4A(c1)
Exit For
End Select
Next
Array.Reverse(table4A)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table4A.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, table4A, 5)
FileClose(7)
End Sub
Private Sub Table4_main(ByRef table4() As Int32, ByRef table4A() As Int32)
Dim c1, c2, h1, h2, h3, h4, h5, h6, h7, suit As Int32
Dim value, index, temp As Int32
Dim OC(5) As Int32
Dim HC(6) As Int32
Dim rank As Int32
For c1 = 0 To table4A.GetUpperBound(0)
value = table4A(c1)
index = c1 * 52
suit = (value - 1) \ 373071582
value -= suit * 373071582
h1 = (value - 1) \ 13817466
value -= h1 * 13817466
h2 = (value - 1) \ 511758
value -= h2 * 511758
h3 = (value - 1) \ 18954
value -= h3 * 18954
h4 = (value - 1) \ 702
value -= h4 * 702
h5 = (value - 1) \ 26
value -= h5 * 26
h6 = value
OC = New Int32() {h1, h2, h3, h4, h5, h6}
For c2 = 0 To 5 'Pass non-suited as clubs, suited as spades
Select Case OC(c2)
Case Is <= 13
OC(c2) = OC(c2) * 4 - 3 'clubs
Case Else
OC(c2) = (OC(c2) - 13) * 4 - 2 'diamond
End Select
Next
'Good luck trying to understand my logic here. Basically i'm tricking my old evaluator. I feed it clubs if the card is not part of a possible flush, and diamonds if it is. I then tell my evaluator to ignore all club flushes.
For c2 = 1 To 52
If SN(c2) <> suit Then temp = (CN(c2) - 1) * 4 - 3 Else temp = (CN(c2) - 1) * 4 - 2 ' club else diamond
rank = determine_winner2(OC(0), OC(1), OC(2), OC(3), OC(4), OC(5), temp)
'If rank = 0 Then rank = rank
table4(index + c2) = rank
Next c2
Next c1
c1 = table4.GetUpperBound(0)
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\table4.bin", OpenMode.Binary)
FilePut(7, c1, 1)
FilePut(7, table4, 5)
FileClose(7)
End Sub
Private Sub supertable(ByRef HR() As Int32, ByRef table1() As Int32, ByRef table2() As Int32, ByRef table3() As Int32, ByRef table4() As Int32)
Dim length As Int32
Dim shift1, shift2, shift3 As Int32
Dim c1 As Int32
length = table1.GetUpperBound(0) + table2.GetUpperBound(0) + 1 + table3.GetUpperBound(0) + 1 + table4.GetUpperBound(0) + 1
HR = New Int32(length) {}
shift1 += table1.GetUpperBound(0) + 1
For c1 = 0 To table1.GetUpperBound(0)
HR(c1) = table1(c1) + shift1
Next
shift2 = shift1 + table2.GetUpperBound(0) + 1
For c1 = 0 To table2.GetUpperBound(0)
HR(c1 + shift1) = table2(c1) + shift2
Next
shift3 = shift2 + table3.GetUpperBound(0) + 1
For c1 = 0 To table3.GetUpperBound(0)
HR(c1 + shift2) = table3(c1) + shift3
Next
For c1 = 0 To table4.GetUpperBound(0)
HR(c1 + shift3) = table4(c1)
Next
FileOpen(7, "C:\Program Files\DevStudio\VB\Poker5\HR.bin", OpenMode.Binary)
FilePut(7, length, 1)
FilePut(7, HR, 5)
FileClose(7)
End Sub
Private Function FourCard_Lexograph(ByRef OC() As Int32) As Int32
'Don't let the word Lexograph fool you, really these are just unique ID's. I abandoned using lexographs. No need for em.
Select Case SN(OC(0))
Case SN(OC(1)), SN(OC(2)), SN(OC(3))
Case Else
OC(0) = 52 + CN(OC(0)) - 1
End Select
Select Case SN(OC(1))
Case SN(OC(0)), SN(OC(2)), SN(OC(3))
Case Else
OC(1) = 52 + CN(OC(1)) - 1
End Select
Select Case SN(OC(2))
Case SN(OC(0)), SN(OC(1)), SN(OC(3))
Case Else
OC(2) = 52 + CN(OC(2)) - 1
End Select
Select Case SN(OC(3))
Case SN(OC(0)), SN(OC(1)), SN(OC(2))
Case Else
OC(3) = 52 + CN(OC(3)) - 1
End Select
Array.Sort(OC)
FourCard_Lexograph = OC(0) + OC(1) * 65 + OC(2) * 4290 + OC(3) * 283140
End Function
Private Function FiveCard_Lexograph(ByVal OC() As Int32) As Int32
Dim c1 As Int32
Dim c2 As Int32
Dim count As Int32
For c1 = 0 To 4
count = 0
If OC(c1) <= 52 Then
For c2 = 0 To 4
If SN(OC(c1)) = SN(OC(c2)) Then count += 1
Next c2
If count < 3 Then OC(c1) = 52 + CN(OC(c1)) - 1
End If
Next c1
If OC(0) = OC(1) And OC(1) = OC(2) And OC(2) = OC(3) And OC(3) = OC(4) Then FiveCard_Lexograph = -1 : Exit Function
Array.Sort(OC)
FiveCard_Lexograph = OC(0) + OC(1) * 65 + OC(2) * 4290 + OC(3) * 283140 + OC(4) * 18687240
End Function
Private Function SixCard_Lexograph(ByVal OC() As Int32) As Int32
Dim c1 As Int32
Dim c2 As Int32
Dim count As Int32
Dim suit As Int32
For c1 = 1 To 4
count = 0
For c2 = 0 To 5
If SN(OC(c2)) = c1 Then count += 1
Next
If count >= 4 Then suit = c1 : Exit For
Next
If suit > 0 Then
For c1 = 0 To 5
Select Case OC(c1)
Case Is <= 52
If SN(OC(c1)) = suit Then OC(c1) = 13 + CN(OC(c1)) - 1 Else OC(c1) = CN(OC(c1)) - 1
Case Else
OC(c1) -= 52
End Select
Next c1
Else
For c1 = 0 To 5
Select Case OC(c1)
Case Is <= 52
OC(c1) = CN(OC(c1)) - 1
Case Else
OC(c1) -= 52
End Select
Next c1
End If
Array.Sort(OC)
SixCard_Lexograph = OC(0) + OC(1) * 26 + OC(2) * 702 + OC(3) * 18954 + OC(4) * 511758 + OC(5) * 13817466 + suit * 373071582
End Function
Private Function Search_Array(ByRef table() As Int32, ByVal UB1 As Int32, ByVal value As Int32) As Int32
'I'm not a programmer - so i don't know where to look for optimized array search functions, so i wrote my own. I think its pretty efficient, hi speed, for any size array. Keeps dividing the search space by 2 till a solution converges, or returns -1 value is not in the array.
Dim LB1 As Int32
Do
Search_Array = LB1 + (UB1 - LB1) \ 2
If value > table(Search_Array) Then
LB1 = Search_Array
ElseIf value < table(Search_Array) Then
UB1 = Search_Array
Else
Exit Function
End If
If UB1 - LB1 = 1 Then
Select Case value
Case table(LB1)
Search_Array = LB1
Exit Function
Case table(UB1)
Search_Array = UB1
Exit Function
Case Else
Search_Array = -1
Debug.Print("error 3")
Exit Function
End Select
End If
Loop
End Function
Ok the only function I haven't given is the determine winner function, and that is because it calls a bunch of tables created by other functions in my old (read ancient) code. I have the tables in my program because they are stored on hard-drive, but the creation functions are in my old code.
'I admit RayW's code is probably 1000x times easier to follow if u know C++...(i don't btw). Sorry didn't write my code to be well understood, just to create the tables i needed.
|
Two Plus Two 
Previous
Index
Next
Flat
Re: VB source code 2 of 2
Edit
Reply
Quote
