Listas, compreensões e algoritmos recursivos

A pauta [12,15,10] tem uma primeira nota, 12, e uma cauda, [15,10]. Escrevemos a mesma lista como 12:[15,10]. Toda a lista tem uma destas formas: [] ou x:xs. Para somar as notas, [] contribui com zero e x:xs contribui com x mais a soma de xs. Para construir outra lista, : coloca um elemento antes do resultado recursivo.

A página segue as folhas: compreensões e candidatos (folha 2), recursão, ordenação e bits (folha 3), e decisões de agrupar e permutar que voltam nos testes.

Construir e percorrer

3:[5,7] constrói [3,5,7]. O lado direito de : tem de ser uma lista, por isso 3:5 não tem um tipo válido. ++ junta duas listas: [3] ++ [5,7] também dá [3,5,7], mas percorre o operando esquerdo. Construir com : custa tempo constante; juntar xs ++ ys custa tempo proporcional ao comprimento de xs.

Se queres saber se há menos de três elementos, não precisas de contar a lista toda:

curta :: [a] -> Bool
curta (_:_:_:_) = False
curta _ = True

O primeiro padrão precisa de três elementos. A variável _ na cauda pode corresponder a qualquer lista, incluindo uma infinita. Esta função termina depois de observar no máximo três células; length xs < 3 não termina para uma lista infinita.

Geradores e condições

Uma compreensão [expressao | gerador, condicao] produz valores na ordem dos geradores. Com [(x,y) | x <- [1,2], y <- [4,5]], fixamos primeiro x=1 e percorremos os dois y; depois fazemos o mesmo para x=2. O resultado é [(1,4),(1,5),(2,4),(2,5)]. Trocar os geradores muda a ordem.

Um problema de divisores pede candidatos inteiros e um teste de divisibilidade:

divisoresProprios :: Integer -> [Integer]
divisoresProprios n = [d | d <- [1..n-1], n `mod` d == 0]

perfeito :: Integer -> Bool
perfeito n = n > 0 && sum (divisoresProprios n) == n

Para n=12, os divisores próprios são [1,2,3,4,6] e somam 16, por isso perfeito 12 é False. Para 6, os divisores [1,2,3] somam 6 e o resultado é True. A condição n > 0 exclui zero, que de outro modo passaria porque a soma vazia é zero.

Podemos reutilizar a decisão para gerar os números perfeitos até um limite: [n | n <- [1..limite], perfeito n]. Com limite 30, o resultado é [6,28]. A compreensão exterior gera números; a interior, em divisoresProprios, gera os divisores de cada um.

Para testar primalidade não precisamos de chegar a n-1. Se n=d*k e os dois fatores fossem maiores que a raiz quadrada de n, o produto seria maior que n. Um composto tem portanto um divisor até essa raiz. Podemos evitar erros de arredondamento usando d*d <= n com Integer:

primo :: Integer -> Bool
primo n = n > 1 && testar 2
  where
    testar d
      | d*d > n = True
      | n `mod` d == 0 = False
      | otherwise = testar (d+1)

O custo deste método é de ordem raiz quadrada de n, contando candidatos, não o custo de multiplicar inteiros grandes.

Relacionar posições com zip

zip junta posições correspondentes. Uma compreensão pode depois selecionar os pares que interessam:

indices :: Eq a => a -> [a] -> [Int]
indices valor xs = [i | (x,i) <- zip xs [0..], x == valor]

Para indices 'a' "casa", zip forma [('c',0),('a',1),('s',2),('a',3)] e o teste conserva [1,3], porque a enumeração [0..] não precisa de um limite explícito: zip para quando acaba a lista finita xs. O padrão (x,i) separa cada par.

Num gerador dependente, os nomes têm de ser definidos antes de usados. [(x,y) | x <- [1..3], y <- [x..3]] dá [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]. Se trocarmos os geradores, x ainda não existe ao avaliar [x..3].

O triângulo de Pascal também permite combinar posições correspondentes. De [1,3,3,1], acrescentamos zero em pontas opostas:

[0,1,3,3,1]
[1,3,3,1,0]
----------- somar posição a posição
[1,4,6,4,1]

zipWith (+) ([0] ++ linha) (linha ++ [0]) faz estas somas. Para construir o triângulo por coeficientes binomiais, como na folha 2, usamos geradores dependentes:

