Ranking Poker Hands

[bplus]

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

Ha, didn't know we were racing but I have been with Basic Forums since 2014 that might be an advantage.

Your shuffle is allot better than my first shuffle routine that I thought the cat's meow when i posted my first at JB forum way back 2015 maybe? Then tsh73, Russian Computer Science teacher, showed me Fisher Yates Shuffle the most efficient known to computer scientists wow! so yours is really close https://en.wikipedia.org/wiki/Fisher–Yates_shuffle

The one I use in Ranking is directly from JB and they don't have swap so you need to hold a value in temp variable for swap.

Code: (Select All)

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

For QB64pe mod to

Code: (Select All)

Sub shuffle ' for 1 to 52 cards as string in Shared Deck$
    For i = 52 To 2 Step -1
        Swap Deck$(i), Deck$(Int(Rnd * i) + 1) ' random from 1 to i inclusive,
        ' Steve showed me to do random directly without variable assignment
    Next
End Sub

 
Hope to pass tsh73 and Steve advice along to you all 

Thumbs up to Phil for giving me that opportunity.