Private Const INPUT_NEURONS As Integer = 4
Private Const HIDDEN_NEURONS As Integer = 6
Private Const OUTPUT_NEURONS As Integer = 14

Private Const LEARN_RATE As Double = 0.2    'Rho.
Private Const TRAINING_REPS As Integer = 10000

'Input to Hidden Weights (with Biases).
Private wih(INPUT_NEURONS + 1, HIDDEN_NEURONS) As Double

'Hidden to Output Weights (with Biases).
Private who(HIDDEN_NEURONS + 1, OUTPUT_NEURONS) As Double

'Activations.
Private inputs(INPUT_NEURONS - 1) As Double
Private hidden(HIDDEN_NEURONS - 1) As Double
Private target(OUTPUT_NEURONS - 1) As Double
Private actual(OUTPUT_NEURONS - 1) As Double

'Unit errors.
Private erro(OUTPUT_NEURONS - 1) As Double
Private errh(HIDDEN_NEURONS - 1) As Double

Private Const MAX_SAMPLES As Integer = 14

Private trainInputs As Integer(,) = New Integer(,) {{1, 1, 1, 0}, _
                                                    {1, 1, 0, 0}, _
                                                    {0, 1, 1, 0}, _
                                                    {1, 0, 1, 0}, _
                                                    {1, 0, 0, 0}, _
                                                    {0, 1, 0, 0}, _
                                                    {0, 0, 1, 0}, _
                                                    {1, 1, 1, 1}, _
                                                    {1, 1, 0, 1}, _
                                                    {0, 1, 1, 1}, _
                                                    {1, 0, 1, 1}, _
                                                    {1, 0, 0, 1}, _
                                                    {0, 1, 0, 1}, _
                                                    {0, 0, 1, 1}}

Private trainOutput As Integer(,) = New Integer(,) _
                                    {{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, _
                                     {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}}

 

Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) _
                                                            Handles Button1.Click
    NeuralNetwork()
End Sub

Private Sub NeuralNetwork()
Dim i, j, epoch As Integer
Dim sample As Integer = 0
Dim TempString As String

    Text1.Text = ""

    assignRandomWeights()

    'Train the network.
    For epoch = 0 To TRAINING_REPS - 1
        sample += 1
        If sample = MAX_SAMPLES Then
            sample = 0
        End If

        For i = 0 To INPUT_NEURONS - 1
            inputs(i) = trainInputs(sample, i)
        Next i

        For i = 0 To OUTPUT_NEURONS - 1
            target(i) = trainOutput(sample, i)
        Next i

        feedForward()

        backPropagate()

    Next epoch

    getTrainingStats()

    testNetworkTraining()
    testNetworkWithNoise1()

End Sub

Private Sub getTrainingStats()
Dim i, j As Integer
Dim sum As Double = 0.0
Dim TempString As String = ""

    For i = 0 To MAX_SAMPLES - 1

        For j = 0 To INPUT_NEURONS - 1
            inputs(j) = trainInputs(i, j)
        Next j

        For j = 0 To OUTPUT_NEURONS - 1
            target(j) = trainOutput(i, j)
        Next j

        feedForward()

        If maximum(actual) <> maximum(target) Then
            TempString += CStr(inputs(0)) + vbTab + _
                          CStr(inputs(1)) + vbTab + _
                          CStr(inputs(2)) + vbTab + _
                          CStr(inputs(3))
            TempString += CStr(maximum(actual)) + vbTab + _
                          CStr(maximum(target)) + vbCrLf
        Else
            sum += 1
        End If
    Next i

    TempString += "Network is " + CStr((CDbl(sum) / CDbl(MAX_SAMPLES) * 100.0)) + _
                        "% correct." + Chr(13) + Chr(10)

    Text1.Text = TempString

End Sub

Private Sub testNetworkTraining()
'This function simply tests the training vectors against network.
Dim TempString As String = ""
Dim i, j As Integer

    For i = 0 To MAX_SAMPLES - 1
        For j = 0 To INPUT_NEURONS - 1
            inputs(j) = trainInputs(i, j)
        Next j
        feedForward()
        For j = 0 To INPUT_NEURONS - 1
            TempString += CStr(inputs(j)) + vbTab
        Next j
        TempString += "Output: " + CStr(maximum(actual)) + vbCrLf
    Next i

    Text1.Text += TempString

End Sub