binom :: Integer -> Integer -> Integer
binom n k = product [1..n] `div` (product [1..k] * product [1..n-k])

pascal :: Integer -> [[Integer]]
pascal n = [[binom i k | k <- [0..i]] | i <- [0..n]]

O domínio é n >= 0 e, em binom, 0 <= k <= n. A linha i contém i+1 coeficientes. O produto vazio é 1, pelo que a linha zero é [1]. pascal 3 dá [[1],[1,1],[1,2,1],[1,3,3,1]].

Derivar myindex por casos

Para myindex :: [a] -> Int -> a, segue o índice e a lista em conjunto. Com índice 0, a resposta é a cabeça, e a lista tem de ser não vazia. Com índice positivo n + 1, descarta a cabeça e procura n na cauda:

myindex (x:_) 0 = x
myindex (_:xs) n = myindex xs (n - 1)

myindex [7,9,11] 0 dá 7 pela primeira equação. myindex [7,9,11] 2 descarta 7 e 9 e chega a myindex [11] 0, que dá 11. O domínio exclui índices negativos e índices além do fim. Cada chamada recebe uma cauda estritamente menor, por isso a medida length diminui até ao caso base.

Recursão que termina

Antes de escrever as equações, identifica o caso base e uma medida que diminui. Em funções sobre listas finitas, a medida costuma ser o comprimento da lista restante. Em replicar n x, pode ser max 0 n:

replicar :: Int -> a -> [a]
replicar n x
  | n <= 0 = []
  | otherwise = x : replicar (n-1) x

Usar apenas o caso n == 0 faria a função divergir para n negativo, porque o tipo Int -> a -> [a] permite argumentos negativos; se queres excluí-los, precisas de o declarar como pré-condição ou de os tratar.

Para eliminar repetidos conservando a primeira ocorrência, guardamos a cabeça e retiramos todas as suas cópias da cauda. Para "abacaba", conservamos a, resta "bcb", conservamos b e resta "c": o resultado é "abc".

Agrupar iguais consecutivos resolve outra tarefa. Em "AABBBAA", takeWhile (=='A') obtém "AA" e dropWhile (=='A') deixa "BBBAA". Continuamos apenas nesse resto, obtendo ["AA","BBB","AA"]. Os dois grupos de A permanecem separados porque um grupo de B os interrompe.

Se a dúvida é como construir uma função recursiva a partir dos casos de uma lista, vê este vídeo e acompanha cada caso antes da chamada recursiva:

Graham Hutton, FP 8: Recursive FunctionsCarregar vídeo do YouTube

Abrir no YouTube

Ordenação por inserção

A função inserir x ys pressupõe que ys já está ordenada. Se x <= head ys, põe x antes da cabeça; caso contrário, conserva a cabeça e continua na cauda. Para inserir 3 em [1,2,4], conservamos 1, conservamos 2 e paramos antes de 4: [1,2,3,4].

Ordenar uma lista não vazia é ordenar a cauda e inserir a cabeça nesse resultado. A correção tem dois passos: o caso vazio está ordenado; se a cauda recursiva está ordenada e tem os mesmos elementos, inserir a cabeça mantém a ordenação e restitui todos os elementos. Num caso desfavorável, cada inserção percorre quase toda a lista anterior, por isso o total cresce como 1+2+...+(n-1), ou seja ordem n².

Dividir e juntar

Merge sort divide a lista em duas metades, ordena cada metade e junta-as comparando as duas cabeças. Só retiramos a cabeça escolhida: a outra tem de voltar à chamada recursiva. Esquecer essa cabeça perde dados.

As listas de zero e um elemento são casos base. Numa lista maior, splitAt (length xs div 2) produz duas listas estritamente menores. Juntar percorre no máximo n elementos por nível e há ordem log n níveis, dando ordem n log n. Esta versão requer listas finitas.

inserir :: Ord a => a -> [a] -> [a]
inserir x [] = [x]
inserir x (y:ys)
  | x <= y = x:y:ys
  | otherwise = y:inserir x ys

ordenar :: Ord a => [a] -> [a]
ordenar [] = []
ordenar (x:xs) = inserir x (ordenar xs)

