Public Class cBoltzmann

Private nCities As Integer
Private mUnits As Integer
Private mOutput() As Boolean
Private mOn() As Integer
Private mOff() As Integer
Private mThreshold() As Single
Private mWeight(,) As Single
Private mTemperature As Single
Private mGamma As Single
Private mDistance(,) As Single

Public Sub New(ByVal NumCities As Integer, _
               ByVal InitialTemperature As Single, _
               ByVal GammaValue As Single)

    nCities = NumCities
    mUnits = nCities * nCities
    mTemperature = InitialTemperature
    mGamma = GammaValue

    ReDim mOutput(mUnits)
    ReDim mOn(mUnits)
    ReDim mOff(mUnits)
    ReDim mThreshold(mUnits)
    ReDim mWeight(mUnits, mUnits)
    ReDim mDistance(nCities, nCities)

End Sub

Public Sub CalcWeights()
Dim i, j, n1, n2, n3, n4 As Integer
Dim Pred_n3, Succ_n3 As Integer
Dim Weight As Single

    For n1 = 0 To nCities - 1
        For n2 = 0 To nCities - 1
            i = n1 * nCities + n2
            For n3 = 0 To nCities - 1
                For n4 = 0 To nCities - 1
                    j = n3 * nCities + n4
                    Weight = 0.0
                    If i <> j Then
                        If n3 = 0 Then
                            Pred_n3 = nCities - 1
                        Else
                            Pred_n3 = n3 - 1
                        End If
                        If n3 = nCities - 1 Then
                            Succ_n3 = 0
                        Else
                            Succ_n3 = n3 + 1
                        End If
                        If (n1 = n3) Or (n2 = n4) Then
                            Weight = -mGamma
                        ElseIf (n1 = Pred_n3) Or (n1 = Succ_n3) Then
                            Weight = -mDistance(n2, n4)
                        End If
                    End If
                    mWeight(i, j) = Weight
                Next n4
            Next n3
            mThreshold(i) = (-mGamma / 2)
        Next n2
    Next n1

End Sub

Public Sub SetRandom()
Dim i As Integer
    For i = 0 To mUnits - 1
        mOutput(i) = RandomEqualBool()
    Next i
End Sub

Public Sub ReduceHeat()
Dim index As Integer
Dim i, n As Integer
    For i = 0 To mUnits - 1
        mOn(i) = 0
        mOff(i) = 0
    Next i

    For n = 0 To 999 * mUnits - 1
        index = RandomEqualInt(0, mUnits - 1)
        PropagateUnit(index)
    Next n

    For n = 0 To 99 * mUnits - 1
        index = RandomEqualInt(0, mUnits - 1)
        PropagateUnit(index)
        If mOutput(index) Then
            mOn(index) += 1
        Else
            mOff(index) += 1
        End If
    Next n

    For i = 0 To mUnits - 1
        mOutput(i) = (mOn(i) > mOff(i))
    Next i
End Sub

Public Sub PropagateUnit(ByVal i As Integer)
Dim Sum As Single = 0.0
Dim Probability As Single
Dim j As Integer
    For j = 0 To mUnits - 1
        If mOutput(j) = True Then
            Sum += mWeight(i, j) * 1
        Else
            Sum += mWeight(i, j) * 0
        End If
    Next j
    Sum -= mThreshold(i)

    Probability = 1 / (1 + Math.Exp(-Sum / mTemperature))

    If Rnd() <= Probability Then
        mOutput(i) = True
    Else
        mOutput(i) = False
    End If
End Sub

Public Function LengthOfTour() As Single
Dim Length As Single
Dim n1, n2, n3 As Integer

    Length = 0.0
    For n1 = 0 To nCities - 1
        For n2 = 0 To nCities - 1
            If mOutput(((n1) Mod nCities) * nCities + n2) Then
                Exit For
            End If
        Next n2

        For n3 = 0 To nCities - 1
            If mOutput(((n1 + 1) Mod nCities) * nCities + n3) Then
                Exit For
            End If
        Next n3
        Length += mDistance(n2, n3)
    Next n1

    Return Length

End Function

Public ReadOnly Property Cities()
    Get
        Return nCities
    End Get
End Property

Public Property Units() As Integer
    Get
        Return mUnits
    End Get
    Set(ByVal Value As Integer)
        mUnits = Value
    End Set
End Property

Public Property Output(ByVal index As Integer) As Boolean
    Get
        Return mOutput(index)
    End Get
    Set(ByVal Value As Boolean)
        mOutput(index) = Value
    End Set
End Property

Public Property NodeOn(ByVal index As Integer) As Integer
    Get
        Return mOn(index)
    End Get
    Set(ByVal Value As Integer)
        mOn(index) = Value
    End Set
End Property

Public Property NodeOff(ByVal index As Integer) As Integer
    Get
        Return mOff(index)
    End Get
    Set(ByVal Value As Integer)
        mOff(index) = Value
    End Set
End Property

Public Property Threshold(ByVal index As Integer) As Single
    Get
        Return mThreshold(index)
    End Get
    Set(ByVal Value As Single)
        mThreshold(index) = Value
    End Set
End Property

Public Property Weight(ByVal x As Integer, ByVal y As Integer) As Single
    Get
        Return mWeight(x, y)
    End Get
    Set(ByVal Value As Single)
        mWeight(x, y) = Value
    End Set
End Property

Public Property Temperature() As Single
    Get
        Return mTemperature
    End Get
    Set(ByVal Value As Single)
        mTemperature = Value
    End Set
End Property

Public Property Distance(ByVal x As Integer, ByVal y As Integer) As Single
    Get
        Return mDistance(x, y)
    End Get
    Set(ByVal Value As Single)
        mDistance(x, y) = Value
    End Set
End Property

Private Function RandomEqualBool() As Boolean
    If Rnd() >= 0.5 Then
        Return True
    Else
        Return False
    End If
End Function

Private Function RandomEqualInt(ByVal Low As Integer, ByVal High As Integer) _
                                                                    As Integer
    Return CInt(Int((High * Rnd()) + Low))
End Function

Private Function RandomEqualSingle(ByVal Low As Single, ByVal High As Single) _
                                                                    As Single
    Return CSng((High * Rnd()) + Low)
End Function

End Class 'cBoltzmann