login.frm

仿真1：首先把网络温度参数T固定在100

    Command4(Index).Caption = -1
ElseIf Command4(Index).Caption = 0 Then
    Command4(Index).Caption = 1
End If

For i = 0 To 3                           '将初始状态存入output(i)中
output(i) = Command4(i).Caption
Next i

For i = 0 To 15                           '显示出状态编号
  For j = 0 To 3
  Label13.Caption = c(i, j)
  Label9.Caption = Label9.Caption + Label13.Caption
  Next j
  Label9.Caption = Label9.Caption + Chr(10) & Chr(13)
Next i

For i = 0 To 3
Next i
'---------------------------显示对应能量-------------------------------------------
energythreshold = 0
energyweight = 0
For k = 0 To 15
For i = 0 To neuralnumber - 1                          '求一个状态的能量-------
  For j = 0 To neuralnumber - 1
  energyweight = energyweight + weights(i, j) * c(k, i) * c(k, j)
  Next j
  energythreshold = energythreshold + threshold(i) * c(k, i)
Next i
energytotal = -0.5 * energyweight + energythreshold   'E =  - 0.5∑i∑jwijxixj + ∑iθixi
Label13.Caption = energytotal                             '打印出能量
Label10.Caption = Label10.Caption + Label13.Caption + Chr(10) & Chr(13)
Next k

'---------------------------运行网络————————————————————
'   输出为{ui}，神经元的内部状态为{Hi}
Dim heat, probability As Double
Randomize
f = 0
While t >= tend
f = f + 1
'1）从N个神经元中随机选取一个神经元i
i = Int(neuralnumber * Rnd)
'2）求神经元 i的内部状态'     Hi=∑wijuj(t)-θi，j=1…n, j≠i
 For j = 0 To neuralnumber - 1
 heat = heat + weights(i, j) * output(j)
 Next j
 heat = heat - threshold(i)                                 '2)计算 Hi = ∑jwijxj-θi
tmax = 100
'3）按下式所示概率将神经元 i的状态更新为1, p [ui(t+1)=1] = 1 / (1 + Exp(-Hi(t) / t))  '不同的Hi对应不同的概率
'更新方法两种中一种:若Hi(t) > 0，直接使 ui(t+1)=1；若Hi(t) < 0，在[0，0.5]内产生一随机数ε(t)
'当   p[ui(t+1) =1] > ε(t)时，ui（t+1）=1，否则 ui(t+1) =ui(t)
probability = 1 / (1 + Exp(-heat / t))

If heat >= 0 Then
output(i) = 1
End If

If heat < 0 Then
k = Rnd / 2
If probability > k Then
      output(i) = 1
      End If
End If
'4）i以外的神经元输出保持不变  uj(t+1) = uj(t), j=1,2,…,N, j≠i
'5）令 t=t+1，按下式计算新的温度参数T(t+1)=T0/log(t+1)——降温方案,    快速降温方案: t(t) = T0 / (1 + t)
t = tmax / (1 + f)
'6）返回到1），直到T < Td（预先给定） T0，Td凭经验给出现已证明，按上面降温方案，能保证网络收敛于全局最小值

sumstotal = 0
For k = 0 To neuralnumber - 1
If output(k) = 1 Then            '计算
sumstotal = sumstotal + 2 ^ k
End If
Next k
If output(i) = 1 Then
s(sumstotal) = s(sumstotal) + 1
changenumber = changenumber + 1
End If
Wend

For i = 0 To 15          '将记载次数的数组清0
s(i) = 0
Next i

'打印降温期间概率
For i = 0 To 15
  If changenumber <> 0 Then
  q(i) = s(i) / changenumber
  Else
  q(i) = 0
  End If
Label13.Caption = q(i)
Label11.Caption = Label11.Caption + Label13.Caption + Chr(10) & Chr(13)
Next i
'打印0.01温度时的继续进行1000词的状态转移的概率
t = 0.01
Randomize
For f = 0 To 999
i = Int(neuralnumber * Rnd)
 For j = 0 To neuralnumber - 1
 heat = heat + weights(i, j) * output(j)
 Next j
 heat = heat - threshold(i)                                 '2)计算 Hi = ∑jwijxj-θi
probability = 1 / (1 + Exp(-heat / t))

