Frecuencia de Palabras

Nos proponemos hacer un programa funcional que cuente la frecuencia de las ocurrencias de palabras en un texto. El tipo de la función es el siguiente:

frecuencia :: [Palabra] -> [(Palabra,Int)]

Donde Palabra es un sinónimo de tipo, en este caso de un String, y sirve para mejorar la legibilidad del código. Para crear este sinónimo, tenemos que escribir:

type Palabra = String

Y esperamos este tipo de comportamiento.

Main> frecuencia ["hola","que","hola"]
[("hola",2),("que",1)]

Esta función resulta de gran utilidad para análisis estadístico de textos, como el que se utiliza para comprimir archivos, dar importancia a las palabras en las búsquedas en colecciones de documentos (o internet), detectar palabras significativas en documentos, etc.

Para hacer más fácil el uso de esta función tomamos de Haskell The Craft of Functional Programming por Simon Thompson, la definción de una función que parte una cadena en palabras, para no tener que meter a mano palabra por palabra, con el formato de una lista de Strings, que sería bastante pesado.

Veamos el código de “arriba para abajo” top-down, empezando desde la definición principal y terminando en las funciones básicas.

-- Declaracion de tipos
type Palabra = String

partePalabras :: String -> [Palabra]
partePalabras st = partePalabras' (tiraEspacio st)

partePalabras' :: String -> [Palabra]
partePalabras' [] = []
partePalabras' st = (tomaPalabra st) : partePalabras' (tiraEspacio (tiraPalabra st))


tomaPalabra :: String -> String
tomaPalabra [] = []
tomaPalabra (x:xs)  | elemento x espacio = []
                    | otherwise          = x : tomaPalabra xs

tiraPalabra :: String -> String
tiraPalabra [] = []
tiraPalabra (x:xs)  | elemento x espacio = x:xs
                    | otherwise          = tiraPalabra xs

tiraEspacio :: String -> String
tiraEspacio [] = []
tiraEspacio (x:xs)  | elemento x espacio = tiraEspacio xs
                    | otherwise          = x:xs


elemento :: Eq a => a -> [a] -> Bool
-- Definirlo!

espacio :: [Char]
espacio = ['\r','\n','\t',' ']

• Definir la función politípica elemento :: Eq a ⇒ a → [a] → Bool, donde elemento a xs decide si a está en la lista xs. Ejemplo: elemento 'a' “Abracadabra” = True, elemento 10 [1..9] = False.

Casos de Test: elemento [] [ [1,2],[],[3,4] ], elemento “sandia” [“pera”,“melon”,“uva”].

• Habiendo definido elemento, probar las funciones tomarPalabra, tirarEspacio.

Casos de Test:

tiraEspacio "           Despues de tres dias" = "Despues de tres dias"
tomaPalabra "Despues de tres dias" = "Despues"
tiraPalabra "Despues de tres dias" = " de tres dias"
tiraEspacio " de tres dias" = "de tres dias"
tomaPalabra "de tres dias" = "de"
tiraPalabra "de tres dias" = " tres dias"
...

• Las funciones tiraEspacio, tiraPalabras y tomaPalabra pueden ser generalizadas.
  • Defina la función tomaMientras :: (a → Bool) → [a] → [a], donde tomaMientras p xs devuelve todos los elementos mientras cumplan con el predicado p, al primero que no cumpla se para. Ejemplo: tomaMientras (>0) [1,2,3,-1,3,2,1] = [1,2,3], tomaMientras (=='a') “nada por aqui” = [].
  • Defina la función tiraMientras :: (a → Bool) → [a] → [a], donde tiraMientras p xs descarta todos los elementos mientras cumplan con el predicado p, al primero que no cumpla se para. Ejemplo: tiraMientras (>0) [1,2,3,-1,3,2,1] = [-1,3,2,3], tiraMientras (=='a') “nada por aqui” = “nada por aqui”.
  • ¿Cómo se llaman tomaMientras y tiraMientras en el preámbulo estándar?
• Defina tomaPalabra, tomaEspacio, tiraPalabra, usando tomaMientras, tiraMientras.

