Árvores

Playlists

• Desta aula: https://youtube.com/playlist?list=PLYItvall0TqLE8OELzykHZOn7LaKu6-Ze
• Do curso: https://www.youtube.com/playlist?list=PLYItvall0TqJ25sVTLcMhxsE0Hci58mpQ

1 Árvores

Padrões de compartilhamento mais interessantes podem aparecer quando temos mais de um campo por nó. Árvores binárias apresentam esses padrões.

Árvores binárias de busca são árvores binárias cujos elementos internos são organizados em ordem simétrica .

• Ou seja, o valor contido por um nó qualquer é maior que todos os valores armazenados em sua sub-árvore esquerda e menor que todos os elementos armazenados em sua sub-árvore direita.
• Nesta definição assumimos que a árvore só conterá elementos que possuem uma ordem total. Ou, em outras palavras, não admitimos elementos repetidos.

-- Podemos representar uma árvore binária como
data Arv a = ArvVazia | No (Arv a) a (Arv a)

• Vamos usar essa representação para implementar Conjuntos.
• Contudo, é fácil de adaptá-la para outras abstrações como Mapas ou para outras operações (como encontrar o \(i\text{-ésimo}\) menor elemento) acrescentando alguns valores na definição da nossa árvore.

O código abaixo define uma typeclass para um conjunto:

class Conjunto t where
   membro :: Ord a => a -> t a -> Bool
   insere :: Ord a => a -> t a -> t a

-- Podemos representar uma árvore binária como
data Arv a = ArvVazia | No (Arv a) a (Arv a)

E para tornar nossa árvore um conjunto podemos fazer:

instance Conjunto Arv where

    membro _ ArvVazia = False
    membro x (No e v d)
        | x < v     = membro x e
        | x > v     = membro x d
        | otherwise = True

    insere x ArvVazia = No ArvVazia x ArvVazia
    insere x t@(No e v d)
       | x < v     = No (insere x e) v d
       | x > v     = No e v (insere x d)
       | otherwise = t

1.1 Inserção em árvores

A execução da função membro é trivial. Vamos verificar com mais cuidado a execução de insere com o elemento e:

Antes

Depois

• Cada nó que foi copiado, ou seja aqueles que foram afetados pela inserção, tem ao menos uma sub-árvore compartilhada com a árvore inicial. Na verdade, são copiados apenas os nós no caminho da inserção que, para uma árvore que for balanceada, é proporcional a \(O(\log n)\).
• Em um sistema real a maior parte dos nós reside nas sub-árvores compartilhadas.

2 Percursos pré-, em- e pós-ordem

Os três percursos tradicionais de árvores, pré/em/pós-ordem podem ser aplicados de maneira trivial.

Ou em código que imprime o conteúdo dos nós:

preOrdem, inOrdem, posOrdem :: Show a => Arv a -> IO ()
preOrdem ArvVazia = return ()
preOrdem (No e x d) = do
  print x
  preOrdem e
  preOrdem d
inOrdem ArvVazia = return ()
inOrdem (No e x d) = do
  inOrdem e
  print x
  inOrdem d
posOrdem ArvVazia = return ()
posOrdem (No e x d) = do
  posOrdem e
  posOrdem d
  print x

3 Percorrendo em largura

Mas e se quisermos uma busca em largura? As implementações tradicionais para percorrer uma árvore lançam mão de uma fila.

Vamos usar a implementação de fila fuleira® baseada em listas.

-- Fila "fuleira"®
type Queue a = [a]

-- O(1)
empty :: Queue a
empty = []

-- O(1)
isEmpty :: Queue a -> Bool
isEmpty = null

Operações na fila fuleira®:

-- O(1)
enq :: Queue a -> a -> Queue a
enq = flip (:)

-- O(n)
deq :: Queue a -> (a, Queue a)
deq xs = (last xs, init xs)

3.1 BFS - Versão com fila fuleira®

