http://blog.csdn.net/laviewpbt/article/details/1382491
仿逆规则使误差平方和最小化，而LMS算法（见神经网络学习笔记1）则调整权值使均方误差最小，因而两者的结果是相同的，但是LMS算法每输入一个模式就更新一次权值，因此他可以用来实时的学习，而仿逆规则要等所有的输入和输出模式已知后才计算一次权值。
现在我们将Hebb规则用于一个简化的实际模式识别的问题中，我们设定期望输出等于网络的输入我们的目标（T=P），我们需要训练一组已知的原型，下图上部三个数字的为原型模式，白色用-1表示，红色用1表示，则数字0用向量可表示为：
p1 = [0 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0] '
使用Hebb规则，则有 W=p1*p1'+p2*p2'+p3*p3'
因为样本向量中的元素只有两个值，我们可以用一个对称的硬极限传输函数来实现。
实现代码（部分矩阵操作的函数请参考神经网络学习笔记1）：
'程序实现功能：有监督的H
'作 者： laviewpbt
'联系方式： [email protected]
'QQ: 33184777
'版本：Version 1.2.0
'说明：复制请保留源作者信息，转载请说明，欢迎大家提出意见和建议
'*********************************** 矩阵求逆 ***********************************
'
'函 数 名： Inv
'参 数： mtx - 要转置的矩阵
'返 回 值： 返回转求逆后的矩阵
'作 者： 常用工程算法
'时 间： 2006-11-14
'
'*********************************** 矩阵求逆 ***********************************
Public Function Inv(mtx() As Double) As Double()
' 局部变量
Dim n As Integer
n = UBound(mtx)
ReDim nIs(n) As Integer, nJs(n) As Integer, Temp(1 To n, 1 To n) As Double
Dim i As Integer, j As Integer, k As Integer
Dim d As Double, P As Double
For i = 1 To n
For j = 1 To n
Temp(i, j) = mtx(i, j)
Next
Next
' 全选主元，消元
For k = 1 To n
d = 0#
For i = k To n
For j = k To n
P = Abs(mtx(i, j))
If (P > d) Then
d = P
nIs(k) = i
nJs(k) = j
End If
Next j
Next i
' 求解失败
If (d + 1# = 1#) Then
Exit Function
End If
If (nIs(k) <> k) Then
For j = 1 To n
P = mtx(k, j)
mtx(k, j) = mtx(nIs(k), j)
mtx(nIs(k), j) = P
Next j
End If
If (nJs(k) <> k) Then
For i = 1 To n
P = mtx(i, k)
mtx(i, k) = mtx(i, nJs(k))
mtx(i, nJs(k)) = P
Next i
End If
mtx(k, k) = 1# / mtx(k, k)
For j = 1 To n
If (j <> k) Then mtx(k, j) = mtx(k, j) * mtx(k, k)
Next j
For i = 1 To n
If (i <> k) Then
For j = 1 To n
If (j <> k) Then mtx(i, j) = mtx(i, j) - mtx(i, k) * mtx(k, j)
Next j
End If
Next i
For i = 1 To n
If (i <> k) Then mtx(i, k) = -mtx(i, k) * mtx(k, k)
Next i
Next k
' 调整恢复行列次序
For k = n To 1 Step -1
If (nJs(k) <> k) Then
For j = 1 To n
P = mtx(k, j)
mtx(k, j) = mtx(nJs(k), j)
mtx(nJs(k), j) = P
Next j
End If
If (nIs(k) <> k) Then
For i = 1 To n
P = mtx(i, k)
mtx(i, k) = mtx(i, nIs(k))
mtx(i, nIs(k)) = P
Next i
End If
Next k
Inv = mtx
For i = 1 To n
For j = 1 To n
mtx(i, j) = Temp(i, j)
Next
Next
End Function
'*********************************** 矩阵的秩 ***********************************
'
'函 数 名： Rank
'参 数： mtx - 存放待求秩的矩阵
'返 回 值： 返回矩阵的秩
'说 明： 用全选主元高斯消去法求矩阵的秩
'作 者： 常用工程算法
'时 间： 2006-11-14
'
'*********************************** 矩阵的秩 ***********************************
Public Function Rank(mtx() As Double) As Integer
' 局部变量
Dim i As Integer, j As Integer, k As Integer, l As Integer, nIs As Integer, nJs As Integer, nn As Integer
Dim q As Double, d As Double
Dim m As Integer, n As Integer
m = UBound(mtx, 1): n = UBound(mtx, 2)
ReDim Temp(1 To m, 1 To n) As Double
For i = 1 To m
For j = 1 To n
Temp(i, j) = mtx(i, j)
Next
Next
' 基数
k = 0
For l = 1 To nn
q = 0#
For i = 2 To m
For j = 2 To n
d = Abs(mtx(i, j))
If (d > q) Then
q = d
nIs = i
nJs = j
End If
Next j
Next i
' 求解失败
If (q + 1# = 1#) Then
MRank = k
Exit Function
End If
k = k + 1
If (nIs <> l) Then
For j = l To n
d = mtx(l, j)
mtx(l, j) = mtx(nIs, j)
mtx(nIs, j) = d
Next j
End If
If (nJs <> l) Then
For i = l To m
d = mtx(i, nJs)
mtx(i, nJs) = mtx(i, l)
mtx(i, l) = d
Next i
End If
For i = l + 1 To n
d = mtx(i, l) / mtx(l, l)
For j = l + 1 To n
mtx(i, j) = mtx(i, j) - d * mtx(l, j)
Next j
Next i
Next l
' 求解成功
Rank = k
For i = 1 To m
For j = 1 To n
mtx(i, j) = Temp(i, j)
Next
Next
End Function
'*********************************** 求矩阵的Moore_Penrose逆 ***********************************
'
'函 数 名： Moore_Penrose
'参 数： mtx - 待求矩阵
'返 回 值： 返回Moore_Penrose逆
'作 者： laviewpbt
'时 间： 2006-11-14
'
'*********************************** 求矩阵的Moore_Penrose逆 ***********************************
Public Function Moore_Penrose(mtx() As Double) As Double()
Dim m As Integer, n As Integer
m = UBound(mtx, 1): n = UBound(mtx, 2)
ReDim Temp(1 To n, 1 To m) As Double
If Rank(mtx) = m Then
Temp = Mul(Trans(mtx), Inv(Mul(mtx, Trans(mtx))))
Else 'If Rank(mtx) = n Then
Temp = Mul(Inv(Mul(Trans(mtx), mtx)), Trans(mtx))
End If
Moore_Penrose = Temp
End Function
'*********************************** 硬极限传输函数 ***********************************
'
'函 数 名： Hardlim
'参 数： mtx - 待求矩阵
'返 回 值： 返回硬极限处理后的矩阵
'作 者： laviewpbt
'时 间： 2006-11-14
'
'*********************************** 硬极限传输函数 ***********************************
Public Function Hardlims(mtx() As Double) As Double()
Dim i As Integer, j As Integer, m As Integer, n As Integer
m = UBound(mtx, 1): n = UBound(mtx, 2)
ReDim result(m, n) As Double
For i = 1 To m
For j = 1 To n
If mtx(i, j) <= 0 Then
result(i, j) = -1
Else
result(i, j) = 1
End If
Next
Next
Hardlims = result
End Function
窗体中，三个PicStandard控件数组，一个PicTest控件，一个PicResult控件，把他们的index都设置为1，这是为了程序的方便性而做的处理。
Option Base 1
Private Const Row = 6
Private Const Col = 5
Dim P() As Double
Dim W() As Double
Dim T() As Double
Dim PTest() As Double
Private Sub Form_Load()
ReDim P(Row * Col, 3) As Double
ReDim PTest(Row * Col, 1) As Double
ReDim W(Row * Col, Row * Col) As Double
ReDim T(Row * Col, 1) As Double
PicStandard(1).Scale (0, 0)-(5.02, 6.02)
PicStandard(2).Scale (0, 0)-(5.02, 6.02)
PicStandard(3).Scale (0, 0)-(5.02, 6.02)
PicTest(1).Scale (0, 0)-(5.02, 6.02)
PicResult(1).Scale (0, 0)-(5.02, 6.02)
P(1, 1) = -1: P(2, 1) = 1: P(3, 1) = 1: P(4, 1) = 1: P(5, 1) = 1: P(6, 1) = -1 '初始数据
P(7, 1) = 1: P(8, 1) = -1: P(9, 1) = -1: P(10, 1) = -1: P(11, 1) = -1: P(12, 1) = 1
P(13, 1) = 1: P(14, 1) = -1: P(15, 1) = -1: P(16, 1) = -1: P(17, 1) = -1: P(18, 1) = 1
P(19, 1) = 1: P(20, 1) = -1: P(21, 1) = -1: P(22, 1) = -1: P(23, 1) = -1: P(24, 1) = 1
P(25, 1) = -1: P(26, 1) = 1: P(27, 1) = 1: P(28, 1) = 1: P(29, 1) = 1: P(30, 1) = -1
P(1, 2) = -1: P(2, 2) = -1: P(3, 2) = -1: P(4, 2) = -1: P(5, 2) = -1: P(6, 2) = -1
P(7, 2) = 1: P(8, 2) = -1: P(9, 2) = -1: P(10, 2) = -1: P(11, 2) = -1: P(12, 2) = -1
P(13, 2) = 1: P(14, 2) = 1: P(15, 2) = 1: P(16, 2) = 1: P(17, 2) = 1: P(18, 2) = 1
P(19, 2) = -1: P(20, 2) = -1: P(21, 2) = -1: P(22, 2) = -1: P(23, 2) = -1: P(24, 2) = -1
P(25, 2) = -1: P(26, 2) = -1: P(27, 2) = -1: P(28, 2) = -1: P(29, 2) = -1: P(30, 2) = -1
P(1, 3) = 1: P(2, 3) = -1: P(3, 3) = -1: P(4, 3) = -1: P(5, 3) = -1: P(6, 3) = -1
P(7, 3) = 1: P(8, 3) = -1: P(9, 3) = -1: P(10, 3) = 1: P(11, 3) = 1: P(12, 3) = 1
P(13, 3) = 1: P(14, 3) = -1: P(15, 3) = -1: P(16, 3) = 1: P(17, 3) = -1: P(18, 3) = 1
P(19, 3) = 1: P(20, 3) = -1: P(21, 3) = -1: P(22, 3) = 1: P(23, 3) = -1: P(24, 3) = 1
P(25, 3) = -1: P(26, 3) = 1: P(27, 3) = 1: P(28, 3) = -1: P(29, 3) = -1: P(30, 3) = 1
For i = 1 To 30
PTest(i, 1) = -1
Next
RefreshGrid PicStandard(1), P
RefreshGrid PicStandard(2), P
RefreshGrid PicStandard(3), P
RefreshGrid PicTest(1), PTest
RefreshGrid PicResult(1), T
W = Mul(P, Trans(P))
End Sub
'*********************************** 刷新网格 ***********************************
'
'函 数 名： Hardlim
'参 数： pic - 要刷新的图片框
' Data - 刷新中用到的数据
'作 者： laviewpbt
'时 间： 2006-11-14
'
'*********************************** 刷新网格 ***********************************
Private Sub RefreshGrid(pic As PictureBox, Data() As Double)
Dim i As Integer, Index As Integer
Dim m As Integer, n As Integer
Index = pic.Index
For i = 1 To Row * Col
m = Int((i - 1) / Row) + 1
n = ((i - 1) Mod Row) + 1
If Data(i, Index) = 1 Then
pic.Line (m - 1, n - 1)-(m, n), vbRed, BF
Else
pic.Line (m - 1, n - 1)-(m, n), vbWhite, BF '填充网格，注意顺序
End If
Next
For i = 0 To Row
pic.Line (0, i)-(Col, i), vbBlue '画网格线
Next
For i = 0 To Col
pic.Line (i, 0)-(i, Row), vbBlue
Next
End Sub
Private Sub OptHebb_Click()
W = Mul(P, Trans(P))
T = Hardlims(Mul(W, PTest))
RefreshGrid PicResult(1), T
End Sub
Private Sub OptMp_Click()
W = Mul(P, Moore_Penrose(P))
T = Hardlims(Mul(W, PTest))
RefreshGrid PicResult(1), T
End Sub
Private Sub PicStandard_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
i = Int(X) * Row + Int(Y) + 1
If P(i, Index) = 1 Then
P(i, Index) = -1 '更新数据
Else
P(i, Index) = 1
End If
RefreshGrid PicStandard(Index), P
If OptHebb.Value = True Then
W = Mul(P, Trans(P)) '求权值矩阵
Else
W = Mul(P, Moore_Penrose(P))
End If
T = Hardlims(Mul(W, PTest))
RefreshGrid PicResult(1), T
End Sub
Private Sub PicTest_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
i = Int(X) * Row + Int(Y) + 1
If PTest(i, Index) = 1 Then
PTest(i, Index) = -1
Else
PTest(i, Index) = 1
End If
RefreshGrid PicTest(Index), PTest
If OptHebb.Value = True Then
W = Mul(P, Trans(P))
Else
W = Mul(P, Moore_Penrose(P))
End If
T = Hardlims(Mul(W, PTest))
RefreshGrid PicResult(1), T
End Sub
以下是一些效果：
隐去原始模式的下半部分时的识别效果：
上面三个图片框种为标准模式（可以修改的），第四个为测试图片框，第五个为结果图片框。
2 、带有噪音的识别
3 、简单Hebb和仿逆规则的比较：
可见，仿逆规则可以产生比简单Hebb规则好的效果。
4 、 其他数字的识别
