home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / a_Simply_G215187582009.psc / Class / simplyBrainsPOP.cls < prev    next >
Text File  |  2009-05-04  |  4KB  |  174 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "simplyBrainsPOP"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'Author : Creator Roberto Mior
  15. '     reexre@gmail.com
  16. '
  17. 'If you use source code or part of it please cite the author
  18. 'You can use this code however you like providing the above credits remain intact
  19. '
  20. '
  21. '
  22. '------------------------------------------------------------------------
  23. '
  24. 'This Class joint SimplyGA (a population for Genetic Algorithm)
  25. 'and NNParasChopra (a Neural Net)
  26. '
  27. '
  28. 'BrainPOP.InitBrains HowManyIndivids,HowManyBrainCellxIndi
  29. '
  30. 'BrainPOP.InitBrainCell 1, Array(2, 5, 1), 10
  31. 'BrainPOP.InitBrainCell 2, Array(2, 3, 1), 10
  32. '
  33. 'Dim Ga as new simplyGA
  34. 'GA.INIT HowManyIndivids, BrainPOP.GetNofTotalGenes+OtherEventualNotBrainGenes ,.......
  35. '
  36. 'every time and Indi Of GA is Changed (mutated or son) do
  37. 'BrainPOP.TransferGAGenesToBrain GA, changedIndivid
  38. '
  39.  
  40. Private Type tBrain
  41.     
  42.     NN() As New NNparasChopra
  43.     StartGene() As Long
  44.     
  45.     nnPiuMeno() As Double
  46.     
  47. End Type
  48.  
  49.  
  50. Private B() As tBrain
  51. Private NofBIndi As Long
  52. Private NofCELLsXIndi As Long
  53. Private NofGENEsXIndi As Long
  54.  
  55. Public Property Get GetNofTotalGenes()
  56. GetNofTotalGenes = NofGENEsXIndi
  57. End Property
  58.  
  59. Public Property Get GetNofIndi()
  60. GetNofIndi = NofBIndi
  61. End Property
  62.  
  63. Public Sub InitBrains(HowManyIndivids, NofBrainCellXIndivid)
  64.  
  65. NofBIndi = HowManyIndivids
  66. NofCELLsXIndi = NofBrainCellXIndivid
  67. ReDim B(NofBIndi)
  68. NofGENEsXIndi = 0
  69.  
  70. For I = 1 To NofBIndi
  71.     ReDim Preserve B(I).NN(NofCELLsXIndi)
  72.     ReDim Preserve B(I).StartGene(NofCELLsXIndi)
  73.     ReDim Preserve B(I).nnPiuMeno(NofCELLsXIndi)
  74. Next I
  75.  
  76. End Sub
  77.  
  78. Public Sub InitBrainCell(wCell, ArrayOFlyers As Variant, BiasAndWeightEscursion As Double, Optional Lrate As Double = 1.5)
  79. ' call this sub from lowest wCell to highest wCell Order
  80.  
  81. For I = 1 To NofBIndi
  82.     B(I).NN(wCell).CreateNet Lrate, ArrayOFlyers
  83.     B(I).StartGene(wCell) = NofGENEsXIndi + 1
  84.     B(I).nnPiuMeno(wCell) = BiasAndWeightEscursion
  85. Next
  86.  
  87.  
  88. NofGENEsXIndi = NofGENEsXIndi + _
  89.         B(1).NN(wCell).GetTotalNofNeurons + B(1).NN(wCell).GetTotalNofSinaps
  90.  
  91.  
  92.  
  93. End Sub
  94.  
  95. Public Function RUN(wIndivid, wBrainCell, ArrayOfInputs As Variant) As Variant
  96.  
  97. RUN = B(wIndivid).NN(wBrainCell).RUN(ArrayOfInputs)
  98.  
  99. End Function
  100.  
  101. Public Function GetNofInputs(wCell)
  102. GetNofInputs = B(1).NN(wCell).NofInputs
  103. End Function
  104. Public Function GetNofOutputs(wCell)
  105. GetNofOutputs = B(1).NN(wCell).NofOutputs
  106. End Function
  107. Private Function StretchValue(MinF, MaxF, MinT As Double, MaxT As Double, Value) As Double
  108.  
  109. Dim V As Double
  110.  
  111. V = (Value - MinF) / (MaxF - MinF)
  112. V = V * (MaxT - MinT) + MinT
  113.  
  114. StretchValue = V
  115.  
  116. End Function
  117.  
  118. Public Sub TransferGAGenesToBrain(GGAA As SimplyGA, INDI As Long)
  119. Dim G As Long
  120. Dim L
  121. Dim N
  122. Dim S
  123. Dim gFr
  124. Dim gTo
  125. Dim gVal As Long
  126. Dim vMinG
  127. Dim vMaxG
  128. Dim noN
  129. Dim noS
  130. Dim CellStartGene
  131. vMinG = GGAA.Get_gValueMin
  132. vMaxG = GGAA.Get_gValueMax
  133. Dim PiuMeno As Double
  134.  
  135.  
  136.  
  137. For wCell = 1 To NofCELLsXIndi
  138.     
  139.     CellStartGene = B(INDI).StartGene(wCell)
  140.     
  141.     PiuMeno = B(INDI).nnPiuMeno(wCell)
  142.     
  143.     noN = B(INDI).NN(wCell).GetTotalNofNeurons
  144.     noS = B(INDI).NN(wCell).GetTotalNofSinaps
  145.     
  146.     'Transer GA genes to Neuron Bias
  147.     
  148.     gFr = CellStartGene '1 'B(INDI).StartGene(wCell)
  149.     gTo = gFr + noN - 1
  150.     
  151.     For G = gFr To gTo
  152.         
  153.         gVal = GGAA.getGENE(INDI, G)
  154.         B(INDI).NN(wCell).MY_SETneuronBIAS(G - CellStartGene + 1) = _
  155.                 StretchValue(vMinG, vMaxG, -PiuMeno, PiuMeno, gVal)
  156.         
  157.     Next G
  158.     
  159.     'Transer GA genes to Sinap Weights
  160.     gFr = gTo + 1
  161.     gTo = gFr + noS - 1
  162.     
  163.     For G = gFr To gTo
  164.         gVal = GGAA.getGENE(INDI, G)
  165.         B(INDI).NN(wCell).MY_SETSinapsWEIGHT(G - noN - CellStartGene + 1) = _
  166.                 StretchValue(vMinG, vMaxG, -PiuMeno, PiuMeno, gVal)
  167.     Next
  168.     
  169. Next wCell
  170.  
  171.  
  172.  
  173. End Sub
  174.