I am currently working on getting this code to operate as a POF, but it seems if the sizing of the layers are not correct then the network will not work to begin with. This sample using 2/4/2 appears to work fine and once trained works properly.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 |
Public Class Form1 Public Shared r As New Random() Dim network As NeuralNetwork Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim layerList As New List(Of Integer) With layerList .Add(2) .Add(4) .Add(2) End With network = New NeuralNetwork(1.0, layerList) ''''Question 1 Dim inputs As New List(Of Double) inputs.Add(0) inputs.Add(1) ''''Answer to 1 Dim Trainedoutputs As New List(Of Double) Trainedoutputs.Add(1) Trainedoutputs.Add(0) '''Question 2 Dim inputs2 As New List(Of Double) inputs2.Add(1) inputs2.Add(0) '''Answer to 2 Dim Trainedoutputs2 As New List(Of Double) Trainedoutputs2.Add(0) Trainedoutputs2.Add(1) OutputNetwork(network) Debug.WriteLine("=Before training=") Button1_Click(Nothing, Nothing) Debug.WriteLine("=================") Dim TotalCycles As Integer = 600000 For i = 0 To TotalCycles If i <> 0 AndAlso i Mod 100000 = 0 Then Dim ots As List(Of Double) = network.Execute(inputs) Debug.WriteLine(ots(0)) Debug.WriteLine(ots(1)) Debug.WriteLine(i & "-" & CDbl(100 / (TotalCycles / i)) & "%") End If network.Train(inputs, Trainedoutputs) network.Train(inputs2, Trainedoutputs2) Next Debug.WriteLine("=After training=") Button1_Click(Nothing, Nothing) Debug.WriteLine("=================") OutputNetwork(network) End Sub Private Sub OutputNetwork(NN As NeuralNetwork) For ii = NN.LayerCount - 1 To 0 Step -1 Debug.WriteLine("Layer: " & ii) For jj = 0 To NN.Layers(ii).NeuronCount - 1 Dim iNeuron As Neuron = NN.Layers(ii).Neurons(jj) Debug.WriteLine("Neruon: " & jj & " Bias: " & iNeuron.Bias) For kk = 0 To iNeuron.DendriteCount - 1 Debug.WriteLine(vbTab & iNeuron.Dendrites(kk).Weight) Next kk Next jj Next ii End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim inputs As New List(Of Double) inputs.Add(0) inputs.Add(1) Dim ots As List(Of Double) = network.Execute(inputs) Debug.WriteLine(ots(0)) Debug.WriteLine(ots(1)) End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim inputs2 As New List(Of Double) inputs2.Add(1) inputs2.Add(0) Dim ots2 As List(Of Double) = network.Execute(inputs2) Debug.WriteLine(ots2(0)) Debug.WriteLine(ots2(1)) End Sub End Class Public Class Dendrite Dim r As New Random Dim _weight As Double Property Weight As Double Get Return _weight End Get Set(value As Double) _weight = value End Set End Property Public Sub New() Me.Weight = r.NextDouble() End Sub End Class Public Class Neuron Dim r As New Random Dim _dendrites As New List(Of Dendrite) Dim _dendriteCount As Integer Dim _bias As Double Dim _value As Double Dim _delta As Double Public Property Dendrites As List(Of Dendrite) Get Return _dendrites End Get Set(value As List(Of Dendrite)) _dendrites = value End Set End Property Public Property Bias As Double Get Return _bias End Get Set(value As Double) _bias = value End Set End Property Public Property Value As Double Get Return _value End Get Set(value As Double) _value = value End Set End Property Public Property Delta As Double Get Return _delta End Get Set(value As Double) _delta = value End Set End Property Public ReadOnly Property DendriteCount As Integer Get Return _dendrites.Count End Get End Property Public Sub New() Me.Bias = r.NextDouble() End Sub End Class Public Class Layer Dim _neurons As New List(Of Neuron) Dim _neuronCount As Integer Public Property Neurons As List(Of Neuron) Get Return _neurons End Get Set(value As List(Of Neuron)) _neurons = value End Set End Property Public ReadOnly Property NeuronCount As Integer Get Return _neurons.Count End Get End Property Public Sub New(neuronNum As Integer) _neuronCount = neuronNum End Sub End Class Public Class NeuralNetwork Dim _layers As New List(Of Layer) Dim _learningRate As Double Public Property Layers As List(Of Layer) Get Return _layers End Get Set(value As List(Of Layer)) _layers = value End Set End Property Public Property LearningRate As Double Get Return _learningRate End Get Set(value As Double) _learningRate = value End Set End Property Public ReadOnly Property LayerCount As Integer Get Return _layers.Count End Get End Property Sub New(LearningRate As Double, nLayers As List(Of Integer)) If nLayers.Count < 2 Then Exit Sub Me.LearningRate = LearningRate For ii As Integer = 0 To nLayers.Count - 1 Dim l As Layer = New Layer(nLayers(ii) - 1) Me.Layers.Add(l) For jj As Integer = 0 To nLayers(ii) - 1 l.Neurons.Add(New Neuron()) Next For Each n As Neuron In l.Neurons If ii = 0 Then n.Bias = 0 If ii > 0 Then For k As Integer = 0 To nLayers(ii - 1) - 1 n.Dendrites.Add(New Dendrite) Next End If Next Next End Sub 'Function sigmoid(x As Double) As Double ' Return 1 / (1 + Math.Exp(-x)) ' End Function Function sigmoid(x As Double) As Double Return 1 / (1 + Math.Exp(x * -1)) End Function Function Execute(inputs As List(Of Double)) As List(Of Double) If inputs.Count <> Me.Layers(0).NeuronCount Then Return Nothing End If For ii As Integer = 0 To Me.LayerCount - 1 Dim curLayer As Layer = Me.Layers(ii) For jj As Integer = 0 To curLayer.NeuronCount - 1 Dim curNeuron As Neuron = curLayer.Neurons(jj) If ii = 0 Then curNeuron.Value = inputs(jj) Else curNeuron.Value = 0 For k = 0 To Me.Layers(ii - 1).NeuronCount - 1 curNeuron.Value = curNeuron.Value + Me.Layers(ii - 1).Neurons(k).Value * curNeuron.Dendrites(k).Weight Next k curNeuron.Value = sigmoid(curNeuron.Value + curNeuron.Bias) End If Next Next Dim outputs As New List(Of Double) Dim la As Layer = Me.Layers(Me.LayerCount - 1) For ii As Integer = 0 To la.NeuronCount - 1 outputs.Add(la.Neurons(ii).Value) Next Return outputs End Function Public Function Train(inputs As List(Of Double), outputs As List(Of Double)) As Boolean If inputs.Count <> Me.Layers(0).NeuronCount Or outputs.Count <> Me.Layers(Me.LayerCount - 1).NeuronCount Then Debug.WriteLine("output.count <> Layers " & Me.Layers(Me.LayerCount - 1).NeuronCount) Return False End If Execute(inputs) For ii = 0 To Me.Layers(Me.LayerCount - 1).NeuronCount - 1 Dim curNeuron As Neuron = Me.Layers(Me.LayerCount - 1).Neurons(ii) curNeuron.Delta = curNeuron.Value * (1 - curNeuron.Value) * (outputs(ii) - curNeuron.Value) For jj = Me.LayerCount - 2 To 1 Step -1 For kk = 0 To Me.Layers(jj).NeuronCount - 1 Dim iNeuron As Neuron = Me.Layers(jj).Neurons(kk) iNeuron.Delta = iNeuron.Value * (1 - iNeuron.Value) * Me.Layers(jj + 1).Neurons(ii).Dendrites(kk).Weight * Me.Layers(jj + 1).Neurons(ii).Delta Next kk Next jj Next ii For ii = Me.LayerCount - 1 To 0 Step -1 For jj = 0 To Me.Layers(ii).NeuronCount - 1 Dim iNeuron As Neuron = Me.Layers(ii).Neurons(jj) iNeuron.Bias = iNeuron.Bias + (Me.LearningRate * iNeuron.Delta) For kk = 0 To iNeuron.DendriteCount - 1 iNeuron.Dendrites(kk).Weight = iNeuron.Dendrites(kk).Weight + (Me.LearningRate * Me.Layers(ii - 1).Neurons(kk).Value * iNeuron.Delta) Next kk Next jj Next ii Return True End Function 'https://visualstudiomagazine.com/articles/2013/06/01/neural-network-activation-functions.aspx Public Function Activation(ByVal x As Double, ByVal activationType As String, ByVal layer As String) As Double If activationType = "logsigmoid" Then Return LogSigmoid(x) ElseIf activationType = "hyperbolictangent" Then Return HyperbolicTangtent(x) ElseIf activationType = "softmax" Then Return SoftMax(x, layer) Else Throw New Exception("Not implemented") End If End Function Public Function LogSigmoid(ByVal x As Double) As Double If x < -45.0 Then Return 0.0 ElseIf x > 45.0 Then Return 1.0 Else Return 1.0 / (1.0 + Math.Exp(-x)) End If End Function Public Function HyperbolicTangtent(ByVal x As Double) As Double If x < -45.0 Then Return -1.0 ElseIf x > 45.0 Then Return 1.0 Else Return Math.Tanh(x) End If End Function Public ihSum0 As Double Public ihSum1 As Double Public hoSum0 As Double Public hoSum1 As Double Public Function SoftMax(ByVal x As Double, ByVal layer As String) As Double Dim max As Double = Double.MinValue If layer = "ih" Then max = If((ihSum0 > ihSum1), ihSum0, ihSum1) ElseIf layer = "ho" Then max = If((hoSum0 > hoSum1), hoSum0, hoSum1) End If Dim scale As Double = 0.0 If layer = "ih" Then scale = Math.Exp(ihSum0 - max) + Math.Exp(ihSum1 - max) ElseIf layer = "ho" Then scale = Math.Exp(hoSum0 - max) + Math.Exp(hoSum1 - max) End If Return Math.Exp(x - max) / scale End Function End Class |