Учебник по Haskell

Мы будем решать эту задачу рекурсивно. Представим, что мы знаем водостоки для всех точек кроме

данной. Для каждой точки мы можем узнать в какую сторону из неё стекает вода. При этом водосток для

следующей точки такой же как и для текущей. Если же из данной точки вода никуда не течёт, то она сама

является водостоком. Мы определим эту функцию через комбинатор неподвижной точки fix.:

flow :: HeightMap -> SinkMap

flow arr = fix $ \result -> listArray (bounds arr) $

map (\x -> maybe x (result ! ) $ getSink arr x) $

range $ bounds arr

getSink :: HeightMap -> Coord -> Maybe Coord

Мы ищем решение в виде неподвижной точки функции, которая принимает карту стоков и возвращает

карту стоков. Функция getSink по данной точке на карте вычисляет соседнюю точку, в которую стекает вода.

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

вода. Функция listArray конструирует значение типа Array из списка значений. Первым аргументом она

принимает диапазон значений для индексов. Размеры массива совпадают с размерами карты высот, поэтому

первым аргументом мы передаём bounds arr.

Теперь разберёмся с тем как заполняются значения в список. Сначала мы создаём список координат

исходной карты высот с помощью выражения:

range $ bounds arr

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

в лямбда-функции:

\x -> maybe x (result ! ) $ getSink arr x

Водосборы | 187

Мы принимаем текущую координату и с помощью функции getSink находим соседнюю точку, в которую

убегает вода. Если такой точки нет, то в следующем выражении мы вернём исходную точку, поскольку в этом

случае она и будет водостоком, а если такая соседняя точка всё-таки есть мы спросим результат из будущего.

Мы обратимся к результату (result ! ), посмотрим каким окажется водосток для соседней точки и вернём

это значение. Поскольку за счёт ленивых вычислений значения результирующего массива вычисляются лишь

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

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

Осталось только определить функцию поиска ближайшего стока и функцию разметки.

getSink :: HeightMap -> Coord -> Maybe Coord

getSink arr (x, y)

| null sinks = Nothing

| otherwise

= Just $ snd $ minimum $ map (\i -> (arr! i, i)) sinks

where sinks = filter p [(x+1, y), (x-1, y), (x, y-1), (x, y+1)]

p i

= inRange (bounds arr) i && arr ! i < arr ! (x, y)

В функции разметки мы воспользуемся ассоциативным массивом из модуля Data.Map. Функция nub из

модуля Data.List убирает из списка повторяющиеся элементы. Затем мы составляем список пар из коорди-

нат водостоков и меток и в самом конце размечаем исходный массив:

label :: SinkMap -> LabelMap

label a = fmap (m M.! ) a

where m = M. fromList $ flip zip [’a’ .. ] $ nub $ elems a

11.4 Ленивее некуда

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

функции seq. Функцию seq мы можем применять, а можем и не применять. Но кажется, что в декомпозиции

мы не можем уйти от необходимости проведения хотя бы одной редукции. Оказывается можем, в Haskell для

этого предусмотрены специальные ленивые образцы (lazy patterns). Они обозначаются знаком тильда:

lazyHead :: [a] -> a

lazyHead ~(x:xs) = x

Перед скобками сопоставления с образцом пишется символ тильда. Этим мы говорим вычислителю: до-

верься мне, здесь точно такой образец, можешь даже не проверять дальше. Он и правда дальше не пойдёт.

Например если мы напишем такое определение:

lazySafeHead :: [a] -> Maybe a

lazySafeHead ~(x:xs) = Just x

lazySafeHead []

= Nothing

Если мы подставим в эту функцию пустой список мы получим ошибку времени выполнения, вычислитель

доверился нам в первом уравнении, а мы его обманули. Сохраним в модуле Strict и проверим:

Prelude Strict> :! ghc --make Strict

[1 of 1] Compiling Strict

( Strict. hs, Strict. o )

Strict. hs:67:0:

Warning: Pattern match(es) are overlapped

In the definition of ‘lazySafeHead’: lazySafeHead [] = ...

Prelude Strict> :l Strict

Ok, modules loaded: Strict.

Prelude Strict> lazySafeHead [1,2,3]

Just 1

Prelude Strict> lazySafeHead []

Just *** Exception: Strict. hs:(67,0)-(68,29): Irrefutable

pattern failed for pattern (x : xs)

При компиляции нам даже сообщили о том, что образцы в декомпозиции пересекаются. Но мы были

упрямы и напоролись на ошибку, если мы поменяем образцы местами, то всё пройдёт гладко:

Prelude Strict> :! ghc --make Strict

[1 of 1] Compiling Strict

( Strict. hs, Strict. o )

Prelude Strict> :l Strict

Ok, modules loaded: Strict.