home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Neural_Net1771147182004.psc / modNN.bas < prev   
BASIC Source File  |  2003-01-05  |  6KB  |  133 lines
  1. Attribute VB_Name = "modNN"
  2. 'Don't forget to write option base 1 into the code
  3. ' or else this net will not work
  4.  
  5. 'Coded by Paras Chopra
  6. 'paraschopra@lycos.com
  7. 'http://naramcheez.netfirms.com
  8.  
  9. 'Please don't forget to give comments, credits and most important your VOTE!
  10.  
  11. Option Base 1
  12. Option Explicit
  13.  
  14. Const e = 2.7183 'Mathematical const, used in sigmod function
  15.  
  16. Private Type Dendrite ' Dendrite connects one neuron to another and allows signal to pass from it
  17. Weight As Double 'Weight it has
  18. End Type
  19.  
  20. Private Type Neuron 'The main thing
  21. Dendrites() As Dendrite 'Array of Denrites
  22. DendriteCount As Long 'Number of dendrites
  23. Bias As Double 'The bias
  24. Value As Double 'The value to be passed to next layer of neurons
  25. Delta As Double 'The delta of neuron (used while learning)
  26. End Type
  27.  
  28.  
  29.  
  30. Private Type Layer 'Layer contaning number of neurons
  31. Neurons() As Neuron 'Neurons in the layer
  32. NeuronCount As Long 'Number of neurons
  33. End Type
  34.  
  35. Private Type NeuralNetwork
  36. Layers() As Layer 'Layers in the network
  37. LayerCount As Long 'Number of layers
  38. LearningRate As Double 'The learning rateof the network
  39. End Type
  40.  
  41. Dim Network As NeuralNetwork ' Our main network
  42.  
  43. Function CreateNet(LearningRate As Double, ArrayOfLayers As Variant) As Integer '0 = Unsuccesful and 1 = Successful
  44. Dim i, j, k As Integer
  45. Network.LayerCount = UBound(ArrayOfLayers) 'Init number of layers
  46. If Network.LayerCount < 2 Then 'Input and output layers must be there
  47.     CreateNet = 0 'Unsuccessful
  48.     Exit Function
  49. End If
  50. Network.LearningRate = LearningRate 'The learning rate
  51. ReDim Network.Layers(Network.LayerCount) As Layer 'Redim the layers variable
  52. For i = 1 To UBound(ArrayOfLayers) ' Initialize all layers
  53. DoEvents
  54.     Network.Layers(i).NeuronCount = ArrayOfLayers(i)
  55.     ReDim Network.Layers(i).Neurons(Network.Layers(i).NeuronCount) As Neuron
  56.     For j = 1 To ArrayOfLayers(i) 'Initialize all neurons
  57.     DoEvents
  58.         If i = UBound(ArrayOfLayers) Then 'We will not init dendrites for it because output layers doesn't have any
  59.             Network.Layers(i).Neurons(j).Bias = GetRand 'Set the bias to random value
  60.             Network.Layers(i).Neurons(j).DendriteCount = ArrayOfLayers(i - 1)
  61.             ReDim Network.Layers(i).Neurons(j).Dendrites(Network.Layers(i).Neurons(j).DendriteCount) As Dendrite 'Redim the dendrite var
  62.             For k = 1 To ArrayOfLayers(i - 1)
  63.                 DoEvents
  64.                 Network.Layers(i).Neurons(j).Dendrites(k).Weight = GetRand 'Set the weight of each dendrite
  65.             Next k
  66.         ElseIf i = 1 Then 'Only init dendrites not bias
  67.             DoEvents 'Do nothing coz it is input layer
  68.         Else
  69.             Network.Layers(i).Neurons(j).Bias = GetRand 'Set the bias to random value
  70.             Network.Layers(i).Neurons(j).DendriteCount = ArrayOfLayers(i - 1)
  71.             ReDim Network.Layers(i).Neurons(j).Dendrites(Network.Layers(i).Neurons(j).DendriteCount) As Dendrite 'Redim the dendrite var
  72.             For k = 1 To ArrayOfLayers(i - 1)
  73.                 DoEvents
  74.                 Network.Layers(i).Neurons(j).Dendrites(k).Weight = GetRand 'Set the weight of each dendrite
  75.             Next k
  76.         End If
  77.     Next j
  78. Next i
  79. CreateNet = 1
  80. End Function
  81.  
  82.  
  83. Function Run(ArrayOfInputs As Variant) As Variant 'It returns the output inf form of array
  84. Dim i, j, k As Integer
  85. If UBound(ArrayOfInputs) <> Network.Layers(1).NeuronCount Then
  86.     Run = 0
  87.     Exit Function
  88. End If
  89. For i = 1 To Network.LayerCount
  90. DoEvents
  91.     For j = 1 To Network.Layers(i).NeuronCount
  92.     DoEvents
  93.         If i = 1 Then
  94.             Network.Layers(i).Neurons(j).Value = ArrayOfInputs(j) 'Set the value of input layer
  95.         Else
  96.             Network.Layers(i).Neurons(j).Value = 0 'First set the value to zero
  97.             For k = 1 To Network.Layers(i - 1).NeuronCount
  98.                 DoEvents
  99.                 Network.Layers(i).Neurons(j).Value = Network.Layers(i).Neurons(j).Value + Network.Layers(i - 1).Neurons(k).Value * Network.Layers(i).Neurons(j).Dendrites(k).Weight 'Calculating the value
  100.             Next k
  101.         Network.Layers(i).Neurons(j).Value = Activation(Network.Layers(i).Neurons(j).Value + Network.Layers(i).Neurons(j).Bias) 'Calculating the real value of neuron
  102.         'Network.Layers(i).Neurons(j).Value = tanh(Network.Layers(i).Neurons(j).Value + Network.Layers(i).Neurons(j).Bias) 'Calculating the real value of neuron
  103.         End If
  104.     Next j
  105. Next i
  106. ReDim OutputResult(Network.Layers(Network.LayerCount).NeuronCount) As Double
  107. For i = 1 To (Network.Layers(Network.LayerCount).NeuronCount)
  108.     DoEvents
  109.     OutputResult(i) = (Network.Layers(Network.LayerCount).Neurons(i).Value) 'The array of output result
  110. Next i
  111. Run = OutputResult
  112. End Function
  113.  
  114. Function SupervisedTrain(inputdata As Variant, outputdata As Variant) As Integer '0=unsuccessful and 1 = sucessful
  115. Dim i, j, k As Integer
  116. If UBound(inputdata) <> Network.Layers(1).NeuronCount Then 'Check if correct amount of input is given
  117.     SupervisedTrain = 0
  118.     Exit Function
  119. End If
  120. If UBound(outputdata) <> Network.Layers(Network.LayerCount).NeuronCount Then 'Check if correct amount of output is given
  121.     SupervisedTrain = 0
  122.     Exit Function
  123. End If
  124. Call Run(inputdata) 'Calculate values of all neurons and set the input
  125. 'Calculate delta's
  126. For i = 1 To Network.Layers(Network.LayerCount).NeuronCount
  127. DoEvents
  128.     Network.Layers(Network.LayerCount).Neurons(i).Delta = Network.Layers(Network.LayerCount).Neurons(i).Value * (1 - Network.Layers(Network.LayerCount).Neurons(i).Value) * (outputdata(i) - Network.Layers(Network.LayerCount).Neurons(i).Value) 'Deltas of Output layer
  129.     For j = Network.LayerCount - 1 To 2 Step -1
  130.     DoEvents
  131.         For k = 1 To Network.Layers(j).NeuronCount
  132.         DoEvents
  133.             Network.Layers(j).Neurons(k).Delta = Network.Layers(j).Neurons(k).Value * (1 - Network.Layers(j).Neurons(k).Value) * Network.Layers(j + 1).Neurons(i).Dendrites(k).Weight Neurons(k).Value * (1 - Network.Layers(jns(i).Dendrites(k).Weight Neurons(k)b   u      tdata) 'Calculate     tda)twork.Layers(i).rn