Álgebra

Esse post é baseado no livro Teoria das Categorias para Programadores, de Bartosz Milewski.

1 Álgebra

Vamos revisitar a definição de um Monoid:

class Monoid m where
  mempty  :: m
  mappend :: m -> m -> m

Relembrando que um valor de um certo tipo m pode ser escrito como uma função f :: () -> m, e que a assinatura m -> m -> m é isomorfa a (m, m) -> m. Podemos reescrever essa definição como:

class Monoid m where
  mempty  :: () -> m
  mappend :: (m, m) -> m

E, podemos definir um Monoid como uma tupla de funções \(m^1 \times m^(m\times m) = m^{m \times m + 1}\). Ou seja, uma função do tipo:

\(m \times m + 1 \rightarrow m\)

é um candidato a ser um Monoid (mas nem todas são).

Essa formulação nos leva a uma interessante generalização. Vamos exemplificar com outras classes conhecidas da álgebra:

class Semigroup m where
  sgappend :: (m, m) -> m

class Group m where
  gempty  :: () -> m
  gappend :: (m, m) -> m
  ginv    :: m -> m

class Semiring m where
  zero :: () -> m
  one  :: () -> m
  madd :: (m, m) -> m
  mmul :: (m, m) -> m

class Ring m where
  zero :: () -> m
  one  :: () -> m
  madd :: (m, m) -> m
  mmul :: (m, m) -> m
  minv :: m -> m

Quais são as representações algébricas dessas classes? Um semigrupo pode ser representado por \(m \times m \rightarrow m\), o grupo por \(m \times m + m + 1 \rightarrow m\), o semianel é definido como \(m \times m + m \times m + 1 + 1 \rightarrow m\) e o anel por \(m \times m + m \times m + m + 1 + 1 \rightarrow m\).

O argumento de entrada dessas funções representa um Tipo de Dado Algébrico que também é um Functor. Ou seja, genericamente temos uma função F m -> m. Com isso podemos definir o conceito de F-Algebra que consiste de uma tripla \((F, a, F a \rightarrow a)\), sendo \(F\) um endofunctor e \(a\) um objeto da categoria.

Em Haskell podemos definir:

type Algebra f a = f a -> a

Com isso bata definirmos o Functor que representa nossa álgebra e uma função de avaliação. Para o exemplo de Monads temos:

data MonF a = MEmpty | MAppend a a

evalM :: Algebra MonF Integer
evalM MEmpty        = 0
evalM (MAppend m m) = m + m

E para o caso do Anel temos:

data RingF a = RZero
	     | ROne
	     | RAdd a a
	     | RMul a a
	     | RNeg a

evalZ :: Algebra RingF Integer
evalZ RZero      = 0
evalZ ROne       = 1
evalZ (RAdd m n) = m + n
evalZ (RMul m n) = m * n
evalZ (RNeg n)   = -n

As definições acima limitam o conjunto de expressões que podem ser representadas. Por exemplo, dado um RingF Integer não podemos gerar a expressão RAdd (RMul 2) (RMul 3) pois os tipos estariam errados. Para criar uma expressão arbitrária podemos utilizar uma definição recursiva dessa estrutura:

data Ring = RZero
	  | ROne
	  | RAdd Ring Ring
	  | RMul Ring Ring
	  | RNeg Ring

evalZ :: Ring -> Integer
evalZ RZero        = 0
evalZ ROne         = 1
evalZ (RAdd e1 e2) = evalZ e1 + evalZ e2
evalZ (RMul e1 e2) = evalZ e1 * evalZ e2
evalZ (RNeg e)     = -(evalZ e)

Mas agora isso não representa mais uma álgebra e perdemos nossa generalização…

Voltando a utilizar no RingF, como podemos definir uma árvore de expressão com profundidade \(1\)?

type RingF1 a = RingF (RingF a)

Da mesma forma, uma árvore com profundidade \(2\) seria:

type RingF2 a = RingF (RingF (RingF a))

ou

type RingF2 a = RingF (RingF1 a)

Continuando o processo temos que:

type RingFN+1 a = RingF (RingFN a)

