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=