智能控制作业.docx
《智能控制作业.docx》由会员分享,可在线阅读,更多相关《智能控制作业.docx(16页珍藏版)》请在冰豆网上搜索。
![智能控制作业.docx](https://file1.bdocx.com/fileroot1/2023-1/21/2953ef9c-dc3d-4c0b-849f-781af7e196d1/2953ef9c-dc3d-4c0b-849f-781af7e196d11.gif)
智能控制作业
一、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