Evaluating Dice Poker results

Question

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.

Answer 1

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
                .Add dice(i), 1
            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

Answer 2

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".

Answer 3

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