Учебник по Haskell

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)

Nothing

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

19.2 Тестирование с помощью QuickCheck

Мы проверили три случая, ещё три случая, ещё три случая, ожидаемый результат сходится с тем, что

возвращает нам интерпретатор, но можем ли мы быть уверены в том, что алгоритм действительно работает?

280 | Глава 19: Ориентируемся по карте

Для Haskell была разработана специальная библиотека тестирования QuickCheck, которая упрощает про-

цесс проверки программ. Мы можем сформулировать свойства, которые обязательно должны выполняться,

а QuickCheck сгенерирует случайный набор данных и проверит наши свойства на них.

Например в нашей задаче путь из A в B должен совпадать с перевёрнутым путём из B в A. Также все станции

в маршруте должны быть соседними. Давайте проверим эти свойства. Для этого нам нужно сформулировать

их в виде предикатов:

module Test where

import Control.Applicative

import Metro

prop1 :: Station -> Station -> Bool

prop1 a b = connect a b == (fmap reverse $ connect b a)

prop2 :: Station -> Station -> Bool

prop2 a b = maybe True (all (uncurry near) . pairs) $ connect a b

pairs :: [a] -> [(a, a)]

pairs xs = zip xs (drop 1 xs)

near :: Station -> Station -> Bool

near a b = a ‘elem‘ (fst <$> distMetroMap b)

Установим QuickCheck:

cabal install QuickCheck

Теперь нам нужно подсказать QuickCheck как генерировать случайные значения типа Station. QuickCheck

тестирует функции, которые принимают значения из класса Arbitrary и возвращают Bool. Класс Arbitrary

отвечает за генерацию случайных значений.

Основной метод arbitrary возвращает генератор случайных значений:

class Arbitrary a where

arbitrary :: Gen a

Мы воспользуемся тем, что этот класс уже определён для многих стандартных типов. Кроме того класс

Gen явялется монадой. Мы сгенерируем случайное целое число и отобразим его в одну из станций. Сделать

это можно разными способами, мы начнём из одной станции и будем случайно блуждать по карте:

import Test.QuickCheck

...

instance Arbitrary Station where

arbitrary = ($ s0) . foldr (. ) id . fmap select <$> ints

where ints = vector =<< choose (0, 100)

s0 = St Blue De

select :: Int -> Station -> Station

select i s = as !! mod i (length as)

where as = fst <$> distMetroMap s