classganeuron.cls

遗传算法和神经网络的结合应用

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

Const MaxConnections = 1000

Public ID As Integer
Public noOfConnections As Integer
Dim Connection(MaxConnections, 2) As Single
Dim ConnectionNeuron(MaxConnections) As ClassGAneuron
Public NeuronType As Integer
Public timeconst As Single
Public noise As Single
Public threshold As Single
Public State As Single
Public Bias As Single

Const CONNECTION_WEIGHT = 0
Const CONNECTION_NEURON_ID = 1


Public Sub Free()
  Dim i As Integer
  
  For i = 0 To noOfConnections - 1
    Set ConnectionNeuron(i) = Nothing
  Next
End Sub



Public Sub addConnection(fromNeuron As ClassGAneuron, weight As Single, nID As Integer)
'adds a new connection
  If (noOfConnections < MaxConnections) Then
    Connection(noOfConnections, CONNECTION_WEIGHT) = weight
    Connection(noOfConnections, CONNECTION_NEURON_ID) = nID
    Set ConnectionNeuron(noOfConnections) = fromNeuron
    noOfConnections = noOfConnections + 1
  End If
End Sub


Public Sub DeleteRandomConnection()
'deletes a connection at random
  Dim victim As Integer
  Dim i As Integer
  
  victim = CInt(Rnd * noOfConnections - 1)
  If (victim > 0) Then
    For i = victim + 1 To noOfConnections - 1
      Connection(i - 1, CONNECTION_WEIGHT) = Connection(i, CONNECTION_WEIGHT)
      Connection(i - 1, CONNECTION_NEURON_ID) = Connection(i, CONNECTION_NEURON_ID)
      Set ConnectionNeuron(i - 1) = ConnectionNeuron(i)
    Next
    noOfConnections = noOfConnections - 1
  End If
End Sub


