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.