Dealing Cards

[NeoPa]

Introduction:

How do you randomise a set of numbers without having any attempts clash with earlier ones? For instance, if using a random number generator (Rnd([SeedCode]) in VBA.) and you want to emulate randomising a pack of cards without any card being selected more than once, as would be the case if simply using a random index into the original set (or pack) over and over again.

Solution:

You start with the simple numbers 0 to 51 representing the various different cards and these are stored originally in memory locations with a base and offsets between 0 and 51. Note it is not necessary that any of these cards start in any logical or predetermined order. As long as each is there, which implies none can be duplicated.

This is an iterative process which terminates when all cards have been handled - or just those cards considered to be 'dealt' if dealing/selecting fewer than the full set. Today we will look at randomising the full set though. Consider the dealing phase to come afterwards and this illustrates the fullest set of the logic - some of which could be dispensed with if only dealing straight off the 'deck' and not requiring the full set to be randomised in place.

Key:
X = Random Number.
Y = Number of Items Left.
Z = Temp Variable (Used for swapping).

The first step of each iteration is to capture a new random number. In this explanation I will ignore seeding and always use X = Rnd(). A number may be passed as a parameter to control seeding but we're not interested in that here. Using the default means we'll get the next in the current sequence regardless of what that sequence is and how far through it we are already. All values returned are 0 <= X < 1. One (1) can never be returned but zero (0) can.

Multiply that random number by Y and chop any decimal places.
X = Fix(X * Y)
Y starts at 52 but is decremented in each iteration. This gives an even distribution of the numbers available in the range (1st: 0 to 51; 2nd: 0 to 50; 3rd 0 to 49; etc). This is the offset you need - now in X.

Decrement Y now to simplify next step.
Y = Y - 1
Swap the current value found at offset X with that found in offset Y (after decrementing).
Z = Base(X): Base(X) = Base(Y): Base(Y) = Z

Rinse & repeat as long as Y is still greater than one (1).

Illustration:

For simplicity of illustration I will use a restricted set of just 8 items - 0 to 7. The logic works for any number but the illustrations get bigger and more complicated as that number increases.

 Apply Update  Offset: 0  1  2  3  4  5  6  7
               Values: 0  1  2  3  4  5  6  7
0.7055475==>5  Values: 0  1  2  3  4  7  6  5
0.533424 ==>3  Values: 0  1  2  6  4  7  3  5
0.5795186==>3  Values: 0  1  2  7  4  6  3  5
0.2895625==>1  Values: 0  4  2  7  1  6  3  5
0.301948 ==>1  Values: 0  7  2  4  1  6  3  5
0.7747401==>2  Values: 0  7  2  4  1  6  3  5
0.01401764=>0  Values: 7  0  2  4  1  6  3  5

The second column reflects the calculated offset to switch. Notice it's an integer by that point. Also notice that the second to last update switches column #2 with itself. Clearly this is unnecessary and has no effect. In actual code I would usually compare X & Y then only switch if they don't match.

[ADezii]

Hello NeoPa, good to see that an old friend is still around and active. I actually use a Dictionary Object (Microsoft Scripting Runtime) and one of it's critical Properties (Exists) to generate X unique, random numbers between a Low and High Range. Using your example above, the following Code will generate 52 random numbers between 0 and 51. Just a different approach that you may/may not agree with. For the sake of brevity and simplicity, I have removed any validations and error checking.

Dim varRet As Variant
Dim intCtr As Integer
 
'****************** USER DEFINED SDECTION ******************
Const conNUM_OF_RANDOMS = 52
Const conLOWER = 0
Const conUPPER = 51
'***********************************************************
 
varRet = fGenerateUniqueNumbersList(conNUM_OF_RANDOMS, conLOWER, conUPPER)
 
For intCtr = LBound(varRet) To UBound(varRet)
  Debug.Print varRet(intCtr)
Next

Public Function fGenerateUniqueNumbersList(intListLength As Integer, intLowerBound As Integer, intUpperBound As Integer) As Variant
'Set a Reference to the Microsoft Scripting Runtime
Dim dict As Scripting.Dictionary
Dim intVal As Integer
Dim var As Variant
 
Set dict = New Scripting.Dictionary
 
With dict
  Do While .Count < intListLength
    intVal = Int((intUpperBound - intLowerBound + 1) * Rnd + intLowerBound)
      If Not .Exists(intVal) Then .Add intVal, ""
  Loop
 
  fGenerateUniqueNumbersList = .Keys
End With
End Function