Repetindo esse processo infinitas vezes chegaremos ao nosso tipo Ring que não depende de a. Essa aplicação de nosso endofunctor infinitas vezes é chamada de ponto fixo (fixed point) que pode ser definido como:

newtype Fix f = Fix (f (Fix f))

Podemos ler essa definição como “se aplicarmos um endofunctor F a um Fix F, temos como resultado o próprio Fix F, pois Fix F é a aplicação sucessiva infinita vezes do functor F e aplicá-lo mais uma vez não fará diferença.

Examinando o construtor de tipos Fix (o da direita da igualdade), temos que ele tem assinatura

Fix :: (f (Fix f)) -> Fix f

e da mesma forma podemos definir uma função unFix que retira a camada mais externa da aplicação recursiva:

unFix :: Fix f -> f (Fix f)
unFix (Fix x) = x

Por exemplo, Fix RingF = Fix (RingF (Fix RingF)) seria equivalente ao Ring e da mesma forma nos permite fazer:

evalFix :: Fix RingF -> Integer
evalFix (Fix RZero) = 0
evalFix (Fix ROne)  = 1
evalFix (Fix (RAdd e1 e2)) = evalFix e1 + evalFix e2
evalFix (Fix (RMul e1 e2)) = evalFix e1 * evalFix e2
evalFix (Fix (RNeg e)) = -(evalFix e)

Mas isso não é muito prático… Nossa versão da função evalZ :: Algebra Ring integer é muito mais clara e simples de ser definida. Vamos tentar resolver isso transformando a F-Algebra em uma categoria.

2 Categoria F-Algebra

Dado um functor \(F\), a categoria de sua álgebra possui como objetos os pares \((a, F a \rightarrow a)\), ambos da categoria original \(C\).

Um morfismo dessa categoria transforma um \((a, f)\) em um \((b, g)\). Por exemplo, podemos ter um morfismo m :: (Integer, RingF Integer -> Integer) -> (Double, RingF Double -> Double). Na categoria original seria equivalente a um morfismo m' :: a -> b.

Sendo F um Functor, podemos fazer um lift no morfismo m gerando F m :: F a -> F b.

Dessa forma podemos criar o seguinte diagrama:

Desse diagrama segue que temos dois caminhos para chegar de F a para b:

\(g \circ F m = m \circ f\)

Vamos considerar o objeto inicial dessa categoria e, se ele exister, será chamado de algebra inicial. Vamos defini-lo com a tupla (i, j :: F i -> i). Como ele é um objeto inicial, existe um único morfismo m dele para qualquer outro objeto da categoria, portanto ele é um isomorfismo (Teorema de Lambek). Com isso temos o seguinte diagrama:

Agora vamos construir uma álgebra (F i, Fj :: F (F i) -> F i), da mesma forma que no exemplo anterior, deve existir um único m da álgebra inicial para essa:

Também podemos construir o seguinte diagrama:

Se juntarmos os dois diagramas obtemos:

Sendo (i, j) a ágelbra inicial temos que a composição \(j \circ m\) deve ser única, e sendo única somente pode ser a função identidade \(id_i\). Da mesma forma, temos que \(m \circ j = id_{Fi}\), mostrando que \(m\) é o inverso de \(j\) e, então, ambos sendo isomorfismos.

Com isso temos que \(F i\) é isomorfo a \(i\), que é interpretado como \(i\) é o ponto fixo de \(F i\). Em Haskell temos que \(i\) representa nosso Fix f, \(j\) é o construtor Fix e seu inverso é a função unFix.

O Teorema de Lambek diz que para obter a algebra inicial, pegamos o functor \(f\) e substituímos o seu argumento \(a\) por Fix f.

3 Números Naturais

Vamos definir a álgebra dos números naturais, para isso criaremos dois morfismos:

zero :: 1 -> N
succ :: N -> N

O primeiro serve para escolher o número zero, o segundo cria os valores sucessivos dessa álgebra. Combinando os dois, geramos a seguinte álgebra:

-- 1 + N -> N
data NatF a = ZeroF | SuccF a

