Esse post é baseado no livro Teoria das Categorias para Programadores, de Bartosz Milewski.
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.
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
.
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
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
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.
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
.
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]
.
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])
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])
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
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.
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
https://bartoszmilewski.com/2014/10/28/category-theory-for-programmers-the-preface/