Codificación de Huffman en Haskell
En esta relación de ejercicios, para la asignatura de Programación declarativa, se estudia la codificación de Huffman. El contenido de la relación es el siguiente:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 |
-- ---------------------------------------------------------------------------- -- Importación de librerías auxiliares -- -- ---------------------------------------------------------------------------- import Test.QuickCheck import Data.Char import Data.List -- ---------------------------------------------------------------------------- -- Introducción -- ---------------------------------------------------------------------------- -- Este ejercicio está dedicado a la codificación de Huffman, una forma -- de compresión de datos usado, entre otros, para comprimir imágenes -- JPEG. La codificación de Huffman trabaja analizando la entrada que se -- tiene que comprimir y asignando a cada carácter un código (sucesión -- de bits), de forma que a los caracteres más frecuentes se le asignan -- códigos más cortos. A continuación, cada carácter se sustituye por su -- código. Por ejemplo, si el texto a comprimir es la palabra "loro", el -- código asignado puede ser -- +-----+----+ -- | 'l' | 10 | -- | 'r' | 11 | -- | 'o' | 0 | -- +-----+----+ -- y el texto comprimido es "100110" (que usa 6 bits en lugar de los 32 -- bits del texto inicial). -- -- El código se construye a partir de una estructura de datos (árbol) -- como el de abajo, en el que aparecen todos los caracteres del texto -- de entrada -- /\ -- / \ -- o /\ -- / \ -- l r -- El código de cada carácter se obtiene a partir del camino desde la -- raíz del árbol hasta el carácter, poniendo un '0' cada vez que se -- toma la rama izquierda y un '1' cada vez que se toma la rama -- derecha. Por ejemplo, para llegar al carácter 'l' primero se toma la -- rama derecha y después la izquierda, luego el código de 'l' es -- "10". Los caracteres más frecuentes se colocan más cerca de la raíz, -- con lo que sus códigos son menores. -- -- Para construir el árbol, primero se construye un "árbol trivial" (que -- contiene sólo un carácter) para cada uno de los caracteres del texto -- de entrada y se le asigna como "peso" el número de veces que ocurre -- el carácter en el texto de entrada. En el ejemplo, -- * un árbol con el carácter 'l' y peso 1, -- * un árbol con el carácter 'r' y peso 1 y -- * un árbol con el carácter 'o' y peso 2. -- A continuación, se combinan los dos árboles con menor peso, -- obteniendo un nuevo árbol cuyo peso es la suma de los pesos de los -- árboles originales. En nuestro caso, se combinan los árbolos que -- contienen los caracteres 'l' y 'r' obteniendo el árbol -- /\ -- / \ -- l r -- con peso 2. El proceso se repite hasta que sólo queda un árbol. Los -- códigos se extraen del árbol final. -- -- Nosotros representaremos estos árboles en Haskell usando el tipo Huffman -- data Huffman = Hoja Char -- | Rama Huffman Huffman -- deriving (Eq,Ord,Show) -- Por ejemplo, el árbol inicial correspondiente al carácter 'l' se -- representa por -- Hoja 'l' -- y el árbol final el ejemplo se representa por -- Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r')) -- -- Nótese que no se necesita almacenar los '0' y los '1': dado un árbol -- (Rama i d) sabemos que todos los caracteres en la rama i tienen -- códigos que empiezan por '0' y los de la rama d empiezan por '1'. -- -- Representaremos la s tablas de códigos usando el tipo TablaCodigo -- definido por -- type TablaCodigo = [(Char,String)] -- donde cada carácter se empareja con su código, como una cadena de -- bits. En nuestro ejemplo, la tabla de códigos es -- ejemploTablaCodigo = [('o',"0"),('l',"10"),('r',"11")] -- ---------------------------------------------------------------------------- data Huffman = Hoja Char | Rama Huffman Huffman deriving (Eq,Ord,Show) type TablaCodigo = [(Char,String)] ejemploTablaCodigo = [('o',"0"),('l',"10"),('r',"11")] -- ---------------------------------------------------------------------------- -- Ejercicio 1. Definir la función -- codigo :: TablaCodigo -> Char -> String -- tal que (codigo tc c) es el código del carácter c en la tabla de -- códigos tc. Por ejemplo, -- codigo ejemploTablaCodigo 'r' == "11" -- ---------------------------------------------------------------------------- codigo :: TablaCodigo -> Char -> String codigo ((x,y):xys) c | x == c = y | otherwise = codigo xys c -- ---------------------------------------------------------------------------- -- Ejercicio 2. Definir la función -- codifica :: TablaCodigo -> String -> String -- tal que (codifica tc cs) es la cadena obtenida sustituyendo todos los -- caracteres del texto de entrada cs por sus correspondientes códigos en -- la tabla de códigos tc. Por ejemplo, -- codifica ejemploTablaCodigo "loro" == "100110" -- ---------------------------------------------------------------------------- codifica :: TablaCodigo -> String -> String codifica tc cs = concat [codigo tc c | c <- cs] -- ---------------------------------------------------------------------------- -- Ejercicio 3. Definir la función -- extraeCodigos :: Huffman -> TablaCodigo -- tal que (extractCodes h) es la tabla de códigos correspondiente al -- árbol de Huffman h. Por ejemplo, -- ghci> extraeCodigos (Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))) -- [('o',"0"),('d',"10"),('g',"11")] -- ---------------------------------------------------------------------------- extraeCodigos :: Huffman -> TablaCodigo extraeCodigos (Hoja c) = [(c, "")] extraeCodigos (Rama i d) = [(c, '0':k) | (c,k) <- extraeCodigos i] ++ [(c, '1':k) | (c,k) <- extraeCodigos d] -- ---------------------------------------------------------------------------- -- Ejercicio 4. Definir la función -- construyeArbol :: [(Int,Huffman)] -> Huffman -- tal que (construyeArbol xs) es el árbol de Huffman construido a -- partir de la lista de xs cuyos elementos son pares cuyo segundos -- elementos son árboles de Huffman y sus primeros elementos son sus -- correspondientes pesos. Por ejemplo, -- ghci> construyeArbol [(1,Hoja 'l'), (1,Hoja 'r'), (2,Hoja 'o')] -- Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r')) -- Nota: (sort xs) es la lista obtenida ordenando los elementos de xs. -- ---------------------------------------------------------------------------- construyeArbol :: [(Int,Huffman)] -> Huffman construyeArbol = construye . sort construye :: [(Int,Huffman)] -> Huffman construye ((p1,h1):(p2,h2):phs) = construye (insert (p1+p2,Rama h1 h2) phs) construye [(p,h)] = h -- ---------------------------------------------------------------------------- -- Ejercicio 5. Definir la función -- ocurrencias :: Char -> String -> Int -- tal que (ocurrencias x c) es el número de veces que el carácter x -- ocurre en la cadena c. Por ejemplo, -- ocurrencias 'o' "loro" == 2 -- ---------------------------------------------------------------------------- ocurrencias :: Char -> String -> Int ocurrencias x cs = length [y | y <- cs, x==y] -- ---------------------------------------------------------------------------- -- Ejercicio 6. Definir la función -- arbolesIniciales :: String -> [(Int, Huffman)] -- tal que (arbolesIniciales cs) es la lista de los árboles iniciales de -- Huffman, con sus pesos, correspondientes a la cadena cs. Por ejemplo, -- ghci> arbolesIniciales "loro" -- [(1,Hoja 'l'),(2,Hoja 'o'),(1,Hoja 'r')] -- Nota: (nub xs) es la lista obtnida elimando las repeticiones en xs. -- ---------------------------------------------------------------------------- arbolesIniciales :: String -> [(Int, Huffman)] arbolesIniciales cs = [(ocurrencias x cs, Hoja x) | x <- nub cs] -- ---------------------------------------------------------------------------- -- Ejercicio 7. Definir la función -- arbolHuffman :: String -> Huffman -- tal que (arbolHuffman cs) es el árbol de Huffman correspondiente a la -- cadena cs. Por ejemplo, -- ghci> arbolHuffman "loro" -- Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r')) -- ---------------------------------------------------------------------------- arbolHuffman :: String -> Huffman arbolHuffman = construyeArbol . arbolesIniciales -- ---------------------------------------------------------------------------- -- Ejercicio 8. Definir la función -- codigoHuffman :: String -> TablaCodigo -- tal que (codigoHuffman c) es la tabla de códigos de Huffman -- correspondiente a la cadena c. Por ejemplo, -- codigoHuffman "loro" == [('o',"0"),('l',"10"),('r',"11")] -- ---------------------------------------------------------------------------- codigoHuffman :: String -> TablaCodigo codigoHuffman = extraeCodigos . arbolHuffman -- ---------------------------------------------------------------------------- -- Ejercicio 9. Definir la función -- comprime :: String -> String -- tal que (comprime cs) es la cadena obtenida comprimiendo la cadena cs -- con el procedimiento de Huffman. Por ejemplo, -- comprime "loro" == "100110" -- ---------------------------------------------------------------------------- comprime :: String -> String comprime cs = codifica (codigoHuffman cs) cs -- ---------------------------------------------------------------------------- -- Ejercicio 10. Definir la función -- descomprime :: Huffman -> String -> String -- tal que (descomprime a cs) es la cadena obtenida descomprimiendo la -- cadena cs mediante el árbol de Huffman a. Por ejemplo, -- ghci> descomprime (Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))) "100110" -- "loro" -- ---------------------------------------------------------------------------- descomprime :: Huffman -> String -> String descomprime a cs = if null cs then [] else descomprimeAux a cs where descomprimeAux (Hoja x) cs = x:(descomprime a cs) descomprimeAux (Rama i d) ('0':cs) = descomprimeAux i cs descomprimeAux (Rama i d) ('1':cs) = descomprimeAux d cs -- ---------------------------------------------------------------------------- -- Ejercicio 11. Comprobar con QuickCheck si para toda cadena cs se -- cumple que al descomprimir, con el árbol de Huffman de cs, la cadena -- comprimida correspondiente a cs se obtiene la cadena cs. En el caso -- de no verificarse, añadir la precondición más débil para que se -- verifique. -- ---------------------------------------------------------------------------- -- La propiedad general es prop_Huffman_1 :: String -> Bool prop_Huffman_1 cs = descomprime (arbolHuffman cs) (comprime cs) == cs -- La propiedad no se verifica -- ghci> quickCheck prop_Huffman_1 -- Falsifiable, after 3 tests: -- "R" -- La propiedad restringida es prop_Huffman_2 :: String -> Property prop_Huffman_2 cs = noUnitaria cs ==> descomprime (arbolHuffman cs) (comprime cs) == cs -- donde (noUnitaria cs) se verifica si la cadena cs tiene más de un -- carácter distinto. Por ejemplo, -- noUnitaria "ee" ==> False -- noUnitaria "em" ==> True noUnitaria :: String -> Bool noUnitaria cs = length (nub cs) > 1 -- La propiedad restringida sí se verifica: -- ghci> quickCheck prop_Huffman_2 -- OK, passed 100 tests. |