Private Sub testNetworkWithNoise1()
'This function adds a random fractional value to all the training
'inputs greater than zero.
Dim TempString As String = ""
Dim i, j As Integer

    For i = 0 To MAX_SAMPLES - 1
        For j = 0 To INPUT_NEURONS - 1
            If trainInputs(i, j) > 0 Then
                inputs(j) = trainInputs(i, j) + Rnd()
            Else
                inputs(j) = 0
            End If
        Next j
        feedForward()
        For j = 0 To INPUT_NEURONS - 1
            TempString += CStr(Math.Round(inputs(j) * 1000) / 1000) + vbTab
        Next j
        TempString += "Output: " + CStr(maximum(actual)) + vbCrLf
    Next i

    Text1.Text += TempString
End Sub

Private Function maximum(ByRef vector As Double()) As Integer
'This function returns the index of the maximum of vector().
Dim index As Integer
Dim sel As Integer = 0
Dim max As Double = vector(sel)

    For index = 0 To OUTPUT_NEURONS - 1
        If vector(index) > max Then
            max = vector(index)
            sel = index
        End If
    Next

    Return sel

End Function

Private Sub feedForward()
Dim inp As Integer
Dim hid As Integer
Dim out As Integer
Dim sum As Double

    'Calculate input to hidden layer.
    For hid = 0 To HIDDEN_NEURONS - 1
        sum = 0.0
        For inp = 0 To INPUT_NEURONS - 1
            sum += inputs(inp) * wih(inp, hid)
        Next

        'Add in bias.
        sum += wih(INPUT_NEURONS, hid)
        hidden(hid) = sigmoid(sum)
    Next

    'Calculate the hidden to output layer.
    For out = 0 To OUTPUT_NEURONS - 1
        sum = 0.0
        For hid = 0 To HIDDEN_NEURONS - 1
            sum += hidden(hid) * who(hid, out)
        Next

        'Add in bias.
        sum += who(HIDDEN_NEURONS, out)
        actual(out) = sigmoid(sum)
    Next

End Sub

Private Sub backPropagate()
Dim inp As Integer
Dim hid As Integer
Dim out As Integer

    'Calculate the output layer error (step 3 for output cell).
    For out = 0 To OUTPUT_NEURONS - 1
        erro(out) = (target(out) - actual(out)) * sigmoidDerivative(actual(out))
    Next

    'Calculate the hidden layer error (step 3 for hidden cell).
    For hid = 0 To HIDDEN_NEURONS - 1
        errh(hid) = 0.0
        For out = 0 To OUTPUT_NEURONS - 1
            errh(hid) += erro(out) * who(hid, out)
        Next
        errh(hid) *= sigmoidDerivative(hidden(hid))
    Next

    'Update the weights for the output layer (step 4).
    For out = 0 To OUTPUT_NEURONS - 1
        For hid = 0 To HIDDEN_NEURONS - 1
            who(hid, out) += (LEARN_RATE * erro(out) * hidden(hid))
        Next
        'Update the bias.
        who(HIDDEN_NEURONS, out) += (LEARN_RATE * erro(out))
    Next

    'Update the weights for the hidden layer (step 4).
    For hid = 0 To HIDDEN_NEURONS - 1
        For inp = 0 To INPUT_NEURONS - 1
            wih(inp, hid) += (LEARN_RATE * errh(hid) * inputs(inp))
        Next
        'Update the bias.
        wih(INPUT_NEURONS, hid) += (LEARN_RATE * errh(hid))
    Next

End Sub

Private Sub assignRandomWeights()
Dim inp As Integer
Dim hid As Integer
Dim out As Integer

    For inp = 0 To INPUT_NEURONS 'Do not subtract 1 here.
        For hid = 0 To HIDDEN_NEURONS - 1
            'Assign a random weight value between -0.5 and 0.5
            Randomize()
            wih(inp, hid) = (CDbl(Rnd()) - 0.5)
        Next
    Next

    For hid = 0 To HIDDEN_NEURONS 'Do not subtract 1 here.
        For out = 0 To OUTPUT_NEURONS - 1
            'Assign a random weight value between -0.5 and 0.5
            Randomize()
            who(hid, out) = (CDbl(Rnd()) - 0.5)
        Next
    Next

End Sub

Private Function sigmoid(ByVal val As Double) As Double
    Return (1.0 / (1.0 + Math.Exp(-val)))
End Function

Private Function sigmoidDerivative(ByVal val As Double) As Double
    Return (val * (1.0 - val))
End Function