Алгоритм поиска A* на Haskell и превращение мухи в слона
13 апреля 2012
Вы когда-нибудь пробовали написать программу, решающую судоку, задачу о волке, козе и капусте или головоломку вроде кубика Рубика? У этих задач есть кое-что общее — точно известно начальное условие и к какому условию требуется прийти, но придумать алгоритм решения задачи не так-то просто. Такие задачи решаются с помощью поиска на графах.
Представим себе состояние задачи — шахматную доску, кубик Рубика, расположение цифр в пятнашках — в качестве узла графа. Выполняя простые действия над состоянием, такие, как перемещение шахматной фигуры, вписывание цифры в судоку или высаживание козы на берег, мы можем переходить из одного состояния в другое.
Если из одного состояния можно перейти в другое, будем называть такие состояния соседними. Соединяем соседние состояния дугами от родительского к дочернему и получаем пространство состояний в виде ориентированного графа. При этом задача сводится к поиску пути от начального состояния задачи к конечному, то есть от одного узла графа к другому.
Описанный класс задач перестал казаться таким уж сложным, верно? Если требуется найти решение за минимальное количество шагов, используем поиск в ширину, а если количество шагов не имеет значения, то, возможно, разумнее использовать поиск в глубину. Поиск в ширину и поиск в глубину на языке Haskell выглядят примерно таким образом:
class (Eq a, Ord a) => TaskState a where
nearbyStates :: a -> [a]
-- Поиск в ширину
breadthFirstSearch :: TaskState a => a -> (a -> Bool) -> [a]
breadthFirstSearch x isGoal
| isGoal x = [x]
| otherwise =
genericSearch [[x]] [] isGoal
(\open newOpen -> open ++ newOpen)
-- Поиск в глубину
depthFirstSearch :: TaskState a => a -> (a -> Bool) -> [a]
depthFirstSearch x isGoal
| isGoal x = [x]
| otherwise =
genericSearch [[x]] [] isGoal
(\open newOpen -> newOpen ++ open)
genericSearch [] _ _ _ = [] -- если список open пуст, решения нет
genericSearch open closed isGoal modifyOpen
| length solution > 0 = reverse $ head solution
| otherwise =
genericSearch (modifyOpen pathList newOpen)
newClosed isGoal modifyOpen
where
currPath@(currState:_) = head open
pathList = tail open
newClosed = (currState:closed)
-- если точно нет повторов, можно убрать nub
newOpen = L.map (\x -> (x:currPath))
(((nub.nearbyStates) currState) L.\\
(newClosed ++ L.map head pathList))
-- ищем решение во всех новых элементах open
-- это дает существенный прирост скорости
solution = take 1
$ L.filter (\(st:_) -> isGoal st) newOpen
Сразу попробуем решить с помощью приведенного кода какую-нибудь задачку. Пусть это будет известная задача о превращении мухи в слона. Сначала создадим новый тип, соответствующий состоянию задачи:
deriving (Eq, Ord)
instance Show AlchemyTaskState where
show (AlchemyTaskState st) = st
Узел в пространстве состояний представляет собой обычную строку. Пока все просто. Теперь объявим экземпляр класса TaskState для типа AlchemyTaskState:
instance TaskState AlchemyTaskState where
nearbyStates (AlchemyTaskState st) =
map (\s -> AlchemyTaskState s) $ filter near vocabulary
where
near = (==1).sum.zipWith
(\a b -> if a == b then 0 else 1) st
Здесь функция vocabulary возвращает список всех существующих четырехбуквенных слов русского языка, а near проверяет, что два заданных слова отличаются ровно на одну букву.
Дополнение: После публикации заметки Dmitry Olshansky предложил куда более производительную версию функции nearbyStates. Она и приведена выше. Однако информация о времени работы программы относится к старому, неоптимизированному коду.
Собственно, тут можно было бы и заявить, что программа готова:
map (\(AlchemyTaskState s) -> s)
$ breadthFirstSearch (AlchemyTaskState start)
(== AlchemyTaskState goal)
writeList lst = do
putStrLn $ concatMap (++ " ") lst
main = do
writeList $ solveAlchemyTaskSlow "муха" "слон"
… и вообще закрыть тему, если бы не одно «но». На моем очень средненьком по нынешним меркам компьютере решение задачи с помощью поиска в ширину занимает около 32-х секунд. Почему на решение такой простой задачки требуется так много времени?
Примечание: Вопрос о распараллеливании поиска выходит за рамки данной заметки.
Это происходит по той причине, что при поиске в ширину список нерассмотренных состояний open растет экспоненциально в зависимости от текущей глубины поиска. Если целевое состояние находится в 10 шагах от начального и каждое состояние имеет 4 дочерних, поиск в ширину рассмотрит около миллиона состояний прежде, чем найдет решение. Для сравнения, каждое состояние классического кубика Рубика имеет 18 дочерних состояний, а состояние шахматной доски — в среднем 35 состояний.
Таким образом, поиск в ширину хорошо справляется только с задачами, имеющими небольшое пространство состояний. Иногда решить задачу за разумное время можно путем применения поиска в глубину. В нашем случае функция depthFirstSearch находит путь от мухи до слона за 10 секунд. Правда, найденный путь оказывается далеко не оптимальным, а по условию задачи требуется найти именно кратчайший путь. На помощь приходит эвристический поиск.
Идея эвристического поиска состоит в том, чтобы вместо последовательного рассмотрения состояний из списка open, как это делается при поиске в ширину:
pathList = tail open
… выбирать состояние в соответствии с некоторым правилом (эвристикой):
pathList = filter (/= currPath) open
В целях оптимизации открытые состояния хранятся в очереди с приоритетом, а приоритет узла n определяется с помощью функции эвристической оценки f(n). Эта функция может зависеть от описания узла, информации, собранной во время поиска и тп. Первыми из очереди извлекаются узлы с минимальным приоритетом.
На Hackage можно найти множество реализаций очереди с приоритетом, но не все они одинаково хороши. Некоторые реализации оборачивают очередь в монаду IO, некоторые выполняют простые операции, типа определения размера очереди, за O(n), некоторые не поддерживают всех необходимых функций. Например, нам понадобится возможность удаления из очереди заданного элемента.
Я остановил свой выбор на Data.PSQueue. Но, чтобы в будущем иметь возможность «перескочить» на другую реализацию, была написана следующая обертка:
import qualified Data.PSQueue as Q
class QueueClass q where
null :: (Ord k, Ord p) => q k p -> Bool
empty :: (Ord k, Ord p) => q k p
singleton :: (Ord k, Ord p) => k -> p -> q k p
singleton k p = insert k p $ empty
delete :: (Ord k, Ord p) => k -> q k p -> q k p
deleteMin :: (Ord k, Ord p) => q k p -> q k p
insert :: (Ord k, Ord p) => k -> p -> q k p -> q k p
findMin :: (Ord k, Ord p) => q k p -> Maybe (k, p)
lookup :: (Ord k, Ord p) => k -> q k p -> Maybe p
type PQueue = Q.PSQ
instance QueueClass Q.PSQ where
null = Q.null
empty = Q.empty
singleton = Q.singleton
delete = Q.delete
deleteMin = Q.deleteMin
insert = Q.insert
lookup = Q.lookup
findMin q =
case Q.findMin q of
Nothing -> Nothing
Just b -> Just ( Q.key b, Q.prio b )
Пользуясь случаем, хочу поблагодарить Andriy Polishchuk за помощь, оказанную при написании этого куска кода.
Примечание: Возможно, в данном случае было бы эффективнее вместо объявления класса типов просто ввести новый тип-обертку над Data.PSQueue.
Возвращаясь к функции эвристической оценки, следует обратить внимание как минимум на две проблемы. Во-первых, как подобрать эвристику, которая ускоряет поиск, а не замедляет его? Во-вторых, можно ли найти эвристику, которая гарантированно находит кратчайший путь до целевого состояния?
Для решения первой проблемы функцию оценки определяют следующим образом:
f(n) = g(n) + h(n)
Здесь n — рассматриваемый узел графа, g(n) — глубина, на которой был найден узел, а h(n) — эвристическая оценка расстояния от узла до цели. Фактически, f(n) представляет собой длину пути, которая складывается из двух составляющих — уже пройденного расстояния g(n) и оставшегося расстояния h(n). Последнее нам неизвестно, но обычно его можно оценить приблизительно.
Смотрите, что получается. Теперь f(n) вместо какого-то абстрактного приоритета узла возвращает вполне конкретное оценочное расстояние от начального узла до конечного, если пойти через узел n. Первыми из очереди извлекаются узел, пойдя через который, мы, предположительно, достигнем цели за минимальное количество шагов. Чем точнее оценка, тем меньше негодных состояний рассматривается, тем быстрее поиск.
С первой проблемой все более-менее ясно. Со второй сложнее. Рассмотрим следующий алгоритм поиска:
import Data.Set as S
data TaskStateAndPath a =
TaskStateAndPath { state :: a, path :: [a] }
instance Eq a => Eq (TaskStateAndPath a) where
x == y = state x == state y
instance Ord a => Ord (TaskStateAndPath a) where
compare x y = compare (state x) (state y)
instance Show a => Show (TaskStateAndPath a) where
show x = show $ path x
stateAndPath st p =
TaskStateAndPath { state = st, path = p }
-- Упрощенный поиск для алгоритма A*
graphSearch ::
(TaskState s) => s -> (s -> Bool) -> (s -> [s] -> Int) -> [s]
graphSearch st isGoal heuristicFunc =
graphSearch' isGoal heuristicFunc
(Q.insert (stateAndPath st [st]) 0 q)
(S.empty)
where
q = Q.empty :: (Ord x) => PQueue (TaskStateAndPath x) Int
graphSearch' isGoal func open closed =
case Q.findMin open of
Nothing -> []
Just found ->
if isGoal.state.fst $ found
then reverse.path.fst $ found
else nextStep (state.fst $ found) (path.fst $ found)
where
nextStep st p = graphSearch' isGoal func newOpen newClosed
where
newClosed = S.insert st closed
newOpen = L.foldl
(\q s -> insertState s p func q) ( Q.deleteMin open )
(L.filter (\x -> not $ S.member x newClosed)
$ (nub.nearbyStates) st)
insertState s p func q =
case Q.lookup stp q of
Nothing -> ins q
Just f ->
if func s p >= f
then q
else ins $ Q.delete stp q
where
ins = Q.insert stp (func s p)
stp = stateAndPath s (s:p)
Он напоминает поиск в ширину, но имеет ряд существенных отличий. Во-первых, открытые узлы хранятся в очереди с приоритетом, а закрытые — в неупорядоченном множестве без повторов. Чтобы хранить в очереди узел вместе с путем до него, был введен новый тип TaskStateAndPath. Во-вторых, если одно из дочерних состояний уже есть в очереди, производится проверка, не было ли достигнуто это состояние по более короткому пути. Если это так, путь до состояния заменяется на более короткий. Наконец, проверка, является ли состояние целевым, производится только при извлечении состояния из очереди.
Приведенный алгоритм является алгоритмом A* (читается «А звездочка» или «A Star»), если он использует функцию оценки f(n) = g(n) + h(n) (названную в коде heuristicFunc), а эвристическая функция h(n) допустима и монотонна. Есть теорема, доказывающая, что такой алгоритм находит кратчайший путь от начального состояния до конечного. Осталось разобраться, что такое допустимость и монотонность.
Говорят, что эвристическая оценка h(n) допустима, если для любого узла n значение h(n) меньше или равно стоимости кратчайшего пути от n до цели. Функция h(n) называется монотонной (или преемственной), если для любого состояния n1 и его потомка n2 разность h(n1) и h(n2) не превышает фактического расстояния от n1 до n2, а эвристическая оценка целевого состояния равна нулю. Любая монотонная эвристика допустима. Также большинство допустимых эвристик являются монотонными, но не все. Однако из любой допустимой эвристики можно получить монотонную.
Ничего не понятно? Прочитайте еще раз, это важно! Если мы придумаем монотонную h(n) для нашей задачи, то сможем найти кратчайший путь от начального узла до конечного с помощью алгоритма А*, который обычно оказывается намного быстрее поиска в ширину. На практике проще сначала придумать допустимую h(n), а затем либо доказать, что она является монотонной, либо получить с ее помощью монотонную h2(n).
Для задачи о превращении мухи в слона эвристическая оценка может возвращать количество букв, не равных буквам на соответствующих позициях в целевом слове. Поскольку за один шаг разрешается менять только одну букву, несложно убедиться, что такая эвристика является монотонной и допустимой:
(length xs) +
(foldl (\len (c1, c2) -> if c1 == c2 then len - 1 else len)
(length target) $ zip st target)
solveAlchemyTask start goal =
map (\(AlchemyTaskState s) -> s)
$ graphSearch (AlchemyTaskState start)
(== AlchemyTaskState goal) (alchemyHeuristic goal)
main = do
writeList $ solveAlchemyTask "муха" "слон"
В контексте алгоритма А* говорят, что эвристическая оценка h2(n) более информативна, чем h1(n), если для любого состояния n в пространстве поиска выполняется неравенство h2(n) ≥ h1(n). Также говорят, что h2(n) доминирует над h1(n). В этом случае множество состояний, проверяемых h2(n), является подмножеством состояний, проверяемых h1(n). Другими словами, более информативная эвристика позволяет найти оптимальное решение, проверив меньшее количество состояний.
Поиск в ширину является частным случаем алгоритма A*, для него h(n) = 0. Наша эвристика, очевидно, является более информативной, а значит должна находить решение быстрее. И действительно, теперь программа справляется с задачей за 14 секунд. Скорость увеличилась более, чем в два раза.
Следует отметить, что существует версия алгоритма А*, требующая от эвристической оценки только свойства допустимости. Монотонная эвристика гарантирует, что на момент извлечения узла из очереди он будет достигнут по кратчайшему пути. В противном случае для каждого потомка следует выполнить проверку, не содержится ли он в множестве закрытых узлов. Если содержится и на данной итерации потомок был достигнут по более короткому пути, его следует удалить из множества закрытых узлов и поместить в очередь открытых. Но, как уже отмечалось, большинство допустимых эвристик является монотонными, а из тех, что не являются, можно получить монотонные.
В качестве источника дополнительной информации я бы рекомендовал монографию Джорджа Люгера «Искусственный интеллект: стратегии и методы решения сложных проблем». Книгу нелегко найти в печатном виде, зато легко нагуглить. Будьте очень осторожны с информацией из Википедии и различных статей в интернете. Количество двусмысленностей и ошибок в них просто зашкаливает. («Верить в наше время нельзя никому, порой даже самому себе. Мне — можно.»)
Все исходники к этой заметке можно скачать здесь. И кстати, на Hackage действительно нет ни одного алгоритма из этой заметки, или я плохо искал?
Дополнение: Плохо искал — как минимум раз и два. Небольшой бенчмарк показал, что Data.Graph.AStar на 2.2% быстрее моей реализации. Думается, это цена за обертку над Data.PSQueue.
В продолжение темы: Задача о роботе-пылесосе без датчиков.
Метки: Haskell, Алгоритмы, Искусственный интеллект, Функциональное программирование.
Вы можете прислать свой комментарий мне на почту, или воспользоваться комментариями в Telegram-группе.