A*算法实现特例

本实例为广度优先搜索，即类似穷举算法(广度优先算法为A*算法特例)。有空再搞个启发式A*实例

介绍A*算法首先我来创造一个模拟环境来讲解怎么实现A*算法。

先在C盘根目录下创建一个名字为 测试.xls 的表格 然后打开表格在格式里设置行高为10列宽为1
如图

然后 在这个表格里用"a"表示障碍来绘制一个地图
绿点是起点，黑点是终点。然后保存,

这样子我们就得到了一个模拟环境，接下来我就来讲解如何用算法计算出绿点到黑点的最短路径。


首先我们需要将这个模拟地图加载到脚本里，这时候需要用到办公插件里的打开Excel命令

1. Call Plugin.Office.OpenXls("C:\测试.xls")

复制代码

打开了表格记得一定要写个脚本终止事件来结束表格，不然按键关闭后该表格依然为打开状况占据内存。

1. Sub OnScriptExit()
   
2. Call Plugin.Office.CloseXls()
   
3. MessageBox "脚本已经停止！"
   
4. End Sub

复制代码

然后我们创建一个二维的数组来储存地图信息。

1. Dim 地图(101, 101)

复制代码

创建完数组接下来就设置个循环来加载地图

1. w=1:点y = 1:点x = 1
   
2. While w = 1
   
3. Call Plugin.Msg.ShowScrTXT(0, 0, 1024, 768, "加载地图中......", "0000FF")
   
4.     地图(点x, 点y) = Plugin.Office.ReadXls(1, 点y, 点x)
   
5.     If 点x < 51 Then
   
6.         点x = 点x + 1
   
7.     Else
   
8.         点x = 1
   
9.         点y=点y+1
   
10.     End If
    
11.     If 点y = 51 Then
    
12.         w=2
    
13.     End If
    
14. Wend

复制代码

载入地图后我们就可以开始写A*

A* A* 什么才是A*呢？ 首先我们知道游戏的地图都是一个一个坐标点组成的，就有点像扫雷的格子一样，如果我在的点表示A那么和我相邻的点就有八个，就是这八个点把我包围了 所以就像*这个符号一样
是散射状的， 需要计算两点之间的未知的路径，我们就需要从起点开始一个点一个点的去向终点靠近，就是说我们可以这样子计算 包围起点的有8个点，我们视为第一层，然后再从第一层的每个点的*散射得到第二层，依次类推
当某层接触到终点的时候我们就能得到起点到终点的路径了，因为是一层一层向外推导的，所以当第一个接触到终点的路径一定是最短的层，所以就得到了从起点点到终点的最短路径，这就是A*算法的文字解释。
下面我就用脚本告诉大家如何用按键的脚本实现A*算法
首先 当然是定义起点 和 终点

1. 起点X = 3
   
2. 起点y = 5
   
3. 终点x = 22
   
4. 终点y = 4

复制代码

然后将起点终点坐标注进地图

1. 地图(终点x, 终点y)="起点"
   
2. 地图(终点x, 终点y)="终点"

复制代码

接下来我们再定义两个数组来储存A* 的*状的边各点跟 A点的变化情况
因为我个人比较讨厌变量从0开始 所以在该数组中将0的位置随便放了个值顶替掉。

1. 临x = Array(a, 0, 1, 0, - 1 , 1, 1, - 1 , - 1 )
   
2. 临y = Array(a,- 1 , 0, 1, 0, -1, 1, 1 , - 1 )

复制代码

上面定义的这些-1 1 0什么的可能有些同学还不太明白 我再详细介绍这些数值的由来

2011-5-17 18:53 上传

下载附件(4.8 KB)

如上图 我们可以给点A的周边*状结构来个排序定义，一般我们可以顺逆时针按顺序来（如右图），也可按角和边的关系来定义（如左图），其实不管怎么定义*状的顺序得到的结果都是最优路径，只是路径的某些细节上会不太一样。
一般用先边后角的顺序得出的路径会比较平整。所以我上面定义的数组就是按照左图来定义的   比如 临x(1) 就是1的位置 相对点A  x坐标没有发生改变所以是0, 临y(1) 相对点A的坐标 减少了1 所以是-1.依次类推得到了
这两个计算A*顺序的数组。其实真正A*中这个数组里的值非恒定值 而是根据评估得到的，即
接下来我定义 4个数组来储存两组层的坐标信息，