E para obter o ponto basta substituir \(a\) por Fix NatF, obtendo:

data Nat = NatF (Fix NatF)
	 = ZeroF | SuccF (Fix NatF)
	 = ZeroF | SuccF (NatF (Fix NatF))
	 = ZeroF | SuccF Nat

Para evitar conflito de nome, renomeamos os construtores para:

data Nat = Zero | Succ Nat

4 Catamorfismos

Vamos reescrever o diagrama comutativo da álgebra inicial utilizando a nossa notação em Haskell:

Nesse diagrama temos nossa álgebra inicial do lado esquerdo, e nossa álgebra de interesse com o avaliador alg :: f a -> a. Com isso podemos perceber que m :: Fix f -> a é um avaliador do ponto fixo de nossa álgebra para o tipo a. Podemos inverter a seta de Fix com nosso isomorfismo unFix, levando a:

Pela condição de comutatividade temos que:

m = alg . fmap m . unFix

Que é uma definição recursiva de m. Note que para qualquer árvore de expressão finita ela deve parar em um número finito de passos. Como exemplo, vamos definir m para transformar nosso tipo Fix NatF em um tipo Integer:

data NatF a = ZeroF | SuccF a

instance Functor NatF where
 fmap f ZeroF     = ZeroF
 fmap f (SuccF x) = SuccF (f x)

alg :: Algebra NatF Integer
alg ZeroF     = 0
alg (SuccF x) = x+1

m :: Fix NatF -> Integer
m natf = (alg . fmap m . unFix) natf

m (Fix (SuccF (Fix SuccF (Fix ZeroF))))
 =
   (alg . fmap m . unFix) (Fix (SuccF (Fix SuccF (Fix ZeroF))))
   (alg . fmap m) (SuccF (Fix SuccF (Fix ZeroF)))
   alg (SuccF (m (Fix SuccF (Fix ZeroF))))
   alg (SuccF (alg (SuccF (m (Fix ZeroF)))))
   alg (SuccF (alg (SuccF (alg ZeroF))))
   alg (SuccF (alg (SuccF 0)))
   alg (SuccF 1)
   2

Reparem que a função m é a mesma para qualquer álgebra! Então podemos defini-la como uma função de alta ordem, que é denominada catamorfismo:

cata :: Functor f => (f a -> a) -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFix

Como um outro exemplo, utilizando o mesmo functor NatF, podemos definir:

fib :: NatF (Int, Int) -> (Int, Int)
fib ZeroF = (0, 1)
fib (SuccF (m, n)) = (n, m + n)

fibonacci = cata fib

Dada uma função que converte um inteiro para a representação Fix NatF, temos:

n2nat :: Integer -> Fix NatF
n2nat 0 = Fix ZeroF
n2nat x = Fix (SuccF (n2nat (x-1)))

print $ fibonacci (n2nat 10)
> (55, 89)

Retomando nosso exemplo do tipo Ring:

data RingF a = RZero
	     | ROne
	     | RAdd a a
	     | RMul a a
	     | RNeg a

evalZ :: Algebra RingF Integer
evalZ RZero      = 0
evalZ ROne       = 1
evalZ (RAdd m n) = m + n
evalZ (RMul m n) = m * n
evalZ (RNeg n)   = -n

evalFix = cata evalZ

5 Folds

Vamos descrever uma álgebra para listas:

data ListF e a = NilF | ConsF e a

Ao definir o ponto fixo dessa estrutura, obtemos o nosso tipo lista tradicional:

data List e = Nil | Cons e (List e)

Uma álgebra para lista descrever o valor padrão para uma lista vazia e o que devemos fazer para combinar o elemento atual com o restante da lista. Por exemplo, a álgebra para calcular o tamanho da lista pode ser definido como:

lenAlg :: ListF e Int -> Int
lenAlg (ConsF e n) = n + 1
lenAlg NilF = 0

Comparando com a definição de length utilizando foldr:

length = foldr (\e n -> n + 1) 0

Como outro exemplo, considere a soma dos elementos de uma lista de inteiros e seu respectivo fold:

sumAlg :: ListF Integer Integer -> Integer
sumAlg (ConsF e s) = e + s
sumAlg NilF = 0

sum = foldr (\e s -> e + s) 0

É possível perceber que foldr é simplesmente uma especialização do catamorfismo de uma lista.

6 Co-Álgebra

De forma dual, podemos definir o conceito de Co-Álgebra fazendo:

type CoAlgebra f a = a -> f a

E ao invés de pensarmos no objeto inicial, queremos verificar o objeto final, que representa a álgebra terminal. O conceito dual de catamorfismo é o anamorfismo definido por:

ana :: Functor f => (a -> f a) -> a -> Fix f
ana coalg = Fix . fmap (ana coalg) . coalg

Podemos pensar em uma Co-Álgebra como uma receita para gerar uma estrutura de dados, potencialmente infinita.

Vamos exemplificar com o tipo Stream definido anteriormente como:

data StreamF e a = StreamF e a
  deriving Functor

com seu ponto fixo sendo:

data Stream e = Stream e (Stream e)

Podemos utilizar a co-álgebra para implementar o crivo de Erastótenes, e gerar uma lista infinita dos números primos. A semente dessa lista será a lista infinita [2..]. A próxima semente será a cauda dessa lista com todos os múltiplos de \(2\) removidos, a próxima será a lista com os múltiplos de \(3\) removidos e assim por diante:

era :: [Int] -> StreamF Int [Int]
era (p : ns) = StreamF p (filter (notdiv p) ns)
    where notdiv p n = n `mod` p /= 0

primes = ana era [2..]

É interessante notar que podemos também definir uma álgebra para o tipo StreamF que converte ele em uma lista:

toListC :: Fix (StreamF e) -> [e]
toListC = cata al
   where al :: StreamF e [e] -> [e]
	 al (StreamF e a) = e : a

O dual de foldr para listas é o unfoldr definido como:

unfoldr :: (b -> Maybe (a, b)) -> b -> [a]

Essa função irá gerar uma lista até que a aplicação de \(f b\) retorne Nothing.

7 Hylomorfismo: resolvendo o problema das \(N\) rainhas

Dada uma estrutura naturalmente recursiva transformada em seu ponto fixo, temos que o catamorfismo é uma generalização do fold para essas estruturas. Da mesma forma, o anamorfismo é a generalização do unfold.

Com isso podemos manipular essas estruturas utilizando padrões comuns de recursão para construir soluções de problemas naturalmente recursivos.

Um padrão bastante comum é a combinação desses dois morfismos, denominado hylomorfismo e definido como:

hylo :: Functor f => Algebra f a -> Coalgebra f b -> b -> a
hylo alg coalg = alg . fmap (hylo alg coalg) . coalg

Como o Haskell trabalha com avaliação preguiçosa por padrão, o hylomorfismo constrói a estrutura recursiva e, a cada passo da construção, destrói no processo de folding. Isso permite uma otimização no uso de memória em que a estrutura nunca é construída totalmente, mas apenas o pedaço necessário para cada passo.

Vamos exemplificar o uso do hylomorfismo resolvendo o problema das \(N\) Rainhas. Esse problema consiste em colocar \(N\) rainhas em um tabuleiro de xadrez de tamanho \(N \times N\) de tal forma que nenhuma rainha ataque qualquer outra.

Como sabemos que duas rainhas na mesma coluna se atacam, podemos representar uma solução como uma lista de tamanho \(N\), em que o elemento s[i] representa a linha que queremos colocar a rainha na coluna j. Da mesma forma, sabemos que duas rainhas na mesma linha também se atacam, então uma solução factível não pode conter valores repetidos em nossa lista.

Se garantirmos que nossa solução é representada por uma lista de valores distintos, podemos verificar se uma solução é válida da seguinte forma:

type Solution = [Int]

infeasible :: Solution -> Bool
-- se a rainha r ataca alguem na frente ou
-- se as rainhas a frente representam uma solução infactível
-- então é infactível
infeasible []     = False
infeasible (r:rs) = attack r rs || infeasible rs

