Reproduccion del Análisis de sentimientos con tidymodels y #TidyTuesday Reseñas de Animal Crossing de Julia Silge

A.Carolina Ledezma-Carrizalez (Self-Employed R | Venezuela)
2022-11-28

Reproduccion del Análisis de sentimientos con tidymodels y #TidyTuesday Reseñas de Animal Crossing de Julia Silge

Animal Crossing

Animal Crossing es una serie de videojuegos de simulación de vida publicada por Nintendo y creada por Katsuya Eguchi y Hisashi Nogami,en la que el jugador vive en un pueblo habitado por animales antropomórficos, llevando a cabo diversas actividades.

show

Explorar los Datos

Nuestro objetivo de modelado es predecir la calificación de las reseñas de los usuarios de Animal Crossing a partir del conjunto de datos #TidyTuesday de la semana de 6 de mayo de 2020

Comencemos mirando los datos de revisión de los usuarios.

show
user_reviews <- readr::read_tsv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-05/user_reviews.tsv")

user_reviews %>%
  count(grade) %>%
  ggplot(aes(grade, n)) +
  geom_col(fill = "midnightblue", alpha = 0.7)+
  theme_minimal()

Muchas personas otorgan puntajes de cero y muchas personas otorgan puntajes de 10. Esto no parece una buena distribución para predecir una cantidad que ni siquiera es realmente continua como esta grade, por lo que convertiremos estos puntajes de usuario en una etiqueta , reseñas de usuarios buenas y malas y crear un modelo de clasificación.

En el video, utilicé un código como el siguiente para ver algunas reseñas de ejemplo. En realidad, mirar sus datos siempre es una buena idea, ¡y esto no es menos cierto con el texto! 📄 Un tema común de las críticas negativas es la frustración con la configuración de una isla por consola y, más específicamente, los roles relativos del jugador 1 frente a otros en la misma consola.

Definitivamente vimos alguna evidencia de problemas de raspado al mirar el texto de revisión. Eliminemos al menos el final “Expand”de las revisiones y creemos una nueva ratingvariable categórica.

show
reviews_parsed <- user_reviews %>%
  mutate(text = str_remove(text, "Expand$")) %>%
  mutate(rating = case_when(
    grade > 7 ~ "good",
    TRUE ~ "bad"
  ))

¿Cuál es la distribución de palabras por reseña?

show
words_per_review <- reviews_parsed %>%
  unnest_tokens(word, text) %>%
  count(user_name, name = "total_words")

words_per_review %>%
  ggplot(aes(total_words)) +
  geom_histogram(fill = "midnightblue", alpha = 0.8)+
  theme_minimal()

No creo que esta pueda ser una distribución verdadera y natural de palabras por revisión. Esa fuerte caída en la distribución parece muy extraña y creo que es una señal de algún problema con el proceso de generación de datos (es decir, un problema de raspado). ¡Así es la vida a veces! Los datos nunca son perfectos y, a veces, tenemos que hacer lo mejor que podamos con los datos disponibles. Si este fuera mi propio proyecto de principio a fin, volvería a raspar y vería si puedo hacer alguna mejora en esa etapa.

Por ahora, sigamos adelante y veamos qué podemos aprender. Hay muchos más ejemplos geniales de #TidyTuesday EDA para explorar, ¡ incluyendo más minería de texto !

EDA para explorar, ¡ incluyendo más minería de texto !

Vamos a construir un modelo

Podemos comenzar cargando el metapaquete tidymodels y dividiendo nuestros datos en conjuntos de entrenamiento y prueba.

show
set.seed(123)
review_split <- initial_split(reviews_parsed, strata = rating)
review_train <- training(review_split)
review_test <- testing(review_split)

A continuación, preprocesemos nuestros datos para prepararlos para el modelado. Podemos usar pasos especializados de textrecipes , junto con los pasos generales de la receta.

show
review_rec <- recipe(rating ~ text, data = review_train) %>%
  step_tokenize(text) %>%
  step_stopwords(text) %>%
  step_tokenfilter(text, max_tokens = 500) %>%
  step_tfidf(text) %>%
  step_normalize(all_predictors())

review_prep <- prep(review_rec)

review_prep
Recipe

Inputs:

      role #variables
   outcome          1
 predictor          1

Training data contained 2249 data points and no missing data.

Operations:

Tokenization for text [trained]
Stop word removal for text [trained]
Text filtering for text [trained]
Term frequency-inverse document frequency with text [trained]
Centering and scaling for tfidf_text_0, tfidf_text_1, tfidf_tex... [trained]

Repasemos los pasos de esta receta, que son los que considero valores predeterminados sensatos para un primer intento de entrenar un modelo de clasificación de texto, como un modelo de análisis de sentimientos.