'Partial' Output:

 14 
 36 
 21 
 42 
 38 
 22 
 4 
 17 
 16 
 41 
 7 
 30 
 49 
 12 
 48 
 5 
 51 
 32 
 31 
 46 
 29 
 44 
 3 
 39 

[NeoPa]

Hi ADezii.

Always good to catch up old friend :-)

I would comment on your code, that it illustrates exactly why I developed (Independently - I suspect others use similar techniques.) the way I show to assign a correct value for each iteration through the loop. It means the loop is executed exactly 52 times rather than as many times as it takes to come across 52 separate values (On average 236 as it happens). When you think about the last iteration then each attempt has a 1/52 chance of arriving at the one valid number left. It starts a lot more reliably though, of course.

Using computers you're very unlikely to notice the inefficiency of course, but I have a natural aversion to such things. They make me feel uncomfortable. It's why I was so pleased to come up with the alternative when I did.

Another point worth noting, for the code efficiency coefficient, is that while .Exists() shows as one simple command in your code, you must realise that under the hood it is checking through each value already added to the dictionary. Relatively speaking (IE. at the processor level where everything is super-fast anyway.) that is quite extremely slow and expensive.

Apologies for critiquing your code so harshly, but it does have the value of illustrating that not all approaches are the same. Additionally it does help to explain, for others who may not grasp the importance of such things as I know you & I do, how the technique I illustrated can get to the heart of the matter rather than a trial-and-error loop where most tries have to be discarded as unfit for purpose. They both work in the end of course.

[ADezii]

Apologies for critiquing your code so harshly, but it does have the value of illustrating that not all approaches are the same.
Don't ever be concerned about that, your criticisms and recommendations are always welcome and appreciated. Oftentimes, I'll replace my approach with yours since it will usually be more efficient and faster, I am definitely receptive to new and better ideas.

What I would like to do, strictly out of curiosity?, and of course with your explicit approval, is to run Benchmark Tests against the two approaches but with much larger Datasets, something similar to returning 1,500 Random Values between 20,000 and 30,000. All Parameters would be less than the Maximum INTEGER Value of 32,767. In order to accomplish this, I would obviously need the Code that you would like to use for these Tests. Don't feel bad if you are not willing to provide it, I will understand.

Again, always a pleasure to hear from you, and don't ever lose that fine edge that you have.

[NeoPa]

Now you have me laughing out loud.

I was preparing a reply of the sort - "Well, what else do you want than the code I already included in the article?", when I noticed I hadn't actually included the code at all!!!!! I'll rectify that.

Of course I'm very happy for you to run tests on the different approaches. I'll get on to - probably rewriting - the original code now.

Feeling sheepish - but at the same time can't stop laughing at my mistake.

[NeoPa]

It looks like I didn't save the file at all :-(

Never mind. I'll post the code and attach the XLSM file I used for showing the results. It's currently signed as NeoPa so if anyone wants to play around with it then they will lose the signature, but otherwise no harm done. Unsigned code can also run fine as long as the MotW (Mark of the Web) is removed and the folder it's in is marked as trusted on your system.

The following code, in a standard module I've called "modMain" but whose name doesn't really matter, the actual randomising is done. I've deliberately kept the displaying of the data in the Excel worksheet as separate code as it relies heavily on the Excel interface whereas the randomising code is pure VBA.

Option Explicit
 
'DealCards() Randomises a set of cards.
Public Sub DealCards(lngTotal As Long)
    Dim lngX As Long, lngY As Long, lngZ As Long, lngMax As Long
    Dim lngArray() As Long
 
    ' ** Initialise **
    lngMax = lngTotal - 1
    ReDim lngArray(0 To lngMax)
    For lngX = 0 To lngMax
        lngArray(lngX) = lngX
    Next lngX
    ' ** Randomise **
    ' No special work to redo seed here.  Just using what comes for now.
    For lngX = lngMax To 1 Step -1
        lngY = CLng(CSng(lngX + 1) * Rnd())
        If lngY < lngX Then
            lngZ = lngArray(lngX)
            lngArray(lngX) = lngArray(lngY)
            lngArray(lngY) = lngZ
        End If
    Next lngX
    Call ShowCards(lngArray())
End Sub

I'll discuss the ShowCards() procedure separately. It's helpful to allow people to see the results but otherwise it's fundamentally irrelevant to the discussion.

NB. The working version has now been attached to the original post of this article.

[NeoPa]

To fill in the gaps where the operator may specify how many items they want randomised and how to show the data (If the value 52 is entered it assigns all the cards to four separate players and each value is marked with the card code (A, 2-10, J, Q & K) as well as a suit code (S=Spades, H=Hearts, D=Diamonds & C=Clubs.) whereas any other value just lists the numerical values in Column B in the worksheet). Cell A1 is where the total number is entered and whenever this is changed a new set of data will appear depending on the logic just described.

