Parte I: Análisis exploratorio
Leemos el dataframe
Iniciamos cargando las librerias y leyendo los archivos de datos.
Damos una mirada a los conjuntos de datos
Primero tenemos que dar una mirada a los datos que nos han proporcionado. Estos consisten de los archivos: ratings.csv, books.csv, book_tags.csv, tags.csv.
ratings.csv contiene los puntajes que todos los usuarios han dado a los libros (un total de 980k puntajes para 10,000 libros de 53,424 usuarios) books.csv contiene más información sobre los libros, tal como el autor, año, etc. book_tags.csv contiene todas las etiquetas (tag_ids) que han sido asignadas a los libros y su correspondiente número de etiquetas (tag_counts). tags.csv contiene los nombres de las etiquetas correspondientes a los tag_ids. Estos dos últimos archivos están ligados por los identificadores de los libros.
Ratings.csv
## Rows: 79,701
## Columns: 3
## $ book_id <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,~
## $ user_id <int> 314, 439, 588, 1169, 1185, 2077, 2487, 2900, 3662, 3922, 5379,~
## $ rating <int> 5, 3, 5, 4, 4, 4, 4, 5, 4, 5, 5, 3, 5, 5, 3, 1, 4, 5, 4, 4, 5,~
Books.csv
## Rows: 10,000
## Columns: 23
## $ id <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 1~
## $ book_id <int> 2767052, 3, 41865, 2657, 4671, 11870085, 590~
## $ best_book_id <int> 2767052, 3, 41865, 2657, 4671, 11870085, 590~
## $ work_id <int> 2792775, 4640799, 3212258, 3275794, 245494, ~
## $ books_count <int> 272, 491, 226, 487, 1356, 226, 969, 360, 311~
## $ isbn <chr> "439023483", "439554934", "316015849", "6112~
## $ isbn13 <int64> 9780439023480, 9780439554930, 978031601584~
## $ authors <chr> "Suzanne Collins", "J.K. Rowling, Mary Grand~
## $ original_publication_year <int> 2008, 1997, 2005, 1960, 1925, 2012, 1937, 19~
## $ original_title <chr> "The Hunger Games", "Harry Potter and the Ph~
## $ title <chr> "The Hunger Games (The Hunger Games, #1)", "~
## $ language_code <chr> "eng", "eng", "en-US", "eng", "eng", "eng", ~
## $ average_rating <dbl> 4.34, 4.44, 3.57, 4.25, 3.89, 4.26, 4.25, 3.~
## $ ratings_count <int> 4780653, 4602479, 3866839, 3198671, 2683664,~
## $ work_ratings_count <int> 4942365, 4800065, 3916824, 3340896, 2773745,~
## $ work_text_reviews_count <int> 155254, 75867, 95009, 72586, 51992, 140739, ~
## $ ratings_1 <int> 66715, 75504, 456191, 60427, 86236, 47994, 4~
## $ ratings_2 <int> 127936, 101676, 436802, 117415, 197621, 9272~
## $ ratings_3 <int> 560092, 455024, 793319, 446835, 606158, 3275~
## $ ratings_4 <int> 1481305, 1156318, 875073, 1001952, 936012, 6~
## $ ratings_5 <int> 2706317, 3011543, 1355439, 1714267, 947718, ~
## $ image_url <chr> "https://images.gr-assets.com/books/14473036~
## $ small_image_url <chr> "https://images.gr-assets.com/books/14473036~
Limpiando el conjunto de datos
Como con cualquier conjunto de datos de la vida real, primero necesitamos hacer una pequeña limpieza a los datos. Cuando realizamos la exploración notamos que algunas combinaciones de usuarios y libros tienen multiples puntuajes cuando en teoría solamente debe existir uno por usuario.
Removemos los registros duplicados.
ratings[, N := .N, .(user_id, book_id)]
## corresponding dplyr code
# ratings %>% group_by(user_id, book_id) %>% mutate(n=n())
cat('Number of duplicate ratings: ', nrow(ratings[N > 1]))## Number of duplicate ratings: 338
ratings <- ratings[N == 1]
cat('\nNumber of duplicate ratings: ', nrow(ratings[N > 1]))##
## Number of duplicate ratings: 0
summary(ratings)## book_id user_id rating N
## Min. : 1 Min. : 2 Min. :1.000 Min. :1
## 1st Qu.:2657 1st Qu.:12638 1st Qu.:3.000 1st Qu.:1
## Median :5068 Median :25182 Median :4.000 Median :1
## Mean :4908 Mean :25749 Mean :3.861 Mean :1
## 3rd Qu.:7073 3rd Qu.:38615 3rd Qu.:5.000 3rd Qu.:1
## Max. :9998 Max. :53424 Max. :5.000 Max. :1
y removemos aquellos usuarios que han calificado menos de 3 libros
ratings[, N := .N, .(user_id)]
## corresponding dplyr code
# ratings %>% group_by(user_id) %>% mutate(n = n())
cat('Número de usuarios que calificaron menos de 3 libros: ', uniqueN(ratings[N <= 2, user_id]))## Número de usuarios que calificaron menos de 3 libros: 18842
ratings <- ratings[N > 2]summary(ratings)## book_id user_id rating N
## Min. : 1 Min. : 7 Min. :1.000 Min. : 3.000
## 1st Qu.:1715 1st Qu.:12399 1st Qu.:3.000 1st Qu.: 4.000
## Median :4135 Median :24613 Median :4.000 Median : 6.000
## Mean :4145 Mean :25427 Mean :3.858 Mean : 7.652
## 3rd Qu.:6150 3rd Qu.:38124 3rd Qu.:5.000 3rd Qu.: 9.000
## Max. :9998 Max. :53403 Max. :5.000 Max. :32.000
Empezamos la exploración de los datos
¿Cuál es la distribución de los datos?
Podemos ver que ya la mayoría de las calificaciones tienden a ser positivas. La mayoría de las calificaciones están en el rango de 3-5, mientras que pocas calificaciones están en el rango de 1-2.
ratings %>%
ggplot(aes(x = rating,
fill = factor(rating))) +
geom_bar(color = "grey20") +
scale_fill_brewer(palette = "YlGnBu") +
guides(fill = FALSE)Número de calificaciones por usuario
Podemos observar que hay algunos usuarios que han dado muchas calificaciones. Esto es interesante porque podemos examinar como se comportan las calificaciones de los usuarios más activos de los menos activos.
ratings %>%
group_by(user_id) %>%
summarize(number_of_ratings_per_user = n()) %>%
ggplot(aes(number_of_ratings_per_user)) +
geom_bar(fill = "cadetblue3", color = "grey20") +
coord_cartesian(c(3, 50))Distribucion media de calificaciones de usuarios
Los usuarios tienen diferentes tendencias al calificar libros. Algunos pueden dar 5 estrellas a libros mediocres, mientras que otros no dan calificacion de 5 al menos que sea un libro perfecto para ellos. Estas tendencias se pueden observar en las siguientes figuras. En el lado derecho hay un gran número de usuarios con una calificación media de 5, indicando que a ellos realmente les gustaron todos los libros o que solamente calificaron libros que les gustaron. También podemos observar que casi no hay calificaciones bajas. Estas tendencias serán importantes para el filtro colaborativo que veremos despues.
ratings %>%
group_by(user_id) %>%
summarize(mean_user_rating = mean(rating)) %>%
ggplot(aes(mean_user_rating)) +
geom_histogram(fill = "cadetblue3", color = "grey20")ratings %>%
group_by(book_id) %>%
summarize(number_of_ratings_per_book = sum(n()))## # A tibble: 812 x 2
## book_id number_of_ratings_per_book
## <int> <int>
## 1 1 100
## 2 2 100
## 3 3 100
## 4 5 100
## 5 6 100
## 6 8 100
## 7 10 100
## 8 11 100
## 9 13 100
## 10 21 100
## # ... with 802 more rows
Número de calificaiones por libro.
Podemos ver que el subconjunto de libros tiene alrededor de 18 y 20 calificaciones.
ratings %>%
group_by(book_id) %>%
summarize(number_of_ratings_per_book = n()) %>%
ggplot(aes(number_of_ratings_per_book)) +
geom_bar(fill = "orange", color = "grey20", width = 1) + coord_cartesian(c(0,40))Distribución de calificación media de los libros.
La distribución media no muestra ninguna peculiaridad.
ratings %>%
group_by(book_id) %>%
summarize(mean_book_rating = mean(rating)) %>%
ggplot(aes(mean_book_rating)) +
geom_histogram(fill = "orange", color = "grey20") + coord_cartesian(c(1,5))Distribución de generos
Extraer el genero del libro no es una tarea trivial ya que los usuarios asignan las etiquetas a los libros, el cual podría o no coinicidir con el genero establecido por GoodReads. Una forma de hacerlo es esocger las etiqutes que coinicidan con las indicadas por GoodReads.
Se puede observar que la mayoría de los libros son de Fantasía, romance o misterio, mientras que no hay muchos de cocina.
genres <- str_to_lower(c("Art", "Biography", "Business", "Chick Lit", "Children's", "Christian", "Classics", "Comics", "Contemporary", "Cookbooks", "Crime", "Ebooks", "Fantasy", "Fiction", "Gay and Lesbian", "Graphic Novels", "Historical Fiction", "History", "Horror", "Humor and Comedy", "Manga", "Memoir", "Music", "Mystery", "Nonfiction", "Paranormal", "Philosophy", "Poetry", "Psychology", "Religion", "Romance", "Science", "Science Fiction", "Self Help", "Suspense", "Spirituality", "Sports", "Thriller", "Travel", "Young Adult"))
exclude_genres <- c("fiction", "nonfiction", "ebooks", "contemporary")
genres <- setdiff(genres, exclude_genres)
available_genres <- genres[str_to_lower(genres) %in% tags$tag_name]
available_tags <- tags$tag_id[match(available_genres, tags$tag_name)]
tmp <- book_tags %>%
filter(tag_id %in% available_tags) %>%
group_by(tag_id) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(sumN = sum(n), percentage = n / sumN) %>%
arrange(-percentage) %>%
left_join(tags, by = "tag_id")
tmp %>%
ggplot(aes(reorder(tag_name, percentage),
percentage, fill = percentage)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_distiller(palette = 'YlOrRd') +
labs(y = 'Percentage', x = 'Genre')Top 10 de libros mejor calificados
Se muestra que a los usuarios les suele gustar: a) Calvin and Hobbes, b) Algunas colecciones de libros.
books %>%
mutate(image = paste0('<img src="', small_image_url, '"></img>')) %>%
arrange(-average_rating) %>%
top_n(10,wt = average_rating) %>%
select(image, title, ratings_count, average_rating) %>%
datatable(class = "nowrap hover row-border", escape = FALSE, options = list(dom = 't',scrollX = TRUE, autoWidth = TRUE))## TE RECOMENDAMOS COPIES EL CÓDIGO Y LO PEGUES EN LA CONSOLA PARA QUE VISUALICES LA LISTA COMPLETA.Top 10 de libros populares
Viendo los libros que han recibido más calificaciones nos podemos dar una idea de su popularidad.
books %>%
mutate(image = paste0('<img src="', small_image_url, '"></img>')) %>%
arrange(-ratings_count) %>%
top_n(10,wt = ratings_count) %>%
select(image, title, ratings_count, average_rating) %>%
datatable(class = "nowrap hover row-border",
escape = FALSE,
options = list(dom = 't', scrollX = TRUE, autoWidth = TRUE))Idiomas de los libros
Como vimos al inicio el dataset books.csv contiene información sobre el idioma en que está escrito el libro. Podemos explorar que tantos libros existe en otros idiomas.
p1 <- books %>%
mutate(language = factor(language_code)) %>%
group_by(language) %>%
summarize(number_of_books = n()) %>%
arrange(-number_of_books) %>%
ggplot(aes(reorder(language,
number_of_books),
number_of_books,
fill = reorder(language, number_of_books))) +
geom_bar(stat = "identity", color = "grey20", size = 0.35) +
coord_flip() +
labs(x = "language", title = "english included") +
guides(fill = FALSE)
p2 <- books %>%
mutate(language = factor(language_code)) %>%
filter(!language %in% c("en-US", "en-GB", "eng", "en-CA", "")) %>%
group_by(language) %>%
summarize(number_of_books = n()) %>%
arrange(-number_of_books) %>%
ggplot(aes(reorder(language, number_of_books), number_of_books, fill = reorder(language, number_of_books))) +
geom_bar(stat = "identity", color = "grey20", size = 0.35) + coord_flip() +
labs(x = "", title = "english excluded") + guides(fill = FALSE)
grid.arrange(p1,p2, ncol=2)¿Qué influencia la calificación de un libro?
A continuación podemos ver si encontramos alguna asociación de características con la calificación de un libro. Para una vista rápida, primero vamos a generar una gráfica de la matriz de correlación entre el promedio de califación average_rating y algunas variables.
En resumen, solamente podemos encontrar una pequeña correlación entre las características y la calificación promedio. Lo cual indica que no hay una relación fuerte entre la calificación que recibe un libr y sus meta-variables. Lo cual indica que la calificación depende fuertemente en otras características.
tmp <- books %>%
select(one_of(c("books_count","original_publication_year","ratings_count", "work_ratings_count", "work_text_reviews_count", "average_rating"))) %>%
as.matrix()
corrplot(cor(tmp, use = 'pairwise.complete.obs'), type = "lower") #### ¿Es mejor la secuela que la original? Podemos ver que dentro de una serie, las secuelas son ligeramente mejor que el original.
books <- books %>%
mutate(series = str_extract(title, "\\(.*\\)"),
series_number = as.numeric(str_sub(str_extract(series, ', #[0-9]+\\)$'),4,-2)),
series_name = str_sub(str_extract(series, '\\(.*,'),2,-2))
books %>%
filter(!is.na(series_name) & !is.na(series_number) & series_number %in% c(1,2)) %>%
group_by(series_name, series_number) %>%
summarise(m = mean(average_rating)) %>%
ungroup() %>%
group_by(series_name) %>%
mutate(n = n()) %>%
filter(n == 2) %>%
ggplot(aes(factor(series_number), m, color = factor(series_number))) +
geom_boxplot() + coord_cartesian(ylim = c(3,5)) + guides(color = FALSE) + labs(x = "Volume of series", y = "Average rating") Part II: Filtros colaborativos
En este filtro colaborativo basado en usuarios consideramos los siguiente puntos:
Identificar otros usuarios con gustos similares al usuario en cuestion en términos de los libros y calificaciones que tienen en comun.
Si encontramos estos usuarios similares entonces tomamos el promedio de las calificaciones de los libros que el usuario en cuestion no ha leido aún.
Recomendar aquellos libros con la calificacion promedio más alto.
Estos tres pasos los convertirmos en un algoritmo. Pero antes de iniciar tenemos que construir los datos. A continuación crearemos una matriz donde las filas corresponden a los usuarios y cada columna corresponde a los libros. Una matriz de ejemplo para 3 usuarios y 5 libros se muestra a continuación. Como podremos observar no todos los usuarios han calificado todos los libros.
## book_id
## user_id 1 2 3 4 5
## 1 NA NA 4 NA NA
## 2 2 1 NA NA NA
## 3 NA NA 3 NA 3
Para convertir nuestos datos en esta matriz lo haremos de la siguiente manera:
dimension_names <- list(user_id = sort(unique(ratings$user_id)),
book_id = sort(unique(ratings$book_id)))
ratingmat <- spread(select(ratings,
book_id,
user_id,
rating),
book_id,
rating) %>% select(-user_id)
ratingmat <- as.matrix(ratingmat)
dimnames(ratingmat) <- dimension_names
ratingmat[1:5, 1:5]## book_id
## user_id 1 2 3 5 6
## 7 NA NA NA NA NA
## 10 NA NA NA NA NA
## 23 NA NA NA NA NA
## 27 NA NA NA NA NA
## 35 NA NA NA NA NA
dim(ratingmat)## [1] 10045 812
Podemos ver que nuestra matriz de calificaciones tiene 10,045 filas x 812 columnas. Ahora tenemos listos nuestros datos.
Ahora continuaremos con los tres primeros pasos.
Paso 1: Encontrar usuarios similares
En este paso seleccionaremos usuarios que tengan en común los mismos libros. Seleccionaremos un usuario de ejemplo “David” (user_id: 17329). 1) Seleccionamos usuarios que han calificado los mismos libros que David también ha calificado. 2) Veremos que en total tenemos 189 usuarios que tienen al menos un par de libros en común.
current_user <- "17329"
rated_items <- which(!is.na((as.data.frame(ratingmat[current_user, ]))))
selected_users <- names(which(apply(!is.na(ratingmat[ ,rated_items]), 1, sum) >= 2))
head(selected_users, 40)## [1] "314" "725" "1064" "1323" "1794" "2077" "2271" "3114" "3757"
## [10] "3982" "4289" "4641" "4859" "5100" "5109" "5161" "5303" "6323"
## [19] "6390" "7585" "7857" "8146" "8278" "8337" "8371" "8463" "8579"
## [28] "8587" "8632" "8770" "8899" "9123" "9557" "9698" "9722" "10087"
## [37] "10110" "10140" "10288" "10502"
length(selected_users)## [1] 189
Para estos usuarios podemos calcular la similitud de sus calificaciones con las de “David”. Existen varias opciones para calcular la similitud. Típicamente se utiliza el coseno de similitud o la correlación de Pearson.
Después calcularemos la correlación de todos los usuarios seleccionados contra las calificaciones de David. Como ejemplo lo haremos para 2 usuarios (user_ids: 1339 y 26990). Podemos ver que la similitud es más alta para el usuario 1339 que el usuario 26990
user1 <- data.frame(item=colnames(ratingmat),
rating=ratingmat[current_user,]) %>% filter(!is.na(rating))
user2 <- data.frame(item=colnames(ratingmat),
rating=ratingmat["26990",]) %>% filter(!is.na(rating))
tmp<-merge(user1, user2, by="item")
tmp## item rating.x rating.y
## 1 1032 5 5
## 2 2696 3 2
## 3 3304 3 3
## 4 5107 3 5
## 5 6334 3 4
## 6 976 5 5
cor_u1 <- cor(tmp$rating.x, tmp$rating.y, use="pairwise.complete.obs")
print(paste("1339", cor_u1, sep=':'))## [1] "1339:0.612372435695794"
user2 <- data.frame(item = colnames(ratingmat), rating = ratingmat["26990", ]) %>% filter(!is.na(rating))
tmp <- merge(user1, user2, by="item")
tmp## item rating.x rating.y
## 1 1032 5 5
## 2 2696 3 2
## 3 3304 3 3
## 4 5107 3 5
## 5 6334 3 4
## 6 976 5 5
cor_2 <- cor(tmp$rating.x, tmp$rating.y, use="pairwise.complete.obs")
print(paste("26990", cor_2, sep=':'))## [1] "26990:0.612372435695794"
Para reducir la influencia de diferencias interindividuales en las calificaiones medias podemos normalizar las calificaciones de los usuarios substrayendo la media del usuario de todas las calificaiones individuales. Por ejemplo si un usuario calificó 5 libros con 1, 2, 3, 4, 5 sus calificaciones se convertirán en -2, -1, 0, 1, 2. (media es: 3).
rmat <- ratingmat[selected_users, ]
user_mean_ratings <- rowMeans(rmat,na.rm=T)
rmat <- rmat - user_mean_ratingsAhora calculamremos la similitud de todos los usuarios contra David y los ordenaremos de acuerdo a la similitud más alta.
similarities <- cor(t(rmat[rownames(rmat) != current_user, ]),
rmat[current_user, ],
use='pairwise.complete.obs')
sim <- as.vector(similarities)
names(sim) <- rownames(similarities)
res <- sort(sim, decreasing = TRUE)
head(res, 40)## 725 2271 3757 5109 5303 7857 8278 9722 10087 10704 12014 13353 13629
## 1 1 1 1 1 1 1 1 1 1 1 1 1
## 15194 17493 17832 18199 18798 18957 20076 20737 21599 22243 22744 24383 28443
## 1 1 1 1 1 1 1 1 1 1 1 1 1
## 28481 29031 29572 30358 30681 31305 33119 33147 33207 33556 34531 34808 35259
## 1 1 1 1 1 1 1 1 1 1 1 1 1
## 37035
## 1
Ahora podemos seleccionar los usuarios con mayor similitud: 143, 439, 793, 883, 1339.
Visualizaremos las similitud entre usuarios
Las similitudes entre usuarios pueden visualizarse usuando el paquete qgraph. El ancho de las aristas corresponden a la similitud entre usuarios (azul para correlación positiva y rojo para correlación negativa).
sim_mat <- cor(t(rmat), use = 'pairwise.complete.obs')
random_users <- selected_users[120:160]
qgraph(sim_mat[c(current_user, random_users),
c(current_user, random_users)],
layout="spring",
vsize=5,
theme="TeamFortress",
labels=c(current_user, random_users))Paso 2: Obtener predicciones de libros
Para obtener recomendaciones para nuestro usuario debemos tomar los usuarios más similares (por ejemplo 4) y promediar sus calificaciones para aquellos los libros que David aún no ha calificado. Para obtener promedios más confiables podemos incluir únicamente productos que han sido calificados por otros usuarios similares.
similar_users <- names(res[1:4])
similar_users_ratings <- data.frame(item = rep(colnames(rmat),
length(similar_users)),
rating = c(t(as.data.frame(rmat[similar_users,])))) %>% filter(!is.na(rating))
current_user_ratings <- data.frame(item = colnames(rmat),
rating = rmat[current_user,]) %>% filter(!is.na(rating))
predictions <- similar_users_ratings %>%
filter(!(item %in% current_user_ratings$item)) %>%
group_by(item) %>%
summarize(mean_rating = mean(rating))
predictions %>%
datatable(class = "nowrap hover row-border", options = list(dom = 't', scrollX = TRUE, autoWidth = TRUE))Paso 3: Recomendar las 5 mejores predicciones
Obtenido el resultado, ordenaremos las predicciones respecto a la califcación media y recomendar a David los libros con las calificaciones más altas. En nuestro caso serían los libros: 115, 118, 1544, 1597, 17.
predictions %>%
arrange(-mean_rating) %>%
top_n(10, wt = mean_rating) %>%
mutate(book_id = as.numeric(as.character(item))) %>%
left_join(select(books, authors, title, book_id), by = "book_id") %>%
select(-item) %>%
datatable(class = "nowrap hover row-border", options = list(dom = 't',scrollX = TRUE, autoWidth = TRUE))Este es el principio básico del filtro colaborativo basado en usuarios. Ahora podemos evaluar y comparar algunos algoritmos de recomendación.
Usando recommenderlab
Recommenderlab es un paquete de R que provee la infraestructura para evaluar y comprara multiples algoritmos basados en filtros colaborativos.
Muchos algoritmos han sido implementados en este paquete. Podemos utilizarlos para ahorrar el esfuerzo al codificar y evaluar.
Hay una aspecto importante al considerar la representación de la matriz. Como podimos ver anteriormente, la mayoría de los valores en la matriz de calificaiones no se encuentran, ya que los usuarios califican pocos libros. Esto nos permitirá representar la matriz en un formato disperso para ahorrar memoria.
ratingmat0 <- ratingmat
ratingmat0[is.na(ratingmat0)] <- 0
sparse_ratings <- as(ratingmat0, "sparseMatrix")
rm(ratingmat0)
gc()Recommenderlab utiliza una variante especial de las matrices dispersas, así que primero convertimos la matriz en esta clase.
real_ratings <- new("realRatingMatrix", data = sparse_ratings)
real_ratings## 10045 x 812 rating matrix of class 'realRatingMatrix' with 54558 ratings.
Ejecutar un algoritmo en Recommederlab es realmente fácil. Todo lo que tenemos que hacer es llamar a Recommender() y pasarle los datos, seleccionar el método (“UBCF” - user-based collaborative filtering) y pasar algunos parámetros, por ejemplo el método para calcular la similitud y el número de usuarios similares para usar en la predicción).
model <- Recommender(real_ratings, method = "UBCF", param = list(method = "pearson", nn = 4))Crear las predicciones también es muy intuitivo. Solamente hay que llamar a predict() y pasar el modelo, las calificaciones de los usuarios que quieres predicir. y un parámetro que nos diga la función que quieres utilizar para obtener las predicciones de las calificaciones.
#Making predictions
prediction <- predict(model, real_ratings[current_user, ], type = "ratings")Veremos las mejores predicciones para David:
as(prediction, 'data.frame') %>%
arrange(-rating) %>% .[1:5,] %>%
mutate(book_id = as.numeric(as.character(item))) %>%
left_join(select(books, authors, title, book_id), by = "book_id") %>%
select(-item) %>%
datatable(class = "nowrap hover row-border", escape = FALSE, options = list(dom = 't',scrollX = TRUE, autoWidth = TRUE))
Podemos ver que las recomendaciones son similares a las de nuestro algoritmo básico. (4, 17, 20, 27)
Algunas ideas para mejorar el modelo.
El procedimiento mostrado es muy simple. Podemos realizar algunas mejores al algoritmo: 1. Podemos medir la calificaciones por similitud. Esto significa que entre mayor la similitud de un usuario con el usuario en cuestion entonces sus calificaiones reciben un mayor peso en el cálculo de las predicciones.
- El cálculo de la similitud puede llevar pesos de acuerdo a las calificaiones que los usuarios han dado a libros que tienen en común. Entre más calificaiones en común mayor el puntaje de similitud.
Evaluando las predicciones.
Otra ventaja de Recommenderlab es que ofrece la posibilidad de evaluar y comparar fácilmente los algoritmos. Para hacer esto, primero tenemos que crear un esquema de evaluación. Por ejemplo utiliar una validación cruzada de 10. El primer parámetro determina cuantas calificaiones son dadas para crear las predicciones y cuantas predicciones por usuario se utilizaran para evaluarlas. En el caso de -1 indica el numero de items a remover y su desempeño se evalua con 1 para cada usuario.
scheme <- evaluationScheme(real_ratings[1:500,], method = "cross-validation", k = 10, given = -1, goodRating = 5)Como segundo paso, enlistaremos todos los algoritmos que queremos comparar. Los algoritmos que evaluaremos son el IBCF (Item Based Colaborative Filter), el SVD (Singular Value Decomposition), POPULAR, el cual se basa en la popularidad del objeto para realizar una recomendación y un algoritmo aleatorio (RANDOM).
algorithms <- list("random" = list(name = "RANDOM", param = NULL),
"IBCF" = list(name = "IBCF", param = list(method='Pearson', k=10)),
"SVD" = list(name = "SVD", param = list(k=10)),
"POPULAR" = list(name = "POPULAR")
)
# evaluate the alogrithms with the given scheme
results <- evaluate(scheme, algorithms, type = "ratings")## RANDOM run fold/sample [model time/prediction time]
## 1 [0sec/0.02sec]
## 2 [0sec/0.01sec]
## 3 [0sec/0.25sec]
## 4 [0sec/0.03sec]
## 5 [0sec/0.04sec]
## 6 [0sec/0.03sec]
## 7 [0sec/0.05sec]
## 8 [0sec/0.04sec]
## 9 [0.02sec/0.02sec]
## 10 [0sec/0.03sec]
## IBCF run fold/sample [model time/prediction time]
## 1 [2.56sec/0.03sec]
## 2 [2.47sec/0.01sec]
## 3 [2.89sec/0sec]
## 4 [2.58sec/0.03sec]
## 5 [3.46sec/0.02sec]
## 6 [3.61sec/0.03sec]
## 7 [2.42sec/0.02sec]
## 8 [2.34sec/0.02sec]
## 9 [2.13sec/0.02sec]
## 10 [2.59sec/0.03sec]
## SVD run fold/sample [model time/prediction time]
## 1 [0.11sec/0.05sec]
## 2 [0.11sec/0.05sec]
## 3 [0.16sec/0.11sec]
## 4 [0.08sec/0.06sec]
## 5 [0.11sec/0.06sec]
## 6 [0.1sec/0.06sec]
## 7 [0.14sec/0.07sec]
## 8 [0.07sec/0.03sec]
## 9 [0.09sec/0.03sec]
## 10 [0.08sec/0.06sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.02sec/0.04sec]
## 2 [0sec/0.01sec]
## 3 [0sec/0.01sec]
## 4 [0sec/0.01sec]
## 5 [0.01sec/0.02sec]
## 6 [0sec/0.03sec]
## 7 [0.02sec/0.01sec]
## 8 [0sec/0.02sec]
## 9 [0.01sec/0sec]
## 10 [0sec/0.02sec]
# Test with TopN
# results <- evaluate(scheme, algorithms, type = "topNList")
# restructure results output
tmp <- lapply(results, function(x) slot(x, "results"))
res <- tmp %>%
lapply(function(x) unlist(lapply(x, function(x) unlist(x@cm[ ,"RMSE"])))) %>%
as.data.frame() %>%
gather(key = "Algorithm", value = "RMSE")
res %>%
ggplot(aes(Algorithm, RMSE, fill = Algorithm)) +
geom_bar(stat = "summary") + geom_errorbar(stat = "summary", width = 0.3, size = 0.8) +
coord_cartesian(ylim = c(0.6, 1.3)) + guides(fill = FALSE)Podemos ver que de todos los algoritmos, el Item Based Collaborative Filter se desempeñan mejor.
Algoritmos disponibles
También es posbile comparar el desempeño contra diferentes algoritmos. Los siguientes son los disponibles:ble:
recommenderRegistry$get_entry_names()## [1] "HYBRID_realRatingMatrix" "HYBRID_binaryRatingMatrix"
## [3] "ALS_realRatingMatrix" "ALS_implicit_realRatingMatrix"
## [5] "ALS_implicit_binaryRatingMatrix" "AR_binaryRatingMatrix"
## [7] "IBCF_binaryRatingMatrix" "IBCF_realRatingMatrix"
## [9] "LIBMF_realRatingMatrix" "POPULAR_binaryRatingMatrix"
## [11] "POPULAR_realRatingMatrix" "RANDOM_realRatingMatrix"
## [13] "RANDOM_binaryRatingMatrix" "RERECOMMEND_realRatingMatrix"
## [15] "RERECOMMEND_binaryRatingMatrix" "SVD_realRatingMatrix"
## [17] "SVDF_realRatingMatrix" "UBCF_binaryRatingMatrix"
## [19] "UBCF_realRatingMatrix"
Puedes obtener más información acerca de estos algitmos con el siguiente comando.
recommenderRegistry$get_entries(dataType = "realRatingMatrix")Resumen parte II
En los filtros colaborativos la idea principal es utilizar las califcaiones de usuarios similares para crear recomendaciones. El algoritmo básico es fácil de implementar a mano. Pero existen paquetes como Recomenderlab que ayudan mucho a simplificar el trabajo.