1. Dim 动1x(1000), 动1y(1000), 动2x(1000), 动2y(1000)

复制代码

数组动1 用来储存正在计算层的坐标，数组动2 用来存储 动1计算出来的下一层的坐标，比如起点A 一开始就被放入动1数组中，然后在计算的起点A的过程中得到的他周边8个点就被存在动2数组中。
当动1数组内的所有坐标都被计算完之后，这时候动2数组里已经记录下下一层的全部坐标，就可将这些坐标用循环结构导入动1数组在进行下一层的计算。
这样的设计可以实现上一层向下一层推导的过程，很多学A*的人都被卡在这里了。
实际脚本中我是用动态数组来做这个的，这里为了方便大家理解就省略一个知识点，代用一个定义为1000的数组来做。

做完定义数组，下面就是定义一些循环控制变量了。
我一共设计了3个循环控制变量，

1. 总点=1   //总点表示正在计算的层有多少个点
   
2. 动点=1  //动点 表示正在计算该层中第几个点
   
3. 动点1=1 //动点1 表示正在储存的点是下一层中的第几个点

复制代码

设计完这些我就开始从里层循环开始写
A*A*
*就=8个周边点，所以想都不用想就知道核心循环一定是

1. For 8
   
2. Next

复制代码

然后我们在FOR 8 循环里将控制核心写出来

1. For 8   
   
2.              //我用算点 表示 A* 中A点周边的*点
   
3.              算点x = 动1x(动点) + 临x(步) : 算点y = 动1y(动点) + 临y(步)
   
4.              //用判断语句判断防止出地图边界
   
5.             If 算点x > 0 and 算点y > 0 and 算点x < 100 and 算点y < 100 Then
   
6.                       //从地图数组里拿取算点的信息 查看是否是障碍 或者终点 或者其他
   
7.                       资料=地图(算点x, 算点y)
   
8.                       If 资料 = "终点" Then
   
9.                         ElseIf 资料 = "a"  Then
   
10.                         ElseIf 资料 = ""  Then
    
11.                        End If
    
12.              End If
    
13.             步 = 步 + 1
    
14. Next

复制代码

然后我们不能只算一个点 所以在这个循环外在套一个循环，这里就有点像找字或者验证码什么的了。不过这个结构虽然像 但是它是个动态的结构，不像找字是个固定的循环结构，这个结构里全部用变量控制着循环
每循环的量是不一样的  是因为该层的可计算点数 总点 来控制的所以这个循环外面我们套个For 总点

1. For 总点   
   
2. 步=1   
   
3. For 8      
   
4. 代码.......     
   
5. 步=步+1   
   
6. Next  
   
7. 动点=动点+1
   
8. Next

复制代码

从上面的代码 大家都应该明白了吧 步这个变量只是在FOR 8 中使用  在下一次FOR 8之前需要归一  所以在FOR 8 头上 FOR 总点底下加 步=1 而FOR 8 的结束语句前 步则加1
然后在FOR 总点  的结束语句前 加了个 动点=动点+1  则是用来控制 当前计算动点 是该曾第几动点 每计算一个都向下累加


到了这一步 我们已经写完一个层的计算代码，但实际中我们不知道距离到终点我们要经过几个层  所以我们需要在  FOR 总点 循环之外 再加一个条件循环 DO while，让找到终点则条件改变 停止循环

Do  While w = 2
Call Plugin.Msg.ShowScrTXT(0, 0, 1024, 768, "路径计算中.........", "0000FF")
    动点=1
    动点1=1
    For 总点
        步 = 1
        For 8
            算点x = 动1x(动点) + 临x(步) : 算点y = 动1y(动点) + 临y(步)
            If 算点x > 0 and 算点y > 0 and 算点x < 100 and 算点y < 100 Then
                资料=地图(算点x, 算点y)
                If 资料 = "终点" Then
                    资料=地图(动1x(动点), 动1y(动点))
                    路径 = 资料 & 步
                    MessageBox 路径
                    Call Plugin.Sys.SetCLB(路径)
                    Exit Do
                    w = 3
                ElseIf 资料 = "a" or 资料 = "0" Then
                ElseIf 资料 = "" or 资料="b" Then
                    资料=地图(动1x(动点), 动1y(动点))
                    输入 = 资料 & 步
                    地图(算点x, 算点y) = 输入
                    动2x(动点1) = 算点x
                    动2y(动点1) = 算点y
                    动点1 = 动点1 + 1
                End If
            End If
            步 = 步 + 1
        Next
        动点=动点+1
    Next
    总点=动点1-1
    i = 1
    For 总点
        动1x(i) = 动2x(i)
        动1y(i) = 动2y(i)
        i=i+1
    Next  
