和声搜索算法源代码

和声搜索算法是一和启发式的全局搜索智能算法，在许多优化问题中得到了成功应用，而且在不少优化问题上比常规的一些智能算法的性能表现更优越，并且程序实现比较简单，这里给出的源代码是和声搜索算法的一个实现版本，harmony search算法的介绍流程可以参考CnHUP写的和声搜索算法，具体代码如下：

'================================
' 和声搜索算法源代码
' 
'================================
Function fn(x1, x2) As Double
    fn = 100 * (x2 - x1 ^ 2) ^ 2 + (1 - x1) ^ 2
End Function

Sub Harmony_Search_Main()
    Dim limit(2, 3), x(2)
    Dim HM(100, 2)

    ND = 2    'number of decision variables

    'lower limit, upper limit & # of initinal segments
    limit(1, 1) = -10: limit(1, 2) = 10: limit(1, 3) = 300
    limit(2, 1) = -10: limit(2, 2) = 10: limit(2, 3) = 300

    HMS = 30: HMCR = 0.95: PAR = 0.7: MaxImp = 30000

    For i = 1 To HMS
        For j = 1 To ND
            d1 = limit(j, 2) - limit(j, 1)
            x(j) = limit(j, 1) + d1 * Rnd
        Next j

        For j = 1 To ND
            HM(i, j) = x(j)
        Next j
        HM(i, 0) = fn(x(1), x(2))
    Next i

    For iter = 1 To MaxImp
        For j = 1 To ND
            If Rnd >= HMCR Then
                'Random Searching
                d1 = limit(j, 2) - limit(j, 1)
                x(j) = limit(j, 1) + d1 * Rnd
            Else
                'Harmony Memory Considering
                d1 = Int(HMS * Rnd) + 1
                x(j) = HM(d1, j)

                If Rnd <= PAR Then
                    ' Pitch Adjusting
                    d1 = (limit(j, 2) - limit(j, 1)) / limit(j, 3)
                    If Rnd > 0.5 Then
                        x(j) = x(j) + d1 * Rnd
                    Else
                        x(j) = x(j) - d1 * Rnd
                    End If
                End If
            End If
        Next j

        'eval(fn)
        Sol = fn(x(1), x(2))

        hmax_num = 1: hmax = HM(1, 0)
        For i = 2 To HMS
            If HM(i, 0) > hmax Then
                hmax_num = i
                hmax = HM(i, 0)
            End If
        Next i

        If Sol < hmax Then
            For j = 1 To ND
                HM(hmax_num, j) = x(j)
            Next j
            HM(hmax_num, 0) = Sol
        End If

        hmin_num = 1: hmin = HM(1, 0)
        For i = 2 To HMS
            If HM(i, 0) < hmin Then
                hmin_num = i
                hmin = HM(i, 0)
            End If
        Next i

        'update solution and result view
        If Sol = hmin Then
            Cells(4, 5) = iter
            Cells(5, 5) = x(1)
            Cells(6, 5) = x(2)
            Cells(7, 5) = Sol
        End If
    Next iter

End Sub