A*算法实现特例

待我称王封你为后i 2022-04-21 15:58 160阅读 0赞

本实例为广度优先搜索，即类似穷举算法(广度优先算法为A\*算法特例)。有空再搞个启发式A\*实例  
  
介绍A\*算法首先我来创造一个模拟环境来讲解怎么实现A\*算法。  
  
先在C盘根目录下创建一个名字为 测试.xls 的表格 然后打开表格在格式里设置行高为10列宽为1  
如图  
![A教程1.JPG][A_1.JPG]  
然后 在这个表格里用"a"表示障碍来绘制一个地图  
绿点是起点，黑点是终点。然后保存,  
![A教程2.JPG][A_2.JPG]  
这样子我们就得到了一个模拟环境，接下来我就来讲解如何用算法计算出绿点到黑点的最短路径。  
![A教程4.JPG][A_4.JPG]  
  
首先我们需要将这个模拟地图加载到脚本里，这时候需要用到办公插件里的打开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什么的可能有些同学还不太明白 我再详细介绍这些数值的由来  
![A教程5.JPG][A_5.JPG]

2011-5-17 18:53 上传

[**下载附件**(4.8 KB)][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][http_bbs.anjian.com_thread-223322-1-1.html]

[A_1.JPG]: /images/20220414/df24fb4fb1cd44b29013006d8808aecb.png
[A_2.JPG]: /images/20220414/d6f780576a404e8d84f6a98e5906764a.png
[A_4.JPG]: /images/20220414/e4ab922295824acf965314a1c052c3e9.png
[A_5.JPG]: /images/20220414/0b363075213141fb9cbc1dcc455bfe6d.png
[4.8 KB]: http://bbs.anjian.com/forum.php?mod=attachment&aid=NTgyNDh8NzA5NDJlYzN8MTM1Njg3NDU5OXwwfDIyMzMyMg%3D%3D&nothumb=yes
[http_bbs.anjian.com_thread-223322-1-1.html]: http://bbs.anjian.com/thread-223322-1-1.html