[代码资源] 传统模拟退火算法源代码（VB.net)

[复制链接]

字体大小: 正常放大

xttataat

5 主题	4 听众	41 积分

升级 37.89%

TA的每日心情

	郁闷 2012-2-15 14:23

签到天数: 4 天

[LV.2]偶尔看看I

电梯直达

1^#

发表于 2012-1-13 19:26 |只看该作者 |正序浏览

|招呼Ta 关注Ta

贴上本人自己写的模拟退火算法的源代码，开发环境 Visual Basic.net 2005
觉得有用的给个回复，拉拉人气..

Public Class CSA

Public Function obFun(ByVal x As Double) As Double
      Return 2 * Math.Pow(x, 2) - x - 1
End Function

''' <summary>
''' 传统的模拟退火算法
''' </summary>
''' <param name="Ux ">参数的取值范围上限</param>
''' <param name="Lx ">参数的取值范围下限</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function CSA(ByVal Ux As Double, ByVal Lx As Double) As Double
      Dim init_temperature As Double, total_numk As Double, step_size As Double '定义初始温度,温度k时循环总次数，步长
      Dim x As Double, receivnum As Double '定义变量当前值，前一个值，内循环的接受数据

      '初始化SA参数
      init_temperature = 0.01
      total_numk = 1000
      step_size = 0.001
      receivnum = 50
      x = (Lx - Ux) * Rnd() + Ux '随机产生变量x

      Dim k As Integer = 0 '温度下降次数控制变量
      Dim temperature_k As Double = init_temperature '定义第k次温度
      Dim best_x As Double
      Dim de As Double = 0.0
      Dim fcur As Double = 0.0
      Dim xi As Double

      Dim fprevs As Double = obFun(x)
      Dim xprevs As Double = x
      'SA算法核心
      Do
         'xprevs = x '保留前一个变量值

         '以下三个参数用于估算接受概率
         Dim rec_num As Integer = 0 '接受次数计数器
         Dim temp_i As Double = 0 '记录下面for循环的循环次数
         Dim temp_num = 0 '记录fxi<fx的次数

         For i As Integer = 1 To total_numk
            '产生满足要求的下一个数
            Do
                  xi = x + (2 * Rnd() - 1) * step_size
            Loop While (xi > Ux Or xi < Lx)

            fcur = obFun(xi)
            de = fcur - fprevs

            If de < 0 Then '函数值小的直接进入下次迭代
                  best_x = xi
                  x = xi
                  rec_num += 1
                  temp_num += 1
                  fprevs = fcur
            Else
                  Dim p As Double, r As Double
                  p = Math.Exp(-de / temperature_k)
                  r = Rnd()

                  If p > r Then
                     '以概率的形式接受使函数值变大的数
                     x = xi
                     rec_num += 1
                     fprevs = fcur
                  End If
            End If
            If rec_num > receivnum Then
                  temp_i = i - 1
                  Exit For
            End If
         Next

         k += 1
         temperature_k = init_temperature / (k + 1) '温度下降原则

         If Math.Abs(best_x - 0.25) < 0.00001 Then Exit Do

      Loop While (k < 5000 )
      xprevs = x

      Return best_x
End Function

End Class

& ~% @- r+ S) q3 x

算法测试：

在窗口中添加一个按钮

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim csa As CSA_Cnhup = New CSA_Cnhup

Dim x1 As Double, x2 As Double
x1 = 2 'CDbl(InputBox("参数上限", "参数范围", 2) & " ")
x2 = -2 'CDbl(InputBox("参数下限", "参数范围", -2) & " ")
Dim y As Double

For i As Integer = 0 To 19
y = csa.CSA(x1, x2)
Debug.Print("(" & y.ToString & "," & csa.obFun(y).ToString & ")")
Next
Debug.Print((New System.Text.StringBuilder).Append("-", 60).ToString)
End Sub

zan

传统, 算法, 源代码