Двоичные деревья поиска деревья хорошо ведут себя на случайных или неупорядоченных данных, однако на упорядоченных данных их производительность резко падает, и каждая операция может занимать до O(n) времени. Решение этой
проблемы состоит в том, чтобы каждое дерево поддерживать в приблизительно сбалансированном состоянии. Тогда каждая операция выполняется не хуже, чем за время O(log n). Одним из наиболеепопулярных семейств сбалансированных двоичных деревьев поиска являются красно-чёрные
Красно-чёрное дерево представляет собой двоичное дерево поиска, в
котором каждый узел окрашен либо красным, либо чёрным. Мы добавляем
поле цвета в тип двоичных деревьев поиска.
```
datatype Color = R | B
datatype Tree = E | T of Color x Tree x Elem x Tree
```
Все пустые узлы считаются чёрными, поэтому пустой конструктор E в поле цвета не нуждается.
Мы требуем, чтобы всякое красно-чёрное дерево соблюдало два
инварианта:
* Инвариант 1. У красного узла не может быть красного ребёнка.
* Инвариант 2. Каждый путь от корня дерева до пустого узла содержит одинаковое количество чёрных узлов.
Вместе эти два инварианта гарантируют, что самый длинный возможный
путь по красно-чёрному дереву, где красные и чёрные узлы чередуются,
не более чем вдвое длиннее самого короткого, состоящего только из
чёрных узлов.
Функция member для красно-чёрных деревьев не обращает
внимания на цвета. За исключением заглушки в варианте для конструктора
T, она не отличается от функции member для
несбалансированных деревьев.
```
fun member (x, E) = false
| member (x, T (_, a, y, b) =
if x < y then member (x, a)
else if x > y then member (x, b)
else true
```
Функция insert более интересна, поскольку она должна поддерживать два инварианта баланса.
```
fun insert (x, s) =
let fun ins E = T (R, E, x, E)
| ins (s as T (color, a, y, b)) =
if x < y then balance (color, ins a, y, b)
else if x > y then balance (color, a, y, ins b)
else s
val T (_, a, y, b) = ins s (* $\mbox{гарантированно непустое}$ *)
in T (B, a, y, b)
```
Эта функция содержит три существенных изменения по сравнению с insert для несбалансированных деревьев поиска. Во-первых, когда мы создаем новый
узел в ветке ins E, мы сначала окрашиваем его в красный
цвет. Во-вторых, независимо от цвета, возвращаемого ins,
в окончательном результате мы корень окрашиваем чёрным. Наконец, в
ветках `x < y` и `x > y` мы вызовы конструктора `T` заменяем на обращения к функции `balance`. Функция `balance` действует подобно конструктору `T`, но только она переупорядочивает свои аргументы, чтобы обеспечить выполнение инвариантов баланса.
Если новый узел окрашен красным, мы сохраняем Инвариант 2, но в
случае, если отец нового узла тоже красный, нарушается Инвариант 1. Мы
временно позволяем существовать одному такому нарушению, и переносим
его снизу вверх по мере перебалансирования. Функция
\lstinline!balance! обнаруживает и исправляет красно-красные нарушения,
когда обрабатывает чёрного родителя красного узла с красным
ребёнком. Такая чёрно-красно-красная цепочка может возникнуть в
четырёх различных конфигурациях, в зависимости от того, левым или
правым ребёнком является каждая из красных вершин. Однако в каждом из
этих случаев решение одно и то же: нужно преобразовать
чёрно-красно-красный путь в красную вершину с двумя чёрными детьми,
как показано на Рис.. Это преобразование можно записать
так:
```
fun balance (B,T (R,T (R,a,x,b),y,c),z,d) = T (R, T (B,a,x,b),T (B,c,z,d))
| balance (B,T (R,a,x,T (R,b,y,c)),z,d) = T (R, T (B,a,x,b),T (B,c,z,d))
| balance (B,a,x,T (R,T (R,b,y,c),z,d)) = T (R, T (B,a,x,b),T (B,c,z,d))
| balance (B,a,x,T (R,b,y,T (R,c,z,d))) = T (R, T (B,a,x,b),T (B,c,z,d))
| balance body = T body
```
Нетрудно проверить, что в получающемся поддереве будут соблюдены оба
инварианта красно-чёрного баланса.
Замечание! Заметим, что в первых четырех строках \lstinline!balance! правые части одинаковы. В некоторых реализациях Стандартного ML, в
частности, в Нью-Джерсийском Стандартном ML (Standard ML of New
Jersey), поддерживается расширение, называемое
\term{или-образцы}{or-patterns}, позволяющее слить несколько
вариантов с одинаковыми правыми сторонами в один
\cite{FahndrichBoyland1997}. С использованием или-образцов можно
переписать функцию \lstinline!balance! так:
```
fun balance ( (B,T (R,T (R,a,x,b),y,c),z,d)
| (B,T (R,a,x,T (R,b,y,c)),z,d)
| (B,a,x,T (R,T (R,b,y,c),z,d))
| (B,a,x,T (R,b,y,T (R,c,z,d))) ) = T (R, T (B,a,x,b),T (B,c,z,d))
| balance body = T body
```
После балансировки некоторого поддерева красный корень этого поддерева
может оказаться ребёнком ещё одного красного узла. Таким образом,
балансировка продолжается до самого корня дерева. На самом верху
дерева мы можем получить красную вершину с красным ребёнком, но без
чёрного родителя. С этим вариантом мы справляемся, всегда перекрашивая корень
в чёрное.
Реализация красно-чёрных деревьев
```
functor RedBlackSet(Element: ORDERED) : SET =
type Elem = Element.T
datatype Color = R | B
datatype Tree = E | T of Color $\times$ Tree $\times$ Elem $\times$ Tree
type Set = Tree
val empty = E
fun member (x, E) = false
| member (x, T (_, a, y, b) =
if Element.lt (x,y) then member (x, a)
else if Element.lt (y,x) then member (x, b)
else true
fun balance (B,T (R,T (R,a,x,b),y,c),z,d) = T (R, T (B,a,x,b),y,T (B,c,z,d))
| balance (B,T (R,a,x,T (R,b,y,c)),z,d) = T (R, T (B,a,x,b),y,T (B,c,z,d))
| balance (B,a,x,T (R,T (R,b,y,c),z,d)) = T (R, T (B,a,x,b),y,T (B,c,z,d))
| balance (B,a,x,T (R,b,y,T (R,c,z,d))) = T (R, T (B,a,x,b),y,T (B,c,z,d))
| balance body = T body
fun insert (x, s) =
let fun ins E = T (R, E, x, E)
| ins (s as T (color, a, y, b)) =
if Element.lt (x,y) then balance (color, ins a, y, b)
else if Element.lt (y,x) then balance (color, a, y, ins b)
else s
val T (_, a, y, b) = ins s /* $\mbox{гарантированно непустое}$ */
in T (B, a, y, b)
end
```