RosettaCodeData/Task/Set-puzzle/FreeBASIC/set-puzzle.basic

Sub countAttributes(cards() As String, colors() As String, numbers() As String, shapes() As String, fillings() As String)
    For i As Integer = 0 To 2
        Dim As String card = cards(i)
        colors(i) = Mid(card, 1, Instr(card, " ") - 1)
        card = Mid(card, Instr(card, " ") + 1)
        numbers(i) = Mid(card, 1, Instr(card, " ") - 1)
        card = Mid(card, Instr(card, " ") + 1)
        shapes(i) = Mid(card, 1, Instr(card, " ") - 1)
        fillings(i) = Mid(card, Instr(card, " ") + 1)
    Next
End Sub

Sub cartesianProduct(colors() As String, numbers() As String, shapes() As String, fillings() As String, deck() As String)
    Dim As Integer i, j, k, l, index
    index = 0
    For i = 0 To Ubound(colors)
        For j = 0 To Ubound(numbers)
            For k = 0 To Ubound(shapes)
                For l = 0 To Ubound(fillings)
                    deck(index) = colors(i) & " " & numbers(j) & " " & shapes(k) & " " & fillings(l)
                    index += 1
                Next
            Next
        Next
    Next
End Sub

Sub randomSample(deck() As String, nDraw As Integer, sample() As String)
    Dim As Integer i, r, indices(Ubound(deck))
    For i = 0 To Ubound(deck)
        indices(i) = i
    Next
    For i = 0 To nDraw - 1
        r = Int(Rnd * (Ubound(indices) - i + 1)) + i
        Swap indices(i), indices(r)
        sample(i) = deck(indices(i))
    Next
End Sub

Sub combinations3(drav() As String, comb() As String)
    Dim As Integer i, j, k
    Dim n As Integer = Ubound(drav) + 1
    Dim count As Integer = n * (n - 1) * (n - 2) / 6
    Redim comb(count - 1)
    Dim index As Integer = 0
    For i = 0 To n - 3
        For j = i + 1 To n - 2
            For k = j + 1 To n - 1
                comb(index) = drav(i) & " | " & drav(j) & " | " & drav(k)
                index += 1
            Next
        Next
    Next
End Sub

Sub sortArray(arr() As String)
    Dim As Integer i, j, ub
    ub = Ubound(arr)
    For i = 0 To ub - 1
        For j = i + 1 To ub
            If arr(i) > arr(j) Then Swap arr(i), arr(j)
        Next
    Next
End Sub

Function isSet(cards() As String) As Boolean
    Dim As Integer i, j
    Dim As String colors(2), numbers(2), shapes(2), fillings(2), attr(2), sortedAttr(2)
    Dim As String card

    For i = 0 To 2
        card = cards(i)
        colors(i) = Mid(card, 1, Instr(card, " ") - 1)
        card = Mid(card, Instr(card, " ") + 1)
        numbers(i) = Mid(card, 1, Instr(card, " ") - 1)
        card = Mid(card, Instr(card, " ") + 1)
        shapes(i) = Mid(card, 1, Instr(card, " ") - 1)
        fillings(i) = Mid(card, Instr(card, " ") + 1)
    Next
    For i = 0 To 3
        Select Case i
        Case 0
            For j = 0 To 2: attr(j) = colors(j): Next
        Case 1
            For j = 0 To 2: attr(j) = numbers(j): Next
        Case 2
            For j = 0 To 2: attr(j) = shapes(j): Next
        Case 3
            For j = 0 To 2: attr(j) = fillings(j): Next
        End Select

        For j = 0 To 2
            sortedAttr(j) = attr(j)
        Next

        sortArray(sortedAttr())

        If (sortedAttr(0) = sortedAttr(1) And sortedAttr(1) = sortedAttr(2)) Or (sortedAttr(0) <> sortedAttr(1) And sortedAttr(1) <> sortedAttr(2) And sortedAttr(0) <> sortedAttr(2)) Then
            Continue For
        Else
            Return False
        End If
    Next
    Return True
End Function

'--- Programa Principal ---
Randomize Timer
Dim As Integer i, j, posic, validSets
Dim As String colors(2) =   {"    red", "  green", " purple"}
Dim As String numbers(2) =  {"  one", "  two", "three"}
Dim As String shapes(2) =   {"    oval", "squiggle", " diamond"}
Dim As String fillings(2) = {"  solid", "   open", "striped"}
Dim As String deck(80)
cartesianProduct(colors(), numbers(), shapes(), fillings(), deck())

Dim As Integer nDraw = 9, nGoal = nDraw / 2
Dim As String drav(nDraw - 1)
randomSample(deck(), nDraw, drav())
Dim As String sets(), cards(2)
Do
    combinations3(drav(), sets())
    validSets = 0
    For i = 0 To Ubound(sets)
        posic = 1
        For j = 0 To 2
            cards(j) = Mid(sets(i), posic, Instr(posic, sets(i), " | ") - posic)
            posic = Instr(posic, sets(i), " | ") + 3
        Next
        If isSet(cards()) Then
            validSets += 1
        End If
    Next
    If validSets = nGoal Then Exit Do
    randomSample(deck(), nDraw, drav())
Loop

Print "Dealt "; nDraw; " cards:"
For i = 0 To Ubound(drav)
    Print drav(i)
Next

Print !"\nContaining:"
For i = 0 To Ubound(sets)
    posic = 1
    For j = 0 To 2
        cards(j) = Mid(sets(i), posic, Instr(posic, sets(i), " | ") - posic)
        posic = Instr(posic, sets(i), " | ") + 3
    Next
    If isSet(cards()) Then
        For j = 0 To 2
            Print cards(j)
        Next
        Print
    End If
Next

Sleep