
Grupo 601
Profesor Alan Hazael Coello
Alumnas:
Avril Lobato Delgado A00833113 Lisset Hernández Montoya A01284611
Introducción
El sistema de recomendación depende de las calificaciones que da la
gente a un objeto, por ende, entre más esparcidad, es decir, entre mayor
aparición de valores NA’s o vacíos, el sistema tiende a ser menos
eficiente.
Librerías
library(tidyverse)
library(recommenderlab)
Dataframe de rankings de películas acorde a usuarios del
grupo
Se seleccionan tres usuarios del salón a inventar datos de usuarios y
convertirlos en una matriz
movie_ratings <- data.frame(
KungFuPanda1 = c(5, 4, 4, 5),
Enredados = c(4, 3, 4, 4),
UP = c(4, 2, NA, 4),
Cars1 = c(5, 5, 4, 5),
ToyStory3 = c(3, 2, 4, 3),
Shrek2 = c(5, 3, 5, 4),
LaMonja = c(2, 4, NA, 2)
)
rownames(movie_ratings) <- c('Luis_Elizondo', 'David_Castillo', 'You', "Emilio_Martinez")
movie_ratings
## KungFuPanda1 Enredados UP Cars1 ToyStory3 Shrek2 LaMonja
## Luis_Elizondo 5 4 4 5 3 5 2
## David_Castillo 4 3 2 5 2 3 4
## You 4 4 NA 4 4 5 NA
## Emilio_Martinez 5 4 4 5 3 4 2
Construcción de matrices
# Funcion de coseno que va a sacar las distancias
cosine_similarity <- function(vec_1, vec_2) {
vec_len <- length(vec_1)
# NA values are replaced with 0
vec_1[is.na(vec_1)] <- 0
vec_2[is.na(vec_2)] <- 0
# Computing the denominator
vec_1_denom <- sqrt(sum(vec_1^2))
vec_2_denom <- sqrt(sum(vec_2^2))
denominator <- vec_1_denom * vec_2_denom
# Computing the numerator
tib = tibble(vec_1 = vec_1, vec_2 = vec_2)
tib <- tib %>% mutate(products = vec_1 * vec_2)
numerator <- sum(tib$products)
# Return the cosine similarity
return (numerator / denominator)
}
Construcción de vectores según distancia
cosenoidal
# Obtenemos los vectores de cada persona
you <- as.numeric(as.vector(movie_ratings['You',]))
Luis_Elizondo <- as.numeric(as.vector(movie_ratings['Luis_Elizondo',]))
David_Castillo <- as.numeric(as.vector(movie_ratings['David_Castillo',]))
Emilio_Martinez <- as.numeric(as.vector(movie_ratings['Emilio_Martinez',]))
# Obtenemos "distancia" usando similitud por conseno
similarities <- data.frame(
cosine_similarity = c(cosine_similarity(you, Luis_Elizondo), cosine_similarity(you, David_Castillo), cosine_similarity(you, Emilio_Martinez))
)
rownames(similarities) <- c('Luis_Elizondo', 'David_Castillo', 'Emilio_Martinez')
similarities
## cosine_similarity
## Luis_Elizondo 0.8999064
## David_Castillo 0.8260842
## Emilio_Martinez 0.8853728
Obtención de promedios de rankings acorde a
usuarios
# Creamos una función para obtener un promedio ponderado en base a los amigos
movie_rating_weighted_average <- function(movie, friends) {
denominator <- 0
numerator <- 0
for (friend in friends) {
friend_similarity <- similarities[friend,][1]
friend_rating <- movie_ratings[friend, movie][1]
# Tomaremos el promedio ponderado en cuenta solo para películas con calificación
if (is.na(friend_rating)) next
denominator <- denominator + friend_similarity
numerator <- numerator + (friend_similarity * friend_rating)
}
return (numerator / denominator)
}
Predicción de Rankings
Se emplea la función creada con anterioridad para predecir “You” en
base a los tres usuarios para todas las películas
friend_names <- c('Luis_Elizondo', 'David_Castillo', 'Emilio_Martinez')
new_movies <- c('Shrek2', 'LaMonja', 'KungFuPanda1', "Enredados","UP","Cars1","ToyStory3")
new_movie_predicted_ratings <- tibble()
for (n in new_movies) {
predicted_rating <- movie_rating_weighted_average(n, friend_names)
prediction_tibble <- tibble(movie = n, predicted_rating = predicted_rating)
new_movie_predicted_ratings <- bind_rows(new_movie_predicted_ratings, prediction_tibble)
}
new_movie_predicted_ratings <- new_movie_predicted_ratings %>%
arrange(desc(predicted_rating))
new_movie_predicted_ratings
## # A tibble: 7 × 2
## movie predicted_rating
## <chr> <dbl>
## 1 Cars1 5
## 2 KungFuPanda1 4.68
## 3 Shrek2 4.03
## 4 Enredados 3.68
## 5 UP 3.37
## 6 ToyStory3 2.68
## 7 LaMonja 2.63
Conclusión
Con base en lo anteriormente realizado, se destaca que el usuario de
“You” tiene mayor afinidad en gustos cinematográficos con el usuario de
Lusi Elizondo, en comparación con los otros usuarios, David Castillo y
Emilio Martínez. Esto sugiere que las predicciones de rating para las
películas no vistas por “You” están más en línea con las evaluaciones de
Luis Elizondo que con las de los otros dos usuarios. Acorde a esto, se
determina y/o predice que la película de “La Monja” sería de poco agrado
para “You” con una ponderación de 2.6; a diferencia de “Shrek 2” la cual
le daría una ponderación de 4.02. En consecuencia, la película de “La
Monja” sería el filme con menor agrado en la muestra con una
calificación menor a 3. Asimismo, se denota que “You” podría tomar
recomendaciones de películas de Luis Elizondo con más confianza, ya que
es más probable que disfruten de las mismas películas debido a su
similitud en ratings.
LS0tDQp0aXRsZTogIlNpc3RlbWEgZGUgUmVjb21lbmRhY2nDs24iDQpzdWJ0aXRsZTogIkNEMzAwMkMgSW50ZWxpZ2VuY2lhIEFydGlmaWNpYWwgY29uIEltcGFjdG8gRW1wcmVzYXJpYWwiDQphdXRob3I6ICJBdnJpbCBMb2JhdG8geSBMaXNzZXQgSGVybsOhbmRleiINCmRhdGU6ICIyMDI0LTAzLTIxIg0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQogICAgdG9jX2Zsb2F0OiB5ZXMNCiAgICBjb2RlX2Rvd25sb2FkOiB5ZXMNCiAgICB0aGVtZTogY2VydWxlYW4NCiAgICBoaWdobGlnaHQ6IHB5Z21lbnRzDQplZGl0b3Jfb3B0aW9uczogDQogIGNodW5rX291dHB1dF90eXBlOiBjb25zb2xlDQotLS0NCiFbXShodHRwczovL2NpdHJpcy11Yy5vcmcvd3AtY29udGVudC91cGxvYWRzLzIwMTkvMTAvVGVjLWRlLU1vbnRlcnJleS1sb2dvLWhvcml6b250YWwtYmx1ZS5wbmcpDQoNCjxkaXYgc3R5bGU9InRleHQtYWxpZ246IGNlbnRlciI+DQogIDxwPjxzdHJvbmc+R3J1cG8gNjAxPC9zdHJvbmc+PC9wPg0KICA8cD48c3Ryb25nPlByb2Zlc29yIEFsYW4gSGF6YWVsIENvZWxsbzwvc3Ryb25nPjwvcD4NCjwvZGl2Pg0KDQo8ZGl2IHN0eWxlPSJ0ZXh0LWFsaWduOiBjZW50ZXIiPg0KICA8cD48c3Ryb25nPkFsdW1uYXM6PC9zdHJvbmc+PC9wPg0KDQogIEF2cmlsIExvYmF0byBEZWxnYWRvIEEwMDgzMzExMw0KICBMaXNzZXQgSGVybsOhbmRleiBNb250b3lhIEEwMTI4NDYxMQ0KDQoNCjwvZGl2Pg0KDQoNCiMgKipJbnRyb2R1Y2Npw7NuKioNCkVsIHNpc3RlbWEgZGUgcmVjb21lbmRhY2nDs24gZGVwZW5kZSBkZSBsYXMgY2FsaWZpY2FjaW9uZXMgcXVlIGRhIGxhIGdlbnRlIGEgdW4gb2JqZXRvLCBwb3IgZW5kZSwgZW50cmUgbcOhcyBlc3BhcmNpZGFkLCBlcyBkZWNpciwgZW50cmUgbWF5b3IgYXBhcmljacOzbiBkZSB2YWxvcmVzIE5BJ3MgbyB2YWPDrW9zLCBlbCBzaXN0ZW1hIHRpZW5kZSBhIHNlciBtZW5vcyBlZmljaWVudGUuDQoNCg0KIyAqKkxpYnJlcsOtYXMqKg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoDQoJZWNobyA9IFRSVUUsDQoJbWVzc2FnZSA9IEZBTFNFLA0KCXdhcm5pbmcgPSBGQUxTRQ0KKQ0KYGBgDQoNCmBgYHtyIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKSAgIA0KbGlicmFyeShyZWNvbW1lbmRlcmxhYikNCmBgYA0KDQojICoqRGF0YWZyYW1lIGRlIHJhbmtpbmdzIGRlIHBlbMOtY3VsYXMgYWNvcmRlIGEgdXN1YXJpb3MgZGVsIGdydXBvKioNClNlIHNlbGVjY2lvbmFuIHRyZXMgdXN1YXJpb3MgZGVsIHNhbMOzbiAgYSBpbnZlbnRhciBkYXRvcyBkZSB1c3VhcmlvcyB5IGNvbnZlcnRpcmxvcyBlbiB1bmEgbWF0cml6DQoNCmBgYHtyIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCm1vdmllX3JhdGluZ3MgPC0gZGF0YS5mcmFtZSgNCiAgS3VuZ0Z1UGFuZGExID0gYyg1LCA0LCA0LCA1KSwgDQogIEVucmVkYWRvcyA9IGMoNCwgMywgNCwgNCksDQogIFVQID0gYyg0LCAyLCBOQSwgNCksDQogIENhcnMxID0gYyg1LCA1LCA0LCA1KSwNCiAgVG95U3RvcnkzID0gYygzLCAyLCA0LCAzKSwNCiAgU2hyZWsyID0gYyg1LCAzLCA1LCA0KSwNCiAgTGFNb25qYSA9IGMoMiwgNCwgTkEsIDIpDQopDQpyb3duYW1lcyhtb3ZpZV9yYXRpbmdzKSA8LSBjKCdMdWlzX0VsaXpvbmRvJywgJ0RhdmlkX0Nhc3RpbGxvJywgJ1lvdScsICJFbWlsaW9fTWFydGluZXoiKQ0KbW92aWVfcmF0aW5ncw0KYGBgDQoNCiMgKipDb25zdHJ1Y2Npw7NuIGRlIG1hdHJpY2VzKioNCmBgYHtyIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCiAgIyBGdW5jaW9uIGRlIGNvc2VubyBxdWUgdmEgYSBzYWNhciBsYXMgZGlzdGFuY2lhcw0KY29zaW5lX3NpbWlsYXJpdHkgPC0gZnVuY3Rpb24odmVjXzEsIHZlY18yKSB7DQogIHZlY19sZW4gPC0gbGVuZ3RoKHZlY18xKQ0KICANCiAgIyBOQSB2YWx1ZXMgYXJlIHJlcGxhY2VkIHdpdGggMA0KICB2ZWNfMVtpcy5uYSh2ZWNfMSldIDwtIDANCiAgdmVjXzJbaXMubmEodmVjXzIpXSA8LSAwDQogIA0KICAjIENvbXB1dGluZyB0aGUgZGVub21pbmF0b3INCiAgdmVjXzFfZGVub20gPC0gc3FydChzdW0odmVjXzFeMikpDQogIHZlY18yX2Rlbm9tIDwtIHNxcnQoc3VtKHZlY18yXjIpKQ0KICBkZW5vbWluYXRvciA8LSB2ZWNfMV9kZW5vbSAqIHZlY18yX2Rlbm9tDQogIA0KICAjIENvbXB1dGluZyB0aGUgbnVtZXJhdG9yDQogIHRpYiA9IHRpYmJsZSh2ZWNfMSA9IHZlY18xLCB2ZWNfMiA9IHZlY18yKQ0KICB0aWIgPC0gdGliICU+JSBtdXRhdGUocHJvZHVjdHMgPSB2ZWNfMSAqIHZlY18yKQ0KICBudW1lcmF0b3IgPC0gc3VtKHRpYiRwcm9kdWN0cykNCiAgDQogICMgUmV0dXJuIHRoZSBjb3NpbmUgc2ltaWxhcml0eQ0KICByZXR1cm4gKG51bWVyYXRvciAvIGRlbm9taW5hdG9yKQ0KfQ0KYGBgDQoNCiMgKipDb25zdHJ1Y2Npw7NuIGRlIHZlY3RvcmVzIHNlZ8O6biBkaXN0YW5jaWEgY29zZW5vaWRhbCoqDQpgYGB7ciBlY2hvPVRSVUUsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQojIE9idGVuZW1vcyBsb3MgdmVjdG9yZXMgZGUgY2FkYSBwZXJzb25hDQp5b3UgPC0gYXMubnVtZXJpYyhhcy52ZWN0b3IobW92aWVfcmF0aW5nc1snWW91JyxdKSkNCkx1aXNfRWxpem9uZG8gPC0gYXMubnVtZXJpYyhhcy52ZWN0b3IobW92aWVfcmF0aW5nc1snTHVpc19FbGl6b25kbycsXSkpDQpEYXZpZF9DYXN0aWxsbyA8LSBhcy5udW1lcmljKGFzLnZlY3Rvcihtb3ZpZV9yYXRpbmdzWydEYXZpZF9DYXN0aWxsbycsXSkpDQpFbWlsaW9fTWFydGluZXogPC0gYXMubnVtZXJpYyhhcy52ZWN0b3IobW92aWVfcmF0aW5nc1snRW1pbGlvX01hcnRpbmV6JyxdKSkNCg0KDQojIE9idGVuZW1vcyAiZGlzdGFuY2lhIiB1c2FuZG8gc2ltaWxpdHVkIHBvciBjb25zZW5vDQpzaW1pbGFyaXRpZXMgPC0gZGF0YS5mcmFtZSgNCiAgY29zaW5lX3NpbWlsYXJpdHkgPSBjKGNvc2luZV9zaW1pbGFyaXR5KHlvdSwgTHVpc19FbGl6b25kbyksIGNvc2luZV9zaW1pbGFyaXR5KHlvdSwgRGF2aWRfQ2FzdGlsbG8pLCBjb3NpbmVfc2ltaWxhcml0eSh5b3UsIEVtaWxpb19NYXJ0aW5leikpDQopDQpyb3duYW1lcyhzaW1pbGFyaXRpZXMpIDwtIGMoJ0x1aXNfRWxpem9uZG8nLCAnRGF2aWRfQ2FzdGlsbG8nLCAnRW1pbGlvX01hcnRpbmV6JykNCnNpbWlsYXJpdGllcw0KYGBgDQoNCiMgKipPYnRlbmNpw7NuIGRlIHByb21lZGlvcyBkZSByYW5raW5ncyBhY29yZGUgYSB1c3VhcmlvcyoqDQpgYGB7ciBlY2hvPVRSVUUsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQojIENyZWFtb3MgdW5hIGZ1bmNpw7NuIHBhcmEgb2J0ZW5lciB1biBwcm9tZWRpbyBwb25kZXJhZG8gZW4gYmFzZSBhIGxvcyBhbWlnb3MNCm1vdmllX3JhdGluZ193ZWlnaHRlZF9hdmVyYWdlIDwtIGZ1bmN0aW9uKG1vdmllLCBmcmllbmRzKSB7DQogIGRlbm9taW5hdG9yIDwtIDANCiAgbnVtZXJhdG9yIDwtIDANCiAgZm9yIChmcmllbmQgaW4gZnJpZW5kcykgew0KICAgIGZyaWVuZF9zaW1pbGFyaXR5IDwtIHNpbWlsYXJpdGllc1tmcmllbmQsXVsxXQ0KICAgIGZyaWVuZF9yYXRpbmcgPC0gbW92aWVfcmF0aW5nc1tmcmllbmQsIG1vdmllXVsxXQ0KICAgIA0KICAgICMgVG9tYXJlbW9zIGVsIHByb21lZGlvIHBvbmRlcmFkbyBlbiBjdWVudGEgc29sbyBwYXJhIHBlbMOtY3VsYXMgY29uIGNhbGlmaWNhY2nDs24NCiAgICBpZiAoaXMubmEoZnJpZW5kX3JhdGluZykpIG5leHQNCiAgICANCiAgICBkZW5vbWluYXRvciA8LSBkZW5vbWluYXRvciArIGZyaWVuZF9zaW1pbGFyaXR5DQogICAgbnVtZXJhdG9yIDwtIG51bWVyYXRvciArIChmcmllbmRfc2ltaWxhcml0eSAqIGZyaWVuZF9yYXRpbmcpDQogIH0NCiAgDQogIHJldHVybiAobnVtZXJhdG9yIC8gZGVub21pbmF0b3IpDQp9DQpgYGANCg0KDQojICoqUHJlZGljY2nDs24gZGUgUmFua2luZ3MqKg0KU2UgZW1wbGVhIGxhIGZ1bmNpw7NuIGNyZWFkYSBjb24gYW50ZXJpb3JpZGFkIHBhcmEgcHJlZGVjaXIgIllvdSIgZW4gYmFzZSBhIGxvcyB0cmVzIHVzdWFyaW9zIHBhcmEgdG9kYXMgbGFzIHBlbMOtY3VsYXMNCmBgYHtyIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmZyaWVuZF9uYW1lcyA8LSBjKCdMdWlzX0VsaXpvbmRvJywgJ0RhdmlkX0Nhc3RpbGxvJywgJ0VtaWxpb19NYXJ0aW5leicpDQpuZXdfbW92aWVzIDwtIGMoJ1NocmVrMicsICdMYU1vbmphJywgJ0t1bmdGdVBhbmRhMScsICJFbnJlZGFkb3MiLCJVUCIsIkNhcnMxIiwiVG95U3RvcnkzIikNCm5ld19tb3ZpZV9wcmVkaWN0ZWRfcmF0aW5ncyA8LSB0aWJibGUoKQ0KZm9yIChuIGluIG5ld19tb3ZpZXMpIHsNCiAgcHJlZGljdGVkX3JhdGluZyA8LSBtb3ZpZV9yYXRpbmdfd2VpZ2h0ZWRfYXZlcmFnZShuLCBmcmllbmRfbmFtZXMpDQogIHByZWRpY3Rpb25fdGliYmxlIDwtIHRpYmJsZShtb3ZpZSA9IG4sIHByZWRpY3RlZF9yYXRpbmcgPSBwcmVkaWN0ZWRfcmF0aW5nKQ0KICBuZXdfbW92aWVfcHJlZGljdGVkX3JhdGluZ3MgPC0gYmluZF9yb3dzKG5ld19tb3ZpZV9wcmVkaWN0ZWRfcmF0aW5ncywgcHJlZGljdGlvbl90aWJibGUpDQp9DQpuZXdfbW92aWVfcHJlZGljdGVkX3JhdGluZ3MgPC0gbmV3X21vdmllX3ByZWRpY3RlZF9yYXRpbmdzICU+JQ0KICBhcnJhbmdlKGRlc2MocHJlZGljdGVkX3JhdGluZykpDQoNCm5ld19tb3ZpZV9wcmVkaWN0ZWRfcmF0aW5ncw0KYGBgDQoNCiMgKipDb25jbHVzacOzbioqDQpDb24gYmFzZSBlbiBsbyBhbnRlcmlvcm1lbnRlIHJlYWxpemFkbywgc2UgZGVzdGFjYSBxdWUgZWwgdXN1YXJpbyBkZSAiWW91IiB0aWVuZSBtYXlvciBhZmluaWRhZCBlbiBndXN0b3MgY2luZW1hdG9ncsOhZmljb3MgY29uIGVsIHVzdWFyaW8gZGUgTHVzaSBFbGl6b25kbywgZW4gY29tcGFyYWNpw7NuIGNvbiBsb3Mgb3Ryb3MgdXN1YXJpb3MsIERhdmlkIENhc3RpbGxvIHkgRW1pbGlvIE1hcnTDrW5lei4gRXN0byBzdWdpZXJlIHF1ZSBsYXMgcHJlZGljY2lvbmVzIGRlIHJhdGluZyBwYXJhIGxhcyBwZWzDrWN1bGFzIG5vIHZpc3RhcyAgcG9yICJZb3UiIGVzdMOhbiBtw6FzIGVuIGzDrW5lYSBjb24gbGFzIGV2YWx1YWNpb25lcyBkZSBMdWlzIEVsaXpvbmRvIHF1ZSBjb24gbGFzIGRlIGxvcyBvdHJvcyBkb3MgdXN1YXJpb3MuIEFjb3JkZSBhIGVzdG8sIHNlIGRldGVybWluYSB5L28gcHJlZGljZSBxdWUgbGEgcGVsw61jdWxhIGRlICJMYSBNb25qYSIgc2Vyw61hIGRlIHBvY28gYWdyYWRvIHBhcmEgIllvdSIgY29uIHVuYSBwb25kZXJhY2nDs24gZGUgMi42OyBhIGRpZmVyZW5jaWEgZGUgIlNocmVrIDIiIGxhIGN1YWwgbGUgZGFyw61hIHVuYSBwb25kZXJhY2nDs24gZGUgNC4wMi4gRW4gY29uc2VjdWVuY2lhLCBsYSBwZWzDrWN1bGEgZGUgIkxhIE1vbmphIiBzZXLDrWEgZWwgZmlsbWUgY29uIG1lbm9yIGFncmFkbyBlbiBsYSBtdWVzdHJhIGNvbiB1bmEgY2FsaWZpY2FjacOzbiBtZW5vciBhIDMuIEFzaW1pc21vLCBzZSBkZW5vdGEgcXVlICJZb3UiIHBvZHLDrWEgdG9tYXIgcmVjb21lbmRhY2lvbmVzIGRlIHBlbMOtY3VsYXMgZGUgTHVpcyBFbGl6b25kbyBjb24gbcOhcyBjb25maWFuemEsIHlhIHF1ZSBlcyBtw6FzIHByb2JhYmxlIHF1ZSBkaXNmcnV0ZW4gZGUgbGFzIG1pc21hcyBwZWzDrWN1bGFzIGRlYmlkbyBhIHN1IHNpbWlsaXR1ZCBlbiByYXRpbmdzLg0KDQo=