Домино - QBasic

Формулировка задачи:

Вот реально наскучили однотипные задачи от

echs

, замешанные на рекурсии особенно. Есть же и другие приёмы программирования. Вот известен ли вам метод бэктрекинг? Задача такая: Из стандартного набора домино ( кто не знает, 28 штук = 0-0, 0-1, 0-2 ... 6-6) в случайном порядке берём N штук. Задача компьютера выстроить максимально возможную цепочку, состыковывая их по правилам домино частями с равным количеством точек.

Пример

N= 6 1-2:1-3:2-6:3-6:5-6:4-4

Решение

Цепочка из 5 элементов 5-6:6-2:2-1:1-3:3-6 Кто сможет решить любым способом, не обязательно при помощи бэктрекинга, главное правильно и эффективно?

Решение задачи: «Домино»

textual
                            Листинг программы 
                        

                            Dim s, b() As Boolean, n As Long, m As String, k As Long, l As Long
 
Sub main()
    m = ""
    k = 0
    l = 0
    s = Array("1-2", "1-3", "2-6", "3-6", "5-6", "4-4")
    n = UBound(s)
    ReDim b(n) As Boolean
    domino "", ""
    Debug.Print Mid$(m, 2)
    'Debug.Print "Всего вариантов: " & l, "из них с максимальной последовательностью: " & k
End Sub
 
Sub domino(txt As String, ms As String)
    Dim i As Long, flag As Boolean
    For i = 0 To n
        If (b(i) = False And (Right(txt, 1) = Left(s(i), 1) Or Right(txt, 1) = Right(s(i), 1))) Or txt = "" Then
            flag = True
            b(i) = True
            If Right(txt, 1) = Right(s(i), 1) Then domino StrReverse(s(i)), ms & ":" & StrReverse(s(i)) Else domino CStr(s(i)), ms & ":" & s(i)
            b(i) = False
        End If
    Next i
    If Not flag Then
        If Len(m) < Len(ms) Then m = ms: k = 0
        If Len(ms) = Len(m) Then k = k + 1
        l = l + 1
    End If
End Sub
                        