boltzmann.txt

vb的波尔兹曼机（含模拟退火算法）

Dim w(1 To 99, 1 To 99) As Double
Dim pointcount As Integer
Dim initialPoint As Integer
Dim x(1 To 99) As Integer
Dim yuZhi(1 To 99) As Double
Dim E As Double
Dim initialT As Double
Dim lastT As Double
Dim Pi(1 To 99) As Double
Dim Si(1 To 99) As Integer


Private Sub Command1_Click()

lastT = Val(Text3.Text)
initialT = Val(Text2.Text)
nextT = initialT
Text4.Text = ""
Text4.Text = Text4.Text + "初始神经元状态"
For ii = 1 To pointcount - 1
Text4.Text = Text4.Text + Str(x(ii))
Next ii
Text4.Text = Text4.Text + Str(x(ii)) + Chr(13) + Chr(10)
Text4.Text = Text4.Text + "运行结果" + Chr(13) + Chr(10)
Text4.Text = Text4.Text + "i" + Space(10)
Text4.Text = Text4.Text + "H" + Space(10)
Text4.Text = Text4.Text + "能量" + Space(10)
Text4.Text = Text4.Text + "神经元状态" + Chr(13) + Chr(10)
'For m = 1 To pointCount
'x(m) = Val(Text2(m - 1).Text)
'Next m

For k = 1 To Val(Text1(1).Text)

E = 0
H = 0
initialPoint = Int(pointcount * Rnd) + 1

For i = 1 To pointcount
  For j = 1 To pointcount
  If Not i = j Then E = w(i, j) * x(i) * x(j) + E
  Next j
Next i
E = -0.5 * E

For i = 1 To pointcount
E = E + x(i) * yuZhi(i)
Next i

For P = 1 To pointcount
  H = H + w(initialPoint, P) * x(P)
Next P
H = H - yuZhi(initialPoint)

sigmoid = 1 / (1 + Exp(-H / nextT))
Randomize
possible = 0.5 * Rnd

If H > 0 Then
x(initialPoint) = 1
Else
  If possible < sigmoid Then
  x(initialPoint) = 1
  Else
  x(initialPoint) = 0
  End If

End If
nextT = initialT / Log(k + 1)

If nextT < lastT Then
Text4.Text = Text4.Text + "温度到达最低点"
Exit For
End If
Text4.Text = Text4.Text + Str(initialPoint) + Space(3)
Text4.Text = Text4.Text + Format(Str(H), "0.000000") + Space(3)
Text4.Text = Text4.Text + Format(Str(E), "0.000000") + Space(3)
For q = 1 To pointcount
Text4.Text = Text4.Text + Str(x(q)) + Space(3)
Next q
'Text4.Text = Text4.Text + Str(x(pointcount)) + Chr(13) + Chr(10)
Text4.Text = Text4.Text + Str(sigmoid) + Space(3) + Str(possible) + Chr(13) + Chr(10)
Next k

End Sub

Private Sub Command2_Click()
For i = 1 To pointcount
x(i) = InputBox("请输入神经元的初始状态", "输入神经元初始状态", 1)
Next i
Text4.Text = Text4.Text + "神经元状态已经确定。" + Chr(13) + Chr(10)
For i = 1 To pointcount - 1
Text4.Text = Text4.Text + Str(x(i)) + " "
Next i
Text4.Text = Text4.Text + Str(x(i)) + " " + Chr(13) + Chr(10)
End Sub

Private Sub Command3_Click()

For n = 1 To pointcount
Randomize
yuZhi(n) = 2 * Rnd - 1
'text4.text=text4.text+ yuZhi(n)
Next n
pointcount = Val(Text1(0).Text)
For j = 1 To pointcount
  For k = 1 To j
  If Not j = k Then
  Randomize
  w(j, k) = 2 * Rnd - 1
  w(k, j) = w(j, k)
  Else
  w(j, k) = 0
  End If
  ' text4.text=text4.text+ "w" + Str(j) + Str(K) + "   " + Str(w(j, K)) + Str(w(K, j))
  Next k
Next j

Text4.Text = Text4.Text + "网络的权值和阈值已经确定。" + Chr(13) + Chr(10)

'For i = 0 To pointCount - 1

'Text2(i).Visible = True
'yuZhi(i + 1) = Rnd
'Next i
End Sub

Private Sub Command4_Click()

lastT = Val(Text3.Text)
initialT = Val(Text2.Text)
nextT = initialT
Text4.Text = ""
Text4.Text = Text4.Text + " "
Text4.Text = Text4.Text + "初始神经元状态"
For ii = 1 To pointcount - 1
Text4.Text = Text4.Text + Str(x(ii))
Next ii
Text4.Text = Text4.Text + Str(x(ii)) + Chr(13) + Chr(10)
Text4.Text = Text4.Text + "运行结果"
Text4.Text = Text4.Text + " "
Text4.Text = Text4.Text + Space(1) + "i" + Space(10)
Text4.Text = Text4.Text + "H" + Space(20)
Text4.Text = Text4.Text + "能量" + Space(10)
Text4.Text = Text4.Text + "神经元状态" + Chr(13) + Chr(10)
Text4.Text = Text4.Text + " "
Text4.Text = Text4.Text + " "
'For m = 1 To pointCount
'x(m) = Val(Text2(m - 1).Text)
'Next m

For k = 1 To Val(Text1(1).Text)

E = 0
H = 0
initialPoint = Int(pointcount * Rnd) + 1

For i = 1 To pointcount
  For j = 1 To pointcount
  If Not i = j Then E = -0.5 * (w(i, j) * x(i) * x(j)) + E
  Next j
  E = E + x(i) * yuZhi(i)
Next i

For P = 1 To pointcount
  H = H + w(initialPoint, P) * x(P)
  
Next P

H = H - yuZhi(initialPoint)

If H >= 0 Then
  x(initialPoint) = 1
Else
  x(initialPoint) = -1
End If

nextT = initialT / (k + 1)

Text4.Text = Text4.Text + Str(initialPoint) + Space(3)
Text4.Text = Text4.Text + Str(H) + Space(3)
Text4.Text = Text4.Text + Str(E) + Space(3)
For q = 1 To pointcount
Text4.Text = Text4.Text + Str(x(q)) + Space(3)
Next q
'Text4.Text = Text4.Text + Str(x(pointcount)) + Chr(13) + Chr(10)
Text4.Text = Text4.Text + Str(sigmoid) + Str(nextT) + Chr(13) + Chr(10)
Next k

End Sub