神经网络：感知机和线性神经网络的实现

 

示例工程：https://files.cnblogs.com/laviewpbt/NeuronLinear.rar

友情提示：本文系参考机械工业出版社《神经网络设计》（戴葵等译）一书而编制的相关程序，对于初学者或者想深入了解神经网络内核的爱好者，这是一本最具有阅读价值的教材。

感知机和线性神经网络是最简单和最基本的神经网络类型，但他们也有着广泛的应用。感知机和线性神经网络的学习规则相当的简单，对于感知机有：

          

对于线性神经网络有：

          

可以看出，两者有很多的相似，因此，编程中可以把两者的公共函数放在一个模块中，但注意感知机的传输函数是硬极限传输函数，而线性网络是采用的线性函数。

上式中，w表示的权值矩阵，P是我们的输入向量，e表示期望值和实际输出的误差，b表示的是偏置值。

理论上已经证明了，只要权值的解存在，那么感知机和线性网络总能收敛，但是什么情况下权值的解存在呢，这个其实也是感知机的局限所在：他只能对线性可分的对象进行划分。当然我们这里说的是单层的感知机。

在如今的众多软件中，有不少工具都以提供了神经网络工具箱，最方便的某过于matlab，这些工具使用方便、快捷，不过他们都把其实现的过程封装于底部，并且由于工具箱的庞大性，在某些实际的工程项目中我们无法直接移植他，所以自己动手实现其过程不仅能体验到知识的魅力，亦能对书本知识加以更加深刻的认识，何乐而不为呢。

因为在神经网络的编码过程中，大量运用到矩阵操作，因此，我们有必要把一些常用的矩阵算法集中，以方便不同算法的调用，比如矩阵的加法如下：

 

矩阵相加
'函 数 名：Add
'参    数：   mtxA - 矩阵A
'            mtxB - 矩阵B
'返 回 值： 返回运算后的矩阵
'作    者： laviewpbt
'时    间： 2008-11-11
'*********************************** 矩阵相加 *****************************
Public Function Add()Function Add(mtxA() As Double, mtxB() As Double) As Double()
    Dim i As Long, j As Long
    Dim m As Long, n As Long
    If UBound(mtxA, 1) <> UBound(mtxB, 1) Or UBound(mtxA, 2) <> UBound(mtxB, 2) Then
        Exit Function
    End If
    m = UBound(mtxA, 1): n = UBound(mtxA, 2)
    ReDim mtxC(m, n) As Double
    For i = 1 To m
        For j = 1 To n
            mtxC(i, j) = mtxA(i, j) + mtxB(i, j)
        Next 
    Next 
    Add = mtxC
End Function

 

其他矩阵算法可以参考附件。

我们为感知机网络新建一个类模块：Perceptrons，在运行前，我们需要确定的参数有：最大迭代次数，学习方法(learnp,learnpn)，初始权值和偏置值的确定方法以及是否需要偏置值。

按照上述感知机网络学习规则，确定训练函数代码如下：

 

感知机训练函数
Public Sub Train()Sub Train(P() As Double, T() As Double)
    Dim i               As Long, j              As Long
    Dim m               As Long, Index          As Long
    If UBound(P, 2) <> UBound(T, 2) Then        '数组的第二维表述训练样本的个数
        MsgBox "你的输入参数有问题。", vbCritical, "错误"
        Exit Sub
    End If
    ReDim m_Weight(m_Neurons, m_InputNum) As Double     'S X R，权值矩阵
     ReDim m_Bias(m_Neurons, 1) As Double                'S X 1，偏置值矩阵
     ReDim e(m_Neurons, 1) As Double                     'S X 1，误差矩阵
     m = UBound(P, 2)
    Randomize
    If m_IniMethod = "IniRnd" Then   '如果是IniZero的话，因为VB默认的数据初始化值为0，就可以不用写代码了
        For i = 1 To m_Neurons
            m_Bias(i, 1) = Rnd
            For j = 1 To m_InputNum            '随机初始权值矩阵和偏置值
                m_Weight(i, j) = Rnd
            Next
        Next
    End If
    If m_HasBias = True Then
        For i = 1 To m_Neurons
            m_Bias(i, 1) = 0               '无偏差时b=0
        Next
    End If
    For i = 1 To m_MaxEpochs
        Index = Index + 1
        If Index > m Then Index = 1 '当前验证的样本数
        e = Subs(GetMatrixCol(T, Index), Hardlim(Add(Mul(m_Weight, GetMatrixCol(P, Index)), m_Bias)))
        ' E=T-Hardlim(W*P+b)
        If IsMatrixEqualZero(e) = True Then    '如果当前样本的偏差为0，在检测其他样本
            If AllOk(m_Weight, m_Bias, P, T) = True Then mMsg = "经过" & i & "次迭代，感知机已收敛。": Exit Sub
        End If
        ' W=W+E*P'
        If m_TrainFcn = "Learnp" Then
            m_Weight = Add(m_Weight, Mul(e, Trans(GetMatrixCol(P, Index))))
        ElseIf m_TrainFcn = "Learnpn" Then
            m_Weight = Add(m_Weight, Mul(e, Trans(NormalMatrix(GetMatrixCol(P, Index)))))
        End If
        ' b=b+E
        If m_HasBias = False Then
            m_Bias = Add(m_Bias, e)
        End If
    Next
    mMsg = "在设定的迭代次数内，感知机未收敛。":