Primero, debemos decir recipe()cuál será nuestro modelo (usando una fórmula aquí) y qué datos estamos usando. A continuación, tokenizamos nuestro texto, con la tokenización predeterminada en palabras individuales. A continuación, eliminamos las palabras vacías (nuevamente, solo el conjunto predeterminado). No sería práctico mantener todos los tokens de todo este conjunto de datos en nuestro modelo, por lo que podemos filtrar hacia abajo para mantener solo, en este caso, los 500 tokens más utilizados (después de eliminar las palabras vacías). Este es un corte bastante dramático y mantener más tokens sería un buen próximo paso para mejorar este modelo. A continuación, debemos decidir algún tipo de ponderación para estos tokens, ya sea algo como la frecuencia del término o, lo que usamos aquí, tf-idf . Finalmente, centramos y escalamos (es decir, normalizamos) todos los valores tf-idf recién creados porque el modelo que vamos a usar es sensible a esto. Antes de usar prep(), estos pasos se han definido pero en realidad no se ejecutan ni implementan. La prep()función es donde todo se evalúa.

Ahora es el momento de especificar nuestro modelo. Aquí podemos configurar la especificación del modelo para la regresión de lazo penalty = tune(), ya que aún no conocemos el mejor valor para el parámetro de regularización y mixture = 1para lazo. Según mi experiencia, el lazo ha demostrado ser una buena base para el modelado de texto. (¡Y a veces es difícil hacerlo mucho mejor!)

Estoy usando a workflow()en este ejemplo por conveniencia; estos son objetos que pueden ayudarlo a administrar las canalizaciones de modelado más fácilmente, con piezas que encajan como bloques de Lego. Contiene workflow()tanto la receta como el modelo.

show
lasso_spec <- logistic_reg(penalty = tune(), mixture = 1) %>%
  set_engine("glmnet")

lasso_wf <- workflow() %>%
  add_recipe(review_rec) %>%
  add_model(lasso_spec)

lasso_wf
══ Workflow ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: logistic_reg()

── Preprocessor ──────────────────────────────────────────────────────
5 Recipe Steps

• step_tokenize()
• step_stopwords()
• step_tokenfilter()
• step_tfidf()
• step_normalize()

── Model ─────────────────────────────────────────────────────────────
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = tune()
  mixture = 1

Computational engine: glmnet 

Ajuste los parámetros del modelo

¡Preparémonos para afinar el modelo de lazo! Primero, necesitamos un conjunto de posibles parámetros de regularización para probar.

show
lambda_grid <- grid_regular(penalty(), levels = 40)

A continuación, necesitamos un conjunto de datos remuestreados para ajustar y evaluar todos estos modelos.

show
set.seed(123)
review_folds <- bootstraps(review_train, strata = rating)
review_folds
# Bootstrap sampling using stratification 
# A tibble: 25 × 2
   splits             id         
   <list>             <chr>      
 1 <split [2249/809]> Bootstrap01
 2 <split [2249/850]> Bootstrap02
 3 <split [2249/811]> Bootstrap03
 4 <split [2249/816]> Bootstrap04
 5 <split [2249/855]> Bootstrap05
 6 <split [2249/838]> Bootstrap06
 7 <split [2249/818]> Bootstrap07
 8 <split [2249/825]> Bootstrap08
 9 <split [2249/805]> Bootstrap09
10 <split [2249/808]> Bootstrap10
# … with 15 more rows
# ℹ Use `print(n = ...)` to see more rows

Ahora podemos ponerlo todo junto e implementar el ajuste. Podemos establecer métricas específicas para calcular durante la optimización con metric_set(). Veamos el AUC, el valor predictivo positivo y el valor predictivo negativo para que podamos entender si una clase es más difícil de predecir que otra.

show
doParallel::registerDoParallel()

set.seed(2020)
lasso_grid <- tune_grid(
  lasso_wf,
  resamples = review_folds,
  grid = lambda_grid,
  metrics = metric_set(roc_auc, ppv, npv)
)

Una vez que tengamos nuestros resultados de sintonización, podemos examinarlos en detalle.

show
lasso_grid %>%
  collect_metrics()
# A tibble: 120 × 7
    penalty .metric .estimator  mean     n std_err .config            
      <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>              
 1 1   e-10 npv     binary     0.753    25 0.00438 Preprocessor1_Mode…
 2 1   e-10 ppv     binary     0.867    25 0.00329 Preprocessor1_Mode…
 3 1   e-10 roc_auc binary     0.882    25 0.00261 Preprocessor1_Mode…
 4 1.80e-10 npv     binary     0.753    25 0.00438 Preprocessor1_Mode…
 5 1.80e-10 ppv     binary     0.867    25 0.00329 Preprocessor1_Mode…
 6 1.80e-10 roc_auc binary     0.882    25 0.00261 Preprocessor1_Mode…
 7 3.26e-10 npv     binary     0.753    25 0.00438 Preprocessor1_Mode…
 8 3.26e-10 ppv     binary     0.867    25 0.00329 Preprocessor1_Mode…
 9 3.26e-10 roc_auc binary     0.882    25 0.00261 Preprocessor1_Mode…