Para probar ejemplos más largos podemos agregar una función que dado el nombre de un archivo, devuelve un String con ese archivo (tomado de EasyIO.hs del curso Introductory Functional Programming for Physics Students )
Este código debe estar al inicio del script.

-- extensión para poder leer archivos en Strings
import Hugs.IOExts(unsafePerformIO)

leeArchivo :: String -> String
leeArchivo nombre = unsafePerformIO $ readFile nombre

Para obtener textos largos e interesantes tenemos el Proyecto Gutemberg-Español donde hay muchos libros que ya no tienen derecho de copia.
Por ejemplo están Cuentos de Amor de Locura y de Muerte de Horacio Quiroga y El Gaucho Martín Fierro de José Hernandez.

Hay que tener cuidado con la codificación pues no todas funcionan.
Por ejemplo UTF8 es una codificación posible. Bajamos el archivo Martín Fierro en UTF8, lo guardamos con el nombre 14765-utf8.txt y lo usamos para probar partePalabras.

Main> take 100 (partePalabras (leeArchivo "14765-utf8.txt"))
["The","Project","Gutenberg","EBook","of","El","Gaucho","Mart\237n","Fierro, ...

o de una forma equivalente utilizando el operador . de composición de funciones, a fin de evitar un poco de paréntesis y mejorar la lectura del código.

((take 100).partePalabras.leeArchivo) "14765-utf8.txt"
["The","Project","Gutenberg","EBook","of","El","Gaucho","Mart\237n","Fierro, ...

• Contar cuántas palabras hay en “El Gaucho Martín Fierro”.
• Obtener las palabras de “El Gaucho Martín Fierro” que tienen más de 15 letras.
• Observar que hay problemas con partePalabras y los signos de puntuación. ¿Cómo mejoraría este aspecto de la función?

La función más importante tiene el siguiente tipo:

frecuencia :: [Palabra] -> [(Palabra,Int)]

donde el resultado es una lista de pares (Palabra,Int) que representa la cantidad de veces que una palabra está en el texto.

Para definir esta función utilizaremos la idea de acumulación. Básicamente si podemos definir una función:

agregaOcurrencia :: Palabra -> [(Palabra,Int)] -> [(Palabra,Int)]

que procesa una palabra, sumando 1 al entero cada vez que se encuentra una ocurrencia de la palabra. La definición de frecuencia es simplemente acumular toda la lista con esta función.

• Definir la función agregaOcurrencia :: Palabra → [(Palabra,Int)] → [(Palabra,Int)], donde agregaOcurrencia palabra xs toma la lista xs de pares (p,n) y actualiza la lista de frecuencias para incorporar una nueva ocurrencia de palabra. Ejemplos: agregaOcurrencia “hola” [] = [(“hola”,1)], agregaOcurrencia “hola” [(“hola”,1),(“que”,1)] = [(“hola”,2),(“que”,1)].

Casos de test: agregaOcurrencia “hola” [(“hola”,1)], agregaOcurrencia “que” [(“hola”,1)].

• A partir de agregaOcurrencia y foldr definir la función frecuencia :: [Palabra] → [(Palabra,Int)], donde frecuencia xs retorna la lista de frecuencias de cada una de las palabras de xs. Ejemplo: frecuencia [“hola”, “que”, “hola”] = [(“hola”,2),(“que”,1)].

Caso de test: frecuencia (partePalabras “Cantando me he de morir Cantando me han de enterrar”) = [(“enterrar”,1),(“de”,2),(“han”,1),(“me”,2),(“Cantando”,2),(“morir”,1),(“he”,1)]

• Componer frecuencia, take, partePalabras y leeArchivo para computar la frecuencia de las primeras 10, 100, 1000 y 10000 palabras de “El Gaucho Martín Fierro”. Cuidado, con 1000 y 10000 puede demorar un buen rato.

El esquema presentado hasta ahora (frecuencia.partePalabras.leeArchivo) resulta poco útil, debido a que resulta esencial, conocer cuales son, por ejemplo, las 10 palabras más frecuentes. Veamos la utilidad en distintos contextos:

• Compresión de texto: estas palabras se deben codificar “cortito”.
• Relevancia de palabras para búsquedas: a estas palabras no hay que darles peso.
• Detectar palabras significativas: simplemente son irrelevantes, se descartan.

La lista que devuelve frecuencia está ordenada según aparecen las palabras. Podríamos intentar ordenarlas de acuerdo a la frecuencia y luego tomar las 10 primeras para ver con que nos encontramos.

En el Problemario del taller, se planteó la función ordenaIns, y en en la Wiki con las soluciones tiene el siguiente código insertaOrd, ordenaIns, que al día de hoy es:

{-Lord Hobborg-}
insertaOrd :: Int -> [Int] -> [Int]
insertaOrd y (x:xs) | y>=x = x:insertaOrd y xs
                    | y<x  = y:(x:xs)
insertaOrd y _      = [y]

{-Lord Hobborg-}
ordenaIns :: [Int] -> [Int]
ordenaIns (x:xs) = insertaOrd x (ordenaIns xs)
ordenaIns _      = []

• Variando ligeramente insertaOrd, definir la función insertaOrdFrec :: (Palabra,Int) → [(Palabra,Int)] → [(Palabra,Int)], donde insertaOrdFrec (p,n) xs inserta la palabra y su frecuencia de manera ordenada en la frecuencia dentro de la lista xs que se supone ordenada de menor a mayor en frecuencia. Ejemplo: insertaOrdFrec (“algo”,10) [(“nada”,1),(“mucho”,100)] = [(“nada”,1),(“algo”,10),(“mucho”,100)].

Casos de test: insertaOrdFrec (“algo”,10) [], insertaOrdFrec (“algo”,10) [(“nada”,1)], insertaOrdFrec (“algo”,10) [(“mucho”,100)].

• Variando ligeramente ordenaIns y usando insertaOrdFrec, definir ordenaInsFrec :: [(Palabra,Int)] → [(Palabra,Int)], donde ordenaInsFrec.xs ordena la lista de frecuencias xs de menor a mayor. Ejemplo: ordenaInsFrec [(“mucho”,100),(“algo”,10),(“nada”,1)] = [(“nada”,1),(“algo”,10),(“mucho”,100)].
• Agregar ordenaInsFrec como un eslabón más a la cadena de funciones (frecuencia.(take 1000).partePalabras.leeArchivo) “14765-utf8.txt” para obtener en forma creciente la frecuencia de las primeras 1000 palabras de “El Gaucho Martín Fierro”.
• Redefinir ordenaInsFrec a partir de insertaOrdFrec y foldr.

El cálculo de la frecuencia resulta ineficiente. Por cada palabra tenemos que recorrer toda la lista de frecuencias [(Palabra,Int)] a fin de incluir la nueva ocurrencia. De hecho para las aproximadamente 15000 palabras que contiene “El Gaucho Martín Fierro”, este proceso toma su tiempo.

Una posible mejora sería mantener ordenada por palabras la lista de frecuencias, a fin de cortar la búsqueda apenas llegamos a una palabra mayor. El código es el siguiente:

-- Ordenada por palabras
agregaOcurrenciaOrd :: Palabra -> [(Palabra,Int)] -> [(Palabra,Int)]
agregaOcurrenciaOrd palabra [] = [(palabra,1)]
agregaOcurrenciaOrd palabra ((p,n):xs) | p==palabra = (p,n+1) : xs
				       | p<palabra  = (p,n)   : agregaOcurrenciaOrd palabra xs
				       | p>palabra  = (palabra,1) : (p,n) : xs

-- Optimizada?
frecuencia' :: [Palabra] -> [(Palabra,Int)]
frecuencia' xs = foldr agregaOcurrenciaOrd [] xs

Activamos la llave que muestra la cantidad de reducciones con:

Main> :set +s

Y comprobamos cual de las dos versiones resulta más rápida (menor cantidad de reducciones).

Main> (frecuencia.(take 100).partePalabras.leeArchivo) "14765-utf8.txt"
[("Palacio.",1),("Cecowski",1),("Mariano",1), ... ]
(77558 reductions, 131876 cells)
Main> (frecuencia'.(take 100).partePalabras.leeArchivo) "14765-utf8.txt"
[("#14765]",1),("***",2),("2005",1),("23,",1), ... ]
(105556 reductions, 232333 cells)

D'oh!

Al parecer la idea no es buena, y se pone peor a medida que aumentamos la cantidad de palabras que tomamos en el take.

Podemos intentar cambiar de manera salvaje la estructura de datos, es decir cambiar la lista de pares por otra estructura que mejore el tiempo de búsqueda de una palabra.

Una de las estructuras de datos más comunes que mejora de manera dramática el tiempo de búsqueda son los Árboles Binarios de Búsqueda o ABB.

Esta estructura de datos es ligeramente más complicada que la lista, cada nodo tiene:

• Dato
• Subárbol izquierdo
• Subárbol derecho

donde el dato que está en la raíz es mayor que todos los del subárbol izquierdo y menor que todos los del subárbol derecho.

Luego con esta forma de estructurar los datos, realizar una búsqueda es sencillo:

• si el dato que buscamos es menor que la raíz lo buscamos en el árbol izquierdo, descartando posiblemente la mitad de los datos!.
• en cambio si es mayor que la raíz, miramos el árbol derecho, también achicando a la mitad el problema.
• si el dato está en la raíz, listo.

Para definir estos árboles haremos uso de la definición de tipos de datos en Haskell data.

data ArbolFrec = Nodo (Palabra,Int) ArbolFrec ArbolFrec | Nulo

agregaOcurrenciaArbol :: Palabra -> ArbolFrec -> ArbolFrec
agregaOcurrenciaArbol palabra Nulo = Nodo (palabra,1) Nulo Nulo
agregaOcurrenciaArbol palabra (Nodo par@(p,n) izq der)
		| p==palabra = Nodo (p,n+1) izq der
		| p<palabra  = Nodo par (agregaOcurrenciaArbol palabra izq) der
		| p>palabra  = Nodo par izq (agregaOcurrenciaArbol palabra der)

frecuencia'' :: [Palabra] -> ArbolFrec
frecuencia'' xs = foldr agregaOcurrenciaArbol Nulo xs

Lo probamos para ver el resultado en las 100 primeras palabras y obtenemos:

Main> (frecuencia''.(take 100).partePalabras.leeArchivo) "14765-utf8.txt"
ERROR - Cannot find "show" function for:
*** Expression : (frecuencia'' . take 100 . partePalabras . leeArchivo) "14765-utf8.txt"
*** Of type    : ArbolFrec

El problema se soluciona desactivando una llave de Hugs

Main> :set -u
Main> (frecuencia''.(take 100).partePalabras.leeArchivo) "14765-utf8.txt"
ArbolFrec_Nodo ("Palacio.",1) (ArbolFrec_Nodo ("by",3) (ArbolFrec_Nodo ("formatted",1) (ArbolFrec_Nodo ("set",1) (ArbolFrec_Nodo ("www.gutenberg.net",1) ArbolFrec_Nulo (ArbolFrec_Nodo ("this",1) (ArbolFrec_Nodo ("with",2) ...

… y esto no se entiende nada! Entonces definimos una función que “aplana” el árbol en una lista, de forma tal que lo podamos leer y también ordenarlo.

aplanaArbol :: ArbolFrec -> [(Palabra,Int)]
aplanaArbol Nulo = []
aplanaArbol (Nodo par izq der) = par : (aplanaArbol izq ++ aplanaArbol der)

Ahora si veamos como se comporta la versión ABB del problema:

Main> (aplanaArbol.frecuencia''.(take 100).partePalabras.leeArchivo) "14765-utf8.txt"
[("Palacio.",1),("by",3),("formatted",1),("set",1),("www.gutenberg.net",1), ...
(58403 reductions, 104322 cells)

Woohoo!

La siguiente tabla resume las reducciones en de las 3 versiones y para 3 cantidades de palabras:

Notar que la mejora de frecuencia' ' es mucho más que lineal, para 100 palabras es 1.17 veces más rápido que el standard frecuencia, para 1000 es 2.43 veces más rápido y finalmente para 10000 palabras es 7.24 veces más rápido.