VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPatricWeight"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Ostergard, P.R.J., A new algorithm for the maximum-weight clique problem. Nordic Journal of Computing, Vol. 8. (2001) 424-436
' (without compresing graphs etc)

Private level_nodes() As Long, nStart() As Long, NodesNum() As Long
Private t As Long, mnMaxClique As Long, nMaxCliques() As Long
Private nLevelWAcc() As Long
'

Public Function Start() As Long
  Dim i As Long, t_minus_1 As Long, nn As Long, wt As Long
  
  ReDim level_nodes(1 To Nodes, 1 To Nodes, 0 To 1)
  ReDim NodesNum(1 To Nodes)
  ReDim nStart(1 To Nodes)
  ReDim nMaxCliques(1 To Nodes)
  
  mnMaxClique = 0
  '''''' each level has its own set of nodes
  For i = 1 To Nodes
    level_nodes(1, i, 0) = i
  Next
  NodesNum(1) = Nodes
  
  '''''''''''''''''''''''''''''''''''
  DefineClasses
  For i = 1 To Nodes
    level_nodes(1, i, 1) = i
  Next
  
  ReDim nLevelWAcc(1 To Nodes)
  
  For nn = Nodes To 1 Step -1
    t = 2
    NodesNum(t) = 0
    nLevelWAcc(t) = w(level_nodes(1, nn, 0))
    For i = nn + 1 To Nodes
      If arr(level_nodes(1, nn, 0), level_nodes(1, i, 0)) Then
        NodesNum(t) = NodesNum(t) + 1
        level_nodes(t, NodesNum(t), 0) = level_nodes(1, i, 0)
        level_nodes(t, NodesNum(t), 1) = level_nodes(1, i, 1)
      End If
    Next
    If NodesNum(t) = 0 Then
      t = t - 1
      If nLevelWAcc(t + 1) > mnMaxClique Then
        mnMaxClique = nLevelWAcc(t + 1)
      End If
    Else
      nStart(t) = 0
    End If
    
    While t >= 2
      nStart(t) = nStart(t) + 1
      
      If NodesNum(t) < nStart(t) Then
        t = t - 1
      Else
        wt = 0
        For i = nStart(t) To NodesNum(t)
          wt = wt + w(level_nodes(t, i, 0))
        Next
        
        ''' Degree control
        If (nLevelWAcc(t) + wt) > mnMaxClique And _
        (nLevelWAcc(t) + nMaxCliques(level_nodes(t, nStart(t), 1))) > mnMaxClique Then
          t_minus_1 = t
          t = t + 1
          nStart(t) = 0
          NodesNum(t) = 0
          nLevelWAcc(t) = nLevelWAcc(t_minus_1) + w(level_nodes(t_minus_1, nStart(t_minus_1), 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), 0), level_nodes(t_minus_1, i, 0)) Then
              NodesNum(t) = NodesNum(t) + 1
              level_nodes(t, NodesNum(t), 0) = level_nodes(t_minus_1, i, 0)
              level_nodes(t, NodesNum(t), 1) = level_nodes(t_minus_1, i, 1)
            End If
          Next
          If NodesNum(t) = 0 Then
            t = t - 1
            If nLevelWAcc(t + 1) > mnMaxClique Then
              mnMaxClique = nLevelWAcc(t + 1)
            End If
          End If
        Else
          t = t - 1
        End If
      End If
    Wend
    nMaxCliques(nn) = mnMaxClique
  Next
  
  ''' return size of maximu clique
  Start = mnMaxClique
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, nNodeNum As Long

  ReDim class_init(1 To Nodes)
  '''''
  mnRemainNodes = Nodes
  While True
    ''' build up new class
    bFirstNode = True
    ''' position of first node
    i = mnRemainNodes
    While i > 0
      ''' swap nodes
      nNodeNum = level_nodes(1, i, 0)
      If i <> mnRemainNodes Then
        ''' swap rows
        level_nodes(1, i, 0) = level_nodes(1, mnRemainNodes, 0)
        level_nodes(1, mnRemainNodes, 0) = nNodeNum
      End If
      
      mnRemainNodes = mnRemainNodes - 1
      If mnRemainNodes = 0 Then Exit Sub
      If bFirstNode Then
        For k = 1 To mnRemainNodes
          nkNode = level_nodes(1, k, 0)
          class_init(nkNode) = arr(nNodeNum, nkNode)
        Next
      Else
        For k = 1 To mnRemainNodes
          nkNode = level_nodes(1, k, 0)
          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, 0)) Then Exit For
      Next
    Wend
  Wend
    
End Sub