module1.vb

重排九宫问题的启发式搜索算法求解

Module Module1
    Public strBD As String '0-8(cData);9-17(fData);18-26(Steps);27-35(preference)
    Public Enum BD
        c = 0
        f = 9
        s = 18
        p = 27
    End Enum
    Public Const conL As Byte = 9

    Public cData As String  '当前状态
    Public fData As String  '父状态
    Public Steps As Int32   '
    Public Preference As Int32  '优先级


    Public Const conEndSign As String = "111111111"    '找最优路径是的结束标记
    Public Const conSpace As String = "0"    '空格常量
    Public Const conS As String = "123804765"   '标准状态常量


   



    Public colOpen As Collection    'open，close,best表
    Public colClose As Collection
    Public colBest As Collection





    Public Function Extension(ByVal strValue As String) As Collection     '扩展接点
        Dim strC, strF, strS, strP As String

        Dim n, m, t As Int32

        Dim bytSpace As Byte
        Dim tn, tm As Int16
        Dim chrC(8), chrS(8) As Char

        Dim colTemp As New Collection


        cData = strValue.Substring(0, 9)
        fData = strValue.Substring(9, 9)
        Steps = strValue.Substring(18, 9) + 1
        Preference = strValue.Substring(27, 9)

        bytSpace = cData.IndexOf(conSpace) '找出空格所在位置
        tn = bytSpace \ 3   '所在行
        tm = bytSpace Mod 3 ' 所在列

        strS = Steps + 1
        strS = strS.PadLeft(9)
        strF = cData
        chrS = conS.ToCharArray


        '空格上移
        chrC = cData.ToCharArray
        If tn - 1 > -1 Then
            '移动
            n = bytSpace - 3
            chrC(bytSpace) = chrC(n)
            chrC(n) = conSpace
            strC = chrC.Clone

            '计算优先级

            m = 0
            For t = 0 To 8
                If chrC(t) <> chrS(t) Then
                    m = m + 1
                End If
            Next
            strP = m * 1000 + Steps + 1
            strP = strP.PadLeft(9)

            '判断是否与fdata.fdata相同
            If Not strC.Equals(fData) Then
                strBD = strC.Insert(9, strF.Insert(9, strS.Insert(9, strP)))
                colTemp.Add(strBD)
            End If
        End If

        '空格下移
        chrC = cData.ToCharArray
        If tn + 1 < 3 Then
            '移动
            n = bytSpace + 3
            chrC(bytSpace) = chrC(n)
            chrC(n) = conSpace
            strC = chrC.Clone

            '计算优先级

            m = 0
            For t = 0 To 8
                If chrC(t) <> chrS(t) Then
                    m = m + 1
                End If
            Next
            strP = m * 1000 + Steps + 1
            strP = strP.PadLeft(9)

            '判断是否与fdata.fdata相同
            If Not strC.Equals(fData) Then
                strBD = strC.Insert(9, strF.Insert(9, strS.Insert(9, strP)))
                colTemp.Add(strBD)
            End If
        End If
        '空格左移
        chrC = cData.ToCharArray
        If tm - 1 > -1 Then
            '移动
            n = bytSpace - 1
            chrC(bytSpace) = chrC(n)
            chrC(n) = conSpace
            strC = chrC.Clone

            '计算优先级

            m = 0
            For t = 0 To 8
                If chrC(t) <> chrS(t) Then
                    m = m + 1
                End If
            Next
            strP = m * 1000 + Steps + 1
            strP = strP.PadLeft(9)

            '判断是否与fdata.fdata相同
            If Not strC.Equals(fData) Then
                strBD = strC.Insert(9, strF.Insert(9, strS.Insert(9, strP)))
                colTemp.Add(strBD)
            End If
        End If
        '空格右移
        chrC = cData.ToCharArray
        If tn + 1 < 3 Then
            '移动
            n = bytSpace + 1
            chrC(bytSpace) = chrC(n)
            chrC(n) = conSpace
            strC = chrC.Clone

            '计算优先级

            m = 0
            For t = 0 To 8
                If chrC(t) <> chrS(t) Then
                    m = m + 1
                End If
            Next
            strP = m * 1000 + Steps + 1
            strP = strP.PadLeft(9)

            '判断是否与fdata.fdata相同
            If Not strC.Equals(fData) Then
                strBD = strC.Insert(9, strF.Insert(9, strS.Insert(9, strP)))
                colTemp.Add(strBD)
            End If
        End If




        Return colTemp
    End Function

End Module