10 5.88e-10 npv     binary     0.753    25 0.00438 Preprocessor1_Mode…
# … with 110 more rows
# ℹ Use `print(n = ...)` to see more rows

La visualización suele ser más útil para comprender el rendimiento del modelo.

show
lasso_grid %>%
  collect_metrics() %>%
  ggplot(aes(penalty, mean, color = .metric)) +
  theme_minimal()+
  geom_line(size = 1.5, show.legend = FALSE) +
  facet_wrap(~.metric) +
  scale_x_log10()

Esto nos muestra mucho. Vemos claramente que AUC y PPV se han beneficiado de la regularización y pudimos identificar el mejor valor de penaltypara cada una de esas métricas. No ocurre lo mismo con el VPN. Una clase (los comentarios felices) es más difícil de predecir que la otra. Podría valer la pena incluir más tokens en nuestro modelo, según este gráfico.

Elige el modelo definitivo

Mantengamos nuestro modelo como está por ahora y elijamos un modelo final basado en AUC. Podemos usar select_best()para encontrar el mejor AUC y luego actualizar nuestro flujo de trabajo lasso_wfcon este valor.

show
best_auc <- lasso_grid %>%
  select_best("roc_auc")

best_auc
# A tibble: 1 × 2
  penalty .config              
    <dbl> <chr>                
1 0.00889 Preprocessor1_Model32
show
final_lasso <- finalize_workflow(lasso_wf, best_auc)

final_lasso
══ Workflow ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: logistic_reg()

── Preprocessor ──────────────────────────────────────────────────────
5 Recipe Steps

• step_tokenize()
• step_stopwords()
• step_tokenfilter()
• step_tfidf()
• step_normalize()

── Model ─────────────────────────────────────────────────────────────
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = 0.00888623816274339
  mixture = 1

Computational engine: glmnet 

Este es nuestro flujo de trabajo ajustado y finalizado (pero aún no está en forma). Una de las cosas que podemos hacer cuando comenzamos a ajustar este flujo de trabajo finalizado en todo el conjunto de capacitación es ver cuáles son las variables más importantes que usan el paquete vip .

show
final_lasso %>%
  fit(review_train) %>%
  pull_workflow_fit() %>%
  vi(lambda = best_auc$penalty) %>%
  group_by(Sign) %>%
  top_n(20, wt = abs(Importance)) %>%
  ungroup() %>%
  mutate(
    Importance = abs(Importance),
    Variable = str_remove(Variable, "tfidf_text_"),
    Variable = fct_reorder(Variable, Importance)
  ) %>%
  ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
  theme_minimal()+
  geom_col(show.legend = FALSE) +
  facet_wrap(~Sign, scales = "free_y") +
  labs(y = NULL)

A las personas que están contentas con Animal Crossing les gusta hablar sobre lo relajante, fantástico, agradable y genial que es, y también hablan en sus reseñas sobre el “bombardeo de reseñas” de las reseñas negativas. Tenga en cuenta que muchas de las palabras de las críticas negativas se usan específicamente para hablar sobre la experiencia multijugador (es aburrido para el segundo jugador, el segundo jugador no puede hacer “nada” o hacer avanzar la historia, el juego cooperativo no funciona bien, etc). Estos usuarios quieren una solución y declaran que Nintendo es codicioso por el juego de una isla por consola.

Finalmente, volvamos a nuestros datos de prueba. El paquete de ajuste tiene una función last_fit()que es útil para situaciones en las que ha ajustado y finalizado un modelo o flujo de trabajo y desea ajustarlo por última vez en sus datos de entrenamiento y evaluarlo en sus datos de prueba. Solo tiene que pasar esta función a su modelo/flujo de trabajo finalizado y su división.

show
review_final <- last_fit(final_lasso, review_split)

review_final %>%
  collect_metrics()
# A tibble: 2 × 4
  .metric  .estimator .estimate .config             
  <chr>    <chr>          <dbl> <chr>               
1 accuracy binary         0.877 Preprocessor1_Model1
2 roc_auc  binary         0.943 Preprocessor1_Model1

No ajustamos demasiado durante nuestro proceso de ajuste, y la precisión general no es mala. Vamos a crear una matriz de confusión para los datos de prueba.

show
review_final %>%
  collect_predictions() %>%
  conf_mat(rating, .pred_class)
          Truth
Prediction bad good
      bad  439   55
      good  37  219

Aunque nuestra precisión general no es tan mala, encontramos que es más fácil detectar las críticas negativas que las positivas.