Unknown - haskell-notes

очередь содержит один элемент, поэтому она перейдёт к следующему случаю и извлечёт из очереди один

элемент (next), который будет передан в функцию pong. Функция pong проверит нет ли в списке уже посе-

щённых элементов того, который был только что извлечён (inside a visited). Если это окажется так, то

она запросит следующий элемент у функции ping. Если же исходный элемент окажется новым, она добавит

его в список (getPath a : ...) и запланирует обход всех дочерних деревьев данного элемента (schedule

(subForest a) toVisit). При первом заходе исходный элемент окажется новым и функция findPath поймёт,

что список не пустой и остановит вычисление. Она немного передохнёт и примется за следующий случай.

Там она будет извлекать первый элемент списка и сопоставлять его с предикатом. При этом первый элемент

уже вычислен. Мы воспользуемся этим, убедимся в том, что он не является целью и рекурсивно вызовем

функцию find на хвосте списка. Функция findPath запросит следующее значение и так далее.

Наша функция flattenPath не является развёрткой, но очень похожа на неё тем, что позволяет вычислять

результирующий список частично. Например функция length требует полного обхода списка. Мы не можем

использовать её с бесконечными списками. Теперь давайте разберёмся с подчинёнными функциями:

getPath :: Tree( Patha, h) -> Patha

getPath =fst .rootLabel

Функции для множества вершин, которые мы уже посетили:

import qualified Data.Set asS

...

type Visiteda

= S.Seta

none :: Orda => Visiteda

none = S.empty

insert :: Orda => Tree( Patha, h) -> Visiteda -> Visiteda

insert = S.insert .pathEnd .getPath

inside :: Orda => Tree( Patha, h) -> Visiteda -> Bool

inside = S.member .pathEnd .getPath

Алгоритм эвристического поиска А* | 279

Функции для очереди тех вершин, что мы только собираемся посетить:

import Data.Maybe

import qualified Data.PriorityQueue.FingerTree asQ

...

type ToVisita h = Q.PQueueh ( Tree( Patha, h))

priority t =(snd $rootLabel t, t)

singleton :: Ordh => Tree( Patha, h) -> ToVisita h

singleton =uncurry Q.singleton .priority

next :: Ordh => ToVisita h ->( Tree( Patha, h), ToVisita h)

next =fromJust . Q.minView

isEmpty :: Ordh => ToVisita h -> Bool

isEmpty = Q.null

schedule :: Ordh =>[ Tree( Patha, h)] -> ToVisita h -> ToVisita h

schedule = Q.union . Q.fromList .fmap priority

Эти функции очень простые, они специализируют более общие функции для типов Setи

PQueue, вы наверняка легко разберётесь с ними, заглянув в документацию к модулям Data.Setи

Data.PriorityQueue.FingerTree.

Осталось только написать функцию, которая будет составлять дерево поиска для алгоритма A*. Она при-

нимает функцию ветвления, а также функцию расстояния до цели и строит по ним дерево поиска:

astarTree ::( Numh, Ordh)

=>(a ->[(a, h)]) ->(a ->h) ->a -> Tree(a, h)

astarTree alts distToGoal s0 =unfoldTree f (s0, 0)

wheref (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)

Nothing

В третьем случае маршрут не был найден, поскольку у нас нет станции Deна оранжевой ветке.