Public Sub Mutate(alpha As Single, weight_saturation As Single)
'mutate the neuron parameters
  Dim w As Single
  Dim i As Integer

  'Parametric mutations - node parameters
  timeconst = timeconst + N(alpha)
  If (timeconst < 1#) Then
    timeconst = 1#
  End If
  noise = noise + N(alpha)  'note: noise is the percentage of random noise in the system
  If (noise < -0.1) Then
    noise = -0.1
  End If
  If (noise > 0.1) Then
    noise = 0.1
  End If
  threshold = threshold + N(alpha)
  If (threshold < -1#) Then
    threshold = -1#
  End If
  If (threshold > 1#) Then
    threshold = 1#
  End If
  Bias = Bias + N(alpha)
  If (Bias < -1#) Then
    Bias = -1#
  End If
  If (Bias > 1#) Then
    Bias = 1#
  End If
  'parametric_mutations - weights
  For i = 0 To noOfConnections - 1
    w = Connection(i, CONNECTION_WEIGHT)
    w = w + (N(alpha) / noOfConnections)
    If (w <= weight_saturation) Then
      w = -weight_saturation
    End If
    If (w > weight_saturation) Then
      w = weight_saturation
    End If
    Connection(i, CONNECTION_WEIGHT) = w
  Next
  
End Sub


Public Sub Copy(Dest As ClassGAneuron)
'makes a copy of this neuron
  Dim i As Integer
  
  Dest.ID = ID
  Dest.noOfConnections = 0
  For i = 0 To noOfConnections - 1
    Call Dest.addConnection(ConnectionNeuron(i), Connection(i, CONNECTION_WEIGHT), Val(Connection(i, CONNECTION_NEURON_ID)))
  Next
  Dest.NeuronType = NeuronType
  Dest.timeconst = timeconst
  Dest.noise = noise
  Dest.threshold = threshold
  Dest.Bias = Bias
End Sub


Public Sub Save(fileNumber As Integer)
'saves the parameters for this neuron
  Dim i As Integer
  
  Print #fileNumber, noOfConnections
  For i = 0 To noOfConnections - 1
    Print #fileNumber, Connection(i, CONNECTION_NEURON_ID)
    Print #fileNumber, Connection(i, CONNECTION_WEIGHT)
  Next
  Print #fileNumber, NeuronType
  Print #fileNumber, timeconst
  Print #fileNumber, noise
  Print #fileNumber, threshold
  Print #fileNumber, Bias
  Print #fileNumber, ID
End Sub


Public Sub Load(fileNumber As Integer)
'loads the parameters for this neuron
'the Reconnect fnction must be called later to connect to the input neurons
  Dim i As Integer
  Dim nID As Integer
  Dim nw As Single
  
  Input #fileNumber, noOfConnections
  For i = 0 To noOfConnections - 1
    Input #fileNumber, nID
    Connection(i, CONNECTION_NEURON_ID) = nID
    Input #fileNumber, nw
    Connection(i, CONNECTION_WEIGHT) = nw
    Set ConnectionNeuron(i) = New ClassGAneuron
  Next
  Input #fileNumber, NeuronType
  Input #fileNumber, timeconst
  Input #fileNumber, noise
  Input #fileNumber, threshold
  Input #fileNumber, Bias
  Input #fileNumber, ID
End Sub


Public Sub renumberConnections()
'updates the neuron IDs on connections
  Dim i As Integer
  
  For i = 0 To noOfConnections - 1
    Connection(i, CONNECTION_NEURON_ID) = ConnectionNeuron(i).ID
  Next
End Sub


Public Sub removeConnectionsToNeuron(nID As Integer)
'removes any connections to a neuron with the given ID
  Dim i As Integer
  Dim j As Integer
  Dim newNoOfConnections As Integer
  Dim NewConnection(MaxConnections, 2) As Single
  Dim NewConnectionNeuron(MaxConnections) As ClassGAneuron
  
  i = 0
  While (i < noOfConnections) And (Connection(i, CONNECTION_NEURON_ID) <> nID)
    i = i + 1
  Wend
  
  If (i < noOfConnections) Then
    
    newNoOfConnections = 0
    For i = 0 To noOfConnections - 1
      If (Connection(i, CONNECTION_NEURON_ID) <> nID) Then
        NewConnection(newNoOfConnections, CONNECTION_NEURON_ID) = Connection(i, CONNECTION_NEURON_ID)
        NewConnection(newNoOfConnections, CONNECTION_WEIGHT) = Connection(i, CONNECTION_NEURON_ID)
        Set NewConnectionNeuron(newNoOfConnections) = ConnectionNeuron(i)
        newNoOfConnections = newNoOfConnections + 1
      End If
    Next
  
    For i = 0 To newNoOfConnections - 1
      Connection(i, CONNECTION_NEURON_ID) = NewConnection(i, CONNECTION_NEURON_ID)
      Connection(i, CONNECTION_WEIGHT) = NewConnection(i, CONNECTION_NEURON_ID)
      Set ConnectionNeuron(i) = NewConnectionNeuron(i)
    Next
    noOfConnections = newNoOfConnections
  End If
  
End Sub


Public Sub Reconnect(net As ClassGAnet)
'reconnects based on neuron IDs
  Dim i As Integer
  Dim nID As Integer
  
  For i = 0 To noOfConnections - 1
    nID = Connection(i, CONNECTION_NEURON_ID)
    Set ConnectionNeuron(i) = net.getNeuron(nID)
  Next
End Sub


Public Sub RandomNeuron(net As ClassGAnet)
'creates a random neuron with random connections
  Dim i As Integer
  Dim c As Integer
  Dim fromNeuron As ClassGAneuron
  
  timeconst = 1
  noise = Rnd * 0.1
  threshold = Rnd * 0.5
  noOfConnections = 0
  Bias = Rnd
  
  'create some connections
  c = CInt(Rnd * 4)
  For i = 1 To c
    Set fromNeuron = net.getRandomNeuron
    Call addConnection(fromNeuron, Rnd - 0.5, fromNeuron.ID)
  Next
End Sub


Public Sub Update()
  On Error GoTo Update_err
  
  Dim adder As Single
  Dim i As Integer
  
  adder = Bias
  For i = 0 To noOfConnections - 1
    adder = adder + (Connection(i, CONNECTION_WEIGHT) * ConnectionNeuron(i).State)
  Next
  State = function_sigmoid(adder) + (Rnd * noise)
  
Update_exit:
  Exit Sub
Update_err:
  MsgBox "classGAneuron/Update/" & Error$(Err) & "/" & Err, , "Error"
  Resume Update_exit
End Sub