Evaluating Dice Poker results

In Dice Poker (or Yacht), a player rolls 5 standard dice (sides 1 - 6) and the resulting roll is given a score based on combinations:

• Two matching dice only - pair
• Three matching dice only - three
• Four matching dice only - four
• Five matching dice - yacht
• two pairs, full house, small straight, large straight, you get the idea

A player rolls the dice and the input is in a space-delimited format e.g.

3 6 5 6 1 - pair
1 6 6 1 6 - full-house
2 4 3 5 1 - small-straight

I'm reading these results from column A on Sheet1 (we'll say). I'm not convinced I'm checking the hands for results very effectively. It works, but it seems incoherent.

First I have an Enum of the results as well as a function for getting the name of the result -

Option Explicit
Private Enum Combination
none
pair
three
four
Yacht
twopair
fullhouse
smallstraight
bigstraight
End Enum

Private Function GetEnum(ByVal value As Combination) As String
Select Case value
Case 0
GetEnum = "none"
Case 1
GetEnum = "pair"
Case 2
GetEnum = "three"
Case 3
GetEnum = "four"
Case 4
GetEnum = "yacht"
Case 5
GetEnum = "two-pairs"
Case 6
GetEnum = "full-house"
Case 7
GetEnum = "small-straight"
Case 8
GetEnum = "big-straight"
End Select
End Function

The meat of it is here:

Sub YachtHands()
Dim lastRow As Long
Dim dice As Variant
lastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
Dim index As Long
Dim result As String
For index = 1 To lastRow
dice = Split(Sheet1.Cells(index, 1), " ")
result = result & EvaluateHand(dice)
Next
Debug.Print Trim\$(result)
End Sub

Private Function EvaluateHand(ByVal dice As Variant) As String
Dim score As Combination
Dim bucket() As Long
Dim threeFlag As Boolean
Dim twoFlag As Boolean
ReDim bucket(1 To 6)
Dim i As Long
For i = LBound(dice) To UBound(dice)
bucket(dice(i)) = bucket(dice(i)) + 1
Next
For i = LBound(bucket) To UBound(bucket)
If bucket(i) > 3 Then
score = bucket(i) - 1
GoTo Eval
End If
If bucket(i) = 3 Then
If twoFlag Then
score = fullhouse
GoTo Eval
Else
threeFlag = True
End If
End If
If bucket(i) = 2 Then
If threeFlag Then
score = fullhouse
GoTo Eval
ElseIf twoFlag Then
score = twopair
GoTo Eval
Else
twoFlag = True
End If
End If
Next
If threeFlag Then
score = three
GoTo Eval
End If
If twoFlag Then
score = pair
GoTo Eval
End If
score = CheckStraight(bucket)
Eval:
EvaluateHand = GetEnum(score) & " "
End Function

Private Function CheckStraight(ByVal bucket As Variant) As Combination
If bucket(1) = 1 And bucket(2) = 1 And bucket(3) = 1 And bucket(4) = 1 And bucket(5) = 1 Then CheckStraight = smallstraight
If bucket(2) = 1 And bucket(3) = 1 And bucket(4) = 1 And bucket(5) = 1 And bucket(6) = 1 Then CheckStraight = bigstraight
End Function

I think my straight checking function is sort of ridiculous. My main evaluation also uses a lot of GoTo which in general should be avoided. It also suffers some arrow-code. I think this all stems from whatever algorithm I'm using.

• Don't have time for an answer at the moment - but the one thing that jumped out at me is the Select and enum combination. An Enum is effectively a Long, so you can assign values (they are implicitly assigned anyway) and convert value into the enum or the other way. – AJD Aug 22 '18 at 20:35

Some general notes:

• GetEnum function:
Select Case value
Case 0
GetEnum = "none"

This kind of hard-coding of values is very risky, if you change the enumeration your function will break. It should be Case none ...

• EvaluateHand
• What if you have not exactly 5 numbers?
• you're right, usage of GoTo should be very limited, you could avoid majority of it by ElseIf or Select Case
• also, I wouldn't have went so much details like the snippet below, just set the flags during the For, then check the flags at the end and set score
If bucket(i) = 3 Then
If twoFlag Then
score = fullhouse
GoTo Eval
• I don't think an array is the best fit for this purpose, I'd suggest to use a dictionary, like here below:

Private Function EvaluateHand_MJ(ByVal dice As Variant) As String
Dim values As New Dictionary
Dim i As Long
Dim result As Combination

result = Combination.none

