Функциональное программирование в Scheme: структуры данных

Оглавление

Введение

Поводом к этой статье послужил мой диалог по джабберу с [info]redchrom-ом, где он усомнился в целесообразности использования функционального стиля, мол, "мозг просаживает и производительность падает" :) Ниже я попробую опровергнуть эти утверждения (насколько это у меня получится) -- я попробую показать, что писать в функциональном стиле на схеме не просто легко и приятно, но и штраф в производительности мы получаем более, чем терпимый.

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

Интересный момент с публикацией подобной статьи в моем жж заключается в том, что практически никому из моих друзей по френдленте это особо интересно не будет =) Для половины чтение этого материала не даст никакой новой информации (благо, достаточный примитив), а для другой половины все это абсолютно неактуально. Из-за этого, ориентироваться на какую-то целевую аудиторию у меня не получится (разве что, конкретно на Хрома). Но, тем не менее, я все равно прошу всех почитать по одной причине: сам процесс написания подобных статей для меня относительно в новинку, поэтому мне интересно, насколько у меня вообще получается это дело, и имеет ли какой-то смысл продолжать :)

Подготовка к процессу

Чтобы опровергнуть утверждение об "обрезанности" и "непригодности" стандартной схемы для "реальной жизни", я решил усложнить себе задачу: далее мы будем пользоваться только самой базовой функциональностью языка. В связи с этим, для прогона всех исходных кодов, которые встретятся в моем материале, вы можете использовать практически любой интерпретатор схемы, который встречается в природе (лично я буду пользоваться Chicken Scheme). Мало того -- с минимальными правками синтаксиса, примеры можно запускать даже компиляторами Common Lisp или elisp :)

Итак, собственно, приступим.

Самые основы: map, fold, unfold

Как известно, lisp вообще очень любит обрабатывать списки -- даже название расшифровывается как "LISt Processing Language". Его любовь к спискам настолько всеобъемлюща, что даже собственно программа на лиспе представляет собой список.

Эти однонаправленные списки -- вполне так себе функциональная структура данных, если не баловаться мутаторами над ними. Я надеюсь, что читатель уже умеет пользоваться списками в достаточной мере (знает о cons, car и cdr, а кроме этого умеет через них выражать length, append и map). Если же вдруг нет, то рекомендую вначале ознакомиться с SICP на уровне, хотя бы, первых нескольких уроков.

В стандарт языка уже включена совершенно волшебная функция map для списков. Как известно, она используется для превращения одного или нескольких списков в другой, путем последовательного применения заданной функции к каждому элементу. Это предельно полезная штуковина, но, все-таки, существуют ситуации, когда ее оказывается недостаточно. Для полного счастья со списками нам надо добавить в наш набор еще две простенькие, но необходимые функции: свертку списка fold и развертку unfold. Они рассматриваются в SICP, но я возьму на себя смелость напомнить идею.

fold

Fold "спрессовывает" заданный список до одного значения. Работает это так: пользователь задает начальное значение результата (т.н. "аккумулятор"), и функцию, которая на вход получает текущее значение аккумулятора и очередной элемент из списка, а на выходе выдает новое значение аккумулятора. Как только мы добрались до конца списка, получаем обратно аккумулятор. Лучше всего алгоритм работы понимается на примере:

