====== 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.
===== División en Palabras =====
Para hacer más fácil el uso de esta función tomamos de [[http://www.cs.kent.ac.uk/people/staff/sjt/craft2e/|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',' ']
==== Ejercicios ====
* 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//.
===== Lectura del Archivo =====
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 [[http://www.cs.chalmers.se/~rjmh/Teaching/Fysiker/EasyIO.hs|EasyIO.hs]] del curso //Introductory Functional Programming for Physics Students// 8-O) \\
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 [[http://www.gutenberg.org/browse/languages/es|Proyecto Gutemberg-Español]] donde hay muchos libros que ya no tienen derecho de copia. \\
Por ejemplo están [[http://www.gutenberg.org/files/13507/13507.txt|Cuentos de Amor de Locura y de Muerte]] de Horacio Quiroga y [[http://www.gutenberg.org/etext/14765|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 {{:introalg:14765-utf8.txt|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, ...
==== Ejercicios ====
* 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?
===== Cálculo de la Frecuencia =====
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.
==== Ejercicios ====
* 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.
===== Ordenando por frecuencias =====
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 [[introalg:problemas07|Problemario del taller]], se planteó la función //ordenaIns//, y en en la Wiki con las soluciones tiene el siguiente código [[introalg:problemas07#insertaord_ordenains|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 [Int]
ordenaIns (x:xs) = insertaOrd x (ordenaIns xs)
ordenaIns _ = []
==== Ejercicios ====
* 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//**.
===== Optimización del Cómputo =====
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
| ppalabra = (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 [[http://es.wikipedia.org/wiki/%C3%81rbol_binario_de_b%C3%BAsqueda|Á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
| ppalabra = 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:
^ algoritmo\palabras ^100 ^1000 ^10000 ^
| frecuencia' | 96K | 2.99M | 188M |
| frecuencia | 68K | 1.61M | 61M |
| frecuencia'' | 58K | 0.66M | 8.42M |
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.