If heat >= 0 Then
output(i) = 1
End If

If heat < 0 Then
k = Rnd / 2
If probability > k Then
      output(i) = 1
      End If
End If
sumstotal = 0
For k = 0 To neuralnumber - 1
If output(k) = 1 Then            '计算
sumstotal = sumstotal + 2 ^ k
End If
Next k
'if output
s(sumstotal) = s(sumstotal) + 1
Next f

'打印出来概率
For i = 0 To 15     '打印出实际概率值
p(i) = s(i) / 1000
Label13.Caption = p(i)
Label12.Caption = Label12.Caption + Label13.Caption + Chr(10) & Chr(13)
Next i

End Sub

Private Sub Command2_Click()
'定温


Dim i, j, k, f, tempoutput As Integer
Dim tend, tmax, t As Double                '停止温度0.01，最高温度100
Dim runnumber As Integer                 '运行次数1000
Dim changenumber As Integer               '状态转移总次数
Dim statenumber As Integer               '状态数16
Dim neuralnumber As Integer              '神经元数
Dim energyweight, energythreshold, energytotal As Double            '能量
Dim s(16) As Integer                     '各状态出现的次数
Dim p(16) As Double                      '各状态出现的频率
Dim h(4) As Double                       '各各神经元此时状态的能量
Dim q(16) As Double                      '各状态出现的理论值
Dim stateenergy(16) As Double           '个状态的能量
'Dim inistate(4) As Integer               '初始设值状态
Dim threshold(4) As Double               '域值
Dim weights(4, 4) As Double               '连接权重
Dim output(4) As Integer                 '此时的状态
Dim c(16, 4) As Integer                  '16种状态
c(0, 0) = -1
c(0, 1) = -1
c(0, 2) = -1
c(0, 3) = -1
c(1, 0) = -1
c(1, 1) = -1
c(1, 2) = -1
c(1, 3) = 1
c(2, 0) = -1
c(2, 1) = -1
c(2, 2) = 1
c(2, 3) = -1
c(3, 0) = -1
c(3, 1) = -1
c(3, 2) = 1
c(3, 3) = 1
c(4, 0) = -1
c(4, 1) = 1
c(4, 2) = -1
c(4, 3) = -1
c(5, 0) = -1
c(5, 1) = 1
c(5, 2) = -1
c(5, 3) = 1
c(6, 0) = -1
c(6, 1) = 1
c(6, 2) = 1
c(6, 3) = -1
c(7, 0) = -1
c(7, 1) = 1
c(7, 2) = 1
c(7, 3) = 1
c(8, 0) = 1
c(8, 1) = -1
c(8, 2) = -1
c(8, 3) = -1
c(9, 0) = 1
c(9, 1) = -1
c(9, 2) = -1
c(9, 3) = 1
c(10, 0) = 1
c(10, 1) = -1
c(10, 2) = 1
c(10, 3) = -1
c(11, 0) = 1
c(11, 1) = -1
c(11, 2) = 1
c(11, 3) = 1
c(12, 0) = 1
c(12, 1) = 1
c(12, 2) = -1
c(12, 3) = -1
c(13, 0) = 1
c(13, 1) = 1
c(13, 2) = -1
c(13, 3) = 1
c(14, 0) = 1
c(14, 1) = 1
c(14, 2) = 1
c(14, 3) = -1
c(15, 0) = 1
c(15, 1) = 1
c(15, 2) = 1
c(15, 3) = 1

neuralnumber = Text1.Text
runnumber = Text3.Text
Text2.Text = 100
tmax = Text2.Text
tend = Text4.Text
statenumber = Sqr(neuralnumber)
t = tmax
Randomize                                '初始化域值
For i = 0 To neuralnumber - 1
threshold(i) = Rnd
Next i

For i = 0 To neuralnumber - 2            '初始化连接权重
  For j = i + 1 To neuralnumber - 1
  weights(i, j) = Rnd
  weights(j, i) = weights(i, j)
  Next j
Next i
For i = 0 To neuralnumber - 1
 weights(i, i) = 0
Next i


For i = 0 To 3                           '将初始状态存入output(i)中
output(i) = Command4(i).Caption
Next i