With values
For i = LBound(dice) To UBound(dice)
If .Exists(dice(i)) Then
.Item(dice(i)) = .Item(dice(i)) + 1
Else
End If
Next i

Select Case .Count  ' check number of distinct values
Case 1          ' all dices are the same, must be a yacht
result = Combination.yacht
Case 2         ' two distinct numbers: four (4+1) or a fullhouse(3+2)
If .Item(.Keys(1)) = 2 Or .Item(.Keys(1)) = 3 Then
result = Combination.fullhouse
Else
result = Combination.four
End If
Case 3         ' 3 distinct: two pairs (2+2+1) or a three (3+1+1)
For i = 1 To 3
Select Case .Item(.Keys(i))
Case Is = 2
result = Combination.twopair
Case Is = 3
result = Combination.three
End Select
Next i
Case 4         ' 3 unique numbers and a pair
result = Combination.pair
Case 5         ' straight (1 or 6 missing) or nothing
For i = 1 To 6
If Not .Exists(CStr(i)) Then
If i = 1 Then
result = Combination.bigstraight
ElseIf i = 6 Then
result = Combination.smallstraight
End If
End If
Next i
End Select
End With

EvaluateHand_MJ = GetEnum(result) & " "
End Function
• Oh, yeah that's pretty clever - the dictionary. Thanks! – Raystafarian Aug 23 '18 at 5:11

The code below does not use the Combination enumeration.

If bucket(i) > 3 Then
score = bucket(i) - 1
GoTo Eval
End If

"5 of a kind" is not handled.

I would replace the Combination enumeration and GetEnum function with a Select Case.

IMO, using a second array to count the die groups would really simplify the logic.

Dim counts(0 To 5) As Long
For i = LBound(bucket) To UBound(bucket)
counts(bucket(i)) = counts(bucket(i)) + 1
Next

If counts(5) > 0 Then
EvaluateHand = "Five of a Kind"
ElseIf counts(4) > 0 Then
EvaluateHand = "Five of a Kind"
ElseIf counts(3) > 0 And counts(2) > 0 Then
EvaluateHand = "Full House"
ElseIf counts(3) > 0 Then
EvaluateHand = "Three of a Kind"
ElseIf counts(2) = 2 Then
EvaluateHand = "Two Pair"
ElseIf counts(2) = 1 Then
EvaluateHand = "One Pair"
ElseIf bucket(1) = 0 Then
EvaluateHand = "Large Straight"
ElseIf counts(6) = 0 Then
EvaluateHand = "Small Straight"
Else
EvaluateHand = "Pai Gow"
End If

*The term "Pai Gow" comes from the Chinese poker game of the same name means "No Hand".

• Cool idea..btw. – TinMan Aug 23 '18 at 6:30

Here is another possible solution building on your algorithm, exploiting enumeration opportunities:

Private Function EvaluateHand(ByVal dice As Variant) As String
Dim score As Combination
Dim bucket() As Long
ReDim bucket(1 To 6)
Dim i As Long

For i = LBound(dice) To UBound(dice)
bucket(dice(i)) = bucket(dice(i)) + 1
Next

i = 1
Do
Select Case bucket(i)
Case 5
score = Yacht
Case 4
score = four
Case 3
score = score + three
Case 2
score = score + pair
End Select
i = i + 1
Loop While i < 7 And score < fullhouse ' evaluation need to be continued while score is nothing / pair / three
If score = none Then
If bucket(1) = 0 Then
score = bigstraight
ElseIf bucket(6) = 0 Then
score = smallstraight
End If
End If

EvaluateHand = GetEnum(score) & " "
End Function

For that enum need to be redefined

Private Enum Combination
none = 0
three = 1
pair = 2

four = 5
Yacht = 6
twopair = 4     ' pair * 2
fullhouse = 3   ' pair +three
smallstraight = 7
bigstraight = 8
End Enum

For that GetEnum need to be updated too:

Private Function GetEnum(ByVal value As Combination) As String
Select Case value
Case none
GetEnum = "none"
Case pair
GetEnum = "pair"
Case three
GetEnum = "three"
Case four
GetEnum = "four"
Case Yacht
GetEnum = "yacht"
Case twopair
GetEnum = "two-pairs"
Case fullhouse
GetEnum = "full-house"
Case smallstraight
GetEnum = "small-straight"
Case bigstraight
GetEnum = "big-straight"
End Select
End Function
• Ha! That's actually pretty clever too – Raystafarian Aug 23 '18 at 22:47