Tarea 7
Kervin Alfaro Araya
7/4/2021
##Librerías, dataset y limpieza de datos
#install.packages("glmnet")
library(glmnet)## Warning: package 'glmnet' was built under R version 4.0.5## Loading required package: Matrix## Loaded glmnet 4.1-1library(textrecipes)## Loading required package: recipes## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union##
## Attaching package: 'recipes'## The following object is masked from 'package:Matrix':
##
## update## The following object is masked from 'package:stats':
##
## steplibrary(stopwords)
library(themis)## Registered S3 methods overwritten by 'themis':
## method from
## bake.step_downsample recipes
## bake.step_upsample recipes
## prep.step_downsample recipes
## prep.step_upsample recipes
## tidy.step_downsample recipes
## tidy.step_upsample recipes
## tunable.step_downsample recipes
## tunable.step_upsample recipes##
## Attaching package: 'themis'## The following objects are masked from 'package:recipes':
##
## step_downsample, step_upsamplelibrary(tidymodels)## -- Attaching packages -------------------------------------- tidymodels 0.1.2 --## v broom 0.7.5 v rsample 0.0.9
## v dials 0.0.9 v tibble 3.1.0
## v ggplot2 3.3.3 v tidyr 1.1.3
## v infer 0.5.4 v tune 0.1.3
## v modeldata 0.1.0 v workflows 0.2.2
## v parsnip 0.1.5 v yardstick 0.0.7
## v purrr 0.3.4## -- Conflicts ----------------------------------------- tidymodels_conflicts() --
## x purrr::discard() masks scales::discard()
## x tidyr::expand() masks Matrix::expand()
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## x tidyr::pack() masks Matrix::pack()
## x recipes::step() masks stats::step()
## x themis::step_downsample() masks recipes::step_downsample()
## x themis::step_upsample() masks recipes::step_upsample()
## x tidyr::unpack() masks Matrix::unpack()
## x recipes::update() masks Matrix::update(), stats::update()library(dplyr)
library(tidyr)
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --## v readr 1.4.0 v forcats 0.5.1
## v stringr 1.4.0## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x readr::col_factor() masks scales::col_factor()
## x purrr::discard() masks scales::discard()
## x tidyr::expand() masks Matrix::expand()
## x dplyr::filter() masks stats::filter()
## x stringr::fixed() masks recipes::fixed()
## x dplyr::lag() masks stats::lag()
## x tidyr::pack() masks Matrix::pack()
## x readr::spec() masks yardstick::spec()
## x tidyr::unpack() masks Matrix::unpack()library(tidymodels)
SpamData <- read.csv("https://raw.githubusercontent.com/kervinalfaro/Data-Mining/main/spamData.csv")
Clean_String <- function(string){
# Remover caracteres no UTF-8
temp<- iconv(enc2utf8(string),sub="byte")
temp<- str_replace_all(temp,"[^[:graph:]]", " ")
# Remover todo lo que no sea número o letra
temp <- stringr::str_replace_all(temp,"[^a-zA-Z\\s]", " ")
# remover espacios extra
temp <- stringr::str_replace_all(temp,"[\\s]+", " ")
# minúscula
temp <- tolower(temp)
return(temp)
}
# Aplicar la función a los comentarios
SpamData$message <- Clean_String(SpamData$message )Muestra de entrenamiento y creación de receta
reviewClass <- SpamData %>% # bookseviews ya está precargado y limpio.
mutate(class = factor(if_else(class == "spam","spam", "ham")),
len= str_length(message)
)
#Realizar la partición de las muestras
reviews_split <- initial_split(reviewClass,prop=.7)
reviews_train <- training(reviews_split)
reviews_test <- testing(reviews_split)
#Creamos la receta inicial
reviews_recipe <- recipe(class ~ message+len,
data = reviews_train)
#Aplicar los pasos de procesamiento de datos
reviews_recipeProcessed <- reviews_recipe %>%
step_text_normalization(message) %>% # elimina caracteres extraños
step_tokenize(message) %>%
step_stopwords(message, keep = FALSE) %>%
step_untokenize(message) %>%
step_tokenize(message, token = "ngrams",
options = list(n = 4, n_min = 1)) %>%
step_tokenfilter(message, max_tokens = 200) %>%
step_tfidf(message) %>%
step_upsample(class) #alternativa a step_smote##Ajuste
# Creamos el workflow y la receta para el nuevo modelo
reviews_wf <- workflow() %>%
add_recipe(reviews_recipeProcessed)
# Especificación del modelo
rlasso_spec <- logistic_reg(penalty = tune(), mixture = 1) %>% # Mixture=1 se requiere para indicar que es LASSO
set_engine("glmnet")
# Observamos el modelo especificado
rlasso_spec## Logistic Regression Model Specification (classification)
##
## Main Arguments:
## penalty = tune()
## mixture = 1
##
## Computational engine: glmnet#Ajustar el modelo con los datos
lasso_wf <- workflow() %>%
add_recipe(reviews_recipeProcessed) %>%
add_model(rlasso_spec)
# Observamos el modelo
lasso_wf## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: logistic_reg()
##
## -- Preprocessor ----------------------------------------------------------------
## 8 Recipe Steps
##
## * step_text_normalization()
## * step_tokenize()
## * step_stopwords()
## * step_untokenize()
## * step_tokenize()
## * step_tokenfilter()
## * step_tfidf()
## * step_upsample()
##
## -- Model -----------------------------------------------------------------------
## Logistic Regression Model Specification (classification)
##
## Main Arguments:
## penalty = tune()
## mixture = 1
##
## Computational engine: glmnet# Creamos un grid para entrenar los parametros adicionales del modelo
lambda_grid <- grid_random(penalty(), size = 25)
lambda_grid## # A tibble: 25 x 1
## penalty
## <dbl>
## 1 5.60e- 9
## 2 1.02e-10
## 3 1.91e- 4
## 4 3.33e-10
## 5 4.75e- 2
## 6 2.71e-10
## 7 1.75e- 5
## 8 4.53e- 3
## 9 6.25e- 2
## 10 4.57e- 7
## # ... with 15 more rows#Seteamos semilla aleatoria y creamos los subsets de la validación cruzada
set.seed(123)
reviews_folds <- vfold_cv(reviews_train,v=5)
reviews_folds## # 5-fold cross-validation
## # A tibble: 5 x 2
## splits id
## <list> <chr>
## 1 <split [3120/781]> Fold1
## 2 <split [3121/780]> Fold2
## 3 <split [3121/780]> Fold3
## 4 <split [3121/780]> Fold4
## 5 <split [3121/780]> Fold5#Medición de métricas
# Entrenamos el modelo con los diferentes valores del grid para que escoja los mejores valores de los parametros
set.seed(2020)
lasso_grid <- tune_grid(lasso_wf,
resamples = reviews_folds,
grid = lambda_grid,
control = control_resamples(save_pred = TRUE),
metrics = metric_set(f_meas, recall, precision)
)## ! Fold2: internal: While computing binary `precision()`, no predicted events were...## ! Fold3: preprocessor 1/1, model 1/1: from glmnet Fortran code (error code -75); ...## ! Fold3: internal: While computing binary `precision()`, no predicted events were...## ! Fold4: preprocessor 1/1, model 1/1: from glmnet Fortran code (error code -69); ...## ! Fold5: internal: While computing binary `precision()`, no predicted events were...lasso_grid## Warning: This tuning result has notes. Example notes on model fitting include:
## internal: While computing binary `precision()`, no predicted events were detected (i.e. `true_positive + false_positive = 0`).
## Precision is undefined in this case, and `NA` will be returned.
## Note that 692 true event(s) actually occured for the problematic event level, 'ham'.
## preprocessor 1/1, model 1/1: from glmnet Fortran code (error code -75); Convergence for 75th lambda value not reached after maxit=100000 iterations; solutions for larger lambdas returned
## preprocessor 1/1, model 1/1: from glmnet Fortran code (error code -69); Convergence for 69th lambda value not reached after maxit=100000 iterations; solutions for larger lambdas returned## # Tuning results
## # 5-fold cross-validation
## # A tibble: 5 x 5
## splits id .metrics .notes .predictions
## <list> <chr> <list> <list> <list>
## 1 <split [3120/781]> Fold1 <tibble [75 x 5~ <tibble [0 x 1~ <tibble [19,525 x 5~
## 2 <split [3121/780]> Fold2 <tibble [75 x 5~ <tibble [1 x 1~ <tibble [19,500 x 5~
## 3 <split [3121/780]> Fold3 <tibble [75 x 5~ <tibble [2 x 1~ <tibble [19,500 x 5~
## 4 <split [3121/780]> Fold4 <tibble [75 x 5~ <tibble [1 x 1~ <tibble [19,500 x 5~
## 5 <split [3121/780]> Fold5 <tibble [75 x 5~ <tibble [1 x 1~ <tibble [19,500 x 5~#Visualizamos las métricas del modelo resultante
lasso_grid %>%
collect_metrics()## # A tibble: 75 x 7
## penalty .metric .estimator mean n std_err .config
## <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 1.02e-10 f_meas binary 0.973 5 0.00125 Preprocessor1_Model01
## 2 1.02e-10 precision binary 0.985 5 0.00314 Preprocessor1_Model01
## 3 1.02e-10 recall binary 0.962 5 0.00413 Preprocessor1_Model01
## 4 2.71e-10 f_meas binary 0.973 5 0.00125 Preprocessor1_Model02
## 5 2.71e-10 precision binary 0.985 5 0.00314 Preprocessor1_Model02
## 6 2.71e-10 recall binary 0.962 5 0.00413 Preprocessor1_Model02
## 7 3.33e-10 f_meas binary 0.973 5 0.00125 Preprocessor1_Model03
## 8 3.33e-10 precision binary 0.985 5 0.00314 Preprocessor1_Model03
## 9 3.33e-10 recall binary 0.962 5 0.00413 Preprocessor1_Model03
## 10 5.60e- 9 f_meas binary 0.973 5 0.00125 Preprocessor1_Model04
## # ... with 65 more rows#Visualizamos los cambios de las métricas en función de los valores de penalidad
lasso_grid %>%
collect_metrics() %>%
ggplot(aes(penalty, mean, color = .metric)) +
geom_line(size = 1.5, show.legend = FALSE) +
facet_wrap(~.metric) +
scale_x_log10() +
theme_minimal()
#Modelo final
#seleccionamos el mejor modelo según métrica F1 Score
best_f <- lasso_grid %>%
select_best("f_meas")
best_f## # A tibble: 1 x 2
## penalty .config
## <dbl> <chr>
## 1 1.02e-10 Preprocessor1_Model01#Entrenamos el modelo final con los valores del mejor modelo de entrenamiento
final_lasso <- finalize_workflow(lasso_wf, best_f) %>%
fit(reviews_train)
final_lasso## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: logistic_reg()
##
## -- Preprocessor ----------------------------------------------------------------
## 8 Recipe Steps
##
## * step_text_normalization()
## * step_tokenize()
## * step_stopwords()
## * step_untokenize()
## * step_tokenize()
## * step_tokenfilter()
## * step_tfidf()
## * step_upsample()
##
## -- Model -----------------------------------------------------------------------
##
## Call: glmnet::glmnet(x = maybe_matrix(x), y = y, family = "binomial", alpha = ~1)
##
## Df %Dev Lambda
## 1 0 0.00 0.246500
## 2 1 3.02 0.224600
## 3 1 5.66 0.204700
## 4 1 8.00 0.186500
## 5 1 10.05 0.169900
## 6 1 11.83 0.154800
## 7 2 14.17 0.141100
## 8 3 16.29 0.128500
## 9 4 19.13 0.117100
## 10 4 21.77 0.106700
## 11 5 24.19 0.097230
## 12 6 26.87 0.088590
## 13 9 29.47 0.080720
## 14 12 32.70 0.073550
## 15 15 36.08 0.067020
## 16 16 39.25 0.061060
## 17 19 42.14 0.055640
## 18 23 45.08 0.050700
## 19 25 47.95 0.046190
## 20 28 50.65 0.042090
## 21 32 53.19 0.038350
## 22 33 55.59 0.034940
## 23 35 57.74 0.031840
## 24 38 59.75 0.029010
## 25 39 61.62 0.026430
## 26 43 63.33 0.024080
## 27 45 65.02 0.021940
## 28 45 66.54 0.020000
## 29 48 67.91 0.018220
## 30 53 69.21 0.016600
## 31 55 70.42 0.015130
## 32 56 71.51 0.013780
## 33 58 72.54 0.012560
## 34 59 73.47 0.011440
## 35 68 74.36 0.010430
## 36 70 75.20 0.009499
## 37 76 76.00 0.008656
## 38 77 76.74 0.007887
## 39 83 77.43 0.007186
## 40 89 78.09 0.006548
## 41 98 78.75 0.005966
## 42 103 79.38 0.005436
## 43 107 79.97 0.004953
## 44 113 80.53 0.004513
## 45 124 81.07 0.004112
## 46 130 81.61 0.003747
##
## ...
## and 54 more lines.#Evaluación del modelo
#Evaluamos el modelo con los datos de prueba
review_final <- last_fit(final_lasso,
split=reviews_split,
metrics = metric_set(f_meas, recall, precision)
)
# Observamos métricas del modelo evaluado en datos de prueba
review_final %>%
collect_metrics()## # A tibble: 3 x 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 f_meas binary 0.975 Preprocessor1_Model1
## 2 recall binary 0.967 Preprocessor1_Model1
## 3 precision binary 0.982 Preprocessor1_Model1# Visualizar las predicciones del dataframe de prueba
review_final %>%
collect_predictions %>%
head()## # A tibble: 6 x 5
## id .pred_class .row class .config
## <chr> <fct> <int> <fct> <chr>
## 1 train/test split ham 1 ham Preprocessor1_Model1
## 2 train/test split ham 2 ham Preprocessor1_Model1
## 3 train/test split ham 5 ham Preprocessor1_Model1
## 4 train/test split ham 6 spam Preprocessor1_Model1
## 5 train/test split ham 8 ham Preprocessor1_Model1
## 6 train/test split spam 10 spam Preprocessor1_Model1comment<- "had your mobile months or more u r entitled to update to the latest colour mobiles with camera for free call the mobile update co free on "
len<- str_length(comment)
new_comment <- tribble(~message,~len,comment,len)
new_comment## # A tibble: 1 x 2
## message len
## <chr> <int>
## 1 "had your mobile months or more u r entitled to update to the latest co~ 138prediction<-predict(final_lasso, new_data = new_comment)
paste0("el mensaje es: ",prediction$.pred_class)## [1] "el mensaje es: spam"