excel has always been one of my favorite programs.
recently i was having one of those friday night theredoitical conversations with a fellow nerd who showed me a new game called
Sets.
He enjoys playing it with his wife, but ocassionally would just like to know all permutations so they can get on with the next hand.
On the way home, i came up with a sloppy algirithm for checking validity of all relevent combinations and decided to try my hand at modeling it in excel. Version 1 was to have no graphics but just descrive the cards with characters.
4 user defined functions later the prototype was complete.
then i found this cool forms editor in the vba backend of excel, so i made a pretty little form.
I think excell will be my new prototyping platform because it's more portable then a webserver for third paries.
Overview: 81 unique Cards are a combination of the 4 areas
Number 1 2 3 1 2 3
Color R G P Red Green Puple
Symbol D W O Diamond Wave Oval
Shading H L S Hollow Lined Solid
12 cards are laid out and each party visually starts matching trios.
EACH Trio combination is Looked at indepently:
is the number the same or all different
is the color the same or all different
is the symbol the same or all different
is the shading the same or all diferent = TRUE (considered a Set)
and our happy excel UDF's.
Function RandLotto(Bottom As Integer, Top As Integer, Amount As Integer) As String
'cook us up some unique random numbers between bottom and top
Dim iArr As Variant
Dim i As Integer
Dim r As Integer
Dim temp As Integer
Application.Volatile
ReDim iArr(Bottom To Top)
For i = Bottom To Top
iArr(i) = i
Next i
For i = Top To Bottom + 1 Step -1
r = Int(Rnd() * (i - Bottom + 1)) + Bottom
temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = temp
Next i
For i = Bottom To Bottom + Amount - 1
RandLotto = RandLotto & " " & iArr(i)
Next i
RandLotto = Trim(RandLotto)
End Function
Function SplitReturn(txt As String, Delimeter As String, Position As Integer)
'hack up a string and return position.
'used in conjunction with randlotto to push on cell of 12 entries into 12 cells.
Dim x As Variant
x = Split(txt, Delimeter)
SplitReturn = x(Position - 1)
End Function
Function CheckCards(Cards As Range) As String
'check every relelvent combination for validation
Dim Output As String 'string to return
Dim x As Integer 'hold first card
Dim y As Integer 'hold second card
Dim z As Integer 'hold third card
Dim a As Integer 'counter master just for testing
For x = 1 To 10 Step 1
For y = x + 1 To 11 Step 1
For z = y + 1 To 12 Step 1
'IF card(X)Position 1, 2 ,3 4 check out then output card #'s
If ValidateCards(Cards(x), Cards(y), Cards(z)) = True Then
If Output <> "" Then Output = Output & " ! "
Output = Output & x & "," & y & "," & z
End If
'a = a + 1
'If x = 10 And y = 11 And z = 12 Then Output = Output & "!TotalCounts:" & a
Next z
Next y
Next x
CheckCards = Output
End Function
Function ValidateCards(x As String, y As String, z As String) As String
'check 3 cards to see if they validate
Dim toReturn As Boolean
toReturn = False 'default value to return
'check positions 1,1,2,4
If (Mid(x, 1, 1) = Mid(y, 1, 1) And Mid(y, 1, 1) = Mid(z, 1, 1)) Or (Mid(x, 1, 1) <> Mid(y, 1, 1) And Mid(x, 1, 1) <> Mid(z, 1, 1) And Mid(y, 1, 1) <> Mid(z, 1, 1)) Then
If (Mid(x, 2, 1) = Mid(y, 2, 1) And Mid(y, 2, 1) = Mid(z, 2, 1)) Or (Mid(x, 2, 1) <> Mid(y, 2, 1) And Mid(x, 2, 1) <> Mid(z, 2, 1) And Mid(y, 2, 1) <> Mid(z, 2, 1)) Then
If (Mid(x, 3, 1) = Mid(y, 3, 1) And Mid(y, 3, 1) = Mid(z, 3, 1)) Or (Mid(x, 3, 1) <> Mid(y, 3, 1) And Mid(x, 3, 1) <> Mid(z, 3, 1) And Mid(y, 3, 1) <> Mid(z, 3, 1)) Then
If (Mid(x, 4, 1) = Mid(y, 4, 1) And Mid(y, 4, 1) = Mid(z, 4, 1)) Or (Mid(x, 4, 1) <> Mid(y, 4, 1) And Mid(x, 4, 1) <> Mid(z, 4, 1) And Mid(y, 4, 1) <> Mid(z, 4, 1)) Then
toReturn = True
End If '3
End If '2
End If '1
End If '0
ValidateCards = toReturn
'ValidateCards = Mid(x, 0, 1)
End Function