Loop





到这里其实A*算法已经完成了，按照这个脚本计算之后我们得到一条"111222333444555666"这样到数字串表示的起点到终点的路径，但是这个不好观察，所以我在写一个将改路径反映到表格地图中，让大家可直观观察的脚本


Dim b(100)
i = 1
c=Len(路径)
    For c

        b(i) = Mid(路径, i, 1)
        If b(i) = "0" Then
        ElseIf b(i) = "1" Then
        起点y = 起点y - 1
        ElseIf b(i) = "2" Then
        起点x = 起点x + 1
        ElseIf b(i) = "3" Then
        起点y = 起点y + 1
        ElseIf b(i) = "4" Then
        起点x = 起点x - 1
        ElseIf b(i) = "5" Then
        起点y = 起点y - 1
        起点x = 起点x + 1
        ElseIf b(i) = "6" Then
        起点y = 起点y + 1
        起点x = 起点x + 1
        ElseIf b(i) = "7" Then
        起点y = 起点y + 1
        起点x = 起点x - 1
        ElseIf b(i) = "8" Then
        起点y = 起点y - 1
        起点x = 起点x - 1
        End If
        Call Plugin.Office.WriteXls(1, 起点y, 起点x, "b")
        i=i+1
    Next



将上面的全部内容整合成完整的脚本

1. //旧脚本效率低 已经删除

复制代码

旧的脚本将每一个坐标的路径都完整记录进去 非常占用内存和计算速度。 觉得没有必要将全部路径记录下来 只要将每个点的值储存他来的点的方向就OK了 这样直接可以逆推路径
下面发修改过的代码

1. Call Plugin.Office.OpenXls("C:\测试.xls")
   
2. Dim 地图(101, 101)
   
3. w=1:点y = 1:点x = 1
   
4. While w = 1
   
5.     Call Plugin.Msg.ShowScrTXT(0, 0, 1024, 768, "加载地图中......", "0000FF")
   
6.     地图(点x, 点y) = Plugin.Office.ReadXls(1, 点y, 点x)
   
7.     If 点x < 51 Then
   
8.         点x = 点x + 1
   
9.     Else
   
10.         点x = 1
    
11.         点y=点y+1
    
12.     End If
    
13.     If 点y = 51 Then
    
14.         w=2
    
15.     End If
    
16. Wend
    
17. Sub OnScriptExit()
    
18.     Call Plugin.Office.CloseXls()
    
19.     MessageBox "脚本已经停止！"
    
20. End Sub
    
21. 起点X = 3
    
22. 起点y = 5
    
23. 终点x = 22
    
24. 终点y = 4
    
25. 地图(起点x, 起点y) = "起点"
    
26. Call Plugin.Office.WriteXls(1, 起点y, 起点x, 0)
    
27. 地图(终点x, 终点y)="终点"
    
28. 层 = 1
    
29. 临x = Array(a, 0, 1, 0, - 1 , 1, 1, - 1 , - 1 )
    
30. 临y = Array(a,- 1 , 0, 1, 0, -1, 1, 1 , - 1 )
    
31. 动态点x = 起点x
    
32. 动态点y = 起点y
    
33. MessageBox "开始穷举路径"
    
34. w=2
    
35. Dim 动1x(1000), 动1y(1000), 动2x(1000), 动2y(1000)
    
36. 总点=1
    
37. 动1x(1)=起点x:动1y(1)=起点y
    
38. Do  While w = 2
    
39.     Call Plugin.Msg.ShowScrTXT(0, 0, 1024, 768, "路径计算中.........", "0000FF")
    
40.     动点=1
    
41.     动点1=1
    
42.     For 总点
    
43.         步 = 1
    
44.         For 8
    