End Sub

 

   数组P表示用户输入的样本，其第一维表示样本的特征数，第二维表示样本的个数，数组T表示输入对应的正确的输出，其第一维表示神经元的个数，第二维表示样本的个数。

      我们可以利用一下函数进行仿真：

Public Function Sim()Function Sim(P() As Double) As Double()
    Dim m As Long
    m = UBound(P, 2)
    Sim = Hardlim(Add(Mul(m_Weight, P), RepeatColVector(m_Bias, m)))
End Function

 

       线性网络的权值和偏置值的更新公司虽然和感知机类似，但是其原理和感知机有较大的不同。线性网络采用的是一个称为LMS(Least Mean Square,最小均方误差)算法的学习规则，并且其传输函数为一线性函数，虽然他同感知机一样，只能解决线性可分问题，但是线性网络要强大的多，感知机规则能保证将训练模式收敛到一个可正确分类的解上，但得到的网络对噪声敏感。而LMS算法使均方误差最小化，从而使网络的边界判定边界尽量原理训练模式。

       在运行线性网络之前，我们必须确定其学习速率。当学习速率过大时，网络无法收敛，而学习速率过小，会导致网络收敛过慢。由理论分析可知，最大学习速率是由输入数据和偏置值所构造的一个赫森矩阵的最大特征值所决定的，在无法计算这个特征值时，我们只能使用试凑法，而将学习速率取得较小。

我们还需要确定其他参数有：最大迭代次数，初始权值和偏置值的确定方法以及是否需要偏置值。

线性网络的训练函数可由如下编码表示：

Public Sub Train()Sub Train(P() As Double, T() As Double)
    Dim i               As Long, j              As Long
    Dim m               As Long, Index          As Long
    If UBound(P, 2) <> UBound(T, 2) Then        '数组的第二维表述训练样本的个数
        MsgBox "你的输入参数有问题。", vbCritical, "错误"
        Exit Sub
    End If
    m_InputNum = UBound(P, 1)
    m_Neurons = UBound(T, 1)
    ReDim m_Weight(m_Neurons, m_InputNum) As Double              'S X R
    ReDim m_Bias(m_Neurons, 1) As Double               'S X 1
    ReDim e(m_Neurons, 1) As Double     '误差矩阵 S X 1
    m = UBound(P, 2)
    Randomize
    If m_IniMethod = "IniRnd" Then   '如果是IniZero的话，因为VB默认的数据初始化值为0，就可以不用写代码了
        For i = 1 To m_Neurons
            m_Bias(i, 1) = Rnd
            For j = 1 To m_InputNum            '随机初始权值矩阵和偏置值
                m_Weight(i, j) = Rnd
            Next
        Next
    End If
    If m_HasBias = False Then
        For i = 1 To m_Neurons
            m_Bias(i, 1) = 0               '无偏差时b=0
        Next
    End If
    m_Iteration = 0
    For i = 1 To m_MaxEpochs
        Index = Index + 1
        m_Iteration = m_Iteration + 1
        ReDim Preserve mError(m_Iteration) As Double
        If Index > m Then Index = 1 '当前验证的样本数
        e = Subs(GetMatrixCol(T, Index), Purelin(Add(Mul(m_Weight, GetMatrixCol(P, Index)), m_Bias)))
        ' E=T-Purelin(W*P+b)
        mError(m_Iteration) = MeanError(Purelin(Add(Mul(m_Weight, P), RepeatColVector(m_Bias, m))), T)
        If mError(m_Iteration) < m_Goal Then mMsg = "经过" & m_Iteration & "次迭代，线性网络已收敛。": Exit Sub
        ' W=W+2*lr*E*P'
        m_Weight = Add(m_Weight, Nmul(Mul(e, Trans(GetMatrixCol(P, Index))), 2 * m_LearnRate))
        ' b=b+2*lr*E
        m_Bias = Add(m_Bias, Nmul(e, 2 * m_LearnRate))
    Next
    mMsg = "在设定的迭代次数和要求精度内，线性网络未收敛。":
End Sub

 

