My current code finds the vertex cover for five nodes. How would I generalize it to any number of nodes? Should I try recursion?

Question

I am writing a code for a project that is trying to find the minimum solution to the Vertex Cover Problem: Given a graph, find the minimum number of vertices needed to cover the graph.

I am trying to write a program for a brute force search through the entire solution space. Right now, my code works by doing the following:

Example using 4 nodes:

• Check Every Single Node: Solution Space: {1}, {2}, {3}, {4}
• Check Every Couple of Nodes: Solution Space: {1,2}, {1,3}, {1,4}, {2,3}, {2,4}, {3,4}
• Check Every Triple of Nodes: Solution Space: {1,2,3}, {1,2,4}, {2,3,4}
• Check Every Quadruple of Nodes: Solution Space: {1,2,3,4}

Currently, my code works for 5 nodes. The problem is that it searches through these permutations using a fixed number of nested while loops. If I wanted to run 6 nodes, I would need to add in another While loop. I am trying to generalize the code so that the number of nodes can itself be a variable.

The code finds a solution by triggering a row of binary numbers based on the solution space above, eg if the solution being tried is {1,2,4} then the first, second, and fourth binary value will be set to equal 1 while the third is set to 0. A matrix is set up to use these inputs to determine if they cover the graph. Here is a picture further showing how this works.

Any ideas on how to generalize this to any number of nodes? Thoughts on recursion?

Also, note in the code there is a section that waits for 1 second. This is just for aesthetics, it is not serving any purpose besides making the code fun to watch.

i = 0
j = 0
k = 0
m = 0

Range("Z22").Select

While i < 5 'Checks to see if a single vertice can cover the graph.


    Cells(5, 20 + i).Value = 1
    Application.Wait (Now + TimeValue("0:00:1"))
    If Cells(21, 13).Value = Cells(22, 26).Value Then

        GoTo Line1

    Else
        Cells(5, 20 + i) = 0
        i = i + 1
    End If

Wend

i = 0

While i < 4 'Checks to see if two vertices can cover the graph

Cells(5, 20 + i).Value = 1
j = i + 1


 While j < 5

      Cells(5, 20 + j).Value = 1
      Application.Wait (Now + TimeValue("0:00:1"))
    If Cells(21, 13).Value = Cells(22, 26).Value Then

        GoTo Line1

    Else
        Cells(5, 20 + j) = 0
        j = j + 1
    End If

 Wend

Cells(5, 20 + i) = 0
i = i + 1

Wend


k = 0


While k < 3 'Checks to see if three vertices can cover the graph

Cells(5, 20 + k) = 1
 i = k + 1
    While i < 4

    Cells(5, 20 + i).Value = 1
    j = i + 1


        While j < 5

             Cells(5, 20 + j).Value = 1
             Application.Wait (Now + TimeValue("0:00:1"))
           If Cells(21, 13).Value = Cells(22, 26).Value Then

               GoTo Line1

           Else
               Cells(5, 20 + j) = 0
               j = j + 1
           End If

        Wend

    Cells(5, 20 + i) = 0
    i = i + 1

      Wend

Cells(5, 20 + k).Value = 0
k = k + 1

Wend



While m < 2 'Checks to see if four vertices can cover the graph

Cells(5, 20 + m).Value = 1
 k = m + 1
    While k < 3

    Cells(5, 20 + k) = 1
     i = k + 1
        While i < 4

        Cells(5, 20 + i).Value = 1
        j = i + 1


            While j < 5

                 Cells(5, 20 + j).Value = 1
                 Application.Wait (Now + TimeValue("0:00:1"))
               If Cells(21, 13).Value = Cells(22, 26).Value Then

                   GoTo Line1

               Else
                   Cells(5, 20 + j) = 0
                   j = j + 1
               End If

            Wend

        Cells(5, 20 + i) = 0
        i = i + 1

          Wend

    Cells(5, 20 + k).Value = 0
    k = k + 1

    Wend

Cells(5, 20 + m).Value = 0
m = m + 1

Wend



If Cells(21, 13).Value <> Cells(22, 26).Value Then 'Final effort
    Range("T5:X5") = 1
    MsgBox ("It takes all five vertices.")

End If





Line1:
 Application.DisplayAlerts = True

End Sub

Answer 1

This makes combinations for any n; does not use recursion. I've got to think if recursion would be applicable (make it simpler?)

Option Explicit

Const nnodes = 6
Dim a&(), icol&

Sub Main()
  ThisWorkbook.Sheets("sheet1").Activate
  Cells.Delete
  Dim i&, j&
  For i = 1 To nnodes ' from 1 to nnodes
    ReDim a(i)
    For j = 1 To i ' -- start with 1 up
      a(j) = j
    Next j
    Cells(i, 1) = i ' show
    icol = 2 ' for show
    Do ' -- show combination and get next combination
    Loop While doi(i)
  Next i
End Sub

Function doi(i) As Boolean ' show and get next
  Dim j&, s$
  For j = 1 To i ' build string for show
    If j > 1 Then s = s & ","
    s = s & Str$(a(j))
  Next j
  Cells(i, icol) = "{" & s & "}" ' show
  icol = icol + 1
  ' -- get next combination (if)
  For j = i To 1 Step -1 ' check if any more
    If a(j) < nnodes - i + j Then Exit For
  Next j
  If j < 1 Then doi = False: Exit Function ' no more
  a(j) = a(j) + 1 ' build next combination
  While j < i
    a(j + 1) = a(j) + 1
    j = j + 1
  Wend
  doi = True
End Function

EDIT: Changed "permutation" to "combination".
EDIT2: I kept coming back to recursion -- it does simplify the code:

Option Explicit

Dim icol& ' for showing combinations

Sub Main() ' get (non-empty) partitions of nnodes
  Const nnodes = 6
  Dim k&
  ThisWorkbook.Sheets("sheet2").Activate
  Cells.Delete
  For k = 1 To nnodes ' k = 1 to n
    Cells(k, 1) = k ' for showing
    icol = 2
    Call Comb("", 0, 1, nnodes, k) ' combinations(n,k)
  Next k
End Sub

Sub Comb(s$, lens&, i&, n&, k&) ' build combination
  Dim s2$, lens2&, j&
  For j = i To n + lens + 1 - k '
    If lens = 0 Then s2 = s Else s2 = s & ", "
    s2 = s2 & j
    lens2 = lens + 1
    If lens2 = k Then ' got it?
      Cells(k, icol) = "{" & s2 & "}" ' show combination
      icol = icol + 1
    Else
      Call Comb(s2, lens2, j + 1, n, k) ' recurse
    End If
  Next j
End Sub