(10-11-2022, 01:15 PM)bplus Wrote:

(10-11-2022, 07:00 AM)PhilOfPerth Wrote:

(10-11-2022, 05:52 AM)bplus Wrote:

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.

(10-12-2022, 01:44 PM)TerryRitchie Wrote:

(10-12-2022, 09:03 AM)Pete Wrote:

(10-11-2022, 02:11 PM)TerryRitchie Wrote: 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://staging.qb64phoenix.com/showthread.php?tid=444&pid=2466#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

Quote: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

(10-13-2022, 04:24 AM)mnrvovrfc Wrote:

Quote: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.

(10-13-2022, 02:35 AM)TerryRitchie Wrote: LOL, well it's true!