juntar :: Ord a => [a] -> [a] -> [a]
juntar [] ys = ys
juntar xs [] = xs
juntar (x:xs) (y:ys)
  | x <= y = x:juntar xs (y:ys)
  | otherwise = y:juntar (x:xs) ys

mergeSort :: Ord a => [a] -> [a]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs = juntar (mergeSort esq) (mergeSort dir)
  where (esq,dir) = splitAt (length xs `div` 2) xs

semRepetidos :: Eq a => [a] -> [a]
semRepetidos [] = []
semRepetidos (x:xs) = x:semRepetidos (filter (/= x) xs)

grupos :: Eq a => [a] -> [[a]]
grupos [] = []
grupos (x:xs) = (x:takeWhile (==x) xs):grupos (dropWhile (==x) xs)

fromBits :: [Integer] -> Integer
fromBits = foldl (\n b -> 2*n+b) 0

main :: IO ()
main = do
  print (ordenar [4,1,3,1])
  print (mergeSort [4,1,3,1])
  print (semRepetidos "abacaba")
  print (grupos "AABBBAA")
  print (fromBits [1,0,1,1])

Acumular uma representação binária

Ler um bit depois do prefixo equivale a multiplicar o valor anterior por dois e somar o bit. Para [1,0,1,1], os acumuladores são 0, 1, 2, 5, 11. Isto dá foldl (\n b -> 2*n+b) 0.

A função pressupõe que cada elemento é 0 ou 1. O tipo [Integer] não impõe essa regra; verifica all (\b -> b==0 || b==1) bits se a entrada não for controlada. Para converter no sentido inverso, divide por dois, recolhe os restos e inverte a lista. Define ainda que representação queres para zero, normalmente [0], e exclui números negativos ou especifica outra codificação.

Intercalar sem acrescentar nas pontas

Queremos pôr um separador entre elementos. Para intercalar '-' "rt", o resultado é "r-t". A lista vazia continua vazia; um elemento fica sozinho. Estes dois casos impedem um separador no fim:

intercalar :: a -> [a] -> [a]
intercalar _ [] = []
intercalar _ [x] = [x]
intercalar s (x:xs) = x:s:intercalar s xs

A última equação só é usada quando há pelo menos dois elementos, porque os casos anteriores já trataram zero e um.

As funções usadas em permutar

permutar usa map e concatMap, que a página seguinte estuda a fundo; aqui basta o contrato:

map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs

concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f xs = concat (map f xs)

map (y:) coloca y à frente de cada lista produzida pela recursão. concatMap (posicoes x) junta essas listas de possibilidades numa só lista. A definição completa de map, filter e fold fica para a página de ordem superior.

Inserir em todas as posições e permutar

Inserir x em todas as posições de "ab" dá ["xab","axb","abx"]. Há uma possibilidade antes da cabeça; nas restantes, conservamos a cabeça e inserimos mais adiante:

posicoes :: a -> [a] -> [[a]]
posicoes x [] = [[x]]
posicoes x (y:ys) = (x:y:ys) : map (y:) (posicoes x ys)

permutar :: [a] -> [[a]]
permutar [] = [[]]
permutar (x:xs) = concatMap (posicoes x) (permutar xs)

posicoes x [] dá uma lista com uma possibilidade, [[x]]. Já permutar [] dá [[]], porque existe uma ordenação da lista vazia. Se devolvesse [], não haveria uma possibilidade onde inserir o elemento na chamada anterior.

Para permutar "ab", começamos pela cauda "b", cuja única permutação é "b". Inserir a nas duas posições produz "ab" e "ba", ou seja para "abc" a cauda tem duas permutações e cada uma dá três posições para a, portanto seis resultados.

O tipo não exige Eq: trata ocorrências, mesmo quando os valores são iguais. permutar "aa" produz "aa" duas vezes. Com n elementos há n! resultados nesta enumeração; visitar ou imprimir os n elementos de cada resultado já exige ordem n*n! operações. Não uses este método como procura eficiente para entradas grandes. A construção termina para listas finitas, mas o número de possibilidades cresce depressa.

Converter inteiro para bits

O primeiro resto de dividir por dois é o bit menos significativo. Para 10, as divisões sucessivas são 10/2, 5/2 e 2/2, seguidas de 1/2. Os restos surgem como [0,1,0,1]; inverter dá [1,0,1,0].

