Ranking Poker Hands

[PhilOfPerth]

Code: (Select All)

' Poker.bas 2022-10-10 b+ try ranking hands
Dim Shared Order$
Order$ = " A 2 3 4 5 6 7 8 910 J Q K"
Dim Shared Deck$(52), rankCount(10)
makeDeck
'For i = 1 To 52
'  Print i, Deck$(i)
'Next
'end

shuffle
'For i = 1 To 52
'  Print i, Deck$(i)
'Next
'end

'make sure we detect rare occurances
h$ = " AC10C JC QC KC"
Print h$; " = "; RankName$(Rank(h$))
h$ = " KS10S JS QS AS"
Print h$; " = "; RankName$(Rank(h$))
h$ = " AC 3C JC QC KC"
Print h$; " = "; RankName$(Rank(h$))
h$ = " AC 2C 3C 4C 5C"
Print h$; " = "; RankName$(Rank(h$))
h$ = " AS 2C 3C 4C 5C"
Print h$; " = "; RankName$(Rank(h$))
Cls
tests = 10000000
While fini = 0
    For k = 0 To 9
        h$ = ""
        For i = 1 To 5
            h$ = h$ + Deck$(k * 5 + i)
        Next
        r = Rank(h$)
        rankCount(r) = rankCount(r) + 1
    Next
    hands = hands + 10
    If hands >= tests Then fini = 1 Else shuffle
    'input "Quit? ";a$
    'if a$ = "y" then fini = 1 else  shuffle
Wend
For i = 1 To 10
    Print rankCount(i); ", "; Int(rankCount(i) / tests * 100); "%, "; RankName$(i)
Next

Function RankName$ (RNumber)
    Select Case RNumber
        Case 1: RankName$ = "Royal Flush"
        Case 2: RankName$ = "Straight Flush"
        Case 3: RankName$ = "Four of a Kind"
        Case 4: RankName$ = "Full House"
        Case 5: RankName$ = "Flush"
        Case 6: RankName$ = "Straight"
        Case 7: RankName$ = "Three of a Kind"
        Case 8: RankName$ = "Two Pair"
        Case 9: RankName$ = "Pair"
        Case 10: RankName$ = "High Card"
    End Select
End Function

Function Rank (hand$)
    Dim arrange(13)
    For i = 1 To 5
        v$ = Mid$(hand$, i * 3 - 2, 2)
        f = (InStr(Order$, v$) + 1) / 2
        arrange(f) = arrange(f) + 1
    Next
    For i = 1 To 13
        Select Case arrange(i)
            Case 2: pair = pair + 1
            Case 3: three = 1
            Case 4: four = 1
        End Select
    Next
    If four = 1 Then Rank = 3: Exit Function
    If three = 1 And pair = 1 Then Rank = 4: Exit Function
    If three = 1 Then Rank = 7: Exit Function
    If pair = 2 Then Rank = 8: Exit Function
    If pair = 1 Then
        Rank = 9: Exit Function
    Else ' check flush and straight
        suit$ = Mid$(hand$, 3, 1): flush = 1
        For i = 2 To 5
            If Mid$(hand$, i * 3, 1) <> suit$ Then flush = 0: Exit For
        Next
        i = 1: straight = 1 ' find lowest card i
        While arrange(i) = 0
            i = i + 1
        Wend
        If i = 1 Then
            If arrange(10) = 1 And arrange(11) = 1 And arrange(12) = 1 And arrange(13) = 1 Then
                straight = 1: royal = 1: GoTo FinishRank
            End If
        End If
        If i >= 10 Then
            straight = 0
        Else
            straight = 1
            For j = i + 1 To i + 4 ' check next 4 cards in sequence
                If arrange(j) <> 1 Then straight = 0: Exit For
            Next
        End If
        FinishRank:
        If (straight = 1) And (flush = 1) And (royal = 1) Then Rank = 1: Exit Function
        If (straight = 1) And (flush = 1) Then Rank = 2: Exit Function
        If (flush = 1) Then Rank = 5: Exit Function
        If (straight = 1) Then
            Rank = 6
        Else
            Rank = 10
        End If
    End If
End Function

Sub shuffle
    For i = 52 To 2 Step -1
        r = Int(Rnd * i) + 1
        t$ = Deck$(i)
        Deck$(i) = Deck$(r)
        Deck$(r) = t$
    Next
End Sub

Sub makeDeck
    suit$ = "CDHS"
    For s = 1 To 4
        For i = 1 To 13
            Deck$((s - 1) * 13 + i) = Mid$(Order$, (i - 1) * 2 + 1, 2) + Mid$(suit$, s, 1)
        Next
    Next
End Sub

'      rank name   calc %   calc odds
'1data  "  Royal Flush", 0.000154, 649740
'2data  " Straight Flush", 0.00139 , 72193.33
'3data  " Four of a Kind", 0.0240 ,  4165
'4data  "   Full House", 0.144  ,  694.17
'5data  "     Flush", 0.197  ,  508.8
'6data  "    Straight", 0.392  ,  254.8
'7data  "Three of a Kind", 2.11  ,   47.3
'8data  "    Two Pair", 4.75  ,   21.03
'9data  "      Pair", 42.3   ,   2.36
'10 data  "   High Card", 50.1   ,   1.995

You beat me (again)!
I'm in the middle (or at least I've started) writing a game based on a similar algorithm.
I use this for shuffling:

for a=1 to 52 
swop=int (rnd*52)+1
swap deck$(a),deck$(swop)
next