{"id":1507,"date":"2011-08-03T09:10:26","date_gmt":"2011-08-03T09:10:26","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=1507"},"modified":"2011-08-03T09:10:26","modified_gmt":"2011-08-03T09:10:26","slug":"codificacion-de-huffman-en-haskell","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/codificacion-de-huffman-en-haskell\/","title":{"rendered":"Codificaci\u00f3n de Huffman en Haskell"},"content":{"rendered":"<p>En esta relaci\u00f3n de ejercicios, para la asignatura de <a href=\"http:\/\/www.cs.us.es\/~jalonso\/cursos\/pd\">Programaci\u00f3n declarativa<\/a>, se estudia la <a href=\"http:\/\/en.wikipedia.org\/wiki\/Huffman_coding\">codificaci\u00f3n de Huffman<\/a>. El contenido de la relaci\u00f3n es el siguiente:<br \/>\n<!--more--><\/p>\n<pre lang=\"haskell\">\r\n-- ----------------------------------------------------------------------------\r\n-- Importaci\u00f3n de librer\u00edas auxiliares                                       --\r\n-- ----------------------------------------------------------------------------\r\n\r\nimport Test.QuickCheck\r\nimport Data.Char\r\nimport Data.List\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Introducci\u00f3n\r\n-- ----------------------------------------------------------------------------\r\n\r\n-- Este ejercicio est\u00e1 dedicado a la codificaci\u00f3n de Huffman, una forma\r\n-- de compresi\u00f3n de datos usado, entre otros, para comprimir im\u00e1genes\r\n-- JPEG. La codificaci\u00f3n de Huffman trabaja analizando la entrada que se\r\n-- tiene que comprimir y asignando a cada car\u00e1cter un c\u00f3digo (sucesi\u00f3n\r\n-- de bits), de forma que a los caracteres m\u00e1s frecuentes se le asignan\r\n-- c\u00f3digos m\u00e1s cortos. A continuaci\u00f3n, cada car\u00e1cter se sustituye por su\r\n-- c\u00f3digo. Por ejemplo, si el texto a comprimir es la palabra \"loro\", el\r\n-- c\u00f3digo asignado puede ser\r\n--    +-----+----+\r\n--    | 'l' | 10 |\r\n--    | 'r' | 11 |\r\n--    | 'o' |  0 |\r\n--    +-----+----+\r\n-- y el texto comprimido es \"100110\" (que usa 6 bits en lugar de los 32\r\n-- bits del texto inicial). \r\n--\r\n-- El c\u00f3digo se construye a partir de una estructura de datos (\u00e1rbol)\r\n-- como el de abajo, en el que aparecen todos los caracteres del texto\r\n-- de entrada\r\n--              \/\\\r\n--             \/  \\\r\n--            o   \/\\\r\n--               \/  \\\r\n--              l    r\r\n-- El c\u00f3digo de cada car\u00e1cter se obtiene a partir del camino desde la\r\n-- ra\u00edz del \u00e1rbol hasta el car\u00e1cter, poniendo un '0' cada vez que se\r\n-- toma la rama izquierda y un '1' cada vez que se toma la rama\r\n-- derecha. Por ejemplo, para llegar al car\u00e1cter 'l' primero se toma la\r\n-- rama derecha y despu\u00e9s la izquierda, luego el c\u00f3digo de 'l' es\r\n-- \"10\". Los caracteres m\u00e1s frecuentes se colocan m\u00e1s cerca de la ra\u00edz,\r\n-- con lo que sus c\u00f3digos son menores.\r\n-- \r\n-- Para construir el \u00e1rbol, primero se construye un \"\u00e1rbol trivial\" (que\r\n-- contiene s\u00f3lo un car\u00e1cter) para cada uno de los caracteres del texto\r\n-- de entrada y se le asigna como \"peso\" el n\u00famero de veces que ocurre\r\n-- el car\u00e1cter en el texto de entrada. En el ejemplo, \r\n--    * un \u00e1rbol con el car\u00e1cter 'l' y peso 1,\r\n--    * un \u00e1rbol con el car\u00e1cter 'r' y peso 1 y\r\n--    * un \u00e1rbol con el car\u00e1cter 'o' y peso 2.\r\n-- A continuaci\u00f3n, se combinan los dos \u00e1rboles con menor peso,\r\n-- obteniendo un nuevo \u00e1rbol cuyo peso es la suma de los pesos de los\r\n-- \u00e1rboles originales. En nuestro caso, se combinan los \u00e1rbolos que\r\n-- contienen los caracteres 'l' y 'r' obteniendo el \u00e1rbol\r\n--      \/\\\r\n--     \/  \\\r\n--    l    r\r\n-- con peso 2. El proceso se repite hasta que s\u00f3lo queda un \u00e1rbol. Los\r\n-- c\u00f3digos se extraen del \u00e1rbol final.\r\n-- \r\n-- Nosotros representaremos estos \u00e1rboles en Haskell usando el tipo Huffman     \r\n--    data Huffman = Hoja Char\r\n--                 | Rama Huffman Huffman\r\n--                 deriving (Eq,Ord,Show)\r\n-- Por ejemplo, el \u00e1rbol inicial correspondiente al car\u00e1cter 'l' se\r\n-- representa por\r\n--    Hoja 'l'\r\n-- y el \u00e1rbol final el ejemplo se representa por\r\n--    Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))\r\n-- \r\n-- N\u00f3tese que no se necesita almacenar los '0' y los '1': dado un \u00e1rbol\r\n-- (Rama i d) sabemos que todos los caracteres en la rama i tienen\r\n-- c\u00f3digos que empiezan por '0' y los de la rama d empiezan por '1'.\r\n-- \r\n-- Representaremos la s tablas de c\u00f3digos usando el tipo TablaCodigo\r\n-- definido por\r\n--    type TablaCodigo = [(Char,String)]\r\n-- donde cada car\u00e1cter se empareja con su c\u00f3digo, como una cadena de\r\n-- bits. En nuestro ejemplo, la tabla de c\u00f3digos es\r\n--    ejemploTablaCodigo = [('o',\"0\"),('l',\"10\"),('r',\"11\")]\r\n-- ----------------------------------------------------------------------------\r\n\r\ndata Huffman = Hoja Char\r\n             | Rama Huffman Huffman\r\n             deriving (Eq,Ord,Show)\r\n\r\ntype TablaCodigo = [(Char,String)]\r\n\r\nejemploTablaCodigo = [('o',\"0\"),('l',\"10\"),('r',\"11\")]\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 1. Definir la funci\u00f3n\r\n--    codigo :: TablaCodigo -> Char -> String\r\n-- tal que (codigo tc c) es el c\u00f3digo del car\u00e1cter c en la tabla de\r\n-- c\u00f3digos tc. Por ejemplo,\r\n--    codigo ejemploTablaCodigo 'r'  ==  \"11\"\r\n-- ----------------------------------------------------------------------------\r\n\r\ncodigo :: TablaCodigo -> Char -> String\r\ncodigo ((x,y):xys) c\r\n    | x == c    = y\r\n    | otherwise = codigo xys c\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 2. Definir la funci\u00f3n \r\n--    codifica :: TablaCodigo -> String -> String\r\n-- tal que (codifica tc cs) es la cadena obtenida sustituyendo todos los\r\n-- caracteres del texto de entrada cs por sus correspondientes c\u00f3digos en\r\n-- la tabla de c\u00f3digos tc. Por ejemplo,\r\n--    codifica ejemploTablaCodigo \"loro\"  ==  \"100110\"\r\n-- ----------------------------------------------------------------------------\r\n\r\ncodifica :: TablaCodigo -> String -> String\r\ncodifica tc cs = concat [codigo tc c | c <- cs]\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 3. Definir la funci\u00f3n \r\n--    extraeCodigos :: Huffman -> TablaCodigo\r\n-- tal que (extractCodes h) es la tabla de c\u00f3digos correspondiente al\r\n-- \u00e1rbol de Huffman h. Por ejemplo,\r\n--    ghci> extraeCodigos (Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r')))\r\n--    [('o',\"0\"),('d',\"10\"),('g',\"11\")]\r\n-- ---------------------------------------------------------------------------- \r\n\r\nextraeCodigos :: Huffman -> TablaCodigo\r\nextraeCodigos (Hoja c)   = [(c, \"\")]\r\nextraeCodigos (Rama i d) = [(c, '0':k) | (c,k) <- extraeCodigos i] ++\r\n                           [(c, '1':k) | (c,k) <- extraeCodigos d]  \r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 4. Definir la funci\u00f3n \r\n--    construyeArbol :: [(Int,Huffman)] -> Huffman\r\n-- tal que (construyeArbol xs) es el \u00e1rbol de Huffman construido a\r\n-- partir de la lista de xs cuyos elementos son pares cuyo segundos\r\n-- elementos son \u00e1rboles de Huffman y sus primeros elementos son sus\r\n-- correspondientes pesos. Por ejemplo,\r\n--    ghci> construyeArbol [(1,Hoja 'l'), (1,Hoja 'r'), (2,Hoja 'o')]\r\n--    Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))\r\n-- Nota: (sort xs) es la lista obtenida ordenando los elementos de xs.\r\n-- ----------------------------------------------------------------------------\r\n\r\nconstruyeArbol :: [(Int,Huffman)] -> Huffman\r\nconstruyeArbol = construye . sort\r\n\r\nconstruye :: [(Int,Huffman)] -> Huffman\r\nconstruye ((p1,h1):(p2,h2):phs) = construye (insert (p1+p2,Rama h1 h2) phs)\r\nconstruye [(p,h)]               = h\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 5. Definir la funci\u00f3n\r\n--    ocurrencias :: Char -> String -> Int\r\n-- tal que (ocurrencias x c) es el n\u00famero de veces que el car\u00e1cter x\r\n-- ocurre en la cadena c. Por ejemplo,\r\n--    ocurrencias 'o' \"loro\"  ==  2\r\n-- ----------------------------------------------------------------------------\r\n\r\nocurrencias :: Char -> String -> Int\r\nocurrencias x cs = length [y | y <- cs, x==y]\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 6. Definir la funci\u00f3n\r\n--    arbolesIniciales :: String -> [(Int, Huffman)]\r\n-- tal que (arbolesIniciales cs) es la lista de los \u00e1rboles iniciales de\r\n-- Huffman, con sus pesos, correspondientes a la cadena cs. Por ejemplo,\r\n--    ghci> arbolesIniciales \"loro\"\r\n--    [(1,Hoja 'l'),(2,Hoja 'o'),(1,Hoja 'r')]\r\n-- Nota: (nub xs) es la lista obtnida elimando las repeticiones en xs.\r\n-- ----------------------------------------------------------------------------\r\n\r\narbolesIniciales :: String -> [(Int, Huffman)]\r\narbolesIniciales cs = [(ocurrencias x cs, Hoja x) | x <- nub cs]\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 7. Definir la funci\u00f3n\r\n--    arbolHuffman :: String -> Huffman\r\n-- tal que (arbolHuffman cs) es el \u00e1rbol de Huffman correspondiente a la\r\n-- cadena cs. Por ejemplo,\r\n--    ghci> arbolHuffman \"loro\"\r\n--    Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))\r\n-- ----------------------------------------------------------------------------\r\n\r\narbolHuffman :: String -> Huffman\r\narbolHuffman = construyeArbol . arbolesIniciales\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 8. Definir la funci\u00f3n\r\n--    codigoHuffman :: String -> TablaCodigo\r\n-- tal que (codigoHuffman c) es la tabla de c\u00f3digos de Huffman\r\n-- correspondiente a la cadena c. Por ejemplo,\r\n--    codigoHuffman \"loro\"  ==  [('o',\"0\"),('l',\"10\"),('r',\"11\")]\r\n-- ----------------------------------------------------------------------------\r\n\r\ncodigoHuffman :: String -> TablaCodigo\r\ncodigoHuffman = extraeCodigos . arbolHuffman\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 9. Definir la funci\u00f3n\r\n--    comprime :: String -> String\r\n-- tal que (comprime cs) es la cadena obtenida comprimiendo la cadena cs\r\n-- con el procedimiento de Huffman. Por ejemplo,\r\n--    comprime \"loro\"  ==  \"100110\"\r\n-- ----------------------------------------------------------------------------\r\n\r\ncomprime :: String -> String\r\ncomprime cs = codifica (codigoHuffman cs) cs\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 10. Definir la funci\u00f3n\r\n--    descomprime :: Huffman -> String -> String\r\n-- tal que (descomprime a cs) es la cadena obtenida descomprimiendo la\r\n-- cadena cs mediante el \u00e1rbol de Huffman a. Por ejemplo,\r\n--    ghci> descomprime (Rama (Hoja 'o') (Rama (Hoja 'l') (Hoja 'r'))) \"100110\"\r\n--    \"loro\"\r\n-- ----------------------------------------------------------------------------\r\n\r\ndescomprime :: Huffman -> String -> String\r\ndescomprime a cs =\r\n    if null cs then [] else descomprimeAux a cs\r\n    where descomprimeAux (Hoja x) cs         = x:(descomprime a cs)\r\n          descomprimeAux (Rama i d) ('0':cs) = descomprimeAux i cs\r\n          descomprimeAux (Rama i d) ('1':cs) = descomprimeAux d cs\r\n\r\n-- ----------------------------------------------------------------------------\r\n-- Ejercicio 11. Comprobar con QuickCheck si para toda cadena cs se\r\n-- cumple que al descomprimir, con el \u00e1rbol de Huffman de cs, la cadena\r\n-- comprimida correspondiente a cs se obtiene la cadena cs. En el caso\r\n-- de no verificarse, a\u00f1adir la precondici\u00f3n m\u00e1s d\u00e9bil para que se\r\n-- verifique.\r\n-- ----------------------------------------------------------------------------\r\n\r\n-- La propiedad general es \r\nprop_Huffman_1 :: String -> Bool\r\nprop_Huffman_1 cs =\r\n    descomprime (arbolHuffman cs) (comprime cs) == cs\r\n\r\n-- La propiedad no se verifica\r\n--    ghci> quickCheck prop_Huffman_1\r\n--    Falsifiable, after 3 tests:\r\n--    \"R\"\r\n\r\n-- La propiedad restringida es\r\nprop_Huffman_2 :: String -> Property\r\nprop_Huffman_2 cs =\r\n    noUnitaria cs ==>\r\n    descomprime (arbolHuffman cs) (comprime cs) == cs\r\n\r\n-- donde (noUnitaria cs) se verifica si la cadena cs tiene m\u00e1s de un\r\n-- car\u00e1cter distinto. Por ejemplo,\r\n--    noUnitaria \"ee\"  ==>  False\r\n--    noUnitaria \"em\"  ==>  True\r\nnoUnitaria :: String -> Bool\r\nnoUnitaria cs = length (nub cs) > 1\r\n\r\n-- La propiedad restringida s\u00ed se verifica:\r\n--    ghci> quickCheck prop_Huffman_2\r\n--    OK, passed 100 tests.\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>En esta relaci\u00f3n de ejercicios, para la asignatura de Programaci\u00f3n declarativa, se estudia la codificaci\u00f3n de Huffman. El contenido de la relaci\u00f3n es el siguiente:<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"jetpack_post_was_ever_published":false,"_kad_post_transparent":"","_kad_post_title":"","_kad_post_layout":"","_kad_post_sidebar_id":"","_kad_post_content_style":"","_kad_post_vertical_padding":"","_kad_post_feature":"","_kad_post_feature_position":"","_kad_post_header":false,"_kad_post_footer":false,"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"footnotes":"","_jetpack_memberships_contains_paid_content":false},"categories":[5],"tags":[270,126],"jetpack_featured_media_url":"","jetpack_sharing_enabled":true,"jetpack_likes_enabled":false,"_links":{"self":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/1507"}],"collection":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/comments?post=1507"}],"version-history":[{"count":2,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/1507\/revisions"}],"predecessor-version":[{"id":1509,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/1507\/revisions\/1509"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=1507"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=1507"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=1507"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}