(fold + 0 '(1 2 3 4))


Результатом работы этой функции, как можно догадаться, будет число 10 -- логически это получается сумма всех элементов списка. Здесь начальным значением аккумулятора служит 0, а в качестве преобразующей функции мы передали +. Тем самым на первом элементе списка мы складываем 0 (аккумулятор) и 1 (первый элемент), на втором -- 1 и 2, потом 3 и 3, ну и так далее. В итоге у нас в зубах общая сумма.

Логика работы понятна, теперь записываем ее на языке scheme:

(define (fold proc acc list)
  (if (null? list)
      acc
      (fold proc (proc (car list) acc) (cdr list))))

unfold

Unfold действует, в некотором роде, обратно fold: она развертывает лист из данных пользователя. Логически это ближе всего к обычному, хорошо всем известному, циклу for из си-подобных языков: задается начальное значение переменной, условие окончания цикла и модификация переменной на каждой итерации цикла. В итоге назад мы получаем в зубы список, состоящий из всех значений этой переменной, в которых она успела побывать:

(define (1+ x) (+ x 1))

(unfold 0 (lambda (x) (>= x 10)) 1+)


Следуем здесь вышеописанной логике: начальное значение у нас 0, условие остановки -- когда значение больше или равно 10, модификатор: обычное инкрементирование переменной. На выходе, как и ожидалось, получаем список: (0 1 2 3 4 5 6 7 8 9). Записываем определение:

(define (unfold init end? next)
  (let loop ((value init) (list '()))
    (if (end? value)
        (reverse list)
        (loop (next value) (cons value list)))))


Единственный момент, который стоит тут учесть: разворачивание списка в обратную сторону по окончании процесса. Дело в том, что cons'ом мы добавляем элементы в голову, тем самым, получая элементы в обратном порядке.

Итоги раздела

Собственно, вот она и есть, первая наша полезная функциональная структура данных: список :) Чем он хорош для нас:

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

for (int i = 0; i < my_size; i++)
        do_something( my_array[i] );


Но жизнь, как известно, обычными обходами массивов простых значений не заканчивается. Что делать, если нам нужны сложные структуры? Ответ будет раскрыт в следующей главе

Записи

А именно, имеются в виду аналоги сишной struct, которая группирует несколько разнородных значений в один тип, позволяя оперировать всем этим добром скопом. Например, у нас есть тип, представляющий собой точку в трехмерном пространстве:

struct point3d_t
{
        int x;
        int y;
        int z;
};


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

Логичный вопрос: каким образом модифицировать-то значения полей? Логичный ответ: а никак, у нас же функциональная структура данных :) Чтобы получить точку с другими значениями координат, придется опять звать конструктор make-point3d. И тут мы впервые сталкиваемся с оверхедом в функциональной программе. Насколько он существенный? Скажем так, зависит, от имплементации интерпретатора, а именно, от сборщика мусора. Практически в 90% случаев, когда мы создаем новую запись на основе старой (с измененными значениями), старая структура нам уже не нужна, поэтому она тут же подметается garbage collector'ом. Поэтому, в идеальном случае оверхеда по памяти мы не получим: новые объекты будут писаться на место старых. Но от штрафа по перфомансу мы все же не избавляемся: если нам надо изменить только одно поле структуры, мы все равно должны копировать все. Штраф, вроде как, незначительный, но его надо иметь в виду.

Что ж, давайте вспомним, какие контейнеры нам вообще доступны в схеме, чтобы реализовать нашу структуру.

list

Собственно, да, хорошо известный нам список можно использовать и для группировки значений в структуру данных. Все довольно просто и прозрачно:

(define (make-point3d x y z) (list x y z))

(define (point3d-x point) (car point))
(define (point3d-y point) (cadr point))
(define (point3d-z point) (caddr point))

(define-macro (with-point3d point . body)
  `(apply (lambda (x y z) ,@body) ,point))


Хозяйке на заметку

Если ваш интерпретатор схемы не поддерживает макросы в стиле Common Lisp (define-macro), можно воспользоваться стандартным схемовским define-syntax, поменяв синтаксис макроса



Давайте прикинем, какой оверхед мы получаем с таким подходом.

Пожалуй, единственный плюс такого варианта паковки структур, помимо простоты реализации, это то, что в repl-е содержимое видно глазами в примерно таком виде: (1 5 7).

vector

Кроме всего прочего, схема в своей элементарной реализации предоставляет нам векторы. Грубо говоря, это ни что иное, как всем нам известные массивы из си-подобных языков с единственным бонусом: они бестиповые (вектор может содержать разнородные данные)

Несмотря на то, что массивы у нас сразу ассоциируются с импетаривными языками, мы вполне можем обойтись без деструктивной модификации его элементов: просто будем конструировать каждый раз новый вектор при изменении какого-либо элемента. Давайте прикинем, как можно их приспособить под наш интерфейс:

(define (make-point3d x y z)
  (list->vector (list x y z)))

(define (point3d-x point) (vector-ref point 0))
(define (point3d-y point) (vector-ref point 1))
(define (point3d-z point) (vector-ref point 2))

(define-macro (with-point3d point . body)
  `(let ((x (point3d-x ,point))
         (y (point3d-y ,point))
         (z (point3d-z ,point)))
     ,@body))


Сразу бросается в глаза, что здесь мы сходу избавляемся от двух проблем структур на списках: дополнительной памяти под cdr и оверхеда в обходе списка при доступе к каждому элементу. Тем не менее, совсем без штрафов здесь обойтись тоже не получается: vector->list все равно должен создать список и при копировании пробежаться нему. Хорошо еще, если для аллоцирования памяти ему не надо вычислять размер списка (это implementation-specific поведение). Первый штраф еще как-то можно обойти, например, так:

(define (make-point3d . args) (apply list->vector args))


Правда, таким образом мы теряем проверку рантаймом на количество переменных. Но со второй проблемой (обход списка при копировании) нам все равно ничего не сделать.

Списком и вектором набор доступных нам схемой контейнеров, казалось бы, заканчивается, и вместе с ним, заканчиваются варианты представления структур. Но мы забыли еще один способ манипуляции памяти в лиспе: это замыкания!

lambda

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

(define (make-adder a)
  (lambda (x) (+ x a)))

(define add-7 (make-adder 7))
(define add-8 (make-adder 8))

(add-7 4)
(add-8 4)


Основное внимание тут заслуживает функция make-adder -- она создает новую функцию, "замыкая" свободную переменную a. На деле это заключается в копировании ее значения на момент объявления лямбды: при объявлении make-7 она сохраняет семерку, а при make-8, соответственно, восьмерку. И мы этим свойством замыканий можем воспользоваться, для создания своего контейнера. Попробуем:

(define (make-point3d x y z)
  (lambda () ???)


Что ж, кое-чего у нас уже есть: значения x, y и z захватываются при объявлении замыкания, и возвращаются нам в виде лямбды. Вопрос, как нам теперь их оттуда достать обратно? Вообще, это кажется нетривиальной задачей для человека, привыкшего к императивным языкам. И действительно: напрямую, без жутких хаков рантайма, мы никак не сможем добраться до этих переменных, потому что они видны теперь только изнутри самой этой лямбды.

Мы воспользуемся эффектным приемом, который достаточно широко используется в функциональном программировании: если мы не можем вернуть данные из функции обратно в код, мы вместо этого передадим сам код в эту функцию! А изнутри, как легко догадаться, мы можем спокойно достать интересующие нас данные. Вот так:

(define (make-point3d x y z)
  (lambda (code) (code x y z)))

(define (point3d-x point) (point (lambda (x y z) x)))
(define (point3d-y point) (point (lambda (x y z) y)))
(define (point3d-z point) (point (lambda (x y z) z)))

(define-macro (with-point3d point . body)
  `(,point (lambda (x y z) ,@body)))


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

Таким образом, гоняя туда-сюда куски кода (по-научному, "комбинируя функции"), мы без всяких контейнеров и прямых операций с памятью, смоделировали нужное нам поведение программы. Если немного увлечься и пойти дальше, через обычную лямбду можно выразить и списки, и даже числа (вспомнив лямбда-исчисление), но нам хватит и обычных свойств замыкания.

Какой оверхед мы получаем от этого подхода? В идеальном случае -- практически никакого, кроме копирования (но мы с ним уже должны были смириться) и лишнего вызова функции. Но на деле можно столкнуться с неэффективностью интерпретатора при создании замыканий или передаче параметров при вызове функции -- это все надо смотреть на конкретную реализацию. В большинстве случаев, хранить данные замыканием достаточно эффективно, поэтому мы остановимся, пожалуй, на этом варианте. Основной его минус -- это то, что в REPL'е нельзя напрямую увидеть содержимое контейнера, только если писать специальную печатающую функцию для него (хотя это достаточно просто).

Syntactic sugar

Разумеется, достаточно уныло каждый раз писать одинаковый код для каждого типа записей. Выше мы объявили набор из конструктора и акцессоров для типа point3d, но нам придется повторять все это добро для какого-либо другого типа. К счастью, все это достаточно просто автоматизируется макросами:

(define (s+ . symbols)
  (string->symbol (apply string-append
                         (map symbol->string symbols))))

(define-macro (define-type name . fields)
  `(begin
     (define (,(s+ 'make- name) ,@fields)
       (lambda (code) (code ,@fields)))
     ,@(map (lambda (f)
              `(define (,(s+ name '- f) type)
                 (type (lambda (,@fields) ,f)))) fields)
     ,(apply define-with-macro name fields)))

(define (define-with-macro name . fields)
  `(define-macro (,(s+ 'with- name) type . body)
     (list type (append (list 'lambda '(,@fields)) body))))


Хозяйке на заметку

В вышеприведенном коде имеет смысл обратить внимание на участок с with-: мы имеем макрос, который генерирует другой макрос, который генерирует код :) При желании, подобным образом можно добавить дополнительные инструменты, вроде with-modify-.


Теперь у нас есть достаточно мощная конструкция для объявления чисто функциональных типов записей, которая генерит нам необходимый набор функций:

(define-type point3d
  x
  y
  z)

Итоги раздела

Для реализации функционального аналога сишных структур нам необходим конструктор данных (он создает собственно объект) и набор акцессоров к полям структуры. Модификация существующих значений в функциональных программах запрещена, поэтому акцессоры только "read-only", а для получения объекта с измененными значениями полей мы должны создать его заново при помощи конструктора.

Контейнером для данных в схеме может выступать список, вектор или замыкание. Каждый из предложенных вариантов имеет свои плюсы и минусы, но в итоге мы остановились на замыканиях, как на "максимально функциональном" подходе :)

Сбалансированные бинарные деревья

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

Разумеется, для этих задач можно использовать и привычные нам структуры данных, вроде тех же списков. В основном стандарте схемы есть даже уже готовая функция на этот случай: assoc, которая из заданного списка вида '((k0 v0) (k1 v1) ...) выкусит необходимый нам элемент с ключом k. В принципе, вполне достаточно для организации тех же ассоциативных массивов.

Минусы такого подхода очевидны: для поиска необходим обход вообще всех элементов в наборе, для вставки/удаления -- перестройка всего списка заново, ну и так далее. Поэтому мы попробуем спрограммировать функциональный аналог хорошо известных всем бинарных деревьев (о них можно почитать тут), причем с функцией самобалансировки при изменении (о самобалансирующихся деревьях можно узнать здесь).

На свете существует несколько методик самобалансирования деревьев при изменении, но наиболее популярными являются только две из них: красно-черные деревья и AVL-деревья. По большому счету, разница у них несущественная: первые несколько быстрее на вставке/удалении, вторые -- на поиске. Давайте, ради интереса, реализуем avl-дерево, благо там погеморройней модификации, и будет интересно посмотреть как они будут выглядеть в случае функционального подхода к программированию.

AVL-tree, skeleton

Итак, самый главный вопрос, который нас должен уже изо всех сил мучать: вот у нас в зубах дерево T, каким макаром мы добавим туда новый элемент I, если нам нельзя деструктивно модифицировать уже существующие структуры данных? Ответ, конечно, немного обескуражит любителей императивных языков. Никак :) Поэтому, мы должны из дерева T, в котором элемента I нет, сделать новое дерево T', в котором он уже будет. Ну а старое скормить сборщику мусора, если оно нас больше не интересует. Пахнет какими-то бешеными штрафами по производительности, правда? Ниже мы попробуем разобраться, почему это не так.

Итак, пошли сверху вниз. Вот так дерево будет выглядеть у нас:

(define-type avl-tree
  root
  less?
  equ?)


Так как мы намыливаемся создать достаточно абстрактную структуру данных, нам надо научить дерево сравнивать ключи элементов, чтобы оно корректно построилось. Логично, что в случае с числами в ключах у нас будет "<" для less? и "=" для equ?, для строк, соответственно, "string<?" и "string=?", ну и так далее. Вот, например, так мы строим дерево, которое не содержит ничего:

(define (make-empty-avl-tree less? equ?)
  (make-avl-tree #f less? equ?))


Как можно легко видеть, root (корневой узел в дереве) у нас будет пустым. Собственно, все дерево будет состоять из узлов, а каждый из них, согласно спецификации, должен содержать ключ, значение, левое поддерево и правое поддерево. Так как у нас AVL-tree, мы еще закешируем сюда и высоту левого и правого поддеревьев. В итоге должно получиться что-то вроде:

(define-type avl-node
  key
  value
  l-child
  r-child
  l-depth
  r-depth)


Отсутствие поддерева мы будем обозначать как #f, чтобы было попроще определять этот факт на сравнениях. В принципе, пока все логично и прозрачно, поэтому можно переходить уже к добавлению элементов.

AVL-tree, insert

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

(define (avl-tree-insert tree key value)
  (with-avl-tree tree
                 (make-avl-tree
                  (avl-tree-insert-node root key value less?)
                  less?
                  equ?)))


Дословно: разбираем старое дерево на поля, и склеиваем их обратно в новое дерево, единственно поменяв корень (root). Итак, запоминаем первый момент по оверхеду: на каждой вставке структуру avl-tree мы распаковываем и запаковываем обратно.

Далее, мы должны воткнуть новый узел в дерево на соответствующую ему позицию. Тобишь, добраться до первого пустого места (#f), сворачивая по пути влево, если наш ключ меньше, чем текущий в узле, и вправо, если наоборот:

(define (avl-tree-insert-node node ckey cvalue less?)
  (if (not node)
      (make-avl-node ckey cvalue #f #f 0 0)
      (let ((args (list node ckey cvalue less?)))
        (with-avl-node node
                       (if (less? ckey key)
                           (apply avl-subtree-insert-node
                                  make-left l-child l-depth args)
                           (apply avl-subtree-insert-node
                                  make-right r-child r-depth args))))))

(define (avl-subtree-insert-node make-proc child depth node . args)
  (let ((new-child (apply avl-tree-insert-node child args)))
    (with-avl-node new-child
                   (make-proc node new-child (calc-depth new-child)))))


Идея с модификацией узлов точно такая же, как и со всем деревом. Сначала узел декомпозируется, потом поиск уходит в левое или правое поддерево, и затем узел собирается обратно и возвращается наверх. Рекурсия останавливается на пустом поддереве, где собственно и происходит создание нового узла.

Возвращенное нам поиском поддерево помещается на место левого или правого потомка, в зависимости от того, куда изначально ушел поиск. Обратная сборка узла выполняется, соответственно, функциями make-left или make-right:

(define (make-left node child depth)
  (with-avl-node node
                 (make-avl-node key value child r-child depth r-depth)))
                        
(define (make-right node child depth)
  (with-avl-node node
                 (make-avl-node key value l-child child l-depth depth)))


Ну и до кучи нам осталось определить функцию calc-depth, чтобы все заработало:

(define (calc-depth node)
  (with-avl-node node (1+ (max l-depth r-depth))))



Рис. 1: добавление элемента
Итак, давайте прикинем, насколько все плохо. Справа должна быть картинка, на которой в некое дерево добавляется новый узел с ключом "13". Жирными стрелками видно, по какому пути пошел поиск, в попытках обнаружить место, куда воткнуть новый узел. Логично предположить, что узлы, подвергающиеся декомпозиции и обратной сборке лежат по пути следования поиска -- на диаграмме они обозначены красным цветом. Остальные поддеревья остаются нетронутыми и присобачиваются к ново-собранным узлам обратно как и были.

Суровый ли получается в результате штраф, в сравнении с деструктивным обновлением дерева? Ведь если бы нам были разрешены мутаторы, можно было бы поправить только самый нижний узел "14", записав ему в левое поддерево свежесозданное добро. Ну, можно произвести нехитрый расчет. Для поиска свободной ячейки под новый узел, нам надо пройти по дереву сверху до самого низа. Дерево у нас всегда сбалансированное (avl), поэтому его высота должна быть около log2N, где N -- количество элементов в дереве вообще.

Хозяйке на заметку

Если быть точным, то высота AVL-дерева ограничена сверху значением 1.44 * log2N.



Для дерева из, допустим, 16000 элементов, высота будет 16. Высота 24 уже дает нам 16 миллионов элементов, ну и так далее. Не знаю, как кому, а по мне так штраф совершенно незначительный :) Хотя, конечно, зависит от обстоятельств: если деревьев много, но они маленькие -- оверхед даст о себе знать при интенсивных вставках


Рис. 2: правая ротация
Наше дерево пока достаточно тупо: оно не умеет самобалансироваться. AVL-tree для балансировки использует так называемые "ротации" дерева, поворачивая порядок следования узлов направо (для уменьшения глубины слева) или налево (для уменьшения глубины справа). Когда дерево сбалансировано, в каждом узле дерева разница между высотами левых и правых поддеревьев не должна отличаться больше, чем на единицу. Если после очередной вставки нового элемента в дерево этот баланс нарушается для какого-то узла, AVL-трее начинает соответственно вращать соответствующее поддерево, чтобы уравновесить все обратно.

Прежде, чем написать необходимый код, давайте прикинем, сколько узлов нам надо модифицировать (читай: разобрать и собрать обратно) при одном повороте дерева. Слева должна быть картинка, на которой изображена ротация направо: для узла R после очередной вставки вышло так, что высота левого поддерева стала 3, а высота правого -- 1. Если внимательно посмотреть на диаграмму, то станет видно, что связи изменились для узлов R и A, все остальное осталось нетронутым. Аналогичная картина будет и при повороте налево, "модификации" будут подвергнуты только два узла.

Чтобы понять, насколько сильно здесь будет просаживаться производительность, надо прикинуть, сколько вообще ротаций будет происходить в дереве. К сожалению, общего ответа дать нельзя -- частота вращения напрямую зависит от характера входных данных. Самая худшая ситуация возникнет, когда входной набор уже отсортирован по возрастанию или убыванию: в этом случае добавление будет всегда вправо или влево, и что-то вращать придется, как минимум, на каждой второй вставке. Точнее даже так: на каждом втором элементе у нас будет одно вращение, на каждом четвертом -- два, на каждом восьмом -- три, ну и так далее, по экспоненте двойки. Сразу сообразить сложновато, поэтому давайте прикинем весьма хреновый случай: вставляем 16.777.216-ый элемент в сортированном порядке. Имеем:
  1. 24 модификации узлов на вставке
  2. 24 ротации дерева на балансировке
  3. Каждая ротация требует две модификации, всего 48
  4. Итого суммарно 72 модификации

Семьдесят два модифицированных узла для дерева в почти семнадцати миллионов элементов, я считаю, вполне по-божески. Итак, перейдем к реализации:

--- 1,11 ----
  (define (avl-tree-insert-node node ckey cvalue less?)
    (if (not node)
        (make-avl-node ckey cvalue #f #f 0 0)
+       (avl-tree-check-rotate
         (let ((args (list node ckey cvalue less?)))
           (with-avl-node node
                          (if (less? ckey key)
                              (apply avl-subtree-insert-node
                                     make-left l-child l-depth args)
                              (apply avl-subtree-insert-node
!                                    make-right r-child r-depth args)))))))


Добавили обработку вращений в функцию avl-tree-insert-node, реализуем теперь собственно алгоритм:

(define (avl-tree-check-rotate node)
  (with-avl-node node
                 (cond ((and (> l-depth r-depth)
                             (> (- l-depth r-depth) 1))
                        (apply avl-tree-rotate node rotate-right-set))
                       ((and (> r-depth l-depth)
                             (> (- r-depth l-depth) 1))
                        (apply avl-tree-rotate node rotate-left-set))
                       (else node))))

(define rotate-right-set (list make-right
                               avl-node-l-child
                               make-left
                               avl-node-r-child
                               avl-node-r-depth))

(define rotate-left-set  (list make-left
                               avl-node-r-child
                               make-right
                               avl-node-l-child
                               avl-node-l-depth))

(define (avl-tree-rotate node make-a get-child-a make-b get-child-b get-depth-b)
  (let* ((child-a (get-child-a node))
         (child-b (get-child-b child-a))
         (depth-b (get-depth-b child-a)))
    (let ((new-node (make-b node child-b depth-b)))
      (make-a child-a new-node (calc-depth new-node)))))


Функция avl-tree-rotate умеет поворачивать и направо, и налево. Единственная разница в этих двух алгоритмах -- это набор акцессоров и конструкторов, они ей прилетают из rotate-right-set и rotate-left-set. Итого, у нас уже есть вполне себе полноценное самобалансирующееся бинарное дерево, с возможностью вставки. Наполнять его тестовыми значениями удобно, например, с помощью хорошо известной нам уже функции fold:

(define (fill list)
  (fold (lambda (k t) (avl-tree-insert t k #t))
        (make-empty-avl-tree < =)
        list))


И затем можно уже экспериментировать. Например, можно узнать, какая глубина дерева у нас получится, если забить в дерево миллион элементов:

(calc-depth (avl-tree-root (fill (unfold 0 (lambda (x) (>= x 1e6)) 1+))))

AVL-tree, lookup

В отличие от вставки, поиск в дереве прост, как автомат Калашникова. Ничего модифицировать не надо, просто тупо сворачиваем влево, если искомый ключ меньше текущего, и вправо, если больше. Если ключи сравнялись -- мы у цели. Если уперлись в пустое место -- в дереве нет искомого ключа. На том и порешим:

(define (avl-tree-lookup tree ckey)
  (with-avl-tree tree
                 (let lookup ((node root))
                   (if (not node)
                       #f
                       (with-avl-node node
                                      (cond ((equ? ckey key) value)
                                            ((less? ckey key) (lookup l-child))
                                            (else (lookup r-child))))))))


Как гласит наука, при N элементах в дереве, поиск у нас займет в районе log2N сравнений. Ничего особо мудрого тут не наблюдается, и отличий в лукапе от императивного варианта нет никакого: даже рекурсия в lookup оказалась хвостовой и должна развернуться в обычный цикл. Поэтому перейдем дальше к обходу дерева.

AVL-tree, traversal

Мы реализуем симметричный обход дерева (слева направо), таская за собой пользовательскую функцию, которой будем подсовывать данные из очередного узла. Но тут надо учесть один момент: при таком подходе возникает проблема в том, что эта пользовательская функция сможет выполнять только простые действия, вроде печати данных на экран. Не стоит забывать, что мы сейчас действуем строго в рамках функционального подхода к программированию, поэтому пользователю не удастся сохранить какой-нибудь промежуточный результат своих вычислений где-то в глобальной переменной.

Решение тут достаточно простое: мы будем таскать с собой не только пользовательскую функцию, но и некий пользовательский контекст, который на каждом шаге обхода мы будем подсовывать функции вместе с данными узла. Результат функции пусть генерирует новый контекст, который будет подсунут следующему вызову функции, и так далее. Ничего не напоминает? Конечно же, это fold, который мы определили в первом разделе, и который работает на списках. Ну а наш будет работать на дереве.

Хозяйке на заметку

Строго говоря, если вдаваться немного в подробности, в функциональном программировании есть интересный трюк, благодаря которому такой процесс протаскивания контенста можно автоматизировать и скрыть с глаз вообще, называется: "Монада". Но про монады я, пожалуй, расскажу в другой статье, а пока мы реализуем обход дерева в рамках fold.



(define (avl-tree-fold tree proc acc)
  (with-avl-tree tree
                 (let traverse ((node root) (c-acc acc))
                   (if (not node)
                       c-acc
                       (with-avl-node node
                                      (let* ((l-val (traverse l-child c-acc))
                                             (c-val (proc key value l-val))
                                             (r-val (traverse r-child c-val)))
                                        r-val))))))


В принципе, такого алгоритма хватает, чтобы произвести любую операцию с деревом, которая связана с его обходом. Вот так, например, можно найти максимальное значение в дереве:

(define (avl-tree-max-value tree)
  (avl-tree-fold tree (lambda (k v a) (max v a)) 0))


А вот так мы создадим точную копию заданного дерева с удвоенными значениями ключа:

(define (avl-tree-double-copy tree)
  (avl-tree-fold tree
                 (lambda (k v t) (avl-tree-insert t (* k 2) v))
                 (make-empty-avl-tree (avl-tree-less? tree)
                                      (avl-tree-equ? tree))))


Ну и так далее: подсчитать сумму значений в дереве, реализовать что-то типа avl-tree-filter (строит копию дерева, но без тех значений, которые не удовлетворяют условию) и тому подобное добро. Если хотите, можете потренироваться, а мы пока перейдем к модификациям дерева.

AVL-tree, replace

По большому счету, замена в нашем дереве -- это та же вставка, но с дополнительно проверкой на совпадение добавляемого ключа и текущего. Если вдруг проверка успешна, то следует пересобрать текущий узел с новым значением; во всем остальном -- полный копипаст. По перфомансу тоже все аналогично, но в случае с заменой гарантировано будут отсутствовать ротации -- скелет дерева-то не меняется. В качестве бонуса еще и не всегда обязательно ползти до самого дна дерева, замена может произойти хоть в корне. В этом случае пересборке подвергнется только собственно корень и объект avl-tree, больше ничего. Давайте переопределим avl-tree-insert-node с поддержкой возможности замены:

(define (avl-tree-insert tree key value)
  (avl-tree-replace tree key (lambda (x) value)))
  
(define (avl-tree-replace tree key value-proc)
  (with-avl-tree tree
                 (make-avl-tree
                  (avl-tree-insert-node root key value-proc less? equ?)
                  less?
                  equ?)))

--- 1,22 ----
! (define (avl-tree-insert-node node ckey value-proc less? equ?)
    (if (not node)
!        (make-avl-node ckey (value-proc #f) #f #f 0 0)
        (avl-tree-check-rotate
!        (let ((args (list node ckey value-proc less? equ?)))
           (with-avl-node node
!                         (cond ((equ? ckey key)
!                                (make-avl-node key (value-proc value) l-child r-child l-depth r-depth))
!                               ((less? ckey key)
                                 (apply avl-subtree-insert-node
                                        make-left l-child l-depth args))
!                               (else
                                 (apply avl-subtree-insert-node
                                        make-right r-child r-depth args))))))))


Кроме новой проверки на equ?, претерпело изменение еще и протаскивания данных узла: теперь вместо просто значения можно передать функцию замены, которая получит старое значение узла, а результат ее работы будет новым значением. Собственно, тут ничего сложного нету. Главная мысль понятна, поэтому можно переходить к итогам.

Итоги раздела

Деревья (и бинарные в том числе), вообще, благодарная стуктура данных в функциональном программировании. Красиво строится и разбирается рекурсией, и (как мы выяснили в этом разделе) с практически незаметной просадкой производительности по сравнению с императивным своим вариантом. Конкретное AVL-tree, которое мы программировали в этой главе, по-моему, не просто выглядит достаточно симпатично с точки зрения кода, но и обладает хорошей практической полезностью: оно весьма шустро, и, в то же время, не нарушает соглашений чисто функциональной парадигмы программирования.

В процессе нам пригодились и fold / unfold из первой главы, и записи из второй. Вообще, в функциональном программировании повторное использование кода всегда легко и приятно, главное, не нарушать его принципов :)

Очереди

По-хорошему, очереди ценны тем, что операции "воткнуть в начало" и "откусить с конца" имеют сложность O(1), иными словами, перфоманс от количества элементов в этой очереди не зависит.

В схеме практикуются два тупых и прямолинейных (поэтому самых распространенных) подхода к реализации очередей, оба базируются на списках. В первом случае это самый обычный (и вполне себе функциональный) список, в котором элементы следуют в прямом или обратном порядке. Соответственно, либо insert, либо remove начинают требовать пробежки по всему списку до самого конца, и мы получаем сложность O(N) на одной из двух наших основных операций. Во втором случае используются мутаторы set-car! и/или set-cdr! (например, такой вариант продемонстрирован в SICP), но мы и от него с негодованием откажемся.

На самом деле, существует и чисто-функциональные варианты очереди, где "втыкание" и "откусывание" стабильно занимают константное время. Один из таких вариантов предложен в статье Криса Окасаки "Simple and Purely Functional Queues and Deques", основан он на так называемых "ленивых списках". Хотя там ничего сложного нет, мне все равно пока неохота перекладывать сейчас эту идею на схему, потому что иначе мне придется сначала рассказывать о реализации ленивых списков (потоков, streams) в языке. Это тянет на отдельную статью, потому что там возникает несколько неудобных моментов: подтекание памяти, если реализовывать "в лоб" на delay / force, и активное использование мутаторов, если делать по-человечески. Поэтому всех любопытных я пока что отправляю к SRFI-41 и SRFI-45, а сам расскажу о более простом варианте построения чисто-функциональных очередей на двух обычных энергичных списках, имеющий сложность для insert и remove, в основном, O(1).

Queue, skeleton

Идея тут вполне очевидная, до которой несложно додуматься и самому. Ну и до нас, разумеется, до нее додумались куча людей. Суть такова: мы заводим два списка, в одном из которых у нас будет левая часть очереди, а во втором -- правая, но в обратном порядке. Реализация основных операций становятся простой, как валенок: insert вклеивает новый элемент в правый список (в конец очереди), remove откусывает первый элемент от левого списка (из начала очереди). Обе операции требуют O(1). Разумеется, возникает резонный вопрос: откуда возьмутся элементы в левом списке, если добавляем мы всегда в правый? На этом месте у нас и возникает та неприятность, которая делает нашу очередь "почти" O(1). Когда мы хотим сделать remove, а левый список у нас пуст, мы просто заменяем в нашей структуре левый список правым (натравив сначала reverse), а правый список опустошаем.

(define-type queue
  left-list
  right-list
  length)
  
(define (make-empty-queue) (make-queue '() '() 0))


В принципе, конечно, length тут необязателен -- длину можно считать как (+ (length left-list) (length right-list)), но, на всякий случай, мы ее все же закешируем, ибо библиотечный length может внезапно решить вычислять длину через обход всего списка.

(define (queue-empty? queue)
  (zero? (queue-length queue)))

Queue, insert

Операция еще проще, чем валенок: разбираем структуру, и собираем обратно с модифицированными right-list и length:

(define (queue-insert queue element)
  (with-queue queue
              (make-queue left-list
                          (cons element right-list)
                          (1+ length))))


Процесс должен быть понятен даже ежу. Теперь перейдем к более сложной части: выкусыванию элемента.

Queue, remove

Прежде всего надо не забыть следующий момент: мы придерживаемся функциональной парадигмы программирования. Поэтому результатом remove, помимо собственно откушенного значения от очереди Q, должна являться еще и новая, модифицированная очередь Q'. Следовательно, remove возвращает два значения.

(define-type remove-result
  value
  queue)

(define (queue-remove queue)
  (with-queue queue
              (cond ((zero? length) (make-remove-result #f queue))
                    ((null? left-list)
                     (queue-remove (make-queue (reverse right-list)
                                               '()
                                               length)))
                    (else (make-remove-result (car left-list)
                                              (make-queue (cdr left-list)
                                                          right-list
                                                          (1- length)))))))


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

Функция queue-remove может обнаружить три состояния:
  1. Ей подсунули пустую очередь. Возвращает #f
  2. У нее пустой левый список. Она переливает туда данные из правого, и снова зовет саму себя
  3. В левом списке есть какое-то добро. Откусывает оттуда первый элемент и возвращает его, напару с модифицированной очередью

Ну и, по-традиции, можно привести парочку примеров, как с получившейся очередью работать. Например, сконвертируем список в очередь или обратно:

(define (list->queue list)
  (fold (lambda (e q) (queue-insert q e))
        (make-empty-queue)
        list))

(define (queue->list queue)
  (let traverse ((queue queue) (list '()))
    (if (queue-empty? queue)
        (reverse list)
        (with-remove-result (queue-remove queue)
                            (traverse queue (cons value list))))))


Или там, выкинем из очереди ненужные нам элементы:

(define (queue-filter queue check?)
  (let traverse ((queue queue) (result-queue (make-empty-queue)))
    (if (queue-empty? queue)
        result-queue
        (with-remove-result (queue-remove queue)
                            (traverse queue
                                      (if (check? value)
                                          (queue-insert result-queue value)
                                          result-queue))))))
                                


Ну и так далее.

Итоги раздела

Сделать абсолютно честную O(1) на любой insert и remove у нас, конечно, не получилось, потому что мы добровольно отказались пока от ленивых списков. Но даже энергичный вариант вышел вполне себе пригодным к практике. Давайте попробуем поразмышлять, действительно ли это так.

Итак, существует условие, которое нам омрачает жизнь: когда левый список пустой, и нам нужно забрать элемент из очереди. Насколько часто нам нужно сливать данные туда из левого списка? Легко прикинуть, что если у нас очередь используется в режиме "положить элемент, забрать элемент", оверхеда никакого не будет. А что если "положить N элементов, забрать N элементов"?

Откровенно говоря, если вспомнить математику, в нашем случае мы все равно имеем право говорить, что remove занимает O(1) время. Термин по-буржуйски звучит "amortized time", я не могу сходу вспомнить его перевод, но смысл должен быть понятен.

Насколько неприятен такой внезапный скачок в ресурсопотреблении? Ну, в приложениях реального времени, это, конечно, катастрофа :) Но писать приложения для реалтайма на языке, как минимум, со сборкой мусора уже не очень мудро (если gc, конечно, не специализированный). Во всех остальных случаях, я считаю, можно удовлетвориться этим самым "amortized time", смирились же мы с периодическими включениями сборщика мусора.

Подводим итоги: у нас есть чисто-функциональная очередь с O(1) вставкой и удалением.

Чего еще не хватает?

Zipper-based

Двусвязные списки, деки, и даже очереди с приоритетом реализуются очень похоже на очередь, которую мы рассмотрели выше. В основе таких структур лежат два списка (если я не ошибаюсь, такой паттерн называется Zipper), а в паре с их ленивостью можно добиться вполне так себе честных O(1) для основных операций.

Хэш-таблица

Наверное, основной вопрос будет звучать так: "Как сделать функциональную хэш-таблицу?". С хэшами тут достаточно скользкий момент :) С одной стороны -- традиционно хэш-таблицу реализуют на массивах, а с ними функциональное программирование особо не дружит: обновление одного элемента потребует копирования всего массива целиком. С другой стороны, не всегда в жизни требуется read/write таблица, иногда достаточно один раз ее собрать и потом использовать в read-only режиме (например, всевозможные словари). В этом случае данные достаточно собрать, например, в том же AVL-дереве, а потом воспользоваться неким avl-tree->vector, которое легко реализовать через avl-tree-fold:

(define-type hash-vector
  vector
  hash-proc
  equ?)

(define (avl-tree->hash-vector tree table-size hash-proc)
  (let ((vector    (make-vector table-size '()))
        (hash-proc (lambda (x) (modulo (hash-proc x) table-size))))
    (avl-tree-fold tree
                   (lambda (k v a)
                     (let* ((index (hash-proc k))
                            (cell (cons k v))
                            (list (vector-ref vector index)))
                       (vector-set! vector index (cons cell list))))
                   (void))
    (make-hash-vector vector hash-proc (avl-tree-equ? tree))))


Далее уже спокойно использовать получившийся вектор как хэш-таблицу в режиме только чтения.

(define (assoc-ex key list =)
  (cond ((null? list) #f)
        ((= key (caar list)) (car list))
        (else (assoc-ex key (cdr list) =))))

(define (hash-vector-lookup hash-vector key)
  (with-hash-vector hash-vector
                    (let* ((index (hash-proc key))
                           (list  (vector-ref vector index))
                           (value (assoc-ex key list equ?)))
                      (if value (cdr value) #f))))


Опять же, использование массивов для хэш-таблиц весьма выгодно из-за дешевой адресации, но необязательно. В качестве маппинга "результат хэш-функции" -> "значение или список значений" можно использовать любую структуру данных, хоть список, хоть дерево, что угодно. Самое главное, чтобы поддерживался тот самый "amortized time" в O(1) для лукапа и вставки.

Допустим, мы сгенерировали дерево из значений от 0 до M - 1. Затем, на каждый запрос мы считаем некую хэш-функцию от ключа, делим ее по модулю M, и результат считаем ключом для адресации в этом дереве. В случае коллизий -- разрешаем их методом separate chaining (по-сути, просто держим список значений на каждом узле). Чем этот подход будет отличаться от варианта на массиве? Да ничем, по-большому счету. Да, у нас лишний расход в памяти, и лукап выполняется не мгновенно, а за время log2M, но от N (количество элементов в хэше) он не зависит! Тоесть, мы получаем ровно тот же O(1) для вставки и поиска, только несколько более ресурсоемкий. Ну, а когда количество элементов вырастет настолько, что коллизии будут уже сильно надоедать, нам точно так же придется ресайзить несущее дерево, как в случае с массивом.

(define-type hash-tree
  tree
  size
  table-size
  hash-proc
  equ?
  load-factor)

(define (make-empty-hash-tree table-size hash-proc equ? load-factor)
  (make-hash-tree (let loop ((index 0)
                             (tree (make-empty-avl-tree < =)))
                    (if (>= index table-size)
                        tree
                        (loop (1+ index)
                              (avl-tree-insert tree index '()))))
                  0
                  table-size
                  hash-proc
                  equ?
                  load-factor))

(define (hash-tree-resize htree new-size)
  (with-hash-tree htree
                  (avl-tree-fold (hash-tree-tree htree)
                                 (lambda (index list tree)
                                   (fold (lambda (v t)
                                           (hash-tree-insert t (car v) (cdr v)))
                                         tree
                                         list))
                                 (make-empty-hash-tree new-size
                                                       hash-proc
                                                       equ?
                                                       load-factor))))
        
(define (hash-tree-insert htree key value)
  (with-hash-tree htree
                  (if (>= (/ size table-size) load-factor)
                      (let ((new-tree (hash-tree-resize htree
                                                        (* table-size 2))))
                        (hash-tree-insert new-tree key value))
                      (make-hash-tree
                       (let ((index (modulo (hash-proc key) table-size)))
                         (avl-tree-replace tree
                                           index
                                           (lambda (list)
                                             (cons (cons key value) list))))
                       (1+ size) table-size hash-proc equ? load-factor))))

(define (hash-tree-lookup htree key)
  (with-hash-tree htree
                  (let* ((index (modulo (hash-proc key) table-size))
                         (list  (avl-tree-lookup tree index))
                         (value (assoc-ex key list equ?)))
                    (if value (cdr value) #f))))


В принципе, хоть у нас и получилось реализовать чисто-функциональную хэш-таблицу, она все равно выглядит несколько неуклюже, и не так органично вписывается в функциональную парадигму, как обычное дерево. В обычной жизни хэш-таблицы активно используются как раз из-за возможности машины мгновенно проводить адресацию в непрерывном куске памяти. За счет этого, вставка и поиска в хэшах частенько бывает быстрее, чем в дереве, даже несмотря на коллизии и ресайз таблицы при переполнении. В нашем же случае, никаких особых бонусов по сравнению с деревом мы не получаем, даже несмотря на O(1) сложность для insert / lookup. Единственное заметное преимущество такой хэш-таблицы перед тем же avl-tree заключается в том, что большая часть работы по аллокации памяти и балансировке дерева смещается в make-empty-hash-tree. Если задать изначально достаточно большой размер несущего дерева, то на вставке hash-tree будет выигрывать у avl-tree, в ином случае ее преимущество нивелируется необходимостью разрастания (и, соответственно, последующего копирования содержимого) таблицы.

Суммируя вышесказанное, можно прийти к такому решению:

Какой вообще смысл в функциональных структурах данных?

Это вполне логичный вопрос, который может возникнуть у человека, осилившего прочитать всю мою статью с начала до этого места :) И действительно, в отличие от своих императивных аналогов, чисто функциональные структуры данных:

Тем не менее, такие структуры данных имеют ряд неоспоримых достоинств, благодаря которым их активное использование имеет смысл. Во-первых, ограничив себя функциональной парадигмой в их реализации, мы автоматом и совершенно нахаляву получаем следующие подарки:

Во-вторых, благодаря функциональной парадигме, алгоритмы становятся абстрактней, а повторное использование кода удобней. К примеру, можно взять тот же fold -- простейший комбинатор, а сколько всего полезного можно им сделать со списком! Так и в любом другом месте -- когда ты точно уверен, что результат функции зависит исключительно от ее аргументов (глобального контекста-то нет), комбинировать их становится очень просто. Не знаю, кому как, а для меня простота code reuse в функциональном программировании -- это killer feature.

Что еще интересного почитать по теме?

Разумеется, Purely Functional Data Structures Криса Окасаки. Кроме книжки, у него еще есть пачка статей на эту же тему, например, уже упоминаемая мной "Simple and Purely Functional Queues and Deques" (может быть легко выгуглена). Так же может быть полезно следить за его блогом.

Помимо Окасаки, есть еще пачка заумных статей на википедии:

Ну и, само-собой разумеется, Structure and Interpretation of Computer Programs, если кто вдруг еще не читал.
© swizard

LiveJournal swizard
Jabber swizard@beercan.ru
Last.fm swizard