moduleData.Graph.AStar(aStar)whereimportqualifiedData.SetasSetimportData.Set(Set,(\\))importqualifiedData.MapasMapimportData.Map(Map,(!))importqualifiedData.PSQueueasPSQimportData.PSQueue(PSQ,Binding(..),minView)importData.List(foldl')dataAStarac=AStar{visited::!(Seta),waiting::!(PSQac),score::!(Mapac),memoHeur::!(Mapac),cameFrom::!(Mapaa),end::!(Maybea)}derivingShowaStarInitstart=AStar{visited=Set.empty,waiting=PSQ.singletonstart0,score=Map.singletonstart0,memoHeur=Map.empty,cameFrom=Map.empty,end=Nothing}runAStar::(Orda,Ordc,Numc)=>(a->Seta)-- adjacencies in graph->(a->a->c)-- distance function->(a->c)-- heuristic distance to goal->(a->Bool)-- goal->a-- starting vertex->AStarac-- final staterunAStargraphdistheurgoalstart=aStar'(aStarInitstart)whereaStar's=caseminView(waitings)ofNothing->sJust(x:->_,w')->ifgoalxthens{end=Justx}elseaStar'$foldl'(expandx)(s{waiting=w',visited=Set.insertx(visiteds)})(Set.toList(graphx\\visiteds))expandxsy=letv=scores!x+distxyincasePSQ.lookupy(waitings)ofNothing->linkxyv(s{memoHeur=Map.inserty(heury)(memoHeurs)})Just_->ifv<scores!ythenlinkxyvselseslinkxyvs=s{cameFrom=Map.insertyx(cameFroms),score=Map.insertyv(scores),waiting=PSQ.inserty(v+memoHeurs!y)(waitings)}-- | This function computes an optimal (minimal distance) path through a graph in a best-first fashion,-- starting from a given starting point.aStar::(Orda,Ordc,Numc)=>(a->Seta)-- ^ The graph we are searching through, given as a function from vertices-- to their neighbours.->(a->a->c)-- ^ Distance function between neighbouring vertices of the graph. This will-- never be applied to vertices that are not neighbours, so may be undefined-- on pairs that are not neighbours in the graph.->(a->c)-- ^ Heuristic distance to the (nearest) goal.->(a->Bool)-- ^ The goal, specified as a boolean predicate on vertices.->a-- ^ The vertex to start searching from.->Maybe[a]-- ^ An optimal path, if any path exists.aStargraphdistheurgoalstart=lets=runAStargraphdistheurgoalstartincaseendsofNothing->NothingJuste->Just(reverse.takeWhile(not.(==start)).iterate(cameFroms!)$e)plane::(Integer,Integer)->Set(Integer,Integer)plane(x,y)=Set.fromList[(x-1,y),(x+1,y),(x,y-1),(x,y+1),(x-1,y-1),(x+1,y+1),(x-1,y+1),(x+1,y-1)]planeDist::(Integer,Integer)->(Integer,Integer)->DoubleplaneDist(x1,y1)(x2,y2)=sqrt((x1'-x2')^2+(y1'-y2')^2)where[x1',y1',x2',y2']=mapfromInteger[x1,y1,x2,y2]