backpropagation.vb

BP神经网络原代码,每个输入向量占用一行,用|分隔输入和预期输出值.

Imports System.IO
Module BackPropagation
    Private path As String = Application.StartupPath.Substring(0, Application.StartupPath.IndexOf("bin\Debug"))
    Public PicValue(2000, 1) As Double '存储误差的X坐标和相应Y的值
    Public MaxXAxis As Integer = 0 'picValue数组下坐的最大有效值，即X轴的最大值
    '训练时加入了动量和偏移量
    '输入向量为n维,隐藏层的神经元个数为h,输出向量是m维,学习率为a
    '训练时偏爱后面的样本,与样本的顺序有一定的联系
    Public Sub Train(ByVal HideNeuron As Integer, ByVal alpha As Single)
        Dim h As Integer = HideNeuron
        Dim SampleInput(,) As Double = {{0, 0}}
        Dim StdOutput(,) As Double = {{0, 0}}
        ReadSample(SampleInput, StdOutput, path + "samplec.txt")
        Dim m, n As Integer
        n = UBound(SampleInput, 2) + 1
        m = UBound(StdOutput, 2) + 1
        Dim deltaW(h - 1, m - 1), deltaV(n - 1, h - 1) As Double '上次的修改量
        Dim DeltaOp(m - 1) As Double '对第P个样本的修改量
        Dim DeltaHp(h - 1) As Double '对第P个样本的修改量
        Dim OHide(h - 1), Out(m - 1) As Double '隐层和输出层神经元的输出结果
        Dim e, LoopE, Ep As Double   'e为精度控制参数,loopE为循环时的精度变量
        Dim loopNum As Long '循环次数
        Const maxLoop As Integer = 10 ^ 5 '最大循环次数
        Dim SNum As Integer = UBound(SampleInput, 1) '训练样本的个数
        Dim p, i, j As Integer
        Dim temp(h - 1), temp1 As Double  '隐层与标准输出的估计误差
        Dim w(h - 1, m - 1) As Double  '输出层权重
        Dim v(n - 1, h - 1) As Double  '隐层权重
        Dim wb(m - 1) As Double  '输出层偏移量
        Dim vb(h - 1) As Double  '隐层偏移量
        initWeight(w, wb)
        initWeight(v, vb)
        Dim oldvb(UBound(vb, 1)), oldwb(UBound(wb, 1)) As Double
        e = 0.00025
        LoopE = 1.00025
        loopNum = 0
        '====================
        Dim f As StreamWriter = File.CreateText(path + "nn.txt")
        While LoopE > e And loopNum < maxLoop
            loopNum = loopNum + 1  '不能收敛时,达到最大数时退出
            LoopE = 0
            For p = 0 To SNum '对所有样本进行循环
                '计算隐层的输出值
                For i = 0 To h - 1 '第i个隐层神经元
                    OHide(i) = 0
                    For j = 0 To n - 1 '第P个向量的第J个输入元素值
                        OHide(i) = OHide(i) + v(j, i) * SampleInput(p, j)
                    Next
                    OHide(i) = 1 / (1 + Math.Exp(-(OHide(i) + vb(i)))) '加上偏移量  
                Next
                '计算输出层的输出值
                Ep = 0
                For i = 0 To m - 1
                    Out(i) = 0  '第I个输出分量
                    For j = 0 To h - 1
                        Out(i) = Out(i) + w(j, i) * OHide(j)
                    Next
                    Out(i) = 1 / (1 + Math.Exp(-(Out(i) + wb(i))))  ' 
                    Ep = Ep + ((Out(i) - StdOutput(p, i)) ^ 2) / 2
                Next
                LoopE = LoopE + Ep
                '计算输出层权重的修改量
                For i = 0 To m - 1
                    '第P个样本的修改量
                    DeltaOp(i) = Out(i) * (1 - Out(i)) * (StdOutput(p, i) - Out(i))
                Next
                '计算隐层权重的修改量
                For i = 0 To h - 1
                    temp(i) = 0
                    For j = 0 To m - 1
                        temp(i) = temp(i) + w(i, j) * DeltaOp(j)
                    Next
                    '第P个样本的修改量
                    DeltaHp(i) = OHide(i) * (1 - OHide(i)) * temp(i)
                Next
                '修改隐层权重
                For i = 0 To h - 1
                    For j = 0 To n - 1
                        temp1 = alpha * SampleInput(p, j) * DeltaHp(i) + 0.9 * deltaV(j, i) '增加动量
                        v(j, i) = v(j, i) + temp1
                        deltaV(j, i) = temp1
                    Next
                    temp1 = alpha * DeltaHp(i) + 0.9 * oldvb(i)
                    vb(i) = vb(i) + temp1
                    oldvb(i) = temp1
                Next
                '修改输出层权重
                For i = 0 To m - 1
                    For j = 0 To h - 1
                        temp1 = alpha * OHide(j) * DeltaOp(i) + 0.9 * deltaW(j, i)
                        w(j, i) = w(j, i) + temp1
                        deltaW(j, i) = temp1
                    Next
                    temp1 = alpha * DeltaOp(i) + 0.9 * oldwb(i)
                    wb(i) = wb(i) + temp1
                    oldwb(i) = temp1
                Next
            Next
            '====================
            If (loopNum Mod 200) = 1 Then
                f.WriteLine(LoopE.ToString)
                PicValue(MaxXAxis, 0) = MaxXAxis
                PicValue(MaxXAxis, 1) = LoopE
                MaxXAxis = MaxXAxis + 1
            End If
            '====================
        End While
        f.WriteLine(LoopE.ToString)
        '存储权重
        If loopNum < maxLoop Then
            Dim vf As StreamWriter = File.CreateText(path + "HideWeight.txt")
            Dim wf As StreamWriter = File.CreateText(path + "OutWeight.txt")
            Dim vbf As StreamWriter = File.CreateText(path + "HideBias.txt")
            Dim wbf As StreamWriter = File.CreateText(path + "OutBias.txt")

            '将输入神经元的维数,隐层神经元的维数,输出神经元的维数存在隐层权重的第一行
            vf.WriteLine(n.ToString + "," + h.ToString + "," + m.ToString)
            For i = 0 To n - 1
                For j = 0 To h - 1
                    vf.WriteLine(i.ToString + "," + j.ToString + "," + v(i, j).ToString)
                Next
            Next
            '偏移量
            For i = 0 To h - 1
                vbf.WriteLine(i.ToString + "," + vb(i).ToString)
            Next
            For i = 0 To m - 1
                wbf.WriteLine(i.ToString + "," + wb(i).ToString)
            Next

            '修改输出层权重
            For i = 0 To h - 1
                For j = 0 To m - 1
                    wf.WriteLine(i.ToString + "," + j.ToString + "," + w(i, j).ToString)
                Next
            Next
            vf.Flush()
            wf.Flush()
            vbf.Flush()
            wbf.Flush()
            vf.Close()
            wf.Close()
            vbf.Close()
            wbf.Close()
        End If
        '====================
        f.Flush()
        f.Close()
        '====================
    End Sub


    '用随机数初始化权重数组,每一个权重必需是一个不同的值
    Public Sub initWeight(ByRef weight(,) As Double, ByRef WeightBias() As Double)
        Dim w As Integer = UBound(weight, 1)
        Dim h As Integer = UBound(weight, 2)
        Dim i, j, k As Integer
        Dim temp As Double
        Dim r As Random = New Random()
        Dim produce((w + 1) * (h + 1)) As Double  '存储已经产生的随机数
        For i = 0 To h
            For j = 0 To w
                temp = 0.0
                While temp = 0.0
                    temp = r.NextDouble() '返回一个0.0-1之间的随机数
                    For k = 0 To i * w + j - 1
                        If produce(k) = temp Then '已经存在相同的权重,丢弃这个值
                            temp = 0
                            Exit For
                        End If
                    Next
                End While
                produce(i * w + j) = temp
                weight(j, i) = temp
            Next
            WeightBias(i) = r.NextDouble '偏移量
        Next
    End Sub
    '从文件将样本读入到数组中
    'n为输入样本的维数,m为标准输出的维数,FilePath为存储样本的文件路径
    Private Sub ReadSample(ByRef SampleInput(,) As Double, ByRef StdOutput(,) As Double, ByVal FilePath As String)
        Dim i, j, m, n As Integer
        Dim temp(), Input(), Output() As String
        Dim Rows() As String = File.ReadAllLines(FilePath)
        temp = Rows(0).Split("|") '样本向量的每一行,| 前的为输入元素值,| 后的为为输出元素值
        Input = temp(0).Split(",")
        Output = temp(1).Split(",")
        n = UBound(Input, 1) + 1
        m = UBound(Output, 1) + 1
        Dim h As Integer = UBound(Rows)
        ReDim SampleInput(h, n - 1) '根据样本的数目,重新定义数组的长度
        ReDim StdOutput(h, m - 1)
        Dim min, max As Double
        For i = 0 To h
            temp = Rows(i).Split("|") '样本向量的每一行,| 前的为输入元素值,| 后的为为输出元素值
            Input = temp(0).Split(",")
            Output = temp(1).Split(",")
            min = 10 ^ 7
            max = 0
            For j = 0 To n - 1
                SampleInput(i, j) = Input(j)
                If Val(Input(j)) > max Then
                    max = Val(Input(j))
                End If
                If Val(Input(j)) < min Then
                    min = Val(Input(j))
                End If
            Next
            '规范化,所有分量的值归入0~1之间
            For j = 0 To n - 1
                If max - min > 0 Then
                    SampleInput(i, j) = (SampleInput(i, j) - min) / (max - min)
                End If
            Next
            For j = 0 To m - 1
                StdOutput(i, j) = Output(j)
            Next
        Next
    End Sub
    Private Sub ReadWeight(ByRef HideWeight(,) As Double, ByRef OutputWeight(,) As Double, _
                           ByRef HideBias() As Double, ByRef OutBias() As Double)
        Dim HideRows() As String = File.ReadAllLines(path + "HideWeight.txt")
        Dim OutRows() As String = File.ReadAllLines(path + "OutWeight.txt")
        Dim vbs() As String = File.ReadAllLines(path + "HideBias.txt")
        Dim wbs() As String = File.ReadAllLines(path + "OutBias.txt")
        Dim temp() As String = HideRows(0).Split(",")
        Dim n As Integer = Val(temp(0))
        Dim h As Integer = Val(temp(1))
        Dim m As Integer = Val(temp(2))
        Dim w(h - 1, m - 1) As Double '输出层的权矩阵
        Dim v(n - 1, h - 1) As Double '输入层的权矩阵
        Dim vb(h - 1), wb(m - 1) As Double
        Dim i As Integer
        Dim r As Integer = UBound(HideRows, 1) '行数
        '读隐层权重
        For i = 1 To r
            temp = HideRows(i).Split(",")
            v(temp(0), temp(1)) = temp(2)
        Next
        HideWeight = v
        '隐层偏移量
        r = UBound(vbs, 1)
        For i = 0 To r
            temp = vbs(i).Split(",")
            vb(temp(0)) = temp(1)
        Next
        HideBias = vb
        '读输出层权重
        r = UBound(OutRows, 1)
        For i = 0 To r
            temp = OutRows(i).Split(",")
            w(temp(0), temp(1)) = temp(2)
        Next
        OutputWeight = w
        '输出层偏移量
        r = UBound(wbs, 1)
        For i = 0 To r
            temp = wbs(i).Split(",")
            wb(temp(0)) = temp(1)
        Next
        OutBias = wb
    End Sub
    '输入向量为n维,隐藏层的神经元个数为h,输出向量是m维,学习率为a
    '训练时对样本的顺序无要求
    Public Sub Recognition(ByRef InputX As String, ByRef OutputY As String)
        If InputX = "" Then
            Exit Sub
        End If
        Dim v(,) As Double = {{0, 0}}
        Dim w(,) As Double = {{0, 0}}
        Dim vb() As Double = {0}
        Dim wb() As Double = {0}
        ReadWeight(v, w, vb, wb)
        Dim n As Integer = UBound(v, 1) '输入维数
        Dim h As Integer = UBound(v, 2) '隐层维数
        Dim m As Integer = UBound(w, 2) '输出维数
        Dim OHide(h), Out(m) As Double '隐层和输出层神经元的输出结果
        Dim i, j As Integer
        Dim input() As String = InputX.Split(",")
        Dim temp(n) As Double
        Dim min, max As Double
        '计算隐层的输出值
        min = 10 ^ 7
        max = 0
        For i = 0 To n
            temp(i) = Val(input(i))
            If temp(i) > max Then
                max = temp(i)
            End If
            If temp(i) < min Then
                min = temp(i)
            End If
        Next
        ''规范化,所有分量的值归入0~1之间
        For i = 0 To n
            If max - min > 0 Then
                temp(i) = (temp(i) - min) / (max - min)
            End If
        Next
        For i = 0 To h  '第i个隐层神经元
            OHide(i) = 0
            For j = 0 To n  '第P个向量的第J个输入元素值
                OHide(i) = OHide(i) + v(j, i) * Val(temp(j))
            Next
            OHide(i) = 1 / (1 + Math.Exp(-(OHide(i) + vb(i))))
        Next
        '计算输出层的输出值
        OutputY = ""
        For i = 0 To m
            Out(i) = 0  '第I个输出分量
            For j = 0 To h
                Out(i) = Out(i) + w(j, i) * OHide(j)
            Next
            Out(i) = 1 / (1 + Math.Exp(-(Out(i) + wb(i))))
            If OutputY = "" Then
                OutputY = (Math.Round(Out(i))).ToString
            Else
                OutputY = OutputY + "," + (Math.Round(Out(i))).ToString
            End If
        Next
    End Sub

End Module