разбивается на три составляющие:
search :: (Ord h, Ord a) => (a -> Bool) -> Tree (a, h) -> Maybe [a]
search isGoal =
findPath isGoal . flattenTree . addPath
выпишем типы составляющих функций и проверим код в интерпретаторе.
un = undefined
findPath :: (a -> Bool) -> [Path a] -> Maybe [a]
findPath = un
flattenTree :: (Ord h, Ord a) => Tree (Path a, h) -> [Path a]
flattenTree = un
addPath :: Tree (a, h) -> Tree (Path a, h)
addPath = un
data Path a = Path
{ pathEnd
:: a
, path
:: [a]
}
Обратите внимание на то как поступающие на вход данные разделились между функциями. Информа-
ция о приоритете вершин не идёт дальше функции flattenTree, а предикат isGoal используется только в
функции findPath. Модуль прошёл проверку типов и мы можем детализировать функции дальше:
addPath :: Tree (a, h) -> Tree (Path a, h)
addPath = iter []
where iter ps t = Node (Path val (reverse ps’), h) $
iter ps’ subForest t
where (val, h)
= rootLabel t
ps’
= val : ps
В этой функции мы просто присоединяем к данной вершине все родительские вершины, так мы составля-
ем маршрут от данной вершины до начальной, поскольку мы всё время добавляем новые вершины в начало
списка, в итоге у нас получаются перевёрнутые маршруты, поэтому перед тем как обернуть значение в кон-
структор Path мы переворачиваем список. На самом деле нам нужно перевернуть только один путь. Путь,
который ведёт к цели, но за счёт того, что язык у нас ленивый, функция reverse будет применена не сразу, а
лишь тогда, когда нам действительно понадобится значение пути. Это как раз и произойдёт лишь один раз,
в самом конце программы, лишь для одного значения!
Давайте пока пропустим функцию flattenTree и сначала определим функцию findPath. Эта функция
принимает все вершины, которые мы обошли если бы шли без цели (функции isGoal) и ищет среди них
первую, которая удовлетворяет предикату. Для этого мы воспользуемся стандартной функцией find из мо-
дуля Data.List:
findPath :: (a -> Bool) -> [Path a] -> Maybe [a]
findPath isGoal =
fmap path . find (isGoal . pathEnd)
Напомню тип функции find, она принимает предикат и список, а возвращает первое значение списка, на
котором предикат вернёт True:
find :: (a -> Bool) -> [a] -> Maybe a
278 | Глава 19: Ориентируемся по карте
Функция fmap применяется из-за того, что результат функции find завёрнут в Maybe, это частично опре-
делённая функция. В самом деле ведь в списке может и не оказаться подходящего значения.
Осталось определить функцию flattenTree. Было бы хорошо определить её так, чтобы она была развёрт-
кой для списка. Поскольку функция find является свёрткой (может быть определена через fold), вместе эти
функции работали бы очень эффективно. Мы определим функцию flattenTree через взаимную рекурсию.
Две функции будут по очереди вызывать друг друга. Одна из них будет извлекать следующее значение из
очереди, а другая – проверять не встречалось ли нам уже такое значение, и добавлять новые элементы в
очередь.
flattenTree :: (Ord h, Ord a) => Tree (Path a, h) -> [Path a]
flattenTree a = ping none (singleton a)
ping :: (Ord h, Ord a) => Visited a -> ToVisit a h -> [Path a]
ping visited toVisit
| isEmpty toVisit = []
| otherwise
= pong visited toVisit’ a
where (a, toVisit’) = next toVisit
pong :: (Ord h, Ord a)
=> Visited a -> ToVisit a h -> Tree (Path a, h) -> [Path a]
pong visited toVisit a
| inside a visited
= ping visited toVisit
| otherwise
= getPath a :
ping (insert a visited) (schedule (subForest a) toVisit)
Типы Visited и ToVisit обозначают наборы вершин, которые мы уже посетили и которые только собира-
емся посетить. Не вдаваясь в подробности интерфейса этих типов, давайте присмотримся к функциям ping и
pong с точки зрения функции, которая их будет вызывать, а именно функции findPath. Эта функция ожидает
на входе список. Внутри она обходит список в поисках нужного элемента, поэтому она будет применять со-
поставление с образцом, разбирая список на части. Сначала она запросит сопоставление с пустым списком,
запустится функция ping с пустым множеством посещённых вершин (none) и одним элементом в очереди
вершин (singleton a), которые предстоит посетить. Функция ping проверит не является ли очередь пустой,
очередь содержит один элемент, поэтому она перейдёт к следующему случаю и извлечёт из очереди один
элемент (next), который будет передан в функцию pong. Функция pong проверит нет ли в списке уже посе-
щённых элементов того, который был только что извлечён (inside a visited). Если это окажется так, то
она запросит следующий элемент у функции ping. Если же исходный элемент окажется новым, она добавит
его в список (getPath a : … ) и запланирует обход всех дочерних деревьев данного элемента (schedule
(subForest a) toVisit). При первом заходе исходный элемент окажется новым и функция findPath поймёт,
что список не пустой и остановит вычисление. Она немного передохнёт и примется за следующий случай.
Там она будет извлекать первый элемент списка и сопоставлять его с предикатом. При этом первый элемент
уже вычислен. Мы воспользуемся этим, убедимся в том, что он не является целью и рекурсивно вызовем
функцию find на хвосте списка. Функция findPath запросит следующее значение и так далее.
Наша функция flattenPath не является развёрткой, но очень похожа на неё тем, что позволяет вычислять
результирующий список частично. Например функция length требует полного обхода списка. Мы не можем
использовать её с бесконечными списками. Теперь давайте разберёмся с подчинёнными функциями:
getPath :: Tree (Path a, h) -> Path a
getPath = fst . rootLabel
Функции для множества вершин, которые мы уже посетили:
import qualified Data.Set as S
…
type Visited a
= S.Set a
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)
