智能控制作业.docx
- 文档编号:7166605
- 上传时间:2023-01-21
- 格式:DOCX
- 页数:16
- 大小:21.40KB
智能控制作业.docx
《智能控制作业.docx》由会员分享,可在线阅读,更多相关《智能控制作业.docx(16页珍藏版)》请在冰豆网上搜索。
智能控制作业
一、A*寻路算法
AttributeVB_Name="mFindPath"
OptionExplicit
DimarrBap()AsbPoint'地图状态
DimarrOpen()AsfsPoint'开放列表
DimlOpenSizeAsLong'开放列表元素个数
DimTCountAsLong'目标序号
'※※※※ A*寻路函数※※※※※※※※※
'输入参数
'arrMap()asfsPoint地图障碍物数据
'arrPath()aslong路径列表
'lPathCountaslong路径长度
'pStartPointasfsPoint起始点
'pGotoPointasfsPoint目标点
'lWidthaslong地图宽度
'lHeightaslong地图高度
'输出参数
'类型:
long寻路结果
'3地图格式不正确
'2目标为障碍点
'1寻路成功
'0寻路失败无法到达
'4已经到达终点
'5目标被占
'6寻路过程中发生错误
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
PublicFunctionfPath(arrMap()AsfsPoint,arrPath()AsLong,lPathCountAsLong,pStartPointAsfsPoint,pGotoPointAsfsPoint,lWidthAsLong,lHeightAsLong)AsLong'寻路
DimiAsLong'循环用变量
DimCountAsLong'点的序号或者总数
DimpCurrentPointAsfsPoint
DimpSearchPointAsfsPoint
DimpSearchXAsLong,pSearchYAsLong
DimtmpXAsLong,tmpYAsLong
DimarrXofs(8)AsLong,arrYofs(8)AsLong'XY变化常量数组
DimarrIofs(8)AsLong'序号变化常量数组
DimtmpOfsAsLong'序号变化量
OnErrorGoToPathErr:
'判断地图
IflWidth<1OrlHeight<1Then
fPath=3'地图数据不正确
ExitFunction
EndIf
'TCount=pGotoPoint.Y*lWidth+pGotoPoint.X'目标序号
TCount=pGotoPoint.Index
'判断是否为障碍物
IfpGotoPoint.Y>lHeight-1OrpGotoPoint.X>lWidth-1Then
fPath=2
ExitFunction
EndIf
IfarrMap(TCount).BOrarrMap(TCount).DThen
'可以通过或者是门点
fPath=0
Else'否则退出寻路
fPath=2
ExitFunction
EndIf
IfarrMap(TCount).lNpcId<>0Then
fPath=5
ExitFunction
EndIf
IfpGotoPoint.Y=pStartPoint.YAndpGotoPoint.X=pStartPoint.XThen
fPath=4
ExitFunction
EndIf
'设置常数数组该数组决定了寻路的优先顺序
arrXofs(0)=-1
arrXofs
(1)=1
arrXofs
(2)=-1
arrXofs(3)=1
arrXofs(4)=-1
arrXofs(5)=1
arrXofs(6)=0
arrXofs(7)=0
arrYofs(0)=-1
arrYofs
(1)=1
arrYofs
(2)=1
arrYofs(3)=-1
arrYofs(4)=0
arrYofs(5)=0
arrYofs(6)=-1
arrYofs(7)=1
tmpOfs=0-lWidth
arrIofs(0)=tmpOfs-1
arrIofs
(1)=lWidth+1
arrIofs
(2)=lWidth-1
arrIofs(3)=tmpOfs+1
arrIofs(4)=-1
arrIofs(5)=1
arrIofs(6)=tmpOfs
arrIofs(7)=lWidth
'初始化数据
Count=lWidth*lHeight'地图总点数
ReDimarrBap(Count)
'清空所有需要用到的列表
ReDimarrOpen(Count)
'起始点进入开放列表
Count=pStartPoint.Y*lWidth+pStartPoint.X
pStartPoint.Index=Count
tmpX=Abs(pStartPoint.X-pGotoPoint.X)
tmpY=Abs(pStartPoint.Y-pGotoPoint.Y)
pStartPoint.G=0
IftmpX>tmpYThen
pStartPoint.H=tmpX
Else
pStartPoint.H=tmpY
EndIf
pStartPoint.F=pStartPoint.G+pStartPoint.H
arrBap(Count).Parent=0
arrBap(Count).aIndex=1
arrOpen
(1)=pStartPoint
lOpenSize=1
DoWhilelOpenSize>0
pCurrentPoint=pBinaryHeapDelete()
Count=pCurrentPoint.Index
arrBap(Count).bClose=True
arrBap(Count).aIndex=0
Fori=0To7
pSearchPoint.X=pCurrentPoint.X+arrXofs(i)
pSearchPoint.Y=pCurrentPoint.Y+arrYofs(i)
Count=pCurrentPoint.Index+arrIofs(i)
pSearchPoint.Index=Count
IfCount=TCountThen'就是终点
arrBap(Count).Parent=pCurrentPoint.Index
'保存路径
lPathCount=-1
DoWhilearrBap(Count).Parent<>0
lPathCount=lPathCount+1
arrPath(lPathCount)=Count
Count=arrBap(Count).Parent
Loop
'起始点放入最后
arrPath(lPathCount+1)=Count
fPath=1
ExitFunction
Else
IfarrMap(Count).BAndarrMap(Count).lNpcId=0Then'不是障碍点
IfNotarrBap(Count).bCloseThen'不在关闭列表
pSearchPoint.G=pCurrentPoint.G+1
tmpX=Abs(pSearchPoint.X-pGotoPoint.X)
tmpY=Abs(pSearchPoint.Y-pGotoPoint.Y)
pStartPoint.G=0
IftmpX>tmpYThen
pSearchPoint.H=tmpX
Else
pSearchPoint.H=tmpY
EndIf
pSearchPoint.F=pSearchPoint.G+pSearchPoint.H
IfarrBap(Count).aIndex<>0Then
IfpSearchPoint.F '更新开放列表 arrBap(Count).Parent=pCurrentPoint.Index pBinaryHeapUpdatearrBap(Count).aIndex EndIf Else'加入到开放列表 pBinaryHeapAddpSearchPoint arrBap(Count).Parent=pCurrentPoint.Index EndIf EndIf EndIf EndIf Next Loop ExitFunction PathErr: fPath=6 EndFunction '增加一个值到末尾并重新排序 PrivateSubpBinaryHeapAdd(pAddPointAsfsPoint) DimlParentIndexAsLong DimlSelectIndexAsLong DimtmpPointAsfsPoint lOpenSize=lOpenSize+1 arrOpen(lOpenSize)=pAddPoint arrBap(arrOpen(lOpenSize).Index).aIndex=lOpenSize lSelectIndex=lOpenSize DoWhileTrue lParentIndex=Int(lSelectIndex/2) IflParentIndex>0Then IfarrOpen(lSelectIndex).F<=arrOpen(lParentIndex).FThen '比父节点F值小交换 tmpPoint=arrOpen(lSelectIndex) arrOpen(lSelectIndex)=arrOpen(lParentIndex) arrOpen(lParentIndex)=tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex=lParentIndex arrBap(arrOpen(lParentIndex).Index).aIndex=lSelectIndex lSelectIndex=lParentIndex Else'比父节点F值大不处理 ExitDo EndIf Else'无父节点走人 ExitDo EndIf Loop EndSub '取出第一个值并重新排序 PrivateFunctionpBinaryHeapDelete()AsfsPoint DimtmpResultAsfsPoint DimtmpPointAsfsPoint DimlSelectIndexAsLong DimlLeftChildIndexAsLong DimlRightChildIndexAsLong tmpResult=arrOpen (1) lOpenSize=lOpenSize-1 '把最后一个点移动到最前面 IflOpenSize>0Then arrOpen (1)=arrOpen(lOpenSize+1) lSelectIndex=1 arrBap(arrOpen(lSelectIndex).Index).aIndex=lSelectIndex '比较子节点 DoWhileTrue lLeftChildIndex=lSelectIndex*2 lRightChildIndex=lLeftChildIndex+1 IflLeftChildIndex>lOpenSizeThen '没有左子节点则结束 ExitDo Else IflLeftChildIndex=lOpenSizeThen'只有左子节点 IfarrOpen(lSelectIndex).F>arrOpen(lLeftChildIndex).FThen'父节点F值大则交换 tmpPoint=arrOpen(lSelectIndex) arrOpen(lSelectIndex)=arrOpen(lLeftChildIndex) arrOpen(lLeftChildIndex)=tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex=lLeftChildIndex arrBap(arrOpen(lLeftChildIndex).Index).aIndex=lSelectIndex lSelectIndex=lLeftChildIndex Else'父节点比子节点F值小则结束 ExitDo EndIf Else IflRightChildIndex<=lOpenSizeThen IfarrOpen(lLeftChildIndex).F<=arrOpen(lRightChildIndex).FThen'左边F值小 IfarrOpen(lSelectIndex).F>arrOpen(lLeftChildIndex).FThen'父节点F值大则交换 tmpPoint=arrOpen(lSelectIndex) arrOpen(lSelectIndex)=arrOpen(lLeftChildIndex) arrOpen(lLeftChildIndex)=tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex=lLeftChildIndex arrBap(arrOpen(lLeftChildIndex).Index).aIndex=lSelectIndex lSelectIndex=lLeftChildIndex Else'父节点比子节点F值小则结束 ExitDo EndIf Else IfarrOpen(lSelectIndex).F>arrOpen(lRightChildIndex).FThen'父节点F值大则交换 tmpPoint=arrOpen(lSelectIndex) arrOpen(lSelectIndex)=arrOpen(lRightChildIndex) arrOpen(lRightChildIndex)=tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex=lRightChildIndex arrBap(arrOpen(lRightChildIndex).Index).aIndex=lSelectIndex lSelectIndex=lRightChildIndex Else'父节点比子节点F值小则结束 ExitDo EndIf EndIf EndIf EndIf EndIf Loop EndIf pBinaryHeapDelete=tmpResult EndFunction '更新一个点并重新排序 PrivateSubpBinaryHeapUpdate(IndexAsLong) DimlParentIndexAsLong DimlSelectIndexAsLong DimtmpPointAsfsPoint lSelectIndex=Index DoWhileTrue lParentIndex=Int(lSelectIndex/2) IflParentIndex>0Then IfarrOpen(lSelectIndex).F '比父节点F值小交换 tmpPoint=arrOpen(lSelectIndex) arrOpen(lSelectIndex)=arrOpen(lParentIndex) arrOpen(lParentIndex)=tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex=lParentIndex arrBap(arrOpen(lParentIndex).Index).aIndex=lSelectIndex lSelectIndex=lParentIndex Else'比父节点F值大不处理 ExitDo EndIf Else'无父节点走人 ExitDo EndIf Loop EndSub '加载地图数据 PublicSubpAddMapData(lMapDataIDAsLong,strMsgAsString) DimbytChar()AsByte DimMapFileAsString DimiLenAsLong DimiAsLong,jAsLong DimmAsLong,iCountAsLong DimiMapWidthAsLong DimiMapHeightAsLong MapFile=App.Path&"\Data\cMap\"&strMsg&".dat" OpenMapFileForBinaryAs#2 iLen=LOF (2) IfiLen>0Then ReDimbytChar(iLen-1) Get#2,1,bytChar() Close#2 iMapHeight=Val(GetValue("Index_"&strMsg,"Height",fMapSet)) iMapWidth=Val(GetValue("Index_"&strMsg,"Width",fMapSet)) nMap(lMapDataID).lWidth=iMapWidth nMap(lMapDataID).lHeight=iMapHeight nMap(lMapDataID).lDataSize=iMapWidth*iMapHeight IfnMap(lMapDataID).lDataSize<>iLenThenExitSub'地图数据不正确 ReDimnMap(lMapDataID).cMapData(nMap(lMapDataID).lDataSize-1) iCount=-1 Fori=0ToiMapHeight-1 Forj=0ToiMapWidth-1 iCount=iCount+1 nMap(lMapDataID).cMapData(iCount).X=j nMap(lMapDataID).cMapData(iCount).Y=i IfbytChar(iCount)=0Then nMap(lMapDataID).cMapData(iCount).B=False Else nMap(lMapDataID).cMapData(iCount).B=True EndIf Next Next nMap(lMapDataID).bData=True '读取固定门点 DimarrData()AsString DimbrrData()AsString strMsg=GetValue("bDoor",CStr(lMapDataID),fMapSet) arrData=Split(strMsg,"_") Form=0ToUBound(arrData) brrData=Split(arrData(m),",") IfUBound(brrData)>0Then i=CLng(brrData (1)) j=CLng(brrData(0)) iCount=iMapWidth*i+j nMap(lMapDataID).cMapData(iCount).B=False nMap(lMapDataID).cMapData(iCount).D=True EndIf Next '读取死点 strMsg=GetValue("bFault",CStr(lMapDataID),fMapSet) arrData=Split(strMsg,"_") Form=0ToUBound(arrData) brrData=Split(arrData(m),",") IfUBound(brrData)>0Then i=CLng(brrData (1)) j=CLng(brrData(0)) iCount=iMapWidth*i+j nMap(lMapDataID).cMapData(iCount).B=False EndIf Next '读取活点 strMsg=GetValue("bThrough",CStr(lMapDataID),fMapSet) arrData=Split(strMsg,"_") Form=0ToUBound(arrData) brrData=Split(arrData(m),",") IfUBound(brrData)>0Then i=CLng(brrData (1)) j=CLng(brrData(0)) iCount=iMapWidth*i+j nMap(lMapDataID).cMapData(iCount).B=True EndIf Next Else Close#2 ExitSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 智能 控制 作业