45.             算点x = 动1x(动点) + 临x(步) : 算点y = 动1y(动点) + 临y(步)
    
46.             If 算点x > 0 and 算点y > 0 and 算点x < 100 and 算点y < 100 Then
    
47.                 资料=地图(算点x, 算点y)
    
48.                 If 资料 = "a" or 资料 = "0" Then
    
49.                 ElseIf 资料 = "" or 资料 = "b" or 资料 = "终点" Then
    
50.                     If 步 = 1 Then
    
51.                         输入=3
    
52.                     ElseIf 步 = 2 Then
    
53.                         输入=4
    
54.                     ElseIf 步 = 3 Then
    
55.                         输入=1
    
56.                     ElseIf 步 = 4 Then
    
57.                         输入=2
    
58.                     ElseIf 步 = 5 Then
    
59.                         输入=7
    
60.                     ElseIf 步 = 6 Then
    
61.                         输入=8
    
62.                     ElseIf 步 = 7 Then
    
63.                         输入=5
    
64.                     ElseIf 步 = 8 Then
    
65.                         输入=6
    
66.                     End If
    
67.                     h = abs(算点x - 终点x) * 10 + abs(算点y - 终点y) * 4   //能理解这三句的同学就应该能自己写A*了
    
68.                     g = abs(算点x - 起点x) * 10 + abs(算点y - 起点y) * 4   //能理解这三句的同学就应该能自己写A*了
    
69.                     F = g + h                                                           //能理解这三句的同学就应该能自己写A*了
    
70. 
    
71.                     //我这里只写特例即 H=0 的情况
    
72. 
    
73. 
    
74. 
    
75.                     地图(算点x, 算点y) = 输入
    
76.                     If 资料 = "终点" Then
    
77.                         Exit Do
    
78.                     End If
    
79.                     动2x(动点1) = 算点x
    
80.                     动2y(动点1) = 算点y
    
81.                     动点1 = 动点1 + 1
    
82.                 End If
    
83.             End If
    
84.             步 = 步 + 1
    
85.         Next
    
86.         动点=动点+1
    
87.     Next
    
88.     总点=动点1-1
    
89.     i = 1
    
90.     For 总点
    
91.         动1x(i) = 动2x(i)
    
92.         动1y(i) = 动2y(i)
    
93.         i=i+1
    
94.     Next  
    
95. Loop
    
96. 反过来获取从终点到起点的路径
    
97. 路径=""
    
98. 算点x = 终点x
    
99. 算点y = 终点y
    
100. While 资料 <> "起点"
     
101.     资料=地图(算点x, 算点y)
     
102.     If 资料 <> "起点" Then
     
103.     算点x = 算点x + 临x(资料)
     
104.     算点y = 算点y + 临y(资料)
     
105.     End If
     
106.     路径=路径&资料
     
107. Wend
     
108. 
     
109. MessageBox 路径
     
110. Dim b(100)
     
111. i = 1
     
112. c=Len(路径)-1
     
113. For c
     
114.     b(i) = Mid(路径, i, 1)
     
115.     If b(i) = "0" Then
     
116.     ElseIf b(i) = "1" Then
     
117.         终点y = 终点y - 1
     
118.     ElseIf b(i) = "2" Then
     
119.         终点x = 终点x + 1
     
120.     ElseIf b(i) = "3" Then
     
121.         终点y = 终点y + 1
     
122.     ElseIf b(i) = "4" Then
     
123.         终点x = 终点x - 1
     
124.     ElseIf b(i) = "5" Then
     
125.         终点y = 终点y - 1
     
126.         终点x = 终点x + 1
     
127.     ElseIf b(i) = "6" Then
     
128.         终点y = 终点y + 1
     
129.         终点x = 终点x + 1
     
130.     ElseIf b(i) = "7" Then
     
131.         终点y = 终点y + 1
     
132.         终点x = 终点x - 1
     
133.     ElseIf b(i) = "8" Then
     
134.         终点y = 终点y - 1
     
135.         终点x = 终点x - 1
     
136.     End If
     
137.     Call Plugin.Office.WriteXls(1, 终点y, 终点x, "b")
     
138.     i=i+1
     
139. Next

复制代码

 

转自 http://bbs.anjian.com/thread-223322-1-1.html