程序中还附带了一个求矩阵最大特征值的函数MaxLamda，这也是一个很有使用价值的函数，记得好像是参考一本模糊数学的教材上的例子写得。

以下为一个划分为2类的例子，其中绿色的分解线是由感知机产生的，而另外一组分界线是有线性网络产生的，由图可以明显的感受到，有新型网络所得到的分解线更能够明显的把所有的对象分为两类，而感知机似乎不能完美的保证两端平衡，这也是因为感知机在迭代中只要对现有的样本都已经完全分好类了就退出循环，而线性网络确要保证均方误差最小。

         

如果样本中存在奇异点，即某些样本特别大或或者特别小，那么如果采用Learnp算法，可能需要很多步迭代才能收敛，而采用修改的Learnp算法将会几大的提高速度，如下图所示。

                    

     当然，对于多类线性可分的情况，感知机也能正常工作，如下图所示：  

   分为四类的效果（训练了2次，所以有4条分界线）：

     

          

    对于线性神经网络,我们再举三个简单的例子来说明：

     1、输入向量P=[1,-1.3],输出向量T=[0.5 1.0],设计一个线性网络来在寻找两者之间的关系。

     其实这里就是数学上的两点确定一条直线的问题，即求ax+b=0中的a和b。

直线参数求解
    Dim p(1, 2) As Double
    Dim t(1, 2) As Double
    Dim s As New Linear
    Dm y() As Double
    p(1, 1) = 1:p(1, 2) = -1.3
    t(1, 1) = 0.5
    t(1, 2) = 1
    s.R = 1
    s.s = 1
    s.lr = 0.01
    s.MaxEpochs = 10000
    s.Goal = 0.00001
    s.Train p, t
    y = s.Sim(p)
    Text1.Text = Format(y(1, 1), "0.0000") & " " & Format(y(1, 2), "0.0000") & vbCrLf

 

      由最终得到的结果可以看到，网络解和理论解想看无多。

    2 、设输入向量p=[1 1.5 1.2 -0.3 ;-1 2 3 -0.5 ;2 1 -1.6 0.9] ,t=[0.5 3 -2.2 1.4 ;1.1 -1.2 1.7 -0.4 ;3 0.2 -1.8 -0.4;-1 0.1 -1 0.6], 由p,t可知，网络为3×4的结构，即输入层有3个神经元，输出层有4个神经元。如果从解线性方城组的角度考虑，则对于这个网络，每个输出神经元都有四个变量，包括三个权值和一个偏置值，同时有4个限制方程，每组输入对应4个输出值，这样4个输出结点就有16组方程，因此，只要输入向量不线性相关，就可以得到一精确解。

方程组求解
    Dim p(3, 4) As Double
    Dim t(4, 4) As Double
    Dim s As New Linear
    p(1, 1) = 1: p(1, 2) = 1.5: p(1, 3) = 1.2: p(1, 4) = -2.3
    p(2, 1) = -1: p(2, 2) = 2: p(2, 3) = 3: p(2, 4) = -0.5
    p(3, 1) = 2: p(3, 2) = 1: p(3, 3) = -1.6: p(3, 4) = 0.9
    t(1, 1) = 0.5: t(1, 2) = 3: t(1, 3) = -2.2: t(1, 4) = 1.4
    t(2, 1) = 1.1: t(2, 2) = -1.2: t(2, 3) = 1.7: t(2, 4) = -0.4
    t(3, 1) = 3: t(3, 2) = 0.2: t(3, 3) = -1.8: t(3, 4) = -0.4
    t(4, 1) = -1: t(4, 2) = 0.1: t(4, 3) = -1: t(4, 4) = 0.6
    s.R = 3
    s.s = 4
    s.MaxEpochs = 2000
    s.lr = s.Maxlinlr(p) / 2
    s.Train p, t
    y = s.Sim(p)

 

     3、设输入向量为p=[1 1.5 3.0 -1.2], t=[0.5 1.1 3 -1]，此问题相当于4个方程组解w和b两个未知数，所以直接解是无解的，但是用线性网络确可以得到很好的一个逼近。

线性逼近
    Dim p(1, 4) As Double
    Dim t(1, 4) As Double
    Dim s As New Linear
    Dim e() As Double
    p(1, 1) = 1: p(1, 2) = 1.5: p(1, 3) = 3#: p(1, 4) = -1.2
    t(1, 1) = 0.5: t(1, 2) = 1.1: t(1, 3) = 3#: t(1, 4) = -1#
    s.R = 1
    s.s = 1
    s.MaxEpochs = 500
    s.lr = 0.01
    s.Goal = 0.00001
    s.Train p, t
    e = s.Err
    y = s.Sim(p)

 

效果图：

 

 

'******************************你的评论是我发表文章的极大动力**'**************************

'****************************欢迎和你讨论技术问题：QQ 33184777**************************