A folha 3 pede toBits :: Int -> [Int]. Para esse tipo, esta definição assume binário sem sinal, com n >= 0. Escolhemos [0] para zero; a folha não fixa essa convenção:

toBits :: Int -> [Int]
toBits n
  | n < 0 = error "Esperado um inteiro nao negativo"
  | n == 0 = [0]
  | otherwise = reverse (restos n)
  where
    restos 0 = []
    restos k = k `mod` 2 : restos (k `div` 2)

O guarda negativo assinala uma violação da pré-condição; não fornece uma representação de números negativos. O programa completo chama esta versão toBitsFicha para a distinguir da seguinte. Numa resposta à ficha, conserva o tipo pedido.

toBits :: Integer -> Maybe [Integer]
toBits n
  | n < 0 = Nothing
  | n == 0 = Just [0]
  | otherwise = Just (reverse (restos n))
  where
    restos 0 = []
    restos k = k `mod` 2 : restos (k `div` 2)

intercalar :: a -> [a] -> [a]
intercalar _ [] = []
intercalar _ [x] = [x]
intercalar s (x:xs) = x:s:intercalar s xs

posicoes :: a -> [a] -> [[a]]
posicoes x [] = [[x]]
posicoes x (y:ys) = (x:y:ys) : map (y:) (posicoes x ys)

permutar :: [a] -> [[a]]
permutar [] = [[]]
permutar (x:xs) = concatMap (posicoes x) (permutar xs)

toBitsFicha :: Int -> [Int]
toBitsFicha n
  | n < 0 = error "Esperado um inteiro nao negativo"
  | n == 0 = [0]
  | otherwise = reverse (restos n)
  where
    restos 0 = []
    restos k = k `mod` 2 : restos (k `div` 2)

toBits :: Integer -> Maybe [Integer]
toBits n
  | n < 0 = Nothing
  | n == 0 = Just [0]
  | otherwise = Just (reverse (restos n))
  where
    restos 0 = []
    restos k = k `mod` 2 : restos (k `div` 2)

main :: IO ()
main = do
  print (intercalar '-' "rt")
  print (intercalar '-' "")
  print (intercalar '-' "r")
  print (posicoes 'x' "ab")
  print (permutar "ab")
  print (permutar "aa")
  print (length (permutar "abc"))
  print (map toBits [-1,0,10])
  print (map toBitsFicha [0,12])

As escolhas para zero e negativos são parte do contrato, não consequências impostas pelo tipo Integer.

Agrupar comparando com o início do grupo

Em "AABBBAA", os iguais consecutivos formam ["AA","BBB","AA"]. Podemos passar a comparação como argumento, sem exigir Eq a no tipo da função. A comparação é que decide o que significa pertencer ao mesmo grupo:

agruparPor :: (a -> a -> Bool) -> [a] -> [[a]]
agruparPor _ [] = []
agruparPor rel (x:xs) = (x:iguais) : agruparPor rel resto
  where
    (iguais, resto) = span (rel x) xs

span p xs separa o maior prefixo em que p é verdadeiro e o resto, como takeWhile e dropWhile juntos. O primeiro elemento x entra sempre no seu grupo. Comparar cada elemento seguinte com esse mesmo x identifica a fronteira; o resto começa um grupo novo.

Uma relação arbitrária pode não ser transitiva. Com rel x y = abs (x-y) <= 1 em [0,1,2], 0 aceita 1, mas recusa 2. O resultado é [[0,1],[2]]. Comparar cada elemento com o vizinho anterior daria um só grupo, pois 1 aceita 2: seria outro contrato.

agruparPor :: (a -> a -> Bool) -> [a] -> [[a]]
agruparPor _ [] = []
agruparPor rel (x:xs) = (x:iguais) : agruparPor rel resto
  where
    (iguais, resto) = span (rel x) xs

main :: IO ()
main = do
  print (agruparPor (==) "AABBBAA")
  print (agruparPor (\x y -> abs (x-y) <= 1) [0,1,2 :: Integer])
  print (agruparPor (==) ([] :: [Int]))

No caso não vazio, retiramos pelo menos a cabeça. Mesmo que a relação recuse todos os elementos seguintes, a recursão recebe uma lista menor. Para terminar a lista inteira de grupos, a entrada tem de ser finita e cada comparação tem de terminar. A função não ordena nem procura iguais depois da primeira falha.