none :: Ord a => Visited a
none = S. empty
insert :: Ord a => Tree (Path a, h) -> Visited a -> Visited a
insert = S. insert . pathEnd . getPath
inside :: Ord a => Tree (Path a, h) -> Visited a -> Bool
inside = S. member . pathEnd . getPath
Алгоритм эвристического поиска А* | 279
Функции для очереди тех вершин, что мы только собираемся посетить:
import Data.Maybe
import qualified Data.PriorityQueue.FingerTree as Q
...
type ToVisit a h = Q.PQueue h (Tree (Path a, h))
priority t = (snd $ rootLabel t, t)
singleton :: Ord h => Tree (Path a, h) -> ToVisit a h
singleton = uncurry Q. singleton . priority
next :: Ord h => ToVisit a h -> (Tree (Path a, h), ToVisit a h)
next = fromJust . Q. minView
isEmpty :: Ord h => ToVisit a h -> Bool
isEmpty = Q. null
schedule :: Ord h => [Tree (Path a, h)] -> ToVisit a h -> ToVisit a h
schedule = Q. union . Q. fromList . fmap priority
Эти функции очень простые, они специализируют более общие функции для типов Set и
PQueue, вы наверняка легко разберётесь с ними, заглянув в документацию к модулям Data.Set и
Data.PriorityQueue.FingerTree.
Осталось только написать функцию, которая будет составлять дерево поиска для алгоритма A*. Она при-
нимает функцию ветвления, а также функцию расстояния до цели и строит по ним дерево поиска:
astarTree :: (Num h, Ord h)
=> (a -> [(a, h)]) -> (a -> h) -> a -> Tree (a, h)
astarTree alts distToGoal s0 = unfoldTree f (s0, 0)
where f (s, h) = ((s, heur h s), next h <$> alts s)
heur h s = h + distToGoal s
next h (a, d) = (a, d + h)
Поиск маршрутов в метро
Теперь давайте посмотрим как наша функция справится с задачей поиска маршрутов в метро:
metroTree :: Station -> Station -> Tree (Station, Double)
metroTree init goal = astarTree distMetroMap (stationDist goal) init
connect :: Station -> Station -> Maybe [Station]
connect a b = search (== b) $ metroTree a b
main = print $ connect (St Red Sirius) (St Green Prizrak)
К примеру найдём маршрут от станции “Дно Болота” до станции “Призрак”:
*Metro> connect (St Orange DnoBolota) (St Green Prizrak)
Just [St Orange DnoBolota, St Orange PlBakha,
St Red PlBakha, St Red Sirius, St Green Sirius,
St Green Zvezda, St Green Til,
St Green TrollevMost, St Green Prizrak]
*Metro> connect (St Red PlShekspira) (St Blue De)
Just [St Red PlShekspira, St Red Rodnik, St Blue Rodnik,
St Blue Krest, St Blue De]
*Metro> connect (St Red PlShekspira) (St Orange De)