From 3ea9b21820e0500fbb717777325bd1585ed15dc0 Mon Sep 17 00:00:00 2001 From: Felipe Gonzalez Date: Wed, 8 Nov 2023 10:47:39 -0600 Subject: [PATCH] =?UTF-8?q?Agregar=20ejemplo=20de=20recomendaci=C3=B3n=20i?= =?UTF-8?q?mpl=C3=ADcita?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ejemplos/recomendacion-implicita-last-fm.qmd | 193 +++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100644 ejemplos/recomendacion-implicita-last-fm.qmd diff --git a/ejemplos/recomendacion-implicita-last-fm.qmd b/ejemplos/recomendacion-implicita-last-fm.qmd new file mode 100644 index 0000000..8316fa5 --- /dev/null +++ b/ejemplos/recomendacion-implicita-last-fm.qmd @@ -0,0 +1,193 @@ +--- +title: "Recomendación implícita para last-fm 360K" +--- + +Datos de preferencia implícita de Lastfm, . Hay que poner estos datos en datos/lastfm-dataset-360K/ + + +## Limpieza de datos + +Arrancamos spark: + +```{r, message=FALSE, warning=FALSE} +library(tidyverse) +library(sparklyr) +config <- spark_config() +config$`sparklyr.shell.driver-memory` <- "6G" +config$`sparklyr.connect.cores.local` <- 6 +config$`sparklyr.shell.executor-memory` <- "4G" +#config$`spark.env.SPARK_LOCAL_IP.local` <- "0.0.0.0" +sc <- spark_connect(master = "local", config = config) +spark_set_checkpoint_dir(sc, './checkpoint') +``` + +Leemos datos + +```{r} +#http://ocelma.net/MusicRecommendationDataset/lastfm-360K.html +path <- '../datos/lastfm-dataset-360K/usersha1-artmbid-artname-plays.tsv' +lastfm_tbl <- spark_read_csv(sc, + name = "last_fm", path = path, header = FALSE, infer_schema = FALSE, + columns = c("user_id" = "character", "artist_id" = "character", "name" = "character", + "plays" = "integer"), + delim = "\t", quote="\"", overwrite = TRUE) +lastfm_tbl +lastfm_tbl |> tally() +``` + + + +Limpiamos algunos na's y vemos la distribución de número de *plays* + +```{r} +lastfm_tbl <- lastfm_tbl |> + filter(!is.na(plays)) |> + filter(!is.na(artist_id)) +resumen <- lastfm_tbl |> summarise(p_1 = percentile_approx(plays, 0.01), + p_50 = percentile_approx(plays, 0.55), + p_99 = percentile_approx(plays, 0.99), + max = max(plays, na.rm = T), n = n()) |> collect() +resumen +``` + +En la cola superior hay valores muy grandes (casi medio millón de veces para +un usuario y una canción). Podemos filtrar estos valores atípicos. Probamos +por ejemplo con 5000 veces para una canción y un usuario: + +```{r} +lastfm_tbl |> + summarise(mayor_5000 = sum(as.integer(plays > 5000), na.rm = TRUE)) |> collect() +lastfm_tbl <- lastfm_tbl |> filter(plays <= 5000) +``` + +**Nota**: en estos casos, donde tenemos una cola fuertemente larga a la derecha, +podemos usar también $c_{ij} = 1 + \alpha\log(1+r_{ij}/\epsilon)$, donde +$\epsilon>0$ es chica (en el paper, por ejemplo, usan $\epsilon=10^{-8}$). + +Numeramos los usuarios y los artistas, filtramos artistas desconocidos: + + +```{r} +lastfm_tbl <- lastfm_tbl |> + ft_string_indexer("user_id", "user") |> + ft_string_indexer("artist_id", "item") +#Filtramos artista desconocido (buscar el id) +desconocidos <- lastfm_tbl |> + filter(artist_id=="125ec42a-7229-4250-afc5-e057484327fe") |> collect() +table(desconocidos$name) +lastfm_tbl <- lastfm_tbl |> + filter(artist_id != "125ec42a-7229-4250-afc5-e057484327fe") + +``` + +Y podemos ver los artistas más populares, escogiendo un numbre (puede haber +variaciones en el nombre que se identifican con el mismo id) para +cada id de artistas: + +```{r} +artistas <- lastfm_tbl |> + group_by(item, artist_id) |> + summarise(total_plays = sum(plays, na.rm = TRUE), + name = first_value(name), .groups = "drop") +artistas_df <- artistas |> collect() |> arrange(desc(total_plays)) +artistas_df +``` + + +```{r} +lastfm_tbl <- lastfm_tbl |> ungroup() |> select(-name) |> + left_join(artistas |> select(item, name)) |> + group_by(user, item, artist_id, user_id, name) |> + summarise(plays = sum(plays, na.rm = TRUE), .groups = "drop") +lastfm_tbl +``` + + +## ALS para calificaciones implícitas + +Es necesario afinar los siguientes parámetros con un conjunto +de validación. Usamos los siguientes valores como ejemplo: + + +```{r als-spark} +modelo_imp <- ml_als(lastfm_tbl |> select(user, item, plays), + rating_col = "plays", rank = 10, reg_param = 0.01, alpha = 20, + implicit_prefs = TRUE, checkpoint_interval = 5, max_iter = 30) +# Nota: checkpoint evita que la gráfica de cálculo +# sea demasiado grande. Cada 5 iteraciones hace una +# nueva gráfica con los resultados de la última iteración. +``` + + +Estos son los factores de los artistas: + +```{r} +modelo_imp$item_factors +``` + +Y los factores de los usuarios son: + +```{r} +modelo_imp$user_factors +``` + +Podemos examinar predicciones para un usuario. Primero vemos qué escuchó este usuario: + +```{r} +usuario_num <- 11295 +#usuario_num <- 1012 +usuario_plays_df <- lastfm_tbl |> filter(user == usuario_num) |> + arrange(desc(plays)) |> collect() +usuario_plays_df |> select(name, plays) +``` + +Ahora examinamos el ranking de las predicciones: + +```{r} +usuario_df <- artistas_df |> + mutate(user = usuario_num) +usuario_tbl <- copy_to(sc, usuario_df, name ="usuario", overwrite = TRUE) +usuario_tbl <- ml_predict(modelo_imp, usuario_tbl) |> + mutate(rank = percent_rank(prediction)) |> + select(name, total_plays, rank) +usuario_tbl |> filter(total_plays > 500000) |> + arrange(desc(rank)) +``` + + +```{r} +usuario_df <- usuario_tbl |> collect() +ranking_df <- usuario_df |> + left_join(usuario_plays_df |> + select(name, plays)) |> + mutate(plays = ifelse(is.na(plays), 0, 1)) +``` + +Obtenemos el siguiente ranking de entrenamiento: + +```{r} +ranking_df |> summarise(error_rank = sum(plays * rank) / sum(plays)) +``` + +Si escogiéramos el ranking al azar, obtenemos alrededor de 0.5: + +```{r} +ranking_df |> mutate(rank = runif(length(rank))) |> summarise(error_rank = sum(plays * rank) / sum(plays)) +``` + +## Examinando los factores + + + + + + + + + + + + +```{r} +spark_disconnect(sc) +```