Handling the number in A1 being updated is done within the module for the Worksheet. it's pretty basic to be fair :

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Address() <> "$A$1" Then Exit Sub
        If .Value < 1 Then Exit Sub
        Call DealCards(.Value)
    End With
End Sub

The last bit of code still missing is the ShowCards() procedure referenced at the end of DealCards() from my earlier post :

'ShowCards() converts the resulting numbers to actual cards in their suits etc.
Private Sub ShowCards(lngArray() As Long)
    Dim lngX As Long, lngY As Long, lngZ As Long
    Dim strRange As String, strCard As String
    Dim blnCards As Boolean
 
    Call Columns("B:E").Delete
    blnCards = (UBound(lngArray) = 51)
    If blnCards Then
        Range("B1") = "Player 1"
        Range("C1") = "Player 2"
        Range("D1") = "Player 3"
        Range("E1") = "Player 4"
    End If
    For lngX = 0 To UBound(lngArray)
        If blnCards Then
            Select Case lngX
            Case Is < 13
                strRange = "B" & lngX + 2
            Case Is < 26
                strRange = "C" & lngX - 11
            Case Is < 39
                strRange = "D" & lngX - 24
            Case Else
                strRange = "E" & lngX - 37
            End Select
            lngY = lngArray(lngX)
            Select Case lngY Mod 13
            Case 0
                strCard = "A "
            Case Is < 10
                strCard = (lngY Mod 13) + 1 & " "
            Case 10
                strCard = "J "
            Case 11
                strCard = "Q "
            Case 12
                strCard = "K "
            End Select
            strCard = strCard & Mid("SHDC", (lngY \ 13) + 1, 1)
            Range(strRange) = strCard
        Else
            Range("B" & lngX + 1) = lngArray(lngX) + 1
        End If
    Next lngX
End Sub

Much more verbiage in that one as it has to handle the differences between simple numbers and a standard deck of cards. Relatively basic at its core though.

[ADezii]

Back again, NeoPa. I had some free time, so I ran some Benchmarks Tests comparing both your approach (arbitrarily called the Single Pass Approach) against the Collection Approach. The results weren't exactly what I expected, but here they are:

1. With each approach, I generated 10,000 Unique, Random Numbers.
2. Each approach consisted of 20 Trial Runs.
3. For a simple timing mechanism, I used the timeGetTime() API Functrion which returns the number of milliseconds that Windows has been running.
4. The Tests were performed on an Intel(R) Core(TM) i7-6700 CPU @ 3.40 GHz, RAM 8.00 GB, Windows 10 Enterprise.
5. Believe it or not, the Collection Approach was significantly faster which I would not expect. Interested in hearing your comments on this.

[NeoPa]

Hi ADezii.

Indeed that does seem perplexing. I assume you recognise and understand why the Single Pass Approach would logically be quicker - quicker by a far more significant margin even than the results seem to show in the reverse direction.

Ultimately, I'd need your whole test setup (Not computer, I just mean the software/code.) in order to be able to investigate what might be leading to such seriously anomalous results.

I've sent you a PM with my e-mail address (in case you don't have it already - which you may well have of course).

[NeoPa]

I have managed to work with ADezii's test system and, with a couple of very minor adjustments (that had unfortunately a great deal of adverse effect) it now accurately (and as one might expect understanding the logic) reflects the improvement of performance of this approach when compared with the general, more hit-&-hope approach as you can find in many places.

One of the things it demonstrated very strongly is that the performance of the single-pass approach as I've illustrated does not suffer as the number of items to sort increases. That is to say that it grows, but only in a linear fashion. However, the hit-&-hope approach degrades quite appreciably (exponentially) as the number increases.

I have to admit that the whole topic is a little esoteric as, when the number of items is something of practical use like a pack of cards (52) then if we can see that 10,000 items takes about a 50th of a second even for the slow approach, then when would it ever matter? Nevertheless, just understanding how & why one is relatively so much faster than the other - and for those circumstances where millions are required of course - it's pretty handy to know.

I've included, with thanks to ADezii who set up the test system this was taken from, the overall results for both sets of data.

PS. I cheated a little as the delays were so long so I took the first ten results for the "Collection" data and just copied them into the slots for 11 to 20. Nevertheless you'll see the minimal variation within these results indicates clearly that the other ten would have been very similar. I've attached the database so anyone can test for themselves should they wish to ;-)