larguraQ :: Show a => Arv a -> IO ()
larguraQ arv =
  larguraFila $ enq empty arv
  where
  larguraFila q =
    if isEmpty q then return ()
    else case deq q of
      (ArvVazia, q') -> larguraFila q'
      (No e x d, q') -> do
        print x
        larguraFila $ enq (enq q' e) d

Com as estruturas de dados que temos até agora (apenas listas), apesar de possível, ainda não é trivial implementar uma estrutura de dados para fila que seja eficiente.

Uma outra abordagem (sem usar filas) é utilizar um algoritmo baseado em níveis:

larguraNivel :: Show a => Arv a -> IO ()
larguraNivel arv =
  larguraNivel' [arv]
  where
    printArv ArvVazia = return ()
    printArv (No _ x _) = print x

    filhos ArvVazia = []
    filhos (No e _ d) = [e, d]

    larguraNivel' [] = return ()
    larguraNivel' lvl = do
      mapM_ printArv lvl
      larguraNivel' $ concatMap filhos lvl

3.2 Numerando os nós em largura - BFN

Vamos considerar agora um problema um pouco diferente: numeração dos nós em largura (en: breadth-first numbering, BFN).

Considere que queremos uma função:

bfn :: Arv a -> Arv (a, Int)

onde o segundo elemento da tupla é a ordem em que este elemento foi visitado pela varredura.

Se fosse para fazer os casos tradicionais (a.k.a. fáceis) pré/in/pós-ordem…

numeraPreOrdem :: Arv a -> Arv (a, Int)
numeraPreOrdem arv =
  snd $ numeraPreOrdem' 1 arv
  where
    numeraPreOrdem' i ArvVazia = (i, ArvVazia)
    numeraPreOrdem' i (No e x d) =
      (i3, No e' (x, i) d')
      where
        (i2, e') = numeraPreOrdem' (i + 1) e
        (i3, d') = numeraPreOrdem' i2 d

numeraInOrdem :: Arv a -> Arv (a, Int)
numeraInOrdem arv =
   snd $ numeraInOrdem' 1 arv
  where
    numeraInOrdem' i ArvVazia = (i, ArvVazia)
    numeraInOrdem' i (No e x d) =
      (i3, No e' (x, i2) d')
      where
        (i2, e') = numeraInOrdem' i e
        (i3, d') = numeraInOrdem' (i2 + 1) d

numeraPosOrdem :: Arv a -> Arv (a, Int)
numeraPosOrdem arv =
   snd $ numeraPosOrdem' 1 arv
  where
    numeraPosOrdem' i ArvVazia = (i, ArvVazia)
    numeraPosOrdem' i (No e x d) =
      (i3 + 1, No e' (x, i3)  d')
      where
        (i2, e') = numeraPosOrdem' i e
        (i3, d') = numeraPosOrdem' i2 d

3.3 BFN - Versão com fila

Já a versão em largura é um pouco mais trabalhosa…

bfnFila t =
  fst $ deq $ bfn' 1 (enq empty t)
  where
    bfn' i inQ
      | isEmpty inQ = empty
      | otherwise =
        case deq inQ of
          (ArvVazia, inQ1) -> enq (bfn' i inQ1) ArvVazia
          (No e x d, inQ1) ->
            let
              inQ2 = enq (enq inQ1 e) d
              outQ0 = bfn' (i + 1) inQ2
              (d', outQ1) = deq outQ0
              (e', outQ2) = deq outQ1 in
              enq outQ2 (No e' (x, i) d')

Apesar de, a princípio, esta versão parecer complicada ela é bem eficiente.

• Se a fila utilizada tiver complexidade \(O(1)\) para inserção e remoção, então o algoritmo roda em tempo \(O(n)\).

3.4 BFN - Versão pavorosa (a.k.a. por níveis)

bfn2 arv = head $ bfn' 1 [arv]
  where
    filhos ArvVazia = []
    filhos (No a _ b) = [a, b]

    recons _ [] [] = []
    recons i (ArvVazia:ts) cs= ArvVazia : recons i ts cs
    recons i ~(No _ x _ : ts) ~(a : b : cs) =
      No a (x, i) b : recons (i + 1) ts cs

    bfn' _ [] = []
    bfn' i lvl =
      let
        proxNivel = concatMap filhos lvl
        j = i + length proxNivel `div` 2
        proxNivelNum = bfn' j proxNivel in
        recons i lvl proxNivelNum

Além de pavorosa, essa versão não é nem um pouco eficiente. Ela varre cada nível 3 vezes!

• Uma vez para pegar os filhos.
• Uma segunda vez para computar o comprimento.
• Uma terceira para reconstruir o nível.

Veremos em seguida como fazer isto de maneira mais eficiente e simples explorando a avaliação preguiçosa disponível em praticamente todas as linguagens de programação funcional.

3.5 BFN - Versão preguiçosa - Solução de Jones e Gibbons

Tal qual fizemos no exemplo de Fibonacci e dos Números Primos, imagine que magicamente caia no seu colo uma lista com os índices dos primeiros elementos de cada nível.

Usando essa lista “mágica”, a função abaixo numera os nós em largura:

-- Versão lazy por Jones e Gibbons
bfnJG' :: ([Int], Arv a) -> ([Int], Arv (a, Int))
bfnJG' (ks, ArvVazia) = (ks, ArvVazia)
bfnJG' (k : ks0, No a x b) =
  (k + 1 : ks2, No a' (x, k) b')
  where
    (ks1, a') = bfnJG' (ks0, a)
    (ks2, b') = bfnJG' (ks1, b)

Compare a saída de bfn' com a sua entrada. O que você vê?

💡 💡 Vamos plugar a saída na entrada! 💡 💡

Precisamos apenas adicionar o primeiro nível:

bfnJG t = t'
  where (ks, t') = bfnJG' (1 : ks, t)

Uma descrição mais pormenorizada da solução proposta por Jones e Gibbons pode ser encontrada em seu paper.

Para realmente entender

Para realmente entender o que está ocorrendo aqui, explique porque trocar a implementação de bfnJG de:

bfnJG t = t'
  where (ks, t') = bfnJG' (1 : ks, t)

para:

bfnJG2 t =
  snd $  bfnJG' (1 : ks, t)
  where
    ks = tail (1 : ks)

não funciona.

A depender da versão do GHC, você pode receber um erro: <<loop>>. ao executar bfnJG2.¹

3.6 Experimente no Repl.it

Experimente o código dessa seção no Repl.it abaixo:

Código no Repl.it

4 Zippers para Árvores

• Diferentemente do caso de listas, zippers para árvores não são unidimensionais.

• Para percorrer uma árvore podemos:

  • ir em direção às folhas (no caso de uma árvore binária seguindo pelos filhos à esquerda ou à direita).
  • ir em direção à raiz (para cima).

Assim, nosso zipper terá as seguintes opções de deslocamento:

• esq → caminha em direção às folhas pelo filho esquerdo
• dir → caminha em direção às folhas pelo filho direito
• cima → caminha em direção à raiz

4.1 Implementando um zipper para árvores

Assim como o zipper de listas, o nosso zipper de árvores precisará guardar pelo menos o foco e o caminho percorrido.

-- Podemos representar uma árvore binária como
data Arv a = ArvVazia | No (Arv a) a (Arv a)

type ZipperArv a =
    (Arv a, [Either (a, Arv a) (a, Arv a)])

toArvZipper :: Arv a -> ZipperArv a
toArvZipper arv = (arv, [])

fromArvZipper :: ZipperArv a -> Arv a
fromArvZipper (arv, []) = arv
fromArvZipper z = fromJust $ fromArvZipper <$> arvCima z

arvFoco :: ZipperArv a -> Maybe a
arvFoco (ArvVazia, _) = Nothing
arvFoco (No _ x _, _) = Just x

arvTrocaFoco :: a -> ZipperArv a -> Maybe (ZipperArv a)
arvTrocaFoco _ (ArvVazia, _) = Nothing
arvTrocaFoco x (No a _ b, rastro) =
    Just (No a x b, rastro)

arvDir :: ZipperArv a -> Maybe (ZipperArv a)
arvDir (ArvVazia, _) = Nothing
arvDir (No e x d, rastro) =
    Just (d, Right (x, e):rastro)

arvEsq :: ZipperArv a -> Maybe (ZipperArv a)
arvEsq (ArvVazia, _) = Nothing
arvEsq (No e x d, rastro) =
    Just (e, Left (x, d):rastro)

arvCima :: ZipperArv a -> Maybe (ZipperArv a)
arvCima (_, []) = Nothing
arvCima (arv, Left (x, d):rastro)  =
    Just (No arv x d, rastro)
arvCima (arv, Right (x, e):rastro) =
    Just (No e x arv, rastro)

4.2 Sobre o uso de Maybe

• Note que como no caso do zipper para listas, todas as operações que podem falhar devolvem um Maybe a.

• Isto torna as nossas funções totais evitando, em tempo de compilação, uma série de erros que normalmente ocorreriam apenas em tempo de execução.

> head []
*** Exception: Prelude.head: empty list

4.3 Trocando valores - Versão na munheca

Tal qual fizemos com as listas, vamos trocar um valor por outro em nossa BST na unha e em seguida usando zippers!

trocaArv :: Ord a => a -> a -> Arv a -> Arv a
trocaArv _ _ ArvVazia = ArvVazia
trocaArv velho novo (No e x d)
  | x < velho = No e x $ trocaArv velho novo d
  | x > velho = No (trocaArv velho novo e) x d
  | otherwise = No e novo d

4.4 Trocando valores - Versão com zipper

trocaArvZ :: Ord a => a -> a -> Arv a -> Arv a
trocaArvZ velho novo arv =
  fromArvZipper $ trocaArvZ' $ toArvZipper arv
  where
    trocaArvZ' z@(ArvVazia, _) = z
    trocaArvZ' z
      | f < velho = go arvDir
      | f > velho = go arvEsq
      | otherwise = fromJust $ arvTrocaFoco novo z
      where
        f = fromJust $ arvFoco z
        go d = maybe z trocaArvZ' (d z)

4.5 Comentários finais

• Zippers foram propostos originalmente por Gérard Huet em 1997.

• Certamente muitos que trabalharam com árvores durante os mais de 50 anos de linguagens funcionais fizeram buscas em largura.

  • Impressionantemente, um dos primeiros papers que descrevem de maneira organizada e elegante como isto pode ser feito é de 1993!
    • Veremos esta solução na próxima aula.
  • Em 2000 Chris Okasaki fez uma enquete com diversos usuários (em uma conferência da área) e descobriu que havia um bloqueio mental generalizado. Em outras palavras, ninguém sabia fazer isso direito em um contexto funcional!

5 Roseiras

• Roseiras (en: rose trees) são árvores que têm um número variável, potencialmente infinito², de ramificações por nó.

5.1 Implementando uma roseira (plantando? 😛)

• Em Haskell podemos representar tal estrutura da seguinte maneira

data RoseTree a = EmptyRose | RoseTree a [RoseTree a]

• Contudo, a implementação acima permite que criemos coisas assim:

arv = RoseTree 42 [EmptyRose]

• Não queremos isso! Temos algumas opções para evitar o problema…

data RoseTree a = EmptyRose | RoseTree a [RoseTree a]

1. Algoritmo do avestruz³: assumimos que o problema não vai ocorrer pois a nossa implementação, assim como os usuários da nossa ED que são “gente boa”, nunca vão fazer a besteira de colocar uma árvore vazia na lista. 🤮
2. Função intermediária⁴: para acesso ao construtor RoseTree que verifica, em tempo de execução, que não estamos recebendo árvores vazias para incluir na lista. 🙄
3. Tipos fantasmas⁵: para garantir que tudo está correto em tempo de compilação! 😎

5.2 Uma pitada de type-safe programming com tipos fantasmas

• Um tipo fantasma (en: phantom type) é simplesmente um tipo paramétrico que não utiliza pelo menos um dos seus tipos parâmetros em sua definição.

Talvez um exemplo seja ser mais esclarecedor…

data FormData a = FormData String

O exemplo parece estranho… Porque um tipo a se ele não é usado? De fato é possível usar o tipo FormData da seguinte maneira:

changeType :: FormData a -> FormData b
changeType (FormData str) = FormData str

Que troca o tipo simplesmente chamando o mesmo construtor dos dois lados da equação!

data Validated
data Unvalidated
-- Se escondermos os construtores dos usuários (basta
-- não exportá-los) essa  função é a única que pode
-- ser usada pelos usuários. Ou seja, o usuário só
-- pode criar FormData que não são validados.
formData :: String -> FormData Unvalidated
formData str = FormData str

-- Podemos criar uma função que valida os dados
validate :: FormData Unvalidated -> Maybe (FormData Validated)
validate (FormData str) = ...

-- E assim GARANTIR que funções consumam apenas dados
-- que foram validados!
useData :: FormData Validated -> IO ()
useData (FormData str) = ...

data FormData a = FormData String

• Contudo, essa implementação não garante que só existam os tipos que façam sentido como FormData Validated e FormData Unvalidated.
• Tal como está, o código permitiria a criação de um FormData Int.
  • Claro, como só exportamos a função auxiliar formData, apenas a nossa própria biblioteca conseguiria tal feito. Mas nem isso quero deixar em aberto!

Para resolver, podemos fazer⁶:

data ValidationStatus = Validated | Unvalidated

data FormData (status :: ValidationStatus) where
  FormData :: String -> FormData status

formData :: String -> FormData Unvalidated
formData str = FormData str

validate :: FormData Unvalidated -> Maybe (FormData Validated)
validate (FormData str) = ..

5.3 Tipos fantasmas na roseira

Utilizando tipos fantasmas, o código pode ser melhorado:

data Emptiness = Empty | NonEmpty

data RoseTree (e :: Emptiness) a where
  EmptyRose :: RoseTree Empty a
  RoseTree  :: a -> [RoseTree NonEmpty a] -> RoseTree NonEmpty a

5.4 Um zipper para roseiras

• Não faz mais sentido falar em direita ou esquerda para ir em direção às folhas.
• Mais ainda, o que significa mudar o foco de uma roseira?
• Temos uma mistura de um zipper de árvores com um zipper de listas!

5.5 Implementando um zipper para roseiras

data RoseTreeZipper a = RoseTreeZipper
  a -- Valor do foco
  (ListZipper (RoseTree NonEmpty a)) -- Subzipper da lista de filhos
  [(a, ListZipper (RoseTree NonEmpty a))] -- Rastro

Vamos comparar⁷ com o zipper de árvores e listas:

type ZipperArv a =
    (Arv a, [Either (a, Arv a) (a, Arv a)])

toRoseZipper :: RoseTree e a -> Maybe (RoseTreeZipper a)
toRoseZipper EmptyRose = Nothing
toRoseZipper (RoseTree v bs) =
  Just $ RoseTreeZipper v (toListZipper bs) []

roseFoco :: RoseTreeZipper a -> a
roseFoco (RoseTreeZipper v _ _) = v

roseTrocaFoco :: RoseTreeZipper a-> a-> RoseTreeZipper a
roseTrocaFoco (RoseTreeZipper _ lz ps) x =
  RoseTreeZipper x lz ps

roseDir :: RoseTreeZipper a -> Maybe (RoseTreeZipper a)
roseDir (RoseTreeZipper v lz ps) = do
  lz' <- lzDir lz
  Just $ RoseTreeZipper v lz' ps

roseEsq :: RoseTreeZipper a -> Maybe (RoseTreeZipper a)
roseEsq (RoseTreeZipper v lz ps) = do
  lz' <- lzEsq lz
  Just $ RoseTreeZipper v lz' ps

roseBaixo:: RoseTreeZipper a -> Maybe (RoseTreeZipper a)
roseBaixo (RoseTreeZipper v lz ps) = do
  (RoseTree v' bs') <- lzFoco lz
  Just $ RoseTreeZipper v' (toListZipper bs') ((v, lz) : ps)

roseCima :: RoseTreeZipper a -> Maybe (RoseTreeZipper a)
roseCima (RoseTreeZipper _ _ []) = Nothing
roseCima (RoseTreeZipper _ _ ((v',lz'):ps)) =
  Just $ RoseTreeZipper v' lz' ps

5.6 Comentários finais

• Roseiras foram apresentadas por Lambert Meertens em 1988.
• Sua variação preguiçosa para buscas vinculadas a otimização talvez seja a sua aplicação mais comum quando vinculada a zippers.

5.7 Exercício 1

A combinação das implementações das funções trocaFoco e roseCima, tal como está, descarta eventuais alterações feitas no valor em foco. Corrija a implementação.

data RoseTreeZipper a = RoseTreeZipper
  a -- Valor do foco
  (ListZipper (RoseTree NonEmpty a)) -- Subzipper da lista de filhos
  [(a, ListZipper (RoseTree NonEmpty a))] -- Rastro

roseTrocaFoco :: RoseTreeZipper a-> a-> RoseTreeZipper a
roseTrocaFoco (RoseTreeZipper _ lz ps) x =
  RoseTreeZipper x lz ps

roseCima :: RoseTreeZipper a -> Maybe (RoseTreeZipper a)
roseCima (RoseTreeZipper _ _ []) = Nothing
roseCima (RoseTreeZipper _ _ ((v',lz'):ps)) =
  Just $ RoseTreeZipper v' lz' ps

6 Árvores Rubro-Negras

6.1 Árvores Balanceadas de Busca

• Árvores de busca com garantias de altura máxima.
• Em outras palavras, árvores balanceadas em geral têm a garantia de que a sua altura é no máximo \(O(\text{lg} n)\).
• Árvores AVL e árvores rubro-negras são exemplos de árvores balanceadas de busca.

6.2 Árvores Rubro-Negras

• Árvores Rubro-Negras são árvores de busca balanceadas.
• Também chamadas de árvores vermelho-preto (en: red-black trees).
• Receberam este nome em um artigo de Guibas e Sedgewick em 1978.

  • Supostamente pois a impressora apenas era capaz de imprimir vermelho e preto…

    

6.3 Características

• Uma árvore rubro-negra é uma árvore de busca binária, logo segue todas as regras:

  • todo nó da sub-árvore esquerda de um nó p tem chave menor que a chave de p;
  • todo nó da sub-árvore direita de um nó p tem chave maior que a chave de p.

• Além disto, cada nó de uma árvore rubro negra tem as seguintes características:

  • Cor – vermelho ou preto.
  • Chave (ou valor) – Conteúdo do nó.
  • Dir, Esq – Sub-árvores direita e esquerda.

6.4 Regras de uma árvore rubro-negra

• Regra -1: É uma árvore binária de busca.
• Regra 0: Os nós são vermelhos ou pretos.
• Regra 1: A raiz é sempre preta.
• Regra 2: Nenhum nó vermelho tem filhos vermelhos.
• Regra 3: Os nós “nulos” são considerados pretos.
• Regra 4: Para cada nó \(p\), todos os caminhos desde \(p\) até as folhas contêm o mesmo número de nós pretos.

Exemplo 1.

É uma árvore rubro-negra?

Exemplo 2.

É uma árvore rubro-negra?

Exemplo 3.

É uma árvore rubro-negra?

Exemplo 4.

É uma árvore rubro-negra?

6.5 Representação

Por simplicidade, no restante das figuras vamos representar as árvores omitindo as folhas nulas (pretas). Uma árvore válida seria então:

Restringindo a maneira que os nós podem ser coloridos do caminho da raiz até qualquer uma das suas folhas, as árvores rubro-negras garantem:

• que nenhum dos caminhos será maior que 2x o comprimento de qualquer outro.
• que a árvore é aproximadamente balanceada.

6.6 Altura negra

A altura negra de um nó \(n\) é definida como o número de nós pretos (sem incluir o próprio n) visitados em qualquer caminho de n até as folhas.

• A altura negra do nó n é denotada por \(H_p(n)\).

• Pela Regra 4, \(H_p(n)\) é bem definida para todos os nós da árvore.

  • A altura negra da árvore rubro-negra é definida como sendo a \(H_p(\text{raiz})\).

6.7 Lema 1 - Altura máxima

• Lema 1: A altura máxima de uma árvore rubro-negra com \(n\) nós internos é de \(2\text{lg}(n+1)\).

  • A prova pode ser feita por indução utilizando a \(H_p\) dos nós da árvore. Veja o Lema 13.1 do [CLRS] para a prova completa.

• Corolário: As operações de Busca, Mínimo, Máximo, Sucessor e Predecessor podem ser efetuadas em tempo \(O(\text{lg}(n))\).

6.8 Operações em árvores rubro-negras

• Busca – A busca que estamos acostumados funciona sem modificações.

• Inserção e Remoção – Se feitas sem qualquer cuidado, apesar de manter as propriedades de árvores binárias de busca, podem ferir as propriedades rubro-negras.

  
  

  Veja animação de operações em: http://tommikaikkonen.github.io/rbtree

6.9 Show me the code!

Primeiro definimos as cores:

data RBColor = R | B

E em seguida, a árvore:

data RBTree a where
  RBEmpty :: Ord a => RBTree a
  RBT :: Ord a => RBColor -> RBTree a -> a -> RBTree a -> RBTree a

6.10 Operações básicas

data RBTree a where
  RBEmpty :: Ord a => RBTree a
  RBT :: Ord a => RBColor -> RBTree a -> a -> RBTree a -> RBTree a

empty :: Ord a => RBTree a
empty = RBEmpty

singleton :: Ord a => a -> RBTree a
singleton x = RBT B empty x empty

null :: RBTree a -> Bool
null RBEmpty = True
null _       = False

head :: RBTree p -> p
head (RBT _ _ x _) = x
head _ = error "head: empty Red Black Tree"

data RBTree a where
  RBEmpty :: Ord a => RBTree a
  RBT :: Ord a => RBColor -> RBTree a -> a -> RBTree a -> RBTree a

elem :: a -> RBTree a -> Bool
elem _ RBEmpty = False
elem x (RBT _ l y r)
  | x < y = elem x l
  | x > y = elem x r
  | otherwise = True

-- Percurso in-ordem
toList :: RBTree a -> [a]
toList RBEmpty = []
toList (RBT _ l v r) =
  toList l ++  v : toList r

6.11 Inserção em árvores rubro-negras

Quebra a Regra 0 – Todo nó deve ser vermelho ou preto.

6.12 Consertando a Regra 0

• É preciso decidir, qual faz menos mal, colocar um nó vermelho ou um preto?
  • O vermelho pode não quebrar nada.
  • O preto vai desequilibrar a altura negra da raiz, com certeza.

6.13 Mantendo as regras válidas

• Regra 0 resolvida, sempre insiro um nó com a cor vemelha.
• E agora, qual regra eu quebrei?
  • Melhor ainda, quais regras eu poderia ter quebrado?

6.14 Rebalanceamento

Primeiramente, criamos uma função que cria a árvore alvo após o balanceamento:

buildRed :: Ord a => RBTree a -> a -> RBTree a -> a -> RBTree a -> a -> RBTree a -> RBTree a
buildRed a x b y c z d =
  RBT R (RBT B a x b) y (RBT B c z d)

Agora basta descrever as transições dos 4 casos:

balance :: Ord a => RBColor -> RBTree a -> a -> RBTree a -> RBTree a
balance B (RBT R (RBT R a x b) y c) z d = -- Caso 1
  buildRed a x b y c z d
balance B (RBT R a x (RBT R b y c)) z d = -- Caso 2
  buildRed a x b y c z d

balance B a x (RBT R b y (RBT R c z d)) = -- Caso 3
  buildRed a x b y c z d
balance B a x (RBT R (RBT R b y c) z d) = -- Caso 4
  buildRed a x b y c z d
balance color a x b =
  RBT color a x b

6.15 Inserção

• Fazemos a inserção como sempre.
• Na linha 2, garantimos que a raiz continuará preta.
• As chamadas à balance garantem que as propriedades da árvore serão mantidas

insert :: Ord a => a -> RBTree a -> RBTree a
insert x t = makeBlack $ ins t
  where
    ins RBEmpty = singleton x
    ins t2@(RBT color l y r)
      | x < y = balance color (ins l) y r
      | x > y = balance color l y (ins r)
      | otherwise = t2

    makeBlack ~(RBT _ a y b) = RBT B a y b

insert :: Ord a => a -> RBTree a -> RBTree a
insert x t = makeBlack $ ins t
  where
    ins RBEmpty = singleton x
    ins t2@(RBT color l y r)
      | x < y = balance color (ins l) y r
      | x > y = balance color l y (ins r)
      | otherwise = t2

    makeBlack ~(RBT _ a y b) = RBT B a y b

6.16 Corrigindo a inserção

• A correção é simples, bastando fazer com que o nó inserido seja vermelho.

insert :: Ord a => a -> RBTree a -> RBTree a
insert x t = makeBlack $ ins t
  where
    ins RBEmpty = RBT R empty x empty
    ins t2@(RBT color l y r)
      | x < y = balance color (ins l) y r
      | x > y = balance color l y (ins r)
      | otherwise = t2

    makeBlack ~(RBT _ a y b) = RBT B a y b

Quais outros erros poderiam estar escondidos na nossa implementação? O compilador não poderia nos ajudar a detectá-los?

6.17 Comentários finais

A versão de árvore rubro-negra que apresentamos aqui é devida a Chris Okasaki e foi apresentada em 1999. Antes disso as implementações funcionais eram uma adaptação forçada das implementações imperativas.

Aqueles mais atentos vão perceber que houve a omissão de um tópico essencial: remoção funcional de nós.

• Essa omissão também ocorre no livro do Okasaki [CO].
• Assim como a inserção, a versão funcional “redonda” de árvores rubro-negras demorou para aparecer. Em particular, a remoção só apareceu em 2014 em um paper apropriamente chamado (tradução minha): “Remoções: a maldição das árvores rubro negras”.

6.18 Experimente no Repl.it

Experimente o código dessa seção no Repl.it abaixo:

Código no Repl.it

7 Type-safe Red-Black Trees

• Assim como fizemos com as Roseiras, vamos melhorar o nosso código para que erros como o que cometemos (e alguns outros) não sejam possíveis.

• Para isto vamos precisar relembrar um pouco de matemática.

7.1 Axiomas de Peano

• Em 1879, Giuseppe Peano apresentou uma fundamentação (utilizando a linguagem da época) que admite três conceitos primitivos (número natural, zero e sucessor) relacionados entre si por cinco axiomas.
• Este conjunto de axiomas é a base para a formalização ordinal de números naturais.
• Mais detalhes em [MC].

• Indicaremos por \(\sigma(n)\) o sucessor de \(n\) e, como usual, \(0\) para denotar o valor zero.

• Os cinco axiomas são:

  1. \(0\) é um número natural.
  2. Todo número natural \(n\) tem um sucessor \(\sigma(n)\).
  3. \(0\) não é sucessor de nenhum número.
  4. Se \(\sigma(n) = \sigma(m)\) então \(n = m\).
  5. Princípio da indução completa: Seja \(S\) um conjunto de números naturais tal que: (i) \(0 \in S\); e (ii) Se \(n \in S\) então \(\sigma(n) \in S\); então \(S\) é o conjunto de todos os números naturais.

7.2 Cálculo λ

• Criado por Alonzo Church na década de 1930.
  • Apresentado em 1932 e refinado até 1940 quando apresentou a sua versão tipada.
  • Church foi o orientador de doutorado do Alan Turing, que publicou o paper descrevendo máquinas de Turing em 1936.
  • Para saber mais sobre Cálculo-\(\lambda\): aqui e [SK] Cap. 5.

7.3 Cálculo λ e Axiomas de Peano

• Church apresentou uma maneira de representar inteiros em Cálculo-\(\lambda\) utilizando funções anônimas.
• Essa representação ficou conhecida como Números de Church.
• Um número n é codificado como a chamada de uma função n vezes:

ZERO = \f x -> x
UM   = \f x -> f x
DOIS = \f x -> f (f x)
TRES = \f x -> f (f (f x))

• Que nada mais é que a ideia da função \(\sigma\) apresentada por Peano!

7.4 Saindo de valores e indo para tipos

• A implementação sugerida anteriormente é baseada em valores disponíveis apenas em tempo de execução.
• Queremos usar essa garantia em tempo de compilação!⁸.

-- Inteiros de Peano
data Peano = Zero | Succ Peano

E os números naturais passam a ser…

type One = Succ Zero
type Two = Succ One
type Three = Succ Two
...

7.5 Pronto! Já temos o que precisamos!

• Vamos relembrar as regras de uma árvore rubro-negra:
  • Regra 0: Os nós são vermelhos ou pretos ✗
  • Regra 1: A raiz sempre é preta ✗
  • Regra 2: Nenhum nó vermelho tem filhos vermelhos ✗
  • Regra 3: Os nós nulos são pretos ✗
  • Regra 4: Altura negra à esquerda e à direita iguais ✗

… e nossa implementação atual:

data RBColor = R | B

data RBTree a where
  RBEmpty :: Ord a => RBTree a
  RBT :: Ord a => RBColor -> RBTree a -> a -> RBTree a -> RBTree a

7.6 Vamos começar pelo mais fácil… Regras 0 e 3

• Regra 0: Os nós são vermelhos ou pretos ✓
• Regra 1: A raiz sempre é preta ✗
• Regra 2: Nenhum nó vermelho tem filhos vermelhos ✗
• Regra 3: Os nós nulos são pretos ✓
• Regra 4: Altura negra à esquerda e à direita iguais ✗

data Color = R | B
type Black = Node B -- Apenas um atalho
type Red   = Node R

data Node (c :: Color) a where -- regra 0
  Null :: Ord a => Black a -- regra 3
  RBT :: Ord a => c -> Node c0 a -> a -> Node c1 a -> Node c a

7.7 Regra 1

• Regra 0: Os nós são vermelhos ou pretos ✓
• Regra 1: A raiz sempre é preta ✓
• Regra 2: Nenhum nó vermelho tem filhos vermelhos ✗
• Regra 3: Os nós nulos são pretos ✓
• Regra 4: Altura negra à esquerda e à direita iguais ✗

data Color = R | B
type Black = Node B
type Red   = Node R

data RBTree a = Black a -- regra 1

data Node (c :: Color) a where -- regra 0
  Null :: Ord a => Black a -- regra 3
  RBT :: Ord a => c -> Node c0 a -> a -> Node c1 a -> Node c a

7.8 Regra 2

• Regra 0: Os nós são vermelhos ou pretos ✓
• Regra 1: A raiz sempre é preta ✓
• Regra 2: Nenhum nó vermelho tem filhos vermelhos ✓
• Regra 3: Os nós nulos são pretos ✓
• Regra 4: Altura negra à esquerda e à direita iguais ✗

data Color = R | B
type Black = Node B
type Red   = Node R

data RBTree a = Black a -- regra 1

data Node (c :: Color) a where -- regra 0
  Null :: Ord a => Black a -- regra 3
  Black::Ord a => Node c0 a -> a -> Node c1 a -> Black a
  -- regra 2
  Red :: Ord a => Black a -> a -> Black a -> Red a

7.9 Regra 4

• Regra 0: Os nós são vermelhos ou pretos ✓
• Regra 1: A raiz sempre é preta ✓
• Regra 2: Nenhum nó vermelho tem filhos vermelhos ✓
• Regra 3: Os nós nulos são pretos ✓
• Regra 4: Altura negra à esquerda e à direita iguais ✓

data Peano = Zero | Succ Peano
type One = Succ Zero

data RBTree a = forall n. T (Black n a) -- regra 1

data Node (c :: Color) (n :: Peano) a where -- regra 0
  Null  :: Ord a => Black One a -- regra 3, 4
  Black :: Ord a => Node c0 n a -> a -> Node c1 n a -> Black (Succ n) a -- regra 4
  -- regra 2 e 4
  Red :: Ord a => Black n a -> a -> Black n a -> Red n a

7.10 gRReat success!

7.11 Busca

A busca precisa apenas de algumas pequenas alterações para funcionar na nova ED:

elem :: Ord a => a -> RBTree a -> Bool
elem x (T node) = elemNode x node

elemNode :: a -> Node c n a -> Bool
elemNode x node =
  case node of
     Null -> False
     (Black l y r) -> elem' x l y r
     (Red l y r) -> elem' x l y r
  where
    elem' e l y r
      | e < y = elemNode e l
      | e > y = elemNode e r
      | otherwise = True

7.12 Inserção

• A estratégia que utilizamos antes de:

  • Inserir um novo nó vermelho.
  • Verificar se há um problema e propagar as correções até a raiz…

• … não funciona mais!

• Os tipos proibem que criemos uma árvore inválida mesmo que temporariamente!

• Precisamos montar uma árvore válida diretamente.

7.13 Relembrando o rebalanceamento

7.14 Consertando a inserção

• A ideia da implementação se baseia na seguinte observação: a inserção de um novo nó vermelho abaixo de…

  • … um nó vermelho pode causar uma violação das regras.
  • … um nó preto não gera uma violação das regras.

• Assim, dividimos a implementação da inserção em cores!

7.15 O tipo Violation

data Violation (n :: Peano) a where
  Case14 -- Nós vermelhos à esq. esq.
    :: Ord a =>   -- Caso 1 Caso 4
       a          -- Red y  Red z
    -> a          -- Red x  Red y
    -> Black n a  -- a      b
    -> Black n a  -- b      c
    -> Black n a  -- c      d
    -> Violation n a
  Case23 -- Nós vermelhos à dir. dir.
    :: Ord a =>   -- Caso 2 Caso 3
       a          -- Red x  Red y
    -> a          -- Red y  Red z
    -> Black n a  -- a      b
    -> Black n a  -- b      c
    -> Black n a  -- c      d
    -> Violation n a

7.16 Inserção abaixo de um nó vermelho

-- insere o elemento x0 na árvore de raiz vermelha n
-- Fica sob responsabilidade do pai a correção de
-- eventuais violações.
insR :: a -> Red n a -> Either (Violation n a) (Red n a)
insR x0 n@(Red l0 y0 r0) -- l0 e r0 são pretos
  | x0 < y0 =
    case insB x0 l0 of
      (Left black)        -> mkRed black y0 r0
      (Right (Red a x b)) -> Left $ Case14 y0 x a b r0
  | x0 > y0 =
    case insB x0 r0 of
      (Left black)        -> mkRed l0 y0 black
      (Right (Red b y c)) -> Left $ Case23 y0 y l0 b c
  | otherwise = Right n
  where
    mkRed a v c = Right $ Red a v c

7.17 Inserção abaixo de um nó preto

-- insere o elemento x0 na árvore de raiz negra e
-- devolve um novo no pode ser vermelho ou negro
insB :: a -> Black n a -> Either (Black n a) (Red n a)
insB x0 Null = Right $ Red Null x0 Null
insB x0 n@(Black l0 y0 r0)
  | x0 < y0 =
    case l0 of
      Null -> eitherInsBL x0 Null y0 r0
      black@Black{} -> eitherInsBL x0 black y0 r0
      red@Red{} ->
        case insR x0 red of
          (Left (Case14 y x a b c)) -> -- Caso 1
            balance a x b y c y0 r0
          (Left (Case23 x y a b c)) -> -- Caso 2
            balance a x b y c y0 r0
          (Right r) ->
            mkBlack y0 r r0

  -- O caso de x0 > y0 é semelhante, porém pode causar
  -- as violações 3 ou 4
  | x0 > y0 =
    case r0 of
      Null -> eitherInsBR x0 l0 y0 Null
      black@Black{} -> eitherInsBR x0 l0 y0 black
      red@Red{} ->
        case insR x0 red of
          (Left (Case14 z y b c d)) -> -- Caso 4
            balance l0 y0 b y c z d
          (Left (Case23 y z b c d)) -> -- Caso 3
            balance l0 y0 b y c z d
          (Right r) ->
            mkBlack y0 l0 r

  -- Neste caso o valor já estava na árvore
  | otherwise = Left n
  where
    mkBlack x a b = Left $ Black a x b
    eitherInsBR x l y r = either (mkBlack y l) (mkBlack y l) (insB x r)
    eitherInsBL x l y r = either (flip (mkBlack y) r) (flip (mkBlack y) r) (insB x l)
    balance a x b y c z d =  Right $ Red (Black a x b) y (Black c z d)

7.18 Inserção geral

E finalmente a inserção na árvore propriamente dita

-- insere o elemento x na árvore t
insert :: a -> RBTree a -> RBTree a
insert x (T node) =
  -- pela regra 1 (e o tipo de RBTree) sabemos que node
  -- é preto, então insB type-checks
  case insB x node of
    (Left b) -> T b
    (Right (Red l v r)) -> T $ Black l v r

7.19 Agora sim!

7.20 Ainda falta uma regra

• Regra -1: A árvore é de busca ✗
• Infelizmente, para fazer a verificação em tempo de compilação, precisamos de uma linguagem com tipos dependentes (en: dependent types) como Idris.
  • Reveja o comentário quando falamos sobre este assunto relacionado às Roseiras.
• O máximo que podemos fazer, enquanto as propostas de tipos dependentes para Haskell ainda não estão prontas, é uma verificação em tempo execução 😢

7.21 Comentários finais

• Implementações type-safe (com diversos graus de safety 😛) de árvores rubro-negras abundam na Internet.
  • Inclusive em linguagens como Java.
• Dentre as implementações em linguagens funcionais, as seguintes características de implementação comuns à que mostramos aqui estão presentes (em maior ou menor grau) em muitas delas:
  • Uso de GADTs e DataKinds para garantir as cores.
  • Números de Peano para assegurar que a altura negra está consistente.
  • Divisão entre inserções vermelhas e inserções pretas.
• Até onde pude averiguar, contudo, o uso de um tipo Violation como o que fizemos aqui para melhor organização e entendimento do código é minha jaboticaba.

7.22 Experimente no Repl.it

Experimente o código dessa seção no Repl.it abaixo:

Código no Repl.it

8 Referências

• [CO]
• Purely Functional Data Structures
  • Por Chris Okasaki

• [MC]
• Números - Uma introdução à Matemática
  • Por César Polcino Milies & Sônia Pitta Coelho

8.1 Artigos - Varredura de árvores

• Okasaki, Chris. “Breadth-first numbering: lessons from a small exercise in algorithm design.” International Conference on Functional Programming: Proceedings of the fifth ACM SIGPLAN international conference on Functional programming. 2000.
• Jones, Geraint, and Jeremy Gibbons. “Linear-time Breadth First Tree Algorithms: An exercise in the arithmetic of folds and zips”. Department of Computer Science, The University of Auckland, New Zealand, 1993.

8.2 Artigos - Árvores rubro-negras

• Okasaki, Chris. “Red-black trees in a functional setting.” Journal of functional programming 9.4 (1999): 471-477.
• Germane, Kimball, and Matthew Might. “Deletion: The curse of the red-black tree.” Journal of Functional Programming 24.4 (2014): 423-433.
• Kahrs, Stefan. “Type-Safe Red-Black Trees with Java Generics.” Specification Transformation Navigation (2009): 168.

8.3 Outras Referências

• Huet, Gérard. “The zipper.” Journal of functional programming 7.5 (1997): 549-554.

• Meertens, Lambert. “First steps towards the theory of rose trees.” CWI, Amsterdam (1988).

• Eisenberg, Richard A. “Dependent types in haskell: Theory and practice.”. PhD Thesis, University of Pensylvania 2016.

9 Disclaimer

Estes slides foram preparados para os cursos de Paradigmas de Programação e Desenvolvimento Orientado a Tipos na UFABC.

Este material pode ser usado livremente desde que sejam mantidos, além deste aviso, os créditos aos autores e instituições.