Iterated Dealing Random Cards

[jgsiegel]

Hi everyone, I'm new to the forum but I've been lurking for a while when I run into questions on something I'm doing.

I haven't been able to find an answer to my question this time: what happens when you want to deal card hands iteratively? I have some code that deals 15 of 52 cards randomly into column A, but then when I run the same code for thousands of hands, I get some strange results. In the game, each of the six players gets two cards and then there are three community cards, hence the need for 15 cards.

I ran my iterative process for 8000 hands yesterday and ended up with 22 fours of a kind, which seems like a lot more than I should be seeing in just 8000 hands. The individual hand-dealing code is below as well as the iterative code I'm using:

Sub OneHand()
Sheets("Raw").Select
Dim NumArray, SuitArray, AllCards() As Variant
Dim MyCard As String
Dim x, i, MySuit, MyNum, MyVal As Integer


'Load Cards Into the array AllCards


NumArray = Array("14", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13")
SuitArray = Array("h", "s", "c", "d")
x = 1
For MySuit = LBound(SuitArray) To UBound(SuitArray)
    For MyNum = LBound(NumArray) To UBound(NumArray)
        ReDim Preserve AllCards(1 To x)
        AllCards(x) = NumArray(MyNum) & SuitArray(MySuit)
        x = x + 1
    Next MyNum
Next MySuit


'Randomly distribute cards to column A, removing the card that was last
'picked from the array of available cards.


For x = 2 To 16
    Randomize
    MyVal = Int(((UBound(AllCards) - (x - 1)) * Rnd()) + 1)
    MyCard = AllCards(MyVal)
    For i = MyVal To UBound(AllCards) - 1
        AllCards(i) = AllCards(i + 1)
    Next i
    Cells(x, "A").Value = MyCard
Next x


End Sub

Sub Hands()a = 1
    For a = 1 To 8000
        Application.Run ("OneHand")
        Application.Calculate
        Sheets("Raw").Select
        Range("E128:J128").Select
        Selection.Copy
        Sheets("Master").Select
        Cells(a, 1).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Sheets("Raw").Select
        Range("E129:J129").Select
        Selection.Copy
        Sheets("Master").Select
        Cells(a, 7).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
    Next a


End Sub

The bottom of the Hands() code just copies and pastes the results into a Master sheet, it shouldn't have anything to do with the actual iteration and randomization of the hands I'm seeing. Is my Hands() code interacting in any strange way with the OneHand() code during the iterations to give me these strange results? Is the OneHand() code not as random as I think it is? I didn't create the OneHand() code, I found it online someplace, so if it's not random, I may need some help creating a better one.

 

[Rick Rothstein]

Here is a function I have posted in the past (back in my compiled VB volunteering days)...

Sub ShuffleDeck(Deck() As String)
  Dim X As Integer
  Dim TempInt As Integer
  Dim TempCard As String
  Static TempDeck(1 To 52) As String
  Randomize
  If LBound(Deck) <> 1 Or UBound(Deck) <> 52 Then
    'Programmer passed an improper array
    MsgBox "Deck array is dimensioned incorrectly"
    Exit Sub
  ElseIf TempDeck(52) = "" Then
    Randomize
    'Initialize the deck of cards
    For X = 1 To 52
      If ((X - 1) Mod 13) = 0 Then
        TempDeck(X) = "Ace"
      ElseIf ((X - 1) Mod 13) = 10 Then
        TempDeck(X) = "Jack"
      ElseIf ((X - 1) Mod 13) = 11 Then
        TempDeck(X) = "Queen"
      ElseIf ((X - 1) Mod 13) = 12 Then
        TempDeck(X) = "King"
      Else
        TempDeck(X) = CStr(1 + ((X - 1) Mod 13))
      End If
      TempDeck(X) = TempDeck(X) & " of "
      If (X - 1) \ 13 = 0 Then
        TempDeck(X) = TempDeck(X) & "Spades"
      ElseIf (X - 1) \ 13 = 1 Then
        TempDeck(X) = TempDeck(X) & "Hearts"
      ElseIf (X - 1) \ 13 = 2 Then
        TempDeck(X) = TempDeck(X) & "Diamonds"
      ElseIf (X - 1) \ 13 = 3 Then
        TempDeck(X) = TempDeck(X) & "Clubs"
      End If
    Next
  End If
  'Let us shuffle the deck
  X = 52
  For X = 52 To 1 Step -1
    TempInt = Int(X * Rnd + 1)
    Deck(X) = TempDeck(TempInt)
    TempCard = TempDeck(X)
    TempDeck(X) = TempDeck(TempInt)
    TempDeck(TempInt) = TempCard
  Next
End Sub

Here is an example macro which calls the function and "deals" a set of four hands (one at a time)... it should give you an idea of how to use the function in your own program...

Sub ShuffleAndDeal()
  Dim X As Long, Hand As Long, Again As Long, FiveCards As String
  Static MyDeck(1 To 52) As String
  ' Create/shuffle, then deal, a deck of cards
  Do
    ' Create/shuffle
    ShuffleDeck MyDeck
    ' Simulate drawing 4 hands of 5 cards each
    For X = 1 To 20
      If X Mod 5 = 1 Then
        Hand = Hand + 1
        FiveCards = "Hand #" & Hand & vbLf & vbLf
      End If
      FiveCards = FiveCards & MyDeck(X) & vbLf
      If X Mod 5 = 0 Then MsgBox FiveCards
    Next
    Again = MsgBox("Do you want to see another set of 4 hands?", vbYesNo)
    Hand = 0
  Loop Until Again = vbNo
End Sub

 

[StephenCrump]

If you are dealing 8,000 hands of 15 cards, I suspect that 22 fours of a kind is on the low side.

A bit of a coincidence that Rick Rothstein has already responded, as I was going to refer you to a post he had written here:

VB's Randomize Function Should Be Run Only Once Per Session

to suggest that you use Randomize only once, instead of 15 times per hand times 8,000 hands.

 

[Rick Rothstein]

...to suggest that you use Randomize only once...

I am of a mixed mind on this now. While what I posted at the link you referred to is technically correct, someone once posted that VB's Randomize function is so "bad" that it is actually predictable for any given Randomized value after a sufficient number of hands have been dealt (there was a reference to an actual written article if I remember correctly), so while running Randomize each time tends to restrict the randomness of the output, it has the benefit of being unpredictable whereas running Randomize one time can apparently lead to an eventual predictability after a sufficient number of hands have been dealt.

 

[StephenCrump]

I ran my iterative process for 8000 hands yesterday and ended up with 22 fours of a kind, which seems like a lot more than I should be seeing in just 8000 hands.

If you are dealing 8,000 hands of 15 cards, I suspect that 22 fours of a kind is on the low side.

Sorry, my initial comment misunderstood the point.

I now assume you're counting the occurrences where one of the six players has four of a kind in his/her two cards plus the three community cards. I calculate the likelihood of this as approximately 0.144%. Using a simulation of 10,000 draws x 50 iterations, I got an average of 14.4 as expected, with a range from 5 to 25, so your 22 (from 8,000) doesn't look unreasonable.

My code is a little indirect (I randomly pick combinations from an ordered set of all possible combinations, and then randomly permute each one) but is still pretty fast.

Sample output:

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	PlayerA		PlayerB		PlayerC		PlayerD		PlayerE		PlayerF		Pot
2	7D	5D	4S	QS	AS	QD	KD	9H	JD	10C	AC	QH	KC	6D	7H
3	5C	AC	QS	7D	6H	QH	7H	2C	AD	JD	QC	KS	AH	6D	2H
4	AC	JD	7H	QD	5S	10C	5H	4D	8C	7C	7S	4C	9D	10S	8H
5	JH	4S	QS	7C	KH	2S	8C	JS	2C	5C	10D	6S	9D	AC	3S
6	6H	8H	2D	2S	9H	5D	JC	7H	7D	3C	6D	JS	KD	9S	AH
7	KH	4S	4C	QD	KS	JC	9C	5C	6S	8S	9H	QH	7C	AH	3C
8	2D	8D	2H	AH	KC	3S	QC	AC	8H	AS	JD	7S	JC	7D	10S
9	AD	5D	9S	3S	3C	9D	2C	7H	6D	QS	AC	QC	4C	8H	3H
10	etc

<tbody>
</tbody>

​

Sub GenerateCards()

    Dim cNoCombinations As Currency, cCombinationNo As Currency
    Dim lHand() As Long, lResults() As Long, lNoCards As Long, lNoInHand As Long, i As Long, j As Long
    Dim vResults() As Variant
    Dim vSuits As Variant, vValues As Variant
    Const NO_OF_HANDS = 10000
    
    lNoCards = 52
    lNoInHand = 15
    vSuits = Array("D", "C", "H", "S")
    vValues = Array("A", 2, 3, 4, 5, 6, 7, 8, 9, 10, "J", "Q", "K")
    ReDim lHand(1 To lNoInHand)
    ReDim lResults(1 To NO_OF_HANDS, 1 To lNoInHand)
    ReDim vResults(1 To NO_OF_HANDS, 1 To lNoInHand)
    cNoCombinations = Round(Application.Combin(lNoCards, lNoInHand), 0)
    Randomize
    
    For i = 1 To NO_OF_HANDS
        cCombinationNo = 1 + Int(Rnd() * cNoCombinations)
        lHand = GetNthCombination(lNoCards, lNoInHand, cCombinationNo)
        GetRandomOrder lHand
        For j = 1 To lNoInHand
            lResults(i, j) = lHand(j)
        Next j
    Next i
    
    For i = 1 To NO_OF_HANDS
        For j = 1 To lNoInHand
            vResults(i, j) = vValues(lResults(i, j) Mod 13) & vSuits(Int((lResults(i, j) - 1) / 13))
        Next j
    Next i
    
    On Error Resume Next
    Range("MyResults").ClearContents
    On Error GoTo 0
    With Range("A2").Resize(NO_OF_HANDS, lNoInHand)
        .Value = vResults
        .Name = "MyResults"
    End With

End Sub
Function GetNthCombination(N As Long, r As Long, ByVal cCombinationNo As Currency) As Long()

    Dim lCombination() As Long, i As Long, j As Long
    Dim cTemp As Currency
    ReDim lCombination(1 To r)
    
    j = 0
    For i = 1 To r
        Do
            j = j + 1
            cTemp = Round(Application.Combin(N - j, r - i), 0)
            If cCombinationNo <= cTemp Then
                lCombination(i) = j
                Exit Do
            End If
            cCombinationNo = cCombinationNo - cTemp
        Loop
    Next i
    
    GetNthCombination = lCombination

End Function
Sub GetRandomOrder(N() As Long)

    Dim i As Long, j As Long, lTemp As Long
        
    For i = LBound(N) To UBound(N) - 1
        j = Application.RandBetween(i, UBound(N))
        lTemp = N(i)
        N(i) = N(j)
        N(j) = lTemp
    Next i
    
End Sub

 

[jgsiegel]

Thank you both for the answers, I appreciate the very quick turnaround on my question. As it turns out, my code was working properly but was omitting the King of Diamonds, the final card in the array, which of course skewed my 8000-hand simulation fairly drastically. I ran another 1000-hand simulation once the code had been fixed and each of the values (2-14) came up in very close to equal amounts.