La prueba está estructurada en 7 ejercicios teórico-prácticos que piden que se desarrolle la fase de preparación y estimación de un modelo utilizando un juego de datos.
Deben responderse al menos 6 de los 7 ejercicios para poder superar la PEC. Para optar a la máxima nota tienen que responderse los 7 ejercicios.
Ejercicios teóricos
Todos los ejercicios deben ser presentados de forma razonada y clara. No se aceptará ninguna respuesta que no esté claramente justificada.
Ejercicios prácticos
Para todas las PEC es necesario documentar en cada ejercicio práctico qué se ha hecho y cómo se ha hecho.
| Pregunta | Criterio de valoración | Peso |
|---|---|---|
| 1 | Respuesta a la pregunta de forma correcta | 10% |
| 2 | Primera visualización | 5% |
| 2 | Segunda visualización | 5% |
| 3 | Se realiza el gráfico solicitado | 5% |
| 3 | Se contestan las cuestiones y se justifican | 10% |
| 4 | Se describen los valores que se solicitan | 10% |
| 4 | Se evalua la capacidad predictiva que se pide | 5% |
| 4 | Se interpretan los resultados | 5% |
| 5 | Se entrenan los modelos solicitados | 10% |
| 5 | Se valoran los resultados obtenidos | 10% |
| 6 | Se entrena el modelo solicitado | 15% |
| 6 | Se contesta a la cuestión planteada | 10% |
El formato de entrega es: studentname-PECn.html
Fecha de Entrega: 22/11/2020
Se debe entregar la PEC en el buzón de entregas del aula
Esta práctica se basa en una de las aplicaciones de la Minería de Textos, que consiste en clasificar documentos en función de su temática. Esto es lo que se conoce como Topic Model. Para realizar la clasificación utilizaremos el algoritmo de aprendizaje automático K-Nearest Neighbors (K-NN).
Por Topic Model entendemos procesos de aprendizaje automático que tienen por objetivo descubrir el tema subyacente en una colección de documentos. Generalizando un poco más, Topic Model busca patrones en el contenido de los documentos y lo hace en base a la frecuencia de aparición de palabras.
El análisis que realizamos se basa en el hecho de que en documentos pertenecientes a un mismo tema aparecerán palabras que se repetirán con mayor frecuencia. Por lo tanto, el análisis plantea la clasificación de documentos utilizando como criterio las palabras que son más frecuentes en cada temática. Estas frecuencias se almacenarán en una matriz de datos, donde las variables serán las palabras y los registros los documentos, que será la base para que puedan trabajar los algoritmos de aprendizaje automático, que en esta práctica se centran en el K-NN.
En este ámbito de conocimiento se basan los sistemas de clasificación documental, búsqueda de contenidos y sistemas de recomendación entre otros.
Las competencias que se trabajan en esta práctica son:
Para realizar esta práctica recomendamos la lectura de lo siguiente:
Apartados 1.2.1, 1.2.2, 2.1, 3.2.1 y 3.2.2 del material didático Análisis de datos para organizaciones.
Los siguientes Recursos en la web:
– Journal Digital: Topic Modeling
– Wikipedia: Topic Modeling
– Wikipedia: Sistemas de recomendación
– CRAN: Text Mining Package
A menudo es inevitable, al producir una obra multimedia, hacer uso de recursos creados por terceras personas. Es por lo tanto comprensible hacerlo en el marco de una práctica de los estudios de Informática, Multimedia y Telecomunicación de la UOC, siempre y cuando esto se documente claramente y no suponga plagio en la práctica.
Por lo tanto, al presentar una práctica que haga uso de recursos ajenos, se debe presentar junto con ella un documento en el que se detallan todos ellos, especificando el nombre de cada recurso, su autor, el lugar dónde se obtuvo y su estatus legal: si la obra está protegida por el copyright o se acoge a alguna otra licencia de uso (Creative Commons, licencia GNU, GPL …). El estudiante deberá asegurarse de que la licencia no impide específicamente su uso en el marco de la práctica. En caso de no encontrar la información correspondiente tendrá que asumir que la obra está protegida por copyright.
Deberéis, además, adjuntar los ficheros originales cuando las obras utilizadas sean digitales, y su código fuente si corresponde.
El objetivo es clasificar un conjunto de artículos de Reuters correspondientes a distintas temáticas: acquire, crude, earn, grain, interest, money-fx, ship y trade. Se trata de temáticas relacionadas con inversiones financieras y fondos de inversión.
Se utiliza un sistema de clasificación de documentos que se basa en el algoritmo de aprendizaje automático K-NN (K-Nearest Neighbors o K vecinos más próximos).
Los datos están en el fichero data_reuter.txt. Este fichero contiene dos campos, el primero se corresponde con el tipo de temática (en total hay 8) y el segundo campo contiene el artículo relacionado. Entre las 8 temáticas se seleccionan 2 para realizar el análisis.
Para mostrar el funcionamiento del algoritmo de clasificación se utiliza un 70% de los artículos para entrenar el modelo de aprendizaje. Dicho algoritmo se aplica sobre el 30% de artículos restantes con el objetivo de predecir su temática.
El código R que utilizaremos en la práctica se divide en apartados según las tareas que iremos realizando:
Instalamos los packages de R que necesitaremos para realizar la práctica:
Definimos el directorio de trabajo donde tendremos guardado el fichero de datos.
Para instalar los paquetes y definir el directorio de trabajo podéis eliminar los asteriscos delante de los install.packages() y setwd() seleccionarlos y ejecutarlos como comandos de R (Control+Intro).
## Cargamos los paquetes necesarios para ejecutar las funciones que se describen a continuación:
# Para la función Corpus()
library(tm)
# Para la función rbind.fill
library(plyr)
# Para la función knn()
library(class)
# En R una variable tipo factor es una variable categórica que puede contener tanto números como carácteres. Se trata de un tipo de variable muy útil para realizar tareas de modelización estadística.
# En R, por defecto, las columnas con carácteres no numéricos son tratadas como factores. Para evitarlo y garantizar que estas columnas sigan siendo consideradas carácteres, fijaremos el siguiente parámetro
options(stringsAsFactors = FALSE)
# Leemos los datos
data <- read.table('data_reuter.txt', header=FALSE, sep='\t')
# Describimos los datos
## Cuantos hay en total
nrow(data)## [1] 5485# Cuantos hay para cada tipo de temática
table(data$V1)##
## acq crude earn grain interest money-fx ship trade
## 1596 253 2840 41 190 206 108 251library(ggplot2)
qplot(data$V1,xlab="Tematica", main = "Frecuencias")+ coord_flip()
# Finalmente seleccionamos dos temáticas: acq y earn
data2<-data[which(data$V1 %in% c("acq","earn")),]
## Cuantos hay en total
nrow(data2)## [1] 4436A continuación creamos un corpus para cada temática sobre los que se realizarán las siguietes tareas de acondicionado de texto:
# Creación del corpus de la temática acq
## Seleccionamos la temática
data_acq<-data2[(data2$V1=="acq"),]
## Construimos el corpus
source <- VectorSource(data_acq$V2)
corpus1 <- Corpus(source)
## Acondicionamos el corpus
### Convertir todo el texto a minúsculas
corpus1 <- tm_map(corpus1, content_transformer(tolower))
### Elimina números
corpus1 <- tm_map(corpus1, removeNumbers)
### Eliminar signos de puntuación
corpus1 <- tm_map(corpus1, removePunctuation)
###Eliminar espacios en blanco innecesarios
corpus1 <- tm_map(corpus1, stripWhitespace)
### Eliminar palabras sin significado propio
v_stopwords <- c(stopwords("english"),c("dont","didnt","arent","cant","one","also","said"))
corpus1 <- tm_map(corpus1, removeWords, v_stopwords)
### Eliminar signos de puntuación
corpus1 <- tm_map(corpus1, removePunctuation)
### Substituir las palabras derivadas por su palabra raíz
corpus1 <- tm_map(corpus1, stemDocument, language="english")
# Creación del corpus de la temática earn
## Seleccionamos la temática
data_earn<-data2[(data2$V1=="earn"),]
## Construimos el corpus
source <- VectorSource(data_earn$V2)
corpus2 <- Corpus(source)
## Acondicionamos el corpus
corpus2 <- tm_map(corpus2, content_transformer(tolower))
corpus2 <- tm_map(corpus2, removeNumbers)
corpus2 <- tm_map(corpus2, removePunctuation)
corpus2 <- tm_map(corpus2, stripWhitespace)
v_stopwords <- c(stopwords("english"),c("dont","didnt","arent","cant","one","also","said"))
corpus2 <- tm_map(corpus2, removeWords, v_stopwords)
corpus2 <- tm_map(corpus2, removePunctuation)
corpus2 <- tm_map(corpus2, stemDocument, language="english")A continuación construimos una matriz de términos para cada temática para posteriormete unirlas en una misma lista.
# Construimos la matrix de documentos de la temática acq
mat_acq <- TermDocumentMatrix(corpus1)
## Controlamos la dispersión (Sparsity): Número de celdas igual a cero respecto al total.
mat_acq<- removeSparseTerms(mat_acq, 0.85)
inspect(mat_acq)## <<TermDocumentMatrix (terms: 42, documents: 1596)>>
## Non-/sparse entries: 17687/49345
## Sparsity : 74%
## Maximal term length: 10
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1060 1347 181 28 296 49 557 68 77 797
## compani 7 9 1 7 5 6 5 7 5 12
## corp 1 6 3 1 2 0 3 1 1 6
## dlrs 9 10 4 11 7 17 19 15 4 4
## inc 3 2 3 3 2 5 1 4 3 2
## mln 4 6 1 5 7 7 19 4 0 5
## offer 8 7 16 5 0 11 1 7 11 0
## pct 2 1 5 2 2 2 2 6 3 3
## reuter 1 1 1 1 1 1 2 1 2 2
## share 14 12 6 6 7 7 5 11 4 1
## will 1 4 1 9 1 0 2 0 2 3mat_acq<-list(name="acq",mat=mat_acq)
mat_acq## $name
## [1] "acq"
##
## $mat
## <<TermDocumentMatrix (terms: 42, documents: 1596)>>
## Non-/sparse entries: 17687/49345
## Sparsity : 74%
## Maximal term length: 10
## Weighting : term frequency (tf)str(mat_acq)## List of 2
## $ name: chr "acq"
## $ mat :List of 6
## ..$ i : int [1:17687] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ j : int [1:17687] 1 1 1 1 1 1 1 1 1 1 ...
## ..$ v : num [1:17687] 1 1 3 4 2 4 1 2 1 2 ...
## ..$ nrow : int 42
## ..$ ncol : int 1596
## ..$ dimnames:List of 2
## .. ..$ Terms: chr [1:42] "acquir" "buy" "common" "compani" ...
## .. ..$ Docs : chr [1:1596] "1" "2" "3" "4" ...
## ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"# Construimos la matrix de documentos de la temática earn
mat_earn <- TermDocumentMatrix(corpus2)
mat_earn<- removeSparseTerms(mat_earn, 0.85)
inspect(mat_earn)## <<TermDocumentMatrix (terms: 29, documents: 2840)>>
## Non-/sparse entries: 27960/54400
## Sparsity : 66%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1076 1537 176 1987 209 316 459 465 523 703
## cts 4 5 0 4 11 3 5 14 0 12
## dlrs 17 19 11 13 12 19 17 32 47 12
## loss 6 6 4 8 8 2 7 5 8 8
## mln 9 20 24 16 10 18 13 11 45 4
## net 9 3 7 6 5 2 5 9 2 3
## profit 8 6 1 5 5 4 1 0 6 4
## reuter 1 1 1 1 1 1 1 1 1 1
## share 1 6 3 7 9 2 1 7 2 10
## shr 2 2 0 2 2 0 0 3 0 2
## year 2 6 7 6 3 4 10 10 13 4mat_earn<-list(name="earn",mat=mat_earn)
mat_earn## $name
## [1] "earn"
##
## $mat
## <<TermDocumentMatrix (terms: 29, documents: 2840)>>
## Non-/sparse entries: 27960/54400
## Sparsity : 66%
## Maximal term length: 8
## Weighting : term frequency (tf)str(mat_earn)## List of 2
## $ name: chr "earn"
## $ mat :List of 6
## ..$ i : int [1:27960] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ j : int [1:27960] 1 1 1 1 1 1 1 1 2 2 ...
## ..$ v : num [1:27960] 2 1 1 2 1 1 2 1 2 2 ...
## ..$ nrow : int 29
## ..$ ncol : int 2840
## ..$ dimnames:List of 2
## .. ..$ Terms: chr [1:29] "april" "compani" "inc" "mln" ...
## .. ..$ Docs : chr [1:2840] "1" "2" "3" "4" ...
## ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"# Juntamos ambas matrices de términos en una misma lista
mat<-list(mat_acq, mat_earn)
str(mat)## List of 2
## $ :List of 2
## ..$ name: chr "acq"
## ..$ mat :List of 6
## .. ..$ i : int [1:17687] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ j : int [1:17687] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..$ v : num [1:17687] 1 1 3 4 2 4 1 2 1 2 ...
## .. ..$ nrow : int 42
## .. ..$ ncol : int 1596
## .. ..$ dimnames:List of 2
## .. .. ..$ Terms: chr [1:42] "acquir" "buy" "common" "compani" ...
## .. .. ..$ Docs : chr [1:1596] "1" "2" "3" "4" ...
## .. ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## .. ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"
## $ :List of 2
## ..$ name: chr "earn"
## ..$ mat :List of 6
## .. ..$ i : int [1:27960] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ j : int [1:27960] 1 1 1 1 1 1 1 1 2 2 ...
## .. ..$ v : num [1:27960] 2 1 1 2 1 1 2 1 2 2 ...
## .. ..$ nrow : int 29
## .. ..$ ncol : int 2840
## .. ..$ dimnames:List of 2
## .. .. ..$ Terms: chr [1:29] "april" "compani" "inc" "mln" ...
## .. .. ..$ Docs : chr [1:2840] "1" "2" "3" "4" ...
## .. ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## .. ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"Con las dos matrices de frecuencias mat[[1]]$mat para acq y mat[[2]]$mat para earn, podemos realizar algunas visualizaciones básicas.
# Frecuencia de los 25 primeros términos en los 10 primeros documentos para ambos temas
inspect(mat[[1]]$mat[1:25,1:10])## <<TermDocumentMatrix (terms: 25, documents: 10)>>
## Non-/sparse entries: 103/147
## Sparsity : 59%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 10 2 3 4 5 6 7 8 9
## common 3 0 0 0 2 0 2 0 0 1
## compani 4 1 9 1 0 5 1 0 1 0
## corp 0 0 1 0 2 0 1 2 0 2
## dlrs 4 1 4 0 1 2 1 0 1 1
## inc 2 2 3 3 0 1 0 0 1 0
## mln 1 1 3 0 1 3 1 0 1 0
## pct 2 1 0 0 2 2 3 0 0 2
## reuter 1 1 1 1 1 1 1 1 1 1
## share 5 1 6 0 4 0 3 2 0 3
## stock 3 1 1 0 1 8 2 1 0 0inspect(mat[[2]]$mat[1:25,1:10])## <<TermDocumentMatrix (terms: 25, documents: 10)>>
## Non-/sparse entries: 120/130
## Sparsity : 52%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 10 2 3 4 5 6 7 8 9
## cts 0 6 2 7 1 4 3 6 3 2
## dlrs 0 0 2 0 2 3 6 0 3 0
## mln 2 4 6 8 7 0 4 1 4 0
## net 0 2 2 1 3 0 0 2 3 0
## profit 0 4 0 7 0 0 2 6 0 0
## reuter 1 1 1 1 1 1 1 1 1 1
## rev 0 2 0 2 2 0 0 2 2 0
## share 2 0 0 0 0 4 6 0 0 0
## shr 0 2 2 4 2 0 0 2 3 0
## year 0 1 2 0 0 6 1 0 2 0# Frecuencia de los 30 primeros términos en todos los documentos del tema acq
inspect(mat[[1]]$mat[1:30,])## <<TermDocumentMatrix (terms: 30, documents: 1596)>>
## Non-/sparse entries: 14082/33798
## Sparsity : 71%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1060 1347 1477 181 28 296 49 557 68 77
## compani 7 9 3 1 7 5 6 5 7 5
## corp 1 6 2 3 1 2 0 3 1 1
## dlrs 9 10 0 4 11 7 17 19 15 4
## inc 3 2 0 3 3 2 5 1 4 3
## mln 4 6 15 1 5 7 7 19 4 0
## offer 8 7 2 16 5 0 11 1 7 11
## pct 2 1 1 5 2 2 2 2 6 3
## reuter 1 1 2 1 1 1 1 2 1 2
## share 14 12 18 6 6 7 7 5 11 4
## will 1 4 0 1 9 1 0 2 0 2# Frecuencia de los términos en los documentos del tema earn
inspect(mat[[2]]$mat)## <<TermDocumentMatrix (terms: 29, documents: 2840)>>
## Non-/sparse entries: 27960/54400
## Sparsity : 66%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1076 1537 176 1987 209 316 459 465 523 703
## cts 4 5 0 4 11 3 5 14 0 12
## dlrs 17 19 11 13 12 19 17 32 47 12
## loss 6 6 4 8 8 2 7 5 8 8
## mln 9 20 24 16 10 18 13 11 45 4
## net 9 3 7 6 5 2 5 9 2 3
## profit 8 6 1 5 5 4 1 0 6 4
## reuter 1 1 1 1 1 1 1 1 1 1
## share 1 6 3 7 9 2 1 7 2 10
## shr 2 2 0 2 2 0 0 3 0 2
## year 2 6 7 6 3 4 10 10 13 4# Inventario de los primeros términos del del tema earn
head(mat[[2]]$mat$dimnames$Terms)## [1] "april" "compani" "inc" "mln" "record" "reuter"# Número de documentos del tema acq
nDocs(mat[[1]]$mat)## [1] 1596# Número de términos del tema acq
nTerms(mat[[1]]$mat)## [1] 42# Visualizamos los términos con más de 100 apariciones en documentos de temática acq
findFreqTerms(mat[[1]]$mat, lowfreq=100)## [1] "acquir" "buy" "common" "compani" "complet"
## [6] "dlrs" "hold" "inc" "mln" "pct"
## [11] "plan" "price" "purchas" "reuter" "sale"
## [16] "share" "stock" "year" "board" "cash"
## [21] "corp" "offer" "will" "group" "industri"
## [26] "exchang" "invest" "new" "secur" "stake"
## [31] "acquisit" "sell" "term" "ltd" "own"
## [36] "approv" "merger" "sharehold" "subsidiari" "unit"
## [41] "agreement" "agre"# Para acq
mmat_acq <- as.matrix(mat[[1]]$mat)
# Agregamos las frecuencias por términos y las ordenamos de mayor a menor
v_acq <- sort(rowSums(mmat_acq), decreasing=TRUE)
# Creamos un data.frame con términos y frecuencias
d_acq <- data.frame(word=names(v_acq), freq=v_acq)
d_acq[,3]<-"acq"
# Hacemos lo mismo para earn
mmat_earn <- as.matrix(mat[[2]]$mat)
# Agregamos las frecuencias por términos y las ordenamos de mayor a menor
v_earn <- sort(rowSums(mmat_earn), decreasing=TRUE)
# Creamos un data.frame con términos y frecuencias
d_earn <- data.frame(word=names(v_earn), freq=v_earn)
d_earn[,3]<-"earn"
# Concatenamos las dos matrices
fdata<-rbind(d_acq,d_earn)
colnames(fdata)## [1] "word" "freq" "V3"colnames(fdata)<-c("Palabra", "Frecuencia", "Tematica")
# Gráfico de barras con las palabras más frecuentes
library(ggplot2)
ggplot(subset(fdata, Frecuencia>500),aes(Palabra,Frecuencia,fill=Tematica))+geom_bar(stat="identity",position=position_dodge())+theme(axis.text.x=element_text(angle=45, hjust=1))
Podemos construir una nube de palabras para la matriz de términos con ambas temáticas.
# Cargamos la librería wordcloud
require(wordcloud)
# Construimos la nube de palabras o términos, para ello primero seleccionamos los que tienen una frecuencia superior a 500
sfdata<-subset(fdata, Frecuencia>500)
wordcloud(sfdata$Palabra, fdata$Frecuencia,min.freq=500,random.color=FALSE, colors=rainbow(3))
A continuación se construirá un data.frame en el que las columnas representan Términos, las filas Documentos y las celdas Frecuencias del término o palabra en cada documento.
# Creación de un data.frame apto para K-NN
# Para acq
s.mat_acq <- t(data.matrix(mat[[1]]$mat))
# La convertimos en data.frame que vendría a ser como un formato excel (filas, columnas y celdas con valores)
# En este data.frame, tenemos que cada fila es un documento, cada columna una palabra y las celdas contienen la frecuencia en que cada palabra aparece en cada documento.
s.df_acq <- as.data.frame(s.mat_acq, stringsAsFactors = FALSE)
nrow(s.df_acq)## [1] 1596# En la última columna colocaremos el Tema de cada documento tdm[["name"]. Para ello usaremos dos funciones cbind() y rep()
# Recordemos que en la lista TDM habíamos almacenado el tema en el valor "name"
# Mediante la función rep() repetiremos el tema del documento tantas veces como filas hay en el data.frame
Tema <- rep(mat[[1]]$name, nrow(s.df_acq))
s.df_acq<-cbind(s.df_acq,Tema)
# Para earn
s.mat_earn <- t(data.matrix(mat[[2]]$mat))
# La convertimos en data.frame que vendría a ser como un formato excel (filas, columnas y celdas con valores)
# En este data.frame , tenemos que cada fila es un documento, cada columna una palabra y las celdas contienen la frecuencia en que cada palabra aparece en cada documento.
s.df_earn <- as.data.frame(s.mat_earn, stringsAsFactors = FALSE)
# En la última columna colocaremos el Tema de cada documento tdm[["name"]. Para ello usaremos dos funciones cbind() y rep()
# Recordemos que en la lista TDM habíamos almacenado el tema en el valor "name"
# Mediante la función rep() repetiremos el tema del documento tantas veces como filas hay en el data.frame
Tema <- rep(mat[[2]]$name, nrow(s.df_earn))
s.df_earn<-cbind(s.df_earn,Tema)
# Utilizamos la función rbind.fill() para concatenar las filas de dos data frame con distinta dimensión y pone NA en las casillas donde no hay información.
pila <-rbind.fill(s.df_acq, s.df_earn)
pila[is.na(pila)] <- 0
# Cada fila representa un documento, cada columna una palabra y las celdas son la frecuencia de aparición de esa palabra en ese documento.
## Tenemos 4436 documentos
nrow(pila)## [1] 4436## Tenemos 48 palabras
ncol(pila)## [1] 63Construimos un juego de datos de entrenamiento con el 70% de los documentos, es decir, 3106 documentos.
Así mismo construiremos un juego de datos de pruebas con el 30% de documentos restante, es decir 1330 documentos.
# Fijamos una semilla para poder repetir la práctica obteniendo los mismos resultados.
set.seed(111)
# 70% de los documentos para entrenamiento
entrena.idx <- sample(nrow(pila), ceiling(nrow(pila) * 0.7))
# El resto de documentos para pruebas
test.idx <- (1:nrow(pila))[-entrena.idx]Para poder aplicar el algoritmo de aprendizaje por vecindad K-NN necesitamos realizar unas pequeñas adaptaciones.
Éstas consisten en separar por un lado los temas y por otro la matriz de frecuencias.
# guardamos por un lado los temas
tema <- pila[, "Tema"]
# y por otro lado el resto de palabras
pila.nl <- pila[, !colnames(pila) %in% "Tema"]Aplicamos el modelo K-NN, pasándole como parámetros la matriz de frecuencias de los documentos de entrenamiento, la matriz de frecuencias de los documentos de pruebas y los temas de los documentos de entrenamiento.
Los temas de los documentos de prueba no se los pasamos, porque precisamente es lo que el algoritmo debe predecir.
Recordamos que el objetivo del modelo será el de predecir el tema de los documentos de pruebas.
# Modelo KNN
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx])Una vez aplicado el modelo K-NN sobre el juego de documentos de prueba, podemos utilizar una matriz de confusión para valorar el nivel de acierto del modelo.
# Modelo KNN
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx])
# Matriz de confusión
# Las filas son predicciones y las columnas son observaciones reales
conf.mat <- table("Predicción" = knn.pred,"Real" = tema[test.idx])
conf.mat## Real
## Predicción acq earn
## acq 460 10
## earn 30 830Observamos como K-NN, de los 1330 documentos, ha clasificado correctamente 1292:
y ha fallado en 40 documentos, puesto que los ha clasificado 10 como acq cuando en realidad eran earn y 30 como earn que en reladad eran acq.
Para evaluar la capacidad predictiva del algoritmo utilizamos dos medidas, que hemos denominado ratio1 y rati2.
ratio1 <- (conf.mat[1,1]/(conf.mat[1,1]+conf.mat[1,2]))*100
ratio1## [1] 97.87234ratio2 <- (conf.mat[2,2]/(conf.mat[1,2]+conf.mat[2,2]))*100
ratio2## [1] 98.80952En el apartado “Generación de la Matriz de Términos”, un valor a controlar es la “Sparsity” que se fija en 0.85. ¿Qué sucedería si se disminuye el valor de la “Sparsity”? y ¿si se incrementa dicho valor?.
El término “Sparsity” o escasez en castellano hace referencia al conjunto de celdas en una matriz vacías o que bien cuyo contenido es igual a 0.
La “sparsity” tiene una medida entre 1-0, por lo tanto una matriz con una “sparsity” de 1 se considerará totalmente esparza, mientras que una con una “sparsity” de 0 se considerará totalmente densa.
Esto quiere decir que si se disminuye el valor de la “sparsity” se estaría admitiendo una menor dispersión, como resultado tendríamos menos términos en nuestra matriz de términos, a fines de almacenamiento de datos esto puede ser algo bueno, por otra parte una matriz densa requiere mayor potencia computacional, además corremos el riesgo de perder información que puede ser útil.
Por el contrario si aumentamos la sparsity tendríamos más datos con valor 0 (o vacíos) en nuestra matriz, por lo que se necesitaría más espacio de almacenamiento, ya que aunque sean ceros se almacenan de la misma manera que el resto de los datos, por otra parte una matriz esparza es más fácil de calcular, puesto que se eliminan operaciones con elementos cero.
En el apartado “Visualizaciones sobre la matriz de palabras TDM” se muestron algunos ejemplos de visualización de distintas secciones de la matriz de términos. Visualizad los 10 primeros términos y los 5 primeros documentos en la temática “earn”. Posteriormente visualizar aquellas palabras relacionadas con esta misma temática y con frecuencia menor a 2000 y mayor a 20.
Visualizad los 10 primeros términos y los 5 primeros documentos en la temática “earn”.
inspect(mat[[2]]$mat[1:10,1:5])## <<TermDocumentMatrix (terms: 10, documents: 5)>>
## Non-/sparse entries: 29/21
## Sparsity : 42%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 2 3 4 5
## april 2 0 0 0 0
## compani 1 0 0 0 3
## cts 0 2 7 1 4
## dlrs 0 2 0 2 3
## inc 1 1 1 1 1
## mln 2 6 8 7 0
## record 1 0 0 0 0
## reuter 1 1 1 1 1
## share 2 0 0 0 4
## two 1 0 1 0 0Visualizar aquellas palabras relacionadas con esta misma temática y con frecuencia menor a 2000 y mayor a 20.
findFreqTerms(mat[[2]]$mat, lowfreq=20, highfreq = 2000)## [1] "april" "compani" "inc" "record" "share" "two"
## [7] "includ" "note" "qtr" "dividend" "oper" "prior"
## [13] "rev" "corp" "end" "quarter" "sale" "march"
## [19] "div" "pay"En el apartado “Descripción de la TDM”" se construye un gráficos de barras con las palabras con una frecuencia mayor que 500 en ambas temáticas. Construya un gráfico de barras similar pero con las barras apiladas y en posición horizontal. ¿Cuantas barras salen bicolor?. ¿Qué implica la existencias de estas barras bicolor?.
Para la visualización de la gráfica con barras apiladas y en orientación horizontal usé el siguiente comando:
library(ggplot2)
ggplot(subset(fdata,Frecuencia>500),aes(Palabra,Frecuencia,fill=Tematica))+geom_bar(stat="identity",position=position_stack())+theme(axis.text.x=element_text(angle=45, hjust=1))+coord_flip()
Como resultado obtenemos 8 barras bicolores, esto quiere decir que hay 8 términos que tienen una frecuencia superior a 500 en ambas temáticas, la existencia de las barras bicolores nos permite ver la presencia de un mismo término dentro de temáticas diferentes, al ser un gráfico de barras apiladas simples, la interpretación se debe realizar teniendo en cuenta que las barras apiladas simples colocan el valor absoluto de cada temática o subcategoría (en este caso “earn” “acq”) después o sobre la anterior.
En el apartado “Validación del Modelo de clasificación” se presenta la matriz de confusión del modelo generado. A partir de esta matriz se calculan dos ratios. Se supone que la categoría de referencia o “verdadera” es acq. Determinad que ratios (ratio1 y ratio2) hemos calculado y obtened el ratio de precisión. Interpretad los resultados.
ratio1 <- (conf.mat[1,1]/(conf.mat[1,1]+conf.mat[1,2]))*100
ratio1## [1] 97.87234ratio2<-(conf.mat[2,2]/(conf.mat[1,2]+conf.mat[2,2]))*100
ratio2## [1] 98.80952Ratio1: representa los verdaderos positivos, es decir la probabilidad de clasificar el documento “acq” cuando realmente es “acq”. Lo que quiere decir que la probabilidad de clasificar el documento a la temática correspondiente es del 97,87%
Ratio2: representa los verdaderos positivos, es decir la probabilidad de clasificar el documento “earn” cuando realmente es “earn”. Lo que quiere decir que la probabilidad de clasificar el documento a la temática correspondiente es del 98,80%
conf.mat## Real
## Predicción acq earn
## acq 460 10
## earn 30 830Interpretación: La posición “a” representa los verdaderos positivos, es decir asignar correctamente los documentos “adq” cuando realmente son “acq”, en este caso el valor es 460. Mientras que la posición “b” de la matriz representa los falsos positivos, es decir asignar los documentos “acq” cuando realmente son “earn”, en este caso el valor es 10.
La posición “d” en la matriz representa los verdaderos negativos, es decir asignar correctamente los documentos “earn” cuando no son “acq”, en este caso el valor es 830. Mientras que la posición c de la matriz representa los falsos negativos, es decir asignar los documentos “earn” cuando realmente son “acq”, en este caso el valor es 30.
Ratio de precisión: para su cálculo podemos usar la suma de la diagonal de la matriz de confusión, es decir, las clasificaciones acertadas divididas por el número de documentos de prueba. De esta manera se tiene en cuenta la cantidad de falsos positivos que nos da el modelo.
ratio<-sum(diag(conf.mat))/length(test.idx)*100
ratio## [1] 96.99248Esto quiere decir que El modelo KNN supera el 96.99% de acierto.
En el apartado “Validación del Modelo de clasificación” se utiliza la función “knn” para clasificar los documentos según temática. Esta función por defecto supone que el número de vecinos a evaluar es igual a 1. Valorad los resultados del algoritmo K-NN utilizando distinto número de vecinos, por ejemplo, 2, 3 y 5. Qué dificultad añadida podría tener seleccionar K=2.
Como vimos anteriormente al entrenar el modelo KNN con K:1 obtenemos una precisión de 96,99%
K: 2
set.seed(111)
entrena.idx <- sample(nrow(pila), ceiling(nrow(pila) * 0.7))
test.idx <- (1:nrow(pila))[-entrena.idx]
tema <- pila[, "Tema"]
pila.nl <- pila[, !colnames(pila) %in% "Tema"]
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx],k=2)
conf.mat <- table("Predicción" = knn.pred,"Real" = tema[test.idx])
conf.mat## Real
## Predicción acq earn
## acq 461 10
## earn 29 830ratio<-sum(diag(conf.mat))/length(test.idx)*100
ratio## [1] 97.06767K: 3
set.seed(111)
entrena.idx <- sample(nrow(pila), ceiling(nrow(pila) * 0.7))
test.idx <- (1:nrow(pila))[-entrena.idx]
tema <- pila[, "Tema"]
pila.nl <- pila[, !colnames(pila) %in% "Tema"]
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx],k=3)
conf.mat <- table("Predicción" = knn.pred,"Real" = tema[test.idx])
conf.mat## Real
## Predicción acq earn
## acq 464 12
## earn 26 828ratio<-sum(diag(conf.mat))/length(test.idx)*100
ratio## [1] 97.14286K: 5
set.seed(111)
entrena.idx <- sample(nrow(pila), ceiling(nrow(pila) * 0.7))
test.idx <- (1:nrow(pila))[-entrena.idx]
tema <- pila[, "Tema"]
pila.nl <- pila[, !colnames(pila) %in% "Tema"]
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx],k=5)
conf.mat <- table("Predicción" = knn.pred,"Real" = tema[test.idx])
conf.mat## Real
## Predicción acq earn
## acq 467 13
## earn 23 827ratio <- sum(diag(conf.mat))/length(test.idx)*100
ratio## [1] 97.29323La teoría indica que los datos menos diferenciados entre sí darán una mayor precisión entre más vecinos se establezcan, como se puede ver en los resultados usando distintas K, la precisión aumenta conforme aumenta la K, aunque los cambios son bastante sutiles.
Por otra parte es aconsejable usar un número de vecinos impar para clasificaciones con un numero de clases par (ejemplo, aqc y earn= 2 clases) para evitar que dos etiquetas de clases obtengan la misma puntuación.
Del fichero inicial seleccionar dos temáticas distintas a las del enunciado y entrenar un k-NN que permita clasificar nuevos artículos en una de ambas temáticas. ¿Podría explicar de forma detallada como realiza la clasificación el algoritmo k-NN?
#leemos los datos
data <- read.table('data_reuter.txt', header=FALSE, sep='\t')
#Cuantos hay para cada tipo
table(data$V1)##
## acq crude earn grain interest money-fx ship trade
## 1596 253 2840 41 190 206 108 251Seleccionamos las dos nuevas temáticas “crude” y “trade”
data2<-data[which(data$V1 %in% c("crude","trade")),]
# Cuantos hay en total
nrow(data2)## [1] 504Creación del corpus de la temática “crude”
## Seleccionamos la temática, construimos el corpus y acondicionamos
data_crude<-data2[(data2$V1=="crude"),]
source <- VectorSource(data_crude$V2)
corpus1 <- Corpus(source)
corpus1 <- tm_map(corpus1, content_transformer(tolower))## Warning in tm_map.SimpleCorpus(corpus1, content_transformer(tolower)):
## transformation drops documentscorpus1 <- tm_map(corpus1, removeNumbers)## Warning in tm_map.SimpleCorpus(corpus1, removeNumbers): transformation drops
## documentscorpus1 <- tm_map(corpus1, removePunctuation)## Warning in tm_map.SimpleCorpus(corpus1, removePunctuation): transformation drops
## documentscorpus1 <- tm_map(corpus1, stripWhitespace)## Warning in tm_map.SimpleCorpus(corpus1, stripWhitespace): transformation drops
## documentsv_stopwords <- c(stopwords("english"),c("dont","didnt","arent","cant","one","also","said"))
corpus1 <- tm_map(corpus1, removeWords, v_stopwords)## Warning in tm_map.SimpleCorpus(corpus1, removeWords, v_stopwords):
## transformation drops documentscorpus1 <- tm_map(corpus1, removePunctuation)## Warning in tm_map.SimpleCorpus(corpus1, removePunctuation): transformation drops
## documentscorpus1 <- tm_map(corpus1, stemDocument, language="english")## Warning in tm_map.SimpleCorpus(corpus1, stemDocument, language = "english"):
## transformation drops documentsCreación del corpus de la temática “trade”
## Seleccionamos la temática, construimos el corpus y acondicionamos
data_trade<-data2[(data2$V1=="trade"),]
source <- VectorSource(data_trade$V2)
corpus2 <- Corpus(source)
corpus2 <- tm_map(corpus2, content_transformer(tolower))## Warning in tm_map.SimpleCorpus(corpus2, content_transformer(tolower)):
## transformation drops documentscorpus2 <- tm_map(corpus2, removeNumbers)## Warning in tm_map.SimpleCorpus(corpus2, removeNumbers): transformation drops
## documentscorpus2 <- tm_map(corpus2, removePunctuation)## Warning in tm_map.SimpleCorpus(corpus2, removePunctuation): transformation drops
## documentscorpus2 <- tm_map(corpus2, stripWhitespace)## Warning in tm_map.SimpleCorpus(corpus2, stripWhitespace): transformation drops
## documentsv_stopwords <- c(stopwords("english"),c("dont","didnt","arent","cant","one","also","said"))
corpus2 <- tm_map(corpus2, removeWords, v_stopwords)## Warning in tm_map.SimpleCorpus(corpus2, removeWords, v_stopwords):
## transformation drops documentscorpus2 <- tm_map(corpus2, removePunctuation)## Warning in tm_map.SimpleCorpus(corpus2, removePunctuation): transformation drops
## documentscorpus2 <- tm_map(corpus2, stemDocument, language="english")## Warning in tm_map.SimpleCorpus(corpus2, stemDocument, language = "english"):
## transformation drops documentsGeneración de la matriz de términos Temática Crude
# Construimos la matrix de documentos de la temática crude
mat_crude <- TermDocumentMatrix(corpus1)
mat_crude<- removeSparseTerms(mat_crude, 0.85)
inspect(mat_crude)## <<TermDocumentMatrix (terms: 68, documents: 253)>>
## Non-/sparse entries: 4599/12605
## Sparsity : 73%
## Maximal term length: 9
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 137 142 245 249 250 36 44 51 59 84
## barrel 4 4 2 0 1 3 0 1 3 2
## bpd 8 8 0 18 15 1 20 10 7 5
## crude 1 1 2 5 3 6 2 3 7 4
## dlrs 5 5 7 0 0 4 0 1 9 4
## mln 8 8 0 28 11 5 13 8 7 2
## oil 10 10 18 10 8 19 3 3 19 6
## opec 24 23 1 5 4 0 6 19 10 19
## price 10 10 8 2 2 7 3 8 17 14
## reuter 3 2 1 1 1 1 4 4 4 1
## will 4 4 7 2 2 2 0 1 8 1mat_crude<-list(name="crude",mat=mat_crude)
mat_crude## $name
## [1] "crude"
##
## $mat
## <<TermDocumentMatrix (terms: 68, documents: 253)>>
## Non-/sparse entries: 4599/12605
## Sparsity : 73%
## Maximal term length: 9
## Weighting : term frequency (tf)str(mat_crude)## List of 2
## $ name: chr "crude"
## $ mat :List of 6
## ..$ i : int [1:4599] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ j : int [1:4599] 1 1 1 1 1 1 1 1 1 1 ...
## ..$ v : num [1:4599] 2 2 1 3 3 1 2 1 1 2 ...
## ..$ nrow : int 68
## ..$ ncol : int 253
## ..$ dimnames:List of 2
## .. ..$ Terms: chr [1:68] "barrel" "compani" "corp" "crude" ...
## .. ..$ Docs : chr [1:253] "1" "2" "3" "4" ...
## ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"Temática Trade
mat_trade <- TermDocumentMatrix(corpus2)
mat_trade<- removeSparseTerms(mat_trade, 0.85)
inspect(mat_trade)## <<TermDocumentMatrix (terms: 96, documents: 251)>>
## Non-/sparse entries: 6316/17780
## Sparsity : 74%
## Maximal term length: 13
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 108 185 188 201 203 236 31 48 81 86
## billion 11 3 0 1 1 2 6 1 1 1
## countri 6 1 0 1 0 14 1 3 4 4
## export 10 3 1 0 0 2 2 1 0 0
## import 2 1 4 2 12 2 2 3 7 6
## japan 5 13 9 14 8 4 1 1 1 1
## japanes 0 13 8 6 4 0 0 0 0 0
## reuter 1 2 1 3 1 1 1 1 1 1
## trade 18 11 5 22 6 6 8 19 28 26
## will 9 0 1 1 12 9 6 8 6 5
## year 8 3 1 1 4 2 4 2 5 5mat_trade<-list(name="trade",mat=mat_trade)
mat_trade## $name
## [1] "trade"
##
## $mat
## <<TermDocumentMatrix (terms: 96, documents: 251)>>
## Non-/sparse entries: 6316/17780
## Sparsity : 74%
## Maximal term length: 13
## Weighting : term frequency (tf)str(mat_trade)## List of 2
## $ name: chr "trade"
## $ mat :List of 6
## ..$ i : int [1:6316] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ j : int [1:6316] 1 1 1 1 1 1 1 1 1 1 ...
## ..$ v : num [1:6316] 3 1 1 3 1 1 1 2 3 1 ...
## ..$ nrow : int 96
## ..$ ncol : int 251
## ..$ dimnames:List of 2
## .. ..$ Terms: chr [1:96] "billion" "countri" "dlr" "dlrs" ...
## .. ..$ Docs : chr [1:251] "1" "2" "3" "4" ...
## ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"Procedemos a juntar ambas matrices de términos en una misma lista
mat<-list(mat_crude, mat_trade)
str(mat)## List of 2
## $ :List of 2
## ..$ name: chr "crude"
## ..$ mat :List of 6
## .. ..$ i : int [1:4599] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ j : int [1:4599] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..$ v : num [1:4599] 2 2 1 3 3 1 2 1 1 2 ...
## .. ..$ nrow : int 68
## .. ..$ ncol : int 253
## .. ..$ dimnames:List of 2
## .. .. ..$ Terms: chr [1:68] "barrel" "compani" "corp" "crude" ...
## .. .. ..$ Docs : chr [1:253] "1" "2" "3" "4" ...
## .. ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## .. ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"
## $ :List of 2
## ..$ name: chr "trade"
## ..$ mat :List of 6
## .. ..$ i : int [1:6316] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ j : int [1:6316] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..$ v : num [1:6316] 3 1 1 3 1 1 1 2 3 1 ...
## .. ..$ nrow : int 96
## .. ..$ ncol : int 251
## .. ..$ dimnames:List of 2
## .. .. ..$ Terms: chr [1:96] "billion" "countri" "dlr" "dlrs" ...
## .. .. ..$ Docs : chr [1:251] "1" "2" "3" "4" ...
## .. ..- attr(*, "class")= chr [1:2] "TermDocumentMatrix" "simple_triplet_matrix"
## .. ..- attr(*, "weighting")= chr [1:2] "term frequency" "tf"Visualizaciones en la matriz de términos
## Frecuencia de los 25 primeros términos en los 10 primeros documentos para ambos temas
inspect(mat[[1]]$mat[1:25,1:10])## <<TermDocumentMatrix (terms: 25, documents: 10)>>
## Non-/sparse entries: 104/146
## Sparsity : 58%
## Maximal term length: 8
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 10 2 3 4 5 6 7 8 9
## bpd 0 0 4 0 0 0 0 7 0 0
## crude 3 0 0 1 3 4 0 2 0 0
## dlrs 2 0 0 1 1 2 2 2 1 0
## last 1 2 1 0 1 1 0 4 3 0
## market 2 0 5 0 0 0 0 3 0 2
## meet 0 0 7 0 0 0 0 3 0 1
## mln 0 0 4 0 0 0 2 4 1 0
## oil 5 5 12 0 2 1 2 7 4 3
## price 6 2 7 1 2 2 0 8 1 2
## reuter 1 1 2 0 1 1 1 1 1 1inspect(mat[[2]]$mat[1:25,1:10])## <<TermDocumentMatrix (terms: 25, documents: 10)>>
## Non-/sparse entries: 121/129
## Sparsity : 52%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 10 2 3 4 5 6 7 8 9
## billion 3 0 4 0 1 2 1 0 7 2
## countri 1 2 0 0 1 0 3 3 0 4
## export 1 0 3 0 1 4 2 5 2 10
## import 1 5 3 0 2 3 0 0 0 5
## japan 0 5 2 0 10 0 0 3 0 0
## last 1 0 0 0 2 3 1 0 0 4
## reuter 1 1 1 1 1 2 1 1 1 1
## surplus 3 0 4 0 1 4 0 0 0 0
## trade 3 2 2 3 15 5 7 4 0 14
## year 1 2 3 0 1 6 0 0 1 4# Número de documentos del tema crude
nDocs(mat[[1]]$mat)## [1] 253# Número de términos del tema crude
nTerms(mat[[1]]$mat)## [1] 68Representación gráfica de las frecuencias
#para crude y trade
mmat_crude <- as.matrix(mat[[1]]$mat)
v_crude <- sort(rowSums(mmat_crude), decreasing=TRUE)
#Creamos un data.frame con términos y frecuencias
d_crude <- data.frame(word=names(v_crude), freq=v_crude)
d_crude[,3]<-"crude"
mmat_trade <- as.matrix(mat[[2]]$mat)
v_trade <- sort(rowSums(mmat_trade), decreasing=TRUE)
#Creamos un data.frame con términos y frecuencias
d_trade <- data.frame(word=names(v_trade), freq=v_trade)
d_trade[,3]<-"trade"
#Concatenamos las dos matrices
fdata<-rbind(d_crude,d_trade)
colnames(fdata)## [1] "word" "freq" "V3"colnames(fdata)<-c("Palabra", "Frecuencia", "Tematica")Creación de un data frame apto para KNN
# Para crude
s.mat_crude <- t(data.matrix(mat[[1]]$mat))
#La convertimos en data.frame.
s.df_crude <- as.data.frame(s.mat_crude, stringsAsFactors = FALSE)
nrow(s.df_crude)## [1] 253Tema <- rep(mat[[1]]$name, nrow(s.df_crude))
s.df_crude<-cbind(s.df_crude,Tema)
#Para trade
s.mat_trade <- t(data.matrix(mat[[2]]$mat))
s.df_trade <- as.data.frame(s.mat_trade, stringsAsFactors =FALSE)
Tema <- rep(mat[[2]]$name, nrow(s.df_trade))
s.df_trade<-cbind(s.df_trade,Tema)
#concatenamos las filas de los data frame
pila <-rbind.fill(s.df_crude, s.df_trade)
pila[is.na(pila)] <- 0
nrow(pila)## [1] 504ncol(pila)## [1] 126Construcción del modelo de clasificación
#Fijamos semilla
set.seed(111)
# 70% de los documentos para entrenamiento
entrena.idx <- sample(nrow(pila), ceiling(nrow(pila) * 0.7))
# El resto de documentos para pruebas
test.idx <- (1:nrow(pila))[-entrena.idx]
# guardamos por un lado los temas y por el otro las palabras
tema <- pila[, "Tema"]
pila.nl <- pila[, !colnames(pila) %in% "Tema"]Aplicamos el Modelo K-NN
knn.pred <- knn(pila.nl[entrena.idx, ], pila.nl[test.idx, ], tema[entrena.idx])
conf.mat <- table("Predicción" = knn.pred,"Real" = tema[test.idx])
conf.mat## Real
## Predicción crude trade
## crude 83 1
## trade 0 67Observamos como K-NN, de los 151 documentos, ha clasificado correctamente 149: • 83 documentos como crude. • 68 documentos como trade. y ha fallado en 1 documento, puesto que los ha clasificado 1 como trade cuando en realidad era crude Para evaluar la capacidad predictiva del algoritmo utilizamos dos medidas,ratio1 y rati2.
ratio1 <- (conf.mat[1,1]/(conf.mat[1,1]+conf.mat[1,2]))*100
ratio1## [1] 98.80952ratio2 <- (conf.mat[2,2]/(conf.mat[1,2]+conf.mat[2,2]))*100
ratio2## [1] 98.52941Como ratio de precisión del modelo K-NN podemos hacer la siguiente operación
ratio <- sum(diag(conf.mat))/length(test.idx)*100
ratio## [1] 99.33775Esto quiere decir que El modelo KNN supera el 96.99% de acierto
¿Podría explicar de forma detallada como realiza la clasificación el algoritmo k-NN? El algoritmo realiza la clasificación bajo la premisa de que los puntos de datos similares están cerca unos de otros, el algoritmo solo será útil si está premisa es lo suficientemente cierta, ya que KNN captura la idea de similitud (proximidad o cercanía) mediante el calculo de la distancia entre puntos en un gráfico, usualmente la distancia en línea recta (distancia euclidiana)
El algoritmo realiza la clasificación ejecutando los siguientes pasos: 1. Entrenamiento con una parte de los documentos para asimilar las principales frecuencias de cada temática. 2.Calcula la distancia entre el item a clasificar y el resto de items del dataset de entrenamiento. 3.Selecciona los “k” elementos más cercanos 4. Realiza una “votación de mayoría” entre los k puntos: los de una clase/etiqueta que dominen decidirán su clasificación final.
¿En qué distancia se basa el algoritmo K-NN que se define en la función knn() de R que se ha utilizado para entrenar el modelo?. Realizad una o más críticas a dicha distancia y describid cómo podría corregirse.
El algoritmo K-NN que se ha utilizado en el modelo está basado en la distancia Euclidiana, la fórmula de la distancia euclidiana puede usarse para calcular la distancia entre dos puntos en un espacio n-dimensional y es la distancia métrica más usada en el uso del algoritmo KNN
Algunos de los beneficios de usar la distancia euclidiana son su rapidez en el cálculo y la facilidad de interpretación ya que coincide con nuestra idea física más básica de lo que es la distancia.
Como crítica se podría argumentar que esta distancia es sensible a la escala de las variables estudiadas, esto quiere decir que las características de mayor escala tendrían dominación sobre las demás, este problema se podría solucionar estableciendo la normalización de características continuas.
Por otra parte la distancia euclidiana no tiene en cuenta la correlación entre variables, de hecho, está inversamente relacionada con el coeficiente de correlación, ya que el coeficiente de correlación es el average product de la suma de las diferencias al cuadrado.