For i = 0 To 15                           '显示出状态编号
  For j = 0 To 3
  Label13.Caption = c(i, j)
  Label9.Caption = Label9.Caption + Label13.Caption
  Next j
  Label9.Caption = Label9.Caption + Chr(10) & Chr(13)
Next i

For i = 0 To 3
Next i
'---------------------------显示对应能量-------------------------------------------
energythreshold = 0
energyweight = 0
For k = 0 To 15
For i = 0 To neuralnumber - 1                          '求一个状态的能量-------
  For j = 0 To neuralnumber - 1
  energyweight = energyweight + weights(i, j) * c(k, i) * c(k, j)
  Next j
  energythreshold = energythreshold + threshold(i) * c(k, i)
Next i
energytotal = -0.5 * energyweight + energythreshold   'E =  - 0.5∑i∑jwijxixj + ∑iθixi
Label13.Caption = energytotal                             '打印出能量
Label10.Caption = Label10.Caption + Label13.Caption + Chr(10) & Chr(13)
stateenergy(k) = energytotal
Next k

'---------------------------运行网络————————————————————
'   输出为{ui}，神经元的内部状态为{Hi}
Dim heat, probability As Double
Dim sums As Integer
Dim sumstotal As Integer
Randomize

For f = 0 To runnumber - 1
i = Int(neuralnumber * Rnd)               '1）从N个神经元中随机选取一个神经元i
 For j = 0 To neuralnumber - 1            '2）求神经元 i的内部状态 Hi=∑wijuj(t)-θi，j=1…n, j≠i
 heat = heat + weights(i, j) * output(j)
 Next j
 heat = heat - threshold(i)
'3）按下式所示概率将神经元 i的状态更新为1, p [ui(t+1)=1] = 1 / (1 + Exp(-Hi(t) / t))  '不同的Hi对应不同的概率
'更新方法两种中一种:若Hi(t) > 0，直接使 ui(t+1)=1；若Hi(t) < 0，在[0，0.5]内产生一随机数ε(t)
'当   p[ui(t+1) =1] > ε(t)时，ui（t+1）=1，否则 ui(t+1) =ui(t)
probability = 1 / (1 + Exp(-heat / t))
tempoutput = output(i)
If heat >= 0 Then
output(i) = 1
End If

If heat < 0 Then
      k = Rnd / 2
'      k = 0.5
      If probability > k Then
      output(i) = 1
      End If
End If

If output(i) = 1 Then     '如果状态转换，相应的状态的出现值加一

   sumstotal = 0
   For k = 0 To neuralnumber - 1
     If output(k) = 1 Then            '计算状态相应的状态编号
     sumstotal = sumstotal + 2 ^ k
     End If
   Next k
   s(sumstotal) = s(sumstotal) + 1
   changenumber = changenumber + 1
End If

Next f

For i = 0 To 15     '打印出实际概率值
If changenumber <> 0 Then
p(i) = s(i) / changenumber
Else
p(i) = 0
End If
Label13.Caption = p(i)
Label12.Caption = Label12.Caption + Label13.Caption + Chr(10) & Chr(13)
Next i
Dim z As Double
z = 0
'打印理论概率值
'Q(Ei) = (1/Z) exp (-Ei/T)         Ei—状态{ui}所对应的网络能量
'Z=∑exp (-Ei/T) ,i=1…N ——常数，网络所有状态的能量之和为常数
'同时按照Bo1tzmann分布计算网络各个状态出现概率的理论值:
'Q（Ei）=（1/Z）exp（-Ei/T）
'其中Ei = -0.5∑j=1,n,j≠iwijuiuj-θiuj
For i = 0 To 15
z = z + Exp(-stateenergy(i) / 100)
Next i

For i = 0 To 15
q(i) = Exp(-stateenergy(i) / 100)
q(i) = q(i) / z
Label13.Caption = q(i)
Label11.Caption = Label11.Caption + Label13.Caption + Chr(10) & Chr(13)
Next i
Label15.Caption = changenumber
End Sub

Private Sub Command4_Click(Index As Integer)
If Command4(Index).Caption = 1 Then      '设置初始状态
    Command4(Index).Caption = -1
ElseIf Command4(Index).Caption = -1 Then
    Command4(Index).Caption = 1
End If

End Sub