-- | basta verificarmos se uma rainha ataca
--   qualquer outra nas diagonais a frente dela
attack :: Int -> Solution -> Bool
attack r rs = r `elem` upperDiag || r `elem` lowerDiag
  where
    -- as diagonais da linha 4 para frente
    -- serão [3,2,1..] e [5,6,7..]
    diag op   = zipWith op rs [1..]
    upperDiag = diag (-)
    lowerDiag = diag (+)

feasible = not . infeasible

Dessa forma, caso tenhamos uma função genAllsolutions que gera todos os candidatos a solução para um tabuleiro de tamanho \(N\), podemos resolver nosso problema com:

nqueens = head . (filter feasible) . genAllsolutions

Como podemos gerar nossas soluções de forma organizada? Queremos que a lista gerada não contenha repetições. Da mesma forma, não queremos soluções repetidas. Em algoritmos de busca, principalmente quando temos soluções que podem ser construídas iterativamente, podemos representar o conjunto de candidatos a solução em forma de árvore.

No nosso exemplo, para \(N = 3\), poderíamos construir a seguinte árvore de soluções:

0
|
+- 1
|  |
|  +- 2
|  |  |
|  |  `- 3
|  |
|  `- 3
|     |
|     `- 2
|
+- 2
|  |
|  +- 1
|  |  |
|  |  `- 3
|  |
|  `- 3
|     |
|     `- 1
|
`- 3
   |
   +- 1
   |  |
   |  `- 2
   |
   `- 2
      |
      `- 1

Nesse exemplo, a raíz possui um valor simbólico de \(0\) sem significado para a solução do problema. Ao fazer um percurso em profundidade, podemos gerar nosso conjunto de soluções candidatas. Reparem que isso gera todas as permutações da lista [1..3].

7.1 Árvore N-ária

Nossa representação para o conjunto de soluções é uma árvore \(n\)-ária, conhecida também como Rose Tree, que é composta de um elemento representando o nó atual e uma lista contendo os filhos desse nó. Um nó folha é representado com uma lista vazia para seus filhos:

data Rose = NodeR Int [Rose]

Essa definição é o ponto fixo da estrutura mais genérica:

data TreeF a = NodeF Int [a]

instance Functor TreeF where
  fmap f (NodeF x [a]) = NodeF x (fmap f [a])

7.2 Anamorfismo: construindo nossa árvore

A construção de nossa árvore depende da definição de uma Coalgebra que define as regras de gerar novos ramos partindo de uma semente. Nossa semente pode ser representada por uma tupla contendo o valor do nó atual e uma lista de valores que podem seguir esse nó.

Essa lista de valores deve ser um conjunto de valores entre \(1\) e \(N\) contendo apenas aqueles que ainda não foram utilizados por nenhum nó pai. Vamos utilizar a estrutura Set da biblioteca Data.Set para representar esse conjunto.

type Choices = Set Int

Com isso o padrão de construção de nossa árvore, dada uma semente (Int, Choices) é um construir um nó cujo valor é o inteiro e, seus filhos, é uma lista de sementes construída do conjunto \(\{ (m, S \setminus m) \mid m \in S\}\). Com a sintaxe do Haskell, temos:

genBranch :: Coalgebra TreeF (Int, Choices)
genBranch (n, sx) = let seeds = [(m, S.delete m sx) | m <- S.toList sx]
		    in  NodeF n seeds

E nossa árvore é construída com:

tree = ana genBranch

-- arvore construída para conjunto {1..5}
myTree = tree (0, fromList [1..5])

7.3 Catamorfismo: extraindo soluções da árvore

Nosso próximo passo é descrever a álgebra que constrói o conjunto de soluções partindo de nossa árvore de inteiros. Essa álgebra recebe uma árvore e retorna uma lista de soluções. Temos dois padrões para capturar: i) quando temos um nó sem filhos, a única solução é a lista composta por apenas esse nó, ii) quando temos um nó com filhos, devemos retornar a lista de todas as soluções que começam com o valor desse nó e terminam com as soluções parciais geradas pelos filhos, lembrando que esse processo começa da folha até a raíz:

getSols :: Algebra TreeF [Solution]
getSols (NodeF n []) = [[n]]
getSols (NodeF n ts) = concat [fmap (n:) bs | bs <- ts]

Com isso podemos gerar todas as possíveis soluções com:

unfoldTree :: Fix TreeF -> [Solution]
unfoldTree = cata getSols

7.4 Resolvendo o problema de \(N\) rainhas

Para resolver o problema das \(N\) rainhas, basta primeiro gerar nossa árvore com o anamorfismo e, então, recuperar as soluções com o catamorfismo, sugerindo o uso do hylomorfismo:

genAllSolutions :: Int -> [Solution]
genAllSolutions n = (removeRoot . hylo getSols genBranch) (0, S.fromList [1..n])
  where removeRoot = fmap tail

A função removeRoot remove o valor \(0\) do começo de cada lista de soluções, pois ele é apenas um valor simbólico representando a raíz.

Para encontrar a solução para o problema de \(8\) rainhas basta fazer:

nqueen 8

e obtemos a solução [1,5,8,6,3,7,2,4] que é factível e pode ser testada no site http://www.brainmetrix.com/8-queens/. Reparem que o hylomorfismo para essa árvore faz uma busca por profundidade.

7.5 Busca em largura com hylomorfismo

Na nossa solução anterior, fazemos o percurso da árvore em profundidade, ou seja, primeiro geramos uma solução completa para então avaliar a seguinte. Porém, em muitos problemas podemos verificar a factibilidade da solução com apenas um pedaço dela. Por exemplo, a solução parcial [1, 2] é infactível pois a rainha na casa \((1,1)\) ataca a rainha na casa \((2,2)\).

Outro problema é quando temos a possibilidade de gerar uma solução de tamanho infinito, e uma busca em profundidade nunca terminaria.

Na busca em largura queremos gerar nossa árvore nível a nível, para o problema de \(4\) rainhas seria:

	[0]
    [[1], [2], [3], [4]]
[[1,2],[1,3],[1,4],[2,1],[2,3],[2,4],...,[4,1],[4,2],[4,3]]
...

Observando atentamente, percebemos que a construção da solução é o produto cartesiano das ramificações atuais com o nó inicial (logo após a raíz). Ou seja, uma sequência de cartesian sols [[1]..[n]]. Com isso precisamos utilizar uma estrutura de lista:

data ListF e a = EmptyF | ConsF e a

A ideia é gerar uma lista de soluções parciais em que o primeiro elemento é a lista [[1],[2],[3],..[n]], o segundo elemento é [[1,1], [1,2], [1,3]...[n,n]] e assim por diante. Nossa coalgebra de geração da lista recebe a lista de soluções parciais atual e uma lista de sementes, que sempre será a mesma, e retorna um novo elemento da lista com o produto cartesiano entre as soluções atuais e a semente:

coalgBFS :: Coalgebra (ListF [Solution]) ([Solution], [Solution])
coalgBFS (xs, [[]]) = EmptyF
coalgBFS (xs, seed) = ConsF xs' (xs', seed)
  where isFeasible      = filter feasible
	cartesian ys zs = [y <> z | y <- ys, z <- zs]
	xs'             = isFeasible (cartesian xs seed)

Note que já filtramos apenas as soluções parciais factíveis de nossa lista de soluções parciais. Finalmente precisamos gerar uma álgebra que transforma nossa ListF em uma lista:

toList EmptyF        = []
toList (ConsF xss a) = xss ++ a

Com isso nossa solução para \(N\)-rainhas utilizando BFS é o hylomorfismo de nossa álgebra e coalgebra iniciando da tupla de sementes:

nqueensBFS :: Int -> [Int]
nqueensBFS n = let seed      = fmap (:[]) [1..n]
		   sols      = hylo toList coalgBFS (seed, seed)
		   isGoal xs = length xs == n
		   xs        = (filter isGoal) sols
	       in  head xs

8 Referências

https://bartoszmilewski.com/2014/10/28/category-theory-for-programmers-the-preface/