Сколько воды утекло? Решаем задачу лунной походкой на Haskell

В сети гуляет интересная задача, которую задавали на собеседовании в Twitter.

Представьте, что вы смотрите на стенки различной длины в профиль. Идет дождь, где-то вода остается, где-то перетекает за края стенки из-за разницы в высоте. Задача состоит в том, чтобы определить, какой объем воды остался между стенками.

Для представления последовательности стенок мы можем использовать список:

type Height = Int

walls :: [Height]
walls = [2,5,1,2,3,4,7,7,6]

Чтобы выяснить объем воды наверху каждой стенки, нам нужно знать три вещи:

1. Высоту текущей стенки
2. Высоту самой высокой левой стенки
3. Высоту самой высокой правой стенки

Выясняем, какая самая стенка ниже — правая или левая, отнимаем высоту текущей стенки от самой высокой и получаем объем воды. Рассмотрим повнимательнее на примере:



Представим, что нам нужно вычислить объем воды для стенки b. Высота самой высокой левой стенки — а, равняется 3. Высота самой высокой левой стенки — с, равняется 2. Из-за более высокой правой стенки, вода будет выливаться налево, поэтому отсчет ведем с высоты левой стенки. Следовательно, объем воды для стенки b равен = высота с — высота b = 2 — 1 = 1.

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

Начнем с вычисления самой высокой левой стенки для каждой из стенок с помощью эффекта состояния:

type Volume = Int

--| Среди предыдущей и текущей стенки выбираем самую высокую
themax :: Height -> State Height Height
themax h = modify (max h) *> get

-- |  Обходим список и для каждой стенки вычисляем самую высокую левую стенку
highest_left :: [Height] -> [Height]
highest_left walls = evalState (traverse themax walls) 0

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

Обратные аппликативные функторы

В пакете transformers живет интересный тип (в прямом и переносном смысле этого слова). Он позволяет запускать аппликативные эффекты в обратном порядке:

newtype Backwards f a = Backwards { forwards :: f a }

Как это работает? Давайте внимательнее рассмотрим экземпляр класса Applicative для Backwards:

-- | На самом деле это немного упрощенный код после разбора liftA2 и <**>
instance Applicative t => Applicative (Backwards t) where
        pure = Backwards . pure
	Backwards f <*> Backwards x = Backwards ((&) <$> x <*> f)

& это то же самое применение функции к аргументу $, только с другим порядком аргументов: сначала аргумент, потом функция:

f $ x => x & f

Благодаря ленивости, что мы сначала вычисляем второй компонент аппликативной цепочки вычисления, а только потом первый — отсюда и название для этого типа.

В этом же transformers есть еще один интересный тип — Reverse:

newtype Reverse f a = Reverse { getReverse :: f a }

Он запускает эффекты в Traversable в обратном порядке используя Backwards.
А теперь вернемся к нашей исходной задаче с этим самым типом.

Осваиваем лунную походку

«Лу́нная похо́дка» (от англ. moonwalk), или «скольжение назад», — танцевальная техника, когда танцор движется назад, при этом имитируя движения ног как при ходьбе вперед. (Википедия)

Чтобы провернуть такой трюк, мы возьмем ту же функцию с эффектом состояния (как если бы мы шли вперед, слева направо), которую мы использовали для вычисления самой высокой левой стенки:

-- | Среди предыдущей и текущей стенки выбираем самую высокую
themax :: Height -> State Height Height
themax h = modify (max h) *> get

-- | Только в этот раз, мы пойдем справа налево:
highest_right :: [Height] -> [Height]
highest_right walls = getReverse $ evalState (traverse themax $ Reverse walls) 

Теперь у нас есть все, чтобы вычислить итоговый объем накопленной воды. Из самых высоких левой и правой стенки выбираем самую низкую и от нее отнимаем высоту стенки — это и будет объем накопленной воды:

let hls = highest_left [2,5,1,2,3,4,7,7,6] = [2,5,5,5,5,5,7,7,7]
let hrs = highest_right [2,5,1,2,3,4,7,7,6] = [7,7,7,7,7,7,7,7,6]
sum $ zipWith3 (\l x r -> min l r - x) hls walls hrs

Вот так, аппликативные функторы помогли нам абстрагироваться от конкретных эффектов и структур данных. У них есть еще несколько интересных применений — группировка запросов, сортировки.

Исходный код этого варианта решения можно найти тут. У этой задачки есть еще несколько интересных подходов, которые можно посмотреть здесь.