传统模拟退火算法源代码（VB.net) - 数学建模社区-数学中国

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