Ranking Poker Hands

[Pete]

Yep, that's just a method to code a comment as a block in QB64. I picked that one up from Steve.

Pete

[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

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.

I had never heard of the Fisher Yates shuffle, and I'm surprised how similar mine is. I can't see any real advantages of their method over mine (it still uses a temp variable t$) so I'll stick to mine - I think it's easier to follow.

[Pete]

I've always wanted to create a clone of the late 1980's/early 1990's video poker machines found in Vegas at the time. Thanks for posting this code. I've been looking for a project to add to the tutorial that walks the user from start to finish creating a working game. Perhaps a video poker machine would be a good project.

@TerryRitchie,

I forgot I also had the poker slots game posted here: https://qb64phoenix.com/forum/showthread...66#pid2466

You are welcome to add it to your tutorial site, if you like.

Can you believe Bob hand designed those playing cards as bitmaps? The man's a real talent, well, for someone who doesn't program in SCREEN 0, that is.

Pete

Added it a few days ago.

https://www.qb64tutorial.com/games#h.6a3o4uul50i

Same game correct?

Terry

@TerryRitchie

Oh yeah, that's the one. I liked the intro you made for it, especially...

"I haven't had fun losing this much money since I got married!"

Pete

[TerryRitchie]

LOL, well it's true!

[mnrvovrfc]

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

When I look at something like this, my urge is to prevent "a" and "swop" from having the same value, if they're both integers. Such as:

Code: (Select All)

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

Otherwise could leave out the "do" and straight out test the two integers and, if not equal, actually do the swap.

[PhilOfPerth]

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

When I look at something like this, my urge is to prevent "a" and "swop" from having the same value, if they're both integers. Such as:

Code: (Select All)

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

Otherwise could leave out the "do" and straight out test the two integers and, if not equal, actually do the swap.

But does it matter if they are the same value? Obviously, there would not be a swap, but other swaps wouldn't be affected, and if there were only a small number of elements, the whole swap sequence could be looped a few times to ensure thorough mixing.

[Pete]

LOL, well it's true!

Actually Terry, the secret to a great marriage is working towards great communication skills. My wife and I were having problems in that department, until recently, when in the middle of a conversation she hit me in the back of the head with a shovel. She said, "Well how about that? After all these years, I finally found something that resonates with you!"

Pete

[bplus]

So nobody has any idea how to settle ties between pairs which is going to be a problem. Not as bad as spouse beating but there are better forums for that, I hope.

There are probably better forums to explain why Fisher Yates is best shuffle algo, no one here is going to tolerate sitting through the math.

Pardon my Columbian but this is crap!

Code: (Select All)

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

WTH? 2 loops structures yikesl What's wrong with keeping a card right where it is, on occasion? If you demand that it be moved you wreck the random distribution. You should allow a card not to be swapped or swapped with itself. It is explained in the Wiki article why, but like I said it's a mathematical argument that even Steve couldn't sit through, so what can I say. I go Columbian, sure!

[bplus]

I would like to continue on with some kind of Poker app where players join in with their AI's so issue of settling ties is huge obstacle until settled.

According to this article:
https://automaticpoker.com/poker-basics/...-in-poker/

Suits don't matter in tie breakers (of same rank), it's simply Card rank versus card rank from highest to lowest eg A Royal Flush ties another.
Still I think if rank doesn't settle then Suits would but then what's the order alphabetical puts Spades highest Clubs lowest and Diamonds then Hearts next.

And to avoid ties, Poker games should avoid common cards available to all players.

Also there is simple coding solution to 2 digit Tens, just use T like we do for Ace, Jack, Queen, King... I like! (A Royal Flush is all letters.)

Now for tie breaker function now that we have the tie and suit issue cleared up.

[Pete]

I had a straight flush once, but it transitioned into a pair.

Pete