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