Option Explicit
 
' Optimised Carraghan, R., Pardalos, P. M. algorithm
' by using a heuristic vertex colouring classes for pruning
 
Private moClasses() As Long, mnClassesCount As Long
Private nLevelDegree() As Long
Private level_nodes() As Long, nStart() As Long, NodesNum() As Long
Private t As Long, mnMaxClique As Long
'
 
Public Function Start() As Long
  Dim i As Long, t_minus_1 As Long
  
  ReDim level_nodes(1 To Nodes, 1 To Nodes)
  
  mnMaxClique = 0
  '''''' each level has its own set of nodes
  For i = 1 To Nodes
    level_nodes(1, i) = i
  Next
  
  '''''
  DefineClasses
  
  ReDim NodesNum(1 To mnClassesCount)
  ReDim nStart(1 To mnClassesCount)
  ReDim nLevelDegree(1 To mnClassesCount)
  NodesNum(1) = Nodes
 
  t = 1
  nStart(t) = 0
  '''''''''''''''''''''''''''''''''''
  While t >= 1
    nStart(t) = nStart(t) + 1
    
    ''' Degree control
    If NodesNum(t) < nStart(t) Then
      t = t - 1
    Else
      ''' if it is not first node (for fist node degree can not be adjusted)
      ''' and prev. node class is not the same then decrease degree
      ''' (can be done since vertices are sorted
      ''' and if cur. vertex class is not the same as for previous then
      ''' the prev. class is not any longer existing)
      If nStart(t) > 1 Then
        If (moClasses(level_nodes(t, nStart(t))) <> moClasses(level_nodes(t, nStart(t) - 1))) Then
          nLevelDegree(t) = nLevelDegree(t) - 1
        End If
      Else
        ''' calculate degree on new depth
        nLevelDegree(t) = LevelDegree()
      End If
      If (t - 1 + nLevelDegree(t)) > mnMaxClique Then
        t_minus_1 = t
        t = t + 1
        nStart(t) = 0
        NodesNum(t) = 0
        ''' define nodes for the next level
        For i = nStart(t_minus_1) + 1 To NodesNum(t_minus_1)
          If arr(level_nodes(t_minus_1, nStart(t_minus_1)), level_nodes(t_minus_1, i)) Then
            NodesNum(t) = NodesNum(t) + 1
            level_nodes(t, NodesNum(t)) = level_nodes(t_minus_1, i)
          End If
        Next
        If NodesNum(t) = 0 Then
          t = t - 1
          If t > mnMaxClique Then
            mnMaxClique = t
          End If
        End If
            
      Else
        t = t - 1
      End If
    End If
  
  Wend
  
  ''' return size of maximum clique
  Start = mnMaxClique
End Function
 
Private Function LevelDegree() As Long
  Dim res As Long, i As Long, nClass As Long, aClass As Long
    
    For i = nStart(t) To NodesNum(t)
      ''' for node on level define class (moClasses) and mark it as existing
      nClass = moClasses(level_nodes(t, i))
      If nClass <> aClass Then
        aClass = nClass
        res = res + 1
      End If
    Next
    
  LevelDegree = res
End Function
 
Private Sub DefineClasses()
  Dim class_init() As Boolean '' show if node exist
  Dim i As Long, k As Long
  Dim mnRemainNodes As Long, bFirstNode As Boolean, nkNode As Long
  Dim nNodeNum As Long
    
  mnClassesCount = 0
  ReDim class_init(1 To Nodes)
  ''' get info about existing nodes
  ReDim moClasses(1 To Nodes)
  '''''
  mnRemainNodes = Nodes
  While True
    ''' build up new class
    mnClassesCount = mnClassesCount + 1
    bFirstNode = True
    ''' position of first node
    i = mnRemainNodes
    While i > 0
      ''' swap nodes
      nNodeNum = level_nodes(1, i)
      If i <> mnRemainNodes Then
        ''' swap rows
        level_nodes(1, i) = level_nodes(1, mnRemainNodes)
        level_nodes(1, mnRemainNodes) = nNodeNum
      End If
      '''
      moClasses(nNodeNum) = mnClassesCount
      
      mnRemainNodes = mnRemainNodes - 1
      If mnRemainNodes = 0 Then Exit Sub

      If bFirstNode Then
        For k = 1 To mnRemainNodes
          nkNode = level_nodes(1, k)
          class_init(nkNode) = arr(nNodeNum, nkNode)
        Next
      Else
        For k = 1 To mnRemainNodes
          nkNode = level_nodes(1, k)
          class_init(nkNode) = arr(nNodeNum, nkNode) Or class_init(nkNode)
        Next
      End If
      bFirstNode = False
      For i = mnRemainNodes To 1 Step -1
        If Not class_init(level_nodes(1, i)) Then Exit For
      Next
    Wend
  Wend
End Sub